
      HED UTILITY ROUTINES
* 
*      DIRECTORY GET ROUTINE. 
*         CALL WITH POINTER TO DIREC TABLE IN A.
* ROUTINE INSURES THAT THE INDICATED DIRECTORY
* TRACK IS IN CORE (IDTBL BUFFER) 
* 
DIRGE NOP 
      CPA CUDIR     CHECK FOR ALREADY IN
      JMP DIGF
      STA CUDIR     NO?  WELL IT IS NOW 
      LDB A,I       GET THE TRACKS LENGTH 
      STB MWORD       AND SAVE FOR DISC DRIVER
      ADA JD5       => DISC ADDRESS 
      LDB IDTCJ     READ FORM OF CORE ADDRESS 
      JSB DISCJ,I   READ IT IN
DIGF  EQU * 
      LDA CUDIR,I   GET THE TRACK LENGTH
      JMP DIRGE,I   RETURN
* 
*      DIRECTORY SEARCH ROUTINE.
*         NO SKIP IF ENTRY NOT IN DIRECTORY 
* 
DIRLK NOP 
      LDB JDIRU     => LAST DIREC ENTRY + 1 
DIRLQ EQU * 
      CPB JDIRC     CHECK FOR END OF TABLE
      JMP DIRLK,I   NO FIND 
      ADB JM7       MOVE TO PREVIOUS ENTRY
      STB DIRT1     SAVE POINTER TO DIREC ENTRY 
      LDA B,I       CHECK TO SEE IF THE 
      SZA,RSS         TRACK EXISTS
      JMP DIRLP     NO, SKIP IT 
      INB           => FIRST ID 
      LDA ADJ0      => TEST ENTRY 
      JSB DIRCM     DO A COMPARE
      JMP DIRLR     THIS IS THE TRACK 
      JMP DIRLR       FIRST ENTRY, NO LESS
DIRLP EQU * 
      LDB DIRT1 
      JMP DIRLQ     GO LOOK AT NEXT DIREC ENTRY 
* 
DIRLR EQU * 
      LDA DIRT1     GET THE DIREC POINTER 
      JSB DIRGE       AND INSURE THIS TRACK IN
      SZA,RSS       NO SKIP IF TRACK EMPTY
      JMP DIRLK,I   NO FIND 
      CCB 
      DIV JD12      CALCULATE NUMBER OF ENTRIES 
      STA DIRT1       AND SAVE THE COUNT
      LDB IDTBJ     => FIRST ENTRY
      STB DIRP      => CURRENT ENTRY
DIRLS EQU * 
      LDA ADJ0      => TEST ENTRY 
      JSB DIRCM     COMPARE THE TWO ENTRIES 
      JMP DIRLT     > 
      ISZ DIRLK     = FOUND IT
      JMP DIRLK,I   < PAST ITS POSITION WITHOUT FIND
* 
DIRLT EQU * 
      LDB DIRP
      ADB JD12      => NEXT ENTRY 
      STB DIRP      SAVE POINTER FOR INSERTIONS 
      ISZ DIRT1     AND CHECK THE COUNTER 
      JMP DIRLS     GO TEST THIS NEXT ENTRY 
      JMP DIRLK,I   NO FIND 
* 
*      COMPARE ROUTINE
*         CALL WITH POINTERS IN A AND B 
*     TO THE TWO FOUR WORD ENTRIES TO BE COMPARED 
*         NO SKIP   - IF (A) > (B)
*         SINGLE SKIP IF (A) = (B)
*         DOUBLE SKIP IF (A) < (B)
* 
DIRCM NOP 
      STA DIRT2     SAVE A POINTER
      STB DIRT4 
      LDA JM4 
      STA DIRT3     SET COUNTER FOR FOUR WORDS
DIRCN EQU * 
      LDA DIRT2,I   GET A WORD
      ELA,CLE,ERA   CLEAR BIT 15
      CMA,INA 
      LDB DIRT4,I   GET THE OTHER WORD
      ELB,CLE,ERB     CLEAR BIT 15
      ADA B             AND DO A SUBTRACTION
      SSA 
      JMP DIRCM,I   (A) > (B) 
      SZA           MUST CONTINUE IF EQUAL
      JMP DIRCQ       OTHERWISE, DO FINAL COMPARE 
      ISZ DIRT4     ADVANCE THE 
      ISZ DIRT2       POINTERS
      ISZ DIRT3         AND CHECK THE COUNT 
      JMP DIRCN     GO LOOK AT NEXT WROD
DIRCQ EQU * 
      ISZ DIRCM 
      SZA           SKIP IF EQUAL 
      ISZ DIRCM     INCREMENT TO LAST RETURN
      JMP DIRCM,I   RETURN
* 
* 
CDTW  NOP 
      LDA CUDIR     GET POINTER TO CURRENT DIR TRACK
      LDB A,I       GET THE LENGTH
      STB MWORD       AND SAVE FOR DISC DRIVER
      ADA JD5       => DISC ADDRESS 
      LDB IDTBJ     => CORE BUFFER
      JSB DISCJ,I   WRITE IT OUT
      JMP CDTW,I    RETURN
      SKP 
* 
*      ROUTINE TO READ OR WRITE ALL OF THE ADTS 
*      THE MAXIMUM LENGTH OF EACH ADT IS 1400 OCT.
* 
SPDA  NOP 
      LDA JM8 
      STA JTMP0     SET COUNT OF ADT'S
      LDA DADLJ     => ADT LENGTH TABLE 
      STA JTMP1 
SPDAT EQU * 
      STB JTMP2 
      LDA JTMP1,I   GET THE LENGTH
      STA MWORD       FOR THE DISC DRIVER 
      SZA,RSS 
      JMP SPDBC     SKIP READ IF ZERO LENGTH
      LDA JTMP1     => LENGTH TABLE 
      ADA JM2       => DISC ADDRESS 
      JSB DISCJ,I   CALL THE DRIVER 
SPDBC EQU * 
      LDB JTMP2 
      ADB JB14H     ADVANCE TO THE NEXT BUFFER
      LDA JTMP1     ADVANCE TO
      ADA JD3         THE NEXT
      STA JTMP1         LENGTH WORD 
      ISZ JTMP0     CHECK COUNT 
      JMP SPDAT     GET ALL EIGHT 
      JMP SPDA,I    RETURN
* 
* 
*     SECTION TO GET THE NEXT ID TRACK
* 
SPMB  NOP 
SPMBC EQU * 
      STB JTMP0     SAVE CURRENT IDEC POINTER 
      ADB JD3       => LENGTH 
      LDA B,I       GET LENGTH
      SZA           SKIP IF ZERO LENGTH TRACK 
      JMP SPMBE     GO READ IN THE TRACK
      INB           => NEXT IDEC ENTRY
      CPB JIDEL     CHECK FOR END 
      JMP SPFR      NO IDT TO UPDATE
      JMP SPMBC 
SPMBE EQU * 
      STA MWORD     SAVE FOR DISC DRIVER
      ARS,ARS       GENERATE
      ARS             THE ENTRY COUNT 
      STA JTMP1         AND SAVE IT 
      LDA JTMP0     => DISC 
      INA             ADDRESS 
      LDB ADTCJ     => ADT BUFFER 
      JSB DISCJ,I 
      JMP SPMB,I    RETURN
      HED CONSTANTS, TEMPORARIES, ETC.
JM1K  DEC -1024 
JM112 DEC -112
JM22  DEC -22 
JM12  DEC -12 
JM10  DEC -10 
JM9   DEC -9
JM8   DEC -8
JM7   DEC -7
JM6   DEC -6
JM4   DEC -4
JM3   DEC -3
JM2   DEC -2
JM1   DEC -1
JD1   DEC 1 
JD2   DEC 2 
JD3   DEC 3 
JD4   DEC 4 
JD5   DEC 5 
JD7   DEC 7 
JD8   DEC 8 
JD10  DEC 10
JD11  DEC 11
JD12  DEC 12
JB15  OCT 15
JD15  DEC 15
JD16  DEC 16
JD22  DEC 22
JD24  DEC 24
JD27  DEC 27
JD30  DEC 30
JD32  DEC 32
JD35  DEC 35
JD44  DEC 44
JD46  DEC 46
JD600 DEC 600 
JD1K  DEC 1024
JB14H OCT 1400
JMHPY DEC 8784      HOURS PER YEAR
* 
JASB0 ASC 1, 0
JASN  OCT 116       "N" 
JASY  OCT 131       "Y" 
JLB   ASC 1,LB
JTS   ASC 1,TSB 
SLSH  OCT 57        '/' 
MXDAY DEC -367      1'S COMPLEMENT OF MAXIMUM DAY 
MAXYR DEC -100      1'S COMPLEMENT OF MAXIMUM YEAR
MBIAS ABS -30000-6000    TENTHS-OF-SECOND COUNTER 
* 
AADNJ DEF AADN      => UNIT NUMBER SPOT IN MESSAGE
AAERJ DEF AAER      => AAA DEATH ROUTINE
ADJ0  DEF ADTBL 
ADJ6  DEF ADTBL+6   => LAST CHANGE DATE 
ADJ10 DEF ADTBL+10  => RECOVERED FLAG 
ADJ11 DEF ADTBL+11  => LENGTH 
ADJ12 DEF ADTBL+12
ADTBJ EQU ADJ0      => FIRST BUFFER 
ADTCJ DEF ADTBL,I   => ADT BUFFER 
ASRJ  DEF TTY35     => TELETYPE DRIVER
CFFWJ DEF CFFW      => ASCII OUTPUT PRINTER 
CFTDJ DEF CFTD      => SUBTRACT ROUTINE 
CKFCA DEF CKFC      => CHECK FEATURE CODE 
COM6A DEF COM6
CTMJ3 DEF CTMP3 
DADLJ DEF DADLN     => ADT LENGTHS
DATEA DEF DATER 
DCADJ DEF DCADT     => ADT POINTER
DCBVJ DEF DCBV
DCFLJ DEF DCFLG     => SEARCH ONLY FLAG 
DISCJ DEF DISCZ 
DRENJ DEF DREN      => SAVE ROUTINE 
EFIDJ DEF EFID      ID IN LOCAL TABLE?
ENSUA DEF ENSU
ENTEJ DEF ENTEP     => CORE ID TABLE END ADDRESS
FSDAJ DEF FSDAD     => ADT SEARCH ROUTINE 
GETCJ DEF GETCR     => CHARACTER GETTER 
IDTBJ DEF IDTBL     => SECOND BUFFER
IDTCJ DEF IDTBL,I   => IDT BUFFER 
ILDTA DEF ILDTE 
ILINJ DEF ILIN      => "ILLEGAL INPUT"
ILTIA DEF ILTIM 
INTGA DEF INTGR 
JDECJ DEF JDECN     => DIRECTORY ENTRY COUNT
JDIRC DEF DIREC     => DIREC TABLE
JDIRU DEF DIREU     => END OF DIREC TABLE + 1 
JDME2 DEF MLTBE+2   => EQT DISC ADDRESS 
JDTM4 DEF DTMP4 
JIDEC DEF IDEC      => IDEC TABLE 
JIDEL DEF IDEC+12 
JLADP DEF ADTBL+1036,I
JLADQ DEF ADTBL+1036
JMHND DEF MAXSC     => END OF MHAD
JT2P  DEF JTMP2 
LDMDJ DEF MLDLS 
LTP1B DEF LTMP1 
MFENF DEF MFEN
MIDTB ABS -IDTBL
MLENJ ABS -TLEN 
MOVDJ DEF MOVED     => MOVE DESTINATION 
MOVEJ DEF MOVEW     => MOVE ROUTINE 
MOVSJ DEF MOVES     => MOVE SOURCE WORD 
MRIDJ DEF MRIDS 
MRIEJ DEF MRIE      => "NO ROOM FOR <ID><NAME> "
MTAEJ DEF MTAE      => "TAPE ERROR <ID><NAME> LOST" 
MTAEW DEF MTAEV 
MTASJ DEF MTASA     "UNRECOVERED ENTRIES. . . " 
MTBDJ DEF MTBDO 
MTBTJ DEF MTBTL     => "BAD TAPE LABEL" 
MTDMJ DEF MTDEM 
MTJ   DEF MTD       => MAG TAPE DRIVER
MTKBM DEF MTKBL     => RECORD SIZE CALCULATOR 
MTLNB DEF MTLEN 
MTRDJ DEF MTRD      => USER LIBRARY READ ROUTINE
MTRRJ DEF MTRRF 
MTUFW DEF MTUFM     => "UNEXPECTED EOF. <ID><NAME> LOST"
MTUFX DEF MTUFN 
NOMSA DEF NOMES 
RDSEA DEF RDSEG 
RLDCJ DEF RLDC
SUPTA DEF SUPTG 
TCHAJ DEF TCHA      =>"ARE YOU SURE . . . " 
TIMEA DEF TIMER 
TLRTJ DEF TLRT      => TAPE LABEL BUFFER
TLRVJ ABS TLRV      => ALTERNATE TAPE LABEL BUFFER
TLRVN ABS TLRV+TLRN => ALTERNATE REEL NUMBER
TLSVJ DEF TLRV+TLSL+1    => FEATURE CODE IN 2ND BUFF
TLYTJ DEF TLRT+TLYR => PRIMARY TAPE LABEL BUFFER YEAR 
TLYVJ DEF TLRV+TLYR => ALTERNATE TAPE LABEL BUFFER YEAR 
TWODA DEF TWODG 
USTRA DEF TRKTB     => FIRST SWAP TRACK DISC ADDRESS
* 
* LINKS TO LOADER SYSTEM LINKAGE AREA 
* 
?IDA  DEF ?ID 
GMQBA DEF GMQBN 
INCRA DEF INCRE 
PWRFA DEF PWRFL 
SWPAI DEF SWPAA 
SWPII DEF SWPIA 
SWPLA DEF SWPLN 
TSBA  DEF TSB,I 
TTYDI DEF TTYDA 
* 
CUADT BSS 1         => CURRENT IN CORE ADT
CUDIR BSS 1         => CURRENT IN CORE DIR TRACK
*                                   DIREC ENTRY 
DCBS  BSS 1         LOCAL ALTERNATE ALLOCATION FLAG 
DIRP  BSS 1         => CURRENT DIRECTORY ENTRY
DIRT1 BSS 1 
DIRT2 BSS 1 
DIRT3 BSS 1 
DIRT4 BSS 1 
JTMP0 BSS 1 
JTMP1 BSS 1 
JTMP2 BSS 1 
JTMP3 BSS 1 
JTMP4 BSS 1 
JTMP5 BSS 1 
JTMP6 BSS 1 
LDATE EQU DIRT1 
LTIME EQU DIRT2 
LYEAR EQU DIRT3 
SRFLG BSS 1         SELECTIVE RELOAD FLAG 
*                                   0 SEZ MAG TAPE RELOAD 
*                                   1 SEZ SELECTIVE LOAD
      SKP 
* 
*  CHECK FOR PAGE OVERFLOW
* 
      LDA 10000B                                 [B]
      HED UTILITY ROUTINES
      ORG 12000B
*                     * 
**  GET SELECT CODE  ** 
*                     * 
* 
*  ENTER WITH A CHARACTER IN (A).  FIND A TWO-DIGIT OCTAL 
*  INTEGER IN [SELCD,I , SELCD+1,I].  IF THIS CANNOT BE DONE, 
*  PRINT AN ERROR AND EXIT TO (P+3), ELSE EXIT TO (P+4) WITH THE
*  INTEGER IN (B) AND THE FOLLOWING CHARACTER IN (A). 
* 
SELCD NOP 
      JSB DIGCK     DIGIT?
      JMP SELC3     NO
      ADB LM8       YES, OCTAL
      SSB,RSS         DIGIT?
      JMP SELC3     NO
      ALF,RAR       YES 
      STA LTMP1     SAVE IT * 8 
      JSB GETCR     NEXT
      JMP SELC3 
      JSB DIGCK       CHARACTER AN
      JMP SELC3 
      ADB LM8           OCTAL DIGIT?
      SSB,RSS 
      JMP SELC3     NO
      ADA LTMP1     YES, SAVE 
      STA LTMP1       SELECT CODE 
      JSB GETCR 
      NOP 
      LDB SELCD,I   GET LOWER LIMIT 
      ISZ SELCD 
      CMB,INB       WITHIN
      ADB LTMP1 
      SSB             RANGE?
      JMP SELC2     NO
      LDB LTMP1     YES, CHECK
      CMB,INB         UPPER 
      ADB SELCD,I       LIMIT 
      SSB           WITHIN RANGE? 
      JMP SELC2     NO
      LDB LTMP1     YES 
      ISZ SELCD 
SELC1 ISZ SELCD 
      JMP SELCD,I 
SELC3 ISZ SELCD     SKIP OVER ARGUMENT
SELC2 LDA L.21      REPORT
      LDB ILSCL 
      JSB ASRDA,I     ERROR 
      JMP SELC1 
      SKP 
*                     * 
**  GET DISC NUMBER  ** 
*                     * 
*  SEARCH THE INPUT RECORD FOR A '-' FOLLOWED BY AN INTEGER 
*  FOLLOWED BY A COMMA.  EXIT TO (P+2) WITH THE 
*  INTEGER IN (A) IF THE ABOVE CONDITIONS ARE MET; OTHERWISE, 
*  PRINT AN ERROR AND EXIT TO (P+1) 
* 
GTDNO NOP 
GTDN1 JSB GETCR 
      JMP GTDN2 
      CPA DASH      '-' ? 
      RSS           YES 
      JMP GTDN1     NO
      JSB INTGR     GET DISC #
      CPA LB54      FOLLOWED BY A COMMA?
      JMP GTDN3     YES 
GTDN2 LDA L.15      NO
      LDB BDDLA     PRINT 
      JMP GTDN4       ERROR                      [B]
GTDN3 LDA 1         DISC #
      ADB LM8 
      SSB             < UPPER LIMIT?
      JMP GTDN5     YES 
      LDA L.25      NO
      LDB BADDA     PRINT 
GTDN4 JSB ASRDA,I     ERROR                      [B]
      JMP GTDNO,I 
GTDN5 ISZ GTDNO 
      JMP GTDNO,I 
*                        *
**  SET DISC EQT ENTRY  **
*                        *
* 
*  UPON ENTRY, TEMP1 = DISC #, TEMP2 = SELECT CODE, AND TEMP3 = 
*  UNIT #.  IF TEMP2 = 0 UPON ENTRY, ZERO THE DISC #'S SELECT CODE
*  ENTRY IN THE DISC EQT.  OTHERWISE, STORE THE SELECT CODE AND 
*  UNIT # IN THE DISC EQT AND A JSB,I IN THE COMMAND CHANNEL
*  LOCATION.
* 
STDIS NOP 
      LDA TMP1A,I   GET DISC #
      ADA DKTBM     COMPUTE SELECT CODE ADDRESS 
      LDB TMP2A,I   SELECT
      SZB,RSS         CODE 0? 
      JMP STDI1     YES 
      BLF,BLF       NO, SHIFT TO UPPER 8 BITS 
      ADB TMP3A,I   MERGE IN UNIT # 
      STB A,I       SAVE IT 
      LDA TMP2A,I 
      INA           COMMAND CHANNEL LOCATION
      LDB DSINP     INTERRUPT JSB,I 
STDI1 STB A,I       SAVE IT 
      JMP STDIS,I 
      SKP 
*                      *
**  BUILD AN INTEGER  **
*                      *
* 
*  SEARCH THE INPUT STRING FOR AN INTEGER.  IF FOUND, RETURN WITH 
*  IT IN (B).  IF NO DIGITS ARE FOUND OR THE INTEGER OVERFLOWS
*  16 BITS, RETURN WITH 32767 IN (B) & FIRST NON-DIGIT IN (A).
* 
INTGR NOP 
      CCA           SET 'NO DIGITS' 
      STA LTMP5       FLAG
      CLA           INITIALIZE TO ZERO
INTG1 STA LTMP6     STORE PARTIAL RESULT
      JSB GETCR     MORE CHARACTERS?
      JMP INTG2     NO
      JSB DIGCK     YES, DIGIT? 
      JMP INTG2     NO
      STA LTMP5     YES, SAVE IT
      LDA LTMP6     MULITPLY PARTIAL
      MPY L.10        RESULT BY 10
      CLE           ADD IN
      ADA LTMP5       NEW DIGIT 
      SEZ,SZB,RSS 
      SSA           OVERFLOW? 
      JMP INTG3     YES 
      JMP INTG1     NO
INTG2 LDB LTMP6     LOAD INTEGER
      ISZ LTMP5     ANY DIGITS FOUND? 
      JMP INTGR,I   YES 
INTG3 LDB INF       NO,LOAD ILLEGAL INTEGER 
      JMP INTGR,I 
*                               * 
**  CONVERT TWO-DIGIT INTEGER  ** 
*                               * 
* 
*  SEARCH THE INPUT RECORD FOR A TWO-DIGIT INTEGER NOT TO EXCEED
*  -(TWODG,I UPON ENTRY).  IF FOUND, RETURN TO (P+2) WITH INTEGER 
*  IN (B), ELSE EXIT TO ERROR ROUTINE.
* 
TWODG NOP 
      JSB GETCR     FETCH 
      JMP ERR7A,I     AND 
      JSB DIGCK         VERIFY
      JMP ERR7A,I         DIGIT 
      CLB           MULTIPLY
      MPY L.10        BY 10 
      STA LTMP1         AND SAVE
      JSB GETCR     FETCH 
      JMP ERR7A,I     AND 
      JSB DIGCK         VERIFY
      JMP ERR7A,I         DIGIT 
      ADB LTMP1     COMBINE WITH PRIOR RESULT 
      LDA 1 
      ADA TWODG,I   INTEGER 
      ISZ TWODG       TOO 
      SSA               LARGE?
      JMP TWODG,I   NO
      JMP ERR7A,I   YES 
      SKP 
*                          *
**  READ FROM PAPER TAPE  **
*                          *
* 
*  RETURN WITH A WORD FROM PAPER TAPE IN (B).  IF (E) = 1 UPON
*  ENTRY, READ ONLY THE NEXT FRAME.  IF (E) = 0 UPON ENTRY, 
*  COMBINE THE NEXT TWO FRAMES INTO A 16-BIT RESULT.
* 
READ  NOP 
      CLB,CME 
READ1 STC PHRSC,C   READ
      SFS PHRSC       A 
      JMP *-1           CHARACTER 
      CLC PHRSC     INCLUSIVE OR
      MIB PHRSC       INTO (B)
      SEZ,RSS       SECOND CHARACTER TO BE READ?
      JMP READ,I    NO
      BLF,CLE,BLF   YES, MOVE FIRST CHARACTER 
      JMP READ1       TO HIGH PART OF (B) 
*                      *
**  VALIDATE ADDRESS  **
*                      *
* 
*  ENTER WITH AN ADDRESS IN (B).  VERIFY THAT THIS ADDRESS LIES 
*  WITHIN AN AREA OF CORE CONTAINING TSB SYSTEM CODE.  IF THIS IS 
*  NOT THE CASE, HLT 55 OCT WITH THE OFFENDING ADDRESS IN (A).
* 
ADVAL NOP 
      STB LTMP1     SAVE ADDRESS
      CLE           BELOW 
      ADB MAXAD       PROTECTED 
      SEZ               LOADER? 
      JMP ADVA1     NO
      ADB SYSTA     YES, IN MAIN PART 
      SSB,RSS         OF SYSTEM?
      JMP ADVAL,I   YES 
      ADB MAXBA     NO, BELOW 
      SSB,RSS         UNUSED SWAP AREA? 
      JMP ADVA1     NO
      ADB BPAGA     YES, IN BASE PART 
      SSB,RSS         OF SYSTEM?
      JMP ADVAL,I   YES 
      ADB INRPA     NO, WITHIN LEGAL
      SSB,RSS         INTERRUPT AREA? 
      JMP ADVA1     NO
      ADB INRPB     YES,
      SSB,RSS         (A) OR (B) ?
      JMP ADVAL,I   NO
ADVA1 LDA L.17      YES 
      LDB BDADA     PRINT 
      JSB ASRDA,I     ERROR 
      LDA LTMP1     DISPLAY ADDRESS 
      HLT 55B       WAIT FOR REREAD ATTEMPT 
      JMP L46A,I
      SKP 
