ASMB,R,B,C,L,X     DOS/RTE ALGOL
      HED  HP 21XX DOS/RTE ALGOL
* 
      NAM ALGOL,3,99 24129-60001 REV.D 761020 
* 
*     NAME: ALGOL 
*     SOURCE: 24129-80001 
*     RELOC:  24129-60001 
*     PGMR: E. STUTES 
* 
      ENT HPAL,%HPST
      EXT EXEC,.MPY,%WRIT,%WRIF,%READ,%JFIL 
      EXT       %LNAL,%ABAL 
A EQU 0 
B EQU 1 
      SUP 
      SPC 1 
*         ********************************************
*         * ERROR MESSAGES USED BY 21XX ALGOL (HPAL) *
*         ********************************************
*NO.                  ERROR EXPLANATION 
* 1   MORE THAN 2 CHARACTERS USED IN AN ASCII CONSTANT      SCANR 
* 2   @ NOT FOLLOWED BY AN OCTAL DIGIT                      SCANR 
* 3   OCTAL CONSTANT GREATER THAN 177777                    SCANR 
* 4   TWO DECIMAL POINTS IN ONE NUMBER                      SCANR 
* 5   NON INTEGER FOLLOWING APOSTROPHE                      SCANR 
* 6       LABEL DECLARED BUT NOT DEFINED IN PROGRAM 
* 7   NUMBER REQUIRED BUT NOT PRESENT              NUMBR
* 8   MISSING END                                HPAL 
*10   UNDEFINED IDENTIFIER                                  SCANT              Y
*11   ILLEGAL SYMBOL                                        SCANR 
*12   PROCEDURE DESIGNATOR MUST BE FOLLOWED BY LEFT PAREN.     PRO
*13   PARAMETER TYPES DISAGREE                              PRO 
*14   NAME PARAMETER MAY NOT BE AN EXPRESSION               PRO 
*15   PARAMETER MUST BE FOLLOWED BY A COMMA OR RIGHT PAREN. PRO 
*16   TOO MANY PARAMETERS                                   PRO 
*17   TOO FEW PARAMETERS                                    PRO 
*18   ARRAY VARIABLE NOT FOLLOWED BY A LEFT BRACKET         VARBL 
*19   SUBSCRIPT MUST BE FOLLOWED BY A COMMA OR RIGHT BRACKETVARBL 
*20   MISSING THEN                                          AEXP
*21   MISSING ELSE                                          AEXP
*22   ILLEGAL ASSIGNMENT                                    AEXP
*23   MISSING RIGHT PAREN.                                  PRMRY 
*24   STACK OVERFLOW  (4/10/70)                PRMRY
*25   PRIMARY MAY NOT BEGIN WITH THIS TYPE QUANTITY         PRMRY 
*26   TOO MANY SUBSCRIPTS                                   VARBL 
*27   TOO FEW SUBSCRIPTS                                   VARBL
*28  VARIABLE EXPECTED                                        VARBL 
*40   TOO MANY EXTERNAL SYMBOLS                             EXEXT 
*41   DECLARATIVE FOLLOWING STATEMENT                       BLOCK 
*42   NO PARAMETERS DECLARED AFTER LEFT PARENTHESIS         PRGEN 
*43   REAL,INTEGER, OR BOOLEAN ILLEGAL WITH THIS DECL.      DECL.PROC.
*44   DOUBLY DEFINED IDENTIFIER OR RESERVED WORD FOUND      IDTSQ 
*45   ILLEGAL SYMBOL IN DECLARATION                         DECL.PROC.
*46   STATEMENT STARTED WITH ILLEGAL SYMBOL                 STMPR 
*47   LABEL NOT FOLLOWED BY A COLON                         STMPR 
*48   LABEL IS PREVIOUSLY DEFINED                           STMPR 
*49   SEMICOLON EXPECTED AS TERMINATOR                      SEMIT 
*50   LEFT ARROW OR := EXPECTED IN SWITCH DECLARATION       SWGEN 
*51   LABEL ENTRY EXPECTED IN SWITCH DECL.                  SWGEN 
*52   REAL NUMBER ASSIGNED TO INTEGER                       HINOT 
*53   CONSTANT EXPECTED FOLLOWING LEFT ARROW OR :=          EQGEN-IDGEN 
*54   LEFT ARROW OR := EXPECTED IN EQUATE DECLARATION       EQGEN 
*55   LEFT BRACKET EXPECTED IN ARRAY DECLARATION            ARGEN 
*56   INTEGER EXPECTED IN ARRAY DIMENSION                   ARGEN 
*57   COLON EXPECTED IN ARRAY DIMENSION                     ARGEN 
*58   UPPER BOUND LESS THAN LOWER BOUND IN ARRAY            ARGEN 
*59   RIGHT BRACKET EXPECTED AT END OF ARRAY DIMENSIONS     ARGEN 
*60   TOO MANY VALUES FOR ARRAY INITIALIZATION              ARGEN 
*61   ARRAY SIZE ESCESSIVE (SET TO 2047)                    ARGEN 
*63   TOO MANY PARAMETERS FOR PROCEDURE                     PRGEN 
*64   RIGHT PAREN.EXPECTED AT END OF PROC.PARAMETER LIST    PRGEN 
*65   PROCEDURE PARAMETER DESCRIPTOR MISSING                PRGEN 
*66   'VALUE' PARAMETER FOR PROCEDURE NOT IN LIST            PRGEN
*67   ILLEGAL 'TYPE' FOUND IN PROCEDURE DECL.               PRGEN 
*68   ILLEGAL DESCRIPTOR IN PROC. DECLARATIVES              PRGEN 
*69   IDENTIFIER NOT LISTED AS PROCEDURE PARAMETER          PRGEN 
*70   NO TYPE FOR VARIABLE IN PROCED.PARAMETER LIST         PRGEN 
*71   SEMICOLON FOUND IN A FORMAT DECLARATION               FMGEN 
*72   LEFT PARENTHESIS EXPECTED AFTER I/O DECL.NAME         IOGEN 
*73   RIGHT PAREN.EXPECTED AFTER I/O NAME PARAMETERS        IOSET 
*74   UNDEFINED LABEL REFERENCE                             GOSTM 
*75   SWITCH IDENTIFIER NOT FOLLOWED BY A LEFT BRACKET      GOSTM 
*76   MISSING RIGHT BRACKET IN SWITCH DESIGNATOR             GOSTM
*77   THEN MISSING IN IF STATEMENT                          IFSTM 
*78   DO MISSING IN WHILE STATEMENT                         WHIST 
* 79   FOR VARIABLE MUST BE OF TYPE INTEGER            FORCL
* 80  FOR VARIABLE MUST BE FOLLOWED BY AN ASSIGN SYMBOLFORCL
* 81 STEP SYMBOL MISSING IN FOR CLAUSE                 FORCL
* 82 UNTIL SYMBOL MISSING IN FOR CLAUSE                FORCL
* 83 DO SYMBOL MISSING IN FOR CLAUSE                   FORCL
* 84  PARENTHESIS EXPECTED IN 'READ/WRITE' STATEMENT       IOSTM
*85   COMMA EXPECTED INRAD/WRITE STATEMENT                 IOSTM
*86   FREE FORM FORMAT(*) ILLEGAL WITH WRITE               IOSTM
* 87  UNMATCHED 'BEGIN' IN I/O STATEMENT LIST              IOGUT
* 88  MISSING BEGIN IN CASE STATEMENT 
* 89  MISSING END OF CASE STATEMENT 
* 100   PROGRAM MUST START WITH BEGIN, REAL, INTEGER OR PROCEDURE 
*999      TABLE AREAS HAVE OVERFLOWED, PROGRAM IS DISCONTINUED
      SKP 
*              * CONSTANTS FROM -12B TO 26B 
      OCT -12,-11,-10,-7,-6,-5,-4,-3,-2,-1
.     OCT 0,1,2,3,4,5,6,7,10,11,12
.ABS  EQU 1         ABS INTRINSIC 
.KEYS EQU 5         KEYS INTRINSIC
TYARA OCT 13        ARRAY TYPE
TYVAR OCT 14        VARIABLE TYPE 
TYEQU OCT 15        EQUATE TYPE 
TYPRO OCT 16        PROCEDURE TYPE (REAL OR INTEGER)
PRPRO OCT 17        PROPER PROCEDURE
TYCON OCT 20        CONSTANT TYPE 
DFLAB OCT 21,22     DEFINED LABEL TYPE
TYSWT OCT 23        SWITCH TYPE 
TYFMT OCT 24        FORMAT TYPE 
TYINP OCT 25        INPUT TYPE
TYOUT OCT 26        OUTPUT TYPE 
*********        *** END OF FIELD RELATIVE TO '.' ..
TEMPI OCT 30        INTEGER TEMPORARY 
TEMPR OCT 31        REAL TEMPORARY
TYUID OCT 36        UNDEFINED ID
TYUOP OCT 37        UNDEFINED OPERATOR
.37B  EQU TYUOP 
*              ABLAN OCT 40        BLANK
AQUOT OCT 42        ASCII QUOTE (") 
*              CROSS OCT 43        ASCII CROSSHATCH (#) 
AMPER OCT 46        ASCII AMPERSAND (&) 
APOST OCT 47      APOSTROPHE (')
*              ALPRN OCT 50        ASCII LEFT PAREN.
*              ARPRN OCT 51        ASCII RIGHT PAREN. 
*              APLUS OCT 53        ASCII PLUS 
*              ACOMA OCT 54        ASCII COMMA
*              AMINU OCT 55        ASCII MINUS
*              APOIN OCT 56        ASCII POINT
*              ASLSH OCT 57        ASCII SLASH
*              ACOLN OCT 72        ASCII COLON(:) 
*              ASEMI OCT 73        ASCII SEMICOLON (;)
*              ALESS OCT 74        ASCII LESS-THAN (<)
*              AEQUL OCT 75        ASCII EQUAL (=)
*              AGRTR OCT 76        ASCII GREATER (>)
*              AAT   OCT 100       ASCII @
*              POWER OCT 101       ** START OF BLOCK 0 ENTRIES ***
*              SLASH OCT 102       /
*              INTDV OCT 103       \
*              STAR  OCT 104       *
*              MINUS OCT 105       -
*              PLUS  OCT 106       +
LESS  EQU 107B      < 
LEQ   EQU 110B          <=
EQUAL EQU 111B           =
NEQ   EQU 112B           #
GEQ   EQU 113B          >=
GRTR  EQU 114B          > 
NOT   OCT 115 
AND   OCT 116 
OR    OCT 117 
STORE OCT 120       _ OR := 
*              MOD   OCT 121
*              CASE  OCT 126
*              BEGIN OCT 127
*              END   OCT 130
*              COLON OCT 131       :
SEMI  OCT 132       ; 
LPREN OCT 133       ( 
RPREN OCT 134       ) 
LBRAC OCT 135       [ 
RBRAC OCT 136       ] 
COMMA OCT 137       , 
ARRAY OCT 140 
INTEG OCT 141       INTEGER OR BOOLEAN
EQUAT OCT 142       EQUATE
FORMA OCT 143       FORMAT
*              INPUT OCT 144
OUTPU OCT 145       OUTPUT
PROCE OCT 146       PROCEDURE 
LABEL OCT 147 
REAL  OCT 150 
SWITC OCT 151       SWITCH
EOF   EQU 152B      END OF FILE 
UNLOD EQU 156B     UNLOAD 
*              WHILE OCT 157
*              PAUSE OCT 160       PAUSE
*              CODE  OCT 161
*              COMNT OCT 162
DO    OCT 163 
ELSE  OCT 164 
FOR   OCT 165 
*              GO    OCT 166
IF    OCT 167 
READ  OCT 170 
*              STEP  OCT 171
THEN  OCT 172 
*              TO    OCT 173
UNTIL OCT 174 
*              WRITE OCT 175
*              VALUE OCT 176
*              BUCK  OCT 177       $
.377  OCT 377 
P400B OCT 400 
IDTAB EQU *-9         AN ANACHRONISM. 
      ASC 3,           IDENT TABLE HERE 
      BSS 5 
      DEF *+2       IDTAB + 17 HERE 
DCONI DEF *+1       POINTS AT INTEGER CONSTANT
CONFO OCT 20044 
DCONR DEF *+1       POINTS AT REAL CONSTANT 
      OCT 120044
      SKP 
*         ************************************************
*         * SCND - SCAN SOURCE SYMBOLS TO NEXT SEMICOLON *
*         ************************************************
SCND  NOP 
      LDA .TYPE    PICK UP CURRENT SYMBOL TYPE
      RSS          SKIP OVER THE NEXT INSTRUCTION 
      JSB SCANR     GET NEXT SYMBOL 
      CPA SEMI      IS IT A ; ? 
      JMP  SCND,I   YES - EXIT
      JMP *-3       NO - GO BACK TO SCAN
*         ******************************
*         * CHARM - GET ADDRESS OF CUR-*
*         * RENT STUFF NAME.           *
*         *  A = ADDRESS OF ENTRY      *
*         * ON EXIT B = ADDRESS OF NAME*
*         *    A = NO. OF CHARS IN NAME*
*         ******************************
CHARM NOP 
      LDB A 
      LDA B,I 
      AND .37B      MASK IN STUFF WORD COUNT
      CMA,INA 
      ADB A 
      INB           B = LOC OF START OF NAME
      LDA B,I 
      AND HIMSK     GET NO.OF CHARS IN NAME 
      ALF,ALF 
      JMP CHARM,I  EXIT FROM CHARM
*         *************************************** 
*         * SETIN - SET UP PARAMETERS FOR ENTRY * 
*         *         TO THE 'INSRT' ROUTINE.     * 
*         *  ON ENTRY; A = ENTRY TYPE           * 
*         *            B = RBIT SETTING         * 
*         *  ON EXIT; A = LOC OF SYMBOL(*SYMB)  * 
*         *           B =0 (DON'T USE $NEXT)    * 
*         * $BLEV = BLK       $XBIT = 0         * 
*         * $TYPE V VAL OF A ON ENTRY           * 
*         * $RBIT = VAL OF B ON ENTRY           * 
*         * $ADDR = PCNTR                       * 
*         *************************************** 
SETIN NOP 
      STA $TYPE     SET ENTRY TYPE = A
      STB $RBIT     SET REAL/INT BIT = 0
      LDA BLK 
      STA $BLEV     SET BLOCK LEVEL = BLK 
      LDA PCNTR 
      STA $ADDR     SET ADDRESS = PCNTR 
      LDA $SYMB     SET A = LOC OF IDTAB+9
      CLB 
      STB $XBIT 
      JMP SETIN,I 
      SKP 
*         ******************************************************* 
*         * HINIT - GENERATE AN ASSIGNED CONSTANT INTO THE      * 
*         *         OBJECT CODE STREAM FOR ARRAYS AND VARIABLES.* 
*         *        - IF REAL IT GENERATES 2 WORDS               * 
*         ******************************************************* 
HINIT NOP 
      LDA .INFO,I   GET INFO WORD 
      LDB HT        GET TYPE OF VARIABLE
      SSA,RSS       IS THE CONSTANT A REAL NUMBER?
      JMP HINT5     NO - ITS AN INTEGER 
      CPB REAL      YES - CONSTANT IS REAL, IS TYPE?
      JMP HINT2     YES 
      JSB .FLAG     NO - ERROR, INCONSISTENT
      DEC 52        #52 - 'REAL NO. ASS'ND TO INTEGR' 
      CLA 
      STA IDNUM     SET NUMBER TO = 0 
      STA IDNUM+1 
HINT2 LDA IDNUM     EMIT PART OF REAL NO. 
HINT4 JSB EMOCT    EMIT AN OCTAL WORD 
HINT3 LDA IDNUM+1   EMIT INTEGER OR REST OF REAL NO.
      JSB EMOCT 
      JMP HINIT,I  EXIT HERE
HINT5 CPB REAL      IS TYPE = REAL? 
      RSS           YES 
      JMP HINT3     NO - GO TO INTEGER EMIT 
      LDA IDNUM+1  CONVERT AN INTEGER TO REAL 
      JSB FLOAQ 
      STB IDNUM+1  RESTORE THE CONVERTED NUMBER 
      JMP HINT4    GO AND EMIT IT.. 
* COMP COMPUTES THE NEGATIVE OF A FLOATING POINT NUMBER.
* IT IS CALLED WITH THE HIGH PART OF THE # IN B & THE 
* LOW PART IN A, AND RETURNS WITH IT THE SAME WAY.
COMPQ NOP 
      CMB,CLE      COMPLEMENT HI & CLE FOR TESTING
      XOR HIMSK    COMP. LOW MANTISSA BITS
      ADA P400B     AND ADD 1 TO THEM (2'S COMP)
      SEZ,RSS      IF E REMAINS CLEAR, THE LOW
      JMP COMPQ,I   BITS WERE NON0, SO WE'RE DONE 
      INB          OTHERWISE, BUMP THE HIGH BITS
      CPB BIT15    IF THE HIGH BITS ARE 100000
      JMP COMP1                   OR 140000 
      CPB PCMSK      WE HAVE A BOUNDARY CONDITION 
      RSS             AND MUST ADJUST.
      JMP COMPQ,I 
COMP1 ADB PCMSK    THAT ADJUSTS THE MANTISSA. 
      SLA,RAR      POSITION AND EXTEND THE EXPONENT 
      IOR XSEXP 
      SSB,RSS      IF NEW RESULT IS POSITIVE, WE
      INA,RSS      BUMP THE EXPONENT; 
      ADA .-1      IF NEGATIVE, WE DEBUMP IT
      RAL           NOW REPOSITION IT.
      AND .377
      JMP COMPQ,I 
XSEXP OCT 77600   FILL IN FOR HALFWIT NEGATIVE EXPS.
       HED OUTPUT A 'DBL' PUNCH WORD OR RECORD
*         **********************************************************
*         * BREC 1.PROCESSES THE BINARY DBL INSTRUCTIONS AND A DBL *
*         *        RECORD FOR OUTPUT ON THE PUNCH DRIVER           *
*         *      2.UPDATES THE CURRENT LOCATION CNTR(PCNTR / BCNTR)*
*         *   A REGISTER CONTENT INDICATES RELOCATION PARAMETER    *
*         *   0 = ABSOLUTE VALUE.          FOR THE CURRENT INSTRUC.*
*         *   1 = RELOCATABLE VALUE.                               *
*         *   4 = EXTERNAL VALUE                                   *
*         *   5 = MEMORY REFERENCE INST. USING A RELOCATABLE OPRND.*
*         *     IF =5 THEN LOCN. 'SUMP' CONTAINS THE OPERAND AND   *
*         *          LOCN.'INST',BITS 1 AND 0,CONTAIN RELOC.INDIC. *
*         *          0 = RELOCATABLE OPERAND                       *
*         *          1 = BASE PAGE RELOC. OPERAND                  *
*         *  B REGISTER CONTENT INDICATES BREC ACTION.             *
*         *   0 = OUTPUT THE CURRENT CONTENTS OF THE PUNCH BUFFER. *
*         *   1 = ADD A WORD(OR INSTRUCTION) TO THE PUNCH BUFFER.  *
*         * 'INST' CONTAINS THE WORD TO BE ADDED TO THE PNCH BUFFER*
*         **********************************************************
FBNP4 DEF PNBUF+4   START OF DATA INFO. (DBL TYPE)
BREC  NOP 
      STA T    SAVE RELOCATION PARAMETER
      LDA PNBUF 
      SZB       PUNCH A RECORD? 
      JMP HBR10 NO - INSERT A WORD
*         * EMIT A DBL PUNCH RECORD VIA 'PNCH'
      SZA,RSS  IS PNBUF EMPTY?
      JMP BREC,I  YES - EXIT
HBR06 LDA HSVST,I   POS'N RELOCN BYTES
      ALF,RAR 
      ISZ HRCNT 
      JMP *-2 
     RAL
      STA HSVST,I 
      JSB PNCH    GO TO PUNCH ROUTINE 
      JMP BREC,I  EXIT
*         * PROCESS A BINARY WORD FOR * 
*         * INSERTION IN PNBUF.       * 
HBR10 SZA   FIRST WORD IN RECORD? 
      JMP HBR20  NO, SKIP FOLLOWING SETUP.
*         * SET UP PNBUF FOR START OF A NEW RECORD.*
      LDA EMLDX+1   A=60000B (SETS 'RIC'=3) 
      ADA AAT     SET CURRENT PAGE BIT (100B) 
      LDB PCNTR   B=PROG LOCN CNTR
      STB PNBUF+3 SET DBL LOAD ADDRESS
      STA PNBUF+1 SET RIC WORD
      LDA .+4 
      STA PNBUF   SET RECORD WORD COUNT = 4.
      LDA FBNP4 
      STA HSTOR   SET CURR AVAIL BUFF LOC = PNBUF+4 
      LDA .-5 
      STA HRCNT   SET RELOC SLOT COUNTER = -5 
      LDA M54 
      STA HCNTB   SET WORD COUNTER = -54
*         * PROCESS 'INST' FOR INSERTION INTO DBL RECORD.*
HBR20 ISZ PCNTR     BUMP LOC'N CNTR(PCNTR OR BCNTR) 
      LDA HRCNT  IS SLOT CNTR =-5 
      CPA .-5 
      RSS        YES
      JMP HBR25  NO, SKIP SLOT SETUP
      LDA HSTOR 
      STA HSVST  SET ADDRESS FOR NEXT SET OF BYTES
      CLA 
      STA HSVST,I   CLEAR BYTE STORAGE WORD 
      ISZ HSTOR  BUMP TO NEXT AVAILABLE ADDRESS 
      ISZ PNBUF  BUMP RECORD WORD COUNT 
HBR25 ISZ PNBUF+1 BUMP DATA WORD COUNT
      LDA HSVST,I 
      ALF,RAR 
      IOR T       SET RELOC TYPE INTO BYTE SLOT 
      STA HSVST,I    AND REPLACE IT.
      ISZ HRCNT  IS LAST SLOT IN RELOC BYTE WRD FULL
      JMP HBR30   NO. 
      RAL     YES,POSITION BYTE WORD FOR FULL SET 
      STA HSVST,I SET RELOC.BYTE WORD.
      LDA .-5 
      STA HRCNT  SET RELOC SLOT CNTR = -5.
      LDA HCNTB 
      CPA .-1   WORD CNTR ALMOST DONE? (=-1?) 
      JMP HBR30  YES
      ISZ HCNTB   NO, BUMP IT 1 MORE
HBR30 LDA INST    ***INSERT 'INST' INTO DBL RECORD *
      STA HSTOR,I 
      ISZ HSTOR   BUMP RECORD STORE ADDRESS.
      ISZ PNBUF   BUMP RECORD WORD COUNT
    LDA T * TEST RELOCATION ENTRY PARAMETER FOR =5 *
      CPA .+5   =5 ?
      RSS       YES 
      JMP HBR40  NO, SKIP SPECIAL PROCESSING. 
      LDA SUMP   SET RELOC.OPERAND INTO NEXT SLOT 
      STA HSTOR,I    IN THE RECORD
      ISZ HSTOR   BUMP RECORD STORE ADDRESS.
      ISZ PNBUF   BUMP RECORD WORD COUNT
      ISZ HCNTB   WAS THIS THE LAST WORD IN THE REC?
      JMP HBR40   NO
      JMP HBR06   YES, GO AND OUTPUT THE RECORD.
HBR40 ISZ HCNTB   IS THE RECORD FULL NOW? 
      JMP BREC,I  NO, RETURN
      JMP HBR06   YES, GO OUTPUT THE CURRENT RECORD.
M54   DEC -54 
HCNTB BSS 1    WORD COUNTER FOR PNBUF (BREC)
HRCNT BSS 1    RELOC.BYTE COUNTER(-5 TO -1) IN BREC 
HSTOR BSS 1    CURRENT AVAIL.PNBUF LOC'N FOR DBL WRD
HSVST BSS 1    CURRENT ADDR.FOR RELOC.BYTES (BREC)
INST  BSS 1    INSTRUCTION FOR PUNCH/LIST OUTPUT
SUMP  BSS 1    MEMORY REFRNCE OPRND FOR BREC/HLIST
      HED 'LIST OBJECT CODE' SUBROUTINE             LB
*         ****************************************
*         * HLIST - LIST A LINE OF OBJECT CODE   *
*         *         GENERATED BY THE COMPILER.   *
*         *  -A- REGISTER PARAMETERS:            *
*         *    0 = MEMORY REFERENCE   INSTRUCTION*
*         *    1 = OCTAL              INSTRUCTION*
*         *    2 = DEF                INSTRUCTION*
*         *    3 = ORG                PSEUDO-OP  *
*         *    4 = ORR                PSEUDO-OP  *
*         *    5 = BSS                PSEUDO-OP  *
*         *    6 = REGISTER REFERENCE INSTRUCTION*
*         *    7 = ASCII WORD         INSTRUCTION*
*         *                                      *
*         *  FORMAT OF LINE:                     *
*         *                                      *
*         *   COLUMNS         CONTENTS           *
*         *   -------         --------           *
*         *                                      *
*         *     1-2        BLANK                 *
*         *     3-7        LOCATION COUNTER      *
*         *     8-9        BLANK                 *
*         *    10-15       OBJECT CODE WORD      *
*         *     16         BLANK                 *
*         *     17         RELOCATION INDICATOR  *
*         *                  (R, X, OR BLANK)    *
*         *    18-19       BLANK                 *
*         *    20-34       LABEL FIELD           *
*         *    35-36       BLANK                 *
*         *    37-39       OP CODE FIELD (EXCEPT *
*         *                  REGISTER REFERENCE) *
*         *    37-51       OP CODE FIELD (RRF)   *
*         *    40-41       BLANK (EXCEPT FOR RRF)*
*         *    42-56       OPERAND FIELD (NOT    *
*         *                  USED FOR RRF OR ORR)*
*         *  FOLLOWING     +1 (AS REQUIRED)      *
*         *    OPERAND     ,I (AS REQUIRED)      *
*         *                                      *
*         * THE MAXIMUM LINE LENGTH IS 60 CHARS. *
*         * PRBUF IS CLEARED AFTER EACH PRINTING.*
*         ****************************************
BLBL  ASC 1,
HLSTA BSS 1         HLIST PARAMETER.
HLIST NOP           ENTRY/EXIT. 
      STA HLSTA     SAVE ENTERING HLIST PARAMETER.
      LDA LSFLG 
      SZA,RSS       IF OBJECT CODE LISTING NOT
      JMP HLIST,I     WANTED, RETURN IMMEDIATELY. 
      LDA PCNTR     WE WANT LISTING, GET CURRENT
      JSB OCONV      PCNTR, CONVERT IT TO OCTAL,
FUBRP DEF PRBUF       AND STORE IT IN PRBUF.
      LDA BLBL      RESTRICT PCNTR PRINTOUT TO
      STA FUBRP,I     FIVE OCTAL DIGITS.
      LDA .INFO     GET CURRENT STUFF ADDRESS 
      STA HLS04       AND SAVE UNTIL END. 
      LDA HLS05     GET SCATR'S LAST INFO WORD
      STA HLS06       AND SAVE IT UNTIL END.
      JSB LBLCK     IF THIS IS LOCN OF A LABEL, 
      RSS             CHECK FOR INSTRUCTION TYPE. 
      JMP HLS10     NOT A LABEL, SKIP CHECK.
      LDB HLSTA     IF INSTRUCTION
      CPB .+4        IS AN ORR
      JMP HLS10 
      CPB .+3         OR AN ORG,
      JMP HLS10        BYPASS LABEL STORE.
      JSB STLBL     STORE LABEL IN LABEL FIELD. 
HLS10 LDA HLSTA     RECALL LIST PARAMETER.
      ADA PRTBL     USE IT TO TRANSFER
      JMP A,I         TO PROPER CONTROL ROUTINE.
      SPC 1 
PRTBL DEF *+1,I     HLIST JUMP TABLE. 
      DEF MEMRF     MEMORY REFERENCE    - HLSTA = 0.
      DEF OCTAL     "OCT"    PROCESSOR  - HLSTA = 1.
      DEF DEF       "DEF"    PROCESSOR  - HLSTA = 2.
      DEF ORG       "ORG"    PROCESSOR  - HLSTA = 3.
      DEF ORR       "ORR"    PROCESSOR  - HLSTA = 4.
      DEF BSS       "BSS"    PROCESSOR  - HLSTA = 5.
      DEF REGRF     REGISTER REFERENCE  - HLSTA = 6.
      DEF ASCII     "ASC 1," PROCESSOR  - HLSTA = 7.
      SPC 1 
ASCII JSB STINS     STORE CONVERTED INSTRUCTION CODE. 
      LDA .+3       STORE MNEMONIC
      LDB DASCI      "ASC 1," 
      JSB STMNM       INTO OP CODE FIELD. 
      LDA INST      STORE TWO ASCII CHARACTERS
      STA DPB21,I     FOLLOWING "ASC 1,". 
      LDA ACOMA     = DECIMAL 44, CHARACTER COUNT.
      JMP HLS40     LINE SET, GO PRINT IT.
      SPC 1 
DASCI DEF *+1 
      ASC 3,ASC 1,
      SPC 1 
OCTAL JSB STINS     STORE CONVERTED INSTRUCTION WORD. 
      LDA .+2       STORE 
      LDB DOCTL      "OCT" MNEMONIC 
      JSB STMNM       INTO OP CODE FIELD. 
      LDA INST      STORE 
BSS1  JSB OCONV      OCTAL INSTRUCTION
DPB20 DEF PRBUF+20    INTO OPERAND FIELD. 
      LDA ASLSH     = DECIMAL 47, CHARACTER COUNT.
      JMP HLS40     LINE SET, GO PRINT IT.
      SPC 1 
DOCTL DEF *+1 
      ASC 2,OCT 
      SKP 
DEF   LDB DDEF
      LDA .+2       CONTROL HERE FOR JSB TO EXT.
      JSB STMNM     STORE "DEF" OR "JSB" MNEMONIC.
      JSB STINS     STORE CONVERTED INSTRUCTION WRD.
      LDB EMREL     GET RELOCATION INDICATOR. 
      LDA "R"       DEFAULT TO "R". 
      CPB .+4       IF THIS IS EXTERNAL,
      LDA "X"         REPLACE "R" WITH "X". 
      STA DPB8,I    STORE RELOCATION CHAR IN BUFFER.
      CPB .+4       IF THIS IS EXTERNAL,
      JMP DEF4        GO GET NAME FOR PRINT BUFFER. 
      LDA INST      NOT AN EXT, GET INSTR CODE AND
      ELA,CLE,ERA     REMOVE ANY INDIRECT BIT.
      JSB LOOK2     LOOK UP SYMBOL FOR -B-. 
      JMP DEF2      END TABLE, NO SYMBOL REFERENCE. 
      JSB COMPR     SYMBOL MATCHED, IS IT PRINTABLE?
      JMP DEF5      YES, GO GET IT. 
DEF2  LDA HLS02     NO, SO WE PRINT OCTAL ADDRESS.
      CMA,INA       CHECK TO SEE IF OPERAND ADDRESS 
      ADA PCNTR      IS WITHIN 7 OF LOAD ADDRESS. 
      LDB APLUS       AS A PRELIMINARY, DETERMINE 
      SSA,RSS          "+" OR "-".
      LDB AMINU 
      BLF,BLF       ROTATE SIGN TO TOP HALF OF WD.
      SSA           IF DISTANCE IS NEGATIVE,
      CMA,INA         SET IT POSITIVE.
      ADB AZERO     ADD ASCII OFFSET TO -B-.
      ADB A         ADD DISTANCE IN CASE O.K. 
      AND .-8       WIPE OUT LOW 3 BITS.
      SZA           IF DISTANCE GREATER THAN 7, 
      JMP DEF3        THEN JUST PRINT OCTAL ADDR. 
      STB DPB21,I   DIST <= 7, STORE IN PRINT BUFR. 
      LDA ASTAR     THEN GET ASTERISK,
      IOR HNRIC      INCLUDE LEADING BLANK, 
      STA DPB20,I     & PUT IN FRONT OF DISTANCE. 
      JMP DEF6      GO TEST FOR INDIRECT. 
DEF3  LDA HLS02     OPERAND AND PCNTR SEPARATED 
      JSB OCONV      BY MORE THAN 7, SO JUST PRINT
      DEF PRBUF+20    OPERAND ADDRESS.
      JMP DEF6      GO TEST FOR INDIRECT. 
      SPC 1 
DEF4  LDA HLS01     EXTERNAL, GET ITS SYMBOL ADDR.
      RSS           SKIP. 
DEF5  LDA .INFO     FORMAT, VARIABLE, LABEL, ARRAY, 
*                                     OR PROCEDURE. 
      JSB STOPD     STORE SYMBOL IN OPERAND FIELD.
DEF6  LDB INST
      LDA BLBL      ENTER:  -A- = TWO BLANKS. 
      SSB           IF INSTRUCTION IS INDIRECT, 
      LDA COMAI       REPLACE THEM WITH ",I". 
      JSB ADCHR     APPEND CHARS, SET PTR FOR CCNT. 
HLS30 LDA FUBRP     CHARACTER COUNT = 
      CMA,INA         2*(PTR - FUBRP + 1) 
      ADA PTR 
                                                                                                                                                                                        