ASMB,R,Q,C
      HED <<RTE BASIC - DEBUG/SEG #7>>        92076-1X008 REV.2040
      NAM BASC7,5 92076-1X008 REV.2040  800727 92076-16001
* 
* 
* 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
* 
* 
* 
*    NAME:    BASC7 
*    SOURCE:  92076-18008 
*    RELOC:   PART OF 92076-16001 
*    PGRM:    B.J.L.
* 
* 
      ENT BASC7 
      EXT WRITE,OUTLN,REED,OUTER,OPENF,READF,CLOSE
      EXT PRNIN,OUTIN,ENOUT,OUTCR 
      EXT NUMOT,FCNS,DBY10,MBY10,NORML
      EXT SSYMT,.PACK 
      EXT SGMNT,LETCK,DIGCK,SSYMT 
      COM TEMPS(32),PNTRS(81),FILBF(16),FLDCB(144),SPEC(10) 
* 
*PNTRS INCREASED TO 81  800727********************
*TEMPS INCREASED TO 32  800107********************
*****REMOVED CALLS TO OPEN, ADDED CALLS TO OPENF 790829*********
*PNTRS INCREASED TO 79  790831**********************************
*PNTRS INCREASED TO 80  791010**********************************
***REMOVED CALLS TO RDYPT, RETCR 790822*******************
***************************************** 
*                                       * 
*    SEGMENT #7: DEBUG USERS PROGRAM    * 
*                                       * 
***************************************** 
* 
*  THIS PART OF THE INTERPRETER IS LOADED BY THE EXECUTE PHASE OF 
*    BASIC TO PERFORM CERTAIN DEBUGGING FUNCTIONS AND COMMANDS. 
*    CONTROL IS PASSED TO THIS SEGMENT WITH THE VARIABLE 'XSEG7'
*    USED AS A FLAG TO INDICATE THAT A SIMULATE SUBROUTINE CALL 
*    OR DEBUGGING COMMAND IS TO BE PERFORMED. 
*    EXECUTION OF THE USER'S PROGRAM IS RESUMED IN SEGMENT 4
*    AT THE NEXT STATEMENT. 
      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
*****************************790713*************************
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 790831************************* 
****************************CHANGED 791010************************* 
INNAM EQU PNTRS+65  NAME RTN. FROM CRETS (3 WORDS)
INNUM EQU PNTRS+68  SCRATCH FILE # AND COUNTER
HSTPT EQU PNTRS+69  HIGH-STACK POINTER
TSTPT EQU PNTRS+70  TEMPORARY STACK POINTER 
LSTPT EQU PNTRS+71  LOW-STACK POINTER 
LSTAK EQU PNTRS+72  LOW-STACK ADDRESS 
PRADD EQU PNTRS+73  PROGRAM EXECUTION 
DSTRT EQU PNTRS+74  DATA
NXTDT EQU PNTRS+75    STATEMENT 
DCCNT EQU PNTRS+76      POINTERS
NXTST EQU PNTRS+77      NEXT STMT NUMBER 
******MOVED FROM BEHIND TTYPR FOR L 790409****************
PRINT EQU PNTRS+78     LISTING LU#
ERTTY EQU PNTRS+79     ERROR LU#
TRAPF EQU PNTRS+80  TRAP BUSY FLAG  800727***** 
*************************790831****************************** 
*READR NOP              **REMOVED 790828****
*PUNCH NOP              **REMOVED 790828****
*********************************************************************** 
      SKP 
TEMPT BSS 24        TEMPORARIES 
      SPC 1 
FOPBS DEF PRTBL-1 
FINCA DEF FINCH     ADDRESS OF FETCH INPUT ROUTINE
FSCHA DEF FSCH      ADDRESS OF FETCH SOURCE CHAR ROUTINE
DCBAD DEF FLDCB     DCB USED AS COMMAND INPUT BUFFER HERE 
      SPC 1 
      SUP PRESS MULTIPLE LISTINGS 
      SPC 1 
.0    DEC 0 
.1    DEC 1 
.3    DEC 3 
.4    DEC 4 
*.6    DEC 6        **REMOVED 790822**************
.7    DEC 7 
.8    DEC 8 
.10   DEC 10
.15   DEC 15
*.16   DEC 16       **REMOVED 790822****************
*.31   DEC 31        **REMOVED 790822*******************
.32   DEC 32
.34   DEC 34
.40   DEC 40
.43   DEC 43
.45   DEC 45
.46   DEC 46
.47   DEC 47
.48   DEC 48
.9999 DEC 9999
B17   OCT 17
B36   OCT 36
B37   OCT 37
B42   OCT 42
B44   OCT 44
B50   OCT 50
B51   OCT 51
B53   OCT 53
B54   OCT 54
B60   OCT 60
B75   OCT 75
*B77   OCT 77        **REMOVED 790822**************** 
B100  OCT 100 
B106  OCT 106 
B116  OCT 116 
B123  OCT 123 
B133  OCT 133 
B135  OCT 135 
B177  OCT 177 
B377  OCT 377 
B400  OCT 400 
B777  OCT 777 
OPMSK OCT 77000 
TYPFL OCT 100017
OPDMK OCT 100777
M1    DEC -1
M2    DEC -2
M3    DEC -3
M4    DEC -4
M5    DEC -5
M21   DEC -21 
D53   OCT -53 
D100  OCT -100
M32   DEC -32 
M72   DEC -72 
M73   DEC -73 
M80   DEC -80       ***ADD FOR BUG 790928 MM*** 
M256  DEC -256
MAXSN DEC -10000
MNEG  OCT 100000   MAXIMUM NEGATIVE FLOATING
      OCT 376         POINT NUMBER
FLGBT EQU MNEG
AFCNS DEF FCNS
BPAD  DEF BRKP1 
BRMSA DEF *+1       *BREAK PT 
      ASC 4,*BREAK
LNBFF BSS 2           MESSAGE 
LNBFA DEF LNBFF 
      SKP 
***************************** 
*                           * 
* PRINT TABLE FOR OPERATORS * 
*                           * 
***************************** 
PRTBL OCT 1000      BITS 15-9 OF THE LABELLED WORD
      ASC 1," 
      OCT 2000      ARE THE BASIC CODE OPERATOR 
      ASC 1,, 
      OCT 3000      NUMBERS.  BITS 3-0 ARE THE
      ASC 1,; 
      OCT 4001      OPERATOR'S HIERARCHICAL 
      ASC 1,) 
      OCT 5001      PRECEDENCE FOR THOSE OPERATORS
      ASC 1,] 
      OCT 6002      BELONGING TO FORMULAS.  THE 
      ASC 1,, 
      OCT 7002      UNLABELLED WORD GIVES THE 
      ASC 1,= 
      OCT 10007     ASCII REPRESENTATION OF THE 
      ASC 1,+ 
      OCT 11007     SINGLE CHARACTER OPERATORS. 
      ASC 1,- 
      OCT 12010 
      ASC 1,* 
      OCT 13010 
      ASC 1,/ 
      OCT 14012 
      ASC 1,^ 
      OCT 15005 
      ASC 1,> 
      OCT 16005 
      ASC 1,< 
      OCT 17005 
      ASC 1,# 
      OCT 20005 
      ASC 1,= 
      OCT 21011 
      ASC 1,- 
      OCT 22020 
      ASC 1,[ 
      OCT 23020 
      ASC 1,( 
      OCT 24011 
      ASC 1,+ 
      SKP 
* 
      SPC 3 
* 
*************************** 
*                         * 
*  RUNTIME COMMAND TABLE  * 
*                         * 
*************************** 
* 
CMDCT DEC -12       - NUMBER OF COMMANDS
* 
CMDS  DEC 5 
      ASC 3,ABORT   ABORT PROGRAM 
* 
      DEC 6 
      ASC 3,RESUME  CONTINUE WITH PROGRAM 
* 
      DEC 3 
      ASC 2,RES     CONTINUE WITH PROGRAM 
* 
      DEC 3 
      ASC 2,SIM     SIMULATE SUBROUTINES
* 
      DEC 5 
      ASC 3,UNSIM   TURN OFF SIMULATION 
* 
      DEC 4 
      ASC 2,SHOW    DISPLAY VARIABLES 
* 
      DEC 3 
      ASC 2,SET     MODIFY VARIABLES
* 
      DEC 5 
      ASC 3,TRACE   TRACE PROGRAM STATEMENTS
* 
      DEC 7 
      ASC 4,UNTRACE TURN OFF TRACE
* 
      DEC 5 
      ASC 3,BREAK   SET PROGRAM BREAKPOINTS 
* 
      DEC 7 
      ASC 4,UNBREAK TURN OFF BREAKPOINTS
* 
      DEC 5 
      ASC 3,CALLS   LIST CALL MNEMONICS 
* 
* 
* 
CMDEX DEF *+1       EXECUTION ADDRESS OF RUNTIME COMMANDS 
      DEF $ABRT     ABORT PROGRAM 
      DEF $RESM     CONTINUE PROGRAM
      DEF $RESM     CONTINUE PROGRAM
      DEF $SIM      SIMULATE SUBROUTINES
      DEF $UNSM     TURN OFF SIMULATE 
      DEF $SHOW     DISPLAY VARIABLES 
      DEF $SET      MODIFY VARIABLES
      DEF $TRAC     TRACE PROGRAM 
      DEF $UNTR     TURN OFF TRACE
      DEF $BRKP     SET BREAK POINTS
      DEF $UNBP     TURN OFF BREAKPOINTS
      DEF $CALL     LIST CALL MNEMONICS 
* 
      SKP 
****************************************
*                                      *
* EXECUTE DEBUG COMMANDS AND STATEMENTS*
*                                      *
****************************************
* 
BASC7 NOP 
*********************REMOVED 790713************************** 
*     LDA PFLAG     IS THIS INITIALIZATION?*****
*     CPA .9999 
*     RSS           YES, GO GET SEGMENT'S FWAM AND LWAM 
*     JMP BAS7C     NO, CONTINUE EXECUTION
*     JSB GMS.C 
*     JMP ROTAT     RET. TO MAIN FOR FWAM AND LWAM CHECK***** 
************************790713****************************
      LDA TEMP1     SAVE CURRENT
      STA TEM11       LINE ADDRESS
      LDA MNNAM     IS THERE
      SZA             A MNEM TBL TO BE LOADED?
      JSB LOADM     YES, LOAD MNEMONICS INTO MEMORY 
      CCA           SET UP
      ADA SBUFA       OUTPUT
      STA OTBFA         BUFFER
      CLA                 AND 
      STA OCCNT             COUNT PTRS
      STA TYPE
      LDA TEMPS     SET UP POINTER TO FIND END
      STA TEMP1       OF STATEMENT
* 
      LDA M2        SET SLOW STATEMENT
      STA SLSTM       FLAG TO INDICATE POSSIBLY BRKPT OR SIM
* ON EXIT FROM THIS SEGMENT 'SLSTM' WILL BE EITHER M1 FOR 'SIM' OR
*  M2 FOR 'BREAKPOINT' OR 3 FOR 'ABORT' 
      LDA NXTST     IF NEGATIVE 
      SSA             THEN SIMULATE 
      JMP MCALL     ITS A 'SIM', LIST THE MNEMONIC
* 
      LDA .10       ITS A BRKPT, LIST THE LINE NUMBER 
      STA OCCNT 
      ISZ SLSTM     SET 'SLSTM' TO M1 TO DIFFERENCIATE BETWEEN SIM AND BRKPT
      LDA LNBFA       OUT 
      STA OTBFA 
      LDA .LNUM         '*BREAK'
      JSB OUTIN 
      LDA OCCNT           AND 
      LDB BRMSA             LINE #
      JSB WRITE 
NXCOM LDB ACKNA     OUTPUT
      LDA M3          A 
      JSB WRITE         PROMPT
      LDA M80       READ  ***CHG FOR BUG 790928 MM*** 
      LDB DCBAD       A 
      JSB REED          RECORD
      CMA           SET CHAR COUNT
      STA CHCNT       TO -1-#CHARS
      LDA DCBAD     SET UP
      CLE,ELA         BUFFER
      STA BFADD         ADDRESS 
      JSB GTCHR     GET FIRST CHAR
      JMP XEC4      IF NOTHING THEN CONTINUE
      LDB SBUFA     SET UP POINTER
      STB SBPTR       TO INPUT BUFFER 
      STA 1,I       PUT FIRST CHAR IN IT
      LDB CMDCT     SEARCH
      JSB TBSRH       LEGAL COMMAND 
      DEF CMDS
      JSB ERROR     CAN'T FIND IT 
E1    EQU * 
      ADA CMDCT     DETERMINE ORDINAL # IN TABLE
      CMA,INA 
      ADA COUNT 
      ADA CMDEX     INCREMENT TO ENTRY PT ADDRESS 
      LDA 0,I       GET ADDRESS OF COMMAND
      RSS           PEEL
      LDA 0,I           OFF 
      RAL,CLE,SLA,ERA       INDIRECTS 
      JMP *-2 
      JMP 0,I       EXECUTE THE COMMAND 
* 
      SKP 
* 
********************************* 
*                               * 
*  RETURN TO SEG 4 TO CONTINUE  * 
*                               * 
********************************* 
* 
XEC4  LDB .4        LOAD SEGMENT#4
      LDA TEM11     RESTORE CURRENT 
      STA TEMP1       LINE ADDRESS
      JMP SGMNT 
      SKP 
* 
*     HERE FOR:    RESUME 
* 
$RESM JMP XEC4          OR SIMULATE 
* 
* 
* 
*     HERE FOR:    ABORT
* 
$ABRT LDA .3        ABORT RUNNING PROGRAM 
      STA SLSTM 
      CLB 
      STB TEMP3     CLEAR ERROR FLAG
      LDB .8        LOAD SEGMENT#8
      JMP SGMNT 
* 
* 
      SKP 
* 
*     HERE FOR:   TRACE <STMT#>,<STMT#> 
* 
$TRAC JSB GTCHR     GET FIRST CHAR
      JMP TR2       THERE ISNT ANY
      JSB INTCK     CONVERT FIRST STMT #
      DEF MAXSN 
      JSB ERROR     BAD NUMBER
E2    STB LOTRC     SET LOW TRACE NUMBER
      CPA B54       COMMA?
      JMP TR1       YES!
      CPA .10       LAST CHAR?
      JMP TR3       YES, STAND ALONE TRACE
      JMP E1-1      ILLEGAL COMMAND 
TR1   JSB GTCHR     GET NEXT CHAR 
      JMP E4-1      NONE FOUND
      JSB INTCK     CONVERT LAST STMT # 
      DEF MAXSN 
      JMP E2-1      BAD NUMBER
      STB HITRC     SET HIGH TRACE LIMIT
      CMB,INB       IS HIGH 
      ADB LOTRC       LIMITS LARGER 
      SSB,RSS           THAN LOW LIMITS?
      JSB ERROR     YES!
E13   EQU * 
      JMP NXCOM     NO! 
* 
TR2   CLB,INB       SET FOR 
      STB LOTRC       FULL PROGRAM
      LDB .9999         TRACING 
TR3   STB HITRC 
      JMP NXCOM 
* 
* 
*     HERE FOR:  UNTRACE
* 
$UNTR CLA 
      STA LOTRC     CLEAR 
      STA HITRC       OUT TRACE STMT #'S
      JMP NXCOM 
      SKP 
* 
*     HERE FOR:   SIM [ULATE] 
* 
$SIM  LDA .1          SET SIMULATE FLAG 
      STA SMFLG         FOR SUBROUTINE CALLS
      JMP NXCOM 
      SPC 4 
* 
*     HERE FOR:    UNSIM [ULATE]
* 
$UNSM CLA           CLEAR SUBROUTINE
      STA SMFLG       SIMULATE FLAG 
      JMP NXCOM 
* 
*     HERE FOR:   BREAK <STMT #>,<STMT #>,<STMT #>,<STMT #> 
* 
$BRKP LDA M4        SET FOR 
      STA TEMP9       MAXIMUM OF 4 B.P.'S 
      LDA BPAD      SET UP
      STA TEMP8       BREAKPT ADDRESS 
      JSB GTCHR     GET FIRST CHAR
      JMP BP6       NON, SO PRINT LIST
      JMP E3        OK! 
* 
BP1   SZA,RSS       WAS BP AVAILABLE? 
      JMP BP3       NO! 
      JSB GTCHR     GET FIRST CHARACTER 
      JSB ERROR     NONE FOUND! 
E3    JSB INTCK     CONVERT NUMBER
      DEF MAXSN 
      JMP E2-1      BAD NUMBER
      CPB TEMP8,I   ALREADY SET?
      JSB ERROR     YES!
E16   EQU * 
      CPA .10       END?
      STA  FERR     SAVE (A)
BP3   LDA TEMP8,I   IS IT 
      SZA             AVAILABLE?
      JMP BP4       NO! 
      LDA FERR      RESTORE (A) 
      STB TEMP8,I   STORE VALUE 
      CPA B54       COMMA?
      JMP BP2       YES!
      CPA .10       NO, END?
      JMP NXCOM     YES!
BP2   ISZ TEMP8     NEXT ADDRESS
      ISZ TEMP9     LAST ONE? 
      JMP BP1       NO
      JSB ERROR     YES 
E15   EQU * 
* 
BP4   CLA 
      JMP BP2 
* 
* 
*  PRINT BREAK POINTS 
* 
BP6   JSB PRNIN     INITIALIZE
      LDA BRKP1     PRINT 
      JSB OUTIN       BP#1
      LDA B54 
      JSB OUTCR     PRINT COMMA 
      LDA BRKP2     PRINT 
      JSB OUTIN       BP#2
      LDA B54 
      JSB OUTCR     PRINT COMMA 
      LDA BRKP3     PRINT 
      JSB OUTIN       BP#3
      LDA B54 
      JSB OUTCR     PRINT COMMA 
      LDA BRKP4     PRINT 
      JSB OUTIN       BP#4
      JSB OUTLN     PRINT LINE
      JMP NXCOM      GOTO PROMPT
* 
*     HERE FOR:   UNBREAK <STMT #>,<STMT #>,<STMT #>,<STMT #> 
* 
$UNBP LDA M4        SET UP
      STA TEMP9       ADDRESS 
      LDA BPAD          AND 
      STA TEMP8           COUNTER 
UNBP1 JSB GTCHR     GET CHAR
      JMP UNBP3     NONE FOUND
      JSB INTCK     CONVERT NUMBER
      DEF MAXSN 
      JMP E2-1      BAD NUMBER
UNBP4 CPB TEMP8,I   IS IT A CURRENT B.P.? 
      JMP UNBP5     YES 
      ISZ TEMP8 
      ISZ TEMP9     END?
      JMP UNBP4     NO
UNBP2 CPA B54       YES, NOT FOUND, COMMA?
      JMP UNBP1     YES!
      CPA .10       NO, END?
      JMP NXCOM     YES!
      JSB ERROR     BAD COMMAND 
E4    EQU * 
UNBP3 CLA           CLEAR 
      STA BRKP1       OUT 
      STA BRKP2         ALL 
      STA BRKP3           THE 
      STA BRKP4             BREAKPOINTS 
      JMP NXCOM 
UNBP5 CLB           CLEAR OUT 
      STB TEMP8,I     INDIVIDUAL B.P. 
      JMP UNBP2 
      SKP 
* 
*     HERE FOR:   SHOW <VARIABLE>,<VARIABLE>, , , 
* 
$SHOW JSB PRNIN     INITIALIZE FOR PRINT
      JSB LCVAR     FIND PHYSICAL LOCATION OF VARIABLE
      JMP SHOW3     STRING VARIABLE 
      DLD 1,I       GET VARIABLE
      CPA MNEG      IS VARIABLE 
      RSS 
      JMP *+3 
      CPB MNEG+1      DEFINED YET?
      JSB ERROR     NO! 
E14   JSB ENOUT     PRINT THE NUMBER
SHOW4 LDA SCHAR     END OF
      CPA .10         LINE? 
      JMP SHOW2     YES, PRINT LINE 
      JMP $SHOW+1   PRINT NEXT VARIABLE 
* 
SHOW2 JSB OUTLN     PRINT OUT LINE
      JMP NXCOM     RETURN TO COMMAND MODE
* 
SHOW3 LDA M2        PREPARE 
      JSB PSTR        TO
      STA TEMP8         PRINT 
      STB TPRME           STRING
      LDA .32       OUTPUT
      JSB OUTCR       SPACE 
SHOW5 ISZ TNULL     MORE STRING?
      RSS           YES 
      JMP SHOW4     NO! 
      JSB FSCH      FETCH CHARACTER 
      LDA .32        END OF CHARACTERS
      JSB OUTCR     OUTPUT CHARACTER
      JMP SHOW5 
      SKP 
* 
*     HERE FOR:   SET <VARIABLE>=<CONSTANT> 
* 
$SET  NOP 
SET12 JSB LCVAR     FIND PHYSICAL LOCATION OF VARIABLE
      JMP SET2      STRING VARIABLE 
      STB SET4+1    SAVE POINTER TO IT
      LDA SCHAR     RETRIEVE CHARACTER
      CPA B75       EQUALS SIGN?
      RSS           YES!
      JSB ERROR     NOT AN '='! 
E5    JSB GTCHR     GET FIRST CHAR OF CONSTANT
      JMP E2-1      NO CONSTANT 
      CLB           SET SIGN
      STB SIGN        POSITIVE
      INB 
      CPA .43       '+'?
      JMP SET1      YES 
      CPA .45       NO,'-'? 
      CCB,RSS       YES 
      JMP SET3      NO! 
SET1  STB SIGN      RECORD SIGN 
      JSB GTCHR     FETCH NEXT CHAR 
      JMP E2-1      SOLITARY SIGN 
SET3  JSB CVNUM     CONVERT NUMBER
      JMP E2-1      NONE FOUND
      JMP E2-1      BAD EXPONENT
SET4  DST 0         CHANGE VARIABLE VALUE 
      JMP SETND     NEXT COMMAND
SET2  CCA           EXTRACT 
      ADA 1,I         PHYSICAL
      LDA 0,I           LENGTH
      ALF,ALF             OF
      AND B377              DESTINATION STRING
      CMA           SET IT AS END 
      STA TPRME      OF DESTINATION STRING
      CCA           PREPARE 
      JSB PSTR        DESTINATION STRING
      LDB TNULL     SAVE LENGTH 
      STB TEMP7       ALLOWANCE 
* 
      JSB GTCHR     GET FIRST CHAR
      NOP 
      CPA B42       QUOTE?
      RSS           YES!
      JSB BKSPA     BACKSPACE CHARACTER 
      CLB           TURN OFF
      STB BLANK       SUPPRESSION 
      LDA FINCA     ADDRESS OF INPUT ROUTINE
      JSB TRSTR     TRANSFER STRING 
      CLB           ALL REQUESTED 
      CPB TNULL       CHARACTERS TRANSFERRED
      JMP SET5      YES!
      CPB PS1       NO,TRANSFER LENGTH SPECIFIED
      JMP SET6      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) 
SET7  CPA .10       TRANSFER ENDED BY END-OF-INPUT
      JMP SET8      YES!
SET9  JSB GTCHR     NO, WAS IT A QUOTE? 
      LDA .10       EXIT WITH 
      JMP SET8        NEXT CHAR 
SET6  LDB TEMP6,I   SET LOGICAL 
      ADB TNULL       TO ACTUAL 
      STB TEMP6,I       STRING LENGTH 
      JMP SET7
SET5  CPB PS1       LENGTH OF STRING SPECIFIED? 
      JMP SET10     NO! 
SET11 JSB GTCHR     YES!
      JMP SET8      IMPLIED CLOSING QUOTE 
      CPA B42       QUOTE?
      JMP SET9      YES!
      JMP SET11     NO, LOOK FOR " OR END-OF-INPUT
SET10 JSB GTCHR     END-OF-INPUT NEXT?
      JMP SET8      YES!
      CPA B42       QUOTE NO, CLOSING QUOTE?
      JMP SET9      YES!
      LDA TEMP7     NO, DESTINATION STRING EXCEEDED!
      STA TNULL     RESTORE 
      LDA .32       SET TO SKIP BLANKS
      STA BLANK 
      JMP SETND 
* 
SET8  LDB .32       RESTORE 
      STB BLANK       BLANK SUPRESSION
      JMP SETND 
* 
SETND JSB BKSPA     BACKSPACE ONE CHAR
      JSB GTCHR     FETCH NEXT CHAR 
      JMP NXCOM     EOF 
      CPA B54       COMMA?
      JMP SET12     YES!
      JMP E4-1      BAD DELIMITER 
* 
      SKP 
* 
*     HERE FOR:   CALLS 
* 
$CALL LDA MNNAM     ANY 
      SZA,RSS         B&M TABLES? 
      JSB ERROR     NO! 
CERR9 JSB PRNIN     INITIALIZE FOR PRINT
      LDA PRINT     SET TO PRINT
      STA LUOUT       ON LIST DEVICE
      LDB HEDER     PRINT 
      LDA .48 
      JSB WRITE       HEADER
      LDA MNNAM     IS THERE
      SZA,RSS         A MNEMONIC TBL? 
      JMP NXCOM     NO! 
      LDB FWAMM     GET 
      LDA 1,I         THE NUMBER
      STA MCNT         MNEMONICS TO BE LISTED 
      INB           SAVE
CALL1 STB MADDR       MNEMONIC TBL ADDRS
      LDA .32 
      JSB OUTCR 
      LDB MADDR 
      JSB MCOPY     LIST THE MNEMONIC 
      LDA FWAMM,I   GETPACE 
      CMA,INA         FIRST WORD
      ADA MCNT          ADDRESS 
      RAL,RAL             OF ENTRY
      ADA FWAMB             IN BRANCH TABLE 
      STA BADDR               AND SAVE IT 
      INA 
      LDB 0,I       GET ARRAY/SIMPLE
      RBL             WORD AND
      STB ARRAY         SAVE IT 
      INA 
      DLD 0,I       GET VALUE AND REAL/INTEGER
      RBL             AND SAVE
      RAL               THEM
      STA VALUE 
      STB CONVR 
      LDA MADDR,I   GET PARAMETER 
      RRR 4           COUNT 
      AND B17           AND 
      CMA,INA 
      STA PCNT            SAVE IT 
      SZA,RSS       ANY PARAMETERS? 
      JMP CALL2     NO! 
CALL3 LDA CONVR     GET 
      RAR             CONVERSION
      STA CONVR         BIT 
      SLA           IS IT REAL? 
      JMP CONV1     NO, INTEGER!
      LDA R         YES 
CONV2 JSB OUTCR     OUTPUT IT 
      LDA VALUE     GET VALUE 
      RAR             WORD
      STA VALUE         AND SAVE IT 
      SLA,RSS       GOING TO SUBROUTINE?
      JMP *+3       YES!
      LDA V         NO, FROM SUBROUTINE 
      JSB OUTCR     OUTPUT IT 
      LDA ARRAY     GET 
      RAR             SIMPLE/ARRAY
      STA ARRAY         WORD AND SAVE IT
      SLA,RSS       IS IT ARRAY?
      JMP *+3       NO! 
      LDA A         YES!
      JSB OUTCR     OUTPUT LETTER 'A' 
      LDA PCNT      ANY 
      SZA,RSS         PARAMETERS? 
      JMP CALL2     NO! 
      ISZ PCNT      DONE? 
      JMP CALL4     NO! 
      LDA B51       YES, OUTPUT 
      JSB OUTCR       CLOSED PAREN
CALL2 LDA .32       PRINT 
      JSB OUTCR 
      LDB MADDR,I   IS THIS 
      LDA B123        A SUBROUTINE
      SSB               OR A FUNCTION?
      LDA B106      OUTPUT A
      JSB OUTCR       EITHER A 'S' OR 'F' 
      LDA .32       OUTPUT
      JSB OUTCR       SPACE 
      LDA BADDR,I   EXTRACT AND 
      RRR 6         PRINT 
      AND B37         OVERLAY 
      JSB OUTIN         NUMBER
      JSB OUTLN     OUTPUT LINE 
      LDB MADDR     COMPUTE 
      LDA 1,I         POSITION
      AND .7            OF
      ADA .3              NEXT
      ARS 
      ADB 0                  MNEMONIC 
      ISZ MCNT     DONE?
      JMP CALL1     NO! 
      JMP NXCOM     YES!
* 
CALL4 LDA B54       PRINT 
      JSB OUTCR       COMMA 
      JMP CALL3 
* 
CONV1 LDA I         PRINT 
      JMP CONV2       'I' 
* 
* 
ARRAY BSS 1 
CONVR BSS 1 
VALUE BSS 1 
MCNT  BSS 1 
PCNT  BSS 1 
MADDR BSS 1 
BADDR BSS 1 
V     OCT 126 
R     OCT 122 
I     OCT 111 
A     OCT 101 
HEDER DEF *+1 
      ASC 24, <<NAME(PARAMETER DESCRIPTION) TYPE-OVERLAY#>> 
      SKP 
* 
*  READ MNEMONIC TABLE INTO SPACE BETWEEN LONGEST 
*  SEGMENT AND NEXT TO LONGEST SEGMENT
* 
LOADM NOP 
      LDA DCBAD     SET UP
      STA DCB         DATA CONTROL BLOCK
      JSB OPENF     OPEN       **CHANGED 790829****** 
      DEF *+7         MNEMONIC
      DEF DCB,I         TABLE 
      DEF FERR            FILE
      DEF MNNAM 
      DEF .0
      DEF MNNAM+3 
      DEF MNNAM+4 
      JSB CKERR     ERROR?
      LDA FWAMM     SET STARTING
      STA TEMP4       ADDRESS OF MNEMONIC TBL 
LOAD3 JSB READF     READ
      DEF *+6 
      DEF DCB,I       MNEMONIC
      DEF FERR
      DEF TEMP4,I       TABLE 
      DEF .9999           INTO CORE 
      DEF TEMP3 
      LDB TEMP3 
      CPB M1        EOF READ? 
      JMP LOAD7     YES 
      ADB TEMP4     NO, SET NEW READ
      STB TEMP4         INDEX 
* 
      JMP LOAD3     NO, READ SOME MORE
LOAD7 JSB CKERR     ERROR?
      JSB CLOSE     CLOSE 
      DEF *+4 
      DEF DCB,I       THE 
      DEF FERR
      DEF .0            FILE
      JSB CKERR 
      JMP LOADM,I 
* 
**********************************
*                                *
*  CHECK FOR FILE MANAGER ERROR  *
*                                *
**********************************
* 
CKERR NOP 
      LDA FERR      IS THERE
      SSA,RSS         AN ERROR? 
      JMP CKERR,I   NO! 
      STA TEMP3     SAVE ERROR
      JMP OUTER       AND GO TO ERROR PROCESSOR 
* 
      SKP 
* 
**********************************
*                                *
* OUTPUT A MULTICHARACTER SYMBOL *
*                                *
**********************************
* 
MCOPY NOP 
      LDA 1,I       COMPUTE 
      AND .7          ENTRY 
      CMA,INA           LENGTH
      STA TEMP7           AND SAVE IT 
      CLE,INB       SET FOR FIRST CHARACTER 
      STB TEMP3     SAVE SYMBOL ADDRESS 
MCOU3 LDA TEMP3,I   LOAD WORD 
      SEZ,RSS       FIRST CHARACTER?
      ALF,ALF       YES, POSITION IT
      AND B177      EXTRACT CHARACTER 
      JSB OUTCR     OUTPUT IT 
      SEZ,CME       SET FOR NEXT CHARACTER
      ISZ TEMP3     MOVE TO NEXT WORD OF SYMBOL 
      ISZ TEMP7     MORE CHARACTERS?
      JMP MCOU3     YES 
      JMP MCOPY,I 
***************************** 
* 
*   LIST A CALL STATEMENT     * 
*                             * 
******************************* 
* 
MCALL CMA,INA       RESET 'NXTST' 
      STA NXTST 
      LDA SNOWF     OUTPUT
      JSB OUTCR       SNOWFLAKE 
      LDA .LNUM     OUTPUT
      JSB OUTIN       LINE NUMBER 
      LDA .32       OUTPUT
      JSB OUTCR       BLANK 
      LDB CALLA     POINTER TO 'CALL' 
      JSB MCOPY     OUTPUT 'CALL' 
      LDA .32       OUTPUT
      JSB OUTCR       SPACE 
MCAL1 LDA TEMPS 
      LDA 0,I       GET OPERATOR WORD 
      AND B777      GET MNEMONIC TBL OFFSET 
      CMA           USE OFFSET TO FIND MNEMONIC 
      STA TEMP5     NO. OF MNEMONICS TO SKIP
      LDB FWAMM     GET ADDR. OF SUB. MNEMONICS 
      INB 
NXSUB ISZ TEMP5     IS THIS IT? 
      RSS           NO! 
      JMP LCALL     YES!
      LDA 1,I       GET FIRST WORD OF MNEMONIC ENTRY
      AND .7        GET CHARACTER COUNT 
      ADA .3
      ARS           INCREMENT TO NEXT ENTRY 
      ADB 0         ADD IN MNEM TBL ADDRESS 
      JMP NXSUB     CHECK NEXT ENTRY
LCALL JSB MCOPY     LIST THE CALL MNEMONIC
      LDA TEMP4     GET LAST CHAR (SEE OUTCR) 
      CPA .40       LAST CHAR "("?
      JMP *+3       YES, SUPPRESS SPACE 
      LDA .32       OUTPUT
      JSB OUTCR       BLANK 
      ISZ TEMPS     POINT AT FIRST PARAMETER
      ISZ TEMP1       AND UPDATE INTERMEDITATE CODE 
      JMP LIST5     LIST PARAMETERS 
* 
CALLA DEF *+1 
      DEC 4 
      ASC 2,CALL
SNOWF OCT 52
ACKNA DEF *+1 
      ASC 2,>>_ 
ALEN  DEF *+1 
      OCT 3 
      ASC 2,LEN 
* 
* 
LIST3 ISZ TEMPS     MORE
      ISZ TEMP1 
      LDA TEMP1       STATEMENT?
      CPA PRADD 
      RSS           NO! 
      JMP LIST4     YES!
      SPC 1 
*  CONVERSION COMPLETE - OUTPUT THE LINE ON LIST DEVICE 
      SPC 1 
****REMOVED LABEL 'LIST2' 790822********************************
      LDB SBUFA     NO, OUTPUT
      LDA OCCNT 
      JSB WRITE       STATEMENT TO PERIPHERAL 
      JMP NXCOM 
      SPC 1 
*  CONVERT THE OPERATOR 
      SPC 1 
LIST4 LDA TEMPS,I 
      AND OPMSK 
      SZA,RSS       NULL OPERATOR?
      JMP LIST5     YES 
      STA TEMP2     NO, SAVE OPERATOR 
      ALF,ALF       SINGLE
      ARS 
      LDB 0           CHARACTER 
      ADA M21 
      BLS           YES 
      ADB FOPBS     LOAD
      LDA 1,I         SYMBOL
      ALF,ALF       ADJUST
      AND B377      CHARACTER 
      CPA .34       " ? 
      JMP LIS14     YES 
      JSB OUTCR     NO
      SKP 
*  CONVERT THE OPERAND
      SPC 1 
LIST5 LDA TEMPS,I 
      AND OPDMK     SAVE
      STA TEMP3       OPERAND 
      SSA           FLAG BIT SET? 
      JMP LIST9     YES 
      SZA,RSS       NO, NULL OPERAND? 
      JMP LIST3     YES 
      AND TYPFL     ISOLATE TYPE PART 
      CPA .15       FUNCTION? 
      JMP LIST8     YES 
      SPC 1 
*  OUTPUT LETTER-DIGIT COMBINATIONS 
      SPC 1 
LIST6 LDA TEMP3 
      RRR 4 
      AND B177        OUTPUT
      ADA B100
      JSB OUTCR         LETTER
      LDA TEMP3     YES 
      AND .15       RESTORE 
      SZA,RSS       STRING? 
      JMP LIS16     YES!
      ADA M5        NO! 
      SSA           LETTER-DIGIT? 
      JMP LIST3     NO! 
      ADA B60         DIGIT 
LIS17 JSB OUTCR     OUTPUT DIGIT
      JMP LIST3 
      SPC 1 
LIS16 LDA B44       '$' 
      JMP LIS17 
      SPC 1 
LIST8 LDA B106      OUTPUT
      JSB OUTCR 
      LDA B116        'FN'
      JSB OUTCR 
      LDA TEMP3     OUTPUT
      RRR 4 
      AND B177        LETTER
      ADA B100
      JSB OUTCR 
      JMP LIST3 
      SPC 1 
*  OUTPUT FLOATING-POINT CONSTANTS
      SPC 1 
LIST9 XOR FLGBT 
      SZA           NUMBER? 
      JMP LIS10     NO
      ISZ TEMPS     YES 
      LDA TEMPS,I 
      ISZ TEMPS 
      LDB TEMPS,I 
      ISZ TEMP1 
      ISZ TEMP1 
      JSB NUMOT     OUTPUT THE NUMBER 
      NOP 
      JMP LIST3 
      SPC 1 
*  OUTPUT FUNCTION NAMES
      SPC 1 
LIS10 AND .15 
      CPA .3        INTEGER?
      JMP LIS11     YES 
      CPA .15       NO, FUNCTION? 
      RSS           YES 
      JMP LIST6     NO, MUST BE A PARAMETER 
      LDA TEMP3     COMPUTE 
      RRR 4 
      AND B37       COMPUTE INTERNAL FUNCTION NO. 
      CPA B37       IS IT LEN FUNCTION? 
      JMP LENF      YES 
      CPA B36       FORTRAN FUNCTION? 
      JMP FRFCT     YES!
      STA TEMP2           CODE
      CMA 
      STA TEMP5     NO. OF MNEMONICS TO SKIP
      LDA AFCNS     GET ADDR. OF FUNCTION MNEM. 
      RSS           PEEL
      LDA 0,I           OFF 
      RAL,CLE,SLA,ERA       INDIRECTS 
      JMP *-2 
      STA 1         ADDR OF MNEMONIC ENTRIES IN BREG
NXFCN ISZ TEMP5     IS THIS IT? 
      RSS           NO! 
      JMP LFCN      YES!
      LDA 1,I       GET FIRST WORD OF MNEMONIC ENTRY
      AND .7        GET CHARACTER COUNT 
      ADA .3
      ARS           INCREMENT TO NEXT ENTRY 
      ADB 0         ADD IN MNEM TBL ADDRESS 
      JMP NXFCN     CHECK NEXT ENTRY
LFCN  JSB MCOPY     OUTPUT FUNCTION NAME
      JMP LIST3 
* LEN FUNCTION FOUND
LENF  LDB ALEN      ADDRESS OF PRINT
      JMP LFCN        BUFFER FOR LEN
FRFCT ISZ TEMPS 
      ISZ TEMP1 
      JMP MCAL1     PRINT FORTRAN FUNCT MNEM
      SPC 1 
*  OUTPUT INTEGER CONSTANTS 
      SPC 1 
LIS11 ISZ TEMPS     OUTPUT
      ISZ TEMP1 
      LDA TEMPS,I     INTEGER 
      JSB OUTIN 
      JMP LIST3         OPERAND 
      SPC 1 
*  OUTPUT OPERATOR
      SPC 1 
* 
*****REMOVED LABEL 'LIS15' 790822****************************** 
      LDA .32       OUTPUT
      JSB OUTCR       A BLANK FIRST 
LIST1 JSB OUTST     OUTPUT STRING 
      JMP LIST3 
      SPC 1 
*  OUTPUT QUOTE STRING
      SPC 1 
LIS14 LDB TEMPS,I   OUTPUT QUOTE STRING 
      BLF,BLF       TEST BIT 8
      SLB           SUPPRESS QUOTES?
      JMP LIST1     YES!
      JSB OUTCR     OUTPUT "
      JSB OUTST     OUTPUT QUOTE STRING 
      LDA .34       OUTPUT "
      JMP LIS17 
      SPC 1 
******************* 
*                 * 
* OUTPUT A STRING * 
*                 * 
******************* 
OUTST NOP 
      LDA TEMPS,I 
      AND B177      GET STRING COUNT
      CMA,INA,SZA,RSS  NULL STRING? 
      JMP OUTST,I   YES!
      STA TEMP6     NO, SAVE NEG OF COUNT 
OUTS1 ISZ TEMPS     MOVE TO NEXT PAIR OF CHARS
      ISZ TEMP1     BUMP COUNTER
      LDA TEMPS,I   GET THEM
      ALF,ALF       POSITION TO OUTPUT LEFT CHARACTER 
      JSB OUTS2     OUTPUT CHAR 
      LDA TEMPS,I   GET CHAR PAIR AGAIN 
      JSB OUTS2     OUTPUT RIGHT HAND CHAR
      JMP OUTS1 
      SPC 1 
OUTS2 NOP 
      AND B177
      JSB OUTCR     ISOLATE AND OUTPUT CHAR 
      ISZ TEMP6     WAS IT LAST CHAR
      JMP OUTS2,I   NO! 
      JMP OUTST,I   YES!
      SKP 
* 
******************************************* 
*                                         * 
* TABLE SEARCH FOR MULTICHARACTER SYMBOLS * 
*                                         * 
******************************************* 
TBSRH NOP 
      STA SBPTR,I 
      LDA TBSRH,I 
      RSS           PEEL
      LDA 0,I           OFF 
      RAL,CLE,SLA,ERA       INDIRECTS 
      JMP *-2 
      ISZ TBSRH 
      STA TABLE     STORE TABLE ADDRESS 
      STB LNGTH     STORE -(NUMBER OF ENTRIES)
      LDA INBFA     SAVE
      STA TEMP3       INPUT 
      LDA ICCNT           BUFFER
      STA TEMP4           STATUS
      LDA SBPTR     INITIALIZE END-OF-SYMBOL
      STA SMEND       POINTER 
      CLA,INA       COUNT FIRST CHARACTER OF
      STA SLENG       SYMBOL
      LDA SBPTR,I   FETCH PARTIAL SYMBOL
      ALF,ALF       LEFT-JUSTIFY
      IOR .32         FIRST CHARACTER AND 
      STA SBPTR,I       APPEND BLANK
TSRC1 JSB GTCHR     FETCH NEXT CHARACTER
      JMP TSRC9     END-OF-STATEMENT
      LDB SLENG     CHECK FOR 
      CPB .8          IMPOSSIBLE LENGTH 
      JMP TSRC9 
      SLB           EVEN-NUMBERED CHARACTER?
      JMP TSRC2     YES 
      ISZ SMEND     NO, FETCH FRESH WORD, 
      ALF,ALF         LEFT-JUSTIFY CHARACTER, 
      IOR .32           APPEND BLANK, 
      JMP TSR10 
TSRC2 ADA M32       DELETE BLANK, 
      ADA SMEND,I     FILL SECOND CHARACTER,
TSR10 STA SMEND,I       AND STORE 
      ISZ SLENG     COUNT IT
      LDB LNGTH     INITIALIZE TABLE LENGTH 
      STB COUNT       COUNTER 
      LDA TABLE 
TSRC3 STA TBLPT     SET TABLE POINTER 
      LDA TBLPT,I   EXTRACT SYMBOL LENGTH 
      AND .7          FROM TABLE AND COMPARE
      CPA SLENG         WITH CURRENT SYMBOL 
      JMP TSRC5     EQUAL?
TSRC4 ADA .3        DIFFERENT,
      ARS             UPDATE
      ADA TBLPT         TABLE POINTER 
      ISZ COUNT     MORE ENTRIES? 
      JMP TSRC3     YES 
      JMP TSRC1     NO
* 
      SKP 
TSRC5 LDB TBLPT     SET POINTER TO
      STB TSPTR       TABLE SYMBOL
      LDB SBPTR     SET (B) TO INPUT
      JMP TSRC7       SYMBOL POINTER
TSRC6 CPB SMEND     ALL OF SYMBOL CONSIDERED? 
      JMP TSRC8     YES, MATCH OCCURRED 
      INB           NO, INCREMENT 
TSRC7 ISZ TSPTR       SYMBOL POINTERS 
      LDA TSPTR,I   FETCH WORD FROM TABLE 
      CPA 1,I       MATCH WITH INPUT SYMBOL?
      JMP TSRC6     YES 
      LDA SLENG     NO, WRONG 
      JMP TSRC4       SYMBOL
TSRC8 LDA TBLPT,I   EXTRACT 
      AND OPMSK       SYMBOL CODE 
      STA SBPTR,I 
      ISZ TBSRH         AND RETURN VIA
      JMP TBSRH,I         'SUCCESS' EXIT
TSRC9 LDA TEMP3     RESTORE 
      STA INBFA       INPUT 
      LDA TEMP4         BUFFER
      STA ICCNT           STATUS
      LDA SBPTR,I   GET ORIGINAL CHAR 
      ALF,ALF        POSITION IT
      AND B377        ISOLATE IT
      JMP TBSRH,I   'FAILURE' EXIT
      SKP 
* 
****************************
*                          *
*  PREPARE STRING OPERAND  *
*                          *
****************************
* 
*  ON ENTRY (A)=-2 TO INDICATE THE STRING IS A SOURCE STRING. 
*           (B)= POINTER TO STRING ADDRESS
*  ON EXIT  (A)= START OF STRING ADDRESS
*           (B)= LOGICAL STRING LENGTH
*  THE FIRST CHARACTER OF THE STRING OPERAND IS LEFT IN TEMP5 
*  FOR SOURCE STRINGS (A)= TEMP5   UPON EXIT. THE REQUESTED 
*  STRING LENGTH (IN CHARACTERS) IS LEFT IN TEMP6  FOR SOURCE 
*  STRINGS THE ACTUAL STRING LENGTH (WHICH MAY BE LESS THAN THE 
*  REQUESTED LENGTH) 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
      LDB 1,I       GET STRING
      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 
      LDA SUBS1     LOAD START OF STRING DESIGNATOR 
      STA MPT       SAVE IT 
      ADA TEMP5     RECORD CHARACTER ADDRESS
      STA TEMP5       OF START-OF-STRING
      LDA SUBS2     LOAD 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 
E7    STA TNULL 
      ADA B400      NO
      SSA           >255
      JMP E9-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 
E8    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
E9    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 
TPRME BSS 1 
TNULL BSS 1 
      SKP 
* 
****************************
*                          *
*  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
* 
*********************** 
*                     * 
*  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 .32       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 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 GTCHR     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 
* 
TRFCH BSS 1 
* 
* 
******************************* 
*                             * 
*  BACK SPACE OVER CHARACTER  * 
*                             * 
******************************* 
* 
BKSPA NOP 
      CCA 
      ADA CHCNT     BACK SPACE
      STA CHCNT       OVER LAST 
      CCA               CHARACER
      ADA BFADD           IN INPUT
      STA BFADD             BUFFER
      JMP BKSPA,I 
* 
      SKP 
* 
******************************
*                            *
* GET CHAR FROM INPUT BUFFER *
*                            *
******************************
GTCHR NOP 
      ISZ CHCNT     ANY CHARACTERS LEFT?
      RSS 
      JMP GTCHR,I   NO, END-OF-FILE EXIT
      LDB BFADD     LOAD BUFFER ADDRESS 
      ISZ BFADD     UPDATE FOR NEXT TIME
      CLE,ERB       SET CHARACTER FLAG
      LDA 1,I       LOAD CURRENT BUFFER WORD
      SEZ,RSS       FIRST CHARACTER?
      ALF,ALF       YES, POSITION IT
      AND B177      MASK EXTRANEOUS BITS
      CPA .32       BLANK?
      JMP GTCHR+1   YES, FETCH NEXT CHARACTER 
      ISZ GTCHR     UPDATE RETURN ADDRESS 
      JMP GTCHR,I     AND EXIT
* 
****************************
*                          *
*  FIND VARIABLE LOCATION  *
*                          *
****************************
* 
*  EXITS (P+1) IF STRING VARIABLE OR (P+2) IF ARRAY OR
*  SIMPLE VARIABLE.  IN BOTH CASES (B) POINTS AT THE LOCATION 
*  OF THE VARIABLE'S VALUE. 
* 
LCVAR NOP 
      JSB VARBL     GET VARIABLE NAME 
      JSB ERROR     NOT LEGAL 
E10   NOP 
      STA SCHAR     SAVE NEXT CHAR
      LDA VNAM      VARIABLE SYMBOL 
      JSB SSYMT     FIND LOCATION IN SYMBOL TABLE 
      INB,SZB,RSS   IS IT THERE?
      JSB ERROR     NO
E11   AND .15       CHECK TYPE
      SZA,RSS       STRING VARIABLE?
      JMP LCVA1     YES 
      ADA M4        IS IT 
      SSA,RSS         AND ARRAY?
      JMP LCVA2     NO! 
      STB TEMP3     YES, SAVE PTR TO VARIABLE 
      INB 
      LDA 1,I       SAVE
      AND B377        ROW 
      STA TEMP4         BOUNDS! 
      LDA 1,I       GET 
      ALF,ALF         COLUMN
      AND B377          BOUNDS
      CMA,INA       IS IT 
      ADA SUBS1       OUT OF
      SSA,RSS           RANGE?
      JSB ERROR     YES!
E12   LDA SUBS1     NO, IS
      MPY TEMP4 
      LDB TEMP4     IS
      CMB,INB         COLUMN
      ADB SUBS2         BOUND 
      SSB,RSS             OUT OF RANGE? 
      JMP E12-1     YES!
      STA 1 
      ADB SUBS2     COMPUTE 
      BLS             ARRAY 
      ADB TEMP3,I       DISPLACEMENT
LCVA2 ISZ LCVAR     SIMPLE ARRAY VARIABLE (P+2) 
LCVA1 JMP LCVAR,I   STRING VARIABLE (P+1) 
      SKP 
* 
******************************
*                            *
* CHECK FOR VARIABLE OPERAND *
*                            *
******************************
VARBL NOP 
      JSB LTR       LETTER? 
      JMP VARBL,I   NO, EXIT VIA (P+1)
      ISZ VARBL 
      CPA B50       LEFT PARENTHESIS? 
      JMP VARO5     YES 
      CPA B133      LEFT BRACKET? 
      JMP VARO5     YES!
      CPA B44       DOLLAR SIGN?
      JMP VARO6     YES, STRING VARAIBLE! 
      ISZ VARBL     NO
      JSB DIGCK    DIGIT? 
      JMP VARO1     NO
      LDA TEMP1    YES, RETRIEVE LETTER,
      ADB .48       AND RESTORE ASCII DIGIT 
      STB TEMP1 
      JSB STROP     RECORD VARIABLE 
      JSB GTCHR    FETCH FOLLOWING
      LDA .10         CHARACTER 
      JMP VARO2 
VARO1 LDA TEMP1    RETRIEVE LETTER, 
      LDB .47         SET 'NO DIGIT', 
      JSB STROP        AND RECORD VARIABLE
      LDA TEMP2     RETRIEVE FOLLOWING CHARACTER
VARO2 STA TEMP2     SAVE CHARACTER
      JMP VARBL,I   NO, EXIT VIA (P+3)
VARO5 LDA TEMP1     RETRIEVE LETTER 
      LDB .46       RECORD
      JSB STROP       ARRAY IDENTIFIER
      LDA B50       RETRIEVE LEFT PAREN 
VARO7 JSB SBSCK     FETCH SUBSCRIPT 
      NOP 
      JMP VARBL,I   EXIT VIA (P+2)
      SPC 1 
VARO6 LDA TEMP1     RECORD STRING VARIABLE
      LDB B53 
      JSB STROP 
      CLA           SET SUBSCRIPTS
      CCB             INITIALLY TO
      DST SUBS1         TO 0,-1 
      JSB GTCHR     GET 
      LDA .10         NEXT CHARACTER
      JMP VARO7     FETCH SUBSCRIPT 
      SKP 
******************
*                *
* FETCH A LETTER *
*                *
******************
LTR   NOP 
      JSB GTCHR 
      LDA .10 
      JSB LETCK    LETTER?
      JMP LTR,I    NO, EXIT VIA (P+1) 
      ISZ LTR      YES, 
      STA TEMP1      SAVE IT
      JSB GTCHR    NEXT CHARACTER 
      LDA .10         TO (A)
      STA TEMP2     SAVE SECOND CHARACTER 
      JMP LTR,I    EXIT VIA (P+2) 
************************* 
*                       * 
* STORE AN OPERAND NAME * 
*                       * 
************************* 
STROP NOP           LETTER IN (A), NUMBER IN (B)
      ADA D100      NUMERICALLY ADJUST THE
      ADB D53         OPERAND NAME
      ALF           COMBINE THE 
      IOR 1           TWO PARTS 
      STA VNAM      STORE VARIABLE NAME 
      JMP STROP,I 
      SKP 
* 
***************************************************** 
* 
*      INTCK WILL BUILD AN INTEGER FROM INPUT 
* 
*      CALL SEQ: (A)=CURRENT CHAR 
*                JSB INTCK
*                DEF (MAX #)
*     RETURN:    (B)=INTEGER
* 
***************************************************** 
* 
* 
********************* 
*                   * 
* FORMAT AN INTEGER * 
*                   * 
********************* 
INTCK NOP           CHARACTER IN (A)
      CLB           STORE 
      STB INTGR       PARTIAL RESULT
INTC1 JSB DIGCK     DIGIT?
      JMP INTC2     NO
      CLO 
      LDB INTGR     MULTIPLY
      ADB 1           PARTIAL 
      ADB 1             RESULT
      ADB INTGR           BY
      ADB 1                 10
      ADB 0         ADD LATEST DIGIT
      SOC           OVERFLOW? 
      JMP INTC3     YES 
      STB INTGR     STORE PARTIAL RESULT
      JSB GTCHR     NO, FETCH 
      LDA .10         NEXT CHARACTER
      JMP INTC1 
INTC2 LDB INTGR     ZERO
      SZB,RSS         INTEGER?
      JMP INTC3     YES 
      LDB INTCK,I   INTEGER 
      LDB 1,I         TOO 
      ADB INTGR         LARGE?
      SSB,RSS 
      JMP INTC3     YES 
      LDB INTGR     NO, 
      ISZ INTCK         INTEGER IN (B)
INTC3 ISZ INTCK     SET FOR 'FAIL' RETURN 
      JMP INTCK,I 
      SKP 
* 
******************************
*                            *
* ASCII-TO-BINARY CONVERSION *
*                            *
******************************
CVNUM NOP           CHARACTER IN (A), SIGN SETE
      CLB 
      STB EXP 
      STB EXPNT     ZERO
      STB MANT1       ALL 
      STB MANT2         COMPONENTS
      STB EXPON           OF NUMBER 
      STB TEMP3     SET 'NUMBER' FLAG FALSE 
      CCB           SET 'DECIMAL POINT' 
      STB DPFLG       FLAG FALSE
NUMC1 CPA .46       DECIMAL POINT?
      ISZ DPFLG     YES, SET FLAG TRUE
      JMP NUMC2     NO
      CLA           INITIALIZE POST-DECIMAL DIGIT 
      STA EXPON       DIGIT COUNTER TO ZERO 
      JMP NUMC3+1   FETCH A CHARACTER 
NUMC2 JSB DIGCK     DIGIT?
      JMP NUMC7     NO
      ISZ EXPON     YES, COUNT DIGIT
      ALF,ALF       LEFT-JUSTIFY
      ALF,RAR         DIGIT AND 
      STA TEMP4         SAVE IT 
      JSB MBY10     MULTIPLY PREVIOUS NUMBER BY 10
      LDB EXPNT 
      SZB           ZERO EXPONENT?
      JMP NUMC4     NO
      LDA .4        YES, SET
      STA EXPNT       EXPONENT TO 4 
      LDA TEMP4     LOAD
      CLB             NUMBER
NUMC3 JSB NORML     NORMALIZE THE NUMBER
      ISZ TEMP3     SET 'NUMBER OCCURRED' FLAG
      JSB GTCHR     ANOTHER CHARACTER?
      JMP NUM12     NO
      JMP NUMC1     YES 
NUMC4 ADB M4        COMPUTE 
      CMB             EXPONENT
      LDA TEMP4         BIAS AND
      STB TEMP4           SAVE IT 
      CLB 
NUMC5 ISZ TEMP4     DIGIT POSITIONED? 
      JMP NUMC6     NO
      CLE           YES, ADD IN 
      ADB MANT2       LOW PART
      CLO               OF NUMBER 
      SEZ           OVERFLOW? 
      INA           YES, BUMP (A) 
      ADA MANT1     ADD IN HIGH PART OF NUMBER
      SOS           OVERFLOW? 
      JMP NUMC3     NO
      SKP 
      CLE,ERA       YES, ROTATE 
      ERB             DOWN AND
      ISZ EXPNT         BUMP
      NOP                 EXPONENT
      JMP NUMC3 
NUMC6 CLE,ERA       SHIFT 
      ERB             DIGIT 
      JMP NUMC5         RIGHT 
NUMC7 CLB           DECIMAL POINT 
      STB TEMP4 
      CPB TEMP3       OR DIGIT FOUND? 
      JMP CVNUM,I   NO, EXIT VIA (P+1)
      CPA E         YES, 'E' ?
      RSS           YES 
      JMP NUM12     NO, NO EXPONENT PART
      JSB GTCHR 
      JMP NUMER 
      CPA .43       '+' ? 
      JMP NUMC8     YES 
      CPA .45       NO, '-' ? 
      CCA,RSS       YES 
      JMP NUMC9     NO
      STA TEMP4     NOTE MINUS SIGN 
NUMC8 JSB GTCHR 
      JMP NUMER 
NUMC9 JSB DIGCK     DIGIT?
      JMP NUMER     NO
      STA TEMP3     YES, SAVE IT
      JSB GTCHR 
      JMP NUM10     SECOND
      JSB DIGCK       DIGIT?
      JMP NUM10     NO
      LDB TEMP3     YES 
      BLS,BLS       MULTIPLY
      ADB TEMP3       PRIOR DIGIT 
      BLS               BY 10 
      ADA 1         ADD NEW DIGIT 
      STA TEMP3     SAVE EXPONENT 
      JSB GTCHR 
      JMP NUM10     THIRD 
      JSB DIGCK       DIGIT?
      RSS           NO
      JMP NUMER     YES 
NUM10 LDA TEMP3     LOAD EXPONENT 
      ISZ TEMP4     POSITIVE? 
      CMA,INA       YES, COMPLEMENT IT
      RSS           NO
NUM12 CLA           CLEAR IF NO EXPONENT PART 
      ISZ DPFLG     DECIMAL POINT?
      ADA EXPON     YES, CORRECT EXPONENT 
      SZA,RSS       ZERO EXPONENT?
      JMP NUM14     YES 
      SKP 
      SSA           NO, NEGATIVE EXPONENT?
      JMP NUM13     NO
      CMA,INA       YES, SET
      STA EXPON       COUNTER 
      JSB DBY10     DIVIDE NUMBER BY 10 
      ISZ EXPON     DONE? 
      JMP *-2       NO
      JMP NUM14     YES 
NUM13 STA EXPON     SET COUNTER 
      JSB MBY10     MULTIPLY BY 10
      ISZ EXPON     DONE? 
      JMP *-2       NO
NUM14 LDA EXPNT 
      STA EXP 
      LDA MANT1     YES, LOAD 
      LDB MANT2       NUMBER
      ISZ SIGN      POSITIVE? 
      JMP NUM15     YES 
      CMA           NO, 
      CMB,INB,SZB,RSS   COMPLEMENT
      INA                IT 
NUM15 JSB .PACK     PACK NUMBER INTO (A) AND (B)
EXP   BSS 1           EXPONENT
      ISZ CVNUM 
NUMER ISZ CVNUM     RETURN
      JMP CVNUM,I     VIA (P+2) OR (P+3)
EXPON BSS 1 
*TENTH OCT 63146   **REMOVED 790822**************************** 
DPFLG BSS 1 
E     OCT 105 
      SKP 
      SKP 
****************************
*                          *
* CHECK FOR SUBSCRIPT PART *
*                          *
****************************
SBSCK NOP          CHARACTER IN (A) 
      CPA B50       LEFT PAREN? 
      JMP SBSC0     YES!
      CPA B133      LEFT BRACK? 
      RSS           YES!
      JMP SBSCK,I  NO, RETURN VIA (P+1) 
SBSC0 ISZ SBSCK    YES, SET RETURN TO (P+2) 
      JSB GTCHR     GET DIGIT 
      JMP E10-1     NONE! 
      JSB INTCK     FETCH INTEGER 
      DEF M256        SUBSCRIPT BOUND 
      JMP E12-1     OVERFLOW
      ADB M1        BIAS BY -1
      STB SUBS1     STORE FIRST SUBSCRIPT 
      CPA B54       COMMA?
      RSS           YES!
      JMP SBSC1     NO
      JSB GTCHR     GET DIGIT 
      JMP E10-1     NONE! 
      JSB INTCK     FETCH SECOND
      DEF M256        INTEGER SUBSCRIPT BOUND 
      JMP E12-1     OVERFLOW
      JMP SBSC2 
SBSC1 SWP 
      LDA VNAM      IS THIS 
      AND .15         A 
      SZA,RSS           STRING? 
      JMP SBSC3     YES 
      SWP           NO! 
      CLB,INB       SET ONE DIMENSIONAL CASE
SBSC2 ADB M1        BIAS BY -1
      STB SUBS2     SAVE SECOND DIMENSION 
SBSC4 CPA B51       RT PAREN? 
      JMP SBSC5     YES!
      CPA B135      RT BRACKET? 
      RSS           YES 
      JMP E10-1     NO, CLOSING PAREN 
SBSC5 JSB GTCHR    FETCH FOLLOWING
      LDA .10         CHARACTER 
      JMP SBSCK,I   YES 
SBSC3 CCA           SET ONE DIMENSIONAL 
      STA SUBS2       FOR STRINGS 
      SWP 
      JMP SBSC4 
* 
VNAM  BSS 1 
SUBS1 BSS 1 
SUBS2 BSS 1 
* 
      SKP 
*********************** 
*                     * 
* PRINT ERROR MESSAGE * 
*                     * 
*********************** 
ERROR NOP 
      LDB ERROR     ERROR SOURCE IN (B) 
      LDA ERBS      ERROR ADDRESS IN (A)
      INA           MOVE TO NEXT ERROR
      CPB 0,I       SAME AS ACTUAL ERROR? 
      CMA,INA,RSS   YES, MAKE ERROR NEGATIVE
      JMP *-3       NO
      ADA ERBS      MAKE ERROR POSITIVE 
PRMES LDB ERTTY     RESET OUTPUT
      STB LUOUT       L.U. # TO ERROR DEVICE
      STA TEMP3     SAVE FOR COUNTER
      LDB MESGA   SET TABLE PNTR TO START 
PRMS1 LDA 1,I     GET LENGTH OF MESSAGE 
      INB          MOVE PNTR TO MESSAGE 
      ISZ TEMP3   INDEX ERROR CNTR, IS IT = 0?
      RSS          NO, MOVE PNTR TO NEXT MESSG
      JMP PRMS2     YES - GO PRINT MESSAGE
      SLA         IF CHAR COUNT ODD,
      INA          MAKE EVEN
      ARS           CONVERT TO WORDS
      ADB 0          MOVE PNTR TO NEXT MESSG
      JMP PRMS1   GO INDEX ERROR COUNTER
* 
PRMS2 JSB WRITE         PRINT ERROR MESSAGE 
      JMP NXCOM 
* 
      SKP 
*********************** 
*                     * 
* ERROR MESSAGE TABLE * 
*                     * 
*********************** 
      SPC 1 
*  ERROR MESSAGES FOR DEBUG PHASE 
      SPC 1 
MESGA DEF *+1       ADDRESS OF ERRORS 
      DEC 15
      ASC 8,ILLEGAL COMMAND 
      DEC 14
      ASC 7,INVALID NUMBER
      DEC 13
      ASC 7,NO PARAMETERS 
      DEC 13
      ASC 7,BAD DELIMITER 
      DEC 14
      ASC 7,NO EQUALS SIGN
      DEC 22
      ASC 11,NEGATIVE STRING LENGTH 
      DEC 21
      ASC 11,NON-CONTIGUOUS STRING
      DEC 15
      ASC 8,STRING OVERFLOW 
      DEC 16
      ASC 8,INVALID VARIABLE
      DEC 18
      ASC 9,VARIABLE NOT FOUND
      DEC 22
      ASC 11,SUBSCRIPT OUT OF RANGE 
      DEC 14
      ASC 7,INVALID LIMITS
      DEC 24
      ASC 12,UNDEFINED VALUE ACCESSED 
      DEC 23
      ASC 12,MORE THAN 4 BREAKPOINTS
      DEC 22
      ASC 11,BREAKPOINT ALREADY SET 
      DEC 16      **800109**
      ASC 8,NO CALLS DEFINED          **800109**
      SKP 
*************** 
*             * 
* ERROR TABLE * 
*             * 
*************** 
ERBS  DEF * 
      DEF E1        ILLEGAL COMMAND 
      DEF E2        INVALID NUMBER
      DEF E3        NO PARAMETERS 
      DEF E4        BAD DELIMITER 
      DEF E5        NO EQUALS SIGN
      DEF E7        NEGATIVE STRING LENGTH
      DEF E8        NON-CONTIGUOUS STRING 
      DEF E9        STRING OVERFLOW 
      DEF E10       INVALID VARIABLE
      DEF E11       VARIABLE NOT FOUND
      DEF E12       SUBSCRIPT OUT OR RANGE
      DEF E13       INVALID LIMITS
      DEF E14       UNDEFINED VALUE ACCESSED
      DEF E15       MORE THAN 4 BREAKPOINTS 
      DEF E16       BREAKPOINT ALREADY SET
      DEF CERR9     NO CALLS DEFINED         **800109** 
      SKP 
TEMP  EQU TEMPS+1 
TEMP1 EQU TEMPS+2 
TEMP2 EQU TEMPS+3 
TEMP3 EQU TEMPS+4 
TEMP4 EQU TEMPS+5 
TEMP5 EQU TEMPS+6 
TEMP6 EQU TEMPS+7 
TEMP7 EQU TEMPS+8 
TEMP8 EQU TEMPS+9 
TEMP9 EQU TEMPS+10
TEM10 EQU TEMPS+11
TEM11 EQU TEMPS+12  CURRENT LINE NUMBER 
COUNT EQU TEMPT+1 
SCHAR EQU TEMPT+2 
CCODE EQU TEMPT+2 
ARYAD EQU TEMPT+3 
RFLAG EQU TEMPT+4 
TABLE EQU TEMPT+4 
SMEND EQU TEMPT+5 
SLENG EQU TEMPT+6 
TBLPT EQU TEMPT+7 
TSPTR EQU TEMPT+8 
LNGTH EQU TEMPT+9 
FERR  EQU TEMPT+10
CHCNT EQU TEMPT+12  CHAR COUNT
BFADD EQU TEMPT+14  CURRENT ADDRESS 
INTGR EQU TEMPT+15  INTEGER 
* 
      END BASC7