ASMB,R,B,L,C     RTE ASSEMBLER SEPT 1976
* 
*     NAME:   ASMB2 
*     SOURCE: 92060-18025 
*     RELOC:  92060-16025 
*     PGMR:   C.C.H.
* 
*     MODIFIED BY EARL STUTES 1976-09-20-1600 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  ALL RIGHTS     *
*  * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       *
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
*  ***************************************************************
      HED * RTE ASMB2 92060-18025 * (C) HEWLETT-PACKARD COMPANY 1975. 
* 
      NAM ASMB2,5,99 92060-16025 REV.B 760924 
      ENT ASMB2 
      ENT ?ART,?BREC,?LKLI
      EXT ?DCOD,?GETC,?LINC,?LIST,?LOUT,?OKOL,?OPLK 
      EXT ?SUP,?BPKU,?PKUP,?PNCH,?SYMK,?BFLG
      EXT ?LFLG,?LTFL,?LTSA,?LTSB,?RSTA,?ERPR,?CHOP 
      EXT ?CHPI,?OPER,?PLIT,?ASCN,?MSYM,?ASM1,?ICSA 
      EXT ?LINS,?ARTL,?LST,?LPER,?PERL,?SETM,EXEC 
      EXT ?LGFL,?BASF,?SYML 
      EXT ?X,?MOVE,?PLIN,?PCOM,?WRIF
      EXT ?ASCI,?ASII,?PNLE,?ENDS,?ASMB 
      SUP 
TEMP  BSS 225B      RESERVE TEMPORARY AREA
#     EQU TEMP     SAME AS DATA ORIGIN
VALU  EQU TEMP+5
...1  EQU TEMP+7
.1    EQU ...1
.12   EQU .1+7
..M1  EQU .12+6 
L     EQU ..M1+6
.9    EQU #+41B 
.M8   EQU #+43B 
.M29  EQU #+45B 
BLNK  EQU #+46B     =40B(LOWER BLANK) 
.IL   EQU #+47B     ILLEGAL OPERAND MSG CONSTANT 1976-09-20-1500
.NO   EQU #+51B 
.OP   EQU #+52B 
.OV   EQU #+53B 
.UN   EQU #+54B 
BLNS  EQU #+55B 
TW10  EQU #+56B    ADDRESS MASK 
.1000 EQU #+57B 
BIT15 EQU #+60B 
.E    EQU #+61B 
RC    EQU #+64B 
RELC  EQU #+76B     RELOCATION FLAG 
SIGN  EQU #+77B 
SUMP  EQU #+100B   RUNNING SUM FOR 'CHOP' 
TERM  EQU #+101B   NO. OF TERMS IN AN OPERAND 
T     EQU #+102B
BYFLG EQU #+104B   BYTE FLAG FOR 'BREC' 
CNTB  EQU #+106B
CODE  EQU #+107B   OPCODE TYPE(FROM OPTABLE)
DSIG  EQU #+110B    'ASCN'
FLAG  EQU #+111B
FLAQ  EQU #+112B
INST  EQU #+113B   OPCODE FORMAT
LAST  EQU #+114B
PASS  EQU #+115B   PASS FLAG(0=PASS 1  AND 1=PASS2) 
PLCN  EQU #+117B   PROGRAM LOCATION COUNTER 
PLEN  EQU #+120B   LIT LENGTH PASS 1/LIT ORG PASS 2 
PNTR  EQU #+121B   POINTS AT LAST OR CURRENT CHAR.
RCNT  EQU #+122B
SAVB  EQU #+123B
SCN1  EQU #+125B   STATE LNG/OPCODE/OPERAND/LABEL(4)
SVST  EQU #+131B
SYMP  EQU #+133B   SYMBOL LNG/ AND LOC'N
TEST  EQU #+135B   TEST CHARACTER 
*             * I/O STATEMENT BUFFER *
IOBF  EQU #+142B    50 WORDS + END OF STATEMENT BUFF
PBUF  OCT 0,0,0,0 
WCNT  EQU PBUF  WORD(BLK) CNT FOR BIN.RECRD.
ASM1  EQU ?ASM1 
ASMBX EQU ?ASMB 
BFLAG EQU ?BFLG 
CHOP  EQU ?CHOP 
CHOPI EQU ?CHPI 
ERPR  EQU ?ERPR 
GETC  EQU ?GETC 
LINC  EQU ?LINC 
LIST  EQU ?LIST 
LOUT  EQU ?LOUT 
LST   EQU ?LST
LTFLG EQU ?LTFL 
MSYML EQU ?SYML 
OKOLE EQU ?OKOL 
OPERR EQU ?OPER 
RSTA  EQU ?RSTA 
SYMK  EQU ?SYMK 
A     EQU 0 
B     EQU 1 
* 
      SKP 
*             ******************* 
*             * CONTINUE PASS 2 * 
*             ******************* 
ASMB2 LDA ?LPER     LENGTH OF 'CLEAR'AREA 
      LDB ?PERL     GET ORIGIN OF 'CLEAR' AREA
      JSB ?SETM     GO TO SET MEMORY ROUTINE
      OCT 0         TO SET MEMORY TO ZERO 
      CLA 
      STA PLCN      INITIALIZE PROG LOC'N COUNTER 
      CLA,INA 
      STA PASS      SET PASS FLAG 
      JSB RSTA      READ CONTROL STATEMENT
      LDA TW10
      STA ASM1      SET FLAG FOR 'INIT' PORTION 
ASH   JSB RSTA      READ A SOURCE STATEMENT(NAM?) 
      LDA CODE
      CPA .12+3     HED?
      JMP ASH       YES, GO PICK UP THE NEXT STATEME
      STA ASM1      CLEAR 'CS' AND 'INIT' FLAG
      CPA .12+1     (13) NAM ?
      JMP HC02       YES, GO TO LIST IT.
      LDA .NO       'NO'= NO ORG OR NAM STATEMENT 
      JSB ERPR
      JMP HC05      ERROR EXIT FROM INIT
      BSS PBUF-*+61 RESERVE REMAINING PUNCH BUFFER
* 
      SKP 
*        ****************************** 
*        * SKIP AND SPACE LIST OUTPUT * 
*        ****************************** 
SKPR  LDB LINC      'SKIP'ENTRY 
      CMB,INB 
      JMP SK2 
SPCR  JSB CHOPI     EVALUATE SPACE COUNT
      CLB,INB       ERROR - SET COUNT=1 
SK2   SZB,RSS       SPACES=0? 
      JMP HC04       YES, EXIT TO HC04(START OF PASS) 
      LDA ?LFLG      NO, START LINE SKIPPING
      SZA,RSS       LIST REQUESTED? 
      JMP HC04      EXIT TO HC04(START OF PASS) 
      LDA LST       LST FLAG
      SZA           SUPPRESS LISTING? 
      JMP HC04       YES, EXIT TO HC04(START OF PASS) 
      STB DSIG      SET COUNTER 
      LDA LINC
      CPA ..M1      ON LAST LINE? 
      JMP HC04       YES - EXIT 
      ADB LINC
      SSB,RSS       WILL IT GO TO BOTTOM OF PAGE? 
      JMP *+5       YES,GO TO SKIP TO BOTTOM. 
      STB LINC      NO, SAVE NEW LINE COUNT 
      LDA DSIG      GET NO. OF LINES TO BE SKIPPED
      JSB ?LINS     GO TO LINE SKIPPER
      JMP HC04      EXIT TO GET NEXT STATEMENT
      JSB OKOLE     SKIP TO BOTTOM OF PAGE. 
      JMP HC04      EXIT TO GET NEXT STATEMENT
*        *************************
*        * BINARY OUTPUT ROUTINE *
*        *************************
.M54  DEC -54 
      OCT 60100     RIC=5, CURRENT PAGE 
BREC  NOP 
      STA EXTFL     SAVE FOR EXTERNAL CHECKS. 
      CPA .10B      TWO WORD EXTERNAL ? 
      LDA ...1+4     YES, SET RELOC. INDICATOR TO 5 
      STA SAVB+1    SAVE RELOC'N BYTE 
      LDA BFLAG     GET PUNCH REQUEST FLAG
      ADA ?LGFL     LOAD/GO FLAG
      SZA,RSS       WAS PUNCH REQUESTED?
      JMP BREC,I     NO.
      LDA WCNT
      SZB           RECORD OUT ?
      JMP HI66       NO.
      SZA,RSS       WCNT=0? 
      JMP BREC,I     YES. 
* 
*             * OUTPUT A RECORD 
* 
HI60  LDA WCNT
      ALF,ALF       ROTATE 8
      STA WCNT      STORE WCNT IN UPPER PBUF
      LDA SVST,I    POSITION REMAIN RELOCATION BYTES
      ALF,RAR 
      ISZ RCNT
      JMP *-2 
      RAL 
      STA SVST,I    STORE RELOC.BYTES 
* 
*             * SET REC.ID CODE (WORD 2) *
      LDB BREC-1    GET RIC/PAGE INDICATOR
      CLA,INA 
      CPA ?BASF     IF BASE PAGE RELOCATABLE, 
      LDB MICRD+2     SET RIC = 060000 .
      ADB PBUF+1    SET REMAINDER 
      STB PBUF+1
      JSB ?PNCH     GO TO 'PUNCH' 
      JMP BREC,I     AND EXIT 
* 
*             * PROCESS A BINARY OUTPUT WORD *
* 
      DEF PBUF+4
HI66  LDA WCNT
      SZA           FIRST WORD OF RECORD? 
      JMP HI70       -NO- 
      LDB PLCN      PLCN TO BREG
      STB PBUF+3    SET DBL ADDR. 
      STA PBUF+1    SET PBUF+1=0
      LDB ...1+3    (4) 
      STB WCNT      SET WCNT = 4
      LDB HI66-1
      STB STOR      SET STOR=L(PBUF+4)
      LDB ..M1+4    (-5)
      STB RCNT      SET RCNT=-5 
      LDB .M54      -54 
      STB CNTB      SET CNTB FOR WORD COUNT 
HI70  LDB RCNT
      CPB ..M1+4    RCNT= -5? 
      JMP HI74       -YES-SET UP ADDRESSES
* 
*              * STORE RELOC.BYTE / UPDATE *
* 
HI71  ISZ PBUF+1    UPDATE # OF DATA WRDS 
      LDA SVST,I    GET RELOC. BYTE WORD
      ALF,RAR       POSITION FOR NEXT WORD
      IOR SAVB+1    GET THE NEW BYTE
      STA SVST,I    STORE BACK IN BYTE WORD 
      ISZ RCNT      BYTE WORD FULL? 
      JMP HI76       -NO- 
      LDB ..M1+4     -YES- <B>=-5 
      STB RCNT       RESET RCNT TO -5 
      RAL 
      STA SVST,I
      LDA CNTB
      CPA ..M1
      RSS 
      ISZ CNTB
HI76  LDB INST
      ISZ WCNT      ADVANCE WORD COUNT
      LDA EXTFL     GET TWO-WORD EXT. FLAG. 
      CPA .10B      TWO-WORD EXTERNAL ? 
      JMP EXT2      YES, GO TO PROCESS. 
      STB STOR,I     NO, STORE INSTRUCTION. 
      ISZ STOR
      CCE           PREPARE FOR BYTE ADDRESS WORD, IF ANY.
      CPA ...1+4    (5) 2 WORD INSERT?
      JMP HI77      YES, GO TO PROCESS. 
      CPA .1+5      (6) BYTE ADDRESS ?
      JMP BYTAD      YES, GO PROCESS. 
      JMP HI78      TO EXIT TEST
* 
*     * PROCESS 2-WORD EXTERNAL (R = 5) OR BYTE ADDRESS (R = 6) * 
* 
EXT2  LDA SIGN      GET OFFSET FLAG (EXT ORDN'L)
      CLE,SZA       IS THIS AN EXT W/OFFSET? [E_0]
      CCE,RSS        YES, SET <E>=1 AND SKIP. 
      LDA SUMP       NO: I/O EXT. USE ORDN'L IN SUMP. 
      ALS,ALS       POSITION ORDINAL TO BITS 9-2. 
      SEZ           MEM. REF. EXTERNAL WITH OFFSET ?
      IOR INST       YES, INCLUDE INSTRUCTION CODE. 
      IOR .1+2      ADD ABSOLUTE 'MR' INDICATOR (3).
      STA STOR,I    STORE FIRST WORD OF PAIR. 
      ISZ STOR      ADVANCE PUNCH-BUFFER POINTER. 
BYTAD LDA SUMP      GET OFFSET VALUE, OR BYTE ADDRESS IF ANY. 
      SEZ,RSS       MEM. REF. EXT. W/OFFSET OR BYTE ? 
      LDA INST       NO,I/O. USE INSTRUCTION. 
      STA STOR,I    STORE SECOND WORD OF PAIR.
      JMP HI77A     GO TO COMPLETE THE PROCESS. 
* 
HI77  LDA SUMP      GET RELOCATABLE VALUE.
      STA STOR,I
      AND BRMSK     CLEAR UPPER 6 BITS OF 'SUMP'
      BRS,BRS       CLEAR LOWER 2 BITS OF INST
      BLS,BLS 
      IOR 1         'OR' B TO A 
      STA INST
HI77A ISZ WCNT      ADVANCE WORD COUNT. 
      ISZ STOR      ADVANCE PUNCH-BUFFER POINTER. 
      ISZ CNTB      BUMP CNTB 
      RSS 
      JMP HI60
HI78  ISZ CNTB      IS THIS THE LAST WORD?
      JMP BREC,I     NO- EXIT 
      JMP HI60       YES- GO TO PUNCH 
HI74  LDB STOR
      STB SVST
      CLA 
      STA SVST,I    CLEAR RELOC BYTE WORD 
      ISZ STOR
      ISZ WCNT
      JMP HI71
STOR  BSS 1 
BRMSK OCT 1777
.10B  OCT 10
EXTFL NOP           TWO-WORD EXTERNAL FLAG. 
   SKP
HC02  LDA ...1+1    LIST PARAMETER
HC03  JSB LIST
* 
*             * READ NEXT STATEMENT * 
HC04  JSB RSTA      READ NEXT STATEMENT 
* 
*             * TEST MNEMONIC CODES FOR PROCESS TYPE *
HC05  LDA CODE
      LDB INST
      SZA,RSS       (0) ORB ? 
      JMP HC42      YES.
      CPA .100B     CODE = 'MIC' ?
      JMP X39        YES, GO LIST IT. 
      ADA M100B     SUBTRACT 100 OCTAL
      SSA,RSS       CODE >100B ?
      JMP XMIC       YES, ITS A MICROCODE MACRO.
      LDA CODE      GET OPCODE I.D. NO. AGAIN.
      CPA L+3       (43)  SOC OR SOS ?
      JMP HC28       YES
      AND .M8       (177770)
      CPA L         I/O ? 
      JMP IOPR       YES
      ARS,ARS       SHIFT A RIGHT 4 BITS
      ARS,ARS 
      CPA .1+2      60/70(MICRO-OP?)
      JMP MICR      YES 
      LDA CODE      GET JUMP TABLE ADDRESS
      ADA CODLC     ADD OPCODE INCREMENT
      JMP A,I       JUMP TO PROCESSOR 
.100B OCT 100 
M100B OCT -100
* 
*             * PROCESS MEMORY REFERENCE INSTRUCTIONS * 
MEMRY LDA INST
      LDB LTFLG 
      SZB           LITERAL PRESENT?
      JMP HCY        YES
      AND ..M1+1     NO, CLEAR LDSB OF 'INST' 
      STA INST
      LDA .I        SET FOR INDIRECT BIT
      LDB BIT15     INDIRECT BIT MASK(100000B)
      JSB CHOP
      JMP HC17E     ERROR EXIT
HCX   STB SUM.      OPERND VALUE
      CLB           LIST PARAMETER=0
HCXL  STB TERM      SAVE THE LIST PARAMETER 
      LDB SUM.      GET THE OPERAND VALUE 
* 
*              * RELOC.CODE IS IN RELC *
      SZA           ABS?
      JMP HC11       NO 
      ADB TW10       YES, SUBTRACT 2000B. 
      SSB,RSS      IS THE OPERAND LESS THAN 2000B?
      JSB OPERR     NO, IT'S AN "M" TERM ERROR
HC11  LDA SUM.
      LDB CODE
      CPB .12+4     (16) DEF? 
      JMP HC14A      YES, GO CHECK FOR EXT W/OFFSET.
      LDA RELC
      CPA ...1+1    (2) B.P. RELOCATABLE ?
      JMP *+3        YES. 
      SZA           ABSOLUTE? 
      JMP HC15       NO 
      SPC 1 
*             * TEST FOR OPERAND >1023 *
      SPC 1 
      LDA SUM.
      ADA TW10      (176000)
      SSA,RSS 
      JMP OI.SP 
      LDA INST      CLEAR 
      AND CBIT       CURRENT-PAGE BIT [MASK=175777] 
      STA INST
      JMP HC14
      SPC 1 
*             * TEST FOR OPERAND & INSTR IN SAME PAGE * 
      SPC 1 
OI.SP LDA RELC
      CPA ...1+1    (2) B.P. RELOCATABLE ?
      JMP HC13      YES, ERROR. 
      LDA PLCN
      AND TW10
      CMA,INA 
      ADA SUM.
      AND TW10
      SZA,RSS 
      JMP *+3 
HC13  LDA .OV       'OV' ERROR. 
      JSB ERPR
      LDA BRMSK     STRIP UPPER SIX BITS. 
      AND SUM.
      STA SUM.
HC14  LDA RELC
      CPA ...1+1    (2) B.P. RELOCATABLE ?
      JMP HC15+2
HC14A LDA SIGN      GET OFFSET FLAG (EXT ORDINAL).
      SZA           IS OPERAND EXT W/OFFSET ? 
      JMP HC17A      YES, IGNORE ORDN'L FOR NOW.
      LDA SUM.       NO, GET OPERAND VALUE. 
      LDB CODE      GET OPCODE ID NUMBER. 
      CPB .12+4     ARE WE PROCESSING A 'DEF'(16B) ?
      JMP HC17       YES, SET UP ADDRESS FOR 'BREC'.
HC14B LDA SUM.       NO, GET OPERAND VALUE; 
      AND BRMSK       MASK TO FORM ADDRESS, AND 
      JMP HC17         INSERT INTO INST.
HC15  CPA .1+3      EXTERNAL ? (4)
      JMP HC14A      YES, GO CHECK FOR OFFSET.
      LDB ...1+4    (5) 
      STB BYFLG 
      LDB BFLAG     GET THE PUNCH FLAG
      ADB ?LGFL     LOAD/GO FLAG
      SZB,RSS       PUNCH REQUESTED?
      JMP HC14B     NO, GO TO SET ADDR INTO INST
      ADA ..M1      FORM 'MR' INDICATOR FOR OPERAND 
HC17  IOR INST
      STA INST      SET LOADER FLAG 
      LDA SIGN      GET OFFSET FLAG.
HC17A LDB .10B      GET TWO-WORD EXT INDICATOR. 
      SZA           EXTERNAL W/OFFSET IN PROCESS ?
      STB BYFLG      YES, SET FLAG FOR BREC.
* 
*             * SET UP FOR DCOD*
      LDA RELC
HC19  JSB ?DCOD 
* 
*             * OUTPUT A BINARY WORD *
      STB SAVB
      CLB,INB 
      JSB BREC
* 
*             * OUTPUT A LINE FOR LISTING * 
      LDA INST      GET INSTRUCTION PATTERN.
      LDB SIGN      GET OFFSET FLAG.
      SZB           PROCESSING MEM. REF. W/OFFSET?
      IOR B          YES, INCLUDE EXT ORDN'L NO.
      STA INST      SAVE INSTRUCTION FOR LISTING. 
      LDB SAVB      GET RELOC. CHARACTER. 
      LDA TERM      GET THE LIST PARAMETER
      JSB LIST      GO TO LIST THE LINE.
      LDA SIGN      GET OFFSET FLAG.
      SZA,RSS       PROCESSING MEM. REF. EXT W/OFFSET ? 
      JMP HC20       NO,  GO TO ADVANCE LOC'N COUNTER.
      LDA SUM.       YES, GET OFFSET VALUE. 
      STA INST      SAVE IN INST FOR LISTING. 
      LDB PLUS      SET <B> = ASCII: +BLANK.
      LDA .1+5      6=LIST CODE FOR INSTRUCTION ONLY. 
      JSB LIST      GO TO LIST OFFSET VALUE.
HC20  ISZ PLCN      ADVANCE LOCATION COUNTER. 
      JMP HC04      GO TO READ NEXT STATEMENT.
PLUS  ASC 1,+       OFFSET LIST INDICATOR.
*        *****************
*        * BSS PROCESSOR *
*        *****************
BSSP  JSB CHOPI     EVAL. OPERAND 
      JMP HC02      ERROR 
      SZB,RSS       B=0?
      JMP HC02      YES 
      CLB           B=0 
      JSB BREC
      CLA           A=0 
      LDB BLNS      NO RELOC. INDIC.
      JSB LIST
      LDA SUMP      PICK UP BLOCK LENGTH FOR PLCN 
      ADA PLCN
      STA PLCN
      JMP HC04      EXIT
* 
      SKP 
*        ************************ 
*        * PROCESSOR JUMP TABLE * 
*        ************************ 
* 
CODLC DEF *,I 
      DEF HC42      ORG       1 
      DEF HC42      ORR       2 
      DEF X39       *COM      3 
      DEF X39       *ENT      4 
      DEF X39       *EXT      5 
      DEF INST,I    *ARITH    6 
      DEF NUMP      ASC       7 
      DEF NUMP      DEC       10
      DEF NUMP      OCT       11
      DEF BSSP      BSS       12
      DEF EQUP      EQU       13
      DEF FIN2      END       14
      DEF X39       *NAM      15
      DEF MEMRY     MEMORY    16
      DEF X50       HED       17
      DEF MEMRY     DEF       20
      DEF HC26      ABS       21
      DEF SKPR      SKP       22
      DEF SPCR      SPC       23
      DEF X54       LST/UNL   24
      DEF NUMP      DEX       25
      DEF HC70      HDW ARITH 26
      DEF HC80      HDW SHIFT 27
      DEF HC30      CLO ETC   30
.I    OCT 111       ASCII 'I' 31
      DEF RPLP      RPL       32
CBIT  OCT 175777              33
M17   DEC -17                 34
      DEF X52       REP       35
.JSB  OCT 16000               36
.C    OCT 103       ASCII 'C' 37
      DEF X56       SUP/UNS   40
      DEF BYTE      DBL       41
      DEF BYTE      DBR       42
      DEF BYTEG     BYT       43
SUM.  BSS 1 
DEX   OCT 25        'DEX' OPCODE TYPE 
      SKP 
*        ****************************** 
*        * ARITHMETIC MACRO PROCESSOR * 
*        ****************************** 
ART   JSB SYMK      GO TO SYMBOL TABLE LOOKUP 
      RSS           ERROR RETN(UNDEF) 
      JMP *+4       NORMAL RET'N
      LDA .UN       'UN'= UNDEFINED SYMBOL
      JSB ERPR
      CLB           SET B = 0 
      ADB .JSB      'JSB' INSTRUCTION MASK
      STB INST
      LDA ...1+3    (4)  A=EXT
      JSB BREC      PUNCH 
      LDB RC+4      ' X'
      CLA 
*        ********************************************** 
*        * PROCESS THE 'DEF' FOLLOWING THE FIRST WORD * 
*        *  OF AN ARITHMETIC PAIR                     * 
*        ********************************************** 
ARTX  JSB LIST      GO TO LIST FIRST WORD 
      LDA .12+4     (20B) 
      STA CODE      =DEF
      CLA 
      STA INST      CLEAR INST
      LDA LTFLG 
      SZA           LITERAL PRESENT?
      JMP ALTR       YES
      LDA .I        SET UP FOR INDIRECT BIT 
      LDB BIT15     MASK= 100000B 
      JSB CHOP
      NOP 
ALTZ  ISZ PLCN      BUMP LOCATION COUNT 
      STB SUM.      SAVE OPERAND VALUE
      LDB .1+3      LIST PARAMETER=4
      JMP HCXL
ALTR  LDA ?LTSA     PICK UP 
      LDB ?LTSB      LITERAL PARAMS.
      JMP ALTZ        FROM LKLIT
* 
*             * LITERAL PROCESSING *
* 
HCY   SLA,RSS       LSB OF INST INDIC LITERAL POSSIBLE
      JMP HCZ        NO, ERROR
      AND ..M1+1    CLEAR LSB OF INST 
      STA INST
      JSB ?PLIT 
      JMP HCZ+1     ERROR EXIT
      JMP HCX 
HCZ   JSB OPERR     'M' ERROR 
HC17E CLA           LIST PARAMETER =0 
      STA TERM      SAVE IT 
      JMP HC17
* 
      SKP 
* 
*             * PROCESS 'ABS' OPCODE *
* 
HC26  JSB CHOPI     GO EVALUATE OPERAND 
      JMP HP2D      ERROR 
      STB INST
      JMP HP2D      OK..
* 
*             * OUTPUT BIN RECRD AND/OR LIST LINE * 
* 
HC30  JSB LOUT
      JSB LIST
* 
*             * ADD 1 TO PROG. LOCN. CNTR. *
      ISZ PLCN      BUMP LOCATION CNTR
      JMP HC04
* 
X39   CLA,INA       1 TO A
      JMP HC03
* 
*             * ORG,ORB,ORR PRE-PROCESSOR * 
* 
HC42  CLB           OUTPUT A
      JSB BREC       RECORD 
      JSB INST,I    JUMP TO CORRECT SUBROUT.
      JMP HC02      BACK TO START LIST
X50   LDA ?LFLG     GET THE LIST FLAG 
      SZA,RSS       IS LIST FLAG OFF? 
      JMP HC04       YES - GO TO NEXT STATEMENT 
      JSB INST,I    TO HEADER SUBROUTINE
      LDA LST 
      SZA,RSS       IS LIST FLAG ON?
      JSB OKOLE      YES, SPACE TO BOTTOM OF PAGE 
      JMP HC04      GET NEXT STATEMENT
X52   JSB INST,I    TO REPSB
      JMP X39 
X54   STB LST       SET LST/UNL FLAG
      JMP HC04      BYPASS LISTING FOR 'LST/UNL'
X56   STB ?SUP      SET 'SUP/UNS' FLAG
      JMP X39 
      SPC 1 
*             * PASS 2 'EQU' PROCESSOR *
* 
EQUP JSB CHOPI     EVAL. OPERAND
      CLB           ERROR EXITS 
      LDA PLCN
      STA SUMP      SAVE PLCN VALUE 
      STB PLCN      SET PLCN=0
      LDA ...1+1    (2)  LIST 'EQU' 
      JSB LIST
      LDA SUMP      REPLACE PLCN VALUE
      STA PLCN
      JMP HC04
HC70  LDA LTFLG     GET LITERAL FLAG
      SZA           ARE LITERALS PRESENT? 
      JSB ?ARTL      YES, GO TO LITERAL PROCESSOR 
      JSB LOUT      OUTPUT THE ARITH INSTRUCTION
      JMP ARTX      GO PROCEESS THE 'DEF' PORTION.. 
HC80  JSB CHOPI     GO EVALUATE THE COUNT 
      JMP HC84      BAD COUNT EXIT
      ADB M17       B-17
      SSB           B GRTR THAN 16? 
      CPB M17       NO.  IS B=0?
      JSB OPERR     YES, IT'S AN 'M' ERROR,.
      LDA SUMP      GET THE SHIFT OR ROTATE COUNT.. 
      AND .12+3     MASK OUT LOWEST 4 BITS
HC82  ADA INST      MAKE UP THE FINAL INSTRUCTION 
      STA INST
      JMP HC30      GO AND OUTPUT THE INSTRUCTION 
HC84  CLA           SET COUNT FOR 16 BIT SHIFT ROTATE 
      JMP HC82
      SPC 1 
*             ************************
*             * PASS 2 RPL PROCESSOR *
*             ************************
RPLP  LDA SCN1+3    CHECK FOR LABEL.
      SZA           PRESENT ? 
      JMP *+4        YES, GO EVALUATE THE OPERAND.
      LDA .LB        NO, GET ERROR MNEMONIC 'LB'. 
      JSB ERPR      GO TO INDICATE THE ERROR. 
      RSS           CLEAR THE INSTR. FIELD FOR LIST.
      JSB CHOPI     GO TO EVALUATE THE OPERAND. 
      CLB           * ERROR * SET OPERAND =0. 
      STB INST      SAVE OPERAND VALUE FOR LIST.
      LDA .1+6      (7) LIST WITHOUT LOCATION.
      LDB SBLN      ASCII:S-BLANK (SUBSTITUTION)
      JMP HC03      GO TO LIST THE STATEMENT. 
.LB   ASC 1,LB      ASCII 'LB' NO-LABEL ERROR CODE. 
SBLN  ASC 1,S       REPLACEMENT CODE INDICATOR: 'S'.
* 
   SKP
*             ************************* 
*             * OCT/DEC/ASC PROCESSOR * 
*             ************************* 
NUMP  LDA SCN1+2
      STA PNTR      SET POINTER 
      LDA ..M1
      STA T+1       SET FPAS=-1 
      LDA CODE
      CPA ...1+6    (7) 
      JMP ASCR
HE06  LDB PNTR      PNTS AT 1ST CH OF NUMBER
      STB SIGN
      CLB 
      STB CNTC
      INB 
      STB RELC
* 
*             * TEST CHARACTER FOR TERMINATOR * 
HE08  LDA PNTR
      JSB GETC
      STA TERM
      CPA L+4       COMMA?
      JMP HE12       YES
      CPA BLNK      BLANK?
      JMP HE12       YES
* 
*             * UPDATE CHAR.CNTR(CNTC) AND POSN. PNTR(TLOC) * 
      LDB CODE
      CPB .9        OCT?
      JMP HE10+1    YES 
      CPB DEX       'DEX'?
      JMP HE11      YES 
      LDB ...1+1    (2) NOT OCTAL 
      CPA L+6       PERIOD? 
      STB RELC       YES, SET RELC = 2
      CPA .E        'E' ? 
HE10  STB RELC      YES, SET RELC FOR USE AS ASCN MD
      ISZ CNTC
      ISZ PNTR      BUMP PNTR 
      JMP HE08
HE11  LDB .1+2      SET B=3 FOR DEX MODE
      JMP HE10
* 
*             * SET UP VALUE FOR LIST AND/OR PUNCH *
HE12  LDA CODE
      CLB 
      CPA .9        OCT?
      JMP *+3        YES
      LDB RELC       NOT OCT
      BLF,BLF 
      ADB CNTC
      LDA SIGN
      JSB ?ASCN     GO TO 'ASCI' CONVERSION 
      CLA           SET A=0 
      STA INST
      STB SUMP      STORE VALUE 
      LDA VALU      SAVE LEAST SIG PART OF 'DEX'
      STA SIGN
HE18  JSB NOUT
      LDA RELC
      ARS,SLA       IS RELC = 0 OR 1? 
      JMP HE20      NO, ITS 3 OR 2
      LDA TERM
      CPA BLNK
      JMP HC04      EXIT ON BLANK 
      ISZ PNTR      BUMP PNTR 
      JSB ?BPKU     SCAN OVER BLANKS
      LDA PNTR      TEST FOR EOL 1976-09-20-1500
      CMA,INA 
      ADA SCN1      THE RECORD CHARACTER COUNT
      SSA,RSS 
      JMP HE06      MORE DATA FOLLOWS 
      LDA .IL       SOMETHING IS NOT GOOD 
      JSB ?ERPR     TELL EM KEMO SABE 
      CLA           MAKE A NOP
      STA INST       AND
      JSB NOUT         DUMP IT
      JMP HC04       BUG OUT, U DONE
HE20  LDA SUMP
      STA INST      VALUE TO INST 
      LDB RELC
      CPB .1+2      IS RELC=3?
      JMP HE22      YES- SET SUMP FOR 3RD WORD
      CLA 
HE21  STA RELC      SET RELC FOR NEXT TEST
      JMP HE18
* 
HE22  LDA SIGN
      STA SUMP      VALU TO SUMP
      LDA .1+1      FOR SETTING RELC=2
      JMP HE21
*          ***************************
*          * OCT DEC ASC WORD OUTPUT *
*          ***************************
NOUT  NOP 
      CLA           SET A=0 FOR 1ST LINE OUTPUT 
      ISZ T+1       SKIP FOR 1ST LINE OF OUTPUT.
      LDA ...1+3    (4) SET A=4 FOR LIST
      LDB BLNS
      JSB LIST
      CLA 
      CLB,INB 
      JSB BREC      PUNCH 
      ISZ PLCN      BUMP LOCN CNTR. 
      JMP NOUT,I    EXIT
*             ********************
*             * PROCESS ASC HERE *
*             ********************
ASCR  LDA ...1+1    (2) INDIC.'ASC' 
      JSB CHOP      GO EVALUATE WORD LENGTH 
      JMP HC30      * ERROR EXIT
      SZA           VALUE ABSOL.? 
      JMP HP2D-1     NO; * ERROR *
      SZB,RSS       ASKING FOR ZERO WORDS ? 
      JMP HP2D-1     YES, * ERROR * 
      ADB .M29      (-29)(VALUE IS IN SUMP TOO) 
      SSB,RSS       VAL.>28?
      JMP HP2D-1     YES; * ERROR * 
      LDA PNTR
      STA T 
      LDA SUMP
      CMA,INA 
      STA CNTC      VALUE(COMPL.) TO CNTC 
* 
*             * PICK UP WORDS AND STORE INTO PROGRAM *
SB    ISZ T 
      LDA T 
      JSB GETC
      ALF,ALF 
      STA TEST
      ISZ T 
      LDA T 
      JSB GETC
      STA INST
* 
*             *  OUTPUT 2 ASCI CHARACTERS * 
      JSB NOUT
      CLA 
      STA TEST
      ISZ CNTC
      JMP SB
      JMP HC04      DONE, GO GET NEXT STATEMENT 
*             ************************* 
                                                                                                                  