      JSB OUTPT 
      JMP P21 
* 
      SKP 
* 
*   CREATE A WORD TYPE 2 INSTRUCTION. 
*   FIRST, CHECK MNEMONICS AND COLLECT BINARY OPCODES 
*   FOR EACH FIELD. 
* 
TYPE2 LDA .+2       GET A 'SPECIAL' CODE
      LDB .+3       FROM FIELD 3. 
      JSB CODE
      LDA .+5       GO GET AN 'IMM' CODE
      LDB .+4       FROM FIELD 4. 
      JSB CODE
      LDA .+6       GO GET A 'STORE' CODE 
      LDB .+5       FROM FIELD 5. 
      JSB CODE
      LDB F6ADR     GET FLD 6 STARTING BYTE ADDRESS.
      JSB NUM       CONVERT FIELD CONTENTS TO BINARY. 
      SOC           ANY PROBLEMS? 
      JMP TY2.1     YES.
      JMP TY2.2     NO. 
TY2.1 LDA .+11      PRINT ERROR MESSAGE.
      JSB ERROR 
      CLA           MAKE FIELD 6 = 0. 
TY2.2 STA 1 
      AND MSK8      IS # 8 BITS OR LESS?
      SZA 
      JMP TY2.1     NO, SO ERROR. 
      STB FLD6      YES.
* 
*   NOW PUT TOGETHER THE FIELDS OF THE TYPE 2 WORD. 
* 
      LDA FLD3      BITS 0-4 GET FIELD 3
      STA INST1     (HERE A 'SPECIAL' NOP). 
      LDA FLD5      BITS 5-9 GET FIELD 5
      ALF,RAL       (HERE, A 'STORE').
      IOR INST1 
      STA INST1 
      LDA FLD6      BITS 10-17 GET FIELD 6
      AND MSK6      (HERE, A BINARY NO.). 
      ALF,ALF       FIRST, DO BITS 10-15. 
      RAL,RAL 
      IOR INST1 
      STA INST1 
      LDA FLD6      NOW BITS 16-17(0-1).
      AND MSK78 
      ALF,ALF 
      RAL,RAL 
      STA INST2 
      LDA FLD4      BITS 18-19(2-3) GET 
      RAL,RAL       FIELD 4 (HERE, AN 'IMM'). 
      IOR INST2 
      STA INST2 
      LDA FLD2      BITS 20-23(4-7) GET 
      ALF           FIELD 2(HERE, AN 'OPCODE'). 
      IOR INST2 
      STA INST2 
      JSB OUTPT 
      JMP P21 
* 
      SKP 
* 
*   CREATE A WORD TYPE 3 INSTRUCTION. 
*   FIRST, CHECK MNEMONICS AND COLLECT BINARY CODES.
* 
TYPE3 LDA .+3       GO GET A 'CONDITION' CODE 
      LDB .+4       FROM FIELD 4. 
      JSB CODE
      LDA .+6       GET A 'STORE' CODE
      LDB .+5       FROM FIELD 5
      JSB CODE
      LDA FLD5      DID FIELD 5 CONTAIN 
      CPA RJS       AN 'RJS'? 
      JMP TY3.5     YES.
      LDA .+1       NO.  SO SET BIT 14. 
      RAR,RAR 
      RSS 
TY3.5 CLA           'RJS' PRESENT, SO CLEAR 
      STA FLD5      BIT 14. 
      LDB F6ADR     GET FLD 6 STARTING BYTE ADDR. 
      JSB NUM       CONVERT FIELD CONTENTS TO BINARY. 
      SOC           ANY PROBLEMS? 
      RSS           YES.
      JMP TY3.1     NO. 
TY3.0 LDA .+8       GO OUTPUT ERROR MESSAGE.
      JSB ERROR 
      CLA           MAKE FIELD 6 = 0. 
      STA FLD6
      LDA UNCD      DEFAULT 'SPECIAL' CODE (FIELD 
      STA FLD3      3) TO 'UNCD'. 
      JMP TY4.6     GO ASSEMBLE AS TYPE 4 WORD. 
TY3.1 STA SAVA
      AND MSK21     THROW OUT LOW 9 BITS OF THE #.
      STA 1 
      LDA T.001     RE-CREATE THE ABSOLUTE ORIGIN 
      IOR T.002     THROW OUT ITS LOW 9 BITS. 
      AND MSK21 
      CPA 1        THE 3 HIGH BITS SAME IN BOTH #'S?
      RSS           YES, SO GOOD #. 
      JMP TY3.0     NO, SO ERROR. 
      LDA SAVA
      AND MSK23     KEEP LOW 9 BITS.
      STA FLD6      STORE IN FIELD WORD.
* 
*   NOW PUT TOGETHER THE FIELDS OF THE TYPE 3 WORD. 
* 
      LDA FLD3      BITS 0-4 GET FIELD 3
      STA INST1     (HERE, THE 'SPECIAL', 'CNDX'.)
      LDA FLD6      BITS 5-13 GET FIELD 6 
      ALF,RAL       (HERE, AN ADDRESS). 
      IOR INST1 
      STA INST1 
      LDA FLD5      BIT 14 GETS FIELD 5 
      IOR INST1 
      STA INST1 
      LDA FLD4      BITS 15-19 GET FIELD 4
      RAR           (HERE, A 'CONDITION').
      AND MSK15     FIRST, BIT 15.
      IOR INST1 
      STA INST1 
      LDB FLD4
      BRS 
      STB INST2     NOW BITS 16-19(0-3).
      LDA FLD2      BITS 20-23(4-7) GET FIELD 2 
      ALF           (HERE AN 'OPCODE'). 
      IOR INST2 
      STA INST2 
      JSB OUTPT 
      JMP P21 
* 
      SKP 
* 
*   CREATE A WORD TYPE 4 INSTRUCTION. 
*   WE ALREADY HAVE CODES FROM FIELDS 2 AND 3.
* 
TYPE4 LDA FLD3      GET THE FIELD 3 BINARY CODE.
      CPA IOFF      WAS IT 'IOFF'?
      JMP TY4.9     YES.  SO OK.
      CPA STFL      NO. WAS IT 'STFL'?
      JMP TY4.9     YES, SO OK. 
      CPA UNCD      NO. WAS IT 'UNCD'?
      JMP TY4.9     YES.  SO OK.
      CPA BLANK     NO. WAS IT BLANK? 
      JMP TY4.8     YES.
      CPA IOG       NO.  WAS IT 'IOG'?
      JMP TY4.9     YES.  SO OK.
      ADA .M26      'JMP SPECIAL' BUT NOT 'CNDX'? 
      SSA 
      JMP TY4.7     NO, SO ERROR. 
      LDA FLD3      YES.  SO OK.
      JMP TY4.9 
TY4.7 LDA .+4       PRINT ERROR MESSAGE.
      JSB ERROR 
TY4.8 LDA UNCD      STORE 'UNCD' AS DEFAULT.
TY4.9 STA FLD3
      LDB F6ADR     GET FIELD 6 STRTNG BYTE ADDR. 
      JSB NUM       CONVERT FIELD CONTENTS TO BINARY. 
      SOC           ANY PROBLEMS? 
      JMP TY4.0     YES.
      JMP TY4.1     NO. 
TY4.0 LDA .+8       YES.  GO OUTPUT 
      JSB ERROR     ERROR MESSAGE.
      LDA UNCD      STORE 'UNCD' IN 
      STA FLD3      FIELD 3.
      CLA           MAKE FIELD 6 = 0. 
TY4.1 STA 1 
      AND MSK12     IS THE NO. 12 BITS
      SZA           OR LESS?
      JMP TY4.0     NO, SO ERROR. 
      STB FLD6      YES.  SO SAVE FIELD.
* 
*   NOW PUT TOGETHER THE FIELDS OF THE TYPE 4 WORD. 
* 
TY4.6 LDA FLD3      BITS 0-4 GET FIELD 3
      STA INST1     (HERE, A 'SPECIAL').
      LDA FLD6      BITS 5-16 GET FIELD 6 
      CLE 
      ALF,ELA       FIRST, BITS 5-15. 
      IOR INST1 
      STA INST1 
      CLB 
      ELB           NOW BIT 16. 
      LDA FLD2      LEAVE BITS 17-19(1-3) CLEAR.
      ALF           BITS 20-23(4-7) GET 
      IOR 1         FIELD 2(HERE, AN 'OPCODE'). 
      STA INST2 
      JSB OUTPT 
      JMP P21 
* 
      SKP 
* 
*   WE COME HERE AFTER READING AN '$END' RECORD 
*   IN PASS 2.
* 
END   JSB EMPBF     EMPTY PUNCH BUFFER. 
      LDA RCFLG     ARE WE PUNCHING 
      SZA,RSS       A SUITCASE ROM TAPE?
      JMP END00 
      LDA .+2       YES.  THEN SET FLAG 
      STA RCFLG     FOR 'LAST PUNCHOUT'.
      JSB EMPBF     DO 'LAST PUNCHOUT'. 
END00 LDA PCH       WAS THERE A 'NO-PUNCH' CONTROL
      SZA,RSS       CARD? 
      JMP END0      YES, SO DON'T PUNCH END RECORD. 
      LDA RCFLG     NO.. ARE WE PUNCHING A SUITCASE 
      CPA .+2       ROM TAPE? 
      JMP END0      YES, SO NO END RECORD.
      LDA .+2       NO.  PUNCH OUT
      CLB,INB 
      JSB IOSUB     END RECORD. 
      DEF PCH 
      DEF ENDRC 
      DEF .+4 
END0  LDA CRLEN     LIST THE '$END' STATEMENT.
      JSB LSTR
      LDA NMERR     ANY PASS 2
      SZA,RSS       ERRORS? 
      JMP END1      NO. 
      LDB DJ1       YES.  SO GO 
      RBL           PUT NO. INTO  THE 
      INB           NO.-OF-ERRORS STATEMENT 
      JSB DECML     BUFFER. 
END1  LDA LIST
      SZA,RSS       USER NOT LISTING? 
      LDA .+6       YES.  WELL, HE GETS THE 
      STA LIST      NO.-OF-ERRORS STATEMENT ANYWAY. 
      LDA .+2 
      JSB IOSUB 
      DEF LIST
      DEF DJ
      DEF .M18
      JSB LEEDR     PUNCH OUT TRAILER.
      LDA LIST      IF USER IS LISTING ON 
      CPA .+1       LINE PRINTER, 
      RSS 
      JSB EJECT     EJECT PAGE FOR THE GUY. 
      LDA .+2       PRINT FINAL 'END' MESSAGE 
      JSB IOSUB     ON THE TELETYPE.
      DEF TTYO
      DEF ENDMS 
      DEF .M18
      LDA .+2       OUTPUT 4
      LDB .+4       SPACES ON TTY.
      JSB SPACE 
      JMP D1        GO BACK AND DO NEXT MICROPROGRAM. 
      SKP 
* 
*   'CHECK' COMPARES A SUBJECT BYTE STRING OF UP TO 
*   8 BYTES WITH A REFRENCE BYTE STRING.
* 
*   CALLING SEQUENCE: 
* 
*      LDB <SUBJECT BYTE STRING STARTING BYTE ADDRESS>
*      LDA <REFERENCE BYTE STRING STARTING WORD, REPEAT 
*         WORD! ADDRESS>
*      JSB CHECK
* 
*   UPON RETURN:
* 
*      IF 'A' REG = 0, STRINGS DID NOT COMPARE. 
*      IF 'A' REG # 0, STRINGS COMPARED.
* 
CHECK NOP 
* 
*   INITIALIZE. 
* 
      STA SAVO      SAVE REF STRING WORD ADDR.
      LDA .-8       PUT SUBJECT STRING INTO BUFFER, 
      JSB TLOAD     'TOKEN'.
      LDA .-4       SET '#OF WORDS TO BE COMPARED'
      STA CNTR4     COUNTER.
      LDB TOKAD     SET 'B' TO WORD ADDR OF 'TOKEN'.
* 
*   COMPARE WORDS.
* 
CHEK2 LDA SAVO,I    GET NEXT REF. WORD. 
      CPA 1,I       SAME AS NEXT SUBJECT WORD?
      RSS           YES.
      JMP CHEK4     NO. 
      ISZ SAVO      INCR REF STRING WORD ADDR.
      INB           INC SUBJ WORD ADDR. 
      ISZ CNTR4     INCR COUNTER.  DONE YET?
      JMP CHEK2     NO. 
      CLA,INA       YES.  SET 'A' TO INDICATE 'YES, 
      JMP CHECK,I   WE GOT A COMPARE'.  RETURN. 
CHEK4 CLA           NO COMPARE.  SET 'A' TO 
      JMP CHECK,I   INDICATE THIS.  RETURN. 
SAVO  NOP 
CNTR4 NOP 
      SKP 
*   'CLEAN' FILLS A BUFFER WITH A GIVEN CHAR. 
* 
*   CALLING SEQUENCE: 
*      LDB <STARTING WORD ADDRESS OF BUFFER>
* 
*      LDA <+ NO. OF WORDS IN BUFFER> 
* 
*      JSB CLEAN
*      DEF <CHAR IN BOTH HIGH AND LOW BITS> 
* 
CLEAN NOP 
      CMA,INA 
      STA COUNT 
      LDA CLEAN,I   BRING IN CHAR.
      LDA 0,I 
CLE0  STA 1,I 
      INB 
      ISZ COUNT 
      JMP CLE0
      ISZ CLEAN     SET RETURN ADDRESS. 
      JMP CLEAN,I 
      SKP 
* 
*   ASCII TO BINARY CONVERSION ROUTINE. 
* 
*   CALLING SEQUENCE: 
*      A REG SHOULD BE 0 IF STRING OF OCTAL 
*        ASCII DIGITS IS TO BE CONVERTED TO BINARY; 
*        #0 IF STRING OF DECIMAL ASCII DIGITS.
*      B REG SHOULD CONTAIN THE STARTING BYTE ADDRESS 
*        OF THE STRING OF ASCII DIGITS TO BE
*        CONVERTED. 
*                   JSB CNVRT 
* 
*   ON RETURN RESULT IN A REG.
*   OVERFLOW SET ON ERROR 
*   B REG IS NOT SIGNIFICANT. 
* 
CNVRT NOP 
      STB TMPC1     SAVE BYTE ADDRESS 
      LDB .+8       PUT OCTAL BASE IN B.
      SZA           WAMT DECIMAL? 
      LDB .+10      YES, PUT DECIMAL BASE INB.
      STB TMPC2     SAVE BASE.
      CLA           CLEAR TEMPORARY 
      STA TMPC3 
      STA CFLG
CN1   LDB TMPC1     LOAD
      JSB LOADB     BYTE. 
      ADA .M48       VALUE OF BYTE
      SSA           <@60? 
      JMP CN4       YES 
      STA TMPC4     NO,SAVE BYTE. 
      LDA TMPC2     IS
      CMA,INA       BUTE
      ADA TMPC4      NON LEGAL
      SSA,RSS       DIGIT?
      JMP CN4       YES 
      LDA TMPC3     COMPUTE NEXT
      MPY TMPC2     TEMPORARY RESULT. 
      SZB           OVERFLOW? 
      JMP CN2       YES 
      CLO           NO, CLEAR O-BIT.
      ADA TMPC4     ADD IN NEW DIGIT
      SOC           OVERFLOW? 
      JMP CNVRT,I   YES RETURN
      STA TMPC3     SAVE INTERMEDIATE RESULT
      ISZ CFLG      SET GOOD DIGIT FLAG.
      ISZ TMPC1     BUMP BYTE ADDRESS.
      JMP CN1 
CN4   LDA CFLG      ILLEGAL DIGIT FOUND 
      LDB TMPC1     PUT BYTE ADDRESS IN B 
      SZA,RSS       DID WE GET ANYTHING?
      STO            NO, SET ERROR CONDITION
      LDA TMPC3     PUT RESILT IN A-REG 
      JMP CNVRT,I 
CN2   STO            OVERFLOW 
      JMP CNVRT,I 
      SKP 
* 
* 
*   "CODE" OBTAINS THE BINARY CODE EQUIVALENT FOR 
*   THE MNEMONIC IN A GIVEN FIELD, AND STORES IT IN 
*   THE APPROPRIATE FIELD STORAGE LOCATION, EG. "FLD1", ETC.
*   IT PRINTS AN ERROR MESSAGE IF THE MNEMONIC WAS INVALID. 
* 
*   CALLING SEQUENCE: 
*      LDA <MNEMONIC TYPE; FOR DETAILS, SEE UNDER 
*          "$SRCH" SUBROUTINE>
*      LDB <FIELD NO.>
*      JSB CODE 
* 
*   UPON RETURN: THE CODE WILL BE IN THE FIELD STORAGE
*   LOCATION; A AND B REGS ARE NOT SIGNIFICANT. 
* 
CODE  NOP 
      STA CSAVA 
      STB CSAVB 
      ADB F0ADR     GET STARTING BYTE ADDRESS OF
      LDB 1,I       FIELD.
      LDA CSAVA 
      JSB $SRCH     GO GET BINARY CODE. 
      CPA .-1       MNEMONIC ERROR? 
      RSS 
      JMP CO7       NO. 
      LDA CSAVB 
      INA 
      JSB ERROR     PRINT ERROR MESSAGE.
      LDA CSAVA     GET NOP BINARY CODE FOR 
      ADA DEFLT     CURRENT MNEMONIC TYPE.
      LDA 0,I 
CO7   LDB CSAVB     STORE CODE IN PROPER
      ADB FWORD     FIELD WORD. 
      STA 1,I 
      JMP CODE,I
* 
      SKP 
* 
* 
* THIS ROUTINE CONVERTS BINARY
* TO 4 DIGIT DECIMAL
* 
*   CALLING SEQUENCE: 
*      LDA <+BINARY # TO BE CONVERTED>
*      LDB <STARTING BYTE ADDRESS OF ASCII DIGIT STRING>
*      JSB DECML
* 
DECML NOP 
      STB D.000     SAVE ADDRESS
      CLB           DIVIDE
      DIV .1000     BY 1000 
      ADA B60       A=1000TH DIGIT. MAKE ASCII
      STB D.001     SAVE REMAINDER
      LDB D.000     PICK UP ADDRESS 
      JSB STORB     STORE 1000TH DIGIT. 
      STB D.000     SAVE NEXT ADDRESS 
      CLB           DIVIDE
      LDA D.001     REMAINDER 
      DIV .100      BY 100. 
      ADA B60       A= HUNDRED DIGIT. MAKE ASCII
      STB D.001     SAVE REMAINDER
      LDB D.000     PICK UP ADDRESS 
      JSB STORB     STORE HUNDREDS DIGIT
      STB D.000     SAVE NEXT ADDRESS 
      CLB           DIVIDE
      LDA D.001     BY
      DIV .+10      10. 
      ADA B60       A= TENS DIGIT. MAKE ASCII 
      STB D.001     SAVE 1'S DIGIT
      LDB D.000     PICK UP ADDRESS 
      JSB STORB     STORE TENS DIGIT
      LDA D.001     PICK UP 1'S DIGIT 
      ADA B60       MAKE ASCII
      JSB STORB     STORE IT
      JMP DECML,I   RETURN
      SKP 
*   'DEF' FIRST CHECKS IF THE FIELD WHOSE BYTE ADDRESS
*   IS IN B REG, IS A 'DEF'.  IF NOT, THEN RETURN IS
*   MADE WITH A REG # 0.  IF SO, THEN THE DEF STATEMENT 
*   IS PROCESSED AND RETURN IS MADE WITH A = 0. 
* 
*   CALLING SEQUENCE: 
* 
*      LDB <BYTE ADDRESS OF FIELD CONTAINING SUSPECTED DEF.>
* 
*      JSB DEF
* 
*   UPON RETURN: A REG = 0 MEANS THE FIELD CONTAINED
*                          A 'DEF' AND THAT THIS
*                          DEF STATEMENT HAS BEEN PROCESSED.
*                A REG # 0 MEANS THE FIELD DID NOT CONTAIN
*                          A 'DEF'. 
*   IN EITHER CASE, UPON RETURN, B REG CONTAINS GARBAGE.
* 
DEF   NOP 
* 
*   FIRST DETERMINE IF WE HAVE A 'DEF' IN THE FIELD.
* 
      JSB LOADB 
      CPA .D        1ST CHAR = "D"? 
      RSS           YES.
      JMP DEF9      NO. 
      INB           YES.
      JSB LOADB 
      CPA .E        2ND CHAR = "E"? 
      RSS           YES.
      JMP DEF9      NO. 
      INB 
      JSB LOADB 
      CPA .F        3RD CHAR = "F"? 
      RSS           YES.
      JMP DEF9
* 
*   WE HAVE A DEF STATEMENT.
* 
      LDB F6ADR     GO PROCESS ADDRESS IN FIELD 6.
      JSB NUM 
      SOC           ANY PROBLEMS? 
      JMP DEF8      YES.
      STA 1         NO. 
      AND M7777     IS NO. IN RANGE 0-7777 OCT? 
      SZA 
      JMP DEF8      NO, SO ERROR. 
      STB INST1     YES, SO OK.  STORE ADDRESS. 
      STA INST2 
      JMP DEF,I     RETURN. 
DEF8  LDA .+7       PRINT ERROR MESSAGE.
      JSB ERROR 
      JSB NOPER     MAKE A 'NOP' MICROINSTRUCTION.
      CLA 
      JMP DEF,I 
DEF9  CLA,INA       NO DEF STATEMENT. 
      JMP DEF,I 
      SKP 
* 
*   THIS ROUTINE EJECTS PAGE ON LIST
*   DEVICE
*   CALLING SEQUENCE: 
*      JSB EJECT
* 
EJECT NOP 
      LDB LIST      SUPPRESS
      SZB,RSS       LISTING?
      JMP EJECT,I    YES, EXIT. 
      JSB TTYIO     WE EJECTING ON TTY? 
      SZA,RSS 
      JMP EJTT      YES.
EJLP  LDA .+2 
      JSB IOSUB 
      DEF LIST
      DEF LPEJ
      DEF .-2 
      JMP EJ2 
EJTT  NOP 
      LDA SP4 
      STA SAVA
      CLA 
      STA SP4 
      LDA LIST
      LDB .P24
      JSB SPACE 
      LDA SAVA
      STA SP4 
EJ2   NOP 
      LDA LPP 
      CMA,INA 
      STA #LNES 
      JMP EJECT,I 
      SKP 
* 
*   'EMCDE' PUNCHES THE OBJECT TAPE IF THE PUNCH
*   BUFFER IS FULL OR IF WE JUST READ AN '$END' 
*   RECORD.  THEN IT RE-INITIALIZES THE PUNCH 
*   BUFFER AND EXITS. 
* 
*   CALLING SEQUENCE: 
*      JSB EMCDE
* 
EMCDE NOP 
      LDA PNBUF     PUNCH BUFUR 
      CPA .59       FULL? 
      JSB EMPBF     YES EMPTY IT
      LDA LASTP     IS THIS 
      INA           NEXT
      STA 1         SEQUENTIAL INSTRUCTION? 
      LDA PCNTR 
      AND =B377 
      CPA 1 
      RSS 
      JSB EMPBF     NO,EMPTY PUNCH BUFUR. 
      LDA CKSUM     KEEP
      ADA INST1     RUNNING 
      ADA INST2     CHECK-
      STA CKSUM     SUM.
      LDA INST2     PUT 
      LDB INST1     INSTRUCTION 
      STA PNADR,I   INTO
      ISZ PNADR     PUNCH 
      STB PNADR,I   BUFUR.
      ISZ PNADR     POINT TO NEXT POSITION. 
      LDA PCNTR     SAVE CURRENT
      AND =B377     LOW BITS OF 
      STA LASTP     PCNTR FOR NEXT TIME.
      ISZ PNBUF     INCREMENT RECORD CNT. 
      ISZ PNBUF 
      JMP EMCDE,I   EXIT
      SKP 
* 
*  THIS ROUTINE  EMPTIES CURRENT CONTENTS 
*  OF PUNCH BUFUR AND SETS UP HEADER FOR NEXT.
* 
*   CALLING SEQUENCE: 
*      JSB EMPBF
* 
EMPBF NOP 
      LDA RCFLG     WE PUNCHING SUITCASE ROM TAPE 
      CPA .+2       AND IS THIS 'LAST PUNCHOUT'?
      JMP EMP05     YES.
      LDA PNBUF     NO. 
      STA RLEN      SAVE RECORD COUNT.
      CPA .+5       ANY DATA IN 'BUFUR'?
      JMP PB0       NO.  GO SET HEADER. 
      LDA RCFLG     USER WANT SUITCASE ROM TAPE 
      SZA,RSS       PUNCHED?
      JMP EMP1      NO, WANTS REGULAR OBJECT TAPE.
      JMP EMP00     YES.
EMP05 CLA 
      JMP EMP0
EMP00 LDA PNAD      PUT ADDR OF OBJ CODE BUFFER IN 'A'. 
EMP0  JSB SDUMP     GO PUNCH SUITCASE ROM TAPE. 
      JMP PB0 
EMP1  LDA RLEN      GET RECORD LENGTH.
      ALF,ALF 
      STA PNBUF     SET HIGH COUNT. 
      LDA CKSUM     PUT IN
      STA PNBUF+2   CHECKSUM. 
      LDA PCH       SUPPRESS
      SZA,RSS       PUNCHING? 
      JMP PB0 
      JSB TTYPL     LIST AND PUNCH ON TTY?
      SZA 
      JMP EMP22     NO. 
      HLT 52B       YES. LET USER TURN ON PUNCH.
      CLA,INA       SET 'TTY BINARY PUNCH' FLAG.
      STA PNFLG 
EMP22 LDA .+2       GO PUNCH OUT. 
      JSB IOSUB 
      DEF PCH 
      DEF PNBUF 
      DEF RLEN
      JSB TTYPL     IST AND PUNCH ON TTY? 
      SZA,RSS 
      HLT 53B       YES. LET USER TURN OFF PUNCH. 
      CLA           CLEAR 'TTY BINARY PUNCH ' FLAG. 
      STA PNFLG 
PB0   LDA .+5       SET  UP 
      STA PNBUF     HEADER
      LDA PCNTR     FOR NEXT
      STA PNBUF+3   RECORD. 
      ADA DBUG
      ADA PNBUF+1 
      STA CKSUM 
      LDA DBUG
      STA PNBUF+4 
      LDA PBASE     POINT 
      ADA .+5       TO
      STA PNADR     BUFUR POSITION
      JMP EMPBF,I   EXIT
      SKP 
*   'EQU' PROCESSES AN EQU STATEMENT. 
* 
*   CALLING SEQUENCE: 
*      LDB <STARTING BYTE ADDRESS OF FIELD SUSPECTED
*           OF CONTAINING 'EQU'>
* 
*      JSB EQU
* 
*   UPON EXIT, A REG = 0 MEANS FIELD CONTAINS 'EQU'.
*            AND EQU STATEMENT HAS BEEN PROCESSED.
*              A REG # 0 MEANS FIELD DOESN1T CONTAIN 'EQU'. 
*   IN EITHER CASE, B REG CONTAINS GARBAGE UPON EXIT. 
* 
* 
EQU   NOP 
      JSB LOADB 
      CPA .E        1ST CHAR = "E"? 
      RSS           YES.
      JMP EQT9      NO. 
      INB 
      JSB LOADB 
      CPA .Q        2ND CHAR = "Q"? 
      RSS           YES.
      JMP EQT9      NO. 
      INB 
      JSB LOADB 
      CPA .U        3RD CHAR = "U"? 
      RSS           YES.
      JMP EQT9      NO. 
      CLA           WE HAVE AN 'EQU'. 
      LDB PASSN 
      CPB .+2       IS THIS PASS 2? 
      JMP EQU,I     YES.  THEN EXIT NOW.
      JMP EQU1      NO, PASS 1.  GO PROCESS . 
EQT9  CLA,INA       NO 'EQU'. 
      JMP EQU,I 
EQU1  LDB F6ADR     GET OCTAL # FROM FIELD 6. 
      JSB NUM 
      SOC           EVERYTHING OK?
      JMP EQU10     NO. 
      IOR B1KKK     YES. PUT 1 IN BIT 15 AS FLAG. 
      JMP EQU25 
EQU10 LDA .-7       NO, THEN ERROR.  OUTPUT 
      JSB ERROR     ERROR MESSAGE.
      LDA CRLEN     OUTPUT THE BAD EQU STATEMENT
      ADA .-2       WITH PAIR OF EXTRA SPACES AT
      STA EQU15     BEGINNING IN CASE OF LINE PRINTER 
      LDA .+2       AS LIST DEVICE. 
      JSB IOSUB 
      DEF LIST
      DEF CARD-1
      DEF EQU15 
      LDA LIST
      CLB,INB 
                                                                                                                            