ASMB,R,Q,C
      HED <<RTE BASIC - LISTER/SEG #2>>       92101-16005 REV.2040
      NAM BASC2,5 92101-16005 REV.2040 800804 
* 
* 
* 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
* 
* 
* 
*      NAME:      BASC2 
*      SOURCE:    92101-18005 
*      RELOC:     92101-16005 
*      PGMR:      B.J.L.
* 
* 
* 
************************************************************* 
* 
      ENT BASC2,MCOPY 
      EXT EXEC,RDYPT,FNDPS,OUTCR,OUTIN,INTCK
      EXT CLOSE,WRITF,WRITE,ERRPT,NUMOT,GETCR,FCNS
      EXT IFBRK,FINDV,SPEC2,PRMT,COMFL,OPEN,READF 
      EXT GMS.C,ROTAT 
      COM TEMPS(32),PNTRS(75),FILBF(16),FLDCB(144),SPEC(10) 
* 
* INCREASED PNTRS TO 75 *2040*800803* 
* 
*INCREASED TEMPS SIZE TO 32 *800130*BL* 
* 
**************************************
*                                    *
*    SEGMENT #2: LIST THE PROGRAM    *
*                                    *
**************************************
* 
*  THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL 
*    WHENEVER THE 'LIST' OR 'SAVE'  COMMANDS ARE GIVEN. IT WILL RE- 
*    CONSTRUCT A USER PROGRAM, LINE BY LINE, CONVERTING IT FROM THE 
*    TRANSLITERATED FORM TO ASCII. IT THEN OUTPUTS THIS ASCII TO
*    THE LIST DEVICE. 
* 
*  IN ADDITION, THIS SEGMENT IS LOADED WHENEVER AN ERROR OCCURS. IT 
*    WILL PRINT OUT THE APPROPRIATE ERROR MESSAGE AND THEN RETURN 
*    EXECUTION TO THE MAIN CONTROL PROGRAM. 
      SKP 
*************************** 
*                         * 
* CONSTANTS AND VARIABLES * 
*                         * 
*************************** 
* 
FWAM  EQU PNTRS     FIRST WORD OF AVAILABLE MEMORY
LWBM  EQU PNTRS+1   LAST WORD OF AVAILABLE MEMORY 
.INBF EQU PNTRS+2   INPUT BUFFER ADDRESS
SBUFA EQU PNTRS+3   SYNTAX BUFFER ADDRESS 
SYMTA EQU PNTRS+4   START OF SYMBOL TABLE 
SYMTF EQU PNTRS+5   END OF SYMBOL TABLE 
PBUFF EQU PNTRS+6   FIRST WORD OF USER PROGRAM
PBPTR EQU PNTRS+7   LAST WORD+1 OF USER PROGRAM 
INBFA EQU PNTRS+8   INPUT BUFFER POINTER
ICCNT EQU PNTRS+9   INPUT CHARACTER COUNT 
SBPTR EQU PNTRS+10  SYNTAX BUFFER POINTER 
.LNUM EQU PNTRS+11  CURRENT LINE #
FCORE EQU PNTRS+12  START OF FREE CORE
MNNAM EQU PNTRS+13  MNEMONIC TABLE NAME:SC:LU 
BRNAM EQU PNTRS+18  BRANCH TABLE NAME:SC:LU 
FWAMM EQU PNTRS+23  POINTER TO START OF MNEMONIC TABLE
FWAMB EQU PNTRS+24  POINTER TO START OF BRANCH TABLE
.OTBF EQU PNTRS+25  POINTER TO OUTPUT BUFFER 
OCCNT EQU PNTRS+26  OUTPUT CHARACTER COUNT
OTBFA EQU PNTRS+27  POINTER INTO OUTPUT BUFFER
LUOUT EQU PNTRS+28  CURRENT OUTPUT L.U. # 
LUINP EQU PNTRS+29  CURRENT INPUT L.U. #
SIGN  EQU PNTRS+30  SIGN OF CURRENT NUMBER
BLANK EQU PNTRS+31  CURRENT TERMINATION CHAR
REC#  EQU PNTRS+32  COMMAND FILE RECORD NUMBER
FLTYP EQU PNTRS+33  TYPE 0 FILE FLAG
TTYPR EQU PNTRS+34  CONSOLE TTY L.U. #
PRINT EQU PNTRS+35  LISTING L.U. #
READR EQU PNTRS+36  AUXILLIARY INPUT L.U. # 
PUNCH EQU PNTRS+37  AUXILLIARY OUTPUT L.U. #
ERTTY EQU PNTRS+38  ERROR LIST OUTPUT L.U. #
DCB   EQU PNTRS+39  DATA CONTROL BLOCK ADDRESS
FILBK EQU PNTRS+40  FILE CONTROL BLOCK ADDRESS
PFLAG EQU PNTRS+41  SAVE,LOAD FILE FLAG 
LOLIM EQU PNTRS+42  LOW LIMITS OF PROGRAM 
HILIM EQU PNTRS+43  HIGH LIMITS OF PROGRAM
LORUN EQU PNTRS+44  LOW RUN LIMITS
HIRUN EQU PNTRS+45  HIGH RUN LIMITS 
SLSTM EQU PNTRS+46  EXECUTE SLOW STMTS
LOTRC EQU PNTRS+47  LOW TRACE LIMITS
HITRC EQU PNTRS+48  HIGH TRACE LIMITS 
BRKP1 EQU PNTRS+49  BREAK POINT #1
BRKP2 EQU PNTRS+50  BREAK POINT #2
BRKP3 EQU PNTRS+51  BREAK POINT #3
BRKP4 EQU PNTRS+52  BREAK POINT #4
SMFLG EQU PNTRS+53  SIMULATE FLAG 
TYPE  EQU PNTRS+54  PARTIAL LINE CHARACTER COUNT
DLMTR EQU PNTRS+55  CHAR EDIT DELIMITER 
MERGF EQU PNTRS+56  MERGE FLAG
COMN  EQU PNTRS+57  COMMAND FILE NAME 
MANT1 EQU PNTRS+60  MANTISSA #1 
MANT2 EQU PNTRS+61  MANTISSA #2 
EXPNT EQU PNTRS+62  EXPONENT
INLOC EQU PNTRS+63  INV. LOC. LU,STRK,#TKRS BR. 
INTKZ EQU PNTRS+64  TRACK SIZE ON DISC FOR INV. BR. 
HSTPT EQU PNTRS+65  HIGH-STACK POINTER         BR.
TSTPT EQU PNTRS+66  TEMPORARY STACK POINTER    BR.
LSTPT EQU PNTRS+67  LOW-STACK POINTER          BR.
LSTAK EQU PNTRS+68  LOW-STACK ADDRESS          BR.
PRADD EQU PNTRS+69  PROGRAM EXECUTION          BR.
DSTRT EQU PNTRS+70  DATA                       BR.
NXTDT EQU PNTRS+71    STATEMENT                BR.
DCCNT EQU PNTRS+72      POINTERS               BR.
NXTST EQU PNTRS+73      NEXT STMT NUMBER 
TRAPF EQU PNTRS+74  TRAP BUSY FLAG *2040*800803*
      SKP 
TEMPT BSS 7 
STTYP DEF LET 
FOPBS DEF QUOTE-2 
LNBFA DEF LNBFF-1 
ERBFA DEF ERBUF 
DCBAD DEF FLDCB 
AFCNS DEF FCNS
      SPC 1 
      SUP PRESS MULTIPLE LISTINGS 
      SPC 1 
.0    DEC 0 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.5    DEC 5 
.7    DEC 7 
.10   DEC 10
.15   DEC 15
.20   DEC 20
.32   DEC 32
.34   DEC 34
.40   DEC 40
.45   DEC 45
.73   DEC 73
.125  DEC 125       *2001*MM***ADD
.132  DEC 132       *2001*MM***ADD
.133  DEC 133       *2001*MM***ADD
.1000 DEC 1000
.9999 DEC 9999
.G50  OCT 50000 
B36   OCT 36
B37   OCT 37
B40   EQU .32 
B44   OCT 44
B60   OCT 60
B100  OCT 100 
F     OCT 106 
N     OCT 116 
B177  OCT 177 
B777  OCT 777 
MSK0  OCT 377 
B1000 OCT 1000
B1100 OCT 1100
COMWD OCT 34000 
REMOP OCT 36000 
IMAOP OCT 67000 
FOROP OCT 41000 
NEXOP OCT 42000 
NSBOP OCT 56000 
FILOP OCT 63000 
SPLOP OCT 65000 
ONOP  OCT 73000 
TYPFL OCT 100017
OPDMK OCT 100777
M1    DEC -1
M2    DEC -2
M3    DEC -3
M4    DEC -4
M5    DEC -5
M21   DEC -21 
M42   DEC -42 
M99   DEC -99 
M1000 DEC -1000 
M2001 DEC -2001    *2040*BL*800314
MNEG  OCT 100000   MAXIMUM NEGATIVE FLOATING
      OCT 376         POINT NUMBER
FLGBT EQU MNEG
      SPC 3 
ERBUF ASC 5, IN LINE
LNBFF BSS 2 
BLNK  DEF *+1 
      ASC 2,  _                                                     : 
ALEN  DEF *+1 
      OCT 3 
      ASC 2,LEN 
FORCT NOP           'FOR'-'NEXT' SPACE COUNTER
LNCNT NOP           LINE COUNTER
CRLF  DEF *+1 
      OCT 6412
      SKP 
********************
*                  *
* LIST THE PROGRAM *
*                  *
********************
BASC2 NOP 
      LDA PFLAG     IS THIS INITIALIZATION?*****
      CPA .9999 
      RSS           YES, GO GET SEGMENT'S FWAM AND LWAM 
      JMP BAS2C     NO, CONTINUE EXECTION 
      JSB GMS.C 
      JMP ROTAT     RET. TO MAIN FOR FWAM AND LWAM CHECK***** 
BAS2C CLA           INITIALIZE
      STA LNCNT       LINE COUNTER
      LDA LUOUT     IS IT ERROR 
      SSA             MESSAGE ENTRY?
      JMP PRMES     YES!
      LDB LOLIM     SET PTR 
      STB TEMPS       TO PROGRAM START
      LDB PRINT     ASSUME PRINTER
      LDA PFLAG       BUT CHECK FLAG FOR SURE 
      SSA               -1 IF PUNCH 
      LDB PUNCH           ITS A PUNCH REQUEST 
      CMA,SSA,INA,SZA PFLAG <= 0? 
      JMP LIST1     NO, FILE OUTPUT 
      STB LUOUT     SAVE OUTPUT DEVICE L.U. 
      SPC 1 
*  IF LINE PRINTER LIST DEVICE - MOVE FORM TO NEW PAGE
*    IF PUNCH LIST DEVICE - PUNCH LEADER ON TAPE
      SPC 1 
      LDA LUOUT 
      JSB FINDV     FETCH DRIVER NUMBER 
      CPA .2        PUNCH?
      JMP LIS40     YES!
      CPA .10       LINE PRINTER? 
      JMP LIS41     YES, THROW A PAGE!
      CPA .5        CRT LINEPRINTER?
      RSS           MAYBE!
      JMP LIST1     NO SPECIAL PROCESSING 
      CPB .4
LIS41 JSB HEAVE     START AT TOP OF FORM
      JMP LIST1 
* 
LIS40 LDA LUOUT     FORM LEADER 
      IOR B1000       CONTROL WORD
      STA TEMP3 
      JSB EXEC      CALL EXEC 
      DEF *+3 
      DEF .3          TO PUNCH
      DEF TEMP3         LEADER
      SPC 1 
*  INITIALIZE FOR CONVERTING A STATEMENT
      SPC 1 
LIST1 LDB TEMPS     MORE
      CPB HILIM       PROGRAM?
      JMP LIS13     NO
* 
      CCA           INITIALIZE
      ADA .OTBF       OUTPUT
      STA OTBFA         BUFFER POINTER
      CLA           INITIALIZE
      STA OCCNT       CHAR COUNT
      SKP 
* 
      JSB OUTBL     OUT PUT A BLANK 
      JSB OUTBL     OUT PUT A BLANK 
      ISZ LNCNT     UPDATE LINE COUNTER 
      SPC 1 
*  OUTPUT LINE NUMBER 
      SPC 1 
      LDA TEMPS,I   OUTPUT
      STA .LNUM 
      JSB OUTIN       SEQUENCE NUMBER 
      JSB OUTBL     OUTPUT A BLANK
      LDB FORCT 
      JSB FORSP     INDENT 'FOR'-'NEXT' LOOP
      ISZ TEMPS     FETCH 
      LDA TEMPS,I     STATEMENT LENGTH
      CMA,INA       SET 
      INA             WORD
      STA LCNTR         COUNTER 
LIST3 ISZ TEMPS     MORE
      ISZ LCNTR       STATEMENT?
      JMP LIST4     YES 
      SPC 1 
*  CONVERSION COMPLETE - OUTPUT THE LINE ON LIST DEVICE 
      SPC 1 
LIS30 JSB IFBRK     IS
      DEF *+1         ATTENTION 
      SZA               FLAG SET? 
      JMP LIS13     YES, GO TO READY
* 
      LDA PFLAG     IS OUTPUT 
      CPA .1          TO DISK?
      JMP SAVEF     YES!
* 
      LDB .OTBF     OUTPUT
      LDA OCCNT       STATEMENT 
      JSB WRITE         TO PERIPHERAL 
      JMP LIST1 
* 
      SPC 1 
*  OUTPUT TO FILE 
      SPC 1 
SAVEF LDA OCCNT     CHECK FOR UNEVEN
      SLA             CHARACTER COUNT 
      JMP SAVE1     YES, ITS ODD, MAKE IT EVEN
      RAR             COUNT TO
      STA OCCNT         WORD COUNT
      JSB WRITF     WRITE OUT RECORD
      DEF *+6 
      DEF DCB,I 
      DEF FERR
      DEF .OTBF,I 
      DEF OCCNT 
      DEF .0
      LDA FERR      WAS THERE 
      SSA,RSS         AN ERROR? 
      JMP LIST1     NO! 
      STA TEMP3     YES!
      JMP PRMES     PRINT ERROR MESSAGE 
* 
SAVE1 LDA B40       APPEND A
      JSB OUTCR       SPACE TO OUTPUT BUFFER
      JMP SAVEF 
      SPC 1 
*  CONVERT THE OPERATOR 
      SPC 1 
LIST4 LDA TEMPS,I 
      AND OPMSK 
      SZA,RSS       NULL OPERATOR?
      JMP LIST5     YES 
* 
      CPA SPLOP     SPECIAL SYNTAX LISTING
      RSS           YES!
      JMP CONT      NO! 
      LDA LCNTR     LENGTH COUNTER
      LDB .0        LIST SPEC SYNTAX FLAG 
      JSB SPEC2     PROCESS LISTING OF SPECIAL SYNTAX 
      JMP LIS30     DO ACTUAL LISTING 
* 
CONT  STA TEMP2     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
      SKP 
*  CONVERT THE OPERAND
      SPC 1 
LIST5 LDA TEMPS,I 
      AND OPDMK     SAVE
      STA TEMP3       OPERAND 
      SSA           FLAG BIT SET? 
      JMP LIST9     YES 
      SZA,RSS       NO, NULL OPERAND? 
      JMP LIST3     YES 
      AND TYPFL     ISOLATE TYPE PART 
      CPA .15       FUNCTION? 
      JMP LIST8     YES 
      SPC 1 
*  OUTPUT LETTER-DIGIT COMBINATIONS 
      SPC 1 
LIST6 LDA TEMP3 
      RRR 4 
      AND B177        OUTPUT
      ADA B100
      JSB OUTCR         LETTER
      LDA TEMP3     YES 
      AND .15       RESTORE 
      SZA,RSS       STRING? 
      JMP LIS16     YES!
      ADA M5        NO! 
      SSA           LETTER-DIGIT? 
      JMP LIST3     NO! 
      ADA B60         DIGIT 
LIS17 JSB OUTCR     OUTPUT DIGIT
      JMP LIST3 
      SPC 1 
LIS16 LDA B44       '$' 
      JMP LIS17 
      SPC 1 
LIST8 LDA F         OUTPUT
      JSB OUTCR 
      LDA N           'FN'
      JSB OUTCR 
      LDA TEMP3     OUTPUT
      RRR 4 
      AND B177        LETTER
      ADA B100
      JSB OUTCR 
      JMP LIST3 
      SPC 1 
*  OUTPUT FLOATING-POINT CONSTANTS
      SPC 1 
LIST9 XOR FLGBT 
      SZA           NUMBER? 
      JMP LIS10     NO
      ISZ TEMPS     YES 
      LDA TEMPS,I 
      ISZ TEMPS 
      LDB TEMPS,I 
      ISZ LCNTR 
      ISZ LCNTR 
      CCE           OUTPUT
      JSB NUMOT       THE NUMBER
      JMP LIST3 
      SPC 1 
*  OUTPUT FUNCTION NAMES
      SPC 1 
LIS10 AND .15 
      CPA .3        INTEGER?
      JMP LIS11     YES 
      CPA .15       NO, FUNCTION? 
      RSS           YES 
      JMP LIST6     NO, MUST BE A PARAMETER 
      LDA TEMP3     COMPUTE 
      RRR 4 
      AND B37       COMPUTE INTERNAL FUNCTION NO. 
      CPA B37       IS IT LEN FUNCTION? 
      JMP LENF      YES 
      CPA B36       FORTRAN FUNCTION? 
      JMP FRFCT     YES!
      STA TEMP2           CODE
      CMA 
      STA TEMP5     NO. OF MNEMONICS TO SKIP
      LDA AFCNS 
      RSS           PEEL
      LDA 0,I           OFF 
      RAL,CLE,SLA,ERA       INDIRECTS 
      JMP *-2 
      STA 1         ADDR OF MNEMONIC ENTRIES IN BREG
NXFCN ISZ TEMP5     IS THIS IT? 
      RSS           NO! 
      JMP LFCN      YES!
      LDA 1,I       GET FIRST WORD OF MNEMONIC ENTRY
      AND .7        GET CHARACTER COUNT 
      ADA .3
      ARS           INCREMENT TO NEXT ENTRY 
      ADB 0         ADD IN MNEM TBL ADDRESS 
      JMP NXFCN     CHECK NEXT ENTRY
LFCN  JSB MCOPY     OUTPUT FUNCTION NAME
      JMP LIST3 
* LEN FUNCTION FOUND
LENF  LDB ALEN      ADDRESS OF PRINT
      JMP LFCN        BUFFER FOR LEN
FRFCT ISZ TEMPS 
      ISZ LCNTR 
      JMP MCAL1     PRINT FORTRAN FUNCT MNEM
      SPC 1 
*  OUTPUT INTEGER CONSTANTS 
      SPC 1 
LIS11 ISZ TEMPS     OUTPUT
      ISZ LCNTR 
      LDA TEMPS,I     INTEGER 
      SSA           MINUS SIGN REQUIRED?
      JMP LIS19     YES!
LIS18 JSB OUTIN 
      JMP LIST3         OPERAND 
* 
LIS19 LDA .45       OUTPUT
      JSB OUTCR       MINUS SIGN
      LDA TEMPS,I   COMPLEMENT
      CMA,INA         TO OBTAIN 
      JMP LIS18         ABSOLUTE VALUE
      SPC 1 
*  OUTPUT OPERATOR
      SPC 1 
LIS12 JSB OUTBL     OUTPUT A BLANK
* 
      LDA TEMP2     IS THIS 
      CPA FOROP       A 'FOR' STATEMENT?
      JMP LIS21     YES, INDENT 'FOR' STATEMENT 
LIS22 LDA TEMP2 
      CPA NEXOP     IS THIS A 'NEXT' STMT?
      RSS           YES!
      JMP *+4       NO! 
      LDB FORCT     DECREMENT 
      ADB M1          FOR 
      STB FORCT         COUNT 
      CPA .G50      CALL? 
      JMP MCALL     YES. PRINT CALL STATEMENT 
      JSB MCOUT     OUTPUT
      LDA TEMP2       OPERATOR
      CPA REMOP     IS IT A REMARK STATEMENT? 
      JMP LIS15     YES 
      CPA IMAOP     IMAGE STMT? 
      JMP LIS15     YES!
      CPA FILOP     IS IT A FILES STATEMENT?
      JMP LIS23     YES 
      LDA TEMP2     COM STMT? 
      CPA COMWD 
      RSS           YES!
      JMP *+5       NO! 
      ISZ TEMPS     YES, SKIP 
      ISZ TEMPS       OVER COMMON SIZE
      ISZ LCNTR         AND DECREMENT 
      ISZ LCNTR           LENGTH COUNTER
      LDA .32       OUTPUT A BLANK
      JMP LIST5-1   AND LOOK FOR OPERANDS.
* 
LIS23 JSB OUTBL     OUTPUT A BLANK
LIS15 JSB OUTST     OUTPUT STRING 
      JMP LIST3 
      SPC 1 
LIS21 ISZ FORCT     INCREMENT COUNT 
      LDB .1          AND INDENT
      JSB FORSP         'FOR' STATEMENT 
      JMP LIS22           ONE MORE TIME 
      SPC 1 
*  IF PUNCH LIST DEVICE - PUNCH TRAILER ON TAPE 
      SPC 1 
LIS13 LDA PFLAG 
      CPA .1        FILE OUTPUT?
      JMP SAVE2     YES!
      CPA .0        KEYBOARD OUTPUT?
      JMP LIS20     YES!
      LDA LUOUT 
      JSB FINDV     FETCH DRIVER NUMBER 
      CPA .5        264X DEVICE?
      RSS           YES!
      JMP LIS49     NO! 
      CPB .1        MINITAPE? 
      JMP EOF       YES, LEFT UNIT! 
      CPB .2
      JMP EOF       RIGHT UNIT! 
      CPB .4        CRT PRINTER?
      JMP LIS50     YES!
LIS49 CPA .10       A REGULAR LP? 
      JMP LIS50     YES, THROW A PAGE!
      CPA .2        PUNCH?
      JMP EOF       YES, PUNCH TRAILER! 
      JMP ENLST     END!
* 
LIS50 JSB HEAVE     EJECT PAGE
      JMP ENLST 
* 
EOF   LDA LUOUT 
      IOR B1000     FORM EOF REQUEST
      STA TEMP3 
      JSB EXEC      PUNCH LEADER
      DEF *+3         OR
      DEF .3            WRITE 
      DEF TEMP3           EOF FOR 264X
      JMP ENLST 
* 
SAVE2 JSB WRITF     WRITE 
      DEF *+5 
      DEF DCB,I       END-OF
      DEF FERR
      DEF .OTBF,I 
      DEF M1            FILE
      JSB CLOSE     CLOSE FILE! 
      DEF *+4 
      DEF DCB,I 
      DEF FERR
      DEF M1
      LDA FERR      WAS THERE 
      SSA,RSS         AN ERROR? 
      JMP ENLST     NO! 
      STA TEMP3     YES, SAVE ERROR # 
      JMP PRMES     PRINT ERROR MESSAGE 
* 
LIS20 LDA LUOUT     IS THE LIST UNIT
      CPA TTYPR       REALLY THE
      JMP ENLST         CONSOLE 
      JSB HEAVE           OR LINE 
ENLST LDA REC#      INPUT FROM
      CPA .1          COMMAND FILE? 
      JMP PRMT      YES, DON'T PRINT READY
      LDA LNCNT     LINE COUNT
      CPA .1          ONLY ONE? 
      JMP RDYPT     NO! 
      JMP COMFL     YES!
      SKP 
******************************* 
*                             * 
*  INDENT 'FOR'-'NEXT' LOOPS  * 
*                             * 
******************************* 
* 
FORSP NOP 
      SZB,RSS       NEED ANY SPACES?
      JMP FORSP,I   NO! 
      SSB           TOO MANY 'NEXT'S' ? 
      JMP FORSP,I   YES!
      CMB,INB       SET 
      STB TEMP3       COUNTER 
FORS1 LDA PFLAG     OUTPUT TO DISK? 
      CPA .1
      JMP FORS3     YES, GO CHECK FILE TYPE 
      CPA M1        TO PUNCH? 
      JMP FORSP,I   YES, DON'T INDENT 
FORS0 LDA B40       OUTPUT
      JSB OUTCR       SPACE 
      LDA B40       OUTPUT ANOTHER
      JSB OUTCR       SPACE 
      ISZ TEMP3     DONE? 
      JMP FORS0     NO! 
      JMP FORSP,I   YES!
* 
FORS3 LDB DCB       CHECK 
      ADB .2          DCB FOR 
      LDA 1,I           FILE TYPE 
      SZA                 TYPE = 0 ?
       JMP FORSP,I          NO, EXIT NOW
      JMP FORS0     YES, GO INDENT! 
      SPC 2 
********************
*                  *
*  OUTPUT A BLANK  *
*                  *
********************
* 
OUTBL NOP 
      LDA PFLAG     IS OUTPUT 
      CPA .1          TO DISC?
      JMP OUTB1     YES!
      CPA M1         TO PUNCH?
      JMP OUTBL,I   YES 
      JMP OUTB2     NO, OUTPUT BLANK
* 
OUTB1 LDB DCB       CHECK 
      ADB .2          DCB FOR 
      LDA 1,I           FILE TYPE 
      SZA                  = 0? 
      JMP OUTBL,I   YES!
* 
OUTB2 LDA .32       OUTPUT A BLANK
      JSB OUTCR 
      JMP OUTBL,I 
      SKP 
*  OUTPUT QUOTE STRING
      SPC 1 
LIS14 LDB TEMPS,I   OUTPUT QUOTE STRING 
      BLF,BLF       TEST BIT 8
      SLB           SUPPRESS QUOTES?
      JMP LIS13     YES!
      JSB OUTCR     OUTPUT "
      JSB OUTST     OUTPUT QUOTE STRING 
      LDA .34       OUTPUT "
      JMP LIS17 
* 
********************* 
*                   * 
*  OUTPUT FORMFEED  * 
*                   * 
********************* 
* 
HEAVE NOP 
      LDA LUOUT     *2040*800804* 
      AND B177      MAKE SURE V-BIT IS 0
      IOR B1100     FORM TAB COMMAND
      STA LENTH 
      LDA LUOUT     *2040*800804* 
      JSB FINDV     GET DVR NUMBER
      CPA .10       LINE PRINTER
      RSS           YES!
      JMP HEAVE,I 
      JSB EXEC      DO IT TO IT 
      DEF *+4 
      DEF .3
      DEF LENTH 
      DEF M3
      JMP HEAVE,I 
* 
* 
      SKP 
******************* 
*                 * 
* OUTPUT A STRING * 
*                 * 
******************* 
OUTST NOP 
      LDA TEMPS,I 
      AND B177      GET STRING COUNT
      CMA,INA,SZA,RSS  NULL STRING? 
      JMP OUTST,I   YES!
      STA TEMP6     NO, SAVE NEG OF COUNT 
OUTS1 ISZ TEMPS     MOVE TO NEXT PAIR OF CHARS
      ISZ LCNTR     BUMP COUNTER
      LDA TEMPS,I   GET THEM
      ALF,ALF       POSITION TO OUTPUT LEFT CHARACTER 
      JSB OUTS2     OUTPUT CHAR 
      LDA TEMPS,I   GET CHAR PAIR AGAIN 
      JSB OUTS2     OUTPUT RIGHT HAND CHAR
      JMP OUTS1 
      SPC 1 
OUTS2 NOP 
      AND B177
      JSB OUTCR     ISOLATE AND OUTPUT CHAR 
      ISZ TEMP6     WAS IT LAST CHAR
      JMP OUTS2,I   NO! 
      JMP OUTST,I   YES!
* 
**********************************
*                                *
* OUTPUT A MULTICHARACTER SYMBOL *
*                                *
**********************************
MCOUT NOP 
      LDB STTYP     ADDRESS OF STATEMENT OPERATORS
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 JSB MCOPY     GO OUTPUT SYMBOL
      JMP MCOUT,I 
* 
MCOPY NOP 
      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 MCOPY,I 
******************************* 
*                             * 
*   LIST A CALL STATEMENT     * 
*                             * 
******************************* 
* 
MCALL JSB MCOUT     OUTPUT 'CALL" 
      JSB OUTBL     OUTPUT A BLANK
MCAL1 LDA TEMPS 
      STA TEMP7     CLEAR FORT FCT FLAG 
      LDA 0,I       GET OPERATOR WORD 
      AND B777      GET MNEMONIC TBL OFFSET 
      CMA           USE OFFSET TO FIND MNEMONIC 
      STA TEMP5     NO. OF MNEMONICS TO SKIP
      LDB FWAMM     GET ADDR. OF SUB. MNEMONICS 
      INB 
NXSUB ISZ TEMP5     IS THIS IT? 
      RSS           NO! 
      JMP LCALL     YES!
      LDA 1,I       GET FIRST WORD OF MNEMONIC ENTRY
      AND .7        GET CHARACTER COUNT 
      ADA .3
      ARS           INCREMENT TO NEXT ENTRY 
      ADB 0         ADD IN MNEM TBL ADDRESS 
      JMP NXSUB     CHECK NEXT ENTRY
LCALL JSB MCOPY     LIST THE CALL MNEMONIC
      LDA TEMP4     GET LAST CHAR (SEE OUTCR) 
      CPA .40       LAST CHAR "("?
      RSS           YES, SUPPRESS SPACE 
      JSB OUTBL     OUTPUT A BLANK
      ISZ TEMPS     POINT AT FIRST PARAM
      ISZ LCNTR     UPDATE INTERMEDIATE CODE COUNTER
      JMP LIST5