ASMB,R,L,C
      HED RTE MICRO-ASSEMBLER -- PASS 1 
      NAM MICRO,3 92061-16001 REV.2013 800131 
      SUP 
* 
* 
*   ********************************************************* 
*   * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.           * 
*   *                                                       * 
*   * THIS  PROGRAM MAY BE USED WITH ONE COMPUTER SYSTEM AT * 
*   * A  TIME  AND  SHALL  NOT   OTHERWISE   BE   RECORDED, * 
*   * TRANSMITTED OR STORED IN A RETRIEVAL SYSTEM.  COPYING * 
*   * OR  OTHER  REPRODUCTION  OF  THIS  PROGRAM EXCEPT FOR * 
*   * ARCHIVAL PURPOSES IS  PROHIBITED  WITHOUT  THE  PRIOR * 
*   * WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.           * 
*   ********************************************************* 
* 
* 
HEADR ASC 15,PAGE .... RTE MICRO-ASSEMBLER
      ASC 10,REV.2013 800131
TIME  BSS 16
* 
      EXT EXEC
      EXT C.SOR,C.TTY,C.LST,C.BIN             CMPLR LIB FCB 
      EXT SUP.C,OPN.C,PRM.C,GMM.C,WRT.C,RWN.C   CMPLR LIB 
      EXT RUN.C,END.C,SPC.C,EOF.C,RED.C       CMPLR LIB 
* 
* 
******************************
* 
*   PASS 1 STARTS HERE. 
* 
*   HERE WE GET THE PARAMETERS, IF ANY, FROM THE
*   USER'S RUN COMMAND: 
*     :RU,MICRO,<INPUT>,<LIST>,<OUTPUT>,<LINES> 
* 
MICRO NOP 
      JSB SUP.C 
      DEF TIME
      JMP ABRT      ERROR RTN 
      JSB PRM.C 
      DEF .3
      SZA 
      JSB PUNCH 
      LDA PRMPT     SET A = "]_"
      JSB OPN.C 
      DEF C.SOR 
      JMP ABRT      ERROR RTN 
      JSB OPN.C 
      DEF C.LST 
      JMP ABORT    ERROR RTN
      JSB PRM.C    <LINES PER PAGE> 
      DEF .4
      SZA,RSS 
      LDA .56      DEFAULT
      STA LPP      LINES PER PAGE FOR MXREF 
      CMA          -((LPP-3)+1): REMAINING
      STA LINE3     LINES+1 AFTER HEADER
      JSB EJECT    PRINT HEADER 
      JSB EXEC     SWAP WHOLE DISC PARTITION
      DEF *+3            (NO SUCH FUNCT IN CMPLR LIB)UNLESS AUTO
      DEF .22 
      DEF .3
      JSB GMM.C    GET FWA,LWA
      DEF .0
      STA @SYMB 
      STA @SYMT 
      ADA .4
      STA @VAL
      INA 
      STA @TAG
      CMB 
      STB LWA      -LWA-1 
* 
*   INPUT AND EXAMINE A RECORD. 
* 
      JSB MIC      GET MICMX OR MICMXE COMMAND
INPUT JSB LSTR?    LIST PRIOR LINE IF ERROR 
      ISZ LINE# 
      JSB RDCRD     READ CARD 
      LDB @FLD1     EXAMINE 1ST BYTE
      JSB LOADB 
      CPA ASTER     =*? 
      JMP INPUT     YES, IGNORE.
      CPA "$"        =$?
      JMP CNTRL     CONTROL STATE.
      LDA .10      CHECK FOR EQU,ORG,ALGN 
      LDB @FLD2 
      JSB $SRCH 
      SSA 
      JMP INP0     NOT PSEUDO-OP
      AND =B77
      ADA *+2 
      JMP A,I 
      DEF *,I      ONE-ORIGINED BRANCH TABLE
      DEF INP4     EQU STMT 
      DEF INP0     DEF STMT 
      DEF INP0     ONES STMT
      DEF INP0     ZERO STMT
      DEF INP3     ALGN STMT
      DEF INP2     ORG STMT 
      DEF END1     END STMT 
* 
* NORMAL STATEMENT.  PROCESS LABEL IF ANY 
* 
INP0  JSB ORGD?    ENSURE WE HAVE AN ORIGIN 
      JSB LBL?
      JMP INP1
      LDA PCNTR    ENTER INTO SYMTAB
      CLE         NON-EQU LABEL 
      JSB SYMAD 
INP1  JSB POVF? 
      LDA PCNTR 
      INA 
      JSB SETP
      JMP INPUT 
* 
* ORG STATEMENT 
* 
INP2  LDA @FLD2    DISALLOW LABEL 
      LDB @FLD1 
      JSB BLNK? 
      JMP *+2      LABEL PRESENT
      JMP INP21 
      LDA ERR24 
      JSB ERROR 
INP21 JSB ORIG
      JMP BAD.3 
      JMP INPUT 
* 
*  ALGN STATEMENT 
* 
INP3  LDA @FLD2    DISALLOW LABEL 
      LDB @FLD1 
      JSB BLNK? 
      JMP *+2      LABEL PRESENT
      JMP INP31 
      LDA ERR24 
      JSB ERROR 
INP31 JSB ORGD?    ENSURE WE HAVE ORIGIN
      JSB ALGN
      JMP INPUT 
* 
* EQU STATEMENT 
* 
INP4  LDA @FLD6    FIND ADDR EXPRESSION 
      LDB @FLD3 
      JSB BLNK? 
      NOP 
      JSB NUM      (CHECKED IN NUM) 
      SOC 
      JMP BAD.2 
      STA SAVA     SAVE EXPR VALUE
      JSB LBL?
      JMP INPUT 
      LDA SAVA     RESTORE EXPR VALUE 
      CCE          EQU FLAG 
      JSB SYMAD 
      JMP INPUT 
* 
* CONTROL CARD PROCESSOR
* B= BPTR TO COMMAND
* 
CNTRL JSB PSRCH 
      DBL CTBL
      DEC 10
      CPA .7      $CODE COMMAND?
      JMP FDESG    YES
      SZA 
      JMP INPUT    NO: IGNORE COMMAND IN PASS1
* 
*   BAD CONTROL STATEMENT OR PSEUDO-OP
* 
      LDA ERR18    BAD COMMAND
      JMP *+2 
BAD.2 LDA ERR19    BAD LABEL EXPRESSION 
BAD.3 JSB ERROR 
      JMP INPUT 
* 
*  $CODE PARAMETERS ARE NOW INCLUDED IN RUN STRING
FDESG LDA ERR12      $CODE -> RUN STRING
      LDB ANYER 
      STB TEMP
      JSB ERROR 
      LDB TEMP
      STB ANYER     RESTORE FLAG
      JMP INPUT 
TEMP  BSS 1 
* 
* 
******************************
* 
*  END STATEMENT
* 
END1  LDA SYFLG     SYMBOL TABLE
      SZA,RSS       WANTED? 
      JMP PASS2     NO, SO GO TO PASS 2.
      LDA @SYMT     YES.  GET 
      STA PNTR      START OF TABLE
      CPA @SYMB      END? 
      JMP PASS2     YES.  GO TO PASS2.
      LDA ANYER     PAGE EJECT IF ERROR 
      SZA 
      JSB EJECT 
      LDA .2
      JSB SPACE 
      LDA .M12
      JSB PRINT 
      DEF HED1
      LDA .2
      JSB SPACE 
PR1   LDA .9       FILL THE PERTINENT PART OF 
      LDB @CARD     ASCII OUTPUT BUFFER WITH
      JSB CLEAN     SPACES. 
*   NOW WE STORE THE SYMBOL (LABEL) IN THE
*   INPUT BUFFER, WHICH WE ARE USING AS PART OF OUR 
*   ASCII OUTPUT BUFFER.
      LDA PNTR,I
      STA CARD
      ISZ PNTR
      LDA PNTR,I
      STA CARD+1
      ISZ PNTR
      LDA PNTR,I
      STA CARD+2
      ISZ PNTR
      LDA PNTR,I
      STA CARD+3
*   NOW PICK UP OCTAL LOCATION (IE., VALUE) OF SYMBOL.
      ISZ PNTR
      LDA PNTR,I
      ISZ PNTR
*   CONVERT TO ASCII AND STORE IN 
*   NEXT LOCATION IN OUTPUT BUFFER. 
      LDB @FLD1 
      ADB .15 
      STB SAVB      SAVE BYTE ADDRESS.
      JSB OCTAL 
      DEC 6 
      LDA BLNK
      LDB PNTR,I   PICK UP TAG
      SZB 
      LDA "X"       APPEND "X" FOR EXTERNAL (EQU) 
      LDB SAVB      GET BYTE ADDR OF VALUE. 
      INB           INC PAST VALUE
      JSB STORB     STORE SPACE OR 'X' THERE. 
      LDA BLNK2 
      STA CARD-1
      LDA .18 
      JSB PRINT 
      DEF CARD
      ISZ PNTR      POINT 
      LDA PNTR      TO
      CPA @SYMB      NEXT ENTRY. END? 
      JMP *+2 
      JMP PR1       NO, GO DO NEXT. 
      HED  RTE MICRO-ASSEMBLER -- PASS 2
* 
*    PASS 2 STARTS HERE.
* 
* 
* 
*   INITIALIZATION FOR PASS 2.
* 
PASS2 JSB FINI      PRINT END-PASS-1 MSG
      LDA FILE?    OUTPUT TO FILE?
      SZA,RSS 
      JMP OK       NO.
* 
*   OPEN BINARY FILE
* 
      JSB OPN.C 
      DEF C.BIN 
      RSS          ERROR RTN
      JMP OK       NORMAL RTN 
      CLA 
      STA FILE?    RESET OUTPUT FLAGS 
      STA FILE
      LDA ERR13 
      JSB ERROR 
* 
*   INITIALIZE FLAGS, COUNTERS, ETC, FOR 2ND PASS.
*   GENERATE LEADER.
* 
OK    LDA BASE     RESET ORIGINAL ORG 
      STA PCNTR 
      JSB RWN.C 
      DEF C.SOR 
      JMP ABORT    ERROR RTN
      ISZ PASS# 
      CLA 
      STA LINE# 
* 
*   READ A SOURCE RECORD. 
* 
      JSB EJCT? 
      JSB MIC 
P21   ISZ LINE# 
      JSB RDCRD   READ CARD 
      LDB @FLD1     NO.  CHECK
      JSB LOADB     BYTE. 
      CPA ASTER     =*? 
      JMP P21A      YES,IGNORE BUT PRINT
      CPA "$"        =$?
      JMP *+2 
      JMP P21C      NO, GOOD CODE.
      JSB PSRCH 
      DBL CTBL
      DEC 10
      ADA *+2 
      JMP A,I 
      DEF *+1,I    ZERO-ORIGINED JUMP TABLE 
      DEF P21A     ERROR: IGNORE IN PASS2 
      DEF $PAGE 
      DEF $TITL    $PAGE= 
      DEF $LST
      DEF $NOLS 
      DEF $PNCH 
      DEF $NOPN 
      DEF P21A     $CODE
* 
* 
* $PAGE= AND $PAGE
* 
$TITL LDA .M37
      STA COUNT    MAX CHAR COUNT 
      LDA @HFD2 
      STA @DEST 
P.GET JSB LOADB    MOVE TITLE INTO HEADER 
      STB @INP
      LDB @DEST 
      JSB STORB 
      STB @DEST 
      LDB @INP
      ISZ COUNT 
      JMP P.GET 
* 
* 
$PAGE JSB EJCT? 
      JMP P21      DON'T LIST COMMAND 
* 
* $NOLIST: LIST RECORD, THEN TURN OFF LISTING 
* 
$NOLS CLA 
      JSB LSTR2 
      CLA 
      STA LIST? 
      JMP P21 
* 
* $NOPUNCH: TURN OFF PUNCHING 
* 
$NOPN CLA 
      STA FILE? 
      JMP P21A
* 
* $LIST: TURN ON LISTING
* 
$LST  JSB $LIST    ENABLE LISTING 
      JMP P21A
* 
* $PUNCH: TURN ON PUNCHING AND SET LEADER FLAG
* 
$PNCH LDA FILE
      STA FILE? 
* 
P21A  CLA          LIST WITHOUT CODE
      JSB LSTR2 
      JMP P21       GO BACK.
* 
*   DETERMINE STATEMENT TYPE. 
* 
P21C  LDB @FLD2     GET FIELD 2 STARTING BYTE ADR.
      CLA,INA       GO GET AN 
      JSB $SRCH     'OPCODE' BINARY OPCODE. 
      SSA,RSS      BAD CODE?
      JMP P21D      NO. 
      LDA ERR2      YES.  OUTPUT
      JSB ERROR     MESSAGE.
      JSB DEFLT 
      DEC 1 
P21D  STA OPTKN 
      AND =B77      ISOLATE OPCODE
      STA FLD2
      LDA OPTKN     ISOLATE INSTR TYPE
      AND =B170000
      ALF 
      ADA *+2 
      JMP A,I 
      DEF *+1,I     ZERO-ORIGINED BRANCH TABLE
      DEF P21E
      DEF TYPE1 
      DEF TYPE2 
      DEF TYPE3 
      DEF TYPE4 
      DEF TYPE0 
* 
*   DISTINGUISH TYPE3 & TYPE4 BY "CNDX" 
* 
P21E  LDA .2      GET SPECIAL FIELD 
      LDB .3
      JSB CODE
      LDA FLD3
      ALF,RAR 
      CMA,SSA,SLA  BIT 12 OR 13 SET?
      JMP TYP3A    NO: WORD-TYPE-3 SPECIAL (CNDX) 
      LDA OPTKN 
      CPA RTN 
      JMP TYP1A 
      JMP TYP4A 
* 
* 
******************************
* 
* 
*  PROCESS PSEUDO-OPS 
* 
TYPE0 LDA FLD2
      ADA *+2 
      JMP A,I 
      DEF *,I      ONE-ORIGINED BRANCH TABLE
      DEF TY0.3    IGNORE EQU THIS PASS 
      DEF DEFST 
      DEF ONEST 
      DEF ZERST 
      DEF ALNST 
      DEF ORGST 
      DEF END2
* 
*   ZERO STATEMENT
* 
ZERST CLA 
      STA INST1 
      JMP TY0.2 
* 
*   DEF STATEMENT 
* 
DEFST LDA @FLD6    FIND EXPRESSION
      LDB @FLD3 
      JSB BLNK? 
      NOP 
      JSB NUM 
      SOS 
      JMP TY0.1 
      LDA ERR19 
      JSB ERROR 
      CLA 
TY0.1 STA INST1 
      CLA 
      JMP TY0.2 
* 
*   ONES STATEMENT
* 
ONEST CCB 
      STB INST1 
      LDA =B377 
* 
TY0.2 STA INST2 
      JSB OUTPT 
      JMP P21 
* 
*   ALGN STATEMENT
* 
ALNST JSB ALGN
      JMP TY0.3 
* 
*   ORG STATEMENT 
* 
ORGST JSB ORIG
      NOP 
* 
TY0.3 CLA 
      JSB LSTR2   LIST WITHOUT CODE 
      JMP P21 
* 
* 
******************************
* 
* 
*   CREATE A WORD TYPE 1 INSTRUCTION. 
* 
*   FIRST, CHECK MNEMONICS AND COLLECT THE BINARY 
*   CODES FOR EACH FIELD. 
* 
TYPE1 LDA .2       GO GET A 'SPECIAL' CODE
      LDB .3       FROM FIELD 3.
      JSB CODE
      LDA FLD3
      ALF,SLA      ALLOWED IN TYPE-1 INSTRUCTION? 
      JMP TYP1A    YES. 
      LDA ERR16     PRINT ERROR MESSAGE.
      JSB ERROR 
      JSB DEFLT 
      DEC 2 
      STA FLD3
TYP1A LDA .4       GO GET AN 'ALU' CODE 
      LDB .4       FROM FIELD 4.
      JSB CODE
      LDA .6       GO GET A 'STORE' CODE
      LDB .5       FROM FIELD 5.
      JSB CODE
      LDA .7       GO GET AN 'S-BUS' CODE 
      LDB .6       FROM FIELD 6.
      JSB CODE
* 
*   NOW PUT TOGETHER THE FIELDS OF THE TYPE 1 WORD. 
* 
      LDB FLD3     SPECIAL FIELD
      LSR 5 
      LDB FLD5     STORE FIELD
      LSR 5 
      LDB FLD6     SBUS FIELD 
      LSR 5 
      LDB FLD4     ALU FIELD
      LSR 1 
      JMP EMIT1 
* 
* 
******************************
* 
* 
*   CREATE A WORD TYPE 2 INSTRUCTION. 
*   FIRST, CHECK MNEMONICS AND COLLECT BINARY CODES 
*   FOR EACH FIELD. 
* 
TYPE2 LDA .2       GET A 'SPECIAL' CODE 
      LDB .3       FROM FIELD 3.
      JSB CODE
      LDA FLD3
      ALF,SLA      ALLOWED IN TYPE-2 INSTRUCTION? 
      JMP TY2.0    YES. 
      LDA ERR16 
      JSB ERROR 
      JSB DEFLT 
      DEC 2 
      STA FLD3
TY2.0 LDA .5       GO GET AN MODIFIER CODE
      LDB .4       FROM FIELD 4.
      JSB CODE
      LDA .6       GO GET A 'STORE' CODE
      LDB .5       FROM FIELD 5.
      JSB CODE
      LDB @FLD6     GET FLD 6 STARTING BYTE ADDRESS.
      JSB NUM       CONVERT FIELD TO BINARY.
      SOS           ANY PROBLEMS? 
      JMP TY2.2     NO. 
TY2.1 LDA ERR11     PRINT ERROR MESSAGE.
      JSB ERROR 
      CLA           MAKE FIELD 6 = 0. 
TY2.2 STA FLD6
      AND =B177400      IS # 8 BITS OR LESS?
      SZA 
      JMP TY2.1     NO, SO ERROR. 
* 
*   NOW PUT TOGETHER THE FIELDS OF THE TYPE 2 WORD. 
* 
      LDB FLD3     SPECIAL FIELD
      LSR 5 
      LDB FLD5     STORE FIELD
      LSR 5 
      LDB FLD6     OPND FIELD 
      LSR 6 
      STA INST1 
      CLA 
      LSR 2        HI BITS OF OPND
      IOR FLD4     MODIFIER 
      RAR,RAR 
      JMP EMIT2 
* 
* 
******************************
* 
* 
*   CREATE A WORD TYPE 3 INSTRUCTION. 
*   FIRST, CHECK MNEMONICS AND COLLECT BINARY CODES.
* 
TYPE3 LDA .2      GET SPECIAL FIELD 
      LDB .3
      JSB CODE
      LDA FLD3
      ALF,RAR 
      CMA,SSA,SLA  BIT 12 OR 13 SET?
      JMP TYP3A    NO: WORD-TYPE-3 SPECIAL
      LDA ERR15 
      JSB ERROR 
      JSB DEFLT 
      DEC 2 
      STA FLD3
TYP3A LDA .3       GO GET A 'CONDITION' CODE
      LDB .4       FROM FIELD 4.
      JSB CODE
      LDA .9       GET SENSE CODE (STORE FIELD) 
      LDB .5       FROM FIELD 5 
      JSB CODE
      LDA OPTKN 
      CPA RTN 
      JMP TY3.4 
      LDB @FLD6    GET ADDRESS FIELD
      JSB NUM 
      SOS 
      JMP TY3.2 
      LDA ERR19 
TY3.0 JSB ERROR 
      LDA PCNTR     DEFAULT TO ADDR 0 IN CURRENT BLK
      INA            OR BLK+1 IF PCNTR=XXX777 
      AND =B177000
TY3.2 STA FLD6
      LDB PCNTR     IS IT IN SAME BLK OR
      INB            BLK+1 IF PCNTR=XXX777
      XOR B 
      AND =B177000
      SZA,RSS 
      JMP TY3.3    YES
      LDA ERR23    OUT OF RANGE IN FIELD 6
      JMP TY3.0 
TY3.4 LDB @FLD6    ENSURE: NO EXPR FOR RTN OP 
      JSB LOADB 
      CPA BLNK
      JMP TY3.3 
      LDA ERR33    EXPR NOT ALLOWED 
      JMP TY3.0 
* 
*   NOW PUT TOGETHER FIELDS OF TYPE 3 WORD
* 
TY3.3 LDB FLD3     SPECIAL FIELD
      LSR 5 
      LDB FLD6     OPND FIELD 
      LSR 9        MODULO 512 
      IOR FLD5     RJS SENSE
      RAR 
      LDB FLD4     CONDITION FIELD
      LSR 1 
      JMP EMIT1 
* 
* 
******************************
* 
* 
*   CREATE A WORD TYPE 4 INSTRUCTION. 
*   WE ALREADY HAVE CODES FROM FIELDS 2 AND 3.
* 
TYPE4 LDA .8
      LDB .3
      JSB CODE
TYP4A LDA FLD3     GET SPECIAL FIELD
      LDB MX? 
      CPA SPBLK+1  MX BLANK?
      SZB,RSS 
      JMP TY4.3 
      LDA UNCD     YES: CHANGE TO UNCD
      STA FLD3
TY4.3 ALF,RAR 
      SLA          BIT 13 SET?
      JMP TY4.0    YES: WORD-TYPE-4 SPECIAL 
      LDA ERR17 
      JSB ERROR 
      JSB DEFLT 
      DEC 8 
      STA FLD3
TY4.0 LDA @FLD6    ENSURE: EMPTY FIELDS 4 & 5 
      LDB @FLD4 
      JSB BLNK? 
      JMP *+2 
      JMP TY4.4    YES: B=@FLD6 
      LDA ERR25 
      JSB ERROR 
      LDB @FLD6 
TY4.4 JSB NUM 
      SOS 
      JMP TY4.1 
      LDA ERR19 
      JSB ERROR 
      CLA          DEFAULT TO 0 
TY4.1 STA FLD6
      AND MXAD1 
      SZA,RSS 
      JMP TY4.2 
      XOR FLD6     MODULO MAX ADDR
      STA FLD6
      LDA ERR23    OUT OF RANGE IN FIELD 6
      JSB ERROR 
* 
*   NOW PUT TOGETHER THE FIELDS OF THE TYPE 4 WORD. 
* 
TY4.2 LDB FLD3
      LSR 5 
      LDB FLD6
      LSR 11
EMIT1 STA INST1 
      CLA 
      LSR 4 
EMIT2 IOR FLD2
      ALF 
      STA INST2 
      JSB OUTPT 
      JMP P21 
* 
* 
******************************
* 
* 
*   WE COME HERE AFTER READING AN '$END' RECORD 
*   IN PASS 2.
* 
END2  JSB $LIST    ENABLE LISTING 
      CLA          LIST $END IF NOT OURS
      LDB NOEND 
      SZB,RSS 
      JSB LSTR2 
      JSB DONE     CLEAN UP 
      LDB .6      WRITE CONSOLE END MSG 
      LDA ANYER 
      SZA 
      LDB .12 
      STB BLEN
      JSB WRT.C 
      DEF C.TTY 
      DEF ENDMS 
      DEF BLEN
      JMP ABORT   ERROR RTN 
      LDA XREF?    CROSS-REF OPTION?
      SZA,RSS 
      JMP STOP
      JSB XREF     YES: SCHEDULE MXREF
      JMP STOPX    SKIP PAGE EJECT (DONE BY MXREF)
* 
* ABORT MICRO-ASSEMBLER 
* 
ABORT JSB DONE     CLEAN UP 
      JSB WRT.C    PRINT ABORT MSG
      DEF C.TTY 
      DEF AEND
      DEF .8
      NOP         ERROR RTN 
STOP  JSB SPC.C    EJECT PAGE 
      DEF C.LST 
      DEF .M2 
      NOP         ERROR RTN 
      LDA .M10
      STA TEMP
STOPX JSB END.C 
      DEF ANYER 
      ISZ TEMP     TRY AGAIN FOR A WHILE
      JMP STOPX 
      JMP 12       MP ABORT IF WE CAN'T QUIT NICE 
      SPC 2 
ABRT  JSB WRT.C 
      DEF C.TTY 
      DEF AEND
      DEF .8
      NOP 
      JMP STOPX 
      HED RTE MICRO-ASSEMBLER -- SUBROUTINES
      SKP 
******************************
* 
*   A L G N 
* 
*   ENTRY:
*     JSB ALGN
* 
*   EFFECTS THE "ALGN" PSEUDO-OP BY ADJUSTING 
*   PCNTR TO A HEX BOUNDARY.  NOTE THAT WE
*   DO NOT FLAG P-OVERFLOW HERE (ANALOGOUS
*   TO "ORG" PROCESSING). 
* 
ALGN  NOP 
      LDA PCNTR 
      ADA =B17
      AND =B177760
      JSB SETP
      JMP ALGN,I
* 
* 
******************************
* 
*   B L N K ? 
* 
*   ENTRY:
*     LDA <BPTR TO LAST CHAR+1> 
*     LDB <BPTR TO FIRST CHAR>
*     JSB BLNK? 
*     <FALSE EXIT>
*     <TRUE EXIT> 
* 
*   EXIT: 
*     B= BPTR TO CHAR FOLLOWING LAST BLANK
* 
*   SKIPS CONTIGUOUS BLANKS UP TO (BUT NOT INCLUDING) 
*   CHAR POINTED TO IN A-REG.  IF ALL BLANKS, RETURNS 
*   TO "TRUE" EXIT...OTHERWISE, RETURNS TO "FALSE" EXIT.
* 
BLNK? NOP 
      STA BTMP
      LDA BLNK
      JSB SKIP     SKIP ALL BLANKS
      LDA BTMP     @NEXT>=LIMIT?
      CMA,INA 
      ADA B 
      SSA 
      JMP BLNK?,I  NO: B=BPTR TO NEXT 
      LDB BTMP     YES: SET B=BPTR TO LAST+1
      ISZ BLNK? 
      JMP BLNK?,I 
BTMP  BSS 1 
* 
* 
******************************
* 
*   C L E A N 
* 
*   'CLEAN' FILLS A BUFFER WITH A GIVEN CHAR. 
* 
*   CALLING SEQUENCE: 
*      LDB <STARTING WORD ADDRESS OF BUFFER>
* 
*      LDA <+ NO. OF WORDS IN BUFFER> 
* 
*      JSB CLEAN
*      ASC 1,<HIGH AND LOW CHARS IN HIGH/LOW BYTES> 
* 
CLEAN NOP 
      CMA,INA 
      STA COUNT 
      LDA BLNK2     BRING IN BLANKS 
CLE0  STA B,I 
      INB 
      ISZ COUNT 
      JMP CLE0
      JMP CLEAN,I 
* 
* 
******************************
* 
*   C M P B 
* 
*   ENTRY:
*     LDA <BPTR TO LEFT STRING> 
*     LDB <BPTR TO RIGHT STRING>
*     JSB CMPB
*     DEC <LENGTH>
* 
*   EXIT: 
*     A<0 -- LEFT < RIGHT 
*      =0 -- LEFT = RIGHT 
*      >0 -- LEFT > RIGHT 
*     B= NUMBER OF EQUAL CHARACTERS 
* 
*   COMPARISON OF TWO STRINGS.
* 
CMPB  NOP 
      STA CBINP 
      STB CBDST 
      LDA CMPB,I   COMPUTE -COUNT 
      CMA,INA 
      STA COUNT 
      SZA,RSS      CHECK FOR ZERO LENGTH
      JMP CMPB2 
CMPB1 LDB CBINP    GET CHAR FROM LEFT STRING
      JSB LOADB 
      STB CBINP 
      STA CLFT
      LDB CBDST    GET CHAR FROM RIGHT STRING 
      JSB LOADB 
      STB CBDST 
      CMA,INA      LEFT >= RIGHT? 
      ADA CLFT
      SZA 
      JMP CMPB2 
      ISZ COUNT    LEFT=RIGHT 
      JMP CMPB1 
CMPB2 LDB CMPB,I   MAX - RESIDUAL = # EQUAL CHARS 
      ADB COUNT 
      ISZ CMPB     SKIP COUNT 
      JMP CMPB,I
CBDST BSS 1 
CBINP BSS 1 
CLFT  BSS 1 
* 
* 
******************************
* 
*   C N V R T 
* 
*   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= BPTR TO NEXT CHAR (EXCEPT WHEN OVERFLOW IS SET). 
* 
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 RESULT IN A-REG 
      JMP CNVRT,I 
CN2   STO            OVERFLOW 
      JMP CNVRT,I 
* 
* 
******************************
* 
*   C O D E 
* 
*   "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 <TABLE TYPE; FOR DETAILS, SEE UNDER
*          "$SRCH" SUBROUTINE>
*      LDB <FIELD NO.>
*      JSB CODE 
* 
*   CALLED FOR TYPES 2 THROUGH 9. 
*   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 @FADR    GET STARTING BYTE ADDRESS OF 
      LDB B,I       FIELD.
      JSB $SRCH     GO GET BINARY CODE. 
      SSA 
      JMP C06 
      LDB CSAVA    MNEMONIC TYPE
      CPB .6
      JMP C01 
      CPB .7
      JMP *+2 
      JMP C07 
* VERIFY THAT IT'S OK IN S-BUS FIELD
      LDB A 
      BLF,SLB 
      JMP C07      OK 
      JMP C06 
* VERIFY THAT IT'S OK IN STORE FIELD
C01   LDB A 
      BLF,RBR 
      SLB 
      JMP C07      OK 
C06   LDA CSAVA 
      ADA CERR
      LDA A,I 
      JSB ERROR     PRINT ERROR MESSAGE.
      JSB DEFLT 
CSAVA BSS 1        TABLE TYPE 
C07   LDB CSAVB     STORE CODE IN PROPER
      ADB @FLDS     FIELD WORD. 
      STA B,I 
      JMP CODE,I
CERR  DEF *-1,I    2-ORIGINED TABLE 
      DEF ERR3
      DEF ERR4
      DEF ERR5
      DEF ERR6
      DEF ERR7
      DEF ERR8
      DEF ERR3
      DEF ERR9
* 
* 
******************************
* 
*   C O N ? 
* 
*   ENTRY:
*     LDB <BPTR TO FIRST CHAR>
*     JSB CON?
*     <ERROR EXIT>
*     <OK EXIT> 
* 
*   EXIT (OK EXIT): 
*     A= VALUE
*     B= BPTR TO NEXT CHAR (AFTER NUMERIC STRING) 
* 
*   ROUTINE CONVERTS A NUMERIC STRING OF THE FORM:
*     [+/-] <DIGITS> [B]
* 
CON?  NOP 
      CCA 
      STA POS?
      JSB LOADB 
      CPA MINUS 
      ISZ POS?     CLEAR FLAG & SKIP
      CPA PLUS
      JMP *+2      SKIP SIGN
      ADB .M1     BACK-UP OVER FIRST CHAR 
      JSB OCT?     TRAILING "B"?
      JMP C.DEC    NO 
      CLO          YES: CONVERT B-FORM OCTAL
      JSB CNVRT 
      SOC C 
      JMP CON?,I   INVALID NUMBER 
      INB          SKIP "B" 
      JMP C.CV1 
C.DEC CCA          CONVERT DECIMAL VALUE
      CLO 
      JSB CNVRT 
      SOC C 
      JMP CON?,I   INVALID NUMBER 
C.CV1 STB CTMP     SAVE POINTER 
      LDB POS?     CORRECT SIGN 
      SZB,RSS 
      CMA,INA      POS?=0 ==> NEGATE
      LDB CTMP     RESET B=BPTR TO NEXT CHAR
      ISZ CON?
      JMP CON?,I
CTMP  BSS 1 
* 
* 
******************************
* 
*   D E C M L 
* 
*   ENTRY:
*     LDA <NUMBER>
*     LDB <BYTE POINTER TO LAST DIGIT>
*     JSB DECML 
*   EXIT: 
*     B= BYTE POINTER TO BYTE PRECEDING MOST-SIGNIFICANT
*        DIGIT
* 
*   ROUTINE CONVERTS NON-NEGATIVE NUMBER (IE., SIGN=0)
*   TO 4-DIGIT DECIMAL ASCII STRING 
* 
DECML NOP 
      STA BINRY 
      LDA .M4     NUMBER OF DIGITS
      STA DGITS 
DEC0  STB @DEST 
      CLB 
      LDA BINRY 
      DIV .10 
      STA BINRY    BINRY/10 
      LDA B        BINRY MOD 10 
      ADA =B60
      LDB @DEST 
      JSB STORB 
      ADB .M2     BPTR TO NEXT MOST-SIG DIGIT 
      ISZ DGITS 
      JMP DEC0
      JMP DECML,I 
* 
* 
******************************
* 
*   D E F L T 
* 
*   ENTRY:
*     JSB DEFLT 
*     DEC <SEARCH TABLE TYPE> 
* 
*   EXIT: 
*     A= DEFAULT FIELD ENTRY FOR TABLE TYPE 
* 
*   TABLE TYPE MUST BE ON [1,9] 
* 
DEFLT NOP 
      LDA DEFLT,I 
      ISZ DEFLT 
      ADA @DFLT 
      LDA A,I 
      JMP DEFLT,I 
* 
@DFLT DEF *,I      ONE-ORIGINED XE TABLE
      DEF OPBLK 
      DEF SPBLK 
      DEF ALZ 
      DEF ALBLK 
      DEF HIGH
      DEF STBLK 
      DEF SBBLK 
      DEF SPBLK 
      DEF SNBLK 
@MXD  DEF *,I      ONE-ORIGINED MX TABLE
      DEF OPBLK+1 
      DEF SPBLK+1 
      DEF CDBLK+1 
      DEF ALBLK+1 
      DEF HIGH+1
      DEF STBLK+1 
      DEF SBBLK+1 
      DEF UNCD
      DEF SNBLK+1 
* 
* 
******************************
* 
*   D O N E 
* 
*   ENTRY:
*     JSB DONE
* 
* FOR PASS2 COMPLETION ONLY.  DUMP CURRENT BUFFER AND 
* CLOSE OBJECT FILE.  ALSO PRINT PASS-COMPLETION
* MESSAGE.
* 
DONE  NOP 
      ISZ END?
      LDA FILE     RESET FILE STATE 
      LDB FMGR     IGNORE IF FILE ERROR 
      SZB,RSS 
      STA FILE? 
      JSB EMBUF    DUMP RECORD & WRITE END RECORD 
      JSB FINI     WRITE END-PASS MSG 
      JMP DONE,I
* 
* 
******************************
* 
*   E J E C T 
*   E J C T ? 
* 
*   ENTRY:
*     JSB EJECT  -OR-  JSB EJCT?
* 
*   EJECTS PAGE AND PRINTS HEADING.  IF ENTRY IS THROUGH
*   EJCT?, WE IGNORE REQUEST IF LISTING IS NOT ENABLED. 
*   WE DON'T PAGE EJECT IF WE ARE ALREADY POSITIONED AT 
*   TOP OF FORM.