ASMB,R,Q,C
      HED <<RTE BASIC - SYNTAX/SEG #1>>       92076-1X002 REV.2040
      NAM BASC1,5 92076-1X002 REV.2040 800727 92076-16001 
* 
* 
* 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
* 
* 
* 
*      NAME:      BASC1 
*      SOURCE:    92076-18002 
*      RELOC:     PART OF 92076-16001 
*      PGMR:      B.J.L.
* 
* 
* 
************************************************************* 
* 
* 
      ENT BASC1 
      EXT PLIST,PEXMK,GETCR,LETCK,DIGCK,INTCK,MVTOH 
      EXT BCKSP,FNDPS,NUMCK,OUTER 
      EXT FCNS,FCNCT,SPEC1,SPTBL,SPNCT
      COM TEMPS(32),PNTRS(81),FILBF(16),FLDCB(144),SPEC(10) 
* 
*PNTRS INCREASED TO 81  800727**********************
*TEMPS INCREASED TO 32  800107**********************
*PNTRS INCREASED TO 79  790830********************************
*PNTRS INCREASED TO 80  791010********************************
* 
****************************************************
*                                                  *
*    SEGMENT #1: CHECK SYNTAX AND TRANSLITERATE    *
*                                                  *
****************************************************
* 
*  THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL 
*    WHENEVER A RECORD IS INPUT WITH A NUMBER AS THE FIRST CHAR. IT 
*    WILL CONVERT AN ASCII STATEMENT RECORD INTO THE SPECIAL BINARY 
*    CODE WHICH IS USED BY THE LIST AND EXECUTION SEGMENTS OF THE 
*    INTERPRETER. AFTER EACH STATEMENT IS PROCESSED, EXECUTION IS 
*    RETURNED TO THE MAIN CONTROL PROGRAM. THE GENERAL FORM OF THE
*    TRANSLITERATED CODE IS SHOWN BELOW:
* 
*       WORD #1 - LINE NUMBER 
*       WORD #2 - # WORDS IN TRANSLITERATED STATEMENT 
*       WORD #3 > WORD #N - OPERATORS, CONSTANTS, ETC.
      SKP 
*************************** 
*                         * 
* CONSTANTS AND VARIABLES * 
*                         * 
*************************** 
* 
FWAM  EQU PNTRS     FIRST WORD OF AVAILABLE MEMORY
LWBM  EQU PNTRS+1   LAST WORD OF AVAILABLE MEMORY 
.INBF EQU PNTRS+2   INPUT BUFFER ADDRESS
SBUFA EQU PNTRS+3   SYNTAX BUFFER ADDRESS 
SYMTA EQU PNTRS+4   START OF SYMBOL TABLE 
SYMTF EQU PNTRS+5   END OF SYMBOL TABLE 
PBUFF EQU PNTRS+6   FIRST WORD OF USER PROGRAM
PBPTR EQU PNTRS+7   LAST WORD+1 OF USER PROGRAM 
INBFA EQU PNTRS+8   INPUT BUFFER POINTER
ICCNT EQU PNTRS+9   INPUT CHARACTER COUNT 
SBPTR EQU PNTRS+10  SYNTAX BUFFER POINTER 
.LNUM EQU PNTRS+11  CURRENT LINE #
FCORE EQU PNTRS+12  START OF FREE CORE
MNNAM EQU PNTRS+13  MNEMONIC TABLE NAME:SC:LU 
BRNAM EQU PNTRS+18  BRANCH TABLE NAME:SC:LU 
FWAMM EQU PNTRS+23  POINTER TO START OF MNEMONIC TABLE
FWAMB EQU PNTRS+24  POINTER TO START OF BRANCH TABLE
.OTBF EQU PNTRS+25  POINTER TO OUTPUT BUFFER 
OCCNT EQU PNTRS+26  OUTPUT CHARACTER COUNT
OTBFA EQU PNTRS+27  POINTER INTO OUTPUT BUFFER
LUOUT EQU PNTRS+28  CURRENT OUTPUT L.U. # 
LUINP EQU PNTRS+29  CURRENT INPUT L.U. #
SIGN  EQU PNTRS+30  SIGN OF CURRENT NUMBER
BLANK EQU PNTRS+31  CURRENT TERMINATION CHAR
REC#  EQU PNTRS+32  COMMAND FILE RECORD NUMBER
FLTYP EQU PNTRS+33  TYPE 0 FILE FLAG
*******CHANGED FOR L USAGE OF GETST 790409***** 
TTYPR EQU PNTRS+34  CONSOLE LU OR FILENAME
TTYP1 EQU PNTRS+35  3RD AND 4TH CHAR
TTYP2 EQU PNTRS+36  5TH AND 6TH CHAR
TTYP3 EQU PNTRS+37  SECURITY CODE OF FILE 
TTYP4 EQU PNTRS+38  CRN # OF FILE 
************************************************
DCB   EQU PNTRS+39  DATA CONTROL BLOCK ADDRESS
FILBK EQU PNTRS+40  FILE CONTROL BLOCK ADDRESS
PFLAG EQU PNTRS+41  SAVE,LOAD FILE FLAG 
LOLIM EQU PNTRS+42  LOW LIMITS OF PROGRAM 
HILIM EQU PNTRS+43  HIGH LIMITS OF PROGRAM
LORUN EQU PNTRS+44  LOW RUN LIMITS
HIRUN EQU PNTRS+45  HIGH RUN LIMITS 
SLSTM EQU PNTRS+46  EXECUTE SLOW STMTS
LOTRC EQU PNTRS+47  LOW TRACE LIMITS
HITRC EQU PNTRS+48  HIGH TRACE LIMITS 
BRKP1 EQU PNTRS+49  BREAK POINT #1
BRKP2 EQU PNTRS+50  BREAK POINT #2
BRKP3 EQU PNTRS+51  BREAK POINT #3
BRKP4 EQU PNTRS+52  BREAK POINT #4
SMFLG EQU PNTRS+53  SIMULATE FLAG 
TYPE  EQU PNTRS+54  PARTIAL LINE CHARACTER COUNT
DLMTR EQU PNTRS+55  CHAR EDIT DELIMITER 
MERGF EQU PNTRS+56  MERGE FLAG
****************************790712******************************
COMN  EQU PNTRS+57  COMMAND FILE NAME:SC:CRN
MANT1 EQU PNTRS+62  MANTISSA #1 
MANT2 EQU PNTRS+63  MANTISSA #2 
EXPNT EQU PNTRS+64  EXPONENT
******************************CHANGED 790830***************************** 
******************************CHANGED 791010***************************** 
INNAM EQU PNTRS+65  NAME RTN. FROM CRETS (3 WORDS)
INNUM EQU PNTRS+68  SCRATCH FILE # AND COUNTER
HSTPT EQU PNTRS+69  HIGH-STACK POINTER
TSTPT EQU PNTRS+70  TEMPORARY STACK POINTER 
LSTPT EQU PNTRS+71  LOW-STACK POINTER 
LSTAK EQU PNTRS+72  LOW-STACK ADDRESS 
PRADD EQU PNTRS+73  PROGRAM EXECUTION 
DSTRT EQU PNTRS+74  DATA
NXTDT EQU PNTRS+75    STATEMENT 
DCCNT EQU PNTRS+76      POINTERS
NXTST EQU PNTRS+77      NEXT STMT NUMBER 
*****MOVED FROM BEHIND TTYPR FOR L 790409*******************
PRINT EQU PNTRS+78  LISTING LU #
ERTTY EQU PNTRS+79  ERROR LU# 
TRAPF EQU PNTRS+80  TRAP BUSY FLAG 800727*****
**********************************790830******************************* 
*READR NOP           ****REMOVED 790828*****
*PUNCH NOP           ***REMOVED 790828***** 
**************************************************************
      SKP 
      SUP PRESS MULTIPLE LISTINGS 
      SPC 1 
TEMPT BSS 14
.2    DEC 2 
.3    DEC 3 
.7    DEC 7 
.8    DEC 8 
*.5    DEC 5        ****REMOVED 790817*********** 
.10   DEC 10
.15   DEC 15
.32   DEC 32
.40   DEC 40
.41   DEC 41
.43   DEC 43
*.44   DEC 44     ****REMOVED 790817******************* 
.45   DEC 45
.46   DEC 46
.47   DEC 47
.48   DEC 48
.58   DEC 58
*.9999 DEC 9999        ***REMOVED 790817**************
B37   OCT 37
B42   OCT 42
B44   OCT 44
B53   OCT 53
B54   OCT 54
B73   OCT 73
B133  OCT 133 
B135  OCT 135 
B177  OCT 177 
B200  OCT 200 
B2000 OCT 2000
MSK0  OCT 377 
MSK1  OCT 777 
M1400 OCT 176400
B3000 OCT 3000
B4000 OCT 4000
LF    OCT 5000
B1400 OCT 14000 
UNMNC OCT 21000 
B2200 OCT 22000 
B2300 OCT 23000 
LETOP OCT 72000 
*RDOP  OCT 52000        ****REMOVED 790817***** 
SPLOP OCT 65000 
OPMSK OCT 77000 
*OPDMK OCT 100777       **REMOVED 790817**************
FRMSK OCT 100757
*TABCN OCT 100037     **REMOVED 790817***** 
M1    DEC -1
M2    DEC -2
M3    DEC -3
M4    DEC -4
M7    DEC -7
*M8    DEC -8      ***REMOVED 790817****
M9    DEC -9
M16   DEC -16 
M32   DEC -32 
D53   OCT -53 
D100  OCT -100
M256  DEC -256
MAXSN DEC -10000
FN    ASC 1,FN
MNEG  OCT 100000   MAXIMUM NEGATIVE FLOATING
      OCT 376         POINT NUMBER
FLGBT EQU MNEG
ERBS  DEF ERR-1 
STBAS DEF SYNTB-28,I   28 IS OFSET FROM OP CODE B34(FIRST STMT OPCODE)
      SKP 
**********************************
*                                *
* PRINT NAME TABLE FOR OPERATORS *
*                                *
**********************************
QUOTE OCT 1000      BITS 15-9 OF THE LABELLED WORD
      ASC 1," 
COMMA OCT 2000      ARE THE BASIC CODE OPERATOR 
      ASC 1,, 
SMCLN OCT 3000      NUMBERS.  BITS 3-0 ARE THE
      ASC 1,; 
RPARN OCT 4001      OPERATOR'S HIERARCHICAL 
      ASC 1,) 
RBRAC OCT 5001      PRECEDENCE FOR THOSE OPERATORS
      ASC 1,] 
SCMMA OCT 6002      BELONGING TO FORMULAS.  THE 
      ASC 1,, 
ASSOP OCT 7002      UNLABELLED WORD GIVES THE 
      ASC 1,= 
PLUS  OCT 10007     ASCII REPRESENTATION OF THE 
      ASC 1,+ 
MINUS OCT 11007     SINGLE CHARACTER OPERATORS. 
      ASC 1,- 
TIMES OCT 12010 
      ASC 1,* 
DIV   OCT 13010 
      ASC 1,/ 
EXPS  OCT 14012 
      ASC 1,^ 
GTR   OCT 15005 
      ASC 1,> 
LSS   OCT 16005 
      ASC 1,< 
UNEQL OCT 17005 
      ASC 1,# 
EQUAL OCT 20005 
      ASC 1,= 
UNMIN OCT 21011 
      ASC 1,- 
LBRAC OCT 22020 
      ASC 1,[ 
LPARN OCT 23020 
      ASC 1,( 
UPLUS OCT 24011 
      ASC 1,+ 
OROP  OCT 25003 
MSFLG NOP 
ANDOP OCT 26004 
DFLAG NOP 
NOTOP OCT 27011 
PRFLG NOP 
GTREQ OCT 30005 
UFLAG NOP 
LSSEQ OCT 31005 
      NOP 
MINOP OCT 32006 
      NOP 
MAXOP OCT 33006 
      SKP 
* 
DIM   OCT 71003 
      ASC 2,DIM 
COM   OCT 34003 
      ASC 2,COM 
DEF   OCT 35003 
      ASC 2,DEF 
REM   OCT 36003 
      ASC 2,REM 
IF    OCT 40002 
      ASC 1,IF
FOR   OCT 41003 
      ASC 2,FOR 
NEXT  OCT 42004 
      ASC 2,NEXT
END   OCT 45003 
      ASC 2,END 
DATA  OCT 51004 
      ASC 2,DATA
IMAGE OCT 67005 
      ASC 3,IMAGE 
* 
LET   OCT 72003     THESE STATEMENTS MAY FOLLOW AN
      ASC 2,LET 
GOTO  OCT 37004       'IF' OPERATOR 
      ASC 2,GOTO
GOSUB OCT 43005 
      ASC 3,GOSUB 
RTRN  OCT 44006 
      ASC 3,RETURN
STP   OCT 46004 
      ASC 2,STOP
WAIT  OCT 47004 
      ASC 2,WAIT
CALL  OCT 50004 
      ASC 2,CALL
READ  OCT 52004 
      ASC 2,READ
PRNT  OCT 53005 
      ASC 3,PRINT 
INPUT OCT 54005 
      ASC 3,INPUT 
RSTOR OCT 55007 
      ASC 4,RESTORE 
PAUSE OCT 56005 
      ASC 3,PAUSE 
ASSN  OCT 62006 
      ASC 3,ASSIGN
FILS  OCT 63005 
      ASC 3,FILES 
CHAIN OCT 64005 
      ASC 3,CHAIN 
TRAP  OCT 66004 
      ASC 2,TRAP
INVK  OCT 70006 
      ASC 3,INVOKE
* 
FAIL  OCT 57005 
      ASC 3,FAIL: 
THEN  OCT 60004 
      ASC 2,THEN
* 
USING OCT 61005 
      ASC 3,USING 
* 
TO    OCT 75002 
      ASC 1,TO
STEP  OCT 76004 
      ASC 2,STEP
OF    OCT 77002 
      ASC 1,OF
NOT   OCT 27003 
      ASC 2,NOT 
AND   OCT 26003 
      ASC 2,AND 
OR    OCT 25002 
      ASC 1,OR
* 
GTE   OCT 30002 
      ASC 1,>=
LTE   OCT 31002 
      ASC 1,<=
AUNEQ OCT 17002     ALTERNATE UNEQUAL SIGN
      ASC 1,<>
MIN   OCT 32003 
      ASC 2,MIN 
MAX   OCT 33003 
      ASC 2,MAX 
* 
LEN   OCT 3 
      ASC 2,LEN 
      SKP 
************************************* 
*                                   * 
* BRANCH TABLE FOR STATEMENT SYNTAX * 
*  (THIS TABLE IS ORDERED BY OPCODES* 
*  STARTING AT OPCODE B34)          * 
*                                   * 
************************************* 
SYNTB DEF COMS     COM
      DEF DEFS     DEF
      DEF REMS     REM
      DEF GOTOS    GO TO
      DEF IFS      IF 
      DEF FORS     FOR
      DEF NXTS      NEXT
      DEF GOTOS    GOSUB
      DEF ENDS     RETURN 
      DEF ENDS     END
      DEF ENDS     STOP 
      DEF WAITS    WAIT 
      DEF CALLS    CALL 
      DEF DATAS    DATA 
      DEF READS    READ 
      DEF PRINS    PRINT
      DEF INPTS    INPUT
      DEF RSTRS    RESTORE
      DEF PAUS     PAUSE
      DEF SYNE2-1  FAIL 
      DEF SYNE2-1  THEN 
      DEF SYNE2-1  USING
      DEF ASSNG    ASSIGN 
      DEF FILES    FILES
      DEF CHANS    CHAIN
      NOP           SPCECIAL SYNTAX 
      DEF TRAPS     TRAP
      DEF REMS      IMAGE 
      DEF INVOK     INVOKE
      DEF DIMS     LET
      DEF LETS     DIM
      SPC 1 
* 
#STND DEC -28       # STANDARD OPERATORS IN TABLE 
* 
#PSIF DEC -16       # OPERATORS ALLOWED PAST 'IF' 
* 
      SKP 
*********************************** 
*                                 * 
*  CHECK SYNTAX AND TRANSLITERATE * 
*                                 * 
*********************************** 
BASC1 NOP 
**********REMOVED  790530************************** 
*     LDA PFLAG     IS THIS INITIALIZATION?*****
*     CPA .9999 
*     RSS           YES, GO GET SEGMENT'S FWAM AND LWAM 
*     JMP BAS1C     NO, CONTINUE EXECUTION
*     JSB GMS.C 
*     JMP ROTAT     RET. TO MAIN FOR FWAM AND LWAM CHECK***** 
********************790530********************************* 
* 
      LDA SBPTR,I   GET FIRST CHAR IN BUFFER
      SPC 1 
*  DETERMINE SEQUENCE NUMBER
      SPC 1 
SYNTX CPA .45       MINUS SIGN(DELETE CURRENT LINE)?
      JMP DLLIN     YES 
      JSB INTCK     RECORD
      DEF MAXSN       SEQUENCE NUMBER 
      JMP SYE25 
      STA TEMP3     SAVE CHAR 
      LDA LOLIM     IS SEQUENCE 
      CMA,INA         NUMBER >= 
      ADA 1             TO THE
      SSA                 LOW LIMIT?
      JMP PEXMK     NO, IGNORE STMT 
      LDA 1         IS SEQUENCE 
      CMA,INA         NUMBER <= 
      ADA HILIM         TO THE
      SSA                 HIGH LIMIT? 
      JMP PEXMK     NO, IGNORE STMT 
      STB .LNUM     SAVE LINE NUMBER
* 
      LDA MNNAM     IS THERE
      SZA             A MNEMONIC TABLE? 
      JMP *+3       YES!
      CCA           SET COUNT TO
      STA FWAMM,I     INDICATE NO ENTRIES 
* 
      LDB FWAMM     SET UP
      INB             SEARCH
      STB SUBS1         POINTERS
      STB SUBS2 
      STB SUBS3 
      STB SUBS4 
      LDA TEMP3     RECOVER CHAR 
      ISZ SBPTR     SAVE SPACE FOR LENGTH WORDR;
      LDB SBUFA     SET 
      INB             TEMP TO 
      STB TEMP          (SBUFF)+1 
      SPC 1 
* DETERMINE STATEMENT TYPE
      SPC 1 
      CPA .10       NULL STATEMENT? 
      JMP DLSTM     DELETE STATEMENT! 
      LDB #STND     -# OF STANDARD MNEMONICSR 
      JSB TBSRH     FIND STATEMENT TYPE 
       DEF DIM      START AT TOP OF LIST
       RSS          NO ERROR IF NOT FOUND 
      JMP PSTIF     FOUND 
      LDB SPNCT     IS THERE ANY
      SZB,RSS         SPECIAL SYNTAX? 
      JMP SUBR      NO! 
      JSB TBSRH     YES, LOOK UP IN SPECIAL 
       DEF SPTBL      IN SPECIAL
       RSS              SYNTAX TABLE
      JMP PSTIF 
SUBR  LDB FWAMM,I   GET MNEM COUNT
      JSB TBSRH     LOOK IN MNEMONIC TABLE
SUBS1  DEF 0
       JMP TRYLT    TRY LET STATEMENT 
PSTIF LDB M9        SET MULTIPLE STORE
      STB MSFLG       TO FALSE
      LDB PBPTR     NULL
      CPB PBUFF      PROGRAM? 
      RSS 
      JMP SYNT1     NO
      LDB FWAM      INSURE NO 
      STB PBUFF      SPURIOUS COMMON
      STB PBPTR       EXISTS
SYNT1 STB TEMPS       POINTER 
      CLB           SET DEFINE FLAG 
      STB DFLAG       TO FALSE
      STB PRFLG     SET PARAMETER FLAG TO FALSE 
      STB FROMF     SET FROM FLAG CLEAR 
      STA 1 
* 
      LDA SBPTR,I   GET OP CODE 
      AND OPMSK     IS THIS 
      CPA SPLOP       AN OP CODE FOR SPEC SYNTAX? 
      RSS           YES!
      JMP SYNT5     NO! 
      LDB COUNT     TABLE ORDINAL POSITION
      JSB SPEC1     GO AND PROCESS SPEC SYNTAX
       JMP ACTST    ACCEPT GOOD STATEMENT 
       JMP OUTER      OR IF BAD OUTPUT ERROR MESSAGE
SYNT5 LDA FWAMM     IS ENTRY IN 
      CMA,INA        THE STANDARD BASIC 
      ADA TBLPT       STATEMENT TABLE?
      SSA,RSS       NAMED SUBROUTINE? 
      JMP NMSBR     YES 
      LSR 9         COMPUTE ADDRESS OF SYNTAX 
      STB SFLAG     SET STRING FLAG TO OFF
      ADB STBAS         ROUTINE AND 
      JMP 1,I               BRANCH TO IT
**
***   TRY IMPLIED LET 
**
TRYLT LDB M1        SET TO SMALL NEG. NO. 
      STB TBLPT      SO TO SKIP NAMED SUB. SYNTAX 
      JSB BCKSP     BACK UP TO START FORMULA PROCESSOR
      LDA LETOP 
      STA SBPTR,I   DUB IN "LET" CODE 
      JMP PSTIF 
      SKP 
**
* 
***                      ***
**  LET STATEMENT SYNTAX  **
***                      ***
* 
LETS  LDA SBPTR     ENABLE STRING 
      STA SFLAG       VARIABLE
      ISZ MSFLG     SET MULTIPLE STORE FLAG ON
      JSB FSC       FETCH FORMULA 
      ISZ SFLAG     STRING VARIABLE FOUND?
      JMP LET1      NO! 
      JSB SYMCK     YES, DEMAND ASSIGNMENT OPERATOR!
       DEF ASSOP-1
      JMP SYNE2-1   NO ASSIGNMENT OPERATOR! 
      JSB RSTOP     RECORD STRING OPERATOR
      JSB SNULL     RECORD END-OF-FORMULA 
      JMP EOST      DEMAND END
      SPC 1 
LET1  ISZ SFLAG     DID STORE OCCUR?
      JSB ERROR     NO
SYNE2 EQU * 
* 
******************************
*                            *
* CHECK FOR END OF STATEMENT *
*                            *
******************************
EOST  CPA .10       END OF STATEMENT? 
      JMP ACTST     YES,ACCEPT STATEMENT! 
NOEOF JSB ERROR     CHARACTERS AFTER LEGAL END-OF-STATEMENT 
***************************** 
*                           * 
*   CALL STATEMENT SYNTAX   * 
*                           * 
***************************** 
* 
*  THE CALL SYNTAX CHECK MAKES EXTENSIVE USE OF THE MNEMONIC AND
*  BRANCH TABLES TO DETERMINE THE CORRECTNESS OF THE SUBROUTINE 
*  CALL AND THE ORDINAL POSITION OF THE SUBROUTINE WITHIN THE 
*  BRANCH TABLE, SO THAT THE EXECUTE SEGMENT OF BASIC CAN COMPUTE 
*  THE ADDRESS OF THE SUBROUTINE. CERTAIN ERRORS CAN BE CAUSED
*  BY THE INCORRECT USE OF PARAMETERS IN THE CALLING SEQUENCE OF
*  A SUBROUTINE. BELOW IS A SIMPLE TABLE INDICATING LEGAL PARAMETERS: 
* 
* 
*                                DIRECTION OF PARAMETER TRANSFER
*         +---------------------------------------------------+ 
*         ! TYPE OF PARAMETER ! BASIC TO SUB. ! SUB. TO BASIC ! 
*         +---------------------------------------------------! 
*         ! SIMPLE VARIABLE   !     LEGAL     !     LEGAL     ! 
*         +---------------------------------------------------+ 
*         !   CONSTANT        !     LEGAL     !    ILLEGAL    ! 
*         +---------------------------------------------------+ 
*         !  ARRAY VARIABLE   !     LEGAL     !     LEGAL     ! 
*         +---------------------------------------------------+ 
*         !  ARRAY ELEMENT    !     LEGAL     !     LEGAL     ! 
*         +---------------------------------------------------+ 
*         !  STRING VARIABLE  !     LEGAL     !     LEGAL     ! 
*         +---------------------------------------------------+ 
*         !  STRING CONSTANT  !     LEGAL     !    ILLEGAL    ! 
*         +---------------------------------------------------+ 
*         !  EXPRESION        !     LEGAL     !    ILLEGAL    ! 
*         +---------------------------------------------------+ 
* 
* 
* 
*  THE MNEMONIC TABLE CONTAINS THE ASCII NAME OF THE SUBROUTINE,
*  THE NUMBER OF CHARACTERS IN THE SUBROUTINE, AND THE NUMBER OF
*  PARAMETERS IN THE SUBROUTINE CALLING SEQUENCE. THE FORMAT OF 
*  EACH ENTRY IS SHOWN BELOW. 
* 
* 
*           15                              0 
*           +-------------------------------+ 
*           !F!V! ! ! ! ! ! !P!P!P!P!C!C!C!C! 
*           +-------------------------------+ 
*           ! 1ST CHARACTER ! 2ND CHARACTER ! 
*           +-------------------------------+ 
*           ! 3RD CHARACTER !    ETC.       ! 
*           +-------------------------------+ 
* 
*      WHERE :
*                 F     =  1 IF FUNCTION
*                 F     =  0 IF SUBROUTINE
*                 V     =  1 IF VARIABLE LENGTH PARAMETER LIST
*                 V     =  0 IF FIXED NUMBER OF PARAMETERS
*                 PPPP  =  NUMBER OF PARAMTERS
*                 CCCC  =  NUMBER OF CHARACTERS IN NAME 
* 
* 
*  THE BRANCH TABLE CONTAINS INFORMATION REGARDING THE ADDRESS
*  OF THE SUBROUTINE, PARAMETER CONVERSION (REAL TO INTEGER OR
*  INTEGER TO REAL), TYPE OF PARAMETER, AND DIRECTION THAT THE
*  PARAMETER IS REUIRED TO GO ( BASIC TO SUBROUTINE OR SUBROUTINE 
*  TO BASIC). 
* 
* 
*           15                             0
*           +-------------------------------+ 
*           !D!D!D!D!D!P!P!P!P!P!S!S!S!S!S!S! ADDRESS 
*           +-------------------------------+ 
*           !X!A!A!A!A!A!A!A!A!A!A!A!A!A!A!A! ARRAY 
*           +-------------------------------+ 
*           !X!T!T!T!T!T!T!T!T!T!T!T!T!T!T!T! TO FROM 
*           +-------------------------------+ 
*           !F!I!I!I!I!I!I!I!I!I!I!I!I!I!I!I!   CONVERSION
*           +-------------------------------+ 
* 
* 
*    WHERE: 
*             DDDDD  =  IDENTIFICATION LETTER 
*             PPPPP  =  OVERLAY NUMBER
*             SSSSSS =  SUBROUTINE NUMBER WITHIN OVERLAY
*             A      =  1 IF ARRAY, 0 IF NON-ARRAY
*             T      =  1 IF FROM SUBROUTINE, 0 IF TO SUBROUTINE
*             F      =  1 IF INTEGER FUNCTION 
*             F      =  0 IF REAL FUNCTION
*             I      =  1 IF CONVERSION TO INTEGER REQUIRED 
*             I      =  0 IF NO CONVERSION REQUIRED 
*             X      =  BIT POSITION NOT USED 
* 
* 
* 
CALLS JSB GETCR     FETCH AND 
       JMP NOEOF      RECORD
      LDB FWAMM,I   GET MNEM COUNT
      JSB TBSRH     LOOK FOR SUBROUTINE NAME
SUBS2  DEF 0
       JSB ERROR    NOT FOUND 
CALER JMP PSTIF     DO POST-IF STATEMENT
* 
**
*** NAMED SUBROUTINE SYNTAX (NO 'CALL' PREFIX)
**
NMSBR CLA           SET TO
      STA TEMP7       INDICATE SUBROUTINE 
* GET FIRST WORD OF MNEMONIC TBL ENTRY
      LDA PRPTR,I   IS THIS 
      SSA             REALLY A SUBROUTINE?
      JSB ERROR     NO! 
SYNE3 EQU * 
FUNCT STA TEMP6     SAVE PARAMETER WORD 
      RRR 4           COUNT 
      AND .15           FROM
      CMA 
      STA PCNT
      CMA 
*                         BEING DESTROYED 
*                           BY FSC
      LSL 9         LEFT JUSTIFY COUNT
      STA TEMP3       FOR INTERP. CODE
      LDA FWAMM,I   COMPUTE OFFSET IN MNEMONIC TBL
      CMA,INA 
      ADA COUNT     AND SAVE IT FOR LATER 
      STA TCCNT     THIS ORDINAL POSITION OF SUB. ENTRY 
      LDB TEMP6     FORTRAN 
      SSB             FUNCTION? 
      JMP CALL1     YES!
      ADA B5000     NO, ADD IN CALL OP CODE 
CALL4 STA SBPTR,I   STORE IN INTERP. CODE 
      ISZ SBPTR     UPDATE INTERP. CODE PTR.
      LDA COMMA     COMMA CODE
      STA SBPTR,I   STUFF IT (WIPE OUT LEFT PAREN)
      ISZ PCNT      NO! 
      JMP NAMSB 
* 
      LDB B4000     FUDGE A RIGHT PAREN 
      STB SBPTR,I 
      LDA TEMP6     DID WE PROCESS A
      SSA               FUNCTION
      JMP FSC10+1   YES!
      JSB GETCR     FETCH NEXT CHARACTER
      LDA .10 
      ISZ SBPTR 
      JMP CALL5 
* 
CALL1 ADA TEMP3     STUFF IN
      JMP CALL4       PARM COUNT INSTEAD OF B50000
* 
* 
CALL2 CCB 
      JSB SYMCK     COMMA?
       DEF COMMA-1
       JMP CALL3    NO
      ISZ PCNT       YES, MORE PARAMS ALLOWED ? 
      JMP PRMCK     YES, LOOK FOR PARAMETER.
SYE11 JSB ERROR     NO,TOO MANY PARMETERS 
* 
* 
*     PROCESS SUBROUTINE AND FUNCTION PARAMETERS
* 
NAMSB LDA TCCNT     GET ORDINAL NUMBER
      ALS,ALS         AND MULTIPLY BY 4 
      ADA .2            AND ADD 2 TO GET
      ADA FWAMB           POSITION IN BRANCH TBL THEN 
      LDA 0,I               GET THE TO/FROM PARAMETER WORD
      STA TOFRM     SAVE FOR CHECKING EACH PARAMETER
PRMCK LDA TOFRM     GET TO/FROM WORD
      CCB 
      SLA,RSS       IS IT SET?
      CLB           NO! THEN SET THE FLAG TO 0
      STB FROMF     YES! THEN SET IT NON-ZERO 
      ARS           SHIFT TO
      STA TOFRM       FOR NEXT PARAMETER
      JSB GETCR     GET THE FIRST PARAMETER CHARACTER 
      LDA .10 
      CPA B42       IS IT A STRING LITERAL? 
      JMP CALL6     YES!
      JSB LETCK     IS IT A LETTER? 
      JSB PERR      NO, CHECK FOR PARAMETER ERROR 
      JSB BCKSP     NO, PUT CHAR BACK 
      JSB FRCUR     SAVE VARIABLES
      LDA SBPTR     SET TO
      STA SFLAG       ALLOW STRING VARIABLES
      JSB FSC       FETCH 
      CLB           CLEAR 
      STB FROMF     TO/FROM FLAG
      ISZ SFLAG     STRING? 
      RSS           NO! 
      JMP CALL7     YES!
CALL8 JSB FPOP      RESTORE VARIABLES 
      JMP CALL2       PARAMETER FORMULA 
* 
CALL3 ISZ PCNT      MORE PARAMETERS EXPECTED? 
      RSS           YES 
      JMP CALL9     NO! 
      LDB TEMP6     DOES THIS 
      RBL             ROUTINE EXPECT
      SSB,RSS           VARIABLE LENGTH LIST
      JMP SYE11     NO! 
CALL9 JSB RPCK      FETCH RIGHT PARENTHESIS 
      LDB TEMP6     FORTRAN FUNCTION
      SSB               BEING PROCESSED?
      JMP FSC19     YES, COMPLETE SYNTAX CHECK
* 
CALL5 CCB 
      JSB TBSRH     IS CALL FOLLOWED BY "FAIL:"?
       DEF FAIL 
       JMP EOST 
      JSB GETCR     YES. ANALYZE REST OF STMT.
       JMP NOEOF
      ISZ SBPTR 
      JMP FAILS 
* 
CALL6 JSB PERR      CHECK FOR PARAMETER ERROR 
      ISZ SBPTR     POINT AT PLACE TO PUT " OPERATOR
      CCB 
      JSB SYMCK     PUT IN " OPERATOR 
       DEF QUOTE-1
       NOP
      LDA B42       SPECIFY STRING TERMINATOR 
      JSB CHRST     PUT STRING IN INTERP CODE 
      JSB SNULL     ADD NULL AFTER STRING CONSTANT
      JSB GETCR     FETCH NEXT CHARACTER
      LDA .10 
      JMP CALL2 
* 
CALL7 JSB SNULL     PUT NULL AFTER STRING 
      CCB 
      STB SFLAG     RESET SFLAG 
      JMP CALL8 
* 
* 
* A CHECK IS MADE HERE TO SEE IF THE SUBROUTINE PARAMETER 
* (A STRING LITERAL, CONSTANT OR EXPRESSION) IS BEING 
* RETURNED FROM A SUBROUTINE AS INDICATED BY THE BRANCH TABLE 
* 
PERR  NOP 
      LDB FROMF     FLAG
      SZB,RSS         SET?
      JMP PERR,I    NO! 
      CPA .41       RIGHT PAREN?
      JMP PERR,I    YES, OK THEN! 
      CPA B135      RIGHT BRACKET?
      JMP PERR,I    YES, OK 
      CPA B54       COMMA?
      JMP PERR,I    YES, OK THEN! 
      CLA           CLEAR 
      STA FROMF       FROM FLAG 
      JSB ERROR     NO, ILLEGAL PARAMETER 
SYE16 EQU * 
B5000 OCT 50000 
      SKP 
* 
********************
*                  *
*  TRAP STATEMENT  *
*                  *
********************
* 
TRAPS CCB           SET FOR 
      STB CCODE       NEG SEQ NUMBER CASE 
      JSB FSC       FETCH TRAP # FORMULA
      CPA .10       END-OF-STATEMENT? 
      JMP SYNE6-1   YES 
      CCB           GET 
      JSB TBSRH       GOSUB SYNTAX
      DEF GOSUB 
      JSB ERROR     NOT FOUND 
SYNE6 JSB GETCR     CHECK 
      NOP             FOR (-) SIGN
      CPA .45       IS IT?
      JMP TRAP1     YES!
      JSB BCKSP     GET BACK TO LAST CHAR 
TRAP2 CCB           SET FOR 
      STB RFLAG       ERROR RETURN HERE 
      JSB PRGIN     GET SEQUENCE NUMBER 
      DEF MAXSN 
      RSS           GOOD RETURN 
      JSB CKZER     IS NUMBER=0?
      JSB BCKUP     BACK UP TO SEQ NUMBER 
      LDB SBPTR,I   NEGATE
      ISZ CCODE       SEQUENCE NUMBER 
      CMB,INB 
      STB SBPTR,I       IF NECESSARY
      ISZ SBPTR     RESET PTR 
      JMP EOST      END-OF-STATEMENT PROCESSING 
* 
TRAP1 CLB           SET FOR 
      STB CCODE       (-) FOUND 
      JMP TRAP2 
* 
CKZER NOP           IF
      SZB             B=0 
      JMP SYE25         THEN STORE
      STB SBPTR,I         IT IN INTERP. 
      ISZ SBPTR             ELSE PRINT
      JMP CKZER,I             ERROR MESSAGE 
* 
      SKP 
* 
************************
*                      *
* DIM STATEMENT SYNTAX *
*                      *
************************
DIMS  ISZ DFLAG     SET DFLAG TO TRUE 
      LDA SBPTR     ENABLE STRING 
      STA SFLAG       VARIABLE
      JSB ARRYS     CHECK AN ARRAY
      JMP ACTST     DONE
      JMP DIMS+1    WAS A COMMA, CONTINUE 
************************
*                      *
* COM STATEMENT SYNTAX *
*                      *
************************
COMS  CLB           SET ARRAY POINTER 
      STB TEMPS+7     INITIALLY TO ZERO 
      ISZ SBPTR     SAVE SPACE FOR
      ISZ SBPTR       COMMON SIZE WORD
      STB SBPTR,I   INSERT NULL 
      ISZ DFLAG     SET DEFINE FLAG TO TRUE 
COMS1 CCA           SET COMMON FLAG 
      STA PRFLG       TO TRUE 
      LDA SBPTR     ENABLE
      STA SFLAG       STRING VARIABLES
      JSB ARRYS     CHECK FOR ARRAY 
      RSS 
      JMP COMS1     MORE ARRAYS 
      LDB SBUFA     CALCULATE WHERE 
      ADB .3          COMMMON SIZE GOES 
      LDA TEMPS+7   RECORD COMMON 
      STA 1,I         SIZE
      JMP ACTST     EXIT
* 
******************************
*                            *
**  CHAIN STATEMENT SYNTAX  **
*                            *
******************************
* 
CHANS JSB RSTOP     RECORD FILE NAME
INVOK EQU CHANS 
      JSB SNULL     SET END-OF-FORMULA FLAG 
      CCB 
      JSB SYMCK     COMMA 
      DEF COMMA-1     FOLLOWS?
      JMP EOST      NO
      JSB PRGIN     GET A SEQUENCE
      DEF MAXSN 
      JMP EOST        FOR STMNT # 
* 
      SKP 
************************
*                      *
* DEF STATEMENT SYNTAX *
*                      *
************************
DEFS  JSB LTR 
      JMP SYNE4     FIRST 
      LDA TEMP1 
      ALF,ALF        TWO CHARACTERS 
      IOR TEMP2 
      CPA FN           'FN'?
      RSS           YES 
      JMP SYNE4     NO
      JSB LTR       LETTER FOLLOWS? 
SYNE4 JSB ERROR     NO
      LDA TEMP1     YES, RECORD A 
      LDB .58         FUNCTION
      JSB STROP        NAME 
      LDA TEMP2     RETRIEVE CHARACTER
      JSB LPCK      LEFT PARENTHESIS? 
      IOR FLGBT     YES, SET FORMAL 
      STA SBPTR,I     PARAMETER BIT 
      JSB VAROP     FETCH SIMPLE VARIABLE 
      NOP           NONE FOUND
      JSB ERROR     SUBSCRIPTED VARIABLE FOUND
SYNE5 JSB RPCK      RECORD A RIGHT PARENTHESIS
      CCB           ASSIGNMENT
      JSB SYMCK 
      DEF ASSOP-1     OPERATOR? 
      JMP SYNE2-1   NO
      LDA M2        YES,
      ADA SBPTR       RETRIEVE
      LDA 0,I           PARAMETER 
      AND MSK1            AND 
      STA PRFLG             SAVE IT 
      JSB FSC       FETCH DEFINING FORMULA
      JMP EOST      END-OF-STATEMENT TEST 
* 
****************************
*                          *
*  ASSIGN STATEMENT SYNTAX *
*                          *
****************************
* 
ASSNG JSB RSTOP 
      CCB 
      JSB SYMCK     RECORD A
      DEF COMMA-1     COMMA 
      JMP SYE15     NOT A COMMA!
      LDB .2        DISABLE 
      STB SFLAG       STRING VARIABLE 
      JSB FSC       RECORD FORMULA
      CCB 
      JSB SYMCK     RECORD
      DEF COMMA-1     A COMMA 
      JMP SYE15     NOT A COMMA 
      JSB VAROP     SEEK A NUMERIC OPERAND
      JMP SYE25     BAD ARGUMENT
      NOP 
      JSB SNULL     APPEND END-OF-STATEMENT 
      JMP EOST      DEMAND END-OF-STATMENT
* 
********************* 
*                   * 
*  FILES STATEMENT  * 
*                   * 
********************* 
* 
FILES CLA,RSS       SUPPRESS BLANKS 
* 
************************
*                      *
* IMAGE AND REM STMENT *
*   SYNTAX CHECKER     *
*                      *
************************
REMS  LDA B200      DUMMY STRING TERMINATOR 
      JSB CHRST     FETCH CHARACTER STRING
      JMP ACTST 
      SPC 1 
*********************** 
*                     * 
* IF STATEMENT SYNTAX * 
*                     * 
*********************** 
IFS   ISZ SBPTR     FETCH 
      JSB GETCR       NEXT CHARACTER
      JMP SYNE7-1   ILLEGAL IF STMT 
      STA SBPTR,I   FOUND, SAVE IT
      CCB           LOOK
      JSB TBSRH       FOR 'END' 
      DEF END 
      JMP IF0       NONE FOUND
      JSB FILRF     FOUND, GET FILE REFERENCE 
      JSB ERROR     BAD FILE REFERENCE
SYE27 JMP IFS2      FOUND 
IF0   JSB BCKSP     RESTORE 
      JSB BCKUP       AS WAS ON ENTRY 
      STB SFLAG     ENABLE STRING FORMULA 
      JSB FSC       GET DECISION FORMULA
      ISZ SFLAG     STRING? 
      JMP FAILS     NO! 
      STA TEMP1     YES,SAVE NEXT CHAR
      LDB M3        MULTI-CHARACTER 
      JSB TBSRH       OPERATOR
       DEF GTE          PRESENT?
      RSS           NO! 
      JMP STER4     YES, PUT  IT AWAY 
      LDA TEMP1     CHAR IN (A) 
      LDB M4        SEARCH 4 OPERATORS
      JSB SYMCK     SINGLE CHAR REL OPERATOR
       DEF GTR-1      PRESENT?
      JSB ERROR     ILLEGAL REL OPERATOR
STER4 JSB RSTOP     STORE STRING
      JSB SNULL     SET END-OF-FORMULA
FAILS CCB           LOOK FOR
      JSB TBSRH           'THEN'
       DEF THEN 
      JMP IFS1      NOT FOUND 
IFS3  CLB           FOUND, GET STATEMENT
      JMP GOTO0      LABEL NUMBER 
IFS1  LDB #PSIF      FOR FOLLOWING
      JSB TBSRH       OPERATOR
       DEF LET
      RSS 
      JMP PSTIF     FOUND, GO CHECK SYNTAX
      LDB FWAMM,I     FOR FOLLOWING 
      JSB TBSRH         NAMED SUBROUTINE
SUBS3  DEF 0
      JSB ERROR     NOT FOUND 
SYNE7 JMP PSTIF     FOUND, GO CHECK SYNTAX
* 
IFS2  CCB           LOOK FOR
      JSB TBSRH       'THEN'
       DEF THEN 
      JMP SYNE7-1   NOT FOUND (ONLY 'THEN' LEGAL AFTER 'END') 
      JMP IFS3      GET 'GOTO' SYNTAX 
* 
*********************************** 
*                                 * 
* GOTO AND GOSUB STATEMENT SYNTAX * 
*                                 * 
*********************************** 
GOTOS LDA INBFA     SAVE CURRENT
      STA TEMP6       BUFFER POINTER
      LDA ICCNT         AND COUNTER 
      STA TEMP7 
      CCB           SET 'PRGIN' FOR RETURN
GOTO0 STB RFLAG       ON ERROR
      JSB PRGIN     FETCH SEQUENCE
      DEF MAXSN       NUMBER
      JMP GOTO2     FOUND  END-OF-STATEMENT?
GOTO3 JSB BCKUP     BACK UP SYNTAX POINTER
      LDB TEMP6     RESTORE CURRENT 
      STB INBFA       BUFFER POINTER
      LDB TEMP7         AND COUNTER 
      STB ICCNT 
      LDA SBPTR,I   ERASE 
      AND OPMSK       'INTEGER FOLLOWS' 
      STA SBPTR,I        FLAG 
      JSB FSC       FETCH FORMULA 
      CPA .10       END-OF-STATEMENT? 
      JMP SYNE8-1   YES 
      CCB             THE 'OF'
      JSB TBSRH 
       DEF OF 
      JSB ERROR     MISSING 
SYNE8 CLB           SET 'PRGIN' FOR EXIT
      STB RFLAG       ON ERROR
GOTO1 JSB PRGIN     FETCH SEQUENCE
      DEF MAXSN       NUMBER
      CCB 
      JSB SYMCK     COMMA NEXT? 
      DEF COMMA-1 
      JMP EOST      NO, END-OF-STATEMENT? 
      JMP GOTO1     YES 
GOTO2 CPA .10       END-OF-STATEMENT? 
      JMP EOST      YES 
           JSB BCKUP NO, MUST 
      JMP GOTO3       BE A FORMULA
      SKP 
************************
*                      *
* FOR STATEMENT SYNTAX *
*                      *
************************
FORS  JSB VAROP     FETCH SIMPLE VARIABLE 
      NOP           NONE FOUND
      JMP SYNE5-1   SUBSCRIPTED VARIABLE FOUND
      CCB 
      JSB SYMCK     ASSIGNMENT
      DEF ASSOP-1     OPERATOR? 
      JMP SYNE2-1   NO
      JSB FSC       YES, FETCH INITIAL VALUE FORMULA
      CCB               THE 
      JSB TBSRH           'TO'
       DEF TO 
      JSB ERROR     MISSING 
SYNE9 JSB FSC       GET LIMIT FORMULA 
      CPA .10       END-OF-STATEMENT? 
      JMP ACTST     YES 
      JSB BCKUP     NO, ERASE ZERO WORD 
      CCB               FOR 
      JSB TBSRH           THE 'STEP'
       DEF STEP 
      JSB ERROR     MISSING 
SYE10 JSB FSC       GET STEP SIZE FORMULA 
      JMP EOST      END-OF-STATEMENT TEST 
************************* 
*                       * 
* NEXT STATEMENT SYNTAX * 
*                       * 
************************* 
NXTS  JSB VAROP     FETCH SIMPLE VARIABLE 
      NOP           NONE FOUND
      JMP SYNE5-1   SUBSCRIPTED VARIABLE FOUND
      JMP EOST      END-OF-STATEMENT TEST 
******************************************************
*                                                    *
* END, STOP, RESTORE, RETURN, PAUSE STATEMENT SYNTAX *
*                                                    *
******************************************************
ENDS  ISZ SBPTR 
      JSB GETCR     END-OF-STATEMENT? 
      JMP ACTST     YES 
      JMP NOEOF     NO
************************* 
*                       * 
* WAIT STATEMENT SYNTAX * 
*                       * 
************************* 
WAITS CLB           DISALLOW STRINGS
      STB SFLAG 
      JSB GETCR     GET FIRST CHAR
      JMP FSCE1     NO PAREN ERROR
      ISZ SBPTR 
      JSB LPCK      FETCH LEFT PAREN
      JSB FSC       FETCH FORMULA 
      JSB RPCK      FETCH RIGHT PAREN 
      JMP EOST      END-OF-STATEMENT TEST 
      SKP 
* 
********************* 
*                   * 
*  PAUSE STATEMENT  * 
*                   * 
********************* 
* 
PAUS  CLB           DISALLOW
      STB SFLAG       STRINGS 
      ISZ SBPTR 
      JSB GETCR     GET FIRST CHAR
      JMP ACTST     IF NO PARAMETER IT'S OK 
      JSB LPCK      FETCH LEFT PAREN
      JSB GETCR     GET FIRST CHAR OF PARAMETER 
      JMP SYE25     BAD!
      CLB           SET 
      STB SIGN        SIGN POSITIVE 
      JSB NUMCK     NUMBER? 
      JMP SYE25     NO! 
      JMP SYE25     NO! 
      JSB NUMOP     FIX UP PRECEDING OPERATOR 
      JSB RPCK      FETCH LEFT PAREN
      JMP EOST
*********************** 
*                     * 
*  RESTORE STATEMENT  * 
*                     * 
*********************** 
* 
RSTRS JSB GETCR     END OF STMT?
      JMP RSTR1     YES!
      JSB BCKSP     NO,DEMAND 
      JSB PRGIN       SEQUENCE NUMBER 
      DEF MAXSN 
      JMP EOST      DEMAND END-OF-STATEMENT 
RSTR1 ISZ SBPTR     RECORD DUMMY OPERAND
      JMP ACTST     ACCEPT STATEMENT
* 
************************* 
*                       * 
* DATA STATEMENT SYNTAX * 
*                       * 
************************* 
DATAS CLA 
      STA SIGN      CLEAR SIGN
      JSB GETCR 
      JSB ERROR           END-OF-INPUT CONDITION
SYE12 CLB,INB       SET SIGN
      CPA .43       '+' ? 
      JMP DATA4     YES 
      CCB 
      CPA .45       NO, '-' ? 
      JMP DATA4     YES 
DATA1 JSB NUMCK     NO, NUMBER? 
      JMP DATA3     NO
      JSB ERROR     BAD EXPONENT
NUMER JSB NUMOP     FIX UP PRECEDING OPERATOR 
DATA2 CCB           CHECK 
      JSB SYMCK       FOR A 
      DEF COMMA-1       COMMA 
      JMP EOST      END-OF-STATEMENT TEST 
      JMP DATAS     FETCH ANOTHER NUMBER
DATA3 CPB SIGN      SIGN FOUND? (B)=0 
      RSS           NO! 
      JSB ERROR     YES,SOLITARY SIGN 
SYE26 ISZ SBPTR     DEMAND A
      JSB GETST       STRING CONSTANT 
      JMP DATA2 
DATA4 STB SIGN      RECORD SIGN 
      JSB GETCR 
      JMP EOST      END-OF-INPUT CONDITION
      JMP DATA1 
**************************
*                        *
* READ  STATEMENT SYNTAX *
*                        *
************************** 
READS JSB RECRF     READ FROM FILE? 
      JMP READ1     NO! 
      CPA .10       YES, PSEUDO READ? 
      JMP ACTST     YES!
      CPA B73       NO, ';'?
      JMP INPTS     YES!
      JMP SYE15     NO! 
READ1 JSB BCKSP 
* 
**************************
*                        *
* INPUT STATEMENT SYNTAX *
*                        *
**************************
INPTS LDB SBPTR     ENABLE STRING 
      STB SFLAG       VARIABLE
      JSB VAROP     RECORD VARIABLE OPERAND 
      JSB ERROR     MISSING 
SYE13 NOP 
      CCB           CHECK 
      JSB SYMCK       FOR A 
      DEF COMMA-1       COMMA 
      RSS 
      JMP INPTS     IS, FETCH NEXT ITEM 
      JSB SNULL     APPEND END-OF-FORMULA 
      JMP EOST      END OF STATEMENT TEST 
      SKP 
* 
************************************
*                                  *
*  PRINT STATEMENT SYNTAX CHECKER  *
*                                  *
************************************
* 
* 
* 
PRINS JSB USCHK     'USING'?
      JMP PRIN5     NO, NONE FOUND
      CPA .10       END-OF-STMT?
      JMP ACTST     YES 
      JSB SNULL 
      CCB 
      JSB SYMCK     SEMI-COLON FOLLOWS? 
      DEF SMCLN-1 
      JMP SYE15     MISSING OR BAD LIST DELIMITER 
PRIN7 ISZ SBPTR 
      JSB GETCR     MORE PRINT LIST 
      JMP ACTST 
      STA SBPTR,I   SVE CHAR
      JSB BCKSP     RESTORE BUFFER PTR
      JSB BCKUP     RESTORE INPUT STRING
      STB SFLAG     ENABLE STRING VARIABLES 
      JSB FSC       FETCH FORMULA 
      CCB 
      CPB SFLAG     STRING VARIABLE?
      JSB SNULL     YES,OUTPUT A NULL 
      CPA .10       END-0F-STMT?
      RSS           YES 
      JMP PRIN6     NO! 
      JMP ACTST     ACCEPT STMT 
PRIN6 CCB 
      JSB SYMCK     COMMA?
      DEF COMMA-1 
      JMP SYE25     MISSING DELIMITER 
      JMP PRIN7 
* 
PRIN5 JSB RECRF     WRITE ONTO FILE?
      JMP PRIN0-1   NO! 
      CCB           YES, SET
      STB FILRF       'FILE' FLAG 
      CPA .10       NULL WRITE? 
      JMP ACTST     YES!
      CPA B73       NO, ';'?
      JMP PRIN0     YES!
SYE15 JSB ERROR     NO! 
      JSB BCKSP 
PRIN0 ISZ SBPTR     ADVANCE SYNTAX PTR
      JSB GETCR     MORE STATEMENT? 
      JMP ACTST     NO! 
      CCB           YES, ENABLE 
      STB TEMP,I      FORMULA AND TAB 
      CPA B42       QUOTE?
      RSS           YES!
      JMP PRIN3     NO! 
PRIN1 JSB GETST     RECORD A STRING CONSTANT
      ISZ SBPTR 
      CPA .10      END-OF-STATEMENT?
      JMP ACTST     YES!
      CCB           NO! 
      STB TEMP,I
PRIN2 CPA B42       QUOTE?
      JMP PRIN1     YES!
      LDB M2        NO! 
      JSB SYMCK     COMMA OR
      DEF COMMA-1     SEMICOLON?
      RSS       NO! 
      JMP PRIN0     YES!
      JSB SNULL     ZERO NEXT WORD
PRIN3 ISZ TEMP,I    FORMULA OR TAB PERMITTED? 
      JMP SYE15     NO! 
      STA SBPTR,I   YES!
      CCB           'FILE'
      ISZ FILRF       MODE? 
      JMP PRIN4     NO! 
      STB FILRF     YES!
      CCB 
      JSB TBSRH     'END' ? 
      DEF END 
      JMP PRIN4     NO! 
      ISZ SBPTR     YES!
      JSB GETCR     FETCH NEXT
      JMP ACTST       CHARACTER 
      JMP PRIN2 
      SKP 
PRIN4 JSB BCKSP     BACKUP
      JSB BCKUP       POINTERS
      STB SFLAG     ENABLE STRING VARIABLE
      JSB FSC       RECORD FORMULA
      CCB           WAS THIS A
      CPB SFLAG       STRING VARIABLE 
      JSB SNULL         YES, OUTPUT A NULL WORD 
      CPA .10       END-OF-STATEMENT? 
      RSS           YES!
      JMP PRIN2     NO! 
      JSB SNULL     SET END-OF-FORMULA
      JMP ACTST     ACCEPT STATEMENT
      SKP 
*********************************** 
*                                 * 
***  CHECK FOR USING STATEMENT  *** 
*                                 * 
*********************************** 
* 
* 
*  SCAN THE INPUT STRING FOR A USING OPERATOR. IF NONE FOUND, EXIT
*  TO (P+1) WITH THE INPUT STRING AND SYNTAX BUFFER AS UPON ENTRY.
*  OTHERWISE, CHECK FOR A LEGAL OPERATOR FOLLOWING THE 'USING' AND
*  EXIT TO (P+2) AFTER SAVING IT IN THE SYNTAX BUFFER, WITH (A) 
*  = THE NEXT CHARACTER.
* 
***************ADD FOR BUG 790928 MM*************** 
* 
*     HOLD  = TEMPORARY FOR PREVIOUS VALUE OF TEMP8 
*     HOLDF = FLAG TO SHOW THAT HOLD WAS USED DURING THE EXECUTION
*             OF THIS SEGMENT (SET = -32768)
* 
HOLD  BSS 1 
HOLDF BSS 1 
FLAG  DEC -32768
*************************************************** 
* 
USCHK NOP 
***************ADD FOR BUG 790928 MM*************** 
      LDA TEMP8     STORE VALUE OF TEMP8
      STA HOLD        INTO TEMPORARY
      LDA FLAG      SET HOLD FLAG 
      STA HOLDF       TO -32768 
*************************************************** 
      LDA ICCNT     SAVE
      STA TEMP6       INPUT 
      LDA INBFA         BUFFER POINTER
      STA TEMP7           AND 
      LDA SBPTR             OUTPUT
      STA TEMP8               BUFFER POINTERS 
      JSB FILRF     PRINT ON LU?
      JMP USCK4     NO, BACKUP! 
      JMP USCK6     YES!
USCK5 ISZ SBPTR 
      JSB GETCR     GET NEXT CHAR 
      JMP ACTST     NONE FOUND, ACCEPT AS IS
USCK6 CCB           LOOK
      JSB TBSRH     LOOK FOR 'USING'
      DEF USING 
      JMP USCK3     NOT FOUND 
* 
      ISZ USCHK 
      JSB GETCR 
      JMP SYE15     END-OF-STMT FOUND AFTER 'USING' 
      JSB DIGCK     DIGITR
      JMP USCK2     NO, TRY FOR STRING VAR OR CONSTANT
      JSB BCKSP     BACK UP OVER LAST CHAR
      CCB           YES, SET PRGIN FOR EXIT ON ERROR
      STB RFLAG 
      JSB PRGIN     FETCH SEQ NUMBER
      DEF MAXSN 
      CPA .10       END-OF-STMT?
      JMP ACTST     END-OF-STMT 
      JMP USCHK,I   RETURN
* 
USCK2 JSB BCKSP     BACK UP OVER LAST CHAR
      JSB RSTOP     STORE STRING VARIABLE OR STRING CONSTANT
      JMP USCHK,I 
* 
USCK3 LDA TEMP6     RESTORE BUFFER PTR
      STA ICCNT 
      LDA TEMP7 
      STA INBFA 
      LDA TEMP8 
      STA SBPTR 
      JMP USCHK,I 
* 
USCK4 JSB BCKUP     BACKUP
      JSB BCKSP       INPUT AND CODE PTRS!
      JMP USCK5 
* 
*************************** 
*                         * 
*   OUTPUT A NULL WORD    * 
*                         * 
*************************** 
* 
SNULL NOP 
      CLB 
      STB SBPTR,I   STORE 0 IN INTERPRETIVE 
      ISZ SBPTR       BUFFER AREA 
      JMP SNULL,I 
      SKP 
* 
*************************** 
*                         * 
*  SEEK RECORD REFERENCE  * 
*                         * 
*************************** 
* 
*  IF THE NEXT CHARACTER IS NOT '#' THEN RESTORE SBPTR AS UPON
*  ENTRY AND EXIT TO (P+1) WITH THE CHARACTER IN (A). OTHERWISE CHECK 
*  CHARACTER RETURNED IN (A) FROM FILRF. IF IT IS A COMMA OR A
*  SEMICOLON RECORD ITT. EXIT TO (P+2) WITH THE CHARACTER IN (A) IF 
*  IT IS A SEMICOLON. IF A COMMA, PROCESS THE FOLLOWING RECORD
*  REFERENCE AND EXIT TO (P+2) WITH CHARACTER FOLLOWING IT IN (A) 
*  IF A SEMICOLON, RECORD IT BEFORE EXITING.
* 
RECRF NOP 
      JSB FILRF     GET FILE REFERENCE
      JMP RECR1     NONE FOUND
      ISZ RECRF     FOUND 
      CPA B54       COMMA?
      RSS           YES!
      JMP RECR0     NO! 
      LDB B2000     RECORD
      STB SBPTR,I     COMMA 
      JSB FSC       PROCESS RECORD FORMULA
RECR0 LDB B3000 
      CPA B73       SEMICOLON?
      STB SBPTR,I   YES!
      JMP RECRF,I 
RECR1 JSB BCKUP     RESTORE SBPTR 
      JMP RECRF,I 
* 
************************* 
*                       * 
*  SEEK FILE REFERENCE  * 
*                       * 
************************* 
* 
*  IF THE NEXT CHARACTER IS NOT A '#' RETURN TO (P+1) WITH IT IN
*  (A). OTHERWISE RECORD THE FILE REFERENCE AND RETURN TO (P+2) 
*  WITH THE FOLLOWING CHARACTER IN (A). 
* 
FILRF NOP 
      ISZ SBPTR 
      JSB GETCR     NEXT
      JMP FILRF,I 
      CCB             CHARACTER 
      JSB SYMCK 
      DEF UNEQL-1       A '#' SIGN ?
      JMP FILRF,I   NO! 
      JSB FSC       YES, PROCESS FILE FORMULA 
      ISZ FILRF 
      JMP FILRF,I 
      SKP 
**************************
*                        *
* FORMULA SYNTAX CHECKER *
*                        *
**************************
FSC   NOP 
      CLA          SET LEFT PARENTHESIS 
      STA TEMPS,I    COUNT TO ZERO
FSC1  CCA          SET UNARY FLAG 
      STA UFLAG      TO TRUE
      STA TEMP5     SET LEN FLAG OFF
      SPC 1 
*  PROCESS VARIABLE OPERAND 
      SPC 1 
FSC2  JSB VAROP    LOOK FOR VARIABLE OPERAND
      JMP FSC9     NOT FOUND
      JMP FSC13    SUBSCRIPTED OR STRING VARIABLE FOUND 
      JSB PERR      CHECK FOR PARAMETER ERROR 
      JSB LETCK    FOLLOWED BY LETTER?
      JMP FSC6     NO 
      LDB M2       YES, LOOK FOR
      JSB MCBCK      'AND','OR','MIN' OR 'MAX'
      LDB M2        LOOK FOR 'MIN' OR 'MAX' 
      JSB TBSRH 
      DEF MIN 
      RSS           NOT FOUND 
      JMP FSCM
      LDA TEMP1    NOT FOUND, FETCH PREVIOUS
      ALF,ALF        CHARACTER AND LEFT-JUSTIFY IT
      IOR TEMP2    ADD LATEST CHARACTER 
      CPA FN       'FN'?
      JMP FSC4     YES
      JSB BCKSP     GO BACK ONE SPACE 
      LDA TEMP1 
      CCB 
      JSB TBSRH     IS THIS 
      DEF LEN         A LENGTH FUNCTION?
      RSS           NO! 
      JMP FSC15     YES!
      LDB FCNCT      IS FUNCTION IN MNEMONIC TABLE? 
      LDA TEMP1      A = CHARACTER
      JSB TBSRH           FUNCTION
       DEF FCNS 
      JMP FSC16    NOT FOUND
      LDA FCNCT     FOUND FUNCTION SO COMPUTE OFFSET IN 
      CMA,INA        TABLE
      ADA COUNT 
FSC18 ALF 
      IOR FLGBT     ADD FLAG BIT
      JMP FSC5
FSC16 LDB FWAMM,I   GET TABLE LENGTH
      JSB TBSRH     IS THERE
SUBS4 DEF 0           FORTRAN FUNCTION
      JMP FSC3      NO! 
      LDA FRMSK     YES, CODE OCT 36
      CCB             INDICATES 
      ADB SBPTR          A FORTRAN FUNCTION 
      STA TEMP1     SAVE IT 
      LDA 1,I       RETRIEVE PREVIOUS 
      AND OPMSK       OPERATOR
      IOR TEMP1         AND COMBINE WITH FUNCTION 
      STA 1,I             FUNCTION
      STA TEMP7     SET TEMP7 AS FORTRAN FNCT FLAG
      LDA PRPTR,I   IS IT REALLY
      SSA,RSS         A FORTRAN FUNCTION? 
      JSB ERROR     NO! 
SYNE1 EQU * 
      JMP FUNCT     YES,CHECK SYNTAX OF IT
FSC3  ISZ UFLAG    'NOT' PERMITTED? 
      JMP FSC8-2   NO 
      CCB            SEARCH FOR 
      JSB TBSRH         'NOT' 
       DEF NOT
      JMP FSC8-2   'NOT' NOT FOUND
      CCB          RETRIEVE 
      ADB SBPTR      PREVIOUS WORD
      LDA 1,I          WORD 
      AND OPMSK    SET TO 
      STA 1,I        NULL OPERAND 
      JMP FSC14 
      SPC 1 
*  LEN FUNCTION FOUND?
      SPC 1 
FSC15 CLA           SET LEN FLAG! 
      STA TEMP5 
      LDA B37       LEN OP CODE IS FIXED
      JMP FSC18       AT OCT 37 
      SPC 1 
*  PROCESS USER-DEFINED FUNCTIONS (FNA, FNB, ...) 
      SPC 1 
FSC4  JSB GETCR     IDENTIFYING 
      JMP SYNE4       FUNCTION
      JSB LETCK         LETTER? ?q
      JMP SYNE4     NO
      ADA D100      YES,
      ALF             ASSEMBLE AND
FSC5  ADA .15           SAVE
      STA TEMP1           FUNCTION IDENTIFIER 
      CCB           RETRIEVE
      ADB SBPTR       PREVIOUS
      LDA 1,I           PROGRAM WORD
      AND OPMSK     EXTRACT OPERATOR, 
      IOR TEMP1       APPEND OPERAND, 
      STA 1,I            AND RECORD 
      ISZ TEMP5     IS "LEN" FLAG SET?
      JMP FSC17     YES!
      JSB GETCR     LEFT PARENTHESIS
FSCE1 JSB ERROR       OR
      JSB LPCK          LEFT BRACKET? 
      JSB FRCUR     YES, SAVE LOCAL VARIABLES OF FSC
      JSB FSC       FETCH ACTUAL PARAMETER
      JSB FPOP      RESTORE LOCAL VARIABLES OF FSC
      JSB RPCK      FETCH RIGHT PARENTHESIS 
      JMP FSC10+1 
FSC7  LDB M2       CHECK FOR
      JSB SYMCK      RIGHT PARENTHESIS
      DEF RPARN-1      OR RIGHT BRACKET 
      JMP FSC8     NOT FOUND
      LDA B4000     RECORD A
      STA SBPTR,I     RIGHT PARENTHESIS 
      LDA .41       RESTORE RIGHT PARENTHESIS 
      CCB          MATCHING 
      ADB TEMPS,I    LEFT 
      SSB              PARENTHESIS? 
      JMP FSC8     NO 
      STB TEMPS,I  YES
      ISZ SBPTR 
      JSB GETCR    FETCH
      LDA .10 
FSC6  CPA .10       END OF FORMULA? 
      JMP FSC8     YES
      STA UFLAG    NO, SET UNARY FLAG TO FALSE
      LDB M7        SEARCH FOR A MULTICHARACTER 
      JSB MCBCK      BINARY OPERATOR
      LDB MSFLG    SEARCH 
      JSB SYMCK      FOR A
      DEF PLUS-1       BINARY OPERATOR
      CCB,RSS       NOT FOUND 
      JMP FSCM      FOUND 
      JSB SYMCK 
      DEF ASSOP-1     OPERATOR? 
      JMP FSC7     NO 
      LDA M2
      STA SFLAG     YES, SET
      JMP FSC1        'STORE OCCURRED' FLAG 
      JSB GETCR    RETRIEVE LETTER
      LDA .10 
FSC8  LDB TEMPS,I  ALL LEFT PARENTHESES S\
      SZB            MATCHED? 
FSCE2 JSB ERROR     NO
      STB SBPTR,I  YES, RECORD AN 
      ISZ SBPTR      END-OF-FORMULA AND 
      CCB 
      JMP FSC,I        EXIT WITH CHARACTER IN (A) 
      SPC 1 
*  PROCESS "LEN" FUNCTION FOR STRING ARGUMENT 
      SPC 1 
FSC17 JSB GETCR     RECORD
      JMP FSCE1       LEFT
      JSB LPCK          PARENTHESIS 
      JSB LTR       LETTER NEXT?
      JSB ERROR     NO, PARAMETER NOT STRING! 
STER2 CPA B44       YES, FOLLOEWED BY "$"?
      RSS           YES!
      JMP STER2-1   NO, PARAMETER NOT STRING! 
      LDA TEMP1     RECORD
      LDB B53         STRING
      JSB STROP         VARAIABLE 
      CLA           PLACE NULL
      STA SBPTR,I     AFTER PARAMETER 
      ISZ SBPTR 
      JSB GETCR     RECORD
      JMP FSCE2       RIGHT 
      JSB RPCK          PARENTHESIS 
      JMP FSC10+1 
      SPC 1 
*  PROCESS CONSTANT OPERAND 
      SPC 1 
FSC9  CLB           SET SIGN POSITIVE 
      STB SIGN
      JSB NUMCK     NUMBER? 
       JMP FSC11    NO, TRY FOR LEFT PAREN
       JMP NUMER-1
       JMP FSC10    FOUND IT! 
FSC19 LDB M2        SET STORE 
      STB SFLAG       OCCURRED FLAG 
      RSS 
FSC10 JSB NUMOP     YES, FIX UP PRECEDING OPPERATOR 
      LDB M9        UPDATE
      STB MSFLG      MULTIPLE STORE FALG
      JMP FSC6
FSC11 CPA .40       LEFT
      JMP FSC12     PARENTHESIS 
      CPA B133          OR LEFT BRACKET?
      JMP FSC12     YES 
      ISZ UFLAG     NO! 
      SPC 1 
*   PROCESS UNARY OPERATORS 
      SPC 1 
FSCE3 JSB ERROR     NO
      LDB UNMNC 
      CPA .43       '+'?
      JMP *+4       YES 
      CPA .45       NO, '-'?
      JMP *+3       YES 
      JMP FSCE3     NO
      ADB B3000     STORE 
      ISZ SBPTR       UNARY 
      STB SBPTR,I       OPERATOR
FSC14 LDB M9        UPDATE
      STB MSFLG       MULTIPLE STORE FLAG 
      JMP FSC2        FLAG
      SPC 1 
FSC12 ISZ SBPTR     IS LPAR,
      LDA LPARN      RECORD IT
      AND OPMSK       AND 
      ISZ TEMPS,I      COUNT IT 
      STA SBPTR,I 
FSCM  LDB M9        ENTER ON MULTICHAR OPR
      STB MSFLG     UP DATE MULTIPLE STORE FLAG 
      JMP FSC1
      SPC 1 
FSC13 CCB           STRING VARIABLE 
      CPB SFLAG       FOUND?
      JMP FSC,I     YES!
      JMP FSC6      NO! 
      SKP 
**********************************************
*                                            *
* CHECK FOR A MULTICHARACTER BINARY OPERATOR *
*                                            *
**********************************************
MCBCK NOP 
      JSB TBSRH     LOOK FOR 'AND' OR 'OR'
       DEF AND
      JMP MCBCK,I  NOT FOUND YET
      JMP FSCM      FOUND 
********************************
*                              *
* RESTORE FSC LOCAL QUANTITIES *
*                              *
********************************
FPOP  NOP 
      STA TEMP1    SAVE CHARACTER 
      LDB TEMPS 
      ADB M7
      STB TEMPS     RESTORE S-STACK TOP 
      INB 
      LDA 1,I 
      STA MSFLG     RESTORE MULTIPLE STORE FLAG 
      INB 
      LDA 1,I       RESTORE 
      STA PCNT        PARAMETER COUNT 
      INB 
      LDA 1,I       RESTORE FORTRAN 
      STA TEMP7       FUNCTION FLAG 
      INB 
      LDA 1,I 
      STA UFLAG     RESTORE UNARY OPERATOR FLAG 
      INB 
      LDA 1,I 
      STA FSC       RESTORE FSC RETURN ADDRESS
      INB 
      LDA 1,I       RESTORE 
      STA VAROP       VAROP RETURN ADDRESS
      ISZ SFLAG     RESTORE SFLAG VALUE 
      NOP 
      LDA TEMP1     RETRIEVE CHARACTER
      JMP FPOP,I
***************************** 
*                           * 
* SAVE FSC LOCAL QUANTITIES * 
*                           * 
***************************** 
FRCUR NOP 
      LDB TEMPS     FETCH CURRENT S-STACK POINTER 
      INB           UPDATE IT 
      LDA MSFLG     DUMP MULTIPLE STORE 
      STA 1,I         FLAG ON S-STACK 
      INB 
      LDA PCNT      SAVE
      STA 1,I         PARAMETER COUNT 
      INB 
      LDA TEMP7     SAVE FORTRAN
      STA 1,I         FUNCTION FLAG 
      INB 
      LDA UFLAG     STACK UNARY OPERATOR
      STA 1,I         FLAG
      INB 
      LDA FSC       STACK FSC 
      STA 1,I         RETURN ADDRESS
      LDA VAROP     STACK VAROP RETURN ADDRESS
      JSB SSOV        AND CHECK FOR S-STACK OVERFLOW
      CCA 
      ADA SFLAG     DISABLE SFLAG VALUE 
      STA SFLAG 
      JMP FRCUR,I 
      SKP 
**********************************************
*                                            *
* PUT ITEM ON S-STACK AND CHECK FOR OVERFLOW *
*                                            *
**********************************************
SSOV  NOP           STORE QUANTITY
      INB           ADVANCE S-STACK POINTER 
      STA 1,I       SAVE ITEM IN (A)
      INB           ADVANCE S-STACK POINTER 
      STB TEMPS       AND RECORD IT 
      CMB,INB 
      ADB LWBM      LAST WORD 
      SSB             EXCEEDED? 
FSCE4 JSB ERROR     YES 
      JMP SSOV,I
****************************
*                          *
* CHECK FOR SUBSCRIPT PART *
*                          *
****************************
SBSCK NOP          CHARACTER IN (A) 
      CLB           CLEAR CALL SYNTAX 
      STB FROMF       TO-FROM FLAG
      LDB M2       LEFT BRACKET 
      JSB SYMCK      OR 
      DEF LBRAC-1      LEFT PARENTHESIS?
      JMP SBSCK,I  NO, RETURN VIA (P+1) 
      ISZ SBSCK    YES, SET RETURN TO (P+2) 
      LDA ARYAD,I   SET 
      AND M16         ARRAY 
      INA               TO
      STA ARYAD,I         SINGLE SUBSCRIPT
      LDA B2200     RECORD A
      STA SBPTR,I     LEFT BRACKET
      CLB          DIM OR COM 
      CPB DFLAG      STATEMENT? 
      JMP SBSC3    NO 
      CLB           SET 'PRGIN' FOR 
      STB RFLAG      EXIT ON ERROR
      JSB PRGIN     FETCH INTEGER 
      DEF M256        SUBSCRIPT BOUND 
      BLF,BLF       SAVE
      STB TEMP1       BOUND 
      LDB SFLAG     STRING
      CPB M1          VARIABLE? 
      JMP SBSC6     YES!
      CCB           IS THE
      JSB SYMCK      NEXT CHARACTER 
      DEF SCMMA-1      A COMMA? 
      JMP SBSC1     NO
      ISZ ARYAD,I   YES, NOTE SECOND SUBSCRIPT
      JSB PRGIN     FETCH SECOND
      DEF M256        INTEGER SUBSCRIPT BOUND 
      RSS 
SBSC1 CLB,INB       SET ONE-DIMENSIONAL CASE
      ISZ PRFLG    COM STATEMENT? 
      JMP SBSC2    NO 
      STA TEMP2     SAVE CHARACTER
      LDA 1 
      IOR TEMP1     RETRIEVE FIRST BOUND
      JSB MDIM      FIND STORAGE NEED 
      ISZ SFLAG     STRING
      RSS             VARIABLE? 
      JMP SBSC4     YES!
SBSC5 ADA TEMPS+7   UPDATE COM
      SSA           IF SET OVERFLOW *800128*
      JMP FSCE4     ERROR *800128*
      STA TEMPS+7     STORAGE POINTER 
      LDA TEMP2    RETRIEVE NEXT CHARACTER
SBSC2 LDB M2       RIGHT PARENTHESIS
      JSB SYMCK      OR 
      DEF RPARN-1      RIGHT BRACKET? 
      JMP FSCE2     NO
      LDA LF        YES, RECORD A 
      STA SBPTR,I     RIGHT BRACKET 
      ISZ SBPTR    ADJUST S-BUFFER POINTER
      JSB GETCR    FETCH FOLLOWING
      LDA .10         CHARACTER 
      LDB DFLAG     DIM OR COM
      SZB             STATEMENT?
      JMP SBSCK,I   YES 
      JSB FPOP     RESTORE FSC LOCAL VARIABLES
      LDB M2       RESTORE
      ADB TEMPS      S-STACK
      STB TEMPS        POINTER
      INB          FETCH
      LDB 1,I        RETURN ADDRESS 
      JMP 1,I          AND EXIT 
SBSC3 LDA SBSCK     SAVE
      LDB TEMPS      RETURN ADDRESS 
      JSB SSOV           ON S-STACK 
      JSB FRCUR    SAVE FSC LOCAL VARIABLES 
      LDB M9       SET MULTIPLE STORE FLAG
      STB MSFLG      TO FALSE 
      LDA ARYAD     SAVE
      LDB TEMPS       OPERAND 
      JSB SSOV          ADDRESS 
      JSB FSC      GET SUBSCRIPT FORMULA
      JSB BCKUP       ERASE ZERO WORD 
      LDB M2        RESTORE 
      ADB TEMPS       S-STACK 
      STB TEMPS         POINTER 
      INB           RESTORE 
      LDB 1,I         OPERAND 
      STB ARYAD         ADDRESS 
      CCB           IS THE
      JSB SYMCK       NEXT CHARACTER
      DEF SCMMA-1       A COMMA?
      JMP SBSC2     NO
      ISZ ARYAD,I   YES, NOTE SECOND SUBSCRIPT
      JSB FSC       GET SUBSCRIPT FORMULA 
      JSB BCKUP       ERASE ZERO WORD 
      JMP SBSC2 
SBSC4 ARS           ADJUST SIZE 
      INA             OF COMMON 
      ARS               TO EQUAL
      INA                 SPACE FOR CHARS 
      JMP SBSC5             PLUS SPACE FOR SIZE 
* 
SBSC6 LDB TEMP1 
      BLF,BLF       RT JUSTIFY
      ADB M256      IS DIMENSION
      SSB,RSS         GREATER THAN 255 CHARS? 
      JMP STER3-1   YES!
      JMP SBSC1     NO! 
      SPC 1 
      SKP 
******************************************* 
*                                         * 
* TABLE SEARCH FOR MULTICHARACTER SYMBOLS * 
*                                         * 
******************************************* 
TBSRH NOP 
      STA SBPTR,I 
      LDA TBSRH,I 
      RSS           PEEL OFF INDIRECTS
      LDA 0,I 
      RAL,CLE,SLA,ERA 
      JMP *-2 
      ISZ TBSRH 
      STA TABLE     STORE TABLE ADDRESS 
      STB LNGTH     STORE -(NUMBER OF ENTRIES)
      LDA INBFA     SAVE
      STA TEMP3       INPUT 
      LDA ICCNT           BUFFER
      STA TEMP4           STATUS
      LDA SBPTR     INITIALIZE END-OF-SYMBOL
      STA SMEND       POINTER 
      CLA,INA       COUNT FIRST CHARACTER OF
      STA SLENG       SYMBOL
      LDA SBPTR,I   FETCH PARTIAL SYMBOL
      ALF,ALF       LEFT-JUSTIFY
      IOR .32         FIRST CHARACTER AND 
      STA SBPTR,I       APPEND BLANK
TSRC1 JSB GETCR     FETCH NEXT CHARACTER
      JMP TSRC9     END-OF-STATEMENT
      LDB SLENG     CHECK FOR 
      CPB .8          IMPOSSIBLE LENGTH 
      JMP TSRC9 
      SLB           EVEN-NUMBERED CHARACTER?
      JMP TSRC2     YES 
      ISZ SMEND     NO, FETCH FRESH WORD, 
      ALF,ALF         LEFT-JUSTIFY CHARACTER, 
      IOR .32           APPEND BLANK, 
      JMP TSR10 
TSRC2 ADA M32       DELETE BLANK, 
      ADA SMEND,I     FILL SECOND CHARACTER,
TSR10 STA SMEND,I       AND STORE 
      ISZ SLENG     COUNT IT
      LDB LNGTH     INITIALIZE TABLE LENGTH 
      STB COUNT       COUNTER 
      LDA TABLE 
TSRC3 STA TBLPT     SET TABLE POINTER 
      STA PRPTR       PTR AND SAVE IT 
      LDA TBLPT,I   EXTRACT SYMBOL LENGTH 
      AND .7          FROM TABLE AND COMPARE
      CPA SLENG         WITH CURRENT SYMBOL 
      JMP TSRC5     EQUAL?
TSRC4 ADA .3        DIFFERENT,
      ARS             UPDATE
      ADA TBLPT         TABLE POINTER 
      ISZ COUNT     MORE ENTRIES? 
      JMP TSRC3     YES 
      JMP TSRC1     NO
* 
      SKP 
TSRC5 LDB TBLPT     SET POINTER TO
      STB TSPTR       TABLE SYMBOL
      LDB SBPTR     SET (B) TO INPUT
      JMP TSRC7       SYMBOL POINTER
TSRC6 CPB SMEND     ALL OF SYMBOL CONSIDERED? 
      JMP TSRC8     YES, MATCH OCCURRED 
      INB           NO, INCREMENT 
TSRC7 ISZ TSPTR       SYMBOL POINTERS 
      LDA TSPTR,I   FETCH WORD FROM TABLE 
      CPA 1,I       MATCH WITH INPUT SYMBOL?
      JMP TSRC6     YES 
      LDA SLENG     NO, WRONG 
      JMP TSRC4       SYMBOL
TSRC8 LDA TBLPT,I   EXTRACT 
      AND OPMSK       SYMBOL CODE 
      STA SBPTR,I 
      ISZ TBSRH         AND RETURN VIA
      JMP TBSRH,I         'SUCCESS' EXIT
TSRC9 LDA TEMP3     RESTORE 
      STA INBFA       INPUT 
      LDA TEMP4         BUFFER
      STA ICCNT           STATUS
      LDA SBPTR,I   GET ORIGINAL CHAR 
      ALF,ALF        POSITION IT
      AND MSK0        ISOLATE IT
      JMP TBSRH,I   'FAILURE' EXIT
************************************* 
*                                   * 
* CHECK SYNTAX OF ARRAY DEFINITIONS * 
*                                   * 
************************************* 
ARRYS NOP 
      JSB ARRID     FETCH ARRAY IDENTIFIER
      JSB SBSCK     RECORD A SUBSCRIPT
      JSB ERROR     MISSING SUBSCRIPT 
SYE20 CPA .10       END-OF-STATEMENT? 
      JMP ARRYS,I   YES, RETURN VIA (P+1) 
      CCB           NO, 
      JSB SYMCK       MUST BE 
      DEF COMMA-1       A COMMA 
      JMP NOEOF     ISN'T 
      ISZ ARRYS     IS, RETURN
      JMP ARRYS,I     VIA (P+2) 
**************************
*                        *
* FETCH ARRAY IDENTIFIER *
*                        *
**************************
ARRID NOP 
      JSB LTR      FETCH LETTER 
      JMP SYE20-1  NONE FOUND 
      CPA B44       $ ? 
      JMP ARRE1     YES 
ARRE2 LDA SBPTR    NO,SAVE
      STA ARYAD       OPERAND ADDRES
      LDA TEMP1    RECORD 
      LDB .46         ARRAY 
      JSB STROP        IDENTIFIER 
      LDA TEMP2    RETRIEVE FOLLOWING CHARACTER 
      JMP ARRID,I 
ARRE1 LDA SFLAG     STRING VARIABLE 
      CPA SBPTR       PERMITTED 
      CCA,RSS       YES!
      JSB ERROR     STRING NOT PERMMITED
STER5 STA SFLAG     SET FLAG TO 'STRING OCCURRED' 
      LDA TEMP1     RECORD
      LDB B53         STRING
      JSB STROP         VARIABLE
      LDA TEMPS     SET PTR TO DUMMY LOCATION 
      STA ARYAD 
      JSB GETCR     FETCH NEXT CHAR 
      LDA .10 
      JMP ARRID,I 
******************************
*                            *
* CHECK FOR VARIABLE OPERAND *
*                            *
******************************
VAROP NOP 
      JSB LTR       LETTER? 
      JMP VAROP,I   NO, EXIT VIA (P+1)
      ISZ VAROP 
      CPA .40       LEFT PARENTHESIS? 
      JMP VARO5     YES 
      CPA B44       DOLLAR SIGN?
      JMP VARO6     YES, STRING VARAIBLE! 
      CPA B133      NO, LEFT BRACKET? 
      JMP VARO5     YES 
      ISZ VAROP     NO
      JSB DIGCK    DIGIT? 
      JMP VARO1     NO
      LDA TEMP1    YES, RETRIEVE LETTER,
      ADB .48       AND RESTORE ASCII DIGIT 
      STB TEMP1 
      JSB STROP     RECORD VARIABLE 
      JSB GETCR    FETCH FOLLOWING
      LDA .10         CHARACTER 
      JMP VARO2 
VARO1 LDA TEMP1    RETRIEVE LETTER, 
      LDB .47         SET 'NO DIGIT', 
      JSB STROP        AND RECORD VARIABLE
      LDA TEMP2     RETRIEVE FOLLOWING CHARACTER
VARO2 STA TEMP2     SAVE CHARACTER
      CLB           INSIDE A
      CPB PRFLG       DEF STATEMENT?
      JMP VAROP,I   NO, EXIT VIA (P+3)
      CCB 
      ADB SBPTR       RETRIEVE
      LDA 1,I 
      AND MSK1          OPERAND 
      CPA PRFLG     MATCH PARAMETER?
      JMP VARO4     YES 
VARO3 LDA TEMP2     NO, RETRIEVE
      JMP VAROP,I     CHARACTER AND EXIT VIA (P+3)
VARO4 LDA 1,I       SET OPERAND TO
      IOR FLGBT       ACTUAL PARAMETER
      STA 1,I           AND RECORD IT 
      JMP VARO3 
VARO5 LDA SBPTR     SAVE
      STA ARYAD       OPERAND ADDRESS 
      LDA TEMP1     RETRIEVE LETTER 
      LDB .46       RECORD
      JSB STROP       ARRAY IDENTIFIER
      LDA B133      RETRIEVE LEFT BRACKET 
VARO7 JSB SBSCK     FETCH SUBSCRIPT 
      NOP 
      JMP VAROP,I   EXIT VIA (P+2)
      SPC 1 
VARO6 LDA SFLAG     STRING VARIABLE PERMITTED 
      CPA SBPTR 
      CCA,RSS       YES!
      JSB ERROR     NO, ILLEGAL STRING VARIABLE!
STER1 STA SFLAG     SET SFLAG TO 'STRING OCCURRED'
      LDA TEMP1     RECORD STRING VARIABLE
      LDB B53 
      JSB STROP 
      LDA TEMPS     SET POINTER TO DUMMY
      STA ARYAD       LOCATION
      JSB GETCR     GET 
      LDA .10         NEXT CHARACTER
      JMP VARO7     FETCH SUBSCRIPT 
      SKP 
******************
*                *
* FETCH A LETTER *
*                *
******************
LTR   NOP 
      JSB GETCR 
      LDA .10 
      JSB LETCK    LETTER?
      JMP LTR,I    NO, EXIT VIA (P+1) 
      ISZ LTR      YES, 
      STA TEMP1      SAVE IT
      JSB GETCR    NEXT CHARACTER 
      LDA .10         TO (A)
      STA TEMP2     SAVE SECOND CHARACTER 
      JMP LTR,I    EXIT VIA (P+2) 
************************* 
*                       * 
* STORE AN OPERAND NAME * 
*                       * 
************************* 
STROP NOP           LETTER IN (A), NUMBER IN (B)
      ADA D100      NUMERICALLY ADJUST THE
      ADB D53         OPERAND NAME
      ALF           COMBINE THE 
      IOR 1           TWO PARTS 
      IOR SBPTR,I   COMPLETE OPERAND-OPERATOR PAIR
      STA SBPTR,I     AND STORE IT
      ISZ SBPTR     UPDATE S-BUFFER POINTER 
      JMP STROP,I 
******************************
*                            *
* CHECK FOR LEFT PARENTHESIS *
*                            *
******************************
LPCK  NOP           CHARACTER IN (A)
      LDB M2        LEFT PARENTHESIS
      JSB SYMCK       OR
      DEF LBRAC-1       LEFT BRACKET? 
      JMP FSCE1     NO
      LDA B2300     YES, RECORD A 
      STA SBPTR,I     LEFT PARENTHESIS
      JMP LPCK,I    EXIT
**************************
*                        *
* BACK UP SYNTAX POINTER *
*                        *
**************************
BCKUP NOP 
      CCB           DECREMENT 
      ADB SBPTR       SYNTAX POINTER
      STB SBPTR         BY 1
      JMP BCKUP,I 
      SKP 
******************************* 
*                             * 
* CHECK FOR RIGHT PARENTHESIS * 
*                             * 
******************************* 
RPCK  NOP 
      LDB M2       RIGHT PARENTHESIS
      JSB SYMCK      OR 
      DEF RPARN-1      RIGHT BRACKET? ?
      JMP FSCE2     NO
      LDA B4000     YES, RECORD A 
      STA SBPTR,I     RIGHT PARENTHESIS 
      ISZ SBPTR    UPDATE SYNTAX BUFFER POINTER 
      JSB GETCR    FETCH
      LDA .10         FOLLOWING CHARACTER 
      JMP RPCK,I
* 
************************* 
*                       * 
* RECORD STRING FORMULA * 
*                       * 
************************* 
* 
* DEMAND A STRING VARIABLE OR A STRING CONSTANT. EXIT TO
* ERROR IF NEITHER IS FOUND, ELSE EXIT WITH THE NEXT CHAR-
* ACTER IN (A). 
* 
RSTOP NOP 
      LDA SBPTR     SEEK
      STA SFLAG       STRING
      JSB VAROP         OPERAND 
      JMP RSTO1     FIRST CHARACTER NOT LETTER
      ISZ SFLAG     STRING VARIABLE?
      JMP STER1-1   NO STRING FOUND!
      JMP RSTOP,I 
      SPC 1 
RSTO1 ISZ SBPTR 
      JSB GETST     DEMAND STRING CONSTANT
      JMP RSTOP,I 
      SKP 
*************************** 
*                         * 
* FETCH A STRING CONSTANT * 
*                         * 
*************************** 
* 
* EXIT TO ERROR IF (A) # " UPON ENTRY. ELSE SAVE CURRENT PTR
* AND PACK INPUT STRING INTO BUFFER WORD. EXIT TO ERROR IF NO 
* CLOSING " IS FOUND. RECORD OPENING " ALONG WITH COUNT OF
* THE STRING CHARS AND EXIT WITH THE NEXT CHARACTER IN (A). 
* EXIT TO ERROR IF STRING EXCEEDS 255 CHARACTERS. 
* 
GETST NOP 
      LDB SBPTR     SAVE SYNTAX BUF PTR 
      STB ARYAD 
      CCB           LOOK FOR
      JSB SYMCK       QUOTE AND RECORD
       DEF QUOTE-1      OPERATOR
      JMP STER1-1   NO STRING FOUND!
      LDA B42       SET QUOTE AS TERMINATOR 
      JSB CHRST     RECORD STRING CONSTANT
      LDA ARYAD,I   CHECK FOR 
      ADA M1400       TOO MANY CHARACTERS 
      SSA,RSS 
      JSB ERROR     YES!
STER3 JSB GETCR     NO,FETCH NEXT CHAR
      LDA .10       END-OF-STATEMENT
      JMP GETST,I 
      SKP 
*************************************** 
*                                     * 
* FLAG OPERATOR WHICH PRECEDES NUMBER * 
*                                     * 
*************************************** 
NUMOP NOP 
      STA TEMP4 
      LDB M3        FETCH 
      ADB SBPTR       PRECEDING 
      LDA 1,I           OPERATOR
      IOR FLGBT     ADD FLAG BIT
      STA 1,I       REPLACE OPERATOR
      LDA TEMP4 
      JMP NUMOP,I 
************************************
*                                  *
* FETCH AND RECORD PROGRAM INTEGER *
*                                  *
************************************
PRGIN NOP 
      LDA SBPTR,I   SET 
      IOR FLGBT       'INTEGER
      ADA .3             FOLLOWS' 
      STA SBPTR,I          OPERAND
      LDA PRGIN,I   GIVE ADDRESS
      STA PRGI1       TO INTCK
      ISZ SBPTR 
      ISZ PRGIN 
      JSB GETCR 
      JMP PRGI2 
      JSB INTCK     FETCH 
PRGI1 NOP 
      RSS 
      JMP PRGIN,I   RETURN VIA P+2
PRGI2 ISZ RFLAG     RETURN ON ERROR?
SYE25 JSB ERROR     NO
      ISZ PRGIN     YES 
      JMP PRGIN,I   RETURN VIA P+3
****************************
*                          *
* PROCESS CHARACTER STRING *
*                          *
****************************
CHRST NOP 
      STA TEMP2     REM SENDS US (A)=B200 
      LDB SBPTR     SAVE PTR TO CHAR COUNT WORD 
      STB TEMP9 
      SZA           IF A=0 SUPPRESS BLANKS
      STB BLANK     ANYTHING GOES ON INPUT
      JSB GETCR     FIRST CHAR CAN EVEN BE TERMINATOR 
       JMP CHRS5    NO MORE CHARS 
      CPA TEMP2     TERMINATOR? 
      JMP CHRS3     YES!
CHRS1 ISZ TEMP9,I   INCREMENT CHAR COUNT
      ALF,ALF 
      ISZ SBPTR 
      STA SBPTR,I   STORE IN LEFT HALF OF WORD
      JSB CHRS2     GET A CHARACTER BUT NOT TERMINATOR
      ISZ TEMP9,I   INCREMENT CHAR COUNT
      IOR SBPTR,I 
      STA SBPTR,I   STORE RIGHT HALF IN WORD
      JSB CHRS2     GET A CHARACTER BUT NOT TERMINATOR
      JMP CHRS1 
      SPC 1 
CHRS2 NOP 
      JSB GETCR     GET NEXT CHARACTER
       JMP CHRS5    NO MORE CHARACTERS
      CPA TEMP2     TERMINATOR CHARCTER?
CHRS3 CLA,RSS       YES!
      JMP CHRS2,I 
      ISZ SBPTR 
      STA SBPTR,I   NULL OPERATOR FOLLOWS STRING
      LDA .32 
      STA BLANK     BEGIN IGNORING BLANKS AGAIN 
      JMP CHRST,I 
      SPC 1 
CHRS5 JSB BCKSP     IN CASE WE NEED TO SENSE THIS LATER 
      LDA TEMP2 
      CPA B200      ARE WE DOING A REM
      JMP CHRS3     YES, ALL OK!
      SZA,RSS       DOING A FILES STMT? 
      JMP CHRS3     YES!
      LDA .32       RESTORE BLANK 
      STA BLANK       DELIMITER 
*********************ADDED 800318*********************************
      LDA FLAG
      CPA HOLDF     CHECK FOR FROM PRINT
      RSS           YES RESET CHAR. COUNT 
      JMP USHLD     NO
      LDA HOLD
      STA TEMP8 
USHLD CLA 
      STA HOLDF     CLEAR FLAG
**************************800318**********************************
      JSB ERROR     NO, MISSING TERMINATOR
SYE14 EQU * 
* 
********************
*                  *
* DELETE STATEMENT *
*                  *
********************
DLLIN LDA .LNUM     GET CURRENT LINE #
      RSS             AND DELETE IT 
DLSTM LDA SBUFA,I   LOAD SEQUENCE NUMBER
      JSB FNDPS     FIND STATEMENT TO BE DELETED
      JMP PEXMK     DOESN'T 
      JMP PEXMK      EXIST
      CLA           ZERO WORD SKIP FOR DESTINATION
      STB LOLIM 
      INB           ADDRESS OF SOURCE WORD SKIP IN B
      JSB CLPRG     CLOSE UP PROGRAM
      LDA LOLIM,I   SET UP
      STA .LNUM       TO
      INA 
      JSB FNDPS         LIST
      NOP                 NEXT
      NOP 
      STB HILIM             STATEMENT 
      JMP PLIST 
      SKP 
********************
*                  *
* ACCEPT STATEMENT *
*                  *
********************
ACTST LDA SBUFA     COMPUTE 
      CMA,INA         LENGTH
      ADA SBPTR         OF STATEMENT
      STA TEMP,I          AND RECORD IT 
      LDA SBUFA,I   LOAD SEQUENCE NUMBER
      JSB FNDPS     SEARCH ON SEQUENCE NUMBER 
      JMP ACCS1     APPEND STATEMENT TO PROGRAM 
      JMP ACCS4     INSERT STATEMENT IN PROGRAM 
      INB           REPLACE STATEMENT IN PROGRAM
      LDA MERGF     IS MERGE
      SSA             FLAG SET? 
      JMP PEXMK     YES, DON'T OVERLAY OLD STMT 
      LDA 1,I       COMPARE LENGTHS OF
      CMA,INA         STATEMENT BEING REPLACED
      ADA TEMP,I        AND STATEMENT 
      SZA,RSS             REPLACING IT
      JMP ACCS2     EQUAL 
      SSA,RSS 
      JMP ACCS4+1   SHORTER 
      LDA TEMP,I    LONGER, 
      JSB CLPRG       CLOSE UP PROGRAM
      JMP ACCS2 
ACCS1 LDA TEMP,I    LOAD PROGRAM SPACE REQUIREMENT
      JSB OVCHK     SUFFICIENT PROGRAM SPACE LEFT?
ACCS2 CLB           YES, SET COUNTER TO ZERO
      LDA SBUFA     INITIALIZE
      STA TEMP2       SOURCE ADDRESS
ACCS3 LDA TEMP2,I   TRANSFER WORD FROM
      STA TEMP3,I     S-BUFFER TO PROGRAM SPACE 
      ISZ TEMP2     INCREMENT SOURCE AND
      ISZ TEMP3       DESTINATION ADDRESSES 
      INB           BUMP COUNTER
      CPB TEMP,I    ENTIRE STATEMENT MOVED? 
      JMP ACCS5     YES 
      JMP ACCS3     NO
ACCS4 LDA TEMP,I    LOAD PROGRAM SPACE REQUIREMENT
      JSB OVCHK     SUFFICIENT PROGRAM SPACE LEFT?
      JSB MVTOH     MAKE
      JMP ACCS2       ROOM
* 
ACCS5 LDA .INBF     MOVE
      LDB .OTBF       STATEMENT 
      JSB MVW           TO
      DEC 40              OUTPUT ***CHG FOR BUG 790928 MM***
      NOP                   BUFFER FOR CHAR EDITTING
***************ADD FOR BUG 790928 MM*************** 
      LDA FLAG      IS HOLDF = FLAG 
      CPA HOLDF 
      JMP LDHLD       YES, LOAD HOLD INTO TEMP8 
      LDA TEMP8       NO, USE TEMP8 AS IS AND 
      JMP CMPLT           CONTINUE AS BEFORE
LDHLD LDA HOLD      RESTORE TEMP8 
      STA TEMP8       WITH HOLD VALUE 
CMPLT STA HOLDF      TO DESTROY THE HOLD FLAG *800206*
      CMA 
*************************************************** 
*     LDA TEMP8               FOR CHAR ***DEL FOR BUG 790928 MM***
*     CMA                       EDITTING ***DEL FOR BUG 790928 MM***
      STA OCCNT 
      JMP PEXMK     EXIT THIS PHASE 
*************************** 
*                         * 
* DELETE SPACE IN PROGRAM * 
*                         * 
*************************** 
CLPRG NOP           REFERENCE LOCATION IN TEMP3 
      ADA TEMP3     SKIP (A) LOCATIONS FROM TEMP3 
      STA TEMP4       AND SAVE DESTINATION ADDRESS
      LDB 1,I       SKIP TO END OF STATEMENT BEING
      ADB TEMP3       DELETED, SOURCE ADDRESS IN (B)
CLPR1 CPB PBPTR     ALL OF PROGRAM MOVED? 
      JMP CLPR2     YES 
      LDA 1,I       NO, MOVE WORD FROM SOURCE TO
      STA TEMP4,I     DESTINATION ADDRESS 
      ISZ TEMP4     INCREMENT DESTINATION ADDRESS 
      INB           INCREMENT SOURCE ADDRESS
      JMP CLPR1 
CLPR2 LDA TEMP4     SET END-OF-PROGRAM
      STA PBPTR       POINTER 
      JMP CLPRG,I 
************************************
*                                  *
* CHECK FOR PROGRAM SPACE OVERFLOW *
*                                  *
************************************
OVCHK NOP           NEW WORD REQUIREMENT IN (A) 
      LDB PBPTR     SET SOURCE ADDRESS
      STB TEMP2       FOR PROGRAM RELOCATION
      ADB 0         SET DESTINATION 
      STB TEMP4       ADDRESS 
      CMB,INB       ENOUGH
      ADB LWBM        FREE
      SSB               SPACE?
      JMP FSCE4     NO, PROGRAM SPACE OVERFLOW
      LDB TEMP4     YES, RELOCATE FREE
      STB PBPTR       PROGRAM SPACE POINTER 
      JMP OVCHK,I 
* 
* 
* 
*  MOVE WORDS ROUTINE 
* 
*    CALLING SEQ IS:    A=SOURCE ADDRESS
*                       B=DESTINATION ADDRESS 
* 
*     (P)           JSB MVW 
*     (P+1)         COUNT OF WORDS
*     (P+2)         NOP 
*     (P+3)         RETURN HERE 
* 
MVW   NOP 
      STA TEMP4     SAVE SOURCE ADDRS 
      LDA MVW,I     GET COUNT 
      CMA,INA         AND USE 
      ISZ MVW           AS COUNTER
      STA MVW,I           FOR MOVE
MVW1  LDA TEMP4,I   GET WORD
      STA 1,I       PUT AWAY
      ISZ TEMP4     INCREMENT SOURCE ADDR 
      INB           INCREMENT DESTINATION ADDR
      ISZ MVW,I     INCREMENT COUNTER, DONE?
      JMP MVW1      NO, NOT YET 
      ISZ MVW       YES 
      JMP MVW,I 
      SKP 
*********************** 
*                     * 
* PRINT ERROR MESSAGE * 
*                     * 
*********************** 
ERROR NOP 
      LDA MERGF     IF FLAG IS
      SSA,RSS         SET THEN CHECK FOR = LINE #'S 
      JMP ERRO1     NOT SET 
* 
      LDA .LNUM     YES, SEARCH 
      JSB FNDPS       PROGRAM TO SEE
      NOP               THERE IS ALREADY
      RSS                 A STMT WITH THIS LINE NUMBER
      JMP PEXMK     FOUND ONE, IGNORE ERROR THEN
* 
ERRO1 LDB ERROR     ERROR SOURCE IN (B) 
      LDA ERBS      ERROR ADDRESS IN (A)
      INA           MOVE TO NEXT ERROR
      CPB 0,I       SAME AS ACTUAL ERROR? 
      CMA,INA,RSS   YES, MAKE ERROR NEGATIVE
      JMP *-3       NO
      ADA ERBS      MAKE ERROR POSITIVE 
      CMA,INA 
      STA TEMP3     SAVE IT 
      JMP OUTER     PRINT ERROR MESSAGE 
*************** 
*             * 
* ERROR TABLE * 
*             * 
*************** 
ERR   DEF NUMER     ILLEGAL EXPONENT
      DEF SYNE1     NOT A FORTRAN FUNCTION
      DEF SYNE2     MISSING ASSIGNMENT OPERATOR 
      DEF SYNE3     NOT A SUBROUTINE CALL 
      DEF SYNE4+1   MISSING OR BAD FUNCTION NAME
      DEF SYNE5     MISSING OR BAD SIMPLE VARIABLE
      DEF SYNE6     MISSING OR BAD TRAP NUMBER
      DEF SYNE7     MISSING OR ILLEGAL 'THEN' 
      DEF SYNE8     MISSING OR ILLEGAL 'OF' 
      DEF SYNE9     MISSING OR ILLEGAL 'TO' 
      DEF SYE10     MISSING OR ILLEGAL 'STEP' 
      DEF CALER     MISSING OR ILLEGAL SUBROUTINE 
      DEF SYE11+1   TOO MANY PARAMETERS 
      DEF SYE12     MISSING OR ILLEGAL DATA ITEM
      DEF SYE13     ILLEGAL READ OR INPUT VARIABLE
      DEF SYE14     NO CLOSING QUOTE
      DEF SYE15+1   MISSING OR BAD LIST DELIMITER 
      DEF SYE16     ILLEGAL PARAMETER 
      DEF STER1     ILLEGAL STRING VARIABLE 
      DEF STER2     PARAMETER NOT STRING
      DEF SYE20     MISSING OR ILLEGAL SUBSCRIPT
      DEF STER3     STRING LONGER THAN 255 CHARACTERS 
      DEF STER4     ILLEGAL STRING RELATIONAL OPERATOR
      DEF STER5     STRING NOT PERMMITED
      DEF FSCE1+1   MISSING LEFT PARENTHESIS
      DEF FSCE2+1   MISSING RIGHT PARENTHESIS 
      DEF FSCE3+1   UNRECOGNIZED OPERAND
      DEF ARRE2     MISSING OR BAD ARRAY IDENTIFIER 
      DEF SYE25+1   MISSING OR BAD INTEGER
      DEF SYE26     SIGN WITHOUT NUMBER 
      DEF NOEOF+1   CHARACTERS AFTER STATEMENT END
      DEF FSCE4+1   OUT OF CORE DURING SYNTAX 
      DEF MER9      ARRAY TOO LARGE 
      DEF SYE27     NO FILE REFERENCE FOUND 
      SKP 
******************************************
*                                        *
* FIND AND STORE ONE-CHARACTER OPERATORS *
*                                        *
******************************************
SYMCK NOP           CHARACTER IN (A)
      STB COUNT     -(ENTRIES TO BE SEARCHED) 
      ALF,ALF       POSITION
      IOR .32         CHARACTER 
      LDB SYMCK,I   STARTING TABLE ENTRY - 2
      ISZ SYMCK     SET RETURN ADDRESS
SYMC1 ADB .2        UPDATE TABLE POINTER
      CPA 1,I       MATCH?
      JMP SYMC2 
      ISZ COUNT     NO, CONTINUE SEARCH?
      JMP SYMC1     YES 
      ALF,ALF       NO, RESTORE 
      AND B177        CHARACTER 
      JMP SYMCK,I       AND EXIT
SYMC2 CCA           GET 
      ADA 1           INFORMATION 
      LDA 0,I           WORD
      AND OPMSK           AND 
      STA SBPTR,I           STORE IT
      CPA B1400 
      JMP FSC14 
      ISZ SYMCK     RETURN VIA
      JMP SYMCK,I     (P+2) 
      SKP 
****************************
*                          *
* COMPUTE STORAGE OF ARRAY *
*                          *
****************************
MDIM  NOP 
      STA 1         STORE PACKED DIMS. TEMPORALILY
      AND MSK0
      STA COUNT     STORE # COLUMNS 
      LDA 1 
      ALF,ALF 
      AND MSK0      A = # OF ROWS 
      ALS           DOUBLE FOR FLOATING POINT 
      MPY COUNT     COMPUTE 2*ROWS*COLUMS 
      SSA           RESULT < 32768 ?
      JSB ERROR     NO, ERROR DIMENSIONS TOO LARGE
MER9  JMP MDIM,I    YES, RETURN 
* 
TEMP  EQU TEMPS+1 
TEMP1 EQU TEMPS+2 
TEMP2 EQU TEMPS+3 
TEMP3 EQU TEMPS+4 
TEMP4 EQU TEMPS+5 
TEMP5 EQU TEMPS+6 
TEMP6 EQU TEMPS+7 
TEMP7 EQU TEMPS+8 
TEMP8 EQU TEMPS+9 
TEMP9 EQU TEMPS+10
PCNT  EQU TEMPS+11
COUNT EQU TEMPT+1 
SFLAG EQU TEMPT+2 
CCODE EQU TEMPT+2 
ARYAD EQU TEMPT+3 
RFLAG EQU TEMPT+4 
TABLE EQU TEMPT+4 
SMEND EQU TEMPT+5 
SLENG EQU TEMPT+6 
TBLPT EQU TEMPT+7 
TSPTR EQU TEMPT+8 
LNGTH EQU TEMPT+9 
PRPTR EQU TEMPT+10  PARAMETER PTR 
TCCNT EQU TEMPT+11  ORDINAL NUMBER OF SUBROUTINE
FROMF EQU TEMPT+12  FROM SUB. PARAMETER FLAG
TOFRM EQU TEMPT+13  TO/FROM WORD
* 
      END BASC1