      HED LIST PROGRAM
*
* **********************
****                  ***
***  LIST THE PROGRAM  ***
****                  ***
* **********************
*
LIST  LDB PBUFF     INITIALIZE TO FIRST
      STB TEMPS       STATEMENT OF PROGRAM
      JSB GETCR     SEQUENCE NUMBER GIVEN?
      JMP LIST0     NO
      LDB .BUFA     YES, SET FOR
      STB SBPTR       SEQUENCE NUMBER
      JSB INCHK,I   FETCH
      DEF MAXSN       IT
      LDA .BUFA,I   LOAD SEQUENCE NUMBER
      JSB FNDPS     FIND INTIAL STATEMENT
      JMP RDYDA,I
      NOP           SAVE
      STB TEMPS       ADDRESS
LIST0 CLB           HIGH-SPEED
      CPB TFLAG       PUNCH?
      JMP LIST1     NO
      LDA B133      YES, EMIT
      JSB LISTR,I     LEADER
LIST1 LDB TEMPS     MORE
      CPB PBPTR       PROGRAM?
      JMP LIS13     NO
      CCA           INITIALIZE
      ADA SBUFA       OUTPUT BUFFER
      STA BADDR         POINTER
      CLA           INITIALIZE
      STA CCNT        CHARACTER COUNT
      LDA TEMPS,I   OUTPUT
      JSB OUTIN       SEQUENCE NUMBER
      LDA BLANK     OUTPUT
      JSB OUTCR       BLANK
      ISZ TEMPS     FETCH
      LDA TEMPS,I     STATEMENT LENGTH
      CMA,INA       SET
      INA             WORD
      STA SLWST         COUNTER
LIST3 ISZ TEMPS     MORE
      ISZ SLWST       STATEMENT?
      JMP LIST4     YES
LIST2 LDB SBUFA     OUTPUT
      LDA CCNT
      JSB LISTR,I     STATEMENT
      JMP LIST1
LIST4 LDA TEMPS,I
      AND OPMSK
      SZA,RSS       NULL OPERATOR?
      JMP LIST5     YES
      STA TEMP2     NO, SAVE OPERATOR
      ALF,ALF       SINGLE
      ARS
      LDB 0           CHARACTER
      ADA M21
      SSA,RSS           OPERATOR?
      JMP LIS12     NO
      BLS           YES
      INB           LOAD
      ADB FOPBS       SYMBOL'S
      LDA 1,I           ASCII WORD
      ALF,ALF       ADJUST
      AND MSK0      CHARACTER
      CPA .34       * ?
      JMP LIS14     YES
      JSB OUTCR     NO
LIST5 LDA TEMPS,I
      AND OPDMK     SAVE
      STA TEMP3       OPERAND
      AND TYPFL     EXTRACT OPERAND TYPE
      STA LFLAG     SET LFLAG FALSE
      SSA           FLAG BIT SET?
      JMP LIST9     YES
      SZA,RSS       NO, NULL OPERAND?
      JMP LIST3     YES
      CPA .15       FUNCTION?
      JMP LIST8     YES
LIST6 ADA M5
      SSA           LETTER-DIGIT COMBINATION?
      JMP LIST7     NO
      CCA           YES, SET
      STA LFLAG       LFLAG FALSE
LIST7 LDA TEMP3
      ALF,ALF       RESTORE AND
      ALF
      AND B177        OUTPUT
      ADA B100
      JSB OUTCR         LETTER
      ISZ LFLAG     DIGIT FOLLOWS?
      JMP LIST3     NO
      LDA TEMP3     YES
      AND .15       RESTORE
      ADA .43         DIGIT
      JSB OUTCR     OUTPUT DIGIT
      JMP LIST3
LIST8 LDA F         OUTPUT
      JSB OUTCR       'F'
      LDA N         OUTPUT
      JSB OUTCR       'N'
      JMP LIST7
LIST9 XOR FLGBT
      CLE,SZA       NUMBER?
      JMP LIS10     NO
      ISZ TEMPS     YES
      STA SIGN      SET SIGN FLAG FALSE
      LDA TEMPS,I
      ISZ TEMPS
      LDB TEMPS,I
      ISZ SLWST
      ISZ SLWST
      SSA           NEGATIVE NUMBER?
      CCE           YES, SET SIGN FLAG TRUE
      JSB NUMOA,I
      NOP
      JMP LIST3
LIS10 CPA .3        INTEGER?
      JMP LIS11     YES
      CPA .15       NO, FUNCTION?
      RSS           YES
      JMP LIST6     NO, MUST BE A PARAMETER
      LDA TEMP3     COMPUTE
      ALF,RAL         PRINT
      AND OPMSK         TABLE
      STA TEMP2           CODE
      LDB ATAB      OUTPUT
      JSB MCOUT       FUNCTION NAME
      JMP LIST3
LIS11 ISZ TEMPS     OUTPUT
      ISZ SLWST
      LDA TEMPS,I     INTEGER
      JSB OUTIN
      JMP LIST3         OPERAND
LIS12 LDA BLANK     OUTPUT
      JSB OUTCR       BLANK
      LDB STTYP     OUTPUT
      JSB MCOUT       OPERATOR
      LDA REMOP     WAS IT
      CPA TEMP2       A REM?
      JMP OUTS1     YES, OUTPUT REMARK
      LDA BLANK     NO, OUTPUT
      JMP LIST5-1     A BLANK
LIS13 CLB           HIGH-SPEED
      CPB TFLAG       PUNCH?
      JMP RDYDA,I   NO
      LDA B133      YES, EMIT
      JSB LISTR,I     TRAILER
      JMP RDYDA,I
LIS14 JSB OUTCR     OUTPUT *
      JSB OUTST     OUTPUT QUOTE STRING
      LDA .34       OUTPUT
      JMP LIST5-1
*                       *
**  OUTPUT AN INTEGER  **
*                       *
OUTIN NOP           INTEGER IN (A)
      LDB M4        SET
      STB DIGCT       DIGIT COUNTER
      LDB LDVSR     SET DIVISOR
      STB DIVSR       ADDRESS
      CLB           SET LEADING
      STB LDZRO       ZERO FLAG
OUTI1 LDB DIVSR,I   NEGATE
      CMB,INB         AND STORE
      STB MIND          DIVISOR
      CCB           SET QUOTIENT
      INB             TO ZERO
      ADA MIND      SUBTRACT DIVISOR FROM INTEGER
      SSA,RSS       NEGATIVE RESULT?
      JMP *-3       NO, INCREMENT QUOTIENT
      ADA DIVSR,I   YES, RECOVER REMAINDER
      STA MCOUT       AND SAVE IT
      LDA 1
      SZA           ZERO?
      JMP OUTI2     NO
      CPA LDZRO     YES, LEADING ZERO?
      JMP OUTI3     YES
OUTI2 ADA .48       NO, COMPUTE ASCII FOR DIGIT
      STA LDZRO     SET 'ZEROES SIGNIFICANT'
      JSB OUTCR     OUTPUT DIGIT
OUTI3 LDA MCOUT     RETRIEVE REMAINDER
      ISZ DIVSR     SET FOR NEXT DIVISOR
      ISZ DIGCT     DIVISION NECESSARY?
      JMP OUTI1     YES
      ADA .48       NO, COMPUTE ASCII FOR LAST
      JSB OUTCR       DIGIT AND OUTPUT IT
      JMP OUTIN,I
*                     *
**  OUTPUT A STRING  **
*                     *
OUTST NOP           * ENTRY POINT
OUTS1 LDA TEMPS,I   REM ENTRY POINT
      AND B177      OUTPUT SECOND CHARACTER
      SZA             OF WORD IF
      JSB OUTCR         NOT NULL
      ISZ TEMPS     BUMP POINTER
      ISZ SLWST     REM COMPLETED?
      RSS           NO
      JMP LIST2     YES
      LDA TEMPS,I   EXTRACT
      ALF,ALF         FIRST CHARACTER
      AND B177          OF WORD
      CPA .2        EXIT
      JMP OUTST,I     IF A
      CPA .3            CLOSING
      JMP OUTST,I         QUOTE
      JSB OUTCR     OUTPUT
      JMP OUTS1       CHARACTER
*                                  *
**  LIST A MULTICHARACTER SYMBOL  **
*                                  *
MCOUT NOP
MCOU1 LDA 1,I       LOAD INFORMATION WORD
      AND OPMSK     COMPARE WITH
      CPA TEMP2       OPERATOR CODE
      JMP MCOU2     EQUAL
      LDA 1,I       UNEQUAL,
      AND .7          COMPUTE
      ADA .3            ENTRY
      ARS                 LENGTH
      ADB 0         COMPUTE ADDRESS OF NEXT ENTRY
      JMP MCOU1
MCOU2 LDA 1,I       COMPUTE
      AND .7          ENTRY
      CMA,INA           LENGTH
      STA DIGCT           AND SAVE IT
      CLE,INB       SET FOR FIRST CHARACTER
      STB TEMP3     SAVE SYMBOL ADDRESS
MCOU3 LDA TEMP3,I   LOAD WORD
      SEZ,RSS       FIRST CHARACTER?
      ALF,ALF       YES, POSITION IT
      AND B177      EXTRACT CHARACTER
      JSB OUTCR     OUTPUT IT
      SEZ,CME       SET FOR NEXT CHARACTER
      ISZ TEMP3     MOVE TO NEXT WORD OF SYMBOL
      ISZ DIGCT     MORE CHARACTERS?
      JMP MCOU3     YES
      JMP MCOUT,I
*
*
LDVSR DEF *+1
      DEC 10000
      DEC 1000
      DEC 100
      DEC 10
*
*
SFLAG EQU ARRYS
TABLE EQU PRGIN
LNGTH EQU TEMPS+8
SMEND EQU INTCK
SLENG EQU OVCHK
TBLPT EQU FNDPS
TSPTR EQU CLPRG
INTGR EQU OVCHK
LFLAG EQU PRGIN
DIVSR EQU INTCK
LDZRO EQU OVCHK
MIND  EQU FNDPS
      HED PRE-EXECUTION PROCESSING
*               ***********************
*               PHASE 2 OF THE COMPILER
*               ***********************
*
*               THIS PHASE HAS THE FOLLOWING 3 FUNCTIONS:
*               1. SYMBOL TABLE CONSTRUCTION
*               2. FOR LOOP CHECKING
*               3. ARRAY STORAGE ALLOCATION
*
MFASE LDA PBPTR     NULL
      CPA PBUFF       PROGRAM?
      JMP RDYDA,I   YES
      STA FCORE     NO, SET FOR-TABLE POINTER
      LDA FWAM
      STA COML     INITIALIZE COMMON POINTER
      LDA SYMTA
      STA SYMTF    INITIALIZE SYMBOL TABLE POINTER
      LDA PBUFF
      STA MPTR     INITIALIZE PROGRAM POINTER
MLOP1 LDB MPTR,I
      STB .LNUM    SET LINE NUMBER
      LDB MPTR
      ISZ MPTR
      ADB MPTR,I   COMPUTE LOCATION OF NEXT
      STB MNPTR    STATEMENT AND STORE THIS
      ISZ MPTR
      LDA MPTR,I   FETCH THE FIRST WORD IN THE
MLO10 ARS           STATEMENT AND SAVE
      ALF,ALF       THE STATEMENT TYPE
      AND .63
      STA TYPE
      CPA .46       MAT STATEMENT?
      JMP MLO12     YES
      CPA .30       NO, REM STATEMENT?
      STB MPTR      YES, SET TO SKIP IT
      CPA .43       NO, PRINT STATEMENT?
      STB MPTR      YES, SET TO SKIP IT
      CCA           NO, SET
      STA MWDNO       'FIRST VARIABLE'
      JMP MLOP2+1       FLAG
*
MLO12 LDA MPTR      SEEK
      INA             SUBSIDIARY
      LDA 0,I           STATEMENT
      JMP MLO10           TYPE
*
MLO13 AND MSK1      YES, ISOLATE OPERAND
      LDB MPTR     INDEX THE PROGRAM POINTER BY
      SZA,RSS      AN AMOUNT APPROPRIATE TO THE
      ADB .2       OPERAND. THE FOLLOWING APPLIES
      CPA .3       OPERAND = 0  ADD 2 TO POINTER
      INB          OPERAND =3  ADD 1 TO POINTER
      STB MPTR
*
MLOP2 ISZ MPTR      INCREMENT WORD-OF-STATEMENT PTR
      LDA MPTR      STATEMENT
      CPA MNPTR       EXHAUSTED?
      JMP MLOP5     YES
      LDA MPTR,I    NO
      SSA           'CONSTANT' OPERAND?
      JMP MLO13     YES
      AND MSK1      NO
      SZA,RSS       NULL OPERAND?
      JMP MLOP2     YES
      STA MBOX1     NO, SAVE IT
      AND .15       PROGRAMMER-DEFINED
      CPA .15         FUNCTION?
      JMP MLOP6     YES
      ADA M4        NO
      SSA           ARRAY VARIABLE?
      JMP MLOP7     YES
      LDA MBOX1     NO, SIMPLE VARIABLE
      JSB SSYMA,I   ALREADY IN
      SSB,RSS         SYMBOL TABLE?
      JMP MLOP3     YES
      LDA MNEG      NO
      LDB MNEG+1    ENTER
      STA MBOX1+1     IT WITH
      STB MBOX1+2       'UNDEFINED'
      LDA M3              VALUE
      JSB ESYMT
MLOP3 LDB TYPE
      LDA MBOX1
      CPB .34       NEXT STATEMENT?
      JMP MLOP4     YES
      CPB .33       NO, FOR STATEMENT?
      ISZ MWDNO     YES, FIRST VARIABLE?
      JMP MLOP2     NO
      ISZ FCORE     DEMAND
      LDB FCORE       SPACE
      CPB SYMTF         FOR NEW
      JMP MER8-1          ENTRY
      STA FCORE,I   SAVE VARIABLE NAME
      JMP MLOP2
*
MLOP4 LDB FCORE     FOR-TABLE
      CPB PBPTR       EMPTY?
      JSB ERROR     YES
MER3  CPA FCORE,I   NO, MATCH LATEST ENTRY?
      RSS           YES
      JMP MER3-1    NO
      ADB M1        REMOVE
      STB FCORE       MATCHED
      JMP MLOP2         ENTRY
*
MLOP5 CPA PBPTR     PROGRAM EXHAUSTED?
      RSS           YES
      JMP MLOP1     NO
      LDA TYPE      YES
      CPA .37       END STATEMENT?
      JMP M1LOP     YES
      JSB ERROR     NO
MLOP6 LDA MPTR,I    ISOLATE
      AND OPMSK       PRECEDING OPERATOR
      CPA DEFOP     'DEF' ?
      RSS           YES
      JMP MLOP2    NO GO TO PROCESS NEXT WORD
      LDA MBOX1    SEARCH SYMBOL TABLE FOR
      JSB SSYMA,I     THE FUNCTION
      SSB,RSS
      JSB ERROR    FOUND. ERROR MULTIPLY DEFINED
MER4  LDA MPTR
      ADA .3       ENTER THE FUNCTION INTO THE
      STA MBOX1+1  SYMBOL TABLE TOGETHER WITH
      LDA M2       ITS ENTRY POINT IN THE SOURCE
      JSB ESYMT    CODE
      JMP MLOP2    GO TO PROCESS THE NEXT WORD
*
MLOP7 STA 1
      LDA TYPE
      CPA .27       DIM STATEMENT?
      JMP MLOP8     YES
      CPA .28       NO, COM STATEMENT?
      JMP MLOP8     YES
      JSB MSYMT     NO, LOOK FOR IT IN SYMBOL TABLE
      JMP MLOP2     FOUND
      CLA           NOT THERE
      STA MBOX1+1   ENTER IT WITH
      STA MBOX1+2     DIMENSIONS AND
      STA MBOX1+3       DIMENSIONALITY
      JMP MLOP0           UNDEFINED
*
MLOP8 ISZ MPTR     PROCESS COM OR DIM STMT
      ISZ MPTR
      LDA MPTR,I   PICK UP FIRST DIMENSION
      ALF,ALF      SHIFT TO M. S. PART OF WORD
      CPB M3       IS THIS A SINGLE DIMENSION ARRAY
      JMP *+5      YES, JUMP
      ISZ MPTR     NO, INDEX POINTER TO THE LOC.
      ISZ MPTR     OF SECOND DIMENSION AND PACK
      IOR MPTR,I   INTO A WITH THE FIRST DIMENSION
      RSS
      IOR .1
      STA MBOX1+2  SET UP TO STORE PACKED
      STA MBOX1+3  DIMENSIONS IN FORMAL AND ACTUAL
      CLA           SLOTS AND UNDEFINED FLAG IN
      STA MBOX1+1  STORAGE ALLOCATION SLOT
      JSB MSYMT     IN SYMBOL TABLE?
      JMP MLOP9     NO
      LDA TYPE      YES
      CPA .28
      RSS          IS STMT A COM
      JMP MLOP0    NO, JUMP
      LDA MBOX1+2  YES PICK UP PACKED DIMENSIONS
      JSB MDIM     COMPUTE STORAGE REQUIRED
      LDB COML     POINTER TO NEXT FREE LOC IN COM
      STB MBOX1+1  STORE IN STORAGE ALLOCATION SLOT
      ADB 0        UPDATE POINTER BY THE AMOUNT OF
      STB COML     STORAGE ASSIGNED.
MLOP0 LDA M4       ENTER THE FOUR WORD ENTRY
      JSB ESYMT    PREVIOUSLY SET UP IN MBOX1 INTO
      JMP MLOP2    SYMBOL TABLE AND CONTINUE
*
MLOP9 ADB .2        CHECK THE FORMAL DIMENSIONS
      LDA 1,I      LOCATION TO SEE IF THE DIMENSION
      SZA           IS ALREADY DEFINED
      JSB ERROR    ERROR, DOUBLY DIMENSIONED
MER5  LDA TYPE
      CPA .28       COM STMT?
      JMP ESYN3,I   ERROB MISPLACED COM STMT
      LDA MBOX1+2
      STA 1,I      STORE THESE DIMENSIONS IN FORMAL
      INB          AND ACTUAL SLOTS IN SYMBOL TABLE
      STA 1,I      ENTRY
      JMP MLOP2    GO TO PROCESS NEXT WORD
*
*                  THE SECTION WHICH FOLLOWS CHECKS
*                  THAT ALL FOR LOOPS HAVE BEEN
*                  TERMINATED, ASSIGNS THE STANDARD
*                  DIMENSIONS TO UNDIMENSIONED ARRAYS
*                  AND MAKES STORAGE ASSIGNMENTS FOR
*                  ALL ARRAYS WHICH DO NOT APPEAR IN
*                  A COM STMT
*
M1LOP LDA FCORE     ALL FORS
      CPA PBPTR       MATCHED?
      RSS           YES
      JSB ERROR     NO
MER6  LDB SYMTF
*
M2LOP CPB SYMTA     MORE SYMBOLS?
      JMP M4LOP     NO
      LDA 1,I       YES
      AND .15       ACCONT FOR
      ADB .2          A FUNCTION
      CPA .15       IS IT?
      JMP M2LOP     YES
      INB           NO, ACCOUNT FOR
      ADA M4          SIMPLE VARIABLE
      SSA,INA,RSS   IS IT?
      JMP M2LOP     YES
      SZA,RSS       NO, # OF SUBSCRIPTS KNOWN?
      JSB ERROR     NO
MER10 INA           SAVE
      STA MBOX1+1     FLAG
      STB MBOX1     SAVE POINTER
      LDA 1,I       DEFINED
      SZA             ARRAY?
      JMP M3LOP     YES
      LDA STDIM     NO, LOAD
      ISZ MBOX1+1     APPROPRIATE
      ADA .9            STANDARD DIMENSIONS
      STA 1,I       RECORD AS
      ADB M1          FORMAL AND ACTUAL
      STA 1,I           DIMENSIONS
M3LOP JSB MDIM      SAVE STORAGE
      STA MBOX1+1     REQUIREMENT
      LDB MBOX1     LOAD
      ADB M2          ADDRESS OF
      LDA 1,I           ELEMENT SPACE
      SZA           DEFINED IN COM?
      JMP MER7      YES
      LDA FCORE     NO, USE CURRENT
      STA 1,I         FREE-CORE ADDRESS
      ADA MBOX1+1   UPDATE FREE-CORE
      STA FCORE       ADDRESS
      CMA,INA       OUT
      ADA SYMTF       OF
      SSA               SPACE?
      JSB ERROR     YES
MER7  ADB .3        NO, ADVANCE POINTER
      JMP M2LOP       TO NEXT ENTRY
*
M4LOP LDB PBPTR     INITIALIZE ALL
      CPB FCORE       ARRAY ELEMENTS
      JMP FASE3,I       TO 'UNDEFINED'
      LDA MNEG
      STA 1,I
      INB
      LDA MNEG+1
      STA 1,I
      INB
      JMP M4LOP+1
*
STDIM OCT 5001
      SKP
*               *****************************
*               ENTER SYMBOL TABLE SUBROUTINE
*               *****************************
*
*               TRANSFER -(A) WORDS FROM THE BUFFER ADDRESSED
*               BY MBUF TO THE TOP OF THE SYMBOL TABLE.
*
ESYMT NOP
      STA MBIN1    SAVE NEGATIVE OF LENGTH OF ENTRY
      ADA SYMTF
      STA SYMTF    MOVE SYMBOL TABLE START LOCATOR
      STA MBIN2    UP BY THE LENGTH OF ENTRY
      CMA,INA      CHECK THAT THE SYMBOL TABLE AND
      ADA FCORE     FOR TABLE DO NOT OVERLAP
      SSA,RSS
      JSB ERROR    OVERLAP ERROR
MER8  LDB MBUF     POINTER TO REQD ENTRY
      LDA 1,I      TRANSFER ENTRY TO THE SYMBOL
      STA MBIN2,I  TABLE
      INB
      ISZ MBIN2
      ISZ MBIN1
      JMP MER8+1
      JMP ESYMT,I  RETURN
*
*          **********************************************
*          SUBROUTINE TO SEARCH SYMBOL TABLE FOR AN ARRAY
*          **********************************************
MSYMT NOP          B GIVES ARRAY TYPE -3 = 1 DIM,
      STB MBIN1    -2 = 2DIM, -1 = UNDIMENSIONED
      LDA MBOX1    LOAD IDENTIFIER
      JSB SSYMA,I   SEARCH SYMBOL TABLE
      SSB,RSS
      JMP MSYMT,I  FOUND, RETURN
      ISZ MBIN1    IF ARRAY UNDIMENSIONED
      RSS
      JMP MSYM     JUMP TO NOT FOUND EXIT
      ISZ MBIN1    SET UP TO CHECK THAT ARRAY DOES
      ADA .2       NOT APPEAR IN THE TABLE WITH
      ADA M1       DIFFERENT DIMENSIONS. CHANGE
      JSB SSYMA,I   TYPE 2 TO 1 8 TYPE 1 TO  2 AND
      SSB,RSS      SEARCH AGAIN
      JSB ERROR    FOUND, INCONSISTENT DIMENSIONS
MSYM  ISZ MSYMT    NOT FOUND, INCREMENT RETURN
      JMP MSYMT,I  ADDRESS AND RETURN
*
*
MBUF  DEF TEMPS
MBOX1 EQU TEMPS
MBIN1 EQU SLWST
MBIN2 EQU RSCHK
MPTR  EQU SBPTR
MNPTR EQU OPCHK
COML  EQU TEMPS+9
MWDNO EQU TEMPS+10
DIGCT EQU MSYMT
