**
***  RESTORE FSC LOCAL QUANTITIES  **
**
FPOP  NOP
      STA TEMP1    SAVE CHARACTER
      LDB TEMPS
      ADB M5
      STB TEMPS     RESTORE S-STACK TOP
      INB
      LDA 1,I
      STA MSFLG     RESTORE MULTIPLE STORE 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
      LDA TEMP1     RETRIEVE CHARACTER
      JMP FPOP,I
**
***  SAVE LOCAL QUANTITIES OF FSC  **
**
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 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
      JMP FRCUR,I
**
***  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)
      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
      JSB PGINT,I   FETCH INTEGER
      DEF M256        SUBSCRIPT BOUND
      BLF,BLF       SAVE
      STB TEMP1       BOUND
      CCB           IS THE
      JSB SYMCK      NEXT CHARACTER
      DEF SCMMA-1      A COMMA?
      JMP SBSC1     NO
      ISZ ARYAD,I   YES, NOTE SECOND SUBSCRIPT
      JSB PGINT,I   FETCH SECOND
      DEF M256        INTEGER SUBSCRIPT BOUND
      RSS
SBSC1 CLB,INB       SET ONE-DIMENSIONAL CASE
      ISZ PFLAG    COM STATEMENT?
      JMP SBSC2    NO
      STA TEMP2     SAVE CHARACTER
      LDA 1
      IOR TEMP1     RETRIEVE FIRST BOUND
      JSB MDIM      FIND STORAGE NEED
      ADA TEMPS+7   UPDATE COM
      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
      CCB          CANCEL
      ADB SBPTR      END-OF-FORMULA
      STB SBPTR          OPERATOR
      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
      CCB           CANCEL
      ADB SBPTR      END-OF-FORMULA
      STB SBPTR          OPERATOR
      JMP SBSC2
      SKP
**
***  CHECK SYNTAX OF ARRAY DEFINITIONS  **
**
ARRYS NOP
      JSB ARRID     FETCH ARRAY IDENTIFIER
      JSB SBSCK     RECORD A SUBSCRIPT
      JSB ERROR     MISSING SUBSCRIPT
ARRE1 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
      JSB ERROR    NONE FOUND
ARRE2 LDA SBPTR     SAVE
      STA ARYAD       OPERAND ADDRES
      LDA TEMP1    RECORD
      LDB .46         ARRAY
      JSB STROP        IDENTIFIER
      LDA TEMP2    RETRIEVE FOLLOWING CHARACTER
      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 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 PFLAG       DEF STATEMENT?
      JMP VAROP,I   NO, EXIT VIA (P+3)
      CCB
      ADB SBPTR       RETRIEVE
      LDA 1,I
      AND MSK1          OPERAND
      CPA PFLAG     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
      JSB SBSCK     FETCH SUBSCRIPT
      NOP
      JMP VAROP,I   EXIT VIA (P+2)
**
***  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
      SKP
**
***  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
**
***  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
**
***  FETCH MAT STATEMENT SUBSCRIPT  **
**
MATSB NOP
      LDB M2        LEFT PARENTHESIS
      JSB SYMCK       OR
      DEF LBRAC-1       LEFT BRACKET?
      JMP MATSB,I   NO
      ISZ MATSB     YES, SET RETURN ADDRESS
      LDA B2200     RECORD A
      STA SBPTR,I     LEFT BRACKET
      JSB FSC       FETCH SUBSCRIPT
      CCB
      JSB SYMCK     COMMA?
      DEF COMMA-1
      RSS           NO
      JSB FSC       YES, FETCH SUBSCRIPT
      LDB M2        RIGHT PARENTHESIS
      JSB SYMCK       OR
      DEF RPARN-1       RIGHT BRACKET
      JMP FSCE2
      LDA LF        RECORD A
      STA SBPTR,I     RIGHT BRACKET
      ISZ SBPTR
      JSB GETCR     END-OF-STATEMENT?
      JMP ACCST,I   YES
      JMP MATSB,I
      SKP
**
***  FETCH PARENTHESIZED FORMULA  **
**
GETPF NOP
      JSB GETCR
      JMP EOF
      ISZ SBPTR
      JSB LPCK      FETCH LEFT PARENTHESIS
      JSB FSC       FETCH FORMULA
      JSB RPCK      GET RIGHT PARENTHESIS
      JMP GETPF,I
**
***  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
      SKP
*
*   SYSTEM COMMAND TABLE
*
SYCMD OCT 00003
      ASC 2,RUN     EXECUTE PROGRAM
*
      OCT 02003
      ASC 2,SCR     SCRATCH PROGRAM
*
      OCT 03004
      ASC 2,LIST    LIST COMMAND
*
      OCT 05005
      ASC 3,PLIST   PUNCH LIST COMMAND
*
      OCT 12003
      ASC 2,PTA     ACTIVATE PHOTO-READER
*
      OCT 33004
STCMD ASC 2,STOP    ABORT CURRENT ACTIVITY
*
      OCT 46003
      ASC 2,TAP     ACTIVATE TTY TAPE MODE
*
      OCT 50003
      ASC 2,BYE     EXIT SYSTEM
**
***  PRINT NAME TABLE FOR OPERATORS  **
**
LET   OCT 32003     BITS 15-9 OF THE LABELLED WORD
      ASC 2,LET
DIM   OCT 33003     ARE THE BASIC CODE OPERATOR
      ASC 2,DIM
COM   OCT 34003     NUMBERS.  BITS 2-0 ARE THE
      ASC 2,COM
DEF   OCT 35003     LENGTH IN CHARACTERS OF THE
      ASC 2,DEF
REM   OCT 36003     SYMBOL.  THE ASCII VERSION OF
      ASC 2,REM
GOTO  OCT 37004     THE SYMBOL FOLLOWS.
      ASC 2,GOTO
IF    OCT 40002
      ASC 1,IF
FOR   OCT 41003
      ASC 2,FOR
NEXT  OCT 42004
      ASC 2,NEXT
GOSUB OCT 43005
      ASC 3,GOSUB
RTRN  OCT 44006
      ASC 3,RETURN
END   OCT 45003
      ASC 2,END
STP   OCT 46004
      ASC 2,STOP
WAIT  OCT 47004
      ASC 2,WAIT
CALL  OCT 50004
      ASC 2,CALL
DATA  OCT 51004
      ASC 2,DATA
READ  OCT 52004
      ASC 2,READ
PRINT OCT 53005
      ASC 3,PRINT
INPUT OCT 54005
      ASC 3,INPUT
RSTOR OCT 55007
      ASC 4,RESTORE
MAT   OCT 56003
      ASC 2,MAT
THEN  OCT 57004
      ASC 2,THEN
TO    OCT 60002
      ASC 1,TO
STEP  OCT 61004
      ASC 2,STEP
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,<>
*
TAB   OCT 1003
      ASC 2,TAB
SIN   OCT 2003      THIS SECTION HAS THE PRE-DEFINED
      ASC 2,SIN
COS   OCT 3003      FUNCTIONS.  HERE BITS 13-9 ARE
      ASC 2,COS
TAN   OCT 4003      THE IDENTIFYING NUMBER OF THE
      ASC 2,TAN
ATN   OCT 5003      FUNCTION.
      ASC 2,ATN
EXPN  OCT 6003
      ASC 2,EXP
LOG   OCT 7003
      ASC 2,LOG
ABS   OCT 10003
      ASC 2,ABS
SQR   OCT 11003
      ASC 2,SQR
INT   OCT 12003
      ASC 2,INT
RND   OCT 13003
      ASC 2,RND
SGN   OCT 14003
      ASC 2,SGN
ZER   OCT 15003     MATRIX FUNCTIONS
      ASC 2,ZER
CON   OCT 16003
      ASC 2,CON
IDN   OCT 17003
      ASC 2,IDN
INV   OCT 20003
      ASC 2,INV
TRN   OCT 21003
      ASC 2,TRN
**
***  TABLE SEARCH FOR MULTICHARACTER SYMBOLS  **
**
TBSRH NOP
      STA TABLE     STORE TABLE ADDRESS
      STB LNGTH     STORE -(NUMBER OF ENTRIES)
      LDA BADDR     SAVE
      STA TEMP3       INPUT
      LDA CCNT          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
      AND B177      TWO
      CPA SBPTR,I     CHARACTERS?
      RSS           NO
      JMP TSR10     YES
      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 .7          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,
      STA SMEND,I         AND STORE
      JMP TSR10
TSRC2 ADA M32       DELETE BLANK,
      ADA SMEND,I     FILL SECOND CHARACTER,
      STA SMEND,I       AND STORE
TSR10 ISZ SLENG     COUNT IT
      LDB LNGTH     INITIALIZE TABLE LENGTH
      STB COUNT       COUNTER
      LDA TABLE
TSRC3 STA TBLPT     SET TABLE POINTER
      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
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 BADDR       INPUT
      LDA TEMP4         BUFFER
      STA CCNT            STATUS
      JMP TBSRH,I   'FAILURE' EXIT
**
***  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
      JSB GETCR
SYE25 JSB ERROR
      JSB INTCK     FETCH
PRGI1 NOP
      ISZ PRGIN
      JMP PRGIN,I
**
***  BUILD AN INTEGER  **
**
INTCK NOP           CHARACTER IN (A)
      CLB           STORE
      STB INTGR       PARTIAL RESULT
INTC1 JSB DIGCK     DIGIT?
      JMP INTC2     NO
      CLO
      LDB INTGR     MULTIPLY
      ADB 1           PARTIAL
      ADB 1             RESULT
      ADB INTGR           BY
      ADB 1                 10
      ADB 0         ADD LATEST DIGIT
      SOC           OVERFLOW?
      JMP SYE25     YES
      STB INTGR     STORE PARTIAL RESULT
      JSB GETCR     NO, FETCH
      LDA .10         NEXT CHARACTER
      JMP INTC1
INTC2 LDB INTGR     ZERO
      SZB,RSS         INTEGER?
      JMP SYE25     YES
      STB SBPTR,I   NO, RECORD IT
      LDB INTCK,I   INTEGER
      LDB 1,I         TOO
      ADB INTGR         LARGE?
      SSB,RSS
      JMP SYE25     YES
      LDB INTGR     NO,
      ISZ SBPTR       RETURN WITH
      ISZ INTCK         INTEGER
      JMP INTCK,I         IN (B)
**
***  PROCESS CHARACTER STRING  **
**
CHRST NOP
      STA TEMP2     RECORD TERMINATOR CHARACTER
      LDA .10       DUMMY
      STA BLANK       DELETE CHARACTER
CHRS1 JSB GETCR
      JMP CHRS3     TO END-OF-STATEMENT EXIT
      CPA TEMP2     TERMINATOR CHARACTER?
      JMP CHRS2     YES
      IOR SBPTR,I   NO, FILL
      STA SBPTR,I     SECOND CHARACTER
      JSB GETCR
      JMP CHRS3     TO END-OF-STATEMENT EXIT
      CPA TEMP2     TERMINATOR CHARACTER?
      JMP CHRS2     YES
      ISZ SBPTR     NO, MOVE TO NEW WORD
      ALF,ALF         AND STORE
      STA SBPTR,I       FIRST CHARACTER
      JMP CHRS1
CHRS2 ISZ CHRST     SET (P+2) EXIT
CHRS3 ISZ SBPTR     MOVE TO NEXT BUFFER WORD
      LDA .32       RESTORE BLANK AS
      STA BLANK       DELETE CHARACTER
      JMP CHRST,I
      SKP
**
***  DELETE STATEMENT  **
**
DLSTM LDA SBUFA,I   LOAD SEQUENCE NUMBER
      JSB FNDPS     FIND STATEMENT TO BE DELETED
      JMP PEXMA,I   DOESN'T
      JMP PEXMA,I     EXIST
      CLA           ZERO WORD SKIP FOR DESTINATION
      INB           ADDRESS OF SOURCE WORD SKIP IN B
      JSB CLPRG     CLOSE UP PROGRAM
      JMP PEXMA,I   EXIT TO PHASE 1 WAIT
*
***                  ***
**  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 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 PEXMA,I   YES
      JMP ACCS3     NO
ACCS4 LDA TEMP,I    LOAD PROGRAM SPACE REQUIREMENT
      JSB OVCHK     SUFFICIENT PROGRAM SPACE LEFT?
      JSB MVTOH     MAKE
      JMP ACCS2       ROOM
      SKP
**
***  FIND SEQUENTIAL POSITION  **
**
FNDPS NOP
      STA TEMP3     SAVE SEQUENCE NUMBER
      LDB PBUFF     STARTING ADDRESS
FNDP1 CPB PBPTR     END OF PROGRAM?
      JMP FNDP4     YES, EXIT VIA (P+1)
      LDA 1,I       SUBTRACT PROGRAM
      CMA,INA         SEQUENCE NUMBER FROM
      ADA TEMP3       S-BUFFER SEQUENCE NUMBER
      SZA,RSS       EQUAL?
      JMP FNDP2     YES, SET EXIT TO (P+3)
      SSA           NO, P-SEQ NO > S-SEQ NO ?
      JMP FNDP3     YES, SET EXIT TO (P+2)
      LDA 1         POINT (A) TO
      INA             PROGRAM ADDRESS INCREMENT
      ADB 0,I       COMPUTE NEW ADDRESS
      JMP FNDP1
FNDP2 ISZ FNDPS
FNDP3 ISZ FNDPS
FNDP4 STB TEMP3     SAVE STATEMENT ADDRESS
      JMP FNDPS,I
**
***  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 FSCEF,I   NO, PROGRAM SPACE OVERFLOW
      LDB TEMP4     YES, RELOCATE FREE
      STB PBPTR       PROGRAM SPACE POINTER
      JMP OVCHK,I
