      HED PURGE * THE PURGE COMMAND MAKES IT POSSIBLE TO REMOVE FROM THE LIBRARY* PROGRAMS WHICH HAVE NOT BEEN ACCESSED FOR SOME PERIOD OF TIME.* THE FORMAT FOR THE COMMAND IS AS FOLLOWS: * *     PURGE-DAY/YEAR* * WHERE DAY IS AN INTEGER FROM 1 TO 366 AND YEAR IS AN INTEGER FROM * 0 TO 99. ALL PROGRAMS OR FILES WHICH HAVE NOT BEEN ACCESSED SINCE * THE SPECIFIED DATE ARE DELETED FROM THE LIBRARY.* * PURGE WILL REFUSE TO OPERATE IF THE SPECIFIED DATE IS BEYOND* TODAY'S DATE. * * THE ALGORITHM USED OPERATES IN A MANNER ALMOST IDENTICAL TO THAT* USED IN THE LOCK OVERLAY SECTION, EXCEPT THAT THE ADT MUST BE * UPDATED IN ADDITION TO THE IDT.  THE ACTUAL UPDATING OF THESE IS* PERFORMED BY CALLING THE ROUTINE PURFX, WHICH READS IN THE PURGE* OVERLAY ROUTINE TO DO THE UPDATING.       SPC 3       ORG LIBRA       LDA A000      IF HELLO PROGRAM      STA LTEMP      EXISTS, ASSIGN IT      LDA PURHE       TODAY'S DATE SO IT      STA LTEMP+1      DOESN'T GET PURGED.      DLD PURHE+1       DST LTEMP+2       JSB DLOOK       RSS       JMP PUR2      JSB DATE      LDB LTEMP+5       ADB .+5       STA 1,I       LDA LTEMP+4       ADA .+6       LDA 0,I       LDB LIBD      JSB DISCL * * INTERPRET DATE. * PUR2  JSB PURNO     GET DAY OF YEAR.      DEC -367      CPA .+57B     TEST FOR NONZERO AND SLASH FOL-       SZB,RSS        LOWING.      JMP PUR1      PARAMETER ERROR.      STB PURDT     SAVE DATE.      JSB PURNO     NOW GET THE YEAR.       DEC -100      CPA .+15B     CHECK FOR RETURN FOLLOWING.       CLA,RSS       JMP PUR1*       RRR 7         MERGE YEAR AND DATE.      IOR PURDT       STA PURDT       JSB DATE      NOW GET TODAY'S DATE.       LDB PURDT     MAKE SURE SPECIFIED DATE IS       CMB,CLE,INB    <=TODAY'S DATE       ADA 1       SEZ,RSS       JMP PUR1* * THE NEXT STEP IS TO GUARANTEE THAT WE DON'T KILL ANY FILES CUR- * RENTLY IN USE. TO DO THIS WE WILL CHECK THAT THE FUSS TABLE IS* EMPTY.*       LDA M128      READ FUSS       STA WORD       TABLE.       LDA FUSS,I      LDB LIBDI       JSB DISCL *       LDB LIBDPUR4  CPB L128      DONE?       JMP PUR3      YES.      LDA 1,I       SZA       JMP PUR7      INB       JMP PUR4* * ROUTINE TO INPUT A NUMBER * PURNO NOP       JSB PURDG     GET A DIGIT       JMP LFRER     ILLEGAL IF NONE.PURN1 STB PURN      SAVE PARTIAL RESULT.      ADB PURNO,I   CHECK FOR OVERFLOW.       SSB,RSS       JMP PUR1      JSB PURDG     GET NEXT DIGIT.       JMP PURN2     END OF NUMBER.      LDA PURN      MULTIPLY PREVIOUS RESULT BY 10.       RAL,RAL       ADA PURN      RAL       ADB 0         ADD IN NEW VALUE      JMP PURN1     LOOPPURN2 LDB PURN      RETURN NO.      ISZ PURNO       JMP PURNO,I * * PURDG NOP           GET DECIMAL DIGIT       JSB T35CQ     GET CHAR.       JMP PURDG,I   NONE THERE.       LDB 0         DO DIGIT TEST.      ADB M72B      SSB,RSS       JMP PURDG,I       ADB .+10      SSB,RSS       ISZ PURDG       JMP PURDG,I * * ERROR PRINT.* PUR1  LDB .-18      JSB PURER       OCT 5111      ASC 8,LLEGAL PARAMETERPUR7  LDB .-11      JSB PURER       OCT 5102      ASC 6,USY FILES PURER NOP       STB PURN      LDA T35B1       STA MOVED       LDA PURER       STA MOVES       BRS       JSB MOVEW       LDA PURN      CMA,INA       LDB T35B1       JMP LEND+2* PUR3  LDA IDLEN      COMPUTE NEGATIVE       LDB IDLEN      POINTER TO TEST      CMB,INB         WHEN PURFX MUST       ADB ADLEN        BE CALLED.       SSB       LDA ADLEN       ADA MLIBD       ADA .-4       STA PURID *       LDA L5440     INITIALIZE POINTER TO       STA PURP       END OF CORE TABLE.       LDA DIRD0     INITIALIZE DIRECTORY POINTER. PUR10 STA PURI      LDA PURP      CAN DIRECTORY FIT?      ADA PURI,I      ADA MLIBD       SSA       JSB PURFX     NO--PERFORM CLEARNUP.       LDA PURI,I    READ DIRECTORY.       STA WORD      LDA PURI      ADA .+6       LDA 0,I       STA PURDD       LDB LIBDI       JSB DISCL *       LDA LIBD      INITIALIZE POINTERS.      STA MOVED       STA MOVES       CMA       ADA PURI,I      CMA       STA PURD* PUR11 LDB MOVES     FINISHED SCANNING DIRECTORY?      CPB PURD      JMP PUR12     YES.      ADB .+5       DO WE WANT TO DELETE THIS ENTRY?      LDA PURDT       CMA,CLE,INA       ADA 1,I       SEZ,RSS       JMP PUR13     YES.      LDB .-8       NO-MOVE UP ENTRY      JSB MOVEW       JMP PUR11 * * ENTRY DELETION. * PUR13 LDA MOVES,I   COPY ID,DISC ADR.,LENGTH INTO T.      STA PURT      ADB .+3       STB MOVES       ADB .-2       DLD 1,I       STA PURT+1      ASR 6       CMB,INB       STB PURT+2*       LDA PURD      CAN NEW ENTRY FIT IN WITH THE       CMA,INA        DIRECTORY?       STA 1       ADA .-3       ADA PURP      SSA,RSS       JMP PUR14     YES--GO DO NEXT TEST. * * SQUEEZE DIRECTORY.*       LDA MOVED     SAVE DEST       STA PURN       POINTER.       ADB MOVES     MOVE REMAINDER      JSB MOVEW      OF DIRECTORY.      LDA MOVED     RESET       STA PURD       POINTERS.      LDA PURN      STA MOVED       STA MOVES * PUR14 LDA PURP      WILL IDT AND ADT STILL FIT IF       ADA PURID      WE MAKE ANOTHER ENTRY?       SSA,RSS       JMP PUR15     YES.*       LDA PURD      WRITE OUT DIRECTORY.      CMA,INA       ADA LIBD      STA WORD      STA PURW      LDA PURDD       LDB LIBD      JSB DISCL *       JSB PURFX     CLEAN UP. *       LDA PURW      READ      STA WORD       DIRECTORY      LDA PURDD       BACK.       LDB LIBDI       JSB DISCL * PUR15 CCB           MAKE TABLE ENTRY.       ADB PURP      LDA PURT+2      STA 1,I       ADB .-2       STB PURP      DLD PURT      DST PURP,I      JMP PUR11 PUR12 LDA MOVED     UPDATE DIREC.       CMA,INA       ADA LIBD      STA PURI,I      STA WORD      LDA LIBD      STA MOVES       LDA PURI      INA       STA MOVED       LDB .-4       JSB MOVEW       LDA PURDD     WRITE OUT DIRECTORY.      LDB LIBD      JSB DISCL       LDA PURI      LAST TRACK?       CPA DIRD3       JMP *+3       ADA .+7       JMP PUR10       JSB PURFX       JMP LENDPURXF LDA PURLN     GET BACK TO PURGE.      STA WORD      LDA LIB,I       LDB #LIBI       JSB DISCL       JMP PURFX,I * PURFX NOP           ROUTINE TO CALL IN OVERLAY.       DLD LIB,I       LDA 1       LDB PURLN       STB WORD      LDB #LIBI       JSB DISCL       JMP LIBRA PURLN ABS LIBRA-PURXF PURHE ASC 3,HELLO $PUR  EQU *       HED PURGE OVERLAY * PURFX IS CALLED WHENEVER THE PATCH TABLE HAS REACHED ITS LIMIT. * THIS ROUTINE FIRST UPDATES IDT BY DECREASING THE "DISC USED" ENTRY* IN EACH IDT ENTRY REFERENCED BY A PATCH. IT THEN BUILDS A NEW ADT * BASED ON THE RELEASED DISC SPACE.       SPC 2       ORG LIBRA       LDA MOVED       LDB MOVES       DST PURM      LDA IDLEN     FIRST READ IDT.       STA WORD      LDA IDLOC       LDB LIBDI       JSB DISCL *       LDB IDLEN     SET IDT POINTER.      CMB,INB       ADB LIBD      ADB .-8       LDA PURP      COPY PURP PURX1 STA PURPP     DONE WITH       CPA L5440      IDT?       JMP PURX2     YES.      LDA PURPP,I    NO--GET ID FROM ENTRY.       CPA 1,I       FOUND THE IDT ENTRY?      JMP *+3       YES.      ADB .-8       NO--BUMP IDT POINTER BACK.      JMP *-3 *       ADB .+7       UPDATE IDT ENTRY.       ISZ PURPP       ISZ PURPP       LDA PURPP,I   GET LENGTH.       CMA,INA       SUBTRACT FROM IDT ENTRY.      ADA 1,I       STA 1,I       ADB .-7       RESTORE IDT POINTER.      LDA PURPP     BUMP PATCH POINTER.       INA       JMP PURX1 * PURX2 LDA IDLOC     WRITE BACK IDT.       LDB LIBD      JSB DISCL *       LDA ADLEN     READ IN ADT.      STA WORD      LDA ADLOC       LDB LIBDI       JSB DISCL * PURX3 LDA PURP      IS PATCH TABLE EMPTY?       CPA L5440       JMP PURX4     YES--GO WRITE ADT.      ISZ PURP      PURP=>DISC ADR OF PATCH.      LDB LIBD      SEARCH ADT FOR AN ENTRY BEYONDPURX5 LDA 1,I        RELEASED ONE.      CMA,CLE,INA       ADA PURP,I      ADB .+2       SEZ       JMP PURX5 * * TRY  TO  MERGE WITH NEXT ENTRY*       ISZ PURP      ADA PURP,I      SZA       JMP PURX6     CAN'T DO IT.      ADB .-1       COMBINE       LDA 1,I        LENGTHS      ADA PURP,I      STA 1,I       ADB .-1       CCA       ADA PURP      STA PURP      LDA PURP,I      STA 1,I       CMA,INA       TRY TO COMINE 2 ADJACENT      ADB .-2        ENTRIES.       ADA 1,I       INB       ADA 1,I       SZA       JMP PURX9     CAN'T COMBINE ENTRIES       ADB .+2       LDA 1,I       GET LENGTH OF 2ND ENTRY.      ADB .-2       ADA 1,I       ADD TO      STA 1,I        LENGTH OF 1ST.       INB           SLIDE       STB MOVED      TOGETHER.      ADB .+2       STB MOVES       ADB MLIBD       ADB ADLEN       JSB MOVEW PRX10 ISZ ADLEN     ADJUST      ISZ ADLEN      ADLEN.       JMP PURX9 * PURX6 CCA           CAN WE MERGE WITH PREVIOUS ENTRY      ADA PURP      STA PURP      ADB .-4       LDA 1,I       INB       ADA 1,I       CPA PURP,I      JMP PURX8     YES--GO DO IT.* * HAVE TO CREATE A NEW ENTRY. FIRST TEST TO SEE IF* THERE IS ROOM TO EXPAND THE ADT.*       LDA ADLEN       ADA .-2       STA ADLEN       AND M64       ADA IDLEN       ADA P5440       SSA       JMP PRX10     NOT ENOUGH--FORGET IT.      LDA ADLEN     SLIDE       CMA            DOWN.      ADA LIBD      STA MOVED       ADA .-2       STA MOVES       CMA,INA       ADB 0       JSB MOVEB       ISZ MOVES     INSERT NEW ENTRY      DLD PURP,I      DST MOVES,I PURX9 ISZ PURP      ADJUST PURP &       ISZ PURP       LOOP.      JMP PURX3 * PURX8 ISZ PURP      MERGE NEW ENTRY WITH PREVIOUS       LDA PURP,I      ADA 1,I       STA 1,I       JMP PURX9+1 * * PURX4 DLD PURM      RESTORE MOVES AND MOVED.      STA MOVED       STB MOVES       LDA ADLEN     WRITE ADT BACK.       STA WORD      LDA ADLOC       LDB LIBD      JSB DISCL       LDA IDLEN     COMPUTE NEW VALUE       LDB IDLEN      FO PURID.      CMB,INB       ADB ADLEN       SSB       LDA ADLEN       ADA MLIBD       ADA .-4       STA PURID       JMP PURXF $$PUR EQU *         (MUST BE <= PURXF)*       ORG LTEMP PURDT BSS 1 PURN  BSS 1 PURP  BSS 1 PURI  BSS 1 PURDD BSS 1 PURD  BSS 1 PURT  BSS 3 PURID BSS 1 PURW  BSS 1 PURPP BSS 1 PURM  BSS 2       HED ROSTER* ROSTER PRINTS A LISTING, ON THE SYSTEM CONSOLE, OF ALL* IDS OF CURRENTLY ACTIVE USERS. THEY ARE PRINTED 8 PER LINE.       SPC 2       ORG LIBRA       LDA ROSLB     SET LF-BLANK IN BUFFER      STA T35BF       JSB ROST8     PROCESS FIRST 8       DEF TTY00+?ID       LDA .+48      OUTPUT THEM.      LDB T35B1       JSB T35SP       LDA T35BF       IOR HIMSK       STA T35BF       JSB ROST8     PROCESS LAST 8      DEF TTY08+?ID       LDA .+48      OUTPUT THEM.      LDB T35B1       JMP LEND+2      SPC 1 * ROST8 FILLS THE TELETYPE BUFFER WITH 8 IDS. THE FORMAT IS:*     LF,BLANK,7(ID,BLANK,BLANK),ID       SPC 1 ROST8 NOP       LDA T35B1     SET UP POINTER FOR FIRST ID.      INA       STA ROSP      LDA .-8       SET UP COUNTER.       STA ROSC      LDA ROST8,I   SET UP POINTER TO ID.       STA ROSID       JMP ROS2      GO DO FIRST ID. ROS1  LDA ASCBB     PUT BLANKS IN AS SEPARATORS.      STA ROSP,I      ISZ ROSPROS2  LDA ROSID,I   GET ID      SZA,RSS       TEST FOR NO ID.       JMP ROS3      AND B1777     MASK NUMBER PART      CLB           GET #/100 IN A,# MOD 100 IN B.      DIV .100      STB ROST      SAVE LAST 2 DIGITS.       STA 1         COMBINE FIRST DIGIT WITH LETTER.      LDA ROSID,I       ARS,ARS       AND ROSMS       ADA 1       ADA ROSFX       STA ROSP,I    STORE IN BUFFER.      ISZ ROSP      LDA ROST      GET LAST 2 DIGITS.      CLB       DIV .+10      SEPARATE THEM.      ALF,ALF       PACK AND CONVERT      ADA 1          TO ASCII.      ADA ASC00       JMP ROS4      GO STORE IN BUFFER. ROS3  LDA ROSDD     IF NO ID, PUT DOTS IN BUFFER.       STA ROSP,I      ISZ ROSPROS4  STA ROSP,I      ISZ ROSP      LDA ROSID     ADVANCE ID POINTER.       ADA .+TTY01-TTY00       STA ROSID       ISZ ROSC      ANY MORE?       JMP ROS1      YES.      ISZ ROST8       JMP ROST8,I   NO* ROSP  EQU LTEMP ROSC  EQU LTEMP+1 ROSLB OCT 5040ROSID EQU LTEMP+2 ROST  EQU LTEMP+3 ROSMS OCT 17400 ROSFX ASC 1,@0ROSDD ASC 1,..$ROS  EQU * 