* 
***   INITIALIZE USER SWAP AREAS
* 
* qq
*     FOR EACH USER PORT, INITIALIZE THE SWAPPING PORTION OF
*     THE LANGUAGE PROCESSOR, WRITE IT TO THE APPROPRIATE 
*     SWAP TRACK
* 
      LDA M16      SET FOR
      STA TEMP0    16 USERS 
      LDA TTYDA    FOR DISC ADDRESS 
      STA TEMP1    IN TTY00 
      LDA USTRA    POINTER TO 
      STA TEMP2    FIRST USER TRACK ADDRESS 
      CLA          INCREMENT FROM TTY00 
      STA TEMP3    TO CURRENT TTY TABLE 
LDR71 LDA SWPIA     SWAP AREA QUANTITIES
      LDB ?MASK    LOAD 
      ADB TEMP3    USER 
      LDB 1,I      BIT MASK 
      STB 0,I      RECORD IT
      INA 
      CMB          RECORD 
      STB 0,I      COMPLEMENT 
      INA          USER BIT MASK
      LDB ?BHED    RECORD ADDRESS OF
      ADB TEMP3     CHARACTER ADDRESS 
      STB 0,I        OF LOGICAL BUFFER
      INA 
      LDB ?BSTR    RECORD ADDRESS OF
      ADB TEMP3     LAST CHARACTER
      STB 0,I        OF LOGICAL BUFFER
      INA 
      LDB ?BGIN    RECORD ADDRESS OF
      ADB TEMP3     CHARACTER ADDRESS 
      STB 0,I        OF PHYSICAL BUFFER 
      INA 
      LDB ?BEND    RECORD ADDRESS OF ADDRESS
      ADB TEMP3     LAST CHARACTER+1
      STB 0,I        OF PHYSICAL BUFFER 
      INA 
      LDB ?ID      LOAD ADDRESS OF
      ADB TEMP3    ID/NAME
      STB 0,I      RECORD IT
      LDB TEMP3    UPDATE 
      ADB INCRE    TOTAL
      STB TEMP3    INCREMENT
      LDA TEMP2,I  RECORD 
      ISZ TEMP2    DISC ADDRESS 
      STA TEMP1,I  IN TTY TABLE 
* 
      LDB TEMP1    UPDATE TTY TABLE 
      ADB INCRE    POINTER
      STB TEMP1    DISC ADDRESS 
      LDB SWPLN    WRITE
      STB WORD,I   SWAP 
      LDB SWPAA    AREA 
      SZA          TO 
      JSB DISC,I   DISC 
      ISZ TEMP0    ALL DONE?
      JMP LDR71     NO
      LDA MSLEP     SET MAG TAPE SLEEP ADDRESS
      STA MGSLE,I 
      LDA MAINP     SET STARTING ADDRESS
      STA PMAIN,I     OF UTILITY. 
* 
***   WRITE SYSTEM TO DISC
* 
*     DUMP THE CORE-RESIDENT TSB SYSTEM TO THE DISC FOR 
*     POTENTIAL BOOTSTRAP LOADING.
* 
* 
      LDB M6144     WRITE LOADER
      STB WORD,I   TO 
      LDA TRKTA      DISC 
      STA TEMP1 
      LDA TEMP1,I 
      LDB RSY00,I 
      ADB BIT15 
      JSB DISC,I
* 
      LDA BSYA1,I  WRITE
      STA WORD,I   BASIC
      LDB RSYA1,I  SEGMENT # 1
      ADB BIT15 
      ISZ TEMP1 
      LDA TEMP1,I 
      JSB DISC,I
* 
      LDA BSYA2,I  WRITE
      STA WORD,I   BASIC
      ISZ TEMP1 
      LDA TEMP1,I 
      LDB RSYA2,I  TO DISC
      ADB BIT15 
      JSB DISC,I
* 
* 
***   GET DATE AND TIME 
* 
* 
*     THE DISC RESIDENT TSB BOOTSTRAP LOADER TRANSFERS HERE 
*     AFTER LOADING TSB FROM THE DISC.  THIS SECTION REQUESTS 
*     THE DATE AND TIME OF DAY FOR THE INTERNAL CLOCKING
*     ROUTINES. 
* 
LDR72 LDA .8        PRINT 
      LDB DATEA 
      JSB ASR35,I  'DATE?'
      CLA          GET
      JSB ASR35,I  RESPONSE 
      JSB INTGA,I  GET DAY OF YEAR
      STA TEMP0    SAVE FOLLOWING CHARACTER 
      SZB,RSS      NON-ZERO?
      JMP ERR6     NO 
      LDA 1        YES
      ADB MXDAY 
      SSB,RSS      <367?
      JMP ERR6     NO 
      CLB          YES
      MPY .24      CONVERT
      STA DATE,I   TO HOURS 
      LDA TEMP0    '/'
      CPA SLSH     NEXT?
      JMP LDR60    YES
ERR6  LDA .15      NO, PRINT
      LDB ILDTA    'ILLEGAL 
      JSB ASR35,I  DATE'
      JMP LDR72 2
LDR60 JSB INTGA,I  GET YEAR 
      CPA B15      MORE CHARACTERS? 
      RSS          NO 
      JMP ERR6     YES
      STB YEAR,I   RECORD YEAR
      ADB MAXYR 
      SSB,RSS      <100?
      JMP ERR6     NO 
LDR61 LDA .8       YES
      LDB TIMEA    REQUEST
      JSB ASR35,I  TIME OF DAY
      CLA          GET
      JSB ASR35,I  RESPONSE 
      JSB TWODA,I  GET TWO-DIGIT
      DEC -24      INTEGER<24 
      STB TEMP0    SAVE IT
      JSB TWODA,I  GET TWO-DIGIT
      DEC -60      INTEGER<60 
      LDA 1        CONVERT
      CLB          TO TENTHS
      MPY .600     OF SECONDS R 
      LDB COM6     SET
      STB SLDIR    TABLE POINTER
      LDA LIBRA    SET POINTER TO 
      STA TEMP4    ADDRESS TABLE
SYSL1 LDA TEMP4,I  COPY 
      STA 1,I      LENGTH 
      ISZ TEMP4    TABLE
      INB          INTO 
      ISZ SYSLF    ADDRESS
      JMP SYSL1    TABLE
      LDA TRKTA 
      ADA .+3 
      LDA 0,I 
      STA SYST1    * SET
      JSB ISOTA,I  * DISC 
      STA SYSS1    *
      LDA TRKTA     * ADDRESSES 
      ADA .+4       * 
      LDA 0,I       * 
      STA SYST2    * OF SYSTEM
      JSB ISOTA,I  * LIBRARY
      STA SYSS2    * TRACKS 
* qq
SYSL2 LDB M256     SET WORD COUNT 
      STB WORD,I   FOR DISC TRANSFER
      LDB SLDIR,I  COMPUTE # OF 
      ASR 7        SECTORS NEEDED 
      LDA M2       ROOM ON
      ADA SYSS1    FIRST
      SSA          TRACK? 
      JMP SYSL5    NO 
      LDA 1        YES, UPDATE
      ADA SYSS1    REMAINING
      STA SYSS1    SECTOR COUNT 
      LDA SYST1    LOAD DISC ADDRESS
      CMB,INB      SAVE 
      ADB SYST1    DISC ADDRESS OF
      STB SYST1    REMAINING SPACE
SYSL4 STA SLDIR,I  SAVE DISC ADDRESS
      ISZ SLDIR    IN LOADER TABLE
* 
      LDB LIBRA    WRITE PROGRAM
      JSB DISC,I   TO DISC
      LDA LIBRA 
      JMP SYSLB,I 
* 
SYSL5 LDA M2       HANDLE 
      ADA SYSS2 
      SSA          SECOND 
      JMP SYSL8 
      LDA 1        TRACK
      ADA SYSS2 
      STA SYSS2 
      LDA SYST2 
      CMB,INB BQ
      ADB SYST2 2
      STB SYST2 
      JMP SYSL4 
* qq
* 
SYSL8 LDA .26      OUTPUT 
      LDB SYSLA    OVERFLOW 
      JSB ASR35,I  MESSAGE
      JMP ERINA,I  TERMINATE LOADING
      HED * CONSTANTS, TEMPORARIES, ETC. *
* *q
M3072 DEC -3072 2M
D3072 DEC 3072
M6144 DEC -6144 \\\^
N1024 DEC -1024 
M256  DEC -256
M202  DEC -2020`
M203  DEC -203
M128  DEC -128
.600  DEC 600 
B5.7  OCT 77777 
B15   OCT 15
B11   OCT 11
DISCN OCT 100 
B100  EQU DISCN 
B300 OCT 300
B111  OCT -111__
DIRD0 EQU B100
B200  OCT 200 
B106  OCT 106 
BIT15 OCT 100000
SLSH  OCT 57       '/'
N     OCT 116      'N'
Y     OCT 131      'Y'
MXDAY DEC -367     1'S COMPLEMENT OF MAXIMUM DAY
MAXYR DEC -100     1'S COMPLEMENT OF MAXIMUM YEAR 
EQTLN DEC -56 
MBIAS ABS -30000-6000    TENTHS-OF-SECOND COUNTER 
SETDS OCT 30011 
* 
* 
EQTA  EQU B100     EQUIPMENT TABLE ADDRESS
CEQTA OCT 100000   EQT 'DISC READ' CORE ADDRESS 
DNTR  DEF DINIT 
MSLEP DEF SLEEP 
MAINP DEF MAIN
DEQTA OCT 114 
DIRD3 DEF 100B+42 
LNKAD DEF LSLTB    LINKAGE TABLE ADDRESS
DIRE6 EQU B106
ADTBL EQU 37700B-12500B 
ADTBA DEF ADTBL    ADT BUFFER ADDRESS 
DIRBA DEF DIRBF    ADDRESS OF NULL DIRECTORY
TRKTA DEF TRKTB    SYSTEM TRACK TABLE ADDRESS 
USTRA DEF TRKTB+5     USER TRACK DISC ADDRESS 
LDRT0 DEF LDRTK 
LDRT1 DEF LDRTT 
OODSA DEF OODSP 
RSY00 DEF RSYS0 
BSYA1 DEF BSYS1 1i
BSYA2 DEF BSYS2 
* qq
RSYA1 DEF RSYS1 1*
RSYA2 DEF RSYS2 
WORD  DEF WORDC    DISC BLOCK WORD COUNT ADDRESS
TSBBA DEF BSLDR 
* qq
LBAD NOP
CNT2  NOP 
INDEX NOP 
ADTTT NOP 
DRP1  NOP 
D1L   NOP 
D2L   NOP 
LTEMP EQU 20
SFLAG NOP 
TRTAB DEF TRTBL 
SUB1A DEF SUB1
FSUBA DEF FSUB
CLEAR DEF CLDSC 
SL1A DEF SL1+2
TBUF  DEF TBUFR 
STAR  DEF *+1 1
      OCT 6412
      ASC 1,* AA
TBUFI DEF TBUFR,I 
ADR2  NOP 
COMRI DEF COMER                                 (D) 
SCFGI DEF SCFIG                                 (D) 
SC??I DEF SC??
TEMP0 BSS 1 
TEMP1 BSS 1 
TEMP2 BSS 1 1 
TEMP3 BSS 1 
TEMP4 BSS 1 
COUNT BSS 1 OO
MTFLG BSS 1        LOADER MODE FLAG 
SYSLF BSS 2        SYSTEM LIBRARY FLAGS 
SYST1 BSS 1 
SYST2 BSS 1        DISC ADDRESSES OF SPACE
SYSS1 BSS 1 
SYSS2 BSS 1        SPACE AVAILABLE ON 
SLDIR BSS 1        SYSTEM LIBRARY DIRECTORY POINTER 
* 
DSC1A DEF DISC1 
SYIDT DEF SYID1 
SYID1 NOP 
TSSYS ASC 4,TSSYSTEM
ASR35 DEF TTY35    TTY DRIVER ADDRESS 
MOVUA DEF MOVUP 
DISC  DEF DISCD    DISC DRIVER ADDRESS
ADVLA DEF ADVAL 
GTTRA DEF GTTRK 
INTGA DEF INTGR 
ISOTA DEF ISOTL 
READA DEF READ
TWODA DEF TWODG 
GETCA DEF GETCR 
EOFA  DEF EOFER 
TPEA  DEF TPERR 
OCTLA DEF INTCK 
SCHKA DEF SCHEK 
SDRVA DEF SDRIV 
LSTAT DEF DISST 
BBSP  DEF XBSP
LBDMS DEF BADMS-1 
NMOTA DEF NUMOT 
LBDMA DEF BDMSA+1 
* 
LBRYA DEF LBRY
ILINA DEF ILIN
EOTMA DEF EOTM
CHKSA DEF CHKSM 
DATEA DEF DATER 
ILDTA DEF ILDTE EL
TIMEA DEF TIMER R'
ILTIA DEF ILTIM 
TITLE DEF HEDR
SYSLA DEF SYSL
ERINA DEF ERRIN 
NPRTA DEF NBPRT 
SYSDA DEF SYID# 
PINIT DEF INIT
* 
***   NULL DIRECTORY
* 
DIRBF DEC 0,0,0,0,0,-1,0,0       DIRECTORY
      DEC -1,-1,-1,-1,0,-1,0,0   PSEUDO-ENTRIES 
* 
LBRY  OCT 6412
      ASC 5,LIBRARY?
MNBPT OCT 5116
      ASC 8,UMBER OF PORTS? ?>
HEDR  OCT 6412
      ASC 10,2000E LOADER/UTILITY 
      OCT 6412
EOTM  OCT 5105
      ASC 5,ND OF TAPE
      OCT 6400
CHKSM OCT 51030j
      ASC 7,HECKSUM ERROR 
      OCT 6400
DATER OCT 5104
      ASC 3,ATE?
ILDTE OCT 5111
      ASC 6,LLEGAL DATE 
      OCT 6400
TIMER OCT 5124<<<<
      ASC 3,IME?
ILTIM OCT 5111
      ASC 6,LLEGAL TIME 
      OCT 6400
LABOR ASC 9,LOAD/DUMP ABORTED 
      OCT 6412
SYSL  OCT 5123
      ASC 12,YSTEM LIBRARY OVERFLOW 
OODSP OCT 5117
      ASC 9,UT OF DISC SPACE
SYID# OCT 6412


      ASC 9,SYSTEM ID NUMBER? 
      HED * UTILITY ROUTINES *
ERRIN LDA L.20     OUTPUT 
      LDB LABOA    TERMINATION
      JSB ASRDA,I  MESSAGE
      HLT 1        * IRRECOVERABLE
      JMP *-1      * HALT 
* 
***   GET A COMPLETE TRACK
* *q
* 
*     SEARCH ADT FOR A FULL TRACK. IF NONE FOUND, TERMINATE 
*     LOADING. IF FOUND, RETURN WITH DISC ADDRESS IN (A). IF
*     (A) = -1 UPON ENTRY, DELETE TRACK'S ADT ENTRY, ELSE SET 
*     ITS SECTOR COUNT TO ZERO. 
* 
GTTRK NOP 
      STA LTMP1    SAVE FLAG
      LDB L.2      SET
      ADB ADLEN    ENTRY COUNTER
      BRS          SKIPPING LAST
      STB LTMP2    PSEUDO-ENTRY 
      LDB ADTBF    (B) WILL HOLD ENTRY ADDRESSES
GTTR1 LDA 1,I      LOAD ENTRY'S DISC ADDRESS
      JSB ISOTL    GET TRACK LENGTH 
      INB          IN SECTORS 
      CPA 1,I      ALL OF TRACK AVAILABLE?
      JMP GTTR2    YES
      INB          NO 
      ISZ LTMP2    MORE ADT ENTRIES?
      JMP GTTR1    YES
      JMP ERR5A,I  NO 
GTTR2 CLA          CLAIM
      STA 1,I      TRACK
      ADB LM1      LOAD 
      LDA 1,I      DISC ADDRESS 
      ISZ LTMP1    REMOVE ENTRY?
      JMP GTTRK,I  NO 
      STA LTMP2    YES
      ADB L.2      ELIMINATE
      LDA 1 
      JSB MOVUP    ENTRY
      LDA LTMP2    RETRIEVE 
      JMP GTTRK,I  DISC ADDRESS 
* 
***   ISOLATE TRACK LENGTH
* qq
* *q
*     ENTER WITH A DISC ADDRESS IN (A). RETURN WITH THE LENGTH
*     IN SECTORS OF THE REFERENCED TRACK IN (A).
* 
ISOTL NOP 
      LDA D48 
      JMP ISOTL,I 
* 
***   BUILD AN INTEGER
* qq
* q{
*     SEARCH THE INPUT STRING FO 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).
* *q
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    MULTIPLY PARTIAL 
      MPY L.10     RESULT BY 10 
      CLE          ADD IN 
      ADA LTMP5    NEW DIGIT
      SEZ,SZB,RSS 
      SSA          OVERFLOW?
      RSS          YES
      JMP INTG1    NO 
      LDB INF      REPLACE WITH 
      JMP INTGR,I  MAXIMUM INTEGER
INTG2 LDB LTMP6    LOAD INTEGER 
      ISZ LTMP5    ANY DIGITS FOUND?
      JMP INTGR,I  YES
      LDB INF      NO, LOAD ILLEGAL INTEGER 
      JMP INTGR,I 
* 
***   CONVERT TWO-DIGIT INTEGER 
* 
* *q
*     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.
* qq
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
* qq
***   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
* *q
READ  NOP 
      CLB,CME 
READ1 STC PHI/O,C  READ 
      SFS PHI/O    A
      JMP *-1      CHARACTER
      CLC PHI/O    INCLUSIVE OR 
      MIB PHI/O    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
* 
* qq
*     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). 
* qq
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 
      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
* qq
***   FIND ADT POSITION 
* 
* 
*     SEARCH THE ADT FOR THE FIRST ENTRY WHOSE DISC ADDRESS IS
*     EQUAL TO OR EXCEEDS THE DISC ADDRESS IN LTMP4. RETURN 
*     WITH A POINTER TO THIS ENTRY IN (B).
* 
FADTP NOP 
      LDA LTMP4    2'S COMPLEMENT 
      CMA,CLE,INA  DISC ADDRESS 
      STA LTMP0    SAVE IT
      LDB ADTBF    INITIAL ADT POINTER
FADT1 ADA 1,I      FIRST ADT ENTRY >= 
      SEZ          TRACK DISC ADDRESS?
      JMP FADTP,I  YES
      LDA LTMP0    NO, TRY
      ADB L.2      NEXT ENTRY 
      JMP FADT1 
* *q
***   ELIMINATE ADT ENTRY 
* 
* 
*     ENTER WITH THE ADDRESS OF THE SCRATCHED ADT ENTRY IN (A)
*     AND (B). MOVE THE TABLE BELOW IT OVER IT AND DECREMENT
*     THE ADT LENGTH BY 2.
* qq
MOVUP NOP 
      STA SOURC    SAVE SOURCE ADDRESS
      ADB LM2      SAVE 
      STB DEST     DESTINATION ADDRESS
      ADA ADLEN    COMPUTE
      CMA,INA      NUMBER OF
      ADA ADTBF    ENTRIES
      CMA,INA      TO BE
      ARS          MOVED
      STA MCNTN
MOVU1 DLD SOURC,I  MOVE 
      DST DEST,I   ENTRY
      LDA SOURC    UPDATE 
      STA DEST
      ADA L.2      ADDRESSES
      STA SOURC 
      ISZ MCNT     DONE?
      JMP MOVU1    NO 
      ISZ ADLEN    YES, REDUCE TABLE LENGTH 
      ISZ ADLEN    BY ONE ENTRY 
      JMP MOVUP,I 
* 
***   CHECK FOR A DIGIT 
* 
* 
*     ENTER WITH A CHARACTER IN (A). IF IT IS A DIGIT, RETURN 
*     TO (P+2) WITH THE BINARY DIGIT IN (A) AND (B)< OTHERWISE
*     RETURN TO (P+1) WITH THE CHARACTER IN (A).
* 
DIGCK NOP 
      LDB 0        ASCII
      ADB LD72     72 OCT OR
      SSB,RSS      GREATER? 
      JMP DIGCK,I  YES
      ADB LB12     NO, ASCII 57 OCT 
      SSB          OR LESS? 
      JMP DIGCK,I  YES
      LDA 1        NO 
      ISZ DIGCK 
      JMP DIGCK,I 
* 
***   FETCH INPUT CHARACTER 
* qq
* 
*     RETURN TO (P+2) WITH THE NEXT NON-BLANK CHARACTER FROM
*     THE INPUT RECORD IN (A). IF A CARRIAGE RETURN IS FOUND, 
*     RETURN TO (P+1) WITH IT IN (A). 
* 
GETCR NOP 
      LDB BADDR    LOAD CHARACTER POINTER 
      ISZ BADDR    ADVANCE IT 
      CLE,ERB      LOAD 
      LDA 1,I      WORD 
      SEZ,RSS      ADJUST AS
      ALF,ALF      NECESSARY
      AND LB377    MASK OFF CHARACTER 
      CPA BLANK    BLANK? 
      JMP GETCR+1  YES, IGNORE IT 
      CPA LB15     NO, CARRIAGE RETURN? 
      JMP GETBP      YES - BACK UP AND EXIT 
      ISZ GETCR    NO, EXIT 
      JMP GETCR,I  TO (P+2) 
GETBP CCB BB
      ADB BADDR     BACK UP BUFFER POINTER
      STB BADDR 
      JMP GETCR,I 
* 
***   GET NUMBER OF PORTS 
* 
* qq
*     REQUEST THE NUMBER OF AVAILABLE PORTS. CHECK FOR A
*     RESPONSE BETWEEN 1 AND 8. A SIMPLE CARRIAGE RETURN
*     IMPLIES A FULL SYSTEM OF 8 PORTS. 
* 
NBPRT NOP 
      LDA L.18     REQUESTS{
      LDB MNBPA 
      JSB ASRDA,I  NUMBER 
      CLA 
      JSB ASRDA,I  OF PORTS 
      JSB GETCR    GET CHARACTER
      JMP NBPR2    CR 
      JSB DIGCK    DIGIT? 
      JMP NBPR1    NO 
      STA LTMP1    YES
      JSB GETCR    CARRIAGE RETURN FOLLOWS? 
      JMP NBPR3    YES
      JSB DIGCK      DIGIT? 
      JMP NBPR1       NO
      STA LTMP2      YES
      LDA LTMP1        FORM NUMBER
      MPY L.10
      ADA LTMP2 
      STA LTMP1 
      JSB GETCR       CARRIAGE RETURN?
      JMP NBPR3       YES 
NBPR1 LDA L.15     NO, OUTPUT 
      LDB ILINL    ERROR
      JSB ASRDA,I  MESSAGE
      JMP NBPRT+1  TRY AGAIN
NBPR2 LDA L.16
      RSS 
NBPR3 LDA LTMP1 
      CMA,INA,SZA,RSS     ZERO? 
      JMP NBPR1    YES
      LDB 0 
      ADA L.16     NO 
      SSA             GREATER THAN 16?
      JMP NBPR1    YES
      STB NPORT    SAVE-# OF PORTS
      JMP NBPRT,I 
* 
* CONVERTT SUBCHANNEL TO DISC ADDRESS 
* 
FSUB  NOP 
      CLE 
      ERB,RBR 
      SEZ,RSS S 
      ADB F1000
      STB 0 
      JMP FSUB,I,l
F100  OCT 100 
* 
**    TAPE ERROR
* qq
TPERR LDA .+22       TIMING OF
      LDB TAPEA        PARITY 
      JSB ASRDA,I        ERROR
      JMP ERRIN 
EOFER LDA .+38       END OF FILE
      LDB EOFMA AL
      JSB ASRDA,I Ih
      JMP ERRNA,I 
ERRNA DEF ERRIN 
* qq
EOFMA DEF EOFM
TAPEA DEF TAPER 
EOFM  OCT 6412
      ASC 18,UNEXPECTED END-OF-FILE/END-OF-TAPE 
TAPER OCT 5124
      ASC 18,APE CANNOT BE READ 
* 
*  CHECK DISC LABEL 
* 
LABCK NOP 
      LDB PTBF      B=> 2ND WORD
      INB BE
      LDA PSYST     SAVE POINTER. 
      STA LTEMP 
      LDA B,I       A= 2ND WORD 
      CPA LTEMP,I   IS IT A TIME SHARE DISC?
      RSS 
      JMP LBCK2     NO. 
      LDA .-3       YES. SET COUNTER. 
      STA LTEMP+1 
      INB           BUMP POINTERS.
      ISZ LTEMP 
LBCK1 LDA B,I       LOAD NEXT LABEL WORD. 
      CPA LTEMP,I   CHECK IF SYSTEM DISC. 
      RSS 
      JMP LABCK,I   NO. EXIT. 
      INB           BUMP. 
      ISZ LTEMP 
      ISZ LTEMP+1   DONE? 
      JMP LBCK1     NO. 
LBCK2 LDA .+18      YES. SYSTEM DISC! 
      LDB LBCK4     OUTPUT "NOT A USER DISC"
      JSB ASRDA,I     MESSAGE.
      JMP INCMP,I 
* 
**  OUTPUT A NUMBER TO USERS BUFFER 
* qq
NUMOT NOP 
      IOR .+60B     OUTPUT NUMBER.
      ALF,ALF F
      IOR .+15B     ADD ON CR.
      STA B,I 
      JMP NUMOT,I I?
* 
* 
