* 
RDCR8 LDA .+1 
      JSB IOSUB 
RDCR9 DEF RDR 
      DEF CARD
      DEF .M80
      LDA PASSN     IS THIS PASS 1? 
      CPA .+1 
      RSS           YES.
      JMP RDCRD,I   NO, SO EXIT.
      LDA MAG       SHOULD WE COPY RECORD ONTO
      SZA,RSS       MAG TAPE? 
      JMP RDCRD,I   NO, SO EXIT.
      LDA .+2       YES, COPY ONTO MAG TAPE.
      JSB IOSUB 
      DEF MAG 
      DEF CARD
      DEF CRLEN 
      JMP RDCRD,I 
ABORT NOP 
      LDA .+2 
      JSB IOSUB 
      DEF .+2 
      DEF AEND
      DEF .M18
      JSB EJECT     EJECT PAGE ON LIST DEVICE.
      HLT 76B 
      JMP MICRO 
      SKP 
* 
*   'SDUMP' DUMPS A SPECIAL 32-MICROINSTRUCTION/RECORD
*   OBJECT TAPE FOR USE IN THE HP SUITCASE ROM
*   SIMULATOR.
* 
*   CALLING SEQUENCE: 
* 
*     LDA BUFDF     DEF THE OBJECT CODE BUFFER
*                     'A' REG =0 MEANS  ALL OBJECT CODE 
*                     HAS BEEN PASSED TO 'SDUMP'. 
*                     NO MORE IS COMING.
*     JSB SDUMP     CALL THE DUMP ROUTINE 
* 
A     EQU 0 
B     EQU 1 
* 
SDUMP NOP           SUITCASE TAPE DUMP ROUTINE
      LDB A,I       GET THE RECORD LENGTH 
      SZB,RSS       IS THIS THE FINAL CALL? 
      JMP ENDSD     YES, DUMP THE LAST BLOCK OF 32
      ADB =D-5      HEADER BLOCK LENGTH = 5 
      CMB,INB       2'S COMPLEMENT OF LENGTH
      STB OCNTR     SAVE IN OBJECT COUNTER
      ADA =D5       DEF U. INST ADRS AND UPPER BYTE 
      STA OBJPT     SAVE DEF IN OBJECT BUFF POINTER 
      LDB M2CTR     GET THE MOD 2 COUNTER 
      SZB           DID WE STOP ON FIRST WORD?
      JMP WORD2     NO, GO SAVE SECOND WORD 
WORD1 LDA OBJPT,I   U. INST ADDRESS AND UPPER 8 BITS
      AND =B377     STRIP OFF THE ADDRESS 
      ALF,ALF       U. INST M.S. 8 BITS 
      STA SBPNT,I   SAVE IN THE DUMP BUFFER 
      ALF,ALF       PUT BACK IN LOWER BYTE
      ADA CKSM      ADD TO ACCUMULATED CHECKSUM 
      STA CKSM      SAVE THE NEW CHECKSUM 
      JSB BUMPO     BUMP THE OBJECT BUFFER POINTER
      LDA =B177400  UPPER BYTE MASK 
      LDB OBJPT,I   GET U. INST LOWER 16 BITS 
      AND B         GET U. INST 2ND BYTE
      ALF,ALF       2ND BYTE TO LOWER STORE WORD
      IOR SBPNT,I   INCLUDE WITH M.S 8 BITS OF INST 
      STA SBPNT,I   SAVE U. INST 16 BITS
      AND =B377     STRIP OFF THE UPPER BYTE
      ADA CKSM      ADD THE ACCUMULATED CHECKSUM
      STA CKSM      STORE THE NEW CHECKSUM
      JSB BUMPS     BUMP THE STORE POINTER
      LDA OBJPT,I   GET BACK LOWER 16 BITS OF U. INST 
      AND =B377     ISOLATE LEAST. SIG 8 BITS 
      ALF,ALF       PLACE IN UPPER STORE WORD 
      STA SBPNT,I   SAVE IN THE DUMP BUFFER 
      ALF,ALF       PUT BACK IN LOWER HALF
      ADA CKSM      ADD TO ACCUMULATED CHECKSUM 
      STA CKSM      SAVE THE NEW CHECKSUM 
      ISZ M2CTR     BUMP THE MOD 2 COUNTER
      JSB BUMPO     BUMP THE OBJECT POINTER 
WORD2 LDA =B377     LOWER BYTE MASK 
      LDB OBJPT,I   GET U. INST UPPER 8 BITS
      AND B         STRIP OFF THE ADDRESS 
      IOR SBPNT,I   INCLUDE WITH M.S. 8 BITS
      STA SBPNT,I   MOST SIG. 16 BITS 
      AND =B377     STRIP OFF THE UPPER 8 BITS
      ADA CKSM      ADD TO ACCUMULATED CHECKSUM 
      STA CKSM      SAVE THE NEW CHECKSUM 
      JSB BUMPS     BUMP THE DUMP BUFFER POINTER
      JSB BUMPO     BUMP THE OBJECT BUFFER POINTER
      LDB OBJPT,I   GET LOWER 16 U. INST BITS 
      STB SBPNT,I   STORE IN THE DUMP BUFFER
      LDA =B377     LOWER BYTE MASK 
      AND B         STRIP OFF THE UPPER BYTE
      ADA CKSM      ADD TO ACCUMULATED CHECKSUM 
      STA CKSM      SAVE THE NEW CHECKSUM 
      BLF,BLF       ROTATE LOWER 16 BITS OF U. INST 
      LDA =B377     LOWER BYTE MASK 
      AND B         A = U. INST 2ND BYTE
      ADA CKSM      ADD TO ACCUMULATED CHECKSUM 
      STA CKSM      STORE THE NEW CHECKSUM
      CLA           RESET THE MOD 2 COUNTER 
      STA M2CTR      TO ZERO FOR NEXT GROUP 
      JSB BUMPS     BUMP THE DUMP BUFFER POINTER
      JSB BUMPO     BUMP THE OBJECT BUFFER POINTER
      JMP WORD1     GO PROCESS THE NEXT OBJECT WORD 
* 
ENDSD LDB M2CTR     GET THE MOD 2 COUNTER 
      SZB,RSS       DID WE STOP ON FIRST WORD?
      JMP EWRD2     NO, GO SAVE SECOND WORD 
* 
EWRD1 LDB CKSM      GET ACCUMULATED CHECKSUM. 
      ADB =B377     ALL ONES IN UPPER 8 MICRO BITS
      STB CKSM      SAVE THE NEW CHECKSUM 
      LDA =B377     MICRO CODE DEFAULT UPPER 8 BITS 
      IOR SBPNT,I   INCLUDE WITH LOWER 8 BITS OF
      JSB SSTOR      PREVIOUS MICRO INSTRUCTION 
EWRD2 CCA           SET A = ALL ONES FOR DEFAULT
      LDB CKSM      GET ACCUMULATED CHECKSUM
SONES ADB =B776     CHECKSUM +B377 + B377 
      STB CKSM      STORE THE NEW CHECKSUM. 
      JSB SSTOR     STORE ALL ONES IN DUMP BUFFER 
      JMP SONES     CONTINUE UNTIL BUFFER FULL
* 
SSTOR NOP           STORE IN THE DUMP BUFFER
      STA SBPNT,I    THROUGH BUFFER POINTER 
      ISZ SBPNT     BUMP THE DUMP BUFFER POINTER
      ISZ SCNTR     IS THE BUFFER FULL? 
      JMP SSTOR,I   NO, CONTINUE LOADING
      LDA CKSM      GET ACCUMULATED CHECKSUM
      CMA           COMPUTE ONES COMPLEMENT 
      ALF,ALF       1'S COMPLEMENT ROTATED
      STA CKSM      AND SAVE BACK IN CHECKSUM 
* 
*     THE FINAL DUMP OF 'SBUFF' IS DONE HERE. 
* 
      JSB PUNCH     DUMP 'SBUFF' ON PUNCH 
      JMP SDUMP,I   EXIT FROM SUITCASE ROM TAPE DUMP
* 
BUMPO NOP 
      ISZ OBJPT     BUMP THE OBJECT BUFFER PNTR 
      ISZ OCNTR     IS THE LAST WORD PROCESSED? 
      JMP BUMPO,I   NO, CONTINUE PROCESSING 
      JMP SDUMP,I   YES, WAIT FOR NEXT FULL BUFFER
* 
BUMPS NOP 
      ISZ SBPNT     BUMP THE DUMP STORE POINTER 
      ISZ SCNTR     IS THE DUMP BUFFER FULL?
      JMP BUMPS,I   NO, CONTINUE LOADING IT 
      LDA CKSM      NO, GET ACCUMULATED CHECKSUM
      CMA           CALCULATE 1'S COMPLEMENT
      ALF,ALF       1'S COMPLEMENT ROTATED
      STA CKSM      SAVE CHECKSUM FOR THE DUMP
      JSB PUNCH     DUMP 'SBUFF' ON PUNCH 
      LDA =D-48     RESET THE DUMP STORE COUNTER
      STA SCNTR      TO STORE 48 WORDS
      LDA SBPTR     RESET THE DUMP STORE POINTER
      STA SBPNT      TO FIRST U. INST WORD
      CLA           RESET THE ACCUMULATED 
      STA CKSM      CHECKSUM TO ZERO
      JMP BUMPS,I   ALL THE POINTERS ARE RESET
* 
*     DUMP THE CONTENTS OF THE DUMP BUFFER
*     STARTING AT 'SBUFF' FOR 52 WORDS. 
* 
PUNCH NOP           DUMP 'SBUFF' ON PUNCH 
      LDA .+2 
      LDB .+1 
      JSB IOSUB 
      DEF PCH 
      DEF SBUFF     BUFFER ADDRESS
      DEF D52       DUMP 52 WORDS 
      JMP PUNCH,I    AND EXIT 
* 
* 
*     CONSTANTS AND POINTERS FOR SUITCASE TAPE DUMP ROUTINE 
* 
D52   DEC 52        'SBUFF' BUFFER LENGTH = 52
M2CTR NOP           MOD 2 COUNTER 
OBJPT NOP           OBJECT BUFFER TEMP POINTER
OCNTR BSS 1         OBJECT RECORD COUNTER 
SBDEF DEF SBUFF     POINTER TO START OF DUMP BUFFER 
SBPNT DEF SBUFF+1   DEF USED FOR FIRST DUMP CALL
SBPTR DEF SBUFF+1   POINTERS TO FIRST U. INST ADDRESS 
SBUFF OCT 032000    ROTATE 52 = RECORD LENGTH 
      BSS 48        MICRO INSTRUCTION DUMP BUFFER 
CKSM  NOP           BYTE CHECKSUM ACCUMULATOR 
      NOP           THE LAST 2 BUFFER WORDS DUMPED
      NOP            IN A RECORD ARE ZEROS
SCNTR DEC -48       SUITCASE BUFFER STORE COUNTER 
      SKP 
* 
*   'SERCH' SEARCHES THE SYMBOL TABLE FOR THE 
*   SYMBOL (IE, LABEL) WHOSE STARTING BYTE ADDRESS
*   IS IN THE B REG.
*   CALLING SEQUENCE: 
*      B REG SHOULD CONTAIN STARTING BYTE ADDRESS 
*         OF SYMBOL TO BE SEARCHED FOR. 
*      JSB SERCH
* 
*   UPON RETURN, THE WORD ADDRESS OF THE START OF 
*   THE SYMBOL TABLE ENTRY FOR THAT SYMBOL WILL BE IN A REG.
*   A REG < 0 IMPLIES SYMBOL NOT PRESENT IN SYMBOL
*   TABLE.
* 
* 
SERCH NOP 
      LDA .-8       PUT THE SYMBOL INTO THE 
      JSB TLOAD     BUFFER, 'TOKEN'.
      LDB HDTAB     PICK UP HEAD TABLE ADDRESS
SR0   CPB SYMB      END OF TABLE? 
      RSS 
      JMP *+3 
      CCA           YES NOT FOUND 
      JMP SERCH,I   EXIT
      LDA 1,I       NO,COMPARE
      CPA TOKAD,I   1ST 2 CHARS THE SAME? 
      JMP *+3       YES 
      ADB .+6       NO, POINT 
      JMP SR0       TO NEXT ENTRY GO BACK.
      LDA TOKAD     COMPARE 
      INA           NEXT
      STA SR.00     2 
      INB           CHARACTERS. 
      LDA 1,I 
      CPA SR.00,I   SAME? 
      JMP *+3 
      ADB .+5       NO, POINT TO NEXT 
      JMP SR0       ENTRY & TRY AGAIN 
      ISZ SR.00     YES 
      INB           CHECK NEXT
      LDA 1,I       2.
      CPA SR.00,I   SAME? 
      JMP *+3 
      ADB .+4       NO, POINT TO NEXT 
      JMP SR0       ENTRY & TRY AGAIN.
      ISZ SR.00     YES.
      INB           CHECK LAST
      LDA 1,I       2 CHARS.
      CPA SR.00,I   SAME? 
      JMP SR1 
      ADB .+3       NO.  POINT B REG. TO START OF 
      JMP SR0       NEXT ENTRY.  TRY AGAIN. 
SR1   LDA 1         YES, SUCCESS. 
      ADA .-3       SET A TO HEAD OF ENTRY. 
      JMP SERCH,I   & EXIT. 
      SKP 
* 
* THIS ROUTINE SEARCHES THE OPCODE TABLE INDICATED BY A-REG 
* FOR MNEMONIC POINTED TO BY B REG. 
* 
*   ON ENTRY: A REG SHOULD CONTAIN NO. REFERENCING TABLE
*             TO BE SEARCHED, AS FOLLOWS: 
*             A=1  REFERENCES  'OPCODE' TABLE.
*             A=2       "      'SPECIAL'  " 
*             A=3       "      'CONDITION'   "
*             A=4       "      'ALU'      " 
*             A=5       "      'IMM'      " 
*             A=6       "      'STORE'    " 
*             A=7       "      'S-BUS'    " 
* 
*             B= BYTE POINTER TO MNEMONIC STRING
* 
* ON EXIT  A= VALUE OF OPCODE 
*             IF A=-1, THEN THE MNEMONIC WASN'T FOUND.
* 
* 
*  TABLE LOOKS LIKE 
* 
*             ***************** 
*             * BYTE1 * BYTE2 * 
*             ***************** 
*             * BYTE3 * BYTE4 * 
*             ***************** 
*             *     VALUE     * 
*             ***************** 
*             *       .       * 
*             *       .       * 
* 
$SRCH NOP 
      STB S.000     SAVE BYTE ADDRESS 
      LDB SBUS      PUT DEFAULT TABLE VALUE IN B. 
      CPA .+1       'OPCODE'? 
      LDB OPCOD     YES, PUT TABLE ADR IN B REG.
      CPA .+2       'SPECIAL'?
      LDB SPEC      YES, PUT TABL ADR IN B REG. 
      CPA .+3       'CONDITION'?
      LDB COND      YES, LOAD TABL ADR IN B REG.
      CPA .+4       'ALU'?
      LDB ALU       YES, PUT TABL ADR IN B REG. 
      CPA .+5       'IMM'?
      LDB IMM       YES, PUT TABL ADR IN B REG. 
      CPA .+6       'STORE'?
      LDB STORE     PUT TABL ADR IN B REG.
      CPA .+7       'S-BUS'?
      LDB SBUS      YES, PUT TABL ADR IN B REG. 
      STB PNTR      SAVE TABLE HEAD.
      LDB S.000     PUT OPCODE MNEMONIC 
      LDA .-4       STRING INTO THE 
      JSB TLOAD     BUFFER, 'TOKEN'.
      LDB PNTR      DO 1ST
SRC00 LDA 1,I       2 
      CPA TOKEN     BYTES COMPARE?
      JMP SRCH1     YES.
      ADB .+3       NO.  POINT TO 
SRCH0 LDA 1,I       NEXT ENTRY. 
      SZA           END OF TABLE? 
      JMP SRC00     NO.  GO BACK. 
      CCA           YES SET ERROR 
      JMP $SRCH,I   EXIT
SRCH1 INB           DO 2ND
      LDA 1,I       2 
      CPA TOKEN+1   BYTES COMPARE 
      JMP SRCH2     YES.
      ADB .+2       NO.  POINT TO NEXT MNEMONIC 
      JMP SRCH0     AND GO TEST THAT ONE. 
SRCH2 INB           YES.
      LDA 1,I       PICK UP BINARY CODE.
      JMP $SRCH,I   EXIT
      SKP 
* 
* THIS ROUTINE SKIPS OVER ALL CONSECUTIVE SYMBOLS 
* LIKE THAT IN A-REG. 
* 
*   CALLING SEQUENCE: 
*      LDA <BYTE TO BE SKIPPED OVER IN LOW BITS,
*         NULL IN HIGH BITS>
*      LDB .BYTE ADDRESS WHERE POSSIBLE SKIP IS TO
*         BEGIN>
*      JSB SKIP 
*   UPON RETURN:
*      B REG WILL CONTAIN BYTE ADDR OF FIRST CHAR 
*         UNLIKE THE ONE SKIPPED OVER.
*      A REG NOT SIGNIFICANT. 
*      IF OVERFLOW IS SET, THEN END OF BUFFER WAS REACHED 
*         BEFORE REACHING A CHAR DIFFERENT FROM ONE TO BE SKIPPED 
*         OVER. 
* 
SKIP  NOP 
      STA CHAR      SAVE TEST CHAR
SKP0  JSB LOADB     LOAD CHAR FROM STRING 
      SZA           =0? 
      JMP *+3 
      STO          YES SET END OF LINE FLAG.
      JMP SKIP,I    EXIT
      CLO 
      CPA CHAR      =CHAR?
      RSS 
      JMP SKIP,I    NO EXIT 
      INB           YES CHECK 
      JMP SKP0      NEXT ONE. 
      SKP 
*   'SKP' PROCESSES THE 'SKP' PSEUDO OP, WHICH CAUSES 
*   AN EJECT OF THE LISTING PAGE AT THE POINT WHERE THE 
*   'SKP' IS ENCOUNTERED. 
* 
*   CALLING SEQUENCE: 
* 
*      JSB SKP
* 
*   UPON RETURN:
* 
*      IF NOT A 'SKP', 'A' REG=0;  IF A 'SKP', 'A' REG=1. 
*      IF CALL OCCURS IN PASS 1, NOTHING ELSE HAPPENS.
*      IF CALL OCCURS IN PASS 2, PAGE WILL HAVE BEEN EJECTED. 
* 
SKP   NOP 
      LDB F2ADR     GET FIELD 2 BYTE ADDR.
      LDA SKAD      GET ADDR OF STRING 'SKP'. 
      JSB CHECK     DO WE HAVE A 'SKP' STATEMENT? 
      SZA,RSS 
      JMP SKPP5     NO. 
      LDA PASSN     ARE WE IN PASS 1? 
      CPA .+1 
      JMP SKPP4     YES.
      JSB EJECT     NO, MUST BE PASS 2. EJECT PAGE. 
      JMP SKPP4 
SKPP4 CLA,INA       SET 'A' FOR 'YES, 'SKP'.
      JMP SKP,I 
SKPP5 CLA           SET 'A' FOR 'NO SKP'. 
      JMP SKP,I 
      SKP 
* THIS ROUTINE SKIPS TO SYMBOL IN A-REG 
* STARTING AT BYTE ADDRESS SPECIFIED IN B-REG.
* IF END OF CARD IS REACHED BEFORE SYMBOL FOUND 
* OVERFLOW IS SET.
* 
SKPTO NOP 
      STA CHAR      SAVE TEST CHAR
SK0   JSB LOADB     LOAD CHAR FROM STRING 
      CPA CHAR      =?
      RSS           YES 
      JMP *+3 
      CLO           CLEAR OVERFLOW
      JMP SKPTO,I   EXIT
      SZA           END OF STRING?
      JMP *+3 
      STO            YES SET OVERFLOW 
      JMP SKPTO,I   EXIT
      INB           ELSE BUMP ADDRESS 
      JMP SK0       + TRY AGAIN.
      SKP 
* 
* 
*   THIS ROUTINE SPACES N LINES ON SPECIFIED
*   DEVICE. 
* 
*   CALLING SEQUENCE: 
*      LDA <L.U. # OF DEVICE TO BE SPACED ON> 
*      LDB <+ # OF LINES TO BE SPACED>
*      JSB SPACE
* 
SPACE NOP 
      SZA,RSS       IS L.U.#=0? 
      JMP SPACE,I   YES.  THEN GO BACK NOW. 
      CMB,INB       SET 
      STB SCNT      COUNT 
      STA DEVIC     SAVE L.U. 
      SZA,RSS       SUPPRESS LISTING? 
      JMP SPACE,I   YES 
      LDA SPSTW 
      AND UMSK
      IOR DEVIC 
      STA SPSTW 
      JSB .IOC.     I/O ON TTY? 
SPSTW OCT 040000
      AND EQMSK 
      SZA,RSS 
      JMP SPTT      YES.
      LDA LPSPC 
      STA SPBUF 
      JMP SP1 
SPTT  LDA TTYSP 
      STA SPBUF 
SP1   NOP 
      LDA .+2 
      JSB IOSUB 
      DEF DEVIC 
      DEF SPBUF 
      DEF .-2 
SP4   JSB PAGER 
      ISZ SCNT      FINISHED? 
      JMP SP1       NO, GO BACK.
      JMP SPACE,I   YES EXIT
      SKP 
* 
* THIS ROUTINE STORES LOW BYTE OF A IN
* LOCATION IN B. ADDRESS INCREMENTED ON EXIT. 
* 
STORB NOP 
      STB L.000     SAVE B-REG
      CLE,ERB       E INDICATE HI OR LO 
      STB L.002     SAVE WORD ADDRESS 
      AND LOMSK     SAVE
      STA L.001     SOURCE BYTE.
      LDA 1,I       PICK UP WORD. 
      LDB HIMSK     PUT HI MASK IN B-REG. 
      SEZ,RSS       DEST IS LO BYTE?
      BLF,BLF       NO SAVE OPPOSITE
      AND 1         BYTE. 
      SEZ,RSS          SHIFT CURRENT
      ALF,ALF       BYTE HIGH IF NECESSARY
      IOR L.001     OR IN SOURCE BYTE.
      SEZ,RSS           RE-ADJUST 
      ALF,ALF       WORD IF NEXESSARY 
      STA L.002,I   STORE 
      LDB L.000     BUMP
      INB           BYTE ADDRESS
      JMP STORB,I   EXIT. 
      SKP 
* 
*   'SYMAD' ADDS THE SYMBOL(IE., THE LABEL) POINTED 
*   TO BY B REG TO THE SYMBOL TABLE.
* 
*   CALLING SEQUENCE: 
*   B REG MUST CONTAIN THE STARTING BYTE ADDRESS
*        OF THE SYMBOL TO BE ADDED; 
*      A REG MUST CONTAIN THE VALUE OF THE SYMBOL 
*        (IE., THE ADDRESS OF SYMBOL IN THE MICROPROGRAM).
*      JSB SYMAD
* 
* ROUTINE CHECKS FOR DUPLICATE ENTRIES OUTPUTS
* APPROPRIATE ERRORS. 
* 
* E-REG SET ON ENTRY IMPLIES EXTERNAL SYMBOL
* 
* SYMBOL TABLE FORMAT:
* 
*         *************** 
*         *BYTE1 * BYTE2* 
*         *************** 
*         *BYTE3 * BYTE4* 
*         *************** 
*         *BYTE5 * BYTE6* 
*         *************** 
*         *BYTE7 * BYTE8* 
*         *************** 
*         *    VALUE    * 
*         *************** 
*         *     TAG     * 
*         *************** 
* 
SYMAD NOP 
      STA VALU,I    SAVE VALUE. 
      CLA           SET 
      SEZ           EXTERNAL
      INA           FLAG IF 
      STA TAG,I     INDICATED.
      SEZ           THIS '
      JMP SY0       IS
      CLE,ERB       LABEL 
* 
*   THIS SECTION HANDLES INTERNAL SYMBOLS.
* 
      LDA .-4       STORE THE 
      STA COUNT     LABEL INTO
SYM1  LDA 1,I       SYMBOL TABLE. 
      STA SYMB,I
      INB 
      ISZ SYMB
      ISZ COUNT 
      JMP SYM1
      LDB SYMB
      ADB .-4 
      STB SYMB
SY2   LDB SYMB
      RBL 
      JSB SERCH     IS CURRENT SYMBOL ALREADY 
      SSA           IN SYMBOL TABLE?
     JMP SY3        NO.  GOOD.
      LDA .-1       YES.  THEN WE HAVE DUPLICATE
      JSB ERROR     LABELS, AN ERROR.  PRINT MESSAGE. 
      LDA TOKAD     OUTPUT DUPLICATE SYMBOL WITH
      ADA .-1       PAIR OF EXTRA SPACES AT 
      STA SY2.5     START FOR LINE PRINTER .
      LDA .+2 
      JSB IOSUB 
      DEF LIST
SY2.5 NOP 
      DEF .-10
      LDA LIST
      CLB,INB 
      JSB SPACE 
      JMP SYMAD,I   EXIT. 
SY3   LDA TAG       BUMP
      INA           END 
      STA SYMB      OF TABLE
      ADA .+4       POINTERS
      STA VALU      SYMB,VALU 
      INA           & 
      STA TAG       TAG 
      CMA,INA 
      ADA LWAM
      SSA,RSS 
      JMP SYMAD,I   EXIT. 
      LDA .+2 
      JSB IOSUB 
      DEF .+1 
      DEF SOVFL 
      DEF .M18
      JMP ABORT 
* 
*   THIS SECTION HANDLES EXTERNAL SYMBOLS.
* 
SY0   STB S.000     SAVE BYTE ADDRESS IN TEMP.
      LDA .-8       SET 
      STA SCNT      COUT
      LDB SYMB      BLANK 
      LDA BLNK2     OUT 
      STA 1,I       SPACE 
      INB           FOR 
      STA 1,I       EXTERNAL
      INB           SYMBOL. 
      STA 1,I 
      INB 
      STA 1,I 
      LDB S.000     GET 1ST 
      JSB LOADB     BYTE
      INB           BUMP &
      STB S.000     SAVE ADDRESS. 
      LDB SYMB      STORE 
      RBL           AWAY
SY1   JSB STORB     CHARACTER.
      STB S.002     SAVE NEXT ADDRESS 
      LDB S.000     CHECK 
      ISZ S.000     NEXT
      JSB LOADB     CHARACTER 
      CPA SPAC      = SPACE?
      JMP SY2    YES GO SEARCH. 
      LDB S.002     NO
      ISZ SCNT      BUMP CHARACTER COUNT
      JMP SY1       IF
      LDA .-2       MORE THAN 8 
      JSB ERROR     ERROR 
      LDA .+2 
      JSB IOSUB 
      DEF LIST
      DEF CARD
      DEF CRLEN 
      JMP SYMAD,I   EXIT. 
      SKP 
* 
*   'TLOAD' LOADS THE BUFFER 'TOKEN' WITH THE STRING
*   OF ASCII CHARACTERS WHOSE STARTING BYTE ADDRESS 
*   IS IN THE B REGISTER. 
* 
*   CALLING SEQUENCE: 
*      B REG SHOULD CONTAIN THE STARTING BYTE 
*      ADDRESS OF THE STRING OF ASCII CHARACTERS. 
* 
*      A REG SHOULD CONTAIN MINUS THE MAX. NO.
*      OF CHARACTERS THE STRING MIGHT HAVE. 
*      MAX ALLOWED IS 8 CHARS.
* 
*      JSB TLOAD
* 
*   NOTE:  AS SOON AS A FINAL SPACE OR A '+' OR A '-' IS
*   READ, LOADING STOPS.  A 'FINAL SPACE' MEANS, A SPACE
*   FOLLOWING SOME NON-SPACE (AND NON-+, NON MINUS) 
*   CHAR.   IF NO FINAL SPACE, OR '+', OR '-' IS READ, THEN 
*   LOADING STOPS WHEN THE MAX NO. OF CHARS AS WAS SPECIFIED
*   IN 'A' REG, ARE LOADED. 
* 
TLOAD NOP 
      STA SCOUN 
      STB SAVC
      CLA           ZERO THE 'FINAL SPACE' FLAG.
      STA SFLG
      LDB TOKAD 
      RBL 
      STB SAVD
*   FILL BUFFER 'TOKEN' WITH SPACES.
      LDA .-4 
      STA COUNT 
      LDB TOKAD 
      LDA BLNK2 
TL0   STA 1,I 
      INB 
      ISZ COUNT 
      JMP TL0 
*   LOAD STRING.
TL1   LDB SAVC      BRING IN THE
      JSB LOADB     NEXT CHAR.
      ISZ SAVC      INC ADDRESS FOR NEXT TIME.
      CPA SPAC      JUST READ A SPACE?
      JMP TL2       YES.  GO SEE IF IT'S A FINAL .
      CPA PLUS      NO.  READ A PLUS? 
      JMP TLOAD,I   YES, THEN EXIT. 
      CPA MINUS     NO.  READ A '-'?
      JMP TLOAD,I   YES.  THEN EXIT.
TL3   LDB SAVD      NOW STORE 
      JSB STORB     THE CHAR. 
      STB SAVD      SAVE NEXT STORAGE ADDR. 
      CLA,INA       SET THE 'FINAL SPACE' FLAG TO 
      STA SFLG      SHOW 'YES, WE READ A NON-SPACE' 
      ISZ SCOUN     DONE YET? 
      JMP TL1       NO. 
      ISZ SAVC      YES. INC 'FROM' BYTE ADDR FOR 
      JMP TLOAD,I   POSSIBLE USE IN 'NUM' SUBR. EXIT. 
TL2   STA SAVW      SAVE 'A' REG. 
      LDA SFLG      IS THIS AN INITIAL SPACE? 
      SZA 
      JMP TLOAD,I   NO, FINAL, SO EXIT. 
      LDA SAVW      YES, SO STORE SPACE.
      JMP TL3 
SFLG  NOP 
SAVW  NOP 
      SKP 
*   'TTYIO' DETERMINES IF A GIVEN LOGICAL UNIT #
*   CORRESPONDS TO THE TTY. 
* 
*   CALLING SEQUENCE: 
* 
*      LDB <LOGICAL UNIT #> 
* 
*      JSB TTYIO
* 
*   UPON RETURN:
* 
*      IF A REG = 0, THEN DEVICE IS TTY.
*      IF A REG # 0 THEN NOT TTY. 
* 
TTYIO NOP 
      LDA EJST      SET UP CONTROL WORD.
      AND UMSK
      IOR 1 
      STA EJST
      JSB .IOC.     IS DEVICE TTY?
EJST  OCT 040000
      AND EQMSK 
      JMP TTYIO,I   A REG HAS ANSWER. RETURN.