      HED CATALOG 
* CATALOG PRINTS A LIST OF USER FILES ON THE USER TELETYPE. 
* IT PRINTS THESE, 5 PER LINE, ALONG WITH THEIR LENGTHS AND 
* AN INDICATION OF FILES.  CATALOG IS IDENTICAL TO LIBRARY, 
* EXCEPT THAT LIBRARY PRINTS FROM THE A000 FILE DIRECTORY.
* LIBRARY MUST FOLLOW CATALOG IN SEQUENCE.
* 
      ORG LIBRA 
* 
      NOP 
* 
CAT1  LDA MLINK+1   SET USER ID INTO LTEMP. 
      ADA .+?ID-?LINK 
      LDA 0,I 
CAT2  STA LTEMP     RENDEZVOUS WITH "LIBRARY".
* 
      LDA .-5    SET LINE COUNTER 
      STA CATN
      LDA .+12B     OUTPUT LF 
      JSB LOUT
       LDA .-8      SET TRACK COUNTER TO 8
       STA CATTR
      LDB DIRD0     SET POINTER TO FIRST
      STB LTEMP+4     DIRECTORY TRACK 
CAT5   LDA 1,I      LOAD LENGTH 
       SZA,RSS      IS TRACK EMPTY? 
       JMP CAT3     YES GO TO NEXT TRACK
      INB     LOAD ID 
      LDA 1,I 
      CMA,INA   MAKE NEGATIVE 
      ADA LTEMP   IS IT THE ONE WERE LOOKING FOR? 
      SSA       IF POSITIVE THEN IT IS
       JMP CAT3    NO TRY NEXT TRACK
       LDA LIBD     YES 
       STA LTEMP+5 SET POINTER TO TRACK 
* 
*      ENTRIES FOR THE GIVEN ID 
*      MAY BE ON THIS TRACK, SO READ IT IN
* 
       ADB .+5+U
       LDA 1,I      LOAD DISC ADDRESS 
      STA CATDA    SAVE IT
       ADB .-6
       LDB 1,I      LOAD LENGTH 
       STB WORD 
       STB CATDL    SAVE LENGTH 
       LDB LIBDI    READ IN DIRECTORY TRACK 
       JSB DISCL
* 
*      THE TRACK HAS BEEN READ IN 
*     NOW SCAN IT FOR THE CORRECT ID
* 
CAT4  LDB CATDL     SAVE END-OF-TRACK POINTER 
       CMB,INB
      ADB LIBD
       STB LTEMP+13 
CAT10 LDB LTEMP+5   LOAD ENTRY POINT
CAT11 CPB LTEMP+13
       JMP CAT3     TRACK IS ALL DONE 
       LDA 1,I      LOAD ID 
       CPA LTEMP   SAME?
       JMP CAT12    YES - OUTPUT
       ADB .+8      NEXT ENTRY
      JMP CAT11 
CAT12 STB LTEMP+5 
       LDA .-3      SET COUNTER FOR 
      STA CATC       PRINTING NAME. 
CAT15 ISZ CATP      BUMP P TO NEXT WORD.
      LDA CATP,I
      ALF,ALF       GET LEFT CHAR.
      JSB LOUT      PRINT IT. 
      LDA CATP,I    OUTPUT IT 
      JSB LOUT
     ISZ CATC      TEST FOR 6 CHARS OUT.  
      JMP CAT15 
      LDA .+40B     OUTPUT A BLANK. 
      JSB LOUT
      CCB 
      ADB CATP      => SECOND WORD OF NAME
      LDA 1,I 
      AND BIT15 
      SZA,RSS       FILE? 
      JMP CAT20     NO
      LDA ASCF      YES--OUTPUT 
      JMP CAT21       AN 'F'
CAT20 EQU *                                      X] 
      LDA .+40B     OUTPUT A BLANK
CAT21 JSB LOUT
      LDA CATP      BUMP TO PROGRAM LENGTH
      ADA .+4 
      STA CATP
* *q
      LDA CATP,I    GET NUMBER. 
      CMA,INA 
      CLB 
      DIV DVSRS+1   DIV BY 1000.
      STB CATLN     SAVE REMAINDER. 
      ADA ASC00 
      JSB LOUT
      LDA CATLN     GET HUNDREDS. 
      CLB 
      DIV DVSRS+2 
      STB CATLN 
      ADA ASC00 
      JSB LOUT
      LDA CATLN     GET TENS. 
      CLB 
      DIV .+10
      STB CATLN 
      ADA ASC00 
      JSB LOUTU>
      LDA CATLN     GET UNITS 
      ADA ASC00 
      JSB LOUT
      LDA .+40B     OUTPUT A BLANK
      JSB LOUT
      LDA .+40B 
      JSB LOUT>>
* 
      ISZ CATP      BUMP POINTER TO NEXT ENTRY. 
      LDA CATP
      ISZ CATN      END OF LINE?
      JMP CAT10     NO
      JSB RDPRG    READ IN USER AREA
      LDA CATDL 
      STA ERSEC+7 
      LDA CATDA 
      STA ERSEC+8 
      LDA CATTR 
      STA ERSEC+9 
       LDA LTEMP    R  SET VALUES FOR SUSPEND 
       STA ERSEC+3
       LDA LTEMP+4
       STA ERSEC+4
       LDA LTEMP+5+
       STA ERSEC+5
      LDB MLINK+1 
      ADB .+?PROG-?LINK 
      LDA 1,I       COMPUTE 
      CMA,INA 
      ADA USE         LENGTH
      STA WORD
      ADB .+?DISC-?PROG 
      LDA 1,I       DISC ADDRESS
      LDB USE       CORE ADDRESS
      JSB DISCL 
* 
      LDA .+15B     OUTPUT CR.
      JSB LOUT
      LDA .+12B    OUTPUT LINE FEED 
      JSB LOUT
      JSB SCHOU,I   OUTPUT WAIT.
* qq
* READ THE LAST ENTRY OUT OF ERSEC(0:2) AND 
* PUT IT INTO LTEMP(1:3). 
* 
      JSB RDPRG     READ IN USER PROGRAM
       LDA ERSEC+3
       STA LTEMP    RESTORE POINTERS AFTER SUSPEND
       LDA ERSEC+4
       STA LTEMP+4
       LDA ERSEC+5
       STA LTEMP+5
      LDA ERSEC+7 
      STA CATDL 
      LDA ERSEC+8 
      STA CATDA 
      LDA ERSEC+9 
      STA CATTR 
      LDA .-5   RESET LINE COUNTER
      STA CATN
       LDA CATDL    READ THE DIRECTORY TRACK BACK IN
       STA WORD 
       LDA CATDA
       LDB LIBDI
       JSB DISCL
       JMP CAT4 
CAT3   ISZ CATTR
       JMP *+4      STILL MORE TRACKS 
       LDA .+15B    ALL DONE
       JSB LOUT 
       JMP LLEND
       LDB LTEMP+4 POINT TO NEXT BASE PAGE ENTRY
       ADB .+7
       STB LTEMP+488
       JMP CAT5 
CATP  EQU LTEMP+5 
CATN  EQU LTEMP+7 
CATC  EQU LTEMP+10
CATLN EQU LTEMP+11
CATDL EQU LTEMP+8 
CATDA EQU LTEMP+2 
CATTR EQU LTEMP+1 
ASCF  OCT 106 
$CAT  EQU * 
      HED LIBRARY 
* LIBRARY IS IDENTICAL TO CATALOG EXCEPT THAT IT USES A000
* AS ID RATHER THAN THE USER ID. IT MUST BE LOADED IMMEDIATELY
* AFTER CATALOG.
      SPC 1 
      ORG LIBRA 
      CLA **
      ORG CAT1T	
      LDA A000
      JMP CAT2
      HED DELETE
* THE DELETE COMMAND ALLOWS A USER TO DELETE A SECTION OF HIS 
* PROGRAM IN A SINGLE LINE. THE FORMAT IS:
*     DELETE-M,N
*  OR 
*     DELETE-M
* WITH THE FIRST FORMAT, ALL LINES FROM M THROUGH N ARE 
* DELETED. WITH THE SECOND, ALL LINES FROM M TO THE END OF
* THE PROGRAM ARE DELETED.
      SPC 1 
      ORG LIBRA 
      JSB DELNM     GET M.
      STA DELM
      LDA DEL99 
      CPB .+54B     IF COMMA FOLLOWS, GO
      JSB DELNM      GET N. 
      STA DELN
      CPB .+15B     NEXT CHAR MUST BE A CR. 
      JMP DEL2
      JMP ILFER 
* 
DEL2  CMA           CHECK FOR M<=N
      ADA DELM
      SSA,RSS 
      JMP ILFER 
* 
      JSB RDPRG     READ IN PROGRAM AND 
      JSB DCMPL      DECOMPILE IT.
* qqq{
      LDA PBPTR     LOCATE FIRST
      LDB DELM       STATEMENT TO BE DELETED. 
      JSB FNDPS 
      RSS 
      NOP 
      STB MOVED 
* 
      LDA PBPTR     LOCATE FIRST STATEMENT
      LDB DELN       NOT TO BE DELETED. 
      STA MOVES 
      CPB DEL99 
      JMP DEL3
      INB 
      JSB FNDPS 
      RSS 
      NOP 
      STB MOVES 
* 
DEL3  LDB MOVES     IF DEST=SOURCE, NOTHING DELETED.
      CPB MOVED 
      JMP DEL4
      CMB,INB       OTHERWISE, MOVE UP. 
      ADB PBPTR R
      CMB,INB 
      JSB MOVEW 
      LDA MOVED     SET NEW VALUE OF
      STA PBPTR      PBPTR. 
      LDA MLINK+1   TELL SCHEDULER THAT 
      ADA .-?LINK    PROGRAM IS IN CORE.
      STA MAIN
      JMP LLEND 
* 
DEL4  LDA MLINK+1 
      ADA .-?LINK 
      STA MAIN
      LDA .-17
      LDB *+2 
      JMP LIBER 
      DEF *+1 
      OCT 5116      LF-N
      ASC 7,OTHING DELETED
      OCT 6400      CR
* 
* DELNM READS A NUMBER FROM THE USER'S BUFFER. IN CASE OF ERROR IT
* GOES TO DEL1. OTHERWISE IT RETURNS WITH A=# AND B=NEXT CHAR.
* qq
DELNM NOP 
      CLA           INITIALIZE TO 0.
DEL7  EQU *                                      B] 
      STA DELT
      JSB LCHAR     GET A CHARACTER              B] 
      NOP 
      STA 1         SAVE IN B.
      ADA M72B      TEST FOR DIGIT. 
      SSA,RSS 
      JMP DEL6
      ADA .+10
      SSA 
      JMP DEL6
      LDB DELT                                   B] 
      ADB DELMX                                  B] 
      SSB,RSS                                    B] 
      JMP ILFER     NUMBER TOO LARGE             B] 
      LDB DELT      MPY OLD VALUE BY 10.
      RBL,RBL 
      ADB DELT
      RBL 
      ADA 1         ADD IN NEW. 
*                                                                B] 
      JMP DEL7      LOOP. 
* q{
DEL6  LDA DELT      GET VALUE 
      SZA           FAIL IF ZERO. 
      JMP DELNM,I 
      JMP ILFER 
* 
DELM  EQU LTEMP P
DELN  EQU LTEMP+1 
DELT  EQU LTEMP+2 
DEL99 DEC 9999
DELMX  DEC -1000                                 B] 
$DEL  EQU * 
      HED TIME
* THE TIME COMMAND PRINTS THE USER'S CONSOLE TIME DURING THIS 
* SESSION AND HIS TOTAL CONSOLE TIME TO DATE. 
      SPC 1 
      ORG LIBRA Ah
      SPC 1 
      LDA .-16      OUTPUT START OF 
      LDB TIM1       MESSAGE. 
      JSB LTYPR 
* qq
      LDA MLINK+1   COMPUTE LOC OF USER'S 
      ADA .+?TIME-?LINK  STARTING TIME. 
      DLD 0,I       GET STARTING TIME.
      CMA,INA       MAKE NEGATIVE AND 
      CMB,INB        SAVE IN TIMT.
      DST TIMT
      DLD DATIM     GET CURRENT TIME. 
      ADA TIMT      COMPUTE DIRRERENCES: A=# OF HRS;
      CLE           B=# OF 100 MS UNITS.
      ADB TIMT+1     E=-SIGN OF B.
      STB TIMT+1    SAVE UNITS. 
      MPY D60       CHANGE HRS TO MINS. 
      STA TIMT
      LDA TIMT+1    GET UNIT COUNT. IF E=0
      SEZ,RSS        THEN COUNT IS NEGATIVE.
      CCB 
      DIV D600      CHANGE TO MINS. 
      ADA TIMT      ADD IN PREVIOUS AMT.
      STA TIMT
      JSB TIMPR     PRINT IT. 
* 
      LDA .-14      OUTPUT SOME MORE
      LDB TIM2       CHARACTERS.
      JSB LTYPR 
* 
      LDA MLINK+1  GET USER 
      ADA .+?ID-?LINK 
      LDA 0,I           ID
      STA ID
      JSB FIDT     SEARCH IDT 
* qq
      ADB .+5       GET TIME TO DATE. 
      LDA 1,I 
      ADA TIMT      ADD IN CURRENT TIME.
      JSB TIMPR     PRINT IT. 
* qq
      LDA .+15B     OUTPUT CR.
      JSB LOUT
      JMP LLEND     TERMINATE.
* 
TIM1  DEF *+1 
      OCT 5103      LF-C
      ASC 7,ONSOLE TIME = 
TIM2  DEF *+1 &&
      ASC 7, TOTAL TIME = 
TIM3  DEF *+1 
      ASC 5, MINUTES. .b
* qq
* TIMPR OUTPUTS THE INTEGER IN A TO THE CONSOLE.
* 
TIMPR NOP 
      SZA,RSS       SPECIAL CASE OF ZERO. 
      JMP TIMP1 
      STA TIMNM     SAVE ORIGINAL NUMBER. 
      LDB TIMXK     GET INITIAL DIVISOR OF 10000. 
      STB TIMDV 
TIMP4 CLB           COMPUTE A DIGIT.
      DIV TIMDV 
      STB TIMN      SAVE REMAINDER. 
      CPB TIMNM     IF REMAINDER=ORIGINAL NUMBER
      JMP TIMP2     THIS IS A LEADING ZERO. 
      ADA .+60B     OUTPUT
      JSB LOUT       DIGIT. 
TIMP2 LDA TIMDV     PRODUCE NEW DIVISOR.
      CLB 
      DIV .+10
      STA TIMDV 
      SZA,RSS       DONE IF DIVISOR IS ZERO.
      JMP TIMP3 
      LDA TIMN      GET # AGAIN AND LOOP. 
      JMP TIMP4 
TIMP1 LDA .+60B     OUTPUT SINGLE 0.
      JSB LOUT
TIMP3 LDA .-9       PRINT 
      LDB TIM3       "MINUTES." 
      JSB LTYPR 
* qq
      JMP TIMPR,I 
* 
TIMXK DEC 10000 
TIMN  EQU LTEMP 
TIMT  EQU LTEMP+1 
TIMNM EQU LTEMP+3 
TIMDV EQU LTEMP+4 
$TIM  EQU * *c
      HED  USER DISC COMMAND                    [X] 
*                                               [X] 
*     THE DISC COMMAND IS ANALOGOUS             [X] 
*     TO THE TIME COMMAND, IT OUTPUTS           [X] 
*     THE TOTAL NUMBER OF SECTORS               [X] 
*     ALLOWED AND THE NUMBER USED.              [X] 
*                                               [X] 
      SPC 2                                     [X] 
      ORG LIBRA                                 [X] 
      SPC 1                                     [X] 
      LDB MLINK+1   SET ID
      ADB .+?ID-?LINK 
      LDA 1,I         FOR 
      STA ID              FIDT
      LDA .-16     OUTPUT                       [X] 
      LDB DU1      "DISC ALLOWED ="             [X] 
      JSB LTYPR                                 [X] 
      JSB FIDT     GET ID ENTRY 
      ADB .+6                                   [X] 
      STB LTEMP+2                               [X] 
      LDA 1,I      GET DISC ALLOWED             [X] 
      JSB DUNM     CONVERT + OUTPUT             [X] 
      LDA .-22     OUTPUT                       [X] 
      LDB DU2      MIDDLE PORTION               [X] 
      JSB LTYPR                                 [X] 
      LDB LTEMP+2                               [X] 
      INB                                       [X] 
      LDA 1,I                                   [X] 
      JSB DUNM     OUTPUT DISC USED             [X] 
      LDA .-8      OUTPUT FINAL                 [X] 
      LDB DU3      PORTION OF MESSAGE           [X] 
      JSB LTYPR                                 [X] 
      LDA .+15B    TERMINATE                    [X] 
      JSB LOUT                                  [X] 
      JMP LLEND                                 [X] 
*                                               [X] 
*        SUBROUTINE TO CONVERT TO                    [X]
*     ASCII AND OUTPUT IT.                      [X] 
*                                               [X] 
DUNM  NOP                                       [X] 
      SZA,RSS      ZERO?                        [X] 
      JMP DUNM1    YES                          [X] 
      STA LTEMP                                 [X] 
      LDB DIDV     DEC 10000                    [X] 
      STB LTEMP+3  SAVE DIVISOR                 [X] 
DUNM4 CLB          GET A DIGIT                  [X] 
      DIV LTEMP+3                               [X] 
      STB LTEMP+1                               [X] 
      CPB LTEMP    LEADING ZERO?                [X] 
      JMP DUNM2    YES                          [X] 
      ADA .+60B    MAKE ASCII                   [X] 
      JSB LOUT     OUTPUT DIGIT                 [X] 
DUNM2 LDA LTEMP+3  FORM NEXT                    [X] 
      CLB          DIVISOR                      [X] 
      DIV .+10                                  [X] 
      STA LTEMP+3                               [X] 
      SZA,RSS      IF ZERO THEN DONE            [X] 
      JMP DUNM,I   DONE                         [X] 
      LDA LTEMP+1  LOAD REMAINDER               [X] 
      JMP DUNM4                                 [X] 
DUNM1 LDA .+60B    ZERO!                        [X] 
      JSB LOUT                                  [X] 
      JMP DUNM,I                                [X] 
*                                               [X] 
*                                               [X] 
DIDV  DEC 10000                                 [X] 
DU1   DEF *+1                                   [X] 
      OCT 5104                                  [X] 
      ASC 7,ISC ALLOWED =                       [X] 
DU2   DEF *+1                                   [X] 
      ASC 11, SECTORS  DISC USED =              [X] 
DU3   DEF *+1                                   [X] 
      ASC 4, SECTORS                            [X] 
$UDIS EQU *                                     [X] 
      HED MESSAGE 
*    THE MESSAGE COMMAND IS USED TO SEND
*   A MESSAGE TO THE CONSOLE
      ORG LIBRA 
      LDA MSQCT     ALREADY A MESSAGE IN QUEUE? 
      SZA 
      JMP MESS1     NO
* 
      LDA MSQP1     LOAD BUFFER POINTER 
      INA 
      LDB CRLF      LOAD CR-LF AND
      STB A,I         STORE IN BUFFER 
      INA 
      STA MSQP2     SET POINTER 
      LDA MLINK+1   GET THE USER NUMBER 
      ADA .+?TNUM-?LINK 
      LDA 0,I         INTO A REGISTER 
      ALF,ALF 
      CLB 
      DIV .+10     DIVIDE BY 10 
      ALF,ALF 
      IOR 1 
      IOR ASC00     CONVERT TO ASCII
      STA MSQP2,I   STORE IT IN BUFFR 
      ISZ MSQP2 
      LDA ASCBB     STORE TWO BLANKS
      STA MSQP2,I I
      LDB MSQP2     TURN BUFFER 
      INB             POINTER INTO
      BLS               CHARACTER 
      STB MSQP2           POINTER 
      LDA .+6 
      STA MSQP1,I   SET LENGTH
      CLA 
      STA LCHR2     PREVENT DEBLANKING
      JSB LCHAR     GET A CHAR
      JMP MESER     NONE? - ERROR 
MESS2 LDB .+74      IS MESSAGE TOO LONG?
      CPB MSQP1,I 
      JMP MESS4     YES - STOP HERE 
      JSB MESCH     STORE CHAR
      JSB LCHAR     NEXT CHAR 
      JMP MESS4     ALL DONE
      JMP MESS2 
MESS4 LDA .+12B     LF
      JSB MESCH 
      LDB MESWK     RESTORE LCHAR 
      STB LCHR2 
      ISZ MSQCT     INC. MESSAGE FLAG 
      ISZ MSQCT      SET MESSAGE COUNT =2 
      JMP LLEND 
* *q
MESER LDB MESWK     FIX LCHAR 
      STB LCHR2 
      JMP ILFER 
* 
MESS1 LDA .-14
      LDB *+2 
      JMP LIBER 
      DEF *+1 
      OCT 5103
      ASC 6,ONSOLE BUSY 
* qq
*     ROUTINE TO STORE CHARS INTO BUFFER
* 
MESCH NOP 
      LDB 0         SET-UP FOR FOLLOWING        (D) 
      ADB M32       IS THIS CHARACTER A         (D) 
      SSB,RSS       NON-PRINTING ONE?           (D) 
      JMP *+4       NO,PRINTING                 (D) 
      CPA BELL      YES, IS IT A BELL           (D) 
      JMP *+2       RING THE BELL               (D) 
      JMP MESCH,I   NON OF THE ABOVE, EXIT      (D) 
      LDB MSQP2     LOAD CHAR POINTER 
      CLE,ERB       TURN INTO WORD POINTER
      SEZ,RSS       UPPER/LOWER?
      ALF,ALF       UPPER 
      SEZ 
      IOR B,I             LOWER 
      STA B,I       STORE WORD
      ISZ MSQP2     ADVANCE POINTER 
      ISZ MSQP1,I   AND COUNTER 
      JMP MESCH,I 
* *q
MESWK JMP LCHR1 
MSQP2 BSS 1 
BELL  OCT 7                                     (D) 
$MESS EQU * rr
      HED PROTECT T
* THE PROTECT COMMAND CAN BE USED BY A000 TO PROTECT PROGRAMS AND 
* FILES FROM BEING READ BY OTHER USERS. ALL THE COMMAND DOES IS TO
* SET BIT 15 OF WORD 1 IN THE DIRECTORY ENTRY FOR THE PROGRAM.
      SPC 1 1
      ORG LIBRA 
      SPC 1 
      LDA MLINK+1   GET USER'S ID.
      ADA .+?ID-?LINK 
      LDA 0,I       CHECK FOR PROPER
      CPA A000       USER.
      JMP PRO1
* *q
      LDA .-19
      LDB *+2 
      JMP LIBER 
      DEF *+1 
      OCT 5120      LF-P-

      ASC 9,RIVILEGED COMMAND 
* qq
PRO1  STA LTEMP     PLACE ID INTO LTEMP.
      LDA DLTEM     SET POINTER FOR PROGRAM NAME. 
      STA PROC
      LDA .-3       SET UP COUNTER. 
      STA PRODO-
      JSB LCHAR     GET FIRST CHAR. 
      JMP PRO2      ERROR IF NONE.
PRO3  ALF,ALF       SAVE CHARACTER IN 
      ISZ PROC       TABLE. 
      STA PROC,I
      JSB LCHAR     GET RIGHT CHAR. 
      LDA .+40B     IF END CHANGE TO BLANK
      IOR PROC,I
      STA PROC,I
      JSB LCHAR     GET NEXT CHAR.
      LDA .+40B 
      ISZ PROD      DO WE WANT IT?
      JMP PRO3      YES.
      CPA .+40B     MUST BE A BLANK.
      JMP PRO4
* 
PRO2  LDA .-13
      LDB *+2 
      JMP LIBER 
      DEF *+1 
      OCT 5111      LF-I
      ASC 6,NVALID NAME 
* 
PRO4  JSB DLOOK     SEARCH FOR PROG. IN DIRECTORY.
      JMP PRO6      FOUND.
* qq
      LDA .-16
      LDB *+2 
      JMP LIBER 
      DEF *+1 1;
      OCT 5116      LF-N
      ASC 7,O SUCH PROGRAM
* 
PRO6  LDB LTEMP+5   SET PROTECT BIT.
      INB 
      LDA 1,I 
PRO7  IOR BIT15 
      STA 1,I 
* qq
      LDB LTEMP+4   WRITE OUT DIRECTORY.
      LDA 1,I I
      STA WORD
      ADB .+6 
      LDA 1,I 
      LDB LIBD
      JSB DISC,I
      JMP LLEND 
PROD  EQU LTEMP+6 6q
PROC  EQU LTEMP+7 7A
$PRO  EQU * 
