      SKP 
DRV#  NOP 
CCCNT NOP CC
SEEEK OCT 30000 
CLDSC NOP 
      LDA .-4 
      STA CCCNT      CLEAR 4 DISC DRIVES
      CLA 
      STA DRV#
CLER1 JSB .STAT 
      ISZ DRV#
      ISZ CCCNT 
      JMP CLER1 
      LDA .-4 
      STA CCCNT 
      CLA 
      STA DRV#
CLER2 EQU * 
      CLA 
      OTA DC
      STC DC,C
      LDA SEEEK 
      IOR DRV#
      CLC CC
      OTA CCCo
      STC CC,C
      SFS DC
      JMP *-1 1
      CLA 
      OTA DC
      STC DC,C
      SFS CC
      JMP *-1 
      JSB .STAT 
      ISZ DRV#
      ISZ CCCNT 
      JMP CLER2 
      JMP CLDSC,I 33
.STAT NOP 
      CLA A*
      IOR DRV#
      STC DC,C
      CLC CCCF
      OTA CC
      STC CC,C
      SFS DC
      JMP *-1 
      LIA DCD
      JMP .STAT,I 
      HED * CONSTANTS, TEMPORARIES, ETC * 
PHI/O EQU 13B 
LM2   DEC -2
LM1   DEC -1
LD72  OCT -72 
L.2   DEC 2 
L.16  DEC 16GG
LB12  OCT 12
L.10  DEC 10
LB15  DEC 13
L.15  DEC 15
L.17  DEC 17
L.18  DEC 18
L.20  DEC 20
D48   DEC 48
LB377 OCT 377 
INF   OCT 77777 
BLANK OCT 40
MAXAD OCT 140100
SYSTA ABS 37700B-SSYST
MAXBA ABS SSYST-2000B 
SSYST EQU 14000B
ADTBF DEF ADTBL    ADT BUFFER ADDRESS 
ASRDA DEF TTY35 
L46A DEF LDR46
ERR5A DEF ERR5
ERR7A DEF ERR7
LABOA DEF LABOR 
LTMP0 BSS 1 
LTMP1 BSS 1 
LTMP2 BSS 1 
LTMP4 BSS 1 
LTMP5 BSS 1 f
LTMP6 BSS 1 n
DEST  BSS 1 1

SOURC BSS 1 
MCNT  BSS 1 
BADDR BSS 1 
BDADA DEF BADAD 
MNBPA DEF MNBPT 
ILINL DEF ILIN
BADAD OCT 5111
      ASC 7,LLEGAL ADDRESS
      OCT 6400
SYMSA OCT 6412
      ASC 6,SYSTEM ID?
LBMSA OCT 6412
      ASC 6,DISC LABEL: 
LBCK4 DEF LBCK5 00
LBCK5 OCT 6412      CR-LF 
      ASC 8,NOT A USER DISC 
PTBF  DEF TBUFR 
PSYST DEF TSSYS 
INCMP DEF INCOM 
SBC1  DEF SUBC1 
PSUB  DEF SUBCK 
CHANL BSS 1 
IPTBF DEF TBUFR,I 
LBCK6 DEF *+1 
      OCT 6412      CR-LF 
      ASC 7,NOT A SYS DISC
BSLD  DEF BSLDR 
BSLDI DEF BSLDR,I 
PLDTK DEF LDRTK 
MD128 DEC -128
P52   DEC 52
DMK   DEC -6144 4V
DM203 DEC -203
OP200 OCT 200 
OP100 OCT 100 
DM256 DEC -256
PWORD DEF WORDC 
TSBL  DEF TSBLA,I 
PLIBR DEF LIBRA 
PDIS  DEF DISCD 
PDNTR DEF DINIT 
BDRA  DEF BADDR 
UPMSP DEF *+1 
      OCT 6412      CR-LF 
      ASC 12,INSERT CARTR IN SUBCH 1
      OCT 6412      CR-LF 
      ASC 11,PRESS 'RUN' WHEN READY 
      OCT 6412      CR-LF 
LBCK7 DEF LBCK8 
LBCK8 OCT 6412      CR-LF 
      ASC 7,DISC STILL UP 
      HED **  UTILITY ROUTINES ** 
* qq
**  BACK SPACE BUFFER POINTER 
* 
XBSP  NOP 
      CCA AF
      ADA BDRA,I
      STA BDRA,I
      JMP XBSP,I
* 
* 
* qq
* qq
**  LOAD SYSTEM START-UP
* 
INIT  NOP 
      LDA DM256 
      STA PWORD,I 
      LDA TSBL,I
      LDB PLIBR,I 
      CCE 
      ELB,RBR 
      JSB PDIS,I
      JMP INIT,I,
* q{
* 
**  CHECK USER DISC FLAG
* qq
FCHEK NOP 
      LDB PTBF,I    GET USER DISC FLAG. 
      SSB,RSS       IF =0, RETURN.
      JMP FCHEK,I   OTHERWISE OUTPUT
      LDA .+16        ERROR MESSAGE.
      LDB LBCK7 
      JSB ASRDA,I 
      JMP INCMP,I 
* 
* *q
      HED ** DLOAD ** 
* 
*  DLOAD,<0 OR 1> 
* 
DLOAD JSB INTGR     GET SUBCHANNEL
      STB CHANL     SAVE IT.
      ADB .-2 
      SSB,RSS       0 OR 1? 
      JMP SBC1,I    NO. OUTPUT MESSAGE. 
      LDB CHANL     YES. CHECK STATUS ON
      JSB PSUB,I      REQUESTED DISC. 
      JSB FSUB      FORM DISC ADDRESS.
      LDB .-5       READ LABEL ON REQUESTED DISC. 
      STB PWORD,I I?
      LDB IPTBF 
      JSB PDIS,I
      JSB LBLCK     CHECK LABEL FOR SYSTEM DISC.
* 
      LDB CHANL     SUBCH. 0 OR 1?
      SZB,RSS 
      JMP DLOD1     SUBCH. 0. START UP. 
* 
      LDB DMK       SUBCH#1. INITIALIZE DISC. 
      STB PWORD,I   SET WORD COUNT. 
      LDB DM203     SET TRACK COUNT.
      STB LTEMP 
      CLA           SET FOR TRACK 0.
      JMP *+3 
DDLD  LDA LTEMP+1   COMPUTE TRACK NR. 
      ADA OP200       AND 
      STA LTEMP+1       SAVE IT.
      LDB PTBF      INITIALIZE TRACK. 
      IOR OP100 
      JSB PDNTR,I I]
      NOP           NORMAL RETURN.
      ISZ LTEMP     ERROR RETURN. DONE? 
      JMP DDLD      NO. 
      LDB DMK       YES. DUMP SYSTEM TO SUBCH#0.
      STB PWORD,I   SET TO TRANSFER 6144 WORDS. 
      LDB DM203     SET TO TRANSFER 203 TRACKS. 
      STB LTEMP 
      CLA           SET TRACK POINTER TO TRACK 0. 
      JMP *+3 
DLOOP LDA LTEMP+1   COMPUTE TRACK NUMBER
      ADA OP200       AND 
      STA LTEMP+1       SAVE IT.
      LDB IPTBF     READ TRACK FROM 
      JSB PDIS,I      SUBCH.1 
      LDA LTEMP+1   SET DISC ADDRESS TO 
      IOR OP100       SUBCH.0 
      LDB PTBF      WRITE TRACK TO
      JSB PDIS,I      SUBCH.0 
      ISZ LTEMP     DONE? 
      JMP DLOOP     NO. 
      LDA P52       YES. DISC DUMP COMPLETE.
      LDB UPMSP     OUTPUT
      JSB ASRDA,I     MESSAGE.
      CLF 0 00
      HLT 33B 
* 
      JSB CLDSC     CLEAR ALL DISCS.
DLOD1 LDA PLDTK,I   IS LOADER TRACK ADDRESS 
      SZA             GENERATED?
      JMP BSLD,I     YES. START UP. 
      LDA MD128     NO. LOAD PART OF SYSTEM LOADER
      STA PWORD,I     FROM SUB 0, TRACK 0, SECTOR 1 
      CLA,INA           TO GET DISC ADDRESSES.
      ADA OP100 
      LDB BSLDI I
      JSB PDIS,I
      JMP BSLD,I    START UP. 
* qq
* *q
* 
*  CHECK LABEL FOR SYSTEM DISC. 
* 
LBLCK NOP Pk
      LDB PTBF      SET POINTERS. 
      INB BE
      LDA PSYST 
      STA LTEMP 
      LDA .-4       SET COUNTER.
      STA LTEMP+1 
LBLC1 LDA B,I       LOAD NEXT WORD. 
      CPA LTEMP,I   CHECK IF SYSTEM DISC. 
      RSS 
      JMP LBLC2     NO. OUTPUT ERROR MESSAGE. 
      INB           YES.
      ISZ LTEMP 
      ISZ LTEMP+1   DONE? 
      JMP LBLC1     NO. 
      JMP LBLCK,I   YES.
LBLC2 LDA .+16      OUTPUT "NOT A SYS DISC" 
      LDB LBCK6       MESSAGE.
      JSB ASRDA,I 
      JMP INCMP,I 
* 
* qq
      HED *  CONSTANTS, TEMPORARIES, ETC *
      SKP 
.     EQU 526B     THIS MUST BE IN THE SAME POSITION
*                                  AS THE SYSTEM DOT TABLE
      SPC 2 
      ORG .-29
      DEC -29,-28,-27,-26,-25,-24,-23,-22,-21 
      DEC -20,-19,-18,-17,-16,-15,-14,-13,-12,-11 
      DEC -10,-9,-8,-7,-6,-5,-4,-3,-2,-1
      DEC 0,1,2,3,4,5,6,7,8,9,10
      DEC 11,12,13,14,15,16,17,18,19,20 
      DEC 21,22,23,24,25,26,27,28,29,30 
      DEC 31,32,33,34,35,36,37,38,39,40 
      DEC 41,42,43,44,45,46,47,48,49,50 
M16   EQU .-16
M10   EQU .-101Q
M4    EQU .-4 
M2    EQU .-2 
.2    EQU .+2 
.4    EQU .+4 
.7    EQU .+7 
.8    EQU .+8 
.12   EQU .+12
.13   EQU .+13
.15   EQU .+15
.17   EQU .+17
.20   EQU .+20
.24   EQU .+24
.26   EQU .+26
COMMA EQU .+54B 
DB7   EQU .+7 
DB15  EQU .+15B 
DB23  EQU .+23B 
DB31  EQU .+31B 
DB41  EQU .+41B 
DM5   EQU .-5 
DM3   EQU .-3 
      HED  COPY ROUTINE 
      ORG 10000B
* qqq{
*     COPY,<SUB>,<SUB>
* 
*         COPY FROM FIRST SUBCHANNEL TO SECOND
* 
COPY  JSB INTGI,I   GET FIRST SUBCHANNEL
      JSB SUBCK     VALID SUBCHANNEL? 
      STB SUB1      SAVE IT 
      JSB FSUBB,I   FORM BASIC DISC ADDRESS 
      STA DISC1     SAVE IT.
      JSB XBKSP,I 
      JSB GETCH,I   GET NEXT CHARACTER
      JMP CERRA,I   ALL OUT, ERROR
      CPA COMMA     COMMA?
      RSS           YES 
      JMP *-4       NO
      JSB INTGI,I   GET SECOND SUBCHANNEL 
      JSB SUBCK     VALID?
      STB SUB2      SAVE IT 
      JSB FSUBB,I IL
      STA DISC2     SAVE IT 
* qq
*     CHECK DISC STATUS 
* 
* 
      LDA DISC1     SET WORKING DISC ADDRESSES
      STA DAD1        FOR SOURCE
      LDA DISC2 
      STA DAD2        FOR DEST. 
      LDA X203      SET TRACK COUNT 
      STA TCNTA,I 
      LDA X6144 
      STA WORDA,I 
COPY1 LDA DAD1      READ
      LDB TBFI        SOURCE
      JSB DISCL,I       DISC
      LDA DAD2      WRITE 
      LDB TBUFA         DESTINATION 
      JSB DISCL,I 
      LDA DAD1      GO
      ADA XB200       TO
      STA DAD1          NEXT
      LDA DAD2            TRACK 
      ADA XB200 
      STA DAD2
      ISZ TCNTA,I   DONE? ?
      JMP COPY1     NO
* 
      LDA .+18
      LDB COPMS     "COPY COMPLETE" 
      JSB T35DR,I 
      JMP INCMA,I 
* *q
* qq
      HED ** SELECTIVE LOAD **
* 
*     SLOAD,<SUB>,<TAPE SC>,<FILE #>
* *q
SLOAD JSB SLDP
* qq
      JSB GETCH,I   GET NEXT CHAR.
      JMP CERRA,I   NONE FOUND. 
      CPA COMMA     COMMA?
      RSS           FOUND COMMA 
      JMP SCHK1     NO - ERROR
      JSB INTGI,I   GET FILE
      CPB INF1      FILE # OK?
      JMP CERRA,I   NO
*     SPACE OVER INDICATED # OF FILES (N-1) 
* *q
      LDA B 
      SZA           IF FILE NR=0 OR 
      CPA .+1       =1 THEN 
      JMP SL1       NO SPACING. 
      ADA .-1       DECREMENT FILE NR.
      CLB 
      JSB MGTPA,I   SPACE TO CORRECT FILE 
      OCT 4 
      JMP EFA,I 
      JMP TPE,I 
* qq
SL1   CLA,INA      SET SELECTIVE FLAG 
      STA SFLGA,I 
      LDB .-5 		
      STB WORDA,I 
      SZA,RSS       SELECTIVE LOAD? 
      JMP SL6       NO. 
      LDA DISC1     YES. READ DISC LABEL. 
      LDB TBFI
      JSB DISCL,I 
      JSB FCKP,I    CHECK USER DISC FLAG. 
SL6   LDA .-5       READ LABEL FROM TAPE. 
      LDB TRTBA 
      JSB MREAD 
      LDA DISC1 
      LDB TRTBA 
      JSB DISCL,I 
      LDA .-3 
      LDB TRTBA       LENGTHS 
      JSB MREAD 
      LDA .-3 
      STA WORDA,I 
      LDA DISC1       OUTPUT LENGTHS TO DISC
      INA 
      LDB TRTBA AH
      JSB DISCL,I 
      DLD TRTB1,I   LOAD DIRECTORY LENGTHS
      DST DL1 
* 
      LDA TRTBL     READ
      STA WORDA,I IN
      STA ADTTA,I 
      LDB TBUFA 
      JSB MREAD 
      LDA DISC1     OUTPUT
      ADA .+2         ADT 
      LDB TBUFA         TO
      JSB DISCL,I 
* 
      DLD TRTBL+1   SAVE
      DST D1L         DIRECTORY LENGTHS 
      LDA D203      INPUT 
      LDB TRTBA 
      STB LTEMP 
      JSB MREAD Dn
* qq
      LDA D203          SCAN
      STA TCNTA,I       TABLE 
      LDA DISC1 
      STA DISC2 
* qq
SL4   LDA LTEMP,I   LOAD LENGTH 
      SZA,RSS       ZERO? 
      JMP SL2         YES 
      ASL 7           # OF WORDS
      STA LTEMP+1 
      ADA X3072     LONGER THAN 3072? 
      SZA,RSS 
      JMP SL3 
      SSA 
      JMP SL3 99
      LDA X3072     INPUT 
      STA WORDA,I 
      LDB TBUFA     FIRST 
      JSB MREAD         TRACK 
      LDA DISC2         DISC
      LDB TBUFA 
      JSB DISCL,I 
      LDA LTEMP+1   INPUT 
      ADA X3072      TRACK
      CMA,INA         2ND 
      STA WORDA,I 
      LDB TBUFA       PART
      JSB MREAD           TRACK 
      LDA DISC2     DUMP
      ADA .+24        TO
      LDB TBUFA 
      JSB DISCL,I 
      JMP SL2 
SL3   LDA LTEMP+1   READ
      CMA,INA           FROM
      STA WORDA,I   MAG 
      LDB TBUFA       TAPE
      JSB MREAD 
* 
      LDA DISC2     DUMP
      LDB TBUFA 
      JSB DISCL,I 
* 
SL2   LDA DISC2     GO TO 
      ADA XB200     NEXT
      STA DISC2         TRACK 
      ISZ LTEMP 
      ISZ TCNTA,I 
      JMP SL4 
* *q
*     NOW READ DIRECTORIES
* 
      LDA DL1       LOAD
      STA WORDA,I 
      LDB TBUFA       FIRST 
      JSB MREAD     DIRECTORY TRACK 
      LDA DISC1     DUMP
      ADA XB200 
      LDB TBUFA 
      JSB DISCL,I 
* 
      LDA DL2       CHECK 2ND TRACK 
      SZA,RSS         IF ZERO 
      JMP SL5           IT'S NOT THERE
      STA WORDA,I 
      LDB TBUFA 
      JSB MREAD Dn
      LDA DISC1     DUMP
      ADA XB400 
      LDB TBUFA       TO DISC 
      JSB DISCL,I 
SL5   EQU * 
      LDA SFLGA,I   IS IT SELECTIVE?
      SZA,RSS 
      JMP LD53A,I     NO - IT'S FROM LOADER 
* 
      JSB MGTPA,I     REWIND
      OCT 3 
      JMP INCMA,I 
      HED ** SELECTIVE DUMP **
* 
*     SDUMP,<SUB>,<SC>,<FILE> 
* 
SDUMP JSB SLDP
      LDA SUB1
      SZA,RSS       CANNOT SELECTIVELY DUMP SYSTEM
      JMP SUBC1     OUTPUT "INVALID SUBCH.".
      JSB GETCH,I   SEARCH FOR FILE # 
      JMP CERRA,I   NONE FOUND. 
      CPA COMMA     COMMA?
      RSS           YES 
      JMP SCHK1     NO - ERROR
      JSB INTGI,I   GET FILE
      CPB INF1      FILE # OK?
      JMP CERRA,I   NO
* qq
*     SPACE OVER N-1 FILES
      LDA B 
      SZA           IF FILE NR=0 OR 
      CPA .+1         =1, THEN
      JMP SD3           NO SPACING. 
      ADA .-1       DECREMENT FILE NR.
      CLB 
      JSB MGTPA,I   SPACE TO CORRECT FILE 
      OCT 4 
      JMP EFA,I Il
      JMP TPE,I 
* 
*     NOW DUMP DISC 
* 
SD3   EQU * 
      CLA,INA       SET 
      STA SFLGA,I     FOR SELECTIVE 
      LDA .-5 
      STA WORDA,I   OUTPUT ID AND LABEL TO TAPE 
      LDA DISC1 
      LDB TBFI
      JSB DISCL,I 
      JSB PLABC,I   CHECK LABEL.
      LDA .-5 5\
      LDB TBUFA Ak
      JSB MWRIT 
      LDA .-3       INPUT 
      STA WORDA,I     ADT LENGTH AND
      LDA DISC1       DIREC TRACK 
      INA               LENGTHS 
      LDB TBFI
      JSB DISCL,I 
      LDA .-3 
      LDB TBUFA Ak
      JSB MWRIT 
      LDA SFLGA,I   SELECTIVE 
      SZA,RSS 
      JMP SD31
      LDA SUB1      COMPUTE 
      MPY .+14        DIRECTORY 
      ADA XB100     LOCATION
      STA DRPA,I
      LDA TBUFA       SET LENGTH
      INA 
      LDA 0,I 
      LDB DRPA,I      FOR FIRST 
      STA 1,I           DIRECTORY TRACK 
      LDA DISC1     SET DISC
      ADA XB200       ADDRESS 
      LDB DRPA,I      FOR FIRST DIRECTORY 
      ADB .+6             TRACK 
      STA 1,I 
      INB           LENGTH & ADDRESS
      LDA TBUFA     OF SECOND 
      ADA .+2 
      LDA 0,I 
      STA 1,I           TRACK 
      LDA DISC1 
      ADA XB400 
      ADB .+6 
      STA 1,I 
* 
SD31  EQU * 
      LDA TBUFA,I   INPUT ADT.
      STA WORDA,I 
      LDA DISC1 
      ADA .+2 
      LDB TBFI
      JSB DISCL,I 
* *q
      LDA TBUFA     SET 
      STA LTEMP+1     ADT 
      LDA WORDA,I     POINTERS
      CMA,INA 
      ADA LTEMP+1 
      STA LTEMP 
      LDA DISC1 18
      STA DSCA,I
      JMP SD2       GO TI SLEEP 
* 
      HED ** FORMAT DISC ** 
* 
*     FORMAT,<SUBCHAN>
* 
FORMA JSB INTGI,I   GET SUBCHANNEL
      JSB SUBCK     VALID?
      SZB,RSS       IF SUBCHAN=0 THEN INVALID 
      JMP SUBC1       SUBCHANNEL ZERO INVALID 
      STB SUB1B:
      JSB FSUBB,I   FORM DISC ADDRESS 
      STA DISC1 
* 
      CLA 
      STA BAD       CLEAR BAD TRACKS COUNT
      STA ADLEN     ADT LENGTH = 0
      LDA ADTT      INITIALIZE ADT TABLE POINTER
      STA ADTP
      LDA D203      SET TRACK COUNTER 
      STA TCNTA,I 
      LDA DISC1     SAVE DISC ADDRESS 
      STA DAD1
      LDA X6144 
      STA WORDA,I 
FORM1 LDA DAD1      LOAD DISC ADDRESS 
      LDB TBUFA 
      JSB DINIT     GO TO INITIALIZE
      JMP .ADT. 
*     BAD TRACK 
      LDA TCNTA,I 
      ADA D200]]]O
      SSA Au
      JMP DISBD     DISC IS BAD - DONT USE IT 
      ISZ BAD       ADD 1 TO BAD TRACK COUNT
FORM2 LDA DAD1      GO TO NEXT TRACK
      ADA XB200 
      STA DAD1
      ISZ TCNTA,I I.
      JMP FORM1     NO
      JMP FORM3     YES - LABEL DISC
* 
*     TRACK IS OK SO SET ADT ENTRY
* 
.ADT. LDA TCNTA,I 
      ADA D200        THEN NO ADT ENTRY 
      SSA 
      JMP FORM2 
      LDA DAD1      -- OK - FORM ENTRY
      LDB XD48      OF 48 SECTORS 
      DST ADTP,I    SAVE ENTRY
      ISZ ADTP
      ISZ ADTP
      LDA ADLEN       COUNT WORDS IN ADLENGTH 
      ADA .-2 
      STA ADLEN 
      JMP FORM2 
* qq
FORM3 LDA DAD1      DUMMY 
      CLB             END 
      DST ADTP,I          ENTRY 
      LDA ADLEN 
      ADA .-2 
      STA ADLEN 
      STA WORDA,I 
      LDA DISC1         TO
      ADA .+2            THE
      LDB ADTT              DISC
      JSB DISCL,I 
* 
*     OUTPUT DIRECTORY
* qq
      LDA .-16      OUTPUT
      STA WORDA,I 
      LDA DISC1         ENTRY 
      ADA XB200 
      LDB PSEUD             DIRECTORY 
      JSB DISCL,I 
* 
      LDA ADLEN     OUTPUT
      STA TRBLA,I     LENGTH
      LDA .-16          TABLE 
      STA TRTB1,I       TO
      CLA                   DISC
      STA TRTB2,I 
      LDA .-3 
      STA WORDA,I 
      LDA DISC1 18
      INA 
      LDB TRTBA 
      JSB DISCL,I 
* 
FORM4 EQU * 
      LDA .+14      ASK FOR 
      LDB SYMSF       SYSTEM ID?
      JSB T35DR,I I
      CLA **
     JSB T35DR,I,
      JSB INTGI,I   GET INTEGER 
      CPB INF1      IS THERE ONE? 
      JMP FORM4 
      STB SYSLI     YES 
FORM5 LDA .+14
      LDB LBMES     "DISC LABEL: "
      JSB T35DR,I 
      CLA A*
      JSB T35DR,I 
* qq
      LDB INBFR     CHECK IF LABEL="SYSTEM" 
      LDA SYSTP 
      STA LTEMP 
      LDA .-3 3a
      STA LTEMP+1 
FORM6 LDA B,I 
      CPA LTEMP,I 
      RSS 
      JMP FORM7 
      INB 
      ISZ LTEMP 
      ISZ LTEMP+1 
      JMP FORM6 
      JMP FORM5 
* qq
FORM7 LDA INBFR     MOVE
      STA MOVES       LABEL 
      LDA LBBUF         TO
      ADA .+2                LABEL
      STA MOVED             BUFFER
      LDB .-3 
      JSB MOVEW 
      LDA DISC1 
      LDB .-5       OUTPUT LABEL TO TRACK 0 SECTOR 0
      STB WORDA,I 
      LDB LBBUF 
      JSB DISCL,I 
* 
*     OUTPUT # OF BAD TRACKS
* 
      LDA BAD       OUTPUT
      LDB BADMS       # 
      JSB NMOTP,I 
* 
      LDA .+22
      LDB BDMSA       MESSAGE 
      JSB T35DR,I 
* 
      JMP INCMA,I 
BDMSA DEF *+1 
      OCT 6412
      ASC  9,# OF BAD TRACKS =
      BSS 1 
BADMS DEF *-1 1@
* 
**  TRACK 0,1,2 IS BAD DISC CANNOT BE USED
* qq
DISBD LDA D44       OUTPUT BAD
      LDB DBADA       DISC
      JSB T35DR,I       MESSAGE 
      JMP INCMA,I 
D44   DEC 44
DBADA DEF DDBAD 
SYSTP DEF TSSYS+1 
* *q
** PSEUDO ENTRY FOR DISC DIRECTORY
*
PSEUD DEF DIRBF 
      HED * SUBROUTINES * *S
* qq
*     SELECTIVE LOAD AND DUMP 
*     PREPARATION 
* 
SLDP  NOP 
      JSB INTGI,I   GET SUBCHANNEL
      JSB SUBCK       VALID?
      STB SUB1
      JSB FSUBB,I   FORM DISC ADDRESS 
      STA DISC1     SAVE IT 
      JSB XBKSP,I Iu
      JSB GETCH,I 
      JMP CERRA,I 
      CPA COMMA     COMMA?
      RSS           YES 
      JMP SUBC1     NOPE - ERROR
      JSB INTCK     GET SC
      STA 1 
      JSB SCHEK 
      JSB CONMG,I 
      JSB MGTPA,I 
      OCT 3         REWIND TAPE 
* *q
      JMP SLDP,I
* 
* 
*     SUBROUTINE TO CONVERT CHAR STRING TO NUMBER 
* 
INTCK NOP 
      CLA           INITIALIZE TOTAL
      STA NUM 
INT2  EQU * 
      JSB GETCH,I   LOAD CHARACTER
      JMP INT1       NO CHARS 
      ADA M70B      SUBTRACT OCT 70 (ASC 8) 
      SSA,RSS 
      JMP INT1      NOT OCTAL 
      ADA .+10B     ADD 10B (I.E. 8)
      SSA 
      JMP INT1      NON- NUMERIC
* *q
*     DIG IT IN A Am
* 
      LDB NUM 
      BLS,BLS      MULTIPLY 
      BLS             BY 8
      ADB 0         ADD NEW DIGIT 
      STB NUM       SAVE NEW TOTAL
      JMP INT2        CONTINUE
INT1  JSB XBKSP,I      BACK UP ONE CHARACTER
      LDA NUM      LOAD NUMBER
      JMP INTCK,I      RETURN 
* 
*     CHECK NUMBER FOR VALID SUBCHANNEL 
* 
SUBCK NOP P
      STB 0      SAVE # IN A
      ADA .-4 
      SSA         VALID?
      JMP SUBC2 
* 
*     INVALID SUBCHANNEL
* 
SUBC1 EQU * 
      LDA .+20      "INVALID SUBCHANNEL". 
      LDB INVLA 
      JSB T35DR,I 
      JMP INCMA,I   RE-INPUT COMMAND
SUBC2 STB LTEMP 
      CLA,INA 
      RBR,SLB       CHECK STATUS ON REQUESTED DISC
      RSS 
      CLA 
      STA DDRVA,I 
      JSB DDSTA,I 
      LDB LTEMP 
      JMP SUBCK,I ??
DDRVA DEF SDRIV 
DDSTA DEF DISST 
* 
*     CHECK FOR VALID SELECT CODE 
* 
SCHEK NOP 
      STA 1         SAVE IT IN B
      ADB .-10B     SUBTRACT 10B
      SSB 
      JMP SCHK1     ERROR - TOO SMALL 
      ADB M67B      SUBTRACT 67B
      SSB,RSS 
      JMP SCHK1     ERROR - TOO LARGE 
      JMP SCHEK,I   OK - RETURN 
* 
SCHK1 LDA .+22
      LDB SCERA     "INVALID SELECT CODE" 
      JSB T35DR,I I
      JMP INCMA,I   RE-INPUT COMMAND
* 
SCERR NOP           MAG. TAPE S.C. IS INVALID.
SCR1  LDA .+2227
      LDB SCERA 
      JSB T35DR,I 
      LDA .+22
      LDB SCERM     "RE-INPUT SELECT CODE 
      JSB T35DR,I 
      CLA 
      JSB T35DR,I 
      JSB INTCK     CONVERT SC
      STA 1 
      ADB .-10B       VALID?
      SSB 
      JMP SCR1
      ADB M67B
      SSB,RSS 
      JMP SCR1
      JMP SCERR,I   OK- RETURN
LBBUF DEF SYSLI     LABEL 
SYSLI NOP             BUFFER
LABEL ASC 1,TS
      BSS 3 
      SKP 
      SKP 
*     MAG TAPE SLEEP
* qq
* 
SLEEP EQU * 
      CLF 0 
      LDA .+14
      LDB MAGTP     "SELECT CODE?"
      JSB T35DR,I 
      CLA 
      JSB T35DR,I 
      JSB OCTIN,I   CHECK FOR OCTAL INTEGER 
      STA 1 
      ADB .-10B     IS SELECT CODE VALID? 
      SSB 
      JSB SCERR     NO. 
      ADB M67B
      SSB,RSS 
      JSB SCERR     NO. 
* 
*     SELECT CODE IS OK 
* qq
      JSB CONMG,I   CONFIGURE MAG TAPE DRIVER 
* 
*     MAG TAPE IS READY 
* qq
      JSB MGTPA,I 
      OCT 3         REWIND TAPE 
* 
*     DUMP TO MAG TAPE
* 
      CLA 
      STA SFLGA,I   CLEAR SELECTIVE FLAG
* 
*     DUMP EQUIPMENT TABLE TO TAPE
* *q
      LDA .-5       OUTPUT ID AND LABEL TO TAPE 
      STA WORDA,I 
      LDA XB100 
      LDB TBFI      INPUT FROM DISC 
      JSB DISCL,I 
      LDA .-5 
      LDB TBUFA Ak
      JSB MWRIT 
      LDA XB111     LENGTH
      LDB XB100     ADDRESS 
      JSB MWRIT 
* 
      LDA IDTTA     SET UP TO DUMP
      STA IDTRA       ID TRACKS 
      LDA IDTRL 
      STA IDTLA 
      LDA .-4       FOUR TRACKS 
      STA TCNTA,I I
MSLP2 LDA IDTRL,I   GET 
      SZA,RSS 
      JMP MSLP1     ZERO => EMPTY 
      STA WORDA,I   READ
      LDA IDTRA,I     ID
      LDB TBFI            TRACK 
      JSB DISCL,I 
      LDA WORDA,I   OUTPUTU{
      LDB TBUFA       IT
      JSB MWRIT 
MSLP1 ISZ IDTRL     NEXT
      ISZ IDTRA       TRACK 
      ISZ TCNTA,I      DONE?
      JMP MSLP2     NO
* qq
*     NOW PREPARE LIBRARY 
*     FOR SYSTEM DISC 
* 
      LDA ADLEN     INPUT 
      STA WORDA,I   ADT 
      LDA ADLOC CU
      LDB TBFI
      JSB DISCL,I 
* 
      LDB TBUFA 
      STB LTEMP 
      LDB X203
      STB TCNTA,I 
      LDB TRTBA     CLEAR 
      LDA .+48        TRACK 
MSLP3 STA 1,I           TABLE 
      INB 
      ISZ TCNTA,I I.
      JMP MSLP3 
* 
MSLP6 LDA LTEMP,I   LOAD ADT ENTRY
      AND XDMSK 
      CPA XB100 
      RSS           YES 
      JMP MSLP4 
      LDA LTEMP,I 
      CLB 
      LSR 7         GET TRACK # 
      ADA TRTBA     COMPUTE 
      ISZ LTEMP       IN TRACK TABLE
      LDB LTEMP,I   LOAD LENGTH OF TRACK
      SZB,RSS       IF ZERO - IGNORE
      JMP MSLP5-1 
      CMB,INB 
      ADB .+48
      STB 0,I       STORE IN TRACK TABLE
MSLP5 ISZ LTEMP 
      JMP MSLP6     BACK FOR MORE 
* 
* 
MSLP4 LDB XB100     CLEAR 
      ADB .+13        TRACK 
      LDA 1,I           TABLE 
      CLB                 UP
      LSR 7                 TO
      ADA TRTBA               LAST
      STA LTEMP                 DIRECTORY 
      LDB TRBLA                   TRACK 
      CLA A*
MSP13 EQU * 
      STA 1,I 
      CPB LTEMP 
      JMP MSP14 
      INB 
      JMP MSP13 
MSP14 LDA X203
      LDB TRTBA AH
      JSB MWRIT 
* 
*     NOW START DUMPING 
*     THE TRACKSKr
* 
      LDA XB100 
      STA DSCA,I    INITIALIZE DISC ADDRESS 
      JSB DLIB      DUMP THE LIBRARY
      LDA XB100     SET DIRECTORY 
      STA DRPA,I
      JSB DDRC      DUMP DIRECTORY
* 
