ASMB,R,L,C
* 
*     NAME:   ASMB4 
*     SOURCE: 92067-18074 
*     RELOC:  92067-16074 
*     PGMR:   C.C.H.,S.P.K. 
*     MODIFIED BY EARL STUTES 1976-09-20-1600 
*     MOD 77-01-30 ADDED DEY OP CODE EAS
*     MODIFIED BY VERN MCGEORGE 22MAY79 TO RELEASE LOD & GEN INSTR. 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  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 ASMB4 92067-16074 * (C) HEWLETT-PACKARD COMPANY 1978. 
* 
      NAM ASMB4,5,99 92067-16074 REV.1940 790531
      ENT ASMB4,?AREC 
      EXT WRT.C,C.BIA 
      EXT ?SUP,?BPKU,?PKUP,?LFLG,?RSTA,?ERPR
      EXT ?OPLK,?GETC,?LINC,?LIST,?LOUT 
      EXT ?CHOP,?CHPI,?OPER,?ASCN,?MSYM,?ASM1,?LINS 
      EXT ?LST,?LPER,?PERL,?SETM,EXEC,?FMPE 
      EXT ?ENDS,?PLIN,?ASMB,?BINF 
      SPC 2 
      EXT ?TEMP,?RELC,?SIGN,?SUMP,?TERM,?T,?CNTB
      EXT ?CODE,?DSIG,?FLAG,?FLAQ,?INST,?LAST,?PASS 
      EXT ?PLCN,?PNTR,?SCN1,?TEST,?IOBF,?PBUF 
      SUP 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.5    DEC 5 
.6    DEC 6 
.12   DEC 12
.13   DEC 13
.14   DEC 14
.15   DEC 15
.16   DEC 16
.M1   DEC -1
.M2   DEC -2
.M3   DEC -3
.M4   DEC -4
.M5   DEC -5
.M6   DEC -6
L     OCT 50,51,52,53,54,55,56
.9    DEC 9 
.M8   DEC -8
.M29  DEC -29 
BLNK  OCT 40        =40B(LOWER BLANK) 
.NO   ASC 1,NO
.OP   ASC 1,OP
.OV   ASC 1,OV
.IL   ASC 1,IL
BLNS  ASC 1,
TW10  OCT 176000    ADDRESS MASK
B1000 OCT 1000
BIT15 OCT 100000
.E    OCT 105 
TEMP  EQU ?TEMP 
RELC  EQU ?RELC     RELOCATION FLAG 
SIGN  EQU ?SIGN 
SUMP  EQU ?SUMP     RUNNING SUM FOR 'CHOP'
TERM  EQU ?TERM     NO. OF TERMS IN AN OPERAND
T     EQU ?T
CNTB  EQU ?CNTB 
CODE  EQU ?CODE     OPCODE TYPE(FROM OPTABLE) 
DSIG  EQU ?DSIG     'ASCN'
FLAG  EQU ?FLAG 
FLAQ  EQU ?FLAQ 
INST  EQU ?INST     OPCODE FORMAT 
LAST  EQU ?LAST 
PASS  EQU ?PASS     PASS FLAG(0=PASS 1  AND 1=PASS2)
PLCN  EQU ?PLCN     PROGRAM LOCATION COUNTER
PNTR  EQU ?PNTR     POINTS AT LAST OR CURRENT CHAR. 
SCN1  EQU ?SCN1     STATE LNG/OPCODE/OPERAND/LABEL(4) 
TEST  EQU ?TEST     TEST CHARACTER
*             * I/O STATEMENT BUFFER *
IOBF  EQU ?IOBF     50 WORDS + END OF STATEMENT BUFF
PBUF  EQU ?PBUF 
WCNT  EQU PBUF      WORD(BLK) CNT FOR BIN.RECRD.
ASM1  EQU ?ASM1 
CHOP  EQU ?CHOP 
CHOPI EQU ?CHPI 
ERPR  EQU ?ERPR 
GETC  EQU ?GETC 
LINC  EQU ?LINC 
LIST  EQU ?LIST 
LOUT  EQU ?LOUT 
LST   EQU ?LST
OPERR EQU ?OPER 
RSTA  EQU ?RSTA 
A     EQU 0 
B     EQU 1 
      SPC 1 
*              **************************************** 
*              * CONTINUE PASS 2 OF ABSOLUTE ASSEMBLY * 
*              **************************************** 
      SPC 1 
ASMB4 LDA .VAL0     REMOVE INDIRECTS FROM ADDRESS 
      RSS 
      LDA A,I 
      RAL,CLE,SLA,ERA 
      JMP *-2 
      STA .VAL0     DIRECT ADDRESS
      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 
      CLB 
      DST PBUF
      DST PBUF+1
      LDA .2000 
      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 .15       HED?
      JMP ASH       YES, GO PICK UP THE NEXT STATEME
      STA ASM1      CLEAR 'CS' AND 'INIT' FLAG
      CPA .1
      JMP HI12
      LDA .NO       'NO'= NO ORG OR NAM STATEMENT 
      JSB ERPR
      JMP HC05      ERROR EXIT FROM INIT
HI12  JSB ?CHOP     EVALUATE ORG
      JMP HC02      ERROR RETURN
      STB PLCN
      JMP HC02
* 
.2000 OCT 2000
* 
      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      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      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 TOP OF FORM 
      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
      CCA           SKIP TO TOP OF FORM 
      STA LINC
      JMP HC04      EXIT TO GET NEXT STATEMENT
* 
*        *************************
*        * BINARY OUTPUT ROUTINE *
*        *************************
.M57  DEC -57 
      DEF PBUF+2
BREC  NOP 
      LDA ?BINF     BINARY OUTPUT REQUESTED?
      SZA,RSS 
      JMP BRECX     NO, THEN RETURN 
      LDA WCNT
      SZB           RECORD OUT? 
      JMP HI66       NO.
      SZA,RSS       WCNT=0? 
      JMP BREC,I     YES. 
HI60  LDA WCNT      ** OUTPUT A BINARY RECORD **
      ALF,ALF       ROTATE 8
      STA WCNT      STORE WCNT IN UPPER PBUF
      ALF,ALF 
      ADA .3        ADD 3 TO THE DATA COUNT 
      STA CNTB      SET COUNTER = WCNT+3
      JSB WRT.C     WRITE RECORD ON BINARY OUTPUT FILE
      DEF C.BIA 
      DEF PBUF      PUNCH BUFFER
      DEF CNTB      WORD COUNT
      JMP HIERR     FMP ERROR 
BRECX CLA 
      STA WCNT      INITIALIZE WCNT =0
      JMP BREC,I     AND EXIT 
* 
HIERR CLA,INA       ERROR IN OUTPUT FILE
      JMP ?FMPE     DISPLAY ERROR AND ABORT ASSEMBLER 
HI66  SZA           1ST WORD OF BINARY RECORD?
      JMP HI70      -NO-
      LDB PLCN      PLCN TO BREG
      STB PBUF+59   PUT IN CHECKSUM SAVER 
      STB PBUF+1    SET RECORD ADDR.
      LDA BREC-1
      STA STOR      SET STOR=L(PBUF+2)
      LDA .M57
      STA CNTB      SET COUNT=-57 
HI70  LDA INST
      STA STOR,I    SET CURRENT BIN. WORD 
      ISZ STOR      BUMP POINTER
      ADA PBUF+59   UPDATE CHECKSUM 
      STA PBUF+59 
      STA STOR,I    SAVE IN LWA+1 OF PUNCH RECORD 
      ISZ WCNT
      ISZ CNTB      IS RECORD FULL? 
      JMP BREC,I    NO - EXIT 
      JMP HI60      YES - GO PUNCH
STOR  BSS 1 
      SPC 2 
HC02  LDA .2      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
      CPA .100B     CODE = 'MIC' ?
      JMP X39        YES, GO TO LIST IT.
      ADA M100B     SUBTRACT 100 OCTAL
      SSA,RSS       CODE >100B ?
      JMP XMIC       YES, IT'S A MICROCODE MACRO. 
      LDA CODE      GET OPCODE I.D. 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 .3        60 OR 70?(MICRO-OP?)
      JMP MICR      YES 
      LDA CODE
      ADA CODLC     SET UP ADDRESS OF PROCESSOR 
      JMP A,I       JUMP TO OPCODE PROCESSOR
* 
      SKP 
*               ************************
*               * PROCESSOR JUMP TABLE *
*               ************************
* 
* 
CODLC DEF *,I 
      DEF HC42      ORG       1 
      DEF HC42      ORR       2 
      DEF HC38      *COM      3 
      DEF HC38      *ENT      4 
      DEF HC38      *EXT      5 
      DEF HC38      *ARITH    6 
      DEF ASCP      ASC       7 
      DEF DCNUM     DEC       10
      DEF OCNUM     OCT       11
      DEF BSSP      BSS       12
      DEF EQUP      EQU       13
      DEF FIN2      END       14
      DEF HC38      *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 DXNUM     DEX       25
      DEF HC70      HDW ARITH 26
      DEF HC80      HDW SHIFT 27
      DEF HC30      CLO, ETC. 30
.I    OCT 111       ASCII I   31
      DEF HC38      *RPL      32
      DEF HC38      *GEN      33
      DEF HC38      *LOD      34
      DEF X52       REP       35
M17   DEC -17                 36   -17 FOR SHIFT-ROT
CNTC  NOP                     37   MICRO-OP PROC
      DEF X56       SUP/UNS   40
      DEF BYTE      DBL       41
      DEF BYTE      DBR       42
      DEF BYTEG     BYT       43
      DEF DYNUM     DEY       44
INSV  NOP                          MICRO-OP PROC
SUM.  EQU INSV                     MEMORY REF PROC. 
DEX   OCT 25                       'DEX' OPCODE TYPE
DEY   OCT 44                       'DEY' OPCODE TYPE
CBIT  OCT 175777
.1777 OCT 1777
* 
      SKP 
*             * PROCESS MEMORY REFERENCE INSTRUCTIONS * 
* 
MEMRY LDA INST
      AND .M2       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.      OPERAND VALUE 
      CLB           LIST PARAMETER=0
HCXL  STB TERM      SAVE THE LIST PARAMETER 
      LDA SUM.
      LDB CODE
      CPB .16       (16) DEF? 
      JMP HC17
      ADA TW10      NO - TEST FOR OPERAND>1023
      SSA,RSS       IS IT?
      JMP *+5        YES. 
      LDA INST      NO - SET TO CLEAR'CURRENT' BIT. 
      AND CBIT      CURRENT BIT MASK(175777)
      STA INST      RESTORE 
      JMP HC14
      LDA PLCN      TEST NOW FOR OPER.AND INSTR.
      AND TW10        IN THE SAME PAGE OF MEMORY
      CMA,INA 
      ADA SUM.
      AND TW10
      SZA,RSS       IN SAME PAGE? 
      JMP *+3        YES
      LDA .OV        NO - IT'S AN OVERFLOW
      JSB ERPR
      LDA .1777 
      AND SUM.      STRIP UPPER 6 BITS OF OPERAND 
      STA SUM.
HC14  LDA SUM.      GET ADDRESS 
HC17  IOR INST       FOR INSTRUCTION, AND 
      STA INST        SET LOADER FLAG 
* 
*             * OUTPUT A BINARY WORD *
* 
HC19  CLB,INB 
      JSB BREC
* 
*             * OUTPUT A LINE FOR LISTING * 
* 
      LDB BLNS      GET BLANKS FOR LIST ROUTINE 
      LDA TERM      GET THE LIST PARAMETER
      JSB LIST
      ISZ PLCN
      JMP HC04
* 
      SKP 
*        *****************
*        * 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 
*         **********************************************
*         * PROCESS THE 'DEF' FOLLOWING THE FIRST WORD *
*         *  OF AN ARITHMETIC PAIR                     *
*         **********************************************
HC70  JSB LOUT      OUTPUT THE ARITH. OPERATION 
      JSB LIST      LIST THE FIRST WORD 
      LDA .16       (20B) 
      STA CODE      =DEF
      CLA 
      STA INST      CLEAR INST
      LDA .I        SET UP FOR INDIRECT BIT 
      LDB BIT15     MASK= 100000B 
      JSB CHOP
      NOP 
      ISZ PLCN      BUMP LOCATION COUNTER 
      STB SUM.      SAVE OPERAND VALUE
      LDB .4        LIST PARAMETER=4
      JMP HCXL
HC17E CLA           LIST PARAMETER =0 
      STA TERM      SAVE IT 
      JMP HC17
* 
*             * 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
* 
*             * COM,ENT,EXT AND ARITH MACRO 
* 
HC38  LDA .IL       ILLEGAL IN ABSOLUTE ASSEMBLY
      JSB ERPR
X39   CLA,INA       1 TO A
      JMP HC03
* 
      SKP 
* 
*             * PRE-PROCESSOR FOR ORG AND ORR * 
* 
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
      CCA           SPACE TO BOTTOM OF PAGE 
      STA LINC
      JMP HC04      GET NEXT STATEMENT
X52   JSB INST,I    TO REPSB
      JMP X39 
X54   STB LST       SET LST/UNL FLAG
      JMP HC04      EAS 1976-09-20-1600 
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 .2        (2)  LIST 'EQU' 
      JSB LIST
      LDA SUMP      REPLACE PLCN VALUE
      STA PLCN
      JMP HC04
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 .15       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
* 
      SKP 
*             ************************* 
*             * OCT/DEC/ASC PROCESSOR * 
*             ************************* 
OCNUM CLA 
      JMP NUMPX 
DCNUM LDA .1
      JMP NUMPX 
DXNUM LDA .3
      JMP NUMPX 
DYNUM LDA .4
NUMPX STA WHAT
NUMP  LDA SCN1+2
      STA PNTR      SET POINTER 
      LDA .M1 
      STA T+1       INITIALIZE FPAS 
HE06  LDB PNTR      PNTS AT 1ST CH OF NUMBER
      STB SIGN
      CLB 
      STB CNTC
      LDB WHAT
      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 .8        IF OP CODE # DEC THEN GO COUNTEMUP
      JMP *+2 
      JMP CNTUP 
      LDB .2        TEST FOR REAL OR INTEGER
      CPA L+6       IF DECIMAL POINT THEN 
      JMP *+2        RELC := 2
      CPA .E        ELSE IF "E" THEN
      STB RELC      RELC := 2 
CNTUP ISZ CNTC
      ISZ PNTR      BUMP PNTR 
      JMP HE08
* 
*             * SET UP VALUE FOR LIST AND/OR PUNCH *
HE12  LDB RELC
      BLF,BLF 
      ADB CNTC
      LDA SIGN
      JSB ?ASCN     GO TO 'ASCI' CONVERSION 
      JMP ASCER     THIS IS THE ERROR RETURN
      STA TEMP+1
      LDA .VAL0 
      STA WPNTR     SET UP WORKING POINTER
      LDA RELC
      CMA,INA,SZA,RSS SET UP WORKING COUNTER
      CCA           OOPS IT WAS ZERO, MAKE IT -1
      STA RELC
NUMLP LDA WPNTR,I   OUTPUT A WORD TO THE DATA STREAM
      JSB NOUT
      ISZ WPNTR 
      ISZ RELC      IF U DUN DEN BUG OUT
      JMP NUMLP     IF NOT DEN LOOP 
HE18  LDA TERM      GET THE TERMINATOR
      CPA BLNK      IS THIS THE END OF THE TERM ? 
      JMP HC04       YES, EXIT ON BLANK 
      ISZ PNTR      BUMP PNTR 
      JSB ?BPKU     SCAN OVER BLANKS
      LDA PNTR      TEST FOR EOL 1976-09-20-1600
      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
      JSB NOUT         DUMP IT
      JMP HC04      BUG OUT, U DONE 
* 
ASCER CLA 
      JSB NOUT      PUT A ZERO IN THE DATA STREAM 
      JMP HE18      CONTINUE SCAN 
.VAL0 DEF TEMP+1
WPNTR BSS 1 
WHAT  BSS 1 
.8    DEC 8 
* 
*          ***************************
*          * OCT DEC ASC WORD OUTPUT *
*          ***************************
NOUT  NOP 
      STA INST
      CLA 
      ISZ T+1       IF NOT FIRST LINE THEN
      LDA .4        (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 *
*             ********************
ASCP  LDA SCN1+2    INITIALIZE FOR ASC PROCESSING 
      STA PNTR
      LDA .M1 
      STA T+1 
      LDA .2        (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
* 
*             *  OUTPUT 2 ASCI CHARACTERS * 
      JSB NOUT
      CLA 
      STA TEST
      ISZ CNTC
      JMP SB
      JMP HC04      DONE, GO GET NEXT STATEMENT 
*             ************************* 
*             * PROCESS I/O GROUP HERE *
*             **************************
RAM   OCT 105000
      OCT 177400
      OCT 300 
IOPR  LDA SCN1+2    IS OPERAND
      SZA            PRESENT? 
      JMP P           YES!
      LDA CODE      NO OPERAND
      CPA L+1       'HLT'?
      JMP HP2D       YES
* 
*             * OPERAND ERROR EXIT HERE * 
      JSB OPERR     (HP2D-1)
HP2D  CLA 
      STA TERM      SAVE THE LIST PARAMETER 
      JMP HC19
P     LDA .C        TEST FOR 'CLEAR FLAG'(C). 
      LDB B1000     GET 'C' MASK FOR IO INSTR.
      JSB CHOP
      JMP Q         ERROR EXIT
      LDA 1 
      LDB INST      LOAD B WITH OCTAL INSTR 
      ADA IOPR-2    MASK FIRST PART 
      CPB RAM       SEE IF A RAM INSTR
      RSS           SKIP NEXT MASK IF RAM 
      ADA IOPR-1    IF NOT RAM ADD SECOND PART
      LDB SUMP      RESTORE B REG 
* 
      SKP 
* 
*             * TEST FOR VALUE>63 * 
* 
      SSA           VALUE >64 ? 
      JMP *+4        YES-O.K. 
      LDA .OV       'OV'  ADDRESS OVERFLOW
      JSB ERPR      GO PRINT ERROR MESSAGE. 
Q     CLB 
      ADB INST      (HE54+1)
      STB INST
      JMP HP2D
.C    OCT 103       ASCII 'C' 
* 
*             * PROCESS SOC OR SOS
* 
HC28  LDA SCN1+2    PNTR TO OPERAND 
      SZA,RSS       OPERAND PRESENT?
      JMP HP2D      NO
      LDB 0         A TO B
      JSB ?MSYM 
      ADA .M1 
      SZA 
      JMP HP2D
      LDA LAST
      CPA .C        IS 'C' PRESENT? 
      JMP *+2        YES
      JMP HP2D       NO 
* 
*             * 'OR' 1 TO BIT 9 (C BIT) OF I/O INST * 
* 
      LDA INST
      IOR B1000     MASK IN CURRENT BIT 
      STA INST
      JMP HP2D
* 
      SKP 
*             **********************
*             * MICRO-OP PROCESSOR *
*             **********************
MICRD OCT 7777,4000,60000,60,71,14000 
* 
*             * INITIALIZE FLAGS *
MICR  CLA 
      STA CNTC      =0 WHEN CLE APPEARS 
      STA TERM      BITS 12-11 = 1 IF B REG 
*                                   BITS 12-11 = 2 IF A REG 
      STA TEMP+4    BITS 14-13=1 IF SRG; =2 IF ASG
      STA INSV      USED TO ACCUMULATE THE CODE 
      STA FLAG
      STA TEST      CLEAR CHAR TESTER 
* 
*             * START HERE FOR EACH NEW CODE *
F     LDA INST      UNPACK THE MICRO-OP CODE
* 
*              THE FORMAT IS: 
*                BITS 14-13=1 IF SRG,2 IF ASG, 0 IF 
*                                            EITHER 
*                BITS 12-11=1 IF BREG,2 IF AREG, 0 IF 
*                                            NEITHER. 
*                BITS 11-0 = ACTUAL 12 BIT CODE 
      AND MICRD     EXTRACT OPCODE
      STA FLAQ      SAVE IT (=+2) 
      LDA CODE      THIS IS THE GROUP NUMBER. 
      CMA,INA       MAKE SURE IT'S BIGGER THAN THE LAST.
      ADA FLAG      A=(LAST GRP)-(PRESENT GRP)
      SSA 
      JMP O         SEQUENCE IS OK
* 
*             * IF PRES GRP IS GO WE CAN CHANGE IT AND MAY BE OK
      LDA CODE
      CPA MICRD+3   IS CODE TYPE = 60B (MICRO-OP)?
      JMP *+4       CHANGE ERROR GROUP AND OP CODE
MERR  LDA .OP       'OP' FOR OPCODE ERROR 
      JSB ERPR       RETURN 
      JMP HP2D
      LDA MICRD+4   71B, CHANGE GROUP (FROM *-4)
      STA CODE      TO 71 
* 
*             * MOVE BITS 8-5 OF OPCODE TO BITS 4 AND 2-0 * 
      LDA FLAQ
      AND MICRD+1   SET A/B BIT 
      STA 1         SAVE IN B.
      XOR FLAQ
      ALF,ALF       MOVE BITS 0 AND 15-13 
      RAR,SLA       MOVE BIT 0 TO 
      INA            BIT 1. 
      ALF,RAR       ROTATE LEFT 3, TO BITS 4,2-0
      IOR 1         PUT IN THE A/B BIT
      JMP F+2 
O     LDA CODE
      STA FLAG      SET LAST GRP TO PRESENT GRP 
* 
*             * CHECK REGISTER CONSISTENCY *
      LDA INST
      AND MICRD+5   GET BITS 12-11
      IOR TERM
      CPA MICRD+5   IF EQUAL, THERE'S A REGISTER
      JMP MERR       INCONSISTENCY. 
      STA TERM      NEW REGS TO REGS, 
* 
*             * OTHERWISE CHECK GROUP CONSISTENCY * 
      LDA INST
      AND MICRD+2   BITS 14-13
      IOR TEMP+4
      CPA MICRD+2   IF EQUAL,THERE ARE 2 CODES
      JMP MERR       FROM DIFFERENT GROUPS. 
      STA TEMP+4
* 
*             * CHECK FOR CLE * 
      LDA FLAQ
      SZA,RSS 
      ISZ CNTC
* 
*             * NOW 'OR' THE CODE INTO CURRENT CODE SO FAR *
      IOR INSV
      STA INSV
* 
*             * GET THE NEXT CHARACTER *
      LDA SCN1+1    OPCODE PNTR 
      ADA .3        (3) 
      STA PNTR      POINTS AT POS'N FOLLOWING OPCODE
      JSB ?PKUP 
      CPA BLNK      IS THIS CHAR. A BLANK ? 
      JMP *+7        YES, WE'RE DONE. 
      CPA L+4       COMMA ? 
      JMP *+2 
      JMP MERR
* 
*             * GET THE NEXT OPCODE * 
      JSB ?OPLK     OPCODE LOOKUP 
      JMP HP2D
      JMP F 
* 
*             * TO FINISH TEST CLE; IF USED AND IN ASG SET, ADD 40
*             * TO THE CODE.
      LDA TEMP+4    (FROM *-7)
      ALF,ALF 
      SZA,RSS 
      IOR BLNK      (40B) 
      LDB CNTC
      SZB,RSS 
      CLA 
      IOR INSV
      STA INST
      JMP HP2D
* 
      SKP 
*              *****************
*              * PROCESS 'END' *
*              *****************
* 
FIN2  CLB 
      JSB BREC      PUNCH REST OF LAST DBL RECORD 
      CLA,INA 
      LDB BLNS
      JSB LIST      LIST 'END' STATEMENT
                                                                                                      