*DECK     BASCOMP 
         IDENT     BASCOMP
          ENTRY  BASCOMP
 BASCOMP  BSS    0
*CALL COPYRITE
          EJECT                                                         000310
          IPARAMS                                                       000320
          COMMENT BASIC 3 - BASIC COMPILER. 
*CALL LIPARAM 
          EJECT                                                         000330
          ENTRY  BASIC$ 
         ENTRY     BASIC                                                000380
**        BASIC$ IS LOADED DIRECTLY BY SORT UNDER KRONOS
*         VERSION 1.0 WHEN CALLED BY TELEX. 
* 
*         710225 DAL ENTRIES ADDED FOR LGT IN BOTH BASCOMP AND BASRTS 
          SYSCOM
          IFC    EQ,,"OS.NAME",SCOPE ,
 ACTR     EQU    64B
 PGNR     EQU    64B
          ENDIF 
         TITLE     BASCOMP
          EJECT 
* 
*         ENTRY-POINTS TO RUN-TIME SYSTEM 
* 
*         INPUT-ROUTINES
          EXT    DATAXXX,GOSUBXX
*         OUTPUT-ROUTINES 
          EXT       BASOCON,BATOCON 
          EXT    BASOMOV,BASOTAB
* 
* 
        ENTRY   BENDRT
* 
*         ERROR-ROUTINES
          EXT       BASEGEN,BATEGEN 
          EXT    BASEXIT
          EXT    BASRCHK
          EXT    ER119,ER120,ER121,ER122
          EXT    ER123,ER124,ER125,ER129
*                                  STRING FUNCTIONS 
          EXT    BASXCHR,BATXCHR   CHR$ 
          EXT    ASCII,ASCORD 
          EXT    BASXLPD,BASTLPD  LPAD$ 
          EXT    BASXRPD,BASTRPD  RPAD$ 
          EXT    BASXLTR,BASTLTR  LTRM$ 
          EXT    BASXRTR,BASTRTR  RTRM$ 
          EXT    BASXORD,BASTORD  ORD 
          EXT    BASXUPR,BASTUPR  UPRC$ 
          EXT    BASXLWR,BASTLWR  LWRC$ 
          EXT    BASXPOS,BASTPOS  POS 
          EXT    BASXSRE,BASTSRE  SREP$ 
          EXT    BASANSL,BATANSL   ANSI SUBSTRING REPLACEMENT.
          EXT    BASANSR,BATANSR   ANSI SUBSTRING EXTRACTION. 
          EXT    OLDFILE           OLD FILENAME FOR CHAIN 
          ENTRY  BASIC01
          EXT    BASXGST,BASCGST
          EXT    BASCDT1,BASCDT2
*                                                                       007190
          EXT    MOVESTT,MOVERTN                                        007200
          ENTRY  BSFUNTL
          EXT    BASCALL,BASPARM       CALL STATEMENT 
          EXT    COMRUNS
          EXT    ELAPTIM
          EXT    BASATIM
          EJECT 
* 
*        PRINTBYTE ENTRIES IN BASCOMP, CHANGED BY BASOPTS 
* 
          ENTRY     PRTBT10 
          ENTRY     PRTBT11 
          ENTRY     PRTBT12 
          ENTRY     PRTBT13 
          ENTRY     PRTBT14 
          ENTRY     PRTBT15 
          ENTRY     PRTBT16 
          ENTRY     PRTBT17 
          ENTRY     PRTBT18 
          ENTRY  PRTB10A
          ENTRY  PRTB10B
          ENTRY  PRTB10C
          ENTRY  PRTBT43
          ENTRY     PRTBT20 
          ENTRY     PRTBT30 
          ENTRY  PRTBT3B
          ENTRY     PRTBT40 
          ENTRY  PRTBT41
          ENTRY  PRTBT42
          ENTRY     PRTBT50 
          ENTRY     PRTBT60 
          ENTRY     PRTBT61 
          ENTRY     PRTBT70 
          ENTRY  PRTBT19
          ENTRY     XPOSTPR 
          ENTRY     XWRITLN 
          ENTRY     XPAGERR 
          ENTRY  XPGERR 
  
**        ASSEMBLY LIST ENTRIES.
  
          ENTRY  FULLWRD
          ENTRY  STORINS
          ENTRY  PARCEL 
          ENTRY  DEFLABX
          ENTRY  LABREF 
          ENTRY  XSTOXT 
          ENTRY  LABEL0 
          ENTRY  OUTWORD
          ENTRY  LABEL2 
          ENTRY  BDEFLCN
          ENTRY  BDEFLLP
          ENTRY  RELOC
          ENTRY  XPRT1,XPRT2,XREM 
          ENTRY  PRUSFLG     PRINT USING FLAG 
          ENTRY  LISTOPT,ERRFET,INPTFET 
          EXT    MEMUP
* 
          ENTRY  DBFLG             DEBUG MODE FLAG
          ENTRY  RJERROR
          EXT    BASCIO=
          EXT    BASMSG=
          EXT    BASSYS=
          EXT    BASWNB=
 CIO=     EQU    BASCIO=
 MSG=     EQU    BASMSG=
 SYS=     EQU    BASSYS=
 WNB=     EQU    BASWNB=
          EJECT 
* 
* 
*         REFERENCES TO I/O-ROUTINES
* 
          EXT       BASICHK 
          EXT    INPBUFF
          EXT       BASICON 
          EXT       BASIUNP 
          EXT    SKIPEOL
         EXT       BASCARD
         EXT       BASOPTS
          ENTRY  BASE              ARRAY BASE 
          ENTRY  BASDEF.
          ENTRY  FORMALS,FORMPTR   DEF LOACL PARAMS 
          ENTRY  BASFLN.           USER DEF FIRST LINE NO.
          ENTRY  BASLLN.           USER DEF LAST LINE NO. 
* 
*CALL,SYSEQU
          USE    OVER 
 BUFF     BSS    0
          USE    *
* 
          B1=1
 SUBR     SPACE  4,8
***       SUBR - SUBROUTINE ENTRY/EXIT DEFINITION.
* 
* 
* TAG     SUBR               DEFINE *EXIT.* AND *TAG_X*.
* TAG     SUBR   0           SAME.
* TAG     SUBR   =           SAME, AND DECLARE *TAG* AS ENTRY POINT.
* TAG     SUBR   -           DEFINE *EXIT.* BUT NOT *TAG_X*.
* TAG     SUBR   LETTER      DEFINE *TAG_LETTER* BUT NOT *EXIT.*. 
* 
*         ENTRY  *TAG* = SUBROUTINE ENTRY NAME. 
* 
*         EXIT   CODE GENERATED --
*                TAG    EQ    *+1S17    ALWAYS. 
*                       ENTRY TAG       IF = SPECIFIED. 
*                EXIT.  SET   *         IF BLANK, 0, =, OR - SPECIFIED. 
*                       NOREF EXIT.     IF BLANK, 0, =, OR - SPECIFIED. 
*                TAG_X  EQU   *         IF BLANK, 0, OR = SPECIFIED.
*                       NOREF TAG_X     IF BLANK, 0, OR = SPECIFIED.
*                TAG_LETTER  EQU  *     IF LETTER SPECIFIED.
* 
*         USES   NONE.
* 
*         CALLS  NONE.
  
  
          PURGMAC SUBR
  
          MACRO  SUBR,T,A 
T  EQ *+1S17D 
'?CPU#EN MICRO 1,,=T= 
  IFC NE, A  ,3 
  IFC LT, A 0 ,2
"'?CPU#EN"A EQU * 
  SKIP 7
  IFC NE, A - ,4
  IFC EQ, A = ,1
  ENTRY T 
"'?CPU#EN"X EQU * 
  NOREF "'?CPU#EN"X 
EXIT. SET * 
  NOREF EXIT. 
  ENDM
          XTEXT  COMCMTM
          IFC    EQ,,"OS.NAME",KRONOS,
 OPL      XTEXT  COMCMAC
          ENDIF 
          TITLE  BASIC COMPILER 
 CODE     TABLE  1                 GENERATED CODE 
 DATA     TABLE  1                 DATA VALUES
 CONS     TABLE  1                 CONSTANTS
 LABS     TABLE  2                 LABELS 
 FUNS     TABLE  1                 FUNCTIONS
 FLLS     TABLE  1                 FORWARD REFERENCE FILLS
 LINK     TABLE  1                 LINK TABLE REFERENCES
 EXTS     TABLE  1                 EXTERNAL REFERENCE NAMES 
          BSSZ   1
 TABLES   HERE
          XTEXT  COMCMTP
          XTEXT  COMCMVE
          ENTRY  MTU
          ENTRY  MTD
          ENTRY  ADW
          ENTRY  LM 
          ENTRY  ATS
          ENTRY  F.CODE 
          ENTRY  L.CODE 
          ENTRY  F.IDS             FWA OF NAMES TABLE 
          ENTRY  L.IDS             LENGTH OF NAMES TABLE
          ENTRY  TN 
          EXT    OBUFLCL
 OBUFLMT  EQU    31D
          EXT    BASRCL=
 RCL=     EQU    BASRCL=
          ENTRY  INNEXT 
* 
BDFLT    DATA      1.0
* 
**        FIXED LENGTH SYMBOL TABLE (IDS-IDENTIFIERS).
* 
 F.IDS    CON    0
 L.IDS    CON    NUMBVAR
* 
 BENDRT   BSSZ  1              RUN TIME END ADDRESS 
* 
 NUCLEUS  DATA  0LNUCLEUS 
 SYSOVL   DATA  0LSYSOVL
 OPTSL    VFD   42/0,18/0                           42/NAME,18/STATUS 
          VFD    6/1,6/0,2/1,4/0,1/1,4/0,1/0,36/0 
          VFD    42/0LBASIC10,18/0
 OMFLG    DATA   0                 DBUG.OM OLDCOPY FLAG 
          EJECT                                                         001230
*                                                                       001240
* DEFINE SPECIAL CHARACTERS USED IN RESERVED WORD TABLE                 001250
*                                                                       001260
 LT.SYMB  EQU    72B               LESS THAN                            001270
 GT.SYMB  EQU    73B               GREATER THAN                         001280
 EQ.SYMB  EQU    54B               EQUAL TO                             001290
 ST.SYMB  EQU    47B               STAR                                 001300
 IF1      IFEQ   CHARSET,NEWCSET
 CIRCLOW  EQU    2                 LOW ORDER PART OF ASCII CIRCUMFLEX 
 CIRCFLEX EQU    76B               NON-ASCII CIRCUMFLEX 
 IF2      IFNE   IP.CSET,IP.C63 
 COLONLOW EQU    4                 LOW PART OF ASCII COLON
 COLON    EQU    0                 NON-ASCII COLON
 IF2      ENDIF 
 IF1      ENDIF 
          EJECT 
* 
*         MACROS USED IN BASIC10
* 
* 
*  MACRO-S USED THROUGHOUT THE COMPILE PHASE
* 
* 
*  CALL THE ERROR ROUTINE 
* 
 CALLERR  MACRO     ERRPTR
          SX0       ERRPTR
          JP        ERROR 
          ENDM
* 
 OUTINS   MACRO     INDEX               CALL CODE GENERATOR 
          SA1       INDEX 
          RJ OUTINS 
          ENDM
* 
* 
 RJERROR  MACRO     MESS
          SX0       MESS
          RJ        RJERROR 
          ENDM
* 
 INCRAND  MACRO 
          SB2       B2+ANDINCR
          SB5       LANDST
          GE        B2,B5,ANDSTOFL
          ENDM
* 
 DECRAND  MACRO 
          SB2       B2-ANDINCR
          ENDM
* 
 TESTAND  MACRO     OP,DELTA,LABEL      JUMPS TO LABEL IF ANDPTR OP 
                                        FORPTR + DELTA
          SA1       FORPTR
          IFNE      DELTA,0,1 
          SB6       X1+DELTA
          IFEQ      DELTA,0,1 
          SB6       X1
          OP        B6,B2,LABEL 
          ENDM
* 
 ARTHPAIR MACRO     INST
          SX7       INST
          RJ        ARTHPAIR
          ENDM
* 
 SETVINX  MACRO     CLASSWD             SETS TOR X-REGISTER INTO
          SA1       CLASSWD               TOP OF ANDSTACK 
          SA2       REGSTPTR
          SA2       X2+REGSTACK 
          BX6       X1+X2 
          SA6       B2+ANDSTACK 
          ENDM
* 
 MATUSE   MACRO 
          SA1       ANDSTACK-1+B2 
          MX0       1 
          LX1       30
          LX0       57
          SX7    X1 
          SA1    F.IDS
          IX7    X1+X7
          SA1    X7 
          BX7       X0+X1 
          SA7       A1
          ENDM
* 
 UPANDPTR MACRO 
          SB2       B2+ANDINCR
          ENDM
* 
LNCHECK  MACRO     LABEL                CHECK LINE NO SIZE AND INTEGERIZ
         SA1       ANDSTACK+B2
         SA2       ANDSTACK-1+B2
         AX1       30 
         SX1       X1-INT 
         NZ        X1,LABEL 
         SA3       MAXLN
         FX3       X3-X2
         NG        X3,LABEL 
         UX2       B6,X2
         LX6       B6,X2
         ENDM 
 BACKCH   MACRO  LABEL
          SX1    B7 
 LABEL    SX1    X1-1 
          SA5    X1 
          SX5    X5-1R
          ZR     X5,LABEL 
          ENDM
* 
*         READCH AND READCHB ARE USED BY THE READ ROUTINE 
* 
* 
*         READCH LEAVES THE NEXT NON-BLANK SOURCE CHARACTER IN X1 
* 
 READCH   MACRO  LABEL
          LOCAL  EXIT 
          BSS    0
 LABEL    SA1    B7 
          SB7    B7+1 
          BSS    0
          SX6    X1-1R
          ZR     X6,*-1 
          PL   X1,EXIT             DONE IF NOT ESCAPE CODE
          RJ   CNVTESC             DECODE 
 EXIT     BSS    0
          ENDM
* 
*         READCHB LEAVES THE NEXT SOURCE CHAR IN X1 
* 
 READCHB  MACRO  LABEL
 LABEL    SA1    B7 
          SB7    B7+1 
          BSS    0
          ENDM
  
**        ZERO - ZERO MANAGED TABLE.
*         ZERO   A,B
*                A                 FIRST WORD ADDRESS OF TABLE
*                B                 AMOUNT OF TABLE TO ZERO
  
 ZERO     MACRO  A,B
          SA1    A
          SB2    B-1
          MX6    0
          SA6    X1 
 +        SB2    B2-B1
          SA6    A6+B1
          GT     B2,B0,*
          ENDM
          EJECT 
* 
*         MAIN CONTROL OF COMPILER
* 
 BASIC    BSS    0
          RJ     BASCARD           GET CONTROL CARD 
 BASIC$   BSS    0
          RJ     DBID              CHECK FOR DEBUG(ON) OR DEBUG.
          SA1   BSFUNTBL+BSENDP         FETCH RUN TIME END ADDRESS
          SX6   X1             TRUNCATE 
          SA6   BENDRT         SAVE FOR BASOPTS 
          SX6    A0                LOADER LEAVES FL IN A0 
          SA6    FIELDLG           SAVE FIELD LENGTH
          SB1    1
          RJ   BASATIM             CURRENT CP TIME IN X5
          BX6    X5                SAVE START TIME
          SA6    TIME 
          RJ     PRSP        SET UP TERMINAL I/O
          SX7    B1 
          MX0    42 
          SA7    COMRUNS
          SA1    ASOPTION          SET RUN-TIME ASCII FLAG
          ZR     X1,BASIC55 
          SX6    1
          SA6    ASCII
 BASIC55  BSS    0
          SA1    EOPTION
          SA2       IOPTION 
          SX3    ERRFET 
          SX7    INPTFET
          BX4    X0*X1
          BX5    X0*X2
          BX6    X4+X3       COMBINE ADDRESS WITH FILE NAME 
          SA6    A1 
          BX7    X5+X7       COMBINE ADDRESS WITH FILE NAME 
          SA7    A2 
          SA1    FIELDLG           FIND END OF FIELD LENGTH 
          SX7    X1-3              USE FL-3 FOR END OF MANAGED TABLES 
          SA7       UPPERTB 
          SA7    F.TEND 
          RJ     MTU               MOVE TABLES UP 
          SX6    INST 
        SA1   BSFUNTBL+BSENDP        FETCH END ADDRESS OF RUN TIME RTNS 
        SX1   X1
        IX2   X6-X1 
        PL    X2,BASIC56      BR, RUN TIME RTNS < COMPILER
        SX6   X1+1            ADJUST LM FOR RUN TIME RTNS 
BASIC56 BSS   0 
          SA6    LM                RESET BASE OF TABLES 
          SA1    XOPTION           X1 = B OPTION
          SA2    LOPTION           X2 = L OPTION
          BX2    X1+X2
          ZR     X2,BASIC01        BR, NO SPECIAL OPTIONS TO PROCESS
* 
*     LOAD  BASOPTS SPECIAL OPTIONS PROCESSOR 
* 
          MX5      1
          SA1      64B              (X1)= RA+64B
          SA2      65B              (X2)= RA+65B
          LX5      19 
          BX2      X2*X5            (X2)= LIBRARY FILE FLAG 
          MX5      42 
          BX1      X1*X5            (X1)= NAME/LIBRARY NAME 
          ZR       X2,OVL01         BR, LOAD OPTION U=0 
          SA5      NUCLEUS
          IX5      X1-X5            CHECK FOR NUCLEUS 
          NZ       X5,OVL01         BR, NAME NOT NUCLEUS
          SA1      SYSOVL           (X1)= 6LSYSOVL
 OVL01    SA3      OPTSL
          SA4      A3+1 
          IX6      X1+X3            PUT NAME IN LDV REQUEST 
          LX2      24 
          IX7      X2+X4            SET U IN LDV REQUEST
          SA6      A3 
          SA7      A4 
          SYSTEM  LDV,R,OPTSL 
          SA5    OPTSL+1     GET TRANSFER ADDR
          SB6    X5 
          SB3    =YDBUG.OM         WEAK EXTERNAL REF TO DEBUG 
          NG     B3,ESCPE          BR IF NOT IN DEBUG MODE
          SA1    OMFLG             FETCH DEBUG OLDCOPY FLAG 
          RJ     =YDBUG.OM         LET CID KNOW OVERLAY LOADED
 ESCPE    BSS    0                 CALL BASOPTS 
          JP     B6 
 BASIC01  BSS       0 
          RJ        PREPARE 
 BSC1     BSS    0
          IFC    EQ,,"OS.NAME",SCOPE ,
          SA1    ASOPTION 
          ZR     X1,BASIC00 
          RJ     CHKASC 
 BASIC00  BSS    0
          ENDIF 
          SX6    IREOL             PSUEDO END-OF-PROGRAM CHAR 
          SX7    IRENDB            PSUEDO END-OF-BUFFER CHAR
          SA6    CHARBUF           INITIALIZE CHAR BUFFER 
          SA7    A6+B1
          MX6    0
          SA6    A7+B1
          SA1    IBFLG
          NG     X1,BASIC06        RUN,BASIC
          SA1    EOPTION
          SA2    LOPTION
          MX3    42 
          SB5    X1 
          BX1    X1-X2
          BX1    X3*X1
          ZR     X1,BASIC06        EOPTION .EQ. LOPTION 
          SA1    B5+FETSTAT 
          LX1    59-18       INTERACTIVE BIT
          NG     X1,BASIC06        INTERACTIVE FILE 
          SA5    ERRHDR 
          RJ     BASOMOV
          MX4    59 
          RJ     BASOTAB
          SA5    ERRHDR1
          RJ   BASOMOV
          MX4    59 
          RJ   BASOTAB
 BASIC06  BSS    0
          RJ        COMPILE 
 XPOSTPR  NO                            A CALL FOR POSTPROCESSOR
 +        BSS       0                   MAY BE ADDED HERE BY OVERLAY
          RJ   CMMSG               CM USED DAYFILE MSG
          SA1    IOPTION           SAVE SOURCE FILENAME FOR CHAIN 
          MX2    42 
          BX6    X1*X2
          SA6    OLDFILE           IN BASEGEN 
          SA1    TIME              START TIME 
          RJ   ELAPTIM             GET COMPILE TIME IN DISPLAY CODE IN X6 
          SA6    CTIMESS           STORE IN MSG 
          IFNE   MESSAG,0 
          MESSAGE CTIMESS,0,R       COMP TIME TO SYS/USER D-FILE
          ELSE
          MESSAGE CTIMESS,6,R       COMP TIME TO SYS/USER D-FILE
 IF1      ENDIF 
          SA1       ERRORFL 
          ZR        X1,BASIC03          NO ERROR
          SA1    SLOPTION 
          SA2    OLOPTION 
          BX1    X1+X2
          SA3    EOPTION
          BX1    X1-X3
          SX1    X1 
          ZR     X1,BASIC02  EOPTION=LOPTION
          SB5    X3 
          RJ     =XBASOCLS
 BASIC02  BSS    0
          SA1    ERRORFL
          PL     X1,BASIC04 
          MESSAGE EMPMESS,0,R 
          SA1    GOOPTION 
          NG     X1,COMPEND 
          EQ     BASEXIT
* 
 BASIC04  BSS    0
          MESSAGE BCEMESS,0 
          SA1    DBOPTION 
          LX1    2           BINARY REGARDLESS SW 
          NG     X1,BASIC05 
          SA1    GOOPTION 
          NG     X1,COMPEND 
          EQ     BASEXIT
 BASIC03  BSS    0
          SA1    WARNFL 
          ZR     X1,BASIC05        BR IF NO WARNING MESSAGES
          SA1    SLOPTION 
          SA2    OLOPTION 
          BX1    X1+X2
          SA3    EOPTION
          BX1    X1-X3
          SX1    X1 
          ZR     X1,BASIC05 
          SB5    X3 
          RJ     =XBASOCLS
 BASIC05  BSS    0
          SA1    GOOPTION 
          SB7    B0 
          SX7    B0 
          SA7    COMRUNS
          SA7    EOPTION
          SA7    A7+1 
          NG     X1,COMPEND  NO-GO
          SA1    XOPTION
          NZ     X1,TRANS10  LOAD AND EXECUTE BFILE 
          EQ     TRANSFR
* 
 COMPEND  BSS    0
          ENDRUN
* 
* 
 BCEMESS  DATA   C*BASIC COMPILATION ERRORS*
 CTIMESS  DATA   C*   XXX.XXX CP SECONDS COMPILATION TIME*
 EMPMESS  DATA   C*  INPUT FILE EMPTY OR MISPOSITIONED* 
* 
 TIME     BSS    1                 SAVE START CP TIME HERE
*         END MAIN CONTROL
* 
          EJECT 
* 
*         PROCEDURE INPUT NEXT LINE 
* 
 INNEXT   BSSZ      1 
          SA1       IOPTION 
          SB5       X1                  GET CHANNEL 
          RJ        BASICHK             CHECK FOR READY 
          NZ        B6,INNEXT2          IF EOR THEN GOTO INNEXT2
          SB6       CHARBUF 
          SB7       UNPBUFL 
          RJ        BASIUNP             UNPACK THE LINE 
          SA1       STMTCTR     STATEMENT COUNTER 
          SX6       X1+1
          SA6       A1
*         A CALL TO WRITE LINE MAY BE ADDED 
 XWRITLN  NO
 INNEXT3  BSS       0 
          SX6       B7
          SA6       B5+FETOUT 
          SX1       CHARBUF             FWA OF CHARACTER-BUFFER 
          SB7       X1                  PRESET INPUT-POINTER
          SX6       IREOS 
          SX7       IREOL 
          SA6       X1+B6               SET EOS 
          SA7       A6+1                SET EOL 
          SX6       IRENDB
          SA6       A7+1                SET ENDBUFFER 
          SX7       X1+B6 
          SA7       SAVEEND 
          SA1    SKIPEOL
          ZR   X1,INNEXT           EXIT IF NOT LONG LINE
          SX6    WERR2             MSG ADDR 
          SA6    WNSW              SET SWITCH FOR WARNING AT EOS
          EQ        INNEXT
 INNEXT2  BSS       0 
          SA1    STMTCTR
          NZ     X1,INNEXT4 
          SA1    ERRORFL     EMPTY INPUT FILE 
          MX6    59 
          SA6    A1 
 INNEXT4  BSS    0
          SX1       CHARBUF             FWA OF CHARACTER-BUFFER 
          SB7       X1                  PRESET INPUT-POINTER
          SX6       IREOP 
          SA6       B7
          SA1       B5+FETOUT 
          SB6       1                   SET FOR ONE CHAR
          SB7       X1                  SET ZERO LENGTH LINE
          SX6       B0
          SX7       X1-1
          SA6       X7                  MOVE ZERO TO BUFFER 
          SA7       B5+FETOUT           RESET OUT TO OUT - 1
          EQ        INNEXT3 
 SAVEEND  BSS       0 
          DATA      0 
 STMTCTR  DATA      0           STATEMENT COUNTER 
 LISTOPT  DATA      1 
 LINPAGE  EQU       FETSETV 
 PAGECNT  EQU       FETINDX 
* 
*         END INPUT NEXT LINE 
* 
* 
* 
*    CM USED DAYFILE MESSAGE
* 
 CMMSG    DATA   0
* 
          RJ     AMU         UPDATE MEMORY USED 
          SA1    F.CODE 
          SA2    MU 
          IX1    X1+X2       TOTAL MEMORY USED
          MX2    54                -100B
          IX1    X1-X2             SPACE+100B 
          BX1    X2*X1             ROUNDED TO NEAREST 100B
          LX1    42                XXXX00 0...0 
          SB5    6                 CONVERT 6 OCTAL DIGITS 
          SX6    B0 
          MX2    57 
 CMMSG3   LX1    3                 SPLIT UP OCTAL DIGITS AS 0X0X0X... 
          LX6    6
          BX3    -X2*X1            OCTAL DIGIT X
          BX6    X6+X3             0X 
          SB5    B5-1 
          NZ   B5,CMMSG3           LOOP 
          SA1    CMZERO            DISPLAY 000000 
          IX6    X6+X1             DISPLAY XXXXXX 
          BX1    X6                SUPPRESS LEAD ZERO 
          AX1    30 
          SX1    X1-1R0 
          NZ   X1,CMMSG4           SKIP IF NOT A ZERO 
          SX1    1R -1R0
          LX1    30                22 00 00 00 00 00
          IX6    X6+X1
 CMMSG4   SA1    CMZERO            DISPLAY 000000 
          SA1    CMMESS            BBBBBBB0...0 
          BX2    X6 
          AX2    18                HIGHER 3 DIGITS
          BX7    X2+X1
          SA7    A1                STORE IN MSG 
          SA1    A1+1              000B CM US 
          MX2    42 
          BX2    -X2*X6            LOWER 3 DIGITS 
          LX2    42 
          BX7    X2+X1
          SA7    A1 
          IFNE   MESSAG,0 
          MESSAGE CMMESS,0,R        CM USED MESSAGE TO SYS/USER D-FILE
          ELSE
          MESSAGE CMMESS,6,R        CM USED MESSAGE TO SYS/USER D-FILE
          ENDIF 
          EQ   CMMSG               EXIT 
* 
* 
 CMMESS   DATA   7L                BBBBBBB000 
          DATA   7RB CM US         000B CM US 
          DATA   2LED              ED00000000 
 CMZERO   DATA   6R000000 
          EJECT 
* 
*         PROCEDURE TRANSFER
* 
 TRANSFR  BSS    0
          SA1    INSTPTR            SIZE OF CODE
          SA2    F.CODE            START OF CODE
          SA3    L.DATA            SIZE OF DATA 
          SA4    L.CONS            SIZE OF CONSTANTS
          SA5    ABSSTRT
          SX6    X1 
          SB2       X2                  B2 = INST-BASE
          SB3       X5                  B3 = GENERATED-CODE-BASE
          SA1       VARCONT 
          SA2       PRENTRY 
          IX7       X6+X4 
          IX6    X7+X3
          SB1    X6                B1 = NO. OF WORDS TO MOVE
          SB5       X1+B1               B5 = B1 + NO OF VARIABLES 
          SB6       X2                  B6 = ENTRY-ADDRESS
 TRANS04  BSS    0
          SB7    B0 
          SX2    X5+B5
          SX2    X2+2 
           NG   X2,NOTRANS        BR, MAX EXCEEDED
          SX7    X2                                                     006950
          LX7    30                NEW FL IN UPPER 30 BITS              006960
          SA7    MOVESTT           STORE FL IN STATUS WORD              006970
          SA1    FIELDLG
          SX1    X1 
          IX0    X1-X2       CHECK AGAINST CURRENT FL 
          PL     X0,TRANS03 
          BX0    -X0
          RJ     MEMUP
          ZR     X0,TRANS03 
NOTRANS    BSS  0 
*         ISSUE MEM CALL TO INCREASE FL                                 007000
*                                                                       007010
*   FOR NOW ISSUE ERROR MESSAGE 
          MESSAGE NOEX,0,R
          EQ   BASEXIT             DONE 
 TRANS03  BSS    0
          SA2    MOVESTT                                                 BAS0014
          AX2    30                NEW FL                                BAS0014
          MX4    57 
          MX5    54 
          SA3    EXECUTE+1
          IX2    X2-X5       ROUND UPWARD TO NEXT 100B
          BX2    X2*X5      CLEAR LOWER 6 BITS
          LX2    42 
          MX5    6
          SX6    B0 
 TRANS05  LX2    3
          LX6    6
          BX1    -X4*X2     ISOLATE OCTAL DIGIT 
          BX6    X6+X1      FORM DPC NUMERIC FORMAT 
          LX5    1
          NG     X5,TRANS05  IF NOT 6 DIGITS
          LX6    24 
          IX6    X6+X3       CONVERT TO DPC 
          SA6    A3          STORE IN MESSAGE 
          IFC    EQ,,"OS.NAME",KRONOS,                                  007290
          MESSAGE  EXECUTE,0,RECALL 
          MESSAGE  EXECBBB,1,RECALL 
          ENDIF                                                         007530
*         PASS TO MOVERTN ALL B REGISTERS AND X0, X4. 
*         (B3) = LOWEST ADDRESS COMPILED CODE MAY BE MOVED. 
*         (X4) = 2, 3, OR 4, ACCORDING TO WHETHER THE (2,0), (3,0), 
*         OR (4,0) OVERLAY IS SUFFICIENT FOR THIS EXECUTION.
*         (2,0) OVERLAY IS THE RUN-TIME FOR FULL BASIC. 
*         (3,0) OVERLAY IS FOR ELEMENTARY BASIC + STRINGS + OTHER MATH. 
*         (4,0) OVERLAY IS FOR ELEMENTARY (AND FAST) BASIC. 
          SX4    2           DEFAULT TO (2,0) OVERLAY.
          SA2    BSFUNTBL+BSEND3   (X2) = LWA+1 OF (3,0) OVERLAY. 
          SX1    B3          (X1) = LOWEST ADDRESS FOR CODE.
          SX2    X2 
          IX6    X2-X1
          NG     X6,TRANS07 
          SX4    3           CAN REDUCE TO (3,0) OVERLAY. 
          SA3    BSFUNTBL+BSEND4   (X3)<17:00> = LWA+1 OF (4,0) OVERLAY.
          SX3    X3 
          IX7    X3-X1
          NG     X7,TRANS07 
          SX4    4           CAN REDUCE TO (4,0) OVERLAY. 
  
 TRANS07  BSS    0
          SB4    BASCOMP           PASS ADDRESS OF BASCOMP
          EQ     MOVERTN           MOVE CODE DOWN, LOAD RUN-TIME
*                                  LIBRARY OVERLAY,AND START PROGRAM
*                                  EXECUTION FOR COMPILE-TO-CORE MODE.
* 
* 
 TRANS10  BSS    0
          MX0    42 
          BX7    X0*X1
          SA7    PGNR        LOAD AND EXECUTE BFILE 
          SYSTEM LDV
 TRANS11  BSS    0            WAIT TO BE OVERLAYED
          SYSTEM RCL
          EQ     TRANS11
*                                                                       007590
 ADDRWE   BSSZ   1                                                      007600
 EXECUTE  DATA   C*FILENAM --000000*
 EXECBBB  DATA   C*  *
 NOEX     DATA   C* FL TOO SMALL FOR EXECUTION* 
* 
*         END TRANSFER
* 
          EJECT 
 MVUPAND  JP    0 
*     SUBROUTINE TO MOVE UP ENTRIES ON THE ANDSTACK ONE POSITION. 
*     MOVE STARTS WITH THE ENTRY POINTED TO BY B5 ON ENTRY. 
*     I.E. THIS ROUTINE CAN INSERT A SHELL ANYWHERE 
* 
*     INPUT REGISTERS ASSUMED TO BE ACTIVE ARE
*     B1 -
*     B2 - POINTER TO CURRENT TOP OF ANDSTACK 
*     B3 - POINTER TO TOP OF TORSTACK 
*     B4 -
*     B5 - POINTER TO LOWEST ENTRY ON STACK TO BE MOVED UP
*     B7 - POINTER TO INPUT READ CHARACTER
* 
*     UPON EXIT B1,3,4 AND 7 ARE UNCHANGED; B2 WILL POINT TO NEW LOCATION 
*     OF TOP ANDSTACK ENTRY.  THE FORPTR VALUE IN MEMORY WILL HAVE
*     BEEN INCREMENTED IF IT WAS AFFECTED.
*     B5 IS DESTOYED. 
*     THE NEW VACATED ENTRY IS ZEROED OUT - THE CALLER OF 
*     THIS SUBROUTINE IS RESPONSIBLE FOR SETTING UP VALUES IN IT. 
* 
*     DEFENSIVE CHECKING
          LT     B2,B5,SERRORB   BR,ASTK TOP IS BELOW ENTRY PTR 
          SB6    2
          LT     B5,B6,SERRORB   BR, MOVE PTR UNDERFLOW 
* 
* 
*     SAVE B7 
          SX7    B7 
          SA7    TD111225      B7 CHAR PTR SAVED
* 
*     SAVE ENTRY POINTER VALUE FOR FUTURE 
          SX7    B5 
          SA7    TD011630      SAVED B5 ENTRY VALUE 
* 
*     SAVE B5 POINTER IN B6 TEMPORARILY 
          SB6    B5            B5 SAVED IN B6 
* 
*     TEST IF ROOM TO MOVE ANDSTACK UP. 
          INCRAND 
          DECRAND 
* 
*     RESTORE B5
          SB5    B6 
* 
*     SET B5 TO POINT TO LOWEST WORD TO BE MOVED UP 
          SB5    B5-1          B5 POINTS LOWEST WORD TO MOVE
* 
*     COMPUTE WORD COUNT TO MOVE
          SB6    B2-B5         B6 - WORD COUNT 0,1,2..TO MOVE 
* 
*     SET B5 TO ADDRESS OF LOWEST WORD TO MOVE
          SB5    B5+ANDSTACK
* 
* 
* 
*     COUNT OF WORDS IN B6 BECOMES LOOP COUNT.
*     WE NOW MOVE ENTRIES UP ONE POSITION (2 WORDS) 
* 
*     MOVE LOOP STARTS HERE 
*     MOVE OLD TOP WORD TO NEW TOP WORD, THEN TOP-1,TOP-2 ... 
 MVUPAND2 SA2    B5+B6       FETCH ANDSTACK WORD
          SB7    A2+ANDINCR  DEVELOP DESTINATION ADDRESS
          BX7    X2 
          SA7    B7+0        STORE ANDSTACK WORD
*     TEST IF LOOP DONE 
          EQ     B0,B6,MVLPDN  BR, MOVE LOOP DONE 
          SB6    B6-1          DECREMENT LOOP COUNTER 
          EQ     MVUPAND2      LOOP AGAIN 
* 
*     WE ZERO OUT THE NEWLY VACATED ENTRY AS A DEFENSIVE
 MVLPDN   MX7    0             SET UP ZEROES
          SA7    B7-1        STORE ZERO FIRST WORD
          SA7    B7-2        STORE ZERO SECOND WORD 
* 
*     NOW INCREMENT ANDSTACK POINTER TO REFLECT NEW LOCATION OF TOP ENTRY 
          INCRAND 
* 
*     INCREMENT FORPTR IF IT WAS AFFECTED BY MOVE 
          SA1    FORPTR 
          ZR     X1,BD111227  BR, FORPTR NOT AFFECTED 
          SA2    TD011630      SAVED B5 ENTRY VALUE 
          IX2    X1-X2         FORPTR - ENTRY PTR 
          NG     X2,BD111227    DONE, FORPTR NOT AFFECTED 
          SX7    X1+ANDINCR    X7 - INCREMENTED FORPTR
          SA7    FORPTR         STORED
 BD111227 BSS    0
          SA1    TD111225      SAVED B7 CHAR PTR
          SB7    X1            B7 RESTORED
          EQ     MVUPAND
* 
 TD111225 BSSZ   1
 TD011630 BSSZ   1
          EJECT 
* 
*     COMCLR - SUBROUTINE CALLED BY TORIN OF -EOS-, 
*     CALLED BY TOROUT OF -THEN- WHEN IN CONTEXT OF 
*     -IF R (THEN) VERB..- OR -IF R (THEN) GOTO ...-
*     OR -IF R (THEN) A =....-. 
*     CALLED BY TORIN OF -ELSE-.
*     CLEARS FLAGS ETC. TO PREPARE FOR NEW STATMENT WHICH 
*     MAY BE A STATEMENT ON ITS OWN LINE OR A STATEMENT 
*     EMBEDDED IN AN -IF R ... - STATEMENT. 
 COMCLR   JP     0
          SA1    WNSW 
          ZR     X1,COMCLR3 
          BX0    X1          *WARNING MESSAGES* 
          RJ     WERROR 
 COMCLR3  BSS    0
          SX6    -1 
          SA6    REGSTPTR      REGISTER STACK PTR 
          SX6       B0
          SA6    WNSW        CLEAR WARNING SW 
          SA6       DATAST
          SA6    LETSUBS           CLEAR SUBSTR COUNT 
          SA6    DLMTST            CLEAR -DELIMIT- STATEMENT FLAG 
          SA6    FETADDR           CLEAR ADDRESS OF CURRENT FET 
          SA1    DEFFLAG           RESET DEF FLAG IF NOT MULTILINE VALUE
          NG  X1,COMCLR2
          SA6    DEFFLAG           IN CASE ONE-LINE VALUE STILL SET 
 COMCLR2  BSS    0
          SA6    ONANDIF
          SA6    LOGSW
          EQ     COMCLR 
          EJECT 
*     SYNCHK - THIS SUBROUTINE COMPARES THE CURRENT READ
*     SYMBOL AGAINST THE CONTENTS OF THE SYMTBL TABLE 
*     WHICH CONTAINS A SET OF READ SYMBOLS.  THE SYMBOLS
*     IN THE TABLE COMPRISE THE SET OF SYMBOLS THAT ARE 
*     ILLEGAL IF THEY FOLLOW -THEN- OR -ELSE- IN
*     AN -IF R THEN ..(ELSE.....)- STATEMENT. 
* 
*     THIS ROUTINE INTENDED TO BE CALLED FROM TOROUT
*     OF -THEN- AND -ELSE-. 
* 
*     ASSUMES B1-B4,B7 IN USE, ALL OTHER REGS FREE
* 
*     LOGIC THAT FOLLOWS DOES NOT DETECT OR PREVENT 
*     COMPARISON OF INPUT READ SYMBOL AGAINST BINARY
*     ZEROES THAT MAY PAD OUT LAST WORD OF TABLE.  NO HARM DONE.
* 
*     INITIALIZE
 SYNCHK   JP    0 
*     SAVE B7 (READ CHAR PTR) 
          SX7    B7 
          SA7    TD111635 
          SA1    NS      FETCH READ SYMBOL THAT CAUSES UNSTACKING 
          SB5    B0            B5 - LOOP COUNTER
          SB7    LSYMTBL       B7 - COUNT OF TABLE WORDS FOR LOOP CONTROL 
          MX0    45            X0 - MASK FOR EXTRACTING READ SYMBOL (LOW 15 BITS
* 
*     SYMBOLS ARE PACKED 4 PER WORD.  LOOP THRU TABLE.
 BD011044 SA2    B5+SYMTBL     X2= FETCHED TABLE WORD 
*     SET UP CONTROL FOR WORD FIELD LOOPING 
          SB6    4             B6 - WORD FIELD COUNT
* 
*     SHIFT,EXTRACT AND TEST TABLE SYMBOL AGAINST 
*     SYMBOL THAT CAUSES UNSTACKING 
 BD011100 LX2    15            SHIFT SYMBOL TO LOW 15 BITS
          BX3    -X0*X2        X3 = EXTRACTED SYMBOL
          IX3           X1-X3 
          NZ     X3,SYN01        BR, CHECK SOME MORE
* FALL THRU, THIS SYMBOL CANT UNSTACK -THEN- OR -ELSE-
          SA5    TD111635       X5 - SAVED B7 VALUE FETCHED 
          SB7    X5             B7 - RESTORED TO READ BUFFER PTR
          EQ     BILLIF         BR TO ILLEGAL STMT WITHIN IF ERROR
 SYN01    BSS    0
*     TEST ALL FIELDS OF WORD TESTED
          SB6    B6-1          DECREMENT WORD FIELD COUNT 
          NE     B0,B6,BD011100 BRANCH,MORE FIELDS TO CHECK 
*     ALL FIELDS OF WORD CHECK; TEST IF ALL WORDS DONE
          EQ     B5,B7,SYNDUN   ALL DONE, INPUT SYMBOL IS OK
*     MORE WORDS TO TEST. INCREMENT WORD COUNT AND LOOP BACK. 
          SB5    B5+1 
          EQ     B0,B0,BD011044 
*     RESTORE B7 TO READ CHAR PTR 
 SYNDUN   SA1    TD111635      FETCH SAVED B7 
          SB7    X1            B7 RESTORED
          EQ     SYNCHK 
 TD111635 BSSZ   1
* 
* 
*     SYMTBL IS TABLE OF READ SYMBOLS THAT SHOULD 
*     CAUSE UNSTACKING OF -THEN- OR -ELSE- IN AN
*     -IF R THEN....(ELSE...)- STATEMENT. 
*     FOUR 15 BIT SYMBOLS PER WORD.  ORDER IS RANDOM. 
*     LAST WORD CAN BE PACKED WITH TRAILING BINARY ZEROES.
 SYMTBL   VFD    15/LVBAS,15/LVDAT,15/LVDEF,15/LVDIM
          VFD    15/LVFND,15/LVCLN,15/LVREM,15/LVEND
 SYMTBLEN VFD    15/LVFOR,15/LVNEX,15/LVOPT,15/0000B
          EJECT 
*     CVRTJMP - SUBROUTINE CONVERTS THE INSTRUCTION PROTO 
*     IN RELOPR (WHICH IS EXPECTED TO BE A JUMP) TO ITS OPPOSITE. 
* 
 CVRTJMP  JP     0
*     THIS ROUTINE CALLED BY TOROUT OF -THEN IN AN -IF R THEN- STMT.. 
* 
*     SET UP THE JUMP PROTOTYPE IN RELOPR 
          SA1    RELOPR        X1 = RELOPR
*     TEST IF RELATIONAL CONDITION THAT PRECEDED -THEN- WAS LOGICAL 
          SA2    LOGSW
          NZ     X2,BC301900   BR, RELATION NOT LOGICAL 
*     TEST FOR THOSE JUMPS WHICH COULD HAVE BEEN SET
*     BY NON-LOGICAL RELATION AND SUBSTITUTE THE OPPOSITE 
          SA2    EQUALJMP      FETCH INSTRUCTION PROTOTYPE
          IX2    X1-X2         COMPARE PROTOS 
          NZ     X2,BC301905   TRY SOME MORE
          SA2    NOTEQJMP      GET OPPOSITE 
 BC031907 BX7    X2 
          SA7    RELOPR        STORE OPPOSITE IN RELOPR 
          EQ     B0,B0,CVRTJMP ALL DONE 
* 
 BC301905 SA2    MINUSJMP 
          IX2    X1-X2
          NZ     X2,BC301906   TRY SOME MORE
          SA2    PLUSJUMP       GET OPPOSITE
          EQ     B0,B0,BC031907 
* 
 BC301906 SA2    PLUSJUMP 
          IX2    X1-X2
          NZ     X2,BC301900   TRY SOME MORE
          SA2    MINUSJMP      GET OPPOSITE 
          EQ     B0,B0,BC031907 
* 
 BC301900 SA2    NOTEQJMP 
          IX2    X1-X2
          NZ     X2,SERRORB      BR SHOULDNT HAPPEN 
          SA2    EQUALJMP      GET OPPOSITE 
          EQ     B0,B0,BC031907 
          EJECT 
*     FWDJUMP - SUBROUTINE, INTENDED TO BE CALLED BY
*     TOROUT OF -THEN- IN AN -IF R THEN ...- STATEMENT
*     ACQUIRES A FORWARD LABEL AND GENERATES A JUMP TO THE LABEL. 
*     AT ENTRY, RELOPR CONTAINS THE JUMP INSTRUCTION PROTOTYPE. 
*     THE FORWARD LABEL IS ALSO STACKED AT THE TOP OF THE FORSTACK
*     PORTION OF THE ANDSTACK BY THIS ROUTINE.
* 
 FWDJUMP  JP    0 
* 
*     DETERMINE IF ANDSTACK ABOVE THE -IF- FORPTR IS EMPTY
          SA1    FORPTR        FETCH CURRENT -IF- FORPTR
          SB5    X1            SET B5 TO CURRENT -IF- FORPTR
          EQ     B2,B5,BD151601 BR, ANDSTACK ABOVE FORPTR IS EMPTY
* 
* 
*     INSERT A ZEROED ANDSTACK SHELL ENTRY AT 
*     TOP OF FORSTACK 
*     SET B5 TO POINT TO LOWEST ENTRY TO BE MOVED UP
          SA1    FORPTR 
          SB5    X1+ANDINCR 
          RJ     MVUPAND
          EQ     BD151600 
* 
 BD151601 INCRAND  CREATE A SHELL ENTRY 
* 
*     UPDATE FORPTR 
 BD151600 SA1    FORPTR 
          SX7    X1+ANDINCR 
          SA7    FORPTR 
*     SAVE POINTER TO TOP OF ANDSTACK 
          SX6    B2+0 
          SA6    TC301830 
*     SET ANDSTACK POINTER = TOP OF FORSTACK=(SHELL ENTRY)
          SB2    X7 
*     GET A LABEL NAME, INSERT IT IN SHELL
          RJ     LBTOSTK
*     GENERATE JUMP TO FORWARD LABEL
          SA1    RELOPR        GET JUMP PROTOTYPE 
          RJ     OUTINS 
*     RESTORE ANDSTACK POINTER TO POINT TO TOP OF ANDSTACK
          SA1    TC301830      FETCH SAVED POINTER VALUE
          SB2    X1            B2 NOW POINTS TO TOP ANDSTACK
          EQ     B0,B0,FWDJUMP
 TC301830 BSSZ   1
          TITLE     MAIN LOOP 
* 
*  PROCEDURE COMPILE
* 
 COMPILE  JP        0 
          SA1       FORPTR
          SB3       B0                  TORPTR .= 0 
          SB2       X1                  ANDPTR .= FORPTR
          SX6    B0 
          SA6    LETSUBS           CLEAR SUBSTR COUNT 
          SX6       STA6
          SA6       STATE               START IN ERROR STATE
* 
*  NOW FALL INTO MAIN LOOP AND COMPILE, COMPILE, COMPILE, COMPILE ... 
* 
* 
*  MAIN LOOP OF COMPILER. 
*     CALLS READ TO OBTAIN NEXT SYMBOL (IN X2) AND PERFORMS CHECKING
*     OF LEGALITY. IF SYMBOL IS LEGAL, EITHER OPERAND OR OPERATOR 
*     ACTION IS TAKEN, DEPENDING ON THE INCOMMING SYMBOL. 
* 
 MAINLOOP RJ        READ                GET NEXT SYMBOL IN X2 
 ERRECOV  BSS       0 
          BX0       X2                     AND SAVE IT IN X0
          SX5       X2-MINIDENT 
          MX1       54
          AX2       9 
          SA3       STATE 
          BX1       -X1*X2              ISOLATE CLASS 
          SB6       X3                  B6 .= OLD STATE 
          SA1       X1+STATETAB         GET STATE TABLE[CLASS,STATE]
          LX1       B6,X1               LEFT ADJUST NEW STATE 
          AX1       52
          BX7       X1
          PL     X1,GOOD
*     TEST IF OPERATOR LAST READ WAS -THEN- OR -ELSE- 
          SA4    BMAINSIN      FETCH LAST READ OPERATOR TORIN ENTRY 
          SA1    LSTHE         WAS IT -THEN-? 
          IX1    X1-X4
          ZR     X1,WAS        BR, YES IT WAS -THEN-
          SA1    LSELSE        WAS IT -ELSE-? 
          IX1    X1-X4
          ZR     X1,WAS        BR,YES IT WAS -ELSE- 
          SX1    X0-LVOR
          NZ     X1,EILLSTAT IF NOT *OR* PROCESSING 
          READCH
          SX5    X1-1RD      CHECK FOR *ORD*
          NZ     X5,EILLSTAT
          SX7    LVORD       ASSUME *ORD* 
          SX2    LVORD
          SA7    NS 
          EQ     ERRECOV
  
 WAS      BSS    0
*     TEST IF OLD STATE WAS -AFTER EOS- 
          SX1    B6-STA2
          NZ     X1,EILLSTAT   BR, WAS NOT -AFTER EOS-
*     TEST IF NEW READ ITEM IS CLASS INTEGER CONSTANT 
          SX2    X2-ICLOC 
          NZ     X2,EILLSTAT    BR, WAS NOT INTEGER CONSTANT
*     HERE BECAUSE WE ARE ON LINE NUMBER OF 
*     -THEN LN- OR -ELSE LN-. 
*     SET STATE TO -AFTER OPERATOR- 
*    CHECK IF WE ARE IN AN IF STATEMENT 
          SA1    IFONFLG
          ZR     X1,EILLSTAT BR, THEN WITHOUT IF -- ILLEGAL STATEMENT 
          SX7    STA0 
          SA7    STATE
*     RESTORE READ SYMBOL AND TRY AGAIN 
          BX2    X0 
          EQ     ERRECOV
 GOOD     SA7    A3 
          PL        X5,BMAINAND         IT IS AN OPERAND
* 
*  OPERATOR HANDLING
* 
          MX2    60-9              SET UP MASK (ALL 9 BITS) 
          BX0       -X2*X0              EXTRACT TORTABLE INDEX
          SA1       X0+LTORIN           GET TABLE ENTRY 
 REPEAT1  SA3       B3+TORSTACK         GET TOP STACK ENTRY 
          BX6       X1
          UX1       B6,X1               B6 .= PRIORITY
          UX3       B5,X3               B5 .= STACK PRIORITY
          SA6       BMAINSIN            SAVE INPUT ENTRY
          GT        B6,B5,BMAINL2       PRIORITY > STACK PRIORITY 
 UNSTACK  SB3       B3-TORINCR          TORPTR .= TORPTR - 1
          SB5       X3
          AX6       30
          MX0       51
          BX6       -X0*X6
          SA1    SACTEMP1 
          BX7    X1 
          SA7    SACTEMP4          SAVE LAST UNSTACK REASON 
          SA6       SACTEMP1            SAVE LX-FIELD 
* 
*  STACK ACTIONS HAVE UNSTACKING LX-FIELD AVAILABLE IN X6 
* 
 PRTBT50  JP        B5
          JP        B5                  GOTO STACKACTION
 BMAINL2  NZ        B5,BMAINL3          STACK PRIORITY NE 0 
          LX1       30
          UX1       B6,X1               B6 .= SHIFT COUNT 
          LX4       B6,X3               SHIFT STACK ENTRY FOR ACTION TST
          NG        X4,UNSTACK          ACTION BIT IS ON
 BMAINL3  SB6       X6                  B6 .= INACTION
          UX6       B0,X6               REMOVE PRIORITY 
          LX6       21
* 
*   FORMAT OF X6 AT ENTRY TO INACTIONS..
*         9/SYMVAL,12/SHIFT,18/ACTION,12/ZERO,9/INDEX 
* 
 PRTBT30  JP        B6
          JP        B6
* 
*  STACK ACTIONS RETURN HERE
* 
 REPEAT   SA1       BMAINSIN            X1 .= SAVED INPUT ENTRY 
          JP        REPEAT1 
* 
*  OPERAND HANDLING 
* 
 BMAINAND LX5       51
          MX1       54
          BX1       -X1*X5              X1 .= CLASS - VARSTART
          LX5       9 
          SA1       X1+BANDCTBL         GET OPERAND CONTROL TABLE ENTRY 
          MX2       51
          SB6       X1
          BX0       -X2*X5              X0 .= POINTER 
 PRTBT3B  JP        B6
          JP        B6                  GOTO OPERAND ACTION 
* 
 BMAINSIN BSSZ      1                   SAVED INPUT ENTRY 
* 
            EJECT 
* 
*           INPUT ACTION FOR END
* 
 IFEACT   BSS    0
          SA5    ONANDIF
          ZR     X5,STACK1
          SX6     LIFE
          EQ      STACK1
          TITLE     OPERATOR INPUT ACTIONS
* 
 EQUACT1  BSS    0
          SA1    ONANDIF
          SX1    X1-IFTYP 
          ZR     X1,EQUACT2 
          SA1    TORSTACK+B3             IS TOP OF TORSTACK 
          SX2    X1-LACTFAS        CHECK FOR FIRST ASSIGN 
          NZ     X2,EQUACT11       IF NOT GO CHECK FOR ANSI SUBSTR
          SA2       LTREE                YES - CHANG TORSTACK 
          BX6       X2                         TO ASSIGN
          SA6       A1
          JP        EQUACT12            GO TEST ANDSTACK
 EQUACT11 SX2    X1-LACTLSUB       CHAECK FOR ANSI SUBSTR 
          ZR     X2,EQUACT12
          NZ     B3,SERROR9        STACK SHOULD BE EMPTY
 EQUACT12 SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX1       B6,X1               B6 .= KINDPART(ANDSTACKTOP) 
          LX1       30
          EQ        B5,B6,EQUACT13
          SB5       SVKIND
          NE        B5,B6,BEQUERR       KIND NE SIMPLE
 EQUACT13 BSS       0 
          SX2       X1-VINS 
          SX3       X1-AINX 
          ZR  X2,EQUACT14          CLASS = VINS 
          ZR  X3,EQUACT14                  AINX 
          SX2    X1-AINX1 
          ZR  X2,EQUACT14           AINX1 IS A$(1)
*  ALLOW CLASS SINS IN MULTILINE DEF, FNA=1 
          SA2    DEFFLAG           ERROR IF NOT IN DEF
          ZR  X2,BEQUERR
          SX3    X1-SINS           ERROR IF NOT CLASS SINS
          NZ  X3,BEQUERR
 EQUACT14 BSS    0
          SX6       LFAS
          JP        STACK1
 EQUACT2  SA1    TORSTACK+B3
          SX1    X1-LACTFUNP
          NZ     X1,STACK1
          SB3    B3-TORINCR 
          EQ     REPEAT 
* 
 DLMTINA  BSS    0
          SX7    B0                CLEAR -DELIMITER- COUNT
          SA7    DLMRNO 
          SX7    1
          SA7    DLMTST            TURN -DELIMIT- STMT FLAG ON
          SX7    FETCHAN+2         FORCE ADDRESS OF *INPUT* FET 
          EQ     STK1              GO SET UP FETADDR
 IFACT1   BSS    0
          SX7    IFTYP
          SA7    ONANDIF           SET -IF- STATEMENT TYPE
          EQ     STACK1 
* 
* 
 ONACT1   BSS    0
          SX7    ONTYP
          SA7    ONANDIF           SET -ON- STATEMENT TYPE
          EQ     STACK1 
* 
*         PRINT  ACTION 
  
 SPRACT1  NZ     B3,SERRORA  IF TORSTACK NOT EMPTY
          SX7    PRNTYP 
          SA7    ONANDIF
          SX7    1           IMPLY *OUTPUT* FILE
          EQ     STK1 
  
*         READ ACTION 
  
 SREACT1  NZ     B3,SERRORA  IF TORSTACK NOT EMPTY
          SX7    FETCHAN+2   IMPLY *INPUT* FILE 
          EQ     STK1 
  
*         WRITE ACTION
  
 SWRACT1  SX7    1           IMPLY *OUTPUT* FILE
          EQ     STK1 
  
*         INPUT ACTION
  
 SINACT1  SX7    FETCHAN+2   IMPLY *INPUT* FILE 
          EQ     STK1 
  
*         NODATA ACTION 
  
 SNOACT1  EQ     STACK1 
  
 STK1     SA7    FETADDR     SET IMPLIED FILE 
**        DECLBUF CHAINING BUG FIX
* 
 STACK1   SB3       B3+TORINCR
          SB5       LTORST
          GE        B3,B5,TOROVFL 
          SA1       LTOROUT+X6
          BX7       X1                  TORSTACK[TORPTR] .= 
          SA7       TORSTACK+B3           LTOROUT[INDEX]
 PRTBT40  JP        MAINLOOP
          JP        MAINLOOP
* 
 SUBACT1  EQU    STACK1            TEMP 
* 
 POWACT1  BSS       0 
* 
 LFUACT1  BSS       0 
          SA6       SACTEMP2            SAVE ACTION 
          RJ        CLEAR 
          SA1       SACTEMP2
          BX6       X1                  RESTORE ACTION
          JP        STACK1
* 
* 
 EOSACT1  BSS    0
*     TORIN OF -EOS-
* 
          NZ     B3,SERRORB    BR,TORSTACK NOT EMPTY
*     TEST ARE WE PROCESSING -IF R.....- STATEMENT? 
          SA1    GLBLIFR
          ZR     X1,EOSACT2    BR, NOT WITHIN A GLOBAL -IF R..- 
*     IS ANDSTACK (ABOVE -IF R - FORPTR) EMPTY? 
          TESTAND   NE,0,SERRORB
*     ARE THERE FORWARD LABELS ON ANDSTACK
*     ABOVE THE EXTERNAL TO -IF- STATEMENT FORPTR?
* 
*     FIRST, RESTORE EXTERNAL FORPTR
          SA1    SVDFOR 
          BX7    X1 
          SA7    FORPTR        FORPTR = EXTERNAL FORPTR 
*     SECOND, TEST IF ANYTHING ABOVE EXT FORPTR 
          TESTAND EQ,0,EOSACT3 BR, NO FORWARD LABELS
* 
*     HERE BECAUSE THERE ARE FORWARD LABELS 
*     ALL LABELS MUST BE DEFINED AND DROPPED FROM STACK.
 EOSACT4  SA1    LABELDEF 
* MORE THAN ONE LABEL MAY BE DEFINED AT THIS POINT IN STMT. 
          RJ     OUTINS        DEFINE A LABEL 
          DECRAND DROP LABEL FROM STACK 
          TESTAND   NE,0,EOSACT4  TEST, IF MORE LABELS
  
 EOSACT3  BSS    0
 EOSACT2  BSS    0
*     HERE FOR -EOS- OF ALL STATEMENTS
          MX7    0
          SA7    BYPASGO
          SA7    GLBLIFR
          SA7    IFONFLG     CLEAR THE IF STATEMENT 
*     TEST IF ANDSTACK ABOVE EXTERNAL FORPTR EMPTY
          TESTAND   NE,0,SERRORB BR, ANDSTACK NOT EMPTY 
*     CLEAR FLAGS ETC 
          RJ     COMCLR 
          JP     MAINLOOP 
* 
 EOLACT1  BSS       0 
          RJ     OUTWORD           FINISH WORD
          SX6       LBEG
          JP        STACK1              STACK BEGIN LINE ACTION 
* 
 CALACT1  BSS    0                 CALL 
          SX7    -1                SET FLAG FOR READ
          SA7    DATAST            THIS IS CALL STMT
          JP  STACK1
* 
 SRMACT1  BSS       0 
          SA1    DBOPTION 
          PL     X1,XREM     NO TRACE 
          LX1    1
          NG     X1,XREM     NO TRACE 
          SX0    B0 
          SB6    10 
 TLOOP    BSS    0
          READCH
          SX2    X1-LIEOS 
          ZR     X2,TREM1 
          LX0    6
          BX0    X0+X1
          SB6    B6-1 
          NG     B6,REMEXIT 
          EQ     TLOOP
 TREM1    BSS    0
            BX6    X0       ROUTINE OUTINS DESTROYS X0
            SA6    SAVEX0   SO, WE SAVE IT FOR POSSIBLE FUTURE USE
          SA1    TRACE
          BX1    X0-X1       IS IS TRACE,ALL
          ZR     X1,REMTRC   YES, IT IS 
          SA1    TRACEPT
          BX1    X0-X1       IS IT TRACE,PART 
          ZR     X1,REMTCPT  YES, IT IS 
          SA1    NOTRACE
          BX1    X0-X1       IS IT TRACE,NONE 
          NZ     X1,XREM     NO, IT IS NOT
          OUTINS SETLINEX 
          SA1    DBFLG       CHECK FOR CID MODE 
          ZR     X1,TREM2    BR, CID NOT ACTIVE 
          OUTINS DBLN        GENERATE RJ =XDBUG.LN
 TREM2    BSS    0
          OUTINS RJTOF
          BX6    X6-X6
          SA6    TRCPTSW
          EQ     REMEXIT
* 
 REMTRC   BSS    0
          OUTINS SETLINEX 
          SA1    DBFLG       CHECK FOR CID MODE 
          ZR     X1,REMTRC1  BR, CID NOT ACTIVE 
          OUTINS DBLN        GENERATE RJ =XDBUG.LN
 REMTRC1  BSS    0
          OUTINS RJTON
          EQ     REMEXIT
* 
 REMTCPT  BSS    0
          MX6    1
          SA6    TRCPTSW
          SA1    DBFLG       CHECK FOR CID MODE 
          ZR     X1,REMEXIT  BR, DONE 
          OUTINS SETLINEX    GENERATE SA0 LN
          OUTINS DBLN        GENERATE RJ =XDBUG.LN
          EQ     REMEXIT
* 
 TRCPTSW  BSSZ   1           TRACE,PART SW
* 
 TRACEPT  DATA   10HTRACE,PART
 TRACE    DATA   9RTRACE,ALL
 NOTRACE  DATA   10HTRACE,NONE
 SAVEX0     BSS    1        TEMPORARY STORAGE SPACE FOR CONTENTS OF X0
 XREM     EQ     REMEXIT     REM INPUT ACTION, NO-OP"D IF LOPTION SPECIFIED 
*      AND/OR CID ACTIVE
          SA1    DBFLG       CHECK FOR CID MODE 
          ZR     X1,REM0     BR, CID NOT ACTIVE 
          OUTINS SETLINEX    GENERATE SA0 LN
          OUTINS DBLN        GENERTE RJ =XDBUG.LN 
 REM0     BSS    0
            SA1    DBOPTION HAVE 10 CHARS BEEN EXTRACTED? 
            PL     X1,REM01 
            LX1    1
            NG     X1,REM01 IF NOT, EXTRACT THEM AND CHECK FOR OPTIONS
            SA1    SAVEX0   IF SO, GET THOSE CHARS FROM STORAGE 
            BX0    X1       AND 
            EQ     REM1     CHECK IF THEY ARE A LIST,XXX COMMAND
 REM01      BSS    0
          SX0    B0 
          SB6    10 
 REMLOOP  READCH
          SX2    X1-LIEOS 
          ZR     X2,REM1
            LX0    6
            BX0    X0+X1
          SB6    B6-1 
          ZR     B6,REMEXIT 
          EQ     REMLOOP
* 
 REM1     BSS    0
          SA1    LSTALL 
          BX1    X0-X1       IS IT LIST,ALL 
          ZR     X1,REMALL   YES
          SA1    LSTNONE
          BX1    X0-X1       IS IT -LIST,NONE-\ 
          NZ     X1,REMEXIT  NO, EXIT 
          SX6    B0 
          SA6    LISTOPT     SET LIST OPTION OFF
          SA1    STMTCTR     STATEMENT COUNTER
          SX1    X1-1 
          EQ     REMEXIT
 REMALL   BSS    0
          SA1    LISTOPT
          NZ     X1,REMEXIT 
          SX6    1
          SA6    A1 
          SA1    SLOPTION 
          SB5    X1 
 XPRT1    NO                 MAY BE PLUGGED -RJ PRTER-
 REMEXIT  BSS    0
          SA1       SAVEEND 
          SB7       X1
          JP        MAINLOOP
 LSTALL     DATA   8RLIST,ALL 
 LSTNONE    DATA   9RLIST,NONE
* 
 SAPACT   EQU    REMEXIT
 DELPRNA  BSS    0
*                THE LEFT PAREN IN -DELIMIT- STMTS IS NEVER STACKED 
          EQ     MAINLOOP          GO READ NEXT ITEM
* 
 LOGACT1  BSS    0
          SA1    ONANDIF
          SX1    X1-IFTYP 
          NZ     X1,SERROR
          EQ     STACK1 
* 
 NOTACT1  BSS    0
          SA1    ONANDIF
          SX1    X1-IFTYP 
          NZ     X1,SERROR
          SX7    1
          SA7    LOGSW
          EQ     STACK1 
 THACT1   BSS    0
*     TEST IF SYNTAX OF WORD ASSOCIATED WITH THIS 
*     TORIN WAS -THEN- OR -GOTO-.  SET THENGO FLAG
*     0/1 ACCORDINGLY.
          MX7   0       PRESET X7 TO 0
          BACKCH THACT2 
          SA1    X1            FETCH PREVIOUS CHARACTER READ
          SX5    X1-1RN        WAS IT THE -N- IN -THEN-?
          ZR     X5,BF021640    BR,IT WAS -N- OF -THEN- 
          SX5    X1-770161B  WAS IT LOWER CASE N
          ZR     X5,BF021640 BR, IT WAS LOWER CASE N OF -THEN-
* 
*     FALL THRU ASSUMES IT WAS -GOTO- 
          SX7    1             SET X7 TO INDICATE -GOTO-
* 
 BF021640 SA7    THENGO        THENGO FLAG STORED 
* 
* 
*     TEST IF PREVIOUS UNSTACK REASON WAS EOS, I.E. 
*     ARE WE IN CONTEXT OF -LN EOS GOTO LN EOS- 
*     (NOTE - COMPILER INSERTS EOS AFTER LINE LABEL)
          SA1    SACTEMP4      FETCH PREVIOUS UNSTACK REASON
          SX2    X1-LXEOS 
          NZ     X2,BD041022   BRANCH, NOT -LN EOS GOTO ....- 
* 
*     FALL THRU CONTEXT IS -LN EOS GOTO .....-
 BD041042 BSS    0
*     BRANCH IN CONTEXT IS
*     -IF R THEN GOTO LN.....-
*     -IF R....ELSE GOTO LN....-
*     SET UP GOTOJUMP INSTR PROTOTYPE IN RELOPR 
          SA5    GOTOJUMP 
          BX7    X5 
          SA7    RELOPR 
*     VERIFY VERB IS NOT SPELT -THEN- 
          SA5    THENGO        FETCH FLAG RE THEN GOTO SYNTAX 
          ZR     X5,SERROR6 
          EQ     STACK1 
* 
 BD041022 BSS    0
*     CONTEXT IS NOT -LN EOS GOTO .....-
* 
*     WE ARE WITHIN A GLBLIFR STATEMENT.
*     POSSIBILITIES ARE 
*     -IF R THEN .....- 
*        -IF R ....ELSE GOTO .....- 
*       -IF R GOTO .....- 
*       -IF R THEN GOTO ..- 
*     TEST ONANDIF FLAG TO SELECT POSSIBILITY 
          SA1    ONANDIF
          ZR     X1,BD041042   BR, IS ..THEN GOTO..OR ..ELSE GOTO...
* 
*     CONTEXT IS -IF R THEN ....- OR -IF R GOTO ....-.
* 
*     IF GLBLIFR NOT SET, SET IT; AND SAVE EXTERNAL FORPTR. 
          SA1    GLBLIFR
          NZ     X1,BD111104   GLBLIFR ALREADY SET
          MX7    1
          SA7    GLBLIFR       SET GLBLIFR
          SA1    FORPTR        FETCH EXTERNAL FORPTR
          BX7    X1 
          SA7    SVDFOR        SAVE EXTERNAL FORPTR 
 BD111104  BSS    0 
* 
* 
*     SET STATE TO -AFTER EOS- TO FOOL
*     SYNTAX CHECKING INTO THINKING IT IS 
*     STATMENT ON ITS OWN LINE. 
          SX7    STA2 
          SA7    STATE         -AFTER EOS- STORED INTO STATE
* 
*  IF THE RELATIONAL EXPRESSION WAS LOGICAL, LOGSW WILL 
*  BE SET, AND THE TOP ANDSTACK ENTRY WILL BE AN ENTRY
*  TO REPRESENT THE LOGICAL RESULT.  IF THIS IS THE CASE, 
*  WE DROP THE LOGICAL RESULT ENTRY FROM ANDSTACK AS IT IS
*  NO LONGER REQUIRED (EVEN THO IT CONTAINS AN INDICATION 
*  OF THE REGISTER THAT CONTAINS LOGICAL RESULT. THE
*  COMPILER ASSUMES X5 ALWAYS). 
          SA1    LOGSW           X1 - LOGSW 
          ZR     X1,NOLOG        BR, RELATIONAL NOT LOGICAL 
*         DROP THE RESULT 
          DECRAND 
 NOLOG    BSS    0
* 
*     NOTE - BIT MATCHING STRING IN TOROUT OF -THEN-
*     ALLOWS ALL OPERATORS TO UNSTACK -THEN-. 
          EQ     STACK1 
 ELSACT1  BSS    0
*     TORIN OF -ELSE- 
* 
*     SAVE X6 (INDEX TO TOROUT) 
          SA6    TD131200      X6 TOROUT INDEX SAVED
*     VERIFY TORSTACK EMPTY 
          NZ     B3,SERRORB    BR,TORSTACK NOT EMPTY
*     VERIFY ANDSTACK EMPTY (ABOVE -IF R ..- FORPTR)
          TESTAND  NE,0,SERRORB  BR, ANDSTACK NOT EMPTY 
*     TEST IF BYPASGO FLAG SET.  IF SO, DO NOT
*     GENERATE JUMP TO EOS POSITON. 
*     TO ILLUSTRATE-
*     -IF R THEN LN (X) ELSE... EOS- BYPASGO IS SET;
*     JUMP TO EOS POSITON FROM (X) NOT REQUIRED.
*     -IF R THEN PRINT (X) ELSE....EOS- BYPASGO NOT SET;
*     JUMP TO EOS POSITION FROM (X) IS GENERATED. 
          SA1    BYPASGO
          ZR     X1,BE101100   BR, GENERATE JUMP TO FWD LABEL OF -EOS-
* 
*     HERE BECAUSE JUMP TO EOS NOT REQUIRED 
          MX7    0
          SA7    BYPASGO       CLEAR BYPASGO SWITCH 
          EQ     ELSACT2
* 
 BE101100 BSS    0
* 
*     HERE BECAUSE JUMP TO FWD LABEL OF EOS REQD. 
* 
*     CREATE A SHELL ENTRY ON ANDSTACK AT BOTTOM OF 
*     OF -IF R - FORSTACK.
*     BOTTOM OF FORSTACK MUST BE ONE POSITION ABOVE 
*     THE VALUE OF FORPTR AS IT WAS WHEN THE GLOBAL 
*     IF STATEMENT WAS ENTERED. 
*     SHELL TO BE USED FOR FORWARD LABEL OF 
*     EOS POSITION.  IT WILL BE DEFINED AT
*     -EOS- TORIN TIME. 
* 
*     SET B5 TO POINT TO LOWEST ENTRY TO BE MOVED UP
          SA1    SVDFOR        FETCH ENTRY VALUE OF FORPTR
          SB5    X1+ANDINCR    B5 POINTS TO BOTTOM OF -IF R - FORSTACK
*     MOVE UP ANDSTACK AND INSERT SHELL ENTRY.
*     ANDSTACK TOP PTR (B2) AND FORPTR (IN MEMORY)
*     ADJUSTED AS AND IF REQUIRED.
          RJ     MVUPAND
*     SET ANDSTACK POINTER TO POINT TO SHELL
          SA1    SVDFOR 
          SB2    X1+ANDINCR 
*     GET A LABEL NAME AND SET IT INTO SHELL
          RJ     LBTOSTK
*     GENERATE JUMP TO LABEL
          SA1    GOTOJUMP      FETCH INSTR PROTOTYPE
          RJ     OUTINS        GENERATE 
*     RESTORE ANDSTACK POINTER TO ANDSTACK TOP
*     (WHICH IS ALSO THE FORSTACK TOP,AT THIS TIME).
          SA1    FORPTR 
          SB2    X1 
 ELSACT2  BSS    0
*     DEFINE THE FORWARD LABEL OF THIS -ELSE-;
*     LABEL IS AT TOP OF -IF R - FORSTACK.
          SA1    LABELDEF 
          RJ     OUTINS        LABEL DEFINED
*     DROP THE DEFINED LABEL AND DROP FORSTACK TOP
          DECRAND 
          SX7    B2 
          SA7    FORPTR        FORPTR = NEW ANDSTACK TOP
*     CLEAR FOR NEW STATEMENT THAT WILL FOLLOW -ELSE-;
*     INCLUDING CASE OF -ELSE LN-.
          RJ     COMCLR 
*     RESTORE SAVED X6 TOROUT INDEX 
          SA1    TD131200      FETCH SAVED TOROUT INDEX 
          BX6    X1            X6 TOROUT INDEX RESTORED 
*     SET STATE TO -AFTER EOS- TO FOOL SYNTAX 
*     CHECKING DURING NEW STATEMENT COMPILATION.
          SX7    STA2 
          SA7    STATE         STATE SET TO -AFTER EOS- 
          EQ     STACK1 
* 
* 
* 
 CLNACT1  BSS    0
          SX7    -2 
          SA7    DATAST 
          EQ     STACK1 
* 
          TITLE     OPERATOR STACK ACTIONS
* 
*  PRINT
* 
 LACTPRI  BSS       0                   START PRINT 
          SX1       X6-LXFIL
          BX5    X6                DUMP X6 PRO TEM
          SX6       LPR1
          ZR        X1,SETFILE          IT IS PRINT FILE
          SX1    X5-LXPND          TRY FILE-PRINT-POUND-SIGN
          ZR     X1,FINDFIL        EXIT IF IT IS
          BX6    X5                RESTORE X6 
* 
 LACTPR1  BSS       0 
          RJ     CLEAR
          INCRAND 
          SA1    FETADDR
          NG     X1,RONFET         SKIP IF .LT. 0 (FET WILL BE FIXED
*                                  AT RUN-TIME) 
          BX6    X1 
          SA6    ANDSTACK+B2       DUMP IN STACK
          OUTINS   SETB5FET        B5 WILL HOLD RUN-TIME FET
 RONFET   BSS    0
          DECRAND 
          OUTINS   RJOSRT 
          SA1    SACTEMP1          UNSATCKING REASON
          ZR     X1,BPR31 
          SX6    X1-LXUSI 
          NZ     X6,BPR30 
          MX7    0
          SA7    ONANDIF
          SX6    LPRU              ELSE SET-UP NEXT ACTION
          JP     STACK1            AND GO FIND THE LINE NO USED 
* 
 BPR30    BSS    0
*     TEST FOR -PRINT EOS-
          SX6    X1-LXEOS      IS UNSTACK REASON -EOS-
          ZR     X6,BPR30A     BR, -EOS- DID UNSTACK
          SX6    X1-LXELS      IS UNSTACK REASON -ELSE- 
          NZ     X6,LACTPR2  BR, -ELSE-DID NOT UNSTACK THIS 
 BPR30A   BSS    0
          TESTAND NE,0,BPRINT1
          EQ      PRLFCR             GO PRINT EMPTY LINE
 BPR31    BSS    0
          TESTAND NE,0,BPRINT1
          SX7    LXEOS
          SA7    SACTEMP1 
          EQ     PRLFCR 
* 
* 
* 
 LACTPR2  BSS    0
          TESTAND   NE,0,BPRINT1        SEE IF WE HAVE AN OPERAND 
* 
*  WE NOW HAVE PRINT WITHOUT PARAMETERS, SO WE CREATE AN EMPTY STRING 
* 
          SA1    SACTEMP1 
          SX6    X1-LXELS      DID -ELSE- UNSTACK THIS
          ZR     X6,REPEAT     BR, -ELSE- DID UNSTACK THIS
          SX6    LPR2          PRESET X6
          SX5    X1-LXEOS    IS IT AN EMPTY STR UNSTACK BY EOS
          ZR     X5,REPEAT
          SX5    X1-LXSEM 
          ZR     X5,STACK1
 PRLFCR   SA1    L.CONS 
          SA2    DUMPTRWD          DUMMY POINTER WORD 
          SX1    X1+B1             CORRECT POINTER TO TRUE VALUE
          BX1    X2+X1
          ADDWRD CONS,X1
          SX7    X3-1              CONSTANT ORDINAL 
          INCRAND 
          SA1       BANDCSTR
          MX0       42
          BX1       X1*X0 
          BX7       -X0*X7
          BX7       X7+X1 
          SA7       ANDSTACK+B2         STACK THE EMPTY STRING
* CREATE THE 1 BLANK STRING CONSTANT
          SA1    BPREMPTY 
          ADDWRD CONS,X1
 BPRINT1  BSS    0
          RJ        FETCH 
           SA1       ANDSTACK+B2
          SB6       STKIND
          UX1       X1,B5 
          EQ     B6,B5,BPRINT2
          SB6       SVKIND
          EQ     B6,B5,BPRINT2
          OUTINS RJOCON 
 BPRINT2  SA1       SACTEMP1
          SX2    X1-LXEOS 
          ZR     X2,BPRNT22    BR,-EOS- UNSTACKED THIS
          SX2    X1-LXELS      DID -ELSE- UNSTACK THIS
          NZ     X2,BPRNT21    BR, -ELSE- DID NOT UNSTACK THIS
 BPRNT22  BSS    0
          SX1    2                 SET INDEX
 BPRNT21  BSS    0
          OUTINS    (X1+SETX4POS-1)     SX4 TERMINATOR
          OUTINS    RJPRINT             RJ BASOPRT
          DECRAND 
          SA1       SACTEMP1
          SX6    X1-LXEOS      DID -EOS- UNSTACK THIS 
          ZR     X6,REPEAT     BR, -EOS- DID UNSTACK THIS 
          SX6    LPR2          PRESET X6
          SX1    X1-LXELS      DID -ELSE- UNSTACK THIS
          ZR     X1,REPEAT     BR, -ELSE- DID UNSTACK THIS
          JP        STACK1
* 
          SA2    F.LABS 
          IX1    X2+X1             ADDRESS OF LABEL 
          SA1    X1-1              SECOND WORD
          SA5    SEQNO             MERGE CALLING LINE NUMBER INTO 
          IX7    X5+X1             WORD 2 
 LACTPRU  RJ     PRU               PROCESS USING
          ZR     B4,LACTPU1        IF NOT IMAGE REFERENCE 
 LACTPU   BSS    0
          SETVINX LOGVINXW
          OUTINS RJOUSI 
          SA1    SACTEMP1      FETCH UNSTACK REASON 
          SX6    X1-LXELS      DID -ELSE- UNSTACK THIS
          ZR     X6,ZRPRUSN    BR, -ELSE- DID UNSTACK THIS
          SX6    LPRV          PRESET X6
          SX1    X1-LXEOS    IS IT A BLANK ( NO OPERAND) PRINT
          NZ     X1,STACK1   IF NOT GO GET OPERAND(S) 
*                             ELSE GET READY TO EXIT
 ZRPRUSN  BSS    0
          SA1    SACTEMP4    LOAD LAST UNSTACKING REASON
          SX6    X1-LXCOM 
          ZR     X6,PRUOUT
          SX1    X1-LXSEM    CHECK IF IT WAS A SEMI-COLON 
          ZR     X1,PRUOUT   IF SO EXIT (AND HOLD THE LINE) 
          EQ     PRULFCR     AND FORCE NEW LINE 
 LACTPU1  BSS    0
          RJ     FETCH
          EQ     LACTPU 
* 
 LACTPRV  BSS    0
          TESTAND NE,2,BPRNT1 SEE IF WE HAVE AN OPERAND 
          SA5    SACTEMP1 
          SX6    LPRV 
          SX1    X5-LXEOS 
          ZR     X1,ZRPRUSN 
          SX1    X5-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X1,ZRPRUSN    BR, -ELSE- DID UNSTACK 
          SX1    X5-LXSEM 
          ZR     X1,STACK1
 PRULFCR  BSS    0
          OUTINS RELEATOP 
          OUTINS SETXIZER 
          OUTINS SETX4NEG    SX4 TERMINATOR 
          OUTINS RJPRINT
 PRUOUT   BSS    0
          DECRAND 
          EQ     REPEAT 
* 
 BPRNT1   BSS    0
          SA1    ANDSTACK+B2
          UX6    B6,X1             B6 = KIND                             BAS0018
          SB5    TABKIND                                                 BAS0018
          EQ   B5,B6,BILLTAB       TAB ILLEGAL IN PRINT USING            BAS0018
          LX1    30 
          SB6    X1          CLASS
          SB5    VINX 
          RJ     CLEAR       CLEAR
          SX7    B0 
          SA7    SACTEMP4    CLEAR PREVIUOS-OPERATOR-VALUE ( TO 
*                            ENSURE THAT ONLY A SEMI-COLON,EOS
*                            COMBINATION HOLDS THE PRINT LINE)
          DECRAND 
          RJ     FETCH       IMAGE
          INCRAND 
          RJ     FETCH       PRINT ITEM 
          SA1    ANDSTACK+B2
          SB6    STKIND 
          UX1    X1,B5
          EQ     B6,B5,BPRNT4 
          SB6    SVKIND 
          EQ     B5,B6,BPRNT4 
          SX2    0
          EQ     BPRNT41
 BPRNT4   BSS    0
          SX2    1           INDICATES STRING 
 BPRNT41  BSS    0
          SA1    SACTEMP1    WHAT UNSTACK THIS
          SX1    X1-LXSEM    IS IT SEMI-COLON 
          NZ     X1,BPRNT42  NO 
          SX2    X2+2 
 BPRNT42  BSS    0
          OUTINS (X2+SETXIPOS)
          OUTINS RELEATOP 
          OUTINS RJOPRO 
          DECRAND 
          SA1    SACTEMP1 
          SX6    X1-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X6,ZRPRUSN    BR,-ELSE- DID UNSTACK THIS 
          SX6    LPRV          PRESET X6
          SX1    X1-LXEOS      DID -EOS- UNSTACK THIS 
          ZR     X1,ZRPRUSN    BR, -EOS- DID UNSTACK THIS 
          EQ     STACK1 
  
 PRU      SPACE  4
**        PRU - PROCESS USING PART OF PRINT USING 
*         ENTRY  TOP OF ANDSTACK IS USING TAG.
  
  
 PRU      PS
          SA1    ANDSTACK+B2       USING TYPE 
          SB4    B0                SET FLAG FOR NOT FORMAT
          UX1    B5,X1
          SX6    B5-SVKIND
          ZR     X6,PRU            IF SIMPLE VARIABLE 
          SX6    B5-STKIND
          ZR     X6,PRU            IF STRING
          SX6    B5-SYSTKND 
          ZR     X6,PRU            IS SYSTEM TYPE 
          LNCHECK  BILLLAB         CHECK LABEL FOR ERROR
          SA6    A2 
          SA6    PRUSFLG     SET THE REFERENCED-BY-PRINT-USING FLAG 
*                            FOR MORE INFO ABOUT FLAG SEE END OF PRU
*                            ROUTINE. 
          OUTINS NULLTOPU          GENERATE SA5 B4+FORMAT REFERENCE 
          MX7    0
          SA7    PRUSFLG     CLEAR REFERENCED-BY-PRINT-USING-STMT FLAG
          SA1    LABTEMP           MARK IT AS IMAGE REFERENCE WITH LINE 
          SA2    F.LABS 
          IX6    X1+X2
          SA1    X6-1              SECOND WORD OF LABEL ENTRY 
          MX7    60-36
          BX1    -X7*X1 
          LX1    60-36             POSITION NAME AND LINK 
          SA5    SEQNO             CURRENT SEQUENCE  NUBMER 
          IX7    X5+X1             PACK SEQUENCE NUMBER IN LABEL ENTRY
          LX7    36 
          SA7    A1                RESET LABEL ENTRY
          OUTINS REGRES 
          SB4    B1                FLAG IMAGE REFERENCE 
          EQ     PRU
 PRUSFLG  BSSZ   1           1=PRINT USING HAS REFERNCED THIS LABEL.
*                            0=PRINT USING DID NOT REFERNCE THIS LABEL. 
*                            THIS FLAG IS USED TO TELL BASOPTS LABEL ROUTINE
*                            WHICH OFFSET TO USE WHEN AN IMAGE STMT LINE NO.
*                            IS REFERENCED BY EITHER A PRNT USING OR NON-PRNT 
*                            USING STATEMENT. FLAG IS USED ONLY WHEN THE B
*                            OPTION IS SPECIFIED. THE FLAG IS SET IN ROUTINE
*                            PRU (PART OF LACTPRI) IN BASCOMP. THE FLAG IS
*                            CLEARED IN THIS ROUTINE ALSO.
* 
          EJECT 
* 
* 
* 
* 
*                MARGIN STATEMENT 
* 
* 
* 
 LACTMGN  BSS    0
* 
* 
          SX1    X6-LXFIL 
          BX5    X6 
          SX6    LMAR1
          ZR     X1,SETFILE        SKIP IF FILE NAME CAUSED UNSTACK ACT 
          SX1    X5-LXPND 
          ZR     X1,FINDFIL        SKIP IF FILENO CAUSED UNSTACK ACT
          BX6    X5                ELSE RESTORE X6
* 
* 
 LACTMG1  BSS    0
* 
          TESTAND  EQ,0,DFLTMGN    SKIP IF NO OPERAND (FORCE DEFAULT
*                                  MARGIN VALUE)
* 
          SA1    ANDSTACK+B2
          SB5    SIMKND 
          UX1    B6,X1
          NE     B5,B6,BILLMGN     ERROR: ILLEGAL MARGIN
CHKFET   BSS       0
         SA1       FETADDR
         NG        X1,NOFET       SKIP IF FET ADDRESS WILL BE FOUND AT
*                                 RUN-TIME
         INCRAND
         BX6       X1 
         SA6       ANDSTACK+B2
         OUTINS    SETB5FET   GET B5 TO POINT TO FET
         DECRAND
 NOFET    BSS    0
* 
* 
          RJ     FETCH             GEN: LOAD (VBL) MARGIN 
* 
          SA1    B2+ANDSTACK
          MX7    57 
          BX1    -X7*X1 
          SX7    X1-5 
          ZR     X7,MARINX5        SKIP IF MARGIN WILL BE IN X5 (R/T) 
* 
          OUTINS  BX5XI            ELSE GEN: FORCE IT TO X5 
* 
 MARINX5  BSS    0
* 
* 
          OUTINS  RJOMRGN          GEN: CALL BASOMGN
          DECRAND                  RELEASE THE MARGIN OPERAND 
          EQ     REPEAT 
* 
 DFLTMGN  BSS    0
* 
*                NO VALUE SPECIFIED IE DEFAULT IS IMPLIED 
* 
          INCRAND                  RESERVE AN AND-ENTRY 
          SA1    DFLTMAR           DEFAULT LINE WIDTH 
          BX7    X1 
          SA7    B2+ANDSTACK-1     DUMP IT IN AND-ENTRY 
* 
* 
* 
          MX7    42 
          SA1    BANDCON
          BX7    X7*X1
          SA7    ANDSTACK+B2       MIMIC CONSTANT TYPE
* 
         EQ        CHKFET         GO CHECK FET
* 
          EJECT 
* 
*                NOTE THAT DFLTWDS,DFLTCHS AND DFLTLWD ARE COMMON TO
*                BOTH BASCOMP AND BASRTS. 
* 
*  INPUT
* 
 LACTINP  BSS       0                   START INPUT 
          SX1       X6-LXFIL
          BX5    X6                SAVE UNSTACK REASON
          SX6       LIN1
          ZR        X1,SETFILE          IT IS INPUT FILE
          SX1    X5-LXPND          TRY FILE-INPUT-POUND-SIGN
          ZR     X1,FINDFIL        SKIP IF IT IS
          BX6    X5                RESTORE REASON 
* 
 LACTIN1  BSS       0 
          TESTAND   EQ,0,BILLINP        NO OPERAND IS ERROR 
          RJ        CLEAR 
          INCRAND 
          SA1       FETADDR 
          NG     X1,RINFET         SKIP IF .LT. 0 (FET WILL BE FOUND
*                                  AT RUN-TIME) 
          BX6       X1
          SA6       ANDSTACK+B2 
          OUTINS    SETB5FET            SB5 B4+FET REL ADDR 
 RINFET   BSS    0
          SA1    L.CONS      SAVE THE OFFSET
          BX6    X1          OF THE LAST ENTRY IN 
          SA6    SVMSKLOC    THE CONSTANT TABLE AS THE MASK LOCATION. 
          SA1    CONSENTR    CREATE TWO ZERO ENTRIES IN THE 
          BX6    X1          CONSTANTS TABLE FOR THE MASK.
          SA6    B2+ANDSTACK
          BX7    X7-X7
          SA7    B2+ANDSTACK-1
          INCRAND 
          SA6    B2+ANDSTACK
          SA7    B2+ANDSTACK-1
          RJ     FETCH       SA5   MASK.
          DECRAND 
          RJ     FETCH       SA4   MASK+1.
          DECRAND 
          BX7    X7-X7       CLEAR THE VARIABLE LIST
          SA7    VLISTCT     COUNT. 
          OUTINS    RJISRT              RJ BASISRT
          SX6    2                 SET INTYPE TO
          SA6    INTYPE            INDICATE IN2 
* 
 LACTIN2  BSS       0                   INPUT ELEMENT 
          TESTAND   EQ,0,LACTINP2       EXIT IF ANDSTACK EMPTY
          RJ        CLEAR 
          SA1       ANDSTACK+B2 
          UX1       B6,X1 
          SB5       SVKIND
          EQ        B6,B5,LACTINP3
          LX1       30
          SB5       X1-CONST
          EQ B5,B0,BILLINP
          SB5    X1-SYSTKND        IS IT SYSTEM STRING
          EQ     B5,B0,BILLINP     ERROR IF -INPUT- ATTEMPTED 
          SX1       X1-INT
          ZR        X1,BILLINP
          OUTINS    RJINPUT             RJ BASIINP
          RJ        STORE 
          DECRAND 
          SA1    SVMSKLOC    GET THE MASK OFFSET. 
          SA2    F.CONS 
          IX1    X1+X2
          SA1    X1+1        GET THE SECOND WORD OF THE MASK. 
          SX2    1
 LACTINP4 IX6    X1+X2       ADD ONE TO THE COUNT 
          SA6    A1          REPLACE SECOND WORD OF THE MASK. 
          SA1    VLISTCT     INCREMENT THE
          SX6    X1+1        VARIABLE LIST
          SA6    A1          SIZE COUNT.
          SA1    HVLSTCT     COMPARE SIZE COUNT 
          IX1    X1-X6       TO THE LARGEST PREVIOUS COUNT. 
          PL     X1,LACTINP2 NOT LARGER, BR.
          SA6    A1          IS LARGER, REPLACE.
* 
 LACTINP2 SA1       SACTEMP1
          SX6    X1-LXELS      DID -ELSE- UNSTACK THIS
          ZR     X6,BINP2A     BR, -ELSE- DID UNSTACK THIS
          SX6    LIN2          PRESET X6
          SX1    X1-LXEOS      DID -EOS- UNSTACK THIS?
          NZ     X1,INP2B          BR, -EOS- DID NOT UNSTACK THIS 
 BINP2A   BSS    0
          OUTINS    RJENDINP            RJ BASIEND
          JP        REPEAT
 INP2B    SA1    TORSTACK+B3       GET TOP OPERATOR 
          SX2    X1-LACTRDSB       IF RDSUB WE WANT 
          ZR     X2,REPEAT         TO GO UNSTACK IT 
          EQ     STACK1            ELSE STACK IN2 
* 
 LACTINP3 BSS    0
* 
* THIS IS TO INPUT A STRING TO A STRING VARIABLE. 
* WE GENERATE CODE TO FETCH TO A5/X5 THE POINTER WORD 
* OF THE TARGET STRING VARIABLE, THEN GENERATE CODE 
* TO CALL RUN/TIME BASIINS WHICH EXPECTS A5 TO BE LOADED
* WITH TARGET VARIABLE PTR WORD ADDRESS.
* 
          RJ     FETCH           FETCH TARGET PTR WORD TO A5/X5 
           OUTINS RJSINPT 
          MX7    59 
          SA7    REGSTPTR          RELEASE ALL REGISTERS
          DECRAND                  RELEASE TEMP$
          SA1    SVMSKLOC    GET THE MASK OFFSET. 
          SA2    F.CONS 
          IX1    X1+X2
          SA1    X1+1        GET THE SECOND WORD OF THE MASK. 
          MX7    1
          SB6    X1 
          SB5    B6-60       IF VARIABLE IS 1ST - 59TH
          NG     B5,LACTINP5 THEN BRANCH TO SET BIT.
          SB4    B5-60
          SB4    -B4
          LX7    B4,X7       POSITION BIT AND ADD TO SECOND WORD
          BX1    X1+X7       OF THE MASK TO INDICATE STRING.
          EQ     LACTINP4 
 LACTINP5 SA2    A1-1        PICK UP 1ST WORD OF MASK.
          SB4    B6-60
          SB4    -B4
          LX7    B4,X7       POSITION BIT AND ADD TO 1ST WORD OF
          BX7    X7+X2       MASK TO INDICATE STRING. 
          SA7    A2          REPLACE 1ST WORD OF MASK.
          SX2    1
          EQ     LACTINP4 
 VLISTCT  DATA   0           COUNT OF CURRENT VARIABLE LIST 
 HVLSTCT  DATA   0           COUNT OF LONGEST VARIABLE LIST 
 SVMSKLOC DATA   0           OFFSET IN CONS OF THE CURRENT MASK 
 CONSENTR VFD    12/2000B+SIMKND,18/CONST,30/0
 LACTDEL  BSS    0             UNSTACKED BY -,- -EOS- -ELSE- OR FILE
          EJECT 
* 
* 
* 
          SX1    X6-LXFIL 
          BX5    X6                SAVE UNSTACK REASON
          SX6    LDEL1             SET-UP NEXT ACTION 
          ZR     X1,SETFILE        SKIP IF *FILE* DID  CAUSE UNSTACKING 
          SX1    X5-LXPND 
          ZR     X1,FINDFIL        SKIP IF FILE-ORDINAL-POUND-SIGN
          BX6    X5                RESTORE UNSTACK REASON 
* 
* 
 LACTDL1  BSS    0
          RJ     CLEAR
          SA1    FETADDR
          NG     X1,DLRTFET        SKIP IF FET ADDR WILL BE SET AT R/T
          INCRAND 
          BX6    X1 
          SA6    ANDSTACK+B2
          OUTINS  SETB5FET         GEN: GET FET REL ADDR TO B5
          DECRAND 
 DLRTFET  BSS    0
*                                  TEST FOR OPERAND AND IF THERES NONE
          TESTAND  EQ,0,DFLTDEL    SKIP TO RE-ENABLE DEFAULT DELIMITING 
* 
* 
 LACTDL2  BSS    0
          SX7    1
          SA1    DLMRNO 
          IX7    X1+X7
          SX1    X7-DLMLIM         CHECK NO OF DELIMITERS 
          NG     X1,DLMNOK         SKIP IF STILL OK 
          EQ     BILLDNO           *TOO MANY DELIMITERS*
* 
* 
 DLMNOK   BSS    0
          SA7    A1                SAVE DELIMITER COUNT 
          SA1    DLMTROK           CHECK DELIMITER VALIDITY 
          PL     X1,BADLMT         ERROR IF INVALID 
          SX7    B0 
          SA7    A1                RESET TO 0 
          SA1    SACTEMP1 
          SX6    X1-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X6,BDLM1      BR, -ELSE- DID UNSTACK THIS
          SX6    LDEL2         PRESET X6
          SX1    X1-LXEOS      DID -EOS- UNSTACK THIS?
          NZ     X1,STACK1     BR, -EOS- DID NOT UNSTACK THIS 
* 
 BDLM1    BSS    0
* 
          RJ     MRGDELS           MERGE DELIMITERS AND DUMP AS CONSTANT
* 
          RJ     FETCH             GEN: LOAD MERGED DELIMITERS TO X5
          DECRAND 
          OUTINS SB6POS            GEN: SETB6 POS TO FLAG SPECIAL DELIMS
          OUTINS  RJIDLST          GEN: DUMP -DELIMITER- BYTES IN FET 
          JP     REPEAT 
* 
* 
 DFLTDEL  BSS    0
          OUTINS SB6ZRO            GEN: SET B6=0 TO FLAG STD DELIMS 
          OUTINS  RJIDLST          GEN: DUMP INFORMATION IN FET 
          JP     REPEAT 
* 
 MRGDELS  BSS    0
*                                  MRGDELS EXTRACTS 1 (TO 3) DELIMITERS 
*                                  FROM THE OPERAND STACK AND MERGES
*                                  THEM INTO A 42 BIT DESCRIPTOR WHICH
*                                  IS FETCHED AT RUN-TIME AND SAVED 
*                                  IN (THE APPROPRIATE) FET.
* 
* 
          JP     0
          SX0    B7                SAVE SOURCE POINTER
          SX6    B0 
          SX7    B0 
          SB5    DLMLIM-2          USED AS SHIFT LATER (-ESC- DELIM FLG)
          SB6    11 
          SB7    42 
          SA1    DLMRNO            ACTUAL DELIMITER COUNT 
* 
 NXTDLCH  BSS    0
          SA2    ANDSTACK+B2-1     NEXT DELIMITER CHARACTER 
          DECRAND 
          AX3    X2,B6             DROP L.O. 11 BITS
          LX3    X3,B5             SHIFT (0/1) AS -ESCAPE- FLAG 
          IX7    X7+X3             SAVE FLAG
          SB5    B5-1 
          LX2    X2,B7             SHIFT DELIMITER BYTE (12 BITS) INTO
*                                  PLACE
          IX6    X6+X2             AND SAVE IT
          SB7    B7-12
          SX1    X1-1              CHECK DELIMITER COUNT
          NZ     X1,NXTDLCH        LOOP WHILE NON-ZERO
* 
* 
          SA1    DLMRNO            DELIMITER COUNT
          LX7    3                 SHIFT FLAG BITS
          IX7    X7+X1             APPEND DELIMITER COUNT 
          LX7    54                MOVE TO BITS 59-54 
          BX7    X7+X6             MERGE WITH DELIMITER CHARS 
          INCRAND 
          SA7    ANDSTACK+B2-1     DUMP RESULT TO STACK 
          MX7    42 
          SA1    BANDCON
          BX7    X7*X1             MIMIC CONSTANT TYPE
          SA7    ANDSTACK+B2       DUMP TO STACK
* 
* 
          SB7    X0                RESTORE SOURCE POINTER 
          EQ     MRGDELS           EXIT 
* 
* 
  
  
          EJECT 
* 
*  READ 
* 
 LACTREA  BSS       0                   START READ
          SX1       X6-LXFIL
          BX5    X6                SAVE UNSTACK REASON
          SX6       LRDF
          ZR        X1,SETFILE          IT IS READ FILE 
          SX1    X5-LXPND          TRY FILE-READ-POUND-SIGN 
          ZR     X1,FINDFIL        EXIT IF IT IS
          BX6    X5                RESTORE REASON 
          TESTAND   EQ,0,BILLREAD       NO OPERAND IS ERROR 
          SX6    B0                SET INTYPE TO
          SA6    INTYPE            INDICATE RE2 
* 
 LACTRE2  BSS       0                   READ ELEMENT
          TESTAND   EQ,0,LACTREA1       SEE IF WE HAVE AN OPERAND 
          INCRAND 
          OUTINS  FETCHDAT         SAI =XDATAXXX  XI=DATAPTR
          SETVINX  SIMVINXW 
          OUTINS  FETCHDT1         SAI XI  XI=DATA ITEM 
          OUTINS  ORREDATA         OR XI,ENDDATA  RELEASE XI
          OUTINS  DECRDATA         SX6 AI-1 
          OUTINS  STOREDAT         SA6 =XDATAXXX
          SA1       ANDSTACK-ANDINCR+B2 
          UX1       B5,X1 
          SB6       SVKIND
          NE        B5,B6,LACTRE3 
          OUTINS    READSTR 
          OUTINS TRANSMIT 
          OUTINS    SETXSTR 
          OUTINS RJRDCHK
          DECRAND 
          RJ     FETCH
          OUTINS SB6AI
          OUTINS RJSTRST
           RJ     RELEASE 
          JP     LACTRE5
 LACTRE3  BSS       0 
         SB6       SYSTKND              TEST FOR SYSTEM STRINGS 
         EQ        B5,B6,BILLREAD       ERROR EXIT
          OUTINS TRANSMIT 
          OUTINS    SETXNUM 
LACTRE4   BSS       0 
          OUTINS    RJRDCHK 
          DECRAND 
          RJ        STORE 
 LACTRE5  BSS    0
          DECRAND 
          SA1       BDAREFL 
          SB6       -1
          LX1       30
          PX6       B6,X1               SET READ FLAG 
          LX6       30                    IN DATA-READ FLAG WORD
          SA6       A1
 LACTREA1 BSS       0 
          SA1    TORSTACK+B3       GET TOP OPERATOR 
          SX2    X1-LACTRDSB       IF ITS A RDSUB WE
          NZ     X2,LACTRE6        WANT TO
          JP     REPEAT            CONTINUE UNSTACKING
 LACTRE6  BSS    0
          SA1       SACTEMP1
          SX6    X1-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR   X6,REPEAT       BR, -ELSE- DID UNSTACK THIS
          SX6       LRE2
          SX1       X1-LXEOS
          ZR        X1,REPEAT           SEPARATOR = EOS 
          JP        STACK1
* 
*   READ FILE 
* 
 LACTRDF  BSS       0                   START READ FILE 
          TESTAND   EQ,0,BILLREAF       NO OPERAND IS ERROR 
          INCRAND 
          SA1       FETADDR 
          NG     X1,RTFET          SKIP IF .LT. 0 (FILE WILL BE FIXED 
*                                  AT RUN-TIME) 
          BX6       X1
          SA6       ANDSTACK+B2 
          OUTINS    SETB5FET            SB5 B4+FET REL ADDR 
 RTFET    BSS    0
          DECRAND 
          RJ     CLEAR       RELEASE ALL REGISTERS (AT RUN-TIME)
* 
          OUTINS RJIRD0            GEN: RJ BASIRD0
          SX6    1                 SET INTYPE TO
          SA6    INTYPE            INDICATE RF2 
 LACTRF2  BSS       0                   READ FILE ELEMENT 
          TESTAND   EQ,0,LACTRF21 
          RJ        CLEAR 
          SA1       ANDSTACK+B2 
          UX1       B5,X1 
          SB6       SVKIND
          EQ     B5,B6,LACTRFS     SKIP IF READ STR VBL (FROM BIN FILE) 
*                                  BASCOMP.763
          SB6    SYSTKND           SYSTEM STRING (DATE ETC) 
          EQ     B5,B6,BILLREAD    NULL OPERNAD 
          OUTINS  SETX4ZER         GEN: SX4  0 TO FLAG BIN-READ-REAL-VAL
          OUTINS    RJIRED              RJ BASIRED
          RJ        STORE 
          DECRAND 
 LACTRF21 SA1       SACTEMP1
          SX6    X1-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X6,REPEAT     BR, -ELSE- DID UNSTACK THIS
          SX6       LRF2
          SX1       X1-LXEOS
          ZR        X1,REPEAT           SEPARATOR = EOS 
          SA1    TORSTACK+B3       GET TOP OPERATOR 
          SX2    X1-LACTRDSB       IF ITS A RDSUB WE
          ZR     X2,REPEAT         WANT TO UNSTACK IT 
          JP        STACK1
* 
*                                  READ STRING FROM BINARY FILE 
* 
 LACTRFS  BSS    0
          OUTINS SETX4POS          GEN: SX4  1 TO FLAG READ-STR-FROM-BIN
          RJ     FETCH           GEN SA5 TGT PTR WORD 
          OUTINS RJIRED            GEN: RJ  BASIRED 
          MX7    -1                RELEASE REGISTERS
          SA7    REGSTPTR 
          DECRAND                  AND TEMP$
          EQ     LACTRF21          REJOIN STANDARD (REAL VALUE) CASE
 INTYPE   DATA   0                 HOLD I/O TYPE(1=RE2,2=RF2,3=IN2) 
* 
* 
* 
          EJECT 
* 
*  WRITE
* 
 LACTWRT  BSS       0                   WRITE FILE
          SX1       X6-LXFIL
          BX5    X6 
          SX6       LWR2
          ZR        X1,SETFILE
          SX1    X5-LXPND          TRY FILE-WRITE-POUND-SIGN
          ZR     X1,FINDFIL 
          BX6    X5                RESTORE REASON 
          JP        BWRITERR
* 
 LACTWR2  BSS       0                   START WRITE FILE
          TESTAND   EQ,0,BILLWRIT       NO OPERAND IS ERROR 
          INCRAND 
          SA1       FETADDR 
          NG     X1,WRTFET         SKIP IF .LT. 0 (FET WILL BE FIXED
*                                  AT RUN-TIME) 
          BX6       X1
          SA6       ANDSTACK+B2 
          OUTINS    SETB5FET            SB5 B4+FET REL ADDR 
 WRTFET   BSS    0
          DECRAND 
          OUTINS RJOWR0            GEN: RJ BASOWR0
* 
 LACTWR3  BSS       0                   WRITE FILE ELEMENT
          TESTAND   EQ,0,LACTWR31 
          SA1       ANDSTACK+B2 
          UX1       B5,X1 
          SB6       SVKIND
          EQ     B5,B6,LACTWRS
          SB6       STKIND
          EQ     B5,B6,LACTWRS     WRITE STRING CONSTANT IS OK
          SB6    SYSTKND
          EQ     B5,B6,BWRITERR    NULL OPERNAD 
          RJ        FETCH 
          OUTINS SETX4ZER          GEN: SX4  0 TO FLAG BIN-WRITE-REAL-VB
          OUTINS    RJOWRT              RJ BASOWRT
          DECRAND 
 LACTWR31 SA1       SACTEMP1
          SX6    X1-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X6,REPEAT     BR, -ELSE- DID UNSTACK THIS
          SX6       LWR3
          SX1       X1-LXEOS
          ZR        X1,REPEAT           SEPARATOR = EOS 
          JP        STACK1
* 
* 
 LACTWRS  BSS    0                 WRITE STRINGS TO BINARY FILE 
* 
          RJ     FETCH             GEN: GET STRING ADDRESS TO A5
          OUTINS SETX4POS          GEN: SX4  1 TO FLAG WRITE-STR-TO-BINF
          OUTINS RJOWRT            GEN: RJ  BASOWRT 
          DECRAND                  RELEASE OPERAND
          EQ     LACTWR31          JOIN STANDARD (REAL VALUE) CASE
          EJECT 
* 
* 
*                FINDFIL IS ENTERED FROM INPUT,PRINT,READ,WRITE AND ALSO
*                  FROM RESTORE. FOR BOTH CONSTANT AND VARIABLE 
*                  FILE ORDINAL EXPRESSIONS CODE IS GENERATED TO
*                  FIND THE FET AT RUN TIME AND FETADDR IS SET
*                  EQUAL TO -1
*                EXIT TO STACK1.
* 
* 
* 
 FINDFIL  BSS    0
          SA6    SACTEMP3          RECORD RELEVANT NEXT-ACTION
          SA1    DLMTST 
          ZR     X1,FF1      NOT DELIMIT
          MX6    60 
          SA6    A1          SET SWITCH TO -0 
 FF1      BSS    0
          SX6    LFIND1 
          JP     STACK1            GO GET FILE ORDINAL EXPRESSION 
* 
 LACTFL1  BSS    0
* 
*         UNSTACKED BY COMMA(,),EOS(RESTORE),USING
*                      GOTO/THEN OR ELSE
* 
*         BEFORE CHECKING FOR EOS FROM RESTORE ACTION CHECK FOR 
*         AN APOSTROPHE AND IF SO SCAN DOWN THE CHAR UNPACK BUFFER
*         UNTIL THE REAL EOS IS FOUND 
* 
          SX1    X6-LXCOM 
          ZR   X1,FFL2             SKIP IF UNSTACKED BY COMMA 
*         REPLACE THE UNSTACKING SYMBOL FOR LATER 
          SX1    X6-LXTHE 
          NZ     X1,FFL3A      NOT THEN 
          SX7    LITHE
          EQ   FFL6 
 FFL3A    SX1    X6-LXELS      DID -ELSE- UNSTACK THIS
          NZ     X1,FFL3       NOT -ELSE- 
          SX7    LIELS
          EQ     FFL6 
 FFL3     SA1    B7-1              GET UNSTACK CHARACTER
          SX1    X1-1R'      CHECK FOR APOSTROPHE 
          NZ     X1,FFL0           BR, EOS FOUND
* 
*         SKIP OVER COMMENT UNTIL REAL EOS FOUND
* 
 FFLP     SA1    B7                GET NEXT CHAR
          SB7    B7+1              INCR CHAR UNPACK BUFF PTR
          SX1    X1-101B           CHECK FOR EOS
          NZ     X1,FFLP           LOOP UNTIL EOS 
          SA1    B7-1              RESTORE EOS
 FFL0     SX1    X6-LXEOS 
          NZ   X1,FFL5             NOT EOS
          SX7    LIEOS
          EQ   FFL6 
 FFL5     SX1    X6-LXUSI 
          NZ   X1,REPEAT           NOT USING, PROBABLY BAD
         SX7       LIUSI               USING PSEUDO CHARACTER 
 FFL6     BSS    0
         SB7       B7-1                INPUT SCAN COUNTER 
          SA7    B7            PUT PSEUDO CHAR IN INPUT STRING
 FFL2     BSS    0
          SA1    DLMTST 
          PL     X1,FFL4
          SX7    1
          SA7    DLMTST      RESTORE DELIMIT SWITCH 
 FFL4     BSS    0
* 
          RJ     CFLNTYP           CHECK FILE ORDINAL TYPE
* 
          ZR     X1,FNINT          SKIP IF INTEGRAL FILE NO 
          NZ     X2,FTCHFET        SKIP IF ITS A VARIABLE 
 FNINT    BSS    0
          RJ     CHKFLNO           DO A BOUNDS CHECK ON THE FILE NO 
* 
 FTCHFET  BSS    0
          RJ     FETCH             GEN: LOAD THE FILE ORDINAL 
          OUTINS RJOFET            GEN: CALL BASOFET (TO SETUP THE
*                                  FET ADDRESS IN B5) 
* 
          MX7    59 
          SA7    FETADDR           SET: FET-WILL-BE -FOUND-AT-R/T- FLAG 
* 
          SA7    REGSTPTR          RELEASE THE REGISTER USED BY BASOFET 
          DECRAND                  RELEASE THE STACKED FILE-NO OPERAND
          SA1    SACTEMP3          RELOAD THE NEXT ACTION 
          BX6    X1 
          JP     STACK1            AND CONTINUE 
* 
* 
 CHKFLNO  BSS    0
* 
*                CHKFLNO EXPECTS A POSSIBLE FILE NO IN ANDSTACK AND 
*                CHECKS IT TO BE IN THE RANGE : 1 - 2**18-1. AN INTEGRAL
*                VALUE (TRUNCATED IF NECESSARY) IS RETURNED IN X5.
          JP     0
          SA1    ANDSTACK+B2-1     LOAD THE CONSTANT
          BX5    X5-X5       ROUND THE CONSTANT 
          PX5    X5 
          RX1    X5+X1
          NX1    X1 
          UX1    B6,X1             UNPACK 
          LX5    B6,X1             TRUNCATE 
          NG     X5,SERRORE        ILLEGAL FIL NO 
          MX2    42 
          BX2    X2*X5
          NZ     X2,SERRORE        ILLEGAL FILE NO (TOO BIG)
         PX5       B0,X5                RETURN FLOATING POINT TRUNCATED 
         NX5       X5                   ORDINAL IN X5 
          JP     CHKFLNO           AND EXIT 
* 
 SACTEMP3 BSSZ   1
* 
          EJECT 
* 
* 
*          IF END UNSTACKING ACTION 
* 
 LACTIFE  BSS    0
          SA5    GOTOJUMP 
          BX7    X5 
          SA7    RELOPR 
          SX1    X6-LXFIL 
          BX5    X6 
          SX6    LIF2 
          ZR     X1,SIFMERR 
          SX1    X5-LXPND 
          ZR     X1,FINDFIL 
* 
 LCTIFE2  BSS    0                 UNSTACKED BY THEN/GOTO 
*     WAIT FOR -EOS- OR -ELSE- AFTER LINE NUMBER
          SX6    LIF4 
          EQ   STACK1 
* 
 LCTIFE3  BSS    0             UNSTACKED BY -EOS- OR -ELSE- 
          INCRAND 
          SA3     FETADDR 
          NG      X3,FIE3 
          BX6     X3
          SA6     ANDSTACK+B2 
          OUTINS  SETB5FET
 FIE3     BSS     0 
          DECRAND 
          SA5     SACTEMP1
          BX6     X5
          LNCHECK BILLLAB 
          SA6     A2
          OUTINS  RJINOD
          OUTINS  REGRES
          OUTINS  NOTEQJMP
          DECRAND 
          EQ     REPEAT 
* 
*         UNSTACKING ACTION FOR IF MORE 
* 
 LACTIFM  BSS    0
          SA5    GOTOJUMP 
          BX7    X5 
          SA7    RELOPR 
          SX1    X6-LXFIL 
          BX5    X6 
          SX6    LIF3 
          ZR     X1,SIFMERR 
          SX1    X5-LXPND 
          ZR     X1,FINDFIL 
          EQ     SIFMERR         INVALID UNSTACKING REASON
* 
 LCTIFM2  BSS    0                 UNSTACKED BY THEN/GOTO 
          SX6    LIF5          WAIT FOR -EOS- OR -ELSE- 
          EQ   STACK1 
* 
 LCTIFM3  BSS    0             UNSTACKED BY -EOS- OR -ELSE- 
          INCRAND 
          SA3    FETADDR
          NG     X3,FIM3
          BX6    X3 
          SA6    ANDSTACK+B2
          OUTINS  SETB5FET
 FIM3     BSS    0
          DECRAND 
          SA5    SACTEMP1 
          BX6    X5 
          LNCHECK BILLLAB 
          SA6     A2
          OUTINS  RJINOD
          OUTINS  REGRES
          OUTINS  EQUALJMP
          DECRAND 
          EQ     REPEAT 
* 
          EJECT 
* 
*  SET FILE - ENTERED FROM INPUT, PRINT, READ, AND WRITE
* 
 SETFILE  BSS       0 
          SA6       SACTEMP1            SAVE ACTION TO STACK
          SA1       ANDSTACK+B2 
          SB5       FILKND
          UX1       B6,X1               CHECK OPERAND FOR 
          NE        B5,B6,BFILERR         BEING FILEID
          SA5       B2+ANDSTACK-1 
          AX5       18
          RJ        DECLBUF 
          SA7       FETADDR             SET FETADDR FOR FILE
          DECRAND 
          SX6    WERR1
          SA6    WNSW        SET OBSOLETE FORM WARNING SWITCH 
          SA1       SACTEMP1
          BX6       X1
          JP        STACK1
* 
          EJECT 
  
* 
**               APPEND  (FILE) STATEMENT 
* 
  
 LACTAPP  BSS    0
  
          SX1    X6-LXPND    UNSTACKED BY -POUND- SIGN OR FILE
          BX5    X6 
          SX6    LAPQ        SET UP NEXT ACTION (SEE LACTPQ)
          ZR     X1,FINDFIL  SKIP IF UNSTACKED BY -POUND- SIGN
  
          EQ     REPEAT 
  
  
 LACTAPQ  BSS    0
          SA1    FETADDR
          NG     X1,APPFETR  IF FET ADDRESS UNDETERMINED (UNTIL RUN-TIM)
  
          INCRAND 
          BX6    X1 
          SA6    ANDSTACK+B2
          OUTINS SETB5FET 
  
          DECRAND 
  
 APPFETR  BSS    0
  
          OUTINS RJAPPND     GEN: RJ APPEND 
  
          EQ     REPEAT 
  
          EJECT 
* 
*         **************************
* 
*                FILE STATEMENT 
* 
*         **************************
* 
 LACTFIL  BSS    0
          SX1    X6-LXPND          DID -POUND- SIGN CAUSE UNSTACKING
          NZ     X1,REPEAT         EXIT IF NOT
          SX6    LFIE              ELSE EXPECT = (IN FILE STMT) 
          JP     STACK1 
* 
 LACTFIE  BSS    0           UNSTACKED BY = OR :  
          TESTAND  EQ,0,BILLFIL    SKIP TO ERROR IF BLANK FILE STMT 
          SX6    LFCMA
          JP     STACK1            GO GET FILE NAME (STRING VBL OR CNST)
* 
 LACTFCM BSS     0                 UNSTACKED BY (FILE-COMMA OR FILE-EOS)
*     ALSO UNSTACKED BY -ELSE-
          SA1    ANDSTACK+B2
          UX1    B5,X1
          SB6    STKIND 
          NE     B5,B6,STRVFIL     SKIP FOR VARIABLE FILE NAME
* 
          SA1    STRHEAD         X1 = OFFSET TO 1ST WORD OF FILENAME STRG 
          SA5    F.CONS            BASE OF CONSTANTS
          IX1    X1+X5           X1 = ADDRESS OF 1ST WORD OF FN STRING
          SB6    X1 
          SA1    B6                LOAD THE STRING ITSELF 
          BX5    X1                HOLD IT
          SB5    6                 BITS PER CHAR
          MX7    54 
          LX1    6                 FIRST CHAR MUST BE LETTER
          BX2    -X7*X1 
          ZR   X2,ER25             COLON, ILLEGAL, OR NULL STRING IS BAD
          SX2    X2-1R0 
          PL   X2,ER25             NON-LETTER IS BAD
          SB6    7                 TO CHECK 7-CHAR LIMIT
* 
 SHFTNXT  BSS    0
          LX1    X1,B5
          BX2    -X7*X1            ISOLATE CHARACTER
          NZ   X2,FCHOK1
*  FOUND A ZERO CHARACTER - IT IS COLON, ILLEGAL, OR EOS
*  IT MUST BE EOS OR THE FILENAME IS BAD (NO COLONS ALLOWED)
*  CHECK REST OF WORD FOR ZEROS TO END (EOS)
          SB6    B6+1              NUMBER OF CHAR LEFT IN WORD
 FCHOK2   LX1    X1,B5             NEXT CHAR
          BX2    -X7*X1 
          NZ   X2,ER25             MUST BE ZERO TO END
          SB6    B6-1 
          NZ   B6,FCHOK2           LOOP UNTIL WORD DONE 
          EQ   STFIL               NAME IS OK, GO STORE IT
 FCHOK1   BSS    0
          SX2    X2-ALMERIC        CHECK FOR NON-ALPHAMERIC CHARS 
          NG     X2,FCHOK          SKIP IF OK 
          EQ     ER25              ILLEGAL FILENAME 
 FCHOK    BSS    0
          SB6    B6-1 
          NE     B6,B0,SHFTNXT     LOOP IF .LE. 7 CHARS 
          EQ     B0,B0,ER25        ERROR IF .GT. 7 CHARS IN FILENAME
* 
* 
* 
* 
*                VARIABLE FILE NAMES
*                                       FOR EACH FILE STATEMENT WITH A
*                                       VARIABLE FILE NAME GENERATE ONE 
*                                       FET WITH A DUMMY NAME,GENERATE A
*                                       JUMP AT RUN-TIME TO SEARCH FOR
*                                       FILE NAME,AND TO PUT NAME IN FET
*                                       IF NOT FOUND,ALSO GENERATE CODE 
*                                       TO PLACE NUMBER IN FET AT RUN T 
* 
* 
 STRVFIL  BSS    0
          SB6    SVKIND 
          NE     B5,B6,ER25        -ILLEGAL FILENAME- 
 STFIL    BSS    0
          SX7    -1 
          SA7    FETADDR           SET -FET WILL BE FOUND AT RUNTIME- 
          RJ     FETCH             GEN: LOAD THE FILENAME 
          OUTINS SB7AI             GEN: GET B7 TO POINT TO THE FILENAME 
          DECRAND 
* 
* 
*                NEXT EXAMINE THE FILE NO EXPRESSION
* 
* 
          RJ     CFLNTYP           GO CHECK FILE ORDINAL EXPRESSION 
* 
          ZR     X1,FLNINT         SKIP IF ITS INTEGRAL 
         NZ        X2,FLNVAR            SKIP IF IT IS A VARIABLE
* 
 FLNINT   BSS    0
         RJ        CHKFLNO              CHECK FILE ORDINAL
         BX6       X5 
         SA6       ANDSTACK+B2-1        PLACE IN STACK
FLNVAR   BSS       0
         SA5       FILECNT              USE CURRENT FET COUNT TO CREATE 
         RJ        DECLBUF              ADUMMY FET
         SA7       FETADDR              PLACE RELATIVE ADDRES OF FET
         SB6       A2                   GET ABSOLUTE TO B6
          RJ     FETCH             GEN: LOAD THE FILE NUMBER
* 
          SA1    ANDSTACK+B2
          MX7    57 
          BX1    -X7*X1 
          SX7    X1-5 
          ZR     X7,FNOINX5        SKIP IF THE FILENO WILL BE IN X5 (RT)
          OUTINS   BX5XI           GEN : LOAD FILE NO TO X5 
 FNOINX5  BSS    0
* 
          DECRAND                  RELEASE THE STACKED FILE NO OPERAND
* 
         OUTINS    RJOFFT 
* 
          SA1    SACTEMP1 
          SX6    X1-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X6,REPEAT     BR, -ELSE- DID UNSTACK THIS
          SX6    LFILE         PRESET X6, ASSUME COMMA STOPPED SCAN 
          SX1    X1-LXEOS          DID -EOS- APPEAR 
          ZR     X1,REPEAT         IF SO EXIT 
          JP     STACK1            ELSE ARRANGE TO RECYCLE
* 
* 
* 
 CFLNTYP  BSS    0
* 
*                FLNTYP EXPECTS ANDSTACK TO HOLD THE FILE ORDINAL TYPE
*                AND CHECKS THAT IT IS SIMPLE.
*                ON EXIT X1=0 IF THE TYPE IS INTEGRAL.
*                X2=0 IF THE TYPE IS CONSTANT.
* 
          JP     0
          SA1    ANDSTACK+B2
          SB5    SIMKND 
          UX1    B6,X1
          AX1    30 
          NE     B5,B6,SERRORE     -ILLEGAL FILE NO-
          SX2    X1-CONST 
          SX1    X1-INT 
          EQ     B0,B0,CFLNTYP
* 
* 
* 
 GENSB5F  BSS    0
* 
* 
*                                  USE THE ADDRESS IN FETADDR TO GEN
*                                  AN : SB5 FET 
* 
          JP     0
          INCRAND 
          SA1    FETADDR
          BX6    X1 
          SA6    ANDSTACK+B2
          OUTINS   SETB5FET        GEN: SB5 FET ADDRESS 
          DECRAND 
          EQ     GENSB5F           EXIT 
* 
* 
* 
 ALMERIC  EQU    45B               LIMIT FOR FILENAME CHARS 
* 
* 
* 
* 
          EJECT 
  
*                            CLOSE (FILE) STATEMENT 
  
  
 LACTCLO  BSS    0
          SX1    X6-LXPND 
          NZ     X1,REPEAT   EXIT IF POUND SIGN DID NOT CAUSE UNSTACK 
          SX6    LCLO1       NEXT ACT 
          EQ     STACK1 
  
  
 LACCLO1  BSS    0             UNSTACKED BY CMA COLON EOS ELSE
  
          TESTAND  EQ,0,BILLCLO    ERROR IF BLANK CLOSE STMT
  
          OUTINS  SB7ZRO     GEN: SB7 B0 (FLAGS RETURN FILE TO BASOCLO) 
          RJ     CFLNTYP     CHECK FILE ORDINAL EXPRESSION
          ZR     X1,FNOINTG  SKIP IF INTEGRAL 
          NZ     X2,FNOVAR   JUMP IF NOT OTHERWISE CONSTANT 
  
 FNOINTG  BSS    0
          RJ     CHKFLNO     CHECK THE (CONSTANT) FILE ORDINAL
          BX6    X5 
          SA6    ANDSTACK+B2-1     REPLACE IN THE OPERAND STACK 
  
 FNOVAR   BSS    0
          RJ     FETCH       GEN: LOAD THE FILE NO
          SA1    ANDSTACK+B2
          MX7    57 
          BX1    -X7*X1 
          SX7    X1-5 
          ZR     X7,FINX5          SKIP IF FILE NO WILL BE IN X5 AT R/T 
  
          OUTINS  BX5XI 
  
 FINX5    BSS    0
          DECRAND            DROP THE FILE NO OPERAND 
          OUTINS  RJOCLO     GEN: RJ BASOCLO
          SA1    SACTEMP1 
          SX6    X1-LXEOS      DID -EOS- UNSTACK THIS?
          ZR     X6,REPEAT     BR, -EOS- DID UNSTACK THIS 
          SX6    LCLO          PRESET X6
          SX1    X1-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X1,REPEAT     BR, -ELSE- DID UNSTACK THIS
          EQ     STACK1            ELSE MORE FILES TO COME
  
          EJECT 
          EJECT 
* 
* 
*         SETDIGITS USAGE 
 LACTSDG  BSS    0
          SX1    X6-LXDIG 
          NZ     X1,TRYSETF        SKIP TO TEST FOR FILE SET STMT 
          SX6    LSTDIG            SET DIGITS 
          JP     STACK1 
* 
 LACTDGTS BSS    0
          SA1    ANDSTACK+B2
          UX2    B5,X1             UNPACK OPD TO B5 AND X2
          SB6    SIMKND            SIMPLE TYPE
          NE     B5,B6,BILLAOPR    ERROR IF NOT SIMILAR 
          RJ     FETCH
          DECRAND 
          OUTINS RJOSET 
          JP     REPEAT 
          EJECT 
 TRYSETF  BSS    0
          SX1    X6-LXPND 
          NZ     X1,REPEAT
          SX6    LSETF             NEXT ACT (WILL BE UNSTACKED BY COMMA)
          EQ     FINDFIL
  
  
 LACTSFIL BSS    0
          TESTAND  EQ,0,BILLSET    ERROR IF NO OPERAND SPECIFIED
          SA1    ANDSTACK+B2       LOAD THE SET OPERAND 
          SB5    SIMKND 
          UX1    B6,X1
          NE     B5,B6,BILLSET     ERROR: ILLEGAL SET OPERAND 
  
  
          SA1    FETADDR
          NG     X1,VBLFET         FET WILL BE FOUND AT RUN-TIME
  
          INCRAND 
          BX6    X1 
          SA6    ANDSTACK+B2
          OUTINS   SETB5FET        SET B5 TO FET ADDRESS
          DECRAND 
  
 VBLFET   BSS    0
  
          RJ     FETCH
  
          DECRAND 
  
          OUTINS   RJOSETF         GEN: CALL BASFSET
  
  
          JP     REPEAT 
* 
          EJECT 
          EJECT 
 LACTCLN  BSS    0
* 
*         BIT 58,WORD 1 OF THE CURRENT LABEL BLOCK IS NOW SET = 1 (TO 
*         CAUSE SPECIAL HANDLING DURING END-TIME LABEL CLEAN-UP)
          SA1    LABTEMP           ADDRESS OF LINE LABEL BLOCK
          SA2    F.LABS 
          IX1    X1+X2             ADDRESS OF FIRST WORD
          SA2    X1          LOAD FIRST WORD OF LABEL BLOCK 
          MX7    1
          LX7    59          SHIFT TO BIT 58
          BX7    X2+X7       SET FORMAT BIT ON
          MX3    22                CLEAR FOR-LINE FIELD                  BAS0022
          LX3    58                                                      BAS0022
          BX7    -X3*X7                                                  BAS0022
          SA2    ANDSTACK+B2       GET RELADDR OF IMAGE                  BAS0022
          SX2    X2                                                      BAS0022
          LX2    36                                                      BAS0022
          BX7    X7+X2             STORE IN FOR-LINE FIELD               BAS0022
          SA7    X1          RESET LABEL BLOCK ENTRY
          DECRAND 
* 
          EQ     REPEAT 
* 
*         CREATE LABEL OPERAND AND DUMP IN STACK
* 
 LBTOSTK  JP     0
          SA1    NEXTLAB
          SX6    X1-1 
          SA6    A1 
          SX7    B0 
          SA6    ANDSTACK-1+B2
          SA7    ANDSTACK+B2
          EQ     B0,B0,LBTOSTK
          EJECT 
* 
*  DATA 
* 
 SDACT1   SX7       1 
          SA7       DATAST
          JP        STACK1
* 
 LACTDAT  BSS       0 
          TESTAND   EQ,0,LACTDA2        SEE IF WE HAVE AN OPERAND 
          SA1       ANDSTACK+B2 
          SX6    B7 
          SA6    SVB7DT 
          UX1    X1,B6       EXTRACT KIND.
          SB6    B6-STKIND   IF NOT A STRING
          NZ     B6,BDATERR  IT AN ERROR. 
          SA1    QFLAG       CHECK IF QUOTED STRING.
          NZ     X1,LACTDA3  WAS QUOTED, GO SAVE IT.
          SA1    B2+ANDSTACK-1 GET ADDRESS OF SPW.
          SA2    F.CONS      GET BASE OF CONSTANTS. 
          IX1    X1+X2
          SA1    X1          GET SPW. 
          SB7    X1 
          SB7    B7+X2       EXTRACT ADDR OF STRING.
          SB5    DATFET      SET UP PSEUDO FET
          SX6    B7 
          SA6    B5+FETFRST 
          SA6    B5+FETIN 
          SA6    B5+FETOUT
          BX6    X6-X6
          SA6    COMRUNS     SET TO BYPASS THE SKIP_TO_EOL
          IFC    EQ,,"OS.NAME",SCOPE, 
          SA3    ASCII       SAVE ASCII 
          SX6    X3 
          SA6    DASCII 
          BX6    X6-X6
          SA6    ASCII       CLEAR ASCII FLAG 
          ENDIF 
          MX3    -18
          SX6    2
          LX1    24 
          BX3    -X3*X1      LENGTH OF STRING IN CHAR 
          SX2    10 
 LACTDA7  IX3    X3-X2
          NG     X3,LACTDA5 
          SX6    X6+1        INCREMENT WORD COUNT 
          EQ     LACTDA7
 LACTDA5 SX6    X6+B7 
          SA6    B5+FETLIMT 
          BX6    X6-X6       CLEAR X6 (REAL NUMBER) 
          SA2    B5+FETCHAR 
          SB7    X2+INPBUFF+1 
          SX1    IRENDB 
          BX3    X3-X3
* 
*   BASICON PERFORMS UNPACKING BEFORE CONVERSION
*   ENTRY CONDITION IS (B5) = FET ADDRESS 
*                       BUFFER IS EMPTY UPON ENTRY
* 
          RJ     BASICON     GET NUMBER 
          BX7    X7-X7
          SA7    SKIPEOL
          SX7    1
          SA7    COMRUNS       RESUME THE VALUE 
          IFC    EQ,,"OS.NAME",SCOPE, 
          SA3    ASCII       RESTORE ASCII
          SX7    X3 
          SA7    ASCII
          ENDIF 
          NG     X1,LACTDA3  NOT NUMBER 
          SA1    B7          IF WHOLE BUFFER NOT
          SX1    X1-IREOS 
          NZ     X1,LACTDA3  USED, NOT NUMBER.
          ADDWRD DATA,X6     SAVE THE NUMBER
 LACTDA3  BSS       0 
          SA1    SVB7DT 
          SB7    X1 
          SA1       B2+ANDSTACK-1 
          DECRAND 
          ADDWRD DATA,X1           ADD TO DATA TABLE
          SA5    BDAREFL           MARK DATA USED 
          PX6    X5,B1
          SA6    A5 
 LACTDA2  BSS       0 
          SA1       SACTEMP1
          SX6       LDAT
          SX1       X1-LXEOS
          NZ        X1,STACK1           SEPERATOR NE EOS
          JP        REPEAT
 SVB7DT   BSSZ   1
 DATFET   BSSZ   14 
          IFC    EQ,,"OS.NAME",SCOPE, 
 DASCII   BSSZ   1
          ENDIF 
          EJECT 
* 
*  RESTORE
* 
 LACTRES  BSS       0 
          SX1       X6-LXFIL
          BX5    X6                SAVE UNSTACK REASON
          SX6       LREW
          ZR        X1,SETFILE
          SX1    X5-LXPND          TRY FILE-RESTORE-POUND-SIGN
          ZR     X1,FINDFIL        EXIT IF IT IS
          BX6    X5                RESTORE UNSTACK REASON 
          OUTINS DTALOD            SA5;=XDATAXXX
          OUTINS DTARST            SA5;A5+1 
          OUTINS SX6X5             SX6  X5
          OUTINS  STOREDAT         SA6 =XDATAXXX
          JP        REPEAT
* 
 LACTREW  BSS       0                   RESTORE FILE
          INCRAND 
          SA1       FETADDR 
          NG     X1,RESFET         SKIP IF .LT. 0 (FILE WILL BE FIXED 
*                                  AT RUN-TIME) 
          BX6       X1
          SA6       ANDSTACK+B2 
          OUTINS    SETB5FET
 RESFET   BSS    0
          DECRAND 
          OUTINS    RJIREW              RJ BASIREW
          JP        REPEAT
          EJECT 
* 
*  NODATA 
* 
 LACTNOD  BSS       0                   UNSTACKED BY EOS OR FILE
          SX1       X6-LXFIL
          BX5    X6 
          SX6       LNO1
          ZR        X1,SETFILE          IT IS NODATA FILE 
          SX1    X5-LXPND          TRY FILE-NO-SIGN (POUND-SIGN)
          ZR     X1,FINDFIL        IF IT IS GO ANALYSE THE FILE NO
          BX6    X5                RESTORE THE UNSTACK REASON 
         LNCHECK   BILLLAB
          SA6       A2                  INTEGERIZE LABEL
          OUTINS  FETCHDAT         SAI =XDATAXXX  XI=DATAPTR
          SETVINX  SIMVINXW 
          OUTINS  FETCHDT1         SAI XI  XI=DATA ITEM 
          OUTINS    NODATJMP
          DECRAND 
          JP        REPEAT
* 
* 
* 
 LACTNO1  BSS       0                   NODATA FILE 
         LNCHECK   BILLLAB
          SA6       A2
          INCRAND 
          SA3       FETADDR 
          NG     X3,FRTNOD         SKIP IF FET WILL BE FOUND AT RUNTIME 
          BX6       X3
          SA6    ANDSTACK+B2       SET UP FET ADDRESS 
          OUTINS    SETB5FET            SB5 B4+ FET.REL.ADDR
 FRTNOD   BSS    0
          DECRAND 
          OUTINS    RJINOD
          OUTINS REGRES            RESERVE X5 
          OUTINS    NODATJMP
          DECRAND 
          JP        REPEAT
          EJECT 
* 
*  GOSUB
* 
 LACTGOS  BSS       0 
         LNCHECK   BILLLAB
         SA6       A2 
          INCRAND 
          SA1       NEXTLAB 
          SX6       X1-1
          SA6       ANDSTACK-1+B2       ANDSTACK[ANDPTR] .= 
          SA6       A1                  NEXTLAB .= NEXLAB - 1 
          OUTINS    SETB6LIM            SB6 GOSUBLIM
          OUTINS    SETX6RET            SX6 RETINFO 
          OUTINS  FETCHGOS         SAI =XGOSUBXX   XI=GOSUBPTR
          OUTINS  FETCHGS1         SB3 XI  RELEASE XI 
          OUTINS    TESTB3B6            GE  B3,B6,GOSUBERR
          OUTINS    STOREB23            SA6 B2+B3 
          OUTINS    INCREAB3            SB3 B3+1
          OUTINS  SX6GOSUB         SX6 B3 
          OUTINS  STOREGOS         SA6 =XGOSUBXX
          DECRAND 
          OUTINS    GOSUBJMP            EQ  LABEL 
          UPANDPTR
          OUTINS    LABELDEF            DEFINE RETINFO
          DECRAND 
          DECRAND 
          JP        REPEAT
* 
* 
*                JUMP 
* 
* 
 LACTJMP  BSS    0
          SA5    GOTOJUMP 
          BX7    X5 
          SA7    RELOPR 
          SA1    ANDSTACK+B2
          AX1    30 
          SX2    X1-INT            CHECK FOR INTEGER OPERAND
          ZR     X2,LACTGOT        JOIN -GOTO- IF SO
          SX2    X1-CONST          CHECK FOR CONSTANT 
          NZ     X2,LBLVBL         SKIP IF NOT
          SA1    ANDSTACK+B2-1     EXAMINE THE CONSTANT 
          NG     X1,BILLLAB        ERROR: NEGATIVE LABEL
          UX1    B6,X1
          LX1    B6,X1             TRUNCATE LABEL 
          PX7    B0,X1
          NX7    B6,X7
          SA7    A1                PUT IT BACK IN ANDSTACK
          SA1    ANDSTACK+B2
          MX0    30 
          BX1    -X0*X1            DROP -CLASS- BYTE
          SX7    INT               SET UP -INTEGER- CLASS 
          LX7    30 
          IX7    X1+X7             INSERT -INTEGER- CLASS 
          SA7    A1                SET MODIFIED DESCRIPTOR IN ANDSTACK
          EQ     LACTGOT           JOIN -GOTO- HANDLING 
* 
* 
*                LABEL IS VARIABLE (CHECKED AT RUN-TIME)
* 
* 
 LBLVBL   BSS    0
          RJ     FETCH             GEN:LOAD LABEL VALUE 
          DECRAND                  DROP LABEL OPD 
          OUTINS RJEJMP            GEN: CHECK-LABEL-AND-JUMP-TO-IT
          EQ     REPEAT 
* 
*                -ON- UNSTACKED BY -ERROR-
* 
* 
 ONERRST  BSS    0
          SX6    LONERGO           SET UP -GOTO- (ALSO ACTS FOR -THEN-) 
          JP     STACK1 
* 
* 
* 
*     UNSTACKED BY GOTO THEN EOS ELSE 
* 
 LACONEG  BSS    0
          SX7    B0 
          SA7    ONANDIF           CLEAR STATEMENT TYPE 
          SX1    X6-LXEOS          CHECK IF -EOS- CAUSED UNSTACK
          ZR     X1,ONERROR        SKIP IF SO (ITS A NULL -ON ERROR-) 
          SX1    X6-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X1,ONERROR    BR, -ELSE- DID UNSTACK THIS
*                                  (ELSE ITS -ONERROR THEN/GOTO-) 
          SX6    LONELBL
          EQ     STACK1 
* 
* 
 LAOELBL  BSS    0             UNSTACKED BY -EOS- -ELSE-
          SA1    ONATTN            IS THIS ON ATTN THEN/GOTO LN 
          ZR     X1,ONERR          BR, ON ERROR THEN/GOTO LN
          OUTINS RJATTN            ENABLE USER CONTROL OF T.I.
          MX7    0
          SA7    ONATTN            CLEAR ON ATTN FLAG 
          EQ     TRGLBL            GO GET TARGET LABEL
 ONERR    OUTINS RJERR             ENABLE USER ERROR HANDLING 
 TRGLBL   SA5    GOTOJUMP 
          BX7    X5 
          SA7    RELOPR 
          EQ     BTH0B
*                                  TARGET LABEL FOR ERRORS) 
* 
* 
 ONERROR  BSS    0
* 
*                NULL -ON ERROR- IE DISABLE USER ERROR HANDLING 
* 
* 
          TESTAND  NE,0,SERRORC    ERROR: SHOULD NOT HAVE AN OPERAND
* 
          SA1    ONATTN            IS THIS ON ATTENTION (EOS) 
          ZR     X1,ONERS          BR, ON ERROR (EOS) 
          OUTINS RJATNN            DISABLE USER T.I. HANDLING 
          MX7    0
          SA7    ONATTN            CLEAR ON ATTN FLAG 
          JP     REPEAT 
 ONERS    OUTINS RJERS             DISABLE USER ERROR CONTROL 
          JP     REPEAT 
* 
* 
          EJECT 
* 
* ON
* 
LACTONN   BSS       0 
          SX1    X6-LXERR 
          ZR     X1,ONERRST        SKIP IF -ERROR- CAUSED UNSTACK 
          RJ       FETCH
          RJ     RESERVE
          INCRAND 
          SETVINX FVINXWD 
          OUTINS BXIPZRO     BX4   X4-X4
          OUTINS PACKB0      PX4   X4 
          ARTHPAIR ROUNDADD  RX5   X5+X4
          OUTINS   UNPACK 
          OUTINS   LFTSHIFT 
          OUTINS   NGOUTR 
          OUTINS   ZROUTR 
          JP        REPEAT
* 
*  ON GO TO 
SGOACT1   BSS      0
          SB3       B3+TORINCR         STACK THE GOTO 
          SB5       LTORST
          GE        B3,B5,TOROVFL 
          SA1       LTOROUT+X6
          BX7       X1
          SA7       TORSTACK+B3 
          SA5    ONGSFL 
          NZ     X5,ONGS1 
          SX6       LOND
          JP        STACK1             GO STACK THE GOTO NODE 
* 
 ONGS1    BSS    0
          DECRAND           *GET RID OF EXPRESSION
          SX6    LONGS1 
          JP     STACK1 
* COMMA IN COMPUTED GO TO 
 LACTOND  BSS       0 
          OUTINS    SUB1
          LNCHECK   BILLLAB 
          SA6       A2
          OUTINS    ZRJUMP
          DECRAND 
          SA1       SACTEMP1
          SX1       X1-LXCOM
          SX6       LOND
          ZR        X1,STACK1          UNSTACKED BY COMMA 
          DECRAND 
          SX7    B0 
          SA7    ONANDIF           CLEAR STATEMENT TYPE 
          JP        REPEAT
          EJECT 
* 
*         ON GO TO AND ON GOSUB AT UNSTACK TIME 
* 
LACTONG   BSS       0 
          SA1    ONGSFL 
          NZ     X1,GS2 
          OUTINS OUTR 
          JP     REPEAT 
 GS2      BSS    0
          SX7    B0 
          SA7    ONGSFL 
          UPANDPTR                *LINE NUMBER
          UPANDPTR                *JUMP TABLE 
          UPANDPTR                *LAST LABEL 
          OUTINS LABELDEF         *IS NOW DEFINED 
          DECRAND 
          DECRAND 
          DECRAND 
          JP        REPEAT
* 
*         ON GOSUB ACTION UNSTACKED BY FIRST COMMA OR EOS 
* 
 LACTGS1  BSS    0
          OUTINS SETB6LIM 
          OUTINS  FETCHGOS         SAI =XGOSUBXX
          OUTINS  FETCHGS1         SB3 XI 
          OUTINS TESTB3B6 
          INCRAND                 * 
          RJ     LBTOSTK          * 
          OUTINS SETB6XPA 
          INCRAND                 *LAST LABEL 
          RJ     LBTOSTK          * 
          OUTINS SETX6RET         *ADDR IN X6 
          OUTINS SETB5X6          * 
          OUTINS TESTB6B5         * 
          OUTINS STOREB23         * 
          OUTINS INCREAB3         * 
          OUTINS  SX6GOSUB         SX6 B3 
          OUTINS  STOREGOS         SA6 =XGOSUBXX
          DECRAND                 *BACK TO JUMP TABLE LABEL 
          OUTINS LABELDEF         *DEFINE IT
          DECRAND                 *BACK TO LINE NUMBER
          OUTINS JUMPTOB6         *JUMP TO TABLE
 LACTGS2  BSS    0                *UNSTACKED BY COMMA 
          LNCHECK BILLLAB         * 
          SA6     A2
          OUTINS  GOSUBJMP        * 
          DECRAND                 * 
          SX6     LONGS2          * 
          SA1     SACTEMP1        * 
          SX1     X1-LXCOM        * 
          ZR      X1,STACK1       * 
          SX7     B0
          SA7     ONANDIF         * 
          JP     REPEAT 
          EJECT 
* 
*  RETURN 
* 
 LACTRET  BSS       0 
          OUTINS  FETCHGOS         SAI =XGOSUBXX
          OUTINS  FETCHGS1         SB3 XI 
          OUTINS    DECREAB3            SB3 B3-1
          OUTINS  SX6GOSUB         SX6 B3 
          OUTINS  STOREGOS         SA6 =XGOSUBXX
          INCRAND 
          OUTINS    FETCHB23            SA.I B2+B3
          SETVINX   SIMVINXW
          OUTINS    SETB6TOP            SB6  X.I
          OUTINS  RETERTST         NG B3,RETERR 
          OUTINS    JUMPTOB6            JP  B6
          DECRAND 
          JP        REPEAT
* 
*  STOP 
* 
 LACTSTO  BSS       0 
          OUTINS  RJERS            GEN: REVERT TO SYSTEM-ERROR-HANDLING 
          OUTINS    CLEARB7             SB7 B0+B0 
          OUTINS    CLLEGEN             EQ  BASEGEN 
          JP        REPEAT
          EJECT 
* 
*                CHANGE            UNSTACKED BY -TO-
* 
* 
 LACTCHG  BSS    0
          SX7    WERR1       SET OBSOLETE FORM
          SA7    WNSW 
          SA1    ANDSTACK+B2
          UX1    B5,X1
          SB6    SVKIND            -STRING VARIABLE-
          EQ     B5,B6,CHSV        SKIP IF ITS (CHANGE) STRING (TO VBL) 
          SB6    STKIND 
          EQ   B5,B6,CHSV 
          SB6    SIMKND            CHECK FOR SIMPLE 
          NE     B5,B6,BILLCHO     ERROR EXIT IF NOT
          AX1    30 
          SX1    X1-VINS           CHECK FOR CLASS = VINS 
          NZ     X1,BILLCHO        ERROR IF NOT 
* 
*                                  DEAL WITH: CHANGE VBL TO STRING
* 
* 
          RJ     GETARADR          ESTABLISH (FIND) AS ARRAY
* 
          SA1    ANDSTACK-1+B2
          MX2    59 
          MX3    42 
          BX6    X3*X1             DROP -DIM- BYTE
          IX6    X6-X2             FORCE -DIM- = 1
          SA6    A1 
* 
* 
          RJ     FETCH             GEN: LOAD DOPE ON ARRAY
* 
          RJ     CHECKDIM          CHECK SUBSCRIPT COUNT (SHLD BE = 1)
          SA1    ANDSTACK+B2
          MX7    57 
          BX1    -X7*X1 
          SX7    X1-5              CHECK IF X5 WILL HOLD R/T DOPE 
          ZR     X7,DOPINX5        SKIP IF YES
          OUTINS BX5XI             ELSE GEN: SWAP DOPE TO X5
* 
* 
DOPINX5   BSS    0
          DECRAND 
          SX6    LCHGS
          JP     STACK1 
* 
 LACTCHS  BSS    0             UNSTACKED BY -EOS- -ELSE-
          SA1    ANDSTACK+B2
          UX1    B5,X1
          SB6    SVKIND 
          NE     B5,B6,BILLCHO     ERROR IF NOT STRING VBL
* 
          AX1    30                CHECK CLASS
          SX2    X1-VINS           STR VAR OK 
          ZR   X2,CHS1
          SX2    X1-AINX1          SUBSCRIPTED STR VAR OK 
          ZR   X2,CHS1
          SA2    DEFFLAG           ALLOW SINS IN MULTILINE DEF
          ZR   X2,BILLCHO          NOT DEF
          SX2    X1-SINS
          NZ   X2,BILLCHO          ELSE ERROR 
 CHS1     BSS    0
* 
          RJ     FETCH             GEN: STRING FETCH
          OUTINS SB7AI             GEN: SET STRING ADDR IN B7 
          DECRAND 
* 
* 
          OUTINS RJOCVS            GEN: CALL CHANGE -VBL-TO-STRING
* 
          JP     REPEAT 
* 
* 
*                                  STATEMENT IS: CHANGE-STRING-TO-VBL-
* 
 CHSV     BSS    0
          RJ     FETCH             GEN: STRING FETCH
          OUTINS SB7AI             GEN: GET STRING ADDRESS TO B7
* 
          DECRAND 
          SX6    LCHGV
          JP     STACK1            GO GET ARRAY NAME
* 
 LACTCHV  BSS    0
*     UNSTACKED BY -EOS- -ELSE- 
          SA1    ANDSTACK+B2
          UX1    B5,X1
          SB6    SIMKND 
          NE     B5,B6,BILLCHO     ERROR IF NOT SIMPLE
* 
          AX1    30 
          SX1    X1-VINS
          NZ     X1,BILLCHO        ERROR IF WRONG CLASS 
* 
* 
          RJ     GETARADR          ESTABLISH ARRAY ADDRESS
          SA1    ANDSTACK-1+B2
          MX2    59 
          MX3    42 
          BX6    X3*X1             DROP -DIM- BYTE
          IX6    X6-X2             FORCE -DIM- = 1
          SA6    A1                FORCE SUBSCRIPT  COUNT OF 1
* 
* 
          RJ     FETCH             GEN: FETCH ARRAY DOPE
          RJ     CHECKDIM          CHECK SUBSCRIPT USAGE
          SA1    ANDSTACK+B2
          MX7    57 
          BX1    -X7*X1 
          SX7    X1-5              CHECK IF X5 WILL HOLD R/T DOPE 
          ZR     X7,DPINX5         SKIP IF YES
          OUTINS BX5XI             ELSE GEN: MOVE DOPE TO X5
* 
 DPINX5   BSS    0
          DECRAND 
          OUTINS RJOCSV            GEN: CALL CHANGE-STR-TO-VBL
          JP     REPEAT 
          EJECT 
* 
*  DIM AND ASSOCIATED OPERATORS 
* 
*     DIM 
* 
 LACTDIM  BSS       0                   UNSTACKED BY  (SUBSC
          RJ        GETARADR
          SA1       ANDSTACK-1+B2 
          MX0       1 
          AX1       30
          LX0       58
          SA2    F.IDS             START NAME 
          IX7    X2+X1             ADDRESS
          SA2    X7                ID ENTRY 
          BX7    X2                CHECK IF PREVIOUSLY IN DIM STMT
          LX7    2                 BIT 57 
          NG   X7,BILLDIM1         CANNOT REDIM 
          BX7       X0+X2               SET USEDIM BIT
          SA7       A2
          SX6       LLDI
          LX2    30          CHECK IF ALREADY APPEARED
          UX2    B5,X2
          GE     B0,B5,STACK1 
          SX7    WERR5       SET WARNING - DIM AFTER REFERENCE
          SA7    WNSW 
          JP        STACK1
* 
*     (DIM - LEFT DIM PARENTESIS
* 
 LACTLDI  BSS       0                   UNSTACKED BY , OR ) 
          SA1       ANDSTACK+B2 
          AX1       30
          SX1       X1-INT
          NZ        X1,BILLDIM          CLASS NOT INTEGER 
          SA1       ANDSTACK-1+B2       CONSTANT VALUE
          SA5    BASE 
          ZR     X5,ZERDIM         IF BASE = 1 THEN 
          ZR   X1,BILLDIM          DIMENSION ZERO IS BAD
 ZERDIM   BSS    0
         SA3       MAXDIMS              CHECK SIZE
         FX3       X3-X1
         NG        X3,BILLDIM 
          SA2    F.CONS            CONSTANT TABLE 
          DECRAND 
          SA3       ANDSTACK+B2         PTR TO DOPE INFO
          SA4       ANDSTACK-1+B2       NEW 
          MX5       59                  -1
          IX6       X4-X5 
          IX3       X3+X2 
         SA5       BASE             GET BASE OF ARRAYS
         UX5       B0,X5
         NZ        X5,BASONE        BRANCH IF BASE ONE
          SA5       NUMONE
         FX1       X1+X5
BASONE   SA6       A4 
         IX3       X3+X6       .INCREASE
         NX7       B0,X1
          SA7       X3                   TO CONSSTACK[DOPEPTR+NEW]
          SA1       SACTEMP1
          SX6       LLDI
          SX1       X1-LXCOM
          ZR        X1,STACK1           LXFIELD = COMMA 
          RJ        CHECKDIM
          DECRAND 
          SX6       LRDI
          JP        STACK1
* 
*     DIM) - RIGHT DIM PARENTESIS 
* 
 LACTRDI  BSS       0                   UNSTACKED BY , OR EOS 
          SX1       X6-LXEOS
          SX6       LDIM
          ZR        X1,REPEAT           LXFIELD = EOS 
          JP        STACK1
          EJECT 
* 
*  DEF - STATEMENT
* 
 LACTDEF  BSS       0                   UNSTACKED BY (FUN 
          SA1    DEFFLAG
          NZ  X1,BILLDEF1          *DEF WITHIN DEF* 
          SA1    INSTPTR
          SX6    X1 
          SA6    DEFSTRT
          INCRAND 
          SA1    SEQNO             FETCH DEF LINE NO. 
          BX6    X1                AND SAVE FOR CID SYMBOL TABLE
          SA6    BASFLN.           GENERATION IN BASOPTS
          SA1       ANDSTACK-ANDINCR+B2 
          BX6       X1
          SA6       ANDSTACK+B2         MOVE FUNCTION UP ONE
          DECRAND 
          SA1       NEXTLAB 
          SX6       X1-1
          SA6       A1
          SX7       0 
          SA6       ANDSTACK-1+B2       NOW ESTABLISH BY-PASS-LABEL 
          SA7       ANDSTACK+B2 
          OUTINS    GOTOJUMP            AND GENERATE BY-PASS-JUMP 
          UPANDPTR
          SX6    B0                RESET REDEFINITION FLAG
          SA6    REDEF
          SX4       B0                 DEFINITION FLAG
          RJ        DECLFUN 
          SA1       ANDSTACK+B2 
          SB6       X1
          LX1    1                 FN ORDINAL * 2 
          SA4    F.FUNS 
          IX3    X1+X4
          SA4    X3                DECLTABLE
          MX1    1                 SET DEFINED BIT
          BX6    X4+X1
          SA6    A4 
          SA1    A4+1              GET PREVIOUS XREF BITS FROM WORD2
          BX6    X1 
          SA2    REDEF
          ZR  X2,DEF1              SKIP IF NOT REDEFINITION 
          SX6    B0                REDEF, CLEAR PREVIOUS XREF BITS
 DEF1     SX2    1                 SET BIT FOR THIS FUN 
          LX2    B6,X2             B6 = FN ORDINAL
          BX6    X6+X2
          SA6    A1                STORE BACK IN TABLE WORD2
          OUTINS    LABELDEF            DEFINE LABEL FOR FUNCTION 
          OUTINS    ENTRYLIN            SET JP 0
          SA1    SACTEMP1 
          SX2    X1-LXEOS 
          ZR     X2,NOPARM
          SX2    X1-LXEQU 
          ZR     X2,NOPARM
          SX6       LLDE
          JP        STACK1
* 
 LACTLDE  BSS       0                   UNSTACKED BY )
*  OR UNSTACKED BY COMMA
          SX7    X6-LXRPA          SET MULTIARG FLAG
          SA7    ARGFLAG           NONZERO IF MULTI 
          SX6    B2-ANDINCR        SAVE POINTER TO FN ON STACK
          SA6    ARGPTR 
          SX6    -1                RESET FORMAL SAVEAREA PTR
          SA6    FORMPTR
* 
* 
 LACTCDE  BSS    0                 UNSTACKED BY COMMA OR )
*  COME HERE FOR EACH FORMAL PARAMETER
*  CHECK FORMAL VALIDITY
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX1       B6,X1 
          EQ  B5,B6,LDE2           FORMAL IS SIMPLE 
          SB5    SVKIND 
          NE  B5,B6,BILLFORM       FORMAL NOT STR VAR 
 LDE2     BSS    0
          LX1       30
          SX2       X1-VINS 
          NZ        X2,BILLFORM         FORMAL NOT V IN STACK 
          SA1    ARGFLAG           SKIP IF SINGLE ARG 
          ZR  X1,LDE1 
          OUTINS  INCREAA4         GEN - SA4 A4+1  OFFSET IN X4 
          OUTINS  FETCHPAR         GEN - SA5 B2+X4 PARAM IN X5
 LDE1     BSS    0
          SA1    ANDSTACK+B2       SAVE FORMAL DESCRIPTOR FOR FORMID RTN
          BX6    X1 
          SA6    ARGSAVE
          OUTINS    REGRES              RESERVE X5
          SA1    ANDSTACK+B2       SET CLASS VINX 
          UX1    B6,X1             B6=KIND
          SX1    VINX 
          LX1    30                X1=CLASS 
          SA2    REGSTPTR 
          SA2    X2+REGSTACK       X2=REGISTER NUMBER 
          BX6    X1+X2
          PX6    B6,X6
          SA6    ANDSTACK+B2
          SB5    SIMKND 
          EQ  B5,B6,LDE3           JUMP IF SIMPLE 
*                                  COPY STRING TO LOCAL STORAGE 
          OUTINS  SB7AI            GEN - SB7 A5  STR ADDR IN B7 
          OUTINS  RELEATOP         RELEASE X5 
          RJ  STMPLOC              X7 = ADDR OF 8 WD TEMP 
          SA1    ANDSTACK+B2       SET CLASS SINS WITH ADDR 
          UX1    B6,X1             B6 = KIND
          SX1    SINS 
          LX1    30                X1 = CLASS 
          BX7    X7+X1             X7 = ADDR
          PX7    B6,X7
          SA7    ANDSTACK+B2
          OUTINS SB6B2K 
          OUTINS  RJSTRST          GEN - RJ BASASTR  COPY STRING
          EQ  LDE4
 LDE3     BSS    0
          RJ  CLEAR                GEN - STORE PARAM TO TEMPLOC 
* 
 LDE4     BSS    0
*  SAVE IDTABLE INFO FOR THIS IDENTIFIER AND POINT
*  IDTABLE TO NEW LOCATION
*  FIRST SAVE IDTABLE DATA
          SA1    ARGSAVE           GET SAVED FORMAL DESCRIPTOR
          SX6    X1                EXTRACT POINTER INTO IDTABLE 
          SA2    FORMPTR           SCAN FOR DUPLICATE FORMAL
          NG  X2,FORMID2           SKIP IF NO PREVIOUS ONES 
          SB6    X2                B6 = LIMIT 
          SB5    B0                B5 = COUNT 
 FORMID1  SA2    FORMALS+B5        GET FORMAL ENTRY 
          AX2    18                EXTRACT IDTABLE PTR
          SX2    X2 
          BX3    X2-X6             COMPARE TO THIS FORMAL 
          ZR  X3,BILLFORM          BAD IF SAME
          SB5    B5+1 
          LE  B5,B6,FORMID1        LOOP 
 FORMID2  BSS    0
          SA1    F.IDS
          IX2    X1+X6
          SA1    X2                ID TABLE ENTRY 
          MX2    19                EXTRACT PART TO BE SAVED 
          LX2    18                ADDRESS(0-17) AND SIMPLE BIT(59) 
          BX3    X1*X2
          LX6    18                COMBINE DATA AND IDTABLE POINTER 
          BX6    X6+X3             SO WILL KNOW WHERE TO PUT IT BACK
          SA3    FORMPTR           SAVE IT IN FORMALS TABLE 
          SX7    X3+1              INCR TABLE PTR 
          SX3    X7-NUMFORM 
          ZR  X3,BILLFRML          *TOO MANY FORMALS* 
          SA6    FORMALS+X7        SAVE DATA
          SA7    FORMPTR           UPDATE PTR 
*  MODIFY IDTABLE TO POINT TO (TEMP) LOCATION OF FORMAL 
          MX2    41                EXTRACT IDTABLE DATA TO BE KEPT
          LX2    59 
          BX6    X2*X1
          MX2    1                 SET SIMPLE BIT (59)
          BX6    X6+X2             FORMAL IS SIMPLE 
          SA3    ANDSTACK+B2       GET FORMAL TEMP ADDR 
          SX3    X3 
          BX6    X6+X3             ADD TO ENTRY 
          SA6    A1                STORE BACK IN IDTABLE
* 
          SX6    LCDE 
          SA1    SACTEMP1          CHECK WHO UNSTACKED
          SX1    X1-LXCOM 
          ZR  X1,STACK1            JUMP IF COMMA
* 
*  FINISHED SCANNING FORMALS
*  CHECK FORMALS FOR TYPE AND NUMBER
          MX5    0                 INDICATE FN DEF
          RJ  PARAM                CHECK FOR MATCHING ARGS
* 
          SA1    ARGPTR            UNSTACK FORMALS
          SB2    X1 
          SX6       LRDE
          JP        STACK1
* 
 NOPARM   BX6    X6-X6       ZERO OUT ARGPTR
          SA6    ARGPTR 
          BX5    X5-X5       INDICATE IN DEF
          RJ     PARAM       CHECK ARGS(FOR NONE) 
          SA1    SACTEMP1 
          BX6    X1 
 LACTRDE  BSS       0                   UNSTACKED BY =
*  OR UNSTACKED BY EOS FOR MULTILINE DEF
          SA1    FORPTR            SET DEFPTR TO CURRENT FORPTR 
          BX7    X1 
          SA7    DEFPTR 
          SX7    1                 SET ONE-LINE DEF FLAG
          SA7    DEFFLAG
          SX1    X6-LXEOS          CHECK WHO UNSTACKED
          SX6    LDEE 
          NZ  X1,STACK1            NOT EOS, MUST HAVE BEEN =
*  UNSTACKED BY EOS, START OF MULTILINE DEF 
          MX6 1  SET MULTILINE DEF FLAG 
          SA6    DEFFLAG
          INCRAND                  STACK AN ENTRY FOR THE RESULT WORD 
          RJ  TEMPLOC              GET TEMPLOC TO SAVE B5 IN
          SA7    ANDSTACK+B2       X7 = ADDR
          OUTINS  SETX6B5          GEN - SX6 B5 
          OUTINS  STOREVAR         GEN - SA6 B2+ADDR
          SA1    ANDSTACK+B2-ANDINCR  GET FN DESCRIPTOR 
          SX1    X1-NUMBFUN/2      CHECK FOR STR FN (FNA$)
          NG  X1,RDE3              JUMP IF REAL 
          RJ  STMPLOC              X7 = ADDR OF 8 WD TEMP 
          SB6    SVKIND            B6 = KIND
          SX1    SINS 
          LX1    30                X1 = CLASS 
          BX7    X7+X1
          PX7    B6,X7
          SA7    ANDSTACK+B2       RESULT DESCRIPTOR IS SINS
          OUTINS SETX12K     GEN TO BRING ADDR OF FN PTR WD TO X1 
          OUTINS RJRSTR      GEN TO RJ BASRSTR (RETURN PRESENT USE OF FN) 
          EQ     RDE5 
 RDE3     BSS    0
          RJ  TEMPLOC              ADDR RETURNED IN X7
          SA1    SIMSINSW          SIMPLE, CLASS SINS 
          BX7    X7+X1
          SA7    ANDSTACK+B2
 RDE4     BSS    0
          OUTINS SETX6ZER          CODE TO SET RESULT ZERO AT ENTRY 
          OUTINS STOREVAR 
 RDE5     BSS    0
          SX7    B2                SET FORPTR TO TOP, 3 ITEMS KEPT
          SA7    FORPTR            ARE BYPASS, FNAME, RESULT
*  SET INACTIVE BIT FOR ALL LINE NUMBERS IN LABEL TABLE 
*  BIT 59 WORD2 OF ENTRY
 RDE1     BSS    0
          RJ  SRCHLAB              GET LABEL ENTRY ADDR IN B6 
          ZR     B6,REPEAT   EXIT IF NO MORE
          SA1    B6-B1             WORD 2 
          MX7    1
          NG  X1,RDE1              SKIP IF ALREADY INACTIVE 
          BX6    X1+X7             SET BIT 59 (INACTIVE BIT)
          SA6    A1 
          EQ  RDE1                 LOOP 
* 
 LACTDEE  BSS       0                   UNSTACKED BY EOS
          TESTAND  NE,(3*ANDINCR),BILLDEF 
          SA1       ANDSTACK+B2 
          SA2    ANDSTACK+B2-ANDINCR  CHECK RESULT KIND MATCHES FUN 
          UX1       B6,X1 
          SX2    X2-NUMBFUN/2 
          NG  X2,DEFEQU7           JUMP IF REAL FUN 
          SB5    SVKIND            STRING FUN 
          EQ  B5,B6,DEFEQU3        STR VAR RESULT OK
          SB5    STKIND 
          EQ  B5,B6,DEFEQU3        STR CON OK 
          SB5    SYSTKND
          EQ  B5,B6,DEFEQU3        SYS STR OK 
          EQ  BILLDEF 
 DEFEQU7  SB5    SIMKND 
          NE        B5,B6,BILLDEF       BODY OF FUN NOT SIMPLE
* 
* 
 DEFEQU3  BSS    0                 MULTILINE REJOINS HERE AFTER FNEND 
          RJ        FETCH 
          SA1    ANDSTACK+B2
          UX1    B6,X1             B6 = KIND
          SB5    SIMKND 
          NE  B5,B6,DEFEQU5        BYPASS IF NOT REAL 
          OUTINS    NORMTOX5
          EQ  DEFEQU6 
 DEFEQU5  BSS    0
          OUTINS  SX5AIMB2         GEN - SX5 AI-B2  OFFSET IN X5
          RJ  RESERVE 
 DEFEQU6  BSS    0
          DECRAND 
          SX6    B0                TURN OFF DEF FLAG
          SA6    DEFFLAG
          SA1       ANDSTACK+B2 
          LX1    1                 FN ORDINAL * 2 
          SA2    F.FUNS 
          SB5    X1+B1
          SA1    X2+B5             LIST OF FNS WHO CALLED US
          SX6    B0                CLEAR AREA TO BUILD REFS IN
          SA6    A1 
          SA2    ANDSTACK+B2-ANDINCR  FETCH LIST OF FNS WE CALLED 
          SB6    -1                B6 = FN ORDINAL
          SB5    NUMBFUN           B5 = LIMIT 
 DEFEQU1  BSS    0
          SB6    B6+1              NEXT FN ORDINAL
          EQ  B5,B6,DEFEQU2        EXIT IF LIMIT
          LX1    59                FIND NEXT FN THAT CALLED US
          PL  X1,DEFEQU1           LOOP UNTIL BIT SET 
          SX6    B6+B6             FN ORD*2 
          SA3    F.FUNS 
          IX6    X6+X3
          SA3    X6+B1             XREF OF CALLER 
          BX6    X3+X2             ADD LIST OF FNS WE CALLED TO 
          SA6    A3                ITS LIST SINCE IT CALLED US
          AX6    B6,X6             CHECK IF IT IS NOW RECURSIVE 
          LX6    59 
          NG  X6,UFUNLOOP 
          JP        DEFEQU1 
 DEFEQU2  BSS       0 
          OUTINS    GOTOJUMP            JUMP TO EXIT-LINE 
          DECRAND 
          OUTINS    LABELDEF            SET BY-PASS-LABEL 
          DECRAND 
          SA1    B2+ANDSTACK+ANDINCR*2  GET THE FUNCTION NUMBER 
          SA2    F.FUNS 
          LX1    1           POSITION FUNS OFFSET 
          IX1    X1+X2
          SA1    X1          PICK UP THE ENTRY FROM THE FUNS TABLE
          MX2    30 
          LX2    48 
          BX1    X1*X2       EXTRACT THE PARAMETERS 
          BX2    X2-X1       CHECK FOR NO PARM
          ZR     X2,BASDEF.+1 NO PARM, DONT RESET ID TABLE
*  RESET IDTABLE ENTRIES FOR FORMAL PARAMETERS
          SA1    FORMPTR           PTR TO LAST ENTRY SAVED
          SB5    X1 
          SB6    B0                COUNT=0  GOES 0-FORMPTR
 DEFEQU4  BSS    0
          SA1    SEQNO             FETCH FNEND LINE NO. 
          BX6    X1                AND SAVE FOR CID SYMBOL TABLE
          SA6    BASLLN.           GENERATION IN BASOPTS
          SA1    FORMALS+B6        GET A SAVED ENTRY
          BX2    X1                EXTRACT IDTABLE POINTER
          AX2    18 
          SX2    X2 
          SX4    X2                EXTRACT IDTABLE INDEX
          LX4    18                FOR CID SYMBOL TABLE GENERATION
          SA3    F.IDS
          IX2    X3+X2
          SA2    X2                IDTABLE ENTRY
          MX3    19                EXTRACT SAVED INFO TO BE RESTORED
          LX3    18                BITS 0-17, BIT 59
          BX1    X3*X1
          BX7    X3*X2             SAVE DEF LOCAL PARAM FOR 
          IX7    X7+X4             CID SYMBOL TABLE 
          MX3    41                REMOVE OLD INFO FROM IDTABLE ENTRY 
          LX3    59 
          BX6    X3*X2
          BX6    X6+X1             REPLACE WITH SAVED INFO
          SA6    A2                STORE BACK IN IDTABLE
          SA7    A1                SAVE LOCAL PARAM IN LOCAL BLOCK
          SB6    B6+1              INCR TO NEXT SAVED ENTRY 
          LE  B6,B5,DEFEQU4        LOOP IF MORE 
* 
 BASDEF.  JP     REPEAT            CID MODE RJ =XOPTDEF 
*                                  BUILT HERE BY BASOPTS
+         JP     REPEAT 
* 
* 
 LACTFND  BSS    0                 FNEND, UNSTACKED BY EOS
          SA1    DEFFLAG           ERROR IF NOT IN DEF
          ZR  X1,BILLDEF           TEMP *********** 
          TESTAND  NE,0,BILLDEF    CHECK STACK EMPTY
          SA5    SEQNO             SAVE FNEND LINE NUMBER 
          BX7    X5 
          SA7    FNENDSAV 
* 
 FNEND2   BSS    0
          SA1    DEFPTR            CHECK FOR *FOR W/O NEXT* WITHIN DEF
          SB5    X1+3*ANDINCR 
          EQ  B5,B2,FNEND1         JUMP IF TOP=FORPTR=DEFPTR+3*ANDINCR
          RJ  BENDCH6              ISSUE *FOR W/O NEXT* 
          EQ  FNEND2               CHECK FOR ANOTHER
* 
 FNEND1   BSS    0
          SA1    FNENDSAV          RESTORE FNEND LINENO 
          BX7    X1 
          SA7    SEQNO
          SA1    DEFPTR            RESTORE FORPTR AS BEFORE DEF 
          BX7    X1 
          SA7    FORPTR 
* 
*  RESET LABEL TABLE
*  SET DEF BIT FOR ACTIVE ENTRIES - THESE ARE THE ONES
*  IN THIS DEF. (BIT 58)
*  COPY DEF BIT (58) TO INACTIVE BIT (59) FOR ALL LABELS
*  THIS REACTIVATES MAINLINE LABELS BUT KEEPS DEF LABELS
*  INACTIVE 
* 
 FNEND3   BSS    0
          RJ  SRCHLAB              GET LABEL ENTRY ADDR IN B6 
          ZR  B6,FNEND4            JUMP IF DONE 
          SA1    B6-1              GET WORD2 OF ENTRY 
          BX2    X1                CHECK FOR POSSIBLE CONFLICT BIT (57) 
          LX2    2
          PL  X2,FNEND7            SKIP FI NO CONFLICT
          MX2    59                RESET BIT
          LX2    57 
          BX6    X2*X1
          SA6    A1                STORE BACK IN LABEL TABLE
          SA1    B6                GET WORD1
          AX1    36                EXTRACT SAVED LINENO OF CONFLICT 
          SX2    X1 
          EQ  FNEND8               GO ISSUE ERROR MSG 
 FNEND7   BSS    0
          NG  X1,FNEND5            JUMP IF INACTIVE 
*  ACTIVE LABEL ENTRY, IE LABEL IN THIS DEF 
*  IT MUST BE DEFINED OR ERROR
          SA2    B6                GET WORD1 OF ENTRY 
          NG  X2,FNEND6            JUMP IF DEFINED
 FNEND8   BSS    0
          SA1    SEQNO             SAVE FNEND LINE NUMBER 
          SX6    X2 
          SA6    A1                RESET LINE NUMBER
          BX6    X1 
          SA6    FNENDSAV 
          SX6    B6                SAVE POINTER TO LABEL ENTRY
          SA6    LABTEMP2 
          SA1    DBOPTION    BINARY REGARDLESS SW 
          LX1    2
          PL     X1,FNENDX   NOT SET
          SA1    XOPTION
          NZ     X1,FNEND10        IF RELOCATABLE BINARY
          SX6    B3          SAVE B3
          SX7    B7          AND B7 
          LX6    18 
          BX6    X6+X7
          SA1    DEFSTRT
          SA6    LABTEMP3 
          RJ     GETLINK     GET NEXT POS.LINK
 FNEND9   BSS    0
          SX2    B5 
          MX0    44 
          BX2    -X0*X2      DROP POS 
          IX2    X1-X2
          PL     X2,FNEND10  LINK .LT. DEFSTRT
          RJ     DLTLINK     DELETE FROM CHAIN
          EQ     FNEND9 
 FNEND10  BSS    0
          ZR     B5,FNEND11  END OF CHAIN 
          SA2    B6-1        GET WORD2 OF LABEL ENTRY 
          LX2    60-36       POSITION NAME LEFT 
          MX0    18 
          BX6    -X0*X2      CLEAR NAME 
          MX0    1
          BX6    X6+X0       SET TOP BIT IN NAME
          LX6    36          REPOSITION 
          SA6    A2          RESTORE
 FNEND11  BSS    0
          SA1    LABTEMP3 
          SB7    X1 
          AX1    18 
          SB3    X1 
 FNENDX   BSS    0
          RJERROR BERR102    * TRANSFER OUT OF DEF *
* 
          SA1    FNENDSAV          RESTORE FNEND LINENO 
          BX7    X1 
          SA7    SEQNO
          SA1    LABTEMP2    RESTORE LABEL ENTRY ADDRESS
          SA1    X1-1              GET WORD2 AGAIN
          EQ  FNEND5               DO NOT SET DEF BIT, NOT DEFINED IN DE
* 
 FNEND6   MX7    1
          LX7    59 
          BX1    X1+X7             SET DEF BIT (58) 
* 
 FNEND5   MX7    1
          LX7    59                HERE FOR ALL LABELS
*                                  ACTIVE OR NOT
          BX6    X7*X1             COPY BIT 58 TO BIT 59
          LX6    1
          MX3    1
          BX1    -X3*X1 
          BX6    X6+X1
          SA6    A1                STORE BACK IN LABEL TABLE
          EQ  FNEND3               LOOP FOR NEXT LABEL
* 
 FNEND4   BSS    0                 DONE WITH LABELS 
*  GEN CODE TO RESTORE B5 
          SA1    ANDSTACK+B2       GET ADDR OF RESULT 
          SX7    X1-1              X7 = ADDR OF SAVED B5
          INCRAND 
          SA7    ANDSTACK+B2
          OUTINS  FETCHVAR         GEN - SA5 B2+ADDR
          OUTINS  SETB5X5          GEN - SB5 X5 
          OUTINS  RELEATOP         RELEASE X5 
          DECRAND 
          JP  DEFEQU3              FINISH AT LACTDEE AS FOR 1-LINE FNS
* 
*    TOROUT ROUTINE FOR USER FUNCTION - STACK BY BUSEFUN
* 
*         IF UNSTACKED BY = OR ( OR IF TOP OF TORSTACK IF LTDEF 
*           GOTO REPEAT 
*         ELSE
*           GENERATE FUNCTION REFERENCE FOR FUNCTION WITH NO PARMS
* 
 LACTNPF  BSS    0
          SA1    ANDSTACK+B2 TOP OF ANDSTACK
          UX1    B6,X1       SHOULD BE A FUNCTION.
          SB6    B6-UFKIND
          NZ     B6,REPEAT
          SA1    BMAINSIN    PICK UP UNSTACKING TORIN.
          UX1    B0,X1
          LX1    21          EXTRACT TOROUT OFFSET. 
          SX2    X1-LLFN     IF LLFN(LEFT PAREN AFTER FN) 
          ZR     X2,REPEAT   CONTINUE UNSTACKING. 
          SA1    TORSTACK+B3 IF THE TOP OF THE
          SX1    X1-LACTDEF  TORSTACK IS A DEF
          ZR     X1,REPEAT   CONTINUE UNSTACKING. 
          BX6    X6-X6
          SA6    ARGPTR 
          BX5    X5-X5
          RJ     PARAM       CHECK NO OF PARMS
          RJ     CLEAR
          RJ     RESERVE
          EQ     LFN5 
* 
* 
* 
 PARAM    DATA   0
*  SUBROUTINE TO SCAN PARAMETER LIST ON STACK AND BUILD 
*  DESCRIPTOR INDICATING NUMBER OF PARAMS AND TYPE OF EACH. 
*  DESCRIPTOR IS STORED IN BITS 18-47 OF WORD1 OF FUN DICT ENTRY. 
*  FORMAT IS (12/0),6/COUNT,24/BITS,(18/0)  BIT 18 = PARAM1,
*  BIT 19 = PARAM2 ...    BIT IS 0 FOR REAL, 1 FOR STRING.
* 
          SA1    ARGPTR            PTR TO FN ON STACK 
          NZ     X1,PARAM6   JUMP IF NOPARM 
          SA1    ANDSTACK+B2
          MX6    30          NOPARM INDICATOR 
          LX6    48 
          EQ     PARAM7 
 PARAM6   BSS    0
          SX1    X1+ANDINCR        POINT TO FIRST PARAM 
          SX2    B2                LAST PARAM IS TOP
          SB5    SIMKND 
          SX6    B0                X6 = BIT STRING
          SX7    B0                X7 = COUNT 
          SX4    1                 CONSTANT 
 PARAM1   SA3    ANDSTACK+X1       GET PARAM DESCRIPTOR 
          UX3    B6,X3             B6 = KIND
          MX3    0
          EQ  B5,B6,PARAM2         JUMP IF SIMPLE 
          SX3    X4                SET BIT ON FOR STRING
 PARAM2   LX6    59                ADD BIT TO BIT STRING
          BX6    X6+X3
          IX7    X7+X4             INCR COUNT 
          IX3    X1-X2             CHECK IF AT TOP
          ZR  X3,PARAM3            JUMP IF DONE 
          SX1    X1+ANDINCR        POINT TO NEXT PARAM
          EQ  PARAM1               LOOP 
 PARAM3   SB6    X7-1              RIGHT JUSTIFY BITS 
          LX6    B6,X6
          LX7    42                POSITION COUNT 
          LX6    18                POSITION BITS
          BX6    X6+X7             COMBINE
          SA1    ARGPTR            GET FN DESCRIPTOR
          SA1    ANDSTACK+X1
 PARAM7   BSS    0
          LX1    1                 FN ORDINAL * 2 
          SA2    F.FUNS 
          IX7    X2+X1
          SA1    X7                PARAMETER DESCRIPTION
          MX7    30                EXTRACT DESC 
          LX7    48 
          BX2    X7*X1
          NZ  X2,PARAM4            JUMP IF ONE ALREADY EXISTS 
          BX6    X6+X1             STORE PARAM DESC 
          SA6    A1                FIRST USE OF FN, STORE PARAM DESC
          EQ  PARAM 
 PARAM4   BX2    X6-X2             COMPARE NEW DESC TO OLD
          ZR  X2,PARAM             EXIT IF MATCH
          NZ  X5,PARAM5            BYPASS IF FN REFERENCE 
          BX1    -X7*X1            DROP OLD DESC
          BX6    X6+X1             ADD NEW
          SA6    A1                FN DEF, REDEFINE THE ARGS
          SA1    REDEF
          NZ  X1,PARAM             NO ERROR IF FN REDEFINITION
 PARAM5   RJERROR  BERR106         *PARAMETER LIST CONFLICT*
          EQ  PARAM                RETURN 
* 
* 
* 
 DEFSTRT  DATA   0
 DEFFLAG  DATA   0                 MULTILINE DEF FLAG 
 DEFPTR   DATA   0                 TOP OF STACK AT START OF DEF 
 NUMFORM  EQU    20                MAX NO OF FORMALS
 FORMPTR  DATA   -1                POINTS TO LAST USED FORMALS ENTRY
 FORMALS  BSS    NUMFORM           SAVE IDTABLE DATA IN THIS AREA 
 FNENDSAV BSS    1                 SAVE FNEND LINENO HERE 
 REDEF    BSS    1                 NONZERO FOR FN REDEFINITION
 BASFLN.  BSSZ   1                 USER DEF FLN FOR CID 
 BASLLN.  BSSZ   1                 USER DEF LLN FOR CID 
          EJECT 
**
*     BASE STATEMENT
*          UNSTACTED BY EOS 
*          ACTION  -CHECK TO SEE IF ANY ARRAY HAS BEEN EXPLICITLY 
*                   OR IMPLICITLY DEFINED 
*                  -CHECK FOR LEGAL BASE
*                  -CHANGE BASE TO VALUE FROM ANDSTACK
* 
LACTBAS  BSS       0
          SA5    OPTFLG            CK OPTION STATEMENT FLAG 
          NG     X5,OPTBAS         BYPASS WARNING IF -OPTION BASE- STMT 
          SX7    WERR1             SET OBSOLETE FORM WARNING SWITCH 
          SA7    WNSW 
          EQ     BASARR            CONTINUE WITH BASE PROCESSING
 OPTBAS   MX7    0
          SA7    OPTFLG            CLEAR OPTION STATEMENT FLAG
 BASARR   BSS    0
         SB6       NUMARR           NUMBER OF ARRAYS
          SA5    F.IDS
          SA5    X5                START OF ID TABLE
BASLP    LX5       1                SHIFT ARRAY BIT TO SIGN POSITION
         NG        X5,BASE1         ID HAS BEEN USED AS ARRAY GOTO BASE1
         SB6       B6-1             DECREMENT 
         EQ        B6,B0,BASLPE     EXIT FROM LOOP
         SA5       A5+1      .GET NEXT ID 
         EQ        BASLP            LOOP
BASLPE   SA4       ANDSTACK+B2      GET OPERAND  DESCRIPTOR 
         AX4       30               INTEGER TEST  TEST FOR KIND 0 
         SX4     X4-INT      TEST IF INTEGER
         NZ        X4,BASE2         IE TEST IF CLASS 0,INTEGER KIND 
         SA4       B2+ANDSTACK-1    GET VALUE FROM STACK (FP FORM)
         NG        X4,BASE2         CHECK IF BASE LT 0
         SA5      NUMONE
         FX5       X4-X5
         UX5       B0,X5
         ZR        X5,BASECHG 
         PL        X5,BASE2   TEST IF BASE TOO LARGE
BASECHG  BSS       0
          SA1    BASDEF 
          NZ     X1,BASE3 
          SX6    X1+1 
          SA6    A1 
         BX6       X4 
         SA6       BASE             STORE BASE AWAY 
         DECRAND
          SA1    SACTEMP1 
          SX6    LOPT 
          SX1    X1-LXCOM 
          ZR     X1,STACK1
         JP         REPEAT
BASE     BSS            1 
* OPTION STATEMENT
*   CAN BE FOLLOWED BY BASE OR COLLATE
*   THIS ROUTINE USED BY BOTH OPTION AND COLLATE
 LACTCLT  BSS    0
          MX6    1
          SA6    OPTFLG            SET OPTION STATEMENT FLAG
          SA1    BMAINSIN    GET THE TORIN ENTRY
          UX6    B0,X1       CLEAR THE PRIORITY 
          LX6    21          MOVE OFFSET TO LOW ORDER 
          EQ     STACK1      GO STACK IT
 OPTFLG   BSSZ   1                 OPTION STATEMENT FLAG
* 
* OPTION COLLATE STANDARD 
*    SET THE COLLATE FLAG 
* 
 LACTSTD  BSS    0
          SA1    COLLATE     CHECK THE COLLATE FLAG 
          SX1    X1-1 
          ZR     X1,LACTSTD2
          RJERROR BERR116    IF ITS BEEN SET ITS AN ERROR 
          EQ     LACTSTD3 
 LACTSTD2 SX6    2           SET THE COLLATE FLAG 
          SA6    COLLATE
 LACTSTD3 SX6    LOPT 
          SA1    SACTEMP1 
          SX1    X1-LXCOM 
          ZR     X1,STACK1   IF UNSTACKED BY COMMA GO STACK AN LOPT 
          EQ     REPEAT      CONTINUE UNSTACKING
* 
*  OPTION COLLATE NATIVE
* 
 LACTNAT  SA1    COLLATE     CHECK THE COLLATE FLAG 
          SX1    X1-1 
          ZR     X1,LACTNAT2
          RJERROR BERR116    IF ITS BEEN SET THEN WE HAVE AN ERROR
          EQ     LACTNAT3 
 LACTNAT2 IX6    X6-X6
          SA6    COLLATE
 LACTNAT3 SX6    LOPT 
          SA1    SACTEMP1 
          SX1    X1-LXCOM 
          ZR     X1,STACK1
          EQ     REPEAT 
 BASDEF   BSSZ   1
         EJECT
* 
*  IF-STATEMENT 
* 
 LACTIFX  BSS    0
          MX7    59 
          SA7    IFONFLG     TURN IF STATEMENT FLAG ON
          EQ     REPEAT 
* 
* 
 LACTEQU  BSS       0                   = 
          SX7    1
          SA7    STREL             SAVE RELATION--EQU-- 
          SA1    ANDSTACK-ANDINCR+B2
          UX1    B5,X1
          SB6    SVKIND 
          EQ     B5,B6,LACTSTR
          SB6    SYSTKND
          EQ     B5,B6,LACTSTR
          SB6    STKIND 
          EQ     B5,B6,LACTSTR
          SA1    ANDSTACK+B2
          UX1    B5,X1
          SB6    SIMKND 
          NE     B5,B6,BILLCOM         OBJECT NOT SIMPLE
          ARTHPAIR  FLOATSUB
          OUTINS    UNPACK
          SA1       EQUALJMP
          EQ     LIF1              COMMON CLEAN UP
* 
 LACTSTR  BSS       0                  STRING COMPARISON
          SA1       ANDSTACK+B2 
          UX1       B5,X1 
          SB6       SVKIND
          EQ        B5,B6,LACTSTR1
          SB6    SYSTKND           SYSTEM STRING (CLOCK ETC)
          EQ     B5,B6,LACTSTR1 
          SB6       STKIND
          NE        B5,B6,BILLCOM      OBJECT NOT STRING
 LACTSTR1 BSS    0
          RJ     CLEAR
          SB2    B2-ANDINCR 
          RJ        FETCH              SUBJECT
          SB2       B2+ANDINCR
          RJ        FETCH              OBJECT 
          DECRAND 
          SA2    ANDSTACK+B2
          MX7    57 
          SB6    RELTAB 
          BX7    -X7*X2 
          SX2    X7-5 
+         ZR     X2,*+1      SUBJECT IN X5
          SB6    RELTABR     REVERSE RELATION 
          DECRAND 
          SA1       STREL 
          SX1       X1-LXEQU
          SA1    X1+B6
          SA2       SETB6LIM
          MX0       18
          LX2       12
          BX2       -X0*X2
          LX1       42
          BX7       X1+X2 
          LX7       48
          SA7       SBINSTR            SB6   RELATION 
          OUTINS    SBINSTR 
          OUTINS    RJSTRCM 
          INCRAND 
          RJ     RELEASE
          SETVINX   LOGVINXW
          SA1    NOTEQJMP 
          BX7       X1
          SA7       RELOPR
          SX7    1
          SA7    LOGSW
          EQ     REPEAT 
* 
* 
 LACTGTH  BSS       0                   > 
          SX6    1           SET THE SWITCH FLAG
          SA6    OPRNDSW
          SA1       ANDSTACK+B2         EXCHANGE
          SA2       ANDSTACK-1+B2 
          SA3       ANDSTACK-ANDINCR+B2 
          SA4       ANDSTACK-ANDINCR-1+B2 
          BX6       X1
          LX7       X2
          SA6       A3
          SA7       A4
          BX6       X3
          LX7       X4
          SA6       A1
          SA7       A2
* 
 LACTLTH  BSS       0                   < 
          SX7    2
          SA7    STREL             SAVE RELATION--GTH-- 
          SA1    ANDSTACK-ANDINCR+B2
          UX1    B5,X1
          SB6    SVKIND 
          EQ     B5,B6,LACTSTR
          SB6    SYSTKND
          EQ     B5,B6,LACTSTR
          SB6    STKIND 
          EQ     B5,B6,LACTSTR
          ARTHPAIR  FLOATSUB
          SA1       MINUSJMP
 LIF1     BX7    X1 
          SA7       RELOPR
          SA1    LOGSW
          NZ     X1,LOG1
          SA1    SACTEMP1 
          NZ     X1,LOG 
          DECRAND 
          EQ     REPEAT 
* 
 LACTLTE  BSS       0                   @ 
          SX6    1           SET THE SWITCH FLAG
          SA6    OPRNDSW
          SA1       ANDSTACK+B2         EXCHANGE
          SA2       ANDSTACK-1+B2 
          SA3       ANDSTACK-ANDINCR+B2 
          SA4       ANDSTACK-ANDINCR-1+B2 
          BX6       X1
          LX7       X2
          SA6       A3
          SA7       A4
          BX6       X3
          LX7       X4
          SA6       A1
          SA7       A2
* 
 LACTGTE  BSS       0                   \ 
          SX7    5
          SA7    STREL             SAVE RELATION--LTH-- 
          SA1    ANDSTACK-ANDINCR+B2
          UX1    B5,X1
          SB6    SVKIND 
          EQ     B5,B6,LACTSTR
          SB6    SYSTKND
          EQ     B5,B6,LACTSTR
          SB6    STKIND 
          EQ     B5,B6,LACTSTR
          ARTHPAIR  FLOATSUB
          SA1       PLUSJUMP
          EQ     LIF1              COMMON END 
* 
 LACTNEQ  BSS       0                   NOT=
          SX7    6
          SA7    STREL             SAVE RELATION--NEQ-- 
          SA1    ANDSTACK-ANDINCR+B2
          UX1    B5,X1
          SB6    SVKIND 
          EQ     B5,B6,LACTSTR
          SB6    SYSTKND
          EQ     B5,B6,LACTSTR
          SB6    STKIND 
          EQ     B5,B6,LACTSTR
          ARTHPAIR  FLOATSUB
          OUTINS    UNPACK
          SA1       NOTEQJMP
          EQ     LIF1 
* 
* 
 LOG      BSS    0
          SX7    1
          SA7    LOGSW
 LOG1     BSS    0
          OUTINS SB6POS 
          INCRAND 
          SA1    NEXTLAB
          SX6    X1-1 
          SA6    A1 
          SA6    ANDSTACK-1+B2     ESTABLISH LABEL
          SX7    B0 
          SA7    ANDSTACK+B2
          OUTINS RELOPR 
          OUTINS SB6ZRO 
          OUTINS LABELDEF 
          DECRAND 
          OUTINS SXIB6
          OUTINS REGRES 
          SETVINX   LOGVINXW
          SA1    NOTEQJMP 
          BX7    X1 
          SA7    RELOPR 
          EQ     REPEAT 
OPRNDSW   BSSZ   1           FLAG INDICATES OPERANDS HAVE BEEN SWITCHED 
          EJECT 
 LACTTHE  BSS    0             TOROUT OF -THEN- OR -GOTO- 
*     TEST ARE WE WITHIN A GLOBAL IF STATEMENT
          SA1    GLBLIFR
          NZ     X1,BE110919   BR, WITHIN GLOBAL -IF R -- 
* 
*     FALL THRU CONTEXT MUST BE -LN EOS GOTO...-
*     VERIFY ASSUMED CONTEXT
          SX1    X6-LXEOS      DID -EOS- UNSTACK THIS?
          NZ     X1,SERRORB    BR, ILLEGAL STATEMENT
          NZ     B3,SERRORB 
          EQ     BTH0A
* 
 BE110919 BSS    0
*     HERE BECAUSE WITHIN GLOBAL -IF R--
*     MUST BE ONE OF
*     -IF R THEN......- OR -IF R THEN GOTO....- 
*     OR -IF R ....ELSE GOTO...-
* 
*     SET BYPASGO FLAG TO OFF 
          MX7    0
          SA7    BYPASGO       CLEAR FLAG 
*     REGS ASSUMED AVAILABLE X0 THRU X5,X7
*     B1 THRU B4 IN USE 
*     X6 CONTAINS LXFIELD OF CURRENT TORIN I.E. SUBCLASS
* 
*     TEST ARE WE WITHIN A LOCAL -IF- STATEMENT.
          SA1    ONANDIF
          ZR     X1,BE021405   BR, NOT WITHIN A LOCAL -IF R-
* 
*     CONTEXT MUST BE -IF R THEN/GOTO....-
* 
*     TURN ONANDIF OFF
          SX7    0
          SA7    ONANDIF       ONANDIF TURNED OFF 
* 
* 
* 
          SX1    X6-LXEOS      DID EOS UNSTACK THIS?
          NZ     X1,BTH1       BRANCH IF EOS DID NOT UNSTACK
* 
*     CONTEXT FOR FALL THRU MUST BE -IF R THEN/GOTO LN EOS- 
* 
 BTH0A    BSS    0
*     CONTEXT FOR THIS BRANCH IN IS -LN EOS GOTO LN EOS-
* 
 BTH0     BSS    0
*     CONTEXT FOR THIS BRANCH IN IS (WE ARE ON TERM IN ()): 
*     -IF R THEN (GOTO) LN EOS- 
*     OR -IF R .....ELSE (GOTO) LN EOS- 
*     OR -IF R THEN (GOTO) LN ELSE...-
*     OR -IF R ....ELSE (GOTO) LN ELSE...-
* 
* 
 BTH0B    BSS    0           COME HERE FOR ON ERROR GOTO
          LNCHECK BILLLAB 
          SA6    A2            SET LINE NO IN WORD 2 OF ANDSTACK ENTRY
*     CHECK IF RELOPR INITIALIZED 
          SA1    RELOPR 
          SX1    X1            ISOLATE LOW 30 BITS
          ZR     X1,BILLLAB    BAD RELOPR 
*     GENERATE JUMP ON TRUE RELATION TO LINE NUMBER IN THE
*     CASE OF -IF R THEN....- 
          OUTINS RELOPR 
*     DROP LINE NUMBER FROM ANDSTACK
          DECRAND 
*     CLEAR LOGSW 
          MX7    0
          SA7    LOGSW         LOGSW SET TO ZEROES
*     THIS ENDS THEN TOROUT PROCESSING OF SIMPLE
*     IF STATEMENT OF THE FORM -IF R THEN/GOTO LN EOS-
          JP     REPEAT 
* 
 BE021405 BSS    0
*     HERE BECAUSE WE ARE WITHIN A GLOBAL -IF- BUT NOT
*     WITHIN A LOCAL -IF-.
*     MUST BE ON THE TERM ENCLOSED IN () IN FOLLOWING-
*     OR -IF R THEN (GOTO) ....-
*     -IF R...ELSE (GOTO) ....- 
* 
*     TEST UNSTACKING REASON
          SX1    X6-LXEOS      DID -EOS- UNSTACK THIS?
          ZR     X1,BE021425   BR, -EOS- DID UNSTACK THIS 
* 
*     CONTEXT MUST BE -..ELSE (GOTO) LN ELSE...-
*     OR -...THEN (GOTO)LN ELSE...- 
          SX1    X6-LXELS      DID -ELSE- UNSTACK THIS? 
          NZ     X1,BILLIF     BR, ILLEGAL STATEMENT
          MX7    1
          SA7    BYPASGO       TURN BYPASGO ON
*     FALL THRU CONTEXT IS -IF R ....ELSE (GOTO) LN ELSE...-
*     OR -...IF R THEN (GOTO) LN ELSE...- 
 BE021425 BSS    0
*     BRANCH IN CONTEXT IS -...IF R THEN (GOTO) LN EOS- 
*     OR -.....IF R...ELSE GOTO LN EOS- 
          EQ     BTH0 
* 
 BTH1     BSS    0
*     HERE BECAUSE EOS DID NOT UNSTACK THIS TOROUT; THEREFORE 
*     WE ARE PROCESSING A COMPLEX FORM OF IF STATMENT I.E. ONE
*     THAT REQUIRES THAT THE JUMP ON TRUE CONDITION OF THE
*     RELATIONAL EXPRESSION BE CONVERTED TO A JUMP ON THE FALSE 
*     CONDITION OF THE RELATIONAL.
*     FOR EXAMPLE-
*        IF R (X) THEN STATEMENT (Y) .... 
*     IN THE ABOVE CASE IF R IS FALSE WE MUST JUMP FROM 
*     POINT (X) TO POINT (Y), OTHERWISE FALL THRU TO
*     STATEMENT AFTER -THEN-. 
* 
*     CONTEXT POSSIBILITIES ARE (WE ARE ON THE TERM IN ()): 
*     -IF R (THEN) GOTO....- OR -IF R (THEN) VERB....-
*         OR -IF R (THEN) VAR = ....- 
*         OR -IF R (THEN) LN ELSE ....- 
*  NOTE - VAR MAY BE A SIMPLE OPERAND, A SUBSCRIPTED
*  OPERAND, OR SUBSTR(..
* 
* 
          SA1    SACTEMP1 
          SX6    X1-LXELS      DID -ELSE- UNSTACK THIS? 
          NZ     X6,BTH3       BRANCH -ELSE- DID NOT UNSTACK IT 
* 
*     -ELSE- DID UNSTACK THIS. THEREFORE WE EXPECT WE ARE PROCESSING
*     STATEMENT OF THE FORM -IF R THEN LN ELSE...-
* 
*     VERIFY GOOD LINE NUMBER AT TOP OF ANDSTACK. 
*     SET BYPASGO FLAG SO TORIN OF -ELSE- WILL NOT
*     GENERATE AN UNNECESSARY JUMP TO EOS.
*     CHANGE JUMP IN RELOPR TO JUMP ON FALSE CONDITION. 
*     ACQUIRE A FORWARD LABEL AND GENERATE FALSE JUMP TO IT.
* 
*     CHECK VALID LINE NUMBER AT TOP OF ANDSTACK
          LNCHECK BILLLAB 
          SA6    A2            INTEGRIZED LINE NUNMBER STORED WD 2 ANDSTACK 
*     SET BYPASGO FLAG
          MX7    1
          SA7    BYPASGO       BYPASGO SET TO 1 
*     CONVERT TRUE JUMP IN RELOPR TO FALSE JUMP 
          RJ CVRTJMP
*     ACQUIRE FORWARD LABEL, STACK IT AT TOP OF FORSTACK, GENERATE
*     FALSE JUMP TO FORWARD LABEL. THIS WILL DEFINED AT TORIN OF -ELSE-.
          RJ     FWDJUMP
* 
*     AT EXECUTION TIME,
*     IF RELATIONAL CONDITION IS TRUE, CONTROL FALLS THRU TO A -GOTO LN-. 
*     GENERATE THE -GOTO LN-
          SA1    GOTOJUMP      FETCH INSTRUCTION PROTOTYPE
          RJ     OUTINS 
* 
*     DROP THE ANDSTACK ENTRY FOR LN
          DECRAND 
* 
          EQ     B0,B0,REPEAT 
* 
 BTH3     BSS    0
*     HERE BECAUSE UNSTACKING REASON IS NOT -EOS- OR -ELSE- 
*     CONTEXT MUST BE (WE ARE ON TERM IN()):  
*     -IF R (THEN) GOTO..-
*         -IF R (THEN) VAR = ....-
*         -IF R (THEN) VERB ...-
* 
*     THE WORD -GOTO- CANNOT BE A SUBSTITUTE FOR -THEN- 
*     IN THE ABOVE CONTEXTS. WE CHECK TO ENSURE 
          SA1    THENGO        FETCH -THEN/GOTO- SYNTAX FLAG
          NZ     X1,BILLIF     BR, IT WAS -GOTO-, ILLEGAL 
* 
* 
*     TEST FURTHER FOR UNSTACKING REASON
*     WE TEST AGAINST THE READ SYMBOL THAT CAUSES UNSTACKING BECAUSE
*     THE LXFIELD OF THE TORIN IS NOT UNIQUE
          SA1    NS      FETCH READ SYMBOL
          SB5    X1-LVEQU      WAS IT -=-?
          NE     B0,B5,BD011223    BR,-=- DID NOT UNSTACK THIS
* 
*     = UNSTACKED THIS TOROUT.
*         ASSUME -IF R THEN UNSUBSCRIPTED VAR = ...-
* 
 BD011223 BSS    0
*     HERE BECAUSE UNSTACK REASON NOT -EOS- -ELSE- -=-
*     CONTEXT MUST BE (WE ARE ON TERM IN()):  
*     -IF R (THEN) GOTO ...- OR -IF R (THEN) VERB..-
*         OR -IF R (THEN) OPERAND(...-
* 
*     TEST IF UNSTACK REASON IS MEMBER OF SET OF VERBS
*     THAT SHOULD NOT APPEAR FOLLOWING -THEN- IN
*     -IF R THEN ...- STATEMENT; OR FOLLOWING -GOTO- IN -IF R GOTO...-. 
          RJ     SYNCHK 
 BD011440 BSS    0
*     CONTEXT POSSIBILITIES ARE 
*         -IF R (THEN) VAR = ....-
*     -IF R (THEN) GOTO...- 
*     -IF R (THEN) VERB....-
*     WE ARE ON THE TERM WITHIN ()
* 
*     CONVERT JUMP PROTO TO ITS OPPOSITE
          RJ     CVRTJMP
*     ACQUIRE A FORWARD LABEL, GENERATE JUMP TO LABEL, STACK LABEL ON 
*     TOP OF FORSTACK 
*     NOTE - STACK MAY OR MAY NOT BE LOGICALLY EMPTY. 
          RJ     FWDJUMP
* 
*     CLEAR FOR THE NEW STATEMENT THAT FOLLOWS -THEN- 
          RJ     COMCLR 
* 
          JP     REPEAT 
* 
          EJECT 
* 
 LACTELS  BSS    0
*     TOROUT OF -ELSE-
* 
*     TEST IF UNSTACK REASON WAS -EOS- OR -ELSE-. 
          SX1    X6-LXEOS      DID -EOS- UNSTACK THIS?
          ZR     X1,LACTELS1   BR, -EOS- DID UNSTACK THIS 
          SX1    X6-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X1,LACTELS1   -BR, -ELSE- DID UNSTACK THIS 
*     TEST IF -=- UNSTACKED THIS. 
*     WE USE THE READ SYMBOL TO TEST BECAUSE TORIN LX FIELD 
*     IS NOT UNIQUE FOR -=-.
          SA1    NS      FETCH UNSTACKING READ SYMBOL 
          SB5    X1-LVEQU      DID -=- UNSTACK THIS?
          EQ     B0,B5,REPEAT  BR, -=- DID UNSTACK THIS 
* 
*     HERE BECAUSE -EOS- -ELSE- -=- DID NOT UNSTACK THIS. 
*         MUST HAVE BEEN UNSTACKED BY A 
*         VERB OR OPERAND(... 
  
*     VERIFY UNSTACKING READ SYMBOL IS NOT FROM 
*     SET OF SYMBOLS WHICH MUST NOT UNSTACK -ELSE-. 
          RJ     SYNCHK 
          EQ     REPEAT        VERB DID UNSTACK THIS
 LACTELS1 BSS    0
*     HERE BECAUSE THIS WAS UNSTACKED BY -EOS- OR -ELSE-. 
*     CONTEXT MUST BE -....ELSE LN EOS- 
*     -....ELSE LN ELSE ....-.
* 
*     SAVE UNSTACKING REASON
          SA6    TD191230      UNSTACKING REASON SAVED
* 
*     VERIFY LINE NUMBER AT TOP OF ANDSTACK.
          LNCHECK   BILLLAB 
          SA6    A2            INTEGRIZED LINE NUMBER STORED WD 2 ANDSTACK
*     SET BYPASGO FLAG ON (REDUNDANT FOR CASE 
*     OF UNSTACKED BY -EOS- BUT NO HARM DONE).
          MX7    1
          SA7    BYPASGO       BYPASGO SET ON 
* 
*     GENERATE JUMP TO LINE NUMBER
          SA1    GOTOJUMP      FETCH INSTR PROTOTYPE
          RJ     OUTINS        GENERATE JUMP TO LN
  
*     REMOVE LINE NUMBER ENTRY FROM ANDSTACK. 
          DECRAND 
* 
*     FETCH UNSTACK REASON AND TEST 
          SA1    TD191230      X1 = UNSTACK REASON
          SX2    X1-LXELS      WAS IT -ELSE-? 
          ZR     X2,REPEAT     BR, -ELSE- DID UNSTACK THIS
          EQ     EOSACT1       -EOS- DID UNSTACK THIS 
 TD191230 BSSZ   1
 TD131200 BSSZ   1
 THENGO   BSSZ   1
* 
 RELTAB   DATA      0      =
          DATA      4      <
          DATA      5      @
          DATA      2      >
          DATA      3      \
          DATA      1      NOT EQUAL
 RELTABR  DATA   0     =
          DATA   2     >
          DATA   3     \
          DATA   4     <
          DATA   5     :  
          DATA   1     NOT EQUAL
STREL     DATA      0 
 SBINSTR  DATA      0 
 LOGSW    BSSZ   1
          EJECT 
* 
*  FOR-STATEMENT
* 
*     FOR 
* 
 LACTFOR  BSS       0                   UNSTACKED BY =
         SB6       FORLMT               CHECK FOR NESTING LIMIT 
         GT        B2,B6,BFORERR
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX2       B6,X1 
          AX1       30
          NE        B5,B6,BILLAOPR      KIND NOT SIMPLE 
          SX2    X1-VINS
          ZR  X2,FOR1              JUMP IF VINS 
          SA2    DEFFLAG
          ZR  X2,BILLAOPR          ERROR IF NOT IN DEF
          SX2    X1-SINS
          NZ  X2,BILLAOPR          ERROR IF NOT SINS
 FOR1     BSS    0
          SX6       LFOE
          JP        STACK1
* 
*     FOR=
* 
 LACTFOE  BSS       0                   UNSTACKED BY TO 
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX1       B6,X1 
          NE        B5,B6,BILLAOPR      KIND NOT SIMPLE 
          SX6       LTOX
          JP        STACK1
* 
*     TO
* 
 LACTTOX  BSS       0                   UNSTACKED BY STEP OR EOS
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX1       B6,X1 
          NE        B5,B6,BILLAOPR      KIND NOT SIMPLE 
          RJ        FETCH 
          OUTINS    NORMTOX6
          RJ        TEMPLOC 
          SA1       SIMSINSW
          BX6       X7+X1 
          SA6       ANDSTACK+B2         STACK EXP2 AS SIMPLE SINS 
          OUTINS    STOREVAR            SAVE EXP2 
          SA1       SACTEMP1
          SX6       LSTE
          SX1       X1-LXSTE
          ZR        X1,STACK1           TO WAS UNSTACKED BY STEP
          INCRAND                       IMPLICIT STEP 
          SA1       NUMONE               - INTRODUCE A ONE
          SA2       SIMCONWD
          BX6       X1
          LX7       X2
          SA6       ANDSTACK-1+B2 
          SA7       ANDSTACK+B2            AND FALL INTO STEP-ACT 
          EJECT 
* 
*     STEP
* 
 LACTSTE  BSS       0 
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX1       B6,X1 
          NE        B5,B6,BILLAOPR      KIND NOT SIMPLE 
          RJ        FETCH 
          OUTINS    NORMTOX6
          RJ        TEMPLOC 
          SA1       SIMSINSW
          BX6       X1+X7 
          SA6       ANDSTACK+B2         STACK EXP3 AS SIMPLE SINS 
          OUTINS    STOREVAR            SAVE EXP3 
          DECRAND                  POINT TO EXP1
          DECRAND 
          RJ   FETCH               FETCH EXP1 
          OUTINS   NORMTOX6 
          SA1    ANDSTACK+B2-ANDINCR   MOVE FOR-VARIABLE TO TOP 
          BX6    X1 
          SA6    ANDSTACK+B2
          RJ   STORE               STORE EXP1 INTO FOR-VAR
          SA1    ANDSTACK+B2+ANDINCR   MOVE EXP2 AND EXP3 DOWN
          BX6    X1 
          SA6    ANDSTACK+B2
          UPANDPTR
          SA1    ANDSTACK+B2+ANDINCR
          BX6    X1 
          SA6    ANDSTACK+B2
          SA1       NEXTLAB 
          SX6       X1-1
          SA6       ANDSTACK-1+B2       ANDSTACK[ANDPTR] .= 
          SA6       A1                    NEXTLAB .= NEXTLAB - 1
          DECRAND 
          SA1       ANDSTACK-ANDINCR+B2 
          SA2       ANDSTACK+B2 
          BX6       X1                    SAVE DESCRIPTOR 
          LX7       X2
          SA6       ANDSTACK-ANDINCR-1+B2   OF FOR-VARIABLE 
          SA6       A2                  EXCHANGE
          SA7       A1
         RJ        FETCH                FETCH CONTROL VARIABLE
         UPANDPTR 
         OUTINS    LABELDEF             DEFINE FOR LABEL
         DECRAND
         OUTINS    NORMTOX6             MOVE TO X6 FOR LATER STORE
         OUTINS    REGRES               KEEP IN X5
          ARTHPAIR  FLOATSUB
  
**        THIS CORRECTS THE PROBLEM CONCERNED 
**        WITH *FOR-NEXT* LOOPING WHEN USING
**        A NEGATIVE DECREMENT. 
* 
          OUTINS NORMLIZE 
          UPANDPTR
          SA1       ANDSTACK+ANDINCR+B2 
          BX6       X1                  MOVE EXP3 DOWN ON 
          SA6       ANDSTACK+B2            TOP OF FOR-VARIABLE
          ARTHPAIR  FLOATMUL
          UPANDPTR
          SA1       ANDSTACK+ANDINCR+B2 
          SA2       ANDSTACK-ANDINCR-1+B2 
          SA3       ANDSTACK-1+B2 
          SA4       ANDSTACK+ANDINCR-1+B2 
          BX6       X1
          LX7       X2
          SA6       ANDSTACK+B2 
          SA7       ANDSTACK-ANDINCR+B2 
          BX6       X3
          LX7       X4
          SA6       A2
          SA7       A3
          UPANDPTR
          SA1       ANDSTACK-ANDINCR-ANDINCR+B2 
          BX6       X1                  COPY ENTRY FOR CONTROL VAR
          SA6       ANDSTACK+B2 
          RJ        STORE               STORE NEW VALUE 
          DECRAND 
          DECRAND 
          SA2       NEXTLAB 
          SX7       X2-1
          SA7       ANDSTACK-1+B2       SET BYPASS-LABEL INTO ANDSTACK
          SA7       A2
          OUTINS    MINUSJMP
          UPANDPTR
          SX6       B2
          SA6       FORPTR              FORPTR .= ANDPTR
          SA5       ANDSTACK-1+B2      FOR LABEL
          RJ        LABELCTR
          SA1       B6
          SA2    SEQNO             LINE NUMBER
          LX2       36
          BX6       X1+X2 
          SA6       A1                 ADD LINE NO FOR DIAG 
          JP        REPEAT
          EJECT 
* 
*  NEXT 
* 
 LACTNEX  BSS       0 
          SA1       FORPTR
          SA2       ANDSTACK+B2 
          SA3       ANDSTACK-ANDINCR+X1 
          IX4       X2-X3 
          NZ        X4,BNOMWFOR         NO MATCH WITH FOR-VARIABLE
          ARTHPAIR  FLOATADD
          OUTINS NORMLIZE 
         OUTINS    RELEATOP             UPDATE CONTROL VARIABLE 
          OUTINS    GOTOJUMP            GOTO FOR-LABEL
          DECRAND 
          OUTINS    LABELDEF            DEFINE BYPASS-LABEL 
          DECRAND 
          SX6       B2
          SA6       FORPTR              FORPTR  = ANDPTR
          JP        REPEAT
          EJECT 
* 
*  LET
* 
 LACTLET  JP   REPEAT 
* 
*  REM
* 
 LACTREM  EQU       REPEAT
* 
*  ASSIGN 
* 
 LACTFAS  BSS       0                   FIRST ASSIGN
          SB6       B3+B3 
          SB6       B6+2*ANDINCR
          TESTAND  NE,B6,CHKSBS    TEST FOR MATCHING TOR/AND PAIRS
 SUBMTCH  BSS    0
          SA1       ANDSTACK+B2 
          SX7       B0
          SA7       STRASG
          SB5       SVKIND
          UX1       B6,X1 
          EQ        B5,B6,LACTFS1 
          SB5       STKIND
          EQ        B5,B6,LACTFS1 
          SB5    SYSTKND
          EQ     B5,B6,LACTFS1
          SB5       SIMKND
          NE        B5,B6,BASSERR       RIGHT HAND SIDE NOT SIMPLE
          RJ        FETCH               FETCH RIGHT HAND SIDE 
          OUTINS    NORMTOX6
          DECRAND 
* 
 LACTREE  BSS       0                   ASSIGN
          SA1       STRASG
          NZ        X1,LACTFS2
          SA1       ANDSTACK+B2 
          UX1       B6,X1 
          SB5       SVKIND
          EQ        B5,B6,BASSERR 
          RJ        STORE               STORE 
          DECRAND 
          JP        REPEAT
* 
 LACTFS1  BSS    0
          RJ     FETCH             GET THE SOURCE STRING
          OUTINS    SB7AI 
          DECRAND 
          SX7       1 
          SA7       STRASG
 LACTFS2  BSS       0 
          SA1       ANDSTACK+B2 
          UX1       B5,X1 
          SB6       SVKIND
          NE        B5,B6,BASSERR 
          SA1    B2+ANDSTACK-1     LOOK FOR DUMMY ANDSTACK ENTRY (IT
*                                  FLAGS THE SUBSTR PARAMETER SET)
          NG     X1,PUTSUBS        SKIP IF THE TARGET WILL BE 
*                                  SPECIFIED BY A SUBSTR FUNCTION 
          RJ     FETCH
          OUTINS SB6AI           TARGET ADR IN B6 
          DECRAND 
          OUTINS RJSTRST
          RJ     RELEASE
          JP        REPEAT
* 
 CHKSBS   BSS    0                 DO A FURTHER TEST (SUBSTR POSSIBLE)
          SA1    LETSUBS           SUBSTR INCREMENTS ACCUMULATED HERE 
          SB6    B6+X1
          NE     B6,B2,BASSERR     SKIP IF STILL NO MATCH (ERROR) 
          EQ     SUBMTCH           ELSE REJOIN  MAIN SEQUENCE 
* 
 STRASG   BSSZ      1 
 LETSUBS  BSSZ   1                 SET ZERO BY -LET-. INCREMENTED BY 3
*                                  OR 4 ANDINCRS FOR EACH SUBSTRING 
*                                  MET IN A -LET- STATEMENT.
* 
*                                  USED LATER IN A CONSISTENCY CHECK AT 
*                                  CHKSBS.
* 
* 
* 
 PUTSUBS  BSS    0                 SUBSTR (INSERT MODE) 
          SX7    X1+1 
          ZR     X7,SETPRMT        SKIP IF ONE PARAMETER ONLY 
          SX7    1
 SETPRMT  BSS    0
          SA7    SUBPRMS
          DECRAND                  RELEASE DUMMY AND-ENTRY
          RJ     GETPUPV           GEN: FETCH PARAMETERS AND SET X0 
* 
          RJ     FETCH             GEN: FETCH TARGET STRING 
          OUTINS   SB6AI           GEN: GET B6 TO POINT TO IT 
* 
          DECRAND                  RELEASE STRING AND-ENTRY 
* 
*                                  SINCE -SUBSTR- IS HERE USED IN THE 
*                                  -INSERT- MODE, THE ADDRESS OF BASXSBT
*                                  NOW REPLACES THAT OF BASXSBS IN
*                                  AND-TOP. 
* 
* 
          SX2    BFSBSTT
          MX0    42 
          SA1    B2+ANDSTACK
          BX1    X0*X1             PRESERVE 42/ANDTOP 
          IX7    X2+X1             MERGE
          SA7    A1                RESET IN ANDSTACK
* 
* 
          OUTINS CALLTOPS          GEN: RJ BASXSBT
* 
          MX7    59 
          SA7    REGSTPTR          FREE PARAMETER HOLDING REGSTRS 
          DECRAND                  DROP THE FUNCTION AND-ENTRY
          SX7    WERR1
          SA7    WNSW        SET OBSOLETE FORM WARNING SW 
          JP     REPEAT 
* 
* 
          EJECT 
* 
*  SYSTEM FUNCTION
* 
 LACTLSB  BSS       0         UNSTACKED BY MATCHING RIGHT PARENTESIS
* 
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX1       B6,X1 
          NE        B5,B6,BILLAOPR      TOP NOT SIMPLE
          RJ        FETCH               GET ARGUMENT TO X5
          SA1       ANDSTACK+B2 
          MX7       57
          BX1       -X7*X1
          SX7       X1-5
          ZR        X7,SF1             ARG IN X5
          OUTINS    BX5XI 
SF1       BSS       0 
          DECRAND 
          OUTINS    CALLTOPS            RJ FUNCTION-NAME
          SETVINX   SIMVINXW
          SA1       ANDSTACK+B2 
          MX7       57
          BX1       -X7*X1
          SX7       X1-5
          ZR        X7,SF2             RESULT IN X5 
          OUTINS    BXIX5 
SF2       BSS       0 
          JP        MAINLOOP
* 
*                                                                        BAS0018
*         TAB - SPECIAL SYSTEM FUNCTION                                  BAS0018
*                                                                        BAS0018
 LACLSBT  BSS    0                 UNSTACKED BY RIGHT PAREN              BAS0018
          SA1    ANDSTACK+B2                                             BAS0018
          SB5    SIMKND                                                  BAS0018
          UX1    B6,X1                                                   BAS0018
          NE   B5,B6,BILLAOPR      TOP NOT SIMPLE                        BAS0018
          RJ   FETCH               ARG IN X5                             BAS0018
          DECRAND                                                        BAS0018
          OUTINS   CALLTOPS        RJ TAB                                BAS0018
          SETVINX   TABVINXW                                             BAS0018
          JP   MAINLOOP                                                  BAS0018
*                                                                        BAS0018
*                                                                        BAS0018
*                                                                        BAS0018
          EJECT 
*                                  SUBSTR 
 LACTLS1  BSS    0                 UNSTACKED BY COMMA (IN SUBSTR LIST)
* 
*                                  FIRST PARAMETER MUST BE A STRING 
          SA1    ANDSTACK+B2
          UX1    B5,X1
          SB6    STKIND 
          EQ     B5,B6,SUBSTOK     SKIP IF STRING CONSTANT
          SB6    SYSTKND
          EQ     B5,B6,SUBSTOK
          SB6    SVKIND 
          NE     B5,B6,BILLAOPR    ERROR: ITS NOT A STRING (VBL OR CNST)
* 
 SUBSTOK  BSS    0
          SX6    LLSY 
          EQ     STACK1            GO GET 2ND PARAMETER 
* 
* 
 LACTLS2  BSS    0                 UNSTACKED BY COMMA OR )
          SA1    ANDSTACK+B2
          UX1    B5,X1
          SB6    SIMKND 
          NE     B5,B6,BILLAOPR    ERROR: 2ND PARAMETER IS NOT SIMPLE 
* 
          SA1    SACTEMP1 
          SX6    LLSZ              ASSUME THERES A 3RD PARAMETER
          SX7    1
          SA7    SUBPRMS           ASSUME 3 PARAMETERS
          SX1    X1-LXCOM          DID COMMA CAUSE THE UNSTACKING 
          ZR     X1,STACK1         IF SO GO GET 3RD PARAMETER 
          SX7    B0 
          SA7    SUBPRMS
          EQ     CHKLETS
* 
 LACTLS3  BSS    0                 UNSTACKED BY ) 
          SA1    ANDSTACK+B2
          UX1    B5,X1
          SB6    SIMKND 
          NE     B5,B6,BILLAOPR 
 CHKLETS  BSS    0
* 
* 
*                NOTE THAT SUBSTR CHECKS HERE FOR A POSSIBLE ASSIGNMENT 
*                (LET) ENVIRONMENT, IN WHICH CASE CODE GENERATION TAKES 
*                PLACE UNDER CONTROL OF LACTFAS OR LACTREE. 
* 
* 
          EQ     B3,B0,LETSTR      SKIP IF TORSTACK IS EMPTY
          SA1    TORSTACK+B3
          SX2    X1-LACTLET 
          ZR     X2,LETSTR         SKIP IF LET-TOR IS PRESENT 
          SX2    X1-LACTFAS 
          ZR     X2,LETSTR         SKIP IF ITS -ASSIGN ACT1-
          SX2    X1-LACTREE 
          ZR     X2,LETSTR         SKIP IF ITS -ASSIGN ACT2-
* 
          EQ     BILLCLLS 
* 
SUBPRMS   BSSZ   1                 SUBSTR PARAMETER COUNT 
* 
 LETSTR   BSS    0
          SA1    SUBPRMS           IS 0/1 ACCORDING AS THERE ARE 2/3
*                                  PARAMETERS.
          SX7    X1+3 
          LX7    1                 ALLOWS FOR 2 WORDS PER AND-ENTRY 
          SA2    LETSUBS
          IX7    X2+X7             INCREMENT BY 6 OR 8 (PARAM -AND- WDS 
*                                  PLUS SR ENTRY ITSELF)
          SA7    A2                REPLACE (USED FOR CONSISTENCY  CHECK 
*                                  AT LACTFAS)
* 
          INCRAND                  THE OPERAND NOW SET UP IS A DUMMY
*                                  (FLAGS SUBSTR ENTRIES IN ANDSTACK) 
* 
          MX7    59                ASSUME ONLY 2 PARAMS 
          ZR     X1,SETPNO         SKIP IF THERE ARE ONLY 2 
          MX7    58                ELSE THERE ARE 3 
 SETPNO   BSS    0
          SA7    B2+ANDSTACK-1     SET -1/-3 ACCORDING AS 2 OR 3 ACTUAL 
*                                  PARAMETERS  EXIST. 
          SETVINX  SVINSW          MIMIC STR VBL IN STORE (TO SATISFY 
*                                  ASSIGN CHECKS AND AVOID -CLEAR-) 
          JP MAINLOOP 
* 
* 
* 
 GETPUPV  BSS    0
*                                  GENS CODE TO FETCH CHARACTER 
*                                  PARAMETERS (USING COUNT IN SUBPRMS)
*                                  AND ALSO SETS X0 TO 0 OR 1 (AT R/T)
*                                  ACCORDING AS 2 OR 3 PARAMS EXIST.
* 
*                                  NOTE THAT ANY ASSOCIATED AND-ENTRIES 
*                                  ARE RELEASED.
* 
          JP     0
          RJ     CLEAR             DEREGISTER ANY AND-ENTRIES 
          SA1    SUBPRMS           PARAMETER COUNT
          ZR     X1,HAS2PRM        SKIP IF 2 PARAMS EXIST 
* 
          OUTINS SETX0POS          GEN: SET X0 TO 1 ( 3 PARAMS HERE)
* 
          RJ     FETCH             GEN: FETCH THE 3 RD PARAMETER
          SA1    ANDSTACK+B2
          MX7    57 
          BX1    -X7*X1 
          SX7    X1-5 
          ZR     X7,SP3OK          SKIP IF PARAMETER WILL BE IN X5
* 
          OUTINS BX5XI             GEN: FORCE IT TO X5
* 
 SP3OK    BSS    0
          DECRAND 
          EQ     GETNXTP
* 
 HAS2PRM  BSS    0
          OUTINS SETX0ZER          GEN: SET X0 ZERO (ONLY 2 PARAMS) 
          RJ     RESERVE           FORCE NEXT TO X4 
* 
 GETNXTP  BSS    0
* 
          RJ     FETCH             GEN: FETCH 2ND PARAMETER 
          SA1    ANDSTACK+B2
          MX7    57 
          BX1    -X7*X1 
          SX7    X1-4 
          ZR     X7,SP2OK          SKIP IF 2ND PARAMETER WILL BE IN X4
* 
          OUTINS BX4XI             ELSE GEN: FORCE IT TO X4 
* 
 SP2OK    BSS    0
          DECRAND 
          EQ     GETPUPV           EXIT 
* 
* 
* 
*                SYSTEM FUNCTIONS WHICH EXPECT A STRING (CONSTANT OR
*                VARAIBLE) AND RETURN A REAL VALUE
* 
* 
 LACTLSV  BSS    0                 UNSTACKED BY MATCHING RIGHT PAREN
          SA1    ANDSTACK+B2
          UX1    B5,X1
          SB6    SYSTKND
          EQ     B5,B6,KNDOK
          SB6    STKIND 
          EQ     B5,B6,KNDOK
          SB6    SVKIND 
          NE     B5,B6,BILLAOPR    ERROR IF NEITHER STRING CONST OR VBL 
* 
 KNDOK    BSS    0
          RJ     FETCH             GEN: FETCH STRING (CONST OR VBL) 
          OUTINS SB7AI             GEN: SET B7 TO POINT (AT R/T) TO 
*                                  THE STRING INVOLVED. 
* 
* 
*                                  NOW JOIN STANDARD SYSTEM FUNCTION
          JP     SF1               JOIN STANDARD SYS FUNCTION 
* 
* 
 LACTLVS  BSS    0                 SYSFUN - REAL PARAM, STR RESULT
* 
          SA1    ANDSTACK+B2
          SB5    SIMKND 
          UX1    X1,B6
          NE     B5,B6,BILLAOPR        TOP NOT SIMPLE 
* 
          SA1    SACTEMP1 
          SX1    X1-LXRPA          CHECK IF RIGHT PAREN CAUSED UNSTACK
          ZR     X1,ONLY1P         SKIP IF SO IE ONLY 1 PARAMETER 
          SA1    ANDSTACK+B2-ANDINCR  CHECK IF STR$ OR CHR$ 
          SB5    X1                FN ADDR
          SB6    BFVSTBL           STR$ ADDRESS 
          NE   B5,B6,SERROR6       COMMA BAD IF NOT STR$
          SX7    B7 
          SA7    SVB7        SAVE B7
          RJ   CHKSTR              CHECK IF NEXT IS STRING
          SA1    SVB7              RESTORE B7 POINTER 
          SB7    X1 
          ZR   X3,QUO              X3 = 0 IF IT WAS STRING
 UNQ      BSS    0
          SX7    WERR1
          SA7    WNSW        SET OBSOLETE FORM WARNING SW 
          SX7    -3 
          EQ     QUO1 
 QUO      BSS    0
          SX7    B0 
 QUO1     BSS    0
          SA7    DATAST      UNQUOTED STRING ENDING IN )
          SX6    LST2 
          EQ     STACK1 
* 
* 
 LACTST2  BSS    0
          SA1    ANDSTACK+B2
          LX1    30 
          SB6    X1          CLASS
          SB5    VINX 
          EQ     B5,B6,ST3
          SB5    AINX 
          EQ     B5,B6,ST3
          SB5    AINX1
          NE     B5,B6,ST4
 ST3      BSS    0
          LX1    30                    CHECK IF 
          SB6    X1                    REG X5 
          SB5    5                     IS IN USE
          NE     B5,B6,ST4             IF SO
          RJ     CLEAR       CLEAR
 ST4      BSS    0
          DECRAND 
          RJ     FETCH       FETCH IMAGE
          INCRAND 
          RJ     FETCH
          DECRAND 
          DECRAND 
          OUTINS CALLTOPS 
          EQ     NRMLSTR           REJOIN NORMAL STR SEQUENCE 
* 
 ONLY1P   BSS    0
          RJ     FETCH
          DECRAND 
          SA1    ANDSTACK+B2       CHECK IF STR$
          SB5    X1                FN ADDR
          SB6    BFVSTBL           STR$ ADDRESS 
          NE   B5,B6,ONLY1P1       SKIP IF NOT STR$ 
          OUTINS SETX4ZER 
 ONLY1P1  BSS    0
* 
          OUTINS CALLTOPS          GEN: RJ SYSF EG BASXSTR
* 
* 
 NRMLSTR  BSS    0
* 
          SX7    -1 
          SA7    REGSTPTR          FREE ALL REGS (ARGS NOW NO LONGER
*                                  REQUIRED)
* 
          OUTINS SAIB7             GEN: GET AI TO POINT TO THE RESULTING
*                                  STRING (AT RUN-TIME) 
          SETVINX  SVAINXW         MIMIC STRING VBL WITH AN ADDR IN REG.
* 
          JP     MAINLOOP 
* 
* 
 SVB7     BSSZ   1
          EJECT 
* 
*  USER FUNCTION
* 
 LACTLFN  BSS       0                   UNSTACKED BY )
*  OR UNSTACKED BY COMMA
          SX7    X6-LXRPA 
          NZ  X7,LACTCFN           JUMP IF COMMA (MULTIARG FN)
*  SINGLE ARG, CHECK ARG VALIDITY 
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX1       B6,X1 
          EQ  B5,B6,LFN4           ARG IS SIMPLE
          SB5    SVKIND 
          EQ  B5,B6,LFN4           ARG IS STR VAR 
          SB5    STKIND 
          EQ  B5,B6,LFN4           ARG IS STR CON 
          SB5    SYSTKND
          NE  B5,B6,BILLAOPR       ARG NOT SYS STR
 LFN4     BSS    0
*  FETCH ARGUMENT 
          RJ        FETCH               GET ARGUMENT TO X5
          SA1       ANDSTACK+B2 
          MX7       57
          BX1       -X7*X1
          SX7       X1-5
          ZR        X7,UF1             ARG IN X5
          OUTINS    BX5XI 
UF1       BSS       0 
          SX6    B0                INDICATE SINGLE ARG FN 
          SA6    ARGFLAG
          EQ  LFN2                 GO CHECK THE ARGUMENT
* 
* 
* 
* 
 LACTCFN  BSS    0                 UNSTACKED BY COMMA OR )
*  MULTIARG FUNCTION ONLY 
*  CHECK ARGUMENT VALIDITY
          SA1    ANDSTACK+B2
          SB5    SIMKND 
          UX1    B6,X1
          EQ  B5,B6,CFN20          ARG IS SIMPLE
          SB5    SVKIND 
          EQ  B5,B6,CFN20          ARG IS STR VAR 
          SB5    STKIND 
          EQ  B5,B6,CFN20          ARG IS STR CON 
          SB5    SYSTKND
          NE  B5,B6,BILLAOPR       ARG NOT SYS STR
 CFN20    BSS    0
* 
*  GEN CODE TO PUT ARG IN STORAGE IF REQUIRED 
*  ALL ARGS MUST IN (TEMP) STORAGE SO OFFSET FROM B2
*  CAN BE PASSED IN PARAM LIST
* 
          SB5    SIMKND 
          EQ  B5,B6,CFN21          BYPASS IF SIMPLE 
          SB5    SVKIND            STRING ARGUMENT
          NE  B5,B6,CFN22          JUMP IF NOT STRING 
          AX1    30                X1 = CLASS 
          SX2    X1-VINS
          ZR  X2,CFN1              STR VAR ALREADY IN STORAGE 
          SX2    X1-SINS
          ZR  X2,CFN1              STR SINS TOO 
 CFN22    BSS    0
* 
          RJ  FETCH                STR CON GEN - SA5 B4+ADDR
          OUTINS  SB7AI            GEN - SB7 A5 
          OUTINS  RELEATOP
          RJ  STMPLOC              X7 = ADDR OF TEMPLOC 
          SA1    ANDSTACK+B2
          UX1    B6,X1             B6 = KIND
          SX1    SINS 
          LX1    30                X1 = CLASS 
          BX7    X7+X1
          PX7    B6,X7
          SA7    ANDSTACK+B2
          OUTINS SB6B2K 
          OUTINS  RJSTRST           GEN - RJ BASASTR  COPY STRING 
          EQ  CFN1
 CFN21    BSS    0                 SIMPLE ARGUMENT
          SA1    ANDSTACK+B2
          AX1    30                CLASS
          SX2    X1-VINS
          ZR  X2,CFN1              JUMP IF VINS, ALREADY IN STORAGE 
          SX2    X1-SINS
          ZR  X2,CFN1              SINS TOO 
          RJ  FETCH 
 CFN2     RJ  CLEAR                GEN - STORE TO TEMPLOC 
 CFN1     BSS    0
* 
          SA1    SACTEMP1          CHECK WHO UNSTACKED
          SX6    LCFN 
          SX1    X1-LXCOM 
          ZR  X1,STACK1            JUMP IF COMMA
          MX6    1                 LAST ARG, DONE 
          SA6    ARGFLAG           INDICATE MULTIARG FN 
* 
* 
 LFN2     BSS    0                 DONE SCANNING ARGUMENTS
*  GO BACK DOWN STACK TO FIND THE FN
          SX1    B2-ANDINCR 
          SA2    ARGFLAG
          ZR  X2,CFN11             SKIP IF SINGLE ARG FN
          SX1    B2                SEARCH STACK FOR UFUN ENTRY
          SB5    UFKIND 
 CFN10    BSS    0
          SA2    ANDSTACK+X1       GET AN ENTRY 
          UX2    B6,X2             EXTRACT KIND 
          EQ  B5,B6,CFN11          JUMP IF FOUND
          SX1    X1-ANDINCR        TRY NEXT ENTRY 
          EQ  CFN10 
* 
 CFN11    SX6    X1                SAVE POINTER TO FN ON STACK
          SA6    ARGPTR 
*  CHECK ARGUMENTS FOR TYPE AND NUMBER
          MX5    1                 INDICATE FN REFERENCE
          RJ  PARAM                CHECK FOR MATCHING ARGS
          SA1    ARGFLAG           SKIP IF SINGLE ARG FN
          ZR  X1,LFN3 
* 
*  GEN PARAM LIST, LIST OF REL ADDR IN CONST STORAGE
          SA1    ARGPTR 
          SX6    X1+ANDINCR        POINT TO FIRST ARG ON STACK
          SA6    ARGSAVE           SAVE POINTER 
          INCRAND                  GET WORK AREA ON TOP 
          SX7    B0                RESET PARAM LIST ADDR
          SA7    PARPTR 
 CFN13    BSS    0
          SA1    ANDSTACK+X6       ARG DESC 
          BX2    X1 
          AX2    30                CLASS
          SX2    X2-SINS
          SX7    X1                POSSIBLE SINS ADDR 
          ZR  X2,CFN12             SINS, REL ADDR WAS IN STACK ENTRY
          SB5    X1                VINS, FIND REL ADDR
          BX6    X1                PUT DESCRIPTOR ON TOP FOR DECLSIMP 
          SA6    ANDSTACK+B2
          RJ  DECLSIMP
 CFN12    ADDWRD CONS,X7           RELATIVE ADDRESS TO CONSTANTS
          SA1    PARPTR            STORE PTR TO FIRST ENTRY ONLY
          NZ  X1,CFN15             SKIP FI ALREADY SAVED
          SX7    X3-2 
          SA7    PARPTR            SAVE POINTER TO FIRST ARG - 1
 CFN15    BSS    0
          SA1    ARGSAVE
          SX6    X1+ANDINCR        POINT TO NEXT ARG
          SA6    ARGSAVE
          SB6    X6 
          NE  B6,B2,CFN13          LOOP 
* 
*                GEN CODE TO POINT A1 TO PARAM LIST 
          SA1    PARPTR            STACK SAVED PTR TO PARAM LIST
          BX6    X1 
          SA6    ANDSTACK+B2
          OUTINS  POINTA4          GEN - SA4 B4 + RELADDR 
          OUTINS  REGRES           RESERVE X5 FOR RESULT
* 
* 
 LFN3     BSS    0                 UNSTACK THE ARGUMENTS
          SA1    ARGPTR 
          SB2    X1 
* 
* 
 LFN5     BSS    0
          SX4       B0
          BX4       -X4                REFERENCE FLAG 
          RJ        DECLFUN 
          SA1    DEFPTR 
          SA2       ANDSTACK+B2         GET FUNCTION
          SB6    X2                SAVE FN ORDINAL
          LX5    X2,B1      FN ORD * 2
          SA3    F.FUNS 
          SB4    X3+B1             BASE+1 FOR NEXT
          SA5    X5+B4             XREFS
          SA3    A5-B1             DECL TABLE 
          SA4    DEFFLAG
          ZR     X4,LEFTFUN3 BRANCH IF NOT IN DEF 
          NG        X3,LEFTFUN2         IF DECLARED THEN BYPASS 
          SX7    WERR4       SET WARNING MESSAGE FOR
          SA7    WNSW        REFERENCE BEFORE DEFENITION
          SA4       ANDSTACK+2*ANDINCR+X1 
          LX4    1                 FN ORD * 2 
          SA4    X4+B4             XREFS
          BX6    X4+X5             ADD TO PATTERN OF THIS FUN 
          SA6    A5                SO ALL WHO CALLED DEF-FUN CALLED US
          JP        LEFTFUN1
 LEFTFUN3 NG     X3,LEFTFUN1 BRANCH IF DEFINED
          SX7    WERR4       SET WARNING MESSAGE FOR
          SA7    WNSW        REFERENCE BEFORE DEFINITION
          EQ     LEFTFUN1 
 LEFTFUN2 BSS       0 
          SA4       ANDSTACK+ANDINCR+X1 GET PATTERN OF DEF-FUN
          BX6    X4+X5             ADD PATTERN OF THIS FN TO IT 
*                                  SO IT CALLS ALL WE CALL
          SX2    1                 ADD BIT FOR THIS FUN TOO 
          LX2    B6,X2
          BX6    X6+X2
          SA6       A4
 LEFTFUN1 BSS       0 
          OUTINS    CALLTOPU            RJ FUNCTION 
          SA1    ANDSTACK+B2       CHECK IF STRING FUN
          SX1    X1-NUMBFUN/2 
          NG  X1,LFN10             JUMP IF REAL 
          SETVINX  SVAINXW         RESULT IS STRING, AINX 
          SX6    B0                WHICH ACTUALLY MEANS OFFSET IN X 
          SA6    ANDSTACK+B2-1
          EQ  LFN11 
 LFN10    BSS    0
          SETVINX   SIMVINXW            SET RESULT IN X5
 LFN11    BSS    0
          SA1       ANDSTACK+B2 
          MX7       57
          BX1       -X7*X1
          SX7       X1-5
          ZR        X7,UF2             RESULT IN X5 
          OUTINS BX5XI
UF2       BSS       0 
          OUTINS SETLINEX    RESET THE LINE NUMBER
          SA1    B3+TORSTACK+TORINCR
          SX1    X1-LACTNPF 
          ZR     X1,REPEAT   IF PARMLESS FN CONTINUE UNSTACKING 
          SA1    SACTEMP1 
          SX1    X1-LXRPA 
          NZ     X1,REPEAT
          JP        MAINLOOP
 ARGPTR   BSS    1                 POINTER TO FN ON STACK 
 PARPTR   BSS    1                 POINTER TO START OF PARAM LIST 
 ARGFLAG  BSS    1                 NONZERO FOR MULTIARG FN
 ARGSAVE  BSS    1
          EJECT 
* 
*     VARIABLE PARAMETER FUNCTION 
* 
 LACTVPF  BSS    0
          SA1    ANDSTACK+B2
          UX1    X1,B6
          SB5    SIMKND 
          EQ     B5,B6,VP1   ARG IS SIMPLE
          SB5    SYSTKND
          EQ     B5,B6,VP1   ARG IS SYS STR 
          SB5    STKIND 
          EQ     B5,B6,VP1   ARG IS STR CON 
          SB5    SVKIND 
          NE     B5,B6,BILLAOPR        ARG NOT STR VAR
 VP1      BSS    0
          SX7    X6-LXCOM 
          SX6    LVPF 
          ZR     X7,STACK1   UNSTACKED BY COMMA 
          RJ     CLEAR
          SB5    SFKIND      SCAN DOWN TILL 
          SX2    B2          SFKIND FOUND 
 VP21     BSS    0
          SA1    ANDSTACK+X2
          UX1    B6,X1
          EQ     B5,B6,VP3   FOUND
          SX2    X2-ANDINCR 
          EQ     VP21 
 VP3      BSS    0
          SX6    X2 
          SX7    B2 
          SA6    SARGPTR     SAVE FN POINTER
          SA7    SAVEB2      SAVE B2 REG
          SA1    ANDSTACK+X2-1
          MX0    60-6 
          LX1    6
          BX4    -X0*X1      MIN NUMBER OF ARG FOR FUNC 
          IX3    X7-X2
          AX3    1           NO OF ARG
          IX2    X3-X4
          NG     X2,BILL109  NOT ENOUGH ARGUMENT
          LX1    6
          BX7    X1 
          SA7    SAVEFLG
          BX2    -X0*X1      MAX NUMBER OF ARG FOR FUNC 
          IX3    X2-X3
          NG     X3,BILLEXT1 TOO MANY ARGUMENTS 
          SB5    X2-4 
          SB2    X6+ANDINCR 
          NG     B5,VPREG    MAX LT 4 
 VP4      BSS    0
          SA3    SAVEFLG
          LX3    1
          BX7    X3 
          SA7    SAVEFLG
          SA1    ANDSTACK+B2
          UX1    X1,B6
          PL     X3,VP4NUM   ARG S/B NUMERIC
          SB5    STKIND 
          EQ     B5,B6,VP41 
          SB5    SYSTKND
          EQ     B5,B6,VP41 
          SB5    SVKIND 
          NE     B5,B6,BILL106         PARAMETER LIST CONFLICT
          AX1    30 
          SX2    X1-VINS
          ZR     X2,VP42
          SX2    X1-SINS
          ZR     X2,VP42
          SX2    X1-VINXS 
          ZR     X2,VP42
 VP41     BSS    0
          RJ     FETCH       GEN STR CON
          OUTINS SB7AI
          OUTINS RELEATOP 
          RJ     STMPLOC     X7=ADDR OF TEMP LOC
          SA1    ANDSTACK+B2
          SX3    SINS 
          UX1    B6,X1
          LX3    30 
          BX7    X7+X3
          PX7    B6,X7
          SA7    A1 
          OUTINS SB6B2K 
          OUTINS RJSTRST     COPY STRING TO TEMP
          EQ     VP42 
 VP4NUM   BSS    0           SIMPLE KIND
          SB5    SIMKND 
          NE     B5,B6,BILL106         PARAMETER LIST CONFLICT
          AX1    30          CLASS
          SX2    X1-VINS
          ZR     X2,VP42
          SX2    X1-SINS
          ZR     X2,VP42
          SX2    X1-VINXS 
          ZR     X2,VP42
          RJ     FETCH
          RJ     CLEAR
 VP42     BSS    0
          SA1    SAVEB2 
          INCRAND 
          SB5    X1 
          LE     B2,B5,VP4   MORE ARG 
          SA1    SARGPTR     NOW PUT THEM IN
          SB2    X1+ANDINCR  PARAMETER LIST 
          MX7    0
          SA7    SPTR        WILL BE POINTER TO PARAM LIST
 VP44     BSS    0
          SA1    ANDSTACK+B2
          BX2    X1 
          AX2    30 
          SX2    X2-SINS
          SX7    X1 
          ZR     X2,VP45
          SX2    X2+SINS
          SX2    X2-VINXS 
          ZR     X2,VP45
          SB5    X1 
          RJ     DECLSIMP 
 VP45     ADDWRD CONS,X7
          SX7    X3-1              CONSTANT POINTER 
          SA1    SPTR 
          NZ     X1,VP46
          SA7    SPTR        SAVE PARAM LIST ADDR 
 VP46     BSS    0
          SB2    B2+ANDINCR 
          SA1    SAVEB2 
          SB6    X1 
          LE     B2,B6,VP44 
          MX1    0                 ZERO WORD
          ADDWRD CONS,X1           TO PARAMETER LIST
          SA1    SPTR 
          BX6    X1 
          SA6    ANDSTACK+B2 POINTER TO PARAM LIST
          OUTINS FETCHDOP 
          OUTINS RELEATOP 
          EQ     VP6
 VPREG    BSS    0
          SA3    SAVEFLG
          LX3    1
          BX7    X3 
          SA7    SAVEFLG
          SA1    ANDSTACK+B2
          UX1    B6,X1
          NG     X3,VPREGS   ARG S/B STR
          SB5    SIMKND 
          NE     B5,B6,BILL106
          EQ     VPREG1 
 VPREGS   BSS    0
          SB5    STKIND 
          EQ     B5,B6,VPREG1 
          SB5    SYSTKND
          EQ     B5,B6,VPREG1 
          SB5    SVKIND 
          NE     B5,B6,BILL106
 VPREG1   BSS    0
          RJ     FETCH
          INCRAND 
          SA1    SAVEB2 
          SB5    X1 
          LE     B2,B5,VPREG
          SA2    SARGPTR
          IX7    X1-X2
          AX7    1
          SA7    ANDSTACK+B2
          OUTINS SB6TOP      SB6 ? OF PARAM 
 VP6      BSS    0
          SA1    SARGPTR     FLUSH THE
          SB2    X1 
          OUTINS CALLTOPS    RJ        FUNCTION 
          MX7    59          FREE ALL REGS
          SA7    REGSTPTR    (ARG NOT LONGER REQUIRED)
          SA1    ANDSTACK+B2-1
          LX1    12 
          PL     X1,VP61     NUMERIC FUNCTION 
          OUTINS SAIB7       GET AI TO POINT TO RESULTING STR 
          SETVINX SVAINXW 
          SX6    LFUNP
          EQ     STACK1 
 VP61     BSS    0
          OUTINS REGRES 
          SETVINX SIMVINXW
          SX6    LFUNP
          EQ     STACK1 
          SPACE  4
          VFD    6/2,6/2,1/1,2/2,45/0     RPT$
 SARGPTR  BSSZ   1
 SAVEB2   BSSZ   1
 SAVEFLG  BSSZ   1
 SPTR     BSSZ   1
 LACTFUNP BSS    0                 DUMMY TO PREVENT MULTIPLE ASSIGN 
          EQ     REPEAT 
          EJECT 
* 
*  CALL EXTERNAL NAME 
* 
 LACTCAL  BSS    0                 UNSTACKED BY EOS OR (
          SA1    ANDSTACK+B2
          UX1    B6,X1
          SB5    EXTKND 
          NE  B5,B6,BILLEXT 
* 
*  CHECK EXTERNAL NAME FOR VALIDITY 
          SA1    ANDSTACK+B2-1     GET RELADDR OF STR CONST 
          SA2    F.CONS            START OF CONSTANTS 
          IX1    X2+X1           GET NAME FROM CONST STACK
*         (1ST WORD OF STRING IS AT LOC OF PTR WORD + 1)
          SA1    X1+1 
          MX2    42 
          BX2    -X2*X1 
          NZ  X2,BILLEXT           GT 7 CHAR
          SX2    77B
          LX1    6
          BX3    X2*X1             EXTRACT FIRST CHAR 
          ZR  X3,BILLEXT           STARTS WITH COLON
          SX4    X3-1R0 
          PL  X4,BILLEXT           NOT ALPHABETIC 
* 
          SX7    B0                INIT PARAM LIST POINTER
          SA7    PARLPTR
          SX1    X6-LXEOS          CHECK WHO UNSTACKED
          ZR     X1,CALL3          JUMP IF EOS
          SX1    X6-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X1,CALL3          BR, -ELSE- DID UNSTACK THIS
          EQ  REPEAT               STACK LCL
* 
* 
* 
 LACTLCL  BSS    0                 (CALL
*                                  UNSTACKED BY COMMA OR RPAREN 
* 
          SA1    ANDSTACK+B2
          UX1    B6,X1             B6 = CLASS 
          AX1    30                X1 = CLASS 
          SB5    SIMKND 
          EQ  B5,B6,LCL2           JUMP IF SIMPLE 
          SX2    X1-AINX
          NZ  X2,LCL1              JUMP IF NOT STRING AINX
          EQ  LCL3                 CLEAR STRING AINX
 LCL2     SX2    X1-VINX           SIMPLE 
          NZ  X2,LCL1              SKIP IF NOT VINX 
 LCL3     BSS    0                 GEN COPY STRING TO TEMP OR 
          RJ  CLEAR                GEN - NX6 B6,X5 AND SA6 B2+TEMP
 LCL1     RJ  FETCH                GEN CODE TO GET ADDR IN A5 
          OUTINS  SX6A5            GEN - SX6 A5 
          OUTINS  RELEATOP         RELEASE X5 
* 
* IF OPERAND IS STRING KIND, GENERATE CODE TO COMPLEMENT
* THE ADDRESS OF STRING PTR WORD IN X6.  RUNTIME ROUTINE
* BASCALL DETECTS STRING PARAMETERS IN THE PARMLIST BY
* A NEGATIVE ADDRESS IN THE PARMLIST. 
          SA1    B2+ANDSTACK
          UX1    B6,X1           B6=KIND, X1=CLASS
          SB5    SIMKND          IS IT NUMERIC CONS, VAR, OR FUNCTION 
          EQ     B5,B6,DOPARMS   BR, IT IS NUM CONS VAR OR FUNC 
* FALL THRU, IT IS STRING FUNCTION
* 
 CPLMNT   BSS    0
          SX6    6               X6 = REGISTER NO 6 FOR COMPLEMENT PROTO
          SA6    ANDSTACK+B2     REG NO. 6 PLUGGED INTO ANDSTACK TOP
          OUTINS COMPLMNT        GEN BX6 -X6 (SET PTR WORD ADDR NEG)
* 
 DOPARMS  BSS    0
          SA1    PARLPTR           GET OFFSET INTO PARAM LIST 
          SX6    X1-CALLMAX 
          PL  X6,BILLEXT1          JUMP IF TOO MANY ARGS
          BX6    X1                STACK IT 
          SX7    X1+1 
          SA6    ANDSTACK+B2
          SA7    PARLPTR           UPDATE OFFSET
          OUTINS  SB6TOP           GEN - SB6 K
          OUTINS  STOREPAR         GEN - SA6 B6+=XBASPARM 
          DECRAND 
* 
          SA1    SACTEMP1          CHECK WHO UNSTACKED
          SX6    LLCL 
          SX1    X1-LXCOM 
          ZR  X1,STACK1            STACK LCL IF COMMA 
* 
* 
* 
* 
 CALL3    OUTINS SETX6ZER 
          INCRAND 
          SA1    PARLPTR           GET OFFSET INTO PARAM LIST 
          BX6    X1                STACK IT FOR OUTINS
          SA6    ANDSTACK+B2
          OUTINS  SB6TOP           GEN - SB6 K
          OUTINS  STOREPAR         GEN - SA6 B6+=XBASPARM 
          DECRAND 
* 
          SA1    XOPTION
          NZ  X1,CALL2             JUMP IF B OPTION ON
          DECRAND                  GEN - JP ERROR 
          OUTINS  JPCALL
          SA1    SACTEMP1 
          SX1    X1-LXEOS 
          ZR     X1,REPEAT
          JP  MAINLOOP
 CALL2    BSS    0
          SA1    ANDSTACK+B2-1     MOVE REL ADDR OF EXT NAME
          BX6    X1                TO WORD1 FOR OUTINS
*         (REL ADDR IS ADDRESS OF STRING PTR WORD. WE ADD 
*         1 SO ADDR WILL BE ADDRESS OF 1ST WORD OF STRING.) 
          SX6    X6+1            X6 = ADDR OF 1ST WORD OF STRING
          SA6    ANDSTACK+B2
 CALL1    SA2    F.CONS 
          IX7    X2+X6
          SA1    X7 
          SA5    SA5EXT            SET REFERENCE
          MX0    42 
          LX0    30 
          BX6    X0*X5
          SA4    L.EXTS            ADDRESS OF NAME
          LX4    30 
          IX6    X6+X4             INSERT ADDRESS 
          SA6    A5 
          ADDWRD EXTS,X1           ENTER NAME 
          OUTINS  SA5EXT           GEN - SA5 RELADDR,  EXT RELOC
          OUTINS  RJCALL           GEN - RJ BASCALL 
          DECRAND 
          SA1    SACTEMP1 
          SX1    X1-LXEOS 
          ZR     X1,REPEAT
          JP  MAINLOOP
* 
* 
 PARLPTR  BSS    1
          EJECT 
* 
*   CHAIN STRING EXP   OR   CHAIN ? EXP 
* 
 LACTCHN  BSS    0             UNSTACKED BY -EOS- -ELSE- -POUND-
          SX1    X6-LXEOS 
          ZR   X1,CHAIN1           JUMP IF EOS
          SX6    LCHN1             IT WAS POUND, GO GET FILE ORDINAL
          EQ   FINDFIL             AND RETURN TO LACTCHN1 
* 
 CHAIN1   BSS    0
          SA1    ANDSTACK+B2       CHECK FOR STRING 
          UX1    B5,X1
          SB6    SVKIND 
          EQ   B5,B6,CHAIN2        OK 
          SB6    STKIND 
          NE   B5,B6,BILLCHN       NOT STRING 
 CHAIN2   RJ   FETCH               GEN - SA5 STRING 
          DECRAND 
          OUTINS   SETX0ZER        GEN - MX0 0 FOR STRING EXP 
          EQ   CHAIN3 
* 
 LACTCHN1 BSS    0                 UNSTACKED BY EOS 
          OUTINS   SETX0POS        GEN - SX0 1 FOR FILE ORDINAL 
* 
 CHAIN3   OUTINS   RJCHAN          GEN - RJ BASCHAN 
          JP   REPEAT 
          EJECT 
* 
*  LEFT - SUBSCRIPT - PAREN 
* 
 LACTLSS  BSS    0                 UNSTACKED BY ) OR , OR : 
          SX6    X6-LXCOL 
          ZR     X6,LACTSSV        IF UNSTACK BY : TREAT AS ANSI SUBSTR 
          SA1       ANDSTACK+B2         FIRST SUBSCRIPT 
          UX1       B6,X1 
          SB5       SIMKND
          NE        B5,B6,BILLSUB       NOT SIMPLE
          RJ        FETCH               FETCH SUBSCRIPT 
          INCRAND 
          OUTINS SXPT5
          SETVINX FVINXWD 
          OUTINS SHFTLT 
         SA5       BASE             GET BASE OF ARRAYS
         UX5       B0,X5
         NZ        X5,BAZONE        BRANCH IFBASE ONE 
*        CASE WHEN BASE 0 
          ARTHPAIR FLOATADD 
         EQ        LACTL9 
 BAZONE   ARTHPAIR FLOATSUB 
 LACTL9   OUTINS NEGBOUND 
          SA1    SACTEMP1 
          SX1    X1-LXCOM 
          NZ     X1,LACTLA   UNSTACKED BY ) 
          OUTINS UNPACK 
          OUTINS LFTSHIFT 
          OUTINS PACKB0 
 LACTLA   BSS    0
          OUTINS NORMLIZE 
          DECRAND 
          SA1       ANDSTACK+B2 
          UX1       B5,X1 
          SB6       SVKIND
      SX7        B0 
          NE        B5,B6,LACTL1       NOT STRING ARRAY 
          SX7       B6
 LACTL1 BSS      0
          SA7       SUBSTR
          RJ        GETARADR            DECLARE ARRAY 
          SA1       ANDSTACK-1+B2       GET ARRAY-DESCRIPTOR
          MX3       59
          IX6       X1-X3 
          SA6       A1                  INCREASE SUBSCRIPT-COUNT
          UPANDPTR
          SA2       ANDSTACK-ANDINCR+B2 
          SX4       X6
          IX7       X2+X4 
          INCRAND 
          SA7       ANDSTACK+B2         CONSTRUCT ENTRY FOR DOPE-ELEMENT
          RJ        FETCH               FETCH DOPE-ELEMENT
          OUTINS    SUBSCSUB
          OUTINS    PLBOUNDS            AND CHECK FOR LENGTH
          DECRAND 
          SA1       SACTEMP1
          SX6       LSSC
          SX1       X1-LXCOM
          ZR        X1,STACK1           IF COMMA THEN EXIT
          OUTINS    UNPACK              MAKE INTEGER
          OUTINS    LFTSHIFT
 LACTL2   BSS       0 
          DECRAND 
          RJ        FETCH               FETCH BASE
          UPANDPTR
          OUTINS    FIXADD              ADD BASE
          DECRAND 
          RJ        CHECKDIM            CHECK FOR CORRECT NO OF SUBSC.
          SETVINX   SIMAINXW            SET ADDRESS IN X
          SA2       SUBSTR
          ZR        X2,MAINLOOP 
          SX6       B0
          SA6    A2                RESET SUBSTR 
          SETVINX  SVAINX1W 
          JP        MAINLOOP
* 
SUBSTR     DATA     0 
          EJECT 
* 
*  SUBSCRIPT - COMMA
* 
 LACTSSC  BSS       0                   UNSTACKED BY ) OR , 
          SA1       ANDSTACK+B2         NEXT SUBSCRIPT
          UX1       B6,X1 
          SB5       SIMKND
          NE        B5,B6,BILLSUB       NOT SIMPLE
          RJ        FETCH               FETCH SUBSCRIPT 
          INCRAND 
          OUTINS SXPT5
          SETVINX FVINXWD 
          OUTINS SHFTLT 
         SA5       BASE             GET ARRAY BASE
         UX5       B0,X5
         NZ        X5,BASSON1       BRANCH BASE ONE 
*        CASE BASE ZERO 
          ARTHPAIR FLOATADD 
         EQ   LACTS9
*        CASE BASE ONE
 BASSON1  ARTHPAIR FLOATSUB 
 LACTS9   OUTINS NEGBOUND 
          SA1    SACTEMP1 
          SX1    X1-LXCOM 
          NZ     X1,LACTSA   UNSTACKED BY ) 
          OUTINS UNPACK 
          OUTINS LFTSHIFT 
          OUTINS PACKB0 
 LACTSA   BSS    0
          OUTINS NORMLIZE 
          DECRAND 
      SA1        ANDSTACK-ANDINCR+B2
      UX1        B5,X1
      SB6        SVARKND
      SX7        B0 
      NE         B5,B6,LACTS2 
      SX7        B6 
LACTS2 BSS       0
      SA7        SUBSTR 
          RJ        FETCH               FETCH ACCUMULATED VALUE 
          SA1       ANDSTACK-ANDINCR-1+B2  GET ARRAY-DESCRIPTOR 
          MX3       59
          IX6       X1-X3 
          SA6       A1                  INCREASE SUBSCRIPT-COUNT
          UPANDPTR
          SA2       ANDSTACK-2*ANDINCR+B2 
          SX4       X6
          IX7       X2+X4 
          INCRAND 
          SA7       ANDSTACK+B2         CONSTRUCT ENTRY FOR DOPE-ELEMENT
          RJ        FETCH               FETCH DOPE-ELEMENT
          OUTINS    SUBSCMUL            MULTIPLY ACCUMULATED VALUE
          OUTINS    SUBSCSUB
          OUTINS    PLBOUNDS            AND CHECK FOR LENGTH
          DECRAND 
          ARTHPAIR  FLOATADD            ADD NEXT SUBSCRIPT
          OUTINS    NORMLIZE            AND NORMALIZE 
          SA1       SACTEMP1
          SX6       LSSC
          SX1       X1-LXCOM
          ZR        X1,STACK1           IF COMMA THEN EXIT
          OUTINS    UNPACK              MAKE INTEGER
          OUTINS    LFTSHIFT
LACTS1    BSS       0 
          DECRAND 
          RJ        FETCH               FETCH BASE
          UPANDPTR
          OUTINS    FIXADD              ADD BASE
          DECRAND 
          RJ        CHECKDIM            CHECK FOR CORRECT NO OF SUBSC.
          SETVINX   SIMAINXW            SET ADDRESS IN X
          SA2       SUBSTR
          ZR        X2,MAINLOOP 
          SA6    A2 
          SETVINX SVAINX1W
          JP        MAINLOOP
          EJECT 
* 
*  ARITHMETIC OPERATORS 
* 
*     UNARY PLUS
* 
 LACTUNP  BSS       0 
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX1       B6,X1 
          AX1       30
          NE        B5,B6,BILLAOPR      KIND NE SIMPLE
          SX2       X1-CONST
          SX1       X1-INT
 +        ZR        X2,*+1              CLASS = CONSTANT
          NZ        X1,LACTUNP1         CLASS NE INTEGER
          SA2       SIMCONWD
          BX6       X2
          SA6       A1                  SET CLASS TO CONSTANT 
          JP        REPEAT
* 
 LACTUNP1 BSS       0                   OPERAND NOT CONSTANT
          RJ        FETCH 
          JP        REPEAT
* 
*     UNARY MINUS 
* 
 LACTUNM  BSS       0 
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX1       B6,X1 
          AX1       30
          NE        B5,B6,BILLAOPR      KIND NE SIMPLE
          SX2       X1-CONST
          SX1       X1-INT
 +        ZR        X2,*+1              CLASS = CONSTANT
          NZ        X1,LACTUNM1         CLASS NE INTEGER
 +        SA1       ANDSTACK-1+B2 
          BX6       -X1                 COMPLEMENT
          NX6       X6,B6               REMOVE -0 
          SA6       A1
          SA1       SIMCONWD
          BX6       X1
          SA6       ANDSTACK+B2         SET CLASS TO CONSTANT 
          JP        REPEAT
* 
 LACTUNM1 BSS       0                   OPERAND NOT CONSTANT
          RJ        FETCH 
          OUTINS    COMPLMNT            BX.I  -X.I
          OUTINS    NORMLIZE            NX.I  B6,X.I
          JP        REPEAT
* 
*     ADD 
* 
 LACTPLU  BSS       0 
          SA1    ANDSTACK+B2
          UX1    B6,X1
          SB5    SIMKND 
          NE     B5,B6,PLUSTR      MUST BE STRING CONCATENATION 
* 
          ARTHPAIR  FLOATADD            FX.J X.I+X.J
          OUTINS    NORMLIZE            NX.J B6,X.J 
          JP        REPEAT
* 
PLUSTR    BSS    0
          SB5    SVKIND 
          EQ     B5,B6,PLUSTR1
          SB5    SYSTKND
          EQ     B5,B6,PLUSTR1
          SB5    STKIND 
          NE     B5,B6,SERROR 
 PLUSTR1  BSS    0
          SA1    ANDSTACK+B2-ANDINCR
          UX1    B6,X1
          SB5    SVKIND 
          EQ     B5,B6,PLUSTR2
          SB5    SYSTKND
          EQ     B5,B6,PLUSTR2
          SB5    STKIND 
          NE     B5,B6,SERROR 
* 
 PLUSTR2  BSS    0
          RJ     CLEAR
          SB2    B2-ANDINCR 
          RJ     FETCH             FIRST STRING 
          OUTINS SB6AI
          SB2    B2+ANDINCR 
          RJ     FETCH             SECOND STRING
          OUTINS SB7AI
          DECRAND 
          OUTINS RJSTRCN
          OUTINS RELEATOP 
          OUTINS SAIB7
          SETVINX   SVAINXW 
          EQ     REPEAT 
* 
*     SUBTRACT
* 
 LACTMIN  BSS       0 
          ARTHPAIR  FLOATSUB            FX.J X.I-X.J
          OUTINS    NORMLIZE            NX.J B6,X.J 
          JP        REPEAT
*     MULTIPLY
* 
 LACTSTA  BSS       0 
          ARTHPAIR  FLOATMUL            FX.J X.I*X.J
          JP        REPEAT
* 
*     DIVIDE
* 
 LACTSLA  BSS       0 
          RJ        FETCH 
          OUTINS    ZERODIV             ZR XJ,BASEZER 
          ARTHPAIR  FLOATDIV            FX.J X.I/X.J
          JP        REPEAT
* 
*     EXPONENTIATE (POWER)
* 
 LACTPOW  BSS       0 
          RJ        FETCH               BRING EXPONENT INTO X5
          SB2       B2-ANDINCR
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX1       B6,X1 
          NE        B5,B6,BILLAOPR
          RJ        FETCH 
          SB2       B2+ANDINCR
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX1       B6,X1 
          NE        B5,B6,BILLAOPR
          MX7       57
          BX1       -X7*X1
          SX7       X1-5
          ZR        X7,POW1            EXP IN X5
          OUTINS    BX5XI 
          OUTINS    BX4XJ 
POW1      OUTINS    RJPOWER 
          DECRAND 
          SETVINX   SIMVINXW
          SA1       ANDSTACK+B2 
          MX7       57
          BX1      -X7*X1 
          SX7       X1-5
          ZR        X7,POW2            RESULT IN X5 
          OUTINS    BXIX5 
POW2      BSS       0 
          JP        REPEAT
* 
*     LEFT ARITHMETIC PARENTESIS
* 
 LACTLAR  EQU       MAINLOOP
* 
*         LOGICAL  OPERATORS
* 
* 
*         **NOT** 
* 
* 
 LACTNOT  BSS    0
* 
          OUTINS SETX0POS          SET X0 TO 1
          RJ     FETCH
          OUTINS BXIJE0            EXCL OR OF J AND X0
          EQ     REPEAT 
* 
*         **AND** 
* 
 LACTAND  BSS    0
          SA1    NOTEQJMP 
          BX7    X1 
          SA7    RELOPR 
          SX7    BXIJAK 
          EQ     LANDOR 
* 
*         **OR**
* 
 LACTOR   BSS    0
* 
          SA1    NOTEQJMP 
          BX7    X1 
          SA7    RELOPR 
          SX7    BXIJOK 
 LANDOR   BSS    0
********************************************************
*                                                      *
*   THIS IS JUST ABOUT A DIRECT COPY OF ARTHPAIR       *
*     EXCEPT THIS IS CHECKING FOR LOGKND RATHER        *
*     THAN SIMKND.                                     *
*                                                      *
********************************************************
          SA7    ARTHOPR
          SB2    B2-ANDINCR 
          SA1    ANDSTACK+B2
          SB5    LOGKND 
          UX1    B6,X1
          NE     B5,B6,BILLAOPR 
          RJ     FETCH
          SB2    B2+ANDINCR 
          SA1    ANDSTACK+B2
          SB5    LOGKND 
          UX1    B6,X1
          NE     B5,B6,BILLAOPR 
          RJ     FETCH
          SA1    ARTHOPR
          OUTINS X1 
          DECRAND 
          SETVINX   LOGVINXW
          EQ     REPEAT 
* 
          EJECT 
* 
*  BEGIN LINE 
* 
 LACTBEG  BSS       0 
         LNCHECK   BLINERR
          SA1    SEQNO             OLD LINE NUMBER
          SX6    X6 
          SA6    A1                NEW LINE NUMBER
         IX1       X6-X1
          PL     X1,LACTBG1 
          RJERROR BERR51     LINES OUT OF ORDER 
          OUTINS EQ119
 LACTBG1  BSS    0
          OUTINS    SETLINNO
          DECRAND 
          SX6       LSET                STACK NEXT ACTION 
          JP        STACK1
* 
*   SET LINE NUMBER 
* 
 LACTSET  BSS       0                   UNSTACKED BY STATEMENT-VERBS ETC
          SX2       X6-LXNOSET
          ZR        X2,REPEAT           DO NOT GENERATE SA0 XXX 
          OUTINS     SETLINEX           SA0 XXX 
          SA1    DBFLG             CHECK FOR CID MODE 
          ZR     X1,ATTCHK         BR, CID DISABLED 
          OUTINS DBLN              GENERATE RJ =XDBUG.LN
 ATTCHK   SA1    PREFLG            CHECK FOR ON ATTN
          ZR     X1,DBOPT          BR, DONT MODIFY PREAMBLE 
*    HERE TO MODIFY PREAMBLE FOR T.I. PROCESSING
          OUTINS INTLD             LOAD T.I. FLAG 
          OUTINS INTJP             JP, PROCESS T.I. 
 DBOPT    SA1    DBOPTION          CHECK FOR TRACE OPTION 
          PL     X1,REPEAT
          SA1    TRCPTSW     TRACE,PART IN EFFECT 
          ZR     X1,LSET1    NO 
          OUTINS RJTRC1 
          EQ     REPEAT 
 LSET1    BSS    0
          OUTINS RJTRC
          EQ     REPEAT 
          EJECT 
* 
*  MAT  AND ALL ITS ASSOCIATED FELLOWS
* 
*     MAT 
* 
 LACTMAT  BSS       0                   UNSTACKED BY = OR READ OR PRINT 
          SX1       X6-LXEQU
          NZ        X1,LACTMAT1         LXFIELD NOT = 
          SA1       ANDSTACK+B2 
          SB5       SVKIND
          UX1       X1,B6 
          EQ        B5,B6,BILLMAT      NO STRING IN MAT 
          RJ        GETARADR
          MATUSE
          RJ        CHECKDIM
          SX6       LMAE
          JP        STACK1
* 
 LACTMAT1 BSS       0 
          SA1       X6+LACTMATT-2 
          SX7    X1 
          AX1    30 
          SA7       FETADDR             PREPARE FILE I/O
          SX6       X1
          JP        STACK1
* 
 LACTMATT VFD    30/LMPR,30/1          PRINT
          VFD    30/LMRD,30/FETCHAN+2  READ 
          VFD    30/LMIP,30/FETCHAN+2  INPUT
          VFD    30/LMWR,30/1          WRITE
          EJECT 
* 
*     MAT=
* 
 LACTMAE  BSS       0 
          SX2       X6-LXEOS
          ZR        X2,LACTMAE2         EOS 
          SX2    X6-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X2,LACTMAE2   BR, -ELSE- DID UNSTACK THIS
          SX2    X6-2              SET INDEX (LXEOS NO LONGER = 2)
          SX3       X6-LXSTA
          SA1       X2+LACTMAET-1       GET ACTION TO STACK 
      MI         X2,BILLMAT 
          PL        X3,LACTMAE1         NOT (ARITH OR (MFUN 
          SX6       X1
          JP        STACK1
 LACTMAE1 BSS       0                   IT IS + OR - OR * 
          RJ        GETARADR
          MATUSE
          RJ        CHECKDIM
          RJ        FETCH               FETCH DESCRIPTOR OF FIRST OP. 
          SA1       SACTEMP1
          SX2       X1-LXSTA
          SX4    X2+BSTMBIN        ADDRESS
          SA3       LACTMAEA            GET PROTOTYPE 
          BX6       X3+X4 
          SA6       ANDSTACK+B2         SET UP ANDSTACK FOR MAT FUNCTION
          SX6       LMCL
          JP        STACK1
 LACTMAE2 BSS    0             UNSTACKED BY -EOS- -ELSE-
*         THIS TESTS CURRENT TOP FOR ASSGNT 
          SA1    ANDSTACK+B2
          UX1    B6,X1
          SB5    MOKIND 
          NE     B5,B6,MATASS 
          DECRAND                       MAT OP IS ON TOP OF ANDSTACK
          RJ        FETCH               FETCH DESCRIPTOR OF RESULT
          SB2       B2+ANDINCR
* 
          OUTINS    CALLTOPS            GENERATE CALL FOR MAT OP
          DECRAND 
          DECRAND 
          JP        REPEAT
* 
 MATASS   BSS    0
          RJ     GETARADR 
          MATUSE
          RJ     CHECKDIM 
          RJ     CHKDIM2     CHECK SAME NO OF DIMS
          RJ     FETCH
          SA3    LACTMAEA 
          SX4    MASSEX 
          BX6    X3+X4
          SA6    ANDSTACK+B2
          DECRAND 
          RJ     FETCH
          SB2    B2+ANDINCR 
          OUTINS CALLTOPS 
          DECRAND 
          DECRAND 
          JP     REPEAT 
* 
 LACTMAET BSS       0 
          VFD       60/LLMF             (MFUN 
          VFD       60/LLSC             (ARITH
          EJECT 
* 
*         MAT (SCM
* 
 LACTLSC  BSS       0                   UNSTACKED BY )
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX1       B6,X1 
          NE        B5,B6,BILLAOPR      NOT SIMPLE
          RJ        FETCH               FETCH SCALAR
          SX4    BSTMSCM
          SA3       LACTMAEA            GET PROTOTYPE 
          BX6       X3+X4 
          SA6       ANDSTACK+B2         SET MAT FUN TO SCM
          SX6       LRSC                SET SCM)
          JP        STACK1
* 
*         MAT SCM)
* 
 LACTRSC  BSS       0                   UNSTACKED BY *
* 
*         MAT FUN 
* 
 LACTLMF  BSS       0                   UNSTACKED BY )
          SX6       LMCL
          JP        STACK1
* 
*         GENERALIZED MAT CALL
* 
 LACTMCL  BSS       0                   UNSTACKED BY EOS
          SA1       ANDSTACK+B2 
          SB5       SVKIND
          UX1       X1,B6 
          EQ        B5,B6,BILLMAT      NO STRING IN MAT 
          RJ        GETARADR
          MATUSE
          RJ        CHECKDIM
          RJ        FETCH               FETCH DESCRIPTOR OF SEC PAR.
          DECRAND 
          DECRAND 
          RJ        FETCH               FETCH DESCRIPTOR OF RESULT
          SB2       B2+ANDINCR          NOW GET OPERATION 
          SA1       ANDSTACK+B2 
          SB5       MFKIND
          UX2       B6,X1 
          NE        B5,B6,BILLMAT       KIND NOT MATFUN 
          OUTINS    CALLTOPS            GENERATE CALL FOR MAT FUN 
          DECRAND 
          DECRAND 
          JP        REPEAT
* 
*         DET 
* 
 LACTDET  BSS    0
          SA1    SACTEMP1    (X1) = SUBCLASS OF UNSTACKING SYMBOL.
          SX6    X1-LXLDT 
          ZR     X6,REPEAT   DO NOTHING IF *DET*(...).
          RJ     LACTDET1    PUT OUT CODE.
          EQ     REPEAT      CONTINUE UNSTACKING. 
 +        NO
* 
 LACTDET1 BSSZ   1
          SA1    ANDSTACK+B2
          SB5    SIMKND 
          UX2    B6,X1
          NE     B5,B6,BILLMAT  KIND NOT SIMPLE FUNCTION. 
          RJ     CLEAR       GEN - CODE TO SAVE ANY REGS IN USE.
          OUTINS CALLTOPS    GEN - RJ BASMDET 
          SA1    SIMVINXW    MARK RESULT IN X5. 
          SX6    5
          BX6    X6+X1
          SA6    ANDSTACK+B2
          OUTINS REGRES      MARK X5 IN USE.
          EQ     LACTDET1 
* 
*         SPECIAL LEFT PARENTHESIS FOR *DET*(<MATRIX>). 
* 
 LACTLDT  BSS    0
          SA1    ANDSTACK+B2
          SB5    SVKIND 
          UX1    B5,X6
          EQ     B5,B6,BILLMAT  NO STRING IN MAT. 
          RJ     GETARADR 
          MATUSE
          RJ     CHECKDIM 
          RJ     FETCH       FETCH DESCRIPTOR OF PARAMETER. 
          DECRAND 
          SA1    ANDSTACK+B2
          SX6    BSFNTBL4-BSFNTBL2  SWITCH TO BASMDTX . 
          IX6    X1+X6
          SA6    A1 
          RJ     LACTDET1    PUT OUT CODE.
          EQ     MAINLOOP 
          EJECT 
* 
*         MAT READ
* 
 LACTMRD  BSS       0 
          SX1       X6-LXFIL
          BX5    X6 
          SX6       LMRF
          ZR        X1,SETFILE          IT IS MAT READ FILE 
          SX1    X5-LXPND          TRY FILE-NO-SIGN (POUND-SIGN)
          ZR     X1,FINDFIL        IF IT IS GO ANALYSE THE FILE NO
          BX6    X5                RESTORE THE UNSTACK REASON 
* 
          TESTAND   EQ,0,BILLMIO        NO OPERAND IS ERROR 
          SA1       BDAREFL 
          SB6       -1
          LX1       30
          PX6       B6,X1               SET READ FLAG 
          LX6       30                    IN DATA-READ FLAG WORD
          SA6       A1
          SX7    2                 MAT READ PTR 
          SA7    MRPTR
          EQ        LACTMIR             CONTINUE IN COMMON PART 
* 
 LACTMRF  BSS       0                   MAT READ FILE 
          TESTAND   EQ,0,BILLMIO        NO OPERAND IS ERROR 
          INCRAND 
          SA1       FETADDR 
          NG     X1,FRTMRD         SKIP IF FET WILL BE FOUND AT RUNTIME 
          BX6       X1
          SA6       ANDSTACK+B2 
          OUTINS    SETB5FET            SB5 B4+FET REL ADDR 
 FRTMRD   BSS    0
          DECRAND 
          OUTINS   RJIRD0 
          SX7    4                 MAT READ FILE PTR
          SA7    MRPTR
          EQ        LACTMIR             CONTINUE IN COMMON PART 
          EJECT 
* 
*         MAT INPUT 
* 
 LACTMIP  BSS       0 
          SX1       X6-LXFIL
          BX5    X6 
          SX6       LMIF
          ZR        X1,SETFILE          IT IS MAT INPUT FILE
          SX1    X5-LXPND          TRY FILE-NO-SIGN (POUND-SIGN)
          ZR     X1,FINDFIL        IF IT IS GO ANALYSE THE FILE NO
          BX6    X5                RESTORE THE UNSTACK REASON 
* 
 LACTMIF  BSS       0                   MAT INPUT AND MAT INPUT FILE
          TESTAND   EQ,0,BILLMIO        NO OPERAND IS ERROR 
          INCRAND 
          SA1       FETADDR 
          NG     X1,FRTMIN         SKIP IF FET WILL BE FOUND AT RUNTIME 
          BX6       X1
          SA6       ANDSTACK+B2 
          OUTINS    SETB5FET            SB5  B4+FET REL ADDR
 FRTMIN   BSS    0
          DECRAND 
          MX7    0                 MAT INPUT PTR
          SA7    MRPTR
* 
 LACTMIR  BSS       0                   COMMON READ/INPUT 
* 
 LACTMX1  BSS       0                   READ/INPUT LIST 
          TESTAND   EQ,0,LACTMRD1       NO OPERAND
          SA1    MRPTR             PREPARE PTR
          SX6    X1                KEEP IT IN X6
          SA1       ANDSTACK+B2 
          SB5       SVKIND
          UX1       X1,B6 
          EQ     B5,B6,LACTMS1     GO TO STRING ARRAYS
          SB5    X6 
 LACTMS2  BSS    0                 PREPARE RJ GENERATION
          SA1    B5+RJMTAB          GET EXT ROUTINES
          SB5    X1                GET RTJ
          SA2    B5                AND
          BX7    X2                STORE
          SA7    MATINOP           IT FOR OUTINS
          EQ     LACTMS3
 LACTMS1  BSS    0
          SB5    X6+1              UPDATE PTR 
          EQ     LACTMS2           JOIN THE CROWD 
 LACTMS3  BSS    0                 SINK 
          RJ        GETARADR
          MATUSE
          RJ        CHECKDIM
          SA1       SACTEMP1
          SX1       X1-LXLSS
          NZ        X1,LACTMRD2         NOT PARANTHESIS 
          INCRAND                       UP ANDSTACK 
          SA1       LTOROUT+LMX2
          SB3       B3+TORINCR          UP TORSTACK 
          BX7       X1
          SA7       TORSTACK+B3         RESET LACTMRD1
          SX6       LLMO
          JP        STACK1
* 
 LACTMX2  BSS       0                   RETURN HERE AFTER MATOP)
          DECRAND 
 LACTMRD2 BSS       0 
          RJ        FETCH               GET DESCRIPTOR OF RESULT
          DECRAND 
          OUTINS    MATINOP             RJ MATIN
 LACTMRD1 BSS       0 
          SA1       SACTEMP1
          SX6    X1-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X6,REPEAT     BR, -ELSE- DID UNSTACK THIS
          SX6       LMX1
          SX1       X1-LXEOS
          ZR        X1,REPEAT           SEPARATOR = EOS 
          JP        STACK1
* 
 MATINOP  BSSZ      1 
 MRPTR    BSS    1
 RJMTAB   VFD    42/0,18/RJMATINP 
          VFD    42/0,18/RJMATIS
          VFD    42/0,18/RJMATRED 
          VFD    42/0,18/RJMATRS
          VFD    42/0,18/RJMATRFL 
          VFD    42/0,18/RJMATRSF 
          EJECT 
* 
*         MAT WRITE 
* 
 LACTMWR  BSS       0 
          SX1       X6-LXFIL
          BX5    X6 
          SX6       LMWF
          ZR        X1,SETFILE          IT IS MAT WRITE FILE
          SX1    X5-LXPND          TRY FILE-NO-SIGN (POUND-SIGN)
          ZR     X1,FINDFIL        IF IT IS GO ANALYSE THE FILE NO
          BX6    X5                RESTORE THE UNSTACK REASON 
          EQ        BILLMAT             MAT WRITE WITHOUT FILE IS ILLEG.
* 
 LACTMWF  BSS       0 
          TESTAND   EQ,0,BILLMIO        NO OPERAND IS ERROR 
          INCRAND 
          SA1       FETADDR 
          NG     X1,FRTMWR         SKIP IF FET WILL BE FOUND AT RUNTIME 
          BX6       X1
          SA6       ANDSTACK+B2 
          OUTINS    SETB5FET            SB5  B4 + FET REL ADDR
 FRTMWR   BSS    0
          DECRAND 
          OUTINS   RJOWR0 
* 
 LACTMW1  BSS       0 
          TESTAND   EQ,0,LACTMWR1       NO OPERAND
          SA1       ANDSTACK+B2 
          SB5       SVKIND
          UX1       X1,B6 
          EQ     B5,B6,LACTMWR2 
          RJ        GETARADR
          MATUSE
          RJ        CHECKDIM
          RJ        FETCH               FETCH DESCRIPTOR OF PAR.
          DECRAND 
          OUTINS    RJMATWRT            RJ BASMWRT
 LACTMWR1 BSS       0 
          SA1       SACTEMP1
          SX6    X1-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X6,REPEAT     BR, -ELSE- DID UNSTACK THIS
          SX6       LMW1
          SX1       X1-LXEOS
          ZR        X1,REPEAT           SEPARATOR = EOS 
          JP        STACK1
 LACTMWR2 BSS    0
          RJ     GETARADR 
          MATUSE
          RJ     CHECKDIM 
          RJ     FETCH
          DECRAND 
          OUTINS RJMATWRS 
          EQ     LACTMWR1 
          EJECT 
* 
*         MAT PRINT 
* 
 LACTMPR  BSS       0 
          SX1       X6-LXFIL
          BX5    X6 
          SX6       LMPF
          ZR        X1,SETFILE          IT IS MAT PRINT FILE
          SX1    X5-LXPND          TRY FILE-NO-SIGN (POUND-SIGN)
          ZR     X1,FINDFIL        IF IT IS GO ANALYSE THE FILE NO
          BX6    X5                RESTORE THE UNSTACK REASON 
* 
 LACTMPF  BSS       0 
          TESTAND NE,0,MPF1 
          SA1    SACTEMP1    IF NO OPERAND
          SX6    X1-LXUSI     IT MUST BE
          NZ     X6,BILLMIO   -MAT PRINT USING- 
 MPF1     BSS    0
          INCRAND 
          SA1       FETADDR 
          NG     X1,FRTMPR         SKIP IF FET WILL BE FOUND AT RUNTIME 
          BX6       X1
          SA6       ANDSTACK+B2 
          OUTINS    SETB5FET            SB5 B4 + FET REL ADDR 
 FRTMPR   BSS    0
          DECRAND 
          OUTINS    RJOSRT              RJ BASOSRT
          SA1    SACTEMP1 
          SX6    X1-LXUSI    DID USING CAUSE UNSTACK
          NZ     X6,LACTMP1  NYET 
          BX7    X7-X7
          SX6    LMPU 
          SA7    ONANDIF
          EQ     STACK1 
* 
 LACTMP1  BSS       0 
          TESTAND   EQ,0,LACTMPR1       NO OPERAND
          SA1       ANDSTACK+B2 
          SB5       SVKIND
          UX1       X1,B6 
          EQ     B5,B6,LACTMP2
         SB5       MFKIND       MATRIX FUNCTIONS
         EQ        B5,B6,BILLMAT
          RJ        GETARADR
          MATUSE
          RJ        CHECKDIM
          RJ        FETCH               FETCH DESCRIPTOR OF PAR.
          DECRAND 
          SA1       SACTEMP1
          SX2    X1-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X2,MPRNT1     BR, -ELSE- DID UNSTACK THIS
          SX2    X1-LXEOS      DID -EOS- UNSTACK THIS?
          NZ     X2,LACTMPZ    BR, -EOS- DID NOT UNSTACK THIS 
 MPRNT1   BSS    0             HERE FOR -ELSE- -EOS-
          SX1    2                 SET INDEX
 LACTMPZ  BSS    0
          OUTINS    (X1+SETX4POS-1)     SX4 TERMINATOR
          OUTINS    RJMATPRT            RJ BASMPRT
 LACTMPR1 BSS       0 
          SA1       SACTEMP1
          SX6    X1-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X6,REPEAT     BR, -ELSE- DID UNSTACK THIS
          SX6       LMP1
          SX1       X1-LXEOS
          ZR        X1,REPEAT           SEPARATOR = EOS 
          JP        STACK1
 LACTMP2  BSS    0
          RJ     GETARADR 
          MATUSE
          RJ     CHECKDIM 
          RJ     FETCH
          DECRAND 
          SA1    SACTEMP1 
          SX2    X1-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X2,MPRNT2A    BR, -ELSE- DID UNSTACK THIS
          SX2    X1-LXEOS      DID -EOS- UNSTACK THIS?
          NZ     X2,LACTMP3    BR, -EOS- DID NOT UNSTACK THIS 
 MPRNT2A  BSS    0             HERE FOR -ELSE- -EOS-
          SX1    2           SET INDEX
 LACTMP3  BSS    0
          OUTINS (X1+SETX4POS-1)
          OUTINS RJMATPRS 
          JP     LACTMPR1 
* 
* 
* 
          SA2    F.LABS 
          IX1    X1+X2
          SA1    X1-1              SECOND WORD OF LABEL 
          SA5    SEQNO             LINE NUMBER
          LX5    36 
          BX7    X5+X1             MERGE LINE NUMBER
 LACTMPU  RJ     PRU               PROCESS USING
          NZ     B4,MPU2           IF IMAGE REFERENCE 
 MPU1     BSS    0
          RJ     FETCH
 MPU2     BSS    0
          SETVINX LOGVINXW
          SA1    SACTEMP1 
          SX6    X1-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X6,BILLMIO    BR, -ELSE- DID UNSTACK THIS
          SX6    LMPV          PRESET X6
          SX1    X1-LXEOS     NO OPERAND IS ERROR 
          ZR     X1,BILLMIO 
          EQ     STACK1 
* 
* 
* 
 LACTMPV  BSS    0
          TESTAND EQ,2,MPV2  NO OPERAND 
          SA1    ANDSTACK+B2
          UX1    B5,X1
          SB6    MFKIND                MATRIX FUNCTION
          EQ     B5,B6,BILLMAT         IS ILLEGAL 
          RJ     GETARADR 
          MATUSE
          RJ     CHECKDIM 
          DECRAND 
          RJ     FETCH       IMAGE
          INCRAND 
          SA1    ANDSTACK+B2
          SB6    SVARKND
          UX1    X1,B5
          NE     B5,B6,MPV1 
          RJ     FETCH
          SX2    1
          EQ     MPV12
 MPV1     BSS    0
          RJ     FETCH
          BX2    X2-X2
 MPV12    BSS    0
          SA1    SACTEMP1    WHAT UNSTACKED THIS
          SX1    X1-LXSEM    IS IT SEMI-COLON 
          NZ     X1,MPV11    NO 
          SX2    X2+2 
 MPV11    BSS    0
          OUTINS (X2+SETXIPOS)         SX3 TERMINATOR 
          OUTINS RELEATOP 
          OUTINS RJMATPRU 
          DECRAND 
          SA1    SACTEMP1 
          SX6    X1-LXELS      DID -ELSE- UNSTACK THIS? 
          ZR     X6,MPV2       BR, -ELSE- DID UNSTACK THIS
          SX6    LMPV 
          SX1    X1-LXEOS 
          ZR     X1,MPV2
          EQ     STACK1 
* 
 MPV2     BSS    0
          DECRAND 
          EQ     REPEAT 
          EJECT 
* 
*         ( MAT OP
* 
 LACTLMO  BSS       0                   UNSTACKED BY , OR ) 
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX1       B6,X1 
          NE        B5,B6,BILLAOPR      NOT SIMPLE
          RJ        FETCH 
         SA5       BASE 
         UX5       B0,X5
         NZ        X5,BAZONE1 
*     CASE BASE ZERO
          INCRAND 
          OUTINS    SXPLONE             SX.NEW  1 
          SETVINX   FVINXWD 
 LACTLM1  OUTINS PACKB0 
          ARTHPAIR ROUNDADD  RX5   X5+X4
         EQ       LACTLM9 
*     CASE BASE IS ONE
 BAZONE1  RJ     RESERVE
          INCRAND 
          SETVINX FVINXWD 
          OUTINS BXIPZRO     BX4   X4-X4
          EQ     LACTLM1
LACTLM9  OUTINS    NORMTOX6 
          SA1       ANDSTACK-ANDINCR-ANDINCR+B2   PTR TO DOPE 
          SA2       ANDSTACK-ANDINCR-ANDINCR-1+B2 NEW 
          MX3       59                            -1
          IX6       X2-X3 
          SX4       X6
          SA6       A2                  NEW .= NEW + 1
          IX7       X1+X4 
          SA7       ANDSTACK+B2         SET ANDSTACK TO DOPE-ELEM. ADDR 
          OUTINS    STOREDOP            SA6   B4 + ADDR 
          DECRAND 
          SA1       SACTEMP1
          SX6    LLMX 
          SX1       X1-LXCOM
          ZR        X1,STACK1 
          DECRAND 
          RJ        CHECKDIM
          SB2       B2+ANDINCR
          JP        MAINLOOP
* 
*   TOROUT ACTION FOR LEFT PAREN FOR SUBSTRING AFTER SUBSCRIPTED
*   STRING VARIABLE.  STACK SUBSTRING LEFT PAREN (LTSBT). 
* 
 LACTSSV  SX6    LSBT 
          EQ     STACK1 
* 
*   TOROUT ACTION FOR SUBSTRING LEFT PAREN. UNSTACKED BY RIGHT PAREN. 
*   STACK SUBSTRING OPERATOR(LTSUB).
* 
 LACTSBT  SX6    LSUB 
          EQ     STACK1 
 LACTSUB  BSS    0                 SUBSTRING OPERATOR 
* 
*   SUBSTRING OPERATOR TOROUT ROUTINE.
* 
*    IF UNSTACKED BY = THEN STACK LTLSUB (LEFT SIDE SUBSTRING) AND
*    RETURN TO READ. IF UNSTACKED BY COMMA OR EOL THEN CHECK TOP
*    OPERATOR. IF ITS A READ OR INPUT TOROUT THEN:  
*        SAVE IT. 
*        REPLACE IT WITH A LTRDSUB. 
*        RESERVE A TEMPORARY STRING AND ANDSTACK IT.
*        GO TO THE SAVED TOROUT ROUTINE.
*    OTHERWISE: 
*        GENERATE SUBSTRING-ON-THE-RIGHT CODE.
* 
          SA1    ONANDIF           IF DURING IF STATEMENT 
          SX1    X1-IFTYP          IT MUST BE A 
          ZR     X1,LACSUB2        RIGHT SIDE SUBSTRING.
          SA1    B7                PRESET A1. 
 LACTSUBX SA1    A1-1              GET PREVIOUS CHAR. 
          SB5    X1-1R             IF ITS A BLANK GO GET
          ZR     B5,LACTSUBX       THE NEXT PREVIOUS. 
          SX1    X1-1R= 
          SA2    SACTEMP1          IF UNSTACKED BY
          ZR     X1,LACSUBT        GO CHECK FOR LET.
          SX1    X2-LXCOM          IF NOT UNSTACKED 
          ZR     X1,LACSUB1        BY A COMMA 
          SX1    X2-LXEOS          OR AN EOS THEN 
          NZ     X1,LACSUB2        GO GENERATE RIGHT SIDE CODE. 
 LACSUB1  SB5    LTRF2-LTINP       GET LENGTH OF TABLE SCAN.
          SA3    B3+TORSTACK       GET 1ST TORSTACK ENTRY.
 LACSUBL  SA1    B5+LTINP          SCAN TOROUT TABLE INPUT
          IX1    X1-X3             AND READ ENTRIES LOOKING 
          ZR     X1,LACSUBM        FOR A MATCH. 
          SB5    B5-1 
          PL     B5,LACSUBL 
          EQ     LACSUB2           GO GENERATE RIGHT SIDE CODE. 
 LACSUBT SX6     LLSUB
          SA1    TORSTACK+B3       CHECK TOP OF TORSTACK
          SX1    X1-LACTLET        FOR LET. 
          NZ     X1,STACK1         NO, GO STACK LSUB
          SB3    B3-TORINCR        YES, THROW IT AWAY 
          EQ     STACK1            GO STACK LSUB
* 
*   AT THIS POINT WE HAVE A SUBSTRING IN A READ OR INPUT. 
* 
 LACSUBM  BSS    0
          SX6    X3                GET THE TOROUT ADDRESS OF 1ST STACK
          SA6    SAVETOR           ENTRY AND SAVE IT. 
          SA1    LTOROUT+LRDSUB    PLACE THE
          BX6    X1                RDSUB OPERATOR IN PLACE
          SA6    B3+TORSTACK       OF TOP OPERATOR. 
          RJ     STMPLOC           GET A WORD OF TEMPORARY STORAGE. 
          SA1    RDSINS            BUILD AN ANDSTACK
          BX7    X7+X1             ENTRY AND
          INCRAND                  STICK IT ON
          SA7    B2+ANDSTACK       THE STACK. 
          MX6    0
          SA6    A7-1 
          INCRAND 
          SA7    A7+2              STACK AGAIN FOR READ OR INPUT
          SA6    A7-1              TO UNSTACK.
          SA1    SAVETOR           TRANSFER CONTROL 
          SB6    X1                TO THE I/O TOROUT
          JP     B6                WE HAD SAVED.
 RDSINS   VFD    12/2000B+SVKIND,18/SINS,30/0 
*   WE COME HERE IF WE HAVE A SUBSTRING ON THE RIGHT. 
* 
*   FIRST LETS CHECK THE ARGUMENTS. 
* 
 LACSUB2  SA1    ANDSTACK+B2       GET THE LAST ARGUMENT. 
          UX1    B5,X1
          SB6    SIMKND            IF ITS NOT SIMPLE THEN 
          NE     B5,B6,BILLAOPR    ITS AN ERROR.
          SA1    ANDSTACK+B2-2     GET THE MIDDLE ARGUMENT. 
          UX1    B5,X1             IT ALSO MUST BE
          NE     B5,B6,BILLAOPR    SIMKND.
          SA1    ANDSTACK+B2-4     GET THE FIRST ARGUMENT.
          UX1    B5,X1
          SB6    STKIND            IT MUST BE A STRING. 
          EQ     B5,B6,ANSUBOK
          SB6    SYSTKND
          EQ     B5,B6,ANSUBOK
          SB6    SVKIND 
          NE     B5,B6,BILLAOPR 
* 
*   NOW LETS FETCH THE REGISTERS WE NEED. 
* 
 ANSUBOK  RJ     CLEAR
          RJ     FETCH             SA5   N. 
          DECRAND 
          RJ     FETCH             SA4   M. 
          DECRAND 
          RJ     FETCH             SA3   A$.
          OUTINS RJANSR            RJ    =XBASANSR. 
          MX7    59                RESET THE REGISTER 
          SA7    REGSTPTR          RESERVATION STACK. 
          OUTINS SAIB7             SA5   B7+B0. 
          SETVINX SVAINXW          PUSH X5 ON THE STACK.
          EQ     REPEAT            CONTINUE UNSTACKING. 
 SAVETOR  CON    0
* 
*   TOROUT ACTION FOR SUBSTRING IN A READ OR INPUT. GENERATE CODE TO
*   SET X0 TO 0 TO INDICATE RETURN OF TEMPORARY STRING. CALL LSUBGEN
*   TO GENERATE SUBSTRING ON THE LEFT CODE. IF UNSTACKED BY A COMMA,
*   RESTACK THE READ OR INPUT OPERATOR, OTHERWISE CONTINUE TO UNSTACK.
* 
 LACTRDSB BSS    0
          OUTINS SETX0ZER          GEN SX0 0 TO INDICATE RETURN OF TEMP$
          RJ     LSUBGEN           GO GENERATE SUBSTRING ON LEFT CODE 
          SA1    SACTEMP1          GET UNSTACKING LX
          SX1    X1-LXCOM 
          NZ     X1,REPEAT         IF NOT COMMA, CONTINUE UNSTACKING
          SA1    INTYPE            GET THE LAST INPUT TYPE
          SA1    X1+INPOINT        RETRIEVE THEIR INDEX TO TOROUT 
          SX6    X1 
          EQ     STACK1            GO STACK IT
 INPOINT  CON    LRE2              INDEXES TO TOROUT FOR RESTACKING 
          CON    LRF2 
          CON    LIN2 
* 
*   TOROUT ACTION FOR LEFT SIDE SUBSTRING. IF TORSTACK IS EMPTY GENERATE
*   A SX0 0 OTHERWISE GENERATE A SX0 1. THE LATTER WILL INHIBIT RELEASE 
*   OF TEMPORARY STRINGS WHEN DOING MULTIPLE ASSIGNMENT. NEXT CALL
*   LSUBGEN TO GENERATE ASSIGNMENT CODE. CONTINUE UNSTACKING. 
* 
 LACTLSUB BSS    0
          RJ     CLEAR             SAVE REGISTERS FOR BASANSL CALL
          EQ     B3,B0,LSUBREL     RELEASE TEMP$ IF STACK EMPTY 
          SA1    ANDSTACK+B2       SAVE SOURCE STRING 
          SA2    ANDSTACK+B2-1
          BX6    X1 
          BX7    X2 
          SA6    SAVSRC 
          SA7    SAVSRC+1 
          OUTINS SETX0POS          OTHERWISE RETAIN TEMP$ 
          RJ     LSUBGEN           GENERATE CODE
          INCRAND 
          SA1    SAVSRC 
          SA2    SAVSRC+1          RESTACK SOURCE STRING
          BX6    X1 
          BX7    X2 
          SA6    ANDSTACK+B2
          SA7    ANDSTACK+B2-1
          EQ     REPEAT 
 LSUBREL  OUTINS SETX0ZER          RELEASE TEMP$
          RJ     LSUBGEN           GENERATE CODE
          EQ     REPEAT 
 SAVSRC   BSS    2
* 
*    ROUTINE TO GENERATE CODE COMMON TO LEFT SIDE ANSI SUBSTRING AND
*    SUBSTRING IN READ OR INPUT.
* 
 LSUBGEN  DATA   0
          RJ     FETCH
          OUTINS SB7AI             PUT ADDRESS IN B7. 
          DECRAND 
          RJ     CLEAR
          RJ     FETCH             GET 'N' ARGUMENT.
          SA1    ANDSTACK+B2       GET THE
          UX7    B5,X1             GET OPERAND TYPE.
          SB6    SIMKND            IF ITS NOT A SIMPLE
          NE     B5,B6,BILLAOPR    THEN ITS AN ERROR. 
          DECRAND 
          RJ     FETCH             GET 'M' ARGUMENT.
          SA1    ANDSTACK+B2       GET THE
          UX7    B5,X1             GET OPERAND TYPE.
          SB6    SIMKND            IF ITS NOT A SIMPLE
          NE     B5,B6,BILLAOPR    THEN ITS AN ERROR. 
          DECRAND 
          RJ     FETCH             GET TARGET STRING. 
          SA1    ANDSTACK+B2       GET OPERAND. 
          UX7    B5,X1             EXTRACT THE TYPE.
          SB6    STKIND            IT MUST BE A STRING. 
          EQ     B5,B6,SPARMOK
          SB6    SYSTKND
          EQ     B5,B6,SPARMOK
          SB6    SVKIND 
          NE     B5,B6,BILLAOPR 
 SPARMOK  OUTINS SB6AI             PUT ADDRESS IN B6. 
          DECRAND 
          OUTINS RJANSL            GEN RJ =XBASANSL.
          MX7    59                RESET THE
          SA7    REGSTPTR          REGISTER RESERVE STACK.
          EQ     LSUBGEN
* 
*  OPERATOR ACTION ROUTINE FOR THE -RANDOMIZE- FUNCTION.
* 
 LACTRAN  BSS    0
          RJ     CLEAR
          OUTINS RJRAN
          JP     REPEAT 
* 
*  OPERATOR STACK ACTION ROUTINE FOR -RND- FUNCTION 
* 
 LACTRND  BSS    0
          SA1    SACTEMP1 
          SX6    X1-LXLSB          DID -SUBRTN LEFT PAREN- UNSTACK THIS 
          ZR     X6,REPEAT         BR, IF LEFT PAREN DID UNSTACK THIS 
          RJ     CLEAR             GEN. CODE TO CLEAR ANY REGS IN USE 
          OUTINS SETX5ZER          GENERATE SX5 0 FOR RND WITH NO PARAM 
          OUTINS CALLTOPS          GENERATE RJ =XBASARND
          SA1    SIMVINXW          MARK RESULT IN X5
          SX6    5
          BX6    X6+X1
          SA6    ANDSTACK+B2
          OUTINS REGRES            MARK X5 IN USE.
          EQ     REPEAT      CONTINUE UNSTACKING. 
          EJECT 
* 
*  END-ACTION.  UNSTACKED BY EOS FOLLOWING END. 
* 
 BENDACT  BSS       0 
 LACTEND  EQU       BENDACT 
          SX7    1
          SA7    ENDFLAG           SET FLAG TO DENOTE *END* UNSTACKED.
          SA1    B7-1              GET UNSTACK CHAR 
          SX1    X1-70B            CHECK FOR APOSTROPHE 
          NZ     X1,BENDAT1        BR, NOT UNSTACKED BY APOSTROPHE
* 
*         SKIP OVER COMMENT TO REAL EOS 
* 
 ENDLP    SA1    B7                LOAD NEXT CHAR 
          SB7    B7+1              INCR CHAR UNPACK BUFF PTR
          SX1    X1-101B           CHECK FOR EOS
          NZ     X1,ENDLP          BR, AT EOS 
 BENDAT1  RJ     READ              SKIP EOL FOLLOWING EOS 
          RJ        READ
          SX1       X2-LVEOP            NEXT SYMBOL MUST BE EOP 
          ZR        X1,BENDCH1
          RJERROR   BERR8               END NOT LAST
 BENDCH1  BSS       0 
* 
*  CHECK IF READ HAS A MATCHING DATA
* 
          SA1       BDAREFL 
          UX1       B5,X1 
          LX1       30
          UX1       B6,X1 
          SB5       B5+B6 
          PL        B5,BENDCH2          READ AND DATA OR NO READ
          RJERROR   BERR14              READ WITHOUT DATA 
 BENDCH2  BSS       0 
* 
*  NOW CHECK FOR EMPTY ANDSTACK 
* 
         LE        B2,B0,BENDCH3  TEST OPERAND STACK
*  STACK NOT EMPTY, COULD BE *FOR W/O NEXT* OR *DEF W/O FNEND*
*                OR AN ILLEGAL *END* STATEMENT. 
          SA1    SEQNO             SAVE END LINE NUMBER 
          SX7    X1 
          SA7    FNENDSAV 
          SA1    ENDFLAG           CHECK IF *END* STATEMENT 
          ZR     X1,BENDCH2A       BR IF NO *END* STATEMENT 
          TESTAND  EQ,0,BENDCH2A   BR,ANDSTACK EMPTY RELATIVE TO FORPTR 
*   ERROR IF *END* W/NON-EMPTY ANDSTACK RELATIVE TO FORPTR. 
          RJERROR  BERR80          ISSUE *ILLEGAL STATEMENT* MSG. 
          SX7    B0 
          SA7    ENDFLAG           RESET *END* FLAG 
          DECRAND 
* 
 BENDCH2A BSS    0
          SA1    DEFFLAG           BYPASS IF NOT IN DEF 
          ZR  X1,BENDCH4
* 
*  CHECK FOR *FOR W/O NEXT* WITHIN DEF
 BENDCH7  SA1    DEFPTR            CHECK FOR *FOR* STUFF
          SB5    X1+3*ANDINCR 
          EQ  B5,B2,BENDCH5        JUMP IF NO MORE *FOR* IN DEF 
          RJ  BENDCH6              ISSUE *FOR WITHOUT NEXT* 
          EQ  BENDCH7              TRY FOR MORE 
* 
 BENDCH5  BSS    0                 NOW FOR THE DEF STUFF
          SA1    FNENDSAV          RESTORE END LINENO 
          SX6    X1 
          SA6    SEQNO
          RJERROR  BERR103         *FNEND MISSING*
          DECRAND                  GET RID OF DEF STUFF 
          DECRAND 
          DECRAND 
* 
 BENDCH4  BSS    0                 NO LONGER IN DEF 
          LE  B2,B0,BENDCH3        JUMP IF EMPTY STACK
          RJ  BENDCH6              ISSUE *FOR WITHOUT NEXT* 
          EQ  BENDCH4              TRY FOR MORE 
* 
* 
 ENDFLAG  DATA   0                 FLAG TO DENOTE *END* WAS UNSTACKED.
* 
 BENDCH6  DATA   0                 ROUTINE TO ISSUE *FOR WITHOUT NEXT*
          SA5       ANDSTACK-1+B2      GET LINE NO OF FOR 
          RJ        LABELCTR
          SA1       B6
          AX1       36
          MX7    38                MASK FOR 
          BX6    -X7*X1            LINE NUMBER
          SA6    SEQNO
          DECRAND 
          DECRAND 
          RJERROR   BERR9               FOR WITHOUT NEXT
          JP  BENDCH6              RETURN 
* 
* 
 BENDCH3  BSS       0 
* 
*  FINISH THE GENERATED CODE
* 
          OUTINS  RJERS            REVERT TO SYSTEM-ERROR-HANDLING
          OUTINS    CLEARB7             SB7 B0
          OUTINS    CLLEGEN             JP BASEGEN
          RJ     OUTWORD           FINISH WORD
* 
*  FIND TOP OF SYSTEM ROUTINES
* 
          SB6       BEXTLNG 
          SX7       B0                  X7 HOLDS MAX TOP
          MX6       42
 BENDL1   SA1       B6+BSFUNTBL-1 
          UX1       B5,X1               B5 .= USE-BIT 
          AX1       30                  X1 .= TOP ADDRESS OF SUBROUTINE 
          ZR        B5,BENDL2           SUBROUTINE NOT USED 
          IX2       X7-X1 
          PL        X2,BENDL2           TOP < MAX TOP 
          BX7       -X6*X1              MAX TOP .= TOP
 BENDL2   SB6       B6-1
          LT        B0,B6,BENDL1
          SA7       ABSSTRT             ABSSTRT .=
          MX6    0
          SA1    XOPTION
 +        ZR     X1,*+1            IF NOT RELOCATABLE 
          SA6    ABSSTRT
* 
*  NOW  CLEAN UP THE LABEL STACK
* 
          SB6    NUMLBLS-1
          JP        BDEFLCNT            CHECK FOR NO LABEL FIRST
 BLABLOOP SA4    F.LABS 
          SA4    X4+B6             LABEL DESCRIPTOR 
          BX0    X4                PRESERVE LABEL DESCRIPTOR (WORD 1) 
          SX2       X4                  X2 .= VALUE 
          PL        X4,BUNDEFL          LABEL IS UNDEFINED
          SA5    A4-B1
          AX5    36          P.U. CALLER LINENO 
          SX5    X5 
          ZR     X5,BLABOK
          SA5    A4                FORMAT BIT IN WORD1
          LX5    1           MUST BE ON.
          PL     X5,PREPF14 
 BLABOK   BSS    0
          SA1    DBOPTION 
          LX1    2           BINARY REGARDLESS SW 
          NG     X1,BLABOK1 
          SA5       ERRORFL             GET ERROR-FLAG
          NZ        X5,BDEFLCNT         IN ERROR BYPASS CHAIN-COMPLETION
 BLABOK1  BSS    0
          AX4       18                  POSITION POS,LINK RIGHT 
          SA1       ABSSTRT 
          IX2       X1+X2               VALUE .= VAL - INSTSRT+ABSSTRT
          SX6    X2 
          SA6    STARVLU           DUMP P-COUNTER VALUE 
          SA5    F.CODE 
          SB2    X5 
 BDEFLLP  BSS    0
          SA2    STARVLU           LOAD P-COUNTER VALUE 
          MX6    44 
          BX7       -X6*X4              X7 .= LINK
          ZR        X7,BDEFLCNT         END OF CHAIN REACHED
          AX4       16
          MX6       58
          BX6       -X6*X4              X6 .= POS 
          BX5       X6
          LX6       4 
          IX6       X6-X5               X6 .= 15*POS, I.E. SHIFTCOUNT 
          SB5       X6                  B5 .= SHIFTCOUNT
          SB3       -B5 
          SB3       B3+60               B3 .= 60-SHIFTCOUNT 
          SA5    X7+B2             INSTRUCTION WORD 
          LX5       B3,X5               POSITION IT RIGHT 
          LX7    X0,B1
          PL     X7,BLLPNXT        BR IF NOT AN IMAGE -STATEMENT- 
*  CHECK FOR TYPE OF IMAGE REFERENCE
          MX3    54 
          SB3    36 
          LX7    X5,B3             RIGHT JUSTIFY OPCODE FOR CHECK 
          BX3    -X3*X7            EXTRACT GENERATED INSTRUCTION OPCODE 
          SX3    X3-50B            CK FOR SET-TYPE INSTRUCTION OPCODE 
          NG     X3,BLLPNXT        BR IF REFERS TO IMAGE -STATEMENT-
*  REFERENCE IS TO IMAGE -FORMAT- WITHIN THE
*  CONSTANTS AREA.
          BX2    X0                GET IMAGE -FORMAT- OFFSET FROM 
          LX2    24                LABEL TABLE WORD                      BAS0022
 BLLPNXT  BSS    0
          SX4    X5 
          MX7       42
          BX6       -X7*X2              TRUNCATE VALUE TO 18 BITS 
          BX5       X7*X5               CLEAR RECEIVING FIELD 
          BX6       X6+X5               INSERT VALUE INTO INSTRUCTION 
          LX6       B5,X6               REPOSITION
          SA6       A5                     AND STORE
          JP        BDEFLLP             REPEAT
 BDEFLCN  BSS    0                 THIS INSTRUCTION USED IF RELOCATABLE 
 BDEFLCNT SA1    L.LABS            SIZE OF LABELS 
          SB6    B6+2 
          SB5    X1 
          LT     B6,B5,BLABLOOP    IF NOT DONE
* 
*  SCAN FUNCTION-TABLE FOR UNDEFINED USER FUNCTIONS 
* 
          SA1    F.FUNS            START OF FUNCTIONS 
          SB2    X1 
          SB3       NUMBFUN-1           B3 .= NO POSSIBLE USER FUN-S
 BFUNLOOP SA1       B2+B3               GET TABLE ENTRY 
          SA1    A1+B3             FN ORDINAL * 2 
          SX5       X1
          ZR        X1,BFUNCNT          THIS FUN NOT USED 
          NG        X1,BFUNCNT          FUN USED AND DEFINED
          RJ        LABELCTR            SEARCH LABELSTACK FOR LABEL 
          SA1       B6
          SX6    X1                SET LINE OF REFERENCE
          SA6    SEQNO
          SX6       B2
          PX6       B3,X6 
          SA6       BUNDFWK             SAVE POINTERS 
          RJERROR   BERR38              GIVE MESSAGE UNDEFINED FUN
          SA1       BUNDFWK 
          UX1       B3,X1 
          SB2       X1                  RESTORE POINTERS
 BFUNCNT  SB3       B3-1
          PL        B3,BFUNLOOP 
* 
*  ALLOCATE STORAGE FOR ARRAYS
* 
          SB5       NUMBVAR-1           PRESET IDTABLE POINTER
          SB2       NUMRVAR-1 
 ARREND0  SA1    F.IDS
          SA1    X1+B5             IDTABLE
          LX1       1                   CHECK SUBSCRIPT-BIT 
          PL        X1,ARREND9
          LX1       29
          UX2       B6,X1               GET DIMENSION AND DOPE-ADDR 
          LX1       32                  CHECK DIM-USE 
          NG        X1,ARREND1
          LX1       1                   IF NO DIM CHECK FOR MAT 
          PL        X1,ARREND1          NO MAT
*         MAT WITHOUT DIM 
 ARREND1  BSS       0 
          GT        B6,ARREND4
          SB6       2                   SET FOR TWODIMENSIONAL
 ARREND4  BSS       0 
          SA4    F.CONS            START OF CONSTANTS 
          IX2       X4+X2 
          SA5       X2+B6               CONSTRUCT SIZE
 ARREND2  BSS       0 
          SB6       B6-1
          SA4       X2+B6 
          LE        B6,ARREND3          END OF SIZE-EVALUATION
          FX5       X5*X4 
          JP        ARREND2 
 ARREND3  BSS       0 
          UX5       B6,X5 
          SA3       VARCONT 
          LX5       X5,B6               INTEGERIZE LENGTH 
 ARREND20 BSS       0 
          SX3       X3
          SX5       X5
          IX6       X3+X5               UPDATE VARCONT
          SA6       A3
          LX5       30
          IX7       X5+X3               SET UP FIRST WORD OF DOPE 
          SA7       X2                  STORE FIRST WORD OF DOPE
 ARREND9  BSS       0 
          SB5       B5-1                DOWN IDTABLE POINTER
          PL        B5,ARREND0
          SA1    DBOPTION 
          LX1    2           BINARY REGARDLESS SW 
          NG     X1,ARRND10 
          SA1       ERRORFL 
          NZ        X1,COMPILE          EXIT IF ERRORS
 ARRND10  BSS    0
* 
*  COMPACT STORAGE BY MOVING DATA AND CONSTANTS DOWN ON TOP OF CODE 
* 
          MX1    1                 PUT INFINITE AT END OF DATA
          ADDWRD DATA,X1
          MX1    0                 ZERO AT START OF VARIABLES 
          ADDWRD CONS,X1
          OUTINS NOPS              NO OPS 
          RJ     OUTWORD           OUTPUT WORD
          SA1    SB1DATA           GENERATE SB1 START OF DATA 
          SA5    INSTPTR
          SA4    ABSSTRT           STARTING LOCATION
          IX5    X5+X4
          SB2    3           CODE YET TO COME NOT IN DEBUG
          SA2    DBFLG             CHECK FOR CID MODE 
          ZR     X2,NODB1          BR, CID DISABLED - NORMAL MODE 
          SB2    7           CODE YET TO COME  IN DEBUG 
 NODB1    SB2    X5+B2             CORRECT FOR CODE YET TO COME 
          SX6    X5-1 
          SA6    PRENTRY           SET ENTRY POINT FOR BINARY 
          SX5    B2 
          LX5    30 
          IX1    X1+X5             INSERT ADDRESS INTO INSTRUCTION
          RJ     OUTINS            GENERATE SB1 START OF DATA 
          SA1    SB4CONS
          SA5    L.DATA            SIZE OF DATA 
          SX4    X5+B2
          SB2    X4 
          LX4    30 
          IX1    X4+X1
          RJ     OUTINS            GENERATE SB4 START OF CONSTANTS
          SA1    SB2VARS
          SA5    L.CONS 
          SB2    B2-B1             CORRECT ADDRESS
          SX4    X5+B2
          SB2    X4 
          LX4    30 
          IX1    X4+X1
          RJ     OUTINS            GENERATE SB2 START OF VARIABLES
          SA1    SX4INPB     GET THE INSTRUCTION SKELETON.
          SA5    VARCONT     GET THE BEGINNING
          SX5    X5+2        OF THE INPUT 
          SX4    X5+B2       CONVERSION 
          LX4    30          BUFFER AND ADD 
          IX1    X1+X4       IT TO THE INSTRUCTION SKELETON.
          SA4    HVLSTCT     INCREASE THE VARIABLES 
          IX6    X4+X5       BLOCK LENGTH BY THE LENGTH 
          SA6    A5          OF THE LONGEST VARIABLE LIST.
          RJ     OUTINS      GO GENERATE SX4 TO BEGINNING OF I C BUFFER 
          SA1    SX5COLL     GET THE INSTRUCTION SKELETON.
          SA5    COLLATE     GET THE COLLATE FLAG.
          LX5    30          SHIFT INTO POSITION
          IX1    X1+X5       ADD IT TO THE INSTRUCTION. 
          RJ     OUTINS      GO SX5 TO COLLATE FLAG 
          SA3   DBFLG           CHECK FOR CID MODE
          ZR    X3,NODB1A       BR, NOT IN CID MODE 
          SA3    DBOPTION 
          LX4    X3,B1
          BX3    X4*X3
          SA1    MX7DBOF
 +        PL     X3,*+1            IF NO DB 
          SA1    MX7DBON
          RJ     OUTINS            GENERATE MX7 
          SA3    ASOPTION 
          SA1    ASOFF
 +        ZR     X3,*+1 
          SA1    ASON 
          RJ     OUTINS            GENERATE MX6 
          OUTINS SB3ZERO
          SA3    PDOPTION 
          LX3    30+6 
          SA1    SB7PD
          IX1    X3+X1
          RJ     OUTINS            GENERATE SB7 PD
          OUTINS STARTUP           GENERATE RJ =XBASESRT
 NODB1A    BSS   0
          SA1    JPSTRT            JP TO START OF CODE
          SA2    ABSSTRT
          LX2    30 
          IX1    X2+X1             INSERT ADDRESS 
          RJ     OUTINS            GENERATE JUMP
          SA2    DBFLG             CHECK FOR CID MODE 
          ZR     X2,NODB2          BR, CID DISABLED - NORMAL MODE 
          SA1    JPDBUG            BUILD JP XFER ADDR 
          SA2    PRENTRY
          LX2    30 
          IX1    X1+X2
          RJ     OUTINS            GENERATE JP XFER ADDR
 NODB2    BSS    0
          SA1    XOPTION
          NZ     X1,COMPILE        IF NOT COMPILE TO CORE 
          SA1    L.DATA            SIZE OF DATA 
          SA2    F.DATA            START OF DATA
          SA3    INSTPTR           SIZE OF CODE 
          SA4    F.CODE 
          IX3    X3+X4             DESTINATION ADDRESS
          SX6    X3                RESET BASE OF DATA 
          SA6    A2 
          IX5    X3+X1             NEW BASE FOR CONSTANTS 
          RJ     =XMVE=            MOVE DATA TABLE
          SA1    L.CONS            SIZE OF CONSTANTS
          SA2    F.CONS            START OF CONSTANTS 
          BX3    X5 
          SX6    X5                RESET BASE OF CONSTANTS
          SA6    A2 
          RJ     =XMVE=            MOVE CONSTANTS 
* 
          EQ   COMPILE             DONE COMPILATION 
* 
* 
* 
* 
 PREPF14  SA4    F.LABS            PICK UP SECOND WORD OF LABEL 
          SB4    B6-B1
          SA4    X4+B4
          AX4    36                ISOLATE CALLERS LINE NUMBER
          SX6    X4                RESET LINE NUBMER
          SA6    SEQNO
          SX6    B6 
          SA6    BUNDFWK
          RJERROR  FSTER14         -USING- REFERENCE INVALID
          SA1    BUNDFWK
          SB6    X1 
          JP     BDEFLCNT 
* 
 STARVLU  BSSZ   1                 P-COUNTER OF CURRENT TARGET LABEL
          EJECT 
* 
*  WORKING LOCATIONS AND CONSTANTS FOR STACK ACTIONS
* 
 SACTEMP1 DATA      0 
 SACTEMP4 DATA   0                 BUFFER FOR PREVIOUS UNSTACK REASON 
 SACTEMP2 DATA      0 
* 
 BPREMPTY VFD    60/55000000000000000000B 
 DUMPTRWD VFD    6/40B,18/1,18/0,18/0 STRING PTR WORD FOR 1 BLANK 
 SIMCONWD VFD       12/2000B+SIMKND,18/CON,30/0 
 SIMVINXW VFD       12/2000B+SIMKND,18/VINX,30/0
 SIMAINXW VFD       12/2000B+SIMKND,18/AINX,30/0
 LACTMAEA VFD       12/2000B+MFKIND,18/FUN,30/0 
 LOGVINXW VFD       12/2000B+LOGKND,18/VINX,30/0
* 
 RELOPR   DATA      0                   SAVED JUMP FOR IF-STATEMENT 
 NEXTLAB  DATA      0 
* 
MAXLN    DATA      99999.0              MAXIMUM LINE NO 
MAXDIMS  DATA      131071.0             MAXIMUM BOUND 
 RJUMP    DATA   100000000B        RJ PSUEDO INSTR
 SETB0    DATA   6100046000B       SET BO PSUEDO INSTR
 COLLATE  DATA   1
          TITLE     OPERAND ACTIONS 
* 
*  OPERAND ACTIONS
* 
 BSYSFUN  SX0    X0+BSFNTBL0
          EQ     BVAR 
 BMATFUN  SX0    X0+BMFUNTBL
          EQ     BVAR 
 BMATOPR  SX0    X0+BMOPRTBL
          EQ     BVAR 
* 
 BUSEFUN  BSS       0 
          SA5    LTOROUT+LNPF      STACK FUNCTION PARAMETER 
          BX7    X5 
          SB3    B3+TORINCR 
          SA7    B3+TORSTACK
 PRTBT42  NO
          BSS    0
*  IF MULTILINE DEF STACK RESULT WORD INSTEAD OF FN NAME
          SA2    DEFFLAG           BYPASS IF NOT IN MULTILINE DEF 
          PL  X2,BVAR              NOT MULTILINE DEF, TREAT AS USUAL
          SA2    DEFPTR            FIND NAME OF FN BEING DEFINED
          SA2    X2+ANDSTACK+2*ANDINCR
          SB5    X2                FN BEING DEFINED 
          SB6    X0                FN BEING STACKED 
          NE  B5,B6,BVAR           NOT SAME, TREAT AS NORMAL FN NAME
*  THIS IS USE OF NAME FNA WITHIN THE DEF OF FNA
*  IT IS A LOCAL VARIABLE, THE RESULT WORD
*  STACK ITS DESCRIPTOR INSTEAD OF FN DESC
          SA1    A2+ANDINCR        GET RESULT DESC
          BX7    X1                STACK IT 
          INCRAND 
          SA7    ANDSTACK+B2
          MX6    0
          SA6    A7-B1       ZERO TO SECOND WORD OF ASTK
*  CHANGE LAST SYMBOL TO OPERAND SO UNARY OPERATORS 
*  WILL NOT GET CONFUSED
          SX6    IDSTART
          SA6    NS 
          JP  MAINLOOP
* 
* 
 BVAR     BSS       0 
          SX6       0 
* 
 BFILEID  BSS       0 
 BCONST   MX2       42
          BX0       -X2*X0              TRUNCATE ADDR/PTR TO 18 BITS
          BX1       X2*X1               CLEAR ADDR/PTR FIELD
          BX7       X0+X1               COMBINE THE TWO 
          INCRAND 
          SA7       B2+ANDSTACK         STACK NEW ENTRY 
          SA6       B2+ANDSTACK-1 
          JP        MAINLOOP
* 
 BVAR2    BSS    0
          SX0    X0+NUMRVAR 
          EQ     BVAR 
* 
 BSTRING  BSS    0
          SA2    DATAST            RESET DATAST IF STR$ FORMAT
          PL   X2,BSTRING1         SKIP IF DATA STMT
* 
 BEXT     BSS    0                 EXT NAME IS STR CONST
          SX7    B0                RESET READ FLAG
          SA7    DATAST 
* 
 BSTRING1 BSS    0
          SA2    STRADDR
          BX0    X2 
          SX6    X0 
          JP        BCONST
* 
 STRADDR  BSS    1
*                                  DIS,LEN,VAL,ETC
 BSYSFSV  SX0    X0+BFSVTBL 
          EQ     BVAR 
 BSYSFVS  SX0    X0+BFVSTBL        STR ETC
          EQ     BVAR 
* 
* 
*                                  SUBSTR ETC 
* 
 BSYSFXS  BSS    0
          SX7    WERR1      SET OBSOLETE FORM 
          SA7    WNSW 
          SA2    TORSTACK+B3
          SX6    X2-LACTLET 
          ZR     X6,BSYSFX1 
          SX6    X2-LACTSET 
          ZR     X6,BSYSFX1 
          SX6    X2-LACTTHE 
          ZR     X6,BSYSFX1 
          SX6    X2-LACTELS 
          NZ     X6,BSYSFN2 
 BSYSFX1  SX0    X0+BFSBSTR 
          EQ     BVAR 
* 
* 
 BSYSTR   SX0    X0+BSYSTBL        SYSTEM ROUTINE ADDRESS 
          MX2    42 
          BX1    X2*X1             CLEAR ADDR FIELD IN STACK ENTRY
          BX7    X0+X1             ADD IN ADDR OF RTN 
          SX6    B0 
          INCRAND 
          SA7    ANDSTACK+B2       STACK FN ADDR
          SA6    ANDSTACK+B2-1
          RJ   CLEAR               GEN - CODE TO SAVE ANY REGS IN USE 
          OUTINS  CALLTOPS         GEN - RJ BASDATE/BASACLK 
          OUTINS  SAIB7            GEN - SA5 B7  X5 = REL ADDR OF STRING
          SA1    SVAINXW           MARK RELADDR IN X5 
          SX6    5
          BX6    X6+X1
          SA6    ANDSTACK+B2
          JP   MAINLOOP 
* 
* 
 BSYSFN2  BSS    0           SUBSTR FUN 
          SX7    LVSST
          SA7    NS 
          SX1    X7-MINIDENT
          AX1    9
          SA1    BANDCTBL+X1
          SX0    LVSST-LCLASS28 
 BVARFN   SA2    FNBLOK+X0         VARIABLE PARAMETER FUNCTIONS 
          SX0    X0+BSVPFNTB
          BX6    X2 
          EQ     BCONST 
  
 BSYSFN4  SX0    X0+BSFNTBL3       TAB
          EQ     BVAR 
  
 BSYSFN3  SX0    X0+BSFNTBL2       ROUTINE ADDRESS
          MX2    42 
          BX1    X2*X1             CLEAR ADDR FIELD IN STACK ENTRY
          BX7    X0+X1
          SX6    B0 
          INCRAND 
          SA7    B2+ANDSTACK       STACK IT 
          SA6    B2+ANDSTACK-1
          SA1    LTOROUT+LDET  STACK OPERATOR FOR *DET* EVAL. 
          SB3    B3+TORINCR 
          BX7    X1 
          SA7    TORSTACK+B3
 PRTBT41  BSS    0
          JP     MAINLOOP 
          JP   MAINLOOP            DONE 
* 
* 
 BSPECFN  BSS    0                 SPECIAL FUNCTION - READ REQUIRED 
          SB6    X0                TAKE ACTION FOR PARTICULAR CASE
          JP   B6+SPECJMP 
 SPECJMP  BSS    0                 JUMP TABLE 
          JP   BSPECFN0            CLK OR CLK$
          JP   BSPECFN1            ASC
* 
 BSPECFN0 BSS    0                 HAVE CLK, IS IT CLK$ 
          READCH   PRTBT21         CHECK NEXT CHAR
          SX1    X1-1R$ 
          ZR   X1,SPECFN01         JUMP IF CLK$ 
          SB7    B7-1              BACKSPACE OVER CHAR
          SX6    LVCLK             WE HAVE CLK
          EQ   SPECFN02 
 SPECFN01 SX6    LVCLCK            WE HAVE CLK$ 
 SPECFN02 SA6    NS                ADJUST LAST SYMBOL 
          MX1    51 
          BX0    -X1*X6            EXTRACT FN INDEX 
          SX6    X6-MINIDENT       GET BANDCTBL INDEX 
          AX6    9
          SA1    X6+BANDCTBL
          SB6    X1 
          JP   B6                  PERFORM OPERAND ACTION 
* 
 BSPECFN1 BSS    0                 ASC COMPILE-TIME FN
          READCH PRTBT22           NEXT NON-BLANK CHAR MUST BE LPAREN 
          SX2    X1-1R( 
          NZ   X2,BILLASC 
          RJ   ABBSCAN             SCAN ABBREV, RETURNED IN X1, FLAG IN X2
          NG   X2,BILLASC          BAD FORMAT, EG PAREN MISSING 
          ZR   X2,SPECFN11         IT WAS ONE-CHARACTER ARG 
          EQ   SPECFN14            IT WAS ABBREVIATION
* 
 SPECFN11 BSS    0                 ASC(X) 
          RJ   ASCORD              FIND ASCII ORDINAL, RETURNED IN X1 
          NG   X1,BILLASC          NON-ASCII CHARACTER
          EQ   SPECFN19            GO STACK THE ORDINAL 
* 
 SPECFN14 BSS    0                 ASC(XX) OR ASC(XXX)
          RJ   ASCABBR             GO GET ASCII ORDINAL OF ABBREV IN X1 
          NG   X1,BILLASC          NOT A VALID ABBREVIATION 
* 
 SPECFN19 PX6    B0,X1             FLOAT ORDINAL, STACK AS INTEGER CONST
          SX0    B0 
          SA1    BANDCON
          SX7    WERR1       SET OBSOLETE FORM
          SA7    WNSW 
          EQ   BCONST 
* 
* 
*  OPERAND ACTION ROUTINE FOR -RND- FUNCTION
* 
 BRNDFN   BSS    0
          SB3    B3+TORINCR 
          SB5    LTORST            CHECK FOR TORSTACK OVERFLOW
          GE     B3,B5,TOROVFL
          SA4    LTRND
          BX7    X4 
          SA7    TORSTACK+B3       STACK LTRND OPERATOR FOR RND FUNCTION
 PRTBT43  BSS    0
          JP     BSYSFUN
          JP     BSYSFUN
* 
* 
* 
* 
* 
* 
 ABBSCAN  DATA   0
*  SCAN INPUT STRING AND COLLECT POSSIBLE ABBREVIATION
*  RETURN X1=CHARACTER RIGHT JUSTIFIED OR ABBREV AS XXX OR XX0
*  RIGHT JUSTIFIED.  RETURN X2 NEGATIVE FOR SCAN ERROR SUCH 
*  AS MISSING PAREN, X2=0 IF RESULT IS ONE-CHAR, ELSE RESULT
*  IS ABBREVIATION. 
*  USED BY ASC FUNCTION AND DELIMIT STMT. 
* 
          READCHB  PRTBT23         FIRST CHAR OF ARG
          BX6    X1 
          SX1    X6-LIEOS 
          ZR   X1,ABBERR           EOS IS ERROR 
          SA6    ABBHOLD           SAVE FIRST CHAR
          READCHB  PRTBT24         SECOND CHAR OF ARG 
          SX2    X1-LIEOS 
          ZR   X2,ABBERR           EOS IS ERR 
          SX2    X1-1R) 
          ZR   X2,ABBSCN1          WE HAVE (X), EXIT
          BX2    X1                SAVE SECOND CHAR 
          SA1    ABBHOLD           MUST BE AN ABBREVIATION
          PL   X1,ABBSCN2 
          RJ   CNVTESC             MAKE FIRST LETTER UPPERCASE
          SX3    X1-LIBAD 
          ZR   X3,ABBERR           WAS NOT A LETTER 
 ABBSCN2  BX7    X1                SAVE FIRST LETTER
          BX1    X2                SECOND ONE TO X1 
          PL   X1,ABBSCN3 
          RJ   CNVTESC             SECOND UPPERCASE 
          SX3    X1-LIBAD 
          ZR   X3,ABBERR           WAS NOT LETTER 
 ABBSCN3  LX7    6                 CONCATENATE LETTERS
          BX7    X7+X1
          SA7    ABBHOLD           SAVE XX
          READCHB  PRTBT25         THIRD CHAR OF ARG
          SX2    X1-LIEOS 
          ZR   X2,ABBERR           EOS IS ERR 
          SX2    X1-1R) 
          ZR   X2,ABBSCN7          WE HAVE (XX) 
          PL   X1,ABBSCN5 
          RJ   CNVTESC             THIRD UPPERCASE
          SX3    X1-LIBAD 
          ZR   X3,ABBERR           WAS NOT LETTER 
 ABBSCN5  SA2    ABBHOLD           ADD THIRD LETTER 
          LX2    6
          BX6    X2+X1
          SA6    A2                STORE BACK 
          READCHB  PRTBT26         FOURTH MUST BE RPAREN
          SX2    X1-1R) 
          NZ   X2,ABBERR
          EQ   ABBSCN4             WE HAVE (XXX)
* 
 ABBSCN1  BSS    0                 (X)
          SA1    ABBHOLD
          PL   X1,ABBSCN6          SKIP IF NOT ESCAPE CODE
          BX1    -X1               GET 74XX OR 76XX 
 ABBSCN6  SX2    B0                INDICATE ONE-CHAR RESULT 
          EQ   ABBSCAN              EXIT
* 
 ABBSCN7  BSS    0                 (XX) 
          SA1    ABBHOLD           XX 
          LX1    6                 XX0
          EQ   ABBSCN8
* 
 ABBSCN4  BSS    0                 (XXX)
          SA1    ABBHOLD
 ABBSCN8  SX2    1                 INDICATE RESULT IS ABBREV
          EQ   ABBSCAN              EXIT
* 
 ABBERR   BSS    0                 SCAN ERROR 
          MX2    1                 INDICATE ERROR 
          EQ   ABBSCAN              EXIT
* 
 ABBHOLD  BSS    1                 BUILD ABBREV HERE
* 
* 
* 
* 
* 
 ASCABBR  DATA   0
*  FIND ASCII ORDINAL OF ABBREVIATION IN X1 
*  2 OR 3 CHARACTER (UPPERCASE) ABBREV IN LOWER 18 BITS OF X1 
*  RETURN X1 = ORDINAL OR -1 IF NOT VALID ABBREVIATION
*  SEARCH TABLE OF ABBREVS, 3 18-BIT ENTRIES PER WORD 
*  POSITION OF MATCH IN TABLE GIVES ASCII ORDINAL 
* 
          ZR   X1,ASCABB2          DISALLOW 3 00 COLONS 
          SB5    1                 CONSTANT 
          SB6    -1                INIT ASCII ORDINAL 
          SA2    ASCTBL-1          INIT TABLE WORD ADDR 
 ASCABB1  SA2    A2+B5             FETCH NEXT TABLE WORD (3 ENTRIES)
          ZR   X2,ASCABB6          EXIT ON END OF TABLE 
          SB6    B6+3              INCR ASCII ORDINAL FOR THIRD ENTRY IN WORD 
          NG   X2,ASCABB1          IGNORE WORD WITH NO ENTRIES
          SX3    X2                THIRD ENTRY
          BX3    X3-X1             COMPARE
          ZR   X3,ASCABB3          MATCH ON THIRD ENTRY 
          AX2    18                SECOND ENTRY 
          SX3    X2 
          BX3    X3-X1
          ZR   X3,ASCABB4          MATCH ON SECOND
          AX2    18                FIRST ENTRY
          SX3    X2 
          BX3    X3-X1
          ZR   X3,ASCABB5          MATCH ON FIRST 
          EQ   ASCABB1             LOOP FOR NEXT WORD 
* 
 ASCABB3  SX1    B6                MATCH ON THIRD ENTRY 
          EQ   ASCABBR
 ASCABB4  SX1    B6-1              MATCH ON SECOND
          EQ   ASCABBR
 ASCABB5  SX1    B6-2              MATCH ON FIRST 
          EQ   ASCABBR
* 
 ASCABB6  BSS    0                 NOT IN FIRST TABLE, SEARCH SECOND
          SA2    ASCTBL1-1         INIT TABLE WORD ADDR 
 ASCABB7  SA2    A2+B5             FETCH WORD 
          ZR   X2,ASCABB2          EXIT ON END OF TABLE 
          SX3    X2                EXTRACT ABBREV 
          BX3    X3-X1             COMPARE
          NZ   X3,ASCABB7          LOOP ON NO MATCH 
          AX2    18                MATCH, EXTRACT ASCII ORDINAL 
          SX1    X2 
          EQ   ASCABBR             EXIT 
* 
 ASCABB2  SX1    -1                NOT IN EITHER TABLE
          EQ   ASCABBR             EXIT 
* 
* 
* 
 ASCTBL   BSS    0
*  TABLE OF ASCII ABBREVIATIONS IN ORDER OF ASCII ORDINAL 
*  EACH WORD CONTAINS 6 UNUSED BITS AND 3 18-BIT ENTRIES
*  NEGATIVE WORD MEANS NO ABBREVIATIONS FOR THESE THREE 
*  ORDINALS,  ZERO WORD ENDS TABLE
* 
*                ABBREVIATION      ORDINAL
          VFD 6/0 
          VFD    18/3LNUL          0
          VFD    18/3LSOH          1
          VFD    18/3LSTX          2
          VFD 6/0 
          VFD    18/3LETX          3
          VFD    18/3LEOT          4
          VFD    18/3LENQ          5
          VFD 6/0 
          VFD    18/3LACK          6
          VFD    18/3LBEL          7
          VFD    18/2LBS           8
          VFD 6/0 
          VFD    18/2LHT           9
          VFD    18/2LLF           10 
          VFD    18/2LVT           11 
          VFD 6/0 
          VFD    18/2LFF           12 
          VFD    18/2LCR           13 
          VFD    18/2LSO           14 
          VFD 6/0 
          VFD    18/2LSI           15 
          VFD    18/3LDLE          16 
          VFD    18/3LDC1          17 
          VFD 6/0 
          VFD    18/3LDC2          18 
          VFD    18/3LDC3          19 
          VFD    18/3LDC4          20 
          VFD 6/0 
          VFD    18/3LNAK          21 
          VFD    18/3LSYN          22 
          VFD    18/3LETB          23 
          VFD 6/0 
          VFD    18/3LCAN          24 
          VFD    18/2LEM           25 
          VFD    18/3LSUB          26 
          VFD 6/0 
          VFD    18/3LESC          27 
          VFD    18/2LFS           28 
          VFD    18/2LGS           29 
          VFD 6/0 
          VFD    18/2LRS           30 
          VFD    18/2LUS           31 
          VFD    18/2LSP           32 
          VFD 6/0 
          VFD    18/0              33  EXCLAMATION
          VFD    18/3LQUO          34  QUOTE
          VFD    18/0              35  POUND
          VFD 6/40B 
          VFD    18/0              36  DOLLAR 
          VFD    18/0              37  PERCENT
          VFD    18/0              38  AMPERSAND
          VFD 6/40B 
          VFD    18/0              39  APOSTROPHE 
          VFD    18/0              40  OPEN PAREN 
          VFD    18/0              41  CLOSE PAREN
          VFD 6/40B 
          VFD    18/0              42  ASTERISK 
          VFD    18/0              43  PLUS 
          VFD    18/0              44  COMMA
          VFD 6/40B 
          VFD    18/0              45  MINUS
          VFD    18/0              46  PERIOD 
          VFD    18/0              47  SLASH
          VFD 6/40B 
          VFD    18/0              48  0
          VFD    18/0              49  1
          VFD    18/0              50  2
          VFD 6/40B 
          VFD    18/0              51  3
          VFD    18/0              52  4
          VFD    18/0              53  5
          VFD 6/40B 
          VFD    18/0              54  6
          VFD    18/0              55  7
          VFD    18/0              56  8
          VFD 6/40B 
          VFD    18/0              57  9
          VFD    18/0              58  COLON
          VFD    18/0              59  SEMICOLON
          VFD 6/40B 
          VFD    18/0              60  LESS 
          VFD    18/0              61  EQUALS 
          VFD    18/0              62  GREATER
          VFD 6/0 
          VFD    18/0              63  QUESTION 
          VFD    18/0              64  AT 
          VFD    18/3LUCA          65  UPPERCASE LETTERS
          VFD 6/0 
          VFD    18/3LUCB          66 
          VFD    18/3LUCC          67 
          VFD    18/3LUCD          68 
          VFD 6/0 
          VFD    18/3LUCE          69 
          VFD    18/3LUCF          70 
          VFD    18/3LUCG          71 
          VFD 6/0 
          VFD    18/3LUCH          72 
          VFD    18/3LUCI          73 
          VFD    18/3LUCJ          74 
          VFD 6/0 
          VFD    18/3LUCK          75 
          VFD    18/3LUCL          76 
          VFD    18/3LUCM          77 
          VFD 6/0 
          VFD    18/3LUCN          78 
          VFD    18/3LUCO          79 
          VFD    18/3LUCP          80 
          VFD 6/0 
          VFD    18/3LUCQ          81 
          VFD    18/3LUCR          82 
          VFD    18/3LUCS          83 
          VFD 6/0 
          VFD    18/3LUCT          84 
          VFD    18/3LUCU          85 
          VFD    18/3LUCV          86 
          VFD 6/0 
          VFD    18/3LUCW          87 
          VFD    18/3LUCX          88 
          VFD    18/3LUCY          89 
          VFD 6/0 
          VFD    18/3LUCZ          90 
          VFD    18/0              91  OPEN BRKT
          VFD    18/0              92  BACKSLASH
          VFD 6/0 
          VFD    18/0              93  CLOSE BRKT 
          VFD    18/0              94  CIRCUMFLEX 
          VFD    18/3LUND          95  UNDERLINE
          VFD 6/0 
          VFD    18/3LGRA          96  GRAVE
          VFD    18/3LLCA          97  LOWERCASE LETTERS
          VFD    18/3LLCB          98 
          VFD 6/0 
          VFD    18/3LLCC          99 
          VFD    18/3LLCD          100
          VFD    18/3LLCE          101
          VFD 6/0 
          VFD    18/3LLCF          102
          VFD    18/3LLCG          103
          VFD    18/3LLCH          104
          VFD 6/0 
          VFD    18/3LLCI          105
          VFD    18/3LLCJ          106
          VFD    18/3LLCK          107
          VFD 6/0 
          VFD    18/3LLCL          108
          VFD    18/3LLCM          109
          VFD    18/3LLCN          110
          VFD 6/0 
          VFD    18/3LLCO          111
          VFD    18/3LLCP          112
          VFD    18/3LLCQ          113
          VFD 6/0 
          VFD    18/3LLCR          114
          VFD    18/3LLCS          115
          VFD    18/3LLCT          116
          VFD 6/0 
          VFD    18/3LLCU          117
          VFD    18/3LLCV          118
          VFD    18/3LLCW          119
          VFD 6/0 
          VFD    18/3LLCX          120
          VFD    18/3LLCY          121
          VFD    18/3LLCZ          122
          VFD 6/0 
          VFD    18/3LLBR          123  OPEN (LEFT) BRACE 
          VFD    18/3LVLN          124  VERTICAL LINE 
          VFD    18/3LRBR          125  CLOSE (RIGHT) BRACE 
          VFD 6/0 
          VFD    18/3LTIL          126  TILDE 
          VFD    18/3LDEL          127
          VFD    18/0 
          DATA   0                 END OF TABLE 
* 
* 
 ASCTBL1  BSS    0
*  TABLE OF ASCII ABBREVIATIONS AND ORDINALS FOR THOSE ORDINALS 
*  WITH MORE THAN ONE ABBREVIATION
*  EACH ENTRY IS 42/ORDINAL,18/ABBREVIATION 
*  ZERO WORD ENDS TABLE 
* 
          VFD    42/34,18/2LQT     QUOTE
          VFD    42/95,18/3LBKR    BACKARROW (UNDERLINE)
          DATA   0                 END OF TABLE 
* 
* 
          TITLE     READ (GET NEXT SYMBOL)
* 
*     READ.  THE READ ROUTINE IS ENTERED WITH B7 POINTING TO THE NEXT 
*          CHARACTER IN THE INPUT STRING.  AT EXIT THE NEXT SYMBOL IS 
*          LEFT BOTH IN X2 AND IN MEMORY AT NS.  AT EXIT TIME THE 
*          SYMBOL JUST FORMED IS CHECKED TO SEE IF IT SHOULD BE 
*          MODIFIED IN ACCORDANCE WITH THE PREVIOUS SYMBOL
* 
* 
* 
* 
 READ     JP        * 
 LREAD0   BSS    0
          SA3    DATAST 
          SX3    X3+1 
          NG     X3,LREAD18  BRANCH IF FORMAT OR STR$ UNQUOTED STRING 
          READCH PRTBT10     GET NEXT CHARACTER IN X1 
          SA3    X1+CHTAB          CHTAB ENTRY
          UX0       X3,B5               SPLIT ENTRY 
          SX4       B5                   RESERVE COUNT      X4
          SB6       X0                  FINAL ACTION INTO   B6
          LX0       30
          SX2       X0                   CHARACTER VALUE    X2
          UX0       B5,X0               RESERVE POINTER     B5
          SA3       DATAST             CHECK FOR UNQUOTED STRING IN 
          NZ        X3,LUNQUOT         DATA STATEMENT 
JPB6      BSS       0 
          JP        B6
          EJECT 
* 
*         OUTPUT ACTIONS FROM CHTAB 
* 
 LALPHF   BSS    0
          SA3    ONANDIF
          SX3    X3-IFTYP 
          ZR     X3,LALPH 
          SX4    2
          SB5    LFORE-LA 
          EQ     LALPH
* 
 LALPHT   BSS    0
          SA3    ONANDIF
          SX3    X3-IFTYP 
          ZR     X3,LALPH 
          SX4    6
          SB5    LTO-LA 
          EQ     LALPH
* 
 LALPHS   SA3       STATE               THIS ACTION EXISTS FOR THE
          SX3       X3-STA2               SPECIFIC CASE 
          NZ        X3,LALPH                FOR I= S TOP
         SX4       3   SET,STOP SUBSTR STMTS COME HERE
          SB5       LSTOP-LA
 LALPH    SX3       X1                  SAVE CHARACTER
          READCH    PRTBT11               AND CHECK NEXT
          SX5       X1-1R0                  FOR ALFABETIC 
          PL        X5,LREAD2                 IF NOT, GOTO LREAD2 
          LX3       6                   TEST FOR
          BX3       X3+X1                 FN
          SX3       X3-2RFN                IF YES,
          ZR        X3,LREAD3                GO TO LREAD3 
          ZR        X4,LREAD9           NO RESERVE POSSIBILITIES
 LREAD11  SX3       X1                  SAVE CHARACTER FOR RESERVE TEST.
          SX6       B7                  SAVE CHARACTER POINTER
          SA6       SAVEB7                FOR POSSIBLE BACK-UP
 LREAD8   SA5       B5+LA 
          BX0       X5                  LETTER COUNT TO X0
          AX0       57
          MX7       57
          BX0       -X7*X0
          MX7       18                  CLEAR RESERVED WORD 
          BX7       -X7*X5                PREPERATORY TO COMPARRISON
 LREAD6   ZR        X0,LREAD5           GO TO LREAD5 IF READY FOR TEST
          READCH    PRTBT12             GET NEXT CHAR 
          SX6       X1-1R0              CHECK FOR 
          PL        X6,LREAD4             NON-ALPHABETIC
LREAD6A  BSS       0
          LX3       6                     AND APPEND TO COMPARISON
          IX3       X3+X1                   WORD
          SX0       X0-1                DOWN LETTER COUNT 
          JP        LREAD6              LOOP
 LREAD5   IX7       X7-X3               CHECK FOR RESERVED MATCH. 
          ZR        X7,LREAD7           GOTO LREAD7 IF MATCH FOUND. 
          SX4       X4-1                DOWN COUNT. 
          SB5       B5+1                UP RESERVE POINTER. 
          NZ        X4,LREAD8           LOOP IF MORE POSSIBILITIES. 
LREAD4   BSS       0
         SX6       X1-1R$     CHECK IF FUNC NAME $
         ZR        X6,LREAD6A      ELSE 
         SA1       SAVEB7         RESTORE 
          SB7       X1                    CHARACTER 
          JP        LREAD9                  POSITION
 LREAD7   MX2       3                   MATCH FOUND. SYMBOL VALUE TO
          BX2       -X2*X5                X2
          AX2       42
         SX3       X2-LVFIL             CHECK IF FILE 
          ZR     X3,LFLIO             GO CHECK FOR -)- USAGE
          SX3    X2-LVONATT        CHECK FOR ON ATTN
          NZ     X3,JPSTDA
*     HERE TO SET UP ON ATTN PSUDEO 
* 
*  NOTE: FOR ON ATTENTION THE RESWORD TABLE ENTRY IS 7RTTENTIO
*        DUE TO SIZE LIMITATIONS. THEREFOR WE NEED TO LOAD THE NEXT 
*        CHARACTER FROM CHARBUF AND CHECK TO SEE IF ITS AN N. IF NOT
*        THEN AN ILLEGAL STMT ERROR CONDITION EXISTS. 
* 
         READCH   ONATTN0            GET NEXT ERROR 
         SX7      X1-1RN             CHECK FOR N
         ZR       X7,ONATTN1         BR, LEAGL ON ATTENTION 
         CALLERR  BERR16             BR, ILLEGAL STATEMENT
ONATTN1   BSS      0
          SX7    1
          SA7    ONATTN            SET ON ATTN FLAG 
          SA7    PREFLG            SET MODIFY PREAMBLE FLAG 
          SX2    LVERR             SET PSUDEO ON ERROR
 JPSTDA   SX3    X2-LVSTD    CHECK FOR STANDARD 
          NZ     X3,JPSTD2   NOT STANDARD 
          READCH PRTB10A
          SX7    X1-1RD      CHECK FOR D
          ZR     X7,JPSTD2   BR, LEGAL
          CALLERR BERR16     ILLEGAL
 JPSTD2   BSS    0
          SX3    X2-LVRAN          CHECK FOR RANDOMI
          NZ     X3,JPSTD3         BR IF NOT RANDOMI
          READCH PRTB10B
          SX7    X1-1RZ            CHECK FOR Z
          NZ     X7,STD09          BR IF ILLEGAL
          READCH PRTB10C
          SX7    X1-1RE            CHECK FOR E
          ZR     X7,JPSTD3         BR IF LEGAL
 STD09    CALLERR  BERR16          ILLEGAL
 JPSTD3   BSS    0
 JPSTD    BSS    0
          SA1    ONANDIF
          SB6    X1 
          JP     B6+STDACT
* 
* 
* 
 STDACT   BSS    0
          EQ     LNONE
          EQ     IFSTMT            -IF- STATEMENT 
          EQ     ONSTMT            -ON- STATEMENT 
          EQ     PRNULL 
* 
* 
 IFSTMT   BSS    0
          SX3    X2-LVTAN          CHECK IF TAN 
          NZ     X3,LNONE 
          READCH                   IS NEXT CHAR ( 
          SX3    X1-1R( 
          ZR     X3,LREAD9         YES IT IS TAN( 
          SA1    SAVEB7            RESTORE
          SB7    X1                CHARACTER
          SX2    LIALPT 
          EQ     LREAD9            POSITION 
* 
* 
* 
 ONSTMT   BSS    0
* 
*                POSSIBLE -ON- CLAUSES INCLUDE: 
*                ON .. GOTO 
*                ON .. GOSUB
*                ON ATTENTION 
*                ON ERROR 
*                ON ATTENTION GOTO
*                ON ATTENTION THEN
*                ON ERROR GOTO
*                ON ERROR THEN
* 
* 
* 
          SA1    NS                CHECK LAST SYMBOL SEEN 
* 
*                CHECK FOR -ON ATTENTION- HERE VIA
* 
*         SX7    X1-LVONATT 
*         ZR     X7,RONATT         SKIP IF IT WAS -ON ATTENTION-
* 
*                NOTE THAT BOTH THESE INSTRUCTIONS ASSUME -ONATTN-
*                HAS BEEN UNYANKED. 
* 
          SX7    X1-LVERR 
          ZR     X7,RONERR         SKIP IF -ON ERROR - WAS SEEN 
          SX7    X2-LVGOT          CHECK NEW SYMBOL 
          NZ     X7,GS1 
          SX2    LVONG             SET UP -ON- SPECIAL
          EQ     LNONE             EXIT 
 GS1      BSS    0
          SX7    X2-LVGOS 
          NZ     X7,LNONE 
          SX7    1
          SA7    ONGSFL 
          SX2    LVONG
          EQ     LNONE
 ONGSFL   BSSZ   1
* 
* 
 RONERR   BSS    0
          SX7    X2-LVGOT          CHECK NEW SYMBOL 
          NZ     X7,LNONE 
* 
* 
          SX2    LVERRGO           SPECIAL (CLASS 0) SYMBOL 
          EQ     LNONE             EXIT 
* 
* 
 PRNULL   BSS    0
* 
* 
*         CLASS 10 OUTSIDE SUBSRIPTING EXPRESSIONS AND
*         CLASS 5 (AS USUAL) INSIDE 
* 
          SB6    X2 
          SB5    LCLASS5+777B 
          GT     B6,B5,LNONE
          SB5    LCLASS5
          LT     B6,B5,LNONE
* 
*         NOW PROCESS THE UNARY 
* 
* 
          SX7    X2 
          SA7    NS                STORE CURRENT LEVEL
          SA4    SKLASS 
          IX2    X2+X4
          EQ     PRTBT20
 SKLASS   VFD    60/LCLSKIP-LCLASS5 
 LRPAR    BSS    0
          SX7    LCLSKIP-LCLASS5
          SA7    SKLASS 
          EQ     LNONE
 LREAD3   READCH    PRTBT13             FN FUNCTION- GET NEXT CHAR. 
          SX2       X1-1R0              IT MUST BE
          PL        X2,LREAD10            A LETTER
          SX3    X1-1RE            IS IT FNE
          NZ  X3,LREAD101          NO 
          READCH PRTBT13A          YES, CHECK FOR POSSIBLE FNEND
          SX3    X1-1RN 
          ZR  X3,LREAD102          JUMP IF *FNEN* 
 LREAD104 SB7    B7-1              JUST FNE, BACK UP OVER *N* 
 LREAD101 BSS    0
          READCH PRTBT13C          CHECK FOR $
          SX3    X1-1R$ 
          SX2    X2+NUMBFUN/2      STR FUN ORDINALS START AT NUMBFUN/2
          ZR  X3,LREAD105          JUMP IF $
          SB7    B7-1              NOT $, BACK UP 
          SX2    X2-NUMBFUN/2      BACK UP ORDINAL TOO
 LREAD105 BSS    0
          SX2       X2+1R0-1RA+FUNSTART  FORM FN - FUNCTION SYMBOL
          JP        LNONE 
 LREAD102 BSS    0
          READCH PRTBT13B          HAVE *FNEN*, TRY FOR *FNEND* 
          SX3    X1-1RD 
          NZ  X3,LREAD103 
          SX2    LVFND             WE HAVE *FNEND*
          JP  LNONE 
 LREAD103 SB7    B7-1              NOT FNEND, BACK UP OVER *D*
          EQ  LREAD104
 LREAD10  SB7       B7-1
          SX2       LILLEG3             BAD 
          JP        LNONE                 FUNCTION
 LREAD2   SX4       X1-1R+
          PL        X4,LREAD09
          BX7    X1 
          SA7    EXSTR1 
          READCH EXSTR2 
          SX4    X1-1R+ 
          PL     X4,EXSTR3
 EXSTR4   BSS   0 
          SB7    B7-1 
          SA1    EXSTR1 
          SX4       X1-1R0+1            IDENTIFIER SYMBOL IS
          IX2       X2+X4                IDSTART+LETTER*10+(DIGIT+1)
          JP        LNONE 
 LREAD09  SX4       X1-1R$
          NZ        X4,LREAD9 
          SX2    X2+LCLASS2S-LCLASS20    LETTER*10  AND CLASS 
          JP        LNONE 
 LREAD9   SB7       B7-1                IDENTIFIER SYMBOL IS
          JP        LNONE                IDSTART+LETTER*10
 EXSTR3   BSS    0
          SX4    X1-1R$ 
          NZ     X4,EXSTR4
          SA1    EXSTR1 
          SX4     X1-1R0+1            DIGIT VALUE 
          IX2     X2+X4               LETTER*10 + DIGIT 
          SX2     X2+LCLASS2S-LCLASS20 ADJUST CLASS 
          JP     LNONE
 EXSTR1   BSS    1
 LMULT    READCH    PRTBT14             GET CHAR AND PERFORM THE
          JP        LREAD11                   RESERVE SCAN. 
 LNUM     BSS    0
*     DETERMINE IF A LINE NUMBER EXPECTED.  IF SO, SET
*     A NON-ZERO FLAG IN X6 BEFORE CALLING BASICON, ELSE
*     SET X6 TO ZERO.  BASICON RETURNS FLOATING REPRESENTATION
*     OF NUMBER.
* 
          SA2    STATE         FETCH STATE
          SX3    X2-STA5       IS STATE -EXPECTING LINE NUMBER-?
          ZR     X3,LNUM2      BR, YES, -EXPECTING LINE NUMBER- 
* 
*     FOR THE CASE OF A COMPLEX IF STATEMENT, 
*     THE TORINS OF -THEN- AND -ELSE- SET THE 
*     STATE TO -AFTER EOS-.  UNDER THESE
*     CIRCUMSTANCES, WE EXPECT A NUMBER TO BE A LINE
*     NUMBER AND SET THE FLAG IN X6 TO NON-ZERO.
*     I.E. MUST BE ON -IF R THEN LN....- OR 
*     -IF R THEN ....ELSE LN....-.
*     NOTE: -THEN LN..- AND -ELSE LN...- COULD OCCUR
*     IN AN -IF R - STATEMENT THAT IS EMBEDDED IN -IF R-
*     STATEMENT.
* 
          SA3    GLBLIFR       FETCH GLBLIFR FLAG I.E. COMPLEX IF FLAG
          ZR     X3,LPOINT     BR, NOT IN A COMPLEX -IF R - STATEMENT.
* 
**
*     WE ARE WITHIN A COMPLEX -IF R - STATEMENT.
*     WITHIN A COMPLEX -IF R- IT IS POSSIBLE FOR
*     BASICON TO RETURN AN ILLEGAL NUMBER STATUS
*     IF IT ENCOUNTERS THE SEQUENCE OF
*     ....NON-EXPONTIAL NUMBER ELSE.... 
*     IN THIS CASE, THE LEADING E IN THE WORD ELSE IS CONSTRUED 
*     AS THE E OF AN EXPONENTIAL NOTATION NUMBER. 
* 
*     ON THE FIRST RETURN OF AN ILLEGAL NUMBER STATUS,
*     WE SET THE LINE NUMBER
*     EXPECTED FLAG AND MAKE A SECOND CALL (I.E. RETRY) 
*     TO BASICON.  LINE NUNBER EXPECTED LOGIC OF BASICON DOES 
*     NOT GET CONFUSED BY THE E OF ELSE.  IF THE SECOND TRY 
*     ALSO FAILS WE EXIT WITH ILLEGAL NUMBER SYMBOL.
* 
*     SET REPEATED ATTEMPTS COUNTER TO ZERO,
*     SAVE B7 CHARACTER POINTER FOR POSSIBLE RETRY
*     SAVE X1 CONTAINING 1ST CHAR OF NUMBER FOR POSS RETRY
          MX7    0
          SA7    TE130855       SET REPEATED TRY CTR TO ZERO
          SX7    B7 
          SA7    TE130856      SAVE B7 CHAR PTR FOR RETRY 
          BX7    X1 
          SA7    TE131655      SAVE X1 CONTAINS 1ST CHAR FOR RETRY
* 
* 
*     FOLLOWING CODE INCREASES PROBABILITY FIRST TRY WILL 
*     BE SUCCESSFUL FOR THE CONTEXTS -...THEN LN...- AND
*     -....ELSE LN....-.
          SX3    X2-STA2       IS STATE -AFTER EOS-?
          NZ     X3,LPOINT     BR, NOT -AFTER EOS-
* 
*     FALL THRU CONTEXT IS
*     IN COMPLEX -IF R- AND STATE IS -AFTER EOS-. 
 BE130913 BSS    0
*     BRANCH IN CONTEXT IS WE ARE MAKING SECOND TRY 
          SX6    1             TURN ON LINE NUMBER EXPECTED FLAG IN X6
          RJ     BASICON       DEVELOP NUMBER 
          JP     LNUM1
 LPOINT   SX6       0                   HERE FOR POINT AS WELL
          RJ        BASICON             GET NORMAL NUMBER 
          JP        LNUM1 
 LNUM2   SX6        1                   GET LINE NUMBER 
          RJ        BASICON 
          SX7       LIEOS               INSERT EOS
          SB7       B7-1                  AFTER 
          SA7       B7                      LINE NUMBER 
 LNUM1   LX1        9                   FORM SYMBOL 
          SX2       X1+NUMSTART           FOR NUMBER
 PRTBT18  NO
          BSS       0 
          PL        X1,LNONE            JUMP IF NO ERROR
* 
*     IF WE ARE WITHIN GLOBAL -IF R-
*     WE MAKE A SECOND TRY AS EXPLAINED ABOVE.
          SA1    GLBLIFR       TEST WITHIN GLOBAL -IF R-
          ZR     X1,BE130910   BR, NOT WITHIN GLOBAL -IF R- 
* 
*     TEST IF TWO TRIES MADE, IF NOT RETRY
          SA1    TE130855      FETCH REPEATED TRIES COUNTER 
          NZ     X1,BE130910   BR,WE HAVE TRIED TWICE 
          MX7    1
          SA7    TE130855      BUMP AND STORE RPTD TRY CTR
          SA1    TE130856      FETCH SAVED B7 CHAR PTR FOR RETRY
          SB7    X1            B7 NOW RESET 
*     FETCH SAVED X1 CONTAINS 1ST CHAR OF NUMBER
          SA1    TE131655      X1 NOW CONTAINS 1ST CHAR OF NUMBER 
          EQ     BE130913 
* 
 BE130910 BSS    0
          SX2       LILLEG4             BAD NUMBER
 LNONE    SX7       X2                  ALL EXITS A VIA LNONE 
          SA7       NS                  SAVE THE SYMBOL JUST PRODUCED 
 PRTBT20  JP        READ                EXIT
          JP        READ                EXIT
 TE130855 BSSZ   1             REPEATED TRIES COUNTER 
 TE130856 BSSZ   1             SAVED B7 CHAR PTR
 TE131655 BSSZ   1             SAVED X1 1ST CHAR OF NO FOR RETRY
 LLPAREN  SA3       NS                  GET PREVIOU SYMBOL
          BX7    X7-X7
          SA7     SKLASS
          SX4       X3-SUBSTART         TEST FOR OPERATOR.  IF YES THE
          NG     X4,DELCHK         SKIP TO CHECK FOR -DELIMIT- STMT 
          AX4       9                   IDENTIFY TYPE OF
          SA2       X4+LLPARTAB           LEFT PARENTESIS 
          JP        LNONE                   BY CLASS OF OPERAND 
 DELCHK   BSS    0
          SA3    DLMTST 
          ZR     X3,SSCHK          IF NOT DELIMIT, GO CHECK FOR )(
          SB7    B7-1              BACK UP SOURCE POINTER 
          SX2    LIDELP            PICK UP (PSEUDO) CHTAB INDEX (TO 
          BX7    X2                FORCE SPECIAL READ ACT FOR DELIMITER)
          SA7    B7                DUMP IT IN SOURCE STRING 
          SX7    LCLSKIP-LCLASS5   IF DELIMIT STMT IN EFFECT
          SA7    SKLASS            RESTORE CORRECT SYMBOL CLASS 
          SX2    LVLARD            SET UP PSEUDO LEFT PAREN (IN)ACTION
          EQ     LNONE             AND GO EXIT
 SSCHK    SA3    STATE
          SX3    X3-STA1           SEE IF LAST CHAR WAS ) 
          NZ     X3,LNONE          SKIP IF NOT AFTER )
          SA3    ANDSTACK+B2       GET TOP OPERAND
          LX3    30 
          SB6    X3                EXTRACT CLASS
          SB5    AINX1             CHECK FOR SUBSCRIPTED STRING 
          NE     B5,B6,ER26        IF NOT IT IS AN ERROR
          SX2    LVSSV             SET TO LPAREN AFTER SUBSCRIPTED STR
          EQ     LNONE
* 
* 
 DLMTPRN  BSS    0                 SCAN SPECIFIED DELIMITER 
          RJ   ABBSCAN              SCAN FOR CHARACTER OR ABBREVIATION
*         RETURNED IN X1, RESULT TYPE FLAG IN X2
          NG   X2,BADLMT           SCAN ERROR 
          ZR   X2,DLMT1            IT WAS SINGLE CHAR 
* 
*         IT WAS ABBREVIATION 
          RJ   ASCABBR             FIND ASCII ORDINAL OF ABBREV 
          NG   X1,BADLMT           BAD ABBREV 
          SX7    B7              SAVE B7
          SA7    DELB7SV         B7 SAVED 
          PX5    B0,X1             FLOAT ASCII ORDINAL
          NX5    B6,X5
          RJ   BASXCHR             FIND DISPLAY CODE OF CHAR
          SA1    B7                B7 POINTS TO RELADDR OF CHAR 
          SA1    B2+X1             FETCH CHAR 
          SA2    DELB7SV         FETCH SAVED B7 
          SB7    X2              B7 NOW RESTORED
          LX1    12                MOVE 6- OR 12-BIT CHAR AROUND TO RIGHT 
          SX2    77B
          BX2    X2*X1
          NZ   X2,DLMT1            SKIP IF XXXX 12 BITS 
          AX1    6                 FORM XX FROM XX00  6 BITS
* 
 DLMT1    BX6    X1                CHARACTER IN X6
          MX7    59                SET DELIMITER-OK FLAG
          SA7    DLMTROK
          SX1    1                 FLAG FOR PSEUDO INTEGER
          EQ   LNUM1               GO STACK THE CHARACTER AS INTEGER CONST
 DELB7SV  BSSZ   1
* 
 BADLMT   BSS    0
          SX2    LILLEG            SET - ILLEGAL STATEMENT
          EQ     LNONE             AND EXIT 
* 
 LCHPLUS  SA3       NS                  GET PREVIOUS SYMBOL 
          SX4    X3-STRSTART       UNARY + UNLESS OPERAND OR )
          PL        X4,LNONE            GOTO LNONE FOR OPERAND
          SX4       LVRPA 
          IX4       X3-X4 
          ZR        X4,LNONE            GOTO LNONE FOR  ) 
          MX4    -9 
          BX4    X3*X4
          SX4    X4-FUNSTART
          ZR     X4,LNONE 
          SX2       LVUNP               CREATE UNARY PLUS 
          JP        LNONE 
 LCHMINUS SA3       NS                  GET PREVIOUS SYMBOL 
          SX4       X3-ANDSTART         UNARY - UNLESS OPERAND OR ) 
          PL        X4,LNONE            GOTO LNONE FOR OPERAND
          SX4       LVRPA 
          IX4       X3-X4 
          ZR        X4,LNONE            GOTO LNONE FOR )
          MX4    -9 
          BX4    X3*X4
          SX4    X4-FUNSTART
          ZR     X4,LNONE 
          SX2       LVUNM               CREATE UNARY MINUS
          JP        LNONE 
* 
          EJECT 
* 
 LSTRING  BSS    0
* 
*         HERE FOR LEADING QUOTE OF QUOTED STRING 
* 
*         QUOTED STRINGS MAY OCCUR IN PRINT, DATA AND OTHER STATEMENTS
* 
*         REGISTERS IN USE AT THIS POINT
*         B7 POINTS TO NEXT CHAR IN CHARACTER BUFFER
*         X2 - VALUE OF CHARACTER FROM LAST ACCESS TO CHTAB TABLE 
* 
*         VALIDATE CONTEXT OF APPEARANCE OF QUOTED STRING AND 
*         ROUTE ACCORDINGLY.
* 
* 
*         FETCH PREVIOUS SYMBOL SO THAT CONTEXT OF THIS STRING
*         MAY BE DETERMINED 
          SA3    NS            X3 - PREVIOUS SYMBOL 
* 
*         SET THE QUOTED FLAG WORD
*         (STORES CHTAB ACTION ADDRESS IN QUOTED TO SET QUOTED FLAG ON) 
          SX7       B6                                                   BASCOMP
          SA7       QUOTED                                               BASCOMP
          SA7    QFLAG       SET QUOTE FLAG 
* 
*         TEST ARE WE WITHIN A PRINT STATEMENT? 
          SA1    ONANDIF                                                 BASCOMP
          SX1    X1-PRNTYP                                               BASCOMP
* 
          NZ     X1,LREAD18                                              BASCOMP
* 
*         WE ARE IN PRINT STATEMENT 
* 
* 
*         TEST WAS PREVIOUS SYMBOL A CONCATENATION OPERATOR?
          SX2    X3-LVPLU    OPERATOR (+)                                BASCOMP
          ZR     X2,LREAD18                                              BASCOMP
* 
*                DOES PREVIOUS SYMBOL HAVE CLASS "ACCEPT UNARY" 
  
          AX3    9           NS                                          BASCOMP
          LX3    9                                                       BASCOMP
          SX2       X3-LCLASS5         UNARY                             BASCOMP
          ZR        X2,LREAD18                                           BASCOMP
* 
*         WAS PREVIOUS SYMBOL A MEMBER FROM SET LCLASS10? 
          SX2       X3-LCLASS10        VERB                              BASCOMP
          ZR        X2,LREAD18                                           BASCOMP
* 
*         WAS PREVIOUS SYMBOL THE VERB -PRINT-? 
          SX2       X3-LCLASS12        PRINT                             BASCOMP
          ZR        X2,LREAD18                                           BASCOMP
* 
*         WAS PREVIOUS SYMBOL A NON-ARITH LEFT PAREN? 
          SX2    X3-LCLASS6        NON-ARITH LEFT PAREN                  BASCOMP
          ZR     X2,LREAD18        CONTINUE                              BASCOMP
* 
*         FAILING ABOVE TESTS, WE BACK UP THE CHARACTER POINTER 
*         TO POINT TO THIS CHARACTER
*         AND SET UP A SYMBOL IN X2 OF SEMI-COLON WHICH WILL
*         BE FURTHER PROCESSED AS A -SKIP PRINT-. 
          SB7       B7-1                                                 BASCOMP
          SX2       LVSEM                                             BASCOMP  6
          EQ     JPSTD                                                   BASCOMP
* 
*         THIS CONCLUDES CONTEXT VALIDATION AND ROUTING 
*         FOR QUOTED STRING.
* 
 LREAD18  BSS    0
* 
*         HERE FOR ALL STRINGS, QUOTED OR UNQUOTED
* 
*         FOR QUOTED STRINGS, B7 IS POINTING TO THE CHARACTER 
*         FOLLOWING THE LEADING QUOTE; FOR UNQUOTED STRINGS,
*         B7 POINTING TO 1ST CHARACTER OF STRING. 
* 
* 
* 
*         THE OBJECTIVE IS TO STORE A STRING IN SEQUENCE- 
*         POINTER WORD,STRING WORDS  (ZERO BYTE DELIMITED)
*         A NULL STRING STORES POINTER WORD OF ZERO AND NO STRING WDS.
* 
* 
*         SEQUENCE OF DEVELOPMENT IS TO ASSEMBLE AND STORE
*         THE WORDS OF THE STRING, WITH ZERO BYTE DELIMITER 
*         THEN STORE THE POINTER WORD AT THE HEAD.
* 
*         BEGIN INITIALIZATION OF LOOP WHICH WILL 
*         ASSEMBLE WORDS IN STRING AND STORE
*         THE ASSEMBLED WORDS IN THE CONSTANT AREA. 
* 
* 
*         COMPUTE THE ADDRESS OF FIRST AVAILABLE WORD 
*         IN CONSTANT AREA
*         AND STORE IT. 
          SA3    L.CONS            SIZE OF CONSTANT TABLE 
          SX7    X3 
          SA7    FACONS            SAVE FOR LATER USE 
          SX7    X3+B1             INCREMENT OFFSET FOR FILE ACTION 
          SA7    STRHEAD         OFFSET TO FILENAME STRING STORED 
          ADDWRD CONS,X1           SAVE SPACE FOR POINTER WORD
* 
* 
*         INITIALIZE FLAGS AND WORDS-TO-STRING ASSEMBLY LOOP
          MX7    0
          SA7    STRE1FLG      STRING END 1 FLAG
          SA7    STRE2FLG      STRING END 2 FLAG
          SA7    STRENDCH      INITILZE STRING END CHARACTER HOLD 
          SA7    STRDCNT       COUNT OF STRING WORDS CONTAINING DATA CHARS
          SA7    STRWCNT         COUNT OF ALL STRING WORDS INCLDG ZBD (NOT PTR W
* 
* 
 LREAD15  BSS    0
* 
*         BEGINNING OF ASSEMBLE STRING WORD.
*         DURING THE COURSE OF SCREENING AND ASSEMBLING CHARACTERS
*         INTO A WORD FOR FUTURE STORAGE IN THE CONSTANT AREA,
*         TESTS ARE MADE TO DETECT A VALID OR INVALID TERMINATION OF
*         THE STRING AND APPROPRIATE STRING END FLAGS ARE SET.
* 
*         INITIALIZE THE CHARACTERS-TO-WORD ASSEMBLY LOOP 
          SB6       60                  INITIALIZE SHIFT COUNT.          BASCOMP
          SX6       0                   INITIALIZE OUTPUT WORD.          BASCOMP
* 
* 
 F091455  BSS    0
*         TEST IF WORD NOW FULLY ASSEMBLED
          ZR     B6,WRDFULL    BR,ASSEMBLY WORD IS FULL 
* 
*          GET, SCREEN AND ASSEMBLE CHARCTER INTO WORD
* 
 LREAD17  READCHB   PRTBT15             GET NEXT CHAR, INCLUDING BLANK   BASCOMP
* 
*         ARE WE IN QUOTED STRING?
          SA3       QUOTED                                               BASCOMP
          ZR        X3,LREAD21  BR, UNQUOTED STRING 
* 
*         HERE FOR QUOTED STRINGS 
* 
          SX0       X1-LIEOS            TEST FOR                         BASCOMP
          ZR        X0,LREAD13            END OF STATEMENT - ERROR       BASCOMP
* 
          SX0       X1-LIQUO            TEST FOR                         BASCOMP
          ZR        X0,LREAD16            END STRING. IF YES,GO LREAD16. BASCOMP
* 
*         FALL THRU FOR QUOTED STRING NOT AT ENDING QUOTE 
* 
* 
 LREAD22   BSS       0                                                    BASCOM
*         BRANCH INS:-
*         HERE FOR CALL STMT NOT AT -EOS- OR (
*         HERE FOR DATA UNQUOTED STRING NOT AT -EOS- OR COMMA 
*         HERE FOR STR$ NOT AT -EOS- OR ) 
*         HERE FOR QUOTED STRING  QUOTE QUOTE 
*         HERE FOR FORMAT IMAGE NOT AT -EOS-
* 
          PL   X1,LREAD222         SKIP IF NOT ESCAPE CODE CHAR          BASCOMP
* 
*         HERE FOR ESCAPE CODE HIT
          BX1    -X1               GET 74XX OR 76XX                      BASCOMP
          MX7    54                                                      BASCOMP
          BX7    -X7*X1            EXTRACT XX                            BASCOMP
          SB7    B7-1              STORE IT BACK WHERE IT CAME FROM      BASCOMP
          SA7    B7                WILL GET NEXT TIME                    BASCOMP
          AX1    6                 RIGHT JUSTIFY 74 OR 76                BASCOMP
          SX3    X7-1R"      CHECK FOR QUOTE 76B
          NZ     X3,LREAD222 BR, NOT 76B
          SB7    B7-1 
          SA7    B7 
* 
* 
 LREAD222 BSS    0                                                       BASCOMP
*         HERE FOR ALL CHARACTERS TO BE ASSEMBLED 
          LX6       6                   APPEND CHARACTER                 BASCOMP
          BX6    X6+X1
* 
*         CHARACTER NOW ASSEMBLED INTO WORD 
* 
*         UPDATE THE CHARACTER-TO-WORD LOOP VARIABLE
  
          SB6       B6-6                DECREMENT SHIFT COUNT            BASCOMP
          BX7    X1          SAVE THE LAST CHARACTER FOR FUTURE 
          SA7    =SPREVCH      REFERENCE
          EQ     F091455 BR TO TEST IF WORD FULL
* 
* 
* 
* 
* 
*         HERE FOR UNQUOTED STRING
LREAD21   SX0       X1-LIEOS                                             BASCOMP
          ZR        X0,LREAD23  BR,AT -EOS- 
* 
*         NOT AT -EOS-
* 
          SA3    DATAST                                                  BASCOMP
          SX3    X3+1                                                    BASCOMP
          ZR     X3,LREAD210  BR, THIS IS CALL EXT NAME 
* 
          SX3    X3+1                                                    BASCOMP
          NG     X3,LREAD211  BR, THIS IS STR$ IMAGE
* 
          ZR     X3,LREAD22  BR, THIS IS FORMAT IMAGE 
* 
*         FALL THRU MUST BE DATA UNQUOTED STRING
* 
          SX0       X1-1R,     TEST FOR COMMA AT END OF UNQUOTED STRING 
          NZ,X0  LREAD22     BR, NOT END OF STRING DELIMITER
          SA3    PREVCH      CHECK IF LAST CHAR IN STRING WAS COLON 
          NZ,X3  LREAD23     BR, LAST CHARACTR WAS NOT A COLON
          SX1    55B         APPEND A BLANK TO THE STRING 
          SB7    B7-1        RESET THE CHARACTER POINTER
          SX7    1
          SA7    COLONFL     SET THE BLANK APPENDED TO ENDING COLON FLAG
          JP     LREAD22
* 
          JP        LREAD22   GO TO ASSEMBLE THE CHARACTER
* 
 LREAD211 BSS    0                                                       BASCOMP
*         HERE FOR STR$ IMAGE 
          SX0    X1-1R)      STRING FUNCTION IMAGE                       BASCOMP
          ZR     X0,LREAD23   BR, STR$ IMAGE, HIT ) 
* 
          EQ     LREAD22    GO TO ASSEMBLE CHARACTER
* 
 LREAD210  BSS    0 
*         HERE FOR CALL EXTERNAL NAME 
  
          SX0    X1-1R             IGNORE BLANK IN CALL NAME
          ZR     X0,LREAD17 
          SX0    X1-1R(            CALL STMT EXT NAME ENDS               BASCOMP
          ZR     X0,LREAD23  JUMP IF ( WAS HIT IN CALL
          SX0    X1-1R' 
          NZ     X0,LREAD22 
* 
*         FALL THRU,  HIT LPAREN OR APOSTROPHE IN CALL STATEMENT. 
* 
 LREAD23   SB7       B7-1                                                 BASCOM
*         BRANCH IN,
*         HIT COMMA IN UNQUOTED STRING (NOT CALL, STR$ OR FORMAT IMAGE
*         BRANCH IN, HIT -EOS- IN ANY UNQUOTED STRING 
*         BRANCH IN, STR$ IMAGE, HIT )
* 
* 
 LREAD16  BSS    0                                                       BASCOMP
*         BRANCH IN, QUOTED STRING, HIT ENDING QUOTE
* 
* AT END OF STRING
* 
* 
*         STORE STRING END CHARACTER FOR FUTURE TESTS 
          BX7    X1 
          SA7    STRENDCH      STRING END CHARACTER STORED
* 
*         WE LOOK AHEAD TO
*         TEST FOR QUOTE QUOTE SEQUENCE IN QUOTED STRINGS 
*         IF THIS IS THE CASE, WE GO BACK TO ASSEMBLE A 
*         QUOTE CHARACTER AND WILL COME THRU HERE AGAIN.
* 
          READCHB PRTBT19                                                BASCOMP
* 
          SX0     X1-LIQUO                                               BASCOMP
          ZR      X0,LREAD22                                             BASCOMP
          SA3    PREVCH      LAST CHARACTER BEFORE ENDING QUOTE 
          NZ,X3  CONT        IF IT'S NOT 00 (:) THEN CONTINUE 
* LAST CHARACTER WAS A COLON SO WRITE A TRAILING BLANK. 
* B7 IS RESET SO IT LOOKS AS IF THE BLANK IS THE LAST CHARACTER 
* AND A BLANK IS PUT INTO X1. 
* 
          SB7    B7-2 
          SX1    55B
          SX7    1
          SA7    COLONFL     SET BLANK APPENDED TO ENDING COLON FLAG
          EQ     LREAD22
 CONT     BSS    0
          SB7     B7-1     B7 NOW POINTS TO 1ST CHAR AFTER THIS STRING
* 
*         SET STRE1FLG
*         THIS FLAG INDICATES THAT WE HAVE ASSEMBLED ALL CHARACTERS 
*         OF THE STRING DATA. 
*         (STILL HAVE TO CONSIDER STRIPPING TRAILING BLANKS)
          SX7    1
          SA7    STRE1FLG      STRE1FLG NOW SET 
* 
* TEST IF ANY CHARACTERS HAVE BEEN ASSEMBLED INTO THE LAST WORD IN X6 
*         IF SO, NORMAL PROCESSING APPLIES. IF NO CHARS IN LAST WORD
*         TEST FURTHER TO DETERMINE IF ANY CHARS HAVE PREVIOUSLY BEEN\
*         STORED FOR STRING.  IF NO PREVIOUS CHARS, WE HAVE A NULL STRING 
*         FOR WHICH ONLY A ZERO POINTER WORD IS TO BE STORED. 
* 
*         IF LAST WORD CONTAINS NO CHARS, BUT THE STRING IS NON-NULL, 
*          THE NORMAL PROCESSING WRITES A ZBD WORD. 
* 
          NZ     X6,ALIGNIT      BR, LAST WORD CONTAINS CHARS, NORMAL PROCESSING
* 
* FALL THRU, NO CHARS IN LAST WORD. 
          SA1    STRWCNT         FETCH COUNT OF STRING WORDS ALREADY STORED 
          NZ     X1,ALIGNIT      BR, TO EFFECTIVELY WRITE A ZBD 
* 
          SX3    B6-60
          NZ     X3,ALIGNIT  IT'S A COLON CHAR IN THE STRING
* 
* FALL THRU, WE HAVE A NULL STRING
          MX7    0               SET UP PTR WORD OF ZERO
          EQ     B071004         GO TO STORE PTR WORD ONLY
* 
 ALIGNIT  BSS    0
*         ALIGN DATA CHARS IN LAST WORD TO LEFT OF WORD 
          LX6     X6,B6            AT END OF STRING, LEFT JUSTIFY LAST WRD
* 
*         COMPUTE NO. OF UNUSED CHAR POSITIONS IN LAST WD 
*         OF STRING AND STORE FOR FUTURE COMPUTATION. 
*         (B6) = 6 * NO. OF UNUSED POSNS
          SB5    0B            B5 UNUSED POSITION COUNTER 
* 
 UNUSLUP  EQ     B0,B6,BF140900     BR, ALL DONE COUNTING 
          SB5    B5+1          INCREMENT UNUSED POSITION COUNT
          SB6    B6-6          DECREMENT COUNT OF UNUSED POSITION BITS
          EQ     UNUSLUP      LOOP
* 
 BF140900 SX7    B5 
          SA7    UNUSCT        STORE COUNT OF UNUSED POSITIONS
* 
* 
* 
* 
          EQ     WRDFULL     GO TO STORE ASSEMBLED WORD 
* 
*         ERRORS IN STRING COME HERE TO RETURN AN ILLEGAL SYMBOL
 LREAD13  SB7       B7-1                                                 BASCOMP
          SX2       LILLEG5             BAD                              BASCOMP
          JP        LNONE                 STRING                         BASCOMP
  
**        STORE FILLED WORD.
  
 WRDFULL  BX1    X6 
          ADDWRD CONS,X1
         SA5 A6 
          SA1    STRWCNT           COUNT SIZE OF CONSTANT 
          SX7    X1+B1
          SA7    A1 
* 
* 
*         TEST IF WE HAVE MET THE END OF THE STRING 
          SA1    STRE1FLG 
          ZR     X1,LREAD15    BR, NOT AT END YET, ASSEMBLE MORE
* 
*         ALL DONE ASSEMBLING STRING CHARACTERS,
*         TEST HAVE WE STRIPPED BLANKS AND ENSURED ZERO BYTE DELIMITING?
          SA1    STRE2FLG 
          NZ     X1,LSWRAPUP     BR, TRLG BLNKS AND ZBD CHECK DONE
* 
*         FALL THRU TO TRY STRIP  BLANKS, ENSURE ZEROBYTE DELIMITING
* 
* 
* BRANCH IN, NON-NULL STRING, NO CHARS IN LAST ASSEMBLY WORD
* 
*         SET STRE2FLG TO INDICATE WE HAVE BEEN THRU HERE 
          SX7    1
          SA7    STRE2FLG      STRE2FLG NOW SET 
* 
* 
* 
* 
 TSTBLKS  BSS    0                                                       BASCOMP
*         TRAILING BLANKS ARE STRIPPED FROM UNQUOTED STRINGS. 
*         TEST IF STRING UNQUOTED 
          SA3    QUOTED                                                  BASCOMP
          NZ  X3,ZBYTECHK          SKIP IF QUOTED STRING                 BASCOMP
* 
*         HERE FOR UNQUOTED STRINGS 
* 
*         BEGINNING 
*         STRIP TRAILING BLANKS FROM UNQUOTED STRING
*         (LOGIC ACTUALLY BACKUPS OVER ANY MIXTURE OF 
*         TRAILING BINARY ZEROES OR BLANK CHARS)
* 
*         COMPUTE ADDRESS OF LAST WORD STORED 
          SA1    F.CONS            START OF CONSTANTS 
          SA2    L.CONS            CURRENT SIZE 
          SX2    X2-1 
          IX1    X1+X2
          SB5    X1          B5 CONTAINS ADDRESS OF LAST WORD OF STRING STORED
* 
* 
          SX3    77B               MASK                                  BASCOMP
*                                                                        BASCOMP
 LREAD165 BSS    0                 NEW WORD                              BASCOMP
          SB6    10                CHAR PER WORD                         BASCOMP
          SA1    B5                FETCH WORD                            BASCOMP
*         WE HOLD ADDRESS OF STRING WORD IN A1
          MI     X1,LREAD169
          ZR  X1,LREAD171          SKIP IF ALL ZERO                      BASCOMP
* 
 LREAD169 BX6    X3*X1             EXTRACT CHARACTER                     BASCOMP
          ZR  X6,LREAD167          SKIP BINARY ZEROES 
* 
          SX6    X6-1R                                                   BASCOMP
          NZ  X6,LREAD168          EXIT IF NON-BLANK                     BASCOMP
          SB4    6           CHECK THE PREVIOUS CH WAS A COLON
          AX6    B4,X1
          NZ     X6,LREAD166  BR, TO STRIP THE BALNK
          SX6    1           KEEP THE BLANK AND SET THE FLAG
          SA6    COLONFL
          JP     LREAD168    EXIT IF COLON-BLANK AT THE END OF STRING 
* 
LREAD166  BX1    -X3*X1      CHANGE BLANK TO ZERO 
* 
 LREAD167 LX1    54                SHIFT RIGHT ONE CHAR                  BASCOMP
          SB6    B6-1          DECREMENT CHAR COUNT 
          NZ  B6,LREAD169          LOOP FOR NEXT CHAR                    BASCOMP
* 
*     ALL TRAILING BLANK CHARACTERS FROM WORD HAVE BEEN ZEROED OUT. 
*     BUT BEFORE WE CAN PROCEDE WE MUST FIRST SAVE THE NEW WORD.
* 
          BX6    X1         SAVE BEFORE GETTING 
          SA6    A1         NEXT WORD OF UNQUOTED STRING
* 
*         FALL THRU,  ALL POSITIONS OF WORD SCANNED FOR TRLG BLNKS
* 
* 
* 
 LREAD171 SB5    B5-1              NEXT WORD GOING BACKWARDS             BASCOMP
          SA1    STRWCNT
          SX7    X1-1          DECREMENT COUNT OF STRING WORDS STORED 
          SA7    STRWCNT       STRWCNT DECREMENTED
* 
*         TEST IF REACHED LIMIT OF BACKUP 
          NZ     X7,LREAD165   BR, LOOP TO SCAN ANOTHER WORD
* 
*         FALL THRU, ALL WORDS SCANNED FOR TRLG BLANKS
* 
* 
          EQ  BDATERR             ILLEGAL STMT; UNQUOTED STRG, NULL, ENDG IN -EO
* 
 LREAD168 BSS    0                 FOUND NON-BLANK CHARACTER             BASCOMP
* 
*         SAVE COUNT OF UNUSED POSITIONS IN LAST WORD OF STRING 
          SX7    B6 
          SX6    10 
          IX7    X6-X7
          SA7    UNUSCT        COUNT OF UNUSED POSITIONS SAVED
* 
*         SHIFT THRU REMAINING CHARACTER POSITIONS TO ALIGN WORD
 SHIFTIN  BSS    0
          LX1    54                REPOSITION WORD                       BASCOMP
          SB6    B6-1                                                    BASCOMP
          NZ  B6,SHIFTIN                                                BASCOMP 
* 
          BX6    X1                STORE IT BACK                         BASCOMP
          SA6    A1                                                      BASCOMP
* 
 LREAD170 BSS    0                                                       BASCOMP
          EQ     ZBYTECHK 
*                                                                        BASCOMP
*         END OF STRIP TRAILING BLANKS FROM UNQUOTED STRING 
* 
 ZBYTECHK BSS    0
* 
*         STORE VALUE OF STRWCNT IN STRDCNT FOR FUTURE
*         CALC OF STRING LENGTH.
*         THEN
*         TEST IF AT LEAST 2 BYTES OF ZEROES IN LAST WORD OF STRG,
*         IF NOT, WE STORE AN ADDITIONAL WORD OF ZEROES.
* 
          SA1    STRWCNT
          BX7    X1 
          SA7    STRDCNT       STRWCNT STORED IN STRDCNT
* 
          SX0    7777B         MASK 
          BX0    X0*X6         X0 CONTAINS LOW 12 BITS OF LAST WORD ASSEMBLED 
          ZR     X0,LSWRAPUP   BR, LAST WORD IS ZBYTE DELIMITED 
* 
*         FALL THRU, MUST STORE ADDITIONAL ZERO BYTE DELIM WORD 
* 
          MX6    0
          EQ     WRDFULL       GO TO STORE IT 
* 
* 
* 
* 
 LSWRAPUP BSS    0                                                       BASCOMP
*         BEGIN OF LSTRING WRAP UP. 
*         CREATE AND STORE THE POINTER WORD AT HEAD OF STRING.
*         STORE ADDRESS OF STRG POINTER WORD
*         FOR USE BY THE CALLER OF READ 
*         INCREMENT THE CONSPTR TO REFLECT SPACE OCCUPIED BY THIS 
*         ZERO BYTE DELIMITED STRING AND ITS POINTER WORD.
*         RESET QUOTED FLAG TO OFF. 
*         DETERMINE THE SYMBOL TO BE RETURNED FOR THE STRING. 
* 
*         ASSEMBLE STRING POINTER WORD AND STORE IT AT HEAD OF STRING 
* 
*         COMPUTE LENGTH OF STRING PROPER (LENGTH DEFINED TO BE 
*         NUMBER OF 6 BIT DATA CHARACTERS POSITIONS, INCLUDING ESCAPES
*         IF ANY, (EXCLUDES ZERO BYTE DELIMITERSS) REQUIRED TO STORE THE STRING)
*         CHAR LENGTH = (STRDCNT * 10) - COUNT OF UNUSED POSNS IN LAST WD.
          SA1    STRDCNT       X1 CONTAINS COUNT OF DATA WORDS STORED 
          BX2    X1            HOLD WDCOUNT IN X2 FOR ADDITION
* 
*         MULT WORDS * 10, SUBTRACT UNUSED POSNS
          LX1    3             X1 WORDS * 8 
          IX1    X1+X2         X1 WORDS * 9 
          IX1    X1+X2         X1 WORDS * 10
          SA3    UNUSCT        X3 COUNT OF UNUSED POS IN LAST WD STORED 
          IX1    X1-X3         X1 STRING LENGTH IN CHARACTERS 
* 
* 
*         NOW ASSEMBLE "STRING CONSTANT" FLAG AND STRING LENGTH FIELDS OF PTR 
          SX7    1               CREATE  STRING CONSTANT  FLAG BIT
          LX7    23 
          BX7    X1+X7         X7 FLAG AND LENGTH COMBINED
          LX7    36            FLAG AND LENGTH IN CORRECT POSITION
* 
*         DEVELOP THE ADDRESS FIELD OF PTR WORD.  THIS IS OFFSET
*         TO BEGINNING OF CONSTANT BLOCK WHICH POINTS TO 1ST DATA 
*         WORD OF STRING. 
* 
          SA1    FACONS            RELATIVE ADDRESS OF START OF CONSTANT
          SX3    X1+1          X3 PRESET TO POINT TO 1ST WORD OF STRING 
* 
* 
*         NOW COMBINE FLAG, LENGTH AND ADDRESS
*         AND STORE THE RESULTING POINTER WORD. 
 PTRCOMB  BX7    X7+X3         PREV COMBINE + ADDRESS 
          SA1    COLONFL     CHECK IF BLANK APPENDED TO ENDING COLON
          ZR     X1,B071004  BR, IF BLANK NOT APPENDED TO ENDING COLON
          MX1    1           ELSE SET UP A MASK IN THE STRING PTR WORD
          LX1    -3          AT POSITION 57 INDICATING THA A BLANK HAS BEEN 
          BX7    X7+X1       APPENDED TO AN ENDING COLON. 
          MX6    0           CLEAR BLANK APPENDED TO ENDING COLON FLAG
          SA6    COLONFL
* 
 B071004  BSS    0
* 
* BRANCH IN, WE HAD A NULL STRING 
* 
          SA1    FACONS        X1 ADDRESS OF POINTER WORD 
          SA2    F.CONS 
          SB4    X1 
          SA7    X2+B4             STORE POINTER WORD 
          SA5    A7+B1
* 
* 
*         STORE THE CONSPTR THAT LOCATES THE STRING POINTER WORD
*         FOR USE BY THE CALLER OF READ.
          BX7    X1 
          SA7    STRADDR          STRADDR NOW STORED
          SA2    STRWCNT           RESET LENGTH OF CONSTANTS TO ACCOUNT 
          IX6    X1+X2             TRAILING BLANKS STRIPPED OFF 
          SX6    X6+B1
          SA6    L.CONS 
* 
*         RESET QUOTED FLAG TO OFF
          SX7       B0                                                   BASCOMP
          SA7       QUOTED                                               BASCOMP
* 
* 
 SETSYM   BSS    0
*         HERE FOR ALL STRINGS
* 
*         BEGINNING 
*         SELECT AND COMPOSE THE SYMBOL FOR THE STRING
* 
* 
*         PRESET SYMBOL 
          SX2    STRSTART     X2 - SYMBOL CLASS FOR STRING
* 
*         TEST IS STRING FROM DATA OR PRINT OR OTHER THAN CALL, IMAGES? 
          SA3       DATAST                                               BASCOMP
          PL  X3,LREAD163          BR, DATA OR PRINT STMT                 BASCOM
* 
*         HERE FOR CALL, FORMAT IMAGE OR STR$ IMAGE 
* 
*         PRESET SYMBOL TO CALL EXT NAME STRING 
          SX2    LCLASS30          CALL STMT, THIS IS EXT NAME           BASCOMP
* 
*         TEST TYPE 
          SX3    X3+3        IS IT UNQUOTED STRING FOR STR$                    B
          NZ     X3,LNONE   BR, MUST BE CALL EXT NAME STRING
* 
*         FALL THRU MUST BE STR$ IMAGE
* 
*         SET UP SYMBOL 
          SX2    LCLASS17                                                BASCOMP
          EQ   LNONE                                                     BASCOMP
* 
* 
 FACONS   BSSZ   1             ADDRESS OF STRING PTR WD 
 STRWCNT  BSSZ   1             COUNT,BASE 0 OF PTR WD + STRING WDS
 STRDCNT  BSSZ   1             COUNT, BASE 1 OF STRING WDS CONTAING DATA
 STRE1FLG BSSZ   1             FLAG, INDICATES ALL STRING DATA CHARS ASSEMBLED
 STRE2FLG BSSZ   1             FLAG, INDICATES TRLG BLKS AND DELIM ENSURED
 STRENDCH BSSZ   1             HOLDG LOCATION, HOLDS STRING ENDG DELIMITER
 UNUSCT   BSSZ   1             COUNT OF UNUSED POSNS IN LAST DATA WORD OF STRG
 PREVCHR  BSSZ   1           PREVIOUS CHARACTER READ
 COLONFL  BSSZ   1           BLANK APPENDED TO ENDING COLON FLAG
* 
* 
* 
 LREAD163 BSS    0                                                       BASCOMP
*         HERE FOR DATA OR PRINT OR OTHER THAN CALL, IMAGES 
* 
*         TEST IS IT DATA STMT? 
          NZ        X3,LNONE           NO SEMI IN DATA                   BASCOMP
* 
*         FALL THRU FOR PRINT AND OTHER THAN DATA, CALL, IMAGES 
* 
*         TEST IS IT PRINT STMT?
          SA1    ONANDIF                                                 BASCOMP
          SX1    X1-PRNTYP                                               BASCOMP
          NZ     X1,LNONE     BR, NOT PRINT STMT
* 
*         FALL THRU, THIS IS PRINT STATEMENT
* 
          SX7    B7          SAVE POINTER                                BASCOMP
* 
          READCH    PRTBT16             CHECK AHEAD                      BASCOMP
* 
          SB7       B7-1                  B7 NOW POINTS TO THIS CHARACTER 
* 
          SX3       X1-1R*              CHECK FOR OPERAND.  THAT IS,
          NG     X3,LREAD121 ALPHA-NUM,+,-
          SX3       X1-1R(
          ZR        X3,LREAD12
          SX3       X1-1R.
          NZ     X3,JPSTD 
 LREAD121 BSS    0
          SX3    X1-1R+ 
          NZ     X3,BF031740 BR, TO CHECK IF -ELSE- AHEAD 
* 
*         HERE BECAUSE NEXT CHARACTER WAS + 
*         CHECK IF WE ARE IN A STRING CONCATENATION 
          SB7    B7+1 
          RJ     CHKSTR      CHECK IF NEXT SYMBOL IS STRING 
          NZ     X3,LREAD123
 BF031749 SB7    X7            RESTORE POINTER
          EQ     JPSTD
 BF031740 BSS    0
*         IF WE ARE WITHIN A GLOBAL -IF R- STATEMENT
*         IT IS POSSIBLE THE WORD FOLLOWING IS -ELSE-.
* 
          SA3    GLBLIFR       FETCH GLBLIFR FLAG 
          ZR     X3,LREAD12    BR, NOT WITHIN GLOBAL -IF R- 
* 
*         NOW TEST FOR E L S E
          SX3    X1-1RE        IS IT E
          NZ     X3,LREAD12    BR, NOT ELSE 
          SB7    B7+1          B7 POINTS TO NEXT CHARACTER
          READCH
* 
          SX3    X1-1RL        IS IT L? 
          NZ     X3,LREAD12    BR, NOT ELSE 
          READCH
* 
          SX3    X1-1RS        IS IT S? 
          NZ     X3,LREAD12    BR, NOT ELSE 
          READCH
* 
          SX3    X1-1RE        IS IT FINAL E OF -ELSE-? 
          NZ     X3,LREAD12    BR, NOT -ELSE- 
* 
*         THE WORD AHEAD IS -ELSE-
          EQ BF031749 
* 
  
 LREAD123 BSS    0
          SB7    X7 
 LREAD12  BSS       0                   IF YES, OVERLAY THE TEMINAL 
          SB7       B7-1                    STRING QUOTE WITH 
          SX6       LISEMI                   A SEMI AND POSITION
          SA6       B7                        TO IT FOR THE NEXT
          EQ     JPSTD
 LFLIO    BSS    0
*                                  -FILE- HAS BEEN MET
          SA1 STATE                THE CURRENT STATE IS NOW USED TO 
          SX1    X1-STA2           DECIDE IF A STATEMENT VERB IS
*                                  EXPECTED 
          ZR     X1,FILST          SKIP IF YES
* 
          READCH
         SX4       X1-1R(               CHECK FOR ( 
         NZ        X4,LCOLON3           IF NOT ERROR
 LCOLON   BSS    0
          SA3    STATE
          SX6    X3-STA2           CHECK IF EXPECTING STATEMENT VERB
          ZR     X6,FMTST          IF SO, ASSUME A FORMAT COLON 
          SX6    X3-STA4           IF OPERATOR EXPECTED THEN FILE STMT
          ZR     X6,FILCLN         OR ANSI SUBSTRING
          SX6    X3-STA1           IF AFTER RIGHT PAREN 
          ZR     X6,SSCOL          MUST BE ANSI SUBSTRING 
         SB6       36                   SET COUNT FOR 
          READCH                          SEVEN CHAR FILE IDENTIFIER
*                                                                       001571
          ZR   X1,LCOLON3          NAME CANNOT START WITH COLON OR ILLEGAL
*                                                                       001577
          SX4       X1-1R0              FIRST CHAR
          PL        X4,LCOLON3            MUST BE 
          SX7       X1                     ALPHABETIC 
 LCOLON2  READCH                        GET NEXT CHAR 
          ZR   X1,LCOLON1          DONE IF COLON OR ILLEGAL 
*                                                                       001567
          SX4       X1-1R9-1            CHECK FOR ALPHANUMERIC
          PL        X4,LCOLON1            LEAVE LOOP IF NOT 
          LX7       6                   CONCATENATE 
          BX7       X7+X1                 NEW CHAR. 
          SB6       B6-6                DOWN CHAR COUNT 
          JP        LCOLON2             LOOP
 LCOLON1  SX2    X2-LVFIL             CHECK ON FILE CONVENTION
          ZR     X2,ICFILE            SKIP IF -FILE- WAS SEEN 
*                                                                       001465
 COLON1   EQU    63B               KRONOS, SCOPE 63 CHAR SET COLON      001470
*                                                                       001480
 CSETIF3  IFEQ   CHARSET,NEWCSET
CSETIF4   IFNE   IP.CSET,IP.C63    ASSEM FOR SCOPE 64 CHAR SET          001500
 COLON2   EQU    00B               SCOPE 64 CHAR SET COLON              001510
          SX4    X1-COLON2         CHECK FOR COLON                      001520
          ZR     X4,IC7CHS         JUMP IF COLON                        001530
          SX4    X1-IREOS          ALLOW END OF STMT (END OF LINE)      001531
          NZ     X4,IC7CHS1        IN ADDITION TO COLON FOR 64 C SET    001532
          SB7    B7-1              BECAUSE TRAILING COLON MAY BE LOST   001534
          EQ     IC7CHS                                                 001536
IC7CHS1   BSS    0                                                      001537
CSETIF4   ENDIF                                                         001540
CSETIF3   ENDIF                                                         001550
*                                                                       001555
          SX4    X1-COLON1         ELSE CHECK FOR                       001560
          NZ        X4,LCOLON3            BY COLON AND 7 OR FEWER 
 IC7CHS   BSS    0
          NG        B6,LCOLON3              CHARS IN NAME 
          SB6       B6+18               POSITION NAME TO LEFT 
          LX6       B6,X7                 WITH ZERO FILL
          SX2       FILSTART            SET OUTPUT TO FILE
 LCOLON4  SX7       LIFIL               CREATE
          SB7       B7-1                  FILE OPERATOR FOR 
          SA7       B7                      NEXT TRIP THRU READ 
 PRTBT17  JP        LNONE 
          JP        LNONE               EXIT
 ICFILE   BSS    0
          SX4    X1-1R) 
          ZR     X4,IC7CHS
 LCOLON3  SX2       LILLEG6             BAD FILE NAME 
          SB7       B7-1
          JP        LCOLON4               CAUGHT BY UNSTACK ACT.
* 
 FILST    BSS    0
          SX2    LVFILE 
          JP     LNONE             EXIT WITH SYMBOL FOR -FILE-STMT
* 
 LPND     BSS    0
          SX2    LVPND             POUND SIGN (USED IN FILE STATEMENT)
          JP     LNONE
* 
 EOBACT   RJ        INNEXT
          JP        LREAD0
LUNQUOT   BSS       0 
          NG  X3,LUNQUOT1          JUMP IF CALL STMT
          SX3    X1-LIBAD 
          ZR   X3,LUNQUOT1         SKIP IF ESCAPE CODE CHAR 
          SX3       X1-LISEMI-1 
          PL        X3,JPB6 
          SA3    DATAST 
          NZ     X3,LUNQUOT2
          SB5       LNUM               NUMBER 
          EQ        B5,B6,LNUM
          SB5       LCHPLUS            NUMBER 
          EQ        B5,B6,LCHPLUS 
          SB5       LCHMINUS           NUMBER 
          EQ        B5,B6,LCHMINUS
          SB5       LPOINT             NUMBER 
          EQ        B5,B6,LPOINT
 LUNQUOT2 BSS    0
          SB5       LSTRING            QUOTE
          EQ        B5,B6,LSTRING 
          SX3       X2-LVCOM
          ZR        X3,JPB6 
 LUNQUOT1 BSS    0
          BX7    X7-X7       CLEAR QUOTE FLAG 
          SA7    QFLAG
          SB7       B7-1
          JP        LREAD18 
 QFLAG    DATA   0
* 
 FILCLN   BSS    0
* 
*  AT THIS POINT COLON CAN BE IN FILE STATEMENT OR ANSI SUBSTRING.
* 
          SA3    TORSTACK+B3            GET TOP OPERATOR
          SB5    X3                     EXTRACT TOROUT ADDR 
          SB6    LACTFIL                GET TOROUT FOR FILE STMT
          NE     B5,B6,SSCOL            SKIP IF NOT FILE STMT 
          SX2    LVCLNF      FILE :  SIMILAR (ALMOST) TO FILE = 
          JP     LNONE
 SSCOL    SX2    LVCOL                  SUBSTRING COLON 
          EQ     LNONE                  GO STACK IT 
 FMTST    BSS    0
          SB5    LFMTCLN-LA        B5 NOW POINTS TO RESERVE FOR COLON 
          SA5    B5+LA             FORCE RESWORD ENTRY FOR FORMAT(COLON)
          JP     LREAD7            AND REJOIN READ SEQUENCE 
* 
*  CHKSTR CHECKS AHEAD TO SEE IF NEXT SYMBOL IS A STRING. 
*     IF SO, X3 = 0 ELSE X3 = 1 
 CHKSTR   PS
          SX6    B7                SAVE SOURCE POINTER IN CASE SUBSTR TEST
          SA6    CHKSAVE
          SX3    B0 
          READCH
          SX6    X1-LIQUO    QUOTE
          ZR   X6,CHKSTR           IT IS STRING 
          SX6    X1-1R0 
          PL     X6,CHKOUT   NOT STRING 
          READCH
          SX6    X1-1R$ 
          ZR     X6,CHKSTR   ALPHA+$
          SX6    X1-1R+ 
          PL     X6,CHKOUT
          SX6    X1-1R0 
          NG     X6,CHK1     ALPHA+ALPHA
          READCH
          SX6    X1-1R$ 
          ZR     X6,CHKSTR   ALPHA+NUM+$
          EQ     CHKOUT 
 CHK1     BSS    0
          READCH
          SX6    X1-1R0 
          PL     X6,CHKOUT   NOT ALPHA+ALPHA+ALPHA
          READCH
          SX6    X1-1R$ 
          ZR     X6,CHKSTR   ALPHA+ALPHA+ALPHA+$
          SX6    X1-1R0 
          PL   X6,CHKOUT           AAA NOTA  IS NOT STRING
*  WE HAVE 4 LETTERS, CHECK IF IT IS SUBSTR 
          READCH
          SX6    X1-1R$ 
          ZR     X6,CHKSTR   AAAA$
          SX6    X1-1R0 
          PL     X6,CHKOUT   AAAA NOT A IS NOT STRING 
          SA1    CHKSAVE           RESET B7 TO START
          SB7    X1 
          READCH
          SX6    X1-1RS 
          NZ   X6,CHKOUT           NOT SUBSTR 
          READCH
          SX6    X1-1RU 
          NZ   X6,CHKOUT
          READCH
          SX6    X1-1RB 
          NZ   X6,CHKOUT
          READCH
          SX6    X1-1RS 
          NZ   X6,CHKOUT
          READCH
          SX6    X1-1RT 
          NZ   X6,CHKOUT
          READCH
          SX6    X1-1RR 
          ZR   X6,CHKSTR           IT IS SUBSTR 
 CHKOUT   BSS    0
          SX3    1
          EQ     CHKSTR 
* 
 CHKSAVE  BSS    1                 SAVE B7 HERE 
* 
* 
* 
 CNVTESC  DATA   0                 DECODE ESCAPE CODE CHAR
*  X1 IS COMPLEMENT OF 74XX OR 76XX 
          BX1    -X1               GET CHAR AS 74XX OR 76XX 
          MX6    54 
          BX6    -X6*X1            EXTRACT THE XX 
          ZR   X6,ESCILL           00 ILLEGAL 
          LX1    52                POSITION 2XX BIT LEFT
          PL   X1,CNVTES1          JUMP IF 74XX 
          SX1    X6                76XX, SAVE THE XX
          SX6    X6-1R0 
          PL   X6,ESCILL           7633-7677 ILLEGAL
          EQ   CNVTESC             RETURN 01-32 IN X1 FOR 7601-7632 
 CNVTES1  BSS    0                 CHAR IS 74XX, X6 IS XX 
 IF1      IFEQ   CHARSET,NEWCSET
          SX1    X6-CIRCLOW        CHECK IF CIRCUMFLEX
          NZ   X1,CNVTES2 
          SX1    CIRCFLEX          RETURN NON-ASCII VALUE 
          EQ   CNVTESC
 CNVTES2  BSS    0
 IF2      IFNE   IP.CSET,IP.C63 
          SX1    X6-COLONLOW       CHECK IF COLON 
          NZ   X1,ESCILL
          SX1    COLON             RETURN NON-ASCII VALUE 
          EQ   CNVTESC
 IF2      ENDIF 
 IF1      ENDIF 
 ESCILL   SX1    LIBAD             RETURN ILLEGAL CHAR FOR ALL ELSE 
          EQ   CNVTESC
* 
* 
* 
* 
 NS       DATA      0 
 DLMTROK  BSSZ   1                 -1 AFTER VALID DELIMITER AND ELSE 0
DATAST    DATA      0 
* 
*         A TRAILING COMMENT.  SKIP TO END OF LINE AND CONTINUE READING.
* 
 LREAD300 SA3    SAVEEND
          SB7    X3 
          EQ     LREAD0 
* 
*     GLBLIFR FLAG IS TURNED ON WHEN IT IS KNOWN THAT A 
*     STATEMENT TYPE -IF R THEN....- IS BEING COMPILED. 
*     THE FLAG REMAINS ON FROM THE TIME OF TORIN OF FIRST 
*     -THEN- THROUGH TO THE TORIN OF -EOS-. 
*     ONCE SET ON THE FLAG REMAINS ON UNTIL -EOS-, REGARDLESS 
*     OF THE TYPE OF STATEMENTS THAT MAY BE IMBEDDED IN 
*     THE -IF R THEN....- STATEMENT.
*     GLBLIFR FLAG IS USED TO INDICATE TO TORIN OF -EOS-
*     THAT A SEARCH FOR FORWARD LABELS IN THE ANDSTACK
*     SHOULD BE CONDUCTED.
*     ALSO USED BY ERROR WHEN RESETTING ANDSTACK POINTER. 
*     ALSO USED BY TORIN OF -EOS- WHEN RESETTING ANDSTACK POINTER.
* 
 GLBLIFR  BSSZ   1
* 
*     BYPASGO FLAG IS TURNED ON BY THE
*     TOROUTS OF -THEN- AND -ELSE- WHEN THEY
*     ARE UNSTACKED BY -ELSE-.
*     TURNED OFF BY TORIN OF -ELSE- 
*     WHEN IT CLEARS FOR A NEW STATEMENT; ALSO TURNED OFF 
*     BY TORIN OF -EOS-.
* 
*      BYPASGO FLAG IS USED BY TORIN OF -ELSE-
*     TO DETERMINE IF A JUMP TO THE EOS POSITION
*     MUST BE GENERATED.
* 
 BYPASGO  BSSZ   1
* 
 IFONFLG  BSSZ   1           SET TO NEGATIVE WHEN IF STATEMENT IS 
*                            ENCOUNTERED. REMAINS NEGATIVE UNTIL EOS
 ONANDIF  BSSZ   1                 1 WHEN -IF- OR -ON- STMTS ELSE ZERO
 ONATTN   BSSZ   1                 SET FOR ON ATTN STMTS
 PREFLG   BSSZ   1                 SET FOR MODIFIED PREAMBLE
 DBFLG    BSSZ   1                 DEBUG MODE FLAG - CID ENABLED
 IFTYP    EQU    1                 -IF- STATEMNET TYPE
 ONTYP    EQU    IFTYP+1           -ON- STMT TYPE 
 PRNTYP   EQU    ONTYP+1
QUOTED    DATA      0 
          IFEQ   CHARSET,OLDCSET
 LCR      EQU    66B
 LFEED    EQU    67B               -LINE FEED- CODE IN KRONOS 
          ELSE
 LCR      EQU    7655B
 LFEED    EQU    7652B
          ENDIF 
 ESC1     EQU    74B               CHARACTER -ESCAPE- CODE
 ESC2     EQU    76B               CHARACTER -ESCAPE- CODE
 DLMLIM   EQU    4                 MAX VALID NO OF DELIMITERS +1
 DLMTST   BSSZ   1                 IS 1/0 ACCORDING AS CURRENT STMT 
*                                  IS/IS NOT A -DELIMIT- STATEMENT
 DLMRNO   BSSZ   1                 COUNT OF DELIMITERS
 STRHEAD  BSSZ   1                 START ADDRESS OF CURRENT STRING
* 
*  END READ 
* 
          TITLE     ERROR HANDLING
* 
* ERROR EXITS 
* 
*  ERROR EXITS FROM READ
* 
 ER20     CALLERR   LERR20
 ER22     CALLERR   LERR22
 ER23     CALLERR   LERR23
 ER24     CALLERR   LERR24
 ER25     CALLERR   LERR25
 ER26     CALLERR  LERR26            ILLEGAL LEFT PAREN 
* 
*  ERROR EXITS FROM OUTINS
* 
 LABELERR CALLERR   BERR2               SAME LINE NUMBER OCCURS TWICE 
 RELERROR CALLERR   BERR3               REGISTER UNDERFLOW SYS ERROR
* 
*  ERROR EXITS FROM MAIN LOOP 
* 
 EILLSTAT BX1       -X7 
          CALLERR   (X1+STATERR)
* 
*  ERRORS IN USAGE OF STACK-S 
* 
 TORUNFL  CALLERR   BERR7               TORSTACK UNDERFLOW
 ANDSTOFL CALLERR   BERR11              ANDSTACK OVERFLOW 
 TOROVFL  CALLERR   BERR6               TORSTACK OVERFLOW 
* 
* 
*  ERROR EXITS FOR LIMITS OF COMPILER 
* 
 BFETOVFL CALLERR   BERR21              TOO MANY FET-S ESTABLISHED
 BILLDNO  CALLERR  BERR63          DELIMITER OVERFLOW 
* 
* 
*  ERROR EXIT FOR UNDEFINED LABELS
* 
 BUNDEFL  BSS       0 
          SX6    X2                SET LINE NUMBER
          SA6    SEQNO
          SX6       B6
          SA6       BUNDFWK 
          SA1    F.LABS 
          SB6    X1+B6
          SX6    B6 
          SA6    LABTEMP2 
          SA1    DBOPTION 
          LX1    2           BINARY REGARDLESS SW 
          PL     X1,UNDERR1  NOT SET
          SA1    XOPTION
          NZ     X1,UNDERR1        IF RELOCATABLE BINARY
 UNDERR   BSS    0
          RJ     GETLINK     GET NEXT POS.LINK
          ZR     B5,UNDERR1  END OF CHAIN 
          RJ     DLTLINK     DELETE FROM CHAIN
          EQ     UNDERR 
 UNDERR1  BSS    0
          SA1    LABTEMP2 
          SA4    X1-1 
          AX4    18 
          SX4    X4 
          NG     X4,UNDERR2  COMPILER GENERATED LABEL 
          RJERROR   BERR10              UNDEFINED LABEL 
 UNDERR2  BSS    0
          SA1       BUNDFWK 
          SB6       X1
          JP        BDEFLCNT
 BUNDFWK  DATA      0 
* 
*  ERROR ACTIONS FOR TOR-INPUT
* 
 SERROR   CALLERR   BERR44              TOR-IN RELATIONAL-S 
 SERROR2  CALLERR   BERR40              TOR-IN STEP 
 SERROR3  CALLERR   BERR41              TOR-IN TO 
 SERROR4  CALLERR   BERR42              TOR-IN )
 SERROR5  CALLERR   BERR43              TOR-IN FILE-ID
 SERROR6  CALLERR   BERR45              TOR-IN ,
 SERROR7  CALLERR   BERR46              TOR-IN SEMICOLON
 SERROR8  CALLERR   BERR47              TOR-IN (MAT FUN 
 SERROR9  CALLERR   BERR48              IN-ACTION = 
 SERRORA  CALLERR   BERR49              IN-ACTION READ, PRINT 
 SERRORB  CALLERR   BERR50              IN-ACTION EOS 
 SERRORC  CALLERR  BERR57          SET DIGITS 
* 
 SERRORD  CALLERR  BERR58          ILLEGAL USING
 SERRORF  CALLERR BERR70           ILLEGAL COLON
* 
 SERRORE  CALLERR  BERR59 
* ERROR EXITS FROM STACK ACTIONS
* 
 BDATERR  CALLERR   BERR12              ILLEGAL OPERAND FOR DATA
 BILLIF   CALLERR BERR115  ILLEGAL STMT WITHIN IF 
 BEQUERR  CALLERR   BERR13              ILLEGAL LEFT HAND SIDE
 BASSERR  CALLERR   BERR16              ILLEGAL ASSIGNMENT
* 
 BFILERR  CALLERR   BERR17              ILLEGAL FILE IDENTIFIER 
 BLINERR  CALLERR   BERR18              ILLEGAL LINE NUMBER 
 BWRITERR CALLERR   BERR19              ILLEGAL WRITE CONSTRUCT 
 BILLAOPR CALLERR   BERR20              ILLEGAL ARITHMETIC OPERAND
 BILLCLLS CALLERR   BERR22              ILLEGAL SYSTEM FUNCTION CALL
* 
 BILLARR  CALLERR   BERR23              ILLEGAL ARRAY REFERENCE 
 BILLAR2  CALLERR   BERR24              ILLEGAL USE OF ARRAY IDENT
 BILLEXT  CALLERR  BERR107         ILLEGAL EXTERNAL NAME
 BILLEXT1 CALLERR  BERR108         TOO MANY ARGUMENTS 
 BILLASC  CALLERR  BERR110         BAD ARG IN ASC 
 BILLMAT  CALLERR   BERR25              ILLEGAL USE OF MAT
 BILLMAT1 CALLERR  BERR111         MAT OPERAND AND RESULT SAME
 BILLDIM  CALLERR   BERR26              ILLEGAL OPERAND IN DIM
 BILLDIM1 CALLERR  BERR112         ILLEGAL REDIMENSION
 BILLSUB  CALLERR   BERR27              ILLEGAL OPERAND IN SUBSCRIPT
 BILLLAB  CALLERR   BERR28              ILLEGAL LABEL IN JUMPS
 BILLLAB1 CALLERR  BERR101         TRANSFER INTO DEF
 BILLLAB2 CALLERR  BERR102         TRANSFER OUT OF DEF
 BILLFORM CALLERR   BERR29              ILLEGAL FORMAL IN DEF 
 BILLFRML CALLERR  BERR105        TOO MANY FORMALS
 BNOMWFOR CALLERR   BERR30              NO MATCH WITH FOR 
 BILLFUN  CALLERR   BERR31              ILLEGAL USER-FUNCTION 
 UFUNLOOP CALLERR   BERR32              USER-FUNCTION LOOP
 BILLINP  CALLERR   BERR33              NO OPERAND WITH INPUT 
 BILLREAD CALLERR   BERR34              NO OPERAND WITH READ
 BILLREAF CALLERR   BERR35              NO OPERAND WITH READ FILE 
 BILLWRIT CALLERR   BERR36              NO OPERAND WITH WRITE FILE
 BILLCLO  CALLERR  BERR68 
 BILLCHO  CALLERR  BERR62          INVALID CHANGE 
 BILLFIL  CALLERR  BERR60          NULL FILE STMT 
 BILLDEF  CALLERR   BERR37              ILLEGAL DEF-STATEMENT 
 BILLDEF1 CALLERR  BERR104         *DEF WITHIN DEF* 
 BILLCOM  CALLERR   BERR54             ILLEGAL COMPARISON 
* 
 BILLSET  CALLERR  BERR67 
BFORERR  CALLERR   BERR52               FOR NEST TOO DEEP 
 BILLMIO  CALLERR   BERR55             NO OPERAND WITH MAT IO 
BILLSTOR CALLERR BERR56 
 BILLMGN  CALLERR  BERR64          ERROR MESSAGE: ILLEGAL MARGIN
BASE1    CALLERR    BERR65          BASE STATEMENT AFTER ARRAY MENTIONED
BASE2    CALLERR    BERR66          ILLEGAL BASE
 BASE3    CALLERR     BERR117 MORE THAN ONE OCCURRANCE OF BASE STATEMENT
 BILLTAB  CALLERR   BERR114        TAB ILLEGAL IN PRINT USING            BAS0018
 SIFMERR  CALLERR BERR69      IF END(MORE) ERROR
 BILL106  CALLERR BERR106    PARAMETER LIST CONFLICT
 BILL109  CALLERR BERR109    NOT ENOUGH ARGUMENTS 
 BILLCHN  CALLERR   BERR113        ILLEGAL ARG FOR CHAIN
* 
* 
*  ERROR ROUTINE
* 
 ERROR    BSS       0 
          SA1       STATE               BYPASS ERRORS 
          SX2       X1-STA6               WHEN IN 
          ZR        X2,MAINLOOP             ERROR STATE 
          RJ        RJERROR 
 ERROR01  BSS    0
          SA2    GLBLIFR
          ZR     X2,ERROR02 
*     HERE BECAUSE ERRORED WITHIN GLOBAL IF R STATEMENT.
*     RESET FORPTR TO EXTERNAL FORPTR.
*     RESET ANDSTACK POINTER TO EXTERNAL FORPTR.
          SA1    SVDFOR        FETCH SAVED EXTERNAL FORPTR
          BX6    X1 
          SA6    FORPTR        RESTORE FORPTR TO EXT FORPTR 
 ERROR02  BSS    0
          SA1       FORPTR
          SB3       B0                  TORPTR .= 0 
          SB2       X1                  ANDPTR .= FORPTR
          SA1    DBOPTION 
          LX1    2           BINARY REGARDLESS SW 
          SX6    B0 
          SA6    ONANDIF           CLEAR -ON- OR -IF- STMT FLAG 
          SA6    LOGSW
          SA6    DATAST 
          SX6       STA6
          SA6       STATE               SET ERROR STATE 
          SA2       NS                  GET LAST SYMBOL 
          PL     X1,ERRECOV 
          OUTINS EQ119       GENERATE -EQ ER119-
          SA2    NS          GET LAST SYMBOL
          JP        ERRECOV             AND RE-TRY IT IN ERROR STATE
* 
*  CALL ERROR ROUTINE AND RETURN
* 
 RJERROR  JP        0 
          SX6    B7 
          SA6    SAVEB7 
          SA1    LISTOPT
          NZ     X1,RJERR1
          SA1    EOPTION
          SB5    X1 
 XPRT2    NO                 MAY BE PLUGGED -RJ PRTER-
 RJERR1   BSS    0
          SA1       ERRORFL 
          SX6       X1+1                UP ERROR COUNT
          SA6       A1
          SB7       X0
          SA1    SEQNO             SET SEQUENCE NUMBER FOR ERROR MESSAGE
          SA0    X1 
          RJ        BASEGEN 
          SA1       SAVEB7
          SB7       X1
 XPAGERR  JP        RJERROR             A CALL FOR PAGE-CTR MAY BE ADDED
          JP        RJERROR 
* 
* 
 WERROR   PS
          SA1    ELOPTION 
          NZ     X1,WERROR   FATAL ERROR ONLY PRINTED 
          SX6    B7 
          SA6    SAVEB7 
          SA1    WARNFL 
          SX6    X1+1 
          SA6    A1                UP WARNING COUNT 
          SB7    X0 
          SA1    SEQNO             SET SEQUENCE NUMBER FOR ERROR MESSAGE
          SA0    X1 
          RJ     BASEGEN
          SA1    SAVEB7 
          SB7    X1 
 XPGERR   EQ     WERROR      A CALL FOR PAGE CTR MAY BE ADDED 
          EQ     WERROR 
* 
 WNSW     BSSZ   1           WARNING MESSAGE SWITCH 
 WARNFL   BSSZ   1                 WARNING FLAG (COUNT) 
 SAVEB7   BSSZ      1 
          EJECT 
* 
*         ERROR MESSAGES
* 
*         THE FORMAT FOR ERROR MESSAGES IS A MESSAGE STRING WITH AN 
*          EOL TERMINATOR.  TO CHANGE AN ERROR MESSAGE, CHANGE
*          THE CORRESPONDING ENTRY.  TO ADD AN ERROR MESSAGE, 
*          WRITE THE MESSAGE AND CHANGE THE CORRESPONDING  BSS 0. 
 LERR20   DATA   18L ILLEGAL CHARACTER                                  005450
 LERR22   DATA   18L ILLEGAL FN NAME                                    005470
 LERR23   DATA   18L ILLEGAL NUMBER                                     005480
 LERR24   DATA   18L ILLEGAL STRING                                     005490
 LERR25   DATA   18L ILLEGAL FILE NAME
 LERR26   DATA   26L ILLEGAL USE OF LEFT PAREN
 BERR64   DATA   18L ILLEGAL MARGIN                                     005510
 BERR2    DATA   18L DUPLICATE LINE NO                                  005530
 BERR5    DATA   C* FL TOO SMALL FOR COMPILATION* 
 BERR6    BSS    0                     TOR-STACK OVERFLOW 
 BERR11   BSS    0                     AND-STACK OVERFLOW 
          DATA   22L STATEMENT TOO COMPLEX
 BERR8    DATA   18L END NOT LAST                                       005550
 BERR9    DATA   18L FOR WITHOUT NEXT                                   005560
 BERR10   DATA   21L UNDEFINED LINE REF                                 005570
 BERR14   DATA   18L READ WITHOUT DATA                                  005580
 BERR21   DATA   18L TOO MANY FILES                                     005600
 BERR63   DATA   21L DELIMITER OVERFLOW                                 005610
 BERR30   DATA   18L NEXT WITHOUT FOR                                   005620
 BERR32   DATA   18L RECURSIVE FN                                       005630
 BERR38   DATA   18L UNDEFINED FN REF                                   005640
 BERR18   DATA   18L ILLEGAL LINE NO                                    005650
 BERR28   DATA   18L ILLEGAL LINE REF                                   005660
 BERR51   DATA   21L LINES OUT OF ORDER                                 005670
 BERR52   DATA   18L FOR NEST TOO DEEP                                  005680
 BERR26   DATA   18L ILLEGAL BOUND                                      005700
 BERR54   DATA   21L ILLEGAL COMPARISON                                 005710
 BERR115  DATA   23L INVALID STMT WITHIN IF 
 BERR116  DATA   24L REDEFINITION OF COLLATE
 BERR3    BSS       0                   REGISTER UNDERFLOW           SYS
 BERR7    BSS       0                   TOR-STACK UNDERFLOW 
 BERR12   BSS       0                   ILLEGAL OPERAND FOR DATA
 BERR13   BSS       0                   ILLEGAL LEFT-HAND-SIDE
 BERR16   BSS       0                   ILLEGAL RIGHT-HAND-SIDE 
 BERR17   BSS       0                   ILLEGAL FILE-IDENTIFIER      SYS
 BERR19   BSS       0                   ILLEGAL WRITE-OPERAND 
 BERR20   BSS       0                   ILLEGAL ARITH OPERAND 
 BERR22   BSS       0                   ILLEGAL SYSTEM-FUNCTION CALL SYS
 BERR23   BSS       0                   ILLEGAL ARRAY-IDENTIFIER
 BERR24   BSS       0                   ILLEGAL NUMBER OF SUBSCRIPTS
 BERR25   BSS       0                   ILLEGAL MAT-STATEMENT 
 BERR27   BSS       0                   ILLEGAL OPERAND IN SUBSCRIPT
 BERR29   BSS       0                   ILLEGAL FORMAL IN DEF 
 BERR31   BSS       0                   ILLEGAL USER FUNCTION        SYS
 BERR33   BSS       0                   NO OPERAND WITH INPUT 
 BERR34   BSS       0                   NO OPERAND WITH READ
 BERR35   BSS       0                   NO OPERAND WITH READ-FILE 
 BERR36   BSS       0                   NO OPERAND WITH WRITE-FILE
 BERR37   BSS       0                   ILLEGAL RIGHT-HAND-SIDE IN DEF
 BERR39   BSS       0                   ILLEGAL USE OF THEN 
 BERR40   BSS       0                   ILLEGAL USE OF STEP 
 BERR41   BSS       0                   ILLEGAL USE OF TO 
 BERR42   BSS       0                   ILLEGAL USE OF )
 BERR43   BSS       0                   ILLEGAL USE OF FILE-ID
 BERR44   BSS       0                   ILLEGAL USE OF RELATIONAL TOR-S 
 BERR45   BSS       0                   ILLEGAL USE OF ,
 BERR46   BSS       0                   ILLEGAL USE OF SEMICOLON
 BERR47   BSS       0                   ILLEGAL USE OF (MAT FUN 
 BERR48   BSS       0                   ILLEGAL USE OF =
 BERR49   BSS       0                   ILLEGAL USE OF READ OR PRINT
 BERR50   BSS       0                   ILLEGAL TERMINATION OF STATEMENT
 BERR55   BSS       0                  NO OPERAND WITH MAT IO 
BERR56   BSS       0
 BERR69   BSS    0
* 
 BERR57   BSS    0                 SETDIGITS
 BERR111  BSS    0                 MAT OPERAND AND RESULT SAME
 BERR113  BSS    0                 ILLEGAL ARG FOR CHAIN
 BERR70   BSS    0                 ILLEGAL COLON
 BERR80   BSS    0                 ILLEGAL *END* STATEMENT
          DATA   18L ILLEGAL STATEMENT                                  005750
* 
* 
 BERR58   DATA   18L ILLEGAL USING                                      005760
 BERR65   DATA   18L INVALID BASE STMT                                  005770
 BERR66   DATA   C* INVALID BASE VALUE *
 BERR117  DATA   C* BASE STATEMENT OCCURS MORE THAN ONCE *
* 
 BERR68   DATA   18L BLANK CLOSE STMT 
 BERR67   DATA   18L SET VALUE ILLEGAL
 BERR62   DATA   18L INVALID CHANGE                                     005810
 BERR59   DATA   C* ILLEGAL FILE NUMBER * 
 BERR60   DATA   18L BLANK FILE STMT                                    005830
 BERR101  DATA   18L TRANSFER INTO DEF
 BERR102  DATA   21L TRANSFER OUT OF DEF
 BERR103  DATA   14L FNEND MISSING
 BERR104  DATA   15L DEF WITHIN DEF 
 BERR107  DATA   22L ILLEGAL EXTERNAL NAME
 BERR108  DATA   21L TOO MANY ARGUMENTS 
 BERR105  DATA   17L TOO MANY FORMALS 
 BERR106  DATA   24L PARAMETER LIST CONFLICT
 BERR109  DATA   C* NOT ENOUGH ARGUMENTS *
 BERR110  DATA   24L ILLEGAL ARGUMENT IN ASC
 BERR112  DATA   21L ILLEGAL REDIMENSION
 BERR114  DATA   27L TAB ILLEGAL IN PRINT USING                          BAS0018
* 
* 
 STATERR  DATA      0 
 STERR01  BSS       0 
 STERR02  BSS       0 
 STERR03  BSS       0 
 STERR04  BSS       0 
 STERR05  BSS       0 
 STERR06  BSS       0 
 STERR07  BSS       0 
 STERR08  BSS       0 
 STERR09  BSS       0 
 STERR10  BSS       0 
 STERR11  BSS       0 
 STERR12  BSS       0 
 STERR13  BSS       0 
 STERR14  BSS       0 
 STERR15  BSS       0 
 STERR16  BSS       0 
 STERR17  BSS       0 
 STERR18  BSS       0 
 STERR19  BSS       0 
 STERR20  BSS       0 
 STERR21  BSS       0 
 STERR22  BSS       0 
 STERR23  BSS       0 
 STERR24  BSS       0 
 STERR25  BSS       0 
          DATA   18L ILLEGAL STATEMENT                                  005860
 STERR26  BSS       0 
 STERR27  BSS       0 
 STERR28  BSS       0 
 STERR29  BSS       0 
 STERR30  BSS       0 
 STERR31  BSS       0 
 STERR32  BSS       0 
 STERR33  BSS       0 
 STERR34  BSS       0 
 STERR35  BSS       0 
 STERR36  BSS       0 
 STERR37  BSS       0 
 STERR38  BSS       0 
 STERR39  BSS       0 
          DATA   18L ILLEGAL STATEMENT                                  005880
 STERR40  BSS       0 
 STERR41  BSS       0 
 STERR42  BSS       0 
 STERR43  BSS       0 
 STERR44  BSS       0 
 STERR45  BSS       0 
 STERR46  BSS       0 
 STERR47  BSS       0 
 STERR48  BSS       0 
 STERR49  BSS       0 
 STERR50  BSS       0 
 STERR51  BSS       0 
 STERR52  BSS       0 
 STERR53  BSS       0 
 STERR54  BSS       0 
 STERR55  BSS       0 
 STERR56  BSS       0 
 STERR57  BSS       0 
 STERR58  BSS       0 
 STERR59  BSS       0 
 STERR60  BSS       0 
 STERR61  BSS       0 
          DATA   18L ILLEGAL STATEMENT                                  005900
 STERR62  BSS       0 
 STERR63  BSS       0 
 STERR64  BSS       0 
 STERR65  BSS       0 
 STERR66  BSS       0 
 STERR67  BSS       0 
 STERR68  BSS       0 
 STERR69  BSS       0 
 STERR70  BSS       0 
 STERR71  BSS       0 
 STERR72  BSS       0 
 STERR73  BSS       0 
 STERR74  BSS       0 
 STERR75  BSS       0 
 STERR76  BSS       0 
 STERR77  BSS       0 
 STERR78  BSS       0 
 STERR79  BSS       0 
          DATA   18L MISSING LINE NO                                    005920
 STERR80  BSS       0 
          DATA   18L ILLEGAL OPERAND                                    005940
STERR81  BSS       0
STERR82  BSS       0
STERR83  BSS       0
STERR84  BSS       0
 STERR85  BSS    0
          DATA   18L ILLEGAL STATEMENT                                  005980
 FSTER14  DATA   C* NON-IMAGE REFERENCED *
* 
 WERR1    DATA   C* OBSOLETE FORM * 
 WERR2    DATA   C* LINE TRUNCATED AT 150 CHARACTERS *
 WERR3    DATA   C* WARNING - FUNCTION REDEFINITION * 
 WERR4    DATA   C* WARNING - FUNCTION REFERENCE BEFORE DEFINITION *
 WERR5    DATA   C* WARNING - DIM AFTER REFERENCE * 
          TITLE     REARRANGE CORE
 TOV      SX0    3000B             MEMUP INCR = 3000B 
          RJ     MEMUP             PICK UP MORE MEMORY
          SA5    FIELDLG           CURRENT FIELD LENGTH 
          PL     X0,TOV1           ADDITIONAL SPACE GRANTED 
          RJERROR BERR5 
          JP     XPOSTPR
 TOV1     SX6    X5-3              END OF MANAGED TABLES
          SA6    F.TEND            SET NEW END OF TABLES
          JP     B6 
          TITLE     OUTINS (CODE GENERATOR) 
* 
*  AT ENTRY X1 = TABLE WORD 
* 
 OUTINS   JP        0 
 ENDOUTIN EQU       OUTINS
          SB6       X1                  EXTRACT ACTION
          BX0       X1                  X0 .= OPCODE,LENGTH,RELOCATION
          AX1       30
          SX3       X1                  X3 .= KFIELD
          AX1       18
          BX2       X1                  X2 .= JREG
          AX1       3                   X1 .= IREG
          SA5       REGSTPTR            MAKE LIFE EASY FOR THE ACTIONS
          SX5       X5+REGSTACK 
 PRTBT70  BSS       0                   PRINTBYTE OF INPUT
          JP        B6                     MAY GO HERE
          JP        B6                  GOTO ACTION 
* 
*  ACTIONS HAVE AVAILABLE AS SCRATCH REGISTERS X4,(X5),X6,X7
* 
 BACT01   RJ        RESERVE 
* 
 BACT04   SA5       B2+ANDSTACK 
          SX3       X5                  KFIELD .= ADDRPART(ANDTOP)
          JP        STOREINS
* 
 BACT02   RJ        RESERVE 
          JP        STOREINS
* 
 BACT05   SA2       ANDSTACK+B2         JREG .= ANDSTACKTOP 
 RELANDST RJ        RELEASE 
* 
          JP     STOREINS 
 BACT6A   BSS    0
 BACT06   JP        STOREINS
* 
 BACT07   SA1       X5-1                IREG .= 
          SA2       ANDSTACK-ANDINCR+B2 JREG .= ANDSTACKTOP - 1 
          SA3       ANDSTACK+B2         KFIELD .= ANDSTACKTOP 
          JP        RELANDST
* 
 BACT08   BSS    0
          SX7    1
          SA7       FORCEUP             FORCEUP .= TRUE 
          JP        RELANDST
* 
 GETLABEL SA5       B2+ANDSTACK-1 
          RJ        LABEL 
          SX3       X5                  KFIELD .= LABEL(ANDTOP) 
          JP        RELANDST
* 
BACT03    SA2       ANDSTACK-ANDINCR+B2 
          SA5       B2+ANDSTACK-1 
          RJ        LABEL 
          SX3       X5
          JP        STOREINS
BACT27    SA1       ANDSTACK-ANDINCR+B2   I REG = 
          SA2       A1               J REG = ANDSTACKTOP - 1
          JP        STOREINS
 BACT10   SA2       X5                  JREG .= REGSTACKTOP 
          JP        GETLABEL
* 
 BACT11   SA1       ANDSTACK+B2         IREG .= 
          SA3       ANDSTACK+B2         KFIELD .= ANDSTACKTOP 
          JP        STOREINS
* 
 BACT12   SA1       ANDSTACK+B2         IREG .= 
          SA2       ANDSTACK+B2         JREG .= ANDSTACKTOP 
          JP        STOREINS
* 
 BACT14   SA1       ANDSTACK+B2         IREG .= 
          SA3       ANDSTACK+B2         KFIELD .= STACKTOP
* 
 BACT13   SA2       ANDSTACK-ANDINCR+B2 JREG .= ANDSTACKTOP-1 
          JP        STOREINS
* 
 BACT15   SA1       ANDSTACK-2*ANDINCR+B2  IREG .=
          SA3       ANDSTACK-2*ANDINCR+B2  KFIELD .= STACKTOP - 2 
* 
 BACT16   SA2       ANDSTACK+B2         JREG .= ANDSTACKTOP 
          JP        STOREINS
* 
*  LINENUMBER ACTION, INITIALIZE STOREINS 
* 
 BACT17   SX7       B0
          MX6       59
          SA7       PARCEL              PARCEL .= 
          SA7       PARTWD              PARTWD .= 
          SA7       ROTCOUNT            ROTCOUNT .= 0 
          SA6       REGSTPTR            REGSTPTR .= -1
          SA5    SEQNO             LINE NUMBER
          RJ        DEFLABEL
          JP        ENDOUTIN
* 
 BACT26   BSS       0                   KFIELD .=LINE NUMBER
          SA3    SEQNO             LINE NUMBER
          JP        STOREINS
* 
*  ACTION TO HANDLE DEFINITION OF RETURN INFO FOR GOSUB 
* 
 BACT18   SA5       B2+ANDSTACK-1 
          RJ        LABEL 
          SX3       X5                  KFIELD .= LABEL(ANDTOP) 
          JP        STOREINS
* 
 BACT19   SX7       1 
          SA7       FORCEUP 
          SA5       B2+ANDSTACK-1 
          RJ        LABEL 
          SX3       X5                  KFIELD .= LABEL(ANDTOP) 
          JP        STOREINS
* 
 BACT20   BSS       0                   DEFINE LABEL
          SA5       ANDSTACK-1+B2         DO NOT GENERATE 
          RJ        DEFLABEL              INSTRUCTION 
          JP        ENDOUTIN
* 
 BACT21   RJ        RELEASE             RELEASE TOP OF STACK, DO NOT
          JP        ENDOUTIN              GENERATE INSTRUCTION
* 
 BACT4F   SX7       1 
          SA7       FORCEUP             FORCEUP .= TRUE 
          JP        BACT04
* 
 BACT6E   BSS    0
 BACT6F   SX7       1 
          SA7       FORCEUP             FORCEUP .= TRUE 
          EQ       STOREINS 
* 
 BACT23   SA3       ANDSTACK+B2         KFIELD .= ANDSTACKTOP 
          JP        RELANDST
* 
 BACT24   RJ        RESERVE             RESERVE A REGISTER
          JP        ENDOUTIN
* 
 BACT25  RJ     RESERVE 
         SA3    ANDSTACK+B2 
          BX1       X3
          LX1       30
          UX1       B6,X1 
          SX1       B6                  IREG .= REGPART(ANDSTACK) 
          JP        STOREINS
 BACT28   SA1       ANDSTACK+B2        IREG.= ANDSTACKTOP 
          JP        STOREINS
 BACT29   SA2    X5                JREG = REGSTACKTOP 
          JP   RELANDST 
 BACT30   SA1    ANDSTACK+B2
          SX2    X1 
          SX3    X1 
          EQ     STOREINS 
          EJECT 
* 
 STORINS  BSS    0                 USED FOR ASSEMBLY LIST 
 STOREINS MX7       42
          BX3       -X7*X3              TRUNCATE KFIELD TO 18 BITS
          MX7       6 
          AX0       18
          LX7       12
          BX4       X7*X0               X4 = OPCODE * 2**6
          MX7       57
          BX1       -X7*X1              TRUNCATE IREG 
          BX2       -X7*X2                AND JREG TO 3 BITS
          LX1       3                   X1 = IREG * 2**3
          BX1       X1+X4 
          BX1       X1+X2               COMBINE OPCODE,IREG, AND JREG 
          BX2       -X7*X0              X2 = RELOCATION 
          AX0       3 
          BX0       -X7*X0              X0 = LENGTH 
          LX0       2 
          SA4    X2+RELJMP         RELOCATION ACTION TABLE
          SB6    X4 
          SB4    B0                NO RELOCATION
          JP     B6                PROCESS RELOCATION 
 RELJMP   VFD    60/STO3           NO RELOCATION
          VFD    60/STO4           PROGRAM RELOCATION 
          VFD    60/STO5           EXTERNAL RELOCATION
STO5      SA4    XOPTION           DONT MARK IF B OPTION
          NZ     X4,XSTOXT
          SA4    X3+BSFUNTBL       MARK IN USE
          PX6    X4,B1
          SA6    A4 
 XSTOXT   SX3    X4                SET K FIELD
          SB4    B0                CLEAR PROGRAM RELOCATION 
          EQ     STO3 
          IX1    X4+X3
          SA4    PARCEL            COMPUTE PARCEL 
          SX7    B1 
          SX6    X4-3 
 +        NZ     X6,*+1            IF NOT LAST PARCEL 
          SX4    B0                RESET TO UPPER 
          IX1    X7+X1             CORRECT ADDRESS
          SX4    X4-6 
          LX4    27 
          IX1    X1-X4             INSERT PARCEL INTO LNK BYTE
          SX4    B1                SET PROGRAM RELOCATION 
          LX4    18 
          IX1    X1+X4
          ADDWRD LINK,X1           SAVE LNK BYTE
          BX1    X0                RESTORE X1 
          SX0    4                 LENGTH IS 4
          MX3    0                 LEAVE K ZERO FOR NOW 
          SB4    B0                NO PROGRAM RELOCATION
          EQ     STO3              PROCESS REST OF INSTRUCTION
 STO4     SB4    2                 SET PROGRAM RELOCATION 
 STO3     SA5    PARCEL 
          SA4       PARTWD              X4 .= PARTWD
          IX0       X0+X5               LENGTH*4 + PARCEL 
          SA2    X0+STINSTBL
          SB6    X2 
          JP        B6
* 
 STI015N  MX4    0                 15 BIT COMMAND PARCEL 0
          SX6    B1 
          EQ     SQW               PROCESS QUARTER WORD 
 STI115N  SX6    B1+B1             15 BIT COMMAND PARCEL 1
          EQ     SQW
 STI215N  SX6    3                 15 BIT COMMAND PARCEL 2
          EQ     SQW
 SQW      LX1    3                 POSITION COMMAND 
          BX7    X3+X1             PACK LAST REGISTER 
          LX4    15                POSITION PREVIOUS PARTWORD 
          BX7    X7+X4
          SA3    RELOC             UPDATE RELOCATION
          SA6    A5                SET PARCEL 
          SA7    A4                SAVE PARTWORD
          LX6    X3,B1
          SA6    A3                RESET RELOCATION 
          EQ     ENDOUTIN 
 STI315N  LX1    3                 15 BIT COMMAND PARCEL 4
          BX7    X3+X1             PACK COMMAND 
          LX4    15 
          BX7    X4+X7             PACK PARTIAL WORD
          SA3    RELOC
          SX6    4
          SA6    A5                SET PARCEL 
          SA7    A4                SET PART WORD
          LX6    X3,B1             POSITION RELOCATION
          SA6    A3 
          RJ     OUTWORD           OUTPUT WORD
          EQ     ENDOUTIN 
 STI330N  LX1    18                30 BIT COMMAND PARCEL 3
          BX0    X1+X3
          RJ     OUTWORD
          R=     X6,2              RESET PARCEL 
          MX4    0
          EQ     CHW1 
 STI230N  R=     X6,4 
          EQ     CHW
 STI130N  R=     X6,3 
          EQ     CHW
 STI030N  R=     X6,2 
          MX4    0
 CHW      LX1    18 
          BX0    X1+X3
          LX4    30                POSITION OLD PART WORD 
 CHW1     BX7    X4+X0             PACK COMMAND 
          SA3    RELOC             RELOCATION 
          SA6    PARCEL            SET PARCEL 
          SA7    PARTWD            SET PARTWD 
          LX3    2                 POSITION OLD RELOCATION
          SX7    B4 
          BX7    X7+X3             PACK RELOCATION
          AX6    2
          SA7    A3                SAVE RELOCATION
 +        ZR     X6,*+1            IF WORD NOT YET FULL 
          RJ     OUTWORD           OUTPUT WORD
          SA1    FORCEUP
          ZR        X1,ENDOUTIN         FORCEUP = FALSE 
          MX7       0 
          SA7       A1                  FORCEUP .= FALSE
          RJ        OUTWORD 
          JP        ENDOUTIN
* 
*  CONTROL TABLE FOR STOREINS 
* 
 STINSTBL BSS    0         LENGTH PARCEL
          VFD    60/STI015N  15    0
          VFD    60/STI115N  15    1
          VFD    60/STI215N  15    2
          VFD    60/STI315N  15    3
          VFD    60/STI030N  30    0
          VFD    60/STI130N  30    1
          VFD    60/STI230N  30    2
          VFD    60/STI330N  30    3
          EJECT 
* 
*  USE  X4,X5,X6,X7 ONLY IN OUTWORD 
* 
 OUTWORD  PS
          SA4    PARCEL            CURRENT PARCEL NUMBER
          SB6    X4-4 
          ZR     X4,OUTWORD        IF NOTHING TO DO 
          SA1    PARTWD            PARTIAL WORD 
          MX6    0
          SA6    A4                CLEAR PARCEL COUNT 
          SX7    46000B            PASS 
          SA5    RELOC             CURRENT RELOCATION 
          ZR     B6,FULLWRD        IF NO PADDING NEEDED 
 OUT1     LX1    15                POSITION INSTRUCTIONS
          SB6    B6+B1             COUNT PARCELS
          LX5    1                 POSITION RELOCATION
          BX1    X1+X7             PACK NO OP 
          NZ     B6,OUT1           IF NOT DONE
          BX6    X5 
          SA6    A5                STORE RELOCATION 
 FULLWRD  ADDWRD CODE,X1           PUT WORD INTO CODE 
          SA5    INSTPTR           INSTRUCTION COUNTER
          SX6    X5+B1             COUNT INSTRUCTIONS 
          SA6    A5 
          JP     OUTWORD           EXIT 
          EJECT 
* 
*  INPUT IS IN THE LOWER 18 BITS OF X5, WHICH IS CONSIDERED A SYMBOL
*     THE VALUE ASSIGNED TO THE LABEL IS THE VALUE OF FIRSTINS
* 
 DEFLABEL JP        0 
          BX6       X5
          SA6    LABTEMP1    SAVE LABEL SYMBOL
          RJ        OUTWORD             FORCE OUT PARTIAL WORD
          SA5    LABTEMP1    FETCH SAVED LABEL SYMBOL 
 DEFLABX  RJ     LABELCTR          MAKE TABLE ENTRY 
          SA4       B6
          NG        X4,LABELERR         LABEL ALREADY DEFINED 
          SX6    X4                SAVE LINENO OF FIRST REFERENCE 
          SA6    LABTEMP1 
          SX6    B6 
          SA5    F.LABS 
          IX6    X6-X5
          SA6    LABTEMP           DUMP ADDRESS OF CURRENT LINE LABEL 
          SA5    INSTPTR
          MX6       42
          BX4       X6*X4               CLEAR VALUE FIELD 
          MX7       1 
          BX6       X4+X5               INSERT VALUE
          BX6       X7+X6                 AND DEFINED BIT 
          SA6       A4
          SA7       PARTLAB             TURN LABEL FLAG ON
          SA4    A4-1              GET WORD2 OF ENTRY 
          PL  X4,DEFLABEL          EXIT IF ACTIVE 
*  ENTRY IS INACTIVE, PREVIOUS REF WAS OUTSIDE THIS DEF 
*  ACTIVATE IT TO INDICATE IN THIS DEF, RESET POSSIBLE CONFLICT BIT 
          MX1    57                SET UP MASK, 1...1000
          LX1    59                01...100 
          SX6    1
          BX1    X6+X1             01...101 
          LX1    58                0101...1 
          BX6    X1*X4             RESET INACTIVE, CONFLICT BITS
          SA6    A4                STORE BACK IN LABEL TABLE
          SA1    LABTEMP1          GET LINENO OF FIRST REFERENCE
          SA5    SEQNO             CURRENT LINE NUMBER
          BX6    X1 
          LX7    X5 
          SA6    A5 
          SA7    A1 
          SA1    DBOPTION    BINARY REGARDLESS SW 
          LX1    2
          NG     X1,DEFLAB3 
          SX0    BERR101     *TRANSFER INTO DEF*
 DEFERR   RJ     RJERROR           OUTPUT ERROR 
          SA1    LABTEMP1          RESTORE LINE NUMBER
          BX6    X1 
          SA6    SEQNO
          EQ     ERROR01
* 
 DEFLAB3  BSS    0
          SX6    B6 
          SX7    B3          SAVE B3
          SX1    B7          AND B7 
          LX7    18 
          BX7    X1+X7
          SA7    LABTEMP3 
          SA1    DEFSTRT
          SA6    LABTEMP2 
          SA1    XOPTION
          NZ     X1,DEFLAB2        IF RELOCATABLE 
 DEFLAB   BSS    0
          RJ     GETLINK     GET NEXT POS.LINK
 DEFLAB0  BSS    0
          ZR     B5,DEFLAB2  END OF CHAIN 
          SX2    B5 
          MX0    44 
          BX2    -X0*X2      STRIP POS
          IX2    X1-X2
          NG     X2,DEFLAB1  LINK .GT. DEFSTRT
          RJ     DLTLINK     DROP ENTRY FROM CHAIN
          EQ     DEFLAB0
 DEFLAB1  BSS    0
          SB6    B5 
          EQ     DEFLAB 
 DEFLAB2  BSS    0
          SA1    LABTEMP3 
          SB7    X1 
          AX1    18 
          SB3    X1 
          SX6    B0 
          SA6    LABTEMP2 
          SX0    BERR101     *TRANSFER INTO DEF*
          EQ     DEFERR            PROCESS ERROR
 LABTEMP  DATA      0 
 LABTEMP1 DATA   0
 LABTEMP2 DATA   0
 LABTEMP3 DATA   0
          EJECT 
* 
*  INPUT IS IN X5 (LAB) 
*  OUTPUT IS IN X5(USAGE) 
* 
*     EACH CALL OF LABEL IS CONSIDERED A REFERENCE TO LAB, SO THE 
*     USAGE CHAIN IS UPDATE ACORDINGLY
* 
 LABEL    JP        0 
 LABREF   RJ     LABELCTR          MAKE ENTRY IN TABLE
          SA4    B6-1        GET WORD2 OF ENTRY 
          PL     X4,LABEL0   IT IS ACTIVE 
          SA4    B6          GET WORD1 OF ENTRY 
          PL     X4,LABEL0   IT IS UNDEFINED
          SA4    DEFFLAG     REFERENCE TO INACTIVE LABEL IS A NO-NO 
          NZ     X4,BILLLAB2 *TRANSFER OUT OF DEF*
          EQ     BILLLAB1    *TRANSFER INTO DEF*
 LABEL0   BSS    0
          SA4       PARCEL
* BASOPTS WILL BUILD AN RJ =XLABEL(LOCATED IN BASOPTS)WHEN B OPTION IS SELECTED 
          SA5    INSTPTR            CURRENT INSTRUCTION LOCATION
          SX7       2 
          SX6       X4-3
          NZ        X6,LABEL1 
          SX5       X5+1                USAGE .= USAGE + 1
          SX4       B0
 LABEL1   BSS       0 
          SB5       X4
          AX7       B5,X7               POS .= 2 -(IF PARCEL = 3 THEN 
          MX6       44                             0 ELSE PARCEL) 
          BX6       -X6*X5              TRUNCATE USAGE TO 16 BITS 
          LX7       16
          BX7       X7+X6               COMBINE POS AND USAGE 
          SA4       B6
          SB6       X4                  B6 .= VALUE 
          LX4       42
          SB5       X4                  B5 .= OLD USAGE 
          MX6       42
          BX4       X6*X4               CLEAR USAGE FIELD 
          BX7       X7+X4               INSERT NEW USAGE
          LX7       18                  REPOSITION
          SA7       A4                  AND STORE BACK
 LABEL2   SA5    F.LABS            START OF LABEL TABLE 
          SB6    X5 
          SX7    A4-B6             RELATIVE ADDRESS OF LABEL
          SA7    LABTEMP           SAVE ADDRESS OF LATEST LABEL BLODK 
          SX5       B5                  RETURN USAGE
          SA4    A4-1              GET WORD2 OF ENTRY 
          PL  X4,LABEL             EXIT IF ACTIVE 
* 
* 
*  THIS LINENO HAS BEEN REFERENCED BEFORE OUTSIDE THIS DEF
*  SO WE HAVE A CONFLICT. CANNOT TELL UNTIL FNEND WHICH IS
*  WRONG - IT DEPENDS ON WHETHER LABEL TURNS OUT TO BE
*  DEFINED IN THIS DEF OR NOT.
          MX7    1                 SET CONFLICT BIT (57)
          LX7    58 
          BX7    X7+X4
          SA7    A4                STORE BACK IN LABEL TABLE
          SA4    A4+1              GET WORD1 AGAIN
          MX7    22                CHECK IF LINENO SAVED ALREADY
          LX7    58 
          BX7    X7*X4
          NZ  X7,LABEL             EXIT IF SAVED
          SA5    SEQNO             LINE NUMBER
          LX5    36 
          BX7    X5+X4             PACK LINE NUMBER 
          SA7    A4                STORE WORD1 BACK IN TABLE
          EQ  LABEL 
* 
* 
          EJECT 
* 
*  LABELCTR (LABEL CONTROL) SEARCHES THE LABELTABLE AND ADDS A NEW
*     ENTRY IF NEED BE. 
*  LABELTABLE RESIDES IN HIGH CORE FROM IDLASRT AND DOWN.  LABLPTR
*     POINTS AT NEXT AVAILABLE WORD IN LABELTABLE.
*  LABELCTR IS ENTERED WITH THE NAME OF THE LABEL IN X5.
*  AT EXIT B6 POINTS AT THE FIRST WORD OF THE ACTUAL ENTRY (ABS ADDR) 
* 
* 
*  EACH ENTRY IN LABELTABL IS COMPRISED OF TWO WORDS WITH LAYOUT
*         WORD 1 ...  1/DEF,1/FORMAT,22/LINE,2/POS,16/USAGE,18/VALUE
* 
*         WORD2  1/I,1/D,1/C,3/0,18/PR USG CALLERS LINE,18/NAME,18/LINK 
* 
*     DEF = 1 LABEL IS DEFINED
*         = 0 LABEL IS UNDEFINED AND VALUE IS LINENO OF FIRST REFERENCE.
* 
*         FORMAT : 1 IF THIS IS A FORMAT LINE@ OTHERWISE 0
* 
*         LINE = LINE NUMBER OF LABEL IF GENERATED BY FOR 
*     POS = POSITION WITHIN WORD OF NEXT USAGE
*           0 - LOWER, 1-MIDDLE, 2-UPPER. 
*     USAGE = HEADER OF A CHAIN THROUGH GENERATED CODE OF USAGES
*           OF THIS LABEL.
*           NOTE THAT THIS RESTRICTS THE LENGTH OF THE GENERATED CODE 
*           TO  2**16 = 65536.
*     VALUE = VALUE OF INSTPTR (ABS ADDR) AT MOMENT OF DEFINITION OF
*           THIS LABEL. 
*           SEE NOTE FOR DEF. 
*     NAME = 18 BIT TRUNCATED NAME OF THIS LABEL. 
* 
*     LINK = REL ADDR (REL TO IDLASRT(B1)) OF NEXT ENTRY OF THIS HASH 
*           THE FIRST 32 WORDS OF LABELTABEL IS A HEADERTABEL INDEX 
*           BY A HASH OF THE NAME (FOR HASH METHOD SEE CODE)
*           EACH ENTRY IS A POINTER (REL TO B1) TO THE FIRST ENTRY
*           FOR THIS HASH 
* 
*     I = 1 IF ENTRY INACTIVE 
*     D = 1 IF LABEL IS IN A DEF
*     C = 1 IF CONFLICT OCCURS WITHIN DEF 
* 
* 
* 
 LABELCTR JP        0 
          MX7       42
          BX6       -X7*X5              X6 .= NAME (TRUNCATED TO 18 BIT)
          BX5       X6
          AX5       5 
          MX4    55 
          IX5       X5+X6               HASH .= MOD(NAME + NAME//32,32) 
          BX5    -X4*X5            EXTRACT HASH 
          LX6    18 
          SA4    F.LABS 
          SB5    X5 
          SA5    X4+B5             HEADER ENTRY 
          SB5       X5                  PTR .= LINKPART(ENTRY)
          ZR     B5,LAB2           IF NO CHAIN
          LX7    18                POSITION MASK
 LAB1     SA5    X4+B5             NEXT 
          SB5       X5                  PTR .= LINKPART(ENTRY)
         BX5       -X7*X5 
          SB6    A5+B1
          BX5    X5-X6
          ZR     X5,LABELCTR       IF FOUND 
          NZ     B5,LAB1           IF MORE TO GO
 LAB2     SA5    A5                OLD ENTRY
          SA4    L.LABS 
          LX7    X1                SAVE X1
          BX1    X6                NAME VALUE 
          IX6    X4+X5             INSERT LINK
          SA6    A5 
          BX5    X2                SAVE X2
          BX6    X3 
          SA6    LABSAV 
          SA7    A6+B1
          ADDWRD LABS,X1           ENTER NAME 
          SA1    SEQNO             ENTER LINE NUMBER OF FIRST REFERENCE 
          ADDWRD A0,X1
          SA3    LABSAV            RESTORE X3 
          SA1    A3+B1
          SB6    A6                ADDRESS OF WORD
          BX2    X5                RESTORE   X2 
          JP        LABELCTR              AND EXIT
 LABSAV   BSS    2                 SPACE TO SAVE REGISTERS
* 
 SRCHLAB  DATA   0
*  SEARCH LABEL TABLE SEQUENTIALLY FOR LINE NUMBER ENTRIES
*  EACH CALL RETURNS B6 = ADDR OF AN ENTRY, B6=0 MEANS END
*  OF LABEL TABLE REACHED.
          SA1    OLDLINK           GET LINK SAVED LAST TIME 
          SB5    X1 
 SRCHLAB5 NZ  B5,SRCHLAB1          JUMP IF ENTRY EXISTS 
 SRCHLAB3 SA1    OLDCHAIN          NO ENTRY, TRY NEXT CHAIN 
          SX6    X1+1              NEXT CHAIN HEADER NUMBER (1-32)
          SX1    X6-33
          ZR  X1,SRCHLAB2          JUMP IF NO MORE CHAINS 
          SA6    OLDCHAIN          SAVE HEADER NUMBER FOR NEXT TIME 
          SB5    X6-1 
          SA1    F.LABS 
          SA1    X1+B5             CHAIN HEADER 
          SB5    X1                LINK PART
          ZR  B5,SRCHLAB3          JUMP IF EMPTY CHAIN
* 
 SRCHLAB1 BSS    0                 WE HAVE LINK TO AN ENTRY 
          SA1    F.LABS 
          SA1    X1+B5             WORD 2 
          SX6    X1                SAVE ITS LINK FOR NEXT TIME
          SA6    OLDLINK
          AX1    18                CHECK NAME 
          SX2    X1 
          NG  X2,SRCHLAB4          JUMP IF INTERNAL LABEL 
          SB6    A1+1              RETURN ADDR OF WORD1 OF ENTRY
          EQ  SRCHLAB 
 SRCHLAB4 SB5    X6                IGNORE INTERNAL LABEL, GET LINK
          EQ  SRCHLAB5             TRY NEXT ENTRY 
* 
 SRCHLAB2 BSS    0                 END OF TABLE 
          SB6    B0                RETURN ZERO
          SX6    B0                RESET FOR NEXT SEARCH
          SA6    OLDLINK
          SA6    OLDCHAIN 
          EQ  SRCHLAB              RETURN 
* 
 OLDLINK  DATA   0
 OLDCHAIN DATA   0
*       GETLINK  ON ENTRY B6 POINTS TO LABEL ENTRY OR HAS POS.LINK
*                ON EXIT NEXT POS.LINK IN B5
 GETLINK  DATA   0
          SA2    LABTEMP2 
          SX4    B6 
          SB7    X2 
          EQ     B6,B7,GETLINK1        B6 POINTS TO LABEL ENTRY 
          RJ     LINKER 
          SA4    X7          GET NEXT LINK
          LX4    B3          SHIFT RIGHT
          SB5    X4          IN B5
          EQ     GETLINK
 GETLINK1 BSS    0
          SA2    B6          GET LABEL ENTRY
          AX2    18          SHIFT RIGHT
          SB5    X2          B5 = NEXT LINK 
          EQ     GETLINK
* 
*       LINKER   CRACKS POS.LINK IN X4
*                X7 = LINK
*                B7 = SHIFT COUNT 
*                B3 = 60-SHIFT COUNT
*                X5 = POS 
* 
 LINKER   DATA   0
          MX6    44 
          BX7    -X6*X4      X7 = LINK
          SB4    X7                RELATIVE ADDRESS 
          SA5    F.CODE            MAKE ADDRESS 
          IX7    X7+X5
          AX4    16 
          MX6    58 
          BX6    -X6*X4      X6 = POS 
          BX5    X6          X5 = POS 
          LX6    4           16*POS 
          IX6    X6-X5       X6 = 15*POS I.E. SHIFT COUNT 
          SB7    X6          B7 = SHIFT COUNT 
          SB3    -B7
          SB3    B3+60       B3 = 60-SHIFT COUNT
          EQ     LINKER 
* 
* 
*    DLTLINK     PICK UP NEW LINK FROM NEXT LINK AND
*                MOVE INTO PRESENT LINK. PLUG -EQ  ER119- INTO NEXT LINK
*                NEW LINK BECOMES NEXT LINK.
*         ENTRY  B6 = PRESENT LINK (OR POINTER TO LABEL ENTRY)
*                B5 = NEXT LINK 
* 
 DLTLINK  DATA   0
          SX4    B5 
          RJ     LINKER 
          SA4    X7 
          LX4    B3          X4 = NEXT POS.LINK 
          SA2    ERMAD             ADDRESS OF ER119 
          MX0    30                MASK FOR INST
          BX6    X0*X4       CLEAR NEXT POS.LINK
          BX6    X6+X2       INSERT -EQ  ER119- 
          LX6    B7          SHIFT BACK INTO POSITION 
          SA6    A4          RESTORE
          SA2    LABTEMP2 
          SB5    X4          NEW POS.LINK 
          SB7    X2 
          EQ     B6,B7,DLTLINK2 STORE NEW POS.LINK IN LABEL ENTRY 
          SX4    B6 
          RJ     LINKER 
          SA4    X7          PICK UP PRESENT LINK 
          LX6    X4,B3       POSITION RIGHT 
          BX6    X0*X6       CLEAR
          SA4    ERMAD
          BX6    X4+X6       INSERT NEW POS.LINK
          LX6    B7          REPOSITION 
          SA6    A4          RESTORE
          EQ     DLTLINK
 DLTLINK2 BSS    0           STORE NEW POS.LINK IN LABEL ENTRY
          SA2    B6          WORD1 OF LABEL ENTRY 
          MX0    42 
          BX4    -X0*X4      NEW POS.LINK 
          LX2    60-18       POSITION RIGHT 
          BX2    X0*X2
          BX6    X2+X4       MERGE
          LX6    18          POSITION BACK
          SA6    A2          RESTORE
          EQ     DLTLINK
* 
* 
ERMAD     VFD    30/0,12/0400B,18/=XER119 
          EJECT 
* 
*  USABLE X-REGISTERS ARE..  (X1),X4,X5,X6,X7 
* 
 RESERVE  JP        0 
          SA4       REGSTPTR
          SA5       ROTCOUNT
          SA1       X4+REGSTACK+1       X1 .= REGSTACK(PTR) 
          SX6       X4+1
          SA6       A4
          ZR        X1,RESROT           REGSTACK(PTR) = 0 
          ZR        X5,RESERVE          ROTCOUNT = 0, IREG .= REGST(PTR)
* 
*     ROTCOUNT IS NON-ZERO - MAKE SURE A REGISTER IS FREE 
* 
 RESCLEAR SA4       FORPTR
          SB5       X4+ANDINCR          FOR I .= FORPTR(ANDINCR)ANDPTR
 RESCLTST LT        B2,B5,RESERVE         DO
          SA4       ANDSTACK+B5 
          LX4       30
          SX5       X4-VINX 
          ZR        X5,RESCL1           CLASS = VINX
          SX5    X4-AINX1 
          ZR     X5,RESCL1
          SX5       X4-AINX 
          NZ        X5,RESCLCNT         CLASS NOT AINX
 RESCL1   LX4       30
          SX5       X4
          IX5       X5-X1 
          NZ        X5,RESCLCNT         NOT THE RIGHT REGISTER
          RJ        TEMPLOC             X7 .= REL ADDR OF TEMP
          SX5    CLASSINC 
* 
          MX6       42
          SB6       X4                  SAVE REGISTER 
          BX4       X4*X6 
          BX4       X4+X7               REPLACE REGISTER WITH REL ADDR
          LX4       30
          PX6       B6,X4               INSERT REGISTER 
          SX7    10B
          BX6    -X7*X6 
          IX6       X5+X6               CHANGE CLASS TO SAVED REGISTER
          LX6       30                  REPOSITION
          SA6       ANDSTACK+B5           AND STACK 
          SA5       PARTWD
          SA1       PARCEL
 +        NZ        X1,*+1
          SX5       0 
          SX6       BX7X0 
          SX1       B5                  SAVE PTR TO ANDSTACK IN X1
          LX5       15
          SX7       B6
          SA4    RELOC
          LX7       3 
          BX6       X6+X5 
          BX6       X6+X7 
          SA6       A5                  PARTWD .= PARTWD *2**15+XMIT
          LX7    X4,B1
          SA7    A4 
          SA5       PARCEL
          SX6       X5+1
          SA6       A5                  PARCEL .= PARCEL + 1
          SX4       X6-3
          NG        X4,RESCL2           THERE IS ROOM FOR THE STORE 
          BX6    X3                SAVE X3
          SA6    SAVX3R 
          BX6    X2 
          SA6    SAVX2R 
          RJ        OUTWORD 
          SA3    SAVX3R 
          SA2    SAVX2R 
          SX6    B0 
          SX1    B5                RESTORE B5 
          SA6       PARTWD
 RESCL2   SA5       PARTWD              GENERAT SA7 B2+RELADDR
          SX6       SA7B2K
          SB5       X1
          LX5       30
          SA1       ANDSTACK+B5 
          LX6       18
          SX1       X1
          BX6       X6+X1 
          BX6       X6+X5               INSERT STORE INTO WORD
          SA5       PARCEL
          SA1    RELOC
          SA6       PARTWD
          SX7       X5+2
          SX5       X5-2
          SA7       A5                  PARCEL .= PARCEL + 2
          LX7    X1,B1
          SA7    A1 
          SX1       B5
          NZ        X5,RESCL3           PARCEL NOT 4
          LX4       9 
          BX6       X4
          SA6       A4
          BX7    X2 
          BX6    X3 
          SA7    SAVX2R 
          SA6    SAVX3R 
          RJ        OUTWORD 
          SA2    SAVX2R 
          SA3    SAVX3R 
          SX1    B5 
 RESCL3   SA1       ANDSTACK+X1 
          LX1       30
          UX1       B6,X1 
          SX1       B6                  IREG = REGNO
          JP        RESERVE 
 RESCLCNT SB5       B5+ANDINCR
          JP        RESCLTST
 RESROT   SX7       X5+1
          SX6       B0
          SA7       A5                  ROTCOUNT .= ROTCOUNT + 1
          SA6       A4                  REGSTPTR .= 1 
          SA1       REGSTACK+X6 
          JP        RESCLEAR
* 
 SAVX2R   BSS    1
 SAVX3R   BSS    1                 HOLD X3 OVER OUTWORD CALL
          DATA      1                   FOR BACT07
 REGSTACK DATA      5,4,3,2,1,0 
 REGSTPTR DATA      -1
 ROTCOUNT DATA      0 
          EJECT 
* 
 RELEASE  JP        0 
          SA4       REGSTPTR
          SA5       ROTCOUNT
          SX6       X4-1
          SA6       A4                  REGSTPTR .= REGSTPTR - 1
          PL        X6,RELEASE          NOT AT BOTTOM OF REGSTACK 
          NG        X4,RELERROR         REGISTER UNDERFLOW
          ZR        X5,RELEASE          STACK IS EMPTY
          SX7       X5-1
          SA7       A5                  ROTCOUNT .= ROTCOUNT - 1
          SX6       4 
          SA6       A4                  REGSTPTR .= 4 
          JP        RELEASE 
          SPACE  4
* 
*  WORKING LOCATIONS FOR OUTINS 
* 
 FORCEUP  DATA      0 
 PARCEL   DATA      0 
 PARTLAB  DATA      0 
 PARTWD   DATA      0 
 RELOC    DATA   0                 RELOCATION BYTES 
          DATA   -15               BYTES LEFT COUNT 
* 
*  EQU-S FOR OUTINS 
* 
 BX7X0    EQU       10700B
 SA7B2K   EQU       5172B 
          TITLE     DECLBUF  (DECLARE  BUFFER)
* 
*  PROCEDURE DECLBUF(FILEID)
* 
*     FILEID IN X5 AT ENTRY  (RIGHT ADJUSTED) 
* 
*     AT EXIT X7 = REL ADDR OF FET
* 
*     AVAILABLE REGISTERS.. A1-7, X0-7, B5, AND B6
* 
 DECLBUF  JP        0 
          SA1    F.CONS            START OF CONSTANTS 
          SB5    B0                INITIAL POINTER
          SA2       X1                  X2 .= HEAD OF CHAIN 
          LX5       60-BFIDWD 
          NG        X2,BDCLNEW          CHAIN EMPTY 
 BDCLBUF1 BX3       X2                  LINK .= NEWLINK 
          MX6       BFIDWD
          BX4    X6*X3       EXTRACT FILE NAME
          IX0       X5-X4 
          SX7       X3                  RETURN REL ADDR OF FET
          ZR        X0,DECLBUF          IT WAS ALREADY THERE
          SB5       X3+BFETCHA
          SA2       B5+X1               GET NEWLINK 
          SX3    X2 
          PL     X3,BDCLBUF1 IF NEW-LINK NOT NEGATIVE (NOT END CHAIN) 
 BDCLNEW  SB6    B5                SAVE POINTER 
          SA4    L.CONS            SIZE OF CONSTANTS
          SB5    X4 
          ALLOC  CONS,BFETLGT      ALLOCATE SPACE FOR FET 
          SA1    F.CONS            START OF CONSTANTS 
          SX0    X1+B5
          SX2    B5 
          SA4    VARCONT
          BX7       X4
          MX6       59
          IX6       X5-X6               SET READY BIT INTO FILE NAME
          SA6       X0                  STORE FILENAME AND STATUS 
          SA7       X0+1                  -   FIRST 
          MX6       0 
          SA7       X0+2                  -   IN
          SA7       X0+3                  -   OUT 
          SA6    X0+FETSETV 
          SA6    X0+FETINDX 
          SA6    X0+FETLOFC 
          SA6    X0+FETROI
          SA6    X0+FETCHAR 
          SA4    ROPTION
          IX7       X7+X4 
          SX7       X7
          SA7       X0+4                  -   LIMIT 
          SA7       VARCONT             VARCONT .= VARCONT + BUFFERLGT
          SA4       BLINEWD 
          SA3       BTYPEWD 
          BX6       X4
          LX7       X3
          SA6    X0+FETLINL 
          SA7    X0+FETSTAT 
          SX7    B0 
          SA7    X0+FETFNUM 
          SA3    X1+B6             POINTER WORD 
          MX6       42                  TRUNCATE CHAIN TO 18 BITS 
          BX7    X5+X2       ENTER NAME IN POINTER
          BX3    -X6*X3 
          BX6       X3+X5               INSERT FILEID INTO CHAINWD
          SA7       A3                  STORE NEW HEAD
          SA6    X0+BFETCHA        APPEND CURRENT END-OF-CHAIN TO FET 
          SX7       X2                  RETURN REL ADDR OF FET
          SA1       FILECNT 
          SX6       X1+1
          SX1       X1-NUMFILES 
          SA6       A1
          PL        X1,BFETOVFL         TOO MANY FILES
          SA2    X0                GET A2 TO POINT TO THE FET 
          SX0    1                 SET FET-ALREADY-EXISTED FLAG 
          JP        DECLBUF 
* 
 DFLTLWD  VFD    30/DFLTWDS,30/DFLTCHS DEFAULT LINE WIDTH: WORDS+CHARS
 BLINEWD  EQU    DFLTLWD
 DFLTMAR  DATA   75.               DEFAULT MARGIN 
 BTYPEWD  VFD    12/2000B,18/0,12/2000B,18/1 TYPE,KK(1 BLNK DLMTS)
* 
 BFETCHA  EQU    FETCHAN           POSITION OF CHAIN IN FET 
 BFETLGT  EQU    FETCHAN+1         LENGTH OF FET
 BFIDWD   EQU       42                  NO BITS IN FILEID (LEFT ADJ.) 
* 
 FETADDR  DATA      0 
 FILECNT  DATA      0                   NUMBER OF FET-S ESTABLISHED 
* 
          TITLE     ROUTINES USED BY ACTIONS
* 
*  CLEAR. SCANS ANDSTACK AND STORES ALL OPERANDS PRESENTLY RESIDING 
*         IN REGISTERS IN TEMPORARY LOCATIONS. ANDSTACK IS SCANNED
*         FROM ANDPTR TO FORPTR.
* 
 CLEAR    JP        0 
          SX6       B2
          SA6       CLEARTMP            SAVE ANDPTR 
 CLEARTST TESTAND   EQ,0,CLEAREND 
          SA1       B2+ANDSTACK 
          AX1       30
          SX2       X1-VINX 
          NZ        X2,CLEAR2           CLASS NOT VINX
          SA1       B2+ANDSTACK 
          UX1       B6,X1 
          SB5       LOGKND
          NE        B5,B6,CLEAR1
          OUTINS    TRANSMIT
          OUTINS    RELEATOP
          EQ        CLEAR3
 CLEAR1   BSS       0 
          OUTINS    NORMTOX6
 CLEAR3   BSS       0 
          RJ        TEMPLOC             REL ADDR IN X7
          SA1       SIMSINSW
 CLEARSET MX0       42
          BX7       -X0*X7              TRUNCATE REL ADDR 
          BX1       X0*X1 
          BX6       X1+X7 
          SA1       ANDSTACK+B2 
          UX1       X1,B6 
          PX6       B6,X6 
          SA6       A1                 SET CLASS AINS OR SINS 
          OUTINS    STOREVAR
          JP        CLEARCNT
 CLEAR2   BSS       0 
          SX2       X1-AINX 
          NZ  X2,STCLEAR           CLASS NOT AINX 
          SA1    B2+ANDSTACK
          UX1    B6,X1
          SB5    SIMKND 
          NE     B5,B6,STRCLEAR 
 CLEAR4   BSS    0                 CLEAR ADDRESS ONLY 
          OUTINS    TRANSMIT
          OUTINS    RELEATOP
          RJ        TEMPLOC 
          SA1       SIMAINSW
          JP        CLEARSET
 STRCLEAR BSS    0
          RJ     FETCH
          OUTINS SB7AI
          OUTINS RELEATOP 
          RJ     STMPLOC
          SA1    STSINSW
          BX6    X1+X7
          SA1    ANDSTACK+B2
          UX1    X1,B6
          PX6    B6,X6
          SA6    A1 
          OUTINS SB6B2K 
          OUTINS RJSTRST
          JP  CLEARCNT
 STCLEAR  BSS    0
          SX2    X1-AINX1 
          ZR  X2,CLEAR4            AINX1 IS SUBSCRIPTED STR VAR, SAVE AD
          SX2    X1-VINXS 
          SX3    SINS 
          ZR     X2,CLEAR5
          SX2    X1-AINXS 
          NZ     X2,CLEARCNT
          SX3    AINS 
 CLEAR5   SA1    B2+ANDSTACK
          MX0    30 
          LX0    60-12
          LX3    30 
          BX7    -X0*X1 
          BX7    X7+X3
          SA7    A1 
 CLEARCNT SB2       B2-ANDINCR
          JP        CLEARTST
 CLEAREND SA1       CLEARTMP
          SB2       X1                  RESTORE ANDPTR
          MX7    -1                CLEAR THE REGISTER STACK 
          SA7    REGSTPTR 
          JP        CLEAR 
* 
 CLEARTMP DATA      0 
          EJECT 
* 
*  ARITHPAIR.  CHECKS TWO TOP ELEMENTS OF ANDSTACK TO BE LEGAL IN 
*              ARITHMETIC OPERATIONS AND BRINGS THEM TO REGISTERS.
*             THE OPERATION TO BE PERFORMED IS IN X7
* 
 ARTHPAIR JP        0 
          SA7       ARTHOPR 
          SB2       B2-ANDINCR
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX1       B6,X1 
          NE        B5,B6,BILLAOPR      TOP-ANDINCR NE SIMPLE 
          RJ        FETCH 
          SB2       B2+ANDINCR
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX1       B6,X1 
          NE     B5,B6,OPANDER
          RJ        FETCH 
          SA1       ARTHOPR 
          OUTINS    X1                  PERFORM OPERATION 
          DECRAND 
          SETVINX   SIMVINXW
          MX6    0           CLEAR THE SWITCH FLAG
          SA6    OPRNDSW
          JP        ARTHPAIR
* 
 OPANDER  SA1    OPRNDSW
          ZR     X1,BILLAOPR BR, OPERANDS HAVE NOT BEEN SWITCHED--
*                            CONTINUE ERROR PROCESSING
  
          MX6    0           CLEAR THE SWITCH FLAG
          SA6    OPRNDSW
  
* SWITCH THE OPERANDS ON THE ANDSTACK BACK TO ORIGINAL POSITIONS
  
          SA1    ANDSTACK+B2
          SA2    ANDSTACK-1+B2
          SA3    ANDSTACK-ANDINCR+B2
          SA4    ANDSTACK-ANDINCR-1+B2
          BX6    X1 
          LX7    X2 
          SA6    A3 
          SA7    A4 
          BX6    X3 
          LX7    X4 
          SA6    A1 
          SA7    A2 
  
          EQ     BILLAOPR    GO PROCESS THE ERROR 
  
 ARTHOPR  DATA      0                   SAVED OPERATION 
          EJECT 
* 
*  FETCH(PTR). GENERATES CODE TO FETCH OPERAND DESCRIBED IN 
*              ANDSTACK(PTR) IF APPROPRIATE 
*              PTR IN B2 AT ENTRY 
* 
 FETCH    JP        0 
          SA1       ANDSTACK+B2 
          UX2       B5,X1               B5 .= KIND, X2 = PTR/ADDR 
 PRTBT61  NO                            PRINTBYTE OF ANDSTACK ENTRY 
          BSS       0 
          SB6    SIMKND                                                  BAS0018
          EQ   B5,B6,FSV           SIMPLE                                BAS0018
          SB6       STKIND
          EQ        B6,B5,FETCHSTR     STRING 
          SB6       ARRKND
          EQ        B6,B5,FETCHARY     ARRAY
      SB6        SVARKND
      EQ         B5,B6,FETCHARY 
          SB6       SVKIND
          EQ        B6,B5,FETCHSTV     STRING VARIABLE
*                                  BASCOMP.3638 
          SB6    LOGKND 
          EQ   B5,B6,FLOG 
          SB6    TABKIND                                                 BAS0018
          EQ   B5,B6,FETCHTAB      TAB                                   BAS0018
          JP   FETCH               IGNORE OTHERS                         BAS0018
* 
*  FETCH SIMPLE VARIABLE
* 
 FSV      BSS    0
          LX1       30                  X1 = CLASS
          SA1       X1+FCHSIMSW 
          SB5       X1
          JP        B5                  BRANCH ON CLASS 
* 
 FSIMVINS BSS       0                   FETCH SIMPLE IN STORE 
          SB5       X2
*  FETCH DOES NOT USE FLAG *FORMAL* TO RECOGNIZE FORMALS ANY MORE 
          RJ        DECLSIMP            AT RETURN X7 = REL ADDR 
          SA7       B2+ANDSTACK 
 FSIMSINS BSS       0 
          OUTINS    FETCHVAR            SA.I B2+RELADDR 
 FSETVINX SETVINX   FVINXWD 
          JP        FETCH 
* 
 FSIMCONS SA1    B2+ANDSTACK-1
          ADDWRD CONS,X1
          SX7    X3-1 
          SA7       B2+ANDSTACK         ANDSTACK[PTR] .= CONSPTR
          OUTINS    FETCHDOP            SA.I B4+CONADDR 
          JP        FSETVINX
* 
 FSIMAINS OUTINS    FETCHVAR            SA.I B2+RELADDR 
          SETVINX   FAINXWD             SET SIMPLE A IN  X
 FSIMAINX OUTINS    FETCHARR            SA.J X.I
          SA1       ANDSTACK+B2 
          SA2       FVINXWD 
          SX3       X1
          BX6       X2+X3 
          SA6       A1                  CHANGE CLASS TO V IN X
          JP        FETCH 
* 
 FSMVINXS OUTINS    REFETCH 
          SA1       ANDSTACK+B2 
          SA2       FVINXWD 
          LX1       30
          UX1       B6,X1 
          SX3       B6
          BX6       X2+X3 
          SA6       A1                  CHANGE CLASS
          JP        FETCH 
* 
 FSMAINXS OUTINS    REFETCH 
          SA1       ANDSTACK+B2 
          SA2       FAINXWD 
          LX1       30
          UX1       B6,X1 
          SX3       B6
          BX6       X2+X3 
          SA6       A1                  CHANGE CLASS
          JP        FSIMAINX
* 
*  FETCH STRING 
* 
 FETCHSTR BSS       0 
          OUTINS    FETCHDOP            SA.I B4+STRADDR 
          SETVINX   STVINXW 
          JP        FETCH 
* 
*  FETCH ARRAY (DOPE-INFO)
* 
 FETCHARY BSS       0 
          OUTINS    FETCHDOP            SA.I B4+ARRADDR 
          SETVINX   FAINXWD 
          JP        FETCH 
* 
* 
*  FETCH STRING VARIABLE
* 
FETCHSTV  LX1       30
          SB5       X1                 CLASS
          SB6       VINS
          EQ        B5,B6,STVINS
          SB6       AINX
          EQ        B5,B6,STAINX
          SB6    AINX1
          EQ  B5,B6,STAINX         AINX1 SAME AS AINX FOR FETCH 
          SB6       AINS
          EQ        B5,B6,STAINS
          SB6    SINS 
          EQ  B5,B6,STSINS
          SB6    AINXS
          EQ     B5,B6,STAINXS
          JP        FETCH 
STVINS    SB5       X2
          RJ        DECLSIMP
          SA7       B2+ANDSTACK 
          OUTINS    FETCHVAR           SA.I  B2+RELADDR 
          SETVINX   SVINXW
          JP        FETCH 
STAINS    OUTINS    FETCHVAR           SA.I  B2+RELADDR 
          SETVINX   SVAINXW 
STAINX    OUTINS    FETCHARR           SA.J  X.I+B2 
          SA1       ANDSTACK+B2 
          LX1       30
          SX2       VINX-AINX 
          IX6       X1+X2 
          LX6       30                 MAKE CLASS VINX
          SA6       A1
          JP        FETCH 
 STSINS   OUTINS  FETCHVAR         GEN  SAI B2+ADDR 
          SETVINX  SVAINXW
          JP  FETCH 
 STAINXS  OUTINS REFETCH
          SA1    ANDSTACK+B2
          LX1    30 
          UX2    B6,X1
          MX7    42 
          BX2    X1*X7
          SX6    AINX1
          BX2    X2+X6
          LX2    30 
          SX1    B6 
          MX7    30 
          BX6    X2*X7
          BX6    X6+X1
          SA6    A1 
          EQ     STAINX 
* 
*  FETCH LOGICAL
* 
 FLOG     BSS    0
          LX1    30                CLASS
          SB5    X1 
          SB6    VINX 
          EQ   B5,B6,FETCH         ALREADY IN REG 
          SB6    VINXS                                                   BAS0020
          NE   B5,B6,FLOG1         JUMP IF NOT VINXS                     BAS0020
          OUTINS  REFETCH          SAI B2+TEMP                           BAS0020
          EQ   FLOG2                                                     BAS0020
 FLOG1    BSS    0                                                       BAS0020
          SB6    SINS 
          NE   B5,B6,FETCH         IGNORE OTHERS
          OUTINS   FETCHVAR        SA.I B2+RELADDR
 FLOG2    BSS    0                                                       BAS0020
          SETVINX   LOGVINXW
          JP   FETCH
*                                                                        BAS0018
*                                                                        BAS0018
 FETCHTAB BSS    0                                                       BAS0018
          LX1    30                                                      BAS0018
          SB5    X1                CLASS                                 BAS0018
          SB6    VINX                                                    BAS0018
          EQ   B5,B6,FETCH         EXIT IF ALREADY IN X                  BAS0018
          OUTINS   FETCHVAR        SAI B2+RELADDR                        BAS0018
          SETVINX   TABVINXW                                             BAS0018
          JP   FETCH                                                     BAS0018
* 
* 
*  SWITCH FOR FETCH SIMPLE
* 
 FCHSIMSW BSS       0 
          VFD       60/FSIMVINS         VINS
          VFD       60/FETCH            VINX
          VFD       60/FSIMAINX         AINX
          VFD       60/FSMVINXS         VINXS 
          VFD       60/FSMAINXS         AINXS 
          VFD       60/FSIMCONS         CONST 
          VFD       60/FSIMAINS         AINS
          VFD       60/FSIMCONS         INT 
          VFD       60/FSIMSINS 
* 
* 
          EJECT 
* 
*  STORE.  PRODUCERER ORDER FOR LAGRING AF INDHOLDET AF X6 I EN 
*          VARIABEL BESKREVET I ANDSTACK[PTR] 
*          PTR FINDES I B2 VED INDHOPPET
* 
 STORE    JP        0 
          SA1       B2+ANDSTACK         GET ANDSTACK ENTRY
          SB5       SIMKND
 PRTBT60  NO
          BSS       0 
          UX1       X1,B6 
          EQ        B5,B6,STORE1        KIND = SIMPLE 
          SB5       LHSKND
         NE        B5,B6,BILLSTOR   KIND NE LHS 
 STORE1   BSS       0 
          SB5       X1
          LX1       30                  X1 .= CLASS 
          SX2       X1-VINS 
          NZ        X2,STORE2           CLASS NE VINS 
          RJ        DECLSIMP
          SA1       ANDSTACK+B2 
          MX2       42
          BX1       X2*X1 
          BX7       X7+X1 
          SA7       A1
          OUTINS    STOREVAR            SA6 B2+RELADR 
          JP     STORE
 STORE2   SX2       X1-AINX 
          ZR  X2,STORE7            AINX 
          SX2    X1-AINX1 
          NZ  X2,STORE3            NOT AINX OR AINX1
 STORE7   BSS    0
          OUTINS    STOREARR            SA6 X.I 
          JP     STORE
 STORE3   SX2       X1-AINS 
          NZ        X2,STORE4           CLASS NE AINS 
          OUTINS    FETCHVAR            SA.I B2+RELADR - FETCH ADDRESS
          SA1       ANDSTACK+B2 
          UX1       X1,B6 
          SA1       FAINXWD 
          SA2       REGSTPTR
          SA2       X2+REGSTACK 
          BX6       X1+X2 
          PX6       X6,B6 
          SA6       ANDSTACK+B2 
          OUTINS    STOREARR            SA6 X.I 
          JP     STORE
 STORE4   SX2       X1-AINXS
          NZ  X2,STORE8            CLASS NE AINXS 
          OUTINS    REFETCH 
          SA1       ANDSTACK+B2 
          SA2       FAINXWD 
          LX1       30
          UX1       B6,X1 
          SX3       B6
          BX6       X2+X3 
          LX1       30
          UX1       B6,X1 
          PX6       B6,X6 
          SA6       A1                  CHANGE CLASS
          OUTINS    STOREARR
          JP     STORE
 STORE8   SX2    X1-SINS
          NZ  X2,BILLSTOR          CLASS NE SINS
          SA1    DEFFLAG           ALLOW SINS ONLY IN DEF 
          ZR  X1,BILLSTOR 
          OUTINS STOREVAR          STORE AS IF VINS 
* 
* 
          JP     STORE
          EJECT 
* 
*  TEMPLOC. OBTAINS THE ADDRESS OF THE NEXT AVAILABLE VARIABLE
*           LOCATION AND RETURNS IT IN X7 
* 
 TEMPLOC  JP        0 
          SA1       VARCONT 
          SX6       X1+1
          BX7       X1                  TEMPLOC .= VARCONT
          SA6       A1                  VARCONT .= VARCONT + 1
          JP        TEMPLOC 
* 
 STMPLOC  EQU    TEMPLOC
          EJECT 
* 
*  DECLSIMP(PTR)
* 
*         THE VALUE OF DECLSIMP(X7) IS THE RELATIVE ADDRESS OF THE
*         SIMPLE VARIABLE DESCRIBED AT IDTABLE[PTR]. IF THIS IS FIRST 
*         REFERENCE, THE RELATIVE ADDRESS IS ASSIGNED, AND USEBIT IS
*         SET. PTR IS IN B5 AT ENTRY. 
* 
 DECLSIMP JP        0 
          SA1    F.IDS
          SA1    X1+B5             IDTABLE(PTR) 
          SX7       X1
          NG        X1,DECLSIMP         NOT FIRST REFERENCE 
          SA2       VARCONT 
          MX3       1 
          BX1       X1+X3               SET USEBIT
          SX7       X2+1
          MX3       42
ADDONE    BSS       0 
          SA7       A2                  VARCONT .= VARCONT + 1
          BX1       X3*X1 
          BX7       -X3*X2
          BX6       X7+X1               INSERT RELADDR IN ENTRY 
          SA6       A1
          JP        DECLSIMP
* 
          EJECT 
* 
*         DECLARE USER-FUNCTION 
* 
 DECLFUN  BSSZ      1 
          SA1       ANDSTACK+B2 
          SB5       UFKIND
          UX1       B6,X1 
          NE        B5,B6,BILLFUN       NOT USER-FUNCTION 
          LX1    1                 FN ORDINAL * 2 
          SA3    F.FUNS 
          IX2    X3+X1
          SA3    X2                DECL ENTRY 
          SX7       X3
          ZR     X7,FUNLAB          IF NO LABEL GET ONE 
          BX4    -X3+X4 
          NG     X4,ENDUFUN         IF REF CALL OR NOT PREVIOUSLY 
*                                        DEFINED, EXIT
          MX6    1                 SET FN REDEFINITION FLAG 
          SA6    REDEF
          SX7    WERR3       SET WARNING MESSAGE FOR
          SA7    WNSW        REDEFINITION 
 FUNLAB   BSS    0
          SA1       NEXTLAB 
          SX7       X1-1
          SA7       A1
          MX4       42
          BX6       -X4*X7
          BX3    X4*X3             DROP OLD LABEL 
          BX6    X6+X3             ADD NEW
          SA6       A3                  DEFINE LABEL FOR FUN
 ENDUFUN  BSS       0 
          SX6       X7
          SA6       ANDSTACK-1+B2       SET LABEL INTO ANDSTACK 
          JP        DECLFUN 
          EJECT 
* 
*  GETARADR (GET ARRAY ADDRESS) 
*     CHECKS TOP OF ANDSTACK FOR SIMPLE VINS
*     CREATES A NEW ANDSTACK ENTRY BY USING INFORMATION FROM THE
*     ANDSTACK AND THE IDTABLE (SYMBOL TABLE) 
* 
 GETARADR JP        0 
          SA1       ANDSTACK+B2 
          SB5       SIMKND
          UX6       B6,X1               X6 .= ADDRPART
          AX1       30
          EQ        B5,B6,GETARL4      SIMPLE 
          SB5       SVKIND
          NE        B5,B6,BILLARR      NOT STRING VARIABLE
 GETARL4  BSS       0 
          SX1       X1-VINS 
          NZ        X1,BILLARR          CALSS NOT VINS
          SA2    F.IDS
          SB5    X6 
          SA2    X2+B5             IDTABLE ENTRY
          SX6       X6
          LX6       30                  POSITION IDTABLEPTR, CLEAR NEW
          SA6       ANDSTACK-1+B2 
          LX2       1 
          NG        X2,GETAREND         NOT FIRST REFERENCE 
* 
*     THIS IS A FIRST REFERENCE 
* 
          MX0       1 
          SB5       -1
          BX2       X0+X2               SET USEARR
          LX2       29
          SA3    L.CONS 
          PX2       B5,X2               SET DIM TO -1 
          BX6       X2+X3               SET CONSPTR INTO ADDRARR
          LX6       30
          SA6       A2                  STORE UPDATED IDTABLE ENTRY 
          SA5    L.CONS            SIZE OF CONSTANTS
          ALLOC  CONS,MAXDIM+1     ALLOCATE SPACE 
          SA1    F.CONS 
          IX1    X1+X5
          SB5    B0 
          BX3    X5                SAVE OLD SIZE
          SB6    MAXDIM 
          SA5        BASE 
         UX5       B0,X5
         NZ        X5,BAZZONE 
          SA5        ELEVEN         FP 11 FOR BASE ZERO 
          EQ         BAZZ 
BAZZONE   SA5        TEN            FP 10 FOR BASE ONE
BAZZ      BX6        X5             STORE-CONDSRT+CONDSPTR+PTR
          SX1    X1+B1       POINT PAST DOPE VECTOR HEADER. 
 GETARL3  SA6       X1+B5                     .= 11 
          SB5       B5+1
          GT        B6,B5,GETARL3 
          BX2       X3
          LX2       31                  PREPARE END PROCES
 GETAREND BSS    0
      SA1        ANDSTACK+B2
      UX1        B5,X1
      SB6        SVKIND 
      SA1        GETARKDW 
      NE         B5,B6,GETARL5
      SA1        GETSARKW 
 GETARL5 BSS     0
          LX2       29
          MX0       42
          BX2       -X0*X2              TRUNCATE DOPE PTR TO 18 BITS
          BX6       X1+X2               INSERT INTO KINDWORD
          SA6       ANDSTACK+B2         AND STACK 
          JP        GETARADR
* 
TEN      DATA   10.0
 ELEVEN   DATA      11.0
          EJECT 
* 
*  CHECKDIM PERFORMS WRAP-UP AT RIGHT SUBSCRIPT PAREN AND ALIKE 
*     CONSTRUCTS. 
* 
 CHECKDIM JP        0 
          SA5       ANDSTACK-1+B2 
          SB5       X5                  B5 .= NEW 
          AX5       30
          SA1    F.IDS
          IX1    X1+X5
          SA1    X1                IDTABLE ENTRY
          LX1       30
          UX1       B6,X1               B6 .= DIM 
          ZR        B5,CHKDIML1         NEW = 0 
          GE        B0,B6,CHKDIML2      DIM @ 0 
          EQ        B6,B5,CHKDIML2      NEW = DIM 
          JP   BILLDIM1            ILLEGAL REDIMENSION
 CHKDIML1 SX2       B6-3
          NG        X2,CHKDIML3         NEW = 0 BUT DIM @ 2 
          JP        BILLMAT 
 CHKDIML2 SX2       B5-1
          NZ        X2,CHKDIML3         NEW NOT 1 
          SA2       NUMONE
          SA3    F.CONS            START OF CONSTANTS 
          BX6       X2
          IX4       X3+X1               NEW IS ONE, SO WE 
          SA6       X4+2                  SET SECOND BOUND TO 1.0 
 CHKDIML3 GT        B6,B0,CHKDIML5      DIM > 0 
          ZR        B6,CHKDIML4         SET NEW DIMENSION ONLY
          SA2    L.CONS            SIZE OF CONSTANTS
          SX4       X1+MAXDIM+1 
          IX4       X4-X2               IF CONSPTR = DOPEPTR+MAXDIM 
          NZ        X4,CHKDIML4           WE TRY TO REDUCE TO 2 DIMENS
          SX1       X1+1
          SX2       B5-2
          SX6       X1+2
 +        NG        X2,*+1              ADDEND .= IF NEW < 2 THEN 2 
          SX6       X1+B5                         ELSE NEW
 +        SA6       A2                  CONSPTR .= DOPEPTR+ADDEND 
 CHKDIML4 SA1    F.IDS
          IX6    X1+X5
          SA1    X6                ID TABLE ENTRY 
          SB6       MAXDIM
          LX1       30
          PX6       B5,X1               DIMPART .= NEW
          LX6       30
          GT        B5,B6,BILLAR2       NEW > MAXDIM , ERROR
          SA6       A1
 CHKDIML5 BSS       0 
          JP        CHECKDIM
* 
 NUMONE   DATA      1.0 
          EJECT 
* 
* CHKDIM2 CHECKS TO MAKE SURE THAT THE NUMBER OF DIMENSIONS ARE THE 
* SAME ON BOTH SIDES OF A MATRIX ASSIGNMENT 
* 
 CHKDIM2  BSSZ   1
          SA1    ANDSTACK-1+B2
          LX1    30 
          SA2    F.IDS
          IX1    X1+X2
          SA1    X1 
          SA3    ANDSTACK-3+B2
          LX3    30 
          IX3    X3+X2
          SA3    X3 
          LX1    30 
          LX3    30 
          UX1    B5,X1
          UX3    B6,X3
          NE     B5,B6,BILLDIM1 
          EQ     CHKDIM2
          TITLE     TABLES
          EJECT 
          SPACE  5
* 
*         CHTAB IS THE TABLE USED BY THE READ ROUTINE TO CONSTRUCT THE
*         NEXT SYMBOL. FORMAT IS
*         VFD  12/200C,18/V,12/RESPTR,18/CHACT
*          C IS THE COUNT OF RESERVED WORDS BEGINING WITH THIS CHARACTER
*          V IS THE VALUE OF THIS CHARACTER AS A SINGLE ENTRY.  IF THIS 
*            IS ILLEGAL A VALUE OF LILLEG IS RETURNED.
*         CHACT IS THE ACTION TO BE PERFORMED FOR THIS CHARACTER.  IN 
*               GENERAL THERE IS NO ACTION, BUT LPAREN, FOR EXAMPLE, IS 
*               MODIFIED DEPENDING ON WHAT PRECEEDED IT 
*         NOTE ALSO THAT FILE (AS IN : FILE 2 =NEWM) MUST BE
*         DISTINGUISHED FROM FILE (AS IN : PRINT FILE ETC)
*          RESPTR IS A POINTER TO THE RESERVED WORD LIST IN CASES WHERE 
*                 THE CHARACTER MAY BE THE FIRST OF A RESERVED WORD.
* 
 CHTAB    BSS       0 
 CSETIF2  IFEQ   CHARSET,OLDCSET
          VFD    12/2000B,18/LILLEG,12/LX0,18/LNONE  BAD
 CSETIF2  ELSE
CSETIF1   IFEQ   IP.CSET,IP.C63                                         000450
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNONE      BAD 
 CSETIF1  ELSE
         VFD       12/2001B,18/LILLEG,12/LX0,18/LCOLON     COLON        000490
CSETIF1   ENDIF                                                         000510
 CSETIF2  ENDIF 
          VFD    12/2007B,18/LIALPA,12/LXA,18/LALPH     A 
         VFD       12/2001B,18/LIALPB,12/LXB,18/LALPH        B
          VFD    12/2013B,18/LIALPC,12/LXC,18/LALPH     C 
          VFD    12/2010B,18/LIALPD,12/LXD,18/LALPH 
          VFD 12/2006B,18/LIALPE,12/LXE,18/LALPH  E 
          VFD    12/2001B,18/LIALPF,12/LXF,18/LALPHF     F
          VFD       12/2002B,18/LIALPG,12/LXG,18/LALPH          G 
          VFD       12/2000B,18/LIALPH,12/LX0,18/LALPH          H 
          VFD       12/2005B,18/LIALPI,12/LXI,18/LALPH          I 
          VFD    12/2001B,18/LIALPJ,12/LXJ,18/LALPH  J
          VFD       12/2000B,18/LIALPK,12/LX0,18/LALPH          K 
          VFD    12/2011B,18/LIALPL,12/LXL,18/LALPH  L
          VFD    12/2005B,18/LIALPM,12/LXM,18/LALPH             M 
          VFD    12/2005B,18/LIALPN,12/LXN,18/LALPH     N 
          VFD    12/2004B,18/LIALPO,12/LXO,18/LALPH     O 
          VFD    12/2002B,18/LIALPP,12/LXP,18/LALPH  P
          VFD       12/2000B,18/LIALPQ,12/LX0,18/LALPH          Q 
          VFD    12/2012B,18/LIALPR,12/LXR,18/LALPH 
          VFD    12/2010B,18/LIALPS,12/LXS,18/LALPHS    S 
          VFD    12/2005B,18/LIALPT,12/LXT,18/LALPHT     T
          VFD    12/2003B,18/LIALPU,12/LXU,18/LALPH  U
          VFD    12/2001B,18/LIALPV,12/LXV,18/LALPH        V
          VFD       12/2001B,18/LIALPW,12/LXW,18/LALPH          W 
          VFD       12/2000B,18/LIALPX,12/LX0,18/LALPH          X 
          VFD       12/2000B,18/LIALPY,12/LX0,18/LALPH          Y 
          VFD       12/2001B,18/LIALPZ,12/LXZ,18/LALPH          Z 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNUM           0 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNUM           1 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNUM           2 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNUM           3 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNUM           4 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNUM           5 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNUM           6 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNUM           7 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNUM           8 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNUM           9 
          VFD       12/2000B,18/LVPLU,12/LX0,18/LCHPLUS         + 
          VFD       12/2000B,18/LVMIN,12/LX0,18/LCHMINUS        - 
         VFD       12/2001B,18/LVSTA,12/LXSTARS,18/LMULT        * 
          VFD       12/2001B,18/LVSLA,12/LX?,18/LMULT           / 
          VFD       12/2000B,18/LVLAR,12/LX0,18/LLPAREN         ( 
          VFD    12/2000B,18/LVRPA,12/LX0,18/LRPAR
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNONE          $ 
          VFD       12/2002B,18/LVEQU,12/LX=,18/LMULT           = 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNONE          BLANK 
 LLCOM    VFD    12/2000B,18/LVCOM,12/LX0,18/JPSTD      , 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LPOINT         . 
          IFEQ   CHARSET,OLDCSET
 LLQUO    VFD       12/2000B,18/LILLEG,12/LX0,18/LSTRING        STRING
         ELSE                                                           000570
         VFD       12/2000B,18/LILLEG,12/LX0,18/LPND       POUND SIGN   000580
         ENDIF                                                          000590
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNONE          [ 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNONE          ] 
 IF1      IFEQ   CHARSET,OLDCSET
          VFD    12/2001B,18/LILLEG,12/LX0,18/LCOLON  COLON 
 IF1      ELSE
 IF2      IFEQ   IP.CSET,IP.C63 
          VFD    12/2000B,18/LILLEG,12/LX0,18/LCOLON  COLON 
 IF2      ELSE
          VFD    12/2000B,18/LILLEG,12/LX0,18/LNONE  PERCENT
 IF2      ENDIF 
 IF1      ENDIF 
          IFEQ   CHARSET,OLDCSET
          VFD    12/2000B,18/LVAPO,12/LX0,18/LNONE    APOSTROPHE
         ELSE                                                           000630
LLQUO    VFD       12/2000B,18/LILLEG,12/LX0,18/LSTRING    QUOTE        000640
         ENDIF                                                          000650
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNONE          _ 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNONE          ! 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNONE          & 
          IFEQ   CHARSET,OLDCSET
          VFD       12/2000B,18/LVPOW,12/LX0,18/LNONE           ' 
          ELSE
          VFD    12/2000B,18/LVAPO,12/LX0,18/LREAD300        APOSTROPHE 
          ENDIF 
          IFEQ   CHARSET,OLDCSET
          VFD    12/2000B,18/LILLEG,12/LX0,18/LPND   POUND SIGN 
         ELSE                                                           000690
         VFD       12/2000B,18/LILLEG,12/LX0,18/LNONE      QUESTION MK  000700
          ENDIF                                                         000710
          VFD       12/2002B,18/LVLTH,12/LX<,18/LMULT           < 
          VFD       12/2002B,18/LVGTH,12/LX>,18/LMULT           > 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNONE          @ 
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNONE          \ 
          IFEQ   CHARSET,OLDCSET
          VFD       12/2000B,18/LILLEG,12/LX0,18/LNONE          ^ 
         ELSE                                                           000760
          VFD    12/2000B,18/LVPOW,12/LX0,18/LNONE  CIRCUMFLEX
         ENDIF                                                          000780
 LLSEM    VFD    12/2000B,18/LVSEM,12/LX0,18/JPSTD
          VFD       12/2000B,18/LVEOB,12/LX0,18/EOBACT          EOB 
 LLEOS    VFD       12/2000B,18/LVEOS,12/LX0,18/LNONE           EOS  // 
          VFD       12/2000B,18/LVEOL,12/LX0,18/LNONE           EOL 
          VFD       12/2000B,18/LVEOP,12/LX0,18/LNONE           EOP 
 LLFIL    VFD       12/2000B,18/LVFIL,12/LX0,18/LNONE           FILE
 LLDELPR  VFD    12/2000B,18/LILLEG,12/LX0,18/DLMTPRN  (DELIMIT LFT PRN)
LLUSI    VFD       12/2000B,18/LVUSI,12/LX0,18/LNONE  -USING- 
 LLBAD    VFD    12/2000B,18/LILLEG,12/LX0,18/LNONE  BAD ESCAPE CODE
 LLTHE    VFD    12/2000B,18/LVTHE,12/LX0,18/LNONE  -THEN- PSEUDO 
 LLELS    VFD    12/2000B,18/LVELSE,12/LX0,18/LNONE  -ELSE- PSEUDO
          EJECT 
* 
*          RESWORD IS A TABLE CONTAINING ALL THE RESERVED WORDS.
*         IT IS INSPECTED AT THE TIME THAT THE FIRST CHARACTER HAS BEEN 
*         RECOGNIZED.  THE COUNT OF RESERVED WORDS BEGINING WITH THAT 
*         CHARACTER IS IN B1.  THE FORMAT IS
*         VFD  3/N,15/V,42/STRING 
*         N IS THE NUMBER OF ADDITIONAL CHARACTERS TO FETCH FROM THE
*           INPUT BEFORE CHECKING FOR A MATCH.  THE SECOND CHARACTER HAS
*           ALREADY BEEN FETCHED AND DOES NOT ENTER INTO THE COUNT. 
*         V IS THE VALUE TO BE GIVEN FOR THE RESERVED WORD IN CASE OF A 
*           MATCH.  V IS EITHER AN INDEX INTO LTORIN, IN CASE THE 
*           RESERVED WORD IS AN OPERATOR, OR AN OPERAND VALUE IN CASE 
*           THE RESERVED WORD IS AN OPERAND.
*         STRING IS THE RESERVED WORD ITSELF, RIGHT POSITIONE WITH
*                ZERO FILL.  THE FIRST CHARACTER IS OMITTED.
* 
  
**        MACRO DEFINITION. 
  
**        RESWD - ENTRY INTO RESERVED WORD TABLE. 
* 
* SYM     RESWD  V
* 
*         SYM    WORD TO BE ENTERED INTO TABLE. 
*         V      LVXXX SYMBOL IF IT IS NOT DETERMINED BY THE
*                FIRST 3 CHARACTERS OF THE WORD.
  
  
          PURGMAC RESWD 
  
          MACRO  RESWD,SYM,LVS
 RES1     MICRO  2,, SYM
 RES3     MICCNT RES1 
 CH       SET    RES3+1-.RES
 .RES     SET    RES3+1 
 RES3     DECMIC RES3 
          IFC    EQ,$LVS$$
 RES2     MICRO  1,3, SYM 
          VFD    3/CH,15/LV"RES2",42/"RES3"R"RES1"
          ELSE
          VFD    3/CH,15/LVS,42/"RES3"R"RES1" 
          ENDIF 
          ENDM
          NOREF  .RES,CH
  
  
          PURGMAC RES 
  
          MACRO  RES,SYM     FIRST ENTRY IN A GROUPING
 SYM      BSS    0
 .RES     SET    2
          ENDM
          SPACE  4
**        RESERVED WORD TABLE.
  
  
 LA       RES 
 ABS      RESWD 
 AND      RESWD 
 ASC      RESWD 
 ATN      RESWD 
 ASL      RESWD 
 APPEND   RESWD 
 ATTENTIO RESWD  LVONATT
  
 LB       RES 
 BASE     RESWD 
  
 LC       RES 
 CLK      RESWD  LVCLK1 
 CON      RESWD 
 COS      RESWD 
 COT      RESWD 
 CLK$     RESWD  LVCLCK 
 CHR$     RESWD 
 CALL     RESWD 
 CLOSE    RESWD 
 CHAIN    RESWD  LVCHN
 CHANGE   RESWD  LVCHG
 COLLATE  RESWD  LVCLT
  
 LD       RES 
 DIM      RESWD 
 DEF      RESWD 
 DIS      RESWD 
 DET      RESWD 
 DATA     RESWD 
 DAT$     RESWD  LVDATE 
 DIGITS   RESWD 
 DELIMIT  RESWD 
  
 LE       RES 
 END      RESWD 
 EXP      RESWD 
 ESL      RESWD 
 ESM      RESWD 
 ELSE     RESWD  LVELSE 
 ERROR    RESWD 
  
 LFORE    RES 
 FOR      RESWD 
 FILE     RESWD 
  
 LF       RES 
 FILE     RESWD 
  
 LG       RES 
 GOTO     RESWD 
 GOSUB    RESWD 
  
 LI       RES 
 IF       RESWD  LVIFX
 IDN      RESWD 
 INT      RESWD 
 INV      RESWD 
 INPUT    RESWD 
  
 LJ       RES 
 JUMP     RESWD  LVJMP
  
 LL       RES 
 LET      RESWD 
 LEN      RESWD 
 LOC      RESWD 
 LOF      RESWD 
 LOG      RESWD 
 LGT      RESWD 
 LPAD$    RESWD  LVLPD
 LTRM$    RESWD 
 LWRC$    RESWD 
  
 LMA      RES 
 MAT      RESWD 
 MAX      RESWD  LVMAXF 
 MIN      RESWD  LVMINF 
 MORE     RESWD 
 MARGIN   RESWD  LVMGN
  
 LN       RES 
 NOT      RESWD 
 NXL      RESWD 
 NEXT     RESWD 
 NATIVE   RESWD 
 NODATA   RESWD 
  
 LO       RES 
 ON       RESWD  LVONN
 OR       RESWD  LVOR 
 ORD      RESWD 
 OPTION   RESWD 
  
 LP       RES 
 POS      RESWD 
 PRINT    RESWD 
  
 LR       RES 
 REM      RESWD 
 RND      RESWD 
 ROF      RESWD 
 RPT$     RESWD 
 READ     RESWD 
 RPAD$    RESWD  LVRPD
 RTRM$    RESWD 
 RETURN   RESWD 
 RESTORE  RESWD 
 RANDOMI  RESWD 
  
 LS       RES 
 SIN      RESWD 
 SGN      RESWD 
 SQR      RESWD 
 STEP     RESWD 
 STR$     RESWD 
 SREP$    RESWD 
 SUBSTR   RESWD 
 STANDAR  RESWD  LVSTD
  
 LSTOP    RES 
 SET      RESWD 
 STOP     RESWD 
 SUBSTR   RESWD 
  
 LTO      RES 
 TO       RESWD  LVTOX
  
 LT       RES 
 TAN      RESWD 
 TIM      RESWD 
 TAB      RESWD 
 TRN      RESWD 
 THEN     RESWD 
  
 LU       RES 
 USR$     RESWD 
 UPRC$    RESWD 
 USING    RESWD 
  
 LW       RES 
 WRITE    RESWD 
  
 LV       RES 
 VAL      RESWD 
  
 LZ       RES 
 ZER      RESWD 
 LEQ      VFD    3/0,15/LVLTE,42/LT.SYMB        EQ OR LT                001330
          VFD    3/0,15/LVGTE,42/GT.SYMB        EQ OR GT                001340
 LLT      VFD    3/0,15/LVLTE,42/EQ.SYMB        LT OR EQ                001350
          VFD    3/0,15/LVNEQ,42/GT.SYMB        LT OR GT                001360
 LGT      VFD    3/0,15/LVGTE,42/EQ.SYMB        GT OR EQ                001370
          VFD    3/0,15/LVNEQ,42/LT.SYMB        GT OR LT                001380
 LSTARS   VFD    3/0,15/LVPOW,42/ST.SYMB     STAR STAR                  001390
 LFMTCLN  VFD    3/0,15/LVCLN,42/0
 LSL      VFD       3/0,15/LVEOS,42/1R/           //
          EJECT 
* 
*  CLASSIFICATION TABLE FOR LEFT PARENTESIS 
* 
 LLPARTAB BSS       0 
          VFD       60/LVLSB            (SUBROUTINE (SYSFUN)
          VFD       60/LVLFN            (FUNCTION (USEFUN)
          VFD       60/LVLMF            (MAT FUNCTION 
          VFD       60/LVLMO            (MAT OPERATION
          VFD       60/LVLAR            STRING
          VFD       60/LVLSS            (SIMPLE 
          VFD       60/LVLSS           STRING VAR 
          VFD       60/LVLAR            REAL CONSTANT 
          VFD       60/LVLAR            INTEGER CONSTANT
          VFD       60/LVLAR            FILE IDENTIFIER 
          VFD    60/LVSYS          SYSTEM STRING (DATE ETC)  NO PARAMETR
          VFD    60/LVLSV          (SUBR: STRING PAR,REAL RESULT (LEN)
          VFD    60/LVLVS          (SUBR: REAL PAR,STRING RESULT (STR)
          VFD    60/LVLSX       MIXED PARAMS AND STRING RESULT (SUBSTR) 
          VFD    60/LVLVP    (SYS FUNC W/VAR PARAM) 
          VFD    60/LVLDT    *DET*, PARAMETER OPTIONAL. 
          VFD    60/LVLCL          (EXTERNAL NAME  (CALL) 
          VFD    60/0              (SPECIAL FN - UNUSED                  BAS0018
          VFD    60/LVLSBT         (TAB                                  BAS0018
          VFD    60/LVLSB          RND FUNCTION - LEFT PAREN
          EJECT 
          EJECT 
* 
*   STATE TABLE TO CHECK LEGALITY OF OPERAND - OPERATOR SEQUENCE
*     EACH COLUMN  IS 8 BITS WIDE AND HOLDS NEWSTATE*8
*     THE ERROR STATE IS SIGNALLED BY A ONE IN THE LEFTMOST BIT OF
*     A COLUMN. 
* 
 STTAB    MACRO     S1,S2,S3,S4,S5,S6,S7   DEFINES STATE TABLE
          VFD       8/S1,8/S2,8/S3,8/S4,8/S5,8/S6,8/S7,4/0
          ENDM
* 
*         STATE    0    1    2    3    4    5    6   *    CLASS 
* 
 STATETAB BSS       0 
          STTAB  SE01,STA0,SE26,STA0,SE47,SE62,SEA6  0 UNARY OPERATOR 
          STTAB  SE02,STA0,SE27,SE40,STA0,SE63,SEA6  1 OPERATOR 
          STTAB  SE02,STA3,STA3,STA3,STA3,SE69,SEA6  THEN/GOTO
          STTAB  STA0,SE01,SE01,STA0,SE01,SE01,SEA6 1N LOGICAL NOT
          STTAB  SE03,STA1,SE28,SE41,STA1,SE64,SEA6  2 RIGHT PAREN
          STTAB  SE04,STA2,STA2,STA2,STA2,SE65,STA2  3 END-OF-STATEMENT 
          STTAB  SE05,SE11,STA5,SE42,SE48,STA5,STA5  4 END-OF-LINE
          STTAB  SE06,STA3,SE29,SE43,STA3,SE66,SEA6  5 TOR ACC. UNARY 
          STTAB  SE07,SE12,SE30,SE44,STA3,SE67,SEA6  6 (-S EXC (ARITH 
          STTAB  STA3,SE13,SE31,STA3,SE49,SE68,SEA6  7 LEFT PAR - ARITH 
          STTAB  SE85,STA3,SE85,SE85,SE85,SE85,SE85 LEFT PAR ANSI SUBSTR
          STTAB  SE08,SE14,STA3,SE45,SE50,SE69,SEA6 10 STATEMENT VERB 
          STTAB  SE09,SE15,STA1,SE46,SE51,SE70,SEA6 11 END, STOP ETC
          STTAB  SE10,SE16,STA3,STA3,SE52,SE71,SEA6 12 READ AND PRINT 
          STTAB  SE10,SE16,SE30,STA4,SE52,SE71,SEA6  CL  STD + NAT
          STTAB  STA0,STA1,STA2,STA3,STA4,STA5,SEA6 IL READ ROUTINE ERR.
          STTAB  SE81,STA3,SE82,STA3,STA3,SE83,SEA6  USING
          STTAB  SE06,STA3,SE29,STA3,STA3,SE66,SEA6 15 SKIP PRINT 
          STTAB  STA4,SE17,SE32,STA4,SE53,SE72,SEA6 13 VAR - SYSFUN 
          STTAB  STA4,SE18,STA4,STA4,SE54,SE73,SEA6  VAR - USEFUN 
          STTAB  STA4,SE19,SE34,STA4,SE55,SE74,SEA6 15 VAR - MATFUN 
          STTAB  STA4,SE20,SE35,STA4,SE56,SE75,SEA6 16 VAR - MATOPR 
          STTAB  STA4,SE21,SE36,STA4,SE57,SE76,SEA6 17 STRING 
          STTAB  STA4,SE22,STA4,STA4,SE58,SE77,SEA6 20 VAR - SIMPLE 
          STTAB  STA4,SE22,STA4,STA4,SE58,SE77,SEA6 2S STRING VAR 
          STTAB  STA4,SE23,SE37,STA4,SE59,SE78,SEA6 21 CONST - REAL 
 ICCLASS  STTAB STA4,SE24,SE38,STA4,SE60,STA2,SEA6  22 CONST - INTEGER
          STTAB  STA4,SE25,SE39,STA4,SE61,SE79,SEA6 23 FILE IDENT 
          STTAB  STA4,SE21,SE36,STA4,SE57,SE76,SEA6  (24) SYSTEM STRING 
          STTAB  STA4,SE17,SE32,STA4,SE53,SE72,SEA6  (25)  LEN,DIS ETC
          STTAB  STA4,SE17,SE32,STA4,SE53,SE72,SEA6  (26)  STR ETC
         STTAB     STA4,SE17,STA4,STA4,SE53,SE72,SEA6  (27) SUBSTR
          STTAB  STA4,SE17,SE32,STA4,SE53,SE72,SEA6   (28)  VAR PARAM FUNC
          STTAB  STA4,SE17,SE32,STA4,SE53,SE72,SEA6   DET 
          STTAB  STA4,SE17,SE32,STA4,SE53,SE72,SEA6  EXT NAME 
          STTAB   STA4,SE17,SE32,STA4,SE53,SE72,SEA6    SPECIAL FN
          STTAB    STA4,SE17,SE32,STA4,SE53,SE72,SEA6    TAB             BAS0018
          STTAB  STA4,SE17,SE32,STA4,SE53,SE72,SEA6   (33) RND
* 
 STATE    DATA      0 
 ICLOC    EQU    ICCLASS-STATETAB 
* 
          EJECT 
* 
*         OPORATORS AT STACK INPUT TIME.  FORMAT IS 
*         VFD       12/20PP,9/SYVAL,9/LXFIELD,12/20SH,18/INACT
*         PP=PRIORITY, SYVAL=VALUE OF TOR, -AN INDEX TO LTOROUT TABLE.
*         LXFIELD=SUBCLASS INDICATOR FOR STACK ACTIONS
*         SH=SHIFT COUNT FOR UNSTACKING CHECK.  INACT=INPUT ACTION. 
* 
LTORIN    BSS       0 
 LSUNP    VFD    12/2011B,9/LUNP,9/LXUNP,12/2014B,18/STACK1  UNARY +
 LSUNM    VFD    12/2011B,9/LUNM,9/LXUNM,12/2014B,18/STACK1  UNARY -
 LSPLU    VFD    12/2010B,9/LPLU,9/LXPLU,12/2014B,18/STACK1  +
 LSMIN    VFD    12/2010B,9/LMIN,9/LXMIN,12/2014B,18/STACK1  -
 LSSTA    VFD       12/2012B,9/LSTA,9/LXSTA,12/2015B,18/STACK1    * 
 LSSLA    VFD       12/2012B,9/LSLA,9/LXSLA,12/2034B,18/STACK1    / 
 LSPOW    VFD       12/2013B,9/LPOW,9/LXPOW,12/2034B,18/POWACT1   ' 
 LSTHE    VFD    12/2003B,9/LTHE,9/LXTHE,12/2030B,18/THACT1  THEN 
 LSELSE   VFD    12/2001B,9/LELS,9/LXELS,12/2033B,18/ELSACT1    ELSE
 LSSTE    VFD       12/2003B,9/LSTE,9/LXSTE,12/2031B,18/SERROR2  STEP 
 LSTOX    VFD       12/2003B,9/LTOX,9/LXTOX,12/2032B,18/SERROR3  TO 
 LSRPA    VFD       12/2001B,9/0000,9/LXRPA,12/2020B,18/SERROR4   ) 
 LSFIL    VFD       12/2002B,9/0000,9/LXFIL,12/2036B,18/SERROR5  FILE 
 LSFILE   VFD    12/2015B,9/LFILE,9/LXFILE,12/2034B,18/STACK1 FILE STMT 
 LSDIG    VFD    12/2002B,9/0000,9/LXDIG,12/2036B,18/SERRORC
 LSEOS    VFD       12/2001B,9/0000,9/LXEOS,12/2033B,18/EOSACT1  EOS
 LSEOL    VFD       12/2001B,9/LBEG,9/LXEOL,12/2033B,18/EOLACT1  EOL
LSEOP     VFD       12/2077B,9/0000,9/LXEOP,12/2034B,18/BENDCH1  EOP
 LSEQU    VFD       12/2007B,9/LEQU,9/LXEQU,12/2016B,18/EQUACT1    =
 LSLTE    VFD       12/2007B,9/LLTE,9/LXLTE,12/2017B,18/LOGACT1    '= 
 LSLTH    VFD       12/2007B,9/LLTH,9/LXLTH,12/2017B,18/LOGACT1     ' 
 LSGTE    VFD       12/2007B,9/LGTE,9/LXGTE,12/2017B,18/LOGACT1    != 
 LSGTH    VFD       12/2007B,9/LGTH,9/LXGTH,12/2017B,18/LOGACT1     ! 
 LSNEQ    VFD       12/2007B,9/LNEQ,9/LXNEQ,12/2017B,18/LOGACT1    '! 
 LSNOT    VFD       12/2006B,9/LNOT,9/LXNOT,12/2017B,18/NOTACT1   NOT 
 LSAND    VFD       12/2005B,9/LAND,9/LXAND,12/2030B,18/LOGACT1   AND 
 LSOR     VFD       12/2004B,9/LOR,9/LXOR,12/2030B,18/LOGACT1     OR
 LSCOM    VFD       12/2002B,9/0000,9/LXCOM,12/2021B,18/SERROR6   , 
 LSSEM    VFD       12/2002B,9/0000,9/LXSEM,12/2022B,18/SERROR7  SEMI 
 LSCLNF   VFD  12/2002B,9/000B,9/LXCLN,12/2016B,18/SERROR   FILE :  
 LSCLN    VFD    12/2015B,9/LCLN,9/LXCLN,12/2034B,18/CLNACT1  FORMAT: 
 LSCOL    VFD    12/2002B,9/000B,9/LXCOL,12/2042B,18/SERRORF SUBSTR : 
 LSLFN    VFD       12/2015B,9/LLFN,9/LXLFN,12/2023B,18/LFUACT1   (FUN
 LSLSB    VFD       12/2015B,9/LLSB,9/LXLSB,12/2014B,18/LFUACT1   (SUBRT
 LSLSBT   VFD    12/2015B,9/LLSBT,9/LXLSBT,12/2014B,18/LFUACT1   (TAB    BAS0018
 LSLSV    VFD    12/2015B,9/LLSV,9/LXLSV,12/2014B,18/LFUACT1  (SF EG LEN
 LSLVS    VFD    12/2015B,9/LLVS,9/LXLVS,12/2014B,18/LFUACT1 SF( EG STR 
 LSLSX    VFD    12/2015B,9/LLSX,9/LXLSX,12/2014B,18/LFUACT1 SF( EG SUBS
 LSVP     VFD    12/2015B,9/LVPF,9/LXVP,12/2014B,18/LFUACT1 
 LSLMF    VFD       12/2015B,9/LLMF,9/LXLMF,12/2025B,18/SERROR8   (MATFU
 LSLMO    VFD       12/2015B,9/LLMO,9/LXLMO,12/2034B,18/STACK1    (MATOP
 LSLAR    VFD       12/2015B,9/LLAR,9/LXLAR,12/2027B,18/STACK1    (ARITH
 LSLARD   VFD    12/2015B,9/LLAR,9/LXLAR,12/2027B,18/DELPRNA  ( FOR DLMT
 LSLSS    VFD       12/2015B,9/LLSS,9/LXLSS,12/2024B,18/SUBACT1   (SUBSC
 LSSSV    VFD    12/2015B,9/LSSV,9/LXSSV,12/2034B,18/STACK1 (-LSS+SUBSTR
 LSLDT    VFD    12/2015B,9/LLDT,9/LXLDT,12/2025B,18/STACK1 
 LSLCL    VFD    12/2015B,9/LLCL,9/LXLCL,12/2014B,18/STACK1  (CALL
 LSAPP    VFD    12/2015B,9/LAPP,9/LXAPP,12/2034B,18/STACK1   APPEND
 LSBAS    VFD    12/2015B,9/LBAS,9/LXBAS,12/2044B,18/STACK1    BASE 
 LSCAL    VFD    12/2015B,9/LCAL,9/LXCAL,12/2034B,18/CALACT1  CALL
 LSCHN    VFD    12/2015B,9/LCHN,9/LXCHN,12/2034B,18/STACK1  CHAIN
 LSCHG    VFD    12/2015B,9/LCHG,9/LXCHG,12/2034B,18/STACK1    CHANGE 
 LSCLO    VFD    12/2015B,9/LCLO,9/LXCLO,12/2034B,18/STACK1    CLOSE
 LSCLT    VFD    12/2015B,9/LCLT,9/LXCLT,12/2044B,18/SERRORC   COLLATE
 LSDEF    VFD       12/2015B,9/LDEF,9/LXDEF,12/2034B,18/STACK1   DEF
 LSDEL    VFD    12/2015B,9/LDEL,9/LXDEL,12/2035B,18/DLMTINA  DELIMIT 
 LSDIM    VFD       12/2015B,9/LDIM,9/LXDIM,12/2034B,18/STACK1   DIM
 LSDAT    VFD       12/2015B,9/LDAT,9/LXDAT,12/2034B,18/SDACT1   DATA 
 LSEND      VFD  12/2015B,9/LEND,9/LXEND,12/2036B,18/IFEACT 
 LSERR    VFD    12/2002B,9/0000,9/LXERR,12/2033B,18/SERRORC  (ON) ERROR
 LSERRGO  VFD    12/2003B,9/0,9/LXERGO,12/2030B,18/SERRORC  SEE LTONERG 
 LSFOR    VFD       12/2015B,9/LFOR,9/LXFOR,12/2034B,18/STACK1   FOR
 LSFND    VFD    12/2015B,9/LFND,9/LXFND,12/2034B,18/STACK1  FNEND
 LSONG    VFD       12/2001B,9/LONG,9/LXONG,12/2034B,18/SGOACT1 
 LSGOS    VFD       12/2015B,9/LGOS,9/LXGOS,12/2034B,18/STACK1   GOSUB
 LSIFM     VFD   12/2015B,9/LIFM,9/LXIFM,12/2036B,18/STACK1 
 LSIFX    VFD    12/2015B,9/LIFX,9/LXIFX,12/2034B,18/IFACT1       IF
 LSINP    VFD    12/2015B,9/LNPT,9/LXINP,12/2035B,18/SINACT1    INPUT 
 LSJMP    VFD    12/2015B,9/LJMP,9/LXJMP,12/2034B,18/STACK1  JUMP 
 LSLET    VFD       12/2015B,9/LLET,9/LXLET,12/2034B,18/STACK1   LET
 LSMAT    VFD       12/2015B,9/LMAT,9/LXMAT,12/2034B,18/STACK1   MAT
 LSMGN    VFD    12/2015B,9/LMAR,9/LXMAR,12/2035B,18/SPRACT1  MARGIN
 LSNAT    VFD    12/2015B,9/LNAT,9/LXNAT,12/2043B,18/SERRORC   NATIVE 
 LSNEX    VFD       12/2015B,9/LNEX,9/LXNEX,12/2034B,18/STACK1   NEXT 
 LSNOD    VFD       12/2015B,9/LNOD,9/LXNOD,12/2034B,18/SNOACT1  NODATA 
 LSONN    VFD    12/2015B,9/LONN,9/LXONN,12/2034B,18/ONACT1      ON 
 LSOPT    VFD    12/2015B,9/LOPT,9/LXOPT,12/2034B,18/STACK1    OPTION 
 LSPND    VFD    12/2002B,9/0,9/LXPND,12/2036B,18/SERRORE 
 LSPRI    VFD       12/2015B,9/LPRI,9/LXPRI,12/2035B,18/SPRACT1  PRINT
 LSREM    VFD       12/2015B,9/LREM,9/LXREM,12/2034B,18/SRMACT1  REM
 LSAPO    VFD    12/2001B,9/0000,9/LXAPO,12/2033B,18/SAPACT APOSTROPHE
 LSREA    VFD       12/2015B,9/LREA,9/LXREA,12/2035B,18/SREACT1  READ 
 LSRET    VFD       12/2015B,9/LRET,9/LXRET,12/2034B,18/STACK1   RETURN 
 LSRES    VFD       12/2015B,9/LRES,9/LXRES,12/2034B,18/STACK1   RESTORE
 LSSET    VFD    12/2015B,9/LSDG,9/LXSET,12/2034B,18/STACK1 
 LSSTD    VFD    12/2015B,9/LSTD,9/LXSTD,12/2043B,18/SERRORC   STANDARD 
 LSSTO    VFD       12/2015B,9/LSTO,9/LXSTO,12/2034B,18/STACK1   STOP 
 LSUSI    VFD    12/2002B,9/0,9/LXUSI,12/2036B,18/SERRORD       USING 
 LSWRI    VFD       12/2015B,9/LWRT,9/LXWRT,12/2035B,18/SWRACT1  WRITE
 LSRAN    VFD    12/2015B,9/LRAN,9/LXRAN,12/2034B,18/STACK1 
 LSILLEG VFD     12/2015B,9/0000,9/00000,12/2000B,18/ER20   BAD CHAR
 LSILLEG3 VFD       12/2015B,9/0000,9/00000,12/2034B,18/ER22   FUNCT
 LSILLEG4 VFD       12/2015B,9/0000,9/00000,12/2034B,18/ER23   NUMBER 
 LSILLEG5 VFD       12/2015B,9/0000,9/00000,12/2034B,18/ER24   STRING 
 LSILLEG6 VFD    12/2015B,9/0,9/0,12/2034B,18/SERRORF  BAD COLON
 LSILLEG7 VFD    12/2015B,9/0,9/0,12/2034B,18/ER26   BAD LPAREN 
          EJECT 
* 
*         OPERATORS AS THEY ARE ENTERED INTO THE TOR-STACK.  FORMAT IS
*         VFD  12/20PP,30/ACTIVBIT,18/OUTPUT-ACTION 
*         THE OUTPUT ACTION WILL ALSO BE USED FOR THE SYMBOL NAME 
* 
 LTOROUT  BSS       0 
 LTUNP    VFD    12/2011B,30/0000000000B,18/LACTUNP     UNARY + 
 LTUNM    VFD    12/2011B,30/0000000000B,18/LACTUNM     UNARY - 
 LTPLU    VFD    12/2010B,30/0000000000B,18/LACTPLU     + 
 LTMIN    VFD    12/2010B,30/0000000000B,18/LACTMIN     - 
 LTSTA    VFD  12/2012B,30/0000000000B,18/LACTSTA           * 
 LTSLA    VFD  12/2012B,30/0000000000B,18/LACTSLA           / 
 LTPOW    VFD  12/2013B,30/0000000000B,18/LACTPOW           ' 
 LTEQU  VFD    12/2007B,30/0000400000B,18/LACTEQU        =
 LTLTH  VFD    12/2007B,30/0000400000B,18/LACTLTH        '
 LTLTE  VFD    12/2007B,30/0000400000B,18/LACTLTE        '= 
 LTGTH  VFD    12/2007B,30/0000400000B,18/LACTGTH        !
 LTGTE  VFD    12/2007B,30/0000400000B,18/LACTGTE        != 
 LTNEQ  VFD    12/2007B,30/0000400000B,18/LACTNEQ        '! 
 LTNOT  VFD    12/2006B,30/0000400000B,18/LACTNOT      NOT
 LTAND  VFD    12/2005B,30/0000400000B,18/LACTAND      AND
 LTOR   VFD    12/2004B,30/0000400000B,18/LACTOR       OR 
 LTSTR    VFD  12/2000B,30/0000400000B,18/LACTSTR         STRING REL
 LTLFN    VFD    12/2000B,30/0300000000B,18/LACTLFN  (FN
 LTCFN    VFD    12/2000B,30/0300000000B,18/LACTCFN  ,FN
 LTNPF    VFD    12/2000B,30/7760764200B,18/LACTNPF   USER FUNCTION 
 LTLSB    VFD  12/2000B,30/0200000000B,18/LACTLSB           (SUBROUTINE 
 LTLSBT   VFD    12/2000B,30/0200000000B,18/LACLSBT      (TAB            BAS0018
 LTVP     VFD    12/2000B,30/0300000000B,18/LACTVPF     VAR PAR FUN 
 LTLSV    VFD    12/2000B,30/0200000000B,18/LACTLSV  STRING IN,REAL OUT 
 LTLVS    VFD    12/2000B,30/0300000000B,18/LACTLVS  RL TO STR CMA/RPRN 
 LTLSX    VFD    12/2000B,30/0100000000B,18/LACTLS1   SUBSTR COMMA
 LTLSY    VFD    12/2000B,30/0300000000B,18/LACTLS2   SUBSTR-COMMA OR ) 
 LTLSZ    VFD    12/2000B,30/0200000000B,18/LACTLS3  SUBSTR ) 
 LTLMF    VFD  12/2000B,30/0200000000B,18/LACTLMF           (MATFUNCTION
 LTLMO    VFD  12/2000B,30/0300000000B,18/LACTLMO           (MATOP
 LTLMX    VFD    12/2000B,30/0200000000B,18/LACTLMO        (MATOP 
 LTLAR    VFD  12/2000B,30/0200000000B,18/LACTLAR           (ARITHMETIC 
 LTLDI    VFD  12/2000B,30/0300000000B,18/LACTLDI           (DIM
 LTLDE    VFD    12/2000B,30/0300000000B,18/LACTLDE  (DEF 
 LTCDE    VFD    12/2000B,30/0300000000B,18/LACTCDE  ,DEF 
 LTLSS    VFD    12/2000B,30/0300000200B,18/LACTLSS        (SUBSCRIPT 
 LTLSC    VFD  12/2000B,30/0200000000B,18/LACTLSC           (SCALAR 
 LTLCL    VFD    12/2000B,30/0300000000B,18/LACTLCL  (CALL
 LTRDE    VFD    12/2000B,30/1000040000B,18/LACTRDE  DEF) 
 LTSSC    VFD  12/2000B,30/0300000000B,18/LACTSSC           SUBSCRIPT,
 LTRSC    VFD  12/2000B,30/2000000000B,18/LACTRSC           SCALAR) 
 LTRDI    VFD  12/2000B,30/0100040000B,18/LACTRDI           DIM)
 LTREE    VFD  12/2000B,30/0000040000B,18/LACTREE           REP=
 LTFAS    VFD  12/2000B,30/0000040000B,18/LACTFAS           FIRST ASSGN 
 LTFIE    VFD    12/2000B,30/1000000000B,18/LACTFIE   FILE =
 LTFCMA   VFD    12/2000B,30/0100040000B,18/LACTFCM   FILE COMMA/EOS
 LTFIND1  VFD    12/2000B,30/0100444000B,18/LACTFL1  FILE ORD.
 LTFOE    VFD  12/2000B,30/0000100000B,18/LACTFOE           FOR=
 LTMAE    VFD  12/2000B,30/6007040000B,18/LACTMAE           MAT=
 LTDEE    VFD  12/2000B,30/0000040000B,18/LACTDEE           DEF=
 LTBEG    VFD  12/2000B,30/0000040000B,18/LACTBEG           BEGIN LINE
 LTSET    VFD  12/2060B,30/0000000000B,18/LACTSET             SET LINE
 LTTHE    VFD    12/2000B,30/7777777777B,18/LACTTHE   THEN
 LTELSE   VFD    12/2000B,30/7777777777B,18/LACTELS   ELSE
 LTSTE    VFD  12/2000B,30/0000040000B,18/LACTSTE           STEP
 LTTOX    VFD  12/2000B,30/0000240000B,18/LACTTOX           TO
 LTAPP    VFD    12/2000B,30/0000004000B,18/LACTAPP    APPEND FIL/PND 
 LTAPQ    VFD    12/2000B,30/0000040000B,18/LACTAPQ   APPEND EOS
 LTBAS    VFD    12/2000B,30/0100040000B,18/LACTBAS     BASE
 LTCAL    VFD    12/2000B,30/4000040000B,18/LACTCAL  CALL 
 LTCHN    VFD    12/2000B,30/0000044000B,18/LACTCHN  CHAIN (EOS,FILE) 
 LTCHN1   VFD    12/2000B,30/0000040000B,18/LACTCHN1  CHAIN1 (EOS)
 LTCHG    VFD    12/2000B,30/0000100000B,18/LACTCHG    CHANGE STMT
 LTCHGV   VFD    12/2000B,30/0000040000B,18/LACTCHV  CHANGE(SV)-EOS 
 LTCHGS   VFD    12/2000B,30/0000040000B,18/LACTCHS    CHANGE(VS)-EOS 
 LTCLO    VFD    12/2000B,30/0000004000B,18/LACTCLO        CLOSE
 LTCLO1   VFD    12/2000B,30/1100040000B,18/LACCLO1  CLOSE (CMA,CLN,EOS)
 LTCLT    VFD    12/2000B,30/0000000100B,18/LACTCLT     COLLATE 
 LTDIM    VFD  12/2000B,30/0010000000B,18/LACTDIM           DIM 
 LTDEL    VFD    12/2000B,30/0100044000B,18/LACTDEL DELIMIT (FIL/CMA/EO)
 LTDEL1   VFD    12/2000B,30/0100040000B,18/LACTDL1   DELIMIT (CMA/EOS) 
 LTDEL2   VFD    12/2000B,30/0100040000B,18/LACTDL2   DELIMIT (CMA/EOS) 
 LTDAT    VFD  12/2000B,30/0100040000B,18/LACTDAT           DATA
 LTFIL    VFD    12/2000B,30/0000004000B,18/LACTFIL    FILE STMT
 LTINP    VFD  12/2000B,30/0100044000B,18/LACTINP           INPUT 
 LTIN1    VFD  12/2000B,30/0100040000B,18/LACTIN1           INPUT1
 LTIN2    VFD  12/2000B,30/0100040000B,18/LACTIN2           INPUT ELEM
 LTREA    VFD  12/2000B,30/0100044000B,18/LACTREA           READ
 LTRDF    VFD  12/2000B,30/0100040000B,18/LACTRDF           READ FILE 
 LTRE2    VFD  12/2000B,30/0100040000B,18/LACTRE2           READ ELEM 
 LTRF2    VFD  12/2000B,30/0100040000B,18/LACTRF2           RD FIL ELEM 
 LTNOD    VFD  12/2000B,30/0000044000B,18/LACTNOD           NODATA
 LTNO1    VFD  12/2000B,30/0000040000B,18/LACTNO1           NODATA FILE 
 LTIFEND  VFD    12/2000B,30/0000004000B,18/LACTIFE  IFEND - POUND
 LTIFM    VFD    12/2000B,30/0000004000B,18/LACTIFM  IFMORE - POUND 
 LTIFE2   VFD    12/2000B,30/0000400000B,18/LCTIFE2  IFEND - THEN 
 LTIFM2   VFD    12/2000B,30/0000400000B,18/LCTIFM2  IFMORE - THEN
 LTIFE3   VFD    12/2000B,30/0000040000B,18/LCTIFE3  IFEND - EOS
 LTIFM3   VFD    12/2000B,30/0000040000B,18/LCTIFM3  IFMORE - EOS 
 LTFOR    VFD  12/2000B,30/1000000000B,18/LACTFOR           FOR 
* LTIFX  VFD    12/2000B,30/1401000000B,18/LACTIFX   IF SEE MORE FEAT.
 LTIFX    VFD    12/2000B,30/1401004000B,18/LACTIFX  IF 
 LTLET    VFD  12/2000B,30/1000000000B,18/LACTLET           LET 
 LTMAT    VFD  12/2000B,30/1000010000B,18/LACTMAT           MAT 
 LTMAR    VFD    12/2000B,30/0000044000B,18/LACTMGN  MARGIN-FILE/EOS
 LTMAR1   VFD    12/2000B,30/0000040000B,18/LACTMG1  (MARGIN) FILE-EOS
 LTDEF    VFD    12/2000B,30/1020040000B,18/LACTDEF 
 LTPRI    VFD  12/2000B,30/0140044000B,18/LACTPRI           PRINT 
 LTPR1    VFD    12/2000B,30/0140044000B,18/LACTPR1        PRINT1 
 LTPR2    VFD    12/2000B,30/0140040000B,18/LACTPR2 
 LTEND    VFD  12/2000B,30/0000040000B,18/LACTEND           END 
 LTFND    VFD    12/2000B,30/0000040000B,18/LACTFND  FNEND
 LTONG    VFD  12/2000B,30/0000040000B,18/LACTONG       ONGO TO 
 LTONGS1  VFD    12/2003B,30/0000040000B,18/LACTGS1 
 LTONGS2  VFD    12/2003B,30/0000040000B,18/LACTGS2 
 LTOND    VFD  12/2003B,30/0000040000B,18/LACTOND       ON NODE 
 LTGOS    VFD  12/2000B,30/0000040000B,18/LACTGOS           GOSUB 
 LTJMP    VFD    12/2000B,30/0000040000B,18/LACTJMP        JUMP 
 LTONERG  VFD    12/2000B,30/0000440000B,18/LACONEG (ONERR)GOTO/THEN/EOS
 LTNELBL  VFD    12/2000B,30/0000040000B,18/LAOELBL  (ONERR GOTO) EOS 
 LTNAT    VFD    12/2000B,30/0100040000B,18/LACTNAT     NATIVE
 LTNEX    VFD  12/2000B,30/0000040000B,18/LACTNEX           NEXT
 LTONN    VFD    12/2002B,30/0000040000B,18/LACTONN           ON
 LTOPT    VFD    12/2000B,30/0000000040B,18/LACTCLT     OPTION
 LTREM    VFD  12/2000B,30/0000040000B,18/LACTREM           REM 
 LTRET    VFD  12/2000B,30/0000040000B,18/LACTRET           RETURN
 LTRES    VFD  12/2000B,30/0000044000B,18/LACTRES           RESTORE 
 LTREW    VFD    12/2000B,30/0000070000B,18/LACTREW     RESTORE FILE
 LTSDG    VFD    12/2000B,30/0000044000B,18/LACTSDG 
 LTSTDIG  VFD    12/2000B,30/0000040000B,18/LACTDGTS
 LTSTD    VFD    12/2000B,30/0100040000B,18/LACTSTD     STANDARD
 LTSTO    VFD  12/2000B,30/0000040000B,18/LACTSTO           STOP
 LTSETF   VFD    12/2000B,30/0000040000B,18/LACTSFIL       SET-FILE-EOS 
 LTWRT    VFD  12/2000B,30/0100044000B,18/LACTWRT           WRITE 
 LTWR2    VFD  12/2000B,30/0100040000B,18/LACTWR2           START WRITE 
 LTWR3    VFD  12/2000B,30/0100040000B,18/LACTWR3           WRITE ELEM
 LTMCL    VFD    12/2000B,30/0000060000B,18/LACTMCL   MAT CALL
 LTDET    VFD    12/2000B,30/7754764200B,18/LACTDET  *DET* W/O PARM.
 LTLDT    VFD    12/2000B,30/0200000000B,18/LACTLDT  *DET* WITH PARM. 
 LTMRD    VFD  12/2000B,30/0110044000B,18/LACTMRD           MAT READ
 LTMRF    VFD  12/2000B,30/0110040000B,18/LACTMRF           MAT RD FILE 
 LTMIP    VFD  12/2000B,30/0110044000B,18/LACTMIP           MAT INPUT 
 LTMIF    VFD  12/2000B,30/0110040000B,18/LACTMIF           MAT IN FILE 
 LTMX1    VFD  12/2000B,30/0110040000B,18/LACTMX1           MAT RD/IN EL
 LTMX2    VFD  12/2000B,30/0100040000B,18/LACTMX2           MAT RD/IN OP
 LTMWR    VFD  12/2000B,30/0100044000B,18/LACTMWR           MAT WRITE 
 LTMWF    VFD  12/2000B,30/0100040000B,18/LACTMWF           MAT WR FILE 
 LTMW1    VFD  12/2000B,30/0100040000B,18/LACTMW1           MAT WR FL EL
 LTMPR    VFD  12/2000B,30/0140044000B,18/LACTMPR           MAT PRINT 
 LTMPF    VFD    12/2000B,30/0140044000B,18/LACTMPF   MAT PR FILE 
 LTMP1    VFD  12/2000B,30/0140040000B,18/LACTMP1           MAT PRINT EL
 LTMPU    VFD    12/2000B,30/0140040000B,18/LACTMPU   MAT PRINT USING 
 LTMPV    VFD    12/2000B,30/0140040000B,18/LACTMPV 
 LTCLN    VFD    12/2000B,30/0000040000B,18/LACTCLN 
 LTPRU    VFD    12/2000B,30/0140040000B,18/LACTPRU 
 LTPRV    VFD    12/2000B,30/0140040000B,18/LACTPRV 
 LTST2P   VFD    12/2000B,30/0200000000B,18/LACTST2 
 LTFUNP   VFD    12/2000B,30/6777777777B,18/LACTFUNP  DUMMY FOR VPF 
 LTSSV    VFD    12/2000B,30/0000000200B,18/LACTSSV 
 LTSBT    VFD    12/2000B,30/0200000000B,18/LACTSBT 
 LTSUB    VFD    12/2000B,30/5740560000B,18/LACTSUB    SUBSTRING
 LTRDSUB  VFD    12/2000B,30/0100040000B,18/LACTRDSB
 LTLSUB   VFD    12/2000B,30/0000040000B,18/LACTLSUB
 LTRAN    VFD    12/2000B,30/0000040000B,18/LACTRAN     RANDOMIZE 
 LTRND    VFD    12/2000B,30/7740764200B,18/LACTRND     RND 
          EJECT 
          EJECT 
**        FNBLOK - TABLE FOR CLASS 28 VARIABLE SYSTEM FUNCTIONS.
* 
*         VFD    6/MIN,6/MAX,1/T,20/ TYPE,27/0
* 
*         MIN    = MINIMUM NUMBER OF ALLOWABLE PARAMETERS.
*         MAX    = MAXIMUM NUMBER OF ALLOWABLE PARAMETERS.
*         T      = FUNCTION RESULT TYPE%
*                  0 = NUMERIC. 
*                  1 = STRING.
*         TYPE   = TYPE OF EACH ARGUMENT AS IN -T-. 
  
**        MACRO DEFINITION. 
  
**        FUN - ENTER FUNCTION INTO FNBLOK TABLE. 
* 
*         FUN    MIN,MAX,TYPE,(BITS)
* 
*         MAX,MIN= ARGUMENT COUNT AS ABOVE. 
*         TYPE   = -STG- IF RESULT IS A STRING VALUE. 
*                  -NUM- IF RESULT IS A NUMERIC VALUE.
*         BITS   = BIT PATTERN FOR ARGUMENTS, 
*                  -STG- FOR A STRING ARGUMENT. 
*                  -NUM- FOR A NUMERIC ARGUMENT.
  
  
          PURGMAC FUN 
  
 FUN      MACRO  MN,MX,TY,BITS
          VFD    6/MN,6/MX,1/TY 
          IRP    BITS 
          VFD    1/BITS 
          IRP 
          VFD    *P/0 
          ENDM
 STG      EQU    1
 NUM      EQU    0
          NOREF  STG,NUM
 FNBLOK   SPACE  4
 FNBLOK   BSS    0
          LOC    0
  
          FUN    1,20,NUM,(NUM)  MAX
          FUN    1,20,NUM,(NUM)  MIN
          FUN    1,2,NUM,(NUM,NUM)  ROF 
          FUN    2,3,STG,(STG,NUM,NUM)  SUBSTR
          FUN    2,2,STG,(STG,NUM)    RPT$
          FUN    2,2,STG,(STG,NUM)  LPAD$ 
          FUN    2,2,STG,(STG,NUM)  RPAD$ 
          FUN    1,1,STG,(STG)  LTRM$ 
          FUN    1,1,STG,(STG)  RTRM$ 
          FUN    1,1,NUM,(STG)  ORD 
          FUN    1,1,STG,(STG)  UPRC$ 
          FUN    1,1,STG,(STG)  LWRC$ 
          FUN    2,3,NUM,(STG,STG,NUM)  POS 
  
          LOC    *O 
          SPACE  4
          EJECT 
* 
*  OPERAND CONTROL TABLE
* 
* 
 BANDTBL  MACRO     KIND,CLASS,ACTION 
          VFD       12/2000B+KIND,18/CLASS,30/ACTION
          ENDM
* 
 BANDCTBL BSS       0                   OPERAND CONTROL TABLE 
* 
          BANDTBL   SFKIND,FUN,BSYSFUN  13 SYSTEM DEFINED FUNCTION
          BANDTBL   UFKIND,FUN,BUSEFUN  14 USER DEFINED FUNCTION
          BANDTBL   MFKIND,FUN,BMATFUN  15 MATRIX FUNCTION (INV, TRN) 
          BANDTBL   MOKIND,FUN,BMATOPR  16 MATRIX OPERATION (ZER ETC) 
 BANDCSTR BSS       0 
          BANDTBL   STKIND,VIS,BSTRING  17 STRING 
          BANDTBL   SIMKND,VIS,BVAR     20 SIMPLE AND ARRAY VARIABLES 
          BANDTBL   SVKIND,VIS,BVAR2     2S STRING VARIABLES
          BANDTBL   CONKND,CON,BCONST   21 CONSTANT - REAL
 BANDCON  BSS    0
          BANDTBL   CONKND,INT,BCONST   22 CONSTANT - INTEGER 
          BANDTBL   FILKND,CON,BFILEID  23 FILE IDENT 
          BANDTBL  SYSTKND,VIS,BSYSTR   (24) SYSTEM STRINGS (DATE ETC)
          BANDTBL  SFSVKND,FUN,BSYSFSV  (25)  LEN,DIS,VAL STR PAR,RL OUT
         BANDTBL SFVSKND,FUN,BSYSFVS  (26) STR  REAL PAR,STR OUTPUT 
         BANDTBL SFSSKND,FUN,BSYSFXS  (27)  MIXED PARS,STR OUT
          BANDTBL SFKIND,FUN,BVARFN    VAR PARAM SYS FUNC 
          BANDTBL  SIMKND,FUN,BSYSFN3   DET 
          BANDTBL  EXTKND,CON,BEXT  EXTERNAL NAME 
          BANDTBL   SFKIND,FUN,BSPECFN   SPECIAL FN 
          BANDTBL   TABKIND,FUN,BSYSFN4      TAB                         BAS0018
          BANDTBL  SFKIND,FUN,BRNDFN     (33) RND FUNCTION. 
* 
*   OPERAND STACK PROTOTYPES
* 
 FVINXWD  EQU       SIMVINXW
 FAINXWD  EQU       SIMAINXW
STVINXW   VFD       12/2000B+STKIND,18/VINX,30/0
SVAINXW   VFD       12/2000B+SVKIND,18/AINX,30/0
 SVAINX1W VFD    12/2000B+SVKIND,18/AINX1,30/0
SVINXW    VFD       12/2000B+SVKIND,18/VINX,30/0
 SVINSW   VFD    12/2000B+SVKIND,18/VINS,30/0  DUMMY (STACKED ON EACH 
*                                  SUBSTR OPERAND TRIPLET/DOUBLET)
 SIMSINSW VFD       12/2000B+SIMKND,18/SINS,30/0
 SIMAINSW VFD       12/2000B+SIMKND,18/AINS,30/0
 STSINSW  VFD    12/2000B+STKIND,18/SINS,30/0 
 GETARKDW VFD       12/2000B+ARRKND,18/VINS,30/0
 GETSARKW VFD    12/2000B+SVARKND,18/VINS,30/0
 TABVINXW VFD    12/2000B+TABKIND,18/VINX,30/0        TAB IN X           BAS0018
          EJECT 
          EJECT 
* 
*  EXTERNAL REFERENCES FOR SUBROUTINE HANDLING
* 
*  SYSTEM DEFINED FUNCTIONS 
*     THE EXPONENT FIELD IS USED AS USE-BIT 
* 
 BSFUNTL  BSS    5               BSFUNTBL LOADED HERE 
*     BSFUNTL OVERLAY ORIGINED HERE 
* 
 BSFUNTBL BSS    0
 STR      SET    0
          MACRO  EXTERN,L,A,B,C 
          IFC    NE,$$L$,1
 L        EQU    STR
 STR      SET    STR+1
          DATA   0L_A 
          ENDM
*CALL,COMBEXT 
* 
          DATA   0LDBUG.LN     DUMMY FOR DEBUG BIN FILE 
 DBUGLN   EQU    STR
 STR      SET    STR+1
 BEXTLNG  EQU       *-BSFUNTBL
* 
*  FLAG WORD FOR READ AND DATA
* 
 BDAREFL  VFD       12/2000B,30/2000B,18/0
          EJECT 
* 
*  CONTROL TABLE FOR OUTINS. THE FORMAT IS DEFINED BY MACRO INSTTAB 
* 
 INSTTAB  MACRO     OPCODE,I,J,K,LENGTH,RELOC,ACTION
          VFD       6/0,3/I,3/J,18/K,6/OPCODE,3/LENGTH,3/RELOC,18/ACTION
          ENDM
* 
* 
*                    OP  I   J    K     L   REL   ACT 
* 
 FETCHVAR INSTTAB   ABK,NUL,TWO,NAUGHT,L=30,NREL,BACT01  FETCHES
 FETCHDOP INSTTAB   ABK,NUL,FUR,NAUGHT,L=30,NREL,BACT01 
 FETCHDAT INSTTAB  ABK,NUL,NUL,DATAX,L=30,XREL,BACT02 
 FETCHDT1 INSTTAB  AXB,NUL,NUL,NAUGHT,L=15,NREL,BACT12
 FETCHARR INSTTAB   AXB,NUL,NUL,TWOTWO,L=15,NREL,BACT12 
 FETCHB23 INSTTAB   ABB,NUL,TWO,THREEE,L=15,NREL,BACT02 
 FETCHGOS INSTTAB  ABK,NUL,NUL,GOSUBX,L=30,XREL,BACT02
 FETCHGS1 INSTTAB  BXB,TRE,NUL,NAUGHT,L=15,NREL,BACT29
 SXPLONE  INSTTAB   XBK,NUL,NUL,PLUSON,L=30,NREL,BACT02 
* 
 STOREVAR INSTTAB   ABK,SIX,TWO,NAUGHT,L=30,NREL,BACT04  STORES 
 STOREDOP INSTTAB   ABK,SIX,FUR,NAUGHT,L=30,NREL,BACT04 
 STOREARR INSTTAB   AXB,SIX,NUL,TWOTWO,L=15,NREL,BACT05 
 STOREGOS INSTTAB  ABK,SIX,NUL,GOSUBX,L=30,XREL,BACT06
 STOREB23 INSTTAB   ABB,SIX,TWO,THREEE,L=15,NREL,BACT06 
 STOREDAT INSTTAB  ABK,SIX,NUL,DATAX,L=30,XREL,BACT06 
* 
 FLOATADD INSTTAB   FAD,NUL,NUL,NAUGHT,L=15,NREL,BACT07  BINARY OPER..
 FLOATSUB INSTTAB   FSB,NUL,NUL,NAUGHT,L=15,NREL,BACT07    TOPM1 =
 FLOATMUL INSTTAB   FMP,NUL,NUL,NAUGHT,L=15,NREL,BACT07     TOPM1 OP TOP
 FLOATDIV INSTTAB   FDV,NUL,NUL,NAUGHT,L=15,NREL,BACT07 
 FIXADD   INSTTAB   IAD,NUL,NUL,NAUGHT,L=15,NREL,BACT07 
 RJPOWER   INSTTAB   RTJ,NUL,NUL,BSTAPWR,L=30,XREL,BACT08   EXPONENT
* 
 ORREDATA INSTTAB   ORX,UND,NUL,BENDAT,L=30,XREL,BACT05  OPERATION, 
 PLBOUNDS INSTTAB   PLX,POS,NUL,BEBOUN,L=30,XREL,BACT05   RELEASE TOP 
 RJPRINT   INSTTAB   RTJ,NUL,NUL,BSTOPRT,L=30,XREL,BACT08 
 RJOWRT    INSTTAB   RTJ,NUL,NUL,BSTOWRT,L=30,XREL,BACT08 
 RJMATPRT  INSTTAB   RTJ,NUL,NUL,BSTMPRT,L=30,XREL,BACT08 
 RJMATPRU  INSTTAB   RTJ,NUL,NUL,BSTMPRU,L=30,XREL,BACT08 
 RJMATRED  INSTTAB   RTJ,NUL,NUL,BSTMRED,L=30,XREL,BACT08 
 RJMATRFL  INSTTAB   RTJ,NUL,NUL,BSTMRFL,L=30,XREL,BACT08 
 RJMATINP  INSTTAB   RTJ,NUL,NUL,BSTMINP,L=30,XREL,BACT08 
 RJMATIS   INSTTAB   RTJ,NUL,NUL,BSTMIS,L=30,XREL,BACT08
 RJMATRS   INSTTAB   RTJ,NUL,NUL,BSTMRS,L=30,XREL,BACT08
 RJMATRSF  INSTTAB   RTJ,NUL,NUL,BSTMRFS,L=30,XREL,BACT08 
 RJMATWRT  INSTTAB   RTJ,NUL,NUL,BSTMWRT,L=30,XREL,BACT08 
 RJMATWRS  INSTTAB   RTJ,NUL,NUL,BSTMWRS,L=30,XREL,BACT08 
 RJMATPRS  INSTTAB   RTJ,NUL,NUL,BSTMPRS,L=30,XREL,BACT08 
 NODATJMP INSTTAB   ORX,UND,NUL,NAUGHT,L=30,PREL,BACT10 
 EQUALJMP INSTTAB   ZRX,ZER,NUL,NAUGHT,L=30,PREL,BACT10 
 NOTEQJMP INSTTAB   NZX,NOZ,NUL,NAUGHT,L=30,PREL,BACT10 
 PLUSJUMP INSTTAB   PLX,POS,NUL,NAUGHT,L=30,PREL,BACT10 
 MINUSJMP INSTTAB   NGX,NEG,NUL,NAUGHT,L=30,PREL,BACT10 
 SETB6TOP INSTTAB   BXB,SIX,NUL,NAUGHT,L=15,NREL,BACT05 
 NORMTOX6 INSTTAB   NML,SIX,SIX,NAUGHT,L=15,NREL,BACT23 
 NORMTOX5 INSTTAB   NML,FEM,SIX,NAUGHT,L=15,NREL,BACT23 
* 
 NORMLIZE INSTTAB   NML,NUL,SIX,NAUGHT,L=15,NREL,BACT11  OPERATION
 DECRDATA INSTTAB  XAK,SIX,NUL,PLUSON,L=30,NREL,BACT16
 UNPACK   INSTTAB   UPK,NUL,SIX,NAUGHT,L=15,NREL,BACT11   ON TOP
 PACKB0   INSTTAB   PAK,NUL,NUL,NAUGHT,L=15,NREL,BACT11 
 LFTSHIFT INSTTAB   LSB,NUL,SIX,NAUGHT,L=15,NREL,BACT11 
 COMPLMNT INSTTAB   CMT,NUL,NUL,NAUGHT,L=15,NREL,BACT11 
 BX4XI    INSTTAB  XMT,FUR,NUL,NAUGHT,L=15,NREL,BACT16
 BX5XI    INSTTAB   XMT,FEM,NUL,NAUGHT,L=15,NREL,BACT16 
 SX5AIMB2 INSTTAB  XAB,FEM,NUL,TWOTWO,L=15,NREL,BACT05
 BX4XJ    INSTTAB   XMT,FUR,NUL,NAUGHT,L=15,NREL,BACT13 
 BXIX5    INSTTAB   XMT,NUL,FEM,NAUGHT,L=15,NREL,BACT28 
 SXIB6    INSTTAB   XBB,NUL,SIX,NAUGHT,L=15,NREL,BACT28 
 BXIJAK   INSTTAB   BPR,NUL,NUL,NAUGHT,L=15,NREL,BACT07 
 BXIJOK   INSTTAB   BSU,NUL,NUL,NAUGHT,L=15,NREL,BACT07 
 BXIJE0   INSTTAB   BDF,NUL,NUL,NAUGHT,L=15,NREL,BACT11 
 LEFTSHFT INSTTAB   LSC,NUL,NUL,THREEE,L=15,NREL,BACT28 
* 
 NEGBOUND INSTTAB   NGX,NEG,NUL,BEBOUN,L=30,XREL,BACT16  OTHER OPER 
 ZERODIV  INSTTAB   ZRX,ZER,NUL,BASEZR,L=30,XREL,BACT16   ON REG. STACK 
 NGOUTR   INSTTAB  NGX,NEG,NUL,BONERR,L=30,XREL,BACT16
 ZROUTR   INSTTAB  ZRX,ZER,NUL,BONERR,L=30,XREL,BACT16
 ZRJUMP   INSTTAB   ZRX,ZER,NUL,NAUGHT,L=30,PREL,BACT03 
 SUB1     INSTTAB  MON,NUL,NUL,MINUS1,L=30,NREL,BACT27
 SUBSCSUB INSTTAB   ISB,NUL,NUL,NAUGHT,L=15,NREL,BACT14 
 SUBSCMUL INSTTAB   FMP,NUL,NUL,NAUGHT,L=15,NREL,BACT15 
 TRANSMIT INSTTAB   XMT,SIX,NUL,NAUGHT,L=15,NREL,BACT16 
 SB6AI    INSTTAB  BAB,SIX,NUL,NAUGHT,L=15,NREL,BACT16
SB7AI     INSTTAB   BAB,SEV,NUL,NAUGHT,L=15,NREL,BACT16 
*                                  BASCOMP.4875 
 SAIB7    INSTTAB  ABB,NUL,SEV,NAUGHT,L=15,NREL,BACT02
 SETX12K  INSTTAB XBK,ONE,TWO,NAUGHT,L=30,NREL,BACT04 
 SETX6B5  INSTTAB  XBB,SIX,FEM,NAUGHT,L=15,NREL,BACT06
 SETB5X5  INSTTAB  BXB,FEM,FEM,NAUGHT,L=15,NREL,BACT06
 SETB6XPA INSTTAB SBX,SIX,FEM,NAUGHT,L=30,PREL,BACT18 
 SETB5X6  INSTTAB BXB,FEM,SIX,NAUGHT,L=15,NREL,BACT06 
 TESTB6B5 INSTTAB GEB,SIX,FEM,BONERR,L=30,XREL,BACT06 
          EJECT 
* 
*                    OP  I   J    K     L   REL   ACT 
* 
 SETLINNO INSTTAB   NUL,NUL,NUL,NAUGHT,L=15,NREL,BACT17  OPERATIONS NOT 
 SETLINEX INSTTAB   ABK,NUL,NUL,NAUGHT,L=30,NREL,BACT26 
 SETX4POS INSTTAB   XBK,FUR,NUL,PLUSON,L=30,NREL,BACT06   INVOLVING 
 SETX4NEG INSTTAB   MSK,FUR,SEV,THREEE,L=15,NREL,BACT06 
 SETX4ZER INSTTAB   MSK,FUR,NUL,NAUGHT,L=15,NREL,BACT06   REGISTER STACK
 SX6GOSUB INSTTAB  XBB,SIX,TRE,NAUGHT,L=15,NREL,BACT06
 SETX6ZER INSTTAB  MSK,SIX,NUL,NAUGHT,L=15,NREL,BACT06
 SETX5ZER INSTTAB  MSK,FEM,NUL,NAUGHT,L=15,NREL,BACT06
* 
*   DO NOT CHANGE POSITION OF THE FOLLOWING FOUR ENTRIES. 
* 
 SETXIPOS INSTTAB XBK,NUL,NUL,PLUSON,L=30,NREL,BACT02 
 SETXINEG INSTTAB MSK,NUL,SEV,THREEE,L=15,NREL,BACT02 
 SETXIZER INSTTAB MSK,NUL,NUL,NAUGHT,L=15,NREL,BACT02 
 SETXIMZ  INSTTAB MSK,NUL,SEV,FOUR,L=15,NREL,BACT02 
 SETX0POS INSTTAB  XBK,NUL,NUL,PLUSON,L=30,NREL,BACT06
 SETX0ZER INSTTAB  MSK,NUL,NUL,NAUGHT,L=15,NREL,BACT06
 SB6POS   INSTTAB  BBK,SIX,NUL,PLUSON,L=30,NREL,BACT06
 SB6ZRO   INSTTAB  BBK,SIX,NUL,NAUGHT,L=30,NREL,BACT06
 SB7ZRO   INSTTAB  BBK,SEV,NUL,NAUGHT,L=30,NREL,BACT06
 SB6B2K   INSTTAB  BBK,SIX,TWO,NAUGHT,L=30,NREL,BACT04
 SETB6LIM INSTTAB   BBK,SIX,NUL,GOSBLM,L=30,NREL,BACT06 
 SX6A5    INSTTAB  XAB,SIX,FEM,NAUGHT,L=15,NREL,BACT06
 SB6TOP   INSTTAB  BBK,SIX,NUL,NAUGHT,L=30,NREL,BACT04
 STOREPAR  INSTTAB   ABK,SIX,SIX,BSPARM,L=30,XREL,BACT6A
 SX6B4M1  INSTTAB  XBK,SIX,FUR,MINUS1,L=30,NREL,BACT06
 INCREAB3 INSTTAB   BBK,TRE,TRE,PLUSON,L=30,NREL,BACT06 
 DECREAB3 INSTTAB   BBK,TRE,TRE,MINUS1,L=30,NREL,BACT06 
 RETERTST INSTTAB   LTB,TRE,NUL,BASERT,L=30,XREL,BACT06 
 SETX6RET INSTTAB   XBK,SIX,NUL,NAUGHT,L=30,PREL,BACT18 
 TESTB3B6 INSTTAB   GEB,TRE,SIX,BASEGS,L=30,XREL,BACT06 
 GOSUBJMP INSTTAB   EQB,NUL,NUL,NAUGHT,L=30,PREL,BACT19 
 JUMPTOB6 INSTTAB   JMP,SIX,NUL,NAUGHT,L=30,NREL,BACT6F 
 GOTOJUMP INSTTAB   JMP,NUL,NUL,NAUGHT,L=30,PREL,BACT19 
 OUTR     INSTTAB   JMP,NUL,NUL,BONERR,L=30,XREL,BACT6F 
 EQ119    INSTTAB  JMP,NUL,NUL,MISERR,L=30,XREL,BACT6E
 CALLTOPU INSTTAB   RTJ,NUL,NUL,NAUGHT,L=30,PREL,BACT19 
 CALLTOPS INSTTAB   RTJ,NUL,NUL,NAUGHT,L=30,XREL,BACT4F 
 LABELDEF INSTTAB   NUL,NUL,NUL,NAUGHT,L=15,NREL,BACT20 
 ENTRYLIN INSTTAB   JMP,NUL,NUL,NAUGHT,L=30,NREL,BACT6F 
 REGRES   INSTTAB   NUL,NUL,NUL,NAUGHT,L=15,NREL,BACT24 
 RELEATOP INSTTAB   NUL,NUL,NUL,NAUGHT,L=15,NREL,BACT21 
 CLEARB7  INSTTAB   BBB,SEV,NUL,NAUGHT,L=15,NREL,BACT06 
 CLLEGEN   INSTTAB   EQB,NUL,NUL,BSEGEN,L=30,XREL,BACT6E
 RJOCON   INSTTAB  RTJ,NUL,NUL,BSTOCON,L=30,XREL,BACT6E 
 NULLTOPU INSTTAB  ABK,FEM,FUR,NAUGHT,L=30,NREL,BACT18
 SETB5FET INSTTAB   BBK,FEM,FUR,NAUGHT,L=30,NREL,BACT04 
 RJSTRST   INSTTAB   RTJ,NUL,NUL,BSTASTR,L=30,XREL,BACT6E 
 RJSTRCM   INSTTAB   RTJ,NUL,NUL,BASTRCM,L=30,XREL,BACT6E 
 RJOSRT    INSTTAB   RTJ,NUL,NUL,BSTOSRT,L=30,XREL,BACT6E 
 RJOMRGN   INSTTAB   RTJ,NUL,NUL,BSTOMGN,L=30,XREL,BACT6E 
 RJISRT    INSTTAB   RTJ,NUL,NUL,BSTISRT,L=30,XREL,BACT6E 
 RJIRD0    INSTTAB   RTJ,NUL,NUL,BSTIRD0,L=30,XREL,BACT6E 
 RJOWR0    INSTTAB   RTJ,NUL,NUL,BSTOWR0,L=30,XREL,BACT6E 
 RJINPUT   INSTTAB   RTJ,NUL,NUL,BSTIINP,L=30,XREL,BACT6E 
 RJSINPT   INSTTAB   RTJ,NUL,NUL,BSTINPT,L=30,XREL,BACT6E 
 SB7STBF   INSTTAB   BBK,SEV,NUL,STRBUF,L=30,XREL,BACT6A
 RJENDINP  INSTTAB   RTJ,NUL,NUL,BSTIEND,L=30,XREL,BACT6E 
 RJIRED    INSTTAB   RTJ,NUL,NUL,BSTIRED,L=30,XREL,BACT6E 
 RJIREW   INSTTAB  RTJ,NUL,NUL,BSTIREW,L=30,XREL,BACT6E 
 RJINOD   INSTTAB  RTJ,NUL,NUL,BSTINOD,L=30,XREL,BACT6E 
 RJAPPND  INSTTAB  RTJ,NUL,NUL,BSTAPPN,L=30,XREL,BACT6E 
 RJEJMP   INSTTAB  RTJ,NUL,NUL,BSTEJMP,L=30,XREL,BACT6E 
 RJERR    INSTTAB  RTJ,NUL,NUL,BSTERR,L=30,XREL,BACT6E
 RJERS    INSTTAB  RTJ,NUL,NUL,BSTERS,L=30,XREL,BACT6E
 RJCHAN   INSTTAB  RTJ,NUL,NUL,BSTCHAN,L=30,XREL,BACT6E 
 RJTRC    INSTTAB  RTJ,NUL,NUL,BSETRC,L=30,XREL,BACT6E
 RJTRC1   INSTTAB  RTJ,NUL,NUL,BSETCP,L=30,XREL,BACT6E
 RJTON    INSTTAB  RTJ,NUL,NUL,BSETON,L=30,XREL,BACT6E
 RJTOF    INSTTAB  RTJ,NUL,NUL,BSETOF,L=30,XREL,BACT6E
 REFETCH  INSTTAB   ABK,NUL,TWO,NAUGHT,L=30,NREL,BACT25 
 SETXSTR  INSTTAB   XBK,NUL,NUL,PLUSON,L=30,NREL,BACT06 
 SETXNUM  INSTTAB   XBK,NUL,NUL,NAUGHT,L=30,NREL,BACT06 
 RJRDCHK  INSTTAB   RTJ,NUL,NUL,BRDCHK,L=30,XREL,BACT6F 
 RJIDLST   INSTTAB   RTJ,NUL,NUL,BSTIDEL,L=30,XREL,BACT6E 
 RJOCSV    INSTTAB   RTJ,NUL,NUL,BSTACSV,L=30,XREL,BACT6E 
 RJOCVS    INSTTAB   RTJ,NUL,NUL,BSTACVS,L=30,XREL,BACT6E 
 RJOFET    INSTTAB   RTJ,NUL,NUL,BSTOFET,L=30,XREL,BACT6E 
 RJOFFT    INSTTAB   RTJ,NUL,NUL,BSTOFFT,L=30,XREL,BACT6E 
 RJOCLO    INSTTAB   RTJ,NUL,NUL,BSTOCLO,L=30,XREL,BACT6E 
 RJOSET    INSTTAB   RTJ,NUL,NUL,BSTOSET,L=30,XREL,BACT6E 
 RJOSETF   INSTTAB   RTJ,NUL,NUL,BSTOSETF,L=30,XREL,BACT6E
 READSTR  INSTTAB   BXB,SEV,NUL,FOUR,L=15,NREL,BACT16 
 RJOUSI    INSTTAB   RTJ,NUL,NUL,BSTOUSI,L=30,XREL,BACT6E 
 RJOPRO    INSTTAB   RTJ,NUL,NUL,BSTOPRO,L=30,XREL,BACT08 
 RJCALL    INSTTAB   RTJ,NUL,NUL,BSCALL,L=30,XREL,BACT6E
 RJRAN    INSTTAB  RTJ,NUL,NUL,BSTRAN,L=30,XREL,BACT6E
 JPCALL   INSTTAB  JMP,NUL,NUL,BSECAL,L=30,XREL,BACT6F
 SA5EXT   INSTTAB   ABK,FEM,NUL,NAUGHT,L=30,CREL,BACT06 
 DTALOD   INSTTAB  ABK,FEM,NUL,DATAX,L=30,XREL,BACT06 
 DTARST   INSTTAB  AAK,FEM,FEM,PLUSON,L=30,NREL,BACT06
 SX6X5    INSTTAB  XMT,SIX,FEM,FEM,L=15,NREL,BACT06 
INCREAA4 INSTTAB AAK,FUR,FUR,PLUSON,L=30,NREL,BACT06
FETCHPAR INSTTAB AXB,FEM,FUR,TWOTWO,L=15,NREL,BACT06
POINTA4  INSTTAB ABK,FUR,FUR,NAUGHT,L=30,NREL,BACT04
 RJSTRCN  INSTTAB  RTJ,NUL,NUL,BSTCN,L=30,XREL,BACT08 
 SB1DATA  INSTTAB  BBK,ONE,NUL,NAUGHT,L=30,PREL,BACT06
 SB4CONS  INSTTAB  BBK,FUR,NUL,NAUGHT,L=30,PREL,BACT06
 SB2VARS  INSTTAB  BBK,TWO,NUL,NAUGHT,L=30,PREL,BACT06
 SX4INPB  INSTTAB XBK,FUR,NUL,NAUGHT,L=30,PREL,BACT06 
 SX5COLL  INSTTAB XBK,FEM,NUL,NAUGHT,L=30,NREL,BACT06 
 JPSTRT   INSTTAB  JMP,NUL,NUL,NAUGHT,L=30,PREL,BACT6F
 JPDBUG   INSTTAB  JMP,NUL,NUL,NAUGHT,L=30,PREL,BACT6F
 DBLN     INSTTAB  RTJ,NUL,NUL,DBUGLN,L=30,XREL,BACT6E
 RJRSTR   INSTTAB  RTJ,NUL,NUL,BSTRSTR,L=30,XREL,BACT6E 
 INTLD    INSTTAB ABK,ONE,NUL,INTFLG,L=30,XREL,BACT6A 
 INTJP    INSTTAB NGX,NEG,ONE,BATTN,L=30,XREL,BACT6A
 RJATTN   INSTTAB RTJ,NUL,NUL,BSATN,L=30,XREL,BACT6E
 RJATNN   INSTTAB RTJ,NUL,NUL,BSANN,L=30,XREL,BACT6E
 ROUNDADD INSTTAB   RAD,NUL,NUL,NAUGHT,L=15,NREL,BACT07 
 BXIPZRO  INSTTAB   BDF,NUL,NUL,NAUGHT,L=15,NREL,BACT30 
 SXPT5    INSTTAB   XBK,NUL,NUL,17174B,L=30,NREL,BACT02 
 SHFTLT   INSTTAB   LSC,NUL,NUL,55B,L=15,NREL,BACT28
 RJANSR   INSTTAB RTJ,NUL,NUL,BSANSR,L=30,XREL,BACT6E 
 RJANSL   INSTTAB RTJ,NUL,NUL,BSANSL,L=30,XREL,BACT6E 
 NOPS     INSTTAB  BBK,NUL,NUL,NAUGHT,L=30,NREL,BACT6F
 MX7DBOF  INSTTAB  MSK,SEV,NUL,NAUGHT,L=15,NREL,BACT06
 MX7DBON  INSTTAB  MSK,SEV,NUL,PLUSON,L=15,NREL,BACT06
 SB7PD    INSTTAB  BBK,SEV,NUL,NAUGHT,L=30,NREL,BACT06
 ASOFF    INSTTAB  MSK,SIX,NUL,NAUGHT,L=15,NREL,BACT06
 ASON     INSTTAB  MSK,SIX,NUL,PLUSON,L=15,NREL,BACT06
 STARTUP  INSTTAB  RTJ,NUL,NUL,BASSRT,L=30,XREL,BACT6F
 SB3ZERO  INSTTAB  BBK,TRE,NUL,NAUGHT,L=30,NREL,BACT06
          EJECT 
          TITLE     STACKS
* 
*   STACKS FOR COMPILE
* 
 SEQNO    DATA   0                 LINE NUMBER
 LANDST   EQU       NOANDENT*ANDINCR    LENGTH OF ANDSTACK
 LTORST   EQU       NOTORENT*TORINCR    LENGTH OF TORSTACK
* 
 FORPTR   DATA      0                   TOP OF ANDSTACK FOR FOR 
*     DURING PROCESSING OF A GLOBAL -IF R...- 
*     STATEMENT, THE EXTERNAL VALUE OF FORPTR 
*     IS SAVED AND FORPTR ASSUMES A VALUE  WHICH HAS
*     MEANING FOR STACK MANAGEMENT WITHIN THE GLOBAL
*     IF STATEMENT. 
 SVDFOR   BSSZ   1
* 
 ANDSTACK EQU    SVDFOR+1 
 TORSTACK EQU    ANDSTACK+LANDST
 CHARBUF  EQU    TORSTACK+LTORST
 PRE0     MX6    0
          SA5    TOST              INITIAL TORSTACK ENTRY 
          BX7    X5 
          SA6    FORPTR 
          SA7    TORSTACK 
          EQ     BSC1 
 TOST     VFD    12/1777B,30/7777777777B,18/TORUNFL 
          EJECT 
          SPACE  5
**        SET UP INPUT FET FOR BASIC EXECUTION
  
 PRSP     PS     0
          SA1    IBFLG       INTERACTIVE-BATCH FLAG 
          SA2    =L*BASIC$* 
          BX6    X1-X2
          SA6    A1          IBFLG-- 0=BATCH,-1=RUN,BASIC,1=SYSTEM BATCH
          ZR     X6,PRSP3         IF *BATCH*
          SX6    B1 
          SA3    ACTR 
          NZ     X3,PRSP.1   SYSTEM BATCH 
          MX6    59 
 PRSP.1   BSS    0
          MX5    42 
          SA6    A1 
          SA1    IOPTION
          SX3    B1 
          LX3    18 
          SX6    INPTFET     INTERNAL FET ADDRESS 
          SA4    X6+B1       IN 
          BX7    X4+X3       ENTER L FIELD
          SA7    A4 
          BX3    X5*X1
          NZ     X3,PRSP2    IF NAME SUPPLIED 
          SA3    =L*INPUT*
 PRSP2    SX4    B1 
          BX7    X3+X4
          SA7    X6 
          BX7    X3+X6
          SA7    A1 
          SA3    IBFLG
          PL     X3,PRSP5    SYSTEM BATCH 
          SA3    =L*INPUT*
          BX7    X3 
          SA7    JOPTION     FORCE NAME *INPUT* IN INTERACTIVE
          BX7    X7-X7
          SA7    LOPTION     CLEAR LOPTION
          SA7    A7+B1       SLOPTION 
          SA7    A7+B1       OLOPTION 
          SA7    A7+B1       BLOPTION 
          SA7    A7+B1       TROPTION 
          SA7    A7+B1       PDOPTION 
          SA7    A7+B1       PSOPTION 
          SA7    A7+B1       ELOPTION 
          SA7    A7+B1       GOOPTION 
          SA7    A7+B1       ERRORFL
          SA3    =L*OUTPUT* 
          BX7    X3 
          SA7    KOPTION
          SA7    EOPTION
          SA1    XOPTION
          ZR     X1,PRSP5 
           MX7   60          SET NO-GO
          SA1   DBFLG       FETCH CID MODE FLAG 
          ZR    X1,PRSP2A   BR, NOT IN CID MODE FLAG
          SX7   1           SET GO OPTION IN CID MODE 
 PRSP2A   SA7   GOOPTION    SAVE GO OPTION
          EQ     PRSP5
 PRSP3    BSS    0
          SA1    EOPTION
          SA2    IOPTION
          BX7    X2 
          BX6    X1 
          SA6    ERRFET 
          SA7    INPTFET
 PRSP5    SA1    IOPTION
          MX3    42 
          MX2    6
          LX2    24 
          SX4    1R 
          LX4    12          POSITION BLANK 
          BX1    X3*X1
          BX6    X4 
 PRSP6    BX0    X2*X1
          NZ     X0,PRSP7    IF NAME BLANK FILLED 
          LX4    6
          BX6    X6+X4       ENTER BLANK
          LX2    6
          EQ     PRSP6       LOOP TO JUSTIFY BLANKS 
 PRSP7    BX6    X6+X1       ENTER NAME 
          SA1    IOPTION
          SA2    =L*INPUT*
          BX1    X1-X2
          BX1    X3*X1
          ZR     X1,PRSP8    INPUT FILE NAME IS *INPUT* 
          SX0    2R 
          BX7    X6+X0
          SA7    ERRHDR+1 
 PRSP8    BSS    0
          SX0    2R-- 
          BX6    X6+X0       FORM FINAL MESSAGE 
          SA6    EXECUTE     STORE IN MESSAGE 
          EQ     PRSP        THIS MESSAGE CLEARS MESSAGE BUFFER 
* 
* 
* 
          EJECT 
* 
*         PROCEDURE PREPARE 
* 
 PREPARE  BSSZ      1 
          SA4    F.TEND            END OF TABLES
          SA5    LM                START OF TABLES
          IX6    X4-X5             SPACE AVAILABLE FOR TABLES 
          SX7    X6-NUMBVAR-NUMLBLS-NUMBFUN*2-BUFFLGT-BUFFERL 
          PL     X7,PREP1          IF ENOUGH MEMORY 
          BX0    -X7               EXTRA WANTED 
          RJ     MEMUP             ASK FOR MEMORY 
           PL      X0,PREP0          ADDITIONAL SPACE GRANTED 
           CALLERR BERR5
PREP0      BSS     0
          SA5    FIELDLG
          SX6    X5-3 
          SA6    F.TEND            RESET END
 PREP1    BSS    0                 BEGIN TABLE ALLOCATION 
          SA5    LM                ALLOCATE FIXED SYMBOL TABLE
          SX6    X5 
          SX7    X5+NUMBVAR        RESET START OF TABLES
          SA7    A5 
          SA6    F.IDS
          RJ     MTU               INITIALIZE MANAGED TABLES
          RJ     MTD
          SB7    CHARBUF     FWA OF CHARACTER  BUFFER 
          SX6       B0
          SA6    ONANDIF
          SA6       ERRORFL 
          SA6    WARNFL 
          SA6    INSTPTR           PRESET INSTRUCTION COUNTER 
 PREPAR7  BSS    0                                                       BAS0014
          SX6       GOSBLM              MAKE ROOM FOR GOSUB-STACK 
          SA6    VARCONT
          SA6       PRENTRY 
         AX5       1          MIDDLE BETWEEN LABLPTR
         IX6       X5+X1      AND INSTPTR 
          MX6    0
          SA6    SEQNO             CLEAR LINE NUMBER
          BX6    X6-X6
          SA6       BASE        STOREIN BASE
          ALLOC  CODE,1000B 
          ALLOC  CONS,400B
          ALLOC  LABS,400B
          MX6    0
          SA6    L.CODE            INITIALIZE CODE TABLE LENGTH 
          SA6    L.CONS            AND CONSTANTS TABLE LENGTH 
          SX6    40B               PRESET L.LABS TO INCLUDE THE 
          SA6    L.LABS            HASH INDEX 
          ALLOC  FUNS,NUMBFUN*2 
          ZERO   F.LABS,NUMLBLS 
          ZERO   F.IDS,NUMBVAR
          ZERO   F.FUNS,NUMBFUN*2 
          MX1    59                -1 
          ADDWRD CONS,X1
*                                                                        BAS0014
          SA3    IBFLG                                                   BAS0014
          NG   X3,PREP4            JUMP IF RUN,BASIC                     BAS0014
          MX6    42                                                      BAS0014
          SA1    LOPTION                                                 BAS0014
          BX1    X6*X1                                                   BAS0014
          SA2    EOPTION                                                 BAS0014
          BX2    X6*X2                                                   BAS0014
          BX1    X1-X2                                                   BAS0014
          ZR   X1,PREP4            JUMP IF EFILE .EQ.LFILE               BAS0014
          SX1    ERRFET            SET FET ADDR IN EOPTION               BAS0014
          BX7    X1+X2                                                   BAS0014
          SA7    EOPTION                                                 BAS0014
          BX7    X2                SET UP EFILE FET                      BAS0014
          SX2    1                                                       BAS0014
          BX7    X7+X2             NAME, COMPLETE BIT                    BAS0014
          SA7    X1                STORE IN FET                          BAS0014
          SB5    X1                KEEP FET ADDR IN B5                   BAS0014
          SA1    B5+FETFRST        SET LENGTH FIELD FOR OPEN             BAS0014
          LX2    18                                                      BAS0014
          BX6    X1+X2                                                   BAS0014
          SA6    A1                                                      BAS0014
          OPEN   B5,ALTERNR,R      OPEN THE FILE                         BAS0014
          SA1    B5                CLEAR STATUS BITS IN FET              BAS0014
          MX2    17                                                      BAS0014
          LX2    18                                                      BAS0014
          BX6    -X2*X1                                                  BAS0014
          SA6    B5                                                      BAS0014
          SA1    B5+FETFRST        CHECK IF INTERACTIVE                  BAS0014
          MX2    DEVTYPL                                                 BAS0014
          BX2    X2*X1                                                   BAS0014
          LX2    DEVTYPL                                                 BAS0014
          SX2    X2-DEVTYP3        TERMINAL TYPE                         BAS0014
          NZ   X2,PREP4            JUMP IF NOT INTERACTIVE               BAS0014
          MX7    1                 SET INTERACTIVE BIT IN FETSTAT        BAS0014
          SA1    B5+FETSTAT                                              BAS0014
          LX7    19                                                      BAS0014
          BX6    X7+X1                                                   BAS0014
          SA6    A1                                                      BAS0014
 PREP4    BSS    0                                                       BAS0014
  
  
  
**        SEPARATE BUFFERS ARE PROVIDED FOR *INPUT* 
**        AND *OUTPUT* IN ORDER TO ELLIMINATE 
**        UNNECESSARY JOB ROLLOUTS WHEN RUNNING 
**        FROM THE TERMINAL.
  
* 
*         DECLARE *OUTPUT* FILE FET 
* 
          SA1    IBFLG             INTERACTIVE-BATCH FLAG 
          SX7    BUFFERL
          ZR     X1,PREPAR2 
          SX7    KBUF0       LENGTH OF TTY *OUTPUT* 
 PREPAR2  SA7    ROPTION
          SA5    KOPTION
          MX2    18 
          AX5       18
          RJ        DECLBUF             DECLARE BUFFER FOR FILE NO 0
          SA2    F.CONS            START CONSTANTS
          SA1       X2
          IX1       X1+X2 
          SA1       X1+FETSTAT
          SB2    WRITFUN
          PX6    X1,B2       SET TO WRITE 
         SA6       A1 
* 
*         DECLARE *INPUT* FILE FET
* 
          SA1    IBFLG       INTERACTIVE/BATCH FLAG 
          SX7    BUFFERL     BATCH INPUT BUFFER LENGTH
          ZR     X1,PREPAR3  BATCH MODE 
*         WE TEST TO SEE IF B OPTION (XOPTION) SPECIFIED. 
*         IF SO, THE INPUT BUFFER SIZE IS THE SIZE REQUIRED FOR 
*         BATCH BECAUSE WE CANNOT KNOW AT COMPILATION TIME WHETHER
*         THE EXECUTION TIME INPUT WILL BE OBTAINED FROM A TERMINAL 
*         OR A FILE.
*         WE ALSO USE BATCH SIZE BUFFER IF A J FILE SPECIFIED 
*         (THIS IS TRUE ALSO FOR THE CASE OF J=INPUT AND JOB
*         IS EXECUTED INTERACTIVELY, ALTHOUGH A SMALLER BUFFER WOULD SUF
*         IN THIS CASE).
          SA1    XOPTION
          NZ     X1,PREPAR3  BRANCH TO USE BATCH BUFFER SIZE
          SA1    JOPTION
          NZ     X1,PREPAR3  BRANCH TO USE BATCH BUFFER SIZE
          SX7    KBUFLGT     LENGTH OF TTY *INPUT*
 PREPAR3  SA7    ROPTION
          SA5    JOPTION
          MX2    18 
          AX5    18 
          RJ     DECLBUF     DECLARE BUFFER FOR FILE NO 1 
          SA2    F.CONS            START CONSTNATS
          SA1    X2 
          IX3    X1+X2
          SA3    X3+FETCHAN  POINTER TO NEXT FET
          IX1    X2+X3       ADDRESS OF INPUT FET 
          SA1    X1+FETSTAT 
          SA4    IBFLG
          ZR     X4,PREPAR4  IF *BATCH* MODE
          SX7    BUFFERL
          SA7    ROPTION           SET BUFFER LENGTH FOR FILE I-O 
 PREPAR4  BSS    0
          SB2    READFUN
          PX6    X1,B2       SET TO READ
          SA6    A1 
          SA1    XOPTION
          ZR     X1,PRE5           IF COMPILE TO CORE 
          OUTINS EQ119             GENERATE EQ =XER119
          RJ     OUTWORD
          OUTINS EQ119             GENERATE EQ =XER119
          RJ     OUTWORD
          SA5    JPSTRT            SET TO JUMP TO START+2 
          SX7    2
          LX7    30 
          IX6    X7+X5
          SA6    A5 
          MX7    0                 RESET ERROR ADDRESS
          SA7    ERMAD
 PRE5     SA1    ASOPTION 
          ZR     X1,PRE6
          SA1    IOPTION
          SA1    X1+FETLINL 
          IX6    X1+X1
          SA6    A1 
          SA1    LOPTION
          ZR     X1,PRE6
          SA1    A1+1 
          SA1    X1+FETLINL 
          IX6    X1+X1
          SA6    A1 
 PRE6     SA3    DBFLG
         NZ    X3,PRE0       BR, CID MODE 
         SA3   DBOPTION      GENERATE NORMAL MODE PROLOGE 
          LX4    X3,B1
          BX3    X4*X3
          SA1    MX7DBOF
 +        PL     X3,*+1            IF NO DB 
          SA1    MX7DBON
          RJ     OUTINS            GENERATE MX7 
          SA3    ASOPTION 
          SA1    ASOFF
 +        ZR     X3,*+1 
          SA1    ASON 
          RJ     OUTINS            GENERATE MX6 
          OUTINS SB3ZERO
          SA3    PDOPTION 
          LX3    30+6 
          SA1    SB7PD
          IX1    X3+X1
          RJ     OUTINS            GENERATE SB7 PD
          OUTINS STARTUP           GENERATE RJ =XBASESRT
          EQ     PRE0 
* 
* 
  
 PREPAR5  BSS    0
          MESSAGE MSGABT,0,R
         EQ        BASEXIT              AFTER MESSAGE SENT,ABORT RUN
MSGABT    DATA   C*FIELD LENGTH TOO SHORT FOR BASIC. *                  006010
 PREPSAV  BSS    1                                                       BAS0014
* 
* 
* 
*         END PREPARE 
* 
          TITLE  DBID - CHECK FOR IMPLICIT DEBUG ENVIRONMENT
*     CHECK FOR IMPLICIT DEBUG(ON) OR DEBUG.
 LWORD    DATA   0                 STS PARAMETER BLOCK
 DB.ON    EQU    34  DEBUG ON BIT IN LOADER CONTROL WORD W.CPLDR1 
 DBDEFT   VFD    60/04000000000000000000B   DB=ID 
 BINDEFT  VFD    60/0L_ZZZZZDC     RELOCATABLE FILE NAME
 GODEFT   VFD    60/1              GO OPTION DEFAULT
* 
 DBID     BSSZ   1
          SA1    DBOPTION 
          LX1    3
          MX6    1
          PL     X1,DBID1          BR, CHECK FOR EXPLICIT DB=0
          SA6    DBFLG             SET DEBUG MODE FLAG
          JP     DBID              AND EXIT 
 DBID1    BSS    0
*                                  VIA A DB=0 OR A GO=0 PARAMETER 
* 
          SA1    LWORD
          MX6    59 
          BX6    X6*X1
          SA6    A1 
* 
*     STS REQUEST  X=5  RETURNS BYTES 0-3 OF LOADER CONTROL 
*                       WORD W.CPLDR1 TO ADDR 
* 
*                 ADDR  BITS 59-12 = W.CPLDR1 BITS 59-12
*                       BITS 11-01 = UNCHANGED
* 
          GETLC LWORD 
          SA1    LWORD             FETCH STS STATUS WORD
          LX1    59-DB.ON 
          PL     X1,DBID           BR, NOT IN DEBUG MODE
          SA1    DBOPTION 
          LX1    4           CHECK DB=0 BIT 
          NG     X1,DBID2    BR, DB=0 
* 
          MX6    1
          SA6    DBFLG             SET DEBUG MODE FLAG
* 
          SA1    DBDEFT            FORCE DB=ID
          SA2    DBOPTION    FETCH ANY USER SELECTED DB OPTIONS 
          IX6    X1+X2       ADD USER SELECTED DB OPTIONS 
          SA6    A2          AND SAVE IN DBOPTION 
 DBID2      BSS         0 
          SA1    XOPTION           CHECK FOR B OPTION 
          NZ     X1,DBID           BR, USER SET B OPTION
          SA2    BINDEFT           FORCE B=ZZZZZDC
          BX6    X2 
          SA6    A1 
 DBGO     BSS    0
          SA1    GOOPTION          CHECK FOR USER DECLARED GO 
          NZ     X1,DBID           BR, USER SET GO OPTION 
          SA2    GODEFT            FORCE GO OPTION
          BX6    X2 
          SA6    A1 
          JP     DBID 
* 
         EJECT
* 
          IFC    EQ,,"OS.NAME",SCOPE ,
 CHKASC   BSSZ   1
          SA1    IOPTION
          SB5    X1 
          SA3    B5 
          MX4    42 
          BX6    X4*X3             FILENAME 
          SA2    FETSTAT+B5 
          UX2    X2,B6
          SX2    B6+1 
          BX6    X6+X2
          SA6    B5 
          READ   B5,R 
          SA1    ASMASK            76007600760076007600B
          SA2    FETOUT+B5
          SA2    X2                FIRST WORD 
          BX1    X1*X2             IS IT ASCII
          SX6    1
          ZR   X1,CHKASC1          YES IT IS
          SX6    B0 
          SA6    ASCII
          EQ     CHKASC 
 CHKASC1  BSS    0
          SA6    ASCII
          SA1    LOPTION
          ZR     X1,CHKASC4  NO LFILE 
          SA1    SLOPTION 
          SA2    OLOPTION 
          BX1    X1+X2
          SB5    X1 
          SA2    B5+FETSTAT 
          LX2    59-18       INTERACTIVE BIT
          NG     X2,CHKASC2  INTERACTIVE SO NO PD WORD REQUIRED 
          SA1    PDOPTION 
          ZR     X1,CHKASC3  NO PD OPTION 
          SX2    1
          BX6    X1+X2
          LX6    54          ASCII PD WORD
          SA1    B5+FETIN 
          SA6    X1-1 
          EQ     CHKASC3
 CHKASC2  BSS    0
          SA1    B5+FETSETV 
          MX6    1
          LX6    23          BIT 22 = ASCII-95 MODE 
          BX7    X1+X6
          SA7    A1 
          SA1    B5+FETFRST 
          LX6    20          BIT 42 FOR ASCII 
          BX7    X6+X1
          SA7    A1 
 CHKASC3  BSS    0
          SA1    EOPTION
          SA2    LOPTION
          BX1    X1-X2
          BX1    X4*X1
          ZR     X1,CHKASC   LFILE .EQ. EFILE SO EXIT 
 CHKASC4  BSS    0
          SA1    EOPTION
          SB5    X1 
          SA1    B5+FETSTAT 
          LX1    59-18       INTERACTIVE BIT
          PL     X1,CHKASC   NOT INTERACTIVE SO EXIT
          SA1    B5+FETSETV 
          MX7    1
          LX7    23          BIT 22 = ASCII-95 MODE 
          BX6    X1+X7
          SA6    A1 
          SA1    FETFRST+B5 
          LX7    20          BIT 42 FOR ASCII 
          BX6    X7+X1
          SA6    A1 
          EQ     CHKASC 
 ASMASK   DATA   76007600760076007600B
* 
          ENDIF 
* 
* 
*        END OF CHARACTER BUFFER FOR INPUT
* 
          BSS    CHARBUF-*+UNPBUFL+3
* 
*        FET FOR INPUT
* 
 INPTFET  SETCHAN (VFD  42/5LINPUT,18/1),READFUN,INST10+KBUFLGT,INPLNGT,
,UNPBUFL/10,UNPBUFL-UNPBUFL/10*10,101 
* 
*        FET FOR TERMINAL 
* 
*        FET FOR OUTPUT WHEN L IS ONLY LIST OPTION USED 
 ERRFET   SETCHAN (VFD 42/6LOUTPUT,18/1),WRITFUN,INST10,KBUFLGT,15,0,0
* 
* 
 ERRHDR   DATA   C*1 PROGRAM BASICXX   ERROR LIST*
 ERRHDR1  DATA   0L0
          USE    OVER 
 INST10   BSS    0
* 
*        INSTRUCTION STACK STARTS HERE
* 
 INST     EQU    INST10+KBUFLGT+INPLNGT 
 MEML     EQU    INST 
* 
* 
          TITLE    COMPILER EQUATES 
* 
* 
* 
*   SYMBOL CLASSES FOR READ 
* 
 LCLASSIN EQU    1000B
 LCLASS0  EQU    0000B
 LCLASS1  EQU    LCLASS0+LCLASSIN      OPERATOR 
 LCLASSGT EQU    LCLASS1+LCLASSIN               GO TO 
 LCLASS1N EQU    LCLASSGT+LCLASSIN              LOG NOT 
 LCLASS2  EQU    LCLASS1N+LCLASSIN     RIGHT PAREN
 LCLASS3  EQU    LCLASS2+LCLASSIN      EOS
 LCLASS4  EQU    LCLASS3+LCLASSIN      EOL
 LCLASS5  EQU    LCLASS4+LCLASSIN      TOR ACC. UNA 
 LCLASS6  EQU    LCLASS5+LCLASSIN      LEFT P (EXC ARTH)
 LCLASS7  EQU    LCLASS6+LCLASSIN      LEFT PAR ART 
 LCLASS7S EQU    LCLASS7+LCLASSIN  LEFT PAR FOR SUBSCRIPTED SUBSTRING 
 LCLASS10 EQU    LCLASS7S+LCLASSIN STAT VERB
 LCLASS11 EQU    LCLASS10+LCLASSIN      END STOP ETC
 LCLASS12 EQU    LCLASS11+LCLASSIN     I/O
 LCLASSCL EQU    LCLASS12+LCLASSIN
 LCLASSIL EQU    LCLASSCL+LCLASSIN
 LCLASS1U EQU    LCLASSIL+LCLASSIN     USING
 LCLSKIP  EQU    LCLASS1U+LCLASSIN     PR NULL     PRNULL CORR. 
 LCLASS13 EQU    LCLSKIP+LCLASSIN     VAR - SYSFUN
 LCLASS14 EQU    LCLASS13+LCLASSIN     VAR - USEFUN 
 LCLASS15 EQU    LCLASS14+LCLASSIN     VAR - MATFUN 
 LCLASS16 EQU    LCLASS15+LCLASSIN     VAR - MATOPR 
 LCLASS17 EQU    LCLASS16+LCLASSIN     STRING 
 LCLASS20 EQU    LCLASS17+LCLASSIN     VAR - SIMPLE 
 LCLASS2S EQU    LCLASS20+LCLASSIN     VAR - STRING 
 LCLASS21 EQU    LCLASS2S+LCLASSIN     CON - REAL 
 LCLASS22 EQU    LCLASS21+LCLASSIN     CON - INT
 LCLASS23 EQU    LCLASS22+LCLASSIN     FILE ID
 LCLASS24 EQU    LCLASS23+LCLASSIN     SYSTEM STRING
 LCLASS25 EQU    LCLASS24+LCLASSIN     LEN DIS ETC
 LCLASS26 EQU    LCLASS25+LCLASSIN     STR ETC
 LCLASS27 EQU    LCLASS26+LCLASSIN     SUBSTR 
 LCLASS28 EQU    LCLASS27+LCLASSIN     VAR PARAM FUNC 
 LCLASS29 EQU    LCLASS28+LCLASSIN     DET FUNCTION 
 LCLASS30 EQU    LCLASS29+LCLASSIN EXTERNAL NAME (CALL) 
 LCLASS31 EQU    LCLASS30+LCLASSIN        SPECIAL FN (CLK,ASC)
 LCLASS32 EQU    LCLASS31+LCLASSIN      TAB                              BAS0018
 LCLASS33 EQU    LCLASS32+LCLASSIN RND FUNCTION 
 SUBSTART EQU       LCLASS13
 FUNSTART EQU       LCLASS14            START OF FUNCTIONS
 MFUSTART EQU       LCLASS15            START OF MAT FUNCTIONS
 MOPSTART EQU       LCLASS16            START OF MAT-OP FUNCTIONS 
 STRSTART EQU       LCLASS17            START OF STRINGS
 IDSTART  EQU       LCLASS20            START OF IDENTIFIERS
 NUMSTART EQU       LCLASS21            START OF NUMBERS
 FILSTART EQU       LCLASS23            START OF FILE IDENTIFIERS 
 MINIDENT EQU       LCLASS13
 ANDSTART EQU       IDSTART             START OF OPERANDS 
* 
*  EQU-TABLE FOR CHTAB
* 
 LX0      EQU       2000B 
 LXA      EQU       2000B+LA-LA 
LXB      EQU       2000B+LB-LA
 LXC      EQU       2000B+LC-LA 
 LXD      EQU       2000B+LD-LA 
 LXE      EQU       2000B+LE-LA 
 LXF      EQU       2000B+LF-LA 
 LXG      EQU       2000B+LG-LA 
 LXI      EQU       2000B+LI-LA 
 LXJ      EQU    2000B+LJ-LA
 LXL      EQU       2000B+LL-LA 
 LXM      EQU    2000B+LMA-LA 
 LXN      EQU       2000B+LN-LA 
 LXO      EQU       2000B+LO-LA 
 LXP      EQU       2000B+LP-LA 
 LXR      EQU       2000B+LR-LA 
 LXS      EQU       2000B+LS-LA 
 LXT      EQU       2000B+LT-LA 
 LXU      EQU    2000B+LU-LA
 LXV      EQU    2000B+LV-LA
* 
 LXW      EQU       2000B+LW-LA 
 LXZ      EQU       2000B+LZ-LA 
 LX?      EQU       2000B+LSL-LA
 LX=      EQU       2000B+LEQ-LA
 LX<      EQU       2000B+LLT-LA
 LX>      EQU       2000B+LGT-LA
LXSTARS  EQU       2000B+LSTARS-LA
 LIQUO    EQU       LLQUO-CHTAB 
 LIEOS    EQU       LLEOS-CHTAB 
 LISEMI   EQU       LLSEM-CHTAB 
 LICOMM   EQU       LLCOM-CHTAB 
 LIDELP   EQU    LLDELPR-CHTAB     DELIMIT STMT LFT PAREN 
 LIFIL    EQU       LLFIL-CHTAB 
LIUSI    EQU       LLUSI-CHTAB
 LIBAD    EQU    LLBAD-CHTAB       BAD ESCAPE CODE
 LITHE    EQU    LLTHE-CHTAB       -THEN- PSEUDO
 LIELS    EQU    LLELS-CHTAB      -ELSE- PSEUDO 
 LIALPA  EQU        1RA*11-1RA*11+IDSTART 
 LIALPB  EQU        1RB*11-1RA*11+IDSTART 
 LIALPC  EQU        1RC*11-1RA*11+IDSTART 
 LIALPD  EQU        1RD*11-1RA*11+IDSTART 
 LIALPE  EQU        1RE*11-1RA*11+IDSTART 
 LIALPF  EQU        1RF*11-1RA*11+IDSTART 
 LIALPG  EQU        1RG*11-1RA*11+IDSTART 
 LIALPH  EQU        1RH*11-1RA*11+IDSTART 
 LIALPI  EQU        1RI*11-1RA*11+IDSTART 
 LIALPJ  EQU        1RJ*11-1RA*11+IDSTART 
 LIALPK  EQU        1RK*11-1RA*11+IDSTART 
 LIALPL  EQU        1RL*11-1RA*11+IDSTART 
 LIALPM  EQU        1RM*11-1RA*11+IDSTART 
 LIALPN  EQU        1RN*11-1RA*11+IDSTART 
 LIALPO  EQU        1RO*11-1RA*11+IDSTART 
 LIALPP  EQU        1RP*11-1RA*11+IDSTART 
 LIALPQ  EQU        1RQ*11-1RA*11+IDSTART 
 LIALPR  EQU        1RR*11-1RA*11+IDSTART 
 LIALPS  EQU        1RS*11-1RA*11+IDSTART 
 LIALPT  EQU        1RT*11-1RA*11+IDSTART 
 LIALPU  EQU        1RU*11-1RA*11+IDSTART 
 LIALPV  EQU        1RV*11-1RA*11+IDSTART 
 LIALPW  EQU        1RW*11-1RA*11+IDSTART 
 LIALPX  EQU        1RX*11-1RA*11+IDSTART 
 LIALPY  EQU        1RY*11-1RA*11+IDSTART 
 LIALPZ  EQU        1RZ*11-1RA*11+IDSTART 
* 
*  EQU-TABLE FOR STATE TABLE
* 
 STA0     EQU       0*8                 AFTER OPERATOR
 STA1     EQU       1*8                 AFTER OPERAND (AFTER ) ONLY)
 STA2     EQU       2*8                 AFTER END-OF-STATEMENT
 STA3     EQU       3*8                 AFTER TOR ACCEPTING UNARY 
 STA4     EQU       4*8                 AFTER VARIABLE
 STA5     EQU       5*8                 EXPECTING LINE NUMBER 
 STA6     EQU       6*8                 ERROR STATE 
* 
*  ERROR ENTRIES IN STATE TABLE 
* 
 SEA6     EQU       -6                  ENTRY FOR ERROR STATE 
* 
 SE01     EQU       STATERR-STERR01 
 SE02     EQU       STATERR-STERR02 
 SE03     EQU       STATERR-STERR03 
 SE04     EQU       STATERR-STERR04 
 SE05     EQU       STATERR-STERR05 
 SE06     EQU       STATERR-STERR06 
 SE07     EQU       STATERR-STERR07 
 SE08     EQU       STATERR-STERR08 
 SE09     EQU       STATERR-STERR09 
 SE10     EQU       STATERR-STERR10 
 SE11     EQU       STATERR-STERR11 
 SE12     EQU       STATERR-STERR12 
 SE13     EQU       STATERR-STERR13 
 SE14     EQU       STATERR-STERR14 
 SE15     EQU       STATERR-STERR15 
 SE16     EQU       STATERR-STERR16 
 SE17     EQU       STATERR-STERR17 
 SE18     EQU       STATERR-STERR18 
 SE19     EQU       STATERR-STERR19 
 SE20     EQU       STATERR-STERR20 
 SE21     EQU       STATERR-STERR21 
 SE22     EQU       STATERR-STERR22 
 SE23     EQU       STATERR-STERR23 
 SE24     EQU       STATERR-STERR24 
 SE25     EQU       STATERR-STERR25 
 SE26     EQU       STATERR-STERR26 
 SE27     EQU       STATERR-STERR27 
 SE28     EQU       STATERR-STERR28 
 SE29     EQU       STATERR-STERR29 
 SE30     EQU       STATERR-STERR30 
 SE31     EQU       STATERR-STERR31 
 SE32     EQU       STATERR-STERR32 
 SE33     EQU       STATERR-STERR33 
 SE34     EQU       STATERR-STERR34 
 SE35     EQU       STATERR-STERR35 
 SE36     EQU       STATERR-STERR36 
 SE37     EQU       STATERR-STERR37 
 SE38     EQU       STATERR-STERR38 
 SE39     EQU       STATERR-STERR39 
 SE40     EQU       STATERR-STERR40 
 SE41     EQU       STATERR-STERR41 
 SE42     EQU       STATERR-STERR42 
 SE43     EQU       STATERR-STERR43 
 SE44     EQU       STATERR-STERR44 
 SE45     EQU       STATERR-STERR45 
 SE46     EQU       STATERR-STERR46 
 SE47     EQU       STATERR-STERR47 
 SE48     EQU       STATERR-STERR48 
 SE49     EQU       STATERR-STERR49 
 SE50     EQU       STATERR-STERR50 
 SE51     EQU       STATERR-STERR51 
 SE52     EQU       STATERR-STERR52 
 SE53     EQU       STATERR-STERR53 
 SE54     EQU       STATERR-STERR54 
 SE55     EQU       STATERR-STERR55 
 SE56     EQU       STATERR-STERR56 
 SE57     EQU       STATERR-STERR57 
 SE58     EQU       STATERR-STERR58 
 SE59     EQU       STATERR-STERR59 
 SE60     EQU       STATERR-STERR60 
 SE61     EQU       STATERR-STERR61 
 SE62     EQU       STATERR-STERR62 
 SE63     EQU       STATERR-STERR63 
 SE64     EQU       STATERR-STERR64 
 SE65     EQU       STATERR-STERR65 
 SE66     EQU       STATERR-STERR66 
 SE67     EQU       STATERR-STERR67 
 SE68     EQU       STATERR-STERR68 
 SE69     EQU       STATERR-STERR69 
 SE70     EQU       STATERR-STERR70 
 SE71     EQU       STATERR-STERR71 
 SE72     EQU       STATERR-STERR72 
 SE73     EQU       STATERR-STERR73 
 SE74     EQU       STATERR-STERR74 
 SE75     EQU       STATERR-STERR75 
 SE76     EQU       STATERR-STERR76 
 SE77     EQU       STATERR-STERR77 
 SE78     EQU       STATERR-STERR78 
 SE79     EQU       STATERR-STERR79 
 SE80     EQU       STATERR-STERR80 
SE81     EQU       STATERR-STERR81
SE82     EQU       STATERR-STERR82
SE83     EQU       STATERR-STERR83
SE84     EQU       STATERR-STERR84
 SE85     EQU    STATERR-STERR85
* 
*  EQU-S FOR OPERAND HANDLING 
* 
*   KINDS 
* 
 SIMKND   EQU       0 
 ARRKND   EQU       1 
 STKIND   EQU       2 
 SFKIND   EQU       3 
 UFKIND   EQU       4 
 MFKIND   EQU       5 
 MOKIND   EQU       6 
 LHSKND   EQU       7 
 RELKND   EQU       10B 
 CONKND   EQU       SIMKND
 FILKND   EQU       11B 
 SVKIND   EQU       12B 
 SFSVKND  EQU    SFKIND 
 SYSTKND  EQU    13B               SYSTEM SUPPLIED STRING (CLOCK ETC) 
 LOGKND   EQU    14B
* 
 SFVSKND  EQU    15B
 SFSSKND  EQU    16B
 SVARKND EQU     17B         STRING VARIABLE ARRAY KIND 
 EXTKND   EQU    20B
 TABKIND  EQU    21B               TAB                                   BAS0018
* 
*   CLASSES 
* 
*  FOLLOWING SYMBOLS ARE USED AS INDEX IN FETCH.
*  CHANGE ONLY WITH CARE
 VINS     EQU       0 
 VINX     EQU       VINS+1
 AINX     EQU       VINX+1
 VINXS    EQU       AINX+1
 AINXS    EQU       VINXS+1 
 CONST    EQU       AINXS+1 
 AINS     EQU       CONST+1 
 INT      EQU       AINS+1
 SINS     EQU       INT+1 
 FUN      EQU       SINS+1
 AINX1    EQU    FUN+1             SUBSCRIPTED STR VAR
 VIS      EQU       VINS
 CON      EQU       CONST 
 CLASSINC EQU       VINXS-VINX
* 
*  EQU-TABLES FOR READ CONTROL TABLES 
* 
* 
*  SUBCLASS FOR STACK ACTIONS 
* 
 LXNOSET  EQU       10B 
* 
 LXUNP    EQU       00B                 UNARY + 
 LXUNM    EQU       00B                 UNARY - 
*  FOLLOWING VALUES FOR PLUS, MINUS, STAR ARE USED AS AN INDEX
*  BY MAT CODE,  CHANGE ONLY WITH CARE. 
 LXPLU    EQU       06B                 + 
 LXMIN    EQU       07B                 - 
 LXSTA    EQU       05B                 * 
 LXSLA    EQU       00B                 / 
 LXPOW    EQU       00B                 ' 
 LXTHE    EQU       00B                 THEN
 LXELS    EQU    76B           ELSE 
 LXSTE    EQU       01B                 STEP
 LXTOX    EQU       00B                 TO
 LXRPA    EQU       02B                 ) 
 LXEOS    EQU    77B
 LXEOL    EQU       00B                 EOL 
 LXEOP    EQU       00B                 EOP 
 LXEQU    EQU       01B                 = 
 LXLTE    EQU       LTLTE-LTEQU+LXEQU   @ 
 LXLTH    EQU       LTLTH-LTEQU+LXEQU   < 
 LXGTE    EQU       LTGTE-LTEQU+LXEQU   \ 
 LXGTH    EQU       LTGTH-LTEQU+LXEQU   > 
 LXNEQ    EQU       LTNEQ-LTEQU+LXEQU   NOT=
 LXAND    EQU       02B 
 LXNOT    EQU       01B 
 LXOR     EQU       03B 
 LXPND    EQU    6
*  FOLLOWING VALUES FOR COMMA, SEMI ARE USED AS AN INDEX
*  BY PRINT CODE, CHANGE ONLY WITH CARE.
 LXCOM    EQU       01B                 , 
LXSEM    EQU       03B                  SEMI COLON
 LXCLN    EQU    0
 LXCOL    EQU    11B               COLON AFTER OPERAND FOR ANSI SUBSTR
 LXLFN    EQU       00B                 (FUN
 LXLSB    EQU    16B               (SUBRTN - SUBROUTINE LEFT PAREN
 LXLSBT   EQU    0                 (TAB                                  BAS0018
 LXVP     EQU    0
 LXLSV    EQU    00B               (STRING TO REAL EG LEN,DIS ETC 
 LXLVS    EQU    00B               (REAL TO STR EG STR ETC
 LXLSX    EQU    00B               (STRING TO STRING EG SUBSTR ETC
*  FOLLOWING USED AS INDEX AT LACTMAE 
 LXLMF    EQU       03B                 (MATFUN 
 LXLMO    EQU       00B                 (MATOP
 LXLSS    EQU       03B                 (SUBSCR 
 LXSSV    EQU    0                 LEFT PAR FOR ANSI SUBSTR AFTER LSS 
 LXLDT    EQU    12B
 LXLAR    EQU       04B                 (ARITH
 LXLCL    EQU    0                 (CALL
 LXAPP    EQU    00B
 LXCAL    EQU    0                 CALL 
 LXCHG    EQU    00B
 LXCLO    EQU    4           CLOSE
 LXCLT    EQU    00B         COLLATE
 LXCHN    EQU    0                 CHAIN
LXBAS    EQU       00B
 LXDEF    EQU       00B                 DEF 
 LXDEL    EQU    00                DELIMIT
 LXDIM    EQU       00B                 DIM 
 LXDAT    EQU       00B                 DATA
 LXEND    EQU       00B                 END 
 LXERR    EQU    6
 LXERGO   EQU    00B
 LXFOR    EQU       00B                 FOR 
 LXFND    EQU    0                 FNEND
 LXGOT    EQU       00B                 GOTO
 LXGOS    EQU       00B                 GOSUB 
 LXIFX    EQU       00B                 IF
 LXIFM      EQU  0
 LXIFE      EQU  0
 LXINP    EQU       04B                 INPUT 
 LXJMP    EQU    00B
 LXLET    EQU       00B                 LET 
 LXMAT    EQU       00B                 MAT 
 LXMAR    EQU    00B
 LXNAT    EQU    00B         NATIVE 
 LXNEX    EQU       00B                 NEXT
 LXNOD    EQU       00B                 NODATA
 LXONG    EQU       00B 
 LXONN    EQU       00B                 ON
 LXOPT    EQU    00B         OPTION 
 LXPRI    EQU       02B                 PRINT 
 LXREM    EQU       LXNOSET             REM 
 LXREA    EQU       03B                 READ
 LXRET    EQU       00B                 RETURN
 LXRES    EQU       00B                 RESTORE 
 LXSET    EQU    00                SET (DIGITS) 
 LXSTD    EQU    00B         STANDARD 
 LXSTO    EQU       00B                 STOP
 LXUSI    EQU    5
 LXWRT    EQU       05B                 WRITE 
 LXFIL    EQU       04B                 FILE
 LXFILE   EQU    0                 FILE STMT
 LXDIG    EQU    1
 LXRAN    EQU    00B               RANDOMIZE
 LXAPO    EQU    77B
* 
*  POINTERS TO OPERATOR TABLE 
* 
 LUNP     EQU       LTUNP-LTOROUT 
 LUNM     EQU       LTUNM-LTOROUT 
 LPLU     EQU       LTPLU-LTOROUT 
 LMIN     EQU       LTMIN-LTOROUT 
 LSTA     EQU       LTSTA-LTOROUT 
 LSLA     EQU       LTSLA-LTOROUT 
 LPOW     EQU       LTPOW-LTOROUT 
 LEQU     EQU       LTEQU-LTOROUT 
 LLTH     EQU       LTLTH-LTOROUT 
 LLTE     EQU       LTLTE-LTOROUT 
 LGTH     EQU       LTGTH-LTOROUT 
 LGTE     EQU       LTGTE-LTOROUT 
 LNEQ     EQU       LTNEQ-LTOROUT 
 LAND     EQU       LTAND-LTOROUT 
 LNOT     EQU       LTNOT-LTOROUT 
 LOR      EQU       LTOR-LTOROUT
 LCLN     EQU    LTCLN-LTOROUT
* 
 LPRU     EQU    LTPRU-LTOROUT
 LPRV     EQU    LTPRV-LTOROUT
 LSTR     EQU       LTSTR-LTOROUT 
 LLFN     EQU       LTLFN-LTOROUT 
 LCFN     EQU    LTCFN-LTOROUT
 LNPF     EQU    LTNPF-LTOROUT     USER FUNCTION
 LLSB     EQU       LTLSB-LTOROUT 
 LLSBT    EQU    LTLSBT-LTOROUT    (TAB                                  BAS0018
 LVPF     EQU    LTVP-LTOROUT 
 LFUNP    EQU    LTFUNP-LTOROUT     DUMMY FOR VPF 
 LLSV     EQU    LTLSV-LTOROUT
 LLVS     EQU    LTLVS-LTOROUT
 LLSX     EQU    LTLSX-LTOROUT
 LLSY     EQU    LTLSY-LTOROUT
 LLSZ     EQU    LTLSZ-LTOROUT
 LST2     EQU    LTST2P-LTOROUT 
 LLMF     EQU       LTLMF-LTOROUT 
 LLMO     EQU       LTLMO-LTOROUT 
 LLMX     EQU    LTLMX-LTOROUT
 LLAR     EQU       LTLAR-LTOROUT 
 LLCL     EQU    LTLCL-LTOROUT     (CALL
 LLDI     EQU       LTLDI-LTOROUT 
 LDEL     EQU    LTDEL-LTOROUT
 LDEL1    EQU    LTDEL1-LTOROUT                  DELIMIT
 LDEL2    EQU    LTDEL2-LTOROUT                  DELIMIT
 LLDE     EQU       LTLDE-LTOROUT 
 LCDE     EQU    LTCDE-LTOROUT
 LLSS     EQU       LTLSS-LTOROUT 
 LLSC     EQU       LTLSC-LTOROUT 
 LRDE     EQU       LTRDE-LTOROUT 
 LSSC     EQU       LTSSC-LTOROUT 
 LRSC     EQU       LTRSC-LTOROUT 
 LRDI     EQU       LTRDI-LTOROUT 
 LREE     EQU       LTREE-LTOROUT 
 LFAS     EQU       LTFAS-LTOROUT 
 LFIE     EQU    LTFIE-LTOROUT
 LFCMA    EQU    LTFCMA-LTOROUT 
 LFIND1 EQU LTFIND1-LTOROUT 
 LFOE     EQU       LTFOE-LTOROUT 
 LMAE     EQU       LTMAE-LTOROUT 
 LDEE     EQU       LTDEE-LTOROUT 
 LBEG     EQU       LTBEG-LTOROUT 
 LSET     EQU       LTSET-LTOROUT 
 LTHE     EQU       LTTHE-LTOROUT 
 LELS     EQU    LTELSE-LTOROUT 
 LSTE     EQU       LTSTE-LTOROUT 
 LTOX     EQU       LTTOX-LTOROUT 
 LAPP     EQU    LTAPP-LTOROUT         APPEND 
 LAPQ     EQU    LTAPQ-LTOROUT         APPEND 
 LCAL     EQU    LTCAL-LTOROUT     CALL 
 LCHN     EQU    LTCHN-LTOROUT     CHAIN
 LCHN1    EQU    LTCHN1-LTOROUT    CHAIN1 
LBAS     EQU       LTBAS-LTOROUT
 LCHG     EQU    LTCHG-LTOROUT     CHANGE 
 LCHGV    EQU    LTCHGV-LTOROUT    CHANGE 
 LCHGS    EQU    LTCHGS-LTOROUT    CHANGE 
 LCLO     EQU    LTCLO-LTOROUT
 LCLO1    EQU    LTCLO1-LTOROUT 
 LCLT     EQU    LTCLT-LTOROUT  COLLATE 
 LDIM     EQU       LTDIM-LTOROUT 
 LDAT     EQU       LTDAT-LTOROUT 
 LFILE    EQU    LTFIL-LTOROUT
 LNPT     EQU    LTINP-LTOROUT
 LIN1     EQU       LTIN1-LTOROUT 
 LREA     EQU       LTREA-LTOROUT 
 LRDF     EQU       LTRDF-LTOROUT 
 LRE2     EQU       LTRE2-LTOROUT 
 LRF2     EQU       LTRF2-LTOROUT 
 LFOR     EQU       LTFOR-LTOROUT 
 LIFX     EQU       LTIFX-LTOROUT 
 LIF2     EQU    LTIFE2-LTOROUT 
 LIF3     EQU    LTIFM2-LTOROUT 
 LIF4     EQU    LTIFE3-LTOROUT 
 LIF5     EQU    LTIFM3-LTOROUT 
 LIFM     EQU    LTIFM-LTOROUT
 LIFE     EQU    LTIFEND-LTOROUT
 LLET     EQU       LTLET-LTOROUT 
 LIN2     EQU       LTIN2-LTOROUT 
 LNAT     EQU    LTNAT-LTOROUT  NATIVE
 LNOD     EQU       LTNOD-LTOROUT 
 LNO1     EQU       LTNO1-LTOROUT 
 LMAT     EQU       LTMAT-LTOROUT 
 LMAR     EQU    LTMAR-LTOROUT     MARGIN 
 LMAR1    EQU    LTMAR1-LTOROUT 
 LDEF     EQU       LTDEF-LTOROUT 
 LPRI     EQU       LTPRI-LTOROUT 
 LPR1     EQU       LTPR1-LTOROUT 
 LPR2     EQU       LTPR2-LTOROUT 
 LEND     EQU       LTEND-LTOROUT 
 LFND     EQU    LTFND-LTOROUT
 LJMP     EQU    LTJMP-LTOROUT
 LONG     EQU       LTONG-LTOROUT 
 LONGS1   EQU    LTONGS1-LTOROUT
 LONGS2   EQU    LTONGS2-LTOROUT
 LOND     EQU       LTOND-LTOROUT 
 LGOS     EQU       LTGOS-LTOROUT 
 LNEX     EQU       LTNEX-LTOROUT 
 LONN     EQU       LTONN-LTOROUT 
 LONERGO  EQU    LTONERG-LTOROUT
 LONELBL  EQU    LTNELBL-LTOROUT
 LOPT     EQU    LTOPT-LTOROUT  OPTION
 LREM     EQU       LTREM-LTOROUT 
 LRET     EQU       LTRET-LTOROUT 
 LRES     EQU       LTRES-LTOROUT 
 LREW     EQU       LTREW-LTOROUT 
 LSDG     EQU    LTSDG-LTOROUT
 LSTDIG   EQU    LTSTDIG-LTOROUT
 LSTD     EQU    LTSTD-LTOROUT  STANDARD
 LSTO     EQU       LTSTO-LTOROUT 
 LSETF    EQU    LTSETF-LTOROUT        SET-FILE TOR 
 LWRT     EQU       LTWRT-LTOROUT 
 LWR2     EQU       LTWR2-LTOROUT 
 LWR3     EQU       LTWR3-LTOROUT 
 LMCL     EQU       LTMCL-LTOROUT 
 LDET     EQU    LTDET-LTOROUT
 LMRD     EQU       LTMRD-LTOROUT 
 LMRF     EQU       LTMRF-LTOROUT 
 LMIP     EQU       LTMIP-LTOROUT 
 LMIF     EQU       LTMIF-LTOROUT 
 LMX1     EQU       LTMX1-LTOROUT 
 LMX2     EQU       LTMX2-LTOROUT 
 LMWR     EQU       LTMWR-LTOROUT 
 LMWF     EQU       LTMWF-LTOROUT 
 LMW1     EQU       LTMW1-LTOROUT 
 LMPR     EQU       LTMPR-LTOROUT 
 LMPF     EQU       LTMPF-LTOROUT 
 LMP1     EQU       LTMP1-LTOROUT 
 LMPU     EQU    LTMPU-LTOROUT
 LMPV     EQU    LTMPV-LTOROUT
 LSSV     EQU    LTSSV-LTOROUT
 LLDT     EQU    LTLDT-LTOROUT
 LSBT     EQU    LTSBT-LTOROUT
 LSUB     EQU    LTSUB-LTOROUT
 LRDSUB   EQU    LTRDSUB-LTOROUT
 LLSUB    EQU    LTLSUB-LTOROUT 
 LRAN     EQU    LTRAN-LTOROUT
 LILLEG   EQU       LSILLEG-LTORIN+LCLASSIL 
 LILLEG3  EQU       LSILLEG3-LTORIN+LCLASSIL
 LILLEG4  EQU       LSILLEG4-LTORIN+LCLASSIL
 LILLEG5  EQU       LSILLEG5-LTORIN+LCLASSIL
 LILLEG6  EQU       LSILLEG6-LTORIN+LCLASSIL
* 
*  OUTPUT VALUES
* 
 LVEOB    EQU       100B                  EOB 
 LVUNP    EQU       LSUNP-LTORIN+LCLASS0  UNARY + 
 LVUNM    EQU       LSUNM-LTORIN+LCLASS0  UNARY - 
 LVPLU    EQU       LSPLU-LTORIN+LCLASS1  + 
 LVMIN    EQU       LSMIN-LTORIN+LCLASS1  - 
 LVSTA    EQU       LSSTA-LTORIN+LCLASS1  * 
 LVSLA    EQU       LSSLA-LTORIN+LCLASS1  / 
 LVPOW    EQU       LSPOW-LTORIN+LCLASS1  ' 
 LACTGOT  EQU    LACTTHE
 LVTHE    EQU    LSTHE-LTORIN+LCLASSGT
 LVELSE   EQU    LSELSE-LTORIN+LCLASSGT 
 LVSTE    EQU       LSSTE-LTORIN+LCLASS5  STEP
 LVTOX    EQU       LSTOX-LTORIN+LCLASS5  TO
 LVRPA    EQU       LSRPA-LTORIN+LCLASS2  ) 
 LVFIL    EQU       LSFIL-LTORIN+LCLASS5  FILE
*         LVFILE SERVES AS ENTRY FOR THE FILE STATEMENT 
 LVFILE   EQU    LSFILE-LTORIN+LCLASS10 
 LVDIG    EQU    LSDIG-LTORIN+LCLASS12
 LVEOS    EQU       LSEOS-LTORIN+LCLASS3  EOS 
 LVEOL    EQU       LSEOL-LTORIN+LCLASS4  EOL 
 LVEOP    EQU       LSEOP-LTORIN+LCLASS4  EOP 
 LVEQU    EQU       LSEQU-LTORIN+LCLASS5  = 
 LVLTE    EQU       LSLTE-LTORIN+LCLASS5  @ 
 LVLTH    EQU       LSLTH-LTORIN+LCLASS5  < 
 LVGTE    EQU       LSGTE-LTORIN+LCLASS5  \ 
 LVGTH    EQU       LSGTH-LTORIN+LCLASS5  > 
 LVNEQ    EQU       LSNEQ-LTORIN+LCLASS5  NOT=
 LVAND    EQU       LSAND-LTORIN+LCLASS1
 LVNOT    EQU       LSNOT-LTORIN+LCLASS1N 
 LVOR     EQU       LSOR-LTORIN+LCLASS1 
 LVCOM    EQU       LSCOM-LTORIN+LCLASS5  , 
LVSEM    EQU       LSSEM-LTORIN+LCLASS5 SEMI COLOM
 LVCLNF   EQU    LSCLNF-LTORIN+LCLASS5      FILE STMT : EQU = 
 LVCLN    EQU    LSCLN-LTORIN+LCLASS10      FORMAT (COLON)
 LVCOL    EQU    LSCOL-LTORIN+LCLASS5 SUBSTRING COLON 
 LVLFN    EQU       LSLFN-LTORIN+LCLASS6  (FUN
 LVLSB    EQU       LSLSB-LTORIN+LCLASS6  (SUBRTN 
 LVLSBT   EQU    LSLSBT-LTORIN+LCLASS6         (TAB                      BAS0018
 LVLVP    EQU    LSVP-LTORIN+LCLASS6   VAR PAR FUN
 LVSYS    EQU    LSILLEG7-LTORIN+LCLASSIL  PAREN AFTER NO PARAM FNS 
 LVLSV    EQU    LSLSV-LTORIN+LCLASS6            STR PARAM,REAL RESULT
 LVLVS    EQU    LSLVS-LTORIN+LCLASS6            REAL PAR,STRING RESULT 
 LVLSX    EQU    LSLSX-LTORIN+LCLASS6            MIXED PARS,STR RESULT
 LVLMF    EQU       LSLMF-LTORIN+LCLASS6  (MATFUN 
 LVLMO    EQU       LSLMO-LTORIN+LCLASS6  (MATOP
 LVLSS    EQU       LSLSS-LTORIN+LCLASS6  (SUBSCR 
 LVSSV    EQU    LSSSV-LTORIN+LCLASS7S  ( AFTER SUBSCRIPT FOR ANSI SUBST
 LVLDT    EQU    LSLDT-LTORIN+LCLASS6   DET(...)
 LVLAR    EQU       LSLAR-LTORIN+LCLASS7  (ARITH
 LVLCL    EQU    LSLCL-LTORIN+LCLASS6   (CALL 
 LVLARD   EQU    LSLARD-LTORIN+LCLASS7       ( FOR -DELIMIT- STMT ONLY
 LVAPP    EQU    LSAPP-LTORIN+LCLASS12           APPEND 
 LVBAS    EQU    LSBAS-LTORIN+LCLASS12    BASE
 LVCAL    EQU    LSCAL-LTORIN+LCLASS10  CALL
 LVCHN    EQU    LSCHN-LTORIN+LCLASS10  CHAIN 
 LVCHG    EQU    LSCHG-LTORIN+LCLASS10           CHANGE 
 LVCLO    EQU    LSCLO-LTORIN+LCLASS10           CLOSE
 LVCLT    EQU    LSCLT-LTORIN+LCLASS12    COLLATE 
 LVDEF    EQU       LSDEF-LTORIN+LCLASS10 DEF 
 LVDEL    EQU    LSDEL-LTORIN+LCLASS12           DELIMIT
 LVDIM    EQU       LSDIM-LTORIN+LCLASS10 DIM 
 LVDAT    EQU       LSDAT-LTORIN+LCLASS10 DATA
 LVEND    EQU    LSEND-LTORIN+LCLASS12
 LVERR    EQU    LSERR-LTORIN+LCLASS12           (ON) ERROR 
 LVERRGO  EQU    LSERRGO-LTORIN+LCLASS0 
 LVONATT  EQU    LCLASS12           ON ATTENTION
 LVFOR    EQU       LSFOR-LTORIN+LCLASS10 FOR 
 LVFND    EQU    LSFND-LTORIN+LCLASS11  FNEND 
 LVGOT    EQU    LVTHE
 LVONG    EQU       LSONG-LTORIN+LCLASS5
 LVGOS    EQU       LSGOS-LTORIN+LCLASS10 GOSUB 
 LVIFX    EQU       LSIFX-LTORIN+LCLASS10 IF
 LVMOR     EQU   LSIFM-LTORIN+LCLASS12
 LVINP    EQU       LSINP-LTORIN+LCLASS12 INPUT 
 LVJMP    EQU    LSJMP-LTORIN+LCLASS10           JUMP 
 LVLET    EQU       LSLET-LTORIN+LCLASS10 LET 
 LVMAT    EQU       LSMAT-LTORIN+LCLASS10 MAT 
 LVMGN    EQU    LSMGN-LTORIN+LCLASS12           MARGIN 
 LVNAT    EQU    LSNAT-LTORIN+LCLASSCL    NATIVE
 LVNEX    EQU       LSNEX-LTORIN+LCLASS10 NEXT
 LVONN    EQU       LSONN-LTORIN+LCLASS10 
 LVOPT    EQU    LSOPT-LTORIN+LCLASS10    OPTION
 LVPND    EQU    LSPND-LTORIN+LCLASS7     POUND SIGN
 LVPRI    EQU       LSPRI-LTORIN+LCLASS12 PRINT 
LVUSI    EQU       LSUSI-LTORIN+LCLASS1U
 LVRAN    EQU    LSRAN-LTORIN+LCLASS10          RANDOMIZE 
 LVREM    EQU       LSREM-LTORIN+LCLASS10 REM 
 LVREA    EQU       LSREA-LTORIN+LCLASS12 READ
 LVRET    EQU       LSRET-LTORIN+LCLASS11 RETURN
 LVRES    EQU       LSRES-LTORIN+LCLASS10 
 LVSET    EQU    LSSET-LTORIN+LCLASS10
 LVSTD    EQU    LSSTD-LTORIN+LCLASSCL    STANDARD
 LVSTO    EQU       LSSTO-LTORIN+LCLASS11 
 LVNOD    EQU       LSNOD-LTORIN+LCLASS10 
 LVWRI    EQU       LSWRI-LTORIN+LCLASS12 WRITE 
 LVABS    EQU       00B+LCLASS13        ABS 
 LVATN    EQU       01B+LCLASS13        ATN 
 LVCOS    EQU       02B+LCLASS13        COS 
 LVEXP    EQU       03B+LCLASS13        EXP 
 LVINT    EQU       04B+LCLASS13        INT 
 LVLOG    EQU       05B+LCLASS13        LOG 
 LVRND    EQU    06B+LCLASS33                   RND 
 LVSIN    EQU       07B+LCLASS13        SIN 
 LVSQR    EQU       10B+LCLASS13        SQR 
 LVTAN    EQU       11B+LCLASS13        TAN 
 LVSGN    EQU       12B+LCLASS13        SGN 
 LVCLK    EQU       13B+LCLASS13        CLK 
 LVTIM    EQU       14B+LCLASS13        TIM 
 LVLGT    EQU    16B+LCLASS13      LGT
 LVESL    EQU    17B+LCLASS13 
 LVESM    EQU    20B+LCLASS13 
 LVNXL    EQU    21B+LCLASS13 
 LVLOC    EQU    22B+LCLASS13                    LOC
 LVLOF    EQU    23B+LCLASS13                    LOF
 LVCOT    EQU    24B+LCLASS13      COT
 LVASL    EQU    25B+LCLASS13     ASL 
 LVINV    EQU    00B+LCLASS15      INV
 LVTRN    EQU       01B+LCLASS15        TRN 
 LVZER    EQU       00B+LCLASS16        ZER 
 LVCON    EQU       01B+LCLASS16        CON 
 LVIDN    EQU       02B+LCLASS16        IDN 
 LVCLCK   EQU    0B+LCLASS24       CLOCK
 LVDATE   EQU    1B+LCLASS24       DATE 
 LVUSR    EQU    2B+LCLASS24    USR$
 LVDIS    EQU    0B+LCLASS25       DIS
 LVLEN    EQU    1B+LCLASS25       LEN
 LVVAL    EQU    2B+LCLASS25       VAL
 LVSTR    EQU    0B+LCLASS26       STR
*  ABOVE ENTRY MUST BE FIRST ONE IN THIS CLASS
 LVCHR    EQU    01B+LCLASS26      CHR$ 
 LVSUB    EQU    0B+LCLASS27       SUBSTR 
 LVMAXF   EQU    00B+LCLASS28          MAX
 LVMINF   EQU    01B+LCLASS28          MIN
 LVROF    EQU    02B+LCLASS28          ROF
 LVSST    EQU    03B+LCLASS28          SUBSTR 
 LVLPD    EQU    05B+LCLASS28  LPAD$
 LVRPD    EQU    06B+LCLASS28  RPAD$
 LVLTR    EQU    07B+LCLASS28  LTRM$
 LVRTR    EQU    10B+LCLASS28  RTRM$
 LVORD    EQU    11B+LCLASS28  ORD
 LVUPR    EQU    12B+LCLASS28  UPRC$
 LVLWR    EQU    13B+LCLASS28  LWRC$
 LVPOS    EQU    14B+LCLASS28  POS
 LVSRE    EQU    15B+LCLASS28  SREP$
LVRPT     EQU    04B+LCLASS28          RPT$ 
 LVDET    EQU    0B+LCLASS29
** LVEXT  EQU    LCLASS30          EXTERNAL NAME
 LVCLK1   EQU    00B+LCLASS31      CLK,CLK$ (SPECIAL) 
 LVASC    EQU    01B+LCLASS31       ASC (SPECIAL) 
 LVTAB    EQU    LCLASS32          TAB                                   BAS0018
 LVAPO    EQU    LSAPO-LTORIN+LCLASS3 
* 
*  EQU-TABLE FOR OUTINS 
* 
*    OPCODES
* 
 RTJ      EQU       01B 
 JMP      EQU       02B 
 ZRX      EQU       03B 
 NZX      EQU       03B 
 PLX      EQU       03B 
 NGX      EQU       03B 
 ORX      EQU       03B 
 EQB      EQU       04B 
 NEB      EQU       05B 
 GEB      EQU       06B 
 LTB      EQU       07B 
 XMT      EQU       10B 
 BPR      EQU       11B 
 BSU      EQU       12B 
 BDF      EQU       13B 
 CMT      EQU       14B 
 BPM      EQU       15B 
 BSM      EQU       16B 
 BDM      EQU       17B 
LSC       EQU       20B 
 RSX      EQU    21B         AXI   JK 
 LSB      EQU       22B 
 NML      EQU       24B 
 UPK      EQU       26B 
 PAK      EQU       27B 
 FAD      EQU       30B 
 FSB      EQU       31B 
 RAD      EQU    34B         RXI   XJ+XK
 IAD      EQU       36B 
 ISB      EQU       37B 
 FMP      EQU       40B 
 MSK      EQU       43B 
 FDV      EQU       44B 
 AAK      EQU    50B
 ABK      EQU       51B 
 AXB      EQU       53B 
 ABB      EQU       56B 
 BBK      EQU       61B 
 SBX      EQU    62B
 BXB      EQU       63B 
 BAB      EQU       64B 
 BBB      EQU       66B 
 XAK      EQU    70B
 XBK      EQU       71B 
 MON      EQU       72B 
 XAB      EQU    75B
 XBB      EQU       76B 
* 
*   RELOCATION FIELD
*         ANY CHANGES IN THIS TABLE MUST BE REFLECTED IN RELJMP AND 
*         IN THE CORRESPONDING BASOPTS TABLE FOR THE ASSEMBLY LISTING.
* 
 NREL     EQU       0 
 PREL     EQU    NREL+1            PROGRAM RELOCATION 
 XREL     EQU    PREL+1            EXTERNAL RELOCATION
 CREL     EQU    XREL              CALL RELOCATION
* 
*   LENGTH FIELD
* 
 L=15     EQU       0 
 L=30     EQU       1 
* 
*   REGISTER NUMBERS
* 
 NUL      EQU       0 
 ONE      EQU       1 
 TWO      EQU       2 
 TRE      EQU       3 
 FUR      EQU       4 
 FEM      EQU       5 
 SIX      EQU       6 
 SEV      EQU       7 
* 
*   INSTRUCTION MODIFIERS (I-FIELD FOR 03-JUMPS)
* 
 UND      EQU       5         OUT OF RANGE (UNDEFINED)
 POS      EQU       2         POSITIVE
 ZER      EQU       0         ZERO
 NOZ      EQU       1         NONZERO 
 NEG      EQU       3         NEGATIVE
* 
*  KFIELDS
* 
 NAUGHT   EQU       0 
 PLUSON   EQU       1 
 TWOTWO   EQU       2 
 THREEE   EQU       3 
 FOUR     EQU       4 
 MINUS1   EQU       -1
*     SYMBOL TABLE USED FOR IF STATEMENT CHECKING 
 LSYMTBL   EQU    SYMTBLEN-SYMTBL 
* 
*  EXTERNAL SYMBOLS 
* 
         IFC       EQ,,"OS.NAME",KRONOS,                                000540
 BSCLBL  MICRO     1,,*BASIC$*                                          000550
         ELSE                                                           000560
 BSCLBL  MICRO     1,,*BASIC*                                           000570
         ENDIF                                                          000580
         END       "BSCLBL"                                             000590
