                               
UART      EQU  $A000           
RECEV     EQU  UART+1          
TRANS     EQU  UART+1          
USTAT     EQU  UART            
UCTRL     EQU  UART            
                               
BS        EQU  8              BACKSPACE 
CR        EQU  $D             ENTER KEY 
ESC       EQU  $1B            ESCAPE CODE 
SPACE     EQU  $20            SPACE (BLANK) 
STKBUF    EQU  58             STACK BUFFER ROOM 
LBUFMX    EQU  250            MAX NUMBER OF CHARS IN A BASIC LINE 
MAXLIN    EQU  $FA            MAXIMUM MS BYTE OF LINE NUMBER 
* PSEUDO OPS                      
SKP1      EQU  $21            OP CODE OF BRN — SKIP ONE BYTE 
SKP2      EQU  $8C            OP CODE OF CMPX # - SKIP TWO BYTES 
SKP1LD    EQU  $86            OP CODE OF LDA # - SKIP THE NEXT BYTE 
*                             AND LOAD THE VALUE OF THAT BYTE INTO ACCA — THIS 
*                             IS USUALLY USED TO LOAD ACCA WITH A NON ZERO VALUE 
RTS_LOW   EQU  $95             
          ORG  0               
ENDFLG    RMB  1              STOP/END FLAG: POSITIVE=STOP, NEG=END 
CHARAC    RMB  1              TERMINATOR FLAG 1 
ENDCHR    RMB  1              TERMINATOR FLAG 2 
TMPLOC    RMB  1              SCRATCH VARIABLE 
IFCTR     RMB  1              IF COUNTER - HOW MANY IF STATEMENTS IN A LINE 
DIMFLG    RMB  1              *DV* ARRAY FLAG 0=EVALUATE, 1=DIMENSIONING 
VALTYP    RMB  1              *DV* *PV TYPE FLAG: 0=NUMERIC, $FF=STRING 
GARBFL    RMB  1              *TV STRING SPACE HOUSEKEEPING FLAG 
ARYDIS    RMB  1              DISABLE ARRAY SEARCH: 00=ALLOW SEARCH 
INPFLG    RMB  1              *TV INPUT FLAG: READ=0, INPUT<>0 
RELFLG    RMB  1              *TV RELATIONAL OPERATOR FLAG 
TEMPPT    RMB  2              *PV TEMPORARY STRING STACK POINTER 
LASTPT    RMB  2              *PV ADDR OF LAST USED STRING STACK ADDRESS 
TEMPTR    RMB  2              TEMPORARY POINTER 
TMPTR1    RMB  2              TEMPORARY DESCRIPTOR STORAGE (STACK SEARCH) 
FPA2      RMB  4              FLOATING POINT ACCUMULATOR #2 MANTISSA 
BOTSTK    RMB  2              BOTTOM OF STACK AT LAST CHECK 
TXTTAB    RMB  2              *PV BEGINNING OF BASIC PROGRAM 
VARTAB    RMB  2              *PV START OF VARIABLES 
ARYTAB    RMB  2              *PV START OF ARRAYS 
ARYEND    RMB  2              *PV END OF ARRAYS (+1) 
FRETOP    RMB  2              *PV START OF STRING STORAGE (TOP OF FREE RAM) 
STRTAB    RMB  2              *PV START OF STRING VARIABLES 
FRESPC    RMB  2              UTILITY STRING POINTER 
MEMSIZ    RMB  2              *PV TOP OF STRING SPACE 
OLDTXT    RMB  2              SAVED LINE NUMBER DURING A "STOP" 
BINVAL    RMB  2              BINARY VALUE OF A CONVERTED LINE NUMBER 
OLDPTR    RMB  2              SAVED INPUT PTR DURING A "STOP" 
TINPTR    RMB  2              TEMPORARY INPUT POINTER STORAGE 
DATTXT    RMB  2              *PV 'DATA' STATEMENT LINE NUMBER POINTER 
DATPTR    RMB  2              *PV 'DATA' STATEMENT ADDRESS POINTER 
DATTMP    RMB  2              DATA POINTER FOR 'INPUT' & 'READ' 
VARNAM    RMB  2              *TV TEMP STORAGE FOR A VARIABLE NAME 
VARPTR    RMB  2              *TV POINTER TO A VARIABLE DESCRIPTOR 
VARDES    RMB  2              TEMP POINTER TO A VARIABLE DESCRIPTOR 
RELPTR    RMB  2              POINTER TO RELATIONAL OPERATOR PROCESSING ROUTINE 
TRELFL    RMB  1              TEMPORARY RELATIONAL OPERATOR FLAG BYTE 
* FLOATING POINT ACCUMULATORS #3,4 & 5 ARE MOSTLY                      
* USED AS SCRATCH PAD VARIABLES.                      
** FLOATING POINT ACCUMULATOR #3 :PACKED: ($40-$44)                      
V40       RMB  1               
V41       RMB  1               
V42       RMB  1               
V43       RMB  1               
V44       RMB  1               
** FLOATING POINT ACCUMULATOR #4 :PACKED: ($45-$49)                      
V45       RMB  1               
V46       RMB  1               
V47       RMB  1               
V48       RMB  2               
** FLOATING POINT ACCUMULATOR #5 :PACKED: ($4A—$4E)                      
V4A       RMB  1               
V4B       RMB  2               
V4D       RMB  2               
** FLOATING POINT ACCUMULATOR #0                      
FP0EXP    RMB  1              *PV FLOATING POINT ACCUMULATOR #0 EXPONENT 
FPA0      RMB  4              *PV FLOATING POINT ACCUMULATOR #0 MANTISSA 
FP0SGN    RMB  1              *PV FLOATING POINT ACCUMULATOR #0 SIGN 
COEFCT    RMB  1              POLYNOMIAL COEFFICIENT COUNTER 
STRDES    RMB  5              TEMPORARY STRING DESCRIPTOR 
FPCARY    RMB  1              FLOATING POINT CARRY BYTE 
** FLOATING POINT ACCUMULATOR #1                      
FP1EXP    RMB  1              *PV FLOATING POINT ACCUMULATOR #1 EXPONENT 
FPA1      RMB  4              *PV FLOATING POINT ACCUMULATOR #1 MANTISSA 
FP1SGN    RMB  1              *PV FLOATING POINT ACCUMULATOR #1 SIGN 
RESSGN    RMB  1              SIGN OF RESULT OF FLOATING POINT OPERATION 
FPSBYT    RMB  1              FLOATING POINT SUB BYTE (FIFTH BYTE) 
COEFPT    RMB  2              POLYNOMIAL COEFFICIENT POINTER 
LSTTXT    RMB  2              CURRENT LINE POINTER DURING LIST 
CURLIN    RMB  2              *PV CURRENT LINE # OF BASIC PROGRAM, $FFFF = DIRECT 
DEVCFW    RMB  1              *TV TAB FIELD WIDTH 
DEVLCF    RMB  1              *TV TAB ZONE 
DEVPOS    RMB  1              *TV PRINT POSITION 
DEVWID    RMB  1              *TV PRINT WIDTH 
RSTFLG    RMB  1              *PV WARM START FLAG: $55=WARM, OTHER=COLD 
RSTVEC    RMB  2              *PV WARM START VECTOR - JUMP ADDRESS FOR WARM START 
TOPRAM    RMB  2              *PV TOP OF RAM 
IKEYIM    RMB  1              *TV INKEY$ RAM IMAGE 
ZERO      RMB  2              *PV DUMMY - THESE TWO BYTES ARE ALWAYS ZERO 
* THE FOLLOWING BYTES ARE MOVED DOWN FROM ROM                      
LPTCFW    RMB  1              16 
LPTLCF    RMB  1              112 
LPTWID    RMB  1              132 
LPTPOS    RMB  1              0 
EXECJP    RMB  2              LB4AA 
                               
* THIS ROUTINE PICKS UP THE NEXT INPUT CHARACTER FROM                      
* BASIC. THE ADDRESS OF THE NEXT BASIC BYTE TO BE                      
* INTERPRETED IS STORED AT CHARAD.                      
GETNCH    INC  <CHARAD+1      *PV INCREMENT LS BYTE OF INPUT POINTER 
          BNE  GETCCH         *PV BRANCH IF NOT ZERO (NO CARRY) 
          INC  <CHARAD        *PV INCREMENT MS BYTE OF INPUT POINTER 
GETCCH    FCB  $B6            *PV OP CODE OF LDA EXTENDED 
CHARAD    RMB  2              *PV THESE 2 BYTES CONTAIN ADDRESS OF THE CURRENT 
*         *    CHARACTER WHICH THE BASIC INTERPRETER IS  
*         *    PROCESSING      
          JMP  BROMHK         JUMP BACK INTO THE BASIC RUM 
                               
VAB       RMB  1              = LOW ORDER FOUR BYTES OF THE PRODUCT 
VAC       RMB  1              = OF A FLOATING POINT MULTIPLICATION 
VAD       RMB  1              = THESE BYTES ARE USE AS RANDOM DATA 
VAE       RMB  1              = BY THE RND STATEMENT 
                               
* EXTENDED BASIC VARIABLES                      
TRCFLG    RMB  1              *PV TRACE FLAG 0=OFF ELSE=ON 
USRADR    RMB  2              *PV ADDRESS OF THE START OF USR VECTORS 
                               
* EXTENDED BASIC SCRATCH PAD VARIABLES                      
VCF       RMB  2               
VD1       RMB  2               
VD3       RMB  2               
VD5       RMB  2               
VD7       RMB  1               
VD8       RMB  1               
VD9       RMB  1               
VDA       RMB  1               
SW3VEC    RMB  3               
SW2VEC    RMB  3               
SWIVEC    RMB  3               
NMIVEC    RMB  3               
IRQVEC    RMB  3               
FRQVEC    RMB  3               
USRJMP    RMB  3              JUMP ADDRESS FOR BASIC'S USR FUNCTION 
RVSEED    RMB  1              * FLOATING POINT RANDOM NUMBER SEED EXPONENT 
          RMB  4              * MANTISSA: INITIALLY SET TO $804FC75259 
                               
**** USR FUNCTION VECTOR ADDRESSES (EX BASIC ONLY)                      
USR0      RMB  2              USR 0 VECTOR 
          RMB  2              USR 1 
          RMB  2              USR 2 
          RMB  2              USR 3 
          RMB  2              USR 4 
          RMB  2              USR 5 
          RMB  2              USR 6 
          RMB  2              USR 7 
          RMB  2              USR 8 
          RMB  2              USR 9 
                               
STRSTK    RMB  8*5            STRING DESCRIPTOR STACK 
LINHDR    RMB  2              LINE INPUT BUFFER HEADER 
LINBUF    RMB  LBUFMX+1       BASIC LINE INPUT BUFFER 
STRBUF    RMB  41             STRING BUFFER 
                               
PROGST    RMB  1              START OF PROGRAM SPACE 
*         INTERRUPT VECTORS                 
          ORG  $FFF2           
SWI3      RMB  2               
SWI2      RMB  2               
FIRQ      RMB  2               
IRQ       RMB  2               
SWI       RMB  2               
NMI       RMB  2               
RESETV    RMB  2               
                               
                               
                               
          ORG  $DB00           
                               
* CONSOLE IN                      
LA171     BSR  KEYIN          GET A CHARACTER FROM CONSOLE IN 
          BEQ  LA171          LOOP IF NO KEY DOWN 
          RTS                  
                               
*                              
* THIS ROUTINE GETS A KEYSTROKE FROM THE KEYBOARD IF A KEY                      
* IS DOWN. IT RETURNS ZERO TRUE IF THERE WAS NO KEY DOWN.                      
*                              
*                              
LA1C1                          
KEYIN     LDA  USTAT           
          BITA #1              
          BEQ  NOCHAR          
          LDA  RECEV           
          ANDA #$7F            
          RTS                  
NOCHAR    CLRA                 
          RTS                  
                               
                               
                               
* CONSOLE OUT                      
PUTCHR    BSR  WAITACIA        
          PSHS A               
          CMPA #CR            IS IT CARRIAGE RETURN? 
          BEQ  NEWLINE        YES 
          STA  TRANS           
          INC  LPTPOS         INCREMENT CHARACTER COUNTER 
          LDA  LPTPOS         CHECK FOR END OF LINE PRINTER LINE 
          CMPA LPTWID         AT END OF LINE PRINTER LINE? 
          BLO  PUTEND         NO 
NEWLINE   CLR  LPTPOS         RESET CHARACTER COUNTER 
          BSR  WAITACIA        
          LDA  #13             
          STA  TRANS           
          BSR  WAITACIA        
          LDA  #10            DO LINEFEED AFTER CR 
          STA  TRANS           
PUTEND    PULS A               
          RTS                  
                               
WAITACIA  PSHS A               
WRWAIT    LDA  USTAT           
          BITA #2              
          BEQ  WRWAIT          
          PULS A               
          RTS                  
                               
*                              
RESVEC                         
LA00E     LDS  #LINBUF+LBUFMX+1 SET STACK TO TOP OF LINE INPUT BUFFER 
          LDA  RSTFLG         GET WARM START FLAG 
          CMPA #$55           IS IT A WARM START? 
          BNE  BACDST         NO - D0 A COLD START 
          LDX  RSTVEC         WARM START VECTOR 
          LDA  ,X             GET FIRST BYTE OF WARM START ADDR 
          CMPA #$12           IS IT NOP? 
          BNE  BACDST         NO - DO A COLD START 
          JMP  ,X             YES, G0 THERE 
                               
* COLD START ENTRY                      
                               
BACDST    LDX  #PROGST+1      POINT X TO CLEAR 1ST 1K OF RAM 
LA077     CLR  ,--X           MOVE POINTER DOWN TWO-CLEAR BYTE 
          LEAX 1,X            ADVANCE POINTER ONE 
          BNE  LA077          KEEP GOING IF NOT AT BOTTOM OF PAGE 0 
          LDX  #PROGST        SET TO START OF PROGRAM SPACE 
          CLR  ,X+            CLEAR 1ST BYTE OF BASIC PROGRAM 
          STX  TXTTAB         BEGINNING OF BASIC PROGRAM 
LA084     LDA  2,X            LOOK FOR END OF MEMORY 
          COMA                * COMPLEMENT IT AND PUT IT BACK 
          STA  2,X            * INTO SYSTEM MEMORY 
          CMPA 2,X            IS IT RAM? 
          BNE  LA093          BRANCH IF NOT (ROM, BAD RAM OR NO RAM) 
          LEAX 1,X            MOVE POINTER UP ONE 
          COM  1,X            RE-COMPLEMENT TO RESTORE BYTE 
          BRA  LA084          KEEP LOOKING FOR END OF RAM 
LA093     STX  TOPRAM         SAVE ABSOLUTE TOP OF RAM 
          STX  MEMSIZ         SAVE TOP OF STRING SPACE 
          STX  STRTAB         SAVE START OF STRING VARIABLES 
          LEAX -200,X         CLEAR 200 - DEFAULT STRING SPACE TO 200 BYTES 
          STX  FRETOP         SAVE START OF STRING SPACE 
          TFR  X,S            PUT STACK THERE 
          LDX  #LA10D         POINT X TO ROM SOURCE DATA 
          LDU  #LPTCFW        POINT U TO RAM DESTINATION 
          LDB  #18            MOVE 18 BYTES 
          JSR  LA59A          MOVE 18 BYTES FROM ROM TO RAM 
          LDU  #IRQVEC        POINT U TO NEXT RAM DESTINATION 
          LDB  #4             MOVE 4 MORE BYTES 
          JSR  LA59A          MOVE 4 BYTES FROM ROM TO RAM 
          LDA  #$39            
          STA  LINHDR-1       PUT RTS IN LINHDR-1 
          JSR  LAD19          G0 DO A ‘NEW’ 
* EXTENDED BASIC INITIALISATION                      
          LDX  #USR0          INITIALIZE ADDRESS OF START OF 
          STX  USRADR         USR JUMP TABLE 
* INITIALIZE THE USR CALLS TO ‘FC ERROR’                      
          LDU  #LB44A         ADDRESS OF ‘FC ERROR’ ROUTINE 
          LDB  #10            10 USR CALLS IN EX BASIC 
L8031     STU  ,X++           STORE ‘FC’ ERROR AT USR ADDRESSES 
          DECB                FINISHED ALL 10? 
          BNE  L8031          NO 
                               
* INITIALISE ACIA                      
          LDA  #RTS_LOW       DIV16 CLOCK -> 7372800 / 4 / 16 = 115200 
          STA  UCTRL           
          LDX  #LA147-1       POINT X TO COLOR BASIC COPYRIGHT MESSAGE 
          JSR  LB99C          PRINT ‘COLOR BASIC’ 
          LDX  #BAWMST        WARM START ADDRESS 
          STX  RSTVEC         SAVE IT 
          LDA  #$55           WARM START FLAG 
          STA  RSTFLG         SAVE IT 
          BRA  LA0F3          GO TO BASIC’S MAIN LOOP 
BAWMST    NOP  NOP REQ’D FOR WARM START  
          JSR  LAD33          DO PART OF A NEW 
LA0F3     JMP  LAC73          GO TO MAIN LOOP OF BASIC 
*                              
* FIRQ SERVICE ROUTINE                      
BFRQSV                         
          RTI                  
*                              
* THESE BYTES ARE MOVED TO ADDRESSES $76 - $85 THE DIRECT PAGE                      
LA10D     FCB  16             TAB FIELD WIDTH 
          FCB  64             LAST TAB ZONE 
          FCB  80             PRINTER WIDTH 
          FCB  0              LINE PRINTER POSITION 
          FDB  LB44A          ARGUMENT OF EXEC COMMAND - SET TO ‘FC’ ERROR 
* LINE INPUT ROUTINE                      
          INC  CHARAD+1        
          BNE  LA123           
          INC  CHARAD          
LA123     LDA  >0000           
          JMP  BROMHK          
*                              
* THESE BYTES ARE MOVED TO ADDRESSES $A7-$B1                      
          JMP  BIRQSV         IRQ SERVICE 
          JMP  BFRQSV         FIRQ SERVICE 
          JMP  LB44A          USR ADDRESS FOR 8K BASIC (INITIALIZED TO ‘FC’ ERROR) 
          FCB  $80            *RANDOM SEED 
          FDB  $4FC7          *RANDON SEED OF MANTISSA 
          FDB  $5259          *.811635157 
* BASIC COMMAND INTERPRETATION TABLE ROM IMAGE                      
COMVEC    FCB  50             50 BASIC COMMANDS 
          FDB  LAA66          POINTS TO RESERVED WORDS 
          FDB  LAB67          POINTS TO JUMP TABLE FOR COMMANDS 
          FCB  29             29 BASIC SECONDARY COMMANDS 
          FDB  LAB1A          POINTS TO SECONDARY FUNCTION RESERVED WORDS 
          FDB  LAA29          POINTS TO SECONDARY FUNCTION JUMP TABLE 
          FDB  0              NO MORE TABLES (RES WORDS=0) 
          FDB  0              NO MORE TABLES 
          FDB  0              NO MORE TABLES 
          FDB  0              NO MORE TABLES 
          FDB  0              NO MORE TABLES 
          FDB  0              NO MORE TABLES (SECONDARY FNS =0) 
                               
* COPYRIGHT MESSAGES                      
LA147     FCC  "6809 EXTENDED BASIC"  
          FCB  CR              
          FCC  "(C) 1982 BY MICROSOFT"  
LA156     FCB  CR,CR           
LA165     FCB  $00             
                               
                               
LA35F     PSHS X,B,A          SAVE REGISTERS 
          LDX  LPTCFW         TAB FIELD WIDTH AND TAB ZONE 
          LDD  LPTWID         PRINTER WIDTH AND POSITION 
LA37C     STX  DEVCFW         SAVE TAB FIELD WIDTH AND ZONE 
          STB  DEVPOS         SAVE PRINT POSITION 
          STA  DEVWID         SAVE PRINT WIDTH 
          PULS A,B,X,PC       RESTORE REGISTERS 
                               
* THIS IS THE ROUTINE THAT GETS AN INPUT LINE FOR BASIC                      
* EXIT WITH BREAK KEY: CARRY = 1                      
* EXIT WITH ENTER KEY: CARRY = 0                      
LA38D                          
LA390     CLR  IKEYIM         RESET BREAK CHECK KEY TEMP KEY STORAGE 
          LDX  #LINBUF+1      INPUT LINE BUFFER 
          LDB  #1             ACCB CHAR COUNTER: SET TO 1 TO ALLOW A 
*         BACKSPACE AS FIRST CHARACTER  
LA39A     JSR  LA171          GO GET A CHARACTER FROM CONSOLE IN 
          CMPA #BS            BACKSPACE 
          BNE  LA3B4          NO 
          DECB                YES - DECREMENT CHAR COUNTER 
          BEQ  LA390          BRANCH IF BACK AT START OF LINE AGAIN 
          LEAX -1,X           DECREMENT BUFFER POINTER 
          BRA  LA3E8          ECHO CHAR TO SCREEN 
LA3B4     CMPA #$15           SHIFT RIGHT ARROW? 
          BNE  LA3C2          NO 
* YES, RESET BUFFER TO BEGINNING AND ERASE CURRENT LINE                      
LA3B8     DECB                DEC CHAR CTR 
          BEQ  LA390          GO BACK TO START IF CHAR CTR = 0 
          LDA  #BS            BACKSPACE? 
          JSR  PUTCHR         SEND TO CONSOLE OUT (SCREEN) 
          BRA  LA3B8          KEEP GOING 
LA3C2     CMPA #3             BREAK KEY? 
          ORCC #1             SET CARRY FLAG 
          BEQ  LA3CD          BRANCH IF BREAK KEY DOWN 
LA3C8     CMPA #CR            ENTER KEY? 
          BNE  LA3D9          NO 
LA3CC     CLRA                CLEAR CARRY FLAG IF ENTER KEY - END LINE ENTRY 
LA3CD     PSHS CC             SAVE CARRY FLAG 
          JSR  LB958          SEND CR TO SCREEN 
          CLR  ,X             MAKE LAST BYTE IN INPUT BUFFER = 0 
          LDX  #LINBUF        RESET INPUT BUFFER POINTER 
          PULS CC,PC          RESTORE CARRY FLAG 
                               
* INSERT A CHARACTER INTO THE BASIC LINE INPUT BUFFER                      
LA3D9     CMPA #$20           IS IT CONTROL CHAR? 
          BLO  LA39A          BRANCH IF CONTROL CHARACTER 
          CMPA #'z+1          * 
          BCC  LA39A          * IGNORE IF > LOWER CASE Z 
          CMPB #LBUFMX        HAVE 250 OR MORE CHARACTERS BEEN ENTERED? 
          BCC  LA39A          YES, IGNORE ANY MORE 
          STA  ,X+            PUT IT IN INPUT BUFFER 
          INCB                INCREMENT CHARACTER COUNTER 
LA3E8     JSR  PUTCHR         ECHO IT TO SCREEN 
          BRA  LA39A          GO SET SOME MORE 
                               
                               
* EXEC                         
EXEC      BEQ  LA545          BRANCH IF NO ARGUMENT 
          JSR  LB73D          EVALUATE ARGUMENT - ARGUMENT RETURNED IN X 
          STX  EXECJP         STORE X TO EXEC JUMP ADDRESS 
LA545     JMP  [EXECJP]       GO DO IT 
                               
* BREAK CHECK                      
LA549     JMP  LADEB          GO DO BREAK KEY CHECK 
                               
* INKEY$                       
INKEY     LDA  IKEYIM         WAS A KEY DOWN IN THE BREAK CHECK? 
          BNE  LA56B          YES 
          JSR  KEYIN          GO GET A KEY 
LA56B     CLR  IKEYIM         CLEAR INKEY RAM IMAGE 
          STA  FPA0+3         STORE THE KEY IN FPA0 
          LBNE LB68F          CONVERT FPA0+3 TO A STRING 
          STA  STRDES         SET LENGTH OF STRING = 0 IF NO KEY DOWN 
          JMP  LB69B          PUT A NULL STRING ONTO THE STRING STACK 
                               
* MOVE ACCB BYTES FROM (X) TO (U)                      
LA59A     LDA  ,X+            GET BYTE FROM X 
          STA  ,U+            STORE IT AT U 
          DECB                MOVED ALL BYTES? 
          BNE  LA59A          NO 
LA5A1     RTS                  
                               
LA5C4     RTS                  
                               
** THIS ROUTINE WILL SCAN OFF THE FILE NAME FROM A BASIC LINE                      
** AND RETURN A SYNTAX ERROR IF THERE ARE ANY CHARACTERS                      
** FOLLOWING THE END OF THE NAME                      
LA5C7     JSR  GETCCH         GET CURRENT INPUT CHAR FROM BASIC LINE 
LA5C9     BEQ  LA5C4          RETURN IF END OF LINE 
          JMP  LB277          SYNTAX ERROR IF ANY MORE CHARACTERS 
* IRQ SERVICE                      
BIRQSV                         
LA9C5     RTI  RETURN FROM INTERRUPT  
                               
* SET CARRY IF NUMERIC - RETURN WITH                      
* ZERO FLAG SET IF ACCA = 0 OR 3A(:) - END                      
* OF BASIC LINE OR SUB LINE                      
BROMHK    CMPA #'9+1          IS THIS CHARACTER >=(ASCII 9)+1? 
          BHS  LAA28          BRANCH IF > 9; Z SET IF = COLON 
          CMPA #SPACE         SPACE? 
          BNE  LAA24          NO - SET CARRY IF NUMERIC 
          JMP  GETNCH         IF SPACE, GET NECT CHAR (IGNORE SPACES) 
LAA24     SUBA #'0            * SET CARRY IF 
          SUBA #-'0           * CHARACTER > ASCII 0 
LAA28     RTS                  
                               
* DISPATCH TABLE FOR SECONDARY FUNCTIONS                      
* TOKENS ARE PRECEEDED BY $FF                      
* FIRST SET ALWAYS HAS ONE PARAMETER                      
FUNC_TAB                       
LAA29     FDB  SGN            SGN 
          FDB  INT            INT 
          FDB  ABS            ABS 
          FDB  USRJMP         USR 
TOK_USR   EQU  *-FUNC_TAB/2+$7F  
TOK_FF_USR EQU  *-FUNC_TAB/2+$FF7F  
          FDB  RND            RND 
          FDB  SIN            SIN 
          FDB  PEEK           PEEK 
          FDB  LEN            LEN 
          FDB  STR            STR$ 
          FDB  VAL            VAL 
          FDB  ASC            ASC 
          FDB  CHR            CHR$ 
          FDB  ATN            ATN 
          FDB  COS            COS 
          FDB  TAN            TAN 
          FDB  EXP            EXP 
          FDB  FIX            FIX 
          FDB  LOG            LOG 
          FDB  POS            POS 
          FDB  SQR            SQR 
          FDB  HEXDOL         HEX$ 
* LEFT, RIGHT AND MID ARE TREATED SEPARATELY                      
          FDB  LEFT           LEFT$ 
TOK_LEFT  EQU  *-FUNC_TAB/2+$7F  
          FDB  RIGHT          RIGHT$ 
          FDB  MID            MID$ 
TOK_MID   EQU  *-FUNC_TAB/2+$7F  
* REMAINING FUNCTIONS                      
          FDB  INKEY          INKEY$ 
TOK_INKEY EQU  *-FUNC_TAB/2+$7F  
          FDB  MEM            MEM 
          FDB  VARPT          VARPTR 
          FDB  INSTR          INSTR 
          FDB  STRING         STRING$ 
NUM_SEC_FNS EQU  *-FUNC_TAB/2    
                               
* THIS TABLE CONTAINS PRECEDENCES AND DISPATCH ADDRESSES FOR ARITHMETIC                      
* AND LOGICAL OPERATORS - THE NEGATION OPERATORS DO NOT ACT ON TWO OPERANDS                      
* S0 THEY ARE NOT LISTED IN THIS TABLE. THEY ARE TREATED SEPARATELY IN THE                      
* EXPRESSION EVALUATION ROUTINE. THEY ARE:                      
* UNARY NEGATION (-), PRECEDENCE &7D AND LOGICAL NEGATION (NOT), PRECEDENCE $5A                      
* THE RELATIONAL OPERATORS < > = ARE ALSO NOT LISTED, PRECEDENCE $64.                      
* A PRECEDENCE VALUE OF ZERO INDICATES END OF EXPRESSION OR PARENTHESES                      
*                              
LAA51     FCB  $79             
          FDB  LB9C5          + 
          FCB  $79             
          FDB  LB9BC          - 
          FCB  $7B             
          FDB  LBACC          * 
          FCB  $7B             
          FDB  LBB91          / 
          FCB  $7F             
          FDB  L8489          EXPONENTIATION 
          FCB  $50             
          FDB  LB2D5          AND 
          FCB  $46             
          FDB  LB2D4          OR 
                               
* THIS IS THE RESERVED WORD TABLE                      
* FIRST PART OF THE TABLE CONTAINS EXECUTABLE COMMANDS                      
LAA66     FCC  "FO"           80 
          FCB  $80+'R'         
          FCC  "G"            81 
          FCB  $80+'O'         
TOK_GO    EQU  $81             
          FCC  "RE"           82 
          FCB  $80+'M'         
          FCB  ''+$80         83 
          FCC  "ELS"          84 
          FCB  $80+'E'         
          FCC  "I"            85 
          FCB  $80+'F'         
          FCC  "DAT"          86 
          FCB  $80+'A'         
          FCC  "PRIN"         87 
          FCB  $80+'T'         
          FCC  "O"            88 
          FCB  $80+'N'         
          FCC  "INPU"         89 
          FCB  $80+'T'         
          FCC  "EN"           8A 
          FCB  $80+'D'         
          FCC  "NEX"          8B 
          FCB  $80+'T'         
          FCC  "DI"           8C 
          FCB  $80+'M'         
          FCC  "REA"          8D 
          FCB  $80+'D'         
          FCC  "RU"           8E 
          FCB  $80+'N'         
          FCC  "RESTOR"       8F 
          FCB  $80+'E'         
          FCC  "RETUR"        90 
          FCB  $80+'N'         
          FCC  "STO"          91 
          FCB  $80+'P'         
          FCC  "POK"          92 
          FCB  $80+'E'         
          FCC  "CON"          93 
          FCB  $80+'T'         
          FCC  "LIS"          94 
          FCB  $80+'T'         
          FCC  "CLEA"         95 
          FCB  $80+'R'         
          FCC  "NE"           96 
          FCB  $80+'W'         
          FCC  "EXE"          97 
          FCB  $80+'C'         
          FCC  "TRO"          98 
          FCB  $80+'N'         
          FCC  "TROF"         99 
          FCB  $80+'F'         
          FCC  "DE"           9A 
          FCB  $80+'L'         
          FCC  "DE"           9B 
          FCB  $80+'F'         
          FCC  "LIN"          9C 
          FCB  $80+'E'         
          FCC  "RENU"         9D 
          FCB  $80+'M'         
          FCC  "EDI"          9E 
          FCB  $80+'T'         
* END OF EXECUTABLE COMMANDS. THE REMAINDER OF THE TABLE ARE NON-EXECUTABLE TOKENS                      
          FCC  "TAB"          9F 
          FCB  $80+'('         
TOK_TAB   EQU  $9F             
          FCC  "T"            A0 
          FCB  $80+'O'         
TOK_TO    EQU  $A0             
          FCC  "SU"           A1 
          FCB  $80+'B'         
TOK_SUB   EQU  $A1             
          FCC  "THE"          A2 
          FCB  $80+'N'         
TOK_THEN  EQU  $A2             
          FCC  "NO"           A3 
          FCB  $80+'T'         
TOK_NOT   EQU  $A3             
          FCC  "STE"          A4 
          FCB  $80+'P'         
TOK_STEP  EQU  $A4             
          FCC  "OF"           A5 
          FCB  $80+'F'         
          FCB  '++$80         A6 
TOK_PLUS  EQU  $A6             
          FCB  '-+$80         A7 
TOK_MINUS EQU  $A7             
          FCB  '*+$80         A8 
          FCB  '/+$80         A9 
          FCB  '^+$80         AA 
          FCC  "AN"           AB 
          FCB  $80+'D'         
          FCC  "O"            AC 
          FCB  $80+'R'         
          FCB  '>+$80         AD 
TOK_GREATER EQU  $AD             
          FCB  '=+$80         AE 
TOK_EQUALS EQU  $AE             
          FCB  '<+$80         AF 
          FCC  "F"            B0 
          FCB  $80+'N'         
TOK_FN    EQU  $B0             
          FCC  "USIN"         B1 
          FCB  $80+'G'         
TOK_USING EQU  $B1             
*                              
                               
* FIRST SET ALWAYS HAS ONE PARAMETER                      
LAB1A     FCC  "SG"           80 
          FCB  $80+'N'         
          FCC  "IN"           81 
          FCB  $80+'T'         
          FCC  "AB"           82 
          FCB  $80+'S'         
          FCC  "US"           83 
          FCB  $80+'R'         
          FCC  "RN"           84 
          FCB  $80+'D'         
          FCC  "SI"           85 
          FCB  $80+'N'         
          FCC  "PEE"          86 
          FCB  $80+'K'         
          FCC  "LE"           87 
          FCB  $80+'N'         
          FCC  "STR"          88 
          FCB  $80+'$'         
          FCC  "VA"           89 
          FCB  $80+'L'         
          FCC  "AS"           8A 
          FCB  $80+'C'         
          FCC  "CHR"          8B 
          FCB  $80+'$'         
          FCC  "AT"           8C 
          FCB  $80+'N'         
          FCC  "CO"           8D 
          FCB  $80+'S'         
          FCC  "TA"           8E 
          FCB  $80+'N'         
          FCC  "EX"           8F 
          FCB  $80+'P'         
          FCC  "FI"           90 
          FCB  $80+'X'         
          FCC  "LO"           91 
          FCB  $80+'G'         
          FCC  "PO"           92 
          FCB  $80+'S'         
          FCC  "SQ"           93 
          FCB  $80+'R'         
          FCC  "HEX"          94 
          FCB  $80+'$'         
* LEFT, RIGHT AND MID ARE TREATED SEPARATELY                      
          FCC  "LEFT"         95 
          FCB  $80+'$'         
          FCC  "RIGHT"        96 
          FCB  $80+'$'         
          FCC  "MID"          97 
          FCB  $80+'$'         
* REMAINING FUNCTIONS                      
          FCC  "INKEY"        98 
          FCB  $80+'$'         
          FCC  "ME"           99 
          FCB  $80+'M'         
          FCC  "VARPT"        9A 
          FCB  $80+'R'         
          FCC  "INST"         9B 
          FCB  $80+'R'         
          FCC  "STRING"       9C 
          FCB  $80+'$'         
                               
*                              
* DISPATCH TABLE FOR COMMANDS TOKEN #               
CMD_TAB                        
LAB67     FDB  FOR             80   
          FDB  GO              81   
          FDB  REM             82   
TOK_REM   EQU  *-CMD_TAB/2+$7F  
          FDB  REM             83 (') 
TOK_SNGL_Q EQU  *-CMD_TAB/2+$7F  
          FDB  REM             84 (ELSE) 
TOK_ELSE  EQU  *-CMD_TAB/2+$7F  
          FDB  IF              85   
TOK_IF    EQU  *-CMD_TAB/2+$7F  
          FDB  DATA            86   
TOK_DATA  EQU  *-CMD_TAB/2+$7F  
          FDB  PRINT           87   
TOK_PRINT EQU  *-CMD_TAB/2+$7F  
          FDB  ON              88   
          FDB  INPUT           89   
TOK_INPUT EQU  *-CMD_TAB/2+$7F  
          FDB  END             8A   
          FDB  NEXT            8B   
          FDB  DIM             8C   
          FDB  READ            8D   
          FDB  RUN             8E   
          FDB  RESTOR         8F 
          FDB  RETURN          90   
          FDB  STOP            91   
          FDB  POKE            92   
          FDB  CONT           93 
          FDB  LIST            94   
          FDB  CLEAR           95   
          FDB  NEW             96   
          FDB  EXEC           97 
          FDB  TRON           98 
          FDB  TROFF          99 
          FDB  DEL            9A 
          FDB  DEF            9B 
          FDB  LINE           9C 
          FDB  RENUM          9D 
          FDB  EDIT           9E 
TOK_HIGH_EXEC EQU  *-CMD_TAB/2+$7F  
                               
* ERROR MESSAGES AND THEIR NUMBERS AS USED INTERNALLY                      
LABAF     FCC  "NF"           0 NEXT WITHOUT FOR   
          FCC  "SN"           1 SYNTAX ERROR   
          FCC  "RG"           2 RETURN WITHOUT GOSUB   
          FCC  "OD"           3 OUT OF DATA   
          FCC  "FC"           4 ILLEGAL FUNCTION CALL   
          FCC  "OV"           5 OVERFLOW   
          FCC  "OM"           6 OUT OF MEMORY   
          FCC  "UL"           7 UNDEFINED LINE NUMBER   
          FCC  "BS"           8 BAD SUBSCRIPT   
          FCC  "DD"           9 REDIMENSIONED ARRAY   
          FCC  "/0"           10 DIVISION BY ZERO 
          FCC  "ID"           11 ILLEGAL DIRECT STATEMENT 
          FCC  "TM"           12 TYPE MISMATCH 
          FCC  "OS"           13 OUT OF STRING SPACE 
          FCC  "LS"           14 STRING TOO LONG 
          FCC  "ST"           15 STRING FORMULA TOO COMPLEX 
          FCC  "CN"           16 CAN'T CONTINUE 
          FCC  "FD"           17 BAD FILE DATA 
          FCC  "AO"           18 FILE ALREADY OPEN 
          FCC  "DN"           19 DEVICE NUMBER ERROR 
          FCC  "IO"           20 I/O ERROR 
          FCC  "FM"           21 BAD FILE MODE 
          FCC  "NO"           22 FILE NOT OPEN 
          FCC  "IE"           23 INPUT PAST END OF FILE 
          FCC  "DS"           24 DIRECT STATEMENT IN FILE 
* ADDITIONAL ERROR MESSAGES ADDED BY EXTENDED BASIC                      
L890B     FCC  "UF"           25 UNDEFINED FUNCTION (FN) CALL 
L890D     FCC  "NE"           26 FILE NOT FOUND 
                               
LABE1     FCC  " ERROR"        
          FCB  $00             
LABE8     FCC  " IN "          
          FCB  $00             
LABED     FCB  CR              
LABEE     FCC  "OK"            
          FCB  CR,$00          
LABF2     FCB  CR              
          FCC  "BREAK"         
          FCB  $00             
                               
* SEARCH THE STACK FOR ‘GOSUB/RETURN’ OR ‘FOR/NEXT’ DATA.                      
* THE ‘FOR/NEXT’ INDEX VARIABLE DESCRIPTOR ADDRESS BEING                      
* SOUGHT IS STORED IN VARDES. EACH BLOCK OF FOR/NEXT DATA IS 18                      
* BYTES WITH A $80 LEADER BYTE AND THE GOSUB/RETURN DATA IS 5 BYTES                      
* WITH AN $A6 LEADER BYTE. THE FIRST NON "FOR/NEXT" DATA                      
* IS CONSIDERED ‘GOSUB/RETURN’                      
LABF9     LEAX 4,S            POINT X TO 3RD ADDRESS ON STACK - IGNORE THE 
*         FIRST TWO RETURN ADDRESSES ON THE STACK  
LABFB     LDB  #18            18 BYTES SAVED ON STACK FOR EACH ‘FOR’ LOOP 
          STX  TEMPTR         SAVE POINTER 
          LDA  ,X             GET 1ST BYTE 
          SUBA #$80           * CHECK FOR TYPE OF STACK JUMP FOUND 
          BNE  LAC1A          * BRANCH IF NOT ‘FOR/NEXT’ 
          LDX  1,X            = GET INDEX VARIABLE DESCRIPTOR 
          STX  TMPTR1         = POINTER AND SAVE IT IN TMPTR1 
          LDX  VARDES         GET INDEX VARIABLE BEING SEARCHED FOR 
          BEQ  LAC16          BRANCH IF DEFAULT INDEX VARIABLE - USE THE 
*                             FIRST ‘FOR/NEXT’ DATA FOUND ON STACK 
*                             IF NO INDEX VARIABLE AFTER ‘NEXT’ 
          CMPX TMPTR1         DOES THE STACK INDEX MATCH THE ONE 
*                             BEING SEARCHED FOR? 
          BEQ  LAC1A          YES 
          LDX  TEMPTR         * RESTORE INITIAL POINTER, ADD 
          ABX                 * 18 TO IT AND LOOK FOR 
          BRA  LABFB          * NEXT BLOCK OF DATA 
LAC16     LDX  TMPTR1         = GET 1ST INDEX VARIABLE FOUND AND 
          STX  VARDES         = SAVE AS ‘NEXT’ INDEX 
LAC1A     LDX  TEMPTR         POINT X TO START OF ‘FOR/NEXT’ DATA 
          TSTA                SET ZERO FLAG IF ‘FOR/NEXT’ DATA 
          RTS                  
* CHECK FOR MEMORY SPACE FOR NEW TOP OF                      
* ARRAYS AND MOVE ARRAYS TO NEW LOCATION                      
LAC1E     BSR  LAC37          ACCD = NEW BOTTOM OF FREE RAM - IS THERE 
*                             ROOM FOR THE STACK? 
* MOVE BYTES FROM V43(X) TO V41(U) UNTIL (X) = V47 AND                      
* SAVE FINAL VALUE OF U IN V45                      
LAC20     LDU  V41            POINT U TO DESTINATION ADDRESS (V41) 
          LEAU 1,U            ADD ONE TO U - COMPENSATE FOR FIRST PSHU 
          LDX  V43            POINT X TO SOURCE ADDRESS (V43) 
          LEAX 1,X            ADD ONE - COMPENSATE FOR FIRST LDA ,X 
LAC28     LDA  ,-X            GRAB A BYTE FROM SOURCE 
          PSHU A              MOVE IT TO DESTINATION 
          CMPX V47            DONE? 
          BNE  LAC28          NO - KEEP MOVING BYTES 
          STU  V45            SAVE FINAL DESTINATION ADDRESS 
LAC32     RTS                  
* CHECK TO SEE IF THERE IS ROOM TO STORE 2*ACCB                      
* BYTES IN FREE RAM - OM ERROR IF NOT                      
LAC33     CLRA                * ACCD CONTAINS NUMBER OF EXTRA 
          ASLB                * BYTES TO PUT ON STACK 
          ADDD ARYEND         END OF PROGRAM AND VARIABLES 
LAC37     ADDD #STKBUF        ADD STACK BUFFER - ROOM FOR STACK? 
          BCS  LAC44          BRANCH IF GREATER THAN $FFFF 
          STS  BOTSTK         CURRENT NEW BOTTOM OF STACK STACK POINTER 
          CMPD BOTSTK         ARE WE GOING TO BE BELOW STACK? 
          BCS  LAC32          YES - NO ERROR 
LAC44     LDB  #6*2           OUT OF MEMORY ERROR 
                               
* ERROR SERVICING ROUTINE                      
LAC46     JSR  LAD33          RESET STACK, STRING STACK, CONTINUE POINTER 
          JSR  LB95C          SEND A CR TO SCREEN 
          JSR  LB9AF          SEND A ‘?‘ TO SCREEN 
          LDX  #LABAF         POINT TO ERROR TABLE 
LAC60     ABX                 ADD MESSAGE NUMBER OFFSET 
          BSR  LACA0          * GET TWO CHARACTERS FROM X AND 
          BSR  LACA0          * SEND TO CONSOLE OUT (SCREEN) 
          LDX  #LABE1-1       POINT TO "ERROR" MESSAGE 
LAC68     JSR  LB99C          PRINT MESSAGE POINTED TO BY X 
          LDA  CURLIN         GET CURRENT LINE NUMBER (CURL IN) 
          INCA                TEST FOR DIRECT MODE 
          BEQ  LAC73          BRANCH IF DIRECT MODE 
          JSR  LBDC5          PRINT ‘IN ****‘ 
                               
* THIS IS THE MAIN LOOP OF BASIC WHEN IN DIRECT MODE                      
LAC73     JSR  LB95C          MOVE CURSOR TO START OF LINE 
          LDX  #LABED         POINT X TO ‘OK’, CR MESSAGE 
          JSR  LB99C          PRINT ‘OK’, CR 
LAC7C     JSR  LA390          GO GET AN INPUT LINE 
          LDU  #$FFFF         THE LINE NUMBER FOR DIRECT MODE IS $FFFF 
          STU  CURLIN         SAVE IT IN CURLIN 
          BCS  LAC7C          BRANCH IF LINE INPUT TERMINATED BY BREAK 
          STX  CHARAD         SAVE (X) AS CURRENT INPUT POINTER - THIS WILL 
*         ENABLE THE ‘LIVE KEYBOARD’ (DIRECT) MODE. THE  
*         LINE JUST ENTERED WILL BE INTERPRETED  
          JSR  GETNCH         GET NEXT CHARACTER FROM BASIC 
          BEQ  LAC7C          NO LINE INPUT - GET ANOTHER LINE 
          BCS  LACA5          BRANCH IF NUMER1C - THERE WAS A LINE NUMBER BEFORE 
*         THE  STATEMENT ENTERED, SO THIS STATEMENT  
*         WILL BE MERGED INTO THE BASIC PROGRAM  
          JSR  LB821          GO CRUNCH LINE 
          JMP  LADC0          GO EXECUTE THE STATEMENT (LIVE KEYBOARD) 
*                              
LACA0     LDA  ,X+            GET A CHARACTER 
          JMP  LB9B1          SEND TO CONSOLE OUT 
* TAKE A LINE FROM THE LINE INPUT BUFFER                      
* AND INSERT IT INTO THE BASIC PROGRAM                      
LACA5     JSR  LAF67          CONVERT LINE NUMBER TO BINARY 
LACA8     LDX  BINVAL         GET CONVERTED LINE NUMBER 
          STX  LINHDR         STORE IT IN LINE INPUT HEADER 
          JSR  LB821          GO CRUNCH THE LINE 
          STB  TMPLOC         SAVE LINE LENGTH 
          BSR  LAD01          FIND OUT WHERE TO INSERT LINE 
          BCS  LACC8          BRANCH IF LINE NUMBER DOES NOT ALREADY EXIST 
          LDD  V47            GET ABSOLUTE ADDRESS OF LINE NUMBER 
          SUBD ,X             SUBTRACT ADDRESS OF NEXT LINE NUMBER 
          ADDD VARTAB         * ADD TO CURRENT END OF PROGRAM - THIS WILL REMOVE 
          STD  VARTAB         * THE LENGTH OF THIS LINE NUMBER FROM THE PROGRAM 
          LDU  ,X             POINT U TO ADDRESS OF NEXT LINE NUMBER 
* DELETE OLD LINE FROM BASIC PROGRAM                      
LACC0     PULU A              GET A BYTE FROM WHAT’S LEFT OF PROGRAM 
          STA  ,X+            MOVE IT DOWN 
          CMPX VARTAB         COMPARE TO END OF BASIC PROGRAM 
          BNE  LACC0          BRANCH IF NOT AT END 
LACC8     LDA  LINBUF         * CHECK TO SEE IF THERE IS A LINE IN 
          BEQ  LACE9          * THE BUFFER AND BRANCH IF NONE 
          LDD  VARTAB         = SAVE CURRENT END OF 
          STD  V43            = PROGRAM IN V43 
          ADDB TMPLOC         * ADD LENGTH OF CRUNCHED LINE, 
          ADCA #0             * PROPOGATE CARRY AND SAVE NEW END 
          STD  V41            * OF PROGRAM IN V41 
          JSR  LAC1E          = MAKE SURE THERE’S ENOUGH RAM FOR THIS 
*         =    LINE & MAKE A HOLE IN BASIC FOR NEW LINE  
          LDU  #LINHDR-2      POINT U TO LINE TO BE INSERTED 
LACDD     PULU A              GET A BYTE FROM NEW LINE 
          STA  ,X+            INSERT IT IN PROGRAM 
          CMPX V45            * COMPARE TO ADDRESS OF END OF INSERTED 
          BNE  LACDD          * LINE AND BRANCH IF NOT DONE 
          LDX  V41            = GET AND SAVE 
          STX  VARTAB         = END OF PROGRAM 
LACE9     BSR  LAD21          RESET INPUT POINTER, CLEAR VARIABLES, INITIALIZE 
          BSR  LACEF          ADJUST START OF NEXT LINE ADDRESSES 
          BRA  LAC7C          REENTER BASIC’S INPUT LOOP 
* COMPUTE THE START OF NEXT LINE ADDRESSES FOR THE BASIC PROGRAM                      
LACEF     LDX  TXTTAB         POINT X TO START OF PROGRAM 
LACF1     LDD  ,X             GET ADDRESS OF NEXT LINE 
          BEQ  LAD16          RETURN IF END OF PROGRAM 
          LEAU 4,X            POINT U TO START OF BASIC TEXT IN LINE 
LACF7     LDA  ,U+            * SKIP THROUGH THE LINE UNTIL A 
          BNE  LACF7          * ZERO (END OF LINE) IS FOUND 
          STU  ,X             SAVE THE NEW START OF NEXT LINE ADDRESS 
          LDX  ,X             POINT X TO START OF NEXT LINE 
          BRA  LACF1          KEEP GOING 
*                              
* FIND A LINE NUMBER IN THE BASIC PROGRAM                      
* RETURN WITH CARRY SET IF NO MATCH FOUND                      
LAD01     LDD  BINVAL         GET THE LINE NUMBER TO FIND 
          LDX  TXTTAB         BEGINNING OF PROGRAM 
LAD05     LDU  ,X             GET ADDRESS OF NEXT LINE NUMBER 
          BEQ  LAD12          BRANCH IF END OF PROG 
          CMPD 2,X            IS IT A MATCH? 
          BLS  LAD14          CARRY SET IF LOWER; CARRY CLEAR IF MATCH 
          LDX  ,X             X = ADDRESS OF NEXT LINE 
          BRA  LAD05          KEEP LOOPING FOR LINE NUMBER 
LAD12     ORCC #1             SET CARRY FLAG 
LAD14     STX  V47            SAVE MATCH LINE NUMBER OR NUMBER OF LINE JUST AFTER 
*                             WHERE IT SHOULD HAVE BEEN 
LAD16     RTS                  
                               
* NEW                          
NEW       BNE  LAD14          BRANCH IF ARGUMENT GIVEN 
LAD19     LDX  TXTTAB         GET START OF BASIC 
          CLR  ,X+            * PUT 2 ZERO BYTES THERE - ERASE 
          CLR  ,X+            * THE BASIC PROGRAM 
          STX  VARTAB         AND THE NEXT ADDRESS IS NOW THE END OF PROGRAM 
LAD21     LDX  TXTTAB         GET START OF BASIC 
          JSR  LAEBB          PUT INPUT POINTER ONE BEFORE START OF BASIC 
* ERASE ALL VARIABLES                      
LAD26     LDX  MEMSIZ         * RESET START OF STRING VARIABLES 
          STX  STRTAB         * TO TOP OF STRING SPACE 
          JSR  RESTOR         RESET ‘DATA’ POINTER TO START OF BASIC 
          LDX  VARTAB         * GET START OF VARIABLES AND USE IT 
          STX  ARYTAB         * TO RESET START OF ARRAYS 
          STX  ARYEND         RESET END OF ARRAYS 
LAD33     LDX  #STRSTK        * RESET STRING STACK POINTER TO 
          STX  TEMPPT         * BOTTOM OF STRING STACK 
          LDX  ,S             GET RETURN ADDRESS OFF STACK 
          LDS  FRETOP         RESTORE STACK POINTER 
          CLR  ,-S            PUT A ZERO BYTE ON STACK - TO CLEAR ANY RETURN OF 
*                             FOR/NEXT DATA FROM THE STACK 
          CLR  OLDPTR         RESET ‘CONT’ ADDRESS SO YOU 
          CLR  OLDPTR+1       ‘CAN’T CONTINUE’ 
          CLR  ARYDIS         CLEAR THE ARRAY DISABLE FLAG 
          JMP  ,X             RETURN TO CALLING ROUTINE - THIS IS NECESSARY 
*                             SINCE THE STACK WAS RESET 
*                              
* FOR                          
*                              
* THE FOR COMMAND WILL STORE 18 BYTES ON THE STACK FOR                      
* EACH FOR-NEXT LOOP WHICH IS BEING PROCESSED. THESE                      
* BYTES ARE DEFINED AS FOLLOWS: 0- $80 (FOR FLAG);                      
*         1,2=INDEX VARIABLE DESCRIPTOR POINTER; 3-7=FP VALUE OF STEP;  
*         8=STEP DIRECTION: $FF IF NEGATIVE; 0 IF ZERO; 1 IF POSITIVE;  
* 9-13=FP VALUE OF ‘TO’ PARAMETER;                      
* 14,15=CURRENT LINE NUMBER; 16,17=RAM ADDRESS OF THE END                      
*         OF   THE LINE CONTAINING THE ‘FOR’ STATEMENT  
FOR       LDA  #$80           * SAVE THE DISABLE ARRAY FLAG IN VO8 
          STA  ARYDIS         * DO NOT ALLOW THE INDEX VARIABLE TO BE AN ARRAY 
          JSR  LET            SET INDEX VARIABLE TO INITIAL VALUE 
          JSR  LABF9          SEARCH THE STACK FOR ‘FOR/NEXT’ DATA 
          LEAS 2,S            PURGE RETURN ADDRESS OFF OF THE STACK 
          BNE  LAD59          BRANCH IF INDEX VARIABLE NOT ALREADY BEING USED 
          LDX  TEMPTR         GET (ADDRESS + 18) OF MATCHED ‘FOR/NEXT’ DATA 
          LEAS B,X            MOVE THE STACK POINTER TO THE BEGINNING OF THE 
* MATCHED ‘FOR/NEXT’ DATA SO THE NEW DATA WILL                      
* OVERLAY THE OLD DATA. THIS WILL ALSO DESTROY                      
* ALL OF THE ‘RETURN’ AND ‘FOR/NEXT’ DATA BELOW                      
* THIS POINT ON THE STACK                      
LAD59     LDB  #$09           * CHECK FOR ROOM FOR 18 BYTES 
          JSR  LAC33          * IN FREE RAM 
          JSR  LAEE8          GET ADDR OF END OF SUBLINE IN X 
          LDD  CURLIN         GET CURRENT LINE NUMBER 
          PSHS X,B,A          SAVE LINE ADDR AND LINE NUMBER ON STACK 
          LDB  #TOK_TO        TOKEN FOR ‘TO’ 
          JSR  LB26F          SYNTAX CHECK FOR ‘TO’ 
          JSR  LB143          ‘TM’ ERROR IF INDEX VARIABLE SET TO STRING 
          JSR  LB141          EVALUATE EXPRESSION 
*                              
          LDB  FP0SGN         GET FPA0 MANTISSA SIGN 
          ORB  #$7F           FORM A MASK TO SAVE DATA BITS OF HIGH ORDER MANTISSA 
          ANDB FPA0           PUT THE MANTISSA SIGN IN BIT 7 OF HIGH ORDER MANTISSA 
          STB  FPA0           SAVE THE PACKED HIGH ORDER MANTISSA 
          LDY  #LAD7F         LOAD FOLLOWING ADDRESS INTO Y AS A RETURN 
          JMP  LB1EA          ADDRESS - PUSH FPA0 ONTO THE STACK 
LAD7F     LDX  #LBAC5         POINT X TO FLOATING POINT NUMBER 1.0 (DEFAULT STEP VALUE) 
          JSR  LBC14          MOVE (X) TO FPA0 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          CMPA #TOK_STEP      STEP TOKEN 
          BNE  LAD90          BRANCH IF NO ‘STEP’ VALUE 
          JSR  GETNCH         GET A CHARACTER FROM BASIC 
          JSR  LB141          EVALUATE NUMERIC EXPRESSION 
LAD90     JSR  LBC6D          CHECK STATUS OF FPA0 
          JSR  LB1E6          SAVE STATUS AND FPA0 ON THE STACK 
          LDD  VARDES         * GET DESCRIPTOR POINTER FOR THE ‘STEP’ 
          PSHS B,A            * VARIABLE AND SAVE IT ON THE STACK 
          LDA  #$80           = GET THE ‘FOR’ FLAG AND 
          PSHS A              = SAVE IT ON THE STACK 
*                              
* MAIN COMMAND INTERPRETATION LOOP                      
LAD9E     ANDCC #$AF           ENABLE IRQ,FIRQ 
          BSR  LADEB          CHECK FOR KEYBOARD BREAK 
          LDX  CHARAD         GET BASIC’S INPUT POINTER 
          STX  TINPTR         SAVE IT 
          LDA  ,X+            GET CURRENT INPUT CHAR & MOVE POINTER 
          BEQ  LADB4          BRANCH IF END OF LINE 
          CMPA #':            CHECK FOR LINE SEPARATOR 
          BEQ  LADC0          BRANCH IF COLON 
LADB1     JMP  LB277          ‘SYNTAX ERROR’-IF NOT LINE SEPARATOR 
LADB4     LDA  ,X++           GET MS BYTE OF ADDRESS OF NEXT BASIC LINE 
          STA  ENDFLG         SAVE IN STOP/END FLAG - CAUSE A STOP IF 
*                             NEXT LINE ADDRESS IS < $8000; CAUSE 
*                             AN END IF ADDRESS > $8000 
          BEQ  LAE15          BRANCH TO ‘STOP’ - END OF PROGRAM 
          LDD  ,X+            GET CURRENT LINE NUMBER 
          STD  CURLIN         SAVE IN CURLIN 
          STX  CHARAD         SAVE ADDRESS OF FIRST BYTE OF LINE 
* EXTENDED BASIC TRACE                      
          LDA  TRCFLG         TEST THE TRACE FLAG 
          BEQ  LADC0          BRANCH IF TRACE OFF 
          LDA  #$5B           <LEFT HAND MARKER FOR TRON LINE NUMBER 
          JSR  PUTCHR         OUTPUT A CHARACTER 
          LDA  CURLIN         GET MS BYTE OF LINE NUMBER 
          JSR  LBDCC          CONVERT ACCD TO DECIMAL AND PRINT ON SCREEN 
          LDA  #$5D           > RIGHT HAND MARKER FOR TRON LINE NUMBER 
          JSR  PUTCHR         OUTPUT A CHARACTER 
* END OF EXTENDED BASIC TRACE                      
LADC0     JSR  GETNCH         GET A CHARACTER FROM BASIC 
          BSR  LADC6          GO PROCESS COMMAND 
          BRA  LAD9E          GO BACK TO MAIN LOOP 
LADC6     BEQ  LADEA          RETURN IF END OF LINE (RTS - was BEQ LAE40) 
          TSTA                CHECK FOR TOKEN - BIT 7 SET (NEGATIVE) 
          LBPL LET            BRANCH IF NOT A TOKEN - GO DO A ‘LET’ WHICH 
*                             IS THE ‘DEFAULT’ TOKEN FOR MICROSOFT BASIC 
          CMPA #$FF           SECONDARY TOKEN 
          BEQ  SECTOK          
          CMPA #TOK_HIGH_EXEC SKIPF TOKEN - HIGHEST EXECUTABLE COMMAND IN BASIC 
          BHI  LADB1          ‘SYNTAX ERROR’ IF NON-EXECUTABLE TOKEN 
          LDX  COMVEC+3       GET ADDRESS OF BASIC’S COMMAND TABLE 
LADD4     ASLA                X2 (2 BYTE/JUMP ADDRESS) & DISCARD BIT 7 
          TFR  A,B            SAVE COMMAND OFFSET IN ACCB 
          ABX                 NON X POINTS TO COMMAND JUMP ADDR 
          JSR  GETNCH         GET AN INPUT CHAR 
*                              
* HERE IS WHERE WE BRANCH TO DO A ‘COMMAND’                      
          JMP  [,X]           GO DO A COMMAND 
SECTOK                         
* THE ONLY SECONDARY TOKEN THAT CAN ALSO BE AN EXECUTABLE IS                      
* THE MID$ REPLACEMENT STATEMENT. SO SPECIAL-CASE CHECK DONE HERE                      
          JSR  GETNCH         GET AN INPUT CHAR 
          CMPA #TOK_MID       TOKEN FOR "MID$" 
          LBEQ L86D6          PROCESS MID$ REPLACEMENT 
          JMP  LB277          SYNTAX ERROR 
                               
*                              
* RESTORE                      
RESTOR    LDX  TXTTAB         BEGINNING OF PROGRAM ADDRESS 
          LEAX -1,X           MOVE TO ONE BYTE BEFORE PROGRAM 
LADE8     STX  DATPTR         SAVE NEW DATA POINTER 
LADEA     RTS                  
*                              
* BREAK CHECK                      
LADEB     JSR  LA1C1          GET A KEYSTROKE ENTRY 
          BEQ  LADFA          RETURN IF NO INPUT 
LADF0     CMPA #3             CONTROL C? (BREAK) 
          BEQ  STOP           YES 
          CMPA #$13           CONTROL S? (PAUSE) 
          BEQ  LADFB          YES 
          STA  IKEYIM         SAVE KEYSTROKE IN INKEY IMAGE 
LADFA     RTS                  
LADFB     JSR  KEYIN          GET A KEY 
          BEQ  LADFB          BRANCH IF NO KEY DOWN 
          BRA  LADF0          CONTINUE - DO A BREAK CHECK 
*                              
* END                          
END       JSR  GETCCH         GET CURRENT INPUT CHAR 
          BRA  LAE0B           
*                              
* STOP                         
STOP      ORCC #$01           SET CARRY FLAG 
LAE0B     BNE  LAE40          BRANCH IF ARGUMENT EXISTS 
          LDX  CHARAD         * SAVE CURRENT POSITION OF 
          STX  TINPTR         * BASIC’S INPUT POINTER 
LAE11     ROR  ENDFLG         ROTATE CARRY INTO BIT 7 OF STOP/END FLAG 
          LEAS 2,S            PURGE RETURN ADDRESS OFF STACK 
LAE15     LDX  CURLIN         GET CURRENT LINE NUMBER 
          CMPX #$FFFF         DIRECT MODE? 
          BEQ  LAE22          YES 
          STX  OLDTXT         SAVE CURRENT LINE NUMBER 
          LDX  TINPTR         * GET AND SAVE CURRENT POSITION 
          STX  OLDPTR         * OF BASIC’S INPUT POINTER 
LAE22                          
          LDX  #LABF2-1       POINT TO CR, ‘BREAK’ MESSAGE 
          TST  ENDFLG         CHECK STOP/END FLAG 
          LBPL LAC73          BRANCH TO MAIN LOOP OF BASIC IF END 
          JMP  LAC68          PRINT ‘BREAK AT ####’ AND GO TO 
*                             BASIC’S MAIN LOOP IF ‘STOP’ 
                               
* CONT                         
CONT      BNE  LAE40          RETURN IF ARGUMENT GIVEN 
          LDB  #2*16          ‘CAN’T CONTINUE’ ERROR 
          LDX  OLDPTR         GET CONTINUE ADDRESS (INPUT POINTER) 
          LBEQ LAC46          ‘CN’ ERROR IF CONTINUE ADDRESS = 0 
          STX  CHARAD         RESET BASIC’S INPUT POINTER 
          LDX  OLDTXT         GET LINE NUMBER 
          STX  CURLIN         RESET CURRENT LINE NUMBER 
LAE40     RTS                  
*                              
* CLEAR                        
CLEAR     BEQ  LAE6F          BRANCH IF NO ARGUMENT 
          JSR  LB3E6          EVALUATE ARGUMENT 
          PSHS B,A            SAVE AMOUNT OF STRING SPACE ON STACK 
          LDX  MEMSIZ         GET CURRENT TOP OF CLEARED SPACE 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          BEQ  LAE5A          BRANCH IF NO NEW TOP OF CLEARED SPACE 
          JSR  LB26D          SYNTAX CHECK FOR COMMA 
          JSR  LB73D          EVALUATE EXPRESSlON; RETURN VALUE IN X 
          LEAX -1,X           X = TOP OF CLEARED SPACE 
          CMPX TOPRAM         COMPARE TO TOP OF RAM 
          BHI  LAE72          ‘OM’ ERROR IF > TOP OF RAM 
LAE5A     TFR  X,D            ACCD = TOP OF CLEARED SPACE 
          SUBD ,S++           SUBTRACT OUT AMOUNT OF CLEARED SPACE 
          BCS  LAE72          ‘OM’ ERROR IF FREE MEM < 0 
          TFR  D,U            U = BOTTOM OF CLEARED SPACE 
          SUBD #STKBUF        SUBTRACT OUT STACK BUFFER 
          BCS  LAE72          ‘OM’ ERROR IF FREE MEM < 0 
          SUBD VARTAB         SUBTRACT OUT START OF VARIABLES 
          BCS  LAE72          ‘OM’ ERROR IF FREE MEM < 0 
          STU  FRETOP         SAVE NEW BOTTOM OF CLEARED SPACE 
          STX  MEMSIZ         SAVE NEW TOP OF CLEARED SPACE 
LAE6F     JMP  LAD26          ERASE ALL VARIABLES, INITIALIZE POINTERS, ETC 
LAE72     JMP  LAC44          ‘OM’ ERROR 
*                              
* RUN                          
RUN       JSR  GETCCH         * GET CURRENT INPUT CHARACTER 
          LBEQ LAD21          * IF NO LINE NUMBER 
          JSR  LAD26          ERASE ALL VARIABLES 
          BRA  LAE9F          ‘GOTO’ THE RUN ADDRESS 
*                              
* GO                           
GO        TFR  A,B            SAVE INPUT CHARACTER IN ACCB 
LAE88     JSR  GETNCH         GET A CHARACTER FROM BASIC 
          CMPB #TOK_TO        ‘TO’ TOKEN 
          BEQ  LAEA4          BRANCH IF GOTO 
          CMPB #TOK_SUB       ‘SUB’ TOKEN 
          BNE  LAED7          ‘SYNTAX ERROR’ IF NEITHER 
          LDB  #3             =ROOM FOR 6 
          JSR  LAC33          =BYTES ON STACK? 
          LDU  CHARAD         * SAVE CURRENT BASIC INPUT POINTER, LINE 
          LDX  CURLIN         * NUMBER AND SUB TOKEN ON STACK 
          LDA  #TOK_SUB       * 
          PSHS U,X,A          * 
LAE9F     BSR  LAEA4          GO DO A ‘GOTO’ 
          JMP  LAD9E          JUMP BACK TO BASIC’S MAIN LOOP 
* GOTO                         
LAEA4     JSR  GETCCH         GET CURRENT INPUT CHAR 
          JSR  LAF67          GET LINE NUMBER TO BINARY IN BINVAL 
          BSR  LAEEB          ADVANCE BASIC’S POINTER TO END OF LINE 
          LEAX $01,X          POINT TO START OF NEXT LINE 
          LDD  BINVAL         GET THE LINE NUMBER TO RUN 
          CMPD CURLIN         COMPARE TO CURRENT LINE NUMBER 
          BHI  LAEB6          IF REO’D LINE NUMBER IS > CURRENT LINE NUMBER, 
*              DON’T START LOOKING FROM  
*              START OF PROGRAM  
          LDX  TXTTAB         BEGINNING OF PROGRAM 
LAEB6     JSR  LAD05          GO FIND A LINE NUMBER 
          BCS  LAED2          ‘UNDEFINED LINE NUMBER’ 
LAEBB     LEAX -1,X           MOVE BACK TO JUST BEFORE START OF LINE 
          STX  CHARAD         RESET BASIC’S INPUT POINTER 
LAEBF     RTS                  
*                              
* RETURN                       
RETURN    BNE  LAEBF          EXIT ROUTINE IF ARGUMENT GIVEN 
          LDA  #$FF           * PUT AN ILLEGAL VARIABLE NAME IN FIRST BYTE OF 
          STA  VARDES         * VARDES WHICH WILL CAUSE ‘FOR/NEXT’ DATA ON THE 
*              STACK TO BE IGNORED  
          JSR  LABF9          CHECK FOR RETURN DATA ON THE STACK 
          TFR  X,S            RESET STACK POINTER - PURGE TWO RETURN ADDRESSES 
*              FROM THE STACK  
          CMPA #TOK_SUB-$80   SUB TOKEN - $80 
          BEQ  LAEDA          BRANCH IF ‘RETURN’ FROM SUBROUTINE 
          LDB  #2*2           ERROR #2 ‘RETURN WITHOUT GOSUB’ 
          FCB  SKP2           SKIP TWO BYTES 
LAED2     LDB  #7*2           ERROR #7 ‘UNDEFINED LINE NUMBER’ 
          JMP  LAC46          JUMP TO ERROR HANDLER 
LAED7     JMP  LB277          ‘SYNTAX ERROR’ 
LAEDA     PULS A,X,U          * RESTORE VALUES OF CURRENT LINE NUMBER AND 
          STX  CURLIN         * BASIC’S INPUT POINTER FOR THIS SUBROUTINE 
          STU  CHARAD         * AND LOAD ACCA WITH SUB TOKEN ($A6) 
*                              
* DATA                         
DATA      BSR  LAEE8          MOVE INPUT POINTER TO END OF SUBLINE OR LINE 
          FCB  SKP2           SKIP 2 BYTES 
                               
* REM, ELSE                      
ELSE                           
REM       BSR  LAEEB          MOVE INPUT POINTER TO END OF LINE 
          STX  CHARAD         RESET BASIC’S INPUT POINTER 
LAEE7     RTS                  
* ADVANCE INPUT POINTER TO END OF SUBLINE OR LINE                      
LAEE8     LDB  #':            COLON = SUBLINE TERMINATOR CHARACTER 
LAEEA     FCB  SKP1LD         SKPILD SKIP ONE BYTE; LDA #$5F 
* ADVANCE BASIC’S INPUT POINTER TO END OF                      
* LINE - RETURN ADDRESS OF END OF LINE+1 IN X                      
LAEEB     CLRB                0 = LINE TERMINATOR CHARACTER 
          STB  CHARAC         TEMP STORE PRIMARY TERMINATOR CHARACTER 
          CLRB                0 (END OF LINE) = ALTERNATE TERM. CHAR. 
          LDX  CHARAD         LOAD X W/BASIC’S INPUT POINTER 
LAEF1     TFR  B,A            * CHANGE TERMINATOR CHARACTER 
          LDB  CHARAC         * FROM ACCB TO CHARAC - SAVE OLD TERMINATOR 
*         IN   CHARAC          
          STA  CHARAC         SWAP PRIMARY AND SECONDARY TERMINATORS 
LAEF7     LDA  ,X             GET NEXT INPUT CHARACTER 
          BEQ  LAEE7          RETURN IF 0 (END OF LINE) 
          PSHS B              SAVE TERMINATOR ON STACK 
          CMPA ,S+            COMPARE TO INPUT CHARACTER 
          BEQ  LAEE7          RETURN IF EQUAL 
          LEAX 1,X            MOVE POINTER UP ONE 
          CMPA #'"            CHECK FOR DOUBLE QUOTES 
          BEQ  LAEF1          BRANCH IF " - TOGGLE TERMINATOR CHARACTERS 
          INCA                * CHECK FOR $FF AND BRANCH IF 
          BNE  LAF0C          * NOT SECONDARY TOKEN 
          LEAX 1,X            MOVE INPUT POINTER 1 MORE IF SECONDARY 
LAF0C     CMPA #TOK_IF+1      TOKEN FOR IF? 
          BNE  LAEF7          NO - GET ANOTHER INPUT CHARACTER 
          INC  IFCTR          INCREMENT IF COUNTER - KEEP TRACK OF HOW MANY 
*                             ‘IF’ STATEMENTS ARE NESTED IN ONE LINE 
          BRA  LAEF7          GET ANOTHER INPUT CHARACTER 
                               
* IF                           
IF        JSR  LB141          EVALUATE NUMERIC EXPRESSION 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          CMPA #TOK_GO        TOKEN FOR GO 
          BEQ  LAF22          TREAT ‘GO’ THE SAME AS ‘THEN’ 
          LDB  #TOK_THEN      TOKEN FOR THEN 
          JSR  LB26F          DO A SYNTAX CHECK ON ACCB 
LAF22     LDA  FP0EXP         CHECK FOR TRUE/FALSE - FALSE IF FPA0 EXPONENT = ZERO 
          BNE  LAF39          BRANCH IF CONDITION TRUE 
          CLR  IFCTR          CLEAR FLAG - KEEP TRACK OF WHICH NESTED ELSE STATEMENT 
*                             TO SEARCH FOR IN NESTED ‘IF’ LOOPS 
LAF28     BSR  DATA           MOVE BASIC’S POINTER TO END OF SUBLINE 
          TSTA                * CHECK TO SEE IF END OF LINE OR SUBLINE 
          BEQ  LAEE7          * AND RETURN IF END OF LINE 
          JSR  GETNCH         GET AN INPUT CHARACTER FROM BASIC 
          CMPA #TOK_ELSE      TOKEN FOR ELSE 
          BNE  LAF28          IGNORE ALL DATA EXCEPT ‘ELSE’ UNTIL 
*                             END OF LINE (ZERO BYTE) 
          DEC  IFCTR          CHECK TO SEE IF YOU MUST SEARCH ANOTHER SUBLINE 
          BPL  LAF28          BRANCH TO SEARCH ANOTHER SUBLINE FOR ‘ELSE’ 
          JSR  GETNCH         GET AN INPUT CHARACTER FROM BASIC 
LAF39     JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          LBCS LAEA4          BRANCH TO ‘GOTO’ IF NUMERIC CHARACTER 
          JMP  LADC6          RETURN TO MAIN INTERPRETATION LOOP 
                               
* ON                           
ON        JSR  LB70B          EVALUATE EXPRESSION 
          LDB  #TOK_GO        TOKEN FOR GO 
          JSR  LB26F          SYNTAX CHECK FOR GO 
          PSHS A              SAVE NEW TOKEN (TO,SUB) 
          CMPA #TOK_SUB       TOKEN FOR SUB? 
          BEQ  LAF54          YES 
          CMPA #TOK_TO        TOKEN FOR TO? 
LAF52     BNE  LAED7          ‘SYNTAX’ ERROR IF NOT ‘SUB’ OR ‘TO’ 
LAF54     DEC  FPA0+3         DECREMENT IS BYTE OF MANTISSA OF FPA0 - THIS 
*                             IS THE ARGUMENT OF THE ‘ON’ STATEMENT 
          BNE  LAF5D          BRANCH IF NOT AT THE PROPER GOTO OR GOSUB LINE NUMBER 
          PULS B              GET BACK THE TOKEN FOLLOWING ‘GO’ 
          JMP  LAE88          GO DO A ‘GOTO’ OR ‘GOSUB’ 
LAF5D     JSR  GETNCH         GET A CHARACTER FROM BASIC 
          BSR  LAF67          CONVERT BASIC LINE NUMBER TO BINARY 
          CMPA #',            IS CHARACTER FOLLOWING LINE NUMBER A COMMA? 
          BEQ  LAF54          YES 
          PULS B,PC           IF NOT, FALL THROUGH TO NEXT COMMAND 
LAF67     LDX  ZERO           DEFAULT LINE NUMBER OF ZERO 
          STX  BINVAL         SAVE IT IN BINVAL 
*                              
* CONVERT LINE NUMBER TO BINARY - RETURN VALUE IN BINVAL                      
*                              
LAF6B     BCC  LAFCE          RETURN IF NOT NUMERIC CHARACTER 
          SUBA #'0            MASK OFF ASCII 
          STA  CHARAC         SAVE DIGIT IN VO1 
          LDD  BINVAL         GET ACCUMULATED LINE NUMBER VALUE 
          CMPA #24            LARGEST LINE NUMBER IS $F9FF (63999) - 
*         (24*256+255)*10+9                 
          BHI  LAF52          ‘SYNTAX’ ERROR IF TOO BIG 
* MULT ACCD X 10                      
          ASLB                * 
          ROLA                * TIMES 2 
          ASLB                = 
          ROLA                = TIMES 4 
          ADDD BINVAL         ADD 1 = TIMES 5 
          ASLB                * 
          ROLA                * TIMES 10 
          ADDB CHARAC         ADD NEXT DIGIT 
          ADCA #0             PROPAGATE CARRY 
          STD  BINVAL         SAVE NEW ACCUMULATED LINE NUMBER 
          JSR  GETNCH         GET NEXT CHARACTER FROM BASIC 
          BRA  LAF6B          LOOP- PROCESS NEXT DIGIT 
*                              
* LET (EXBAS)                      
* EVALUATE A NON-TOKEN EXPRESSION                      
* TARGET = REPLACEMENT                      
LET       JSR  LB357          FIND TARGET VARIABLE DESCRIPTOR 
          STX  VARDES         SAVE DESCRIPTOR ADDRESS OF 1ST EXPRESSION 
          LDB  #TOK_EQUALS    TOKEN FOR "=" 
          JSR  LB26F          DO A SYNTAX CHECK FOR ‘=‘ 
          LDA  VALTYP         * GET VARIABLE TYPE AND 
          PSHS A              * SAVE ON THE STACK 
          JSR  LB156          EVALUATE EXPRESSION 
          PULS A              * REGET VARIABLE TYPE OF 1ST EXPRESSION AND 
          RORA                * SET CARRY IF STRING 
          JSR  LB148          TYPE CHECK-TM ERROR IF VARIABLE TYPES ON 
*                             BOTH SIDES OF EQUALS SIGN NOT THE SAME 
          LBEQ LBC33          GO PUT FPA0 INTO VARIABLE DESCRIPTOR IF NUMERIC 
* MOVE A STRING WHOSE DESCRIPTOR IS LOCATED AT                      
* FPA0+2 INTO THE STRING SPACE. TRANSFER THE                      
* DESCRIPTOR ADDRESS TO THE ADDRESS IN VARDES                      
* DON’T MOVE THE STRING IF IT IS ALREADY IN THE                      
* STRING SPACE. REMOVE DESCRIPTOR FROM STRING                      
* STACK IF IT IS LAST ONE ON THE STACK                      
LAFA4     LDX  FPA0+2         POINT X TO DESCRIPTOR OF REPLACEMENT STRING 
          LDD  FRETOP         LOAD ACCD WITH START OF STRING SPACE 
          CMPD 2,X            IS THE STRING IN STRING SPACE? 
          BCC  LAFBE          BRANCH IF IT’S NOT IN THE STRING SPACE 
          CMPX VARTAB         COMPARE DESCRIPTOR ADDRESS TO START OF VARIABLES 
          BCS  LAFBE          BRANCH IF DESCRIPTOR ADDRESS NOT IN VARIABLES 
LAFB1     LDB  ,X             GET LENGTH OF REPLACEMENT STRING 
          JSR  LB50D          RESERVE ACCB BYTES OF STRING SPACE 
          LDX  V4D            GET DESCRIPTOR ADDRESS BACK 
          JSR  LB643          MOVE STRING INTO STRING SPACE 
          LDX  #STRDES        POINT X TO TEMP STRING DESCRIPTOR ADDRESS 
LAFBE     STX  V4D            SAVE STRING DESCRIPTOR ADDRESS IN V4D 
          JSR  LB675          REMOVE STRING DESCRIPTOR IF LAST ONE 
*              ON STRING STACK  
          LDU  V4D            POINT U TO REPLACEMENT DESCRIPTOR ADDRESS 
          LDX  VARDES         GET TARGET DESCRIPTOR ADDRESS 
          PULU A,B,Y          GET LENGTH AND START OF REPLACEMENT STRING 
          STA  ,X             * SAVE STRING LENGTH AND START IN 
          STY  2,X            * TARGET DESCRIPTOR LOCATION 
LAFCE     RTS                  
                               
LAFCF     FCC  "?REDO"        ?REDO MESSAGE 
          FCB  CR,$00          
                               
LAFD6                          
LAFDC     JMP  LAC46          JMP TO ERROR HANDLER 
LAFDF     LDA  INPFLG         = GET THE INPUT FLAG AND BRANCH 
          BEQ  LAFEA          = IF ‘INPUT’ 
          LDX  DATTXT         * GET LINE NUMBER WHERE THE ERROR OCCURRED 
          STX  CURLIN         * AND USE IT AS THE CURRENT LINE NUMBER 
          JMP  LB277          ‘SYNTAX ERROR’ 
LAFEA     LDX  #LAFCF-1       * POINT X TO ‘?REDO’ AND PRINT 
          JSR  LB99C          * IT ON THE SCREEN 
          LDX  TINPTR         = GET THE SAVED ABSOLUTE ADDRESS OF 
          STX  CHARAD         = INPUT POINTER AND RESTORE IT 
          RTS                  
*                              
* INPUT                        
INPUT     LDB  #11*2          ‘ID’ ERROR 
          LDX  CURLIN         GET CURRENT LINE NUMBER 
          LEAX 1,X            ADD ONE 
          BEQ  LAFDC          ‘ID’ ERROR BRANCH IF DIRECT MODE 
          BSR  LB00F          GET SOME INPUT DATA - WAS LB002 
          RTS                  
LB00F     CMPA #'"            CHECK FOR PROMPT STRING DELIMITER 
          BNE  LB01E          BRANCH IF NO PROMPT STRING 
          JSR  LB244          PUT PROMPT STRING ON STRING STACK 
          LDB  #';            * 
          JSR  LB26F          * DO A SYNTAX CHECK FOR SEMICOLON 
          JSR  LB99F          PRINT MESSAGE TO CONSOLE OUT 
LB01E     LDX  #LINBUF        POINT TO BASIC’S LINE BUFFER 
          CLR  ,X             CLEAR 1ST BYTE - FLAG TO INDICATE NO DATA 
*              IN LINE BUFFER  
          BSR  LB02F          INPUT A STRING TO LINE BUFFER 
          LDB  #',            * INSERT A COMMA AT THE END 
          STB  ,X             * OF THE LINE INPUT BUFFER 
          BRA  LB049           
* FILL BASIC’S LINE INPUT BUFFER CONSOLE IN                      
LB02F     JSR  LB9AF          SEND A "?" TO CONSOLE OUT 
          JSR  LB9AC          SEND A ‘SPACE’ TO CONSOLE OUT 
LB035     JSR  LA390          GO READ IN A BASIC LINE 
          BCC  LB03F          BRANCH IF ENTER KEY ENDED ENTRY 
          LEAS 4,S            PURGE TWO RETURN ADDRESSES OFF THE STACK 
          JMP  LAE11          GO DO A ‘STOP’ IF BREAK KEY ENDED LINE ENTRY 
LB03F     LDB  #2*23          ‘INPUT PAST END OF FILE’ ERROR 
          RTS                  
*                              
* READ                         
READ      LDX  DATPTR         GET ‘READ’ START ADDRESS 
          FCB  SKP1LD         SKIP ONE BYTE - LDA #*$4F 
LB049     CLRA                ‘INPUT’ ENTRY POINT: INPUT FLAG = 0 
          STA  INPFLG         SET INPUT FLAG; 0 = INPUT: <> 0 = READ 
          STX  DATTMP         SAVE ‘READ’ START ADDRESS/’INPUT’ BUFFER START 
LB04E     JSR  LB357          EVALUATE A VARIABLE 
          STX  VARDES         SAVE DESCRIPTOR ADDRESS 
          LDX  CHARAD         * GET BASIC’S INPUT POINTER 
          STX  BINVAL         * AND SAVE IT 
          LDX  DATTMP         GET ‘READ’ ADDRESS START/’INPUT’ BUFFER POINTER 
          LDA  ,X             GET A CHARACTER FROM THE BASIC PROGRAM 
          BNE  LB069          BRANCH IF NOT END OF LINE 
          LDA  INPFLG         * CHECK INPUT FLAG AND BRANCH 
          BNE  LB0B9          * IF LOOKING FOR DATA (READ) 
* NO DATA IN ‘INPUT’ LINE BUFFER AND/OR INPUT                      
* NOT COMING FROM SCREEN                      
          JSR  LB9AF          SEND A '?' TO CONSOLE OUT 
          BSR  LB02F          FILL INPUT BUFFER FROM CONSOLE IN 
LB069     STX  CHARAD         RESET BASIC’S INPUT POINTER 
          JSR  GETNCH         GET A CHARACTER FROM BASIC 
          LDB  VALTYP         * CHECK VARIABLE TYPE AND 
          BEQ  LB098          * BRANCH IF NUMERIC 
* READ/INPUT A STRING VARIABLE                      
          LDX  CHARAD         LOAD X WITH CURRENT BASIC INPUT POINTER 
          STA  CHARAC         SAVE CURRENT INPUT CHARACTER 
          CMPA #'"            CHECK FOR STRING DELIMITER 
          BEQ  LB08B          BRANCH IF STRING DELIMITER 
          LEAX -1,X           BACK UP POINTER 
          CLRA                * ZERO = END OF LINE CHARACTER 
          STA  CHARAC         * SAVE AS TERMINATOR 
          JSR  LA35F          SET UP PRINT PARAMETERS 
          LDA  #':            END OF SUBLINE CHARACTER 
          STA  CHARAC         SAVE AS TERMINATOR I 
          LDA  #',            COMMA 
LB08B     STA  ENDCHR         SAVE AS TERMINATOR 2 
          JSR  LB51E          STRIP A STRING FROM THE INPUT BUFFER 
          JSR  LB249          MOVE INPUT POINTER TO END OF STRING 
          JSR  LAFA4          PUT A STRING INTO THE STRING SPACE IF NECESSARY 
          BRA  LB09E          CHECK FOR ANOTHER DATA ITEM 
* SAVE A NUMERIC VALUE IN A READ OR INPUT DATA ITEM                      
LB098     JSR  LBD12          CONVERT AN ASCII STRING TO FP NUMBER 
          JSR  LBC33          PACK FPA0 AND STORE IT IN ADDRESS IN VARDES - 
*                             INPUT OR READ DATA ITEM 
LB09E     JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          BEQ  LB0A8          BRANCH IF END OF LINE 
          CMPA #',            CHECK FOR A COMMA 
          LBNE LAFD6          BAD FILE DATA' ERROR OR RETRY 
LB0A8     LDX  CHARAD         * GET CURRENT INPUT 
          STX  DATTMP         * POINTER (USED AS A DATA POINTER) AND SAVE IT 
          LDX  BINVAL         * RESET INPUT POINTER TO INPUT OR 
          STX  CHARAD         * READ STATEMENT 
          JSR  GETCCH         GET CURRENT CHARACTER FROM BASIC 
          BEQ  LB0D5          BRANCH IF END OF LINE - EXIT COMMAND 
          JSR  LB26D          SYNTAX CHECK FOR COMMA 
          BRA  LB04E          GET ANOTHER INPUT OR READ ITEM 
* SEARCH FROM ADDRESS IN X FOR                      
* 1ST OCCURENCE OF THE TOKEN FOR DATA                      
LB0B9     STX  CHARAD         RESET BASIC’S INPUT POINTER 
          JSR  LAEE8          SEARCH FOR END OF CURRENT LINE OR SUBLINE 
          LEAX 1,X            MOVE X ONE PAST END OF LINE 
          TSTA                CHECK FOR END OF LINE 
          BNE  LB0CD          BRANCH IF END OF SUBLINE 
          LDB  #2*3           ‘OUT OF DATA’ ERROR 
          LDU  ,X++           GET NEXT 2 CHARACTERS 
          BEQ  LB10A          ‘OD’ ERROR IF END OF PROGRAM 
          LDD  ,X++           GET BASIC LINE NUMBER AND 
          STD  DATTXT         SAVE IT IN DATTXT 
LB0CD     LDA  ,X             GET AN INPUT CHARACTER 
          CMPA #TOK_DATA      DATA TOKEN? 
          BNE  LB0B9          NO — KEEP LOOKING 
          BRA  LB069          YES 
* EXIT READ AND INPUT COMMANDS                      
LB0D5     LDX  DATTMP         GET DATA POINTER 
          LDB  INPFLG         * CHECK INPUT FLAG 
          LBNE LADE8          * SAVE NEW DATA POINTER IF READ 
          LDA  ,X             = CHECK NEXT CHARACTER IN ‘INPUT’ BUFFER 
          BEQ  LB0E7          = 
          LDX  #LB0E8-1       POINT X TO ‘?EXTRA IGNORED’ 
          JMP  LB99C          PRINT THE MESSAGE 
LB0E7     RTS                  
                               
LB0E8     FCC  "?EXTRA IGNORED" ?EXTRA IGNORED MESSAGE 
                               
                               
          FCB  CR,$00          
                               
* NEXT                         
NEXT      BNE  LB0FE          BRANCH IF ARGUMENT GIVEN 
          LDX  ZERO           X = 0: DEFAULT FOR NO ARGUMENT 
          BRA  LB101           
LB0FE     JSR  LB357          EVALUATE AN ALPHA EXPRESSION 
LB101     STX  VARDES         SAVE VARIABLE DESCRIPTOR POINTER 
          JSR  LABF9          GO SCAN FOR ‘FOR/NEXT’ DATA ON STACK 
          BEQ  LB10C          BRANCH IF DATA FOUND 
          LDB  #0             ‘NEXT WITHOUT FOR’ ERROR (SHOULD BE CLRB) 
LB10A     BRA  LB153          PROCESS ERROR 
LB10C     TFR  X,S            POINT S TO START OF ‘FOR/NEXT’ DATA 
          LEAX 3,X            POINT X TO FP VALUE OF STEP 
          JSR  LBC14          COPY A FP NUMBER FROM (X) TO FPA0 
          LDA  8,S            GET THE DIRECTION OF STEP 
          STA  FP0SGN         SAVE IT AS THE SIGN OF FPA0 
          LDX  VARDES         POINT (X) TO INDEX VARIABLE DESCRIPTOR 
          JSR  LB9C2          ADD (X) TO FPA0 (STEP TO INDEX) 
          JSR  LBC33          PACK FPA0 AND STORE IT IN ADDRESS 
*                             CONTAINED IN VARDES 
          LEAX 9,S            POINT (X) TO TERMINAL VALUE OF INDEX 
          JSR  LBC96          COMPARE CURRENT INDEX VALUE TO TERMINAL VALUE OF INDEX 
          SUBB 8,S            ACCB = 0 IF TERMINAL VALUE=CURRENT VALUE AND STEP=0 OR IF 
*                             STEP IS POSITIVE AND CURRENT VALUE>TERMINAL VALUE OR 
*                             STEP IS NEGATIVE AND CURRENT VALUE<TERMINAL VALUE 
          BEQ  LB134          BRANCH IF ‘FOR/NEXT’ LOOP DONE 
          LDX  14,S           * GET LINE NUMBER AND 
          STX  CURLIN         * BASIC POINTER OF 
          LDX  16,S           * STATEMENT FOLLOWING THE 
          STX  CHARAD         * PROPER FOR STATEMENT 
LB131     JMP  LAD9E          JUMP BACK TO COMMAND INTEPR. LOOP 
LB134     LEAS 18,S           PULL THE ‘FOR-NEXT’ DATA OFF THE STACK 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          CMPA #',            CHECK FOR ANOTHER ARGUMENT 
          BNE  LB131          RETURN IF NONE 
          JSR  GETNCH         GET NEXT CHARACTER FROM BASIC 
          BSR  LB0FE          BSR SIMULATES A CALL TO ‘NEXT’ FROM COMMAND LOOP 
                               
                               
LB141     BSR  LB156          EVALUATE EXPRESSION AND DO A TYPE CHECK FOR NUMERIC 
LB143     ANDCC #$FE           CLEAR CARRY FLAG 
LB145     FCB  $7D            OP CODE OF TST $1A01 - SKIP TWO BYTES (DO 
*              NOT CHANGE CARRY FLAG)  
LB146     ORCC #1             SET CARRY 
                               
* STRING TYPE MODE CHECK - IF ENTERED AT LB146 THEN VALTYP PLUS IS 'TM' ERROR                      
* NUMERIC TYPE MODE CHECK - IF ENTERED AT LB143 THEN VALTYP MINUS IS 'TM' ERROR                      
* IF ENTERED AT LB148, A TYPE CHECK IS DONE ON VALTYP                      
* IF ENTERED WITH CARRY SET, THEN 'TM' ERROR IF NUMERIC                      
* IF ENTERED WITH CARRY CLEAR, THEN 'TM' ERROR IF STRING.                      
LB148     TST  VALTYP         TEST TYPE FLAG; DO NOT CHANGE CARRY 
          BCS  LB14F          BRANCH IF STRING 
          BPL  LB0E7          RETURN ON PLUS 
          FCB  SKP2           SKIP 2 BYTES - ‘TM’ ERROR 
LB14F     BMI  LB0E7          RETURN ON MINUS 
          LDB  #12*2          ‘TYPE M1SMATCH’ ERROR 
LB153     JMP  LAC46          PROCESS ERROR 
* EVALUATE EXPRESSION                      
LB156     BSR  LB1C6          BACK UP INPUT POINTER 
LB158     CLRA                END OF OPERATION PRECEDENCE FLAG 
          FCB  SKP2           SKIP TWO BYTES 
LB15A     PSHS B              SAVE FLAG (RELATIONAL OPERATOR FLAG) 
          PSHS A              SAVE FLAG (PRECEDENCE FLAG) 
          LDB  #1             * 
          JSR  LAC33          * SEE IF ROOM IN FREE RAM FOR (B) WORDS 
          JSR  LB223          GO EVALUATE AN EXPRESSION 
          CLR  TRELFL         RESET RELATIONAL OPERATOR FLAG 
LB168     JSR  GETCCH         GET CURRENT INPUT CHARACTER 
* CHECK FOR RELATIONAL OPERATORS                      
LB16A     SUBA #TOK_GREATER   TOKEN FOR > 
          BCS  LB181          BRANCH IF LESS THAN RELATIONAL OPERATORS 
          CMPA #3             * 
          BCC  LB181          * BRANCH IF GREATER THAN RELATIONAL OPERATORS 
          CMPA #1             SET CARRY IF ‘>‘ 
          ROLA                CARRY TO BIT 0 
          EORA TRELFL         * CARRY SET IF 
          CMPA TRELFL         * TRELFL = ACCA 
          BCS  LB1DF          BRANCH IF SYNTAX ERROR : == << OR >> 
          STA  TRELFL         BIT 0: >, BIT 1 =, BIT 2: < 
          JSR  GETNCH         GET AN INPUT CHARACTER 
          BRA  LB16A          CHECK FOR ANOTHER RELATIONAL OPERATOR 
*                              
LB181     LDB  TRELFL         GET RELATIONAL OPERATOR FLAG 
          BNE  LB1B8          BRANCH IF RELATIONAL COMPARISON 
          LBCC LB1F4          BRANCH IF > RELATIONAL OPERATOR 
          ADDA #7             SEVEN ARITHMETIC/LOGICAL OPERATORS 
          BCC  LB1F4          BRANCH IF NOT ARITHMETIC/LOGICAL OPERATOR 
          ADCA VALTYP         ADD CARRY, NUMERIC FLAG AND MODIFIED TOKEN NUMBER 
          LBEQ LB60F          BRANCH IF VALTYP = FF, AND ACCA = ‘+‘ TOKEN - 
*                             CONCATENATE TWO STRINGS 
          ADCA #-1            RESTORE ARITHMETIC/LOGICAL OPERATOR NUMBER 
          PSHS A              * STORE OPERATOR NUMBER ON STACK; MULTIPLY IT BY 2 
          ASLA                * THEN ADD THE STORED STACK DATA = MULTIPLY 
          ADDA ,S+            * X 3; 3 BYTE/TABLE ENTRY 
          LDX  #LAA51         JUMP TABLE FOR ARITHMETIC & LOGICAL OPERATORS 
          LEAX A,X            POINT X TO PROPER TABLE 
LB19F     PULS A              GET PRECEDENCE FLAG FROM STACK 
          CMPA ,X             COMPARE TO CURRENT OPERATOR 
          BCC  LB1FA          BRANCH IF STACK OPERATOR > CURRENT OPERATOR 
          BSR  LB143          ‘TM’ ERROR IF VARIABLE TYPE = STRING 
                               
* OPERATION BEING PROCESSED IS OF HIGHER PRECEDENCE THAN THE PREVIOUS OPERATION.                      
LB1A7     PSHS A              SAVE PRECEDENCE FLAG 
          BSR  LB1D4          PUSH OPERATOR ROUTINE ADDRESS AND FPA0 ONTO STACK 
          LDX  RELPTR         GET POINTER TO ARITHMETIC/LOGICAL TABLE ENTRY FOR 
*                             LAST CALCULATED OPERATION 
          PULS A              GET PRECEDENCE FLAG OF PREVIOUS OPERATION 
          BNE  LB1CE          BRANCH IF NOT END OF OPERATION 
          TSTA                CHECK TYPE OF PRECEDENCE FLAG 
          LBEQ LB220          BRANCH IF END OF EXPRESSION OR SUB-EXPRESSION 
          BRA  LB203          EVALUATE AN OPERATION 
                               
LB1B8     ASL  VALTYP         BIT 7 OF TYPE FLAG TO CARRY 
          ROLB                SHIFT RELATIONAL FLAG LEFT - VALTYP TO BIT 0 
          BSR  LB1C6          MOVE THE INPUT POINTER BACK ONE 
          LDX  #LB1CB         POINT X TO RELATIONAL COMPARISON JUMP TABLE 
          STB  TRELFL         SAVE RELATIONAL COMPARISON DATA 
          CLR  VALTYP         SET VARIABLE TYPE TO NUMERIC 
          BRA  LB19F          PERFORM OPERATION OR SAVE ON STACK 
                               
LB1C6     LDX  CHARAD         * GET BASIC’S INPUT POINTER AND 
          JMP  LAEBB          * MOVE IT BACK ONE 
* RELATIONAL COMPARISON JUMP TABLE                      
LB1CB     FCB  $64            RELATIONAL COMPARISON FLAG 
LB1CC     FDB  LB2F4          JUMP ADDRESS 
                               
LB1CE     CMPA ,X             COMPARE PRECEDENCE OF LAST DONE OPERATION TO 
*         NEXT TO BE DONE OPERATION  
          BCC  LB203          EVALUATE OPERATION IF LOWER PRECEDENCE 
          BRA  LB1A7          PUSH OPERATION DATA ON STACK IF HIGHER PRECEDENCE 
                               
* PUSH OPERATOR EVALUATION ADDRESS AND FPA0 ONTO STACK AND EVALUATE ANOTHER EXPR                      
LB1D4     LDD  1,X            GET ADDRESS OF OPERATOR ROUTINE 
          PSHS B,A            SAVE IT ON THE STACK 
          BSR  LB1E2          PUSH FPA0 ONTO STACK 
          LDB  TRELFL         GET BACK RELATIONAL OPERATOR FLAG 
          LBRA LB15A          EVALUATE ANOTHER EXPRESSION 
LB1DF     JMP  LB277          ‘SYNTAX ERROR’ 
* PUSH FPA0 ONTO THE STACK. ,S   = EXPONENT      
* 1-2,S =HIGH ORDER MANTISSA 3-4,S = LOW ORDER MANTISSA  
* 5,S = SIGN RETURN WITH PRECEDENCE CODE IN ACCA  
LB1E2     LDB  FP0SGN         GET SIGN OF FPA0 MANTISSA 
          LDA  ,X             GET PRECEDENCE CODE TO ACCA 
LB1E6     PULS Y              GET RETURN ADDRESS FROM STACK & PUT IT IN Y 
          PSHS B              SAVE ACCB ON STACK 
LB1EA     LDB  FP0EXP         * PUSH FPA0 ONTO THE STACK 
          LDX  FPA0           * 
          LDU  FPA0+2         * 
          PSHS U,X,B          * 
          JMP  ,Y             JUMP TO ADDRESS IN Y 
                               
* BRANCH HERE IF NON-OPERATOR CHARACTER FOUND - USUALLY ‘)‘ OR END OF LINE                      
LB1F4     LDX  ZERO           POINT X TO DUMMY VALUE (ZERO) 
          LDA  ,S+            GET PRECEDENCE FLAG FROM STACK 
          BEQ  LB220          BRANCH IF END OF EXPRESSION 
LB1FA     CMPA #$64           * CHECK FOR RELATIONAL COMPARISON FLAG 
          BEQ  LB201          * AND BRANCH IF RELATIONAL COMPARISON 
          JSR  LB143          ‘TM’ ERROR IF VARIABLE TYPE = STRING 
LB201     STX  RELPTR         SAVE POINTER TO OPERATOR ROUTINE 
LB203     PULS B              GET RELATIONAL OPERATOR FLAG FROM STACK 
          CMPA #$5A           CHECK FOR ‘NOT’ OPERATOR 
          BEQ  LB222          RETURN IF ‘NOT’ - NO RELATIONAL COMPARISON 
          CMPA #$7D           CHECK FOR NEGATION (UNARY) FLAG 
          BEQ  LB222          RETURN IF NEGATION - NO RELATIONAL COMPARISON 
                               
* EVALUATE AN OPERATION. EIGHT BYTES WILL BE STORED ON STACK, FIRST SIX BYTES                      
* ARE A TEMPORARY FLOATING POINT RESULT THEN THE ADDRESS OF ROUTINE WHICH                      
* WILL EVALUATE THE OPERATION. THE RTS AT END OF ROUTINE WILL VECTOR                      
* TO EVALUATING ROUTINE.                      
          LSRB                = ROTATE VALTYP BIT INTO CARRY 
          STB  RELFLG         = FLAG AND SAVE NEW RELFLG 
          PULS A,X,U          * PULL A FP VALUE OFF OF THE STACK 
          STA  FP1EXP         * AND SAVE IT IN FPA1 
          STX  FPA1           * 
          STU  FPA1+2         * 
          PULS B              = GET MANTISSA SIGN AND 
          STB  FP1SGN         = SAVE IT IN FPA1 
          EORB FP0SGN         EOR IT WITH FPA1 MANTISSA SIGN 
          STB  RESSGN         SAVE IT IN RESULT SIGN BYTE 
LB220     LDB  FP0EXP         GET EXPONENT OF FPA0 
LB222     RTS                  
                               
LB223     JSR  XVEC15         CALL EXTENDED BASIC ADD-IN 
          CLR  VALTYP         INITIALIZE TYPE FLAG TO NUMERIC 
          JSR  GETNCH         GET AN INPUT CHAR 
          BCC  LB22F          BRANCH IF NOT NUMERIC 
LB22C     JMP  LBD12          CONVERT ASCII STRING TO FLOATING POINT - 
*         RETURN RESULT IN FPA0  
* PROCESS A NON NUMERIC FIRST CHARACTER                      
LB22F     JSR  LB3A2          SET CARRY IF NOT ALPHA 
          BCC  LB284          BRANCH IF ALPHA CHARACTER 
          CMPA #'.            IS IT ‘.‘ (DECIMAL POINT)? 
          BEQ  LB22C          CONVERT ASCII STRING TO FLOATING POINT 
          CMPA #TOK_MINUS     MINUS TOKEN 
          BEQ  LB27C          YES - GO PROCESS THE MINUS OPERATOR 
          CMPA #TOK_PLUS      PLUS TOKEN 
          BEQ  LB223          YES - GET ANOTHER CHARACTER 
          CMPA #'"            STRING DELIMITER? 
          BNE  LB24E          NO 
LB244     LDX  CHARAD         CURRENT BASIC POINTER TO X 
          JSR  LB518          SAVE STRING ON STRING STACK 
LB249     LDX  COEFPT         * GET ADDRESS OF END OF STRING AND 
          STX  CHARAD         * PUT BASIC’S INPUT POINTER THERE 
          RTS                  
LB24E     CMPA #TOK_NOT       NOT TOKEN? 
          BNE  LB25F          NO 
* PROCESS THE NOT OPERATOR                      
          LDA  #$5A           ‘NOT’ PRECEDENCE FLAG 
          JSR  LB15A          PROCESS OPERATION FOLLOWING ‘NOT’ 
          JSR  INTCNV         CONVERT FPA0 TO INTEGER IN ACCD 
          COMA                * ‘NOT’ THE INTEGER 
          COMB                * 
          JMP  GIVABF         CONVERT ACCD TO FLOATING POINT (FPA0) 
LB25F     INCA                CHECK FOR TOKENS PRECEEDED BY $FF 
          BEQ  LB290          IT WAS PRECEEDED BY $FF 
LB262     BSR  LB26A          SYNTAX CHECK FOR A ‘(‘ 
          JSR  LB156          EVALUATE EXPRESSIONS WITHIN PARENTHESES AT 
*         HIGHEST PRECEDENCE      
LB267     LDB  #')            SYNTAX CHECK FOR ‘)‘ 
          FCB  SKP2           SKIP 2 BYTES 
LB26A     LDB  #'(            SYNTAX CHECK FOR ‘(‘ 
          FCB  SKP2           SKIP 2 BYTES 
LB26D     LDB  #',            SYNTAX CHECK FOR COMMA 
LB26F     CMPB [CHARAD]       * COMPARE ACCB TO CURRENT INPUT 
          BNE  LB277          * CHARACTER - SYNTAX ERROR IF NO MATCH 
          JMP  GETNCH         GET A CHARACTER FROM BASIC 
LB277     LDB  #2*1           SYNTAX ERROR 
          JMP  LAC46          JUMP TO ERROR HANDLER 
                               
* PROCESS THE MINUS (UNARY) OPERATOR                      
LB27C     LDA  #$7D           MINUS (UNARY) PRECEDENCE FLAG 
          JSR  LB15A          PROCESS OPERATION FOLLOWING ‘UNARY’ NEGATION 
          JMP  LBEE9          CHANGE SIGN OF FPA0 MANTISSA 
                               
* EVALUATE ALPHA EXPRESSION                      
LB284     JSR  LB357          FIND THE DESCRIPTOR ADDRESS OF A VARIABLE 
LB287     STX  FPA0+2         SAVE DESCRIPTOR ADDRESS IN FPA0 
          LDA  VALTYP         TEST VARIABLE TYPE 
          BNE  LB222          RETURN IF STRING 
          JMP  LBC14          COPY A FP NUMBER FROM (X) TO FPA0 
                               
* EVALUATING A SECONDARY TOKEN                      
LB290     JSR  GETNCH         GET AN INPUT CHARACTER (SECONDARY TOKEN) 
          TFR  A,B            SAVE IT IN ACCB 
          ASLB                X2 & BET RID OF BIT 7 
          JSR  GETNCH         GET ANOTHER INPUT CHARACTER 
          CMPB #NUM_SEC_FNS-1*2 29 SECONDARY FUNCTIONS - 1 
          BLS  LB29F          BRANCH IF COLOR BASIC TOKEN 
          JMP  LB277          SYNTAX ERROR 
LB29F     PSHS B              SAVE TOKEN OFFSET ON STACK 
          CMPB #TOK_LEFT-$80*2 CHECK FOR TOKEN WITH AN ARGUMENT 
          BCS  LB2C7          DO SECONDARIES STRING$ OR LESS 
          CMPB #TOK_INKEY-$80*2 * 
          BCC  LB2C9          * DO SECONDARIES $92 (INKEY$) OR > 
          BSR  LB26A          SYNTAX CHECK FOR A ‘(‘ 
          LDA  ,S             GET TOKEN NUMBER 
* DO SECONDARIES (LEFT$, RIGHT$, MID$)                      
          JSR  LB156          EVALUATE FIRST STRING IN ARGUMENT 
          BSR  LB26D          SYNTAX CHECK FOR A COMMA 
          JSR  LB146          ‘TM’ ERROR IF NUMERIC VARiABLE 
          PULS A              GET TOKEN OFFSET FROM STACK 
          LDU  FPA0+2         POINT U TO STRING DESCRIPTOR 
          PSHS U,A            SAVE TOKEN OFFSET AND DESCRIPTOR ADDRESS 
          JSR  LB70B          EVALUATE FIRST NUMERIC ARGUMENT 
          PULS A              GET TOKEN OFFSET FROM STACK 
          PSHS B,A            SAVE TOKEN OFFSET AND NUMERIC ARGUMENT 
          FCB  $8E            OP CODE OF LDX# - SKlP 2 BYTES 
LB2C7     BSR  LB262          SYNTAX CHECK FOR A ‘(‘ 
LB2C9     PULS B              GET TOKEN OFFSET 
          LDX  COMVEC+8       GET SECONDARY FUNCTION JUMP TABLE ADDRESS 
LB2CE     ABX                 ADD IN COMMAND OFFSET 
*                              
* HERE IS WHERE WE BRANCH TO A SECONDARY FUNCTION                      
          JSR  [,X]           GO DO AN SECONDARY FUNCTION 
          JMP  LB143          ‘TM’ ERROR IF VARIABLE TYPE = STRING 
                               
* LOGICAL OPERATOR ‘OR’ JUMPS HERE                      
LB2D4     FCB  SKP1LD         SKIP ONE BYTE - ‘OR’ FLAG = $4F 
                               
* LOGICAL OPERATOR ‘AND’ JUMPS HERE                      
LB2D5     CLRA                AND FLAG = 0 
          STA  TMPLOC         AND/OR FLAG 
          JSR  INTCNV         CONVERT FPA0 INTO AN INTEGER IN ACCD 
          STD  CHARAC         TEMP SAVE ACCD 
          JSR  LBC4A          MOVE FPA1 TO FPA0 
          JSR  INTCNV         CONVERT FPA0 INTO AN INTEGER IN ACCD 
          TST  TMPLOC         CHECK AND/OR FLAG 
          BNE  LB2ED          BRANCH IF OR 
          ANDA CHARAC         * ‘AND’ ACCD WITH FPA0 INTEGER 
          ANDB ENDCHR         * STORED IN ENDCHR 
          BRA  LB2F1          CONVERT TO FP 
LB2ED     ORA  CHARAC         * ‘OR’ ACCD WITH FPA0 INTEGER 
          ORB  ENDCHR         * STORED IN CHARAC 
LB2F1     JMP  GIVABF         CONVERT THE VALUE IN ACCD INTO A FP NUMBER 
                               
* RELATIONAL COMPARISON PROCESS HANDLER                      
LB2F4     JSR  LB148          ‘TM’ ERROR IF TYPE MISMATCH 
          BNE  LB309          BRANCH IF STRING VARIABLE 
          LDA  FP1SGN         * ‘PACK’ THE MANTISSA 
          ORA  #$7F           * SIGN OF FPA1 INTO 
          ANDA FPA1           * BIT 7 OF THE 
          STA  FPA1           * MANTISSA MS BYTE 
          LDX  #FP1EXP        POINT X TO FPA1 
          JSR  LBC96          COMPARE FPA0 TO FPA1 
          BRA  LB33F          CHECK TRUTH OF RELATIONAL COMPARISON 
                               
* RELATIONAL COMPARISON OF STRINGS                      
LB309     CLR  VALTYP         SET VARIABLE TYPE TO NUMERIC 
          DEC  TRELFL         REMOVE STRING TYPE FLAG (BIT0=1 FOR STRINGS) FROM THE 
*                             DESIRED RELATIONAL COMPARISON DATA 
          JSR  LB657          GET LENGTH AND ADDRESS OF STRING WHOSE 
*                             DESCRIPTOR ADDRESS IS IN THE BOTTOM OF FPA0 
          STB  STRDES         * SAVE LENGTH AND ADDRESS IN TEMPORARY 
          STX  STRDES+2       * DESCRIPTOR (STRING B) 
          LDX  FPA1+2         = RETURN LENGTH AND ADDRESS OF STRING 
          JSR  LB659          = WHOSE DESCRIPTOR ADDRESS IS STORED IN FPA1+2 
          LDA  STRDES         LOAD ACCA WITH LENGTH OF STRING B 
          PSHS B              SAVE LENGTH A ON STACK 
          SUBA ,S+            SUBTRACT LENGTH A FROM LENGTH B 
          BEQ  LB328          BRANCH IF STRINGS OF EQUAL LENGTH 
          LDA  #1             TRUE FLAG 
          BCC  LB328          TRUE IF LENGTH B > LENGTH A 
          LDB  STRDES         LOAD ACCB WITH LENGTH B 
          NEGA                SET FLAG = FALSE (1FF) 
LB328     STA  FP0SGN         SAVE TRUE/FALSE FLAG 
          LDU  STRDES+2       POINT U TO START OF STRING 
          INCB                COMPENSATE FOR THE DECB BELOW 
* ENTER WITH ACCB CONTAINING LENGTH OF SHORTER STRING                      
LB32D     DECB                DECREMENT SHORTER STRING LENGTH 
          BNE  LB334          BRANCH IF ALL OF STRING NOT COMPARED 
          LDB  FP0SGN         GET TRUE/FALSE FLAB 
          BRA  LB33F          CHECK TRUTH OF RELATIONAL COMPARISON 
LB334     LDA  ,X+            GET A BYTE FROM STRING A 
          CMPA ,U+            COMPARE TO STRING B 
          BEQ  LB32D          CHECK ANOTHER CHARACTER IF = 
          LDB  #$FF           FALSE FLAG IF STRING A > B 
          BCC  LB33F          BRANCH IF STRING A > STRING B 
          NEGB                SET FLAG = TRUE 
                               
* DETERMINE TRUTH OF COMPARISON - RETURN RESULT IN FPA0                      
LB33F     ADDB #1             CONVERT $FF,0,1 TO 0,1,2 
          ROLB                NOW IT’S 1,2,4 FOR > = < 
          ANDB RELFLG         ‘AND’ THE ACTUAL COMPARISON WITH THE DESIRED - 
COMPARISON                      
          BEQ  LB348          BRANCH IF FALSE (NO MATCHING BITS) 
          LDB  #$FF           TRUE FLAG 
LB348     JMP  LBC7C          CONVERT ACCB INTO FP NUMBER IN FPA0 
                               
* DIM                          
LB34B     JSR  LB26D          SYNTAX CHECK FOR COMMA 
DIM       LDB  #1             DIMENSION FLAG 
          BSR  LB35A          SAVE ARRAY SPACE FOR THIS VARIABLE 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          BNE  LB34B          KEEP DIMENSIONING IF NOT END OF LINE 
          RTS                  
* EVALUATE A VARIABLE - RETURN X AND                      
* VARPTR POINTING TO VARIABLE DESCRIPTOR                      
* EACH VARIABLE REQUIRES 7 BYTES - THE FIRST TWO                      
* BYTES ARE THE VARIABLE NAME AND THE NEXT 5                      
* BYTES ARE THE DESCRIPTOR. IF BIT 7 OF THE                      
* FIRST BYTE OF VARlABLE NAME IS SET, THE                      
* VARIABLE IS A DEF FN VARIABLE. IF BIT 7 OF                      
* THE SECOND BYTE OF VARIABLE NAME IS SET, THE                      
* VARIABLE IS A STRING, OTHERWISE THE VARIABLE                      
* IS NUMERIC.                      
* IF THE VARIABLE IS NOT FOUND, A ZERO VARIABLE IS                      
* INSERTED INTO THE VARIABLE SPACE                      
LB357     CLRB                DIMENSION FLAG = 0; DO NOT SET UP AN ARRAY 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
LB35A     STB  DIMFLG         SAVE ARRAY FLAG 
* ENTRY POINT FOR DEF FN VARIABLE SEARCH                      
LB35C     STA  VARNAM         SAVE INPUT CHARACTER 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          BSR  LB3A2          SET CARRY IF NOT ALPHA 
          LBCS LB277          SYNTAX ERROR IF NOT ALPHA 
          CLRB                DEFAULT 2ND VARIABLE CHARACTER TO ZERO 
          STB  VALTYP         SET VARIABLE TYPE TO NUMERIC 
          JSR  GETNCH         GET ANOTHER CHARACTER FROM BASIC 
          BCS  LB371          BRANCH IF NUMERIC (2ND CHARACTER IN 
*                             VARIABLE MAY BE NUMERIC) 
          BSR  LB3A2          SET CARRY IF NOT ALPHA 
          BCS  LB37B          BRANCH IF NOT ALPHA 
LB371     TFR  A,B            SAVE 2ND CHARACTER IN ACCB 
* READ INPUT CHARACTERS UNTIL A NON ALPHA OR                      
* NON NUMERIC IS FOUND - IGNORE ALL CHARACTERS                      
* IN VARIABLE NAME AFTER THE 1ST TWO                      
LB373     JSR  GETNCH         GET AN INPUT CHARACTER 
          BCS  LB373          BRANCH IF NUMERIC 
          BSR  LB3A2          SET CARRY IF NOT ALPHA 
          BCC  LB373          BRANCH IF ALPHA 
LB37B     CMPA #'$            CHECK FOR A STRING VARIABLE 
          BNE  LB385          BRANCH IF IT IS NOT A STRING 
          COM  VALTYP         SET VARIABLE TYPE TO STRING 
          ADDB #$80           SET BIT 7 OF 2ND CHARACTER (STRING) 
          JSR  GETNCH         GET AN INPUT CHARACTER 
LB385     STB  VARNAM+1       SAVE 2ND CHARACTER IN VARNAM+1 
          ORA  ARYDIS         OR IN THE ARRAY DISABLE FLAG - IF = $80, 
*              DON’T SEARCH FOR VARIABLES IN THE ARRAYS  
          SUBA #'(            IS THIS AN ARRAY VARIABLE? 
          LBEQ LB404          BRANCH IF IT IS 
          CLR  ARYDIS         RESET THE ARRAY DISABLE FLAG 
          LDX  VARTAB         POINT X TO THE START OF VARIABLES 
          LDD  VARNAM         GET VARIABLE IN QUESTION 
LB395     CMPX ARYTAB         COMPARE X TO THE END OF VARIABLES 
          BEQ  LB3AB          BRANCH IF END OF VARIABLES 
          CMPD ,X++           * COMPARE VARIABLE IN QUESTION TO CURRENT 
          BEQ  LB3DC          * VARIABLE AND BRANCH IF MATCH 
          LEAX 5,X            = MOVE POINTER TO NEXT VARIABLE AND 
          BRA  LB395          = KEEP LOOKING 
                               
* SET CARRY IF NOT UPPER CASE ALPHA                      
LB3A2     CMPA #'A            * CARRY SET IF < ‘A’ 
          BCS  LB3AA          * 
          SUBA #'Z+1          = 
*         SUBA #-('Z+1)       = CARRY CLEAR IF <= 'Z' 
          FCB  $80,$A5         
LB3AA     RTS                  
* PUT A NEW VARIABLE IN TABLE OF VARIABLES                      
LB3AB     LDX  #ZERO          POINT X TO ZERO LOCATION 
          LDU  ,S             GET CURRENT RETURN ADDRESS 
          CMPU #LB287         DID WE COME FROM ‘EVALUATE ALPHA EXPR’? 
          BEQ  LB3DE          YES - RETURN A ZERO VALUE 
          LDD  ARYEND         * GET END OF ARRAYS ADDRESS AND 
          STD  V43            * SAVE IT AT V43 
          ADDD #7             = ADD 7 TO END OF ARRAYS (EACH 
          STD  V41            = VARIABLE = 7 BYTES) AND SAVE AT V41 
          LDX  ARYTAB         * GET END OF VARIABLES AND SAVE AT V47 
          STX  V47            * 
          JSR  LAC1E          MAKE A SEVEN BYTE SLOT FOR NEW VARIABLE AT 
*         TOP  OF VARIABLES    
          LDX  V41            = GET NEW END OF ARRAYS AND SAVE IT 
          STX  ARYEND         = 
          LDX  V45            * GET NEW END OF VARIABLES AND SAVE IT 
          STX  ARYTAB         * 
          LDX  V47            GET OLD END OF VARIABLES 
          LDD  VARNAM         GET NEW VARIABLE NAME 
          STD  ,X++           SAVE VARIABLE NAME 
          CLRA                * ZERO OUT THE FP VALUE OF THE NUMERIC 
          CLRB                * VARIABLE OR THE LENGTH AND ADDRESS 
          STD  ,X             * OF A STRING VARIABLE 
          STD  2,X            * 
          STA  4,X            * 
LB3DC     STX  VARPTR         STORE ADDRESS OF VARIABLE VALUE 
LB3DE     RTS                  
*                              
LB3DF     FCB  $90,$80,$00,$00,$00 * FLOATING POINT -32768 
*                             SMALLEST SIGNED TWO BYTE INTEGER 
*                              
LB3E4     JSR  GETNCH         GET AN INPUT CHARACTER FROM BASIC 
LB3E6     JSR  LB141          GO EVALUATE NUMERIC EXPRESSION 
LB3E9     LDA  FP0SGN         GET FPA0 MANTISSA SIGN 
          BMI  LB44A          ‘FC’ ERROR IF NEGATIVE NUMBER 
                               
                               
INTCNV    JSR  LB143          ‘TM’ ERROR IF STRING VARIABLE 
          LDA  FP0EXP         GET FPA0 EXPONENT 
          CMPA #$90           * COMPARE TO 32768 - LARGEST INTEGER EXPONENT AND 
          BCS  LB3FE          * BRANCH IF FPA0 < 32768 
          LDX  #LB3DF         POINT X TO FP VALUE OF -32768 
          JSR  LBC96          COMPARE -32768 TO FPA0 
          BNE  LB44A          ‘FC’ ERROR IF NOT = 
LB3FE     JSR  LBCC8          CONVERT FPA0 TO A TWO BYTE INTEGER 
          LDD  FPA0+2         GET THE INTEGER 
          RTS                  
* EVALUATE AN ARRAY VARIABLE                      
LB404     LDD  DIMFLG         GET ARRAY FLAG AND VARIABLE TYPE 
          PSHS B,A            SAVE THEM ON STACK 
          NOP                 DEAD SPACE CAUSED BY 1.2 REVISION 
          CLRB                RESET DIMENSION COUNTER 
LB40A     LDX  VARNAM         GET VARIABLE NAME 
          PSHS X,B            SAVE VARIABLE NAME AND DIMENSION COUNTER 
          BSR  LB3E4          EVALUATE EXPRESSION (DIMENSlON LENGTH) 
          PULS B,X,Y          PULL OFF VARIABLE NAME, DIMENSlON COUNTER, 
*                             ARRAY FLAG 
          STX  VARNAM         SAVE VARIABLE NAME AND VARIABLE TYPE 
          LDU  FPA0+2         GET DIMENSION LENGTH 
          PSHS U,Y            SAVE DIMENSION LENGTH, ARRAY FLAG, VARIABLE TYPE 
          INCB                INCREASE DIMENSION COUNTER 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          CMPA #',            CHECK FOR ANOTHER DIMENSION 
          BEQ  LB40A          BRANCH IF MORE 
          STB  TMPLOC         SAVE DIMENSION COUNTER 
          JSR  LB267          SYNTAX CHECK FOR A ‘)‘ 
          PULS A,B            * RESTORE VARIABLE TYPE AND ARRAY 
          STD  DIMFLG         * FLAG - LEAVE DIMENSION LENGTH ON STACK 
          LDX  ARYTAB         GET START OF ARRAYS 
LB42A     CMPX ARYEND         COMPARE TO END OF ARRAYS 
          BEQ  LB44F          BRANCH IF NO MATCH FOUND 
          LDD  VARNAM         GET VARIABLE IN QUESTION 
          CMPD ,X             COMPARE TO CURRENT VARIABLE 
          BEQ  LB43B          BRANCH IF = 
          LDD  2,X            GET OFFSET TO NEXT ARRAY VARIABLE 
          LEAX D,X            ADD TO CURRENT POINTER 
          BRA  LB42A          KEEP SEARCHING 
LB43B     LDB  #2*9           ‘REDIMENSIONED ARRAY’ ERROR 
          LDA  DIMFLG         * TEST ARRAY FLAG - IF <>0 YOU ARE TRYING 
          BNE  LB44C          * TO REDIMENSION AN ARRAY 
          LDB  TMPLOC         GET NUMBER OF DIMENSIONS IN ARRAY 
          CMPB 4,X            COMPARE TO THIS ARRAYS DIMENSIONS 
          BEQ  LB4A0          BRANCH IF = 
LB447     LDB  #8*2           ‘BAD SUBSCRIPT’ 
          FCB  SKP2           SKIP TWO BYTES 
LB44A     LDB  #4*2           ‘ILLEGAL FUNCTION CALL’ 
LB44C     JMP  LAC46          JUMP TO ERROR SERVICING ROUTINE 
                               
* INSERT A NEW ARRAY INTO ARRAY VARIABLES                      
* EACH SET OF ARRAY VARIABLES IS PRECEEDED BY A DE-                      
* SCRIPTOR BLOCK COMPOSED OF 5+2*N BYTES WHERE N IS THE                      
* NUMBER OF DIMENSIONS IN THE ARRAY. THE BLOCK IS DEFINED                      
* AS FOLLOWS: BYTES 0,1:VARIABLE’S NAME; 2,3:TOTAL LENGTH                      
* OF ARRAY ITEMS AND DESCRIPTOR BLOCK; 4:NUMBER OF DIMEN-                      
* ISIONS; 5,6:LENGTH OF DIMENSION 1; 7,8:LENGTH OF DIMEN-                      
* SION 2;… 4+N,5+N:LENGTH OF DIMENSION N.                      
                               
LB44F     LDD  #5             * 5 BYTES/ARRAY ENTRY SAVE AT COEFPT 
          STD  COEFPT         * 
          LDD  VARNAM         = GET NAME OF ARRAY AND SAVE IN 
          STD  ,X             = FIRST 2 BYTES OF DESCRIPTOR 
          LDB  TMPLOC         GET NUMBER OF DIMENSIONS AND SAVE IN 
          STB  4,X            * 5TH BYTE OF DESCRIPTOR 
          JSR  LAC33          CHECK FOR ROOM FOR DESCRIPTOR IN FREE RAM 
          STX  V41            TEMPORARILY SAVE DESCRIPTOR ADDRESS 
LB461     LDB  #11            * DEFAULT DIMENSION VALUE:X(10) 
          CLRA                * 
          TST  DIMFLG         = CHECK ARRAY FLAG AND BRANCH IF 
          BEQ  LB46D          = NOT DIMENSIONING AN ARRAY 
          PULS A,B            GET DIMENSION LENGTH 
          ADDD #1             ADD ONE (X(0) HAS A LENGTH OF ONE) 
LB46D     STD  5,X            SAVE LENGTH OF ARRAY DIMENSION 
          BSR  LB4CE          MULTIPLY ACCUM ARRAY SIZE NUMBER LENGTH 
*                             OF NEW DIMENSION 
          STD  COEFPT         TEMP STORE NEW CURRENT ACCUMULATED ARRAY SIZE 
          LEAX 2,X            BUMP POINTER UP TWO 
          DEC  TMPLOC         * DECREMENT DIMENSION COUNTER AND BRANCH IF 
          BNE  LB461          * NOT DONE WITH ALL DIMENSIONS 
          STX  TEMPTR         SAVE ADDRESS OF (END OF ARRAY DESCRIPTOR - 5) 
          ADDD TEMPTR         ADD TOTAL SIZE OF NEW ARRAY 
          LBCS LAC44          ‘OM’ ERROR IF > $FFFF 
          TFR  D,X            SAVE END OF ARRAY IN X 
          JSR  LAC37          MAKE SURE THERE IS ENOUGH FREE RAM FOR ARRAY 
          SUBD #STKBUF-5      SUBTRACT OUT THE (STACK BUFFER - 5) 
          STD  ARYEND         SAVE NEW END OF ARRAYS 
          CLRA                ZERO = TERMINATOR BYTE 
LB48C     LEAX -1,X           * STORE TWO TERMINATOR BYTES AT 
          STA  5,X            * THE END OF THE ARRAY DESCRIPTOR 
          CMPX TEMPTR         * 
          BNE  LB48C          * 
          LDX  V41            GET ADDRESS OF START OF DESCRIPTOR 
          LDA  ARYEND         GET MSB OF END OF ARRAYS; LSB ALREADY THERE 
          SUBD V41            SUBTRACT OUT ADDRESS OF START OF DESCRIPTOR 
          STD  2,X            SAVE LENGTH OF (ARRAY AND DESCRIPTOR) 
          LDA  DIMFLG         * GET ARRAY FLAG AND BRANCH 
          BNE  LB4CD          * BACK IF DIMENSIONING 
* CALCULATE POINTER TO CORRECT ELEMENT                      
LB4A0     LDB  4,X            GET THE NUMBER OF DIMENSIONS 
          STB  TMPLOC         TEMPORARILY SAVE 
          CLRA                * INITIALIZE POINTER 
          CLRB                * TO ZERO 
LB4A6     STD  COEFPT         SAVE ACCUMULATED POINTER 
          PULS A,B            * PULL DIMENSION ARGUMENT OFF THE 
          STD  FPA0+2         * STACK AND SAVE IT 
          CMPD 5,X            COMPARE TO STORED ‘DIM’ ARGUMENT 
          BCC  LB4EB          ‘BS’ ERROR IF > = "DIM" ARGUMENT 
          LDU  COEFPT         * GET ACCUMULATED POINTER AND 
          BEQ  LB4B9          * BRANCH IF 1ST DIMENSION 
          BSR  LB4CE          = MULTIPLY ACCUMULATED POINTER AND DIMENSION 
          ADDD FPA0+2         = LENGTH AND ADD TO CURRENT ARGUMENT 
LB4B9     LEAX 2,X            MOVE POINTER TO NEXT DIMENSION 
          DEC  TMPLOC         * DECREMENT DIMENSION COUNTER AND 
          BNE  LB4A6          * BRANCH IF ANY DIMENSIONS LEFT 
* MULTIPLY ACCD BY 5 - 5 BYTES/ARRAY VALUE                      
          STD  ,--S            
          ASLB                 
          ROLA                TIMES 2 
          ASLB                 
          ROLA                TIMES 4 
          ADDD ,S++           TIMES 5 
          LEAX D,X            ADD OFFSET TO START OF ARRAY 
          LEAX 5,X            ADJUST POINTER FOR SIZE OF DESCRIPTOR 
          STX  VARPTR         SAVE POINTER TO ARRAY VALUE 
LB4CD     RTS                  
* MULTIPLY 2 BYTE NUMBER IN 5,X BY THE 2 BYTE NUMBER                      
* IN COEFPT. RETURN RESULT IN ACCD, BS ERROR IF > $FFFF                      
LB4CE     LDA  #16            16 SHIFTS TO DO A MULTIPLY 
          STA  V45            SHIFT COUNTER 
          LDD  5,X            * GET SIZE OF DIMENSION 
          STD  BOTSTK         * AND SAVE IT 
          CLRA                * ZERO 
          CLRB                * ACCD 
LB4D8     ASLB                = SHIFT ACCB LEFT 
          ROLA                = ONE BIT 
          BCS  LB4EB          BS' ERROR IF CARRY 
          ASL  COEFPT+1       * SHIFT MULTIPLICAND LEFT ONE 
          ROL  COEFPT         * BIT - ADD MULTIPLIER TO ACCUMULATOR 
          BCC  LB4E6          * IF CARRY <> 0 
          ADDD BOTSTK         ADD MULTIPLIER TO ACCD 
          BCS  LB4EB          BS' ERROR IF CARRY (>$FFFF) 
LB4E6     DEC  V45            * DECREMENT SHIFT COUNTER 
          BNE  LB4D8          * IF NOT DONE 
          RTS                  
LB4EB     JMP  LB447          BS' ERROR 
*                              
* MEM                          
* THIS IS NOT A TRUE INDICATOR OF FREE MEMORY BECAUSE                      
* BASIC REQUIRES A STKBUF SIZE BUFFER FOR THE STACK                      
* FOR WHICH MEM DOES NOT ALLOW.                      
*                              
MEM       TFR  S,D            PUT STACK POINTER INTO ACCD 
          SUBD ARYEND         SUBTRACT END OF ARRAYS 
          FCB  SKP1           SKIP ONE BYTE 
*CONVERT THE VALUE IN ACCB INTO A FP NUMBER IN FPA0                      
LB4F3     CLRA                CLEAR MS BYTE OF ACCD 
* CONVERT THE VALUE IN ACCD INTO A FLOATING POINT NUMBER IN FPA0                      
GIVABF    CLR  VALTYP         SET VARIABLE TYPE TO NUMERIC 
          STD  FPA0           SAVE ACCD IN TOP OF FACA 
          LDB  #$90           EXPONENT REQUIRED IF THE TOP TWO BYTES 
*         OF   FPA0 ARE TO BE TREATED AS AN INTEGER IN FPA0  
          JMP  LBC82          CONVERT THE REST OF FPA0 TO AN INTEGER 
                               
* STR$                         
STR       JSR  LB143          TM' ERROR IF STRING VARIABLE 
          LDU  #STRBUF+2      *CONVERT FP NUMBER TO ASCII STRING IN 
          JSR  LBDDC          *THE STRING BUFFER 
          LEAS 2,S            PURGE THE RETURN ADDRESS FROM THE STACK 
          LDX  #STRBUF+1      *POINT X TO STRING BUFFER AND SAVE 
          BRA  LB518          *THE STRING IN THE STRING SPACE 
* RESERVE ACCB BYTES OF STRING SPACE. RETURN START                      
* ADDRESS IN (X) AND FRESPC                      
LB50D     STX  V4D            SAVE X IN V4D 
LB50F     BSR  LB56D          RESERVE ACCB BYTES IN STRING SPACE 
LB511     STX  STRDES+2       SAVE NEW STRING ADDRESS 
          STB  STRDES         SAVE LENGTH OF RESERVED BLOCK 
          RTS                  
LB516     LEAX -1,X           MOVE POINTER BACK ONE 
* SCAN A LINE FROM (X) UNTIL AN END OF LINE FLAG (ZERO) OR                      
* EITHER OF THE TWO TERMINATORS STORED IN CHARAC OR ENDCHR IS MATCHED.                      
* THE RESULTING STRING IS STORED IN THE STRING SPACE                      
* ONLY IF THE START OF THE STRING IS <= STRBUF+2                      
LB518     LDA  #'"            * INITIALIZE 
          STA  CHARAC         * TERMINATORS 
LB51A     STA  ENDCHR         * TO " 
LB51E     LEAX 1,X            MOVE POINTER UP ONE 
          STX  RESSGN         TEMPORARILY SAVE START OF STRING 
          STX  STRDES+2       SAVE START OF STRING IN TEMP DESCRIPTOR 
          LDB  #-1            INITIALIZE CHARACTER COUNTER TO - 1 
LB526     INCB                INCREMENT CHARACTER COUNTER 
          LDA  ,X+            GET CHARACTER 
          BEQ  LB537          BRANCH IF END OF LINE 
          CMPA CHARAC         * CHECK FOR TERMINATORS 
          BEQ  LB533          * IN CHARAC AND ENDCHR 
          CMPA ENDCHR         * DON’T MOVE POINTER BACK 
          BNE  LB526          * ONE IF TERMINATOR IS "MATCHED" 
LB533     CMPA #'"            = COMPARE CHARACTER TO STRING DELIMITER 
          BEQ  LB539          = & DON’T MOVE POINTER BACK IF SO 
LB537     LEAX -1,X           MOVE POINTER BACK ONE 
LB539     STX  COEFPT         SAVE END OF STRING ADDRESS 
          STB  STRDES         SAVE STRING LENGTH IN TEMP DESCRIPTOR 
          LDU  RESSGN         GET INITlAL STRING START 
          CMPU #STRBUF+2      COMPARE TO START OF STRING BUFFER 
LB543     BHI  LB54C          BRANCH IF > START OF STRING BUFFER 
          BSR  LB50D          GO RESERVE SPACE FOR THE STRING 
          LDX  RESSGN         POINT X TO THE BEGINNING OF THE STRING 
          JSR  LB645          MOVE (B) BYTES FROM (X) TO 
*                             [FRESPC] - MOVE STRING DATA 
* PUT DIRECT PAGE STRING DESCRIPTOR BUFFER DATA                      
* ON THE STRING STACK. SET VARIABLE TYPE TO STRING                      
LB54C     LDX  TEMPPT         GET NEXT AVAILABLE STRING STACK DESCRIPTOR 
          CMPX #LINHDR        COMPARE TO TOP OF STRING DESCRIPTOR STACK - WAS #CFNBUF 
          BNE  LB558          FORMULA O.K. 
          LDB  #15*2          STRING FORMULA TOO COMPLEX' ERROR 
LB555     JMP  LAC46          JUMP TO ERROR SERVICING ROUTINE 
LB558     LDA  STRDES         * GET LENGTH OF STRING AND SAVE IT 
*         STA  ,X             * IN BYTE 0 OF DESCRIPTOR 
          FCB  $A7,$00         
          LDD  STRDES+2       = GET START ADDRESS OF ACTUAL STRING 
          STD  2,X            = AND SAVE IN BYTES 2,3 OF DESCRIPTOR 
          LDA  #$FF           * VARIABLE TYPE = STRING 
          STA  VALTYP         * SAVE IN VARIABLE TYPE FLAG 
          STX  LASTPT         = SAVE START OF DESCRIPTOR 
          STX  FPA0+2         = ADDRESS IN LASTPT AND FPA0 
          LEAX 5,X            5 BYTES/STRING DESCRIPTOR 
          STX  TEMPPT         NEXT AVAILABLE STRING VARIABLE DESCRIPTOR 
          RTS                  
* RESERVE ACCB BYTES IN STRING STORAGE SPACE                      
* RETURN WITH THE STARTING ADDRESS OF THE                      
* RESERVED STRING SPACE IN (X) AND FRESPC                      
LB56D     CLR  GARBFL         CLEAR STRING REORGANIZATION FLAG 
LB56F     CLRA                * PUSH THE LENGTH OF THE 
          PSHS B,A            * STRING ONTO THE STACK 
          LDD  STRTAB         GET START OF STRING VARIABLES 
          SUBD ,S+            SUBTRACT STRING LENGTH 
          CMPD FRETOP         COMPARE TO START OF STRING STORAGE 
          BCS  LB585          IF BELOW START, THEN REORGANIZE 
          STD  STRTAB         SAVE NEW START OF STRING VARIABLES 
          LDX  STRTAB         GET START OF STRING VARIABLES 
          LEAX 1,X            ADD ONE 
          STX  FRESPC         SAVE START ADDRESS OF NEWLY RESERVED SPACE 
          PULS B,PC           RESTORE NUMBER OF BYTES RESERVED AND RETURN 
LB585     LDB  #2*13          OUT OF STRING SPACE' ERROR 
          COM  GARBFL         TOGGLE REORGANIZATiON FLAG 
          BEQ  LB555          ERROR IF FRESHLY REORGANIZED 
          BSR  LB591          GO REORGANIZE STRING SPACE 
          PULS B              GET BACK THE NUMBER OF BYTES TO RESERVE 
          BRA  LB56F          TRY TO RESERVE ACCB BYTES AGAIN 
* REORGANIZE THE STRING SPACE                      
LB591     LDX  MEMSIZ         GET THE TOP OF STRING SPACE 
LB593     STX  STRTAB         SAVE TOP OF UNORGANIZED STRING SPACE 
          CLRA                * ZERO OUT ACCD 
          CLRB                * AND RESET VARIABLE 
          STD  V4B            * POINTER TO 0 
          LDX  FRETOP         POINT X TO START OF STRING SPACE 
          STX  V47            SAVE POINTER IN V47 
          LDX  #STRSTK        POINT X TO START OF STRING DESCRIPTOR STACK 
LB5A0     CMPX TEMPPT         COMPARE TO ADDRESS OF NEXT AVAILABLE DESCRIPTOR 
          BEQ  LB5A8          BRANCH IF TOP OF STRING STACK 
          BSR  LB5D8          CHECK FOR STRING IN UNORGANIZED STRING SPACE 
          BRA  LB5A0          KEEP CHECKING 
LB5A8     LDX  VARTAB         GET THE END OF BASIC PROGRAM 
LB5AA     CMPX ARYTAB         COMPARE TO END OF VARIABLES 
          BEQ  LB5B2          BRANCH IF AT TOP OF VARIABLES 
          BSR  LB5D2          CHECK FOR STRING IN UNORGANIZED STRING SPACE 
          BRA  LB5AA          KEEP CHECKING VARIABLES 
LB5B2     STX  V41            SAVE ADDRESS OF THE END OF VARIABLES 
LB5B4     LDX  V41            GET CURRENT ARRAY POINTER 
LB5B6     CMPX ARYEND         COMPARE TO THE END OF ARRAYS 
          BEQ  LB5EF          BRANCH IF AT END OF ARRAYS 
          LDD  2,X            GET LENGTH OF ARRAY AND DESCRIPTOR 
          ADDD V41            * ADD TO CURRENT ARRAY POINTER 
          STD  V41            * AND SAVE IT 
          LDA  1,X            GET 1ST CHARACTER OF VARIABLE NAME 
          BPL  LB5B4          BRANCH IF NUMERIC ARRAY 
          LDB  4,X            GET THE NUMBER OF DIMENSIONS IN THIS ARRAY 
          ASLB                MULTIPLY BY 2 
          ADDB #5             ADD FIVE BYTES (VARIABLE NAME, ARRAY 
*                             LENGTH, NUMBER DIMENSIONS) 
          ABX                 X NOW POINTS TO START OF ARRAY ELEMENTS 
LB5CA     CMPX V41            AT END OF THIS ARRAY? 
          BEQ  LB5B6          YES - CHECK FOR ANOTHER 
          BSR  LB5D8          CHECK FOR STRING LOCATED IN 
*                             UNORGANIZED STRING SPACE 
          BRA  LB5CA          KEEP CHECKING ELEMENTS IN THIS ARRAY 
LB5D2     LDA  1,X            GET F1RST BYTE OF VARIABLE NAME 
          LEAX 2,X            MOVE POINTER TO DESCRIPTOR 
          BPL  LB5EC          BRANCH IF VARIABLE IS NUMERIC 
* SEARCH FOR STRING - ENTER WITH X POINTING TO                      
* THE STRING DESCRIPTOR. IF STRING IS STORED                      
* BETWEEN V47 AND STRTAB, SAVE DESCRIPTOR POINTER                      
* IN V4B AND RESET V47 TO STRING ADDRESS                      
LB5D8     LDB  ,X             GET THE LENGTH OF THE STRING 
          BEQ  LB5EC          BRANCH IF NULL - NO STRING 
          LDD  2,X            GET STARTING ADDRESS OF THE STRING 
          CMPD STRTAB         COMPARE TO THE START OF STRING VARIABLES 
          BHI  LB5EC          BRANCH IF THIS STRING IS STORED IN 
*              THE STRING VARIABLES  
          CMPD V47            COMPARE TO START OF STRING SPACE 
          BLS  LB5EC          BRANCH IF NOT STORED IN THE STRING SPACE 
          STX  V4B            SAVE VARIABLE POINTER IF STORED IN STRING SPACE 
          STD  V47            SAVE STRING STARTING ADDRESS 
LB5EC     LEAX 5,X            MOVE TO NEXT VARIABLE DESCRIPTOR 
LB5EE     RTS                  
LB5EF     LDX  V4B            GET ADDRESS OF THE DESCRIPTOR FOR THE 
*              STRING WHICH IS STORED IN THE HIGHEST RAM ADDRESS IN  
*              THE UNORGANIZED STRING SPACE  
          BEQ  LB5EE          BRANCH IF NONE FOUND AND REORGANIZATION DONE 
          CLRA                CLEAR MS BYTE OF LENGTH 
          LDB  ,X             GET LENGTH OF STRING 
          DECB                SUBTRACT ONE 
          ADDD V47            ADD LENGTH OF STRING TO ITS STARTING ADDRESS 
          STD  V43            SAVE AS MOVE STARTING ADDRESS 
          LDX  STRTAB         POINT X TO THE START OF ORGANIZED STRING VARIABLES 
          STX  V41            SAVE AS MOVE ENDING ADDRESS 
          JSR  LAC20          MOVE STRING FROM CURRENT POSITION TO THE 
*              TOP OF UNORGANIZED STRING SPACE  
          LDX  V4B            POINT X TO STRING DESCRIPTOR 
          LDD  V45            * GET NEW STARTING ADDRESS OF STRING AND 
          STD  2,X            * SAVE IT IN DESCRIPTOR 
          LDX  V45            GET NEW TOP OF UNORGANIZED STRING SPACE 
          LEAX -1,X           MOVE POINTER BACK ONE 
          JMP  LB593          JUMP BACK AND REORGANIZE SOME MORE 
                               
                               
LB60F     LDD  FPA0+2         * GET DESCRIPTOR ADDRESS OF STRING A 
          PSHS B,A            * AND SAVE IT ON THE STACK 
          JSR  LB223          GET DESCRIPTOR ADDRESS OF STRING B 
          JSR  LB146          TM' ERROR IF NUMERIC VARIABLE 
          PULS X              * POINT X TO STRING A DESCRIPTOR 
          STX  RESSGN         * ADDRESS AND SAVE IT IN RESSGN 
          LDB  ,X             GET LENGTH OF STRING A 
          LDX  FPA0+2         POINT X TO DESCRIPTOR OF STRING B 
          ADDB ,X             ADD LENGTH OF STRING B TO STR1NG A 
          BCC  LB62A          BRANCH IF LENGTH < 256 
          LDB  #2*14          STRING TOO LONG' ERROR IF LENGTH > 255 
          JMP  LAC46          JUMP TO ERROR SERVICING ROUTINE 
LB62A     JSR  LB50D          RESERVE ROOM IN STRING SPACE FOR NEW STRING 
          LDX  RESSGN         GET DESCRIPTOR ADDRESS OF STRING A 
          LDB  ,X             GET LENGTH OF STRING A 
          BSR  LB643          MOVE STRING A INTO RESERVED BUFFER IN STRING SPACE 
          LDX  V4D            GET DESCRIPTOR ADDRESS OF STRING B 
          BSR  LB659          GET LENGTH AND ADDRESS OF STRING B 
          BSR  LB645          MOVE STRING B INTO REST OF RESERVED BUFFER 
          LDX  RESSGN         POINT X TO DESCRIPTOR OF STRING A 
          BSR  LB659          DELETE STRING A IF LAST STRING ON STRING STACK 
          JSR  LB54C          PUT STRING DESCRIPTOR ON THE STRING STACK 
          JMP  LB168          BRANCH BACK TO EXPRESSION EVALUATION 
                               
* MOVE (B) BYTES FROM 2,X TO FRESPC                      
LB643     LDX  2,X            POINT X TO SOURCE ADDRESS 
LB645     LDU  FRESPC         POINT U TO DESTINATION ADDRESS 
          INCB                COMPENSATION FOR THE DECB BELOW 
          BRA  LB64E          GO MOVE THE BYTES 
* MOVE B BYTES FROM (X) TO (U)                      
LB64A     LDA  ,X+            * GET A SOURCE BYTE AND MOVE IT 
          STA  ,U+            * TO THE DESTINATION 
LB64E     DECB                DECREMENT BYTE COUNTER 
          BNE  LB64A          BRANCH IF ALL BYTES NOT MOVED 
          STU  FRESPC         SAVE ENDING ADDRESS IN FRESPC 
          RTS                  
* RETURN LENGTH (ACCB) AND ADDRESS (X) OF                      
* STRING WHOSE DESCRIPTOR IS IN FPA0+2                      
* DELETE THE STRING IF IT IS THE LAST ONE                      
* PUT ON THE STRING STACK. REMOVE STRING FROM STRING                      
* SPACE IF IT IS AT THE BOTTOM OF STRING VARIABLES.                      
LB654     JSR  LB146          TM' ERROR IF VARIABLE TYPE = NUMERIC 
LB657     LDX  FPA0+2         GET ADDRESS OF SELECTED STRING DESCRIPTOR 
LB659     LDB  ,X             GET LENGTH OF STRING 
          BSR  LB675          * CHECK TO SEE IF THIS STRING DESCRIPTOR WAS 
          BNE  LB672          * THE LAST ONE PUT ON THE STRING STACK AND 
*                             * BRANCH IF NOT 
          LDX  5+2,X          GET START ADDRESS OF STRING JUST REMOVED 
          LEAX -1,X           MOVE POINTER DOWN ONE 
          CMPX STRTAB         COMPARE TO START OF STRING VARIABLES 
          BNE  LB66F          BRANCH IF THIS STRING IS NOT AT THE BOTTOM 
*                             OF STRING VARIABLES 
          PSHS B              SAVE LENGTH; ACCA WAS CLEARED 
          ADDD STRTAB         * ADD THE LENGTH OF THE JUST REMOVED STRING 
          STD  STRTAB         * TO THE START OF STRING VARIABLES - THIS WILL 
*                             * REMOVE THE STRING FROM THE STRING SPACE 
          PULS B              RESTORE LENGTH 
LB66F     LEAX 1,X            ADD ONE TO POINTER 
          RTS                  
LB672     LDX  2,X            *POINT X TO ADDRESS OF STRING NOT 
          RTS                 *ON THE STRING STACK 
* REMOVE STRING FROM STRING STACK. ENTER WITH X                      
* POINTING TO A STRING DESCRIPTOR - DELETE THE                      
* STRING FROM STACK IF IT IS ON TOP OF THE                      
* STACK. IF THE STRING IS DELETED, SET THE ZERO FLAG                      
LB675     CMPX LASTPT         *COMPARE TO LAST USED DESCRIPTOR ADDRESS 
          BNE  LB680          *ON THE STRING STACK, RETURN IF DESCRIPTOR 
*                             *ADDRESS NOT ON THE STRING STACK 
          STX  TEMPPT         SAVE LAST USED DESCRIPTOR AS NEXT AVAILABLE 
          LEAX -5,X           * MOVE LAST USED DESCRIPTOR BACK 5 BYTES 
          STX  LASTPT         * AND SAVE AS THE LAST USED DESCRIPTOR ADDR 
          CLRA                SET ZERO FLAG 
LB680     RTS                  
                               
* LEN                          
LEN       BSR  LB686          POINT X TO PROPER STRING AND GET LENGTH 
LB683     JMP  LB4F3          CONVERT ACCB TO FP NUMBER IN FPA0 
* POINT X TO STRING ADDRESS LOAD LENGTH INTO                      
* ACCB. ENTER WITH THE STRING DESCRIPTOR IN                      
* BOTTOM TWO BYTES OF FPA0                      
LB686     BSR  LB654          GET LENGTH AND ADDRESS OF STRING 
          CLR  VALTYP         SET VARIABLE TYPE TO NUMERIC 
          TSTB                SET FLAGS ACCORDING TO LENGTH 
          RTS                  
                               
* CHR$                         
CHR       JSR  LB70E          CONVERT FPA0 TO AN INTEGER IN ACCD 
LB68F     LDB  #1             * RESERVE ONE BYTE IN 
          JSR  LB56D          * THE STRING SPACE 
          LDA  FPA0+3         GET ASCII STRING VALUE 
          JSR  LB511          SAVE RESERVED STRING DESCRIPTOR IN TEMP DESCRIPTOR 
          STA  ,X             SAVE THE STRING (IT’S ONLY ONE BYTE) 
LB69B     LEAS 2,S            PURGE THE RETURN ADDRESS OFF OF THE STACK 
LB69D     JMP  LB54C          PUT TEMP DESCRIPTOR DATA ONTO STRING STACK 
                               
                               
ASC       BSR  LB6A4          PUT 1ST CHARACTER OF STRING INTO ACCB 
          BRA  LB683          CONVERT ACCB INTO FP NUMBER IN FPA0 
LB6A4     BSR  LB686          POINT X TO STRING DESCRIPTOR 
          BEQ  LB706          FC' ERROR IF NULL STRING 
          LDB  ,X             GET FIRST BYTE OF STRING 
          RTS                  
                               
                               
LEFT      BSR  LB6F5          GET ARGUMENTS FROM STACK 
LB6AD     CLRA                CLEAR STRING POINTER OFFSET - OFFSET = 0 FOR LEFT$ 
LB6AE     CMPB ,X             * COMPARE LENGTH PARAMETER TO LENGTH OF 
          BLS  LB6B5          * STRING AND BRANCH IF LENGTH OF STRING 
*                             >= LENGTH PARAMETER 
          LDB  ,X             USE LENGTH OF STRING OTHERWISE 
          CLRA                CLEAR STRING POINTER OFFSET (0 FOR LEFT$) 
LB6B5     PSHS B,A            PUSH PARAMETERS ONTO STACK 
          JSR  LB50F          RESERVE ACCB BYTES IN THE STRING SPACE 
          LDX  V4D            POINT X TO STRING DESCRIPTOR 
          BSR  LB659          GET ADDRESS OF OLD STRING (X=ADDRESS) 
          PULS B              * PULL STRING POINTER OFFSET OFF OF THE STACK 
          ABX                 * AND ADD IT TO STRING ADDRESS 
          PULS B              PULL LENGTH PARAMETER OFF OF THE STACK 
          JSR  LB645          MOVE ACCB BYTES FROM (X) TO [FRESPC] 
          BRA  LB69D          PUT TEMP STRING DESCRIPTOR ONTO THE STRING STACK 
                               
* RIGHT$                       
RIGHT     BSR  LB6F5          GET ARGUMENTS FROM STACK 
          SUBA ,X             ACCA=LENGTH PARAMETER - LENGTH OF OLD STRING 
          NEGA                NOW ACCA = LENGTH OF OLD STRING 
          BRA  LB6AE          PUT NEW STRING IN THE STRING SPACE 
                               
* MID$                         
MID       LDB  #$FF           * GET DEFAULT VALUE OF LENGTH AND 
          STB  FPA0+3         * SAVE IT IN FPA0 
          JSR  GETCCH         GET CURRENT CHARACTER FROM BASIC 
          CMPA #')            ARGUMENT DELIMITER? 
          BEQ  LB6DE          YES - NO LENGTH PARAMETER GIVEN 
          JSR  LB26D          SYNTAX CHECK FOR COMMA 
          BSR  LB70B          EVALUATE NUMERIC EXPRESSION (LENGTH) 
LB6DE     BSR  LB6F5          GET ARGUMENTS FROM STACK 
          BEQ  LB706          FC' ERROR IF NULL STRING 
          CLRB                CLEAR LENGTH COUNTER (DEFAULT VALUE) 
          DECA                *SUOTRACT ONE FROM POSITION PARAMETER (THESE 
          CMPA ,X             *ROUTINES EXPECT 1ST POSITION TO BE ZERO, NOT ONE) 
*                             *AND COMPARE IT TO LENGTH OF OLD STRING 
          BCC  LB6B5          IF POSITION > LENGTH OF OLD STRING, THEN NEW 
*                             STRING WILL BE A NULL STRING 
          TFR  A,B            SAVE ABSOLUTE POSITION PARAMETER IN ACCB 
          SUBB ,X             ACCB=POSITION-LENGTH OF OLD STRING 
          NEGB                NOW ACCB=LENGTH OF OLDSTRING-POSITION 
          CMPB FPA0+3         *IF THE AMOUNT OF OLD STRING TO THE RIGHT OF 
          BLS  LB6B5          *POSITION IS <= THE LENGTH PARAMETER, BRANCH AND 
* USE ALL OF THE STRING TO THE RIGHT OF THE POSITION                      
* INSTEAD OF THE LENGTH PARAMETER                      
          LDB  FPA0+3         GET LENGTH OF NEW STRING 
          BRA  LB6B5          PUT NEW STRING IN STRING SPACE 
* DO A SYNTAX CHECK FOR ")", THEN PULL THE PREVIOUSLY CALCULATED NUMERIC                      
* ARGUMENT (ACCD) AND STRING ARGUMENT DESCRIPTOR ADDR OFF OF THE STACK                      
LB6F5     JSR  LB267          SYNTAX CHECK FOR A ")" 
          LDU  ,S             LOAD THE RETURN ADDRESS INTO U REGISTER 
          LDX  5,S            * GET ADDRESS OF STRING AND 
          STX  V4D            * SAVE IT IN V4D 
          LDA  4,S            = PUT LENGTH OF STRING IN 
          LDB  4,S            = BOTH ACCA AND ACCB 
          LEAS 7,S            REMOVE DESCRIPTOR AND RETURN ADDRESS FROM STACK 
          TFR  U,PC           JUMP TO ADDRESS IN U REGISTER 
LB706     JMP  LB44A          ILLEGAL FUNCTION CALL' 
* EVALUATE AN EXPRESSION - RETURN AN INTEGER IN                      
* ACCB - 'FC' ERROR IF EXPRESSION > 255                      
LB709     JSR  GETNCH         GET NEXT BASIC INPUT CHARACTER 
LB70B     JSR  LB141          EVALUATE A NUMERIC EXPRESSION 
LB70E     JSR  LB3E9          CONVERT FPA0 TO INTEGER IN ACCD 
          TSTA                TEST MS BYTE OF INTEGER 
          BNE  LB706          FC' ERROR IF EXPRESSION > 255 
          JMP  GETCCH         GET CURRENT INPUT CHARACTER FROM BASIC 
                               
* VAL                          
VAL       JSR  LB686          POINT X TO STRING ADDRESS 
          LBEQ LBA39          IF NULL STRING SET FPA0 
          LDU  CHARAD         SAVE INPUT POINTER IN REGISTER U 
          STX  CHARAD         POINT INPUT POINTER TO ADDRESS OF STRING 
          ABX  MOVE POINTER TO END OF STRING TERMINATOR  
          LDA  ,X             GET LAST BYTE OF STRING 
          PSHS U,X,A          SAVE INPUT POINTER, STRING TERMINATOR 
*         ADDRESS AND CHARACTER   
          CLR  ,X             CLEAR STRING TERMINATOR : FOR ASCII - FP CONVERSION 
          JSR  GETCCH         GET CURRENT CHARACTER FROM BASIC 
          JSR  LBD12          CONVERT AN ASCII STRING TO FLOATING POINT 
          PULS A,X,U          RESTORE CHARACTERS AND POINTERS 
          STA  ,X             REPLACE STRING TERMINATOR 
          STU  CHARAD         RESTORE INPUT CHARACTER 
          RTS                  
                               
LB734     BSR  LB73D          * EVALUATE AN EXPRESSION, RETURN 
          STX  BINVAL         * THE VALUE IN X; STORE IT IN BINVAL 
LB738     JSR  LB26D          SYNTAX CHECK FOR A COMMA 
          BRA  LB70B          EVALUATE EXPRESSION IN RANGE 0 <= X < 256 
* EVALUATE EXPRESSION : RETURN INTEGER PORTION IN X - 'FC' ERROR IF                      
                               
LB73D     JSR  LB141          EVALUATE NUMERIC EXPRESSION 
LB740     LDA  FP0SGN         GET SIGN OF FPA0 MANTISSA 
          BMI  LB706          ILLEGAL FUNCTION CALL' IF NEGATIVE 
          LDA  FP0EXP         GET EXPONENT OF FPA0 
          CMPA #$90           COMPARE TO LARGEST POSITIVE INTEGER 
          BHI  LB706          ILLEGAL FUNCTION CALL' IF TOO LARGE 
          JSR  LBCC8          SHIFT BINARY POINT TO EXTREME RIGHT OF FPA0 
          LDX  FPA0+2         LOAD X WITH LOWER TWO BYTES OF FPA0 
          RTS                  
                               
* PEEK                         
PEEK      BSR  LB740          CONVERT FPA0 TO INTEGER IN REGISTER X 
          LDB  ,X             GET THE VALUE BEING 'PEEK'ED 
          JMP  LB4F3          CONVERT ACCB INTO A FP NUMBER 
                               
* POKE                         
POKE      BSR  LB734          EVALUATE 2 EXPRESSIONS 
          LDX  BINVAL         GET THE ADDRESS TO BE 'POKE'ED 
          STB  ,X             STORE THE DATA IN THAT ADDRESS 
          RTS                  
                               
                               
* LIST                         
LIST      PSHS CC             SAVE ZERO FLAG ON STACK 
          JSR  LAF67          CONVERT DECIMAL LINE NUMBER TO BINARY 
          JSR  LAD01          * FIND RAM ADDRESS OF THAT LINE NUMBER AND 
          STX  LSTTXT         * SAVE IT IN LSTTXT 
          PULS CC             GET ZERO FLAG FROM STACK 
          BEQ  LB784          BRANCH IF END OF LINE 
          JSR  GETCCH         GET CURRENT CHARACTER FROM BASIC 
          BEQ  LB789          BRANCH IF END OF LINE 
          CMPA #TOK_MINUS     MINUS TOKEN (IS IT A RANGE OF LINE NUMBERS?) 
          BNE  LB783          NO - RETURN 
          JSR  GETNCH         GET NEXT CHARACTER FROM BASIC 
          BEQ  LB784          BRANCH IF END OF LINE 
          JSR  LAF67          GET ENDING LINE NUMBER 
          BEQ  LB789          BRANCH IF LEGAL LINE NUMBER 
LB783 RTS                      
* LIST THE ENTIRE PROGRAM                      
LB784     LDU  #$FFFF         * SET THE DEFAULT ENDING LINE NUMBER 
          STU  BINVAL         * TO $FFFF 
LB789     LEAS 2,S            PURGE RETURN ADDRESS FROM THE STACK 
          LDX  LSTTXT         POINT X TO STARTING LINE ADDRESS 
LB78D     JSR  LB95C          MOVE CURSOR TO START OF A NEW LINE 
          JSR  LA549          CHECK FOR A BREAK OR PAUSE 
          LDD  ,X             GET ADDRESS OF NEXT BASIC LINE 
          BNE  LB79F          BRANCH IF NOT END OF PROGRAM 
LB797                          
          JMP  LAC73          RETURN TO BASIC’S MAIN INPUT LOOP 
LB79F     STX  LSTTXT         SAVE NEW STARTING LINE ADDRESS 
          LDD  2,X            * GET THE LINE NUMBER OF THIS LINE AND 
          CMPD BINVAL         * COMPARE IT TO ENDING LINE NUMBER 
          BHI  LB797          EXIT IF LINE NUMBER > ENDING LINE NUMBER 
          JSR  LBDCC          PRINT THE NUMBER IN ACCD ON SCREEN IN DECIMAL 
          JSR  LB9AC          SEND A SPACE TO CONSOLE OUT 
          LDX  LSTTXT         GET RAM ADDRESS OF THIS LINE 
          BSR  LB7C2          UNCRUNCH A LINE 
          LDX  [LSTTXT]       POINT X TO START OF NEXT LINE 
          LDU  #LINBUF+1      POINT U TO BUFFER FULL OF UNCRUNCHED LINE 
LB7B9     LDA  ,U+            GET A BYTE FROM THE BUFFER 
          BEQ  LB78D          BRANCH IF END OF BUFFER 
          JSR  LB9B1          SEND CHARACTER TO CONSOLE OUT 
          BRA  LB7B9          GET ANOTHER CHARACTER 
                               
* UNCRUNCH A LINE INTO BASIC’S LINE INPUT BUFFER                      
LB7C2     LEAX 4,X            MOVE POINTER PAST ADDRESS OF NEXT LINE AND LINE NUMBER 
          LDY  #LINBUF+1      UNCRUNCH LINE INTO LINE INPUT BUFFER 
LB7CB     LDA  ,X+            GET A CHARACTER 
          BEQ  LB820          BRANCH IF END OF LINE 
          BMI  LB7E6          BRANCH IF IT’S A TOKEN 
          CMPA #':            CHECK FOR END OF SUB LINE 
          BNE  LB7E2          BRNCH IF NOT END OF SUB LINE 
          LDB  ,X             GET CHARACTER FOLLOWING COLON 
          CMPB #TOK_ELSE      TOKEN FOR ELSE? 
          BEQ  LB7CB          YES - DON’T PUT IT IN BUFFER 
          CMPB #TOK_SNGL_Q    TOKEN FOR REMARK? 
          BEQ  LB7CB          YES - DON’T PUT IT IN BUFFER 
          FCB  SKP2           SKIP TWO BYTES 
LB7E0     LDA  #'!            EXCLAMATION POINT 
LB7E2     BSR  LB814          PUT CHARACTER IN BUFFER 
          BRA  LB7CB          GET ANOTHER CHARACTER 
                               
LB7E6     LDU  #COMVEC-10     FIRST DO COMMANDS 
          CMPA #$FF           CHECK FOR SECONDARY TOKEN 
          BNE  LB7F1          BRANCH IF NON SECONDARY TOKEN 
          LDA  ,X+            GET SECONDARY TOKEN 
          LEAU 5,U            BUMP IT UP TO SECONDARY FUNCTIONS 
LB7F1     ANDA #$7F           MASK OFF BIT 7 OF TOKEN 
LB7F3     LEAU 10,U           MOVE TO NEXT COMMAND TABLE 
          TST  ,U             IS THIS TABLE ENABLED? 
          BEQ  LB7E0          NO - ILLEGAL TOKEN 
          SUBA ,U             SUBTRACT THE NUMBER OF TOKENS FROM THE CURRENT TOKEN NUMBER 
          BPL  LB7F3          BRANCH IF TOKEN NOT IN THIS TABLE 
          ADDA ,U             RESTORE TOKEN NUMBER RELATIVE TO THIS TABLE 
          LDU  1,U            POINT U TO COMMAND DICTIONARY TABLE 
LB801     DECA                DECREMENT TOKEN NUMBER 
          BMI  LB80A          BRANCH IF THIS IS THE CORRECT TOKEN 
* SKIP THROUGH DICTIONARY TABLE TO START OF NEXT TOKEN                      
LB804     TST  ,U+            GRAB A BYTE 
          BPL  LB804          BRANCH IF BIT 7 NOT SET 
          BRA  LB801          GO SEE IF THIS IS THE CORRECT TOKEN 
LB80A     LDA  ,U             GET A CHARACTER FROM DICTIONARY TABLE 
          BSR  LB814          PUT CHARACTER IN BUFFER 
          TST  ,U+            CHECK FOR START OF NEXT TOKEN 
          BPL  LB80A          BRANCH IF NOT DONE WITH THIS TOKEN 
          BRA  LB7CB          GO GET ANOTHER CHARACTER 
LB814     CMPY #LINBUF+LBUFMX TEST FOR END OF LINE INPUT BUFFER 
          BCC  LB820          BRANCH IF AT END OF BUFFER 
          ANDA #$7F           MASK OFF BIT 7 
          STA  ,Y+            * SAVE CHARACTER IN BUFFER AND 
          CLR  ,Y             * CLEAR NEXT CHARACTER SLOT IN BUFFER 
LB820     RTS                  
*                              
* CRUNCH THE LINE THAT THE INPUT POINTER IS                      
* POINTING TO INTO THE LINE INPUT BUFFER                      
* RETURN LENGTH OF CRUNCHED LINE IN ACCD                      
*                              
LB821     LDX  CHARAD         GET BASIC'S INPUT POINTER ADDRESS 
          LDU  #LINBUF        POINT X TO LINE INPUT BUFFER 
LB829     CLR  V43            CLEAR ILLEGAL TOKEN FLAG 
          CLR  V44            CLEAR DATA FLAG 
LB82D     LDA  ,X+            GET INPUT CHAR 
          BEQ  LB852          BRANCH IF END OF LINE 
          TST  V43            * CHECK ILLEGAL TOKEN FLAG & BRANCH IF NOT 
          BEQ  LB844          * PROCESSING AN ILLEGAL TOKEN 
          JSR  LB3A2          SET CARRY IF NOT UPPER CASE ALPHA 
          BCC  LB852          BRANCH IF UPPER CASE ALPHA 
          CMPA #'0            * DON’T CRUNCH ASCII NUMERIC CHARACTERS 
          BLO  LB842          * BRANCH IF NOT NUMERIC 
          CMPA #'9            * 
          BLS  LB852          * BRANCH IF NUMERIC 
* END UP HERE IF NOT UPPER CASE ALPHA OR NUMERIC                      
LB842     CLR  V43            CLEAR ILLEGAL TOKEN FLAG 
LB844     CMPA #SPACE         SPACE? 
          BEQ  LB852          DO NOT REMOVE SPACES 
          STA  V42            SAVE INPUT CHARACTER AS SCAN DELIMITER 
          CMPA #'"            CHECK FOR STRING DELIMITER 
          BEQ  LB886          BRANCH IF STRING 
          TST  V44            * CHECK DATA FLAG AND BRANCH IF CLEAR 
          BEQ  LB86B          * DO NOT CRUNCH DATA 
LB852     STA  ,U+            SAVE CHARACTER IN BUFFER 
          BEQ  LB85C          BRANCH IF END OF LINE 
          CMPA #':            * CHECK FOR END OF SUBLINE 
          BEQ  LB829          * AND RESET FLAGS IF END OF SUBLINE 
LB85A     BRA  LB82D          GO GET ANOTHER CHARACTER 
LB85C     CLR  ,U+            * DOUBLE ZERO AT END OF LINE 
          CLR  ,U+            * 
          TFR  U,D            SAVE ADDRESS OF END OF LINE IN ACCD 
          SUBD #LINHDR        LENGTH OF LINE IN ACCD 
          LDX  #LINBUF-1      * SET THE INPUT POINTER TO ONE BEFORE 
          STX  CHARAD         * THE START OF THE CRUNCHED LINE 
          RTS  EXIT 'CRUNCH'   
LB86B     CMPA #'?            CHECK FOR "?" - PRINT ABBREVIATION 
          BNE  LB873          BRANCH IF NOT PRINT ABBREVIATION 
          LDA  #TOK_PRINT     * GET THE PRINT TOKEN AND SAVE IT 
          BRA  LB852          * IN BUFFER 
LB873     CMPA #''            APOSTROPHE IS SAME AS REM 
          BNE  LB88A          BRANCH IF NOT REMARK 
          LDD  #$3A00+TOK_SNGL_Q COLON, REM TOKEN 
          STD  ,U++           SAVE IN BUFFER 
LB87C     CLR  V42            SET DELIMITER = 0 (END OF LINE) 
LB87E     LDA  ,X+            SCAN TILL WE MATCH [V42] 
          BEQ  LB852          BRANCH IF END OF LINE 
          CMPA V42            DELIMITER? 
          BEQ  LB852          BRANCH OUT IF SO 
LB886     STA  ,U+            DON’T CRUNCH REMARKS OR STRINGS 
          BRA  LB87E          GO GET MORE STRING OR REMARK 
LB88A     CMPA #'0            * LESS THAN ASCII ZERO? 
          BCS  LB892          * BRANCH IF SO 
          CMPA #';+1          = CHECK FOR NUMERIC VALUE, COLON OR SEMICOLON 
          BCS  LB852          = AND INSERT IN BUFFER IF SO 
LB892     LEAX -1,X           MOVE INPUT POINTER BACK ONE 
          PSHS U,X            SAVE POINTERS TO INPUT STRING, OUTPUT STRING 
          CLR  V41            TOKEN FLAG 0 = COMMAND, FF = SECONDARY 
          LDU  #COMVEC-10     POINT U TO COMMAND INTERPRETATION 
*                             TABLE FOR BASIC - 10 
LB89B     CLR  V42            INITIALIZE V42 AS TOKEN COUNTER 
LB89D     LEAU 10,U           MOVE TO NEXT COMMAND INTERPRETATION TABLE 
          LDA  ,U             GET NUMBER OF COMMANDS 
          BEQ  LB8D4          GO DO SECONDARY FUNCTIONS IF NO COMMAND TABLE 
          LDY  1,U            POINT Y TO COMMAND DICTIONARY TABLE 
LB8A6     LDX  ,S             GET POINTER TO INPUT STRING 
LB8A8     LDB  ,Y+            GET A BYTE FROM DICTIONARY TABLE 
          SUBB ,X+            SUBTRACT INPUT CHARACTER 
          BEQ  LB8A8          LOOP IF SAME 
          CMPB #$80           LAST CHAR IN RESERVED WORD TABLE HAD 
*                             BIT 7 SET, SO IF WE HAVE $80 HERE 
*                             THEN IT IS A GOOD COMPARE 
          BNE  LB8EA          BRANCH IF NO MATCH - CHECK ANOTHER COMMAND 
          LEAS 2,S            DELETE OLD INPUT POINTER FROM STACK 
          PULS U              GET POINTER TO OUTPUT STRING 
          ORB  V42            OR IN THE TABLE POSITION TO MAKE THE TOKEN 
*                             - NOTE THAT B ALREADY HAD $80 IN IT - 
          LDA  V41            * CHECK TOKEN FLAG AND BRANCH 
          BNE  LB8C2          * IF SECONDARY 
          CMPB #TOK_ELSE      IS IT ELSE TOKEN? 
          BNE  LB8C6          NO 
          LDA  #':            PUT A COLON (SUBLINE) BEFORE ELSE TOKEN 
LB8C2     STD  ,U++           SECONDARY TOKENS PRECEEDED BY $FF 
          BRA  LB85A          GO PROCESS MORE INPUT CHARACTERS 
LB8C6     STB  ,U+            SAVE THIS TOKEN 
          CMPB #TOK_DATA      DATA TOKEN? 
          BNE  LB8CE          NO 
          INC  V44            SET DATA FLAG 
LB8CE     CMPB #TOK_REM       REM TOKEN? 
          BEQ  LB87C          YES 
LB8D2     BRA  LB85A          GO PROCESS MORE INPUT CHARACTERS 
* CHECK FOR A SECONDARY TOKEN                      
LB8D4     LDU  #COMVEC-5      NOW DO SECONDARY FUNCTIONS 
          COM  V41            TOGGLE THE TOKEN FLAG 
          BNE  LB89B          BRANCH IF NOW CHECKING SECONDARY COMMANDS 
                               
* THIS CODE WILL PROCESS INPUT DATA WHICH CANNOT BE CRUNCHED AND SO                      
* IS ASSUMED TO BE ILLEGAL DATA OR AN ILLEGAL TOKEN                      
          PULS X,U            RESTORE INPUT AND OUTPUT POINTERS 
          LDA  ,X+            * MOVE THE FIRST CHARACTER OF AN 
          STA  ,U+            * ILLEGAL TOKEN 
          JSR  LB3A2          SET CARRY IF NOT ALPHA 
          BCS  LB8D2          BRANCH IF NOT ALPHA 
          COM  V43            SET ILLEGAL TOKEN FLAG IF UPPER CASE ALPHA 
          BRA  LB8D2          PROCESS MORE INPUT CHARACTERS 
LB8EA     INC  V42            INCREMENT TOKEN COUNTER 
          DECA                DECR COMMAND COUNTER 
          BEQ  LB89D          GET ANOTHER COMMAND TABLE IF DONE W/THIS ONE 
          LEAY -1,Y           MOVE POINTER BACK ONE 
LB8F1     LDB  ,Y+            * GET TO NEXT 
          BPL  LB8F1          * RESERVED WORD 
          BRA  LB8A6          GO SEE IF THIS WORD IS A MATCH 
                               
* PRINT                        
PRINT     BEQ  LB958          BRANCH IF NO ARGUMENT 
          BSR  LB8FE          CHECK FOR ALL PRINT OPTIONS 
          RTS                  
LB8FE                          
LB918     JSR  XVEC9          CALL EXTENDED BASIC ADD-IN 
LB91B     BEQ  LB965          RETURN IF END OF LINE 
LB91D     CMPA #TOK_TAB       TOKEN FOR TAB( ? 
          BEQ  LB97E          YES 
          CMPA #',            COMMA? 
          BEQ  LB966          YES - ADVANCE TO NEXT TAB FIELD 
          CMPA #';            SEMICOLON? 
          BEQ  LB997          YES - DO NOT ADVANCE CURSOR 
          JSR  LB156          EVALUATE EXPRESSION 
          LDA  VALTYP         * GET VARIABLE TYPE AND 
          PSHS A              * SAVE IT ON THE STACK 
          BNE  LB938          BRANCH IF STRING VARIABLE 
          JSR  LBDD9          CONVERT FP NUMBER TO AN ASCII STRING 
          JSR  LB516          PARSE A STRING FROM (X-1) AND PUT 
*                             DESCRIPTOR ON STRING STACK 
LB938     BSR  LB99F          PRINT STRING POINTED TO BY X 
          PULS B              GET VARIABLE TYPE BACK 
          JSR  LA35F          SET UP TAB WIDTH ZONE, ETC 
LB949     TSTB                CHECK CURRENT PRINT POSITION 
          BNE  LB954          BRANCH IF NOT AT START OF LINE 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          CMPA #',            COMMA? 
          BEQ  LB966          SKIP TO NEXT TAB FIELD 
          BSR  LB9AC          SEND A SPACE TO CONSOLE OUT 
LB954     JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          BNE  LB91D          BRANCH IF NOT END OF LINE 
LB958     LDA  #CR            * SEND A CR TO 
          BRA  LB9B1          * CONSOLE OUT 
LB95C     JSR  LA35F          SET UP TAB WIDTH, ZONE ETC 
          BEQ  LB958          BRANCH IF WIDTH = ZERO 
          LDA  DEVPOS         GET PRINT POSITION 
          BNE  LB958          BRANCH IF NOT AT START OF LINE 
LB965     RTS                  
* SKIP TO NEXT TAB FIELD                      
LB966     JSR  LA35F          SET UP TAB WIDTH, ZONE ETC 
          BEQ  LB975          BRANCH IF LINE WIDTH = 0 (CASSETTE) 
          LDB  DEVPOS         GET CURRENT POSITION 
          CMPB DEVLCF         COMPARE TO LAST TAB ZONE 
          BCS  LB977          BRANCH IF < LAST TAB ZONE 
          BSR  LB958          SEND A CARRIAGE RETURN TO CONSOLE OUT 
          BRA  LB997          GET MORE DATA 
LB975     LDB  DEVPOS         * 
LB977     SUBB DEVCFW         * SUBTRACT TAB FIELD WIDTH FROM CURRENT 
          BCC  LB977          * POSITION UNTIL CARRY SET - NEGATING THE 
          NEGB                * REMAINDER LEAVES THE NUMBER OF SPACES TO NEXT 
*              * TAB ZONE IN ACCB  
          BRA  LB98E          GO ADVANCE TO NEXT TAB ZONE 
                               
* PRINT TAB(                      
LB97E     JSR  LB709          EVALUATE EXPRESSION - RETURN VALUE IN B 
          CMPA #')            * 'SYNTAX' ERROR IF NOT ')' 
          LBNE LB277          * 
          JSR  LA35F          SET UP TAB WIDTH, ZONE ETC 
          SUBB DEVPOS         GET DIFFERENCE OF PRINT POSITION & TAB POSITION 
          BLS  LB997          BRANCH IF TAB POSITION < CURRENT POSITION 
LB98E                          
LB992     BSR  LB9AC          SEND A SPACE TO CONSOLE OUT 
          DECB                DECREMENT DIFFERENCE COUNT 
          BNE  LB992          BRANCH UNTIL CURRENT POSITION = TAB POSITION 
LB997     JSR  GETNCH         GET NEXT CHARACTER FROM BASIC 
          JMP  LB91B          LOOK FOR MORE PRINT DATA 
* COPY A STRING FROM (X) TO CONSOLE OUT                      
LB99C     JSR  LB518          PARSE A STRING FROM X AND PUT 
*         DESCRIPTOR ON STRING STACK  
LB99F     JSR  LB657          GET LENGTH OF STRING AND REMOVE 
*         DESCRIPTOR FROM STRING STACK  
          INCB                COMPENSATE FOR DECB BELOW 
LB9A3     DECB                DECREMENT COUNTER 
          BEQ  LB965          EXIT ROUTINE 
          LDA  ,X+            GET A CHARACTER FROM X 
          BSR  LB9B1          SEND TO CONSOLE OUT 
          BRA  LB9A3          KEEP LOOPING 
LB9AC     LDA  #SPACE         SPACE TO CONSOLE OUT 
          FCB  SKP2           SKIP NEXT TWO BYTES 
LB9AF     LDA  #'?            QUESTION MARK TO CONSOLE OUT 
LB9B1     JMP  PUTCHR         JUMP TO CONSOLE OUT 
                               
* FLOATING POINT MATH PACKAGE                      
                               
* ADD .5 TO FPA0                      
LB9B4     LDX  #LBEC0         FLOATING POINT CONSTANT (.5) 
          BRA  LB9C2          ADD .5 TO FPA0 
* SUBTRACT FPA0 FROM FP NUMBER POINTED                      
* TO BY (X), LEAVE RESULT IN FPA0                      
LB9B9     JSR  LBB2F          COPY PACKED FP DATA FROM (X) TO FPA1 
                               
* ARITHMETIC OPERATION (-) JUMPS HERE - SUBTRACT FPA0 FROM FPA1 (ENTER                      
* WITH EXPONENT OF FPA0 IN ACCB AND EXPONENT OF FPA1 IN ACCA)                      
LB9BC     COM  FP0SGN         CHANGE MANTISSA SIGN OF FPA0 
          COM  RESSGN         REVERSE RESULT SIGN FLAG 
          BRA  LB9C5          GO ADD FPA1 AND FPA0 
* ADD FP NUMBER POINTED TO BY                      
* (X) TO FPA0 - LEAVE RESULT IN FPA0                      
LB9C2     JSR  LBB2F          UNPACK PACKED FP DATA FROM (X) TO 
*         FPA1; RETURN EXPONENT OF FPA1 IN ACCA  
                               
* ARITHMETIC OPERATION (+) JUMPS HERE - ADD FPA0 TO                      
                               
LB9C5     TSTB                CHECK EXPONENT OF FPA0 
          LBEQ LBC4A          COPY FPA1 TO FPA0 IF FPA0 = 
          LDX  #FP1EXP        POINT X TO FPA1 
LB9CD     TFR  A,B            PUT EXPONENT OF FPA1 INTO ACCB 
          TSTB                CHECK EXPONENT 
          BEQ  LBA3E          RETURN IF EXPONENT = 0 (ADDING 0 TO FPA0) 
          SUBB FP0EXP         SUBTRACT EXPONENT OF FPA0 FROM EXPONENT OF FPA1 
          BEQ  LBA3F          BRANCH IF EXPONENTS ARE EQUAL 
          BCS  LB9E2          BRANCH IF EXPONENT FPA0 > FPA1 
          STA  FP0EXP         REPLACE FPA0 EXPONENT WITH FPA1 EXPONENT 
          LDA  FP1SGN         * REPLACE FPA0 MANTISSA SIGN 
          STA  FP0SGN         * WITH FPA1 MANTISSA SIGN 
          LDX  #FP0EXP        POINT X TO FPA0 
          NEGB                NEGATE DIFFERENCE OF EXPONENTS 
LB9E2     CMPB #-8            TEST DIFFERENCE OF EXPONENTS 
          BLE  LBA3F          BRANCH IF DIFFERENCE OF EXPONENTS <= 8 
          CLRA                CLEAR OVERFLOW BYTE 
          LSR  1,X            SHIFT MS BYTE OF MANTISSA; BIT 7 = 0 
          JSR  LBABA          GO SHIFT MANTISSA OF (X) TO THE RIGHT (B) TIMES 
LB9EC     LDB  RESSGN         GET SIGN FLAG 
          BPL  LB9FB          BRANCH IF FPA0 AND FPA1 SIGNS ARE THE SAME 
          COM  1,X            * COMPLEMENT MANTISSA POINTED 
          COM  2,X            * TO BY (X) THE 
          COM  3,X            * ADCA BELOW WILL 
          COM  4,X            * CONVERT THIS OPERATION 
          COMA                * INTO A NEG (MANTISSA) 
          ADCA #0             ADD ONE TO ACCA - COMA ALWAYS SETS THE CARRY FLAG 
* THE PREVIOUS TWO BYTES MAY BE REPLACED BY A NEGA                      
*                              
* ADD MANTISSAS OF FPA0 AND FPA1, PUT RESULT IN FPA0                      
LB9FB     STA  FPSBYT         SAVE FPA SUB BYTE 
          LDA  FPA0+3         * ADD LS BYTE 
          ADCA FPA1+3         * OF MANTISSA 
          STA  FPA0+3         SAVE IN FPA0 LSB 
          LDA  FPA0+2         * ADD NEXT BYTE 
          ADCA FPA1+2         * OF MANTISSA 
          STA  FPA0+2         SAVE IN FPA0 
          LDA  FPA0+1         * ADD NEXT BYTE 
          ADCA FPA1+1         * OF MANTISSA 
          STA  FPA0+1         SAVE IN FPA0 
          LDA  FPA0           * ADD MS BYTE 
          ADCA FPA1           * OF MANTISSA 
          STA  FPA0           SAVE IN FPA0 
          TSTB TEST SIGN FLAG  
          BPL  LBA5C          BRANCH IF FPA0 & FPA1 SIGNS WERE ALIKE 
LBA18     BCS  LBA1C          BRANCH IF POSITIVE MANTISSA 
          BSR  LBA79          NEGATE FPA0 MANTISSA 
                               
* NORMALIZE FPA0                      
LBA1C     CLRB                CLEAR TEMPORARY EXPONENT ACCUMULATOR 
LBA1D     LDA  FPA0           TEST MSB OF MANTISSA 
          BNE  LBA4F          BRANCH IF <> 0 
          LDA  FPA0+1         * IF THE MSB IS 
          STA  FPA0           * 0, THEN SHIFT THE 
          LDA  FPA0+2         * MANTISSA A WHOLE BYTE 
          STA  FPA0+1         * AT A TIME. THIS 
          LDA  FPA0+3         * IS FASTER THAN ONE 
          STA  FPA0+2         * BIT AT A TIME 
          LDA  FPSBYT         * BUT USES MORE MEMORY. 
          STA  FPA0+3         * FPSBYT, THE CARRY IN 
          CLR  FPSBYT         * BYTE, REPLACES THE MATISSA LSB. 
          ADDB #8             SHIFTING ONE BYTE = 8 BIT SHIFTS; ADD 8 TO EXPONENT 
          CMPB #5*8           CHECK FOR 5 SHIFTS 
          BLT  LBA1D          BRANCH IF < 5 SHIFTS, IF > 5, THEN MANTISSA = 0 
LBA39     CLRA                A ZERO EXPONENT = 0 FLOATING POINT 
LBA3A     STA  FP0EXP         ZERO OUT THE EXPONENT 
          STA  FP0SGN         ZERO OUT THE MANTISSA SIGN 
LBA3E     RTS                  
LBA3F     BSR  LBAAE          SHIFT FPA0 MANTISSA TO RIGHT 
          CLRB                CLEAR CARRY FLAG 
          BRA  LB9EC           
* SHIFT FPA0 LEFT ONE BIT UNTIL BIT 7                      
* OF MATISSA MS BYTE = 1                      
LBA44     INCB                ADD ONE TO EXPONENT ACCUMULATOR 
          ASL  FPSBYT         SHIFT SUB BYTE ONE LEFT 
          ROL  FPA0+3         SHIFT LS BYTE 
          ROL  FPA0+2         SHIFT NS BYTE 
          ROL  FPA0+1         SHIFT NS BYTE 
          ROL  FPA0           SHIFT MS BYTE 
LBA4F     BPL  LBA44          BRANCH IF NOT YET NORMALIZED 
          LDA  FP0EXP         GET CURRENT EXPONENT 
          PSHS B              SAVE EXPONENT MODIFIER CAUSED BY NORMALIZATION 
          SUBA ,S+            SUBTRACT ACCUMULATED EXPONENT MODIFIER 
          STA  FP0EXP         SAVE AS NEW EXPONENT 
          BLS  LBA39          SET FPA0 = 0 IF THE NORMALIZATION CAUSED 
*         MORE OR EQUAL NUMBER OF LEFT SHIFTS THAN THE  
*         SIZE OF THE EXPONENT  
          FCB  SKP2           SKIP 2 BYTES 
LBA5C     BCS  LBA66          BRANCH IF MANTISSA OVERFLOW 
          ASL  FPSBYT         SUB BYTE BIT 7 TO CARRY - USE AS ROUND-OFF 
*                             FLAG (TRUNCATE THE REST OF SUB BYTE) 
          LDA  #0             CLRA, BUT DO NOT CHANGE CARRY FLAG 
          STA  FPSBYT         CLEAR THE SUB BYTE 
          BRA  LBA72          GO ROUND-OFF RESULT 
LBA66     INC  FP0EXP         INCREMENT EXPONENT - MULTIPLY BY 2 
          BEQ  LBA92          OVERFLOW ERROR IF CARRY PAST $FF 
          ROR  FPA0           * SHIFT MANTISSA 
          ROR  FPA0+1         * ONE TO 
          ROR  FPA0+2         * THE RIGHT - 
          ROR  FPA0+3         * DIVIDE BY TWO 
LBA72     BCC  LBA78          BRANCH IF NO ROUND-OFF NEEDED 
          BSR  LBA83          ADD ONE TO MANTISSA - ROUND OFF 
          BEQ  LBA66          BRANCH iF OVERFLOW - MANTISSA = 0 
LBA78     RTS                  
* NEGATE FPA0 MANTISSA                      
LBA79     COM  FP0SGN         TOGGLE SIGN OF MANTISSA 
LBA7B     COM  FPA0           * COMPLEMENT ALL 4 MANTISSA BYTES 
          COM  FPA0+1         * 
          COM  FPA0+2         * 
          COM  FPA0+3         * 
* ADD ONE TO FPA0 MANTISSA                      
LBA83     LDX  FPA0+2         * GET BOTTOM 2 MANTISSA 
          LEAX 1,X            * BYTES, ADD ONE TO 
          STX  FPA0+2         * THEM AND SAVE THEM 
          BNE  LBA91          BRANCH IF NO OVERFLOW 
          LDX  FPA0           * IF OVERFLOW ADD ONE 
          LEAX 1,X            * TO TOP 2 MANTISSA 
          STX  FPA0           * BYTES AND SAVE THEM 
LBA91     RTS                  
LBA92     LDB  #2*5           OV' OVERFLOW ERROR 
          JMP  LAC46          PROCESS AN ERROR 
LBA97     LDX  #FPA2-1        POINT X TO FPA2 
* SHIFT FPA POINTED TO BY (X) TO                      
* THE RIGHT -(B) TIMES. EXIT WITH                      
* ACCA CONTAINING DATA SHIFTED OUT                      
* TO THE RIGHT (SUB BYTE) AND THE DATA                      
* SHIFTED IN FROM THE LEFT WILL COME FROM FPCARY                      
LBA9A     LDA  4,X            GET LS BYTE OF MANTISSA (X) 
          STA  FPSBYT         SAVE IN FPA SUB BYTE 
          LDA  3,X            * SHIFT THE NEXT THREE BYTES OF THE 
          STA  4,X            * MANTISSA RIGHT ONE COMPLETE BYTE. 
          LDA  2,X            * 
          STA  3,X            * 
          LDA  1,X            * 
          STA  2,X            * 
          LDA  FPCARY         GET THE CARRY IN BYTE 
          STA  1,X            STORE AS THE MS MANTISSA BYTE OF (X) 
LBAAE     ADDB #8             ADD 8 TO DIFFERENCE OF EXPONENTS 
          BLE  LBA9A          BRANCH IF EXPONENT DIFFERENCE < -8 
          LDA  FPSBYT         GET FPA SUB BYTE 
          SUBB #8             CAST OUT THE 8 ADDED IN ABOVE 
          BEQ  LBAC4          BRANCH IF EXPONENT DIFFERENCE = 0 
                               
                               
LBAB8     ASR  1,X            * SHIFT MANTISSA AND SUB BYTE ONE BIT TO THE RIGHT 
LBABA     ROR  2,X            * 
          ROR  3,X            * 
          ROR  4,X            * 
          RORA                * 
          INCB                ADD ONE TO EXPONENT DIFFERENCE 
          BNE  LBAB8          BRANCH IF EXPONENTS NOT = 
LBAC4     RTS                  
LBAC5     FCB  $81,$00,$00,$00,$00 FLOATING POINT CONSTANT 1.0 
                               
* ARITHMETIC OPERATION (*) JUMPS HERE - MULTIPLY                      
* FPA0 BY (X) - RETURN PRODUCT IN FPA0                      
LBACA     BSR  LBB2F          MOVE PACKED FPA FROM (X) TO FPA1 
LBACC     BEQ  LBB2E          BRANCH IF EXPONENT OF FPA0 = 0 
          BSR  LBB48          CALCULATE EXPONENT OF PRODUCT 
* MULTIPLY FPA0 MANTISSA BY FPA1. NORMALIZE                      
* HIGH ORDER BYTES OF PRODUCT IN FPA0. THE                      
* LOW ORDER FOUR BYTES OF THE PRODUCT WILL                      
* BE STORED IN VAB-VAE.                      
LBAD0     LDA  #0             * ZERO OUT MANTISSA OF FPA2 
          STA  FPA2           * 
          STA  FPA2+1         * 
          STA  FPA2+2         * 
          STA  FPA2+3         * 
          LDB  FPA0+3         GET LS BYTE OF FPA0 
          BSR  LBB00          MULTIPLY BY FPA1 
          LDB  FPSBYT         * TEMPORARILY SAVE SUB BYTE 4 
          STB  VAE            * 
          LDB  FPA0+2         GET NUMBER 3 MANTISSA BYTE OF FPA0 
          BSR  LBB00          MULTIPLY BY FPA1 
          LDB  FPSBYT         * TEMPORARILY SAVE SUB BYTE 3 
          STB  VAD            * 
          LDB  FPA0+1         GET NUMBER 2 MANTISSA BYTE OF FPA0 
          BSR  LBB00          MULTIPLY BY FPA1 
          LDB  FPSBYT         * TEMPORARILY SAVE SUB BYTE 2 
          STB  VAC            * 
          LDB  FPA0           GET MS BYTE OF FPA0 MANTISSA 
          BSR  LBB02          MULTIPLY BY FPA1 
          LDB  FPSBYT         * TEMPORARILY SAVE SUB BYTE 1 
          STB  VAB            * 
          JSR  LBC0B          COPY MANTISSA FROM FPA2 TO FPA0 
          JMP  LBA1C          NORMALIZE FPA0 
LBB00     BEQ  LBA97          SHIFT FPA2 ONE BYTE TO RIGHT 
LBB02     COMA                SET CARRY FLAG 
* MULTIPLY FPA1 MANTISSA BY ACCB AND                      
* ADD PRODUCT TO FPA2 MANTISSA                      
LBB03     LDA  FPA2           GET FPA2 MS BYTE 
          RORB ROTATE CARRY FLAG INTO SHIFT COUNTER;  
*         DATA BIT INTO CARRY  
          BEQ  LBB2E          BRANCH WHEN 8 SHIFTS DONE 
          BCC  LBB20          DO NOT ADD FPA1 IF DATA BIT = 0 
          LDA  FPA2+3         * ADD MANTISSA LS BYTE 
          ADDA FPA1+3         * 
          STA  FPA2+3         * 
          LDA  FPA2+2         = ADD MANTISSA NUMBER 3 BYTE 
          ADCA FPA1+2         = 
          STA  FPA2+2         = 
          LDA  FPA2+1         * ADD MANTISSA NUMBER 2 BYTE 
          ADCA FPA1+1         * 
          STA  FPA2+1         * 
          LDA  FPA2           = ADD MANTISSA MS BYTE 
          ADCA FPA1           = 
LBB20     RORA * ROTATE CARRY INTO MS BYTE  
          STA  FPA2           * 
          ROR  FPA2+1         = ROTATE FPA2 ONE BIT TO THE RIGHT 
          ROR  FPA2+2         = 
          ROR  FPA2+3         = 
          ROR  FPSBYT         = 
          CLRA                CLEAR CARRY FLAG 
          BRA  LBB03          KEEP LOOPING 
LBB2E     RTS                  
* UNPACK A FP NUMBER FROM (X) TO FPA1                      
LBB2F     LDD  1,X            GET TWO MSB BYTES OF MANTISSA FROM 
*         FPA  POINTED TO BY X  
          STA  FP1SGN         SAVE PACKED MANTISSA SIGN BYTE 
          ORA  #$80           FORCE BIT 7 OF MSB MANTISSA = 1 
          STD  FPA1           SAVE 2 MSB BYTES IN FPA1 
          LDB  FP1SGN         * GET PACKED MANTISSA SIGN BYTE. EOR W/FPA0 
          EORB FP0SGN         * SIGN - NEW SIGN POSITION IF BOTH OLD SIGNS ALIKE, 
          STB  RESSGN         * NEG IF BOTH OLD SIGNS DIFF. SAVE ADJUSTED 
*                             * MANTISSA SIGN BYTE 
          LDD  3,X            = GET 2 LSB BYTES OF MANTISSA 
          STD  FPA1+2         = AND PUT IN FPA1 
          LDA  ,X             * GET EXPONENT FROM (X) AND 
          STA  FP1EXP         * PUT IN EXPONENT OF FPA1 
          LDB  FP0EXP         GET EXPONENT OF FPA0 
          RTS                  
* CALCULATE EXPONENT FOR PRODUCT OF FPA0 & FPA1                      
* ENTER WITH EXPONENT OF FPA1 IN ACCA                      
LBB48     TSTA                TEST EXPONENT OF FPA1 
          BEQ  LBB61          PURGE RETURN ADDRESS & SET FPA0 = 0 
          ADDA FP0EXP         ADD FPA1 EXPONENT TO FPA0 EXPONENT 
          RORA                ROTATE CARRY INTO BIT 7; BIT 0 INTO CARRY 
          ROLA                SET OVERFLOW FLAG 
          BVC  LBB61          BRANCH IF EXPONENT TOO LARGE OR SMALL 
          ADDA #$80           ADD $80 BIAS TO EXPONENT 
          STA  FP0EXP         SAVE NEW EXPONENT 
          BEQ  LBB63          SET FPA0 
          LDA  RESSGN         GET MANTISSA SIGN 
          STA  FP0SGN         SAVE AS MANTISSA SIGN OF FPA0 
          RTS                  
* IF FPA0 = POSITIVE THEN 'OV' ERROR IF FPA0                      
* = IS NEGATIVE THEN FPA0 = 0                      
LBB5C     LDA  FP0SGN         GET MANTISSA SIGN OF FPA0 
          COMA                CHANGE SIGN OF FPA0 MANTISSA 
          BRA  LBB63           
LBB61     LEAS 2,S            PURGE RETURN ADDRESS FROM STACK 
LBB63     LBPL LBA39          ZERO FPA0 MANTISSA SIGN & EXPONENT 
LBB67     JMP  LBA92          OV' OVERFLOW ERROR 
* FAST MULTIPLY BY 10 AND LEAVE RESULT IN FPA0                      
LBB6A     JSR  LBC5F          TRANSFER FPA0 TO FPA1 
          BEQ  LBB7C          BRANCH IF EXPONENT = 0 
          ADDA #2             ADD 2 TO EXPONENT (TIMES 4) 
          BCS  LBB67          OV' ERROR IF EXPONENT > $FF 
          CLR  RESSGN         CLEAR RESULT SIGN BYTE 
          JSR  LB9CD          ADD FPA1 TO FPA0 (TIMES 5) 
          INC  FP0EXP         ADD ONE TO EXPONENT (TIMES 10) 
          BEQ  LBB67          OV' ERROR IF EXPONENT > $FF 
LBB7C     RTS                  
LBB7D     FCB  $84,$20,$00,$00,$00 FLOATING POINT CONSTANT 10 
* DIVIDE FPA0 BY 10                      
LBB82     JSR  LBC5F          MOVE FPA0 TO FPA1 
          LDX  #LBB7D         POINT TO FLOATING POINT CONSTANT 10 
          CLRB                ZERO MANTISSA SIGN BYTE 
LBB89     STB  RESSGN         STORE THE QUOTIENT MANTISSA SIGN BYTE 
          JSR  LBC14          UNPACK AN FP NUMBER FROM (X) INTO FPA0 
          FCB  SKP2           SKIP TWO BYTES 
* DIVIDE (X) BY FPA0-LEAVE NORMALIZED QUOTIENT IN FPA0                      
LBB8F     BSR  LBB2F          GET FP NUMBER FROM (X) TO FPA1 
                               
* ARITHMETIC OPERATION (/) JUMPS HERE. DIVIDE FPA1 BY FPA0 (ENTER WITH                      
* EXPONENT OF FPA1 IN ACCA AND FLAGS SET BY TSTA)                      
                               
* DIVIDE FPA1 BY FPA0                      
LBB91     BEQ  LBC06          /0' DIVIDE BY ZERO ERROR 
          NEG  FP0EXP         GET EXPONENT OF RECIPROCAL OF DIVISOR 
          BSR  LBB48          CALCULATE EXPONENT OF QUOTIENT 
          INC  FP0EXP         INCREMENT EXPONENT 
          BEQ  LBB67          OV' OVERFLOW ERROR 
          LDX  #FPA2          POINT X TO MANTISSA OF FPA2 - HOLD 
*                             TEMPORARY QUOTIENT IN FPA2 
          LDB  #4             5 BYTE DIVIDE 
          STB  TMPLOC         SAVE BYTE COUNTER 
          LDB  #1             SHIFT COUNTER-AND TEMPORARY QUOTIENT BYTE 
* COMPARE FPA0 MANTISSA TO FPA1 MANTISSA -                      
* SET CARRY FLAG IF FPA1 >= FPA0                      
LBBA4     LDA  FPA0           * COMPARE THE TWO MS BYTES 
          CMPA FPA1           * OF FPA0 AND FPA1 AND 
          BNE  LBBBD          * BRANCH IF <> 
          LDA  FPA0+1         = COMPARE THE NUMBER 2 
          CMPA FPA1+1         = BYTES AND 
          BNE  LBBBD          = BRANCH IF <> 
          LDA  FPA0+2         * COMPARE THE NUMBER 3 
          CMPA FPA1+2         * BYTES AND 
          BNE  LBBBD          * BRANCH IF <> 
          LDA  FPA0+3         = COMPARE THE LS BYTES 
          CMPA FPA1+3         = AND BRANCH 
          BNE  LBBBD          = IF <> 
          COMA                SET CARRY FLAG IF FPA0 = FPA1 
LBBBD     TFR  CC,A           SAVE CARRY FLAG STATUS IN ACCA; CARRY 
*         CLEAR IF FPA0 > FPA1  
          ROLB                ROTATE CARRY INTO TEMPORARY QUOTIENT BYTE 
          BCC  LBBCC          CARRY WILL BE SET AFTER 8 SHIFTS 
          STB  ,X+            SAVE TEMPORARY QUOTIENT 
          DEC  TMPLOC         DECREMENT BYTE COUNTER 
          BMI  LBBFC          BRANCH IF DONE 
          BEQ  LBBF8          BRANCH IF LAST BYTE 
          LDB  #1             RESET SHIFT COUNTER AND TEMPORARY QUOTIENT BYTE 
LBBCC     TFR  A,CC           RESTORE CARRY FLAG AND 
          BCS  LBBDE          BRANCH IF FPA0 =< FPA1 
LBBD0     ASL  FPA1+3         * SHIFT FPA1 MANTISSA 1 BIT TO LEFT 
          ROL  FPA1+2         * 
          ROL  FPA1+1         * 
          ROL  FPA1           * 
          BCS  LBBBD          BRANCH IF CARRY - ADD ONE TO PARTIAL QUOTIENT 
          BMI  LBBA4          IF MSB OF HIGH ORDER MANTISSA BYTE IS 
*         SET, CHECK THE MAGNITUDES OF FPA0, FPA1  
          BRA  LBBBD          CARRY IS CLEAR, CHECK ANOTHER BIT 
* SUBTRACT FPA0 FROM FPA1 - LEAVE RESULT IN FPA1                      
LBBDE     LDA  FPA1+3         * SUBTRACT THE LS BYTES OF MANTISSA 
          SUBA FPA0+3         * 
          STA  FPA1+3         * 
          LDA  FPA1+2         = THEN THE NEXT BYTE 
          SBCA FPA0+2         = 
          STA  FPA1+2         = 
          LDA  FPA1+1         * AND THE NEXT 
          SBCA FPA0+1         * 
          STA  FPA1+1         * 
          LDA  FPA1           = AND FINALLY, THE MS BYTE OF MANTISSA 
          SBCA FPA0           = 
          STA  FPA1           = 
          BRA  LBBD0          GO SHIFT FPA1 
LBBF8     LDB  #$40           USE ONLY TWO BITS OF THE LAST BYTE (FIFTH) 
          BRA  LBBCC          GO SHIFT THE LAST BYTE 
LBBFC     RORB * SHIFT CARRY (ALWAYS SET HERE) INTO  
          RORB * BIT 5 AND MOVE  
          RORB * BITS 1,0 TO BITS 7,6  
          STB  FPSBYT         SAVE SUB BYTE 
          BSR  LBC0B          MOVE MANTISSA OF FPA2 TO FPA0 
          JMP  LBA1C          NORMALIZE FPA0 
LBC06     LDB  #2*10          /0' ERROR 
          JMP  LAC46          PROCESS THE ERROR 
* COPY MANTISSA FROM FPA2 TO FPA0                      
LBC0B     LDX  FPA2           * MOVE TOP 2 BYTES 
          STX  FPA0           * 
          LDX  FPA2+2         = MOVE BOTTOM 2 BYTES 
          STX  FPA0+2         = 
          RTS                  
* COPY A PACKED FP NUMBER FROM (X) TO FPA0                      
LBC14     PSHS A              SAVE ACCA 
          LDD  1,X            GET TOP TWO MANTISSA BYTES 
          STA  FP0SGN         SAVE MS BYTE OF MANTISSA AS MANTISSA SIGN 
          ORA  #$80           UNPACK MS BYTE 
          STD  FPA0           SAVE UNPACKED TOP 2 MANTISSA BYTES 
          CLR  FPSBYT         CLEAR MANTISSA SUB BYTE 
          LDB  ,X             GET EXPONENT TO ACCB 
          LDX  3,X            * MOVE LAST 2 
          STX  FPA0+2         * MANTISSA BYTES 
          STB  FP0EXP         SAVE EXPONENT 
          PULS A,PC           RESTORE ACCA AND RETURN 
                               
LBC2A     LDX  #V45           POINT X TO MANTISSA OF FPA4 
          BRA  LBC35          MOVE FPA0 TO FPA4 
LBC2F     LDX  #V40           POINT X TO MANTISSA OF FPA3 
          FCB  SKP2           SKIP TWO BYTES 
LBC33     LDX  VARDES         POINT X TO VARIABLE DESCRIPTOR IN VARDES 
* PACK FPA0 AND MOVE IT TO ADDRESS IN X                      
LBC35     LDA  FP0EXP         * COPY EXPONENT 
          STA  ,X             * 
          LDA  FP0SGN         GET MANTISSA SIGN BIT 
          ORA  #$7F           MASK THE BOTTOM 7 BITS 
          ANDA FPA0           AND BIT 7 OF MANTISSA SIGN INTO BIT 7 OF MS BYTE 
          STA  1,X            SAVE MS BYTE 
          LDA  FPA0+1         * MOVE 2ND MANTISSA BYTE 
          STA  2,X            * 
          LDU  FPA0+2         = MOVE BOTTOM 2 MANTISSA BYTES 
          STU  3,X            = 
          RTS                  
* MOVE FPA1 TO FPA0 RETURN W/MANTISSA SIGN IN ACCA                      
LBC4A     LDA  FP1SGN         * COPY MANTISSA SIGN FROM 
LBC4C     STA  FP0SGN         * FPA1 TO FPA0 
          LDX  FP1EXP         = COPY EXPONENT + MS BYTE FROM 
          STX  FP0EXP         = FPA1 TO FPA0 
          CLR  FPSBYT         CLEAR MANTISSA SUB BYTE 
          LDA  FPA1+1         * COPY 2ND MANTISSA BYTE 
          STA  FPA0+1         * FROM FPA1 TO FPA0 
          LDA  FP0SGN         GET MANTISSA SIGN 
          LDX  FPA1+2         * COPY 3RD AND 4TH MANTISSA BYTE 
          STX  FPA0+2         * FROM FPA1 TO FPA0 
          RTS                  
* TRANSFER FPA0 TO FPA1                      
LBC5F     LDD  FP0EXP         * TRANSFER EXPONENT & MS BYTE 
          STD  FP1EXP         * 
          LDX  FPA0+1         = TRANSFER MIDDLE TWO BYTES 
          STX  FPA1+1         = 
          LDX  FPA0+3         * TRANSFER BOTTOM TWO BYTES 
          STX  FPA1+3         * 
          TSTA                SET FLAGS ACCORDING TO EXPONENT 
          RTS                  
* CHECK FPA0; RETURN ACCB = 0 IF FPA0 = 0,                      
* ACCB = $FF IF FPA0 = NEGATIVE, ACCB = 1 IF FPA0 = POSITIVE                      
LBC6D     LDB  FP0EXP         GET EXPONENT 
          BEQ  LBC79          BRANCH IF FPA0 = 0 
LBC71     LDB  FP0SGN         GET SIGN OF MANTISSA 
LBC73     ROLB                BIT 7 TO CARRY 
          LDB  #$FF           NEGATIVE FLAG 
          BCS  LBC79          BRANCH IF NEGATIVE MANTISSA 
          NEGB                ACCB = 1 IF POSITIVE MANTISSA 
LBC79     RTS                  
                               
* SGN                          
SGN       BSR  LBC6D          SET ACCB ACCORDING TO SIGN OF FPA0 
* CONVERT A SIGNED NUMBER IN ACCB INTO A FLOATING POINT NUMBER                      
LBC7C     STB  FPA0           SAVE ACCB IN FPA0 
          CLR  FPA0+1         CLEAR NUMBER 2 MANTISSA BYTE OF FPA0 
          LDB  #$88           EXPONENT REQUIRED IF FPA0 IS TO BE AN INTEGER 
LBC82     LDA  FPA0           GET MS BYTE OF MANTISSA 
          SUBA #$80           SET CARRY IF POSITIVE MANTISSA 
LBC86     STB  FP0EXP         SAVE EXPONENT 
          LDD  ZERO           * ZERO OUT ACCD AND 
          STD  FPA0+2         * BOTTOM HALF OF FPA0 
          STA  FPSBYT         CLEAR SUB BYTE 
          STA  FP0SGN         CLEAR SIGN OF FPA0 MANTISSA 
          JMP  LBA18          GO NORMALIZE FPA0 
                               
* ABS                          
ABS       CLR  FP0SGN         FORCE MANTISSA SIGN OF FPA0 POSITIVE 
          RTS                  
* COMPARE A PACKED FLOATING POINT NUMBER POINTED TO                      
* BY (X) TO AN UNPACKED FP NUMBER IN FPA0. RETURN                      
* ZERO FLAG SET AND ACCB = 0, IF EQUAL; ACCB = 1 IF                      
* FPA0 > (X); ACCB = $FF IF FPA0 < (X)                      
LBC96     LDB  ,X             CHECK EXPONENT OF (X) 
          BEQ  LBC6D          BRANCH IF FPA = 0 
          LDB  1,X            GET MS BYTE OF MANTISSA OF (X) 
          EORB FP0SGN         EOR WITH SIGN OF FPA0 
          BMI  LBC71          BRANCH IF SIGNS NOT = 
* COMPARE FPA0 WITH FP NUMBER POINTED TO BY (X).                      
* FPA0 IS NORMALIZED, (X) IS PACKED.                      
LBCA0     LDB  FP0EXP         * GET EXPONENT OF 
          CMPB ,X             * FPA0, COMPARE TO EXPONENT OF 
          BNE  LBCC3          * (X) AND BRANCH IF <>. 
          LDB  1,X            * GET MS BYTE OF (X), KEEP ONLY 
          ORB  #$7F           * THE SIGN BIT - 'AND' THE BOTTOM 7 
          ANDB FPA0           * BITS OF FPA0 INTO ACCB 
          CMPB 1,X            = COMPARE THE BOTTOM 7 BITS OF THE MANTISSA 
          BNE  LBCC3          = MS BYTE AND BRANCH IF <> 
          LDB  FPA0+1         * COMPARE 2ND BYTE 
          CMPB 2,X            * OF MANTISSA, 
          BNE  LBCC3          * BRANCH IF <> 
          LDB  FPA0+2         = COMPARE 3RD BYTE 
          CMPB 3,X            = OF MANTISSA, 
          BNE  LBCC3          = BRANCH IF <> 
          LDB  FPA0+3         * SUBTRACT LS BYTE 
          SUBB 4,X            * OF (X) FROM LS BYTE OF 
          BNE  LBCC3          * FPA0, BRANCH IF <> 
          RTS                 RETURN IF FP (X) = FPA0 
LBCC3     RORB                SHIFT CARRY TO BIT 7; CARRY SET IF FPA0 < (X) 
          EORB FP0SGN         TOGGLE SIZE COMPARISON BIT IF FPA0 IS NEGATIVE 
          BRA  LBC73          GO SET ACCB ACCORDING TO COMPARISON 
* DE-NORMALIZE FPA0 : SHIFT THE MANTISSA UNTIL THE BINARY POINT IS TO THE RIGHT                      
* OF THE LEAST SIGNIFICANT BYTE OF THE MANTISSA                      
LBCC8     LDB  FP0EXP         GET EXPONENT OF FPA0 
          BEQ  LBD09          ZERO MANTISSA IF FPA0 = 0 
          SUBB #$A0           SUBTRACT $A0 FROM FPA0 EXPONENT T THIS WILL YIELD 
*                             THE NUMBER OF SHIFTS REQUIRED TO DENORMALIZE FPA0. WHEN 
*                             THE EXPONENT OF FPA0 IS = ZERO, THEN THE BINARY POINT 
*                             WILL BE TO THE RIGHT OF THE MANTISSA 
          LDA  FP0SGN         TEST SIGN OF FPA0 MANTISSA 
          BPL  LBCD7          BRANCH IF POSITIVE 
          COM  FPCARY         COMPLEMENT CARRY IN BYTE 
          JSR  LBA7B          NEGATE MANTISSA OF FPA0 
LBCD7     LDX  #FP0EXP        POINT X TO FPA0 
          CMPB #-8            EXPONENT DIFFERENCE < -8? 
          BGT  LBCE4          YES 
          JSR  LBAAE          SHIFT FPA0 RIGHT UNTIL FPA0 EXPONENT = $A0 
          CLR  FPCARY         CLEAR CARRY IN BYTE 
          RTS                  
LBCE4     CLR  FPCARY         CLEAR CARRY IN BYTE 
          LDA  FP0SGN         * GET SIGN OF FPA0 MANTISSA 
          ROLA                * ROTATE IT INTO THE CARRY FLAG 
          ROR  FPA0           ROTATE CARRY (MANTISSA SIGN) INTO BIT 7 
*                             OF LS BYTE OF MANTISSA 
          JMP  LBABA          DE-NORMALIZE FPA0 
                               
* INT                          
* THE INT STATEMENT WILL "DENORMALIZE" FPA0 - THAT IS IT WILL SHIFT THE BINARY POINT                      
* TO THE EXTREME RIGHT OF THE MANTISSA TO FORCE ITS EXPONENT TO BE $AO. ONCE                      
* THIS IS DONE THE MANTISSA OF FPA0 WILL CONTAIN THE FOUR LEAST SIGNIFICANT                      
* BYTES OF THE INTEGER PORTION OF FPA0. AT THE CONCLUSION OF THE DE-NORMALIZATION                      
* ONLY THE INTEGER PORTION OF FPA0 WILL REMAIN.                      
*                              
INT       LDB  FP0EXP         GET EXPONENT OF FPA0 
          CMPB #$A0           LARGEST POSSIBLE INTEGER EXPONENT 
          BCC  LBD11          RETURN IF FPA0 >= 32768 
          BSR  LBCC8          SHIFT THE BINARY POINT ONE TO THE RIGHT OF THE 
*                             LS BYTE OF THE FPA0 MANTISSA 
          STB  FPSBYT         ACCB = 0: ZERO OUT THE SUB BYTE 
          LDA  FP0SGN         GET MANTISSA SIGN 
          STB  FP0SGN         FORCE MANTISSA SIGN TO BE POSITIVE 
          SUBA #$80           SET CARRY IF MANTISSA 
          LDA  #$A0           * GET DENORMALIZED EXPONENT AND 
          STA  FP0EXP         * SAVE IT IN FPA0 EXPONENT 
          LDA  FPA0+3         = GET LS BYTE OF FPA0 AND 
          STA  CHARAC         = SAVE IT IN CHARAC 
          JMP  LBA18          NORMALIZE FPA0 
                               
LBD09     STB  FPA0           * LOAD MANTISSA OF FPA0 WITH CONTENTS OF ACCB 
          STB  FPA0+1         * 
          STB  FPA0+2         * 
          STB  FPA0+3         * 
LBD11     RTS                 * 
                               
* CONVERT ASCII STRING TO FLOATING POINT                      
LBD12     LDX  ZERO           (X) = 0 
          STX  FP0SGN         * ZERO OUT FPA0 & THE SIGN FLAG (COEFCT) 
          STX  FP0EXP         * 
          STX  FPA0+1         * 
          STX  FPA0+2         * 
          STX  V47            INITIALIZE EXPONENT & EXPONENT SIGN FLAG TO ZERO 
          STX  V45            INITIALIZE RIGHT DECIMAL CTR & DECIMAL PT FLAG TO 0 
          BCS  LBD86          IF CARRY SET (NUMERIC CHARACTER), ASSUME ACCA CONTAINS FIRST 
*         NUMERIC CHAR, SIGN IS POSITIVE AND SKIP THE RAM HOOK  
          JSR  XVEC19         CALL EXTENDED BASIC ADD-IN 
LBD25     CMPA #'-            * CHECK FOR A LEADING MINUS SIGN AND BRANCH 
          BNE  LBD2D          * IF NO MINUS SIGN 
          COM  COEFCT         TOGGLE SIGN; 0 = +; FF = - 
          BRA  LBD31          INTERPRET THE REST OF THE STRING 
LBD2D     CMPA #'+            * CHECK FOR LEADING PLUS SlGN AND BRANCH 
          BNE  LBD35          * IF NOT A PLUS SIGN 
LBD31     JSR  GETNCH         GET NEXT INPUT CHARACTER FROM BASIC 
          BCS  LBD86          BRANCH IF NUMERIC CHARACTER 
LBD35     CMPA #'.            DECIMAL POlNT? 
          BEQ  LBD61          YES 
          CMPA #'E            "E" SHORTHAND FORM (SCIENTIFIC NOTATION)? 
          BNE  LBD65          NO 
* EVALUATE EXPONENT OF EXPONENTIAL FORMAT                      
          JSR  GETNCH         GET NEXT INPUT CHARACTER FROM BASIC 
          BCS  LBDA5          BRANCH IF NUMERIC 
          CMPA #TOK_MINUS     MINUS TOKEN? 
          BEQ  LBD53          YES 
          CMPA #'-            ASCII MINUS? 
          BEQ  LBD53          YES 
          CMPA #TOK_PLUS      PLUS TOKEN? 
          BEQ  LBD55          YES 
          CMPA #'+            ASCII PLUS? 
          BEQ  LBD55          YES 
          BRA  LBD59          BRANCH IF NO SIGN FOUND 
LBD53     COM  V48            SET EXPONENT SIGN FLAG TO NEGATIVE 
* STRIP A DECIMAL NUMBER FROM BASIC LINE, CONVERT IT TO BINARY IN V47                      
LBD55     JSR  GETNCH         GET NEXT INPUT CHARACTER FROM BASIC 
          BCS  LBDA5          IF NUMERIC CHARACTER, CONVERT TO BINARY 
LBD59     TST  V48            * CHECK EXPONENT SIGN FLAG 
          BEQ  LBD65          * AND BRANCH IF POSITIVE 
          NEG  V47            NEGATE VALUE OF EXPONENT 
          BRA  LBD65           
LBD61     COM  V46            *TOGGLE DECIMAL PT FLAG AND INTERPRET ANOTHER 
          BNE  LBD31          *CHARACTER IF <> 0 - TERMINATE INTERPRETATION 
*         IF   SECOND DECIMAL POINT  
* ADJUST FPA0 FOR THE DECIMAL EXPONENT IN V47                      
LBD65     LDA  V47            * GET EXPONENT, SUBTRACT THE NUMBER OF 
          SUBA V45            * PLACES TO THE RIGHT OF DECIMAL POINT 
          STA  V47            * AND RESAVE IT. 
          BEQ  LBD7F          EXIT ROUTINE IF ADJUSTED EXPONENT = ZERO 
          BPL  LBD78          BRANCH IF POSITIVE EXPONENT 
LBD6F     JSR  LBB82          DIVIDE FPA0 BY 10 
          INC  V47            INCREMENT EXPONENT COUNTER (MULTIPLY BY 10) 
          BNE  LBD6F          KEEP MULTIPLYING 
          BRA  LBD7F          EXIT ROUTINE 
LBD78     JSR  LBB6A          MULTIPLY FPA0 BY 10 
          DEC  V47            DECREMENT EXPONENT COUNTER (DIVIDE BY 10) 
          BNE  LBD78          KEEP MULTIPLYING 
LBD7F     LDA  COEFCT         GET THE SIGN FLAG 
          BPL  LBD11          RETURN IF POSITIVE 
          JMP  LBEE9          TOGGLE MANTISSA SIGN OF FPA0, IF NEGATIVE 
*MULTIPLY FPA0 BY TEN AND ADD ACCA TO THE RESULT                      
LBD86     LDB  V45            *GET THE RIGHT DECIMAL COUNTER AND SUBTRACT 
          SUBB V46            *THE DECIMAL POINT FLAG FROM IT. IF DECIMAL POINT 
          STB  V45            *FLAG=0, NOTHING HAPPENS. IF DECIMAL POINT FLAG IS 
*                             -1, THEN RIGHT DECIMAL COUNTER IS INCREMENTED BY ONE 
          PSHS A              SAVE NEW DIGIT ON STACK 
          JSR  LBB6A          MULTIPLY FPA0 BY 10 
          PULS B              GET NEW DIGIT BACK 
          SUBB #'0            MASK OFF ASCII 
          BSR  LBD99          ADD ACCB TO FPA0 
          BRA  LBD31          GET ANOTHER CHARACTER FROM BASIC 
LBD99     JSR  LBC2F          PACK FPA0 AND SAVE IT IN FPA3 
          JSR  LBC7C          CONVERT ACCB TO FP NUMBER IN FPA0 
          LDX  #V40           * ADD FPA0 TO 
          JMP  LB9C2          * FPA3 
                               
                               
LBDA5     LDB  V47             
          ASLB                TIMES 2 
          ASLB                TIMES 4 
          ADDB V47            ADD 1 = TIMES 5 
          ASLB                TIMES 10 
          SUBA #'0            *MASK OFF ASCII FROM ACCA, PUSH 
          PSHS B              *RESULT ONTO THE STACK AND 
          ADDA ,S+            ADD lT TO ACCB 
          STA  V47            SAVE IN V47 
          BRA  LBD55          INTERPRET ANOTHER CHARACTER 
*                              
LBDB6     FCB  $9B,$3E,$BC,$1F,$FD * 99999999.9 
LBDBB     FCB  $9E,$6E,$6B,$27,$FD * 999999999 
LBDC0     FCB  $9E,$6E,$6B,$28,$00 * 1E + 09 
*                              
LBDC5     LDX  #LABE8-1       POINT X TO " IN " MESSAGE 
          BSR  LBDD6          COPY A STRING FROM (X) TO CONSOLE OUT 
          LDD  CURLIN         GET CURRENT BASIC LINE NUMBER TO ACCD 
* CONVERT VALUE IN ACCD INTO A DECIMAL NUMBER                      
* AND PRINT IT TO CONSOLE OUT                      
LBDCC     STD  FPA0           SAVE ACCD IN TOP HALF OF FPA0 
          LDB  #$90           REQ’D EXPONENT IF TOP HALF OF ACCD = INTEGER 
          COMA                SET CARRY FLAG - FORCE POSITIVE MANTISSA 
          JSR  LBC86          ZERO BOTTOM HALF AND SIGN OF FPA0, THEN 
*         SAVE EXPONENT AND NORMALIZE IT  
          BSR  LBDD9          CONVERT FP NUMBER TO ASCII STRING 
LBDD6     JMP  LB99C          COPY A STRING FROM (X) TO CONSOLE OUT 
                               
* CONVERT FP NUMBER TO ASCII STRING                      
LBDD9     LDU  #STRBUF+3      POINT U TO BUFFER WHICH WILL NOT CAUSE 
*                             THE STRING TO BE STORED IN STRING SPACE 
LBDDC     LDA  #SPACE         SPACE = DEFAULT SIGN FOR POSITIVE # 
          LDB  FP0SGN         GET SIGN OF FPA0 
          BPL  LBDE4          BRANCH IF POSITIVE 
          LDA  #'-            ASCII MINUS SIGN 
LBDE4     STA  ,U+            STORE SIGN OF NUMBER 
          STU  COEFPT         SAVE BUFFER POINTER 
          STA  FP0SGN         SAVE SIGN (IN ASCII) 
          LDA  #'0            ASCII ZERO IF EXPONENT = 0 
          LDB  FP0EXP         GET FPA0 EXPONENT 
          LBEQ LBEB8          BRANCH IF FPA0 = 0 
          CLRA                BASE 10 EXPONENT=0 FOR FP NUMBER > 1 
          CMPB #$80           CHECK EXPONENT 
          BHI  LBDFF          BRANCH IF FP NUMBER > 1 
* IF FPA0 < 1.0, MULTIPLY IT BY 1E+09 TO SPEED UP THE CONVERSION PROCESS                      
          LDX  #LBDC0         POINT X TO FP 1E+09 
          JSR  LBACA          MULTIPLY FPA0 BY (X) 
          LDA  #-9            BASE 10 EXPONENT = -9 
LBDFF     STA  V45            BASE 10 EXPONENT 
* PSEUDO - NORMALIZE THE FP NUMBER TO A VALUE IN THE RANGE                      
* OF 999,999,999 RO 99,999,999.9 - THIS IS THE LARGEST                      
* NUMBER RANGE IN WHICH ALL OF THE DIGITS ARE                      
* SIGNIFICANT WHICH CAN BE DISPLAYED WITHOUT USING                      
* SCIENTIFIC NOTATION                      
LBE01     LDX  #LBDBB         POINT X TO FP 999,999,999 
          JSR  LBCA0          COMPARE FPA0 TO 999,999,999 
          BGT  LBE18          BRANCH IF > 999,999,999 
LBE09     LDX  #LBDB6         POINT X TO FP 99,999,999.9 
          JSR  LBCA0          COMPARE FPA0 TO 99,999,999.9 
          BGT  LBE1F          BRANCH IF > 99,999,999.9 (IN RANGE) 
          JSR  LBB6A          MULTIPLY FPA0 BY 10 
          DEC  V45            SUBTRACT ONE FROM DECIMAL OFFSET 
          BRA  LBE09          PSEUDO - NORMALIZE SOME MORE 
LBE18     JSR  LBB82          DIVIDE FPA0 BY 10 
          INC  V45            ADD ONE TO BASE 10 EXPONENT 
          BRA  LBE01          PSEUDO - NORMALIZE SOME MORE 
LBE1F     JSR  LB9B4          ADD .5 TO FPA0 (ROUND OFF) 
          JSR  LBCC8          CONVERT FPA0 TO AN INTEGER 
          LDB  #1             DEFAULT DECIMAL POINT FLAG (FORCE IMMED DECIMAL PT) 
          LDA  V45            * GET BASE 10 EXPONENT AND ADD TEN TO IT 
          ADDA #9+1           * (NUMBER ‘NORMALIZED’ TO 9 PLACES & DECIMAL PT) 
          BMI  LBE36          BRANCH IF NUMBER < 1.0 
          CMPA #9+2           NINE PLACES MAY BE DISPLAYED WITHOUT 
*         USING SCIENTIFIC NOTATION  
          BCC  LBE36          BRANCH IF SCIENTIFIC NOTATION REQUIRED 
          DECA                * SUBTRACT 1 FROM MODIFIED BASE 10 EXPONENT CTR 
          TFR  A,B            * AND SAVE IT IN ACCB (DECiMAL POINT FLAG) 
          LDA  #2             FORCE EXPONENT = 0 - DON'T USE SCIENTIFIC NOTATION 
LBE36     DECA                * SUBTRACT TWO (WITHOUT AFFECTING CARRY) 
          DECA                * FROM BASE 10 EXPONENT 
          STA  V47            SAVE EXPONENT - ZERO EXPONENT = DO NOT DISPLAY 
*         IN   SCIENTIFIC NOTATION  
          STB  V45            DECIMAL POINT FLAG - NUMBER OF PLACES TO 
*         LEFT OF DECIMAL POINT  
          BGT  LBE4B          BRANCH IF >= 1 
          LDU  COEFPT         POINT U TO THE STRING BUFFER 
          LDA  #'.            * STORE A PERIOD 
          STA  ,U+            * IN THE BUFFER 
          TSTB CHECK DECIMAL POINT FLAG  
          BEQ  LBE4B          BRANCH IF NOTHING TO LEFT OF DECIMAL POINT 
          LDA  #'0            * STORE A ZERO 
          STA  ,U+            * IN THE BUFFER 
                               
* CONVERT FPA0 INTO A STRING OF ASCII DIGITS                      
LBE4B     LDX  #LBEC5         POINT X TO FP POWER OF 10 MANTISSA 
          LDB  #0+$80         INITIALIZE DIGIT COUNTER TO 0+$80 
* BIT 7 SET IS USED TO INDICATE THAT THE POWER OF 10 MANTISSA                      
* IS NEGATIVE. WHEN YOU 'ADD' A NEGATIVE MANTISSA, IT IS                      
* THE SAME AS SUBTRACTING A POSITIVE ONE AND BIT 7 OF ACCB IS HOW                      
* THE ROUTINE KNOWS THAT A 'SUBTRACTION' IS OCCURING.                      
LBE50     LDA  FPA0+3         * ADD MANTISSA LS 
          ADDA 3,X            * BYTE OF FPA0 
          STA  FPA0+3         * AND (X) 
          LDA  FPA0+2         = ADD MANTISSA 
          ADCA 2,X            = NUMBER 3 BYTE OF 
          STA  FPA0+2         = FPA0 AND (X) 
          LDA  FPA0+1         * ADD MANTISSA 
          ADCA 1,X            * NUMBER 2 BYTE OF 
          STA  FPA0+1         * FPA0 AND (X) 
          LDA  FPA0           = ADD MANTISSA 
          ADCA ,X             = MS BYTE OF 
          STA  FPA0           = FPA0 AND (X) 
          INCB                ADD ONE TO DIGIT COUNTER 
          RORB ROTATE CARRY INTO BIT 7  
          ROLB                *SET OVERFLOW FLAG AND BRANCH IF CARRY = 1 AND 
          BVC  LBE50          *POSITIVE MANTISSA OR CARRY = 0 AND NEG MANTISSA 
          BCC  LBE72          BRANCH IF NEGATIVE MANTISSA 
          SUBB #10+1          * TAKE THE 9’S COMPLEMENT IF 
          NEGB                * ADDING MANTISSA 
LBE72     ADDB #'0-1          ADD ASCII OFFSET TO DIGIT 
          LEAX 4,X            MOVE TO NEXT POWER OF 10 MANTISSA 
          TFR  B,A            SAVE DIGIT IN ACCA 
          ANDA #$7F           MASK OFF BIT 7 (ADD/SUBTRACT FLAG) 
          STA  ,U+            STORE DIGIT IN STRING BUFFER 
          DEC  V45            DECREMENT DECIMAL POINT FLAG 
          BNE  LBE84          BRANCH IF NOT TIME FOR DECIMAL POINT 
          LDA  #'.            * STORE DECIMAL POINT IN 
          STA  ,U+            * STRING BUFFER 
LBE84     COMB                TOGGLE BIT 7 (ADD/SUBTRACT FLAG) 
          ANDB #$80           MASK OFF ALL BUT ADD/SUBTRACT FLAG 
          CMPX #LBEC5+36      COMPARE X TO END OF MANTISSA TABLE 
          BNE  LBE50          BRANCH IF NOT AT END OF TABLE 
* BLANK TRAILING ZEROS AND STORE EXPONENT IF ANY                      
LBE8C     LDA  ,-U            GET THE LAST CHARACTER; MOVE POINTER BACK 
          CMPA #'0            WAS IT A ZERO? 
          BEQ  LBE8C          IGNORE TRAILING ZEROS IF SO 
          CMPA #'.            CHECK FOR DECIMAL POINT 
          BNE  LBE98          BRANCH IF NOT DECIMAL POINT 
          LEAU -1,U           STEP OVER THE DECIMAL POINT 
LBE98     LDA  #'+            ASCII PLUS SIGN 
          LDB  V47            GET SCIENTIFIC NOTATION EXPONENT 
          BEQ  LBEBA          BRANCH IF NOT SCIENTIFIC NOTATION 
          BPL  LBEA3          BRANCH IF POSITIVE EXPONENT 
          LDA  #'-            ASCII MINUS SIGN 
          NEGB                NEGATE EXPONENT IF NEGATIVE 
LBEA3     STA  2,U            STORE EXPONENT SIGN IN STRING 
          LDA  #'E            * GET ASCII ‘E’ (SCIENTIFIC NOTATION 
          STA  1,U            * FLAG) AND SAVE IT IN THE STRING 
          LDA  #'0-1          INITIALIZE ACCA TO ASCII ZERO 
                               
                               
LBEAB     INCA                ADD ONE TO 10’S DIGIT OF EXPONENT 
          SUBB #10            SUBTRACT 10 FROM ACCB 
          BCC  LBEAB          ADD 1 TO 10’S DIGIT IF NO CARRY 
          ADDB #'9+1          CONVERT UNITS DIGIT TO ASCII 
          STD  3,U            SAVE EXPONENT IN STRING 
          CLR  5,U            CLEAR LAST BYTE (TERMINATOR) 
          BRA  LBEBC          GO RESET POINTER 
LBEB8     STA  ,U             STORE LAST CHARACTER 
LBEBA     CLR  1,U            CLEAR LAST BYTE (TERMINATOR - REQUIRED BY 
*         PRINT SUBROUTINES)    
LBEBC     LDX  #STRBUF+3      RESET POINTER TO START OF BUFFER 
          RTS                  
*                              
LBEC0     FCB  $80,$00,$00,$00,$00 FLOATING POINT .5 
*                              
*** TABLE OF UNNORMALIZED POWERS OF 10                      
LBEC5     FCB  $FA,$0A,$1F,$00 -100000000 
LBEC9     FCB  $00,$98,$96,$80 10000000 
LBECD     FCB  $FF,$F0,$BD,$C0 -1000000 
LBED1     FCB  $00,$01,$86,$A0 100000 
LBED5     FCB  $FF,$FF,$D8,$F0 -10000 
LBED9     FCB  $00,$00,$03,$E8 1000 
LBEDD     FCB  $FF,$FF,$FF,$9C -100 
LBEE1     FCB  $00,$00,$00,$0A 10 
LBEE5     FCB  $FF,$FF,$FF,$FF -1 
*                              
*                              
LBEE9     LDA  FP0EXP         GET EXPONENT OF FPA0 
          BEQ  LBEEF          BRANCH IF FPA0 = 0 
          COM  FP0SGN         TOGGLE MANTISSA SIGN OF FPA0 
LBEEF     RTS                  
* EXPAND A POLYNOMIAL OF THE FORM                      
* AQ+BQ**3+CQ**5+DQ**7.... WHERE Q = FPA0                      
* AND THE X REGISTER POINTS TO A TABLE OF                      
* COEFFICIENTS A,B,C,D....                      
LBEF0     STX  COEFPT         SAVE COEFFICIENT TABLE POINTER 
          JSR  LBC2F          MOVE FPA0 TO FPA3 
          BSR  LBEFC          MULTIPLY FPA3 BY FPA0 
          BSR  LBF01          EXPAND POLYNOMIAL 
          LDX  #V40           POINT X TO FPA3 
LBEFC     JMP  LBACA          MULTIPLY (X) BY FPA0 
                               
* CALCULATE THE VALUE OF AN EXPANDED POLYNOMIAL                      
* EXPRESSION. ENTER WITH (X) POINTING TO A TABLE                      
* OF COEFFICIENTS, THE FIRST BYTE OF WHICH IS THE                      
* NUMBER OF (COEFFICIENTS-1) FOLLOWED BY THAT NUMBER                      
* OF PACKED FLOATING POINT NUMBERS. THE                      
* POLYNOMIAL IS EVALUATED AS FOLLOWS: VALUE =                      
* (((FPA0*Y0+Y1)*FPA0+Y2)*FPA0…YN)                      
LBEFF     STX  COEFPT         SAVE COEFFICIENT TABLE POINTER 
LBF01     JSR  LBC2A          MOVE FPA0 TO FPA4 
          LDX  COEFPT         GET THE COEFFICIENT POINTER 
          LDB  ,X+            GET THE TOP OF COEFFICIENT TABLE TO 
          STB  COEFCT         * USE AND STORE IT IN TEMPORARY COUNTER 
          STX  COEFPT         SAVE NEW COEFFICIENT POINTER 
LBF0C     BSR  LBEFC          MULTIPLY (X) BY FPA0 
          LDX  COEFPT         *GET COEFFICIENT POINTER 
          LEAX 5,X            *MOVE TO NEXT FP NUMBER 
          STX  COEFPT         *SAVE NEW COEFFICIENT POINTER 
          JSR  LB9C2          ADD (X) AND FPA0 
          LDX  #V45           POINT (X) TO FPA4 
          DEC  COEFCT         DECREMENT TEMP COUNTER 
          BNE  LBF0C          BRANCH IF MORE COEFFICIENTS LEFT 
          RTS                  
                               
* RND                          
RND       JSR  LBC6D          TEST FPA0 
          BMI  LBF45          BRANCH IF FPA0 = NEGATIVE 
          BEQ  LBF3B          BRANCH IF FPA0 = 0 
          BSR  LBF38          CONVERT FPA0 TO AN INTEGER 
          JSR  LBC2F          PACK FPA0 TO FPA3 
          BSR  LBF3B          GET A RANDOM NUMBER: FPA0 < 1.0 
          LDX  #V40           POINT (X) TO FPA3 
          BSR  LBEFC          MULTIPLY (X) BY FPA0 
          LDX  #LBAC5         POINT (X) TO FP VALUE OF 1.0 
          JSR  LB9C2          ADD 1.0 TO FPA0 
LBF38     JMP  INT            CONVERT FPA0 TO AN INTEGER 
* CALCULATE A RANDOM NUMBER IN THE RANGE 0.0 < X <= 1.0                      
LBF3B     LDX  RVSEED+1       * MOVE VARIABLE 
          STX  FPA0           * RANDOM NUMBER 
          LDX  RVSEED+3       * SEED TO 
          STX  FPA0+2         * FPA0 
LBF45     LDX  RSEED          = MOVE FIXED 
          STX  FPA1           = RANDOM NUMBER 
          LDX  RSEED+2        = SEED TO 
          STX  FPA1+2         = MANTISSA OF FPA0 
          JSR  LBAD0          MULTIPLY FPA0 X FPA1 
          LDD  VAD            GET THE TWO LOWEST ORDER PRODUCT BYTES 
          ADDD #$658B         ADD A CONSTANT 
          STD  RVSEED+3       SAVE NEW LOW ORDER VARIABLE RANDOM # SEED 
          STD  FPA0+2         SAVE NEW LOW ORDER BYTES OF FPA0 MANTISSA 
          LDD  VAB            GET 2 MORE LOW ORDER PRODUCT BYTES 
          ADCB #$B0           ADD A CONSTANT 
          ADCA #5             ADD A CONSTANT 
          STD  RVSEED+1       SAVE NEW HIGH ORDER VARIABLE RANDOM # SEED 
          STD  FPA0           SAVE NEW HIGH ORDER FPA0 MANTISSA 
          CLR  FP0SGN         FORCE FPA0 MANTISSA = POSITIVE 
          LDA  #$80           * SET FPA0 BIASED EXPONENT 
          STA  FP0EXP         * TO 0 1 < FPA0 < 0 
          LDA  FPA2+2         GET A BYTE FROM FPA2 (MORE RANDOMNESS) 
          STA  FPSBYT         SAVE AS SUB BYTE 
          JMP  LBA1C          NORMALIZE FPA0 
*                              
RSEED     FDB  $40E6          *CONSTANT RANDOM NUMBER GENERATOR SEED 
          FDB  $4DAB          * 
                               
* SIN                          
* THE SIN FUNCTION REQUIRES AN ARGUMENT IN RADIANS AND WILL REPEAT ITSELF EVERY                      
* 2*PI RADIANS. THE ARGUMENT IS DIVIDED BY 2*PI AND ONLY THE FRACTIONAL PART IS                      
* RETAINED. SINCE THE ARGUMENT WAS DIVIDED BY 2*P1, THE COEFFICIENTS MUST BE                      
* MULTIPLIED BY THE APPROPRIATE POWER OF 2*PI.                      
                               
* SIN IS EVALUATED USING THE TRIGONOMETRIC IDENTITIES BELOW:                      
* SIN(X)=SIN(PI-X) & -SIN(PI/2-X)=SIN((3*PI)/2+X)                      
SIN       JSR  LBC5F          COPY FPA0 TO FPA1 
          LDX  #LBFBD         POINT (X) TO 2*PI 
          LDB  FP1SGN         *GET MANTISSA SIGN OF FPA1 
          JSR  LBB89          *AND DIVIDE FPA0 BY 2*PI 
          JSR  LBC5F          COPY FPA0 TO FPA1 
          BSR  LBF38          CONVERT FPA0 TO AN INTEGER 
          CLR  RESSGN         SET RESULT SIGN = POSITIVE 
          LDA  FP1EXP         *GET EXPONENT OF FPA1 
          LDB  FP0EXP         *GET EXPONENT OF FPA0 
          JSR  LB9BC          *SUBTRACT FPA0 FROM FPA1 
* NOW FPA0 CONTAINS ONLY THE FRACTIONAL PART OF ARGUMENT/2*PI                      
          LDX  #LBFC2         POINT X TO FP (.25) 
          JSR  LB9B9          SUBTRACT FPA0 FROM .25 (PI/2) 
          LDA  FP0SGN         GET MANTISSA SIGN OF FPA0 
          PSHS A              SAVE IT ON STACK 
          BPL  LBFA6          BRANCH IF MANTISSA POSITIVE 
          JSR  LB9B4          ADD .5 (PI) TO FPA0 
          LDA  FP0SGN         GET SIGN OF FPA0 
          BMI  LBFA9          BRANCH IF NEGATIVE 
          COM  RELFLG         COM IF +(3*PI)/2 >= ARGUMENT >+ PI/2 (QUADRANT FLAG) 
LBFA6     JSR  LBEE9          TOGGLE MANTISSA SIGN OF FPA0 
LBFA9     LDX  #LBFC2         POINT X TO FP (.25) 
          JSR  LB9C2          ADD .25 (PI/2) TO FPA0 
          PULS A              GET OLD MANTISSA SIGN 
          TSTA                * BRANCH IF OLD 
          BPL  LBFB7          * SIGN WAS POSITIVE 
          JSR  LBEE9          TOGGLE MANTISSA SIGN 
LBFB7     LDX  #LBFC7         POINT X TO TABLE OF COEFFICIENTS 
          JMP  LBEF0          GO CALCULATE POLYNOMIAL VALUE 
                               
LBFBD     FCB  $83,$49,$0F,$DA,$A2 6.28318531 (2*PI) 
LBFC2     FCB  $7F,$00,$00,$00,$00 .25 
                               
                               
LBFC7     FCB  6-1            SIX COEFFICIENTS 
LBFC8     FCB  $84,$E6,$1A,$2D,$1B * -((2*PI)**11)/11! 
LBFCD     FCB  $86,$28,$07,$FB,$F8 * ((2*PI)**9)/9! 
LBFD2     FCB  $87,$99,$68,$89,$01 * -((2*PI)**7)/7! 
LBFD7     FCB  $87,$23,$35,$DF,$E1 * ((2*PI)**5)/5! 
LBFDC     FCB  $86,$A5,$5D,$E7,$28 * -((2*PI)**3)/3! 
LBFE1     FCB  $83,$49,$0F,$DA,$A2 * 
                               
          FCB  $A1,$54,$46,$8F,$13 UNUSED GARBAGE BYTES 
          FCB  $8F,$52,$43,$89,$CD UNUSED GARBAGE BYTES 
* EXTENDED BASIC                      
                               
* COS                          
* THE VALUE OF COS(X) IS DETERMINED BY THE TRIG IDENTITY COS(X)=SIN((PI/2)+X)                      
COS       LDX  #L83AB         POINT X TO FP CONSTANT (P1/2) 
          JSR  LB9C2          ADD FPA0 TO (X) 
L837E     JMP  SIN            JUMP TO SIN ROUTINE 
                               
* TAN                          
* THE VALUE OF TAN(X) IS DETERMINED BY THE TRIG IDENTITY TAN(X)=SIN(X)/COS(X)                      
TAN       JSR  LBC2F          PACK FPA0 AND MOVE IT TO FPA3 
          CLR  RELFLG         RESET QUADRANT FLAG 
          BSR  L837E          CALCULATE SIN OF ARGUMENT 
          LDX  #V4A           POINT X TO FPA5 
          JSR  LBC35          PACK FPA0 AND MOVE IT TO FPA5 
          LDX  #V40           POINT X TO FPA3 
          JSR  LBC14          MOVE FPA3 TO FPA0 
          CLR  FP0SGN         FORCE FPA0 MANTISSA TO BE POSITIVE 
          LDA  RELFLG         GET THE QUADRANT FLAG - COS NEGATIVE IN QUADS 2,3 
          BSR  L83A6          CALCULATE VALUE OF COS(FPA0) 
          TST  FP0EXP         CHECK EXPONENT OF FPA0 
          LBEQ LBA92          ‘OV’ ERROR IF COS(X)=0 
          LDX  #V4A           POINT X TO FPA5 
L83A3     JMP  LBB8F          DIVIDE (X) BY FPA0 - SIN(X)/COS(X) 
L83A6     PSHS A              SAVE SIGN FLAG ON STACK 
          JMP  LBFA6          EXPAND POLYNOMIAL 
                               
L83AB     FCB  $81,$49,$0F,$DA,$A2 1.57079633 (PI/2) 
                               
* ATN                          
* A 12 TERM TAYLOR SERIES IS USED TO EVALUATE THE                      
* ARCTAN EXPRESSION. TWO  DIFFERENT FORMULI ARE USED  
* TO EVALUATE THE EXPRESSION DEPENDING UPON                      
* WHETHER OR NOT THE ARGUMENT SQUARED IS > OR < 1.0                      
                               
* IF X**2<1 THEN ATN=X-(X**3)/3+(X**5)/5-(X**7)/7. . .                      
* IF X**2>=1 THEN ATN=PI/2-(1/X-1/((X**3)*3)+(1/((X**5)*5)-. . .)                      
                               
ATN       LDA  FP0SGN         * GET THE SIGN OF THE MANTISSA AND 
          PSHS A              * SAVE IT ON THE STACK 
          BPL  L83B8          BRANCH IF POSITIVE MANTISSA 
          BSR  L83DC          CHANGE SIGN OF FPA0 
L83B8     LDA  FP0EXP         * GET EXPONENT OF FPA0 AND 
          PSHS A              * SAVE IT ON THE STACK 
          CMPA #$81           IS FPAO < 1.0? 
          BLO  L83C5          YES 
          LDX  #LBAC5         POINT X TO FP CONSTANT 1.0 
          BSR  L83A3          GET RECIPROCAL OF FPA0 
L83C5     LDX  #L83E0         POINT (X) TO TAYLOR SERIES COEFFICIENTS 
          JSR  LBEF0          EXPAND POLYNOMIAL 
          PULS A              GET EXPONENT OF ARGUMENT 
          CMPA #$81           WAS ARGUMENT < 1.0? 
          BLO  L83D7          YES 
          LDX  #L83AB         POINT (X) TO FP NUMBER (PI/2) 
          JSR  LB9B9          SUBTRACT FPA0 FROM (PI/2) 
L83D7     PULS A              * GET SIGN OF INITIAL ARGUMENT MANTISSA 
          TSTA                * AND SET FLAGS ACCORDING TO IT 
          BPL  L83DF          RETURN IF ARGUMENT WAS POSITIVE 
L83DC     JMP  LBEE9          CHANGE MANTISSA SIGN OF FPA0 
L83DF     RTS                  
*                              
* TCHEBYSHEV MODIFIED TAYLOR SERIES COEFFICIENTS FOR ARCTANGENT                      
L83E0     FCB  $0B            TWELVE COEFFICIENTS 
L83E1     FCB  $76,$B3,$83,$BD,$D3 -6.84793912E-04 1/23 
L83E6     FCB  $79,$1E,$F4,$A6,$F5 +4.85094216E-03 1/21 
L83EB     FCB  $7B,$83,$FC,$B0,$10 -0.0161117018 
L83F0     FCB  $7C,$0C,$1F,$67,$CA 0.0342096381 
L83F5     FCB  $7C,$DE,$53,$CB,$C1 -0.0542791328 
L83FA     FCB  $7D,$14,$64,$70,$4C 0.0724571965 
L83FF     FCB  $7D,$B7,$EA,$51,$7A -0.0898023954 
L8404     FCB  $7D,$63,$30,$88,$7E 0.110932413 
L8409     FCB  $7E,$92,$44,$99,$3A -0.142839808 
L840E     FCB  $7E,$4C,$CC,$91,$C7 0.199999121 
L8413     FCB  $7F,$AA,$AA,$AA,$13 -0.333333316 
L8418     FCB  $81,$00,$00,$00,$00 1 
*                              
*** TCHEBYSHEV MODIFIED TAYLOR SERIES COEFFICIENTS FOR LN(X)                      
*                              
L841D     FCB  3              FOUR COEFFICIENTS 
L841E     FCB  $7F,$5E,$56,$CB,$79 0.434255942 
L8423     FCB  $80,$13,$9B,$0B,$64 0.576584541 
L8428     FCB  $80,$76,$38,$93,$16 0.961800759 
L842D     FCB  $82,$38,$AA,$3B,$20 2.88539007 
                               
L8432     FCB  $80,$35,$04,$F3,$34 1/SQR(2) 
                               
L8437     FCB  $81,$35,$04,$F3,$34 SQR(2) 
                               
L843C     FCB  $80,$80,$00,$00,$00 -0.5 
                               
L8441     FCB  $80,$31,$72,$17,$F8 LN(2) 
*                              
* LOG - NATURAL LOGARITHM (LN)                      
                               
* THE NATURAL OR NAPERIAN LOGARITHM IS CALCULATED USING                      
* MATHEMATICAL IDENTITIES. FPA0 IS OF THE FORM FPA0=A*(2**B) (SCIENTIFIC                      
* NOTATION). THEREFORE, THE LOG ROUTINE DETERMINES THE VALUE OF                      
* LN(A*(2**B)). A SERIES OF MATHEMATICAL IDENTITIES WILL EXPAND THIS                      
* TERM: LN(A*(2**B))=(-1/2+(1/LN(2))*(LN(A*SQR(2)))+B)*LN(2). ALL OF                      
* THE TERMS OF THE LATTER EXPRESSION ARE CONSTANTS EXCEPT FOR THE                      
* LN(A*SQR(2)) TERM WHICH IS EVALUATED USING THE TAYLOR SERIES EXPANSION                      
LOG       JSR  LBC6D          CHECK STATUS OF FPA0 
          LBLE LB44A          ‘FC’ ERROR IF NEGATIVE OR ZERO 
          LDX  #L8432         POINT (X) TO FP NUMBER (1/SQR(2)) 
          LDA  FP0EXP         *GET EXPONENT OF ARGUMENT 
          SUBA #$80           *SUBTRACT OFF THE BIAS AND 
          PSHS A              *SAVE IT ON THE STACK 
          LDA  #$80            
          STA  FP0EXP          
          JSR  LB9C2          ADD FPA0 TO (X) 
          LDX  #L8437         POINT X TO SQR(2) 
          JSR  LBB8F          DIVIDE SQR(2) BY FPA0 
          LDX  #LBAC5         POINT X TO FP VALUE OF 1.00 
          JSR  LB9B9          SUBTRACT FPA0 FROM (X) 
*         NOW  FPA0 = (1-SQR(2)*X)/(1+SQR(2)*X) WHERE X IS ARGUMENT  
          LDX  #L841D         POINT X TO TABLE OF COEFFICIENTS 
          JSR  LBEF0          EXPAND POLYNOMIAL 
          LDX  #L843C         POINT X TO FP VALUE OF (-.5) 
          JSR  LB9C2          ADD FPA0 TO X 
          PULS B              GET EXPONENT OF ARGUMENT BACK (WITHOUT BIAS) 
          JSR  LBD99          ADD ACCB TO FPA0 
          LDX  #L8441         POINT X TO LN(2) 
          JMP  LBACA          MULTIPLY FPA0 * LN(2) 
                               
* SQR                          
SQR       JSR  LBC5F          MOVE FPA0 TO FPA1 
          LDX  #LBEC0         POINT (X) TO FP NUMBER (.5) 
          JSR  LBC14          COPY A PACKED NUMBER FROM (X) TO FPA0 
                               
* ARITHMETIC OPERATOR FOR EXPONENTIATION JUMPS                      
* HERE. THE FORMULA USED TO EVALUATE EXPONENTIATION                      
* IS A**X=E**(X LN A) = E**(FPA0*LN(FPA1)), E=2.7182818                      
L8489     BEQ  EXP            DO A NATURAL EXPONENTIATION IF EXPONENT = 0 
          TSTA                *CHECK VALUE BEING EXPONENTIATED 
          BNE  L8491          *AND BRANCH IF IT IS <> 0 
          JMP  LBA3A          FPA0=0 IF RAISING ZERO TO A POWER 
L8491     LDX  #V4A           * PACK FPA0 AND SAVE 
          JSR  LBC35          * IT IN FPA5 (ARGUMENT’S EXPONENT) 
          CLRB                ACCB=DEFAULT RESULT SIGN FLAG; 0=POSITIVE 
          LDA  FP1SGN         *CHECK THE SIGN OF ARGUMENT 
          BPL  L84AC          *BRANCH IF POSITIVE 
          JSR  INT            CONVERT EXPONENT INTO AN INTEGER 
          LDX  #V4A           POINT X TO FPA5 (ORIGINAL EXPONENT) 
          LDA  FP1SGN         GET MANTISSA SIGN OF FPA1 (ARGUMENT) 
          JSR  LBCA0          *COMPARE FPA0 TO (X) AND 
          BNE  L84AC          *BRANCH IF NOT EQUAL 
          COMA                TOGGLE FPA1 MANTISSA SIGN - FORCE POSITIVE 
          LDB  CHARAC         GET LS BYTE OF INTEGER VALUE OF EXPONENT (RESULT SIGN FLAG) 
L84AC     JSR  LBC4C          COPY FPA1 TO FPA0; ACCA = MANTISSA SIGN 
          PSHS B              PUT RESULT SIGN FLAG ON THE STACK 
          JSR  LOG             
          LDX  #V4A           POINT (X) TO FPA5 
          JSR  LBACA          MULTIPLY FPA0 BY FPA5 
          BSR  EXP            CALCULATE E**(FPA0) 
          PULS A              * GET RESULT SIGN FLAG FROM THE STACK 
          RORA * AND BRANCH IF NEGATIVE  
          LBCS LBEE9          CHANGE SIGN OF FPA0 MANTISSA 
          RTS                  
                               
* CORRECTION FACTOR FOR EXPONENTIAL FUNCTION                      
L84C4     FCB  $81,$38,$AA,$3B,$29 1.44269504 ( CF ) 
*                              
* TCHEBYSHEV MODIFIED TAYLOR SERIES COEFFICIENTS FOR E**X                      
*                              
L84C9     FCB  7              EIGHT COEFFICIENTS 
L84CA     FCB  $71,$34,$58,$3E,$56 2.14987637E-05: 1/(7!*(CF**7)) 
L84CF     FCB  $74,$16,$7E,$B3,$1B 1.4352314E-04 : 1/(6!*(CF**6)) 
L84D4     FCB  $77,$2F,$EE,$E3,$85 1.34226348E-03: 1/(5!*(CF**5)) 
L84D9     FCB  $7A,$1D,$84,$1C,$2A 9.61401701E-03: 1/(4!*(CF**4)) 
L84DE     FCB  $7C,$63,$59,$58,$0A 0.0555051269 
L84E3     FCB  $7E,$75,$FD,$E7,$C6 0.240226385 
L84E8     FCB  $80,$31,$72,$18,$10 0.693147186 
L84ED     FCB  $81,$00,$00,$00,$00 1 
*                              
* EXP ( E**X)                      
* THE EXPONENTIAL FUNCTION IS EVALUATED BY FIRST MULTIPLYING THE                      
* ARGUMENT BY A CORRECTION FACTOR (CF). AFTER THIS IS DONE, AN                      
* ARGUMENT >= 127 WILL YIELD A ZERO RESULT (NO UNDERFLOW) FOR A                      
* NEGATIVE ARGUMENT OR AN 'OV' (OVERFLOW) ERROR FOR A POSITIVE                      
* ARGUMENT. THE POLYNOMIAL COEFFICIENTS ARE MODIFIED TO REFLECT                      
* THE CF MULTIPLICATION AT THE START OF THE EVALUATION PROCESS.                      
                               
EXP       LDX  #L84C4         POINT X TO THE CORRECTION FACTOR 
          JSR  LBACA          MULTIPLY FPA0 BY (X) 
          JSR  LBC2F          PACK FPA0 AND STORE IT IN FPA3 
          LDA  FP0EXP         *GET EXPONENT OF FPA0 AND 
          CMPA #$88           *COMPARE TO THE MAXIMUM VALUE 
          BLO  L8504          BRANCH IF FPA0 < 128 
L8501     JMP  LBB5C          SET FPA0 = 0 OR ‘OV’ ERROR 
L8504     JSR  INT            CONVERT FPA0 TO INTEGER 
          LDA  CHARAC         GET LS BYTE OF INTEGER 
          ADDA #$81           * WAS THE ARGUMENT =127, IF SO 
          BEQ  L8501          * THEN ‘OV’ ERROR; THIS WILL ALSO ADD THE $80 BIAS 
*              * REQUIRED WHEN THE NEW EXPONENT IS CALCULATED BELOW  
          DECA                DECREMENT ONE FROM THE EXPONENT, BECAUSE $81, NOT $80 WAS USED ABOVE 
          PSHS A              SAVE EXPONENT OF INTEGER PORTION ON STACK 
          LDX  #V40           POINT (X) TO FPA3 
          JSR  LB9B9          SUBTRACT FPA0 FROM (X) - GET FRACTIONAL PART OF ARGUMENT 
          LDX  #L84C9         POINT X TO COEFFICIENTS 
          JSR  LBEFF          EVALUATE POLYNOMIAL FOR FRACTIONAL PART 
          CLR  RESSGN         FORCE THE MANTISSA TO BE POSITIVE 
          PULS A              GET INTEGER EXPONENT FROM STACK 
          JSR  LBB48          * CALCULATE EXPONENT OF NEW FPA0 BY ADDING THE EXPONENTS OF THE 
*              * INTEGER AND FRACTIONAL PARTS  
          RTS                  
                               
* FIX                          
FIX       JSR  LBC6D          CHECK STATUS OF FPA0 
          BMI  L852C          BRANCH IF FPA0 = NEGATIVE 
L8529     JMP  INT            CONVERT FPA0 TO INTEGER 
L852C     COM  FP0SGN         TOGGLE SIGN OF FPA0 MANTISSA 
          BSR  L8529          CONVERT FPA0 TO INTEGER 
          JMP  LBEE9          TOGGLE SIGN OF FPA0 
                               
* EDIT                         
EDIT      JSR  L89AE          GET LINE NUMBER FROM BASIC 
          LEAS $02,S PURGE RETURN ADDRESS OFF OF THE STACK  
L8538     LDA  #$01           ‘LIST’ FLAG 
          STA  VD8            SET FLAG TO LIST LINE 
          JSR  LAD01          GO FIND THE LINE NUMBER IN PROGRAM 
          LBCS LAED2 ERROR #7 ‘UNDEFINED LINE #'  
          JSR  LB7C2          GO UNCRUNCH LINE INTO BUFFER AT LINBUF+1 
          TFR  Y,D            PUT ABSOLUTE ADDRESS OF END OF LINE TO ACCD 
          SUBD #LINBUF+2 SUBTRACT OUT THE START OF LINE  
          STB  VD7            SAVE LENGTH OF LINE 
L854D     LDD  BINVAL         GET THE HEX VALUE OF LINE NUMBER 
          JSR  LBDCC          LIST THE LINE NUMBER ON THE SCREEN 
          JSR  LB9AC          PRINT A SPACE 
          LDX  #LINBUF+1      POINT X TO BUFFER 
          LDB  VD8            * CHECK TO SEE IF LINE IS TO BE 
          BNE  L8581          * LISTED TO SCREEN - BRANCH IF IT IS 
L855C     CLRB                RESET DIGIT ACCUMULATOR - DEFAULT VALUE 
L855D     JSR  L8687          GET KEY STROKE 
          JSR  L90AA          SET CARRY IF NOT NUMERIC 
          BLO  L8570          BRANCH IF NOT NUMERIC 
          SUBA #'0' MASK OFF ASCII  
          PSHS A SAVE IT ON STACK  
          LDA  #10            NUMBER BEING CONVERTED IS BASE 10 
          MUL  MULTIPLY ACCUMULATED VALUE BY BASE (10)  
          ADDB ,S+ ADD DIGIT TO ACCUMULATED VALUE  
          BRA  L855D          CHECK FOR ANOTHER DIGIT 
L8570     SUBB #$01 * REPEAT PARAMETER IN ACCB; IF IT  
          ADCB #$01 *IS 0, THEN MAKE IT ‘1’  
          CMPA #'A' ABORT?          
          BNE  L857D          NO 
          JSR  LB958          PRINT CARRIAGE RETURN TO SCREEN 
          BRA  L8538          RESTART EDIT PROCESS - CANCEL ALL CHANGES 
L857D     CMPA #'L' LIST?           
          BNE  L858C          NO 
L8581     BSR  L85B4          LIST THE LINE 
          CLR  VD8            RESET THE LIST FLAG TO ‘NO LIST’ 
          JSR  LB958          PRINT CARRIAGE RETURN 
          BRA  L854D          GO INTERPRET ANOTHER EDIT COMMAND 
L858A     LEAS $02,S PURGE RETURN ADDRESS OFF OF THE STACK  
L858C     CMPA #CR ENTER KEY?      
          BNE  L859D          NO 
          BSR  L85B4          ECHO THE LINE TO THE SCREEN 
L8592     JSR  LB958          PRINT CARRIAGE RETURN 
          LDX  #LINBUF+1      * RESET BASIC’S INPUT POINTER 
          STX  CHARAD         * TO THE LINE INPUT BUFFER 
          JMP  LACA8          GO PUT LINE BACK IN PROGRAM 
L859D     CMPA #'E' EXIT?           
          BEQ  L8592          YES - SAME AS ENTER EXCEPT NO ECHO 
          CMPA #'Q' QUIT?           
          BNE  L85AB          NO 
          JSR  LB958          PRINT CARRIAGE RETURN TO SCREEN 
          JMP  LAC73          GO TO COMMAND LEVEL - MAKE NO CHANGES 
L85AB     BSR  L85AF          INTERPRET THE REMAINING COMMANDS AS SUBROUTINES 
          BRA  L855C          GO INTERPRET ANOTHER EDIT COMMAND 
L85AF     CMPA #SPACE SPACE BAR?      
          BNE  L85C3          NO 
L85B3     FCB  SKP2           SKIP TWO BYTES 
* DISPLAY THE NEXT ACCB BYTES OF THE LINE IN THE BUFFER TO THE SCREEN                      
*                              
L85B4     LDB  #LBUFMX-1      250 BYTES MAX IN BUFFER 
L85B6     LDA  ,X             GET A CHARACTER FROM BUFFER 
          BEQ  L85C2          EXIT IF IT’S A 0 
          JSR  PUTCHR         SEND CHAR TO CONSOLE OUT 
          LEAX $01,X MOVE POINTER UP ONE  
          DECB DECREMENT CHARACTER COUNTER  
          BNE  L85B6          LOOP IF NOT DONE 
L85C2     RTS                  
L85C3     CMPA #'D' DELETE?         
          BNE  L860F          NO 
L85C7     TST  ,X             * CHECK FOR END OF LINE 
          BEQ  L85C2          * AND BRANCH IF SO 
          BSR  L85D1          REMOVE A CHARACTER 
          DECB DECREMENT REPEAT PARAMETER  
          BNE  L85C7          BRANCH IF NOT DONE 
          RTS                  
* REMOVE ONE CHARACTER FROM BUFFER                      
L85D1     DEC  VD7            DECREMENT LENGTH OF BUFFER 
          LEAY $-01,X POINT Y TO ONE BEFORE CURRENT BUFFER POINTER  
L85D5     LEAY $01,Y INCREMENT TEMPORARY BUFFER POINTER  
          LDA  $01,Y          GET NEXT CHARACTER 
          STA  ,Y             PUT IT IN CURRENT POSITION 
          BNE  L85D5          BRANCH IF NOT END OF LINE 
          RTS                  
L85DE     CMPA #'I' INSERT?         
          BEQ  L85F5          YES 
          CMPA #'X' EXTEND?         
          BEQ  L85F3          YES 
          CMPA #'H' HACK?           
          BNE  L8646          NO 
          CLR  ,X             TURN CURRENT BUFFER POINTER INTO END OF LINE FLAG 
          TFR  X,D            PUT CURRENT BUFFER POINTER IN ACCD 
          SUBD #LINBUF+2 SUBTRACT INITIAL POINTER POSITION  
          STB  VD7            SAVE NEW BUFFER LENGTH 
L85F3     BSR  L85B4          DISPLAY THE LINE ON THE SCREEN 
L85F5     JSR  L8687          GET A KEYSTROKE 
          CMPA #CR ENTER KEY?      
          BEQ  L858A          YES - INTERPRET ANOTHER COMMAND - PRINT LINE 
          CMPA #ESC ESCAPE?         
          BEQ  L8625          YES - RETURN TO COMMAND LEVEL - DON’T PRINT LINE 
          CMPA #BS BACK SPACE?     
          BNE  L8626          NO 
          CMPX #LINBUF+1 COMPARE POINTER TO START OF BUFFER  
          BEQ  L85F5          DO NOT ALLOW BS IF AT START 
          BSR  L8650          MOVE POINTER BACK ONE, BS TO SCREEN 
          BSR  L85D1          REMOVE ONE CHARACTER FROM BUFFER 
          BRA  L85F5          GET INSERT SUB COMMAND 
L860F     CMPA #'C' CHANGE?         
          BNE  L85DE          NO 
L8613     TST  ,X             CHECK CURRENT BUFFER CHARACTER 
          BEQ  L8625          BRANCH IF END OF LINE 
          JSR  L8687          GET A KEYSTROKE 
          BLO  L861E          BRANCH IF LEGITIMATE KEY 
          BRA  L8613          TRY AGAIN IF ILLEGAL KEY 
L861E     STA  ,X+            INSERT NEW CHARACTER INTO BUFFER 
          BSR  L8659          SEND NEW CHARACTER TO SCREEN 
          DECB DECREMENT REPEAT PARAMETER  
          BNE  L8613          BRANCH IF NOT DONE 
L8625     RTS                  
L8626     LDB  VD7            GET LENGTH OF LINE 
          CMPB #LBUFMX-1 COMPARE TO MAXIMUM LENGTH  
          BNE  L862E          BRANCH IF NOT AT MAXIMUM 
          BRA  L85F5          IGNORE INPUT IF LINE AT MAXIMUM LENGTH 
L862E     PSHS X SAVE CURRENT BUFFER POINTER  
L8630     TST  ,X+            * SCAN THE LINE UNTIL END OF 
          BNE  L8630          * LINE (0) IS FOUND 
L8634     LDB  ,-X            DECR TEMP LINE POINTER AND GET A CHARACTER 
          STB  $01,X          PUT CHARACTER BACK DOWN ONE SPOT 
          CMPX ,S HAVE WE REACHED STARTING POINT?  
          BNE  L8634          NO - KEEP GOING 
          LEAS $02,S PURGE BUFFER POINTER FROM STACK  
          STA  ,X+            INSERT NEW CHARACTER INTO THE LINE 
          BSR  L8659          SEND A CHARACTER TO CONSOLE OUT 
          INC  VD7            ADD ONE TO BUFFER LENGTH 
          BRA  L85F5          GET INSERT SUB COMMAND 
L8646     CMPA #BS BACKSPACE?      
          BNE  L865C          NO 
L864A     BSR  L8650          MOVE POINTER BACK 1, SEND BS TO SCREEN 
          DECB DECREMENT REPEAT PARAMETER  
          BNE  L864A          LOOP UNTIL DONE 
          RTS                  
L8650     CMPX #LINBUF+1 COMPARE POINTER TO START OF BUFFER  
          BEQ  L8625          DO NOT ALLOW BS IF AT START 
          LEAX $-01,X MOVE POINTER BACK ONE  
          LDA  #BS            BACK SPACE 
L8659     JMP  PUTCHR         SEND TO CONSOLE OUT 
L865C     CMPA #'K' KILL?           
          BEQ  L8665          YES 
          SUBA #'S' SEARCH?         
          BEQ  L8665          YES 
          RTS                  
L8665     PSHS A SAVE KILL/SEARCH FLAG ON STACK  
          BSR  L8687          * GET A KEYSTROKE (TARGET CHARACTER) 
          PSHS A * AND SAVE IT ON STACK  
L866B     LDA  ,X             GET CURRENT BUFFER CHARACTER 
          BEQ  L8685          AND RETURN IF END OF LINE 
          TST  $01,S          CHECK KILL/SEARCH FLAG 
          BNE  L8679          BRANCH IF KILL 
          BSR  L8659          SEND A CHARACTER TO CONSOLE OUT 
          LEAX $01,X INCREMENT BUFFER POINTER  
          BRA  L867C          CHECK NEXT INPUT CHARACTER 
L8679     JSR  L85D1          REMOVE ONE CHARACTER FROM BUFFER 
L867C     LDA  ,X             GET CURRENT INPUT CHARACTER 
          CMPA ,S COMPARE TO TARGET CHARACTER  
          BNE  L866B          BRANCH IF NO MATCH 
          DECB DECREMENT REPEAT PARAMETER  
          BNE  L866B          BRANCH IF NOT DONE 
L8685     PULS Y,PC THE Y PULL WILL CLEAN UP THE STACK FOR THE 2 PSHS A  
*                              
* GET A KEYSTRKE                      
L8687     JSR  LA171          CALL CONSOLE IN : DEV NBR=SCREEN 
          CMPA #$7F GRAPHIC CHARACTER?  
          BCC  L8687          YES - GET ANOTHER CHAR 
          CMPA #$5F SHIFT UP ARROW (QUIT INSERT)  
          BNE  L8694          NO 
          LDA  #ESC           REPLACE W/ESCAPE CODE 
L8694     CMPA #CR ENTER KEY       
          BEQ  L86A6          YES 
          CMPA #ESC ESCAPE?         
          BEQ  L86A6          YES 
          CMPA #BS BACKSPACE?      
          BEQ  L86A6          YES 
          CMPA #SPACE SPACE           
          BLO  L8687          GET ANOTHER CHAR IF CONTROL CHAR 
          ORCC #$01 SET CARRY       
L86A6     RTS                  
                               
* TRON                         
TRON      FCB  SKP1LD         SKIP ONE BYTE AND LDA #$4F 
                               
* TROFF                        
TROFF     CLRA                TROFF FLAG 
          STA  TRCFLG         TRON/TROFF FLAG:0=TROFF, <> 0=TRON 
          RTS                  
                               
* POS                          
                               
POS       LDA  #0             GET DEVICE NUMBER 
          LDB  LPTPOS         GET PRINT POSITION 
LA5E8     SEX                 CONVERT ACCB TO 2 DIGIT SIGNED INTEGER 
          JMP  GIVABF         CONVERT ACCD TO FLOATING POINT 
                               
                               
* VARPTR                       
VARPT     JSR  LB26A          SYNTAX CHECK FOR ‘(‘ 
          LDD  ARYEND         GET ADDR OF END OF ARRAYS 
          PSHS B,A            SAVE IT ON STACK 
          JSR  LB357          GET VARIABLE DESCRIPTOR 
          JSR  LB267          SYNTAX CHECK FOR ‘)‘ 
          PULS A,B            GET END OF ARRAYS ADDR BACK 
          EXG  X,D            SWAP END OF ARRAYS AND VARIABLE DESCRIPTOR 
          CMPX ARYEND         COMPARE TO NEW END OF ARRAYS 
          BNE  L8724          ‘FC’ ERROR IF VARIABLE WAS NOT DEFINED PRIOR TO CALLING VARPTR 
          JMP  GIVABF         CONVERT VARIABLE DESCRIPTOR INTO A FP NUMBER 
                               
* MID$(OLDSTRING,POSITION,LENGTH)=REPLACEMENT                      
L86D6     JSR  GETNCH         GET INPUT CHAR FROM BASIC 
          JSR  LB26A          SYNTAX CHECK FOR ‘(‘ 
          JSR  LB357          * GET VARIABLE DESCRIPTOR ADDRESS AND 
          PSHS X              * SAVE IT ON THE STACK 
          LDD  $02,X          POINT ACCD TO START OF OLDSTRING 
          CMPD FRETOP         COMPARE TO START OF CLEARED SPACE 
          BLS  L86EB          BRANCH IF <= 
          SUBD MEMSIZ         SUBTRACT OUT TOP OF CLEARED SPACE 
          BLS  L86FD          BRANCH IF STRING IN STRING SPACE 
L86EB     LDB  ,X             GET LENGTH OF OLDSTRING 
          JSR  LB56D          RESERVE ACCB BYTES IN STRING SPACE 
          PSHS X              SAVE RESERVED SPACE STRING ADDRESS ON STACK 
          LDX  $02,S          POINT X TO OLDSTRING DESCRIPTOR 
          JSR  LB643          MOVE OLDSTRING INTO STRING SPACE 
          PULS X,U            * GET OLDSTRING DESCRIPTOR ADDRESS AND RESERVED STRING 
          STX  $02,U          * ADDRESS AND SAVE RESERVED ADDRESS AS OLDSTRING ADDRESS 
          PSHS U              SAVE OLDSTRING DESCRIPTOR ADDRESS 
L86FD     JSR  LB738          SYNTAX CHECK FOR COMMA AND EVALUATE LENGTH EXPRESSION 
          PSHS B              SAVE POSITION PARAMETER ON STACK 
          TSTB * CHECK POSITION PARAMETER AND BRANCH  
          BEQ  L8724          * IF START OF STRING 
          LDB  #$FF           DEFAULT REPLACEMENT LENGTH = $FF 
          CMPA #')'           * CHECK FOR END OF MID$ STATEMENT AND 
          BEQ  L870E          * BRANCH IF AT END OF STATEMENT 
          JSR  LB738          SYNTAX CHECK FOR COMMA AND EVALUATE LENGTH EXPRESSION 
L870E     PSHS B              SAVE LENGTH PARAMETER ON STACK 
          JSR  LB267          SYNTAX CHECK FOR ‘)‘ 
          LDB  #TOK_EQUALS    TOKEN FOR = 
          JSR  LB26F          SYNTAX CHECK FOR “=‘ 
          BSR  L8748          EVALUATE REPLACEMENT STRING 
          TFR  X,U            SAVE REPLACEMENT STRING ADDRESS IN U 
          LDX  $02,S          POINT X TO OLOSTRING DESCRIPTOR ADDRESS 
          LDA  ,X             GET LENGTH OF OLDSTRING 
          SUBA $01,S          SUBTRACT POSITION PARAMETER 
          BCC  L8727          INSERT REPLACEMENT STRING INTO OLDSTRING 
L8724     JMP  LB44A          ‘FC’ ERROR IF POSITION > LENGTH OF OLDSTRING 
L8727     INCA                * NOW ACCA = NUMBER OF CHARACTERS TO THE RIGHT 
*                             * (INCLUSIVE) OF THE POSITION PARAMETER 
          CMPA ,S              
          BCC  L872E          BRANCH IF NEW STRING WILL FIT IN OLDSTRING 
          STA  ,S             IF NOT, USE AS MUCH OF LENGTH PARAMETER AS WILL FIT 
L872E     LDA  $01,S          GET POSITION PARAMETER 
          EXG  A,B            ACCA=LENGTH OF REPL STRING, ACCB=POSITION PARAMETER 
          LDX  $02,X          POINT X TO OLDSTRING ADDRESS 
          DECB                * BASIC’S POSITION PARAMETER STARTS AT 1; THIS ROUTINE 
*                             * WANTS IT TO START AT ZERO 
          ABX                 POINT X TO POSITION IN OLDSTRING WHERE THE REPLACEMENT WILL GO 
          TSTA                * IF THE LENGTH OF THE REPLACEMENT STRING IS ZERO 
          BEQ  L8746          * THEN RETURN 
          CMPA ,S              
          BLS  L873F          ADJUSTED LENGTH PARAMETER, THEN BRANCH 
          LDA  ,S             OTHERWISE USE AS MUCH ROOM AS IS AVAILABLE 
L873F     TFR  A,B            SAVE NUMBER OF BYTES TO MOVE IN ACCB 
          EXG  U,X            SWAP SOURCE AND DESTINATION POINTERS 
          JSR  LA59A          MOVE (B) BYTES FROM (X) TO (U) 
L8746     PULS A,B,X,PC        
L8748     JSR  LB156          EVALUATE EXPRESSION 
          JMP  LB654          *‘TM’ ERROR IF NUMERIC; RETURN WITH X POINTING 
*                             *TO STRING, ACCB = LENGTH 
                               
* STRING                       
STRING    JSR  LB26A          SYNTAX CHECK FOR ‘(’ 
          JSR  LB70B          EVALUATE EXPRESSION; ERROR IF > 255 
          PSHS B              SAVE LENGTH OF STRING 
          JSR  LB26D          SYNTAX CHECK FOR COMMA 
          JSR  LB156          EVALUATE EXPRESSION 
          JSR  LB267          SYNTAX CHECK FOR ‘)‘ 
          LDA  VALTYP         GET VARIABLE TYPE 
          BNE  L8768          BRANCH IF STRING 
          JSR  LB70E          CONVERT FPA0 INTO AN INTEGER IN ACCB 
          BRA  L876B          SAVE THE STRING IN STRING SPACE 
L8768     JSR  LB6A4          GET FIRST BYTE OF STRING 
L876B     PSHS B              SAVE FIRST BYTE OF EXPRESSION 
          LDB  $01,S          GET LENGTH OF STRING 
          JSR  LB50F          RESERVE ACCB BYTES IN STRING SPACE 
          PULS A,B            GET LENGTH OF STRING AND CHARACTER 
          BEQ  L877B          BRANCH IF NULL STRING 
L8776     STA  ,X+            SAVE A CHARACTER IN STRING SPACE 
          DECB                DECREMENT LENGTH 
          BNE  L8776          BRANCH IF NOT DONE 
L877B     JMP  LB69B          PUT STRING DESCRIPTOR ONTO STRING STACK 
                               
* INSTR                        
INSTR     JSR  LB26A          SYNTAX CHECK FOR ‘(‘ 
          JSR  LB156          EVALUATE EXPRESSION 
          LDB  #$01           DEFAULT POSITION = 1 (SEARCH START) 
          PSHS B              SAVE START 
          LDA  VALTYP         GET VARIABLE TYPE 
          BNE  L879C          BRANCH IF STRING 
          JSR  LB70E          CONVERT FPA0 TO INTEGER IN ACCB 
          STB  ,S             SAVE START SEARCH VALUE 
          BEQ  L8724          BRANCH IF START SEARCH AT ZERO 
          JSR  LB26D          SYNTAX CHECK FOR COMMA 
          JSR  LB156          EVALUATE EXPRESSION - SEARCH STRING 
          JSR  LB146          ‘TM’ ERROR IF NUMERIC 
L879C     LDX  FPA0+2         SEARCH STRING DESCRIPTOR ADDRESS 
          PSHS X              SAVE ON THE STACK 
          JSR  LB26D          SYNTAX CHECK FOR COMMA 
          JSR  L8748          EVALUATE TARGET STRING EXPRESSION 
          PSHS X,B            SAVE ADDRESS AND LENGTH ON STACK 
          JSR  LB267          SYNTAX CHECK FOR ')' 
          LDX  $03,S          * LOAD X WITH SEARCH STRING DESCRIPTOR ADDRESS 
          JSR  LB659          * AND GET THE LENGTH ANDADDRESS OF SEARCH STRING 
          PSHS B              SAVE LENGTH ON STACK 
*                              
* AT THIS POINT THE STACK HAS THE FOLLOWING INFORMATION                      
* ON IT: 0,S-SEARCH LENGTH; 1,S-TARGET LENGTH; 2 3,S-TARGET                      
* ADDRESS; 4 5,S-SEARCH DESCRIPTOR ADDRESS; 6,S-SEARCH POSITION                      
          CMPB $06,S          COMPARE LENGTH OF SEARCH STRING TO START 
          BLO  L87D9          POSITION; RETURN 0 IF LENGTH < START 
          LDA  $01,S          GET LENGTH OF TARGET STRING 
          BEQ  L87D6          BRANCH IF TARGET STRING = NULL 
          LDB  $06,S          GET START POSITION 
          DECB                MOVE BACK ONE 
          ABX  POINT X TO POSITION IN SEARCH STRING WHERE SEARCHING WILL START  
L87BE     LEAY ,X             POINT Y TO SEARCH POSITION 
          LDU  $02,S          POINT U TO START OF TARGET 
          LDB  $01,S          LOAD ACCB WITH LENGTH OF TARGET 
          LDA  ,S             LOAD ACCA WITH LENGTH OF SEARCH 
          SUBA $06,S          SUBTRACT SEARCH POSITION FROM SEARCH LENGTH 
          INCA                ADD ONE 
          CMPA $01,S          COMPARE TO TARGET LENGTH 
          BLO  L87D9          RETURN 0 IF TARGET LENGTH > WHAT’S LEFT OF SEARCH STRING 
L87CD     LDA  ,X+            GET A CHARACTER FROM SEARCH STRING 
          CMPA ,U+            COMPARE IT TO TARGET STRING 
          BNE  L87DF          BRANCH IF NO MATCH 
          DECB                DECREMENT TARGET LENGTH 
          BNE  L87CD          CHECK ANOTHER CHARACTER 
L87D6     LDB  $06,S          GET MATCH POSITION 
L87D8     FCB  SKP1           SKIP NEXT BYTE 
L87D9     CLRB                MATCH ADDRESS = 0 
          LEAS $07,S          CLEAN UP THE STACK 
          JMP  LB4F3          CONVERT ACCB TO FP NUMBER 
L87DF     INC  $06,S          INCREMENT SEARCH POSITION 
          LEAX $01,Y          MOVE X TO NEXT SEARCH POSITION 
          BRA  L87BE          KEEP LOOKING FOR A MATCH 
                               
* EXTENDED BASIC RVEC19 HOOK CODE                      
XVEC19    CMPA #'&'           * 
          BNE  L8845          * RETURN IF NOT HEX OR OCTAL VARIABLE 
          LEAS $02,S          PURGE RETURN ADDRESS FROM STACK 
* PROCESS A VARIABLE PRECEEDED BY A ‘&‘ (&H,&O)                      
L87EB     CLR  FPA0+2         * CLEAR BOTTOM TWO 
          CLR  FPA0+3         * BYTES OF FPA0 
          LDX  #FPA0+2        BYTES 2,3 OF FPA0 = (TEMPORARY ACCUMULATOR) 
          JSR  GETNCH         GET A CHARACTER FROM BASIC 
          CMPA #'O'            
          BEQ  L880A          YES 
          CMPA #'H'            
          BEQ  L881F          YES 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          BRA  L880C          DEFAULT TO OCTAL (&O) 
L8800     CMPA #'8'            
          LBHI LB277           
          LDB  #$03           BASE 8 MULTIPLIER 
          BSR  L8834          ADD DIGIT TO TEMPORARY ACCUMULATOR 
* EVALUATE AN &O VARIABLE                      
L880A     JSR  GETNCH         GET A CHARACTER FROM BASIC 
L880C     BLO  L8800          BRANCH IF NUMERIC 
L880E     CLR  FPA0           * CLEAR 2 HIGH ORDER 
          CLR  FPA0+1         * BYTES OF FPA0 
          CLR  VALTYP         SET VARXABLE TYPE TO NUMERIC 
          CLR  FPSBYT         ZERO OUT SUB BYTE OF FPA0 
          CLR  FP0SGN         ZERO OUT MANTISSA SIGN OF FPA0 
          LDB  #$A0           * SET EXPONENT OF FPA0 
          STB  FP0EXP         * 
          JMP  LBA1C          GO NORMALIZE FPA0 
* EVALUATE AN &H VARIABLE                      
L881F     JSR  GETNCH         GET A CHARACTER FROM BASIC 
          BLO  L882E          BRANCH IF NUMERIC 
          JSR  LB3A2          SET CARRY IF NOT ALPHA 
          BLO  L880E          BRANCH IF NOT ALPHA OR NUMERIC 
          CMPA #'G'           CHECK FOR LETTERS A-F 
          BCC  L880E          BRANCH IF >= G (ILLEGAL HEX LETTER) 
          SUBA #7             SUBTRACT ASCII DIFFERENCE BETWEEN A AND 9 
L882E     LDB  #$04           BASE 16 DIGIT MULTIPLIER = 2**4 
          BSR  L8834          ADD DIGIT TO TEMPORARY ACCUMULATOR 
          BRA  L881F          KEEP EVALUATING VARIABLE 
L8834     ASL  $01,X          * MULTIPLY TEMPORARY 
          ROL  ,X             * ACCUMULATOR BY TWO 
          LBCS LBA92          ‘OV' OVERFLOW ERROR 
          DECB                DECREMENT SHIFT COUNTER 
          BNE  L8834          MULTIPLY TEMPORARY ACCUMULATOR AGAIN 
          SUBA #'0'           MASK OFF ASCII 
          ADDA $01,X          * ADD DIGIT TO TEMPORARY 
          STA  $01,X          * ACCUMULATOR AND SAVE IT 
L8845     RTS                  
                               
XVEC15    PULS U              PULL RETURN ADDRESS AND SAVE IN U REGISTER 
          CLR  VALTYP         SET VARIABLE TYPE TO NUMERIC 
          LDX  CHARAD         CURRENT INPUT POINTER TO X 
          JSR  GETNCH         GET CHARACTER FROM BASIC 
          CMPA #'&'           HEX AND OCTAL VARIABLES ARE PRECEEDED BY & 
          BEQ  L87EB          PROCESS A ‘&‘ VARIABLE 
          CMPA #TOK_FN        TOKEN FOR FN 
          BEQ  L88B4          PROCESS FN CALL 
          CMPA #$FF           CHECK FOR SECONDARY TOKEN 
          BNE  L8862          NOT SECONDARY 
          JSR  GETNCH         GET CHARACTER FROM BASIC 
          CMPA #TOK_USR       TOKEN FOR USR 
          LBEQ L892C          PROCESS USR CALL 
L8862     STX  CHARAD         RESTORE BASIC’S INPUT POINTER 
          JMP  ,U             RETURN TO CALLING ROUTINE 
L8866     LDX  CURLIN         GET CURRENT LINE NUMBER 
          LEAX $01,X          IN DIRECT MODE? 
          BNE  L8845          RETURN IF NOT IN DIRECT MODE 
          LDB  #2*11          ‘ILLEGAL DIRECT STATEMENT’ ERROR 
L886E     JMP  LAC46          PROCESS ERROR 
                               
DEF       LDX  [CHARAD]       GET TWO INPUT CHARS 
          CMPX #TOK_FF_USR    TOKEN FOR USR 
          LBEQ L890F          BRANCH IF DEF USR 
          BSR  L88A1          GET DESCRIPTOR ADDRESS FOR FN VARIABLE NAME 
          BSR  L8866          DON’T ALLOW DEF FN IF IN DIRECT MODE 
          JSR  LB26A          SYNTAX CHECK FOR ‘(‘ 
          LDB  #$80           * GET THE FLAG TO INDICATE ARRAY VARIABLE SEARCH DISABLE 
          STB  ARYDIS         * AND SAVE IT IN THE ARRAY DISABLE FLAG 
          JSR  LB357          GET VARIABLE DESCRIPTOR 
          BSR  L88B1          ‘TM’ ERROR IF STRING 
          JSR  LB267          SYNTAX CHECK FOR ‘)‘ 
          LDB  #TOK_EQUALS    TOKEN FOR ‘=‘ 
          JSR  LB26F          DO A SYNTAX CHECK FOR = 
          LDX  V4B            GET THE ADDRESS OF THE FN NAME DESCRIPTOR 
          LDD  CHARAD         * GET THE CURRENT INPUT POINTER ADDRESS AND 
          STD  ,X             * SAVE IT IN FIRST 2 BYTES OF THE DESCRIPTOR 
          LDD  VARPTR         = GET THE DESCRIPTOR ADDRESS OF THE ARGUMENT 
          STD  $02,X          = VARIABLE AND SAVE IT IN THE DESCRIPTOR OF THE FN NAME 
          JMP  DATA           MOVE INPUT POINTER TO END OF LINE OR SUBLINE 
L88A1     LDB  #TOK_FN        TOKEN FOR FN 
          JSR  LB26F          DO A SYNTAX CHECK FOR FN 
          LDB  #$80           * GET THE FLAG TO INDICATE ARRAY VARIABLE SEARCH DISABLE FLAG 
          STB  ARYDIS         * AND SAVE IT IN ARRAY VARIABLE FLAG 
          ORA  #$80           SET BIT 7 OF CURRENT INPUT CHARACTER TO INDICATE AN FN VARIABLE 
          JSR  LB35C          * GET THE DESCRIPTOR ADDRESS OF THIS 
          STX  V4B            * VARIABLE AND SAVE IT IN V4B 
L88B1     JMP  LB143          ‘TM’ ERROR IF STRING VARIABLE 
* EVALUATE AN FN CALL                      
L88B4     BSR  L88A1          * GET THE DESCRIPTOR OF THE FN NAME 
          PSHS X              * VARIABLE AND SAVE IT ON THE STACK 
          JSR  LB262          SYNTAX CHECK FOR ‘(‘ & EVALUATE EXPR 
          BSR  L88B1          ‘TM’ ERROR IF STRING VARIABLE 
          PULS U              POINT U TO FN NAME DESCRIPTOR 
          LDB  #2*25          ‘UNDEFINED FUNCTION CALL’ ERROR 
          LDX  $02,U          POINT X TO ARGUMENT VARIABLE DESCRIPTOR 
          BEQ  L886E          BRANCH TO ERROR HANDLER 
          LDY  CHARAD         SAVE CURRENT INPUT POINTER IN Y 
          LDU  ,U             * POINT U TO START OF FN FORMULA AND 
          STU  CHARAD         * SAVE IT IN INPUT POINTER 
          LDA  $04,X          = GET FP VALUE OF 
          PSHS A              = ARGUMENT VARIABLE, CURRENT INPUT 
          LDD  ,X             = POINTER, AND ADDRESS OF START 
          LDU  $02,X          = OF FN FORMULA AND SAVE 
          PSHS U,Y,X,B,A      = THEM ON THE STACK 
          JSR  LBC35          PACK FPA0 AND SAVE IT IN (X) 
L88D9     JSR  LB141          EVALUATE FN EXPRESSION 
          PULS A,B,X,Y,U      RESTORE REGISTERS 
          STD  ,X             * GET THE FP 
          STU  $02,X          * VALUE OF THE ARGUMENT 
          PULS A              * VARIABLE OFF OF THE 
          STA  $04,X          * STACK AND RE-SAVE IT 
          JSR  GETCCH         GET FINAL CHARACTER OF THE FN FORMULA 
          LBNE LB277          ‘SYNTAX’ ERROR IF NOT END OF LINE 
          STY  CHARAD         RESTORE INPUT POINTER 
L88EF     RTS                  
                               
                               
                               
* DEF USR                      
L890F     JSR  GETNCH         SKIP PAST SECOND BYTE OF DEF USR TOKEN 
          BSR  L891C          GET FN NUMBER 
          PSHS X              SAVE FN EXEC ADDRESS STORAGE LOC 
          BSR  L8944          CALCULATE EXEC ADDRESS 
          PULS U              GET FN EXEC ADDRESS STORAGE LOC 
          STX  ,U             SAVE EXEC ADDRESS 
          RTS                  
L891C     CLRB                DEFAULT TO USR0 IF NO ARGUMENT 
          JSR  GETNCH         GET A CHARACTER FROM BASIC 
          BCC  L8927          BRANCH IF NOT NUMERIC 
          SUBA #'0'           MASK OFF ASCII 
          TFR  A,B            SAVE USR NUMBER IN ACCB 
          JSR  GETNCH         GET A CHARACTER FROM BASIC 
L8927     LDX  USRADR         GET ADDRESS OF STORAGE LOCs FOR USR ADDRESS 
          ASLB                X2 - 2 BYTES/USR ADDRESS 
          ABX                 ADD OFFSET TO START ADDRESS OF STORAGE LOCs 
          RTS                  
* PROCESS A USR CALL                      
L892C     BSR  L891C          GET STORAGE LOC OF EXEC ADDRESS FOR USR N 
          LDX  ,X             * GET EXEC ADDRESS AND 
          PSHS X              * PUSH IT ONTO STACK 
          JSR  LB262          SYNTAX CHECK FOR ‘(‘ & EVALUATE EXPR 
          LDX  #FP0EXP        POINT X TO FPA0 
          LDA  VALTYP         GET VARIABLE TYPE 
          BEQ  L8943          BRANCH IF NUMERIC, STRING IF <> 0 
          JSR  LB657          GET LENGTH & ADDRESS OF STRING VARIABLE 
          LDX  FPA0+2         GET POINTER TO STRING DESCRIPTOR 
          LDA  VALTYP         GET VARIABLE TYPE 
L8943     RTS                 JUMP TO USR ROUTINE (PSHS X ABOVE) 
L8944     LDB  #TOK_EQUALS    TOKEN FOR ‘=‘ 
          JSR  LB26F          DO A SYNTAX CHECK FOR = 
          JMP  LB73D          EVALUATE EXPRESSION, RETURN VALUE IN X 
                               
                               
                               
* DEL                          
DEL       LBEQ LB44A          FC’ ERROR IF NO ARGUMENT 
          JSR  LAF67          CONVERT A DECIMAL BASiC NUMBER TO BINARY 
          JSR  LAD01          FIND RAM ADDRESS OF START OF A BASIC LINE 
          STX  VD3            SAVE RAM ADDRESS OF STARTING LINE NUMBER 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          BEQ  L8990          BRANCH IF END OF LINE 
          CMPA #TOK_MINUS     TOKEN FOR ‘-' 
          BNE  L89BF          TERMINATE COMMAND IF LINE NUMBER NOT FOLLOWED BY ‘-‘ 
          JSR  GETNCH         GET A CHARACTER FROM BASIC 
          BEQ  L898C          IF END OF LINE, USE DEFAULT ENDING LINE NUMBER 
          BSR  L89AE          * CONVERT ENDING LINE NUMBER TO BINARY 
          BRA  L8990          * AND SAVE IT IN BINVAL 
L898C     LDA  #$FF           = USE $FFXX AS DEFAULT ENDING 
          STA  BINVAL         = LINE NUMBER - SAVE IT IN BINVAL 
L8990     LDU  VD3            POINT U TO STARTING LINE NUMBER ADDRESS 
L8992     FCB  SKP2           SKIP TWO BYTES 
L8993     LDU  ,U             POINT U TO START OF NEXT LINE 
          LDD  ,U             CHECK FOR END OF PROGRAM 
          BEQ  L899F          BRANCH IF END OF PROGRAM 
          LDD  $02,U          LOAD ACCD WITH THIS LINE’S NUMBER 
          SUBD BINVAL         SUBTRACT ENDING LINE NUMBER ADDRESS 
          BLS  L8993          BRANCH IF = < ENDING LINE NUMBER 
L899F     LDX  VD3            GET STARTING LINE NUMBER 
          BSR  L89B8          MOVE (U) TO (X) UNTIL END OF PROGRAM 
          JSR  LAD21          RESET BASIC’S INPUT POINTER AND ERASE VARIABLES 
          LDX  VD3            GET STARTING LINE NUMBER ADDRESS 
          JSR  LACF1          RECOMPUTE START OF NEXT LINE ADDRESSES 
          JMP  LAC73          JUMP TO BASIC’S MAIN COMMAND LOOP 
L89AE     JSR  LAF67          GO GET LINE NUMBER CONVERTED TO BINARY 
          JMP  LA5C7          MAKE SURE THERE’S NO MORE ON THIS LINE 
L89B4     LDA  ,U+            GET A BYTE FROM (U) 
          STA  ,X+            MOVE THE BYTE TO (X) 
L89B8     CMPU VARTAB         COMPARE TO END OF BASIC 
          BNE  L89B4          BRANCH IF NOT AT END 
          STX  VARTAB         SAVE (X) AS NEW END OF BASIC 
L89BF     RTS                  
                               
                               
L89C0     JSR  L8866          ‘BS’ ERROR IF IN DIRECT MODE 
          JSR  GETNCH         GET A CHAR FROM BASIC 
L89D2     CMPA #'"'           CHECK FOR PROMPT STRING 
          BNE  L89E1          BRANCH IF NO PROMPT STRING 
          JSR  LB244          STRIP OFF PROMPT STRING & PUT IT ON STRING STACK 
          LDB  #';'           * 
          JSR  LB26F          * DO A SYNTAX CHECK FOR; 
          JSR  LB99F          REMOVE PROMPT STRING FROM STRING STACK & SEND TO CONSOLE OUT 
L89E1     LEAS $-02,S         RESERVE TWO STORAGE SLOTS ON STACK 
          JSR  LB035          INPUT A LINE FROM CURRENT INPUT DEVICE 
          LEAS $02,S          CLEAN UP THE STACK 
          JSR  LB357          SEARCH FOR A VARIABLE 
          STX  VARDES         SAVE POINTER TO VARIABLE DESCRIPTOR 
          JSR  LB146          ‘TM’ ERROR IF VARIABLE TYPE = NUMERIC 
          LDX  #LINBUF        POINT X TO THE STRING BUFFER WHERE THE INPUT STRING WAS STORED 
          CLRA                TERMINATOR CHARACTER 0 (END OF LINE) 
          JSR  LB51A          PARSE THE INPUT STRING AND STORE IT IN THE STRING SPACE 
          JMP  LAFA4          REMOVE DESCRIPTOR FROM STRING STACK 
L89FC     JSR  LAF67          STRIP A DECIMAL NUMBER FROM BASIC INPUT LINE 
          LDX  BINVAL         GET BINARY VALUE 
          RTS                  
L8A02     LDX  VD1            GET CURRENT OLD NUMBER BEING RENUMBERED 
L8A04     STX  BINVAL         SAVE THE LINE NUMBER BEING SEARCHED FOR 
          JMP  LAD01          GO FIND THE LINE NUMBER IN BASIC PROGRAM 
                               
* RENUM                        
RENUM     JSR  LAD26          ERASE VARIABLES 
          LDD  #10            DEFAULT LINE NUMBER INTERVAL 
          STD  VD5            SAVE DEFAULT RENUMBER START LINE NUMBER 
          STD  VCF            SAVE DEFAULT INTERVAL 
          CLRB                NOW ACCD = 0 
          STD  VD1            DEFAULT LINE NUMBER OF WHERE TO START RENUMBERING 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          BCC  L8A20          BRANCH IF NOT NUMERIC 
          BSR  L89FC          CONVERT DECIMAL NUMBER IN BASIC PROGRAM TO BINARY 
          STX  VD5            SAVE LINE NUMBER WHERE RENUMBERING STARTS 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
L8A20     BEQ  L8A3D          BRANCH IF END OF LINE 
          JSR  LB26D          SYNTAX CHECK FOR COMMA 
          BCC  L8A2D          BRANCH IF NEXT CHARACTER NOT NUMERIC 
          BSR  L89FC          CONVERT DECIMAL NUMBER IN BASIC PROGRAM TO BINARY 
          STX  VD1            SAVE NEW RENUMBER LINE 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
L8A2D     BEQ  L8A3D          BRANCH IF END OF LINE 
          JSR  LB26D          SYNTAX CHECK FOR COMMA 
          BCC  L8A3A          BRANCH IF NEXT CHARACTER NOT NUMERIC 
          BSR  L89FC          CONVERT DECIMAL NUMBER IN BASIC PROGRAM TO BINARY 
          STX  VCF            SAVE NEW INTERVAL 
          BEQ  L8A83          ‘FC' ERROR 
L8A3A     JSR  LA5C7          CHECK FOR MORE CHARACTERS ON LINE - ‘SYNTAX’ ERROR IF ANY 
L8A3D     BSR  L8A02          GO GET ADDRESS OF OLD NUMBER BEING RENUMBERED 
          STX  VD3            SAVE ADDRESS 
          LDX  VD5            GET NEXT RENUMBERED LINE NUMBER TO USE 
          BSR  L8A04          FIND THE LINE NUMBER IN THE BASIC PROGRAM 
          CMPX VD3            COMPARE TO ADDRESS OF OLD LINE NUMBER 
          BLO  L8A83          ‘FC’ ERROR IF NEW ADDRESS < OLD ADDRESS 
          BSR  L8A67          MAKE SURE RENUMBERED LINE NUMBERS WILL BE IN RANGE 
          JSR  L8ADD          CONVERT ASCII LINE NUMBERS TO ‘EXPANDED’ BINARY 
          JSR  LACEF          RECALCULATE NEXT LINE RAM ADDRESSES 
          BSR  L8A02          GET RAM ADDRESS OF FIRST LINE TO BE RENUMBERED 
          STX  VD3            SAVE IT 
          BSR  L8A91          MAKE SURE LINE NUMBERS EXIST 
          BSR  L8A68          INSERT NEW LINE NUMBERS IN LINE HEADERS 
          BSR  L8A91          INSERT NEW LINE NUMBERS IN PROGRAM STATEMENTS 
          JSR  L8B7B          CONVERT PACKED BINARY LINE NUMBERS TO ASCII 
          JSR  LAD26          ERASE VARIABLES 
          JSR  LACEF          RECALCULATE NEXT LINE RAM ADDRESS 
          JMP  LAC73          GO BACK TO BASIC’S MAIN LOOP 
L8A67     FCB  SKP1LD         SKIP ONE BYTE - LDA #$4F 
L8A68     CLRA                NEW LINE NUMBER FLAG - 0; INSERT NEW LINE NUMBERS 
          STA  VD8            SAVE NEW LINE NUMBER FLAG; 0 = INSERT NEW NUMBERS 
          LDX  VD3            GET ADDRESS OF OLD LINE NUMBER BEING RENUMBERED 
          LDD  VD5            GET THE CURRENT RENUMBERED LINE NUMBER 
          BSR  L8A86          RETURN IF END OF PROGRAM 
L8A71     TST  VD8            CHECK NEW LINE NUMBER FLAG 
          BNE  L8A77          BRANCH IF NOT INSERTING NEW LINE NUMBERS 
          STD  $02,X          STORE THE NEW LINE NUMBER IN THE BASIC PROGRAM 
L8A77     LDX  ,X             POINT X TO THE NEXT LINE IN BASIC 
          BSR  L8A86          RETURN IF END OF PROGRAM 
          ADDD VCF            ADD INTERVAL TO CURRENT RENUMBERED LINE NUMBER 
          BLO  L8A83          ‘FC’ ERROR IF LINE NUMBER > $FFFF 
          CMPA #MAXLIN        LARGEST LINE NUMBER = $F9FF 
          BLO  L8A71          BRANCH IF LEGAL LINE NUMBER 
L8A83     JMP  LB44A          ‘FC’ ERROR IF LINE NUMBER MS BYTE > $F9 
* TEST THE TWO BYTES POINTED TO BY (X).                      
* NORMAL RETURN IF <> 0. IF = 0 (END OF                      
* PROGRAM) RETURN IS PULLED OFF STACK AND                      
* YOU RETURN TO PREVIOUS SUBROUTINE CALL.                      
L8A86     PSHS B,A            SAVE ACCD 
          LDD  ,X             TEST THE 2 BYTES POINTED TO BY X 
          PULS A,B            RESTORE ACCD 
          BNE  L8A90          BRANCH IF NOT END OF PROGRAM 
          LEAS $02,S          PURGE RETURN ADDRESS FROM STACK 
L8A90     RTS                  
L8A91     LDX  TXTTAB         GET START OF BASIC PROGRAM 
          LEAX $-01,X         MOVE POINTER BACK ONE 
L8A95     LEAX $01,X          MOVE POINTER UP ONE 
          BSR  L8A86          RETURN IF END OF PROGRAM 
L8A99     LEAX $03,X          SKIP OVER NEXT LINE ADDRESS AND LINE NUMBER 
L8A9B     LEAX $01,X          MOVE POINTER TO NEXT CHARACTER 
          LDA  ,X             CHECK CURRENT CHARACTER 
          BEQ  L8A95          BRANCH IF END OF LINE 
          STX  TEMPTR         SAVE CURRENT POINTER 
          DECA                = 
          BEQ  L8AB2          =BRANCH IF START OF PACKED NUMERIC LINE 
          DECA                * 
          BEQ  L8AD3          *BRANCH IF LINE NUMBER EXISTS 
          DECA                = 
          BNE  L8A9B          =MOVE TO NEXT CHARACTER IF > 3 
L8AAC     LDA  #$03           * SET 1ST BYTE = 3 TO INDICATE LINE 
          STA  ,X+            * NUMBER DOESN’T CURRENTLY EXIST 
          BRA  L8A99          GO GET ANOTHER CHARACTER 
L8AB2     LDD  $01,X          GET MS BYTE OF LINE NUMBER 
          DEC  $02,X          DECREMENT ZERO CHECK BYTE 
          BEQ  L8AB9          BRANCH IF MS BYTE <> 0 
          CLRA                CLEAR MS BYTE 
L8AB9     LDB  $03,X          GET LS BYTE OF LINE NUMBER 
          DEC  $04,X          DECREMENT ZERO CHECK FLAG 
          BEQ  L8AC0          BRANCH IF IS BYTE <> 0 
          CLRB                CLEAR LS BYTE 
L8AC0     STD  $01,X          SAVE BINARY LINE NUMBER 
          STD  BINVAL         SAVE TRIAL LINE NUMBER 
          JSR  LAD01          FIND RAM ADDRESS OF A BASIC LINE NUMBER 
L8AC7     LDX  TEMPTR         GET BACK POINTER TO START OF PACKED LINE NUMBER 
          BLO  L8AAC          BRANCH IF NO LINE NUMBER MATCH FOUND 
          LDD  V47            GET START ADDRESS OF LINE NUMBER 
          INC  ,X+            * SET 1ST BYTE = 2, TO INDICATE LINE NUMBER EXISTS IF CHECKING FOR 
*              * EXISTENCE OF LINE NUMBER, SET IT = 1 IF INSERTING LINE NUMBERS  
                               
          STD  ,X             SAVE RAM ADDRESS OF CORRECT LINE NUMBER 
          BRA  L8A99          GO GET ANOTHER CHARACTER 
L8AD3     CLR  ,X             CLEAR CARRY FLAG AND 1ST BYTE 
          LDX  $01,X          POINT X TO RAM ADDRESS OF CORRECT LINE NUMBER 
          LDX  $02,X          PUT CORRECT LINE NUMBER INTO (X) 
          STX  V47            SAVE IT TEMPORARILY 
          BRA  L8AC7          GO INSERT IT INTO BASIC LINE 
L8ADD     LDX  TXTTAB         GET BEGINNING OF BASIC PROGRAM 
          BRA  L8AE5           
L8AE1     LDX  CHARAD         *GET CURRENT INPUT POINTER 
          LEAX $01,X          *AND BUMP IT ONE 
L8AE5     BSR  L8A86          RETURN IF END OF PROGRAM 
          LEAX $02,X          SKIP PAST NEXT LINE ADDRESS 
L8AE9     LEAX $01,X          ADVANCE POINTER BY ONE 
L8AEB     STX  CHARAD         SAVE NEW BASIC INPUT POINTER 
L8AED     JSR  GETNCH         GET NEXT CHARACTER FROM BASIC 
L8AEF     TSTA                CHECK THE CHARACTER 
          BEQ  L8AE1          BRANCH IF END OF LINE 
          BPL  L8AED          BRANCH IF NOT A TOKEN 
          LDX  CHARAD         GET CURRENT INPUT POINTER 
          CMPA #$FF           IS THIS A SECONDARY TOKEN? 
          BEQ  L8AE9          YES - IGNORE IT 
          CMPA #TOK_THEN      TOKEN FOR THEN? 
          BEQ  L8B13          YES 
          CMPA #TOK_ELSE      TOKEN FOR ELSE? 
          BEQ  L8B13          YES 
          CMPA #TOK_GO        TOKEN FOR GO? 
          BNE  L8AED          NO 
          JSR  GETNCH         GET A CHARACTER FROM BASIC 
          CMPA #TOK_TO        TOKEN FOR TO? 
          BEQ  L8B13          YES 
          CMPA #TOK_SUB       TOKEN FOR SUB? 
          BNE  L8AEB          NO 
L8B13     JSR  GETNCH         GET A CHARACTER FROM BASIC 
          BLO  L8B1B          BRANCH IF NUMERIC 
L8B17     JSR  GETCCH         GET CURRENT BASIC INPUT CHARRACTER 
          BRA  L8AEF          KEEP CHECKING THE LINE 
L8B1B     LDX  CHARAD         GET CURRENT INPUT ADDRESS 
          PSHS X              SAVE IT ON THE STACK 
          JSR  LAF67          CONVERT DECIMAL BASIC NUMBER TO BINARY 
          LDX  CHARAD         GET CURRENT INPUT POINTER 
L8B24     LDA  ,-X            GET PREVIOUS INPUT CHARACTER 
          JSR  L90AA          CLEAR CARRY IF NUMERIC INPUT VALUE 
          BLO  L8B24          BRANCH IF NON-NUMERIC 
          LEAX $01,X          MOVE POINTER UP ONE 
          TFR  X,D            NOW ACCD POINTS TO ONE PAST END OF LINE NUMBER 
          SUBB $01,S          SUBTRACT PRE-NUMERIC POINTER LS BYTE 
          SUBB #$05           MAKE SURE THERE ARE AT LEAST 5 CHARACTERS IN THE NUMERIC LINE 
*                              
          BEQ  L8B55          BRANCH IF EXACTLY 5 
          BLO  L8B41          BRANCH IF < 5 
          LEAU ,X             TRANSFER X TO U 
          NEGB                NEGATE B 
          LEAX B,X            MOVE X BACK B BYTES 
          JSR  L89B8          *MOVE BYTES FROM (U) TO (X) UNTIL 
*         *U   = END OF BASIC; (I) = NEW END OF BASIC  
          BRA  L8B55           
* FORCE FIVE BYTES OF SPACE FOR THE LINE NUMBER                      
L8B41     STX  V47            SAVE END OF NUMERIC VALUE 
          LDX  VARTAB         GET END OF BASIC PROGRAM 
          STX  V43            SAVE IT 
          NEGB                NEGATE B 
          LEAX B,X            ADD IT TO END OF NUMERIC POiNTER 
          STX  V41            SAVE POINTER 
          STX  VARTAB         STORE END OF BASIC PROGRAM 
          JSR  LAC1E          ACCD = TOP OF ARRAYS - CHECK FOR ENOUGH ROOM 
          LDX  V45            * GET AND SAVE THE 
          STX  CHARAD         * NEW CURRENT INPUT POINTER 
L8B55     PULS X              RESTORE POINTER TO START OF NUMERIC VALUE 
          LDA  #$01           NEW LINE NUMBER FLAG 
          STA  ,X             * SAVE NEW LINE FLAG 
          STA  $02,X          * 
          STA  $04,X          * 
          LDB  BINVAL         GET MS BYTE OF BINARY LINE NUMBER 
          BNE  L8B67          BRANCH IF IT IS NOT ZERO 
          LDB  #$01           SAVE A 1 IF BYTE IS 0; OTHERWISE, BASIC WILL 
*              THINK IT IS THE END OF A LINE  
          INC  $02,X          IF 2,X = 2, THEN PREVIOUS BYTE WAS A ZERO 
L8B67     STB  $01,X          SAVE MS BYTE OF BINARY LINE NUMBER 
          LDB  BINVAL+1       GET IS BYTE OF BINARY LINE NUMBER 
          BNE  L8B71          BRANCH IF NOT A ZERO BYTE 
          LDB  #$01           SAVE A 1 IF BYTE IS A 0 
          INC  $04,X          IF 4,X = 2, THEN PREVIOUS BYTE WAS A 0 
L8B71     STB  $03,X          SAVE LS BYTE OF BINARY LINE NUMBER 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          CMPA #','           IS IT A COMMA? 
          BEQ  L8B13          YES - PROCESS ANOTHER NUMERIC VALUE 
          BRA  L8B17          NO - GO GET AND PROCESS AN INPUT CHARACTER 
L8B7B     LDX  TXTTAB         POINT X TO START OF BASIC PROGRAM 
          LEAX $-01,X         MOVE POINTER BACK ONE 
L8B7F     LEAX $01,X          MOVE POINTER UP ONE 
          LDD  $02,X          GET ADDRESS OF NEXT LINE 
          STD  CURLIN         SAVE IT IN CURLIN 
          JSR  L8A86          RETURN IF END OF PROGRAM 
          LEAX $03,X          SKIP OVER ADDRESS OF NEXT LINE AND 1ST BYTE OF LINE NUMBER 
L8B8A     LEAX $01,X          MOVE POINTER UP ONE 
L8B8C     LDA  ,X             GET CURRENT CHARACTER 
          BEQ  L8B7F          BRANCH IF END OF LINE 
          DECA                INPUT CHARACTER = 1? - VALID LINE NUMBER 
          BEQ  L8BAE          YES 
          SUBA #$02           INPUT CHARACTER 3? - UL LINE NUMBER 
          BNE  L8B8A          NO 
          PSHS X              SAVE CURRENT POSITION OF INPUT POINTER 
          LDX  #L8BD9-1       POINT X TO ‘UL’ MESSAGE 
          JSR  LB99C          PRINT STRING TO THE SCREEN 
          LDX  ,S             GET INPUT POINTER 
          LDD  $01,X          GET THE UNDEFINED LINE NUMBER 
          JSR  LBDCC          CONVERT NUMBER IN ACCD TO DECIMAL AND DISPLAY IT 
          JSR  LBDC5          PRINT ‘IN XXXX’ XXXX = CURRENT LINE NUMBER 
          JSR  LB958          SEND A CR TO CONSOLE OUT 
          PULS X              GET INPUT POINTER BACK 
L8BAE     PSHS X              SAVE CURRENT POSITION OF INPUT POINTER 
          LDD  $01,X          LOAD ACCD WITH BINARY VALUE OF LINE NUMBER 
          STD  FPA0+2         SAVE IN BOTTOM 2 BYTES OF FPA0 
          JSR  L880E          ADJUST REST OF FPA0 AS AN INTEGER 
          JSR  LBDD9          CONVERT FPA0 TO ASCII, STORE IN LINE NUMBER 
          PULS U              LOAD U WITH PREVIOUS ADDRESS OF INPUT POINTER 
          LDB  #$05           EACH EXPANDED LINE NUMBER USES 5 BYTES 
L8BBE     LEAX $01,X          MOVE POINTER FORWARD ONE 
          LDA  ,X             GET AN ASCII BYTE 
          BEQ  L8BC9          BRANCH IF END OF NUMBER 
          DECB                DECREMENT BYTE COUNTER 
          STA  ,U+            STORE ASCII NUMBER IN BASIC LINE 
          BRA  L8BBE          CHECK FOR ANOTHER DIGIT 
L8BC9     LEAX ,U             TRANSFER NEW LINE POINTER TO (X) 
          TSTB DOES THE NEW LINE NUMBER REQUIRE 5 BYTES?  
          BEQ  L8B8C          YES - GO GET ANOTHER INPUT CHARACTER 
          LEAY ,U             SAVE NEW LINE POINTER IN Y 
          LEAU B,U            POINT U TO END OF 5 BYTE PACKED LINE NUMBER BLOCK 
          JSR  L89B8          MOVE BYTES FROM (U) TO (X) UNTIL END OF PROGRAM 
          LEAX ,Y             LOAD (X) WITH NEW LINE POINTER 
          BRA  L8B8C          GO GET ANOTHER INPUT CHARACTER 
                               
L8BD9     FCC  "UL "          UNKNOWN LINE NUMBER MESSAGE 
          FCB  0               
                               
                               
HEXDOL    JSR  LB740          CONVERT FPA0 INTO A POSITIVE 2 BYTE INTEGER 
          LDX  #STRBUF+2      POINT TO TEMPORARY BUFFER 
          LDB  #$04           CONVERT 4 NIBBLES 
L8BE5     PSHS B              SAVE NIBBLE COUNTER 
          CLRB                CLEAR CARRY FLAG 
          LDA  #$04           4 SHIFTS 
L8BEA     ASL  FPA0+3         * SHIFT BOTTOM TWO BYTES OF 
          ROL  FPA0+2         * FPA0 LEFT ONE BIT (X2) 
          ROLB                IF OVERFLOW, ACCB <> 0 
          DECA                * DECREMENT SHIFT COUNTER AND 
          BNE  L8BEA          * BRANCH IF NOT DONE 
          TSTB CHECK FOR OVERFLOW  
          BNE  L8BFF          BRANCH IF OVERFLOW 
          LDA  ,S             * GET NIBBLE COUNTER, 
          DECA                * DECREMENT IT AND 
          BEQ  L8BFF          * BRANCH IF DONE 
          CMPX #STRBUF+2      DO NOT DO A CONVERSION UNTIL A NON-ZERO 
          BEQ  L8C0B          BYTE IS FOUND - LEADING ZERO SUPPRESSION 
L8BFF     ADDB #'0'           ADD IN ASCII ZERO 
          CMPB #'9'           COMPARE TO ASCII 9 
          BLS  L8C07          BRANCH IF < 9 
          ADDB #7             ADD ASCII OFFSET IF HEX LETTER 
L8C07     STB  ,X+            STORE HEX VALUE AND ADVANCE POINTER 
          CLR  ,X             CLEAR NEXT BYTE - END OF STRING FLAG 
L8C0B     PULS B              * GET NIBBLE COUNTER, 
          DECB                * DECREMENT IT AND 
          BNE  L8BE5          * BRANCH IF NOT DONE 
          LEAS $02,S          PURGE RETURN ADDRESS OFF OF STACK 
          LDX  #STRBUF+1      RESET POINTER 
          JMP  LB518          SAVE STRING ON STRING STACK 
* PROCESS EXCLAMATION POINT                      
L8E37     LDA  #$01           * SET SPACES 
          STA  VD9            * COUNTER = 1 
* PROCESS STRING ITEM - LIST                      
L8E3B     DECB                DECREMENT FORMAT STRING LENGTH COUNTER 
          JSR  L8FD8          SEND A '+' TO CONSOLE OUT IF VDA <>0 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          LBEQ L8ED8          EXIT PRINT USING IF END OF LINE 
          STB  VD3            SAVE REMAINDER FORMAT STRING LENGTH 
          JSR  LB156          EVALUATE EXPRESSION 
          JSR  LB146          ‘TM’ ERROR IF NUMERIC VARIABLE 
          LDX  FPA0+2         * GET ITEM - LIST DESCRIPTOR ADDRESS 
          STX  V4D            * AND SAVE IT IN V4D 
          LDB  VD9            GET SPACES COUNTER 
          JSR  LB6AD          PUT ACCB BYTES INTO STRING SPACE & PUT DESCRIPTOR ON STRING STACK 
          JSR  LB99F          PRINT THE FORMATTED STRING TO CONSOLE OUT 
* PAD FORMAT STRING WITH SPACES IF ITEM - LIST STRING < FORMAT STRING LENGTH                      
          LDX  FPA0+2         POINT X TO FORMATTED STRING DESCRIPTOR ADDRESS 
          LDB  VD9            GET SPACES COUNTER 
          SUBB ,X             SUBTRACT LENGTH OF FORMATTED STRING 
L8E5F     DECB                DECREMENT DIFFERENCE 
          LBMI L8FB3          GO INTERPRET ANOTHER ITEM - LIST 
          JSR  LB9AC          PAD FORMAT STRING WITH A SPACE 
          BRA  L8E5F          KEEP PADDING 
* PERCENT SIGN - PROCESS A %SPACES% COMMAND                      
L8E69     STB  VD3            * SAVE THE CURRENT FORMAT STRING 
          STX  TEMPTR         * COUNTER AND POINTER 
          LDA  #$02           INITIAL SPACES COUNTER = 2 
          STA  VD9            SAVE IN SPACES COUNTER 
L8E71     LDA  ,X             GET A CHARACTER FROM FORMAT STRING 
          CMPA #'%'           COMPARE TO TERMINATOR CHARACTER 
          BEQ  L8E3B          BRANCH IF END OF SPACES COMMAND 
          CMPA #' '           BLANK 
          BNE  L8E82          BRANCH IF ILLEGAL CHARACTER 
          INC  VD9            ADD ONE TO SPACES COUNTER 
          LEAX $01,X          MOVE FORMAT POINTER UP ONE 
          DECB                DECREMENT LENGTH COUNTER 
          BNE  L8E71          BRANCH IF NOT END OF FORMAT STRING 
L8E82     LDX  TEMPTR         * RESTORE CURRENT FORMAT STRING COUNTER 
          LDB  VD3            * AND POINTER TO POSITION BEFORE SPACES COMMAND 
          LDA  #'%'           SEND A ‘%’ TO CONSOLE OUT AS A DEBUGGING AID 
* ERROR PROCESSOR - ILLEGAL CHARACTER OR BAD SYNTAX IN FORMAT STRING                      
L8E88     JSR  L8FD8          SEND A ‘+' TO CONSOLE OUT IF VDA <> 0 
          JSR  PUTCHR         SEND CHARACTER TO CONSOLE OUT 
          BRA  L8EB9          GET NEXT CHARACTER IN FORMAT STRING 
                               
* PRINT RAM HOOK                      
XVEC9     CMPA #TOK_USING     USING TOKEN 
          BEQ  L8E95          BRANCH IF PRINT USING 
          RTS                  
                               
* PRINT USING                      
* VDA IS USED AS A STATUS BYTE: BIT 6 = COMMA FORCE                      
* BIT 5=LEADING ASTERISK FORCE; BIT 4 = FLOATING $ FORCE                      
* BIT 3 = PRE SIGN FORCE; BIT 2 = POST SIGN FORCE; BIT 0 = EXPONENTIAL FORCE                      
L8E95     LEAS $02,S          PURGE RETURN ADDRESS OFF THE STACK 
          JSR  LB158          EVALUATE FORMAT STRING 
          JSR  LB146          ‘TM’ ERROR IF VARIABLE TYPE = NUMERIC 
          LDB  #';'           CHECK FOR ITEM LIST SEPARATOR 
          JSR  LB26F          SYNTAX CHECK FOR ; 
          LDX  FPA0+2         * GET FORMAT STRING DESCRIPTOR ADDRESS 
          STX  VD5            * AND SAVE IT IN VD5 
          BRA  L8EAE          GO PROCESS FORMAT STRING 
L8EA8     LDA  VD7            *CHECK NEXT PRINT ITEM FLAG AND 
          BEQ  L8EB4          *‘FC’ ERROR IF NO FURTHER PRINT ITEMS 
          LDX  VD5            RESET FORMAT STRING POINTER TO START OF STRING 
L8EAE     CLR  VD7            RESET NEXT PRINT ITEM FLAG 
          LDB  ,X             GET LENGTH OF FORMAT STRING 
          BNE  L8EB7          INTERPRET FORMAT STRING IF LENGTH > 0 
L8EB4     JMP  LB44A          ‘FC’ ERROR IF FORMAT STRING = NULL 
L8EB7     LDX  $02,X          POINT X TO START OF FORMAT STRING 
* INTERPRET THE FORMAT STRING                      
L8EB9     CLR  VDA            CLEAR THE STATUS BYTE 
L8EBB     CLR  VD9            CLEAR LEFT DIGIT COUNTER 
          LDA  ,X+            GET A CHARACTER FROM FORMAT STRING 
          CMPA #'!'           EXCLAMATION POINT? 
          LBEQ L8E37          YES - STRING TYPE FORMAT 
          CMPA #'#'           NUMBER SIGN? (DIGIT LOCATOR) 
          BEQ  L8F24          YES - NUMERIC TYPE FORMAT 
          DECB                DECREMENT FORMAT STRING LENGTH 
          BNE  L8EE2          BRANCH IF NOT DONE 
          JSR  L8FD8          SEND A ‘+‘ TO CONSOLE OUT IF VDA <> 0 
          JSR  PUTCHR         SEND CHARACTER TO CONSOLE OUT 
L8ED2     JSR  GETCCH         GET CURRENT CHARACTER FROM BASIC 
          BNE  L8EA8          BRANCH IF NOT END OF LINE 
          LDA  VD7            GET NEXT PRINT ITEM FLAG 
L8ED8     BNE  L8EDD          BRANCH IF MORE PRINT ITEMS 
          JSR  LB958          SEND A CARRIAGE RETURN TO CONSOLE OUT 
L8EDD     LDX  VD5            POINT X TO FORMAT STRING DESCRIPTOR 
          JMP  LB659          RETURN ADDRESS AND LENGTH OF FORMAT STRING - EXIT PRINT USING 
L8EE2     CMPA #'+'           CHECK FOR ‘+‘ (PRE-SIGN FORCE) 
          BNE  L8EEF          NO PLUS 
          JSR  L8FD8          SEND A ‘+' TO CONSOLE OUT IF VDA <> 0 
          LDA  #$08           * LOAD THE STATUS BYTE WITH 8; 
          STA  VDA            * PRE-SIGN FORCE FLAG 
          BRA  L8EBB          INTERPRET THE REST OF THE FORMAT STRING 
L8EEF     CMPA #'.'           DECIMAL POINT? 
          BEQ  L8F41          YES 
          CMPA #'%'           PERCENT SIGN? 
          LBEQ L8E69          YES 
          CMPA ,X             COMPARE THE PRESENT FORMAT STRING INPUT 
*              CHARACTER TO THE NEXT ONE IN THE STRING  
L8EFB     BNE  L8E88          NO MATCH - ILLEGAL CHARACTER 
* TWO CONSECUTIVE EQUAL CHARACTERS IN FORMAT STRING                      
          CMPA #'$'           DOLLAR SIGN? 
          BEQ  L8F1A          YES - MAKE THE DOLLAR SIGN FLOAT 
          CMPA #'*'           ASTERISK? 
          BNE  L8EFB          NO - ILLEGAL CHARACTER 
          LDA  VDA            * GRAB THE STATUS BYTE AND BET BIT 5 
          ORA  #$20           * TO INDICATE THAT THE OUTPUT WILL 
          STA  VDA            * BE LEFT PADDED WITH ASTERISKS 
          CMPB #2             * CHECK TO SEE IF THE $$ ARE THE LAST TWO 
          BLO  L8F20          * CHARACTERS IN THE FORMAT STRING AND BRANCH IF SO 
          LDA  $01,X          GET THE NEXT CHARACTER AFTER ** 
          CMPA #'$'           CHECK FOR **$ 
          BNE  L8F20          CHECK FOR MORE CHARACTERS 
          DECB                DECREMENT STRING LENGTH COUNTER 
          LEAX $01,X          MOVE FORMAT STRING POINTER UP ONE 
          INC  VD9            ADD ONE TO LEFT DIGIT COUNTER - FOR ASTERISK PAD AND 
*              FLOATING DOLLAR SIGN COMBINATION  
L8F1A     LDA  VDA            * GET THE STATUS BYTE AND SET 
          ORA  #$10           * BIT 4 TO INDICATE A 
          STA  VDA            * FLOATING DOLLAR SIGN 
L8F20     LEAX $01,X          MOVE FORMAT STRING POINTER UP ONE 
          INC  VD9            ADD ONE TO LEFT DIGIT (FLOATING $ OR ASTERISK PAD) 
* PROCESS CHARACTERS TO THE LEFT OF THE DECIMAL POINT IN THE FORMAT STRING                      
L8F24     CLR  VD8            CLEAR THE RIGHT DIGIT COUNTER 
L8F26     INC  VD9            ADD ONE TO LEFT DIGIT COUNTER 
          DECB                DECREMENT FORMAT STRING LENGTH COUNTER 
          BEQ  L8F74          BRANCH IF END OF FORMAT STRING 
          LDA  ,X+            GET THE NEXT FORMAT CHARACTER 
          CMPA #'.'           DECIMAL POINT? 
          BEQ  L8F4F          YES 
          CMPA #'#'           NUMBER SIGN? 
          BEQ  L8F26          YES 
          CMPA #','           COMMA? 
          BNE  L8F5A          NO 
          LDA  VDA            * GET THE STATUS BYTE 
          ORA  #$40           * AND SET BIT 6 WHICH IS THE 
          STA  VDA            * COMMA SEPARATOR FLAG 
          BRA  L8F26          PROCESS MORE CHARACTERS TO LEFT OF DECIMAL POINT 
* PROCESS DECIMAL POINT IF NO DIGITS TO LEFT OF IT                      
L8F41     LDA  ,X             GET NEXT FORMAT CHARACTER 
          CMPA #'#'           IS IT A NUMBER SIGN? 
          LBNE L8E88          NO 
          LDA  #1             * SET THE RIGHT DIGIT COUNTER TO 1 - 
          STA  VD8            * ALLOW ONE SPOT FOR DECIMAL POINT 
          LEAX $01,X          MOVE FORMAT POINTER UP ONE 
* PROCESS DIGITS TO RIGHT OF DECIMAL POINT                      
L8F4F     INC  VD8            ADD ONE TO RIGHT DIGIT COUNTER 
          DECB                DECREMENT FORMAT LENGTH COUNTER 
          BEQ  L8F74          BRANCH IF END OF FORMAT STRING 
          LDA  ,X+            GET A CHARACTER FROM FORMAT STRING 
          CMPA #'#'           IS IT NUMBER SIGN? 
          BEQ  L8F4F          YES - KEEP CHECKING 
* CHECK FOR EXPONENTIAL FORCE                      
L8F5A     CMPA #$5E           CHECK FOR UP ARROW 
          BNE  L8F74          NO UP ARROW 
          CMPA ,X             IS THE NEXT CHARACTER AN UP ARROW? 
          BNE  L8F74          NO 
          CMPA $01,X          AND THE NEXT CHARACTER? 
          BNE  L8F74          NO 
          CMPA $02,X          HOW ABOUT THE 4TH CHARACTER? 
          BNE  L8F74          NO, ALSO 
          CMPB #4             * CHECK TO SEE IF THE 4 UP ARROWS ARE IN THE 
          BLO  L8F74          * FORMAT STRING AND BRANCH IF NOT 
          SUBB #4             * MOVE POINTER UP 4 AND SUBTRACT 
          LEAX $04,X          * FOUR FROM LENGTH 
          INC  VDA INCREMENT STATUS BYTE - EXPONENTIAL FORM  
                               
* CHECK FOR A PRE OR POST - SIGN FORCE AT END OF FORMAT STRING                      
L8F74     LEAX $-01,X         MOVE POINTER BACK ONE 
          INC  VD9            ADD ONE TO LEFT DIGIT COUNTER FOR PRE-SIGN FORCE 
          LDA  VDA            * PRE-SIGN 
          BITA #$08           * FORCE AND 
          BNE  L8F96          * BRANCH IF SET 
          DEC  VD9            DECREMENT LEFT DIGIT — NO PRE-SIGN FORCE 
          TSTB * CHECK LENGTH COUNTER AND BRANCH  
          BEQ  L8F96          * IF END OF FORMAT STRING 
          LDA  ,X             GET NEXT FORMAT STRING CHARACTER 
          SUBA #'-'           CHECK FOR MINUS SIGN 
          BEQ  L8F8F          BRANCH IF MINUS SIGN 
          CMPA #$FE           * WAS CMPA #('+')-('-') 
          BNE  L8F96          BRANCH IF NO PLUS SIGN 
          LDA  #$08           GET THE PRE-SIGN FORCE FLAG 
L8F8F     ORA  #$04           ‘OR’ IN POST-SIGN FORCE FLAG 
          ORA  VDA            ‘OR’ IN THE STATUS BYTE 
          STA  VDA            SAVE THE STATUS BYTE 
          DECB                DECREMENT FORMAT STRING LENGTH 
                               
* EVALUATE NUMERIC ITEM-LIST                      
L8F96     JSR  GETCCH         GET CURRENT CHARACTER 
          LBEQ L8ED8          BRANCH IF END OF LINE 
          STB  VD3            SAVE FORMAT STRING LENGTH WHEN FORMAT EVALUATION ENDED 
          JSR  LB141          EVALUATE EXPRESSION 
          LDA  VD9            GET THE LEFT DIGIT COUNTER 
          ADDA VD8            ADD IT TO THE RIGHT DIGIT COUNTER 
          CMPA #17            * 
          LBHI LB44A          *‘FC’ ERROR IF MORE THAN 16 DIGITS AND DECIMAL POiNT 
          JSR  L8FE5          CONVERT ITEM-LIST TO FORMATTED ASCII STRING 
          LEAX $-01,X         MOVE BUFFER POINTER BACK ONE 
          JSR  LB99C          DISPLAY THE FORMATTED STRING TO CONSOLE OUT 
L8FB3     CLR  VD7            RESET NEXT PRINT ITEM FLAG 
          JSR  GETCCH         GET CURRENT INPUT CHARACTER 
          BEQ  L8FC6          BRANCH IF END OF LINE 
          STA  VD7            SAVE CURRENT CHARACTER (<>0) IN NEXT PRINT ITEM FLAG 
          CMPA #';'           * CHECK FOR ; - ITEM-LIST SEPARATOR AND 
          BEQ  L8FC4          * BRANCH IF SEMICOLON 
          JSR  LB26D          SYNTAX CHECK FOR COMMA 
          BRA  L8FC6          PROCESS NEXT PRINT ITEM 
L8FC4     JSR  GETNCH         GET NEXT INPUT CHARACTER 
L8FC6     LDX  VD5            GET FORMAT STRING DESCRIPTOR ADDRESS 
          LDB  ,X             GET LENGTH OF FORMAT STRING 
          SUBB VD3            SUBTRACT AMOUNT OF FORMAT STRING LEFT AFTER LAST PRINT ITEM 
          LDX  $02,X          *GET FORMAT STRING START ADDRESS AND ADVANCE 
          ABX  *POINTER TO START OF UNUSED FORMAT STRING  
          LDB  VD3            * GET AMOUNT OF UNUSED FORMAT STRING 
          LBNE L8EB9          * REINTERPRET FORMAT STRING FROM THAT POINT 
          JMP  L8ED2          REINTERPRET FORMAT STRING FROM THE START IF ENTIRELY 
*         USED ON LAST PRINT ITEM  
                               
* PRINT A ‘+‘ TO CONSOLE OUT IF THE STATUS BYTE <> 0                      
L8FD8     PSHS A              RESTORE ACCA AND RETURN 
          LDA  #'+'           GET ASCII PLUS SIGN 
          TST  VDA            * CHECK THE STATUS BYTE AND 
          BEQ  L8FE3          * RETURN IF = 0 
          JSR  PUTCHR         SEND A CHARACTER TO CONSOLE OUT 
L8FE3     PULS A,PC           RETURN ACCA AND RETURN 
                               
* CONVERT ITEM-LIST TO DECIMAL ASCII STRING                      
L8FE5     LDU  #STRBUF+4      POINT U TO STRING BUFFER 
          LDB  #SPACE         BLANK 
          LDA  VDA            * GET THE STATUS FLAG AND 
          BITA #$08           * CHECK FOR A PRE-SIGN FORCE 
          BEQ  L8FF2          * BRANCH IF NO PRE-SIGN FORCE 
          LDB  #'+'           PLUS SIGN 
L8FF2     TST  FP0SGN         CHECK THE SIGN OF FPA0 
          BPL  L8FFA          BRANCH IF POSITIVE 
          CLR  FP0SGN         FORCE FPA0 SIGN TO BE POSITIVE 
          LDB  #'-'           MINUS SIGN 
L8FFA     STB  ,U+            SAVE THE SIGN IN BUFFER 
          LDB  #'0'           * PUT A ZERO INTO THE BUFFER 
          STB  ,U+            * 
          ANDA #$01           * CHECK THE EXPONENTIAL FORCE FLAG IN 
          LBNE L910D          * THE STATUS BYTE - BRANCH IF ACTIVE 
          LDX  #LBDC0         POINT X TO FLOATING POINT 1E + 09 
          JSR  LBCA0          COMPARE FPA0 TO (X) 
          BMI  L9023          BRANCH IF FPA0 < 1E+09 
          JSR  LBDD9          CONVERT FP NUMBER TO ASCII STRING 
L9011     LDA  ,X+            * ADVANCE POINTER TO END OF 
          BNE  L9011          * ASCII STRING (ZERO BYTE) 
L9015     LDA  ,-X            MOVE THE 
          STA  $01,X          ENTIRE STRING 
          CMPX #STRBUF+3      UP ONE 
          BNE  L9015          BYTE 
          LDA  #'%'           * INSERT A % SIGN AT START OF 
          STA  ,X             * STRING - OVERFLOW ERROR 
          RTS                  
                               
L9023     LDA  FP0EXP         GET EXPONENT OF FPA0 
          STA  V47            AND SAVE IT IN V74 
          BEQ  L902C          BRANCH IF FPA0 = 0 
          JSR  L91CD          CONVERT FPA0 TO NUMBER WITH 9 SIGNIFICANT 
*              PLACES TO LEFT OF DECIMAL POINT  
L902C     LDA  V47            GET BASE 10 EXPONENT OFFSET 
          LBMI L90B3          BRANCH IF FPA0 < 100,000,000 
          NEGA                * CALCULATE THE NUMBER OF LEADING ZEROES TO INSERT - 
          ADDA VD9            * SUBTRACT BASE 10 EXPONENT OFFSET AND 9 (FPA0 HAS 
          SUBA #$09           * 9 PLACES TO LEFT OF EXPONENT) FROM LEFT DIGIT COUNTER 
          JSR  L90EA          PUT ACCA ZEROES IN STRING BUFFER 
          JSR  L9263          INITIALIZE DECIMAL POINT AND COMMA COUNTERS 
          JSR  L9202          CONVERT FPA0 TO DECIMAL ASCII IN THE STRING BUFFER 
          LDA  V47            * GET BASE 10 EXPONENT AND PUT THAT MANY 
          JSR  L9281          * ZEROES IN STRING BUFFER - STOP AT DECIMAL POINT 
          LDA  V47            WASTED INSTRUCTION - SERVES NO PURPOSE 
          JSR  L9249          CHECK FOR DECIMAL POINT 
          LDA  VD8            GET THE RIGHT DIGIT COUNTER 
          BNE  L9050          BRANCH IF RIGHT DIGlT COUNTER <> 0 
          LEAU $-01,U         * MOVE BUFFER POINTER BACK ONE - DELETE 
*              * DECIMAL POINT IF NO RIGHT DIGITS SPECiFIED  
L9050     DECA                SUBTRACT ONE (DECIMAL POINT) 
          JSR  L90EA          PUT ACCA ZEROES INTO BUFFER (TRAILING ZEROES) 
L9054     JSR  L9185          INSERT ASTERISK PADDING, FLOATING $, AND POST-SIGN 
          TSTA                WAS THERE A POST-SIGN? 
          BEQ  L9060          NO 
          CMPB #'*'           IS THE FIRST CHARACTER AN $? 
          BEQ  L9060          YES 
          STB  ,U+            STORE THE POST-SIGN 
L9060     CLR  ,U             CLEAR THE LAST CHARACTER IN THE BUFFER 
*                              
* REMOVE ANY EXTRA BLANKS OR ASTERISKS FROM THE                      
* STRING BUFFER TO THE LEFT OF THE DECIMAL POINT                      
          LDX  #STRBUF+3 POINT X TO THE START OF THE BUFFER  
L9065     LEAX $01,X          MOVE BUFFER POINTER UP ONE 
          STX  TEMPTR         SAVE BUFFER POINTER IN TEMPTR 
          LDA  VARPTR+1       * GET ADDRESS OF DECIMAL POINT IN BUFFER, SUBTRACT 
          SUBA TEMPTR+1       * CURRENT POSITION AND SUBTRACT LEFT DIGIT COUNTER - 
          SUBA VD9            * THE RESULT WILL BE ZERO WHEN TEMPTR+1 IS POINTING 
*              * TO THE FIRST DIGIT OF THE FORMAT STRING  
          BEQ  L90A9          RETURN IF NO DIGITS TO LEFT OF THE DECiMAL POINT 
          LDA  ,X             GET THE CURRENT BUFFER CHARACTER 
          CMPA #SPACE         SPACE? 
          BEQ  L9065          YES - ADVANCE POINTER 
          CMPA #'*'           ASTERISK? 
          BEQ  L9065          YES - ADVANCE POINTER 
          CLRA                A ZERO ON THE STACK IS END OF DATA POINTER 
L907C     PSHS A              PUSH A CHARACTER ONTO THE STACK 
          LDA  ,X+            GET NEXT CHARACTER FROM BUFFER 
          CMPA #'-'           MINUS SIGN? 
          BEQ  L907C          YES 
          CMPA #'+'           PLUS SIGN? 
          BEQ  L907C          YES 
          CMPA $'$'           DOLLAR SIGN? 
          BEQ  L907C          YES 
          CMPA #'0'           ZERO? 
          BNE  L909E          NO - ERROR 
          LDA  $01,X          GET CHARACTER FOLLOWING ZERO 
          BSR  L90AA          CLEAR CARRY IF NUMERIC 
          BLO  L909E          BRANCH IF NOT A NUMERIC CHARACTER - ERROR 
L9096     PULS A              * PULL A CHARACTER OFF OF THE STACK 
          STA  ,-X            * AND PUT IT BACK IN THE STRING BUFFER 
          BNE  L9096          * KEEP GOING UNTIL ZERO FLAG 
          BRA  L9065          KEEP CLEANING UP THE INPUT BUFFER 
L909E     PULS A               
          TSTA                * THE STACK AND EXIT WHEN 
          BNE  L909E          * ZERO FLAG FOUND 
          LDX  TEMPTR         GET THE STRING BUFFER START POINTER 
          LDA  #'%'           * PUT A % SIGN BEFORE THE ERROR POSITION TO 
          STA  ,-X            * INDICATE AN ERROR 
L90A9     RTS                  
*                              
* CLEAR CARRY IF NUMERIC                      
L90AA     CMPA #'0'           ASCII ZERO 
          BLO  L90B2          RETURN IF ACCA < ASCII 0 
          SUBA #$3A           *  #'9'+1 
          SUBA #$C6           * #-('9'+1)  CARRY CLEAR IF NUMERIC 
L90B2     RTS                  
*                              
* PROCESS AN ITEM-LIST WHICH IS < 100,000,000                      
L90B3     LDA  VD8            GET RIGHT DIGIT COUNTER 
          BEQ  L90B8          BRANCH IF NO FORMATTED DIGITS TO THE RIGHT OF DECIMAL PT 
          DECA                SUBTRACT ONE FOR DECIMAL POINT 
L90B8     ADDA V47            *ADD THE BASE 10 EXPONENT OFFSET - ACCA CONTAINS THE 
*         *NUMBER OF SHIFTS REQUIRED TO ADJUST FPA0 TO THE SPECIFIED  
*         *NUMBER OF DlGITS TO THE RIGHT OF THE DECIMAL POINT  
          BMI  L90BD          IF ACCA >= 0 THEN NO SHIFTS ARE REQUIRED 
          CLRA                FORCE SHIFT COUNTER = 0 
L90BD     PSHS A              SAVE INITIAL SHIFT COUNTER ON THE STACK 
L90BF     BPL  L90CB          EXIT ROUTINE IF POSITIVE 
          PSHS A              SAVE SHIFT COUNTER ON STACK 
          JSR  LBB82          DIVIDE FPA0 BY 10 - SHIFT ONE DIGIT TO RIGHT 
          PULS A              GET SHIFT COUNTER FROM THE STACK 
          INCA                BUMP SHIFT COUNTER UP BY ONE 
          BRA  L90BF          CHECK FOR FURTHER DIVISION 
L90CB     LDA  V47            * GET BASE 10 EXPONENT OFFSET, ADD INITIAL SHIFT COUNTER 
          SUBA ,S+            * AND SAVE NEW BASE 10 EXPONENT OFFSET - BECAUSE 
          STA  V47            * FPA0 WAS SHIFTED ABOVE 
          ADDA #$09           * ADD NINE (SIGNIFICANT PLACES) AND BRANCH IF THERE ARE NO 
          BMI  L90EE          * ZEROES TO THE LEFT OF THE DECIMAL POINT IN THIS PRINT ITEM 
          LDA  VD9            *DETERMINE HOW MANY FILLER ZEROES TO THE LEFT OF THE DECIMAL 
          SUBA #$09           *POINT. GET THE NUMBER OF FORMAT PLACES TO LEFT OF DECIMAL 
          SUBA V47            *POINT, SUBTRACT THE BASE 10 EXPONENT OFFSET AND THE CONSTANT 9 
          BSR  L90EA          *(UNNORMALIZATION)-THEN OUTPUT THAT MANY ZEROES TO THE BUFFER 
          JSR  L9263          INITIALIZE DECIMAL POINT AND COMMA COUNTERS 
          BRA  L90FF          PROCESS THE REMAINDER OF THE PRINT ITEM 
*                              
* PUT (ACCA+1) ASCII ZEROES IN BUFFER                      
L90E2     PSHS A              SAVE ZERO COUNTER 
          LDA  #'0'           * INSERT A ZERO INTO 
          STA  ,U+            * THE BUFFER 
          PULS A              RESTORE ZERO COUNTER 
                               
* PUT ACCA ASCII ZEROES INTO THE BUFFER                      
L90EA     DECA                DECREMENT ZERO COUNTER 
          BPL  L90E2          BRANCH IF NOT DONE 
          RTS                  
                               
L90EE     LDA  VD9            * GET THE LEFT DIGIT COUNTER AND PUT 
          BSR  L90EA          * THAT MANY ZEROES IN THE STRiNG BUFFER 
          JSR  L924D          PUT THE DECIMAL POINT IN THE STRING BUFFER 
          LDA  #-9            *DETERMINE HOW MANY FILLER ZEROES BETWEEN THE DECIMAL POINT 
          SUBA V47            *AND SIGNIFICANT DATA. SUBTRACT BASE 10 EXPONENT FROM -9 
          BSR  L90EA          *(UNNORMALIZATION) AND OUTPUT THAT MANY ZEROES TO BUFFER 
          CLR  V45            CLEAR THE DECIMAL POINT COUNTER - SUPPRESS THE DECIMAL POINT 
          CLR  VD7            CLEAR THE COMMA COUNTER - SUPPRESS COMMAS 
L90FF     JSR  L9202          DECODE FPA0 INTO A DECIMAL ASCII STRING 
          LDA  VD8            GET THE RIGHT DIGIT COUNTER 
          BNE  L9108          BRANCH IF RIGHT DIGIT COUNTER <> 0 
          LDU  VARPTR         RESET BUFFER PTR TO THE DECIMAL POINT IF NO DIGITS TO RIGHT 
L9108     ADDA V47            *ADD BASE 10 EXPONENT - A POSITIVE ACCA WILL CAUSE THAT MANY 
* *FILLER ZEROES TO BE OUTPUT TO THE RIGHT OF LAST SIGNIFICANT DATA                      
*         *SIGNIFICANT DATA            
          LBRA L9050          INSERT LEADING ASTERISKS, FLOATING DOLLAR SIGN, ETC 
*                              
* FORCE THE NUMERIC OUTPUT FORMAT TO BE EXPONENTIAL FORMAT                      
L910D     LDA  FP0EXP         * GET EXPONENT OF FPA0 AND 
          PSHS A              * SAVE IT ON THE STACK 
          BEQ  L9116          BRANCH IF FPA0 = 0 
          JSR  L91CD          *CONVERT FPA0 INTO A NUMBER WITH 9 SIGNIFICANT 
*         *DIGITS TO THE LEFT OF THE DECIMAL POINT  
L9116     LDA  VD8            GET THE RIGHT DIGIT COUNTER 
          BEQ  L911B          BRANCH IF NO FORMATTED DIGITS TO THE RIGHT 
          DECA                SUBTRACT ONE FOR THE DECIMAL POINT 
L911B     ADDA VD9            ADD TO THE LEFT DIGIT COUNTER 
          CLR  STRBUF+3       CLEAR BUFFER BYTE AS TEMPORARY STORAGE LOCATION 
          LDB  VDA            * GET THE STATUS BYTE FOR A 
          ANDB #$04           * POST-BYTE FORCE; BRANCH IF 
          BNE  L9129          * A POST-BYTE FORCE 
          COM  STRBUF+3       TOGGLE BUFFER BYTE TO -1 IF NO POST-BYTE FORCE 
L9129     ADDA STRBUF+3       SUBTRACT 1 IF NO POST BYTE FORCE 
          SUBA #$09           *SUBTRACT 9 (DUE TO THE CONVERSION TO 9 
*         *SIGNIFICANT DIGITS TO LEFT OF DECIMAL POINT)  
          PSHS A              * SAVE SHIFT COUNTER ON THE STACK - ACCA CONTAINS THE NUMBER 
*         OF   SHIFTS REQUIRED TO ADJUST FPA0 FOR THE NUMBER OF  
*         FORMATTED PLACES TO THE RIGHT OF THE DECIMAL POINT.  
L9130     BPL  L913C          NO MORE SHIFTS WHEN ACCA >= 0 
          PSHS A              SAVE SHIFT COUNTER 
          JSR  LBB82          DIVIDE FPA0 BY 10 - SHIFT TO RIGHT ONE 
          PULS A              RESTORE THE SHIFT COUNTER 
          INCA                ADD 1 TO SHIFT COUNTER 
          BRA  L9130          CHECK FOR FURTHER SHIFTING (DIVISION) 
L913C     LDA  ,S             *GET THE INITIAL VALUE OF THE SHIFT COUNTER 
          BMI  L9141          *AND BRANCH IF SHIFTING HAS TAKEN PLACE 
          CLRA                RESET ACCA IF NO SHIFTING HAS TAKEN PLACE 
L9141     NEGA                *CALCULATE THE POSITION OF THE DECIMAL POINT BY 
          ADDA VD9            *NEGATING SHIFT COUNTER, ADDING THE LEFT DIGIT COUNTER 
          INCA                *PLUS ONE AND THE POST-BYTE POSlTION, IF USED 
          ADDA STRBUF+3       * 
          STA  V45            SAVE DECIMAL POINT COUNTER 
          CLR  VD7            CLEAR COMMA COUNTER - NO COMMAS INSERTED 
          JSR  L9202          CONVERT FPA0 INTO ASCII DECIMAL STRING 
          PULS A              * GET THE INITIAL VALUE OF SHIFT COUNTER AND 
          JSR  L9281          * INSERT THAT MANY ZEROES INTO THE BUFFER 
          LDA  VD8            *GET THE RIGHT DIGIT COUNTER AND BRANCH 
          BNE  L915A          *IF NOT ZERO 
          LEAU $-01,U         MOVE BUFFER POINTER BACK ONE 
                               
* CALCULATE VALUE OF EXPONENT AND PUT IN STRING BUFFER                      
L915A     LDB  ,S+            GET ORIGINAL EXPONENT OF FPA0 
          BEQ  L9167          BRANCH IF EXPONENT = 0 
          LDB  V47            GET BASE 10 EXPONENT 
          ADDB #$09           ADD 9 FOR 9 SIGNIFICANT DIGIT CONVERSION 
          SUBB VD9            SUBTRACT LEFT DIGIT COUNTER 
          SUBB STRBUF+3       ADD ONE TO EXPONENT IF POST-SIGN FORCE 
L9167     LDA  #'+'           PLUS SIGN 
          TSTB TEST EXPONENT   
          BPL  L916F          BRANCH IF POSITIVE EXPONENT 
          LDA  #'-'           MINUS SIGN 
          NEGB                CONVERT EXPONENT TO POSITIVE NUMBER 
L916F     STA  $01,U          PUT SIGN OF EXPONENT IN STRING BUFFER 
          LDA  #'E'           * PUT AN ‘E’ (EXPONENTIATION FLAG) IN 
          STA  ,U++           * BUFFER AND SKIP OVER THE SIGN 
          LDA  #$2F           * WAS LDA #'0'-1 
*CONVERT BINARY EXPONENT IN ACCB TO ASCII VALUE IN ACCA                      
L9177     INCA                ADD ONE TO TENS DIGIT COUNTER 
          SUBB #10            *SUBTRACT 10 FROM EXPONENT AND ADD ONE TO TENS 
          BCC  L9177          * DIGIT IF NO CARRY. TENS DIGIT DONE IF THERE IS A CARRY 
          ADDB #$3A           WAS ADDB #'9'+1 
          STD  ,U++           SAVE EXPONENT IN BUFFER 
          CLR  ,U             CLEAR FINAL BYTE IN BUFFER - PRINT TERMINATOR 
          JMP  L9054          INSERT ASTERISK PADDING, FLOATING DOLLAR SIGN, ETC. 
                               
* INSERT ASTERISK PADDING, FLOATING $ AND PRE-SIGN                      
L9185     LDX  #STRBUF+4      POINT X TO START OF PRINT ITEM BUFFER 
          LDB  ,X             * GET SIGN BYTE OF ITEM-LIST BUFFER 
          PSHS B              * AND SAVE IT ON THE STACK 
          LDA  #SPACE         DEFAULT PAD WITH BLANKS 
          LDB  VDA            * GET STATUS BYTE AND CHECK FOR 
          BITB #$20           * ASTERISK LEFT PADDING 
          PULS B              GET SIGN BYTE AGAIN 
          BEQ  L919E          BRANCH IF NO PADDING 
          LDA  #'*'           PAD WITH ASTERISK 
          CMPB #SPACE         WAS THE FIRST BYTE A BLANK (POSITIVE)? 
          BNE  L919E          NO 
          TFR  A,B            TRANSFER PAD CHARACTER TO ACCB 
L919E     PSHS B              SAVE FIRST CHARACTER ON STACK 
L91A0     STA  ,X+            STORE PAD CHARACTER IN BUFFER 
          LDB  ,X             GET NEXT CHARACTER IN BUFFER 
          BEQ  L91B6          INSERT A ZERO IF END OF BUFFER 
          CMPB #'E'           * CHECK FOR AN ‘E’ AND 
          BEQ  L91B6          * PUT A ZERO BEFORE IT 
          CMPB #'0'           * REPLACE LEADING ZEROES WITH 
          BEQ  L91A0          * PAD CHARACTERS 
          CMPB #','           * REPLACE LEADING COMMAS 
          BEQ  L91A0          * WITH PAD CHARACTERS 
          CMPB #'.'           * CHECK FOR DECIMAL POINT 
          BNE  L91BA          * AND DON’T PUT A ZERO BEFORE IT 
L91B6     LDA  #'0'           * REPLACE PREVIOUS CHARACTER 
          STA  ,-X            * WITH A ZERO 
L91BA     LDA  VDA            * GET STATUS BYTE, CHECK 
          BITA #$10           * FOR FLOATING $ 
          BEQ  L91C4          * BRANCH IF NO FLOATING $ 
          LDB  #'$'           * STORE A $ IN 
          STB  ,-X            * BUFFER 
L91C4     ANDA #$04           CHECK PRE-SIGN FLAG 
          PULS B              GET SIGN CHARACTER 
          BNE  L91CC          RETURN IF POST-SIGN REQUIRED 
          STB  ,-X            STORE FIRST CHARACTER 
L91CC     RTS                  
*                              
* CONVERT FPA0 INTO A NUMBER OF THE FORM - NNN,NNN,NNN X 10**M.                      
* THE EXPONENT M WILL BE RETURNED IN V47 (BASE 10 EXPONENT).                      
L91CD     PSHS U              SAVE BUFFER POINTER 
          CLRA                INITIAL EXPONENT OFFSET = 0 
L91D0     STA  V47            SAVE EXPONENT OFFSET 
          LDB  FP0EXP         GET EXPONENT OF FPA0 
          CMPB #$80           * COMPARE TO EXPONENT OF .5 
          BHI  L91E9          * AND BRANCH IF FPA0 > = 1.0 
                               
* IF FPA0 < 1.0, MULTIPLY IT BY 1E+09 UNTIL IT IS >= 1                      
          LDX  #LBDC0         POINT X TO FP NUMBER (1E+09) 
          JSR  LBACA          MULTIPLY FPA0 BY 1E+09 
          LDA  V47            GET EXPONENT OFFSET 
          SUBA #$09           SUBTRACT 9 (BECAUSE WE MULTIPLIED BY 1E+09 ABOVE) 
          BRA  L91D0          CHECK TO SEE IF > 1.0 
L91E4     JSR  LBB82          DIVIDE FPA0 BY 10 
          INC  V47            INCREMENT EXPONENT OFFSET 
L91E9     LDX  #LBDBB         POINT X TO FP NUMBER (999,999,999) 
          JSR  LBCA0          COMPARE FPA0 TO X 
          BGT  L91E4          BRANCH IF FPA0 > 999,999,999 
L91F1     LDX  #LBDB6         POINT X TO FP NUMBER (99,999,999.9) 
          JSR  LBCA0          COMPARE FPA0 TO X 
          BGT  L9200          RETURN IF 999,999,999 > FPA0 > 99,999,999.9 
          JSR  LBB6A          MULTIPLY FPA0 BY 10 
          DEC  V47            DECREMENT EXPONENT OFFSET 
          BRA  L91F1          KEEP UNNORMALIZING 
L9200     PULS U,PC           RESTORE BUFFER POINTER AND RETURN 
*                              
* CONVERT FPA0 INTO AN INTEGER, THEN DECODE IT                      
* INTO A DECIMAL ASCII STRING IN THE BUFFER                      
L9202     PSHS U              SAVE BUFFER POINTER 
          JSR  LB9B4          ADD .5 TO FPA0 (ROUND OFF) 
          JSR  LBCC8          CONVERT FPA0 TO INTEGER FORMAT 
          PULS U              RESTORE BUFFER POINTER 
*                              
* CONVERT FPA0 INTO A DECIMAL ASCII STRING                      
          LDX  #LBEC5         POINT X TO UNNORMALIZED POWERS OF 10 
          LDB  #$80           INITIALIZE DIGIT COUNTER TO 0 + $80. 
* BIT 7 SET IS USED TO INDICATE THAT THE POWER OF 10 MANTISSA                      
* IS NEGATIVE. WHEN YOU ‘ADD’ A NEGATIVE MANTISSA, IT IS                      
* THE SAME AS SUBTRACTING A POSITIVE ONE AND BIT 7 OF ACCB                      
* IS HOW THIS ROUTINE KNOWS THAT A ‘SUBTRACTION’ IS OCCURRING.                      
L9211     BSR  L9249          CHECK FOR COMMA INSERTION 
L9213     LDA  FPA0+3         * ‘ADD’ A POWER OF 10 MANTISSA TO FPA0. 
          ADDA $03,X          * IF THE MANTISSA IS NEGATIVE, A SUBTRACTION 
          STA  FPA0+3         * WILL BE WHAT REALLY TAKES PLACE. 
          LDA  FPA0+2         * 
          ADCA $02,X          * 
          STA  FPA0+2         * 
          LDA  FPA0+1         * 
          ADCA $01,X          * 
          STA  FPA0+1         * 
          LDA  FPA0           * 
          ADCA ,X             * 
          STA  FPA0           * 
          INCB                ADD ONE TO DIGIT COUNTER 
          RORB ROTATE CARRY INTO BIT 7  
          ROLB                * SET OVERFLOW FLAG - BRANCH IF CARRY SET AND 
          BVC  L9213          * ADDING MANTISSA OR CARRY CLEAR AND SUBTRACTING MANTISSA 
          BCC  L9235          BRANCH IF SUBTRACTING MANTISSA 
          SUBB #10+1          WAS SUBB #10+1 
          NEGB                * IF ADDING MANTISSA 
L9235     ADDB #$2F           WAS ADDB #'0'-1 
          LEAX $04,X          MOVE TO NEXT POWER OF 10 MANTISSA 
          TFR  B,A            SAVE DIGIT IN ACCA 
          ANDA #$7F           MASK OFF ADD/SUBTRACT FLAG (BIT 7) 
          STA  ,U+            STORE DIGIT IN BUFFER 
          COMB                TOGGLE ADD/SUBTRACT FLAG 
          ANDB #$80           MASK OFF EVERYTHING BUT ADD/SUB FLAG 
          CMPX #LBEE9         COMPARE TO END OF UNNORMALIZED POWERS OF 10 
          BNE  L9211          BRANCH IF NOT DONE 
          CLR  ,U             PUT A ZERO AT END OF INTEGER 
                               
* DECREMENT DECIMAL POINT COUNTER AND CHECK FOR COMMA INSERTION                      
L9249     DEC  V45            DECREMENT DECIMAL POINT COUNTER 
          BNE  L9256          NOT TIME FOR DECIMAL POINT 
L924D     STU  VARPTR         SAVE BUFFER POINTER-POSITION OF THE DECIMAL POINT 
          LDA  #'.'           * STORE A DECIMAL 
          STA  ,U+            * POINT IN THE OUTPUT BUFFER 
          CLR  VD7            * CLEAR COMMA COUNTER - NOW IT WILL TAKE 255 
*                             * DECREMENTS BEFORE ANOTHER COMMA WILL BE INSERTED 
          RTS                  
L9256     DEC  VD7            DECREMENT COMMA COUNTER 
          BNE  L9262          RETURN IF NOT TIME FOR COMMA 
          LDA  #$03           * RESET COMMA COUNTER TO 3; THREE 
          STA  VD7            * DIGITS BETWEEN COMMAS 
          LDA  #','           * PUT A COMMA INTO 
          STA  ,U+            * THE BUFFER 
L9262     RTS                  
                               
* INITIALIZE DECIMAL POINT AND COMMA COUNTERS                      
L9263     LDA  V47            GET THE BASE 10 EXPONENT OFFSET 
          ADDA #10            * ADD 10 (FPA0 WAS ‘NORMALIZED’ TO 9 PLACES LEFT 
          STA  V45            * OF DECIMAL POINT) - SAVE IN DECIMAL POINT COUNTER 
          INCA                ADD ONE FOR THE DECIMAL POINT 
L926A     SUBA #$03           * DIVIDE DECIMAL POINT COUNTER BY 3; LEAVE 
          BCC  L926A          * THE REMAINDER IN ACCA 
          ADDA #$05           CONVERT REMAINDER INTO A NUMBER FROM 1-3 
          STA  VD7            SAVE COMMA COUNTER 
          LDA  VDA            GET STATUS BYTE 
          ANDA #$40           CHECK FOR COMMA FLAG 
          BNE  L927A          BRANCH IF COMMA FLAG ACTIVE 
          STA  VD7            CLEAR COMMA COUNTER - 255 DIGITS OUTPUT BEFORE A COMMA 
L927A     RTS                  
*                              
* INSERT ACCA ZEROES INTO THE BUFFER                      
L927B     PSHS A              SAVE ZEROES COUNTER 
          BSR  L9249          CHECK FOR DECIMAL POINT 
          PULS A              RESTORE ZEROES COUNTER 
L9281     DECA                * DECREMENT ZEROES COUNTER AND 
          BMI  L928E          * RETURN IF < 0 
          PSHS A              SAVE ZEROES COUNTER 
          LDA  #'0'           * PUT A ZERO INTO 
          STA  ,U+            * THE BUFFER 
          LDA  ,S+            RESTORE THE ZEROES COUNTER 
          BNE  L927B          BRANCH IF NOT DONE 
L928E     RTS                  
                               
                               
* LINE                         
LINE      CMPA #TOK_INPUT     ‘INPUT’ TOKEN 
          LBEQ L89C0          GO DO ‘LINE INPUT’ COMMAND 
          JMP  LB277          ‘SYNTAX ERROR’ IF NOT "LINE INPUT" 
                               
                               
* END OF EXTENDED BASIC                      
* INTERRUPT VECTORS                      
          ORG  $FFF0           
LBFF0     FDB  $0000          RESERVED 
LBFF2     FDB  SW3VEC         SWI3 
LBFF4     FDB  SW2VEC         SWI2 
LBFF6     FDB  FRQVEC         FIRQ 
LBFF8     FDB  IRQVEC         IRQ 
LBFFA     FDB  SWIVEC         SWI 
LBFFC     FDB  NMIVEC         NMI 
LBFFE     FDB  RESVEC         RESET 
