
      HED UTILITY ROUTINES
* 
*      ROUTINE TO READ A MAG TAPE LABEL AND 
* MAKE SURE THAT IT HAS A TSB LABEL AND A 
* REEL NUMBER OF ONE.  THE LABEL IS LEFT
* IN THE FIRST TAPE BUFFER (TLRT).
* 
TPLR  NOP 
TPLRA EQU * 
      JSB MTAPE,I   REWIND
      OCT 3           TAPE
* 
      CLA           INITIALIZE
      CLB             SYS LEVEL & FEATURE CODE
      DST TLRT+TLSL     TO ZERO 
*                                       AND FEATURE CODE TO ZERO. 
      LDA TLENA     GET THE EXPECTED LENGTH 
      LDB TLRTA     => FIRST TAPE BUFFER
      JSB MTAPE,I 
      OCT 0 
      JMP EOFRA,I   EOF, NO TAPE LABEL
      JMP TPERA,I   TAPE ERRORS 
      STA MTLNA,I   SAVE LENGTH READ
      DLD TLRT      GET FIRST TWO WORDS 
      CPA LB        IS FIRST WORD "LB"
      RSS 
      JMP TPLRB     ISN'T 
      CPB TS        IS SECOND WORD "TS" 
      RSS 
      JMP TPLRB     ISN'T 
      LDA TLRUA,I   GET REEL NUMBER 
      CPA .1        CHECK FOR FIRST REEL
      JMP TPLR,I    LABEL OKAY, RETURN
* 
TPLRB EQU *         LABEL BAD 
      LDA ASCB1     GET REEL NUMBER FOR MESSAGE 
      STA ERLNA,I   STORE INTO MESSAGE
      LDA .35 
      LDB NXRNA     "MOUNT REEL #  1.  PRESS RUN" 
      JSB ASR35,I 
      HLT 77B       WAIT FOR OPERATOR 
      JMP TPLRA     TRY AGAIN 
      SKP 
*                                  *
**  REQUEST MAG TAPE SELECT CODE  **
*                                  *
* 
*  ANSWER IS THE HIGH PRIORITY SELECT CODE FOR THE MAG TAPE UNIT
*  OR A CARRIAGE RETURN.
*     NORMAL RETURN IS SINGLE SKIP, 
*     RETURN FOR EMPTY LINE IS NO SKIP. 
* 
GMTS  NOP 
      LDA .23       ASK 
      LDB MTSCA       FOR 
      JSB ASR35,I       MAG TAPE
      CLA                 SELECT
      JSB ASR35,I           CODE
      JSB GETCA,I   EMPTY INPUT RECORD? 
      JMP GMTS,I    ONLY A CR 
      JSB SELCA,I   NO, GET SELECT CODE 
      ABS BSDAT+2     IN [17 OCT, 
      OCT 76            76 OCT ]
      JMP GMTS+1    NOT FOUND 
      STB MTFLG     FOUND, SET FLAG TO 'MAG TAPE' 
      CPA B15       CARRIAGE RETURN FOLLOWS?
      JMP GTMS1     YES                          [B]
      LDA .21       NO, OUTPUT                   [B]
      LDB ILSCA       ERROR 
      JSB ASR35,I       MESSAGE 
      JMP GMTS+1    REQUEST AGAIN 
GTMS1 LDA MTFLG     SAVE                         [B]
      STA MAGSC       SELECT CODE                [B]
      JSB MTDIA,I   CONFIGURE MAG TAPE DRIVER 
      ISZ GMTS      GIVE SKIP RETURN
      JMP GMTS,I    RETURN
* 
*      INITIALIZE THE INTERRUPT LOCATIONS FOR 
*  ALL OF THE DISCS PRESENT.
* 
JDSE  NOP 
      LDA M8        NUMBER OF DISC SELECT CODES 
      STA TEMP0 
      LDB DKTBA     => DISC SELECT CODE TABLE 
JDSEA EQU * 
      LDA B,I       GET THIS SELECT CODE
      SZA,RSS       SKIP IF GOOD
      JMP JDSED     NO UNIT CORRESPONDING 
      ALF,ALF       SELECT CODE TO LOW END
      INA           => COMMAND CHANNEL INTERRUPT LOC
      AND B77       MASK OFF UNIT NUMBER
      STA TEMP2 
      LDA DSINA     COMMAND CHANNEL CONTENTS
      STA TEMP2,I   SET INTERRUPT LOCATION
JDSED EQU * 
      INB           ADVANCE THE POINTER 
      ISZ TEMP0 
      JMP JDSEA 
      JMP JDSE,I
* 
*                                    *
**  PROCESS MLOCK/MUNLOCK COMMANDS  **
*                                    *
RLUM  NOP 
RLUM0 LDA .29       REQUEST                      [B]
      LDB LUMLA       MLOCK OR MUNLOCK
      JSB ASR35,I 
      CLA 
      JSB ASR35,I 
      JSB GETCA,I   FIRST 
      JMP RLUM,I
      CPA N             'N'?
      JMP RLUM,I    YES, EXIT 
      CPA M         NO, 'M'?
      JMP RLUM1     YES 
ERR4  LDA .15       NO
      LDB ILINA     PRINT 
      JSB ASR35,I     ERROR 
      JMP RLUM0                                  [B]
* 
RLUM1 JSB GETCA,I   NEXT
      JMP ERR4        CHARACTER 
      CCB               A 
      CPA U               'U'?
      JMP MLKUA,I   YES--ASSUME MUNLOCK 
      CLB           NO, AN
      CPA L           'L'?
      JMP MLKUA,I   YES--ASSUME MLOCK 
      JMP ERR4      NO
*                         * 
**  GET NUMBER OF PORTS  ** 
*                         * 
* 
* REQUEST THE NUMBER OF AVAILABLE PORTS. CHECK FOR A RESPONSE 
* BETWEEN 1 AND 32, A SIMPLE CARRIAGE RETURN IMPLIES NO CHANGE. 
* 
RNPRT NOP 
      LDA .18       REQUEST 
      LDB MNBPA       NUMBER
      JSB ASR35,I       OF PORTS
      CLA,INA       RANGE IS
      LDB .32         1-32
      JSB RQINA,I   GET RESPONSE
      JMP RNPRT+1   ERROR 
      JMP RNPRT,I   CR IMPLIES NO CHANGE
      CMA,INA       SAVE -# 
      STA NPORT       OF PORTS
      JMP RNPRT,I 
      HED CONSTANTS, TEMPORARIES, ETC.
M256  DEC -256
M80   DEC -80 
M60B  OCT -60 
M32   DEC -32 
M40B  EQU M32 
M24   DEC -24 
M23   DEC -23 
M12   DEC -12 
M8    DEC -8
M5    DEC -5
M3    DEC -3
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.5    DEC 5 
.7    DEC 7 
.10   DEC 10
.12   DEC 12
.13   DEC 13
B15   EQU .13 
.15   DEC 15
.18   DEC 18
.19   DEC 19
.21   DEC 21
.22   DEC 22
.23   DEC 23
.24   DEC 24
.25   DEC 25
.26   DEC 26
.29   DEC 29
.32   DEC 32
B40   EQU .32 
.34   DEC 34
.35   DEC 35
.38   DEC 38
B60   OCT 60
B77   OCT 77
B20K  OCT 20000 
BIT15 OCT 100000
O1400 OCT 1400
COMMA OCT 54        ',' 
D     OCT 104       'D' 
I     OCT 111       'I' 
L     OCT 114       'L' 
M     OCT 115       'M' 
N     OCT 116       'N' 
S     OCT 123       'S' 
U     OCT 125       'U' 
Y     OCT 131       'Y' 
ASC   ASC 1,
LB    ASC 1,LB      'LB'
TS    ASC 1,TS      'TS'
DO    ASC 1,DO      'DO'
ASCB0 ASC 1, 0
ASCB1 ASC 1, 1
EQTLN ABS EQTB-EQTND  SIZE OF EQT 
DIRLN ABS DIREC-DIREU 
MXDAA DEF MXDAD 
MXUNA DEF MXDUT 
ELDSA DEF ELDSG     => -#SEG FOR EQT, LOADER & DIREC
* 
* 
ADTBL EQU 32000B    ADT BUFFER
ADTBI DEF ADTBL 
BLNKA DEF BLANK 
CLMFA DEF CLMFL 
DALCA DEF DADLC 
DALNA DEF DADLN 
DCADA DEF DCADT 
DIRCA DEF DIREC 
DKTBA DEF DKTBL     => DISC SELECT CODE TABLE 
DMLTB DEF MLTBL     => SYSTEM SEGMENT TABLE 
DNDTA DEF DNDT
DSYID DEF SYSID 
EMLTB DEF MLTBL+1 
EQTA  DEF EQTB
EQTI  DEF EQTB,I
IDECA DEF IDEC      => IDEC TABLE 
DADTA EQU ADTBI     => ADT BUFFER 
IDTBL EQU ADTBL+8192  ID TABLE BUFFER 
LTP1A DEF LTMP1 
MTRLA DEF MTRLT     BUFFER ADDRESS FOR SEGMENT TABLE
LBUFA DEF LBLBF     LABEL BUFFER ADDRESS
MTRLI DEF MTRLT,I 
MTRND DEF MTRLT+256 
PSEUA DEF DIRBF     => PSEUDO ENTRIES IN DIRECTORY
SYSCD DEC 3000      2000F(OPTION 200/210) TSB    [B]
*                                     SYSTEM LEVEL CODE 
TLENA ABS -TLEN 
TLRTA DEF TLRT      => FIRST TAPE LABEL BUFFER
TLRUA DEF TLRT+TLRN => REEL NUMBER
TRKTC DEF TRKTB 
TLSLA DEF TLRT+TLSL 
* 
TEMP0 BSS 1 
TEMP1 BSS 1 
TEMP2 BSS 1 
TEMP3 BSS 1 
TEMP4 BSS 1 
TEMP5 BSS 1 
ADISC BSS 1 
ADTMP BSS 2 
CNTER BSS 1 
COFLG BSS 1 
EPTR  BSS 1 
FADTC BSS 1         => FIRST ADT ENTRY IN CORE
JDECK BSS 1 
JDECN BSS 1 
      SKP 
MTFLG BSS 1         LOADER MODE FLAG
*                                   -1 SEZ PAPER TAPE LOAD
*                                   0 SEZ SYSTEM UPDATE 
*                                   + SEZ MAG TAPE LOAD 
PTR   BSS 1 
* 
BSDAD DEF BSDA
BSDA  OCT 0,1       ADDRESS OF DISC BOOTSTRAP 
CMLE  DEF MLTBE+2   => EQT DISC ADDRESS IN SST
CMLF  DEF MLTBF+2   => DIREC DISC ADDRESS IN SST
SSTLN ABS MLTBL-MLTBN  SYSTEM SEGMENT TABLE LENGTH
SSTLC DEF MLTBL,I   LOCATION OF SST 
* 
ASR35 DEF TTY35     TTY DRIVER ADRESS 
BUMPA DEF BUMP
CLAMA DEF CLAIM 
DAIRA DEF DAIR
DBSBA DEF DBSUB 
DISCC DEF DISCZ     DISC DRIVER LINKAGE 
DSINA JSB DISCB,I   COMMAND CHANNEL CONTENTS
FNZSA DEF FNZSC 
FSDAC DEF FSDAD 
GETCA DEF GETCR 
GTDNA DEF GTDNO 
ILSIA DEF ILSI                                   [B]
KDSCA DEF KDSC
LDR25 DEF KDS 
LDRWI DEF LDRWE 
MLKUA DEF MLKUN 
MTAPE DEF MTD       MAG TAPE DRIVER ADDRESS 
MTDIA DEF MTDIN     MAG TAPE INITIALIZATION ROUTINE 
MTLNA DEF MTLEN 
NOMSB DEF NOMES 
RCOPA DEF RCOP
RDLBA DEF RDLBL 
RQINA DEF RQINT 
SELCA DEF SELCD 
STDIA DEF STDIS 
WTLBA DEF WTLBL 
* 
BDLA  DEF BDDL
BDLBA DEF BDLBL 
DAIVA DEF DAIV
DIS#A DEF DIS#
DISMA DEF DISMD 
DYWLA DEF DYWLD 
DZMPA DEF DZMBP 
DZMSA DEF DZMS
EOFRA DEF EOFER 
ERLNA DEF ERLN
ILINA DEF ILIN
ILSCA DEF ILSCD 
ILUNA DEF ILUN
LBDOA DEF LBDOS 
LBRYA DEF LBRY
LUMLA DEF LUML
MNBPA DEF MNBPT 
MTSCA DEF MTSC
NDITA DEF NDIT
NIDA  DEF NID 
NXRNA DEF NXRN
RQSTA DEF RQSTD 
SYIDA DEF SYID
TPERA DEF TPERR 
      SPC 3 
* 
*  CHECK FOR PAGE OVERFLOW
* 
      LDA 4000B                                  [B]
      HED MAG TAPE RELOAD 
      ORG 6000B 
* 
KDS   EQU * 
      LDA MTFLA,I   MAG TAPE
      INA,SZA,RSS     RELOAD? 
      JMP KDSC      NO
      LDA COFLF,I 
      SZA,RSS       OPTIONS WANTED
      JMP KDRAA     NO
* 
KDRA  EQU * 
      LDA FD30      GET CHARACTER COUNT 
      LDB LQAAA       AND BUFFER ADDRESS
      JSB ASRDI,I       FOR "ALTERNATE ALLOCATION OPTION?"
      CLA 
      JSB ASRDI,I   WAIT FOR RESPONSE 
      JSB GETCI,I   GET THE FIRST CHARACTER 
      JMP KDRAA     CR, ASSUME NO 
      CPA FASY      CHECK FOR YES 
      JMP KDRAB     YES 
      CPA FASN
      JMP KDRAA     NO
      LDA C.15
      LDB ILINC 
      JSB ASRDI,I   "ILLEGAL INPUT" 
      JMP KDRA      AND ASK AGAIN 
* 
KDRAA CLA,RSS 
KDRAB CCA 
      STA DCBSF,I 
      SPC 3 
* 
*      SECTION TO READ IN THE ID TABLE
* 
* 
*      ROUTINE TO DISTRIBUTE THE ID TABLE ENTRIES 
* EVENLY ACROSS ALL OF THE TRACKS ALLOCATED 
* 
* 
      LDA FM3 
      STA FTMP0     SET COUNT OF TRACKS 
      LDA JDCKF,I 
      SZA,RSS       CHECK FOR 
      JMP KDSCL       NO ID CODE ENTRIES
      CCB 
      ASR 3         MAKE IT INTO ENTRY COUNT
      DIV NIDT      FIND HOW MANY ON EACH TRACK 
      ADA FM1 
      ADB FM1 
      STB FTMP2     B COUNTS # OF LONG ENTRIES
      ASL 3         TURN ENTRY COUNT INTO WORD COUNT
      STA FTMP1     SAVE THE CURRENT A-REGISTER 
      LDB FIDE2     => WORD COUNT WORD
KDSCC EQU * 
      STB FTMP3     SAVE THIS POINTER 
      ADB FM2       CHECK 
      DLD B,I         IF DOUBLE WORD
      IOR B                DISC ADDRESS 
      SZA,RSS                = 0? 
      JMP KDSCD     YES, ALLOTMENT IS ZERO
      LDA FTMP1     RESTORE A-REGISTER
      ISZ FTMP2 
      RSS 
      ADA FD8       HAVE ENOUGH LONG ENTRIES
      STA FTMP3,I   SET THIS TRACK'S WORD COUNT 
      STA FTMP1     SAVE THE CURRENT A REGISTER 
      ADA F8192     CHECK FOR OVERFLOW OF TRACK 
      SSA 
      JMP ITSEF,I   "INSUFFICIENT TABLE SPACE . . ."
KDSCD EQU * 
      LDB FTMP3     GET BACK THE POINTER
      ADB FD4       AND ADVANCE TO THE NEXT ENTRY 
      ISZ FTMP0 
      JMP KDSCC 
* 
      CLA 
      STA FTMP3     SET AMOUNT IN CORE
      LDA FM3 
      STA FTMP0 
      LDA FIDE2     => LENGTHS
      STA FTMP1 
KDSCF EQU * 
      JSB KDSA      GET ENUF OFF OF TAPE
      SZA,RSS       SKIP IF TRACK HAS LENGTH
      JMP KDSCK     DONE IF AN ENTRY IS NULL
      LDA FTMP1 
      ADA FM2       => DISC ADDRESS 
      LDB ADTBA     GET CORE ADDRESS
      JSB DISCL,I 
      LDA ADTBA,I   SET FIRST ENTRY 
      LDB FTMP1       IN IDEC TABLE 
      ADB FM3 
      STA B,I 
      JSB KDSB
KDSCK EQU * 
      LDA FTMP1 
      ADA FD4 
      STA FTMP1       TO THE NEXT IDEC ENTRY
      ISZ FTMP0 
      JMP KDSCF 
      SKP 
* 
*      SECTION TO READ IN THE DIRECTORY 
* 
* 
*      ROUTINE TO DISTRIBUTE DIRECTORY ENTRIES EVENLY 
* ACROSS ALL OF THE ALLOTTED TRACKS 
* 
KDSCL EQU * 
      LDA FM80      GET THE COUNT OF DIR TRACKS 
      STA FTMP0 
      CLA 
      STA FTMP1 
      LDB DIR5F     => DISC ADDRESS IN DIREC
KDSAA EQU * 
      LDA B,I       CHECK FOR 
      INB             NON-EXISTENT
      SZA,RSS           TRACK, I.E. 
      LDA B,I             DOUBLE WORD DISC ADDR = 0 
      SZA           SKIP IF NO TRACK ALLOCATED
      ISZ FTMP1     COUNT EACH ONE ALLOCATED
      ADB FD6       => NEXT DISC ADDRESS
      ISZ FTMP0 
      JMP KDSAA 
* 
      LDA FM80      GET THE NUMBER OF TRACKS
      STA FTMP0 
      LDA JDECF,I   GET THE TOTAL NUMBER OF 
      CCB           DIRECTORY ENTRIES 
      DIV FTMP1     GET THE NUMBER PER TRACK
      ADA FM1       PUT ALL EXTRA ENTRIES AT THE BEGINNING
      ADB FM1 
      STB FTMP2     B COUNTS THE NUMBER OF LONG ENTRIES 
      MPY FD12      TURN ENTRY COUNT INTO WORD COUNT
      STA FTMP1     SAVE CURRENT A-REGISTER 
      LDB DIRCF     => FIRST WORD COUNT 
KDSAC EQU * 
      STB FTMP3     SAVE THIS POINTER 
      ADB FD5       => DISC ADDRESS 
      DLD B,I       GET DOUBLE WORD DISC ADDRESS
      IOR B         CHECK IF ZERO ADDRESS 
      SZA,RSS       SKIP IF GOOD TRACK
      JMP KDSAD     EMPTY TRACK, WC = 0 
      LDA FTMP1     RESTORE A-REGISTER
      ISZ FTMP2     CHECK FOR ALL EXTRA ENTRIES 
      RSS             ACCOUNTED FOR 
      ADA FD12      SHORTEN REMAINING ENTRIES 
      STA FTMP3,I   SET THE WORD COUNT
      STA FTMP1 
      ADA F8192     CHECK FOR TABLE OVERFLOW
      SSA           SKIP IF OKAY
      JMP ITSEF,I   GO PRINT ERROR
KDSAD EQU * 
      LDB FTMP3     GET BACK THE POINTER
      ADB FD7       AND ADVANCE TO THE NEXT ENTRY 
      ISZ FTMP0     CHECK COUNT 
      JMP KDSAC 
* 
      CLA 
      STA FTMP3     SET AMOUNT IN CORE
      LDA FM80      GET THE COUNT OF TRACKS 
      STA FTMP0 
      LDA DIRCF     => DIREC TABLE
KDSAG EQU * 
      STA FTMP1 
      JSB KDSA      READ IN SOME TAPE 
      SZA,RSS       CHECK FOR EMPTY TRACK 
      JMP KDSAK 
      CCB 
      DIV FD12      CONVERT TO -# OF ENTRIES
      STA FTMP2 
* 
      LDB ADTBA     => BUFFER 
KDSAJ EQU * 
      LDA B,I       GET THE ID WORD 
      ADB FD10      => UNUSED WORD
      SZA             AND CHECK FOR THE BEGINNING 
      CPA FM1           OR ENDING PSEUDO-ENTRY
      CLA,RSS       PSEUDO ENTRIES ARE RECOVERED
      CCA           ALL OTHERS ARE NOT RECOVERED
      STA B,I       SET 'MUST BE RECOVERED' BIT 
      ADB FD2       ADVANCE TO THE NEXT ENTRY 
      ISZ FTMP2 
      JMP KDSAJ 
* 
      LDA FTMP1     => DIREC TABLE
      ADA FD5       => DISC ADDRESS 
      LDB ADTBA     GET THE CORE ADDRESS
      JSB DISCL,I   WRITE IT OUT
      LDA FTMP1     => DIREC ENTRY
      INA 
      STA MOVD,I    SET MOVE DESTINATION
      LDA ADTBA 
      STA MOVS,I    SET MOVE SOURCE 
      LDB FM4       COUNT IS FOUR 
      JSB MOVW,I    UPDATE THE DIREC ENTRY
      JSB KDSB      MOVE REMAINDER IN CORE
KDSAK EQU * 
      LDA FTMP1     ADVANCE THE DIREC POINTER 
      ADA FD7 
      ISZ FTMP0     CHECK COUNT 
      JMP KDSAG 
      JMP KDSC
      SKP 
* 
*      TAPE READ ROUTINE FOR IDT AND DIRECTORY RELOAD 
* 
KDSA  NOP 
KDSAF EQU * 
      LDA FTMP3     GET AMOUNT IN CORE
      CMA,INA 
      ADA FTMP1,I   HOW MUCH NEEDED?
      SSA,RSS 
      JMP KDSAH     ENOUGH IN FOR THIS TRACK
      LDA FM1K      = WORD COUNT FOR TAPE READ
      LDB FTMP3     GENERATE
      CMB,INB         ADDRESS FOR 
      ADB ADTBA         PROPER APPEND 
      JSB MTAPF,I 
      OCT 0 
      JMP EOFRF,I 
      JMP TPERF,I 
      ADA FTMP3 
      STA FTMP3     INCREASE AMOUNT IN CORE 
      JMP KDSAF     AND GO BACK FOR CHECK 
* 
*      OKAY, THERE IS ENUF IN CORE, SO RETURN TO WRITE
* OUT THE TRACK 
* 
KDSAH EQU * 
      LDA FTMP1,I   GET THE WORD COUNT
      STA MWORD     SET FOR THE DISC DRIVER 
      JMP KDSA,I    RETURN
* 
* 
KDSB  NOP 
      LDB FTMP1,I   GET THE WORD COUNT
      CMB,INB 
      LDA B 
      ADB FTMP3     UPDATE AMOUNT IN CORE 
      STB FTMP3 
      ADA ADTBA     GENERATE SOURCE ADDRESS 
      STA MOVS,I
      LDA ADTBA     GET DESTINATION 
      STA MOVD,I
      JSB MOVW,I    MOVE REMAINDER BACK 
      JMP KDSB,I
      SKP 
ADTBA DEF ADTBL     ADT BUFFER ADDRESS
DCBSF DEF DCBS      => ALTERNATE ALLOCATION FLAG
DIR5F DEF DIREC+5   => DISC ADDRESS 
DIRCF DEF DIREC 
EOFRF DEF EOFER     UNEXPECTED END OF FILE ERROR
FIDE2 DEF IDEC+3    => WORD COUNT 
ITSEF DEF ITSER     TABLES TOO SMALL
JDECF DEF JDECN 
MOVD  DEF MOVED     MOVE DESTINATION ADDRESS
MOVS  DEF MOVES     MOVE SOURCE ADDRESS 
MOVW  DEF MOVEW     => MOVE ROUTINE 
MTAPF DEF MTD       => MAG TAPE DRIVER
TPERF DEF TPERR     MAG TAPE ERROR
* 
FASN  OCT 116       "N" 
FASY  OCT 131       "Y" 
FM1K  DEC -1024 
FM80  DEC -80 
FM3   DEC -3
FD5   DEC 5 
FD6   DEC 6 
FD8   DEC 8 
FD10  DEC 10
FD12  DEC 12
FD30  DEC 30
F8192 DEC 8192
