ASMB,R,Q,C
      HED <<RTE BASIC - EXECUTE/SEG #4>>      92076-1X005 REV.2040
      NAM BASC4,5,99 92076-1X005 REV.2040 800727 92076-16001
* 
* 
* 
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS      * 
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * 
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
*  **************************************************************** 
* 
*   NAME:     BASC4 
*   SOURCE:   92076-18005 
*   RELOC:    PART OF 92076-16001 
*   PGMR:     B.J.L.
* 
      ENT BASC4,ETAB,ETYP,ERND,ESGN,ESWR,XERR,SERR,OCT,TIM
      EXT IFBRK,BCKSP,WRITE,DRQST,GETCR,MVTOH,OUTER,CRETS 
      EXT IFBRK,ENOUT,NUMCK,OUTCR,..FCM,.IENT 
      EXT OUTLN,OUTIN,TRAP,FCNEX,WDRQS,WRITF,READF,CLOSE
      EXT FCONT,POST,PRNIN,SSYMT,FNDPS,.PACK,COMND
      EXT EXP,ALOG,RMPAR,SPEC4,SGMNT,MBY10,DBY10
      EXT EXEC,OLNCK,DIGCK,.FLUN,GETDG
      EXT .FAD,.FSB,.FMP,.FDV,IFIX,FLOAT,XQPRG,FINDV,CNFUE
* 
      COM TEMPS(32),PNTRS(81),FILBF(16),FLDCB(144),SPEC(10) 
* 
* PNTRS INCREASED TO 81  800727********** 
*TEMPS INCREASED TO 32  800107**********************
*ADDED CALL TO 'XQPRG'  791114*************************** 
*REMOVED CALL TO 'FINDV' 790820************************** 
*ADDED CALL TO CLOSE  790904**************************
*PNTRS INCREASED TO 79, ADDED CALL TO CRETS 790830******* 
*PNTRS INCREASED TO 80  791010*************************** 
* 
***************************************** 
*                                       * 
*    SEGMENT #4: EXECUTE THE PROGRAM    * 
*                                       * 
***************************************** 
* 
*  THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL 
*    AFTER THE SUCCESSFUL COMPLETION OF THE PRE-EXECUTION PROCESSING
*    SEGMENT. IT WILL EXECUTE THE USER PROGRAM, LINE BY LINE, BY
*    EXAMINING THE TRANSLITERATED CODE AND BRANCHING TO THE VARIOUS 
*    EXECUTION SUBROUTINES. UPON COMPLETION, IT RETURNS EXECUTION TO
*    THE MAIN CONTROL PROGRAM.
      SKP 
*************************** 
*                         * 
* CONSTANTS AND VARIABLES * 
*                         * 
*************************** 
* 
FWAM  EQU PNTRS     FIRST WORD OF AVAILABLE MEMORY
LWBM  EQU PNTRS+1   LAST WORD OF AVAILABLE MEMORY 
.INBF EQU PNTRS+2   INPUT BUFFER ADDRESS
SBUFA EQU PNTRS+3   SYNTAX BUFFER ADDRESS 
SYMTA EQU PNTRS+4   START OF SYMBOL TABLE 
SYMTF EQU PNTRS+5   END OF SYMBOL TABLE 
PBUFF EQU PNTRS+6   FIRST WORD OF USER PROGRAM
PBPTR EQU PNTRS+7   LAST WORD+1 OF USER PROGRAM 
INBFA EQU PNTRS+8   INPUT BUFFER POINTER
ICCNT EQU PNTRS+9   INPUT CHARACTER COUNT 
SBPTR EQU PNTRS+10  SYNTAX BUFFER POINTER 
.LNUM EQU PNTRS+11  CURRENT LINE #
FCORE EQU PNTRS+12  START OF FREE CORE
MNNAM EQU PNTRS+13  MNEMONIC TABLE NAME:SC:LU 
BRNAM EQU PNTRS+18  BRANCH TABLE NAME:SC:LU 
FWAMM EQU PNTRS+23  POINTER TO START OF MNEMONIC TABLE
FWAMB EQU PNTRS+24  POINTER TO START OF BRANCH TABLE
.OTBF EQU PNTRS+25  POINTER TO OUTPUT BUFFER 
OCCNT EQU PNTRS+26  OUTPUT CHARACTER COUNT
OTBFA EQU PNTRS+27  POINTER INTO OUTPUT BUFFER
LUOUT EQU PNTRS+28  CURRENT OUTPUT L.U. # 
LUINP EQU PNTRS+29  CURRENT INPUT L.U. #
SIGN  EQU PNTRS+30  SIGN OF CURRENT NUMBER
BLANK EQU PNTRS+31  CURRENT TERMINATION CHAR
REC#  EQU PNTRS+32  COMMAND FILE RECORD NUMBER
FLTYP EQU PNTRS+33  TYPE 0 FILE FLAG
*********CHANGED FOR L USAGE OF GETST 790409********
TTYPR EQU PNTRS+34  CONSOLE TTY L.U. #
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************************************ 
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 
      SPC 1 
      SUP PRESS MULTIPLES LISTING 
      SPC 1 
XH    BSS 1 
XL    BSS 1 
TT1   BSS 1 
TT2   BSS 1 
TT3   BSS 1 
TT4   BSS 1 
EOL   BSS 1         TAB END-OF-LINE FLAG
STRFG BSS 1         STRING CONSTANT FLAG
* 
FOPBS DEF QUOTE-1 
ARBAS DEF AROTB-6,I 
XECBR DEF XECTB-28,I
ADATA DEF DATA
ERBS  DEF ERR-1 
FINCA DEF FINCH     ADDRESS OF FETCH INPUT ROUTINE
FSCHA DEF FSCH      ADDRESS OF FETCH SOURCE CHAR ROUTINE
* 
TRMSA DEF *+1       TRACE 
      ASC 4,*TRACE
LNBFF BSS 2           MESSAGE 
LNBFA DEF LNBFF-1 
      SKP 
.0    DEC 0 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.5    DEC 5 
.6    DEC 6 
.7    DEC 7 
.8    DEC 8 
.9    DEC 9 
.10   DEC 10
.11   DEC 11
.12   DEC 12
.13   DEC 13
.14   DEC 14
.15   DEC 15
.16   DEC 16
.20   DEC 20
.21   DEC 21
.23   DEC 23
.31   DEC 31
.32   DEC 32
.43   DEC 43
.45   DEC 45
.48   DEC 48
.52   DEC 52
.64   DEC 64
.74   DEC 74
.80   DEC 80
.125  DEC 125       ***ADD FOR BUG 790928 MM*** 
.128  DEC 128 
.132  DEC 132 
.133  DEC 133       ***ADD FOR BUG 790928 MM*** 
.144  DEC 144 
*.9999 DEC 9999             ***REMOVED 790820*************
LFTAR OCT 137 
CTRLQ OCT 21
TWOQS OCT 50521     ***ADD FOR BUG 790928 MM*** 
B40   EQU .32 
B42   OCT 42
B77   OCT 77
B177  OCT 177 
B376  OCT 376 
B377  OCT 377 
B400  OCT 400 
B777  OCT 777 
B1000 OCT 1000
B2000 OCT 2000
RSS   OCT 2001
B3000 OCT 3000
B4000 OCT 4000
SCCNT OCT 3002
LBOP  OCT 22000 
BIT13 OCT 20000 
LFPAR OCT 122000
DATA  OCT 51004 
DATOP OCT 51000 
IMGOP OCT 67000 
USEOP OCT 61000 
PRTOP OCT 53000 
ENDOP OCT 45000 
#OP   OCT 17000 
SPLOP OCT 65000 
OPMSK OCT 77000 
*ATMSK OCT 10000           ***REMOVED 790820***************** 
INF   OCT 77777 
INTFL OCT 100003
FRMSK OCT 100757
OPDMK OCT 100777
WRFLG OCT 100001
DSERR OCT 140000
M1    DEC -1
M2    DEC -2
M3    DEC -3
M4    DEC -4
M5    DEC -5
M6    DEC -6
M7    DEC -7
M12   DEC -12 
M15   DEC -15 
M17   DEC -17 
M20   DEC -20 
M21   DEC -21 
D33   OCT -33 
M73   DEC -73 
M80   DEC -80 
M81   DEC -81 
M125  DEC -125      ***ADD FOR BUG 790928 MM*** 
M132  DEC -132      ***ADD FOR BUG 790928 MM*** 
M133  DEC -133      ***ADD FOR BUG 790928 MM*** 
M256  DEC -256
M280  DEC -280
M1000 DEC -1000 
HALF  OCT 40000 
      OCT 0 
HONE  EQU HALF
MNEG  OCT 100000   MAXIMUM NEGATIVE FLOATING
      OCT 376         POINT NUMBER
FLGBT EQU MNEG
BIT15 EQU MNEG
AFCNX DEF FCNEX 
      SKP 
*************************** 
*                         * 
* EXECUTION BRANCH TABLES * 
*                         * 
*************************** 
* 
*  THE EXECUTION BRANCH TABLES ARE THE BASIS FOR EXECUTING A BASIC
*    USER PROGRAM. FOR EACH OPERATOR IN BASIC THERE IS A UNIQUE CODE
*    NUMBER. THIS CODE NUMBER, WHEN ADDED TO A REFERENCE ADDRESS, 
*    FORMS A POINTER TO ONE OF THE ADDRESSES IN THESE BRANCH TABLES.
*    THE ADDRESS WHICH IS POINTED TO IN THE TABLE, IS THE ADDRESS OF
*    THE CORRESPONDING EXECUTION SUBROUTINE.
* 
XECTB DEF XEC4      COM 
      DEF XEC4      DEF 
      DEF XEC4      REM 
      DEF EGOTO     GO TO 
      DEF EIF       IF
      DEF EFOR      FOR 
      DEF ENEXT     NEXT
      DEF EGOSB     GOSUB 
      DEF ERTRN     RETURN
      DEF EEND      END 
      DEF EEND      STOP
      DEF EWAIT     WAIT
      DEF ECALL     CALL
      DEF XEC4      DATA
      DEF EREAD     READ
      DEF EPRIN     PRINT 
      DEF EINPT     INPUT 
      DEF ERSTR     RESTORE 
      DEF EPAZ      PAUSE 
      DEF XEC4      FAIL
      DEF EGOTO     THEN
      DEF XEC4      USING 
      DEF EASSN     ASSIGN
      DEF XEC4      FILES 
      DEF ECHAN     CHAIN 
      DEF 0         SPECIAL SYNTAX
      DEF ETRAP     TRAP
      DEF XEC4      IMAGE 
      DEF EINVK     INVOKE
      DEF XEC4      DIM 
      DEF ELET      LET 
* 
      SKP 
      DEF FORMX,I   EXIT ON EMPTY STACK 
      BSS 5           DUMMY ADDRESSES 
AROTB DEF ESCMA     SUBSCRIPT SEPARATOR 
      DEF ESTR      ASSIGNMENT OPERATOR 
      DEF EFAD      '+' 
      DEF EFSB      '-' 
      DEF EFMP      '*' 
      DEF EFDV      '/' 
      DEF EPWR      '^' 
      DEF EGTRT     '>' 
      DEF ELST      '<' 
      DEF ENEQL     '#' 
      DEF EEQL      '=' 
      DEF EUMIN     UNARY '-' 
      DEF ELBRC     '[' 
      DEF FORM1     '(' 
      DEF FOR11     UNARY '+' 
      DEF EOR       OR
      DEF EAND      AND 
      DEF ENOT      NOT 
      DEF EGORE     '>='
      DEF ELORE     '<='
      DEF EMIN      'MIN' 
      DEF EMAX      'MAX' 
* 
      SKP 
***************************** 
*                           * 
* OPERATOR PRECEDENCE TABLE * 
*                           * 
***************************** 
* 
*  THIS TABLE IS USED BY THE FORMULA EVALUATION SUBROUTINE TO 
*    DETERMINE THE HIERARCHICAL PRECEDENCE OF THE FORMULA-TYPE
*    OPERATORS. BITS 15-9 OF THE LABELLED WORD ARE THE BASIC
*    CODE OPERATOR AND BITS 3-0 ARE THE PRECEDENCE FOR THE
*    OPERATOR.
QUOTE OCT 1000
COMMA OCT 2000
SEMIC OCT 3000
* 
RPARN OCT 4001
RBRAC OCT 5001
SCMMA OCT 6002
ASSOP OCT 7002
PLUS  OCT 10007 
MINUS OCT 11007 
TIMES OCT 12010 
DIV   OCT 13010 
EXPS  OCT 14012 
GTR   OCT 15005 
LSS   OCT 16005 
UNEQL OCT 17005 
EQUAL OCT 20005 
UNMIN OCT 21011 
LBRAC OCT 22020 
LPARN OCT 23020 
UPLUS OCT 24011 
OROP  OCT 25003 
ANDOP OCT 26004 
NOTOP OCT 27011 
GTREQ OCT 30005 
LSSEQ OCT 31005 
MINOP OCT 32006 
MAXOP OCT 33006 
* 
      SKP 
*********************** 
*                     * 
* EXECUTE THE PROGRAM * 
*                     * 
*********************** 
BASC4 NOP 
*********************REMOVED 790712**************************** 
*     LDA PFLAG     IS THIS AN INITALIZATION? 
*     CPA .9999 
*     RSS           YES, GO GET SEGMENT'S FWAM AND LWAM 
*     JMP BAS4C     NO,CONTINUE EXECUTION 
*     JSB GMS.C 
*     JMP ROTAT     RET. TO MAIN FOR FWAM AND LWAM CHECK
**************************790712******************************* 
      LDA EXFUN     SAVE 'JSB FUNCT' INSTRUCTION
      STA FINST 
      LDB TRAPF     TRAP BUSY FLAG SET IN SEG 3?
      CPB M1        (B)=-1 IF TRAP TABLE IS BUSY
      RSS             YES ITS BUSY SO DONT ALLOW TRAP POLING
      JMP BASX      NO, OK TO USE IT
      LDA RSS       STORE RSS IN 'JSB TRAP' 
      STA TRAPX 
      STA ETRAP 
BASX  LDA SLSTM     RETURN
      CPA M1        RETURN FROM BRKPNT? 
      JMP XEC5      YES!
      CPA M2        RETURN FROM SIM?
      JMP XEC6      YES!
      SZA             FROM SEGMENT 8? 
      JMP XEC4      YES, CONTINUE WITH NEXT STMT
* 
* 
      LDA FWAM      SET FOR RANDOM NUMBER GENERATOR 
      STA XH        INITIALIZE
      INA             RANDOM
      STA XL            VARIABLE
      SPC 1 
*  INITIALIZE THE DATA POINTER
      SPC 1 
      CCA           SET 
      STA DCCNT       'NO 
      STA DSTRT         DATA' 
      LDB PBUFF           CONDITION 
      STB NXTDT 
      LDA ADATA,I   SEARCH FOR FIRST
      JSB STSRH       DATA STATEMENT
      JMP XEC2      NONE FOUND
      STB DSTRT     SAVE STATEMENT LOCATION 
      JSB SETDP     SET DATA POINTER
      SPC 1 
*  INITIALIZE STACK POINTERS
      SPC 1 
XEC2  JSB SETPT     INITIALIZE PTRS 
      LDA LORUN     FIRST STMNT 
      CPA .1          OF PROGRAM? 
      JMP XEC3      YES!
      JSB FNDPS     NO, FIND IT 
      JMP XEC6      P+1 RETURN = STATEMENT # TOO LARGE, IGNOR!
      NOP           P+2 RETURN = STATEMENT NOT FOUND, USE NEXT
*             P+3 RETURN = BRANCH TO STATEMENT REQUEST
* 
XEC3  EQU *         GET FIRST STATEMENT NUMBER
      LDA 1 
      STA NXTST      AND SET UP FOR 
      STB TEMP1       TRACE AND BREAK 
      JMP XEC6
* 
XEC43 LDB 0 
      JMP XEC6+1
      SKP 
*  FIND NEXT STATEMENT TO BE EXECUTED 
      SPC 1 
XEC4  LDA TTYPR     RESTORE 
      STA LUINP       CONSOLE 
      STA LUOUT         LOGICAL UNITS 
      LDA FCORE     SET TEMPORARY 
      STA TSTPT       STACK POINTER 
      LDA NXTST 
      SZA,RSS       END OF PROGRAM? 
      JMP EEND      YES 
* 
XEC6  LDB NXTST     GET NEW LINE NUMBER 
      STB TEMP1 
XEC5  LDA TEMP1 
      JSB TRACE 
      LDA TTYPR     RESTORE 
      STA LUOUT       CONSOLE 
      STA LUINP         LOGICAL UNITS 
* 
      JSB IFBRK     BREAK 
      DEF *+1 
      SZA             FLAG SET? 
      JMP OPEND      YES, STOP THE PRESSES! 
      LDB TEMP1     RESTORE B WITH ADDR OF NEXT STATEMENT 
      LDA M1000 
      STA FILE#     SET FOR NON-FILE I/O
TRAPX JSB TRAP     CHECK FOR INTERRUPT
      JMP ERRTR     ERROR RETURN*800318*
      SSA,RSS 
      JMP EGOS4     INTERRUPT, DO GOSUB 
      JSB FLWST 
SETSX LDA TEMPS,I 
      AND OPMSK     EXTRACT STATEMENT TYPE
      CPA SPLOP     SPECIAL SYNTAX? 
      RSS            YES
      JMP CONT       NO, SKIP THIS
      JSB SPEC4     EXECUTE SPECIAL SYNTAX
      JMP XEC4       EXECUTE NEXT INSTRUCTION 
      JMP OUTER       ERROR PROCESSING
CONT  ALF,ALF       POSITION
      RAR             IT
      ADA XECBR     COMPUTE EXECUTION ADDRESS 
      JMP 0,I       BRANCH TO EXECUTION CODE
*************************ADDED 800318**************************** 
ERRTR CLB 
      STB .LNUM 
      JMP TRERR 
*****************************800318****************************** 
      SKP 
***************** 
*               * 
** EXECUTE LET ** 
*               * 
***************** 
* 
* 
ELET  CLA,INA       ENABLE FOR STRING CONSTANT
      STA STRFG       IN FORMULA
      JSB FORMX 
      JMP XEC4
* 
* 
******************* 
*                 * 
**  EXECUTE FOR  ** 
*                 * 
******************* 
* 
EFOR  JSB FVSRH     FOR-VARIABLE ALREADY IN STACK?
       JMP EFOR1    NO
      STA TEMP2     YES, SAVE SOURCE ADDRESS
      ADA .6        SAVE
      STA TEMP4       DESTINATION ADDRESS 
      STB TEMP1     SAVE FOR-VARIABLE ADDRESS 
      JSB MVTOH     COMPRESS STACK
      LDB TEMP1     RESTORE FOR-VARIABLE ADDRESS
      CLA,RSS       COMPUTE NEW 
EFOR1 LDA M6            TOP OF
      ADA HSTPT           FOR-STACK 
      STA HSTPT             POINTER 
      STA TEMP1 
      CMA,INA       STACK 
      ADA LSTPT 
      SSA,RSS         OVERFLOW? 
      JMP E1        YES. ERROR 57.
      STB TEMP1,I   NO, RECORD FOR-VARIABLE ADDRESS 
      JSB FORMX     INITIALIZE FOR-VARIABLE 
      ISZ TEMPS 
      ISZ TEMP1     SAVE
      LDA TEMP1       LIMIT 
      STA ENEX2+1       ADDRESS 
      JSB FETCH     FETCH 
      STA TEMP1,I     AND 
      ISZ TEMP1         STORE 
      STB TEMP1,I         LIMIT 
      ISZ TEMP1 
      LDB M2        SET FOR STEP SIZE 
      STB FDATA       SIGN CHECK
      LDA TEMPS,I   LOOK FOR
      SZA             FOLLOWING ' STEP' 
      JMP EFOR2     FOUND 
      LDA HONE      NOT FOUND,
      CMB,INB,RSS     DEFAULT IS 1.0
EFOR2 JSB FETCH 
      SSA           STEP SIZE NEGATIVE? 
      ISZ FDATA     YES 
      STA TEMP1,I   SAVE
      ISZ TEMP1       STEP
      STB TEMP1,I       SIZE
      ISZ TEMP1     SET POINTER 
      LDA NXTST       TO STATEMENT
      STA TEMP1,I       FOLLOWING THE FOR 
EFOR3 LDA NEXTX     FIND
      LDB PRADD       'NEXT'
      JSB STSRH         STATEMENT 
       NOP
      JSB FLWST     FIND FOLLOWING STATEMENT
      AND B777      SAME
      CPA ETAB        FOR-VARIABLE? 
      RSS           YES 
      JMP EFOR3     NO
      LDB HSTPT,I   LOAD
      DLD 1,I       LOAD VALUE OF FOR VARIABLE
      JMP ENEX2-2   CHECK ACCEPTABILITY 
* 
* 
NEXTX OCT 42004 
* 
**  EXECUTE NEXT  **
* 
ENEXT JSB FVSRH     FIND CORRESPONDING STACK ENTRY
       JMP XEC4     NONE PRESENT
      STA HSTPT     RESET TOP OF STACK
      STB ENEX1+1   SAVE FOR-VARIABLE ADDRESS 
      INA           SAVE LIMIT
      STA ENEX2+1     ADDRESS 
      ADA .2        SAVE STEP SIZE
      STA TEMP1       ADDRESS 
      LDB M2        SET STEP SIZE 
      STB FDATA       SIGN CHECK
      LDA TEMP1,I   LOAD
      ISZ TEMP1       STEP
      LDB TEMP1,I       SIZE
      ISZ TEMP1 
      SSA           CHECK 
      ISZ FDATA       SIGN
ENEX1 JSB .FAD       INCREMENT  FOR-VARIABLE
       NOP
      DST ENEX1+1,I   AND SAVE VALUE
      STA EFMT
      STB NFMT
ENEX2 JSB .FSB      COMPUTE FOR-VARIABLE - LIMIT
       NOP
      ISZ FDATA     POSITIVE STEP SIZE? 
      ELA           YES, COMPLEMENT SIGN
      SSA           NO, NON-NEGATIVE RESULT?
      JMP ENEX3     NO
      LDA TEMP1,I   YES, GO TO FIRST
      STA NXTST 
      JMP XEC4        STATEMENT OF LOOP 
* 
ENEX3 LDA HSTPT     FAILS,
      ADA .6          ERASE 
      STA HSTPT         STACK ENTRY 
      JMP XEC4
      SKP 
***************** 
*               * 
* EXECUTE PRINT * 
*               * 
***************** 
EPRIN LDA HSTPT     SAVE HI STK PTR IN CASE 
      STA HTEMP       OF END-OF-FILE EXIT 
      STA BFFLG     INIT.FLAG FOR KEEPING TRACK OF OUTPUT CHARACTERS
      JSB VLFIL     VALIDATE FILE REFERENCE 
      JMP EPR01     LU OUTPUT 
      JMP EOFCK     FILE OUTPUT EOF 
      LDB DCB       FILE OUTPUT, POSITION OK
      ADB .7          NOW CHECK 
      LDA 1,I           IF SECURITY CODES 
      SSA,RSS             AGREE OR NOT
      JMP EPR00     MISMATCH, DECLARE ERROR & QUIT
      ADB .6
*     JSB RDCB1     (CHECK FOR NEW DCB)***OUT FOR L 
      LDA 1,I       SET 
      IOR .1          WRITTEN 
*     JSB WDCBB     (CHECK FOR NEW DCB)***OUT FOR L 
      STA 1,I           ON
      ADB M1              BIT 
      LDB 1,I       FETCH WORD POINTER
      LDA DCB       IS THE
      ADA .144        DATA CONTROL
      CPA 1             BLOCK FULL? 
      JMP EPR02     YES!
      LDA M2        NO, TERMINATE RECORD
      STA 1,I         WITH EOR MARK 
      JMP EPR02     BEGIN LIST PROCESSING 
* 
EPR01 CLA,INA       FLAG AS 'PRINT' 
      JSB EPRUS     CHECK FOR USING 
      CLA           FLAG AS 
      STA FFLG        NON-FORMATTED 
      JSB PRNIN     INITIALIZE OUTPUT BUFFER
      JSB FLUPT     FIND ANY PARTIAL LINE FLAG
      CLA,RSS       TURN ON 
EPR02 CCA           TURN OFF
      STA EOL         END-OF-LINE FLAG
EPR04 LDB TEMPS     MORE
      CPB PRADD     STATEMENT?
       JMP EPR19    NO,EXIT PRINT EXECUTION 
      LDA 1,I 
      AND OPDMK     EXTRACT OPERAND 
      SZA           NULL
       JMP EPR07    NO,GO TO EVALUATION 
EPR05 LDB TEMPS 
      INB 
      CPB PRADD     MORE STATEMENT? 
       JMP EPR19      NO, EXIT PRINT PROCESSING 
      LDA 1,I       YES, EXTRACT
      AND OPMSK     OPERATOR
      CPA B2000     "," ? 
       JMP EPR10    YES,GO TO COMMA EXECUTION 
      CPA B3000     ";" ? 
       JMP EPR14    YES, TURN OFF END-LINE FLAG 
      CPA ENDOP     "END" 
       JMP EPR13    YES,GO CHECK FOR FILE I/O 
      SZA           NULL OPERATOR?
       JMP EPR07    NO,EVALUATE FORMULA 
EPR06 ISZ TEMPS     YES, STEP CODE POINTER, 
       JMP EPR04    AND EXAMINE OPERANND. 
* 
EPR07 CLA,INA 
      STA STRFG     ALLLOW STRING CONSTANTS 
      CCA           AND PRESET TAB FLAG 
      STA EOL 
      JSB FORMX     EVALUATE NEXT EXPRESSION
      ISZ EOL       WAS IT A TAB? 
       JMP EPR12    YES, EXECUTION DONE 
      LDB HSTPT,I   WAS IT A STRING?
      SSB 
      JMP EPR11     YES, GO PROCESS IT
      JSB OPCHK     QUALIFY THE OPERAND 
      LDA FILE#     WRITE ON
      SSA,RSS         A FILE? 
       JMP EPR08        YES 
      DLD 1,I           NO
      JSB ENOUT     OUTPUT THE NUMBER 
      CLA           AND REMEMBER THAT 
      STA TABFG     IT WAS NUMERIC OUTPUT 
      JMP EPR12 
* 
EPR08 STB SBPTR     SAVE VALUE ADDRESS
      ISZ HSTPT     POP VARIABLE PTR OFF HI STK 
      LDB M2        REQUEST NUMERIC 
EPR09 JSB FILST       WRITE ON FILE 
      JMP EPR05 
EPR12 ISZ HSTPT     POP VARIABLE PTR OFF HI STK 
      JMP EPR05 
* 
EPR10 LDA FILE#     COMMA EXECUTION,
      SSA,RSS       IS THIS A FILE WRITE? 
      JMP EPR06     YES,QUIT NOW
      CLA 
      CPA EOL       WAS THERE A TAB LAST? 
      JSB EDELM     NO,EXECUTE COMMA
      CLA,INA 
      STA TABFG 
EPR14 ISZ TEMPS     STEP CODE POINTER 
      JMP EPR02       AND TURN OFF END-LINE FLAG
* 
EPR11 LDA M2        PREPARE 
      JSB PSTR      PRINT 
      STA TEMP8     STRING
      STB TPRME 
      LDB TEMPS 
      ADB M1
      STB TEMPS 
      LDB M3
      LDA FILE#     WRITE ON A FILE?
      SSA,RSS 
      JMP EPR09     YES 
* 
      LDA TNULL     IS STRING 
EPR03 ADA .132        TOO LONG  ***CHG FOR BUG 790928 MM*** 
      STA VLFIL         TO BE OUTPUT
      SSA,RSS             IN ONE LUMP?    (VLFIL USED AS COUNTER) 
      JMP EPR18     NO! 
* 
      LDA M133      YES!  ***CHG FOR BUG 790928 MM*** 
EPR17 STA TNULL     RESET LENGTH COUNTER TO MAX LNGTH 
      CMA           GET STRING LENGTH 
      STA EDELM       AND SAVE FOR LATER
      JSB OLNCK     CHECK LINE OVERFLOW 
      LDA .OTBF     FIGURE STARTING 
      CLE,ELA         CHARACTER 
      ADA OCCNT         ADDRESS 
      STA TEMP5           FOR TRSTR 
      ADA EDELM     UPDATE OUTPUT 
      CLE,ERA         POINTER 
      SEZ,RSS 
      ADA M1
      STA OTBFA         SINCE TRSTR WON'T 
      LDA OCCNT           AND ALSO
      ADA EDELM             UPDATE THE
      STA OCCNT               CHAR COUNT
      LDA FSCHA 
      JSB TRSTR     OUTPUT THE CHARACTERS 
      CLA,INA 
      STA TABFG       AND REMEMBER NO BACKSPACING 
* 
      LDA VLFIL     MORE STRING LEFT
      SSA             TO OUTPUT?
      JMP EPR03     YES!
      JMP EPR05 
* 
EPR18 ADA M132      RESET BACK TO ORIGNAL ***CHG FOR BUG 790928 MM*** 
      JMP EPR17 
* 
EPR13 LDA FILE#     FILE WRITE
      SSA           ? 
      JMP EPR16     CHECK FOR TYP 0 FILE! 
      CLA 
      STA EORFL     FIND TYPE 
      JSB GTTYP     OF NEXT ITEM
      CPA .3        EOF?
      JMP EPR06     YES, QUIT NOW 
      ISZ TEMPS     NO, STEP PROGRAM POINTER
      CCB           AND REQUEST 
      JMP EPR09     EOF WRITE 
* 
EPR16 LDA FLTYP     TYPE 0
      SZA             FILE? 
      JMP E9-1      NO, NOT A FILE! 
      LDA M1000     SET FLAG
      STA TEMP7       TO PUNCH TRAILER
* 
EPR19 LDA FILE#     FILE WRITE? 
      SSA,RSS 
      JMP XEC4      YES,ALL DONE
      CLA 
      ISZ EOL       TERMINATE THIS LINE?
      JMP EPR20     YES,GO TO OUTPUT WITH CR-LF 
      JSB OUTPT     OUTPUT A LINE 
EPR21 LDA TEMP7     PUNCH 
      CPA M1000       TRAILER?
      RSS           YES 
      JMP XEC4
* 
EPR20 STA TEMP1,I   CLEAR LU/COUNT WORD 
      JSB OUTLN 
      JMP EPR21 
* 
      JSB FCONT     PUNCH 
      DEF *+4 
      DEF DCB,I 
      DEF FERR        TRAILER 
      DEF B1000 
      JSB CKERR 
      JMP XEC4
* 
* 
EPR00 LDA M7        HERE FOR SECURITY CODE
      STA TEMP3       MISMATCH
      JMP OUTER     HALT AND CATCH FIRE 
* 
HONES NOP 
      LDA LUOUT     SET HONESTY MODE
      IOR B2000 
      STA LUOUT 
      JMP HONES,I 
* 
BLDLU NOP           OFFSET IN B ON ENTRY
      ADB OCCNT     BUILD LU/COUNT WORD 
      ADB TYPE
      LDA LUOUT 
      AND B377
      ALF,ALF 
      IOR 1 
      JMP BLDLU,I   LU/COUNT WORD IN A ON RETURN
      SKP 
*************************************** 
*                                     * 
**  EXECUTE <PRINT USING STATEMENT>  ** 
*                                     * 
*************************************** 
* 
*  EXIT TO (P+1) IF NO USING OPERATOR FOUND, OTHERWISE PREPARE
*  FORMAT SPECIFICATION STRING AND CALL FORMATTED OUTPUT ROUTINE. 
* 
EPRUS NOP 
      STA FFLG      SAVE FORMAT FLAG
      LDB TEMPS 
      LDA 1,I 
      CPA PRTOP     NULL OPERAND? 
      INB           YES 
      CPB PRADD     END OF STATEMENT? 
      JMP EPRUS,I   YES 
      LDA 1,I       NO, 'USING' 
      AND OPMSK       OPERATOR
      CPA USEOP         NEXT? 
      RSS           YES 
      JMP EPRUS,I   NO, EXIT
      XOR 1,I       GET OPERAND 
      STB TEMPS     SAVE POINTER
      SSA,RSS       INTEGER FOLLOWS?
      JMP EPRU1     NO
      INB 
      LDB 1,I       GET ADDRESS OF IMAGE STATEMENT
      ADB .2        => LENGTH WORD
      LDA 1,I 
      AND OPMSK     GET OPERATOR
      CPA IMGOP     IMAGE?
      RSS           YES 
      JSB ERROR     NO, NOT AN IMAGE STMT!
E18   ISZ TEMPS     BUMP TO POINT 
      ISZ TEMPS       TO FIRST OPERAND
      CLA 
      STA NCH 
      JMP FRMAT     CALL FORMATTER
EPRU1 SZA,RSS       NULL OPERAND? 
      JMP EPRU4     YES 
      JSB FORMX     NO, FETCH 
      LDA M2          STRING
      JSB PSTR          OPERAND 
      LDA TEMP6,I   GET 
      AND B377        LENGTH
      SZA,RSS       NULL STRING?
      JMP XEC4      YES 
      CMA,INA       NO, SAVE
      STA STRLN       -LENGTH 
      LDB TSTPT     GET START OF STRING DESIGNATOR
      ADB .2
      LDA 1,I       GET FIRST SUBSCRIPT 
      CMA,INA       NEGATE IT 
      INB 
      ISZ 1,I       SECOND SUBSCRIPT EXIST? 
      JMP EPRU2     YES 
      CLA           NO, SET 
      STA NCH         CHARACTER COUNT 
      JMP EPRU3 
EPRU2 ADA 1,I       COMPUTE DIFFERENCE
      SZA,RSS       NULL STRING?
      JMP XEC4      YES 
      SSA           NO, NEGATIVE? 
      JMP STER1-1   NEGATIVE STRING LENGTH
      STA NCH       NO, SAVE DIFFERENCE 
      CCA 
      ADA 1,I       SECOND
      ADA STRLN       SUBSCRIPT 
      SSA,RSS           VALID?
      JMP E6-1      ILLEGAL SUBSCRIPTS
EPRU3 ADB M1        YES 
      LDA 1,I       FIRST 
      ADA STRLN       SUBSCRIPT 
      SSA,RSS           VALID?
      JMP STER1-1   ILLEGAL SUBSCRIPTS
      LDA 1,I       YES, LOAD IT
      LDB TEMP6     => FIRST WORD OF STRING 
      JMP FRMAT     CALL FORMATTER
EPRU4 INB           => 1ST WORD OF STRING 
      LDA 1,I       UPDATE
      AND OPDMK 
      INA             INTRA-
      ARS 
      ADA TEMPS         STATEMENT 
      ADA .2
      STA TEMPS           POINTER 
      CLA 
      STA NCH 
      JMP FRMAT     CALL FORMATTER
* 
*FFCH  BSS 1         FORMAT FLAG ***REMOVED 790820******* 
NCH   BSS 1         NUMBER OF CHARACTERS
STRLN BSS 1         NEGATIVE STRING LENGTH
      SKP 
******************************* 
*                              *
**  FORMATTED OUTPUT ROUTINE  **
*                              *
********************************
* 
.X    OCT 130 
S     OCT 123 
D     OCT 104 
.A    OCT 101 
M46   DEC -46 
..73  DEC 73
* 
*  THE ADDRESS OF THE FIRST WORD OF THE FORMAT
*  STRING IS IN (B) UPON ENTRY.    THE FORMATTER
*  EXTRACTS THE NUMBER OF CHARACTERS IN THE STRING
*  AND THEN EXTRACTS THE FORMAT SPECIFICATIONS
*  ONE BY ONE.  AS EACH SPECIFICATION IS EXTRACTED, 
*  IT IS LOADED INTO A STACK, ONE CHARACTER PER 
*  WORD AND CHECKED FOR SYNTAX ERRORS.  THE 
*  TYPE OF SPECIFICATION IS DETERMINED AT THIS
*  TIME AND THE SPECIFICATION IS THEN EXECUTED
*  FROM THE STACK.
* 
FRMAT STB EC        SAVE POINTER TO STRING
      INB           MAKE INTO 
      CLE,ELB         CHARACTER POINTER 
      ADB 0         ADD IN STARTING CHARACTER 
      CMA,INA       SAVE STARTING 
      STA CC          CHARACTER 
      STB IFSTR     SAVE IN FORMAT STRING ADDRESS 
      STB DP          AND DELIMITER POINTER 
      JSB PRNIN     INITIALIZE PRINT BUFFER PTRS
      JSB FLUPT     SETUP LU/COUNT WORD 
      LDB NCH       MAYBE 
      SZB 
      JMP FM0       YES 
      LDA EC,I      NO, COMPUTE # 
      AND B377        OF CHARACTERS 
      ADA CC            IN FORMAT 
      STA NCH             STRING
      SZA,RSS       NULL STRING?
      JMP FMEND+1   YES, IGNORE IT
FM0   CLA           INITIALIZE
      STA CC          CHARACTER COUNTER 
      STA CONTR       CONTROL CHARACTER 
      STA EC          EXPRESSION COUNTER
      STA CC1         START OF PARENTHESIS LEVEL 1
      STA CC2         START OF PARENTHESIS LEVEL 2
      STA PC1         REPETITION COUNT FOR LEVEL 1
      STA PC2         REPETITION COUNT FOR LEVEL 2
      STA SFLG        STRING FLAG 
FMT2  JSB DSRCH     DELIMITER SEARCH
      STO           IGNORE BLANKS 
      LDA FST       GET THE 
      JSB MCHAR       FIRST CHARACTER 
      CPA DP        DELIMITER FOUND ? 
      JMP FMEND     YES 
      CPA B53       IS CHARACTER A PLUS ? 
      JMP FMT1      YES 
      CPA B57       SLASH?
      JMP FMT90     YES!
      CPA B55       IS IT A MINUS ? 
      JMP FMT1      YES 
      CPA B43       NO, IS IT A NUMBER SIGN 
      RSS           YES 
      JMP FMT3      NO
FMT1  LDB CC        END OF
      CPB NCH         STRING ?
      JSB ERROR     YES, ERROR
FERR0 STA CONTR     SAVE CARR. CONTROL CHARACTER
      ISZ FST       INCREMENT STRING POINTER
      LDA FST 
      STO           IGNORE BLANKS 
      JSB MCHAR     GET NEXT CHARACTER
      CPA DP        DELIMITER FOUND ? 
      RSS           YES 
      JMP FMT01     NO, CHARACTER FOUND ? 
      CLO           GET 
      LDA DP          THE 
      JSB MCHAR         DELIMITER 
FMT01 CPA B54       IS IT A COMMA ? 
      RSS           YES 
      JSB ERROR     NO, ERROR 
FERR1 ISZ DP        INCREMENT DELIMITER POINTER 
      ISZ CC        AND CHARACTER COUNTER 
      LDB CC
      CPB NCH       ALL CHARACTERS USED ? 
      JMP FERR0-1   YES, ERROR
      LDA DP        NO
      JSB DSRCH     FIND NEXT DELIMITING CHARACTER
FMT3  CCA           INITIALIZE
      STA DPFLG       FIXED FLAG
      STA EFLAG       FLOATING FLAG 
      INA 
      STA NUM1        PRE-DECIMAL POINT D COUNTER 
      STA NUM2        POST-DECIMAL POINT D COUNTER
      STA SBD         S BEFORE D COUNTER
      STA SAD         S AFTER D COUNTER 
      STA SNFLG       SIGN FLAG 
      STA NAD         POST-DECIMAL ZERO COUNTER 
      STA NBD         PRE-DECIMAL POINT DIGIT COUNTER 
      INA 
      STA REPCT       REPETITION COUNT
      LDA IFSS        FORMAT STACK
      STA FSP           POINTER 
      LDA FST       GET NON-DELIMITING
      STO             CHARACTER 
      JSB MCHAR         IGNORING BLANKS 
      CPA DP        IS IT A DELIMITER ? 
      JMP FERR0-1   YES 
      CPA B42       IS IT A QUOTE?
      RSS           YES 
      JMP FMT0      NO
      LDB DP
      CMB,INB       RESET 
      ADB FST         CHARACTER 
      ADB CC            COUNTER 
      STB CC
FMT16 ISZ FST       INCREMENT STRING POINTER
      LDA CC        ALL 
      CPA NCH        CHARACTERS USED ?
      JSB ERROR     YES, ERROR
FERR2 ISZ CC        INCREMENT CHARACTER COUNTER 
      LDA FST 
      CLO           DON'T IGNORE BLANKS 
      JSB MCHAR     GET NEXT CHARACTER
      STA FSP,I     LOAD CHARACTER ONTO STACK 
      ISZ FSP       INCREMENT STACK POINTER 
      CPA B42       IS IT A " ? 
      RSS           YES 
      JMP FMT16     NO
      ISZ FST       INCREMENT STRING POINTER
      ISZ CC              AND CHARACTER COUNTER 
      LDA CC        ALL 
      CPA NCH        CHARACTERS USED ?
      JMP FMT46     YES 
      LDA FST       RESET 
      STA DP          DELIMITER 
      JSB DSRCH         POINTER 
      LDA FST       NEXT CHARACTER
      CPA DP          A DELIMITER ? 
      JMP FMT46     YES 
      STO           IGNORE BLANKS 
      JSB MCHAR     FETCH A FORMAT STRING CHARACTER 
      LDA FST       WOULD IT BE 
      CPA DP          A DELIMITER ? 
      JMP FMT46     YES 
      JMP FERR1-1   NO, ERROR 
FMT0  CPA S         IS IT AN S ?
      JMP FMT14     YES 
      CPA B56       IS IT A . ? 
      JMP FMT9      YES 
      CPA E         IS IT AN E? 
      JMP FMT13     YES 
      JSB DIGCK     IS IT A DIGIT ? 
      JMP FMT6      NO
      STA REPCT     YES, STORE IN REPCT 
      ISZ FST       INCREMENT STRING POINTER
      LDA FST       NEXT CHARACTER
      CPA DP          A DELIMITER ? 
      JSB ERROR     YES, ERROR
FERR3 STO           IGNORE BLANKS 
      JSB MCHAR     GET NEXT CHARACTER
      CPA DP        IS IT A DELIMITER ? 
      JMP FERR3-1 
      JSB DIGCK     IS IT A DIGIT ? 
      JMP FMT5      NO
      LDA REPCT     YES,
      STB REPCT       MULTIPLY PREVIOUS 
      MPY .10           DIGIT BY 10 
      ADA REPCT     ADD IN ONES DIGIT 
      STA REPCT 
      ISZ FST       INCREMENT STRING POINTER
      LDA FST       NEXT CHARACTER
      CPA DP        A DELIMITER ? 
      JMP FERR3-1   YES, ERROR
      STO           IGNORE BLANKS 
***************ADD FOR BUG 790928 MM*************** 
      JSB MCHAR     GET NEXT CHARACTER
      CPA DP        IS IT A DELIMITER?
      JMP FERR3-1     YES, ERROR
      JSB DIGCK     THIRD DIGIT 
      JMP FMT5        NO
      LDA REPCT     YES,
      STB REPCT       MULTIPLY PREVIOUS 
      MPY .10           RESULT BY 10
      ADA REPCT     ADD IN ONES DIGIT 
      STA REPCT 
      ISZ FST       INCREMENT STRING POINTER
      LDA FST       NEXT CHARACTER
      CPA DP        IS IT A DELIMITER?
      JMP FERR3-1     YES, ERROR
      STO           NO, IGNORE BLANKS 
*************************************************** 
      JSB MCHAR     GET NEXT CHARACTER
      CPA DP        IS IT A DELIMITER ? 
      JMP FERR3-1 
      JSB DIGCK     THIRD DIGIT ? 
      RSS 
      JSB ERROR     YES, ERROR
FERR4 EQU * 
FMT5  LDB REPCT 
      SZB,RSS       REPCT ZERO ?
      JSB ERROR     YES 
FERR5 ADB M133       NO. GREATER ***CHG FOR BUG 790928 MM***
      SSB,RSS            THAN 132?
      JMP FERR4-1   YES 
      ADB .133      RESTORE REPCT ***CHG FOR BUG 790928 MM*** 
      CMB,INB       SET NUMBER FLAG 
      STB FSP,I     LOAD ONTO FORMAT STACK
      ISZ FSP       INCREMENT STACK POINTER 
FMT6  CPA .X        IS NEXT CHARACTER AN X ?
      JMP FMT8      YES 
      CPA .A        IS IT AN A ?
      JMP FMT10     YES 
      CPA D         IS IT A D ? 
      RSS           YES 
      JMP FMT15     NO
      LDB DPFLG     DPFLG = -1? 
      SZB 
      JMP FMT7      YES 
      LDB NUM2      ADD REPCT TO
      ADB REPCT       POST-DECIMAL
      STB NUM2          DIGIT COUNTER 
      JMP FMT8
FMT7  LDB NUM1      ADD REPCT TO
      ADB REPCT       PRE-DECIMAL 
      STB NUM1          DIGIT COUNTER 
FMT8  CLB,INB       REINITIALIZE
      STB REPCT       REPCT 
      STA FSP,I     LOAD CHARACTER ONTO STACK 
      ISZ FST       INCREMENT STRING POINTER
      ISZ FSP       AND STACK POINTER 
      LDA FST       NEXT CHARACTER
      CPA DP          A DELIMITER ? 
      JMP FMT08     YES 
      STO           IGNORE BLANKS 
      JSB MCHAR     GET NEXT CHARACTER
      CPA DP        IS IT A DELIMITER ? 
      RSS           YES 
      JMP FMT0
FMT08 LDB FSP 
      STB EST       SET END OF STACK MARK 
      JMP FMT18 
FMT9  ISZ DPFLG     DPFLG = -1 ?
      JSB ERROR     NO
FERR6 JMP FMT8+2    YES 
FMT10 LDB SFLG      IS SFLG 
      SZB,RSS 
      ISZ SFLG      YES, INCREMENT IT 
      JMP FMT8      NO
FMT13 ISZ EFLAG     EFLAG= -1?
      JSB ERROR     NO
FERR7 JMP FMT8+2    YES 
FMT14 LDB NUM1
      ADB NUM2      ANY D'S FOUND ? 
      SZB,RSS 
      ISZ SBD       NO, INCREMENT BEFORE COUNTER
      LDB SBD       ANY S'S BEFORE A D ?
      SZB,RSS 
      ISZ SAD       NO, INCREMENT AFTER COUNTER 
      JMP FMT8+2
FMT15 CPA B50       IS CHARACTER A ( ?
      JMP FMT95     YES 
      CPA B57       SLASH?
      JMP FMT90     YES!
      JSB ERROR     NO, ILLEGAL CHARACTER 
FERR8 EQU * 
FMT18 LDA IFSS      REINITIALIZE
      STA FSP         STACK POINTER 
      CCA               AND 
      STA REPCT           REPCT 
      ADA SFLG      SFLG = 1 ?
      SZA,RSS 
      JMP FMT24     YES 
      ADA M2        SFLG = 3 ?
      SSA,RSS 
      JMP FMT25     YES 
      LDA NUM1     NNO, ANY 
      ADA NUM2        D'S 
      SZA,RSS           FOUND ? 
      JMP FMT20     NO
      JSB EVEXP     EVALUATE EXPRESSION 
      JMP FMEND     NONE FOUND
      JSB ERROR     STRING--ERROR 
FERR9 STA MANT1     IF NUMBER 
      STA NUMW1       SAVE HIGN MANTISSA
      JSB .FLUN     UNPACK NUMBER 
      STA EXPNT       AND SAVE THE EXPONENT 
      LDA MANT1     IS THE NUMBER NEGATIVE ?
      SSA,RSS 
      JMP FMT31     NO
      LDA B55       YES, SET SIGN TO MINUS
      STA SIGN        AND 
      CMB,CLE,INB       COMPLEMENT
      LDA MANT1 
      CMA           OVERFLOW FROM 
      SEZ,RSS         LOW MANTISSA ?
      JMP FMT31-3   NO
      INA           YES, OVERFLOW FROM
      SOS             HIGH MANTISSA ? 
      JMP FMT31-3   NO
      CLE,ERA       YES, SHIFT RIGHT
      ERB             AND 
      ISZ EXPNT         BUMP EXPONENT 
      NOP 
      STA MANT1 
      STA NUMW1     SAVE HIGH MANTISSA
      JMP *+3 
FMT31 LDA B53       SET SIGN
      STA SIGN        TO PLUS 
      STB MANT2 
      STB NUMW2     SAVE LOW MANTISSA 
      LDA EXPNT 
      STA EXPW        AND EXPONENT
      CLB,INB       SET EXPRESSION
      STB EC          FOUND FLAG
      LDA IHB         HOLDING BUFFER
      STA HBP           POINTER 
      LDA EFLAG     EFLAG 
      SZA,RSS         SET  ?
      JMP FMT62     YES 
      LDA DPFLG     DPFLG 
      SZA,RSS         SET 
      JMP FMT45     YES 
      JMP FMT30     NO
**                             ** 
***  OUTPUT A LITERAL STRING  *** 
**                             ** 
FMT46 LDA IFSS      RESET 
      STA FSP         STACK POINTER 
FMT47 LDA FSP,I     TOP OF STACK                 [B]
      CPA B42         A " ? 
      JMP FMT90     YES, DONE WITH THIS SPEC
      CPA B16       IS IT A PSEUDO-LINEFEED ? 
      LDA .10       YES, MAKE IT A LINEFEED 
      CPA B17       IS IT A PSEUDO CARRIAGE RETURN ?
      RSS           YES 
      JMP FMT48                                  [B]
      LDA B15         CARRIAGE RETURN            [B]
FMT48 EQU *                                      [B]
      JSB OUTCR     NO, OUTPUT THE CHARACTER
      ISZ FSP       INCREMENT STACK POINTER 
      JMP FMT47     NO                           [B]
**                                  **
***  OUTPUT A BLANK SPECIFICATION  ***
**                                  **
FMT20 LDA FSP,I     LOAD TOP OF STACK 
      SSA,RSS       IS IT A NUMBER ?
      JMP FMT21     NO
      STA REPCT     YES, STORE NUMBER IN REPCT
      ISZ FSP       INCREMENT STACK POINTER 
      LDA FSP,I     LOAD NEW TOP OF STACK 
FMT21 CPA .X        IS IT AN X ?
      RSS           YES 
      JMP FERR8-1   NO, ERROR 
      JSB OUTBL 
      CCA           REINITIALIZE
      STA REPCT       REPCT 
      LDA FSP       END 
      CPA EST         OF STACK
      JMP FMT90     YES 
      LDA FSP,I     LOAD NEW TOP OF STACK 
      JMP FMT20 
**                     ** 
***  OUTPUT A STRING  *** 
**                     ** 
FMT24 EQU * 
      JSB EVEXP     EVALUATE NEXT EXPRESSION
      JMP FMEND     NONE FOUND
FMT25 EQU * 
      CLB,INB,RSS   SET THE EXPRESSION
      JSB ERROR 
FER14 STB EC          FOUND FLAG
      LDA FSP,I     LOAD TOP OF STACK 
      SSA,RSS       IS IT A NUMBER ?
      JMP FMT26     NO
      STA REPCT     YES 
      ISZ FSP       INCREMENT STACK POINTER 
      LDA FSP,I     LOAD NEW TOP OF STACK 
FMT26 CPA .X        IS IT AN X ?
      RSS           YES 
      JMP FMT27     NO
      JSB OUTBL 
      JMP FMT28 
FMT27 CPA .A        IS IT AN A ?
      RSS           YES 
      JMP FERR9-1   NO, ERROR 
      ISZ FSP       INCREMENT STACK POINTER 
FMT05 EQU * 
      JSB FSCH      FETCH STRING CHARACTER
      LDA BLANK     NO, FETCH A BLANK 
      CPA B16       IS IT A PSEUDO-LINEFEED ? 
      LDA .10       YES, MAKE IT A LINEFEED 
      CPA B17       IS IT A PSEUDO CARRIAGE RETURN ?
      RSS           YES 
      JMP FMT29     NO
      LDA B15         CARRIAGE RETURN            [B]
FMT29 EQU * 
      JSB OUTCR     OUTPUT CHARACTER
      ISZ REPCT     REPCT USED UP ? 
      JMP FMT05     NO
FMT28 CCA           REINITIALIZE
      STA REPCT       REPCT 
      LDA FSP       END OF
      CPA EST         STACK ? 
      JMP FMT90 
      JMP FMT25     NO
**                                   ** 
***  PREPARE AN INTEGER FOR OUTPUT  *** 
**                                   ** 
FMT30 CLA           INITIALIZE PRE-DECIMAL POINT
      STA EXPON       DIGIT COUNTER 
      CCA 
      ADA EXPNT     EXPONENT ZERO OR NEGATIVE ? 
      SSA,RSS 
      JMP FMT32     NO
      LDA B60       YES, LOAD A 
      STA HBP,I       ZERO
      ISZ HBP       INCREMENT BUFFER POINTER
      CCA           NUMBER OF BUFFER WORDS
      STA NHBW        IS ONE
      JMP FMT33 
FMT32 JSB DTL1
      STA EXPON     SAVE NUMBER 
      STA NHBW        OF DIGITS 
      JSB GETDG     GET DIGIT 
      ADA B60       CONVERT TO ASCII
      STA HBP,I     STORE IN HOLD BUFFER
      ISZ HBP       ALL DIGITS
      ISZ EXPON       FOUND ? 
      JMP FMT32+3   NO
FMT33 LDA NUM1      COMPUTE NUMBER OF 
      ADA NHBW        LEADING BLANKS
      LDB SBD       ANY S'S 
      ADB SAD         FOUND ? 
      SZB 
      JMP FMT43     YES 
      LDB SIGN      NO, NUMBER POSITIVE ? 
      CPB B53 
      JMP FMT43     YES 
      ADA M1        NO, SAVE ROOM 
      CLB,INB         FOR 
      STB SNFLG         PRINTING SIGN 
FMT43 SSA           NUMBER OF BLANKS NEGATIVE ? 
      JMP FMT80     YES 
      STA NBLK      NO
      JSB ROUND     ROUND NUMBER IN BUFFER
      RSS 
      JMP FMT80     NO ROOM FOR CARRY FROM ROUND
      LDB IHB       REINITIALIZE
      STB HBP         HOLD BUFFER POINTER 
**                                       ** 
***  OUTPUT NUMBER FROM HOLDING BUFFER  *** 
**                                       ** 
FMT34 LDA FSP,I     LOAD TOP OF FORMAT STACK
      CPA S         IS IT AN S ?
      RSS           YES 
      JMP FMT36     NO
      ISZ FSP       INCREMENT STACK POINTER 
      LDA SNFLG 
      SZA           SNFLG = 0 ? 
      JMP FMT59     NO, IGNORE THE S
      LDB SBD       YES, ANY S'S BEFORE A D ? 
      SZB 
      JMP FMT35     YES 
      LDA SIGN      NO, OUTPUT SIGN 
      JSB OUTCR       IMMEDIATELY 
      LDA .2        SET SNFLG TO 2
      STA SNFLG 
      JMP FMT59 
FMT35 CCB 
      STB SNFLG     SET SNFLG TO -1 
      JMP FMT34 
FMT36 SSA,RSS       TOP OF STACK A NUMBER ? 
      JMP FMT06     NO
      STA REPCT     YES, STORE IN REPCT 
      ISZ FSP       INCREMENT STACK POINTER 
      LDA FSP,I     LOAD NEW TOP OF STACK 
FMT06 CPA .X        IS TOP AN X ? 
      RSS           YES 
      JMP FMT37     NO
      JSB OUTBL 
      CCA           REINITIALIZE
      STA REPCT       REPCT 
      JMP FMT59 
FMT37 CPA D         TOP OF STACK A D ?
      RSS           YES 
      JMP FMT57     NO
      ISZ FSP       INCREMENT STACK POINTER 
      CCA 
      ADA NBLK      NUMBER OF BLANKS > 0 ?
      SSA 
      JMP FMT07     NO
      LDA BLANK     YES, OUTPUT A 
      JSB OUTCR       BLANK 
      CCB           DECREMENT 
      ADB NBLK        BLANK 
      STB NBLK          COUNT 
      JMP FMT40 
FMT07 LDA NBLK      NUMBER OF BLANKS
      SSA             LESS THAN ZERO ?
      JMP FMT56     YES 
      CCA           NO, DECREMENT 
      STA NBLK        BLANK COUNT 
      CCB 
      CPB SNFLG     SNFLG = - 1 ? 
      JMP FMT02     YES 
      ADB SNFLG     SNFLG = 1 ? 
      SZB,RSS 
      JMP FMT40     YES 
      JMP FMT58     NO
FMT56 CCB 
      ADB SNFLG     SNFLG = 1 ? 
      SZB 
      JMP FMT58     NO
FMT02 LDA SIGN      YES, OUTPUT 
      JSB OUTCR       SIGN AND
      LDA .2        SET SNFLG 
      STA SNFLG     TO 2
FMT58 LDA IHB       END 
      ADA .46         OF
      CPA HBP           BUFFER ?
      JMP FMT59 
      LDA HBP,I     OUTPUT A
      JSB OUTCR       DIGIT 
      ISZ HBP       INCREMENT HOLD BUFFER POINTER 
      LDA EFLAG     IS THIS A 
      SZA             FLOATING POINT SPECIFICATION ?
      JMP FMT40     NO
      CLA,INA       YES, HAS THE DECIMAL POINT
      CPA DPFLG       BEEN FOUND YET ?
      JMP FMT40     YES 
      CCA           NO, DECREMENT 
      ADA EXPON       DECIMAL 
      LDB IHB,I     IS THE
      CPB B60         NUMBER ZERO?
      CLA           YES, ZERO EXPONENT
      STA EXPON         EXPONENT
FMT40 ISZ REPCT     REPCT = O ? 
      JMP FMT37+4   NO
      CCA           YES,REINITIALIZE
      STA REPCT       REPCT 
      JMP FMT59 
FMT57 LDB DPFLG     FIXED POINT 
      SZB             SPECIFICATION ? 
      JMP FMT42     NO
      CPA B56       TOP OF STACK A DECIMAL POINT ?
      RSS           YES 
      JMP FMT42     NO
      ISZ FSP       INCREMENT STACK POINTER 
      LDB SNFLG 
      SSB           SNFLG = -1 ?
      JMP FM00      YES 
      ADB M1        NO, = 1 ? 
      SZB 
      JMP FM01      NO
FM00  LDA SIGN      YES, OUTPUT 
      JSB OUTCR       SIGN
      LDA .2        SET SNFLG 
      STA SNFLG       TO 2
FM01  LDA B56       OUTPUT
      JSB OUTCR       DECIMAL POINT 
      ISZ DPFLG     INCREMENT FLAG TO SHOW D.P. FOUND 
FMT59 LDA FSP       END OF
      CPA EST         STACK 
      JMP FMT90     YES 
      JMP FMT34     NO
FMT42 ISZ FSP       INCREMENT STACK POINTER 
      JSB OUTCR     OUTPUT AN E 
FMT76 LDA FSP       END OF
      CPA EST         STACK ? 
      JMP FMT78     YES 
      LDA FSP,I     NO,TOP OF 
      SSA,RSS         STACK A NUMBER ?
      JMP FM02      NO
      ISZ FSP       YES, INCREMENT STACK POINTER
      STA REPCT     STORE NUMBER
      LDA FSP,I     GET NEW TOP OF STACK
FM02  CPA .X        IS IT AN X ?
      RSS           YES 
      JMP FERR7-1   NO, ERROR 
      JSB OUTBL 
      CCA           RESET 
      STA REPCT       REPCT 
      JMP FMT76 
FMT78 LDA B55       OUTPUT
      LDB EXPON 
      SSB             AN
      CMB,INB,RSS 
      LDA B53           EXPONENT
      STB EXPON 
      JSB OUTCR           SIGN
      LDA EXPON 
      CLB           COMPUTE 
      DIV .10 
      ADA B60         EXPONENT'S
      ADB B60 
      STB EXPON         10'S DIGIT
      JSB OUTCR     OUTPUT IT 
      LDA EXPON 
      JSB OUTCR     OUTPUT 1'S DIGIT
      JMP FMT90 
**                                **
***  PREPARE FIXED POINT NUMBER  ***
**                                **
FMT45 CLA           SET PRE-DECIMAL POINT 
      STA EXPON       DIGIT COUNTER 
      STA NAD         ZERO COUNTER
      CPA EXPNT     ZERO EXPONENT ? 
      JMP FMT61+3   YES 
      LDB EXPNT     NO
      SSB           EXPONENT NEGATIVE 
      JMP FMT61     YES 
      JSB DTL1
      STA EXPON     LOAD
      STA NBD         PRE-DECIMAL POINT 
FM03  JSB GETDG         DIGITS
      ADA B60 
      STA HBP,I           INTO
      ISZ HBP               HOLD
      ISZ EXPON               BUFFER
      JMP FM03
FMT50 LDB NUM2      ANY D'S AFTER 
      SZB,RSS         DECIMAL POINT ? 
      JMP FMT51     NO
      LDA IHB       END 
      ADA .46         OF
      CPA HBP           BUFFER ?
      JMP FM04      YES 
      LDB NAD       LEADING 
      CLA             ZEROES
      SZB,RSS           AFTER 
      JMP *+4             DECIMAL 
      ADB M1                POINT 
      STB NAD 
      RSS           YES 
      JSB GETDG 
      ADA B60       LOAD
      STA HBP,I       POST-DECIMAL POINT
      CCB             DIGITS
      ADB NUM2            INTO
      STB NUM2              HOLD
      ISZ HBP                 BUFFER
      JMP FMT50+1 
FM04  LDA NUM2      OUTPUT BLANKS 
      CMA,INA         TO
      STA REPCT         FILL FIELD
      JSB OUTBL 
      CCA           REINITIALIZE
      STA REPCT       REPCT 
      ADA FSP       CORRECT 
      STA FSP         STACK POINTER 
FMT51 LDA NBD       COMPUT NUMBER 
      ADA NUM1        OF LEADING BLANKS 
      LDB SBD       ANY S'S 
      ADB SAD         FOUND ? 
      SZB 
      JMP FMT54     YES 
      LDB SIGN      NO, NUMBER
      CPB B53         POSITIVE ?
      JMP FMT54     YES 
      ADA M1        NO, LEAVE ROOM FOR
      CLB,INB         SIGN TO BE PRINTED AND
      STB SNFLG         SET SNFLG TO 1
FMT54 SSA           NUMBER OF BLANKS NEGATIVE ? 
      JMP FMT80     YES 
      STA NBLK      NO, 
      CCB           NEXT DIGIT A
      ADB NAD         LEADING ZERO ?
      SSB 
      JSB ROUND     NO, ROUND NUMBER
      RSS 
      JMP FMT80     NO ROOM FOR CARRY FROM ROUND
      LDA IHB       RESET HOLD
      STA HBP         BUFFER POINTER
      JMP FMT34     GO OUTPUT THE NUMBER
FMT61 JSB MTG1
      LDA EXPON 
      STA NAD 
      LDB NUM1      ANY D'S FOUND 
      SZB,RSS         BEFORE THE DECIMAL POINT ?
      JMP FMT50     NO
      LDA NUM2      YES, ANY D'S FOUND
      SZA,RSS         AFTER THE DECIMAL POINT ? 
      JMP FMT55     NO
      CPB .1        YES, ONLY ONE OF THEM ? 
      RSS 
      JMP FMT55     NO
      LDA SAD       YES, ANY S'S FOUND ?
      ADA SBD 
      SZA 
      JMP FMT55     YES 
      LDA SIGN      NO, NUMBER
      CPA B55         NEGATIVE ?
      JMP FMT50     YES 
FMT55 LDA B60       NO, LOAD PRE-DECIMAL POINT
      STA HBP,I       ZERO INTO BUFFER
      ISZ HBP 
      CCA           DECREASE NUMBER OF
      ADA NUM1        D'S AVAILABLE FOR SIGN
      STA NUM1          AND BLANKS BEFORE DECIMAL PT. 
      JMP FMT50 
**                                   ** 
***  PREPARE FLOATING POINT NUMBER  *** 
**                                   ** 
FMT62 CLA           INITIALIZE DECIMAL
      STA EXPON       EXPONENT
      CPA EXPNT     ZERO EXPONENT ? 
      JMP *+3       YES 
      JSB MTG1
      JSB DTL1
      CMA,INA       SAVE DECIMAL EXPONENT 
      STA EXPON 
      LDA NUM1      GET 
      ADA NUM2        TOTAL NUMBER
      STA TOTDG         OF DIGITS 
      LDA SBD 
      ADA SAD       ANY S'S FOUND ? 
      SZA 
      JMP FMT67     YES 
      LDA SIGN      NO, NUMBER
      CPA B53         POSITIVE ?
      JMP FMT67     YES 
      CCB           NO, LEAVE ROOM
      ADB NUM1        FOR SIGN
      SSB           NONE ?
      JMP FMT80     YES 
      STB NUM1      NO, DECREMENT 
      CCA             TOTAL NUMBER OF D'S 
      ADA TOTDG         AVAILABLE FOR SIGN
      STA TOTDG           AND BLANKS BEFORE DEC. PT.
      SZA,RSS 
      JMP FMT80 
      CLB,INB       SET SNFLG 
      STB SNFLG       TO 1
FMT67 LDA NUM2      NUM2
      CMA,INA         > 7 ? 
      LDB .6
      ADB 0 
      SSB 
      JMP FMT70     YES 
      LDA TOTDG     YES, TOTAL NUMBER OF D'S
      ADA M8          > 7 ? 
      SSA 
      JMP FMT68     NO
      LDB M7        PREPARE TO GET
      STB DCTR        SEVEN DIGITS
      INA           NUMBER OF BLANKS
      STA NBLK        BECOMES TOTDG - 7 
      JMP FMT72 
FMT68 LDA TOTDG     PREPARE TO GET
      CMA,INA 
      STA DCTR        TOTDG DIGITS
      CLB           SET NUMBER OF BLANKS
      STB NBLK        TO ZERO 
      JMP FMT72 
FMT70 LDB NUM1      ANY D'S BEFORE
      SZB             DECIMAL POINT ? 
      ADA M1        YES, INCREMENT NUMBER OF DIGITS 
      STA DCTR      PREPARE TO GET NUM2 DIGITS
      SZB           SET 
      ADB M1          BLANK 
      STB NBLK          COUNT 
      LDA DCTR      MORE THAN 
      ADA .46         FOURTY-SIX
      SSA,RSS           DIGITS NEEDED ? 
      JMP FMT72     NO
      STA REPCT     YES, OUTPUT NECESSARY BLANKS
      JSB OUTBL 
      ADA FSP       CORRECT 
      STA FSP         STACK POINTER 
      LDA M46       SET DCTR
      STA DCTR        TO 46 
FMT72 EQU * 
      CCA           REINITIALIZE
      STA REPCT       REPCT 
      JSB GETDG 
      ADA B60       CONVERT TO ASCII
      STA HBP,I     STORE IN HOLD BUFFER
      ISZ HBP       INCREMENT BUFFER POINTER
      ISZ DCTR      ALL DIGITS GOT ?
      JMP FMT72     NO
      JSB ROUND     YES, ROUND THE NUMBER IN BUFFER 
      RSS 
      JMP FMT80     NO ROOM FOR CARRY FROM ROUND
      LDA IHB       RESET 
      STA HBP         BUFFER POINTER
      JMP FMT34 
**                                 ** 
***  HANDLE END OF SPECIFICATION  *** 
**                                 ** 
FMT90 CLA 
      STA SFLG        STRING FLAG 
      LDA CC        ENF OF
      CPA NCH         FORMAT STRING ? 
      RSS           YES 
      JMP FMT92     NO
FMT09 LDA CC1       YES, PARENTHESIS
      SZA             BALANCED ?
      JSB ERROR      NO, ERROR
FER10 EQU * 
FMT91 LDB EC        ANY EXPRESSIONS 
      SZB,RSS         USED ?
      JMP FMEND     NO
      LDB EDSTA     END OF
      SZB,RSS         STATEMENT ? 
      JMP FMEND     YES 
      CLA 
      STA EC        YES, CLEAR EC 
      STA CC
      LDA IFSTR     RESET 
      STA DP          DELIMITER POINTER 
      JMP FMT2
FMT92 LDA DP        GET THE 
      CLO             DELIMITING CHARACTER
      JSB MCHAR         NOT IGNORING BLANKS 
      CPA B51       IS IT A RIGHT PARENTHESIS 
      JMP FMT97     YES 
      STA LCH       NO, SAVE THE CHARACTER
      CPA B54       IS IT A COMMA ? 
      JMP FMT93+3   YES 
      CPA B57       IS IT A SLASH ? 
      RSS           YES 
      JMP FERR1-1   NO, ERROR EXIT
FMT93 JSB OUTLN     OUTPUT LINE 
      CLA 
      STA OCCNT 
      STA TEMP1,I   CLEAR LU/CHAR COUNT WORD
      ISZ CC        INCREMENT CHARACTER COUNTER 
      LDA CC        ALL CHARACTERS
      CPA NCH         USED ?
      JMP FMT94     YES 
      ISZ DP        INCREMENT DELIMITER POINTER 
      JSB DSRCH     FIND NEXT DELIMITER 
      STO           IGNORE BLANKS 
      LDA FST 
      JSB MCHAR       NEXT CHARACTER
      CPA DP        IS IT A DELIMITER 
      RSS           YES 
      JMP FM11      NO
      LDA CC        ALL CHARACTERS
      CPA NCH         USED ?
      JMP FMT94     YES 
      LDA DP        NO, GET DELIMITING
      CLO             CHARACTER 
      JSB MCHAR         IGNORING BLANKS 
FM11  CPA B54       IS IT A COMMA 
      JMP FMT94     YES 
      CPA B57       NO, A SLASH 
      JMP FMT89     YES 
      CPA B51       NO, A RIGHT PARENTHESIS ? 
      JMP FMT97     YES 
      JMP FMT3
FMT94 LDA LCH       LAST CHARACTER
      CPA B54         A COMMA ? 
      JMP FERR0-1 
FMT89 LDA CC        NO, ALL CHARACTERS
      CPA NCH         USED ?
      JMP FMT09     YES 
      JMP FMT92     NO
**                                     ** 
***  HANDLE GROUPS OF SPECIFICATIONS  *** 
**                                     ** 
FMT95 CCA           SECOND
      ADA FSP         CHARACTER 
      CPA IFSS          IN STACK ?
      RSS 
      JSB ERROR      NO, ERROR
FER11 LDA CC1       YES, FIRST LEVEL
      SZA             OF PARENTHESIS ?
      JMP FMT96     NO
      ISZ FST       INCREMENT STRING POINTER
      CCA           FIND CHARACTER COUNT
      ADA IFSTR           UP TO AND INCLUDING 
      CMA                     LEFT
      ADA FST                   PARENTHESIS 
      STA CC1 
      LDB REPCT     STORE REPETITION
      STB PC1         COUNT 
      JMP FMT3      PROCESS STRING
FMT96 LDA CC2       SECOND LEVEL
      SZA             OF PARENTHESIS
      JSB ERROR      NO, ERROR
FER12 ISZ FST 
      CCA           FIND CHARACTER COUNT
      ADA IFSTR           UP TO AND 
      CMA                     INCLUDING 
      ADA FST                   LEFT
      STA CC2                     PARENTHESIS 
      LDB REPCT     STORE REPETITION
      STB PC2             COUNT 
      JMP FMT3
FMT97 LDA PC2       SECOND LEVEL OF 
      SZA,RSS         PARENTHESIS ? 
      JMP FMT98     NO
      ADA M1        YES, REPEAT IT
      STA PC2 
      SZA,RSS 
      JMP FMT99 
      LDB CC2       RESET 
      STB CC          CHARACTER COUNTER 
      ADB IFSTR 
      STB DP          AND STRING POINTER
      JSB DSRCH 
      JMP FMT3      REPROCESS PARENTHESIZED STRING
FMT99 CLA           CLEAR SECOND
      STA CC2         LEVEL POINTER 
      STA SFLG        AND STRING FLAG 
      ISZ CC        INCREMENT CHARACTER COUNTER 
      LDA CC        ALL CHARACTERS
      CPA NCH         USED ?
      JMP FERR1-1   YES, ERROR
      ISZ DP        NO, POINT TO DELIMITER
      JSB DSRCH     FIND NEXT DELIMITER 
      STO           GET NEXT
      LDA FST         NON-BLANK 
      JSB MCHAR         CHARACTER 
      CPA DP        IS IT A DELIMITER ? 
      RSS           YES 
      JMP FMT92+3   MAYBE 
      LDB CC        ALL 
      CPB NCH         CHARACTERS USED ? 
      JMP FER10-1     YES, ERROR
      JMP FMT92     NO, INVESTIGATE THE CHARACTER 
FMT98 LDA PC1       FIRST LEVEL 
      SZA,RSS         OF PARENTHESIS ?
      JSB ERROR      NO, ERROR
FER13 ADA M1        YES, REPEAT IT
      STA PC1 
      SZA,RSS 
      JMP FMT00 
      LDB CC1       RESET 
      STB CC          CHARACTER COUNTER 
      ADB IFSTR 
      STB DP
      JSB DSRCH 
      JMP FMT3      REPROCESS PARENTHESIZED STRING
FMT00 CLA           CLEAR FIRST 
      STA CC1         LEVEL POINTER 
      STA SFLG        AND STRING FLAG 
      ISZ CC        INCREMENT CHARACTER COUNTER 
      ISZ DP        POINT TO DELIMITER
      LDA CC        ALL 
      CPA NCH         CHARACTERS USED ? 
      JMP FMT91     YES 
      JSB DSRCH     NO, FIND NEXT DELIMITER 
      STO           GET NEXT
      LDA FST         NON-BLANK 
      JSB MCHAR         CHARACTER 
      CPA DP        IS IT A DELIMITER ? 
      RSS           YES 
      JMP FMT92+3   NO
      LDB CC        ALL 
      CPB NCH         CHARACTERS USED ? 
      JMP FMT91     YES 
      JMP FMT92     NO, INVESTIGATE THE FOUND CHARACTER 
**                                     ** 
***  OUTPUT NUMBER IN DEFAULT FORMAT  *** 
**                                     ** 
FMT80 LDA NUMW1 
      STA MANT1     LOAD
      LDB NUMW2 
      STB MANT2       SAVED 
      LDA EXPW
      STA EXPNT         NUMBER
      CLA           CLEAR 
      STA EXPON       DECIMAL EXPONENT
      STA EFLAG     SET FLOATING POINT FLAG 
      CPA EXPNT     ZERO EXPONENT ? 
      JMP *+3       YES 
      JSB MTG1
      JSB DTL1
      CMA 
      STA EXPON 
      JSB OUTLN     OUTPUT LINE W/CR-LF 
      CLA 
      STA OCCNT 
      STA TEMP1,I   CLEAR LU/CHAR COUNT WORD
      LDA IHB       RESET HOLD
      STA HBP         BUFFER POINTER
      LDA M6        PREPARE TO GET
      STA TOTDG       SIX DIGITS
      JSB GETDG     GET 
      ADA B60 
      STA HBP,I       SIX 
      ISZ HBP 
      ISZ TOTDG         DIGITS
      JMP *-5 
      LDA .2        SET NBLK TO 
      STA NBLK        WHERE IT WONT CAUSE TROUBLE 
      JSB ROUND     ROUND NUMBER IN HOLD BUFFER 
      NOP 
      LDA SIGN      OUTPUT
      JSB OUTCR       SIGN
      LDA IHB       INITIALIZE
      STA HBP       HOLD BUFFER POINTER 
      LDA HBP,I     OUTPUT
      JSB OUTCR       DIGIT 
      ISZ HBP         INCREMENT HOLD BUFFER POINTER 
      LDA B56       OUTPUT
      JSB OUTCR       DECIMAL POINT 
      LDA M5        PREPARE TO OUTPUT 
      STA TOTDG       FIVE DIGITS 
      LDA HBP,I     OUTPUT
      JSB OUTCR       FIVE
      ISZ HBP           DIGITS
      ISZ TOTDG 
      JMP *-4 
      LDA E         OUTPUT
      JSB OUTCR       AN E
      LDA B55 
      LDB EXPON     OUTPUT
      SSB 
      CMB,INB,RSS     EXPONENT
      LDA B53 
      STB EXPON         SIGN
      JSB OUTCR 
      LDA EXPON 
      CLB           GET BOTH EXPONENT DIGITS
      DIV .10 
      ADA B60       CONVERT BOTH
      ADB B60         TO ASCII
      STB EXPON 
      JSB OUTCR     OUTPUT 10'S DIGIT 
      LDA EXPON 
      JSB OUTCR     OUTPUT 1'S DIGIT
      RSS           OUTPUT LINE 
      JMP FMT90 
FM16  JSB OUTLN 
      CLA 
      STA TEMP1,I   CLEAR OUT LU/CHAR COUNT WORD
      STA OCCNT     CLEAR CHAR COUNT
      JMP XIT 
FMEND LDA CONTR     YES, CONTROL
      SZA,RSS       CHARACTER FOUND ? 
      JMP FM16      NO,OUTPUT W/CRLF
      CPA B53       IS CARRIAGE 
      RSS                CONTROL "+"? 
      JMP FM10      NO
      LDA B15       YES 
      JSB OUTCR       OUTPUT A CARRIAGE RETURN
      JMP FM18      OUTPUT THE LINE 
FM10  CPA B55       IS IT A MINUS ? 
      JMP FM12      YES, SUPPRESS CARRIAGE RETURN 
      CPA B43       IS CARRIAGE CONTROL "#"?
      JMP FM13      YES, SUPPRESS CARRIAGE RETURN AND LINEFEED
      JMP XIT       NOT CORRECT CHAR, SO IGNORE ALL 
FM12  LDA .10       OUTPUT A
      JSB OUTCR       LINEFEED
* 
FM13  STA BFFLG     SET TO KEEP TRACK OF CHAR COUNT 
      JSB OUTPT     OUTPUT A LINE 
XIT   LDA HTEMP     RESTORE 
      STA HSTPT       HI STK PTR
      JMP XEC4      EXECUTE NEXT STMT 
* 
FM18  CLA           SET OUTPUT NOW FLAG 
      STA BFFLG 
      JMP FM13
* 
* IF BFFLG=0   THEN OUTPUT WITHOUT CHAR COUNT 
* 
OUTPT NOP 
*****************************790712*****************************
      JSB HONES     SET UP HONESTY MODE DOES NOT
      CLB           MATTER WHAT DEVICE
***REMOVED THIS** 
*     LDA LUOUT 
*     AND B77       IS THIS 
*     JSB FINDV       DEVICE A
*     CPA .10           LINEPRINTER?
*     JMP FM15      YES!
*     LDA LFTAR     ADD LEFT ARROW
*     JSB OUTCR     OUT IT
*     CLB           CLEAR WORD COUNT
********************790712*********************************** 
****REMOVED LABEL 'FM14' 790820***********************
      LDA BFFLG     IS THIS OUTPUT CONTAIN
      SZA,RSS         A CARRIAGE RETURN?
      JMP FM17      YES 
***********************790712******************************** 
*     ADB M1        SUBTRACT 1 FOR BACK ARROW 
***********************790712******************************** 
      JSB BLDLU     BUILD LU/COUNT WORD 
FM17  STA TEMP1,I   PUT IT IN TABLE 
      JSB OUTLN 
      CLA 
      STA OCCNT     CLEAR CHAR COUNT
      JMP OUTPT,I 
* 
***********************REMOVED 790712*****************************
*FM15  JSB HONES     SET UP HONESTY MODE
*     CLB,INB       ADJUST FOR BACK ARROW PROCESSING
*     JMP FM14
******************************790712***************************** 
* 
BFFLG BSS 1 
EC    BSS 1 
FST   BSS 1 
SFLG  BSS 1 
EXPW  BSS 1 
IHB   DEF HB
HB    BSS 46
IFSS  DEF FSS       FORMAT STACK
FSS   BSS 72
HBP   BSS 1 
DPFLG BSS 1 
FSP   BSS 1 
EXPON BSS 1 
FFLG  BSS 1 
EDSTA BSS 1 
ELCNT BSS 1 
NAD   BSS 1 
NBD   BSS 1 
LCH   BSS 1 
NBLK  BSS 1 
NHBW  BSS 1 
NUMW1 BSS 1 
NUMW2 BSS 1 
SNFLG BSS 1 
TOTDG BSS 1 
DCTR  BSS 1 
CC1   BSS 1 
CC2   BSS 1 
CONTR BSS 1 
EFLAG BSS 1 
REPCT BSS 1 
EST   BSS 1 
CC    BSS 1 
DP    BSS 1 
PC1   BSS 1 
PC2   BSS 1 
NUM1  BSS 1 
NUM2  BSS 1 
SAD   BSS 1 
SBD   BSS 1 
IFSTR BSS 1 
B15   EQU .13 
B16   EQU .14 
B17   EQU .15 
B43   OCT 43
B50   OCT 50
B51   OCT 51
B53   OCT 53
B54   OCT 54
B55   OCT 55
B56   OCT 56
B57   OCT 57
B60   OCT 60
B61   OCT 61
M32   DEC -32 
M96   DEC -96 
.58   DEC 58
B140  OCT 140 
E     OCT 105 
.46   DEC 46
M8    DEC -8
      SKP 
**********************************
*                                *
**  FORMATTER UTILITY ROUTINES  **
*                                *
**********************************
* 
* 
***  MAKE A NUMBER LESS THAN 1  *** 
**                               ** 
* 
*  MULTIPLY AN UNPACKED FLOATING POINT
*  NUMBER IN MANT1, MANT2 AND EXP BY 10 UNTIL 
*  IT IS GREATER THAN 1.  THEN DIVIDE BY 10 
* 
MTG1  NOP 
      JSB MBY10 
      LDA EXPNT       MULTIPLY
      CMA,SSA,INA,SZA   NUMBER BY 10
      JMP *+3             UNTIL IT IS 
      ISZ EXPON             GREATER 
      JMP MTG1+1              THAN 1
      JSB DBY10     DIVIDE BY 10
      JMP MTG1,I
* 
*  DIVIDE AN UNPACKED FLOATING POINT NUMBER 
*  IN MANT1, MANT2 AND EXP BY 10 UNTIL IT IS
*  LESS THAN 1
* 
DTL1  NOP 
      LDA EXPON 
DTL10 LDB EXPNT     DIVIDE
      CMB,INB         NUMBER
      SSB,RSS           BY 10 
      JMP DTL1,I          UNTIL 
      STA EXPON             IT IS 
      JSB DBY10               LESS
      CCA                       THAN
      ADA EXPON                   1 
      JMP DTL10 
      SKP 
**                        **
***  ROUND ASCII NUMBER  ***
**                        **
* 
*  NUMBER STORED ONE ASCII DIGIT PER WORD IN
*  HOLDING BUFFER.  ROUTINE GETS NEXT DIGIT 
*  AND ROUNDS IF IT IS >= 5.
*  IF THERE IS A CARRY TO AN EXTRA DIGIT AND NO 
*  ROOM EXISTS, EXIT IS TO (P+1).  OTHERWISE RETURN 
*  TO (P+2).
* 
ROUND NOP 
      JSB GETDG     GET NEXT DIGIT
      ADA M5        IS IT >= 5 ?
      SSA 
      JMP ROUND,I 
      CCA           DECREMENT HOLD
      ADA HBP         BUFFER POINTER
ROND1 LDB 0,I       LOAD NEXT DIGIT 
      INB           INCREMENT IT
      CPB .58       WAS IT A 9 ?
      JMP *+3       YES 
      STB 0,I       NO, SAVE IT 
      JMP ROUND,I     AND RETURN
      LDB B60       OVERLAY 
      STB 0,I         A 0 
      CPA IHB       LEADING DIGIT ? 
      JMP *+3       YES 
      ADA M1        NO, DECREMENT POINTER 
      JMP ROND1 
      LDB B61       OVERLAY A 
      STB 0,I         ONE 
      LDB B60       LOAD
      STB HBP,I       EXTRA ZERO
      LDB EFLAG     FLOATING POINT
      SZB             SPECIFICATION ? 
      JMP ROND2     NO
      ISZ EXPON     INCREMENT EXPONENT
      NOP 
      JMP ROUND,I 
ROND2 CCB          IS NBLK
      ADB NBLK        LESS
      SSB               THAN 1 ?
      ISZ ROUND     NO, RETURN TO (P+2) 
      STB NBLK      YES, KEEP DECREMENTED VALUE 
      JMP ROUND,I 
      SKP 
**                   ** 
***  OUTPUT BLANKS  *** 
**                   ** 
* 
*  OUTPUTS THE NUMBER OF BLANKS SPECIFIED 
*  BY THE NEGATIVE OF REPCT.  THE STACK POINTER 
*  IS INCREMENTED AND REPCT HAS THE VALUE ZERO
*  UPON EXIT. 
* 
OUTBL NOP 
      ISZ FSP       INCREMENT STACK POINTER 
      LDA BLANK     OUTPUT A
      JSB OUTCR       BLANK 
      ISZ REPCT     REPCT USED UP ? 
      JMP *-3 
      JMP OUTBL,I 
* 
      SKP 
**                                       ** 
***  SEARCH FOR A DELIMITING CHARACTER  *** 
**                                       ** 
* 
*  BEGINS SEARCH AT CHARACTER DP.  WHEN A COMMA 
*  OR SLASH IS FOUND, DP IS SET TO POINT TO THAT
*  CHARACTER.  CHARACTERS ARE COUNTED AND IF THE
*  END OF THE STRING IS ENCOUNTERED BEFORE A
*  DELIMITER IS FOUND, A FLAG IS SET
* 
DSRCH NOP 
      LDA DP        SET STRING POINTER TO 
      STA FST         FIRST CHARACTER 
      CLO           DON'T IGNORE BLANKS 
SER1  JSB MCHAR     GET STRING CHARACTER
      CPA B54       IS IT A COMMA ? 
      JMP DSRCH,I   YES 
      CPA B57       NO, IS IT A SLASH ? 
      JMP DSRCH,I   YES 
      CPA B51       NO, IS IT A RIGHT PARENTHESIS ? 
      JMP DSRCH,I   YES 
      ISZ DP        NO,INCREMENT DELIMITER POINTER
      ISZ CC        AND CHARACTER COUNTER 
      LDA DP
      LDB CC
      CPB NCH       ALL CHARACTERS USED ? 
      JMP DSRCH,I   YES 
      JMP SER1      NO
**                          **
***  MASK OUT A CHARACTER  ***
**                          **
* 
*  GET NEXT CHARACTER FROM FORMAT STRING
*  ADDRESS OF CHARACTER IS IN (A).  CHARACTER IS
*  RETURNED IN (A)
* 
MCHAR NOP 
      CLE,ERA       SHIFT ADDRESS RIGHT 
      LDB 0,I       LOAD WORD FROM STRING 
      SEZ,RSS       HIGH CHARACTER ?
      BLF,BLF       YES, SWITCH POSITIONS 
      LDA 1         NO
      AND B377      MASK OUT LOW CHARACTER
      SOS           SHOULD BLANKS BE IGNORED ?
      JMP MCHAR,I 
      CPA BLANK     YES, IS CHARACTER A BLANK ? 
      JMP MCHR1     YES 
      ADA M96       NO
      SSA,RSS       LOWER CASE? 
      ADA M32       YES 
      ADA B140      NO
      JMP MCHAR,I 
MCHR1 EQU * 
      ISZ FST       INCREMENT STRING POINTER
      LDA FST       NEXT CHARACTER
      CPA DP          A DELIMITER ? 
      JMP MCHAR,I   YES, RETURN 
      JMP MCHAR+1   IGNORE THE BLANK
**                         ** 
***  EVALUATE EXPRESSION  *** 
**                         ** 
* 
*  EXTRACT THE NEXT VARIABLE TO BE OUTPUT BY THE FORMATTER. IF
*  NONE FOUND, EXIT TO (P+1).  IF A STRING IS FOUND, EXIT TO
*  (P+2) AFTER PREPARING THE STRING FOR OUTPUT.  IF A NUMERIC 
*  QUANTITY IS FOUND, EXIT TO (P+3) WITH THE NUMBER IF (A) AND (B). 
*  EDSTA IS SET TO 0 IF THIS IS THE LAST VARIABLE IN THE STATEMENT. 
* 
EVEXP NOP 
EVEX0 LDB TEMPS 
      CPB PRADD     END OF STATEMENT? 
      JMP EVEXP,I   YES 
      LDA 1,I 
      AND OPDMK     NULL
      SZA             OPERAND?
      JMP EVEX5     NO, EVALUATE IT 
      INB 
      STB TEMPS 
      CPB PRADD     END-OF-STMT?
      JMP EVEXP,I   YES 
EVEX5 CCA           TURN OFF
      STA EOL         FUNCTION FLAG 
      JSB FORMX     EVALUATE FORMULA
      LDB HSTPT,I   IS IT A 
      SSB             STRING VARIABLE ? 
      JMP EVEX3     YES 
      JSB OPCHK     NO, UNSTACK VALUE ADDRESS 
      ISZ EOL       A FUNCTION ?
      JMP EVEX0 
      LDA TEMPS     LAST VARIABLE?
      INA 
      CPA PRADD 
      CLA           YES 
      STA EDSTA     NO
      DLD 1,I       NO, LOAD NUMBER 
      ISZ EVEXP     RETURN TO (P+3) 
      JMP EVEX4 
EVEX3 LDA M2        PREPARE 
      JSB PSTR        PRINT 
      STA TEMP8         STRING
      STB TPRME 
      LDB TEMPS     END OF
      INB 
      CPB PRADD       STATEMENT?
      CLB           YES 
      STB EDSTA     NO
      LDB TPRME 
EVEX4 EQU * 
      ISZ EVEXP     RETURN TO 
      JMP EVEXP,I     (P+2) 
      SKP 
*********************** 
*                     * 
*  FIND LU/COUNT WORD * 
*                     * 
*********************** 
* 
FLUPT NOP 
      LDA LUOUT     CREATE THE
      AND B77         SEARCH TARGET 
      STA LUTMP 
      LDB M20       INITIALIZE
      STB TEMP7       COUNTER 
      ADB FCORE         AND FIGURE START OF LIST
      CCA           INITIALIZE
      STA TEMP1       EMPTY SLOT POINTER
      STA TEMP3         AND FLAG
FLUP1 LDA 1,I       EXAMINE A WORD
      SZA           EMPTY ? 
      JMP FLUP2       NO
      ISZ TEMP3       YES, IS THIS THE FIRST
      JMP FLUP4         NO, SKIP TO NEXT
      STB TEMP1         YES, SAVE POINTER 
      JMP FLUP4             AND SKIP TO NEXT
FLUP2 ALF,ALF       POSITION AND
      AND B77         ISOLATE LU BYTE 
      CPA LUTMP     DOES IT MATCH ? 
      JMP FLUP3       YES 
FLUP4 INB             NO, TRY AGAIN 
      ISZ TEMP7         UNLESS THERE
      JMP FLUP1           AREN'T ANY MORE 
* 
      CLA           MATCH NOT FOUND 
      LDB TEMP1       WAS THERE AN EMPTY
      SSB               SLOT ?
      JMP E1              NO, OUT OF STORAGE
      JMP FLUP5            YES, QUIT WITH A = 0, B = ADDR 
* 
FLUP3 LDA 1,I       MATCH FOUND 
      STB TEMP1       RETURN WITH A = COUNT WORD
FLUP5 AND B377      SET UP
      STA TYPE        CHAR COUNT
      JMP FLUPT,I 
      SKP 
*************************** 
*                         * 
*  SPACE FOR A COMMA      * 
*                         * 
*************************** 
* 
EDELM NOP 
      CLB 
      STB OUTLN     SET FLAG FOR LINE OVERFLOW
      LDA OCCNT 
      ADA TYPE      FIGURE CURRENT COLUMN 
      DIV .15       TAKE COLUMN .MOD. 15
      SZB,RSS       RIGHT ON ?
       JMP EDELM,I    YES, QUIT NOW 
      LDA 1           NO, COMPUTE 
      ADA M15           BLANKS REQUIRED 
      STA TEMP3           FOR SPACING 
      CMA,INA 
      JSB OLNCK     CHECK FOR LINE OVERFLOW 
      LDA OUTLN     WAS THERE OVERFLOW ?
      SZA 
      JMP EDELM,I     YES, QUIT NOW 
EDEL0 LDA .32         NO, EMIT A SPACE
      JSB OUTCR 
      ISZ TEMP3     KEEP ON DOING IT
      JMP EDEL0       UNTIL FIELD IS FULL 
      JMP EDELM,I 
* 
LUTMP EQU EDELM 
      SKP 
********************* 
*                   * 
**  EXECUTE CHAIN  ** 
*                   * 
********************* 
* 
ECHAN LDA .2        SET FLAG
      STA PFLAG       TO INDICATE 
      CLA,INA       SET TO ALLOW
      STA STRFG       STRING CONSTANTS
      JSB FORMX     EVALUATE FILE NAME
      LDA M2        PREPARE 
      JSB PSTR        STRING ADDRESS AND LENGTH 
      STA TEMP7     ADDRESS 
      STB TEMP8     LENGTH
      LDA TEMPS     FOLLOWED BY 
      INA 
      CPA PRADD       A STMNT NUMBER? 
      JMP ECH2      NO! 
      ISZ TEMPS 
      ISZ TEMPS 
      LDA TEMPS,I   YES, SAVE IT
      STA LORUN     SAVE IT 
      JMP COMND         CHAIN, GOTO COMMAND SEGMENT 
ECH2  CLA,INA       SET FOR CHAIN TO
      STA LORUN 
      JMP COMND       TOP OF PROGRAM
      SKP 
*********************** 
*                     * 
**  EXECUTE INVOKE   ** 
*                     * 
*********************** 
* 
***********************REMOVED 790830******************************** 
*EINVK LDA .1        GO GET ONE TRACK 
*      IOR MNEG      DON'T WAIT IF NO TRACKS
*      STA TK#       NOS OF TRACK 
*      JSB SGETT     TRACK ALLOCATION ROUTINE 
*      LDA DSEC#     NOS OF 64 WORD SECTORS 
*      MPY .64       (64 WD SEC.)(NOS SEC.)=WORDS PER TRACK 
*      STA INTKZ     SAVE IN COMMON FOR FUTURE USE
*      LDA .1        NOS OF TRACKS TO 1 
*      STA TK#       FOR REL. 
*      JSB RETK      RELEASE THE TEST TRACK 
*      LDA FWAMB     START OF PROGRAM AREA
*      CMA,INA
*      ADA SYMTA     END OF SYMBOL TABLE
*      INA           BUMP ONE.. 
*      STA LENPG     LENGTH OF THE PROGRAM
*      ADA B1000     BUMP FOR REST OF ODD SECTOR
*      CLB           CALCULATE THE
*      DIV INTKZ     NUMBER OF TRACKS THAT
*      INA           ARE NEEDED FOR PROGRAM AND COMMON
*      IOR MNEG      TURN ON DON'T WAIT BIT 
*      STA TK#       SAVE 
*      JSB SGETT     GO GET THAT NO. OF TRACKS
*      LDA DLU#      GET DISC LU# 
*      IOR .64       TURN ON BINARY BIT 
*      STA SWCND     CONTROL WORD 
*      LDA LENCM     COMMON WORD COUNT
*      STA SBLNG     BUFFER LENGTH
*      CLA           STARTING 
*      STA STSEC     SECTOR 
*      LDA CMADR     STARTING ADDRESS OF COMMON 
*      STA SBUF      BUF START ADDR 
*      JSB SWRTE     WRITE COMMON TO PROG TRACKS
*      AND DSERR     CHECK FOR DISC ERR 
*      SZA           IN BITS 15-14
*      JMP E1        SOMETHING WRONG
*      CPB LENCM     DID ALL WRDS GO??
*      RSS           YES  OK. 
*      JMP E1        NO,  DISC ERROR
*      LDA STRK#     GET STARTING TRK  NUMBER 
*      ASL 7         SHIFT TO BITS 14-7 
*      IOR TK#       PUT IN NOS OF TRACKS 
*      AND INF       TAKE OUT BIT 15 IF ON. 
*      LDB DLU#      LOOK AT THE LU 
*      ADB M2        IS IT LU 2???
*      SZB           WELL 
*      IOR MNEG      NO, SIGN BIT ON  FOR LU 3
*      STA INLOC     SAVE IN COMMON FOR NEXT INVOKE 
*      LDA INTKZ     GET TRACK SIZE 
*      ADA M512      BUMP DOWN FOR FIRST PROG WRITE 
*      STA TMLND     TEMP DISC LENGTH 
*      LDA .4        SET STARTING 
*      STA STSEC     SECTOR  NUMBER 
*      LDA FWAMB     START PROG ADDRESS 
*      STA TEMAD     TEMP PROG ADDR.
*      STA SBUF      START BUF ADRR 
*      LDA LENPG     PROGRAM LENGTH 
*      STA TMLNP     TEMP LENGTH OF PROG TO GO
*INVK1 LDA TMLND     CURRENT TRACK SIZE 
*      CMA,INA
*      ADA TMLNP     SUB FROM TO GO SIZE
*      SSA           LAST WRITE?? 
*      JMP INVK2     YES COMPLETE 
*      STA TMLNP     UPDATE PROG TO GO
*      LDA TMLND     GET TRACK SIZE 
*      STA SBLNG     BUF LENGTH 
*      ADA TEMAD     RUNNING PROG ADDR
*      STA TEMAD     UPDATE TO NEXT 
*      JMP INVK3     GO WRITE 
*INVK2 LDA TMLNP     TEMP PROG LENGTH 
*      STA SBLNG     MAKE BUFF LENGTH 
*      CLA           SET TO 
*      STA TMLNP     ZERO FOR FINISH
*INVK3 JSB SWRTE     WRITE TO DISC
*      AND DSERR     LOOK AT BITS 15-14 
*      SZA           DISC ERROR?
*      JMP E1        YES
*      CPB SBLNG     WRITE OK?? 
*      RSS           YES
*      JMP E1        NO  SHOW BAD 
*      CLA           ARE WE 
*      CPA TMLNP     ALL FINISHED???
*      JMP ECHAN     YES, DO A PSEUDO CHAIN 
*      STA STSEC     NO, START AT SECTOR ZERO 
*      ISZ STRK#     BUMP TRACK NO
*      LDA INTKZ     UPDATE TRACK SIZE
*      STA TMLND     FOR NEXT WRITE 
*      LDA TEMAD     RUNNING ADDRESS
*      STA SBUF      FOR NEXT WRITE 
*      JMP INVK1     WRITE AGAIN
*      SPC 1
**
**  WRITE TO PROGRAM TRACKS 
**
*      SPC 1
*SWRTE NOP
*      JSB EXEC      THROUGH EXEC 
*      DEF SWRET     RETURN 
*      DEF .2        WRITE
*      DEF SWCND     CON WORD 
*      DEF SBUF,I    BUFF ADDR
*      DEF SBLNG     LENGTH 
*      DEF STRK#     TRACK NUMBER 
*      DEF STSEC     STARTING SECTOR
*SWRET JMP SWRTE,I   RETURN 
**
**    GET TRACKS SUBROUTINE 
**
*      SPC 1
*SGETT NOP           ENTER
*SGET1 JSB EXEC      EXEC 
*      DEF SGRET     RETURN POINT 
*      DEF .4        GET TRACKS CALL
*      DEF TK#       NUMBER OF TRACKS REQUESTED 
*      DEF STRK#     STARTING TRACK NUMBER (EXEC) 
*      DEF DLU#      DISC LU NUMBER (EXEC)
*      DEF DSEC#     NUMBER OF 64 WORD SECT PER TRACK (EXEC)
*SGRET LDA STRK#     DID WE GET TRACKS? 
*      SSA,RSS
*      JMP SGETT,I     YES ALL OK.
*      LDA M20       NO, PRINT MESSAGE. 
*      LDB WATAD     BASIC WAITING  FOR TRACKS
*      JSB WRITE     SEND TO OPERATOR 
*      LDA TK#       GET NOS. OF TRACKS WORD
*      AND INF       TAKE OUT BIT 15
*      STA TK#       AND SUSPEND UNTIL TRACKS 
*      JMP SGET1     BECOME AVAILABLE 
*      SPC 1
**
**  RELEASE TRACKS  SUBROUTINE
**
*      SPC 1
*RETK  NOP           ENTER
*      JSB EXEC      GO 
*      DEF RERET     RETURN POINT 
*      DEF .5        REL TRACKS REQUEST 
*      DEF TK#       NUMBER OF TRACKS 
*      DEF STRK#     STARTING TRACK NUMBER
*      DEF DLU#      DISC LU NUMBER 
*RERET JMP RETK,I    RETURN 
*      SPC 1
*TK#   BSS 1
*STRK# BSS 1
*DLU#  BSS 1
*DSEC# BSS 1
*LENPG BSS 1
*SWCND BSS 1
*SBUF  BSS 1
*SBLNG BSS 1
*CMADR DEF TEMPS
*LENC  EQU SPEC-TEMPS+10  ***CHANGE IF COMMON CHANGES**** 
*LENCM ABS LENC 
*STSEC BSS 1
*TEMAD BSS 1
*TMLND BSS 1
*TMLNP BSS 1
*M512  DEC -512 
*WATAD DEF WATMS
*WATMS ASC 10,BASIC WAITING TRACKS
* 
****************************ADDED 790830************************* 
* 
* THE FOLLOWING ROUTINE UTILIZES THE CREATE SCRATCH FILE ROUTINE
* IN THE FMP.  THIS IS NECESSARY SINCE THE L DOES NOT HAVE SYSTEM 
* TRACKS TO WRITE THE INVOKER PROGRAM OUT TO DISC.  THE COMMON AREA 
* IS ALSO SAVED SO THE LINKAGE BETWEEN MULTI-LEVELS OF INVOKED
* PROGRAMS IS "AUTOMATICALLY" PROVIDED.  THE PNTRS IN COMMON, 
* 'INLOC' AND 'INTKZ', HAVE BEEN CHANGED TO BE USED FOR THE SCRATCH 
* NAME RETURNED FROM THE 'CRETS' ROUTINE.  ONE ADDITIONAL WORD, 'INNUM' 
* IS ALSO ADDED SINCE A 3-WORD ARRAY IS NEEDED FOR THE NAME.  'INNUM' IS
* USED TO INDICATE THE LEVEL OF INVOKE SINCE IT WILL GET INCREMENTED
* AFTER EACH INVOKER PROGRAM IS WRITTEN TO THE DISC.  IT IS INITILIAZED 
* TO ZERO IN SEGMENT 3. 
* 
EINVK LDA FWAMB     COMPUTE THE LENGTH
      CMA,INA       OF THE PROGRAM THRU THE 
      ADA SYMTA     END OF SYMBOL TABLE 
      INA           BUMP BY ONE 
      STA LENPG 
      ADA LENCM     AND ADD ON COMMON SIZE
      CLB           FOR CALCULATION OF # OF 
      DIV .128
      INA           BLOCKS NEEDED +1 FOR
      STA HOLDL+1   REMAINDER *791010*
* 
      JSB CRETS     CREATE SCRATCH FILE 
      DEF INVK1 
      DEF SDCB,I    POINTER TO FLDCB IN COMMON 791014 
      DEF FERR      SO NOT TO CORRUPT FILES 
      DEF INNUM     SCRATCH FILE NUMBER 
      DEF INNAM     RETURNED NAME 
      DEF HOLDL     SIZE IN BLOCKS
      DEF .11 
INVK1 JSB CKERR     CHECK FOR ERROR 
******CHANGED TO BE CONSIST WITH INVOKE CLOSE IN SEG 8 791014***********
      LDA LENCM     GET COMMON LENGTH 
      STA SBLNG     AND SAVE FOR WRITE
      LDA CMADR     GET STARTING ADDRESS COMMON 
      STA SBUF      AND SAVE FOR WRITE
      JSB SWRIT     GO WRITE AND CHECK FOR ERRORS 
      LDA LENPG     GET INVOKER LENGTH
      STA SBLNG     AND SAVE FOR WRITE
      LDA FWAMB     GET STARTING ADDRESS OF INVOKER 
      STA SBUF      AND SAVE FOR WRITE
      JSB SWRIT     GO WRITE PROG. AND CHECK FOR ERRORS 
* 
      JSB CLOSE     CLOSE SCRATCH FILE
      DEF INVK4 
      DEF SDCB,I    POINTER TO FLDCB IN COMMON 791014 
      DEF FERR      SO NOT TO CORRUPT FILES 
      DEF .0
INVK4 LDA INNUM     INCREMENT FOR NEXT INVOKE 
      INA           LEVEL SCRATCH FILE
      STA INNUM 
**************************ADDED 791014**************************
      LDA INNAM+2   INC. SCRATCH FILE # IN NAME 
      ADA .1        FOR PROPER FILE FETCHING IN SEG.8 
      STA INNAM+2 
*************************791014*********************************
      JMP ECHAN     DONE, DO PSEUDO CHAIN 
* 
SWRIT NOP 
      JSB WRITF 
      DEF SWRT1 
      DEF SDCB,I    POINTER TO FLDCB IN COMMON 791014 
      DEF FERR      SO NOT TO CORRUPT FILES 
SBUF  DEF 0 
      DEF SBLNG 
SWRT1 LDA FERR      WAS THERE A FMP ERROR?
      SSA,RSS 
      JMP SWRIT,I    NO 
      STA DFERR     YES, GO CLOSE SO NO CONVICT 
      JSB CLOSE     ERROR WRITF CALL
      DEF SWRT2 
      DEF SDCB,I    POINTER TO FLDCB IN COMMON 791014 
      DEF FERR      SO NOT TO CORRUPT FILES 
      DEF .0
SWRT2 LDA DFERR     GET WRITE ERROR 
      STA TEMP3     AND GO PRINT MESSAGE
      JMP OUTER 
***************************791014************************************** 
* 
SDCB  DEF FLDCB     **791014**
CMADR DEF TEMPS     ***791011** 
HOLDL NOP 
      NOP          DO NOT REMOVE, FOR DOUBLE INTEGER *791010* 
LENC  EQU FLDCB-TEMPS        **791012 DUE TO DCB USAGE
LENCM ABS LENC
LENPG NOP 
SBLNG BSS 1     **791014**
DFERR NOP       **791014**
*************************790830********************************** 
***************************** 
*                           * 
*  VALIDATE A FILE REQUEST  * 
*                           * 
***************************** 
* 
*  EXIT TO (P+1) IF TEMPS+1 DOES NOT BEGIN A FILE REFERENCE 
*    OR IF FILE REFERENCE IS TO A TYPE 0 FILE.
*  EVALUATE THE FILE REFERENCE AND VERIFY ITS CORRESPONDENCE
*     WITH A REQUESTED FILE.  IF A RECORD REFERENCE IS ALSO PRESENT 
*     EVALUATE IT AND CALL FOR ITS POSITION.
*  IF FILE REFERENCE IS VALID, BUT AT END OF FILE,EXIT TO (P+2).
*  IF VALID FILE AND RECORD, EXIT TO (P+3). 
* 
VLFIL NOP 
      LDA M1000     PRESET FOR NO 
      STA FILE#       FILE SPECIFICATION
      STA FLTYP         (NO FILE IS A NON-ZERO FILE)
      LDB TEMPS     IS
      INB 
      CPB PRADD       NEXT
      JMP VLFI0 
      LDA 1,I           OPERATOR
      AND OPMSK 
      CPA #OP             A '#' ? 
      RSS           YES!
VLFI0 JMP VLFIL,I   NO, EXIT TO (P+1) 
      ISZ TEMPS     EVALUATE
      JSB FETCH       FILE REFERENCE
      JSB SBFIX     15-BIT REFERENCE? 
      JSB ERROR     NON-EXISTENT FILE REFERENCED
E9    INA 
      ISZ TEMPS     POINT TO SEPARATOR
      JSB FSTAT     CHECK FILE STATUS 
       JMP VLFI0      LU I/O
      ISZ VLFIL       FILE I/O, ADJUST RETURN 
      STA FILE#     YES, SAVE IT
      LDA TEMPS,I   NEXT
      AND OPMSK       OPERATOR
      CPA USEOP     USING?
      JSB ERROR     YES, WE DONT ALLOW PRINT USING WITH FILE
E19   CPA B2000         A COMMA?
      JMP VLFI3     YES!
      CCB           NO, REQUEST SERIAL RECORD 
VLFI2 STB RCRD# 
      JSB RQSTR     REQUEST A RECORD
       JMP VLFIL,I    PHYSICAL EOF -- TAKE (P+2) EXIT 
      ISZ VLFIL       RECORD OK, TAKE (P+3) EXIT
      JMP VLFIL,I 
VLFI3 JSB FETCH     EVALUATE RECORD REFERENCE 
      JSB SBFIX     15-BIT INTEGER? 
      LDA INF       NO, LOAD IMPOSSIBLE RECORD
      ISZ TEMPS 
      LDB 0         PUT RECORD REFERENCE IN B-REG 
      JMP VLFI2       AND FETCH THE RECORD
      SKP 
**********************
*                    *
*  REQUEST   RECORD  *
*                    *
**********************
* 
*  IF (B) >= 0 THEN THE RECORD ((B)+1) IS PUT IN THE DCB
*   AND THE WORD POINTER IS RESET TO THE START OF THE RECORD. 
*  IF (B) = -1, A RECORD IS READ ONLY IF NO RECORD IS IN CORE.
*  IF (B) = -2, THEN THE NEXT RECORD IS READ.ECORD IS IN CORE.
* 
*  IN ALL CASES, AN EXIT TO (P+1) INDICATES THAT END OF FILE
*    HAS BEEN REACHED, WHILE EXIT TO (P+2) INDICATES THAT 
*    THE REQUESTED RECORD IS IN CORE. 
*  THIS ROUTINE EXITS TO ERROR ON FMGR ERRORS OTHER THAN EOF. 
* 
RQSTR NOP 
      INB 
      STB RQ2     SAVE THE RECORD REFERENCE 
      LDB DCB       SET UP
      ADB .16         BUFFER
      STB TEMP3         ADDRESS 
      ADB M3        FETCH FLAG WORD 
*     JSB RDCB1   (CHECK FOR NEW DCB)***OUT FOR L 
      LDA 1,I         FROM DCB ... TO 
      SSA,RSS           CHECK "IN-CORE" FLAG
      JMP RQS15     NOT IN CORE 
      INB           RECORD IN CORE
      LDA RQ2         IS THIS THE RIGHT 
      SSA               RECORD
      JMP RQST6           GET NEXT RECORD 
      SZA,RSS               SERIAL FILE OPERATION ? 
      JMP RQXIT 
      INA            RANDOM FILE REQUEST
      CPA 1,I             RECORD NUMBERS MATCH ?
      JMP RQST3             YES ! 
RQST6 LDB DCB       HAS 
      ADB .13         BUFFER
*     JSB RDCB1     (CHECK FOR NEW DCB)***OUT FOR L 
      LDA 1,I           BEEN
      SLA,RSS             WRITTEN ON? 
      JMP RQS15     NO, SO DON'T WRITE
      AND MNEG      YES, CLEAR "WRITTEN-ON" FLAG
*     JSB WDCBB     (CHECK FOR NEW DCB)***OUT FOR L 
      STA 1,I 
      INB           NOW CORRECT 
      CCA             RECORD
      ADA 1,I           COUNTER 
      SZA                 UNLESS
      STA 1,I               START OF FILE 
      ADB M2        RESET 
      LDA DCB         WORD
      ADA .16           LOCATION
      STA 1,I 
      STA TEMP3           AND BUFFER PTR
      SKP 
      JSB WRITF     WRITE OUT 
      DEF *+6           NEXT
      DEF DCB,I           RECORD
      DEF FERR
      DEF TEMP3,I 
      DEF .128
      DEF .0
      JSB CKERR     CHECK FOR ERROR 
RQS15 LDB DCB 
      ADB .14          SET UP 
      LDA RQ2            NEW RECORD POINTER 
      SZA                  UNLESS SERIAL I/O
      SSA                 OF EITHER KIND
      RSS 
      STA 1,I 
      JSB READF     READ
      DEF *+4 
      DEF DCB,I       A 
      DEF FERR
      DEF TEMP3,I       RECORD
      JSB CKERR 
      LDB DCB       SET UP
      ADB .12         BUFFER POINTER
      LDA 1             TO BEGINNING
      ADA .4              OF DATA BLOCK 
      STA 1,I 
      INB 
      LDA MNEG        SET "IN-CORE" AND CLEAR 
*     JSB WDCBB     (CHECK FOR NEW DCB)***OUT FOR L 
      STA 1,I           "WRITTEN-ON" FLAGS
RQXIT ISZ RQSTR     RETURN TO P+2 
      JMP RQSTR,I 
* 
RQST3 ADB M2        POINT TO BUFFER POINTER 
      LDA 1         RESET POINTER 
      ADA .4          TO BEGINNING
      STA 1,I           OF DCB
      JMP RQXIT 
* 
CKERR NOP 
      LDA FERR      IS THERE
      CPA M12       PHYSICAL EOF? 
      JMP RQSTR,I   YES, RETURN TO P+1
      SSA,RSS         A FILE MANAGER ERROR? 
      JMP CKERR,I   NO! 
      STA TEMP3     YES!
      JMP OUTER     PRINT MESSAGE AND ABORT 
      SKP 
********************* 
*                   * 
*  FILE VALIDATION  * 
*                   * 
********************* 
* 
*  CHECK TO SEE IF REQUESTED FILE IS OPEN OR IF IT IS 
*  A LOGICAL UNIT. IF NOT A LU# OR OPEN IT IS AN ERROR. 
* 
*  ON ENTRY  A =  FILE REFERENCE #
*  ON EXIT (P+1) LU# EXIT, A = LU#
*          (P+2) FILE EXIT, A = FILE REFERENCE #
* 
FSTAT NOP 
      LDB 0         SAVE FILE # 
      ADB M17       IS FILE 
      SSB,RSS         NUMBER > 16?
      JMP FSTA1     YES!
      CCB           CHECK 
      STB FLTYP     SET NON-0 FILE TYPE 
      ADB 0           DCB 
      ADB FILBK         POINTER TO
      LDB 1,I            SEE IF IT IS 
      SZB,RSS              A PERIPHERAL 
      JMP FSTA1     YES, IT IS! 
      SSB           OPEN? 
      JSB ERROR     NOT OPEN YET! 
E10   STB DCB       YES, SET UP CURRENT DCB PTR 
      ADB .2        GET FILE
      LDB 1,I         TYPE. 
      SZB,RSS       TYPE 0? 
      JMP FSTA2      YES
      ISZ FSTAT      NO, TAKE(P+2) EXIT 
      CPB .1        TYPE 1? 
      JMP FSTAT,I    YES,EXIT 
      JSB ERROR      NO,BAD FILE TYPE 
E16   EQU * 
* 
FSTA2 STB FLTYP     SET TYPE 0 FILE FLAG
***********************CHANGED 800107 FOR UE BIT SETTING************* 
FSTA1 STA HOLD       SAVE THE LU
      JSB FINDV      CHECK FOR INTRF TYPE (B) OF 37(HPIB) 
      CPB B37 
      JMP FSTA3      IS HPIB, GO CHECK FOR CONFIGURED 
FSTA5 LDA HOLD       NO, CONTINUE AS USUAL *800122* 
*******************************800107****************************** 
FSTA6 IOR .128      SET V-BIT FOR OUTPUT *800122* 
      STA LUOUT 
      IOR B400        AND ECHO BIT FOR INPUT
      STA LUINP 
      CCA           CLEAR 
      STA FILE#       FILE I/O FLAG 
      LDB TEMPS 
      JMP FSTAT,I 
******************ADDED***800107**********************************
FSTA3 LDA HOLD
************************CHANGED 800110***************************** 
      JSB CNFUE 
FSTA4 SZA,RSS        CHECK FOR CONFIGURED 
      JMP FSTA5      NO 
      LDA HOLD       GET LU 
*************************800110***********************************
      IOR B1314      SET UE AND UNBUFFERED BIT
      JMP FSTA6       *800122*
* 
HOLD  NOP 
B37   OCT 37
B1314 OCT 60000      *CHANGED 800123* 
*******************************800107*******************************
      SKP 
***************************** 
*                           * 
*  STORE AN ITEM IN A FILE  * 
*                           * 
***************************** 
* 
*  UPON ENTRY (B) INDICATES WHAT IS TO BE WRITTEN ON THE FILE:
*  (B) = -1 WRITES AN END-OF-FILE MARK, (B) = -2 WRITESA TWO- 
*  WORD FLOATING POINT NUMBER, (B) = -3 WRITES A STRING.  IF
*  THE RECORD CAN'T ACCOMODATE THE QUANTITY, A SERIAL WRITE 
*  WILL PLACE IT IN THE FOLLOWING RECORD WHILE A RECORD WRITE 
*  WILL EXIT TO THE END-OF-FILE CODE. 
* 
FILST NOP 
      STB FILT      SAVE REQUEST TYPE 
      LDA DCB       GET 
      ADA .12         CURRENT 
      STA TEMP9         POINTER 
      LDB 0,I             AND SAVE IT 
      ADA .132      IS
      CPA 1           RECORD FULL?
      JMP FILS1     YES!
      STB DADDR     SAVE CURRENT PTR
      ISZ FILT      EOF REQUESTED?
      JMP FILS2     NO! 
      CCA           YES, OVERLAY PREVIOUS 
      STA 1,I       EOR OR EOF WITH EOF MARK
FILS7 LDB DCB       SET 
      ADB .13         BUFFER
      LDA WRFLG         WRITTEN 
*     JSB WDCBB     (CHECK FOR NEW DCB)***OUT FOR L 
      STA 1,I             ON BIT
      ADB M1        IS
      LDA DCB         DCB PACKING 
      ADA .144          BUFFER EXACTLY
      CPA 1,I             FULL? 
      RSS           YES!
      JMP FILST,I   NO! 
      JSB POST      POST THE DATA 
      DEF *+2 
      DEF DCB,I 
      JMP FILST,I   RETURN
* 
FILS2 ISZ FILT      STRING
      JMP FILS6     YES 
      ADB .2        NO! 
FILS3 CMA,INA       COMPARE PROSPECTIVE 
      ADA 1           CURRENT POINTER 
      CMA,INA           END-OF-RECORD POINTER 
      SSA           OVERFLOW? 
      JMP FILS0     YES!
      STB TEMP9,I   NO, SAVE NEW CURRENT PTR
      SZA,RSS       RECORD EXACTLY FULL?
      JMP FILS4     YES!
      LDA M2        NO, FOLLOW ENTRY SPACE
      STA 1,I         WITH EOR MARK 
FILS4 ISZ FILT      STRING? 
      JMP FILS5     NO! 
      LDA TNULL     YES!
      CMA           COMPUTE AND 
      IOR B1000       STORE STRING
      STA DADDR,I       HEADER WORD 
      LDA FSCHA 
      JSB TRSTR     TRANSFER STRING 
      JMP FILS7 
* 
FILS5 DLD SBPTR,I   TRANSFER
      DST DADDR,I     NUMBER
      JMP FILS7 
* 
FILS6 INB           COMPUTE 
      CLE,ELB         DESTINATION 
      STB TEMP5         ADDRESS 
      CMB,INB       COMPUTE 
      ADB TNULL       RECORD
      CMB,INB           SPACE 
      CLE,ERB             REQUIRED
      JMP FILS3 
* 
****************790213*************************************** 
FILS0 LDA M2        INSURE EOR MARK 
      STA DADDR,I     ENDS PRESENT RECORD 
      ISZ TEMP9         AND THAT THIS 
      LDA WRFLG 
      LDB TEMP9           GETS WRITTEN
*     JSB WDCBB      (CHECK FOR NEW DCB)***OUT FOR L
      STA TEMP9,I           ON THE DISC 
      LDA M2
      ADA FILT       RESTORE REQUEST
      STA FILT         TYPE 
****************790213****************************************
FILS1 CCB 
      CPB RCRD#     SERIAL WRITE? 
      RSS           YES 
      JMP EOFCK     CHECK IF ' IF END#' 
      LDB M2        REQUEST NEXT RECORD 
      JSB RQSTR         TO WRITE
       RSS            EOF RETURN
      JMP FILST+2       NORMAL RETURN, CONTINUE 
* 
EOFCK LDA HTEMP     RESTORE HIGH
      STA HSTPT       STACK POINTER 
      LDB DCB       CHECK 
      ADB .15         STMT
      LDA 1,I           NUMBER
      SZA,RSS             TRANSFER ON EOF 
      JSB ERROR     NONE, SO EOF ERROR
E11   JMP EGOS3     YES, GO TO IT 
      SKP 
******************************* 
*                             * 
**  GET NEXT ITEM IN A FILE  ** 
*                             * 
******************************* 
* 
*  THE NEXT ITEM IN A FILE, NUMBER, STRING, END--OF-FILE, OR
*  END-OF-RECORD, IS IDENTIFIED AND UPON EXIT (A) = 1,2,3 OR 4
*  RESPECTIVELY.  EORFL = -1 WILL IGNORE END-OF-RECORD'S AND
*  RETURN WITH THE FIRST OF THE OTHER ITEMS ENCOUNTERED.
* 
GTTYP NOP 
      LDA DCB       IS
      ADA .13         THERE 
*     JSB RDCB2     (CHECK FOR NEW DCB)***OUT FOR L 
      LDB 0,I           A RECORD
      SSB,RSS             IN CORE?
      JMP GTTY1     NO! 
      ADA M1        LOAD ACTIVE 
      LDB 0,I         AND LIMIT RECORD
      ADA .132          POINTERS
      CPA 1         PHYSICAL END-OF-RECORD? 
      JMP GTTY3     YES!
      LDA 1,I       NO, LOAD WORD 
      CLB,INB         OF RECORD 
      CPA M2        END-OF-RECORD?
      JMP GTTY3     YES!
      CPA M1        END-OF-FILE?
      JMP GTTY4     YES!
      AND M256      NO! 
      CPA B1000     STRING? 
      INB           YES, (B)=2
GTTY2 LDA 1         SET (A) = (B) 
      JMP GTTYP,I 
* 
GTTY3 CCB           NO
      CPB EORFL       EOR'S WANTED? 
      JMP GTTY1     NO! 
      LDB .2
GTTY4 ADB .2        (B) = (B) +2
      JMP GTTY2 
* 
GTTY1 LDB M2
      LDA FILE#     REQUEST 
      JSB RQSTR       NEXT RECORD 
      RSS           EOR 
      JMP GTTYP+1 
      CLB,INB 
      JMP GTTY4 
      SKP 
**********************************************************************
* 
*THIS ROUTINE WILL UPDATE THE IB AND WR BITS IN THE NEW DCB WORD 7
*BASED ON INFORMATIOIN IN THE OLD DCB WORD 13.  SINCE BASIC 
*ASSUMES THE INFORMATION TO BE IN WORD 13, THIS ROUTINE WILL ALLOW
*FOR AN EASY CONVERSION TO THE NEW DCB LAYOUT.
* 
*UPON ENTRY THE A AND B REGISTERS ARE AS FOLLOWS: 
* 
*     A=VALUE OF THE OLD DCB WORD 13
*     B=ADDRESS TO THE OLD DCB WORD 13
* 
*A TEST IS DONE ON THE ENTRY POINT $BMON WHICH WILL HAVE BIT 0
*SET IF THE HOST SYSTEM IS AN RTE-4B OR THE NEW DCB LAYOUT. 
* 
*RETURN POINTS: 
* 
*     P+1 FOR THE OLD DCB-TYPE SYSTEMS
*     P+2 FOR THE NEW DCB-TYPE SYSTEMS
* 
*UPON RETURN, THE A AND B REGISTERS WILL HAVE THE SAME VALUES AS UPON 
*ENTRY. 
* 
************************************************************************
*WDCBB NOP
*     STA ASTOR     SAVE THE A AND B REGS.
*     STB BSTOR 
*     LDA $BMON     IS THIS A 4B SYSTEM? A(0)=1 
*     SLA 
*     JMP DCB4B     YES,GO UPDATE WORD 7
*     LDA ASTOR     NO, RESTORE THE A 
*     JMP WDCBB,I   AND RETURN TO P+1 
*DCB4B ADB M6        PICK UP NEW DCB WORD 7 
*     STB ADDR1 
*     LDA 1,I 
*     LDB ASTOR     CHECK VALUES IN OLD DCB 
*     SSB,RSS       FOR IB=1
*     JMP CLIB1     NO
*     IOR .4        YES 
*CHKWR SLB,RSS       AND WR=1 
*     JMP CLWR      NO
*     IOR .1        YES 
*PUTIT STA ADDR1,I   AND STORE IN WORD 7
*     LDA ASTOR     RESTORE ORG. VALUE OF A AND 
*     LDB BSTOR     B 
*     ISZ WDCBB     AND RETURN TO P+2 
*     JMP WDCBB,I 
*CLIB1 AND M5        CLEAR IB (BIT2) IN NEW DCB 
*     JMP CHKWR 
*CLWR  AND M2        CLEAR WR (BIT1) IN NEW DCB 
*     JMP PUTIT 
*ASTOR NOP
*BSTOR NOP
*ADDR1 NOP
*ASTR1 NOP
      SKP 
************************************************************************* 
* 
*THIS ROUTINE HANDLES THE SAME FUNCTION AS RDCB1.  HOWEVER, THE A AND 
*B REGISTER CONTENTS ARE REVERSED:
* 
*     A=ADDRESS TO THE OLD DCB WORD 13
*     B IS MEANINGLESS
* 
*THIS ROUTINE CALLS RDCB1 WHICH RETURNS THE VALUE OF THE IB AND 
*WR BITS IN THE WORD 13 FORMAT IN THE A REGISTER AND THE ADDRESS
*TO THE OLD DCB WORD 13 IN THE B REGISTER, AND RETURNS THIS VALUES
*AS FOLLOWS:
* 
*     A=ADDRESS TO THE OLD DCB WORD 13
*     B=VALUE OF THE IB AND WR BOTS IN THE WORD 13 FORMAT 
* 
*RETURN POINTS: 
* 
*     P+1 FOR THE OLD DCB-TYPE SYSTEMS
*     P+2 FOR THE NEW DCB-TYPE SYSTEMS
* 
************************************************************************* 
*RDCB2 NOP
*     STA ASTR1     SAVE THE ADDRESS TO OLD DCB WORD 13 
*     LDA $BMON     IS THIS A 4B SYSTEM? A(0)=1 
*     SLA 
*     JMP B4DC7     YES, Go POSITION IB AND WR BITS 
*     LDA ASTR1     NO, RESTORE THE ADDR. AND 
*     JMP RDCB2,I   RETURN TO P+1 
*B4DC7 JSB RDCB1     GO GET COVERTED WORD 
*HOLDR NOP           PLACE HOLDER FOR P+2 RETURN
*     LDB 0         PLACE VALUE IB AND WR BIT IN B
*     LDA ASTR1     RESTORE THE ADDR. AND 
*     ISZ RDCB2     RETURN TO P+2 
*     JMP RDCB2,I 
      SKP 
**********************************************************************
* 
*THIS ROUTINE WILL TAKE THE VALUES FOR THE IB AND WR BITS IN THE
*NEW DCB WORD 7 AND POSITION THEM INTO THE FORMAT FOR THE OLD DCB 
*WORD 13.  THE TWO DIFFERENT DCB'S ARE: 
* 
*      OLD DCB WORD 13: 
* 
*      15                     1  0
*      IB                    EF  WR 
* 
*      NEW DCB WORD 7:
* 
*      15                  2  1  0
*      SC                 IB EF WR
* 
*SINCE BASIC ASSUMES THIS FLAG INFORMATION TO BE IN WORD 13, THIS ROUTINE 
*WILL ALLOW FOR AN EASY CONVERSION TO THE NEW DCB LAYOUT. 
* 
*UPON ENTRY THE A AND B REGISTERS ARE AS FOLLOWS: 
* 
*     A IS MEANINGLESS
*     B=ADDRESS TO THE OLD DCB WORD 13
* 
*A TEST IS DONE ON THE ENTRY POINT $BMON WHICH WILL HAVE BIT 0 SET
*IF THE HOST SYSTEM IS AN RTE-4B OR THE NEW DCB LAYOUT. 
* 
*RETURN POINTS: 
* 
*     P+1 FOR THE OLD DCB TYPE SYSTEMS
*     P+2 FOR THE NEW DCB TYPE SYSTEMS
* 
*UPON RETURN, THE REGISTERS WILL BE AS FOLLOWS: 
* 
*     A=VALUE OF THE IB AND WR BITS IN THE WORD 13 FORMAT 
*     B=ADDRESS TO THE OLD DCB WORD 13
* 
**********************************************************************
*RDCB1 NOP
*     STB BSTOR     SAVE ADDR. OF OLD DCB WORD 13 
*     LDB $BMON     IS THIS A 4B SYSTEM? B(0)=1 
*     SLB 
*     JMP B4DCB     YES, GO POSITION THE IB AND WR BITS 
*     LDB BSTOR     NO, RESTORE THE ADDR. AND 
*     JMP RDCB1,I   RETURN TO P+1 
*B4DCB LDB DCB       GET WORD 7 OF NEW DCB
*     ADB .7
*     LDA 1,I 
*     STA ASTOR 
*     AND .4        CHECK FOR IB (BIT2) SET 
*     SZA,RSS 
*     JMP CL15      NO, CLEAR BIT 15
*     LDA ASTOR     YES, SET BIT 15 
*     IOR MNEG      WITH MASK 100000
*B4END AND INTFL     MASK OFF MEANINGLESS BITS (100003) 
*     LDB BSTOR     RESTORE ADDR. AND 
*     ISZ RDCB1     RETURN TO P+2 
*     JMP RDCB1,I 
*CL15  LDA ASTOR     CLEAR BIT 15 
*     AND INF       WITH MASK 77777 
*     JMP B4END 
      SKP 
*************** 
*             * 
* EXECUTE TAB * 
*             * 
*************** 
ETAB  NOP 
      JSB .IENT     SMALL INTEGER?
      JMP TABXT       NO
      ADA M133      EXCEED  ***CHG FOR BUG 790928 MM*** 
      SSA,RSS         132?
      JMP ETAB1     YES!
      CMA,INA       NO, COMPUTE 
      ADA M133        BLANKS  ***CHG FOR BUG 790928 MM*** 
      ADA OCCNT         REQUIRED
      ADA TYPE
      SZA,RSS       ARE WE RIGHT ?
       JMP TABXT      YES 
      SSA,RSS       TOO FAR TO THE RIGHT ?
      JMP ETAB2       YES 
      STA TEMP3       NO, DRIFT TO THE RIGHT
ETAB0 LDA .32           WRITE BLANKS
      JSB OUTCR           RIGHT 
      ISZ TEMP3 
       JMP ETAB0
TABXT CLB 
      STB EOL       SET TAB FLAG TRUE 
      JMP ETAB,I      AND EXIT
* 
ETAB1 JSB OUTLN     OUTPUT THE LINE 
      JMP TABXT 
* 
ETAB2 LDB TABFG     CAN WE
      SZB             LEAN TO THE LEFT ?
       JMP TABXT        NO
      CMA,INA       SAVE NEGATIVE 
      STA TEMP3       BLANK COUNT 
      LDB OCCNT 
ETAB3 LDA OTBFA,I   FETCH LAST WORD 
      SLB             LOW OR HIGH BYTE ?
      ALF,ALF           HIGH BYTE -> LOW BYTE 
      AND B377            AND ISOLATE THE BYTE
      CPA .32       IS IT A BLANK ? 
      RSS             YES 
      JMP TABXT       NO, QUIT NOW
      ADB M1        BACK UP 
      STB OCCNT       ONE CHARACTER 
      SLB           NEW WORD ?
      JMP ETAB4       NO
      LDA OTBFA       YES 
      ADA M1            STEP BUFFER POINTER 
      STA OTBFA           BACK TOO
ETAB4 ISZ TEMP3     COUNT BLANKS REMOVED
      JMP ETAB3       AND CONTINUE
      JMP TABXT         UNLESS COUNT EXHAUSTED
      SKP 
********************* 
* 
**
***  EXECUTE NOT  **
**                **
* 
********************* 
* 
ENOT  JSB STTOP     LOAD OPERAND
      JMP EEQL1 
********************* 
* 
**
***  EXECUTE AND  **
**
* 
********************* 
EAND  JSB BINOP     VALIDATE
       JMP *+2        OPERANDS
       NOP
ANDS  SZA,RSS       FIRST OPERAND ZERO? 
      JMP FALSE     YES 
      LDA ANDS-1,I
      JMP ENEQ1     CHECK SECOND OPERAND
********************* 
* 
**
***  EXECUTE OR  ** 
**
* 
********************* 
EOR   JSB BINOP     VALIDATE
       JMP *+2
       NOP
      IOR *-1,I     TRUE IF EITHER OPND 
      JMP ENEQ1       NON-ZERO. 
******************* 
*                 * 
**  EXECUTE MAX  ** 
*                 * 
******************* 
EMAX  JSB BINOP     VALIDATE OPERANDS 
      JSB .FSB
VMAX   NOP
      SSA,RSS       TOP OPERAND LARGER? 
      JMP ARG1      NO! 
*****REMOVED LABEL 'ARG2' 790820*************** 
      DLD VMAX,I    YES,RETRIEVE IT!
      JMP FORM0 
* 
******************* 
*                 * 
**  EXECUTE MIN  ** 
*                 * 
******************* 
EMIN  JSB BINOP     VALIDATE OPERANDS 
      JSB .FSB      SUBTRACT THE TWO TOP OPERANDS 
VMIN   NOP
      SSA,RSS       TOP OPERAND LARGER? 
      JMP ARG3      NO! 
ARG1  LDB HSTPT,I 
      DLD 1,I 
      JMP FORM0 
ARG3  DLD VMIN,I
      JMP FORM0 
      SKP 
******************
*                *
**  EXECUTE IF  **
*                *
******************
* 
EIF   DLD TEMPS,I   EOF 
      CPB ENDOP       OPERATOR? 
      SSA 
      CLA,INA,RSS   NO,ALLOW STRING 
      JMP EIF1      YES 
      STA STRFG       CONSTANTS!
      JSB FETCH     FETCH VALUE OF FORMULA
      STA EFMT      SAVE RESULT FOR SINGLE STEPPING 
      STB NFMT
      SZA,RSS       RESULTANT TRUE? 
      JMP XEC4      NO
      ISZ TEMPS     ADVANCE TO NEXT OPERATOR
      LDB TEMPS     (B) = PTR TO INTERP. CODE 
      JMP SETSX     GO EVALUATE 'THEN' PART 
EIF1  ISZ TEMPS     EVALUATE
      JSB VLFIL       FILE REQUEST
      JMP E9-1      NOT A FILE
      NOP           FOUND AT EOF
      ISZ TEMPS     FOUND 
      LDB DCB       SET 
      ADB .15         TRANSFER
      LDA TEMPS,I       IN
      STA 1,I             DATA CONTROL BLOCK
      JMP XEC4
* 
* 
********************* 
*                   * 
**  EXECUTE GO TO  ** 
*                   * 
********************* 
* 
EGOTO CLA           SET FLAG TO 'GOTO' MODE 
      JMP EGOS0     FIND REFERENCED STATEMENT 
      SKP 
********************* 
*                   * 
**  EXECUTE INPUT  ** 
*                   * 
********************* 
* 
EINP1 JSB WDRQS     PRINT '?' AS WARNING
      JSB DRQST     YES, CALL FOR MORE
      JSB QCHEK     CHECK FOR STOP CHARACTER
EINP2 JSB CONST     CONVERT AND STORE NUMBER
******************************ADDED 800126*************************** 
      JMP EIN1
EIN   LDB TEMPS     END-OF- 
      INB 
      CPB PRADD       STATEMENT?
      JMP EIN15     YES 
      CPA .10       NO, INSURE MORE INPUT 
EINPT JSB DRQST     CALL FOR INPUT
      JSB QCHEK     CHECK FOR STOP CHARACTER
      JSB FORMX     COMPUTE VARIABLE ADDRESS
      LDB HSTPT,I   IS IT A 
      SSB             STRING VARIABLE?
      JMP EINP4     YES!
      ADB M1        STORE 
      ISZ HSTPT       ADDRESS-1 IN
      STB SBPTR         POINTER 
      JMP EINP2 
EIN1  STA HOLDA 
      LDA LUINP     CHECK FOR HPIB TYPE 
*******************CHANGED 800127***************************************
      AND B1314     BY CHECKING FOR UE AND UN BITS
      CPA B1314     IF UE BIT, HPIB DEVICE IS DOWN
      JMP EIN2      SINCE ONLY WAY HERE!
      LDA HOLDA 
      JMP EINP1 
EIN2  LDA HOLDA 
      JMP EIN15     ****END OF 800127 CHANGES** 
**************************800126******************************************
* 
EINP4 CMB           EXTRACT 
      LDA 1,I         PHYSICAL LENGTH 
      ALF,ALF           LENGTH OF 
      AND B377            DESTINATION STRING
      CMA           SET IT AS END 
      ADA TSTPT,I     OF UNSPECIFIED
      STA TPRME         DESTINATION STRING
      CCA           PREPARE 
      JSB PSTR        DESTINATION STRING
      LDB TNULL     SAVE LENGTH 
      STB TEMP7       ALLOWANCE 
EIN14 JSB GETCR     FETCH CHARACTER 
      NOP 
      CPA B42       QUOTE?
      RSS           YES!
      JSB BCKSP     NO,STRING BEGINS HERE 
      CLB           TURN OFF
      STB BLANK       SUPPRESSION 
      LDA FINCA     ADDRESS OF INPUT ROUTINE
      JSB TRSTR     TRANSFER STRING 
      CLB           ALL REQUESTED 
      CPB TNULL       CHARACTERS TRANSFERRED
      JMP EIN10     YES!
      CPB PS1       NO,TRANSFER LENGTH SPECIFIED
      JMP EINP9     NO
      STA TEMP7     YES, SAVE (A) 
      CCA           FINISH
      STA TPRME 
      ADA TNULL       TRANSFER
      STA TNULL 
      LDA FSCHA         WITH BLANKS 
      JSB TRSTR 
      LDA TEMP7     RESTORE (A) 
EINP7 CPA .10       TRANSFER ENDED BY END-OF-INPUT
      JMP EIN13     YES!
EINP8 JSB GETCR     NO, WAS IT A QUOTE
      LDA .10       EXIT WITH 
      JMP EIN13       NEXT CHARACTER
EINP9 LDB TEMP6,I   SET LOGICAL 
      ADB TNULL       TO ACTUAL 
      STB TEMP6,I       STRING LENGTH 
      JMP EINP7 
EIN10 CPB PS1       LENGTH OF STRING SPECIFIED? 
      JMP EIN12     NO! 
EIN11 JSB GETCR     YES!
      JMP EIN13     IMPLIED CLOSING QUOTE 
      CPA B42       QUOTE?
      JMP EINP8     YES!
      JMP EIN11     NO, LOOK FOR " OR END-OF-INPUT
EIN12 JSB GETCR     END-OF-INPUT NEXT?
      JMP EIN13     YES!
      CPA B42       NO,CLOSING QUOTE? 
      JMP EINP8     YES!
      LDA TEMP7     NO, DESTINATION STRING EXCEEDED!
      STA TNULL     RESTORE 
      LDA SBPTR       DESTINATION STRING
      STA TEMP5         PARAMETERS
      LDA B40       SET TO SKIP BLANKS
      STA BLANK 
      JSB WDRQS     PRINT EXTRA QUESTION MARK AS WARNING
      JSB DRQST     GET A NEW DATA RECORD 
      JSB QCHEK       AND CHECK FOR STOP CHARACTER
      JMP EIN14 
* 
EIN13 LDB B40       RESTORE 
      STB BLANK       BLANK SUPRESSION
      JMP EINP2+2 
* 
EIN15 LDA LUINP     ANY 
      STA LUOUT       PARTIAL 
      JSB FLUPT         LINES 
      SZA,RSS             LEFT? 
      JMP XEC4      NO! 
      CLA           YES!
      STA 1,I 
      JMP XEC4
* 
QCHEK NOP 
      LDA .INBF,I   FETCH FIRST WORD
      CPA TWOQS     ***ADD FOR BUG 790928 MM*** 
      JMP OPEND     ***ADD FOR BUG 790928 MM*** 
      ALF,ALF       POSITION FIRST BYTE 
      AND B377        AND ISOLATE IT
      CPA CTRLQ     IS IT A '^Q' ?
      JMP OPEND       YES, TAKE ORDERLY ABORT EXIT
      JMP QCHEK,I     NO, RETURN
* 
HOLDA NOP 
* 
      SKP 
* 
********************
*                  *
**  EXECUTE TRAP  **
*                  *
********************
* 
ETRAP NOP 
      RSS           SKIP ERROR MESSAGE IF NOT BUSY
      JSB ERROR     TRAP TABLE BUSY 
TERR4 EQU * 
      JSB FETCH     GET TRAP #
      JSB IFIX      MAKE INTEGER
**************************ADDED 800416*********************************** 
      STA TEMTR     SAVE THE TRAP#
      SSA           IS IT NEG?
      JMP TERR3     YES, ERROR
      SZA,RSS       0?
      JMP TERR3     YES, ERROR
      ADA M17       >16?
      SSA,RSS       YES, ERROR
      JMP TERR3 
      LDA TEMTR 
**********************************800416********************************* 
      CMA,INA       MAKE NEGATIVE 
      STA TEMP4     SAVE IT 
      LDB TEMPS 
      ADB .2        SKIP OVER 'GOSUB' AND FLAG
      LDA 1,I       GET SEQ NO. 
*     LDA 0,I       *800421** 
      STA TEMP5     SAVE IT 
      SSA           POSITIVE? 
      CMA,INA       NO, MAKE IT SO
      JSB FNDPS     MAKE SURE 
      JMP E12-1       STATEMENT 
      JMP E12-1         EXISTS
      LDB TEMP5     GET SEQ NO. 
      LDA TEMP4     GET TRAP NO.
      JSB TRAP      SET UP TRAP VS. SEQ NO. 
TRERR RSS           TRAP ERROR
      JMP XEC4
      CPA .1        TRAP TABLE FULL?
      JSB ERROR     YES!
TERR1 CPA .2        ILLEGAL TRAP COMBINATION? 
      JSB ERROR     YES!
TERR2 JSB ERROR     NO, MUST BE SCHEDULED BUT DELETED TASKED
TERR3 JSB ERROR     ERROR ILLEGAL TRAP #
TERR5 JSB ERROR 
E12   EQU * 
* 
TEMTR NOP 
      SKP 
********************* 
*                   * 
**  EXECUTE GOSUB  ** 
*                   * 
********************* 
* 
EGOSB CCA           SET FLAG TO 
EGOS0 STA RFLAG      'GOSUB' MODE 
      LDA 1,I 
      INB           SIMPLE BRANCH 
      AND OPDMK      STATEMENT? 
      CPA INTFL 
      JMP EGOS1     YES!
      JSB FETCH     NO, COMPUTE 
      JSB SBFIX      BRANCH INDEX 
      JMP XEC4      UNSUITABLE RESULT 
      LDB 0 
      BLS           COMPUTE 
      ADB TEMPS      'ADDRESS'
      ADB .2          ADDRESS 
      LDA 1 
      CMA           WITHIN
      ADA PRADD      STATEMENT RANGE
      SSA 
      JMP XEC4      NO! 
EGOS1 LDA 1,I       YES, LOADR BRANCH ADDRESS 
      ISZ RFLAG     'GOTO' MODE?
      JMP EGOS3     YES 
      LDB NXTST     LOAD (B) WITH 
EGOS2 STA NXTST      RETURN SEQUENCE NUMBER 
      JSB SLWST     STACK RETURN ON LOW-CORE STACK
      ADA M21       GOSUBS NESTED 20 DEEP?
      CPA LSTAK 
      JSB ERROR     YES!
E2    JMP XEC4      NO! 
EGOS3 STA NXTST     SAVE STMT # 
      JMP XEC4      EXECUTE IT
* 
EGOS4 STB TEMP7     SAVE TRAP FLAG
*******************CHANGED 800416************************************ 
      STA SHOV1     SAVE SEQ. # 
      JSB FNDPS     FIND ADDRESS
      NOP             OF TRAP 
      JMP SHOV      ERROR FORCE SEQ. # TO .LNUM 
      LDA 1 
      LDB TEMP7     RESTORE TRAP FLAG 
      JMP EGOS2 
* 
SHOV  LDA SHOV1     GET UNDEF SEQ. #
      STA .LNUM 
      JSB ERROR 
ERSEQ EQU * 
* 
SHOV1 NOP 
* 
************************800416******************************************* 
* 
*********************** 
*                     * 
**  EXECUTE RESTORE  ** 
*                     * 
*********************** 
* 
ERSTR LDA TEMPS,I   CHECK TO SEE
      ISZ TEMPS       IF THERE IS ANY 
      LDB DSTRT         DATA STATEMENTS 
      CPB M1        IMPOSSIBLE ADDRESS? 
      JMP XEC4      YES, SO IGNORE IT 
      SSA,RSS       FOLLOWED BY SEQ NUMBER
      JMP E7        NO! 
      LDA TEMPS,I   YES, SO USE IT
      STA 1         SET B TO STMT ADDRESS 
      ADA .2        NOW CHECK TO
      LDA 0,I         SEE IF
      AND OPMSK         THIS IS 
      CPA DATOP           A DATA STATEMENTNT
      RSS           YES IT IS!
      JSB ERROR     NO, NOT A DATA STMNT
E7    JSB SETDP     SET DATA POINTERS 
      JMP XEC4      DONE
* 
**
***  EXECUTE A BINARY OPERATOR  **
**
BINOP NOP 
      JSB OPCHK     VALIDATE TOP (SECOND) OPERAND 
      LDA BINOP 
      INA 
      STB 0,I       POST ITS ADDRESS
      ISZ HSTPT     UNSTACK ADDRESS 
      JSB STTOP     LOAD & VALIDATE FIRST OPERAND 
      JMP BINOP,I 
* 
**
***  EVALUATE FORMULA AND RETURN RESULT  ** 
**
FETCH NOP 
      JSB FORMX     EVALUATE FORMULA
      JSB OPCHK 
      ISZ HSTPT     UNSTACK RESULT ADDRESS
      DLD 1,I       LOAD (A&B) WITH VALUE
      JMP FETCH,I   EXIT
      SKP 
********************************
*                              *
**   EXECUTE SUBSCRIPT COMMA  **
*                              *
********************************
ESCMA JSB ESBS      INTEGERIZE COLUMN SUBSCRIPT 
      ISZ LSTPT 
      JSB ESBS      INTEGERIZE ROW SUBSCRIPT
      LDB HSTPT,I 
      SSB           STRING VARIABLE?
      JMP ESCM2     YES!
      ADB .2        FETCH SUBSCRIPT 
      LDA 1,I           BOUNDS
      AND B377      EXTRACT 
      STA OUTLN     COLUMN BOUND
      LDA 1,I       EXTRACT 
      ALF,ALF         ROW 
      AND B377          BOUND 
      CMA,INA       ACTUAL
      ADA LSTPT,I     ROW SUBSCRIPT 
      SSA,RSS           LEGAL?
      JMP E6-1      NO. ERROR 49. 
      LDA LSTPT,I 
      CLB,INB 
      CPB OUTLN     COLUMN MATRIX?
      JMP ESCM1     YES.
      MPY OUTLN     NO, COMPUTE ADDRESS 
*                     DISPLACEMENT DUE TO ROWS
ESCM1 CCB           UNSTACK 
      ADB LSTPT       ROW 
      STB LSTPT         SUBSCRIPT 
      LDB OUTLN     ACTUAL
      CMB,INB         COLUMN
      ADB LSTPT,I       SUBSCRIPT 
      SSB,RSS             LEGAL?
      JSB ERROR     NO. ERROR 49. 
E6    ADA LSTPT,I   YES, ADD IN COLUMN DISPLACEMENT 
      ALS           DOUBLE DISPLACEMENT 
      LDB HSTPT,I   COMPUTE 
      ADA 1,I         ACTUAL
      STA HSTPT,I       ADDRESS 
      STB TEMP7           AND SAVE BASE FOR ECALL 
      CCB 
      ADB LSTPT     UNSTACK 
      STB LSTPT         * 
      JMP FORM1     GO TO FORMULA PROCESSOR 
* 
ESCM2 JSB RSCHK     PUT STRING
      LDB M2          SUBSCRIPTS
      ADB LSTPT        ON 
      STB LSTPT          TEMPORARY
      INB                  STACK
      DLD 1,I 
      RRR 16        CORRECT ORDER 
      DST TSTPT,I     OF SUBSCRIPTS 
      JMP FORM1 
      SKP 
**
***  INTEGERIZE A SUBSCRIPT  ** 
**
ESBS  NOP 
      JSB OPCHK     VALIDATE SUBSCRIPT
      DLD 1,I       FETCH SUBSCRIPT 
      JSB .IENT     INTEGER?
       JMP E6-1     NO. ERROR 49. 
      SEZ,RSS       YES, ROUND AND
      ADA M1          BIAS BY -1
      SSA           POSITIVE INTEGER? 
      JMP EBS1      CHECK FOR NEG SUBSCRIPT ERROR 
EBS2  STA LSTPT,I   SAVE IN OPERATOR STACK
      ISZ HSTPT     POP OPERAND STACK 
      JMP ESBS,I
EBS1  LDB HSTPT     IS THIS 
      ADB .2          A STRING
      LDB 1,I           VARIABLE? 
      SSB,RSS 
      JMP E6-1      NO, ERROR NEG SUBSCRIPT!
      CPA M1        IF STRING -1
      JMP EBS2        IS OK 
      JMP E6-1      EVERY OTHER NEG VALUE BAD 
**
***  EXECUTE STORE  **
**
ESTR  LDB TEM10      IS NEXT OPERATOR 
      SZB             AN END-OF-FORMULA?
      JMP FOR10     NO, DEFER STORE 
      CPB TEMP5       YES, FIRST STORE OPERATOR USED? 
      JMP ESTR2     YES 
ESTR1 LDA HSTPT,I   SET 
      STA TEMP8          DESTINATION
      LDA TEMP5      SOURCE ADDRESS IN (A)
      LDB 0,I       TRANSFER HIGH 
      STB TEMP8,I        PART OF SOURCE 
      STB EFMT
      ISZ TEMP8        UPDATE 
      INA             POINTERS
      LDB 0,I       TRANSFER LOW
      STB TEMP8,I        PART OF SOURCE 
      STB NFMT
      ISZ HSTPT     POP STACK 
      JMP FOR11     RETURN TO FORMULA PROCESSOR 
* 
ESTR2 LDA HSTPT,I   STRING OPERANDS 
      SSA 
      JMP ESTR3     YES!
      JSB OPCHK     SAVE ADDRESS
      STB TEMP5         OF QUANTITY 
      ISZ HSTPT     POP HIGH-CORE 
      JMP ESTR1       STACK AND EXECUTE STORE 
* 
ESTR3 LDA M2        PREPARE 
      JSB PSTR        SOURCE
      STA TEMP8         STRING
      STB TPRME 
      CCA           PREPARE 
      JSB PSTR        DESTINATION STRING
      LDB PBPTR     SAVE CORE POINTER 
      STB EST1
      LDA TEMP8     TRANSFER
      CMA             TO
      ADA TEMP5         HIGHER
      SSA                 CORE? 
      JMP ESTR4     NO
      ADA TPRME     YES 
      ADA .2        OVERLAPPING 
      SSA,RSS         TRANSFER? 
      JMP ESTR4     NO
      LDA TEMP5     YES, SAVE 
      STA EST2        DESTINATION ADDRESS 
      INB           SET DESTINATION 
      BLS             ADDRESS TO START
      STB TEMP5         OF FREE CORE
      LDA TNULL     SAVE TRANSFER 
      STA EST3        LENGTH
      CMA,INA       ALLOCATE
      ARS             SPACE FOR 
      JSB OVCHK         INTERMEDIATE
      LDA FSCHA           STRING
      JSB TRSTR     TRANSFER STRING TO FREE CORE
      LDA EST3      RESTORE TRANSFER
      STA TNULL       LENGTH
      STA TPRME     RESET ACTUAL SOURCE LENGTH
      LDA EST1      SET SOURCE
      INA             ADDRESS TO
      ALS               INTERMEDIATE
      STA TEMP8           STRING
      LDA EST2      RESTORE ORIGINAL
      STA TEMP5       DESTINATION STRING
ESTR4 LDA FSCHA 
      JSB TRSTR     COMPLETE TRANSFER 
      LDA EST1      RESTORE FREE
      STA PBPTR       CORE POINTER
      JMP FORM9     EXECUTE END-OF-FORMULA
      ISZ PBPTR     DEFER 
      ISZ PBPTR       EXECUTION 
      LDA BASSO     GUARANTEE ASSIGNMENT
      STA PBPTR,I     OPERATOR ON STACK 
      JMP FORM4+6 
* 
BASSO OCT 7402
EST1  BSS 1 
EST2  BSS 1 
EST3  BSS 1 
TNULL BSS 1 
TPRME BSS 1 
CP0   BSS 1 
CP1   BSS 1 
      SKP 
***************** 
*               * 
***  CALL ADD  ** 
*               * 
***************** 
* 
EFAD  JSB BINOP 
      JSB .FAD
       NOP
      JMP FORM0 
**********************
*                    *
**   CALL SUBTRACT  **
*                    *
**********************
* 
EFSB  JSB BINOP     GET OPERAND DIFFERENCE
      JSB .FSB
       NOP
      JMP FORM0 
**********************
*                    *
**   CALL MULTIPLY  **
*                    *
**********************
* 
EFMP  JSB BINOP 
      JSB .FMP
       NOP
      JMP FORM0 
**********************
*                    *
**   CALL DIVIDE    **
*                    *
**********************
* 
EFDV  JSB BINOP 
      JSB .FDV
       NOP
      JMP FORM0 
      SKP 
**********************
*                    *
**     EXECUTE ^    **
*                    *
**********************
* 
EPWR  JSB BINOP     EVALUATE ARGUMENTS
       JMP *+2
EPWRA  NOP          ADDRESS OF POWER
      STA UTEMP     SAVE BASE 
      STB UTEMP+1 
      SZA           BASE ZERO?
      JMP PCHK1     NO
      LDA EPWRA,I   BASE ZERO;
      SZA,RSS       IS POWER ZERO?
      JSB ERROR     YES!
POWER SSA,RSS       NO; POWER POSITIVE? 
      JMP FALSE     YES, RETURN ZERO
      JSB ERROR     NO, ERROR!
ZRTNG LDA INF       USE POSITIVE
      LDB M2          INFINITY
      JMP FORM0 
* 
PCHK1 DLD EPWRA,I   FETCH POWER 
      JSB .IENT     INTEGERIZE
      JMP EPWR2     OVERFLOW
      CPA MNEG      OVERFLOW? 
      JMP EPWR2     YES 
      SOS           BITS LOST?
      JMP EPWR1     NO, IS INTEGER. 
EPWR2 LDA UTEMP     REAL POWER. FETCH BASE
      LDB UTEMP+1 
      SSA           NEGATIVE BASE?
      JSB ERROR     YES. ERROR 51.
BASER EQU * 
       JSB ALOG     TAKE NATURAL LOG OF BASE
        JSB ERROR   LOG ERROR 
LOGER EQU * 
      JSB .FMP       MULTIPLY BY POWER
       DEF EPWRA,I
      JSB EXP       EXPONENTIATE
       JSB ERROR     EXP ERROR
EXPER JMP FORM0 
* 
EPWR1 STA TT1       INTEGER; CALC BY MULTIPLICATION.
      LDB HONE      INITIALIZE RESULT TO 1.0
      STB TT3 
      LDB .2
      STB TT4 
      SSA 
      CMA,INA       TAKE ABSOLUTE VALUE 
IPWR1 SLA,RSS       TEST (SHIFTED) POWER
      JMP IPWR3     WAS EVEN. 
      STA TT2 
      LDA UTEMP     LOAD BASE 
      LDB UTEMP+1 
      JSB .FMP       MULTIPLY  RESULT-SO-FAR
       DEF TT3
      STA TT3       SAVE PARTIAL
      STB TT4         RESULT
      LDA TT2 
IPWR3 ARS 
      STA TT2 
      SZA,RSS       DONE? 
      JMP IPWR4     YES.
      LDA UTEMP     LOAD BASE 
      LDB UTEMP+1 
      JSB .FMP       SQUARE IT
       DEF UTEMP
      STA UTEMP 
      STB UTEMP+1 
      LDA TT2 
      JMP IPWR1 
* 
IPWR4 LDA TT1       GET ORIGINAL POWER
      SSA           POSITIVE POWER? 
      JMP IPWR5     NEGATIVE. RETURN RECIPROCAL.
      LDA TT3       YES,LOAD
      LDB TT4         RESULT
      JMP FORM0 
* 
IPWR5 LDA HONE      LOAD
      LDB .2          1.0 
      JSB .FDV      DIVIDE BY RESULT
       DEF TT3
      JMP FORM0     RETURN RESULT 
* 
* 
******************
*                *
**  EXECUTE <=  **
*                *
******************
**
ELORE JSB COMPR     COMPARE OPERANDS
       SSA          < ? 
      JMP TRUE      NO! 
      JMP EEQL+1    YES!
**
      SKP 
***************** 
*               * 
**  EXECUTE =  ** 
*               * 
***************** 
**
EEQL  JSB COMPR     COMPARE OPERANDS
EEQL1  SZA          EQUAL?
      JMP FALSE     NO! 
      JMP TRUE      YES!
**
***************** 
*               * 
**  EXECUTE #  ** 
*               * 
***************** 
**
ENEQL JSB COMPR     COMPARE OPERANDS
ENEQ1  SZA          NOT EQUAL?
      JMP TRUE      NO! 
      JMP FALSE     YES!
**
***************** 
*               * 
**  EXECUTE >  ** 
*               * 
***************** 
**
EGTRT JSB COMPR     COMPARE OPERANDS
      SSA           < ? 
      JMP FALSE     YES!
      JMP ENEQL+1   NO! 
**
***************** 
*               * 
**  EXECUTE <  ** 
*               * 
***************** 
**
ELST  JSB COMPR     COMPARE OPERANDS
      CMA,RSS 
**
******************
*                *
**  EXECUTE >=  **
*                *
******************
**
EGORE JSB COMPR     COMAPARE OPERANDS 
      SSA           < ? 
      JMP FALSE     YES!
      JMP TRUE      NO! 
**
FALSE CLA           LOAD
      CLB             ZERO
      JMP FORM0 
************************
**
***  EXECUTE UNARY -  **
**
************************
EUMIN JSB STTOP     LOAD NUMBER 
      JSB ..FCM     NEGATE IT 
      JMP FORM0 
***************************** 
**
***  EXECUTE LEFT BRACKET  ** 
**
***************************** 
ELBRC ISZ LSTPT     LOAD SUBSCRIPT COMMA
      LDB SCCNT       INFORMATION WORD
      JSB SLWST     STACK IT
      JSB BHSTP     BUMP STACK
      JSB RSCHK 
      LDA HSTPT     IS THIS 
      ADA .2          A STRING
      LDA 0,I           VARIABLE? 
      SSA 
      JMP ELB1      YES 
TRUE  LDA HONE      NO,ARRAY SO 
      LDB .2          LOAD DEFAULT 0
      JMP FORM0 
ELB1  CLA           SET DEFAULT 
      CLB             SUBSCRIPT TO BE 
      JMP FORM0         FINALLY -1
      SKP 
* 
*********************************** 
*                                 * 
*  COMPARE TOP OPERANDS ON STACK  * 
*                                 * 
*********************************** 
* 
*  ON EXIT (A) IS NEGATIVE IF THE TOP OPERAND OF THE
*  STACK IS GREATER THAN THE NEXT-TO-TOP OPERAND AND
*  POSITIVE IF IT IS LESS, AND ZERO IF THEY ARE EQUAL.
* 
COMPR NOP 
      LDA HSTPT,I   STRING
      SSA             ARGUMENTS?
      JMP COMP1     YES!
      JSB BINOP     NO, COMPARE 
      JSB .FSB        NUMERICAL 
       NOP
      JMP COMPR,I       OPERANDS
      SPC 1 
COMP1 LDA M2        PREPARE 
      JSB PSTR          COMPARISON
      STA TEMP8           STRING
      STB TPRME 
      LDA TNULL     SAVE SPECIFIED
      STA CP0         LENGTH
      LDA M2        PREPARE 
      JSB PSTR        TEST STRING 
      STB CP1       SAVE ACTUAL LENGTH
      ISZ TSTPT     RESERVE SPACE 
      ISZ TSTPT       FOR RESULT
      JSB BHSTP     BUMP HI STACK 
COMP2 ISZ CP0       MORE SPECIFIED STRING 
      JMP COMP3     YES!
      CLB           NO, LOAD A NULL 
      JMP COMP4       CHARACTER 
COMP3 JSB FSCH      LOAD NEXT 
      LDA B40         COMPARISON
      LDB 0             CHARACTER 
COMP4 ISZ TNULL     MORE SPECIFIED TEST STRING? 
      JMP COMP6     YES!
      CLA           NO, LOAD NULL CHARACTER 
COMP5 CMB,INB       COMPARE 
      ADA 1           CHARACTERS
      SZA,RSS       EXIT ON NOT EQUAL 
      SZB,RSS         OR BOTH NULL
      JMP COMPR,I       CHARACTERS
      JMP COMP2 
COMP6 LDA CP1       MORE ACTUAL 
      INA,SZA         TEST STRING?
      JMP COMP7     YES!
      LDA B40       NO, LOAD A BLANK
      JMP COMP5 
COMP7 STA CP1 
      LDA TEMP5     EXTRACT 
      CLE,ERA 
      LDA 0,I         NEXT
      SEZ,RSS 
      ALF,ALF           TEST
      AND B377
      ISZ TEMP5           CHARACTER 
      JMP COMP5 
* 
* 
**
**************************
*                        *
***  FETCH A DATA ITEM  **
*                        *
**************************
* 
*  UPON ENTRY (B)=1 IF NUMBER IS REQUESTED OR (B)=2 IF A
*  STRING IS REQUESTED.  TYPE MATCH IS CHECKED. NUMBERS RETURN
*  IN (A) AND (B)    STRINGS ARE PREPARED A SOURCE STRINGS. 
*  FDATA FILLS FROM A FILE IF ONE IS REFERENCED BY THE CALLER.
*  FDATA MOVES TO NEW FILE RECORDS OR <DATA STMNTS> AS NECESSARY. 
* 
**
FDATA NOP 
      STB TEMP8     SAVE DATA TYPE
      LDA FILE#     READ FROM 
      SSA,RSS         FILE? 
      JMP FDAT4     YES!
FDAT1 ISZ DCCNT     MORE DATA?
      JMP FDAT2     YES 
      LDA DATA      NO, SEARCH
      LDB NXTDT       FOR NEXT
      JSB STSRH         DATA STATEMENT
       JSB ERROR    NONE FOUND. ERROR 56
E4    JSB SETDP     INITIALIZE THE
      JMP FDAT1       DATA POINTERS 
* 
FDAT2 LDB TEMP8     RESTORE TYPE
      ISZ DCCNT     UPDATE
      LDA NXTDT,I     POINTER 
      ISZ NXTDT     CORRECT 
      RBR             TYPE
      XOR 1             OF DATA?
      SSA 
      JSB ERROR     NO! 
E5    SSB,RSS       YES, STRING?
      JMP FDAT3     YES!
      DLD NXTDT,I   LOAD
      ISZ NXTDT       DATA
      ISZ NXTDT     UPDATE POINTER
      ISZ DCCNT       AND COUNTER 
      JMP FDATA,I 
FDAT4 LDB RCRD#     GET TYPE
      STB EORFL       OF NEXT ITEM
      JSB GTTYP         IN FILE 
      CPA TEMP8     MATCHING TYPES? 
      JMP FDAT6     YES!
      CPA .4        NO, END-OF-RECORD?
      JMP EOFCK     YES, EOR ERROR
      CPA .3        NO, END-OF-FILE?
      JMP EOFCK     YES, CHECK FOR TRANSFER TO STMT 
      JMP E5-1      WRONG DATA TYPE!
FDAT6 LDB DCB       LOAD DATA 
      ADB .12         ADDRESS 
      STB TEMP3 
      LDB 1,I 
      LDA .2        IS IT 
      CPA TEMP8       STRING? 
      JMP FDAT7     YES!
      ISZ TEMP3,I   ADJUST RECORD PTR 
      ISZ TEMP3,I     PAST DATA 
      DLD 1,I       NO, LOAD NUMBER 
      JMP FDATA,I 
FDAT7 LDA 1,I       LOAD STRING HEADER
      INB           SET 
      CLE,ELB         SOURCE
      STB TEMP8         ADDRESS 
      CLE,ERB 
      AND B377      SET 
      CMA             TRANSFER
      STA TPRME         LENGTH
      CMA,INA       ADJUST
      ARS             RECORD
      ADB 0             PAST
      STB TEMP3,I         STRING
      JMP FDATA,I 
FDAT3 LDA NXTDT,I   SET 
      ISZ NXTDT 
      LDB NXTDT       START-OF-STRING 
      RBL               CHARACTER 
      STB TEMP8           ADDRESS 
      AND B377      SET 
      CMA             TRANSFER STRING 
      STA TPRME         LENGTH
      CMA,INA       UPDATE
      ARS 
      LDB 0 
      ADA NXTDT       DATA
      STA NXTDT 
      ADB DCCNT 
      STB DCCNT         POINTERS
      JMP FDATA,I 
      SKP 
**
***  SET FOR FOLLOWING STATEMENT  **
**
FLWST NOP           (B) HOLDS PRESENT ADDRESS 
      LDA 1         COMPUTE 
      INA             ADDRESS 
      LDA 0,I           OF
      ADA 1               NEXT
      STA PRADD             STATEMENT 
      CPA PBPTR     END OF PROGRAM? 
      CLA           YES, SET LINE NO. TO 0
      STA NXTST     NEXT SEQ NUMBER 
      ADB .2        FETCH 
      STB TEMPS       FIRST WORD
      LDA 1,I           OF CURRENT
      JMP FLWST,I         STATEMENT 
* 
**
***  SEARCH STACK FOR GIVEN FOR-VARIABLE  **
**
FVSRH NOP 
      LDA TEMPS,I   FETCH 
      AND B777        FOR-VARIABLE
      STA ETAB      SAVE FOR-VARIABLE 
      JSB SSYMT     FIND ADDRESS IN 
      INB             SYMBOL TABLE
      LDA HSTPT     SAVE
      STA TEMP3       STACK TOP 
FVSR1 CPA SYMTF     STACK BOTTOM? 
      JMP FVSRH,I   YES, EXIT VIA (P+1) 
      CPB 0,I       MATCHING FOR-VARIABLE?
      JMP FVSR2     YES 
      ADA .6        NO, MOVE TO 
      JMP FVSR1       NEXT STACK ENTRY
* 
FVSR2 ISZ FVSRH     EXIT
      JMP FVSRH,I     VIA (P+2) 
      SKP 
* 
**********************************************
*                                            *
*  EXECUTE STATEMENTS IN OVERFLOW SEGMENT 8  *
*                                            *
**********************************************
* 
********************
*                  *
*  EXECUTE ASSIGN  *
*                  *
********************
* 
EASSN CLA,INA       SET TO
      STA STRFG       ALLOW STRINGS 
      JSB FORMX     GET ADDRESS OF
      LDA M2        PREPARE 
      JSB PSTR        STRING ADRESS AND LENGTH
      STA TEMP7     ADDRESS 
      STB TEMP6     LENGTH
      JSB FORMX     GET ADDRESS 
      LDB HSTPT,I     OF FILE 
      STB TEMP8         NUMBER
      ISZ TEMPS 
      JSB FORMX     GET ERROR 
      LDB HSTPT,I     RETURN
      STB TEMP9         ADDRESS 
      LDA HSTPT     RESET HI STK
      ADA .2          POINTER 
      STA HSTPT 
      CLA,INA 
      JMP SEG8      FINISH UP EXECUTION 
* 
* 
******************* 
*                 * 
*  EXECUTE PAUSE  * 
*                 * 
******************* 
* 
EPAZ  LDA .2        GO TO 
      RSS             SEGMENT 8 
* 
* 
**********************
*                    *
*  EXECUTE END/STOP  *
*                    *
**********************
* 
EEND  LDA .3        GO TO 
      RSS             SEGMENT 8 
      SKP 
* 
* 
********************************
*                              *
*  EXECUTE OPERATOR ATTENTION  *
*                              *
********************************
* 
OPEND LDA .4        GO TO 
      CLB             SEGMENT 8 
      STB TEMP3         CLEARING ERROR FLAG 
* 
* 
SEG8  STA SLSTM     SET SLOW STATEMENT FLAG 
      LDB .8
      JMP SGMNT     LOAD SEGMENT #8 TO EXECUTE
      SKP 
********************
*                  *
*   EXECUTE CALL   *
*                  *
********************
* 
* 
*   THE GENERAL FLOW THRU ECALL IS AS FOLLOWS:
* 
*     1.  CONTROL IS PASSED TO ECALL OR FCALL WHEN A
*         CALL OR FORTRAN FUNCTION IS FOUND RESPECTIVELY. 
* 
*     2.  IF IT IS A CALL THEN THE SIMULATE FLAG IS CHECKED 
*         AND IF SET CONTROL IS PASSED TO SEGMENT 7 TO SIMULATE 
*         THE CALL STATEMENT. 
* 
*     3.  THEN THE PARAMETERS OF THE CALL ARE STACKED ONE BY ONE
*         ON THE HIGH STACK.  EACH PARAMETER IS A THREE WORD ENTRY. 
*         THE DESCRIPTOR TRIPLET HAS THE FOLLOWING FORM, DEPENDING ON 
*         THE PARAMETER TYPE DISCOVERED BY ECALL: 
* 
*            SIMPLE VARIABLES       ARRAYS            STRINGS 
*          ---------------------------------------------------------- 
* HSTPT+2 !  ARGUMENT POINTER  ! ELEMENT POINTER ! -BASE ADDRESS - 1 !
*         !----------------------------------------------------------!
* HSTPT+1 !  ARGUMENT POINTER  !  ARRAY BASE PTR ! CHARACTER ADDRESS !
*         !----------------------------------------------------------!
* HSTPT   !   2:REAL / 1:INTG  ! ARRAY SIZE (WDS)! -STRG LNGTH (CHAR)!
*          ---------------------------------------------------------- 
* 
*     4.  FOR FORTRAN FUNCTIONS THE SAME THINGS ARE DONE FOR
*         PARAMETERS BUT THE CALL # AND PARAMETER COUNT FROM THE
*         INTERPRETIVE CODE IS STACKED ON THE LOW STACK.  DURING
*         EXECUTION OF THE STATEMENT THE INTERMEDIATE RESULTS ARE 
*         STACKED ON THE TEMPORARY STACK AND POPPED OFF AS REQUIRED.
* 
*     5.  AFTER SCANNING THE LIST, THE
*         PARAM CT. IS PUT ON THE HIGH STACK.  AT THIS TIME THE 
*         HIGH STACK CONTAINS THE PARAMETER COUNT AND THREE WORD ENTRIES
*         FOR EACH OF THE PARAMETERS ALL IN REVERSE ORDER ON THE HIGH 
*         STACK. I.E.  LAST PARAMETER ON TOP. 
* 
*     6.  NEXT THE SUBROUTINE NUMBER IS USED TO FIND THE
*         CORRECT BRANCH TABLE ENTRY AND THE CONTROL WORD AND 
*         PARAMETER CONVERSION WORDS ARE RETRIEVED FROM THE TABLE.
*         FROM THE CONTROL WORD, THE NAME OF THE OVERLAY IS BUILT,
*         AND THE SUBROUTINE NUMBER IS SAVED FOR THE OVERLAY. 
      SKP 
*     7.  THEN THE PARAMETERS ARE WRITTEN OUT TO SYSTEM AVAILABLE 
*         MEMORY WITH CLASS I/O. THE FIRST RECORD WRITTEN IS THE HIGH 
*         STACK WHICH IS USED BY THE OVERLAY AS A PARAMETER DESCRIPTION.
*         THEN EACH PARAMETER IS WRITTEN OUT, ACCORDING TO THE TABLE
*         ON THE NEXT PAGE. 
* 
*     8.  THE OVERLAY IS THEN SCHEDULED.  THE OVERLAY READS IN
*         ALL PARAMETERS FROM SYSTEM AVAILABLE MEMORY, BUILDS 
*         A SUBROUTINE CALL PARAMETER ADDRESS LIST, INTEGERIZES AS
*         REQUIRED, AND TRANSFERS CONTROL TO THE SUBROUTINE 
*         SPECIFIED BY THE BRANCH TABLE CONTROL WORD. 
* 
*     9.  UPON COMPLETION OF THE SUBROUTINE THE PARAMETERS ARE
*         RECONVERTED AS REQUIRED, AND WRITTEN OUT USING
*         CLASS I/O TO SYSTEM AVAILABLE MEMORY. 
*         CONTROL IS THEN RETURNED TO BASIC AND 
*         THE PARAMETERS ARE READ IN FROM SYSTEM AVAILABLE MEMORY 
*         AND PLACED BACK INTO THEIR RESPECTIVE PLACES, IF THE
*         RETURNED VALUE FLAG IS SET FOR THAT PARAMETER, AND IF 
*         THE SUBROUTINE RETURNED NO ERROR FLAG.
* 
*     10. CONTROL IS THEN PASSED TO THE NEXT STATEMENT FOR CALLS, AND 
*         BACK INTO THE FORMX ROUTINE FOR FORTRAN FUNCTIONS, UNLESS 
*         AN ERROR OCCURRED.
* 
*         ERROR CONDITIONS FROM THE OVERLAY ARE ALWAYS FATAL FOR
*         FORTRAN FUNCTIONS, AND ARE FATAL FOR CALLS UNLESS 
*         THE BASIC PROGRAM LINE CONTAINS A "FAIL:" STATEMENT.
*         FOREGROUND/BACKGROUND COMMUNICATION ERRORS AND
*         OVERLAY ABORT ERRORS ARE ALWAYS FATAL.
      SKP 
*     THIS TABLE DESCRIBES THE ACTION OF ECALL IN TRANSFERRING
*     ARGUMENTS FROM THE PARAMETER LIST SPECIFIED IN THE BASIC
*     PROGRAM TO THE OVERLAY ROUTINE IN THE FOREGROUND. 
* 
*     THE ACTION TAKEN BY THE INTERPRETER DEPENDS ON THE CONTENTS 
*     OF THREE PARAMETER CONVERSION WORDS OBTAINED FROM THE 
*     BRANCH TABLE, SPECIFYING THE ATTRIBUTES OF THE ARGUMENTS
*     EXPECTED BY THE OVERLAY ROUTINE:
*             WORD 0 -- ROUTINE CONTROL WORD
*             WORD 1 -- ARRAY IDENTIFIER WORD 
*             WORD 2 -- RETURNED VALUE WORD 
*             WORD 3 -- INTEGER CONVERSION WORD 
* 
* 
*          FORMAL 
*         ARGUMENT :    ARRAY/SIMPLE        RETURN/NO      INTEGER/REAL 
*  ACTUAL         !--------------------------------------------------------!
*  ARGUMENT:      !                    !                !    FIX ON CALL   !
*   SIMPLE        !  PASS VARIABLE     !   SAVE RETURN  !       AND        !
*   VARIABLE      !                    !   IF BIT = 1   !  FLOAT ON RETURN !
*                 !--------------------------------------------------------!
*                 !  PASS ARRAY IF 1   !  PASS VALUE(S) !  FIX ALL VALUES  !
*   ARRAY         !  WITH POINTER TO   !  SAVE RETURN(S)!      AND         !
*   VARIABLE      !  GIVEN ELEMENT     !  IF BIT = 1    !  FLOAT ON RETURN !
*                 ! PASS ELEMENT IF 0  !                !                  !
*                 !--------------------------------------------------------!
*                 !  PASS STRING OR    !                !       \  /       !
*   STRING        !   SUBSTRING IF 1   ! SAVE STRING    !        \/        !
*   VARIABLE      !  PASS 2 CHARACTERS !  OR SUBSTRING  !        /\        !
*                 !    IF 0            !      IF 1      !       /  \       !
*                 !--------------------------------------------------------!
*                 !  PASS STRING OR    !  SYNTAX ERROR  !       \  /       !
*   STRING        !   SUBSTRING IF 1   !   IF BIT = 1   !        \/        !
*   CONSTANT      !  PASS 2 CHARACTERS ! PASS ONLY IF 0 !        /\        !
*                 !                    !                !       /  \       !
*                 !--------------------------------------------------------!
*                 !                    !  SYNTAX ERROR  !   FIX ON CALL    !
*   SIMPLE        !   PASS CONSTANT    !   IF BIT =1    !      AND         !
*   CONSTANT      !                    ! PASS ONLY IF 0 ! FLOAT ON RETURN  !
*                 !                    !                !  IF BIT = 1      !
*                 !--------------------------------------------------------!
*                 !  SYNTAX ERROR      !                !                  !
*   REAL          !    IF BIT = 1      !  SYNTAX ERROR  !  FIX VALUE       !
*   EXPRESSION    !  PASS VALUE IF     !    IF BIT = 1  !    ON CALL       !
*                 !    BIT = 0         !                !                  !
*                 !--------------------------------------------------------!
      SKP 
ECALL LDA SMFLG 
      SZA,RSS 
      JMP CALL0 
      LDA NXTST 
      CMA,INA 
      STA NXTST 
SEG7  LDB .7        LOAD SEGMENT #7 
      JMP SGMNT 
* 
CALL0 JSB BHSTP 
FCALL LDA FORMX     SAVE RETURN 
      STA HSTPT,I      FROM FORMX 
      LDB TEMPS,I   STACK CALL ID WORD
      JSB SLWST       ON LOW STACK
      CLB 
      JSB SLWST     INIT ARGUMENT CNTR
      INB             & 
      STB STRFG      STRING FLAG
CALL2 ISZ TEMPS      FETCH NEXT 
CALL3 LDA TEMPS,I     INTERPRETIVE WORD 
      SZA,RSS       NULL? 
      JMP CBKSP       YES,BACK UP 1 
      CPA LFPAR     SUBCRIPTED VARIABLE?
      JMP CBKSP       YES, BACK UP TO OPND-ID 
      AND OPMSK 
      CPA B4000     RIGHT PARENTHESIS?
      JMP CALL5        YES, END OF LIST 
      JSB FORMX     EVALUATE ARGUMENT 
* 
      LDA HSTPT,I   FETCH ARGUMENT ADDRESS
      SSA           STRING? 
      JMP STVAL      YES
      CMA            NO, CHECK FOR ARRAY
      LDB PBPTR     LOW END OF ARRAY STORAGE
      ADB 0 
      SSB,RSS       ABOVE?
      JMP CSVAL      NO,MUST BE CONSTANT
      LDB FCORE     HIGH END OF ARRAY STORAGE 
      ADB M2        DECREMENT FOR 1'S COMP -1 
      ADB 0 
      SSB           ABOVE?
      JMP COVAL     YES, MUST BE INTERMED,COMMON OR VAR.
COVAR LDB TEMP7,I   NO, FETCH ARRAY BASE ADDR FROM SYM TBL
      ISZ TEMP7     POINT TO ARRAY SIZE 
      LDA TEMP7,I   FETCH ARRAY SIZE
      STB TEMP7     SAVE BASE ADDR TEMPORY
      CLB           MULTIPLY
      RRR 8          COLUMN * 
      BLF,BLF                ROW
      STB TEMP3         TO CALCULATE
      MPY TEMP3           ARRAY SIZE. 
      RRR 15         CONVERT SIZE TO WORDS IN B 
      LDA TEMP7     FETCH BASE ADDR 
      JMP CSVPT     PUT BASE ADDR & SIZE ON HISTK.
* 
COVAL LDB SYMTA     IS
      ADB M1          THE 
      ADB 0             POINTER 
      SSB                 TO A COMMON VARIABLE? 
      JMP COVAR     YES!
* 
CSVAL CMA            BACK TO ADDRESS
      LDB .2        LENGTH =2 
CSVPT STB TEMP3     SAVE SIZE TEMPORARY 
      JSB BHSTP 
      STA HSTPT,I   SAVE BASE OR CHAR ADDR
      JSB BHSTP 
      LDA TEMP3     SAVE LENGTH 
      STA HSTPT,I    +=WORDS, -=CHARS 
      ISZ LSTPT,I   ADD TO ARG COUNT
      JMP CALL2     CHECK FOR MORE
* 
STVAL LDA M2        SOURCE STRING FLAG
      JSB PSTR      PREPARE STRING. RTN A=ADDR, B=LENGTH
      SWP           EXCHANGE REGS 
      CMA 
      STA TEMP7     SAVE ACTUAL STRING LEN
      LDA TEMP6,I   GET ARRAY DIMENSION 
      AND HIMSK       AND 
      ADA TEMP7         STUFF IN ACTUAL LENGTH
      STA TEMP3           AND SAVE  LOGICAL-PHYSICAL LENGTH 
      SWP 
      JSB BHSTP     UNDO STACK BUMP FROM PSTR 
      JMP CSVPT+1   SAVE IT ALL ON HISTK
* 
CBKSP LDB TEMPS     BACK UP 
      ADB M1         TO LAST
      STB TEMPS       INTERPRETIVE
      JMP CALL3        WORD 
* 
*     END OF ARGUMENT SCAN
      SKP 
CALL5 JSB BHSTP     MAKE ROOM ON HI STACK 
      JSB ULWST       AND UNSTACK 
      STB HSTPT,I       ARGUMENT COUNT
      LDA LSTPT,I   ISOLATE CALL INDEX
      AND B777
      ALS,ALS       MULTIPLY BY 4 
      ADA FWAMB     INDEX INTO BRTBL
      STA 1 
      ADB .2
      STB TEMP4      AND SAVE POINTER 
      DLD 0,I 
      STA TEMP3     CALL # &SUB INDEX 
      STB TEMP6     ARRAY IDENTIFIER WORD 
      ALF,RAL       CONVERT FG PROG NAME
      AND .31        TO ASCII 
      IOR .64       LETTER ID FIRST 
      ALF,ALF 
      STA TEMP9      THEN 
      LDA TEMP3 
      RRR 6           TWO 
      AND .31 
      CLB             DIGITS
      DIV .10 
      IOR .48          IN 
      IOR TEMP9 
      STA NAM+1         DECIMAL 
      LDA 1              FORM 
      IOR .48 
      ALF,ALF 
      IOR B40      PUT OUT AN ASCII BLANK *791119*
      STA NAM+2 
      LDA TEMP3     ISOLATE FG DIRECTORY
      AND B77              OFFSET 
      STA SUB#
      DLD TEMP4,I   FETCH INTEGER 
      STB TEMP5       FLAG AND SAVE 
      JSB CINIT     SET UP DESBLK POINTER AND COUNTER 
      ADA .3        SAVE (END OF DESBLK)+1
      STA TEMP7       FOR LATER STACK UPDATE
      JMP CAL7A        AND START DESBLK SCAN
      SKP 
CALL6 LDA TEMP6     ARRAY REQ'D?
      CLE,ERA 
      STA TEMP6 
      SEZ 
      JMP CALL7      YES, SKIP TRUNCATION 
      LDA TT2,I 
      SSA           IS THIS A STRING ?
      JMP CAL6A       YES 
      LDA .2          NO, FORCE 
      LDB TT2           RECORD SIZE 
      STA 1,I             TO 2
      ADB .2                AND 
      LDA 1,I                 BASE ADDRESS
      ADB M1                  TO
      STA 1,I                   ARGUMENT ADDRESS
      JMP CALL7 
* 
CAL6A LDA M2        FORCE 
      STA TT2,I       STRING SIZE = -2
CALL7 LDB TEMP5     EXAMINE 
      CLE,ERB         THE INTEGER FLAG
      STB TEMP5         FOR THIS ARGUMENT 
      SSA,RSS       STRING ARGUMENT ? 
      SEZ,RSS       INTEGER ARGUMENT ?
      JMP CAL7B       STRING OR REAL
* 
* INTEGER ARGUMENT
* 
      LDB TT2 
      LDA 1,I       INTEGERS ONLY 
      ARS             TAKE HALF AS
      STA 1,I           MUCH ROOM 
* 
      INB           MAKE
      LDA 1,I         ELEMENT POINTER 
      CMA,INA           POINT AT
      INB                 RIGHT PLACE 
      ADA 1,I       ELEMENT POINTER IS NORMALLY 
      ARS             THINKING IT IS A
      ADB M1            A REAL ARRAY THATS WHY! 
      ADA 1,I 
      INB 
      STA 1,I 
CAL7B JSB CSTEP     STEP POINTER
CAL7A ISZ TT1         AND COUNTER 
       JMP CALL6        UNLESS END OF SCAN
* 
      LDB BIT15 
      STB CLASS     INITIALIZE CLASS WORD 
      LDB HSTPT     SET UP TRANSFER 
      STB TEMP9       POINTER 
      CMB,INB       FIGURE LENGTH 
      ADB TEMP7       OF DESCRIPTOR BLOCK 
      STB TEMP3         FOR CLASS WRITE/READ
      JSB CLRW      OUTPUT DESCRIPTOR BLOCK 
* 
      DLD TEMP4,I   FETCH INTEGER FLAG WORD 
      STB TEMP2 
      JSB CINIT     START AGAIN AT FIRST PARAMETER
      JMP CAL11 
      SKP 
CALL9 JSB CADCK     SET UP PARAMETER ADDRESSES
       JMP CAL10      REAL VALUE
       JMP CAL9A      INTEGER VALUE 
      STA TEMP5       STRINGS, COPY TO FREE 
      STB TEMP8         SPACE BELOW HICH STACK
      LDA FSCHA 
      JSB TRSTR 
      JMP CAL10 
* 
CAL9A STA TEMP5     HERE FOR INTEGER
      STB TEMP8       PROCESSING
CAL9B DLD TEMP8,I       FETCH A VARIABLE
      ISZ TEMP8 
      ISZ TEMP8 
      JSB IFIX
      STA TEMP5,I       STORE AN INTEGER
      ISZ TEMP5 
      ISZ TNULL         DONE ?
      JMP CAL9B           NO
* 
CAL10 JSB CLRW      OUTPUT THE RECORD 
      JSB CSTEP     STEP THE POINTER
CAL11 ISZ TT1         AND COUNTER 
      JMP CALL9        UNLESS DONE
* 
      LDA MNEG      SET UP MOST 
      STA ERRCD       TERRIBLE ERROR
* 
      LDA CLASS 
      IOR BIT13     SET SAVE-CLASS
      STA CLASS 
      JSB EXEC      GET PARAMATER 
      DEF *+5         STRING
      DEF .14           FROM
      DEF .1              :RU,BASIC 
      DEF SBUFA,I           AND PASS
      DEF M81                 TO SUBROUTINE 
      CMB,INB       SET UP CHAR COUNT 
****************************CHANGED 791114****************************
      STB LEN 
      LDB BFIV
      STB MOVE      SET UP FOR MOVING IN PARMS. 
      LDB SUB#      OVLY DIRECTORY OFFSET 
      STB MOVE,I
      ISZ MOVE
      LDB CLASS     CLASS BUFFER ID WORD
      STB MOVE,I
      ISZ MOVE
      LDB TEMP4,I   NAME/VALUE FLAG WORD
      STB MOVE,I
      ISZ MOVE
      LDB ERTTY     ERROR LU# 
      STB MOVE,I
      ISZ MOVE
      LDB .LNUM     LINE NUMBER 
      STB MOVE,I
* 
      JSB XQPRG     SCHEDULE
      DEF NEW        OVERLAY WITH WAIT
      DEF DDCB       NEEDED DCB 
      DEF SCODE        PASSING
      DEF NAM            THESE PARAMETERS:
      DEF BFIVE 
      DEF SBUFA,I     RUN STRING (COMMAND FILE) 
      DEF LEN 
      DEF ERRCD       RETURN PARAMETER ARRAY
      DEF FERR        ERROR RETURNED
      DEF .0          DON'T CARE SECURITY CODE
      DEF .0          DON'T CARE CRN# 
NEW   LDB FERR        CHECK FOR ERROR *791119*
      SZB,RSS 
      JMP NEW2
*************************ADDED 791119*********************************
      CPB .2        NOT ENOUGH ID SEGS.?
      JMP OERR1-1   YES ISSUE ERROR 
      CPB .3        OVERLAY NOT FOUND?
      JMP E17-1     YES ISSUE ERROR 
      CPB .4        FILE OPEN ERROR?
      JMP E10-1     YES ISSUE ERROR 
      CPB .6        OVERLAY NOT IN SYSTEM?
      JMP E17-1     YES ISSUE ERROR 
      CPB .7        OVERLAY BUSY? 
      JMP OERR2     YES ISSUE ERROR 
      CPB B10       OVERLAY ABORTED?
      JMP E15-1     YES ISSUE ERROR 
      CPB B11       NOT ENOUGH MEMORY?
      JMP E1        YES ISSUE ERROR 
* 
      JSB ERROR     YES, ERROR OVERLAY NOT
E17   EQU *           IN SYSTEM 
      JSB ERROR     ERROR OF NOT ENOUGH 
OERR1 EQU *         ID SEGS. FOR OVERLAY
      JSB ERROR     ERROR OF OVERLAY BUSY 
OERR2 EQU * 
* 
*     SSB           ANY PARAMETERS? 
*     JMP *+4        NO 
* 
*     JSB RMPAR    RECOVER PARAMETERS 
*     DEF *+2         PASSED BACK 
*     DEF ERRCD         FROM OVERLAY
* 
****************************791114************************************
*      RECOVER VARIABLES FROM CLASS 
* 
NEW2  DLD TEMP4,I   PICKUP NAM/VALUE
*******************************791119******************************** 
      STB TEMP2       AND INTEGER FLAG WORDS
      LDB ERRCD 
      SZB           ANY ERRORS? 
      CLA            YES - DON'T STORE RETURNED VALUES
      STA TEMP6 
      LDA TEMP2     IS THIS A FUNCTION
      SSA,RSS         RETURNING AN INTEGER
      JMP CAL12         NO
      LDA ABREG         YES,
      JSB FLOAT           FLOAT THE 
      DST ABREG             RESULT
CAL12 JSB CINIT     SET UP POINTER AND COUNTER
      JMP CA17A       FOR TRANSFER BACK 
      SKP 
CAL13 LDA TEMP6     MORE RETURNED PARAMETERS ?
      SZA,RSS 
      JMP CAL18       NO,FLUSH THE CLASS
      CLE,ERA         YES, FLAG -> E
      STA TEMP6 
      SEZ           RETURN THIS PARAMETER ? 
      JMP CAL14       YES 
      LDA TEMP2       NO, SHIFT 
      CLE,ERA           THE INTEGER 
      STA TEMP2           FLAG WORD 
      JMP CAL17             AND BYPASS CLGET
* 
CAL14 CLB           CLEAR POSTPROCESSING FLAG 
      STB TT3 
      JSB CADCK     SET UP TRANSFER ADDRESSES 
       JMP CAL15      REAL VARIABLE, GO TO CLGET
       NOP            INTEGER 
      STA TEMP8       OR STRING, STORE DESTINATION
      STB TEMP5         AND SOURCE POINTERS 
      CCB                 AND SET POSTPROCESSING
      STB TT3               FLAG
CAL15 JSB CLGET     GET A RECORD
      ISZ TT3       FURTHER PROCESSING
      JMP CAL17       NO
      LDA TEMP3       YES, IS THIS
      SSA,RSS           A STRING ?
      JMP CA16A           NO, INTEGER 
      STB RQ2       SAVE ACTUAL STRING LENGTH 
      LDB TT2       REVISE
      ADB .2          STRING HEADER TO
      LDB 1,I           CORESPOND TO ACTUAL 
      CMB 
      INB 
      LDA 1         IS
      CLE,ELA         THIS
      ADB M1            A 
      CPA TEMP5           SUB-STRING? 
      RSS           NO
      JMP CAL16     YES!
****REMOVED LABEL 'CAL20' 790820******* 
      LDA 1,I 
      AND HIMSK           STRING LENGTH 
      ADA RQ2               AS PASSED BACK FROM 
CAL21 STA 1,I                 SUBROUTINE
      LDA FSCHA           YES, TRANSFER IT
      JSB TRSTR 
      JMP CAL17 
* 
CAL16 LDA RQ2       SET SUBSTRING 
      CMA             TRANSFER
      STA TNULL         LENGTH
      LDA 1,I 
      JMP CAL21 
* 
* 
CA16A LDA TEMP8,I   FETCH AN INTEGER
      ISZ TEMP8 
      JSB FLOAT     FLOAT IT
      DST TEMP5,I     AND STORE FOR BASIC 
      ISZ TEMP5 
      ISZ TEMP5 
      ISZ TNULL     MORE TO DO ?
      JMP CA16A       YES 
* 
CAL17 JSB CSTEP     MORE PARAMETERS ? 
CA17A ISZ TT1 
      JMP CAL13       YES 
      SKP 
CAL18 JSB CFLUS     FLUSH & DEALLOCATE CLASS
      LDA TEMP7     RESTORE THE 
      STA HSTPT       HIGH STACK
      JSB ULWST     POP CALL ID OFF LOW STACK 
      LDA 1         WAS THIS
      AND OPMSK       A REAL
      CPA CALOP         SUBROUTINE ?
      JMP CAL19           YES 
      LDA ERRCD           NO
      SZA           ANY ERROR 
      JSB ERROR       IS A FATAL ERROR
E15   EQU *             IN A FUNCTION 
      JSB BHSTP 
      JSB RSCHK     MAKE ROOM ON
      DLD ABREG       TEMP STACK FOR RETURNED VALUE 
      ISZ TEMPS     STEP PAST RIGHT PARENTHESIS 
      JMP FOR12       AND CONTINUE WITH FORMULA 
* 
CAL19 ISZ HSTPT     POP FORMX RETURN OFF HIGH STACK 
      LDB ERRCD 
      SZB,RSS       ANY ERROR?
      JMP XEC4       NO, NEXT STATEMENT 
      CPB MNEG      FATAL ERROR FLAG ?
      JMP E15-1       YES 
      ISZ TEMPS 
      LDB PRADD       NO, CHECK FOR 
      CPB TEMPS          END OF STATEMENT?
      JMP E15-1      YES, ABORT 
      ISZ TEMPS      NO, SKIP FAIL: CODE
      LDB TEMPS     PRESET B IF THIS IS GOTO
      JMP SETSX      PROCESS REST OF STATEMENT
      SKP 
CLRW  NOP           THIS SUBROUTINE 
      JSB EXEC        WILL OUTPUT A 
       DEF *+8           SINGLE RECORD
       DEF .20            TO A CLASS
       DEF .0               FOR USE BY
       DEF TEMP9,I            THE OVERLAYS
       DEF TEMP3                IN THE FOREGROUND 
       DEF .0 
       DEF .0 
       DEF CLASS
      INA,SZA,RSS   A = -1 ?
      JMP CLERR       YES, NO MEMORY FOR THIS 
      INA,SZA,RSS   A = -2 ?
      JMP CLRW+1      YES, REPEAT REQUEST 
      JMP CLRW,I
* 
CLERR JSB CFLUS     FLUSH THE CLASS ON ERROR
      JMP E1          AND FLAG NO MEMORY
* 
CLGET NOP 
      JSB EXEC      GET A RECORD
       DEF *+5
       DEF .21        FROM THE
       DEF CLASS
       DEF TEMP9,I    SYSTEM
       DEF TEMP3
      JMP CLGET,I 
* 
CFLUS NOP 
      LDA CLASS 
      SZA,RSS 
      JMP CFLUS,I 
      LDA DMMYA 
      STA TEMP9 
      LDA .1
      STA TEMP3 
CFLS1 JSB CLGET 
      SSA,RSS       RECORD GOT? 
      JMP CFLS1      YES, GET ANOTHER 
      LDA CLASS 
      XOR BIT13 
      STA CLASS 
      JSB CLGET 
      CLA           ONE MORE TIME TO DEALLOCATE 
      STA CLASS 
      JMP CFLUS,I     & RETURN
* 
      SKP 
*                   THIS SUBROUTINE SETS UP ADDRESSES 
*              FOR TRANSFERS TO AND FROM CLASS
*              BUFFERS.   REAL VARIABLES ARE
*              TRANSFERED AS INDICATED IN THE 
*              DESCRIPTOR BLOCK ENTRY.
*              STRING VARIABLES ARE TRANSFERRED 
*              FIRST TO FREE SPACE BELOW THE HIGH 
*              STACK, AND THEN INTO THEIR PROPER
*              PLACE WITHIN THE STRING THEY CAME FROM 
*                THIS IS DONE SINCE EXEC DOES NOT 
*              TRANSFER CHARACTERS USING THE NORMAL 
*              CHARACTER ADDRESSING SCHEME. 
* 
CADCK NOP 
      LDA TEMP2     INTEGER FLAG
      CLE,ERA         GOES TO 
      STA TEMP2         E-REG 
      DLD TT2,I 
      STA TEMP3     RECORD LENGTH -> A
      STB TEMP9     BASE ADDR/CHAR ADDR -> B
      LDB TT2 
      ADB .2        IS THIS 
      LDB 1,I         A STRING? 
      SSB,RSS       STRING ?
      JMP CADC1       NO, GO CHECK INTEGER FLAG 
      ISZ CADCK       YES, TAKE THE 
      ISZ CADCK         P+3 EXIT
      CLB 
      RRR 8         (A)= PHYSICAL LENGTH
      BLF,BLF       (B)= LOGICAL LENGTH 
      STB RQ2       SAVE LOGICAL LENGTH 
      CMB,INB       IS PHYSICAL LENGTH
      ADB 0           LONGER OR EQUAL 
      SSB               TO LOGICAL lENGTH?
      LDA RQ2       NO, USE LOGICAL LENGTH
      CMA,INA           BECAUSE USER MAY HAVE 
      STA TEMP3           INLARGED IT 
      ADA M1
      STA TPRME 
      STA TNULL     SETUP FOR TRSTR AND FSCH
      ARS           CONVERT TO WORDS
      ADA M1
      ADA HSTPT       AND ASSIGN FREE SPACE 
      LDB TEMP9 
      STA TEMP9         AND RESET TRANSFER ADDRESS
      RAL           CONVERT TO CHAR ADDRESS 
      STA TT3 
      RAR             AND CHECK 
      JMP CADC2         FOR OVERFLOW
* 
CADC1 LDB TEMP9 
      SEZ,RSS       INTEGER ? 
      JMP CADCK,I     NO, TAKE P+1 EXIT 
      ISZ CADCK       YES, TAKE P+2 
      CMA,INA       TWOS COMPLEMENT WORDS 
      STA TNULL       FOR COUNTER 
      ADA HSTPT     ASSIGN FREE SPACE 
      STA TEMP9       AND RESET TRANSFER POINTER
      STA TT3 
CADC2 CMA,INA 
      ADA LSTPT     OVERFLOW INTO LOW STACK ? 
      SSA,RSS 
      JMP E1        OUT OF MEMORY 
      LDA TT3       RETURN WITH A = FREE SPACE POINTER
      JMP CADCK,I       AND B=STRING CHAR. ADDR.
      SKP 
CINIT NOP 
      LDA HSTPT,I 
      CMA 
      STA TT1       INIT COUNTER
      LDA HSTPT,I     AND 
      MPY .3           POINT TO 
      ADA HSTPT          DESCRIPTOR TRIPLET 
      ADA M2               FOR ARGUMENT #1
      STA TT2 
      JMP CINIT,I 
* 
CSTEP NOP 
      LDA TT2 
      ADA M3
      STA TT2 
      JMP CSTEP,I 
      SPC 5 
NAM   ASC 3,BSXXXX      *****CHANGED 790712******** 
CLASS NOP 
ERRCD BSS 1         MUST BE 
ABREG BSS 2          5 WORDS
SUB#  BSS 2           FOR RMPAR 
DMMYA DEF SUB#
CALOP OCT 50000 
HIMSK EQU M256
SCODE OCT 100027
BFIVE BSS 5         **791114**
DDCB  BSS 144       **791114**
BFIV  DEF BFIVE     **791114**
MOVE  NOP           **791114**
LEN   NOP           **791114**
B10   OCT 10
B11   OCT 11
      SKP 
******************
*                *
* EXECUTE  WAIT  *
*                *
******************
EWAIT NOP 
      ISZ TEMPS     POINT (TEMPS) TO FORMULA
      JSB FETCH     FETCH EVALUATED FORMULA 
      SSA           NEGATIVE
      JMP XEC4      YES 
      JSB IFIX          CONVERT TO INTEGER
      SOC           LARGE INTEGER 
      LDA MNEG      YES 
      CMA           NO
      STA TEMP2     SAVE COUNT (<0) 
      ADA .74         AND CHECK FOR 
      SSA,RSS           SHORT WAIT
      JMP COUNT           GO COUNT FOR < 75 MS
      CCB 
      LDA TEMP2 
      DIV .10       TENS OF MILLISECONDS
      STA TEMP2 
      JSB EXEC      CALL SYSTEM 
      DEF *+6         FOR DELAY 
      DEF .12 
      DEF .0              THIS PRGRM
      DEF .1                BY 10'S OF MS 
      DEF .0                  ONLY ONCE 
      DEF TEMP2                 FOR THIS LONG 
      JMP XEC4      ABANDON REMAINDER(SYSTEM UNCERTAINTY) 
* 
COUNT LDA TEMP2     RECOVER COUNT 
EWAI1 INA,SZA,RSS   WAIT? 
      JMP XEC4      NO! 
      LDB M280      YES SET INNER LOOP
      INB,SZB       MORE? 
      JMP *-1       YES!
      JMP EWAI1     NO! 
      SKP 
**********************
*                    *
*   EXECUTE RETURN   *
*                    *
**********************
ERTRN LDB LSTPT     RETURN STACK
      CPB LSTAK       EMPTY?
      JSB ERROR     YES. ERROR 55.
E3    LDA LSTPT,I   NO, LOAD RETURN ADDRESS 
      ADB M1        RESET 
      STB LSTPT       STACK POINTER 
      SSA,RSS       IF NEGATIVE STMT NUMBER,
      JMP XEC43 
      STA 1         THIS IS RETURN FROM SCHED TASK. 
      LDA M256      HANDLED BY SPECIAL HOOK 
      JSB TRAP     IN TRAP ROUTINE. 
      JMP TRERR     ERROR 
      JSB FNDPS     GET STMT ADDRRESS 
      JMP E12-1     NOT FOUND 
      JMP E12-1     NOT FOUND 
      LDA 1 
      JMP EGOS3     GOTO RETURN ADDR
      SKP 
* 
* 
**  EXECUTE READ  **
* 
EREAD LDA HSTPT     SAVE HI STK PTR IN CASE 
      STA HTEMP       END-OF-FILE EXIT
      JSB VLFIL     LOOK FOR FILE REQUEST 
      JMP EREA4     READ FROM LU OR DATA STMT?
      JMP EOFCK     END OF FILE 
      LDB TEMPS     FILE REQUEST; OK TO READ
EREA1 CPB PRADD     END-OF-STATEMENT? 
      JMP XEC4      YES 
      JSB FORMX     NO, EVALUATE NEXT ADDRESS 
      LDA HSTPT,I   RECORD ADDRESS
      SSA            STRING VARIABLE? 
      JMP EREA2     YES!
      STA OUTLN 
      CLB,INB 
      JSB FDATA     GET DATA ITEM 
      STA OUTLN,I   STORE 
      ISZ OUTLN       DATA
      STB OUTLN,I       ITEM
      ISZ HSTPT 
EREA3 LDB TEMPS 
      INB 
      JMP EREA1 
      SPC 1 
EREA2 LDB .2        PREPARE 
      JSB FDATA       SOURCE STRING 
      CCA           PREPARE 
      JSB PSTR        DESTINATION STRING
      LDA FSCHA 
      JSB TRSTR     TRANSFER STRING 
      JMP EREA3 
* 
EREA4 LDA FILE#     IS THIS A 
      CPA M1000       READ FROM A DATA STMT?
      JMP EREA1-1   YES!
      JMP EINPT   NO, READ FROM LU
* 
* 
**
***  SEARCH FOR STATEMENT OF GIVEN TYPE  ** 
**
STSRH NOP           TYPE IN (A), ADDRESS IN (B) 
      AND OPMSK     (77000) EXTRACT STMT TYPE 
      STA TEMP4 
STSR1 CPB PBPTR     PAST LAST STATEMENT?
      JMP STSRH,I   YES 
      LDA 1         EXTRACT 
      ADA .2          PROGRAM 
      LDA 0,I           STATEMENT 
      AND OPMSK           TYPE
      CPA TEMP4     DESIRED TYPE? 
      JMP STSR2     YES 
      LDA 1         NO, FETCH 
      INA             STATEMENT LENGTH
      ADB 0,I       COMPUTE NEW ADDRESS 
      JMP STSR1 
* 
STSR2 ISZ STSRH     FOUND IT, SKIP RETURN 
      JMP STSRH,I 
* 
**
***  SET POINTER TO START OF DATA STATEMENT  ** 
**
SETDP NOP           STATEMENT ADDRESS IN (B)
      INB           LOAD
      LDA 1,I         STATEMENT LENGTH
      CMA,INA       SET 
      INA             DATA COUNTER
      STA DCCNT         TO 1-STATEMENT LENGTH 
      INB           SET 'NEXT DATA' POINTER ONE 
      STB NXTDT       WORD ABOVE FIRST CONSTANT 
      JMP SETDP,I 
      SPC 1 
SETPT NOP 
      LDB SYMTF     INITIALIZE
      STB HSTPT       POINTERS TO 
      LDB FCORE          'HIGH CORE' STACK, 
      STB TSTPT 
      ADB .23 
      STB LSTAK              AND 'LOW'
      STB LSTPT                   STACK 
      CMB           DO
      ADB HSTPT       STACKS
      SSB               MEET? 
      JMP E1        YES 
      LDB PBUFF     BEGIN 
      JMP SETPT,I     EXECUTION 
      SKP 
***************************************** 
*                                       * 
*   SUBROUTINE FOR EXECUTION OF         * 
*     TRACE AND BREAKPOINT              * 
*                                       * 
***************************************** 
* 
TRACE NOP 
      LDB 0,I       GET ACTUAL STMT NUMBER
      STB .LNUM 
      LDA SLSTM     IS TRACE ENABLED ?
      SZA,RSS 
      JMP TRAC3       NO! 
      CLB             YES, DISABLE TRACE BRKPNT FLAG
      STB SLSTM 
      CPA M1        RETURN FROM SEG 7 BRKPNT? 
      JMP TRACE,I     YES, INHIBIT BRKPNT 
* 
TRAC3 LDA .LNUM     IF
      CPA BRKP1       THIS STATEMENT
      JMP BREAK 
      CPA BRKP2         MATCHES ANY 
      JMP BREAK 
      CPA BRKP3           OF THE
      JMP BREAK 
      CPA BRKP4             BREAKPOINTS 
      JMP BREAK               THEN BREAK !
      CMA,INA       CHECK IF THIS STATEMENT 
      ADA HITRC       IS TO BE
      SSA               TRACED
      JMP TRAC2           NO
      LDA LOTRC           MAYBE 
      CMA,INA 
      ADA .LNUM 
      SSA 
      JMP TRAC2           NO
      LDA .8              YES 
      STA OCCNT     PRINT 
      LDA LNBFA 
      STA OTBFA       "*TRACE"
      LDA .LNUM           & 
      JSB OUTIN           LINE NUMBER 
      LDA OCCNT 
      LDB TRMSA 
      JSB WRITE 
TRAC2 LDA .LNUM 
      CMA,INA       IS THIS 
      ADA HIRUN       THE END 
      SSA               OF THIS RUN ? 
      JMP EEND            YES 
      JMP TRACE,I         NO
* 
BREAK LDA .2        EXECUTE 
      JMP SEG7        BREAKPOINT
* 
      SKP 
**
***  ALLOT SPACE FOR INTERMEDIATE RESULT  **
**
RSCHK NOP 
      LDA TSTPT     ALLOT 
      ADA .2
      STA TSTPT       SPACE 
      ADA M1        OVERFLOW INTO 
      CPA LSTAK       LOW-CORE STACK? 
      RSS           YES 
      JMP RSCHK,I   NO
      LDA LSTAK     SAVE
      INA             LOWER 
      STA TEMP3         STACK BOUND 
      ADA .9        UPDATE
      STA LSTAK       STACK BOTTOM
      LDA LSTPT     SET 
      INA             SOURCE
      STA TEMP2         ADDRESS 
      ADA .9        UPDATE
      STA LSTPT       STACK TOP 
      INA           SET DESTINATION 
      STA TEMP4       ADDRESS 
      CMA,INA       OVERFLOW
      ADA HSTPT       INTO
      SSA               HIGH-CORE STACK?
      JMP E1        YES. ERROR 57.
      JSB MVTOH     NO, MOVE
      JMP RSCHK,I     LOW-CORE STACK
      SKP 
**
***  BUMP HIGH STACK POINTER  **
**
BHSTP NOP 
      CCB           ADVANCE 
      ADB HSTPT 
      STB HSTPT       POINTER 
      CPB LSTPT     OVERFLOW? 
      JMP E1        YES 
      JMP BHSTP,I   NO
**
***  VERIFY LEGITIMACY OF OPERAND  ** 
**
OPCHK NOP 
      LDB HSTPT,I   OPERAND ADDRESS TO (B)
      SSB           STRING OPERAND? 
      JMP OPCH2     YES 
      LDA 1,I       HIGH PART OF
      CPA MNEG        OPERAND 100000B?
      INB,RSS       YES 
      JMP OPCH1     NO; OK. 
      LDA 1,I       IS LOW PART OF OPERAND 376B?
      CPA B376
      JSB ERROR     YES. VALUE NOT DEFINED. (50)
E8    ADB M1
OPCH1 CPB TSTPT     TEMPORARY?
      JMP OPCH3     YES 
      JMP OPCHK,I 
OPCH2 CMB,INB       SET ADDRESS TRUE
      ISZ HSTPT     UNSTACK OPERAND 
OPCH3 LDA TSTPT     UNSTACK TEMP STACK
      ADA M2
      STA TSTPT 
      JMP OPCHK,I 
      SKP 
* 
* 
**************************
*                        *
**  EVALUATE A FORMULA  **
*                        *
**************************
* 
FORMX NOP           FORMULA BEGINS IN (TEMPS) 
      CLB           INITIALIZE OPERATOR 
      JSB SLWST       STACK 
FORM1 LDA TEMPS,I   FETCH OPERAND 
      ISZ TEMPS     SET FOR NEXT WORD OF FORMULA
      AND OPDMK     (100777) EXTRACT OPERAND
      STA TEMP5         AND SAVE IT 
      SZA,RSS       NULL OPERAND? 
      JMP FORM2     YES 
      JSB BHSTP     SET STACK FOR OPERAND ADDRESS 
      SSA           FLAG BIT SET? 
      JMP FORM4     YES 
      JSB SSYMT     FETCH OPERAND ADDRESS 
      INB,SZB,RSS   EXISTANT? 
      JMP E8-1      NO. ERROR 50. 
      AND .15       YES 
      CPA .15       USER DEFINED FUNCTION?
      JMP FORM6     YES 
      STB HSTPT,I   NO
      LDB 1,I       LOAD PTR TO VALUE 
      SZA           STRING VARIABLE?
      JMP FORM2     NO! 
      LDA TEMPS,I   YES 
      AND OPMSK     FOLLOWED BY 
      CPA LBOP        SUBSCRIPT?
      JMP FORM2-2   YES!
      STB TEMP8     NO! 
      JSB RSCHK     CREATE TEMPORARY 
      CLA             RECORD
      CCB 
      DST TSTPT,I   (0,-1)
      LDB TEMP8     RETRIEVE AND
      CMB,INB         NEGATE STRING ADDRESS 
      STB HSTPT,I   STACK OPERAND ADDRESS 
FORM2 LDA TEMPS,I   FETCH 
      AND OPMSK       OPERATOR
      ALF,ALF       POSITION IT 
      CPA .2        STRING CONSTANT?
      JMP FORM3     YES!
FORM8 RAR 
      LDB 0         LOAD ADDRESS OF 
      ADB FOPBS       OPERATOR'S INFORMATION WORD 
      ADA M4        NON-FORMULA 
      SSA             OPERATOR? 
      CLB           YES 
      ADA D33      NO, NON-FORMULA
      SSA,RSS         OPERATOR? 
      CLB           YES 
      CLA           NO
      LDA 1,I       LOAD INFORMATION WORD 
      AND B777      SAVE
      STA TEM10        PRECEDENCE 
      XOR 1,I       RECOVER OPR NO. 
      ARS 
      STA TEMP5         IDENTIFICATION
      JMP FOR11 
* 
*         EVALUATION ROUTINES RETURN VALUE HERE.
* 
FORM0 DST TSTPT,I   STACK HIGH WORD 
      LDA TSTPT     STACK OPERAND 
      STA HSTPT,I     ADDRESS 
FOR11 LDA LSTPT,I   DOES OPERATOR 
      AND B377        ON TOP OF 
      CMA               OPERATOR STACK
      ADA TEM10            HAVE HIGHER
      SSA                   PRECEDENCE? 
      JMP FORM9               YES, EXECUTE IT 
      RSS 
* 
FOR10 ISZ LSTPT 
      LDB TEM10      RETRIEVE PRECEDENCE
      ADB M15       NO, LEFT PARENTHESIS
      SSB             OR LEFT BRACKET?
      ADB .15       NO, RESTORE PRECEDENCE
      ADB TEMP5       COMBINE IDENTIFICATION
      JMP FORM1-1     WITH PRECEDENCE AND STACK 
      SKP 
* 
***************************** 
*                           * 
*  PROCESS STRING CONSTANT  * 
*                           * 
***************************** 
* 
*  WHEN STRING CONSTANTS ARE STACKED, AN APPROPRIATE
*  ENTRY IS PLACED ON THE TEMPORARY STACK SO THAT ALL 
*  STRING OPERANDS HAVE THE SAME FORM:  A NEGATED BASE
*  ADDRESS ON THE OPERAND STACK AND A TWO WORD ENTRY ON 
*  THE TEMPORARY STACK CONTAINING THE START-OF-STRING 
*  AND END-OF-STRING DESIGNATORS BIASED BY -1 (DEFAULT
*  START-OF-STRING DESIGNATORS HAVE A STACK VALUE OF 0, 
*  DEFAULT END-OF-STRING DESIGNATORS HAVE S STACK VALUE 
*  OF -1).  IN THE CASE OF SUBSCRIPTED STRING VARIABLES,
*  THE TEMPORARY IS CREATED WHEN THE ']' IS SCANNED  THE
*  ENTRY FOR NON-SUBSCRIPTED STRING OPERANDS IS CREATED 
*  WHEN THEY ARE SCANNED. 
* 
FORM3 CLA,INA       PRINT STATEMENT 
      CPA STRFG       STRING CONSTANT?
      JSB STSTR     NO,STACK STRING CONSTANT! 
      JMP FORM8     EXECUTE END OF FORMULA
* 
FORM4 CPA FLGBT     CONSTANT? 
      JMP FORM5     YES 
      AND .15       NO
      CPA .15       PRE-DEFINED FUNCTION? 
      JMP FORM7     YES 
      LDB TEMP8        NO, MUST BE A
      JMP FORM2-1     PARAMETER 
* 
FORM5 LDB TEMPS     LOAD CONSTANT ADDRESS 
      ISZ TEMPS     MOVE POINTER TO 
      ISZ TEMPS       NEXT CODE WORD
      JMP FORM2-1 
* 
*     HERE FOR USER-DEFINED FUNCTION (FNA, FNB, ETC.) 
* 
FORM6 STB TEMP5       SAVE SYMBOL TABLE POINTER 
      LDB TSTPT     SAVE CURRENT POINTER
      JSB SLWST       TO TEMPORARY STACK
      LDB TEMP5,I 
      JSB SLWST     SAVE FUNCTION ADDRESS 
      LDA FORMX     SAVE CURRENT
      STA HSTPT,I     FORMX RETURN ADDRESS
      JSB FORMX     EVALUATE THE PARAMETER
      ISZ TEMPS     UPDATE FORMULA POINTER
      ISZ TEMPS       PAST RIGHT PARENTHESIS
      LDA TEMPS     SWITCH
      LDB LSTPT,I     FORMULA POINTER 
      STB TEMPS       TO FUNCTION'S 
      STA LSTPT,I       FORMULA 
      LDB TEMP8        SET
      LDA HSTPT,I     PARAMETER POINTER 
      ISZ LSTPT         TO NEW PARAMETER, 
      ISZ HSTPT           SAVING PREVIOUS 
      STB LSTPT,I           SETTING ON
      STA TEMP8                  LOW-CORE STACK 
      CPA TSTPT     PROTECT PARAMETER IF
      JSB RSCHK     ON TEMPORARY STACK
      JSB FORMX     EVALUATE FUNCTION 
      LDA LSTPT,I   RESTORE OLD 
      STA TEMP8          PARAMETER POINTER
      LDA LSTPT     CUT BACK
      ADA M3          LOW-CORE
      STA LSTPT         STACK 
      INA           RESTORE ORIGINAL
      LDB 0,I         TEMPORARY STACK 
      STB TSTPT         POINTER 
      INA           RESTORE 
      LDB 0,I         ORIGINAL
      STB TEMPS         FORMULA POINTER 
      JSB STTOP     POP RESULT
FOR12 DST TSTPT,I   STORE HIGH WORD 
      ISZ HSTPT 
      LDB HSTPT,I   RESTORE FORMX 
      STB FORMX       RETURN ADDRESS
      LDA TSTPT     STACK ADDRESS 
      STA HSTPT,I     OF RESULT 
      JMP FORM2 
* 
*     HERE FOR PREDEFINED FUNCTION (SIN, ETC.)
* 
FORM7 LDA TEMP5       OPERAND IDENTIFIES FUNCTION 
      CPA FRMSK     FORTRAN FUNCTION? 
      JMP FCALL     YES!
      RRR 4 
      AND .31       FUNCTION OFFSET 
      ALS           MULT BY 2 FOR OFFSET IN BR TBL
      LDB 0         MOVE TO B FOR SLWST 
      JSB SLWST     STACK CALL NUMBER 
      LDA FORMX     SAVE CURRENT
      STA HSTPT,I     FORMX RETURN ADDRESS
      JSB FORMX     EVALUATE THE PARAMETER
      ISZ TEMPS     UPDATE FORMULA POINTER
      ISZ TEMPS       PAST RIGHT PARENTHESIS
      JSB ULWST     POP FUNCT # OFF LOW STACK 
* 
      CLA           SET INST. FOLLOWING FUNCT. CALL 
      STA SKIPE      TO NOP 
      LDA AFCNX 
      RSS           PEEL
      LDA 0,I           OFF 
      RAL,CLE,SLA,ERA       INDIRECTS 
      JMP *-2 
      ADB 0           ENTRY IN THE BRANCH TABLE 
      DLD 1,I       A = WORD THAT INDICATES 
      STA SKIPE     'RSS' OR 'NOP' FOR ERROR
      STB FADRS      B=ADDRESS OF FUNCTION
      LDA HSTPT,I   IS THIS A 
      SSA             STRING VARIABLE?
      JMP FOR13     YES!
      LDA FADRS 
      AND MCMSK 
      CPA B105K     MICROCODED ROUTINE? 
      RSS           YES!
      JMP EXSUB     NO! 
      LDB FADRS 
      STB EXFUN     SET UP TO EXECUTE MICROCODE FUNCTION
      JSB STTOP     GET THE ARGUMENT OF THE FUNCTION
EXFUN JSB FADRS,I   EXECUTE THE FUNCTION!!! 
SKIPE NOP            MODIFIED TO AN 'RSS' IF ERROR RETURN 
      JMP FOR12     FUNCTION EXECUTION COMPLETE 
      JSB ERROR     THERE WAS AN ERROR
FNERR EQU * 
* 
* 
EXSUB LDB FINST     RESTORE 'JSB' INSTRUCTION 
      STB EXFUN 
      JMP EXFUN-1 
* 
FADRS NOP           FUNCTION ADDRESS GOES HERE
FINST NOP            SAVED 'JSB FUNCT' HERE 
MCMSK OCT 177000    MICROCODE MASK
B105K OCT 105000    MICROCODE OP
* 
      SPC 1 
*  LENGTH FUNCTION (LEN)
      SPC 1 
FOR13 LDA HSTPT,I   GET STRING LENGTH 
      CMA,INA         AND CONVERT 
      ADA M1          TO FLT PT 
      LDA 0,I 
      AND B377
      JSB FLOAT     FLOAT STRING LENGTH 
      JMP FOR12 
* 
* 
*     HERE TO EXECUTE AN OPERATOR (+, *, ETC.)
* 
FORM9 LDA LSTPT,I   EXECUTE OPERATOR; UNSTACK 
      CCB             OPERATOR
      ADB LSTPT         INFORMATION 
      STB LSTPT           WORD
      ALF,ALF       COMPUTE 
      AND B177        SUBROUTINE
      SZA,RSS       END FORMULA?
      JMP FORMX,I   YES, EXIT 
      ADA ARBAS     GET ADDRESS 
      JMP 0,I       EXECUTE 
* 
*************************** 
*                         * 
*    FETCH TOP OF STACK   * 
*                         * 
*************************** 
**
STTOP NOP 
      JSB OPCHK     VALIDATE
      JSB RSCHK       OPERAND 
      LDB HSTPT,I   SAVE
      DLD 1,I       LOAD
      JMP STTOP,I 
      SKP 
******************************* 
*                             * 
* STACK (B) ON LOW CORE STACK * 
*                             * 
******************************* 
SLWST NOP 
      ISZ LSTPT 
      LDA LSTPT 
      CPA HSTPT     STACK OVERFLOW
E1    JSB ERROR     YES 
      STB LSTPT,I 
      JMP SLWST,I 
* 
************************************
*                                  *
**  UNSTACK LOW CORE STACK ON (A) **
*                                  *
************************************
* 
ULWST NOP 
      LDB LSTPT,I   POP 
      CCA             STACK 
      ADA LSTPT 
      STA LSTPT 
      JMP ULWST,I 
* 
*************************** 
*                         * 
*  STACK STRING CONSTANT  * 
*                         * 
*************************** 
* 
STSTR NOP 
      JSB BHSTP     SET STACK FOR OPERAND 
      LDA TEMPS     STACK NEGATIVE
      CMA             OF STRING 
      STA HSTPT,I       ADDRESSES 
      LDA TEMPS,I   COMPUTE 
      AND B377        STRING
      CCB                 LENGTH
      ADB 0                 -1
      ADA .3        UPDATE
      ARS             INTRA-STATEMENT 
      ADA TEMPS         POINTER 
      STA TEMPS       PAST STRING 
      JSB RSCHK     CREATE TEMPORARY
      CLA           RECORD
      DST TSTPT,I     (0,(B)) 
      JMP STSTR,I 
      SKP 
* 
****************************
*                          *
*  PREPARE STRING OPERAND  *
*                          *
****************************
* 
*  THE STRING ADDRESS ON TOP OF THE OPERAND STACK IS COMBINED 
*  WITH THE SUBSCRIPTS IN A PSUEDO-ENTRY ON THE TEMPORARY STACK 
*  TO FORM A STRING OPERAND. (A)=-2 UPON ENTRY FOR A SOURCE 
*  STRING            (A)=-1 FOR A DESTINATION STRING. THE ADDRESS OF
*  THE FIRST CHARACTER OF THE STRING OPERAND IS LEFT IN TEMPS+5 
*  FOR SOURCE STRINGS (A)= TEMPS+5 UPON EXIT. THE SOURCE
*  STRING LENGTH IN CHARACTERS (1'S COMPLEMENT) IS IN (B) 
*  UPON EXIT.  THE FOLLOWING
*  CONDITIONS EXIT TO ERROR:  NEGATIVE STRING LENGTH, REQUESTED 
*  DESTINATION STRING WOULD EXCEED PHYSICAL STRING BOUNDARY, OR 
*  REQUESTED DESTINATION STRING WOULD PRODUCE A STRING QUANTITY 
*  WITH TWO UNCONNECTED PARTS. THE LOGICAL LENGTH OF A
*  DESTINATION STRING IS ADJUSTED AS NEEDED.
* 
PSTR  NOP 
      STA PS0       SAVE MODE FLAG
      JSB OPCHK     UNSTACK OPERAND 
      STB PS1       SET FLAG POSITIVE 
      CLE,ELB       SAVE ADDRESS OF FIRST 
      STB TEMP5       CHARACTER OF STRING 
      ERB           SAVE
      ADB  M1         POINTER TO
      STB TEMP6         STRING LENGTH 
      LDB TSTPT     LOAD
      ADB .2          START-OF-STRING 
      LDA 1,I           DESIGNATOR
      STA MPT       SAVE IT 
      ADA TEMP5     RECORD CHARACTER ADDRESS
      STA TEMP5       OF START-OF-STRING
      STA SBPTR     SAVE ADDRESS
      INB           LOAD
      LDA 1,I         END-OF-STRING DESIGNATOR
      INA,SZA       SPECIFIED?
      JMP PSTR2     YES 
      CCA           NO
      CPA PS0       'SOURCE' MODE?
      JMP PSTR1     NO
      LDA TEMP6,I   YES LOAD STRING'S 
      AND B377        LOGICAL LENGTH
      JMP PSTR2 
* 
PSTR1 STA PS1       SET FLAG TO -1
      LDA TPRME     COMPUTE 
      CMA             END-OF-STRING 
      ADA MPT           DESIGNATOR
PSTR2 STA NQT       SAVE IT 
      CMA           IS LENGTH 
      ADA MPT         OF SPECIFIED STRING 
      SSA,RSS           NEGATIVE? 
      JSB ERROR     YES 
STER1 STA TNULL 
      ADA B400      NO
      SSA           >255
      JMP STER3-1   STRING OVERFLOW 
      LDA TEMP6,I   DOES
      AND B377        START-OF-STRING 
      CMA               CHARACTER 
      ISZ PS0             RELATE TO 
      INA                   PREVIOUS
      ADA MPT                 VALUE 
      SSA,RSS                   OF STRING 
      JMP PSTR3     NO
      LDA TEMP6,I   YES,EXTRACT 
      ISZ PS0         END-OF- 
      ALF,ALF           PERMITTED-STRING
      AND B377            DESIGNATOR
      CMA           COMPUTE DIFFERENCE FROM 
      ADA NQT         END OF SPECIFIED STRING -1
      CLB,INB       'SOURCE'
      CPB PS0  MODE?
      JMP PSTR5     NO
      LDB TNULL     YES,SPECIFIED SOURCE STRING 
      INA             CONTAINED WITHIN
      SSA,RSS           DEFINED SOURCE STRING 
      ADB 0         NO, CORRECT LENGTH
      JMP PSTR4       OF ACTUAL SOURCE STRING 
* 
PSTR3 ISZ PS0       'SOURCE' MODE?
      JSB ERROR     NO, NON-CONTIGUOUS STRING 
STER2 CCB           YES SET ACTUAL LENGTH TO 0
PSTR4 LDA TEMP5     LOAD START-OF-STRING
      JMP PSTR,I      CHARACTER ADDRESS 
PSTR5 SSA,RSS       PHYSICAL STORAGE OVERFLOW?
      JSB ERROR     YES, STRING OVERFLOW
STER3 ISZ PS1       END-OF-STRING SPECIFIED?
      JMP PSTR7     YES 
* 
PSTR6 LDA TEMP6,I   NO
      AND M256      RESET 
      IOR NQT       LOGICAL LENGTH
      STA TEMP6,I     OF STRING 
      JMP PSTR,I
* 
PSTR7 LDA TEMP6,I   IS NEW
      AND B377        DESTINATION 
      CMA               STRING
      ADA NQT             LONGER
      SSA,RSS               THAN OLD? 
      JMP PSTR6     YES 
      JMP PSTR,I
* 
PS0   BSS 1 
MPT   BSS 1 
PS1   BSS 1 
NQT   BSS 1 
TRS0  BSS 1 
*********************** 
*                     * 
*  TRANSFER A STRING  * 
*                     * 
*********************** 
* 
*  THE NUMBER OF CHARACTERS SPECIFIED BY TNULL (IN 1'S
*  COMPLEMENT) IS TRANSFERRED FROM THE SOURCE STRING TO 
*  A DESTINATION STRING BEGINNING WITH THE CHARACTER
*  ADDRESSED BY TEMP5.
* 
TRSTR NOP 
      STA TRFCH     SAVE FETCH CHAR ROUTINE ADDR
      ISZ TNULL     MORE TRANSFER STRING? 
      RSS           YES 
      JMP TRSTR,I   NO
      JSB TRFCH,I   FETCH A SOURCE CHARACTER
      LDA B40       NONE LEFT,LOAD A BLANK
      STA TRS0      SAVE IT 
      LDB TEMP5     LOAD
      CLE,ERB         DESTINATION 
      LDA 1,I           WORD
      SEZ,RSS       SAVE
      ALF,ALF         OTHER 
      AND M256          CHARACTER 
      IOR TRS0      COMBINE WITH
      SEZ,RSS         NEW CHARACTER 
      ALF,ALF           AND STORE 
      STA 1,I             WORD
      ISZ TEMP5     INCREMENT DESTINATION ADDRESS 
      JMP TRSTR+2 
* 
****************************
*                          *
*  FETCH CHARACTER STRING  *
*                          *
****************************
* 
*  CHARACTER ADDRESS IN TEMP8, SOURCE CHARACTER COUNT 
*  IN TPRME (IN 1'S COMPLEMENT). EXIT TO (P+1) ON NO
*  MORE CHARACTERS (TPRME = -1) ELSE EXIT TO (P+2) WITH 
*  NEXT CHARACTER IN (A). 
* 
FSCH  NOP 
      LDA TPRME     MORE CHARACTERS?
      INA,SZA,RSS 
      JMP FSCH,I
      STA TPRME     YES, UPDATE CHARACTER COUNT 
      LDA TEMP8     LOAD CHARACTER
      CLE,ERA         ADDRESS 
      LDA 0,I       EXTRACT 
      SEZ,RSS         NEXT CHARACTER
      ALF,ALF 
      AND B377
      ISZ TEMP8     UPDATE CHARACTER ADDRESS
      ISZ FSCH
      JMP FSCH,I
* 
*************************** 
*                         * 
*  FETCH INPUT CHARACTER  * 
*                         * 
*************************** 
* 
*  EXITS NORMALLY TO (P+2) WITH NEXT INPUT CHARACTER IN (A).
*  IF THE CHARACTER IN (A) IS A QUOTE OR THE INPUT RECORD IS
*  EMPTY, EXIT TO TRSTR,I ( THE ONLY CALLER THAT CAN ENCOUNTER
*  THE SITUATION ). 
* 
FINCH NOP 
      ISZ FINCH 
      JSB GETCR     FETCH NEXT CHARACTER
      JMP FINC1     END-OF-INPUT
      CPA B42       QUOTE?
      JMP TRSTR,I   YES!
      JMP FINCH,I 
FINC1 LDA .10       SET END-OF-INPUT
      JMP TRSTR,I 
* 
**********************
*                    *
*  CHECK FOR ENOUGH  *
*                    *
**********************
* 
OVCHK NOP           NEW WORD REQUIREMNET IN (A) 
      ADA PBPTR     CHECK 
      STA PBPTR 
      CMA             FOR 
      ADA LWBM          OVERFLOW
      SSA,RSS 
      JMP E1        OUT OF STORAGE
      JMP OVCHK,I 
      SKP 
* 
******************************
*                            *
* ROUND SUBSCRIPT TO INTEGER *
*                            *
******************************
SBFIX NOP           SUBSCRIPT IN (A) AND (B)
      JSB .FAD      SET FOR ROUNDING
       DEF HALF 
      JSB IFIX      CONVERT TO INTEGER
      SOC           WAS IT INTEGER? 
      JMP SBFIX,I   NO
      ADA M1        YES, BIAS BY -1 
      SSA,RSS       POSITIVE INTEGER? 
      ISZ SBFIX     YES 
      JMP SBFIX,I   NO
********************
*                  *
* INPUT A CONSTANT *
*                  *
********************
CONST NOP 
      JSB GETCR 
      JMP CONST,I 
      CLB           SET SIGN
      STB SIGN        POSITIVE
      INB 
      CPA .43       '+' ? 
      JMP CONS1     YES 
      CPA .45       NO, '-' ? 
      CCB,RSS       YES 
      JMP CONS2     NO
CONS1 STB SIGN      RECORD SIGN 
      JSB GETCR     FETCH NEXT
      JMP E13-1       CHARACTER 
CONS2 JSB NUMCK     FETCH CONSTANT
      JMP CONS3     NONE FOUND
      JSB ERROR     BAD EXPONENT PART 
E14   ISZ CONST     SUCCESSFULLY FOUND
      JMP CONST,I     EXIT VIA (P+2)
CONS3 CPB SIGN      SIGN FOUND? ( (B) = 0)
      CCA,RSS       NO
      JSB ERROR     YES, SOLITARY SIGN
E13   JMP CONST,I   EXIT VIA (P+1)
      SKP 
**********************
*                    *
**  COMPUTE RND(X)  **
*                    *
**********************
* 
* THE RANDOM NUMBER FUNCTION COMPUTES A RANDOM NUMBER FROM THE
* FORMULAS: 
* 
*     X(N)=A*X(N-1)+C(MOD 2^30)     (A=5^11,C=2^30*(1/2-1/SQR(12))) 
*     RND =X/2^30 MIN (1-2^-23) 
* 
ERND  NOP 
      SSA,RSS       POSITIVE ARGUMENT?
      JMP ERND1     YES, USE PREVIOUS VALUE 
      RBL,CLE,ERB   NO, MAKE A
      ELA 
      STA RNDX1       A NEW SEED
      STB RNDX2 
ERND1 EQU * 
      LDA RNDX1     COMPUTE FIRST 
      MPY RNDA2      CROSS PRODUCT. 
      STA RNDX1     SAVE (ONLY NEED LOW ORDER PART) 
      LDA RNDX2     COMPUTE 2ND 
      MPY RNDA1       CROSS PRODUCT.
      ADA RNDX1     ADD IN FIRST. 
      ADA RNDC1     ADD IN HIGH PART OF C.
      STA RNDX1     SAVE TOTAL. (THIS IS HIGH PART).
      CLE 
      LDA RNDX2     COMPUTE LOW ORDER PRODUCT.
      MPY RNDA2 
      ADA RNDC2     ADD IN LOW PART OF C. 
      SEZ           ADD ANY CARRY INTO
      INB            B. 
      RAL,CLE,ERA   E_A(15),A(15)_0.
      STA RNDX2     SAVE LOW ORDER RESULT.
      ELB           SHIFT HIGH ORDER PART & ADD IN
      ADB RNDX1      PREVIOUS TOTAL.
      ELB,CLE,ERB   CLEAR BIT 15 AND STORE. 
      STB RNDX1 
      RAL           SHIFT A ADJACENT TO B.
      SWP           EXCHANGE REGISTERS AND
      JSB .PACK      PACK.
      NOP 
      CPB .2        TEST FOR RESULT=1.0 
      RSS 
      JMP ERND,I    EXIT IF NOT.
      LDA INF       SET RESULT TO 1-2^-23 
      LDB M256
      JMP ERND,I
RNDA1 DEC 1490      A DIV 2^15
RNDA2 DEC 3805      A MOD 2^15
RNDC1 OCT 16441     C DIV 2^15
RNDC2 OCT 7701      C MOD 2^15
RNDX1 BSS 1 
RNDX2 BSS 1 
      SKP 
***** 
* 
** OCT ** BASIC FUNCTION TO CONVERT INTEGER FOR 
*         OCTAL OUTPUT.  ACTUALLY CONVERTS INTEGER
*         TO FLOATING POINT QUANTITY WHICH WILL 
*         PRINT OUT AS OCTAL VALUE
* 
* CALLING SEQUENCE: 
* 
*     DLD  FLOATING EQUIVALENT OF INTEGER 
*     JSB OCT 
*     RETURN (FLOATING PT VALUE IN .A.8.B.) 
* 
***** 
* 
OCT   NOP 
      JSB IFIX      CONVERT TO INTEGER
      LDB M5        INITIALIZE
      STB CNTR       DIGIT COUNTER
      LDB ATBL      INITIALIZE POINTER
      STB TEMP3       TO DIGIT TABLE
      STA 1         MOVE INTEGER TO .B. 
      RBL           USE SIGN BIT
      CLA            AS VALUE 
      SLB             FOR FIRST 
      INA              DIGIT IN 
      STA TEMP3,I        TABLE
OCT01 BLF,RBR       POSITION NEXT OCTAL DIGIT 
      LDA 1 
      AND .7        AND ISOLATE IT IN .A. 
      ISZ TEMP3      BUMP POINTER TO TABLE
      STA TEMP3,I     AND MAKE ENTRY
      ISZ CNTR      BUMP COUNTER, MORE DIGITS?
      JMP OCT01     YES, GET THEM NOW 
* 
** BUILD FLOATING POINT NUMBER
* 
      LDB M6        RESET 
      STB CNTR       DIGIT COUNTER
      LDB ATBL      REINITIALIZE
      STB TEMP3       POINTER TO DIGIT TABLE
      CLA 
      CLB 
      DST VALUE     INITIALIZE FLOATING PT VALUE
OCT02 LDA TEMP3,I    GET NEXT DIGIT 
      ISZ TEMP3       BUMP TO NEXT ENTRY
      JSB FLOAT     CONVERT TO FLOATING POINT 
      JSB .FAD      USE TO UPDATE VALUE 
       DEF VALUE
      ISZ CNTR      BUMP DIGIT COUNTER, DONE ?
      RSS 
      JMP OCT,I     YES, RETURN 
      JSB .FMP      NO, MULTIPLY BY 10, 
       DEF FD10 
      DST VALUE      UPDATE VALUE 
      JMP OCT02       AND DO FOR NEXT DIGIT 
* 
** STORAGE ** 
* 
VALUE BSS 2 
CNTR  BSS 1 
ATBL  DEF *+1 
      BSS 6 
FD10  DEC 10. 
* 
****************************
*                          *
* READ ERROR CODE FUNCTION *
*                          *
****************************
* 
XERR  NOP 
      LDA ERRCD 
      JSB FLOAT     FLOAT CODE
      JMP XERR,I    RETURN IN A-B REGISTERS 
* 
***************************** 
*                           * 
* SET ERROR CODE SUBROUTINE * 
*                           * 
***************************** 
* 
SERR  NOP 
      JSB IFIX      CONVERT TO INTEGER
      STA ERRCD     SAVE
      JMP SERR,I
* 
******************* 
*                 * 
*  TIME FUNCTION  * 
*                 * 
******************* 
* 
TIM   NOP 
      JSB IFIX      FIX INPUT PARAMETER 
      STA TEMP3       AND SAVE
********************ADDED 800319*********************************** 
      ADA M3       CHECK FOR OUT OF HIGH RANGE
      SZA,RSS      ZERO,OK
      JMP TIM1
      SSA,RSS      NEG. OK
      JMP FNERR-1  ELSE, ERROR
TIM1  LDA TEMP3 
      ADA .2       CHECK FOR OUT OF LOW RANGE 
      SZA,RSS      ZERO, OK 
      JMP TIM2
      SSA          POS. OK
      JMP FNERR-1  ELSE ERROR 
TIM2  LDA TEMP3 
************************800319************************************* 
      JSB EXEC      GET 
      DEF *+4         TIME
      DEF .11           FROM
      DEF ATBL+1          THE 
      DEF ATBL+6            SYSTEM
      LDA TEMP3     DETERMINE 
      ADA .2          WHICH 
      ADA ATBL          TIME THE USER WANTS 
      LDA 0,I       GET IT
      JSB FLOAT       AND FLOAT IT
      JMP TIM,I     RETURN
* 
* 
      SKP 
****************
*              *
* SGN FUNCTION *
*              *
****************
* 
ESGN  NOP 
      CLB 
      SZA,RSS       ZERO? 
      JMP ESGN,I    YES!
      SSA,RSS       NO, POSITIVE? 
      LDB .2        YES, SET EXPONENT 
      LDA FLGBT     LOAD MANTISSA 
      SZB           POSITIVE? 
      RAR           YES, CORRECT MANTISSA 
      JMP ESGN,I
* 
* 
********************************************
*                                          *
**  EXECUTE SWITCH REGISTER TEST FUNCTION **
*                                          *
********************************************
ESWR  NOP 
      JSB .IENT     CONVERT TO 16 BIT INTEGER 
      JMP FNERR-1   TOO BIG 
      LDB 0 
      AND .15 
      CPA 1         NUMBER OUTSIDE RANGE 0-15?
      RSS           NO
      JMP FNERR-1   YES 
      LIA 1         READ SWITCH REGISTER
      SZB,RSS       IS THIS THE SWITCH? 
      JMP ESWR1     YES 
      RAR           MOVE TO NEXT SWITCH 
      ADB M1
      JMP *-4 
* 
ESWR1 AND .1        ISOLATE THAT BIT
      JSB FLOAT     CONVERT TO FLOATING POINT 
      JMP ESWR,I   RETURN 
* 
* 
      SKP 
******************************* 
*                             * 
**  COMPUTE FILE DATA TYPE  **
*                             * 
******************************* 
* 
*  UPON ENTRY (A) AND (B) HOLD A FILE NUMVER IN F. P. FORM. 
*  FILE 0 REFERS TO THE <DATA STATEMENT>.  IF THE FILE NUMBER 
*  IS NEGATIVE RETURN 1, 2, 3, OR 4 IF THE NEXT DATA ITEM IS
*  A NUMBER, STRING, END-OF-FILE, OR END-OF-RECORD RESPECTIVELY 
*  IF THE FILE NUMBER IS POITIVE RETURN WITH THE VALUE CORRESPOND-
*  ING TO THE FIRST DATA ITEM FOUND OF ONE OF THE FIRST THREE TYPES.
* 
ETYP  NOP 
      STB TEMP9     SAVE (B)
      LDB FILE#     SAVE VALUE
      STB TEM10       OF FILE # 
      SZA,RSS       'DATA' FILE?
      JMP ETYP3     YES!
      CCB           NO, IGNORE
      SSA             END-OF-RECORDS
      CLB               UNLESS ARGUMENT 
      STB EORFL           IS NEGATIVE 
      LDB TEMP9     RETRIEVE (B)
      SSA,RSS       TAKE ABSOLUTE VALUE 
      JMP ETYP4 
      DST NUMO1 
      CLA 
      CLB 
      JSB .FSB      ARITHMETIC INVERSE
       DEF NUMO1
ETYP4 JSB SBFIX     15-BIT INTEGER? 
      JMP E9-1      NON-EXISTANT FILE REFERENCED
      INA           YES 
      STA FILE#       VALIDATE
      JSB FSTAT         FILE
      JMP E9-1      NON-EXISTANT FILE REFERENCED
      JSB GTTYP     GET DATA TYPE 
ETYP1 LDB TEM10     RESTORE 
      STB FILE#       FILE# 
      JSB FLOAT         IN F. P. FORM 
      JMP ETYP,I
ETYP2 LDB NXTDT     OUT OF
      LDA DATA
      JSB STSRH             DATA? 
      JMP ETYP5     YES!
      JSB SETDP     NO, SET DATA POINTERS 
ETYP3 CCA           MORE DATA IN
      CPA DCCNT       CURRENT STATEMENT?
      JMP ETYP2     NO
      LDB NXTDT,I   YES, LOAD TYPE WORD 
      CLA,INA       SET NUMBER
      SSB,RSS       NUMBER? 
      LDA .2        NO, SET FOR STRING
      JMP ETYP1 
ETYP5 LDA .3
      JMP ETYP1 
      SKP 
* 
*********************** 
*                     * 
* PRINT ERROR MESSAGE * 
*                     * 
*********************** 
ERROR NOP 
      JSB CFLUS     FLUSH ANY CLASS I/O 
      LDA ERBS      ERROR ADDRESS IN (A)
      LDB ERROR     ERROR SOURCE IN (B) 
      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 
      ADA .52       ACCOUNT FOR SHORTENED TABLE 
      STA TEMP3     SAVE IT 
      LDA .3
      JMP SEG8      PRINT ERROR MESSAGE, AFTER CLEANING HOUSE 
      SKP 
*************** 
*             * 
* ERROR TABLE * 
*             * 
*************** 
ERR   DEF E1+1      OUT OF STORAGE
      DEF E2        GOSUBS NESTED 10 DEEP 
      DEF E3        RETURN WITH NO PRIOR GOSUB
      DEF E4        OUT OF DATA 
      DEF E5        WRONG DATA TYPE 
      DEF E6         SUBSCRIPT OUT OF BOUNDS
      DEF E7        STATEMENT REFERENCED NOT DATA 
      DEF E18       STATEMENT REFERENCED NOT IMAGE STMT 
      DEF E19       PRINT USING OUTPUT NOT ALLOWWED 
      DEF E8        UNDEFINED VALUE ACCESSED
      DEF E9        NON-EXISTENT FILE REFERENCED
      DEF E10       FILE NOT OPEN 
      DEF E11       END-OF-FILE/END-OF-RECORD 
      DEF E12       UNDEFINED STATEMENT REFERENCED
      DEF E13       BAD DATA ITEM 
      DEF E14       BAD EXPONENT
      DEF E15       SUB. OR FUNCT. TERMINATED ABNORMALLY
      DEF E16       ILLEGAL FILE TYPE 
      DEF E17       OVERLAY NOT IN SYSTEM 
      DEF TERR1     TRAP TABLE FULL 
      DEF TERR2     BAD TRAP/SEQ # COMBINATION
      DEF TERR3     SCHEDULED BUT DELETED TASK
      DEF TERR4     TRAP TABLE BUSY 
      DEF STER1     NEGATIVE STRING LENGTH
      DEF STER2     NON-CONTIGUOUS STRING 
      DEF STER3     STRING OVERFLOW 
      DEF BASER     NEGATIVE NUMBER TO REAL POWER 
      DEF POWER     ZERO TO ZERO POWER
      DEF ZRTNG     ZERO TO NEGATIVE POWER
      DEF FNERR     OUT OF RANGE IN FUNCTION
      DEF LOGER     LOG OF NEG ARGUMENT 
      DEF EXPER     EXP OUT OF RANGE
      DEF FERR0     MISSING FORMAT SPECIFICATION
      DEF FERR1     ILLEGAL OR MISSING DELIMITER
      DEF FERR2     NO CLOSING QUOTE
      DEF FERR3     BAD CHARACTER AFTER REPLICATOR
      DEF FERR4     REPLICATOR TOO LARGE
      DEF FERR5     REPLICATOR ZERO 
      DEF FERR6     MULTIPLE DECIMAL POINTS 
      DEF FERR7     BAD FLOATING POINT SPECIFICATION
      DEF FERR8     ILLEGAL CHARACTER IN FORMAT 
      DEF FERR9     ILLEGAL FORMAT FOR STRING 
      DEF FER10     MISSING RIGHT PARENTHESIS 
      DEF FER11     MISSING REPLICATOR
      DEF FER12     TOO MANY PARENTHESIS LEVELS 
      DEF FER13     MISSING LEFT PARENTHESIS
      DEF FER14     ILLEGAL FORMAT FOR NUMBER 
      DEF OERR1     NOT ENOUGH ID SEGS. FOR OVERLAY 
      DEF OERR2     OVERLAY BUSY
      DEF TERR5     ILLEGAL TRAP NUMBER *800416*
      DEF ERSEQ     UNDEF TASK SEQUENCE NUMBER *800416* 
      SKP 
NFMT  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
TEM10 EQU TEMPS+11
EFMT  EQU TEMPS+12
RFLAG EQU TEMPS+13
HTEMP EQU TEMPS+14
NUMO1 EQU TEMPS+15
UTEMP EQU TEMPS+16  TWO WORD ARRAY
TRFCH EQU TEMPS+18  ADDRESS OF FETCH CHAR ROUTINE 
FERR  EQU TEMPS+19  FILE ERROR FLAG 
FILE# EQU TEMPS+20  FILE REFERENCE NUMBER 
RCRD# EQU TEMPS+21  RECORD REFERENCE NUMBER 
EORFL EQU TEMPS+22  END-OF-RECORD FLAG
DADDR EQU TEMPS+23  FILE LOCATION PTR 
FILT  EQU TEMPS+24  FILE REQUEST TYPE 
RQ2   EQU TEMPS+25
TABFG EQU TEMPS+26
* 
      END BASC4