
      HED CATALOG 
* CATALOG PRINTS A LIST OF USER PROGRAMS AND FILES ON THE USER
* TELETYPE.  IT PRINTS THESE, 4 PER LINE, ALONG WITH THEIR LENGTHS
* AND AN INDICATION OF FILES, CSAVED PROGRAMS, PROTECTED ENTRIES, 
* AND SANCTIFIED ENTRIES.  LIBRARY MUST FOLLOW CATALOG IN SEQUENCE. 
* 
      ORG LIBRA 
* 
      CLA           FIRST TIME IN, SET LTEMP(1:3)=0.
      STA LTEMP+1   WE WILL HAVE TO LOCATE THE FIRST
      STA LTEMP+2   DIRECTORY ENTRY FOLLOWING 
      STA LTEMP+3   LTEMP(0:3). 
      LDA .+12B     LF
     JSB LOUT 
     LDA .-4
     STA CATJ 
* 
* OUTPUT HEADING
* 
CAT00 EQU * 
     LDA .-9
     STA CATN 
     LDA CATTP
     STA CATS 
CAT01 EQU * 
     LDA CATS,I 
     ALF,ALF
     AND B377 
     JSB LOUT       OUTPUT LEFT CHARACTER 
     LDA CATS,I 
     AND B377 
     JSB LOUT       OUTPUT RIGHT CHARACTER
     ISZ CATS       BUMP TO NEXT HEADING WORD 
     ISZ CATN 
     JMP CAT01
     ISZ CATJ 
     JMP CAT00
     LDA .+15B      CR
     JSB LOUT 
* 
* GET ID AND SEARCH FOR PROGRAMS AND FILES
* 
CAT1  LDA MLINK+1   SET USER ID INTO LTEMP. 
      ADA .+?ID-?LINK 
      LDA 0,I 
      JMP CAT2
      BSS 9         SPACE FOR ID CALCS IN GROUP 
CAT2  STA LTEMP     RENDEZVOUS WITH "LIBRARY".
* 
      LDA .-4       SET N TO COUNT # OF NAMES ON
      STA CATN      THIS LINE.
      CLA           SET J=0 TO INDICATE THAT NO 
      STA CATJ       DIRECTORY TRACK HAS BEEN EXAMED
      LDA .+12B     EMIT A LINE FEED. 
      JSB LOUT
* 
      JSB DLOKP,I   FIND LAST ENTRY <= LAST ONE 
      NOP           OUTPUT. 
      LDA CATI,I    COMPUTE LAST ADDRESS
      CMA,INA       IN TRACK. 
      ADA LIBD
      STA CATQ
* 
CAT22 LDA CATP      SET P TO NEXT 
      ADA .+12       ENTRY
CAT10 STA CATP
      CPA CATQ      IF P=Q, WERE DONE WITH THIS 
      JMP CAT11      TRACK--GO LOOK AT NEXT ONE 
      LDA CATP,I    TEST FOR ENTRY BELONGING TO THIS
      CPA LTEMP     USER--IF NOT, WE'RE DONE. 
      JMP CAT12 
* 
* TERMINATE 
* 
CAT13 LDA .+15B     EMIT CRLF 
      JSB LOUT
      JMP LLEND 
* 
**
*** PROCESS ENTRY 
**
* 
CAT12 JMP CAT23 
      NOP           THIS SPACE IS RESERVED
      NOP             FOR THE ILL-STORED
      NOP               PROGRAM CHECK IN
      NOP                 LIBRARY AND GROUP.
* 
* PRINT NAME
* 
CAT23 LDA .-3       SET UP 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
* 
* CHECK FOR A FILE
* 
      CCB 
      ADB CATP
      LDA B,I       GET SECOND WORD OF NAME 
      SSA,RSS       FILE? 
      JMP CAT20     NO
      LDA ASCF      YES, OUTPUT "F" 
      JMP CAT21 
* 
*  CHECK FOR SEMI-COMPILED PROGRAM
* 
CAT20 LDA CATP,I    GET THIRD WORK OF NAME
      SSA,RSS       SEMI-COMPILED?
      JMP *+3       NO
      LDA ASCC      YES - OUTPUT A "C"
      RSS 
      LDA .+40B     NEITHER, OUTPUT " " 
* 
* CHECK FOR PROTECTED PROGRAM OR FILE 
* 
CAT21 JSB LOUT
      LDB CATP      POINTER TO
      ADB .-2         FIRST WORD OF NAME
      LDA B,I       GET IT
      SSA,RSS       PROTECTED?
      JMP *+3       NO
      LDA ASCP      YES, OUTPUT "P" 
      RSS 
      LDA .+40B 
      JSB LOUT
      LDA .+40B     OUTPUT " "
      JSB LOUT
* 
* GET AND PRINT PROGRAM LENGTH
* 
      LDA CATP      BUMP TO PROGRAM LENGTH
      ADA .+8 
      STA CATP
      CLA           INITIALIZE
      STA CATZS       ZERO SUPPRESS FLAG
* 
      LDA CATP,I    GET LENGTH
      SSA           MAKE POSITIVE IF NECESSARY
      CMA,INA 
      CLB 
      DIV DVSRS     DIVIDE IT BY 10000
      JSB CAT24     OUTPUT THE FIRST CHARACTER
      DIV DVSRS+1   DIV BY 1000.
      JSB CAT24     OUTPUT THE SECOND DIGIT 
      DIV DVSRS+2   DIV BY 100
      JSB CAT24     OUTPUT THE THIRD DIGIT
      DIV .+10
      JSB CAT24     OUTPUT THE FOURTH DIGIT 
      ADA ASC00 
      JSB LOUT
      LDA .+40B     OUTPUT A BLANK
      JSB LOUT
      LDA .+40B      AND ANOTHER
      JSB LOUT
      LDA .+40B       AND ANOTHER 
      JSB LOUT
* 
* ENTRY PROCESSING COMPLETE.  TEST FOR LINE BUFFER FULL 
* 
      ISZ CATP      BUMP POINTER TO NEXT ENTRY. 
      LDA CATP
      ISZ CATN      END OF LINE?
      JMP CAT10     NO. 
      ADA .-11      => FIRST WORD OF LAST NAME
     LDB MLINK+1
     ADB .+?TEMP-?LINK
     STB CATJ       POINTER FOR STORING NAME
     LDB .-3
     STB CATN 
CAT30 EQU * 
     LDB A,I        SAVE A WORD 
     STB CATJ,I       OF THE NAME 
     ISZ CATJ 
     INA
     ISZ CATN 
      JMP CAT30 
* 
      LDA .+15B     OUTPUT CR.
      JSB LOUT
      JSB SCHOU,I   OUTPUT WAIT.
* 
* READ THE LAST ENTRY OUT OF THE TTY
* TABLE AND PUT IT INTO LTEMP[1:3]
* 
      LDA DLTEM     PUT 
      INA 
      LDB .-3 
     STB CATN 
     LDB MLINK+1
     ADB .+?TEMP-?LINK
     STB CATJ 
CAT29 EQU * 
     LDB CATJ,I     RESTORE A WORD
     STB A,I     OF THE NAME
     INA
     ISZ CATJ 
     ISZ CATN 
     JMP CAT29
      JMP CAT1      GO TO START.
* 
* SUBROUTINE FOR PRINTING LENGTH
* 
CAT24 NOP 
      STB CATLN     SAVE REMAINDER
      SZA           IS DIGIT ZERO?
      JMP CAT27     NO, GO PRINT IT 
      LDB CATZS     YES 
      SZB           IS IT A LEADING ZERO? 
      JMP CAT25     NO, GO PRINT IT 
      LDA .+40B     YES, SUPPRESS IT AND
      JMP CAT26       PRINT " " 
CAT27  STA CATZS    NONZERO THE SUPPRESS FLAG 
CAT25  ADA ASC00    CONSTRUCT THE CHARACTER 
CAT26 JSB LOUT      PUT OUT CHARACTER 
      LDA CATLN     GET REMAINDER 
      CLB           PREPARE FOR DIVIDE
      JMP CAT24,I   RETURN
* 
CAT11 LDA CATI      TEST FOR USER DIRECTORY CONTIN- 
      ADA .+7        UED ON NEXT DIRECTORY TRACK. 
      STA CATI
      LDB 0,I 
      SZB,RSS 
      JMP CAT11+1   NEXT TRACK EMPTY.  THERE, RON.
      STB MWORD 
      CMB,INB 
      ADB LIBD
      STB CATQ
      INA           DOES NEXT TRACK BEGIN WITH
      LDB 0,I        THIS USER? 
      CPB LTEMP 
      RSS           YES 
      JMP CAT13     NO--QUIT. 
* 
      ADA .+4       GET DIRECTORY DISC ADDRESS
      LDB LIBDI 
      JSB DISCZ,I   READ DIRECTORY
      JMP CAT28     ARRGH, GO INFORM THE DUDE 
      LDA LIBD
      JMP CAT10 
CAT28 LDA .-22
      LDB *+2 
      JMP LIBER 
      DEF *+1 
      OCT 6412
      ASC 10,CAN'T READ DIRECTORY 
CATI  EQU LTEMP+4   => DIREC ENTRY
CATP  EQU LTEMP+5   => DIRECTORY ENTRY
CATJ  EQU LTEMP+6 
CATN  EQU LTEMP+7   LINE ENTRY COUNTER
CATQ  EQU LTEMP+9   => END OF DIRECTORY TRACK 
CATC  EQU LTEMP+10  CHARACTER COUNTER FOR PROG  NAME
CATLN EQU LTEMP+11
CATS  EQU LTEMP+12  HEADING INDEX 
CATZS EQU LTEMP+13  ZERO SUPPRESS FLAG
* 
* LTEMP, LTEMP+1, LTEMP+2, AND LTEMP+3 ARE ALSO USED
* 
ASCC  OCT 103 
ASCF  OCT 106 
ASCP  OCT 120 
CATTP DEF CATIT 
CATIT ASC 9, NAME    LENGTH 
$CAT  EQU * 
      HED LIBRARY 
* LIBRARY IS IDENTICAL TO CATALOG EXCEPT THAT IT USES A000
* AS ID RATHER THAN THE USER ID, AND PROGRAMS WITH EMBEDDED 
* ERROR MESSAGES ARE NOT LISTED.  IT MUST BE LOADED IMMEDIATELY 
* AFTER CATALOG.  GROUP MUST FOLLOW LIBRARY IN SEQUENCE.
      SPC 1 
      ORG LIBRA 
      CLA 
      ORG CAT1
      LDA A000
      JMP CAT2
      ORG CAT12 
      LDA CATP      CHECK FOR 
      ADA .+4         ILL-STORED
      LDA A,I           PROGRAMS
      SSA 
      JMP CAT22     DON'T LIST THEM 
      HED GROUP 
* GROUP IS IDENTICAL TO LIBRARY EXCEPT THAT IT USES THE 
* GROUP LIBRARIAN'S ID INSTEAD OF A000.  IT MUST BE LOADED
* IMMEDIATELY AFTER LIBRARY.
      SPC 1 
      ORG LIBRA 
      CLA 
      ORG CAT1
      LDB MLINK+1   GET USER ID 
      ADB .+?ID-?LINK 
      LDA B,I 
      AND M2000     ISOLATE AND 
      STA LTEMP       SAVE ALPHABETIC PART
      LDA B,I 
      AND B1777     ISOLATE NUMERICAL PART
      CLB 
      DIV .100      GET RID OF
      MPY .100        TENS AND ONES 
      IOR LTEMP     MERGE IN LETTER 
      HED DIRECTORY - USER CONSOLE
* THE DIRECTORY COMMAND IS AVAILABLE TO USER A000. IT CAUSES THE
* CONTENTS OF THE DISC DIRECTORY TO BE PRINTED ON THE USER'S CONSOLE
* IN THE FOLLOWING FORMAT:
* 
* <ID> <NAME> <PURGE DATE> <FLAGS> <LENGTH> <DISC ADR>
* 
* THE PURGE DATE IS PRINTED AS A 3-DIGIT INTEGER INDICATING THE DAY 
* OF THE YEAR AND A 2-DIGIT INTEGER INDICATING THE YEAR.
* THE DISC ADDRESS IS A LOGICAL BLOCK NUMBER. THE LENGTH IS IN WORDS
* FOR PROGRAMS, RECORDS FOR FILES. THESE ARE ALL PRINTED IN DECIMAL.
* TYPING DIR-ID WILL START THE LISTING WITH THAT ID.
* 
      ORG LIBRA 
      LDB MLINK+1 
      ADB .+?ID-?LINK 
      LDA B,I       GET USER'S ID 
      CPA A000      A000? 
      JMP UDIR1     YES 
      LDA .-19      NO, NOT ALLOWED 
      LDB *+2 
      JMP LIBER 
      DEF *+1 
      OCT 5120
      ASC 9,RIVILEGED COMMAND 
* 
* TEST FOR SPECIFIED ID 
* 
UDIR1 EQU * 
      CLA,INA       INITIALIZE IS IN CASE 
      STA ID          NONE IS SPECIFIED 
      JSB LCHAR     GET A CHAR
      JMP UDIR2     CR - START A BEGINNING OF DIR 
      LDB MLINK+1 
      ADB .+?TNUM-?LINK 
      LDA 1,I       BACKSPACE 
      IOR BKS         BUFFER
      JSB S14SC,I       POINTER 
      JSB GETID     GET THE ID
      JMP ILFER     CR MUST FOLLOW
* 
* PRINT HEADING 
* 
UDIR2 EQU * 
      CCA 
      ADA ID
      LDB MLINK+1 
      ADB .+?RTIM-?LINK 
      STA B,I       SAVE PREVIOUS ID
      JSB UHDBA,I   OUTPUT THE HEADING
      JSB SCHOU,I     AND SUSPEND 
* 
      LDA .-21      21 WORDS IN 
      STA LTEMP       HEADING 
      LDA UDHDA 
      STA LTEMP+1 
UDIR3 EQU * 
      LDA LTEMP+1,I OUTPUT
      ALF,ALF 
      AND B377         THE
      JSB LOUT
      LDA LTEMP+1,I     DIRECTORY 
      AND B377
      JSB LOUT            HEADING 
      ISZ LTEMP+1 
      ISZ LTEMP 
      JMP UDIR3 
      JSB SCHOU,I   SUSPEND 
* 
* SEARCH INITIALIZATION 
* 
      LDA INF       SET UP LTEMP[0:3] FOR 
      STA LTEMP+1     INITIAL SEARCH
      STA LTEMP+2 
      STA LTEMP+3 
      LDB MLINK+1 
      ADB .+?RTIM-?LINK 
      LDA B,I       RETRIEVE
      STA LTEMP       STARTING ID 
* 
* SEARCH FOR ENTRY
* 
UDIR4 EQU * 
      JSB DLOKP,I   SEARCH DIRECTORY FOR
      NOP             PREVIOUS ENTRY
      LDA LTEMP+5   MOVE
      ADA .+12        TO NEXT 
      STA LTEMP+5       ENTRY 
      ADA LTEMP+4,I 
      ADA MLIBD 
      SZA           END OF TRACK
      JMP UDIR7     NO
* 
      LDB LTEMP+4   YES, BUMP TO
      ADB .+7         NEXT ONE
      CPA B,I       LOOP IF EMPTY 
      JMP *-2 
* 
      STB LTEMP+4 
      LDA B,I 
      STA MWORD     LENGTH OF TRACK 
      ADB .+5 
      LDA B         => DISC ADDRESS 
      LDB LIBDI     CORE ADDRESS
      JSB DISCZ,I   READ IT 
      JMP UDI13 
* 
      LDA LIBD      SET POINTER 
      STA LTEMP+5     TO FIRST ENTRY
* 
* THE ENTRY HAS BEEN LOCATED
* 
UDIR7 EQU * 
      LDA LTEMP+5,I GET USER ID 
      LDB MLINK+1 
      ADB .+?RTIM-?LINK 
      STA B,I       SAVE IT 
      CPA .-1       END OF DIRECTORY? 
      JMP LLEND     YES 
      CPA LTEMP     NO, SAME AS PREVIOUS ONE? 
      JMP UDIR8     YES 
* 
* PRINT ID
* 
      RAR,RAR       NO, POSITION
      ALF,ALF         LETTER
      AND .+37B     KEEP ONLY 5 BITS
      ADA B100      CONVERT TO ASCII
      JSB LOUT      OUTPUT IT 
      LDA LTEMP+5,I GET ID AGAIN
      AND B1777     NUMERICAL PART
      CLB 
      DIV .100      FIRST DIGIT IN A, LAST 2 IN B 
      STB LTEMP+8 
      ADA .+60B     CONVERT TO ASCII
      JSB LOUT        AND OUTPUT
      LDA LTEMP+8   OUTPUT LAST 
      JSB UDINM       TWO DIGITS
      JMP UDIR9 
* 
UDIR8 EQU * 
      LDA UDISS     REPLACE 
      JSB UDIOW       ID WITH 
      LDA UDISS         FOUR
      JSB UDIOW           BLANKS
* 
* PRINT PROGRAM/FILE NAME 
* 
UDIR9 EQU * 
      LDB MLINK+1 
      ADB .+?TEMP-?LINK 
      STB LTEMP+8   => INTO TTY TABLE 
      LDA UDISS     2 BLANKS
      JSB UDIOW 
      ISZ LTEMP+5 
      LDA LTEMP+5,I OUTPUT 3 WORDS
      STA LTEMP+8,I 
      JSB UDIOW 
      ISZ LTEMP+8 
      ISZ LTEMP+5     OF NAME WHILE 
      LDA LTEMP+5,I 
      STA LTEMP+8,I 
      JSB UDIOW 
      ISZ LTEMP+8       SAVING THEM IN
      ISZ LTEMP+5 
      LDA LTEMP+5,I 
      STA LTEMP+8,I 
      JSB UDIOW           USER'S TTY TABLE
      LDA UDISS     2 BLANKS
      JSB UDIOW 
* 
* PRINT THE LAST DATE ACCESSED
* 
      LDB LTEMP+5 
      ADB .+2 
      STB LTEMP+5   => DATE 
      LDA LTEMP+5,I 
      AND B777      GET DAY OF YEAR 
      CLB 
      DIV .+10      1ST 2 DIGITS IN A, LAST ONE IN B
      STB LTEMP+8 
      JSB UDINM     OUTPUT FIRST 2
      LDA LTEMP+8   GET LAST ONE
      ADA .+60B     CONVERT TO ASCII
      JSB LOUT        AND OUTPUT
      LDA .+57B     '/' 
      JSB LOUT
      LDA LTEMP+5,I 
      ALF,ALF       POSITION
      RAR             YEAR AND
      AND B177          MASK
      JSB UDINM     OUTPUT IT 
* 
      LDA UDISS     2 BLANKS
      JSB UDIOW 
* 
* CHECK FOR FILE
* 
      LDB LTEMP+5 
      ADB .-3       => SECOND WORD OF NAME
      LDA B,I 
      INB 
      SSA,RSS       FILE? 
      JMP UDI10     NO
      LDA UDIRF     YES, GET AN 'F' 
      JMP UDI11 
* 
* CHECK IF SEMI-COMPILED
* 
UDI10 EQU * 
      LDA B,I 
      SSA,RSS       SEMI-COMPILED?
      JMP UDI11-1   NO
      LDA UDIRC     YES, GET A 'C'
      RSS 
      LDA .+40B     A BLANK 
* 
* CHECK PROTECT BIT 
* 
UDI11 EQU * 
      ADB .-2 
      STB LTEMP+5   => 1ST WORD OF NAME 
      JSB LOUT      OUTPUT A CHAR 
      LDB LTEMP+5,I 
      SSB,RSS       PROTECTED?
      JMP *+3       NO
      LDA UDIRP     YES, GET A 'P'
      RSS 
      LDA .+40B     A BLANK 
      JSB LOUT      OUTPUT CHAR 
      LDA .+40B     A BLANK 
      JSB LOUT
* 
* PRINT THE LENGTH
* 
      LDB LTEMP+5 
      ADB .+10      => LENGTH 
      LDA B,I 
      ADB .-3 
      STB LTEMP+5 
      SSA           COMPLEMENT
      CMA,INA         IF NEGATIVE 
      CLB 
      DIV DVSRS     FIRST DIGIT IN A, LAST 4 IN B 
      STB LTEMP+8 
      ADA .+60B     CONVERT TO ASCII
      JSB LOUT        AND OUTPUT
      LDA LTEMP+8 
      CLB 
      DIV .100      DIGITS 2-3 IN A, 4-5 IN B 
      STB LTEMP+8 
      JSB UDINM     OUTPUT 2-3
      LDA LTEMP+8 
      JSB UDINM     OUTPUT 4-5
* 
* PRINT THE DISC ADDRESS
* 
      LDA UDISS     2 BLANKS
      JSB UDIOW 
      LDB LTEMP+5,I GET 
      ISZ LTEMP+5     DISC
      LDA LTEMP+5,I     ADDRESS 
      DIV DVSRS     1ST 2 DIGITS IN A, LAST 4 IN B
      STB LTEMP+8 
      JSB UDINM     OUTPUT FIRST 2
      LDA LTEMP+8 
      CLB 
      DIV .100      DIGITS 3-4 IN A, 5-6 IN B 
      STB LTEMP+8 
      JSB UDINM     OUTPUT 3-4
      LDA LTEMP+8 
      JSB UDINM     OUTPUT 5-6
      LDA .+23B     X-OFF 
      JSB LOUT
      LDA .+15B     CR
      JSB LOUT
      LDA .+12B     LF
      JSB LOUT
      JSB SCHOU,I   SUSPEND 
      LDB DLTEM     MOVE NAME 
      STB MOVED 
      LDB MLINK+1     FROM TTY
      ADB .+?RTIM-?LINK 
      STB MOVES         TABLE TO
      LDB .-4 
      JSB MOVEW           LTEMP[0:3]
      JMP UDIR4 
* 
* 
UDI13 EQU * 
      LDA .-22
      LDB *+2 
      JMP LIBER 
      DEF *+1 
      OCT 6412
      ASC 10,CAN'T READ DIRECTORY 
* 
* UDINM CONVERTS A #<100 TO ASCII AND OUTPUTS IT
* 
UDINM NOP 
      CLB 
      DIV .+10
      STB LTEMP+11
      ADA .+60B 
      JSB LOUT
      LDA LTEMP+11
      ADA .+60B 
      JSB LOUT
      JMP UDINM,I 
* 
* UDIOW OUTPUTS THE TWO CHARACTERS OF A WORD
* 
UDIOW NOP 
      STA LTEMP+11
      ALF,ALF 
      AND B377
      JSB LOUT
      LDA LTEMP+11
      AND B377
      JSB LOUT
      JMP UDIOW,I 
* 
* 
UDIHD OCT 5040      LF-BLANK
      ASC 9,ID    NAME    DATE
      ASC 9,     LENGTH   DISC
      OCT 20023     BLANK-XOFF
      OCT 6412      CR-LF 
UDHDA DEF UDIHD 
UDISS ASC 1,
UDIRF OCT 106 
UDIRC OCT 103 
UDIRP OCT 120 
* 
* ALL LTEMP LOCATIONS BETWEEN LTEMP AND LTEMP+15 INCLUSIVE  EXCEPT
*   FOR LTEMP+7, LTEMP+9 AND LTEMP+10 ARE USED HERE 
* 
$DIR$ EQU * 
