.TITLE Enhanced Basic for the KIM-1 Computer Simulator
          .FILES H65, INTHEX, MOTSREC, XREF
          .PRINT COLS 120, STATS

; Enhanced BASIC  $ver 2.22p5
; Original version/source by Lee Davison w/updates to Version 2.22
; Patches and updates by Klaus Dorman Version 2.22p5
; Original source from https://github.com/Klaus2m5/6502_EhBASIC_V2.22/tree/master/patched
; Most fully patched version
; 
; Modified to run under the Hans Otten KIM-1 6502 simulator
; Carl Myerholtz 10/2024 www.w9oms.com

; Uses the simulated 6850 ACIA for I/O
; All ACIA functions are coded in the source.
; No calls to a monitor are made. Should be very easy to port
; to another 6502 environment with a ACIA
; Modify as needed Origin, Ram_base, Ram_top currently $2000, $4800, $E000
; for the Hans Otten simulator. 6850 ACIA base address is $1620
; Note enBasic uses page 2 $0200 so lowest Origin or Ram_base is $0300
;
; Modifications:
;	1. Decss changed from $EF to $DC to move away from KIM-1 memory allocations
;	2. Ibuffe changed from $47 (72) to $78 (120) to increase input buffer to 120 characters
;	3. Start at $2000 and Ram_top determined automatically at end of assembly
;	4. Embeded 6850 ACIA code for serial i/o and RST_vec startup code
;	5. Interrupt code was cut out. Removed IRQ,NMI,RETIRQ,RETNMI
;	6. Added a BYE command that exits to the KIM monitor. Cold start needed after BYE

; 2.00      new revision numbers start here
; 2.01      fixed LCASE$() and UCASE$()
; 2.02      new get value routine done
; 2.03      changed RND() to galoise method
; 2.04      fixed SPC()
; 2.05      new get value routine fixed
; 2.06      changed USR() code
; 2.07      fixed STR$()
; 2.08      changed INPUT and READ to remove need for $00 start to input buffer
; 2.09      fixed RND()
; 2.10      integrated missed changes from an earlier version
; 2.20      added ELSE to IF .. THEN and fixed IF .. GOTO <statement> to cause error
; 2.21      fixed IF .. THEN RETURN to not cause error
; 2.22      fixed RND() breaking the get byte routine
; 2.22p     patched to disable use of decimal mode and fix Ibuff issues
;              (bugsnquirks.txt notes 2, 4 and 5)
;              tabs converted to spaces, tabwidth=6
; 2.22p2    fixed can't continue error on 1st statement after direct mode
;              changed INPUT to throw "break in line ##" on empty line input
; 2.22p3    fixed RAM above code / Ibuff above EhBASIC patch breaks STR$()
;              fix provided by github user mgcaret
; 2.22p4    fixed string compare of equal strings in direct mode returns FALSE
;              fixed FALSE stored to a variable after a string compare 
;                 is > 0 and < 1E-16
;              added additional stack floor protection for background interrupts
;              fixed conditional LOOP & NEXT cannot find their data strucure on stack
; 2.22p5    fixes issues reported by users Ruud and dclxvi on the 6502.org forum
;      5.0     http://forum.6502.org/viewtopic.php?f=5&t=5500
;              sanity check for RAM top allows values below RAM base
;      5.1-7   http://forum.6502.org/viewtopic.php?f=5&t=5606
;              1-7 coresponds to the bug# in the thread
;      5.1     TO expression with a subtract may evaluate with the sign bit flipped
;      5.3     call to LAB_1B5B may return to an address -$100 (page not incremented)
;      5.4     string concatenate followed by MINUS or NOT() crashes EhBASIC
;      5.5     garbage collection may cause an overlap with temporary strings
;      5.6     floating point multiply rounding bug
;      5.7     VAL() may cause string variables to be trashed
				.PAGE
; zero page use ..

; the following locations are bulk initialized from StrTab at LAB_GMEM
LAB_WARM          .EQU $00       ; BASIC warm start entry point
Wrmjpl            .EQU LAB_WARM+1; BASIC warm start vector jump low byte
Wrmjph            .EQU LAB_WARM+2; BASIC warm start vector jump high byte

Usrjmp            .EQU $0A       ; USR function JMP address
Usrjpl            .EQU Usrjmp+1  ; USR function JMP vector low byte
Usrjph            .EQU Usrjmp+2  ; USR function JMP vector high byte
Nullct            .EQU $0D       ; nulls output after each line
TPos              .EQU $0E       ; BASIC terminal position byte
TWidth            .EQU $0F       ; BASIC terminal width byte
Iclim             .EQU $10       ; input column limit
Itempl            .EQU $11       ; temporary integer low byte
Itemph            .EQU Itempl+1  ; temporary integer high byte

; end bulk initialize from StrTab at LAB_GMEM

nums_1            .EQU Itempl    ; number to bin/hex string convert MSB
nums_2            .EQU nums_1+1  ; number to bin/hex string convert
nums_3            .EQU nums_1+2  ; number to bin/hex string convert LSB

Srchc             .EQU $5B       ; search character
Temp3             .EQU Srchc     ; temp byte used in number routines
Scnquo            .EQU $5C       ; scan-between-quotes flag
Asrch             .EQU Scnquo    ; alt search character

XOAw_l            .EQU Srchc     ; eXclusive OR, OR and AND word low byte
XOAw_h            .EQU Scnquo    ; eXclusive OR, OR and AND word high byte

Ibptr             .EQU $5D       ; input buffer pointer
Dimcnt            .EQU Ibptr     ; # of dimensions
Tindx             .EQU Ibptr     ; token index

Defdim            .EQU $5E       ; default DIM flag
Dtypef            .EQU $5F       ; data type flag, $FF=string, $00=numeric
Oquote            .EQU $60   ; open quote flag (b7) (Flag: DATA scan; LIST quote; memory)
Gclctd            .EQU $60       ; garbage collected flag
Sufnxf            .EQU $61       ; subscript/FNX flag, 1xxx xxx = FN(0xxx xxx)
Imode             .EQU $62       ; input mode flag, $00=INPUT, $80=READ

Cflag             .EQU $63       ; comparison evaluation flag

TabSiz            .EQU $64       ; TAB step size (was input flag)

next_s            .EQU $65       ; next descriptor stack address

                              ; these two bytes form a word pointer to the item
                              ; currently on top of the descriptor stack
last_sl           .EQU $66       ; last descriptor stack address low byte
last_sh           .EQU $67       ; last descriptor stack address high byte (always $00)

des_sk            .EQU $68       ; descriptor stack start address (temp strings)

;                 .EQU $70       ; End of descriptor stack

ut1_pl            .EQU $71       ; utility pointer 1 low byte
ut1_ph            .EQU ut1_pl+1  ; utility pointer 1 high byte
ut2_pl            .EQU $73       ; utility pointer 2 low byte
ut2_ph            .EQU ut2_pl+1  ; utility pointer 2 high byte

Temp_2            .EQU ut1_pl    ; temp byte for block move    

FACt_1            .EQU $75       ; FAC temp mantissa1
FACt_2            .EQU FACt_1+1  ; FAC temp mantissa2
FACt_3            .EQU FACt_2+1  ; FAC temp mantissa3

dims_l            .EQU FACt_2    ; array dimension size low byte
dims_h            .EQU FACt_3    ; array dimension size high byte

TempB             .EQU $78       ; temp page 0 byte

Smeml             .EQU $79       ; start of mem low byte       (Start-of-Basic)
Smemh             .EQU Smeml+1   ; start of mem high byte      (Start-of-Basic)
Svarl             .EQU $7B       ; start of vars low byte      (Start-of-Variables)
Svarh             .EQU Svarl+1   ; start of vars high byte     (Start-of-Variables)
Sarryl            .EQU $7D       ; var mem end low byte        (Start-of-Arrays)
Sarryh            .EQU Sarryl+1  ; var mem end high byte       (Start-of-Arrays)
Earryl            .EQU $7F       ; array mem end low byte      (End-of-Arrays)
Earryh            .EQU Earryl+1  ; array mem end high byte     (End-of-Arrays)
Sstorl            .EQU $81       ; string storage low byte (String storage (moving down))
Sstorh            .EQU Sstorl+1  ; string storage high byte (String storage (moving down))
Sutill            .EQU $83       ; string utility ptr low byte
Sutilh            .EQU Sutill+1  ; string utility ptr high byte
Ememl             .EQU $85       ; end of mem low byte     (Limit-of-memory)
Ememh             .EQU Ememl+1   ; end of mem high byte    (Limit-of-memory)
Clinel            .EQU $87       ; current line low byte   (Basic line number)
Clineh            .EQU Clinel+1  ; current line high byte  (Basic line number)
Blinel            .EQU $89       ; break line low byte     (Previous Basic line number)
Blineh            .EQU Blinel+1  ; break line high byte    (Previous Basic line number)

Cpntrl            .EQU $8B       ; continue pointer low byte
Cpntrh            .EQU Cpntrl+1  ; continue pointer high byte

Dlinel            .EQU $8D       ; current DATA line low byte
Dlineh            .EQU Dlinel+1  ; current DATA line high byte

Dptrl             .EQU $8F       ; DATA pointer low byte
Dptrh             .EQU Dptrl+1   ; DATA pointer high byte

Rdptrl            .EQU $91       ; read pointer low byte
Rdptrh            .EQU Rdptrl+1  ; read pointer high byte

Varnm1            .EQU $93       ; current var name 1st byte
Varnm2            .EQU Varnm1+1  ; current var name 2nd byte

Cvaral            .EQU $95       ; current var address low byte
Cvarah            .EQU Cvaral+1  ; current var address high byte

Frnxtl            .EQU $97       ; var pointer for FOR/NEXT low byte
Frnxth            .EQU Frnxtl+1  ; var pointer for FOR/NEXT high byte

Tidx1             .EQU Frnxtl    ; temp line index

Lvarpl            .EQU Frnxtl    ; let var pointer low byte
Lvarph            .EQU Frnxth    ; let var pointer high byte

prstk             .EQU $99       ; precedence stacked flag

comp_f            .EQU $9B       ; compare function flag, bits 0,1 and 2 used
								 ; bit 2 set if >
                                 ; bit 1 set if =
                                 ; bit 0 set if <

func_l            .EQU $9C       ; function pointer low byte
func_h            .EQU func_l+1  ; function pointer high byte

garb_l            .EQU func_l    ; garbage collection working pointer low byte
garb_h            .EQU func_h    ; garbage collection working pointer high byte

des_2l            .EQU $9E       ; string descriptor_2 pointer low byte
des_2h            .EQU des_2l+1  ; string descriptor_2 pointer high byte

g_step            .EQU $A0       ; garbage collect step size

Fnxjmp            .EQU $A1       ; jump vector for functions
Fnxjpl            .EQU Fnxjmp+1  ; functions jump vector low byte
Fnxjph            .EQU Fnxjmp+2  ; functions jump vector high byte

g_indx            .EQU Fnxjpl    ; garbage collect temp index

FAC2_r            .EQU $A3       ; FAC2 rounding byte

Adatal            .EQU $A4       ; array data pointer low byte
Adatah            .EQU Adatal+1  ; array data pointer high  byte

Nbendl            .EQU Adatal    ; new block end pointer low byte
Nbendh            .EQU Adatah    ; new block end pointer high  byte

Obendl            .EQU $A6       ; old block end pointer low byte
Obendh            .EQU Obendl+1  ; old block end pointer high  byte

numexp            .EQU $A8       ; string to float number exponent count
expcnt            .EQU $A9       ; string to float exponent count

numbit            .EQU numexp    ; bit count for array element calculations

numdpf            .EQU $AA       ; string to float decimal point flag
expneg            .EQU $AB       ; string to float eval exponent -ve flag

Astrtl            .EQU numdpf    ; array start pointer low byte
Astrth            .EQU expneg    ; array start pointer high  byte

Histrl            .EQU numdpf    ; highest string low byte
Histrh            .EQU expneg    ; highest string high  byte

Baslnl            .EQU numdpf    ; BASIC search line pointer low byte
Baslnh            .EQU expneg    ; BASIC search line pointer high  byte

Fvar_l            .EQU numdpf    ; find/found variable pointer low byte
Fvar_h            .EQU expneg    ; find/found variable pointer high  byte

Ostrtl            .EQU numdpf    ; old block start pointer low byte
Ostrth            .EQU expneg    ; old block start pointer high  byte

Vrschl            .EQU numdpf    ; variable search pointer low byte
Vrschh            .EQU expneg    ; variable search pointer high  byte

FAC1_e            .EQU $AC       ; FAC1 exponent
FAC1_1            .EQU FAC1_e+1  ; FAC1 mantissa1
FAC1_2            .EQU FAC1_e+2  ; FAC1 mantissa2
FAC1_3            .EQU FAC1_e+3  ; FAC1 mantissa3
FAC1_s            .EQU FAC1_e+4  ; FAC1 sign (b7)

str_ln            .EQU FAC1_e    ; string length
str_pl            .EQU FAC1_1    ; string pointer low byte
str_ph            .EQU FAC1_2    ; string pointer high byte

des_pl            .EQU FAC1_2    ; string descriptor pointer low byte
des_ph            .EQU FAC1_3    ; string descriptor pointer high byte

mids_l            .EQU FAC1_3    ; MID$ string temp length byte

negnum            .EQU $B1       ; string to float eval -ve flag
numcon            .EQU $B1       ; series evaluation constant count

FAC1_o            .EQU $B2       ; FAC1 overflow byte

FAC2_e            .EQU $B3       ; FAC2 exponent
FAC2_1            .EQU FAC2_e+1  ; FAC2 mantissa1
FAC2_2            .EQU FAC2_e+2  ; FAC2 mantissa2
FAC2_3            .EQU FAC2_e+3  ; FAC2 mantissa3
FAC2_s            .EQU FAC2_e+4  ; FAC2 sign (b7)

FAC_sc            .EQU $B8       ; FAC sign comparison, Acc#1 vs #2
FAC1_r            .EQU $B9       ; FAC1 rounding byte

ssptr_l           .EQU FAC_sc    ; string start pointer low byte
ssptr_h           .EQU FAC1_r    ; string start pointer high byte

sdescr            .EQU FAC_sc    ; string descriptor pointer

csidx             .EQU $BA       ; line crunch save index
Asptl             .EQU csidx     ; array size/pointer low byte
Aspth             .EQU $BB       ; array size/pointer high byte

Btmpl             .EQU Asptl     ; BASIC pointer temp low byte
Btmph             .EQU Aspth     ; BASIC pointer temp low byte

Cptrl             .EQU Asptl     ; BASIC pointer temp low byte
Cptrh             .EQU Aspth     ; BASIC pointer temp low byte

Sendl             .EQU Asptl     ; BASIC pointer temp low byte
Sendh             .EQU Aspth     ; BASIC pointer temp low byte

; the following locations are bulk initialized from LAB_2CEE at LAB_2D4E
LAB_IGBY          .EQU $BC       ; get next BASIC byte subroutine

LAB_GBYT          .EQU $C2       ; get current BASIC byte subroutine
Bpntrl            .EQU $C3       ; BASIC execute (get byte) pointer low byte
Bpntrh            .EQU Bpntrl+1  ; BASIC execute (get byte) pointer high byte

;                 .EQU $D7       ; end of get BASIC char subroutine
; end bulk initialize from LAB_2CEE at LAB_2D4E

Rbyte4            .EQU $D8       ; extra PRNG byte
Rbyte1            .EQU Rbyte4+1  ; most significant PRNG byte
Rbyte2            .EQU Rbyte4+2  ; middle PRNG byte
Rbyte3            .EQU Rbyte4+3  ; least significant PRNG byte


Decss             .EQU $DC ; Move away from KIM scratch number to dec string start
Decssp1           .EQU Decss+1   ; number to decimal string start

;                 .EQU $Decsspl + 17       ; decimal string end

; token values needed for BASIC

; primary command tokens (can start a statement)


TK_END            .EQU $80             ; END token
TK_FOR            .EQU TK_END+1        ; FOR token
TK_NEXT           .EQU TK_FOR+1        ; NEXT token
TK_DATA           .EQU TK_NEXT+1       ; DATA token
TK_INPUT          .EQU TK_DATA+1       ; INPUT token
TK_DIM            .EQU TK_INPUT+1      ; DIM token
TK_READ           .EQU TK_DIM+1        ; READ token
TK_LET            .EQU TK_READ+1       ; LET token
TK_DEC            .EQU TK_LET+1        ; DEC token
TK_GOTO           .EQU TK_DEC+1        ; GOTO token
TK_RUN            .EQU TK_GOTO+1       ; RUN token
TK_IF             .EQU TK_RUN+1        ; IF token
TK_RESTORE        .EQU TK_IF+1         ; RESTORE token
TK_GOSUB          .EQU TK_RESTORE+1    ; GOSUB token
TK_RETURN         .EQU TK_GOSUB+1     ; RETURN token
TK_REM            .EQU TK_RETURN+1     ; REM token
TK_STOP           .EQU TK_REM+1        ; STOP token
TK_ON             .EQU TK_STOP+1       ; ON token
TK_NULL           .EQU TK_ON+1         ; NULL token
TK_INC            .EQU TK_NULL+1       ; INC token
TK_WAIT           .EQU TK_INC+1        ; WAIT token
TK_LOAD           .EQU TK_WAIT+1       ; LOAD token
TK_SAVE           .EQU TK_LOAD+1       ; SAVE token
TK_DEF            .EQU TK_SAVE+1       ; DEF token
TK_POKE           .EQU TK_DEF+1        ; POKE token
TK_DOKE           .EQU TK_POKE+1       ; DOKE token
TK_CALL           .EQU TK_DOKE+1       ; CALL token
TK_DO             .EQU TK_CALL+1       ; DO token
TK_LOOP           .EQU TK_DO+1         ; LOOP token
TK_PRINT          .EQU TK_LOOP+1       ; PRINT token
TK_CONT           .EQU TK_PRINT+1      ; CONT token
TK_LIST           .EQU TK_CONT+1       ; LIST token
TK_CLEAR          .EQU TK_LIST+1       ; CLEAR token
TK_NEW            .EQU TK_CLEAR+1      ; NEW token
TK_WIDTH          .EQU TK_NEW+1        ; WIDTH token
TK_GET            .EQU TK_WIDTH+1      ; GET token
TK_SWAP           .EQU TK_GET+1        ; SWAP token
TK_BITSET         .EQU TK_SWAP+1       ; BITSET token
TK_BITCLR         .EQU TK_BITSET+1     ; BITCLR token
TK_BYE			  .EQU TK_BITCLR+1	   ; BYE token

; secondary command tokens, can't start a statement

TK_TAB            .EQU TK_BYE+1        ; TAB token
TK_ELSE           .EQU TK_TAB+1        ; ELSE token
TK_TO             .EQU TK_ELSE+1       ; TO token
TK_FN             .EQU TK_TO+1         ; FN token
TK_SPC            .EQU TK_FN+1         ; SPC token
TK_THEN           .EQU TK_SPC+1        ; THEN token
TK_NOT            .EQU TK_THEN+1       ; NOT token
TK_STEP           .EQU TK_NOT+1        ; STEP token
TK_UNTIL          .EQU TK_STEP+1       ; UNTIL token
TK_WHILE          .EQU TK_UNTIL+1      ; WHILE token
TK_OFF            .EQU TK_WHILE+1      ; OFF token

; opperator tokens

TK_PLUS           .EQU TK_OFF+1        ; + token
TK_MINUS          .EQU TK_PLUS+1       ; - token
TK_MUL            .EQU TK_MINUS+1      ; * token
TK_DIV            .EQU TK_MUL+1        ; / token
TK_POWER          .EQU TK_DIV+1        ; ^ token
TK_AND            .EQU TK_POWER+1      ; AND token
TK_EOR            .EQU TK_AND+1        ; EOR token
TK_OR             .EQU TK_EOR+1        ; OR token
TK_RSHIFT         .EQU TK_OR+1         ; RSHIFT token
TK_LSHIFT         .EQU TK_RSHIFT+1     ; LSHIFT token
TK_GT             .EQU TK_LSHIFT+1     ; > token
TK_EQUAL          .EQU TK_GT+1         ; = token
TK_LT             .EQU TK_EQUAL+1      ; < token

; functions tokens

TK_SGN            .EQU TK_LT+1         ; SGN token
TK_INT            .EQU TK_SGN+1        ; INT token
TK_ABS            .EQU TK_INT+1        ; ABS token
TK_USR            .EQU TK_ABS+1        ; USR token
TK_FRE            .EQU TK_USR+1        ; FRE token
TK_POS            .EQU TK_FRE+1        ; POS token
TK_SQR            .EQU TK_POS+1        ; SQR token
TK_RND            .EQU TK_SQR+1        ; RND token
TK_LOG            .EQU TK_RND+1        ; LOG token
TK_EXP            .EQU TK_LOG+1        ; EXP token
TK_COS            .EQU TK_EXP+1        ; COS token
TK_SIN            .EQU TK_COS+1        ; SIN token
TK_TAN            .EQU TK_SIN+1        ; TAN token
TK_ATN            .EQU TK_TAN+1        ; ATN token
TK_PEEK           .EQU TK_ATN+1        ; PEEK token
TK_DEEK           .EQU TK_PEEK+1       ; DEEK token
TK_SADD           .EQU TK_DEEK+1       ; SADD token
TK_LEN            .EQU TK_SADD+1       ; LEN token
TK_STRS           .EQU TK_LEN+1        ; STR$ token
TK_VAL            .EQU TK_STRS+1       ; VAL token
TK_ASC            .EQU TK_VAL+1        ; ASC token
TK_UCASES         .EQU TK_ASC+1        ; UCASE$ token
TK_LCASES         .EQU TK_UCASES+1     ; LCASE$ token
TK_CHRS           .EQU TK_LCASES+1     ; CHR$ token
TK_HEXS           .EQU TK_CHRS+1       ; HEX$ token
TK_BINS           .EQU TK_HEXS+1       ; BIN$ token
TK_BITTST         .EQU TK_BINS+1       ; BITTST token
TK_MAX            .EQU TK_BITTST+1     ; MAX token
TK_MIN            .EQU TK_MAX+1        ; MIN token
TK_PI             .EQU TK_MIN+1        ; PI token
TK_TWOPI          .EQU TK_PI+1         ; TWOPI token
TK_VPTR           .EQU TK_TWOPI+1      ; VARPTR token
TK_LEFTS          .EQU TK_VPTR+1       ; LEFT$ token
TK_RIGHTS         .EQU TK_LEFTS+1      ; RIGHT$ token
TK_MIDS           .EQU TK_RIGHTS+1     ; MID$ token

; offsets from a base of X or Y

PLUS_0            .EQU $00       ; X or Y plus 0
PLUS_1            .EQU $01       ; X or Y plus 1
PLUS_2            .EQU $02       ; X or Y plus 2
PLUS_3            .EQU $03       ; X or Y plus 3

LAB_STAK          .EQU $0100     ; stack bottom, no offset

LAB_SKFE          .EQU LAB_STAK+$FE
                              ; flushed stack address
LAB_SKFF          .EQU LAB_STAK+$FF
                              ; flushed stack address

; the following locations are bulk initialized from PG2_TABS at LAB_COLD
ccflag            .EQU $0200     ; BASIC CTRL-C flag, 00 = enabled, 01 = dis
ccbyte            .EQU ccflag+1  ; BASIC CTRL-C byte
ccnull            .EQU ccbyte+1  ; BASIC CTRL-C byte timeout
VEC_CC            .EQU ccnull+1  ; ctrl c check vector

; end bulk initialize from PG2_TABS at LAB_COLD

; the following locations are bulk initialized by Res_vec from LAB_vec at LAB_stlp
VEC_IN            .EQU VEC_CC+2  ; input vector
VEC_OUT           .EQU VEC_IN+2  ; output vector
VEC_LD            .EQU VEC_OUT+2 ; load vector
VEC_SV            .EQU VEC_LD+2  ; save vector
; end bulk initialize by min_mon.asm from LAB_vec at LAB_stlp

; Ibuffs can now be anywhere in RAM, ensure that the max length is < $80,
; the input buffer must not cross a page boundary and must not overlap with
; program RAM pages!

Ibuffs            .EQU VEC_SV+$16
                              ; start of input buffer after IRQ/NMI code
Ibuffe            .EQU Ibuffs+$78 ; end of input buffer extend to 120 char

Ram_base          .EQU (END_CODE + $FF ) & $FF00 ; start of user RAM 
Ram_top           .EQU $E000 ; end of user RAM+1 (should be page aligned)

Stack_floor       .EQU 16        ; bytes left free on stack for background interrupts

; This start can be changed to suit your system

      *=    $2000

; BASIC cold start entry point

; new page 2 initialisation, copy block to ccflag on

	  JMP	RES_vec			  ; Goto reset to initialize the system
LAB_COLD
      LDY   #PG2_TABE - PG2_TABS - 1
                              ; byte count-1
LAB_2D13
      LDA   PG2_TABS,Y        ; get byte
      STA   ccflag,Y          ; store in page 2
      DEY                     ; decrement count
      BPL   LAB_2D13          ; loop if not done

      LDX   #$FF              ; set byte
      STX   Clineh            ; set current line high byte (set immediate mode)
      TXS                     ; reset stack pointer

      LDA   #$4C              ; code for JMP
      STA   Fnxjmp            ; save for jump vector for functions

; copy block from LAB_2CEE to $00BC - $00D7

      LDX   #StrTab-LAB_2CEE  ; set byte count
LAB_2D4E
      LDA   LAB_2CEE-1,X      ; get byte from table
      STA   LAB_IGBY-1,X      ; save byte in page zero
      DEX                     ; decrement count
      BNE   LAB_2D4E          ; loop if not all done

; copy block from StrTab to $0000 - $0012

LAB_GMEM
      LDX   #EndTab-StrTab-1  ; set byte count-1
TabLoop
      LDA   StrTab,X          ; get byte from table
      STA   PLUS_0,X          ; save byte in page zero
      DEX                     ; decrement count
      BPL   TabLoop           ; loop if not all done

; set-up start values

      LDA   #$00              ; clear A
      STA   FAC1_o            ; clear FAC1 overflow byte
      STA   last_sh           ; clear descriptor stack top item pointer high byte

      LDA   #$0E              ; set default tab size
      STA   TabSiz            ; save it
      LDA   #$03              ; set garbage collect step size for descriptor stack
      STA   g_step            ; save it
      LDX   #des_sk           ; descriptor stack start
      STX   next_s            ; set descriptor stack pointer
      JSR   LAB_CRLF          ; print CR/LF
      LDA   #<LAB_MSZM        ; point to memory size message (low addr)
      LDY   #>LAB_MSZM        ; point to memory size message (high addr)
      JSR   LAB_18C3          ; print null terminated string from memory
      JSR   LAB_INLN          ; print "? " and get BASIC input
      STX   Bpntrl            ; set BASIC execute pointer low byte
      STY   Bpntrh            ; set BASIC execute pointer high byte
      JSR   LAB_GBYT          ; get last byte back

      BNE   LAB_2DAA          ; branch if not null (user typed something)

      LDY   #$00              ; else clear Y
                              ; character was null so get memory size the hard way
                              ; we get here with Y=0 and Itempl/h = Ram_base
LAB_2D93
      INC   Itempl            ; increment temporary integer low byte
      BNE   LAB_2D99          ; branch if no overflow

      INC   Itemph            ; increment temporary integer high byte
      LDA   Itemph            ; get high byte
      CMP   #>Ram_top         ; compare with top of RAM+1
      BEQ   LAB_2DB6          ; branch if match (end of user RAM)

LAB_2D99
      LDA   #$55              ; set test byte
      STA   (Itempl),Y        ; save via temporary integer
      CMP   (Itempl),Y        ; compare via temporary integer
      BNE   LAB_2DB6          ; branch if fail

      ASL                     ; shift test byte left (now $AA)
      STA   (Itempl),Y        ; save via temporary integer
      CMP   (Itempl),Y        ; compare via temporary integer
      BEQ   LAB_2D93          ; if ok go do next byte

      BNE   LAB_2DB6          ; branch if fail

LAB_2DAA
      JSR   LAB_2887          ; get FAC1 from string
      LDA   FAC1_e            ; get FAC1 exponent
      CMP   #$98              ; compare with exponent = 2^24
      BCS   LAB_GMEM          ; if too large go try again

      JSR   LAB_F2FU          ; save integer part of FAC1 in temporary integer
                              ; (no range check)

LAB_2DB6
      LDA   Itempl            ; get temporary integer low byte
      LDY   Itemph            ; get temporary integer high byte
; *** begin patch  2.22p5.0 RAM top sanity check ***
; *** replace
;      CPY   #<Ram_base+1      ; compare with start of RAM+$100 high byte
; +++ with
      CPY   #>Ram_base+1      ; compare with start of RAM+$100 high byte
; *** end patch    2.22p5.0 ***
      BCC   LAB_GMEM          ; if too small go try again


; uncomment these lines if you want to check on the high limit of memory. Note if
; Ram_top is set too low then this will fail. default is ignore it and assume the
; users know what they're doing!

;     CPY   #>Ram_top         ; compare with top of RAM high byte
;     BCC   MEM_OK            ; branch if < RAM top

;     BNE   LAB_GMEM          ; if too large go try again
                              ; else was = so compare low bytes
;     CMP   #<Ram_top         ; compare with top of RAM low byte
;     BEQ   MEM_OK            ; branch if = RAM top

;     BCS   LAB_GMEM          ; if too large go try again

MEM_OK
      STA   Ememl             ; set end of mem low byte
      STY   Ememh             ; set end of mem high byte
      STA   Sstorl            ; set bottom of string space low byte
      STY   Sstorh            ; set bottom of string space high byte

      LDY   #<Ram_base        ; set start addr low byte
      LDX   #>Ram_base        ; set start addr high byte
      STY   Smeml             ; save start of mem low byte
      STX   Smemh             ; save start of mem high byte

; this line is only needed if Ram_base is not $xx00

;      LDY   #$00              ; clear Y

      TYA                     ; clear A
      STA   (Smeml),Y         ; clear first byte
      INC   Smeml             ; increment start of mem low byte

; these two lines are only needed if Ram_base is $xxFF

;      BNE   LAB_2E05          ; branch if no rollover
;      INC   Smemh   
          ; increment start of mem high byte
LAB_2E05
      JSR   LAB_CRLF          ; print CR/LF
      JSR   LAB_1463          ; do "NEW" and "CLEAR"
      LDA   Ememl             ; get end of mem low byte
      SEC                     ; set carry for subtract
      SBC   Smeml             ; subtract start of mem low byte
      TAX                     ; copy to X
      LDA   Ememh             ; get end of mem high byte
      SBC   Smemh             ; subtract start of mem high byte
      JSR   LAB_295E          ; print XA as unsigned integer (bytes free)
      LDA   #<LAB_SMSG        ; point to sign-on message (low addr)
      LDY   #>LAB_SMSG        ; point to sign-on message (high addr)
      JSR   LAB_18C3          ; print null terminated string from memory
      LDA   #<LAB_1274        ; warm start vector low byte
      LDY   #>LAB_1274        ; warm start vector high byte
      STA   Wrmjpl            ; save warm start vector low byte
      STY   Wrmjph            ; save warm start vector high byte
      JMP   (Wrmjpl)          ; go do warm start

; open up space in memory
; move (Ostrtl)-(Obendl) to new block ending at (Nbendl)

; Nbendl,Nbendh - new block end address (A/Y)
; Obendl,Obendh - old block end address
; Ostrtl,Ostrth - old block start address

; returns with ..

; Nbendl,Nbendh - new block start address (high byte - $100)
; Obendl,Obendh - old block start address (high byte - $100)
; Ostrtl,Ostrth - old block start address (unchanged)

LAB_11CF
      JSR   LAB_121F          ; check available memory, "Out of memory" error if no room
                              ; addr to check is in AY (low/high)
      STA   Earryl            ; save new array mem end low byte
      STY   Earryh            ; save new array mem end high byte

; open up space in memory
; move (Ostrtl)-(Obendl) to new block ending at (Nbendl)
; don't set array end

LAB_11D6
      SEC                     ; set carry for subtract
      LDA   Obendl            ; get block end low byte
      SBC   Ostrtl            ; subtract block start low byte
      TAY                     ; copy MOD(block length/$100) byte to Y
      LDA   Obendh            ; get block end high byte
      SBC   Ostrth            ; subtract block start high byte
      TAX                     ; copy block length high byte to X
      INX                     ; +1 to allow for count=0 exit
      TYA                     ; copy block length low byte to A
      BEQ   LAB_120A          ; branch if length low byte=0

                              ; block is (X-1)*256+Y bytes, do the Y bytes first

      SEC                     ; set carry for add + 1, two's complement
      EOR   #$FF              ; invert low byte for subtract
      ADC   Obendl            ; add block end low byte

      STA   Obendl            ; save corrected old block end low byte
      BCS   LAB_11F3          ; branch if no underflow

      DEC   Obendh            ; else decrement block end high byte
      SEC                     ; set carry for add + 1, two's complement
LAB_11F3
      TYA                     ; get MOD(block length/$100) byte
      EOR   #$FF              ; invert low byte for subtract
      ADC   Nbendl            ; add destination end low byte
      STA   Nbendl            ; save modified new block end low byte
      BCS   LAB_1203          ; branch if no underflow

      DEC   Nbendh            ; else decrement block end high byte
      BCC   LAB_1203          ; branch always

LAB_11FF
      LDA   (Obendl),Y        ; get byte from source
      STA   (Nbendl),Y        ; copy byte to destination
LAB_1203
      DEY                     ; decrement index
      BNE   LAB_11FF          ; loop until Y=0

                              ; now do Y=0 indexed byte
      LDA   (Obendl),Y        ; get byte from source
      STA   (Nbendl),Y        ; save byte to destination
LAB_120A
      DEC   Obendh            ; decrement source pointer high byte
      DEC   Nbendh            ; decrement destination pointer high byte
      DEX                     ; decrement block count
      BNE   LAB_1203          ; loop until count = $0

      RTS

; check room on stack for A bytes
; stack too deep? do OM error

LAB_1212
; *** patch - additional stack floor protection for background interrupts
; *** add
;
      CLC                     ; prep ADC
      ADC   #Stack_floor      ; stack pointer lower limit before interrupts

; *** end patch
      STA   TempB             ; save result in temp byte
      TSX                     ; copy stack
      CPX   TempB             ; compare new "limit" with stack
      BCC   LAB_OMER          ; if stack < limit do "Out of memory" error then warm start

      RTS

; check available memory, "Out of memory" error if no room
; addr to check is in AY (low/high)

LAB_121F
      CPY   Sstorh            ; compare bottom of string mem high byte
      BCC   LAB_124B          ; if less then exit (is ok)

      BNE   LAB_1229          ; skip next test if greater (tested <)

                              ; high byte was =, now do low byte
      CMP   Sstorl            ; compare with bottom of string mem low byte
      BCC   LAB_124B          ; if less then exit (is ok)

                              ; addr is > string storage ptr (oops!)
LAB_1229
      PHA                     ; push addr low byte
      LDX   #$08              ; set index to save Adatal to expneg inclusive
      TYA                     ; copy addr high byte (to push on stack)

                              ; save misc numeric work area
LAB_122D
      PHA                     ; push byte
      LDA   Adatal-1,X        ; get byte from Adatal to expneg ( ,$00 not pushed)
      DEX                     ; decrement index
      BPL   LAB_122D          ; loop until all done

      JSR   LAB_GARB          ; garbage collection routine

                              ; restore misc numeric work area
      LDX   #$00              ; clear the index to restore bytes
LAB_1238
      PLA                     ; pop byte
      STA   Adatal,X          ; save byte to Adatal to expneg
      INX                     ; increment index
      CPX   #$08              ; compare with end + 1
      BMI   LAB_1238          ; loop if more to do

      PLA                     ; pop addr high byte
      TAY                     ; copy back to Y
      PLA                     ; pop addr low byte
      CPY   Sstorh            ; compare bottom of string mem high byte
      BCC   LAB_124B          ; if less then exit (is ok)

      BNE   LAB_OMER          ; if greater do "Out of memory" error then warm start

                              ; high byte was =, now do low byte
      CMP   Sstorl            ; compare with bottom of string mem low byte
      BCS   LAB_OMER          ; if >= do "Out of memory" error then warm start

                              ; ok exit, carry clear
LAB_124B
      RTS

; do "Out of memory" error then warm start

LAB_OMER
      LDX   #$0C              ; error code $0C ("Out of memory" error)

; do error #X, then warm start

LAB_XERR
      JSR   LAB_CRLF          ; print CR/LF

      LDA   LAB_BAER,X        ; get error message pointer low byte
      LDY   LAB_BAER+1,X      ; get error message pointer high byte
      JSR   LAB_18C3          ; print null terminated string from memory

      JSR   LAB_1491          ; flush stack and clear continue flag
      LDA   #<LAB_EMSG        ; point to " Error" low addr
      LDY   #>LAB_EMSG        ; point to " Error" high addr
LAB_1269
      JSR   LAB_18C3          ; print null terminated string from memory
      LDY   Clineh            ; get current line high byte
      INY                     ; increment it
      BEQ   LAB_1274          ; go do warm start (was immediate mode)

                              ; else print line number
      JSR   LAB_2953          ; print " in line [LINE #]"

; BASIC warm start entry point
; wait for Basic command

LAB_1274
      LDA   #<LAB_RMSG        ; point to "Ready" message low byte
      LDY   #>LAB_RMSG        ; point to "Ready" message high byte

      JSR   LAB_18C3          ; go do print string

; wait for Basic command (no "Ready")

LAB_127D
      JSR   LAB_1357          ; call for BASIC input
LAB_1280
      STX   Bpntrl            ; set BASIC execute pointer low byte
      STY   Bpntrh            ; set BASIC execute pointer high byte
      JSR   LAB_GBYT          ; scan memory
      BEQ   LAB_127D          ; loop while null

; got to interpret input line now ..

      LDX   #$FF              ; current line to null value
      STX   Clineh            ; set current line high byte
      BCC   LAB_1295          ; branch if numeric character (handle new BASIC line)

                              ; no line number .. immediate mode
      JSR   LAB_13A6          ; crunch keywords into Basic tokens
      JMP   LAB_15F6          ; go scan and interpret code

; handle new BASIC line

LAB_1295
      JSR   LAB_GFPN          ; get fixed-point number into temp integer
      JSR   LAB_13A6          ; crunch keywords into Basic tokens
      STY   Ibptr             ; save index pointer to end of crunched line
      JSR   LAB_SSLN          ; search BASIC for temp integer line number
      BCC   LAB_12E6          ; branch if not found

                              ; aroooogah! line # already exists! delete it
      LDY   #$01              ; set index to next line pointer high byte
      LDA   (Baslnl),Y        ; get next line pointer high byte
      STA   ut1_ph            ; save it
      LDA   Svarl             ; get start of vars low byte
      STA   ut1_pl            ; save it
      LDA   Baslnh            ; get found line pointer high byte
      STA   ut2_ph            ; save it
      LDA   Baslnl            ; get found line pointer low byte
      DEY                     ; decrement index
      SBC   (Baslnl),Y        ; subtract next line pointer low byte
      CLC                     ; clear carry for add
      ADC   Svarl             ; add start of vars low byte
      STA   Svarl             ; save new start of vars low byte
      STA   ut2_pl            ; save destination pointer low byte
      LDA   Svarh             ; get start of vars high byte
      ADC   #$FF              ; -1 + carry
      STA   Svarh             ; save start of vars high byte
      SBC   Baslnh            ; subtract found line pointer high byte
      TAX                     ; copy to block count
      SEC                     ; set carry for subtract
      LDA   Baslnl            ; get found line pointer low byte
      SBC   Svarl             ; subtract start of vars low byte
      TAY                     ; copy to bytes in first block count
      BCS   LAB_12D0          ; branch if overflow

      INX                     ; increment block count (correct for =0 loop exit)
      DEC   ut2_ph            ; decrement destination high byte
LAB_12D0
      CLC                     ; clear carry for add
      ADC   ut1_pl            ; add source pointer low byte
      BCC   LAB_12D8          ; branch if no overflow

      DEC   ut1_ph            ; else decrement source pointer high byte
      CLC                     ; clear carry

                              ; close up memory to delete old line
LAB_12D8
      LDA   (ut1_pl),Y        ; get byte from source
      STA   (ut2_pl),Y        ; copy to destination
      INY                     ; increment index
      BNE   LAB_12D8          ; while <> 0 do this block

      INC   ut1_ph            ; increment source pointer high byte
      INC   ut2_ph            ; increment destination pointer high byte
      DEX                     ; decrement block count
      BNE   LAB_12D8          ; loop until all done

                              ; got new line in buffer and no existing same #
LAB_12E6
      LDA   Ibuffs            ; get byte from start of input buffer
      BEQ   LAB_1319          ; if null line just go flush stack/vars and exit

                              ; got new line and it isn't empty line
      LDA   Ememl             ; get end of mem low byte
      LDY   Ememh             ; get end of mem high byte
      STA   Sstorl            ; set bottom of string space low byte
      STY   Sstorh            ; set bottom of string space high byte
      LDA   Svarl             ; get start of vars low byte  (end of BASIC)
      STA   Obendl            ; save old block end low byte
      LDY   Svarh             ; get start of vars high byte (end of BASIC)
      STY   Obendh            ; save old block end high byte
      ADC   Ibptr             ; add input buffer pointer    (also buffer length)
      BCC   LAB_1301          ; branch if no overflow from add

      INY                     ; else increment high byte
LAB_1301
      STA   Nbendl            ; save new block end low byte (move to, low byte)
      STY   Nbendh            ; save new block end high byte
      JSR   LAB_11CF          ; open up space in memory
                              ; old start pointer Ostrtl,Ostrth set by the find line call
      LDA   Earryl            ; get array mem end low byte
      LDY   Earryh            ; get array mem end high byte
      STA   Svarl             ; save start of vars low byte
      STY   Svarh             ; save start of vars high byte
      LDY   Ibptr             ; get input buffer pointer    (also buffer length)
      DEY                     ; adjust for loop type
LAB_1311
      LDA   Ibuffs-4,Y        ; get byte from crunched line
      STA   (Baslnl),Y        ; save it to program memory
      DEY                     ; decrement count
      CPY   #$03              ; compare with first byte-1
      BNE   LAB_1311          ; continue while count <> 3

      LDA   Itemph            ; get line # high byte
      STA   (Baslnl),Y        ; save it to program memory
      DEY                     ; decrement count
      LDA   Itempl            ; get line # low byte
      STA   (Baslnl),Y        ; save it to program memory
      DEY                     ; decrement count
      LDA   #$FF              ; set byte to allow chain rebuild. if you didn't set this
                              ; byte then a zero already here would stop the chain rebuild
                              ; as it would think it was the [EOT] marker.
      STA   (Baslnl),Y        ; save it to program memory

LAB_1319
      JSR   LAB_1477          ; reset execution to start, clear vars and flush stack
      LDX   Smeml             ; get start of mem low byte
      LDA   Smemh             ; get start of mem high byte
      LDY   #$01              ; index to high byte of next line pointer
LAB_1325
      STX   ut1_pl            ; set line start pointer low byte
      STA   ut1_ph            ; set line start pointer high byte
      LDA   (ut1_pl),Y        ; get it
      BEQ   LAB_133E          ; exit if end of program

; rebuild chaining of Basic lines

      LDY   #$04              ; point to first code byte of line
                              ; there is always 1 byte + [EOL] as null entries are deleted
LAB_1330
      INY                     ; next code byte
      LDA   (ut1_pl),Y        ; get byte
      BNE   LAB_1330          ; loop if not [EOL]

      SEC                     ; set carry for add + 1
      TYA                     ; copy end index
      ADC   ut1_pl            ; add to line start pointer low byte
      TAX                     ; copy to X
      LDY   #$00              ; clear index, point to this line's next line pointer
      STA   (ut1_pl),Y        ; set next line pointer low byte
      TYA                     ; clear A
      ADC   ut1_ph            ; add line start pointer high byte + carry
      INY                     ; increment index to high byte
      STA   (ut1_pl),Y        ; save next line pointer low byte
      BCC   LAB_1325          ; go do next line, branch always, carry clear


LAB_133E
      JMP   LAB_127D          ; else we just wait for Basic command, no "Ready"

; print "? " and get BASIC input

LAB_INLN
      JSR   LAB_18E3          ; print "?" character
      JSR   LAB_18E0          ; print " "
      BNE   LAB_1357          ; call for BASIC input and return

; receive line from keyboard

                              ; $08 as delete key (BACKSPACE on standard keyboard)
LAB_134B
      JSR   LAB_PRNA          ; go print the character
      DEX                     ; decrement the buffer counter (delete)
     .db $2C               ; make LDX into BIT abs

; call for BASIC input (main entry point)

LAB_1357
      LDX   #$00              ; clear BASIC line buffer pointer
LAB_1359
      JSR   V_INPT            ; call scan input device
      BCC   LAB_1359          ; loop if no byte

      BEQ   LAB_1359          ; loop until valid input (ignore NULLs)

      CMP   #$07              ; compare with [BELL]
      BEQ   LAB_1378          ; branch if [BELL]

      CMP   #$0D              ; compare with [CR]
      BEQ   LAB_1384          ; do CR/LF exit if [CR]

      CPX   #$00              ; compare pointer with $00
      BNE   LAB_1374          ; branch if not empty

; next two lines ignore any non print character and [SPACE] if input buffer empty

      CMP   #$21              ; compare with [SP]+1
      BCC   LAB_1359          ; if < ignore character

LAB_1374
      CMP   #$08              ; compare with [BACKSPACE] (delete last character)
      BEQ   LAB_134B          ; go delete last character

LAB_1378
      CPX   #Ibuffe-Ibuffs    ; compare character count with max
      BCS   LAB_138E          ; skip store and do [BELL] if buffer full

      STA   Ibuffs,X          ; else store in buffer
      INX                     ; increment pointer
LAB_137F
      JSR   LAB_PRNA          ; go print the character
      BNE   LAB_1359          ; always loop for next character

LAB_1384
      JMP   LAB_1866          ; do CR/LF exit to BASIC

; announce buffer full

LAB_138E
      LDA   #$07              ; [BELL] character into A
      BNE   LAB_137F          ; go print the [BELL] but ignore input character
                              ; branch always

; crunch keywords into Basic tokens
; position independent buffer version ..
; faster, dictionary search version ....

LAB_13A6
      LDY   #$FF              ; set save index (makes for easy math later)

      SEC                     ; set carry for subtract
      LDA   Bpntrl            ; get basic execute pointer low byte
      SBC   #<Ibuffs          ; subtract input buffer start pointer
      TAX                     ; copy result to X (index past line # if any)

      STX   Oquote            ; clear open quote/DATA flag
LAB_13AC
      LDA   Ibuffs,X          ; get byte from input buffer
      BEQ   LAB_13EC          ; if null save byte then exit

      CMP   #'_'              ; compare with "_"
      BCS   LAB_13EC          ; if >= go save byte then continue crunching

      CMP   #'<'              ; compare with "<"
      BCS   LAB_13CC          ; if >= go crunch now

      CMP   #'0'              ; compare with "0"
      BCS   LAB_13EC          ; if >= go save byte then continue crunching

      STA   Scnquo            ; save buffer byte as search character
      CMP   #$22              ; is it quote character?
      BEQ   LAB_1410          ; branch if so (copy quoted string)

      CMP   #'*'              ; compare with "*"
      BCC   LAB_13EC          ; if < go save byte then continue crunching

                              ; else crunch now
LAB_13CC
      BIT   Oquote            ; get open quote/DATA token flag
      BVS   LAB_13EC          ; branch if b6 of Oquote set (was DATA)
                              ; go save byte then continue crunching

      STX   TempB             ; save buffer read index
      STY   csidx             ; copy buffer save index
      LDY   #<TAB_1STC        ; get keyword first character table low address
      STY   ut2_pl            ; save pointer low byte
      LDY   #>TAB_1STC        ; get keyword first character table high address
      STY   ut2_ph            ; save pointer high byte
      LDY   #$00              ; clear table pointer

LAB_13D0
      CMP   (ut2_pl),Y        ; compare with keyword first character table byte
      BEQ   LAB_13D1          ; go do word_table_chr if match

      BCC   LAB_13EA          ; if < keyword first character table byte go restore
                              ; Y and save to crunched

      INY                     ; else increment pointer
      BNE   LAB_13D0          ; and loop (branch always)

; have matched first character of some keyword

LAB_13D1
      TYA                     ; copy matching index
      ASL                     ; *2 (bytes per pointer)
      TAX                     ; copy to new index
      LDA   TAB_CHRT,X        ; get keyword table pointer low byte
      STA   ut2_pl            ; save pointer low byte
      LDA   TAB_CHRT+1,X      ; get keyword table pointer high byte
      STA   ut2_ph            ; save pointer high byte

      LDY   #$FF              ; clear table pointer (make -1 for start)

      LDX   TempB             ; restore buffer read index

LAB_13D6
      INY                     ; next table byte
      LDA   (ut2_pl),Y        ; get byte from table
LAB_13D8
      BMI   LAB_13EA          ; all bytes matched so go save token

      INX                     ; next buffer byte
      CMP   Ibuffs,X          ; compare with byte from input buffer
      BEQ   LAB_13D6          ; go compare next if match

      BNE   LAB_1417          ; branch if >< (not found keyword)

LAB_13EA
      LDY   csidx             ; restore save index

                              ; save crunched to output
LAB_13EC
      INX                     ; increment buffer index (to next input byte)
      INY                     ; increment save index (to next output byte)
      STA   Ibuffs,Y          ; save byte to output
      CMP   #$00              ; set the flags, set carry
      BEQ   LAB_142A          ; do exit if was null [EOL]

                              ; A holds token or byte here
      SBC   #':'              ; subtract ":" (carry set by CMP #00)
      BEQ   LAB_13FF          ; branch if it was ":" (is now $00)

                              ; A now holds token-$3A
      CMP   #TK_DATA-$3A      ; compare with DATA token - $3A
      BNE   LAB_1401          ; branch if not DATA

                              ; token was : or DATA
LAB_13FF
      STA   Oquote            ; save token-$3A (clear for ":", TK_DATA-$3A for DATA)
LAB_1401
      EOR   #TK_REM-$3A       ; effectively subtract REM token offset
      BNE   LAB_13AC          ; If wasn't REM then go crunch rest of line

      STA   Asrch             ; else was REM so set search for [EOL]

                              ; loop for REM, "..." etc.
LAB_1408
      LDA   Ibuffs,X          ; get byte from input buffer
      BEQ   LAB_13EC          ; branch if null [EOL]

      CMP   Asrch             ; compare with stored character
      BEQ   LAB_13EC          ; branch if match (end quote)

                              ; entry for copy string in quotes, don't crunch
LAB_1410
      INY                     ; increment buffer save index
      STA   Ibuffs,Y          ; save byte to output
      INX                     ; increment buffer read index
      BNE   LAB_1408          ; loop while <> 0 (should never be 0!)

                              ; not found keyword this go
LAB_1417
      LDX   TempB             ; compare has failed, restore buffer index (start byte!)

                              ; now find the end of this word in the table
LAB_141B
      LDA   (ut2_pl),Y        ; get table byte
      PHP                     ; save status
      INY                     ; increment table index
      PLP                     ; restore byte status
      BPL   LAB_141B          ; if not end of keyword go do next

      LDA   (ut2_pl),Y        ; get byte from keyword table
      BNE   LAB_13D8          ; go test next word if not zero byte (end of table)

                              ; reached end of table with no match
      LDA   Ibuffs,X          ; restore byte from input buffer
      BPL   LAB_13EA          ; branch always (all bytes in buffer are $00-$7F)
                              ; go save byte in output and continue crunching

                              ; reached [EOL]
LAB_142A
      INY                     ; increment pointer
      INY                     ; increment pointer (makes it next line pointer high byte)
      STA   Ibuffs,Y          ; save [EOL] (marks [EOT] in immediate mode)
      INY                     ; adjust for line copy
      INY                     ; adjust for line copy
      INY                     ; adjust for line copy
; *** begin patch for when Ibuffs is $xx00 - Daryl Rictor ***
; *** insert
;
;      LDA   Bpntrl            ; test for $00
;      BNE   LAB_142P          ; not $00
;      DEC   Bpntrh            ; allow for increment when $xx00

LAB_142P

; *** end   patch for when Ibuffs is $xx00 - Daryl Rictor ***
; end of patch
      DEC   Bpntrl            ; allow for increment
      RTS

; search Basic for temp integer line number from start of mem

LAB_SSLN
      LDA   Smeml             ; get start of mem low byte
      LDX   Smemh             ; get start of mem high byte

; search Basic for temp integer line number from AX
; returns carry set if found
; returns Baslnl/Baslnh pointer to found or next higher (not found) line

; old 541 new 507

LAB_SHLN
      LDY   #$01              ; set index
      STA   Baslnl            ; save low byte as current
      STX   Baslnh            ; save high byte as current
      LDA   (Baslnl),Y        ; get pointer high byte from addr
      BEQ   LAB_145F          ; pointer was zero so we're done, do 'not found' exit

      LDY   #$03              ; set index to line # high byte
      LDA   (Baslnl),Y        ; get line # high byte
      DEY                     ; decrement index (point to low byte)
      CMP   Itemph            ; compare with temporary integer high byte
      BNE   LAB_1455          ; if <> skip low byte check

      LDA   (Baslnl),Y        ; get line # low byte
      CMP   Itempl            ; compare with temporary integer low byte
LAB_1455
      BCS   LAB_145E          ; else if temp < this line, exit (passed line#)

LAB_1456
      DEY                     ; decrement index to next line ptr high byte
      LDA   (Baslnl),Y        ; get next line pointer high byte
      TAX                     ; copy to X
      DEY                     ; decrement index to next line ptr low byte
      LDA   (Baslnl),Y        ; get next line pointer low byte
      BCC   LAB_SHLN          ; go search for line # in temp (Itempl/Itemph) from AX
                              ; (carry always clear)

LAB_145E
      BEQ   LAB_1460          ; exit if temp = found line #, carry is set

LAB_145F
      CLC                     ; clear found flag
LAB_1460
      RTS

; perform NEW

LAB_NEW
      BNE   LAB_1460          ; exit if not end of statement (to do syntax error)

LAB_1463
      LDA   #$00              ; clear A
      TAY                     ; clear Y
      STA   (Smeml),Y         ; clear first line, next line pointer, low byte
      INY                     ; increment index
      STA   (Smeml),Y         ; clear first line, next line pointer, high byte
      CLC                     ; clear carry
      LDA   Smeml             ; get start of mem low byte
      ADC   #$02              ; calculate end of BASIC low byte
      STA   Svarl             ; save start of vars low byte
      LDA   Smemh             ; get start of mem high byte
      ADC   #$00              ; add any carry
      STA   Svarh             ; save start of vars high byte

; reset execution to start, clear vars and flush stack

LAB_1477
      CLC                     ; clear carry
      LDA   Smeml             ; get start of mem low byte
      ADC   #$FF              ; -1
      STA   Bpntrl            ; save BASIC execute pointer low byte
      LDA   Smemh             ; get start of mem high byte
      ADC   #$FF              ; -1+carry
      STA   Bpntrh            ; save BASIC execute pointer high byte

; "CLEAR" command gets here

LAB_147A
      LDA   Ememl             ; get end of mem low byte
      LDY   Ememh             ; get end of mem high byte
      STA   Sstorl            ; set bottom of string space low byte
      STY   Sstorh            ; set bottom of string space high byte
      LDA   Svarl             ; get start of vars low byte
      LDY   Svarh             ; get start of vars high byte
      STA   Sarryl            ; save var mem end low byte
      STY   Sarryh            ; save var mem end high byte
      STA   Earryl            ; save array mem end low byte
      STY   Earryh            ; save array mem end high byte
      JSR   LAB_161A          ; perform RESTORE command

; flush stack and clear continue flag

LAB_1491
      LDX   #des_sk           ; set descriptor stack pointer
      STX   next_s            ; save descriptor stack pointer
      PLA                     ; pull return address low byte
      TAX                     ; copy return address low byte
      PLA                     ; pull return address high byte
      STX   LAB_SKFE          ; save to cleared stack
      STA   LAB_SKFF          ; save to cleared stack
      LDX   #$FD              ; new stack pointer
      TXS                     ; reset stack
      LDA   #$00              ; clear byte
;*** fix p2: no longer necessary as the continue pointer is saved anyway
;      STA   Cpntrh            ; clear continue pointer high byte
      STA   Sufnxf            ; clear subscript/FNX flag
LAB_14A6
      RTS

; perform CLEAR

LAB_CLEAR
      BEQ   LAB_147A          ; if no following token go do "CLEAR"

                              ; else there was a following token (go do syntax error)
      RTS

; perform LIST [n][-m]
; bigger, faster version (a _lot_ faster)

LAB_LIST
      BCC   LAB_14BD          ; branch if next character numeric (LIST n..)

      BEQ   LAB_14BD          ; branch if next character [NULL] (LIST)

      CMP   #TK_MINUS         ; compare with token for -
      BNE   LAB_14A6          ; exit if not - (LIST -m)

                              ; LIST [[n][-m]]
                              ; this bit sets the n , if present, as the start and end
LAB_14BD
      JSR   LAB_GFPN          ; get fixed-point number into temp integer
      JSR   LAB_SSLN          ; search BASIC for temp integer line number
                              ; (pointer in Baslnl/Baslnh)
      JSR   LAB_GBYT          ; scan memory
      BEQ   LAB_14D4          ; branch if no more characters

                              ; this bit checks the - is present
      CMP   #TK_MINUS         ; compare with token for -
      BNE   LAB_1460          ; return if not "-" (will be Syntax error)

                              ; LIST [n]-m
                              ; the - was there so set m as the end value
      JSR   LAB_IGBY          ; increment and scan memory
      JSR   LAB_GFPN          ; get fixed-point number into temp integer
      BNE   LAB_1460          ; exit if not ok

LAB_14D4
      LDA   Itempl            ; get temporary integer low byte
      ORA   Itemph            ; OR temporary integer high byte
      BNE   LAB_14E2          ; branch if start set

      LDA   #$FF              ; set for -1
      STA   Itempl            ; set temporary integer low byte
      STA   Itemph            ; set temporary integer high byte
LAB_14E2
      LDY   #$01              ; set index for line
      STY   Oquote            ; clear open quote flag
      JSR   LAB_CRLF          ; print CR/LF
      LDA   (Baslnl),Y        ; get next line pointer high byte
                              ; pointer initially set by search at LAB_14BD
      BEQ   LAB_152B          ; if null all done so exit
      JSR   LAB_1629          ; do CRTL-C check vector

      INY                     ; increment index for line
      LDA   (Baslnl),Y        ; get line # low byte
      TAX                     ; copy to X
      INY                     ; increment index
      LDA   (Baslnl),Y        ; get line # high byte
      CMP   Itemph            ; compare with temporary integer high byte
      BNE   LAB_14FF          ; branch if no high byte match

      CPX   Itempl            ; compare with temporary integer low byte
      BEQ   LAB_1501          ; branch if = last line to do (< will pass next branch)

LAB_14FF                      ; else ..
      BCS   LAB_152B          ; if greater all done so exit

LAB_1501
      STY   Tidx1             ; save index for line
      JSR   LAB_295E          ; print XA as unsigned integer
      LDA   #$20              ; space is the next character
LAB_1508
      LDY   Tidx1             ; get index for line
      AND   #$7F              ; mask top out bit of character
LAB_150C
      JSR   LAB_PRNA          ; go print the character
      CMP   #$22              ; was it " character
      BNE   LAB_1519          ; branch if not

                              ; we are either entering or leaving a pair of quotes
      LDA   Oquote            ; get open quote flag
      EOR   #$FF              ; toggle it
      STA   Oquote            ; save it back
LAB_1519
      INY                     ; increment index
      LDA   (Baslnl),Y        ; get next byte
      BNE   LAB_152E          ; branch if not [EOL] (go print character)
      TAY                     ; else clear index
      LDA   (Baslnl),Y        ; get next line pointer low byte
      TAX                     ; copy to X
      INY                     ; increment index
      LDA   (Baslnl),Y        ; get next line pointer high byte
      STX   Baslnl            ; set pointer to line low byte
      STA   Baslnh            ; set pointer to line high byte
      BNE   LAB_14E2          ; go do next line if not [EOT]
                              ; else ..
LAB_152B
      RTS

LAB_152E
      BPL   LAB_150C          ; just go print it if not token byte

                              ; else was token byte so uncrunch it (maybe)
      BIT   Oquote            ; test the open quote flag
      BMI   LAB_150C          ; just go print character if open quote set

      LDX   #>LAB_KEYT        ; get table address high byte
      ASL                     ; *2
      ASL                     ; *4
      BCC   LAB_152F          ; branch if no carry

      INX                     ; else increment high byte
      CLC                     ; clear carry for add
LAB_152F
      ADC   #<LAB_KEYT        ; add low byte
      BCC   LAB_1530          ; branch if no carry

      INX                     ; else increment high byte
LAB_1530
      STA   ut2_pl            ; save table pointer low byte
      STX   ut2_ph            ; save table pointer high byte
      STY   Tidx1             ; save index for line
      LDY   #$00              ; clear index
      LDA   (ut2_pl),Y        ; get length
      TAX                     ; copy length
      INY                     ; increment index
      LDA   (ut2_pl),Y        ; get 1st character
      DEX                     ; decrement length
      BEQ   LAB_1508          ; if no more characters exit and print

      JSR   LAB_PRNA          ; go print the character
      INY                     ; increment index
      LDA   (ut2_pl),Y        ; get keyword address low byte
      PHA                     ; save it for now
      INY                     ; increment index
      LDA   (ut2_pl),Y        ; get keyword address high byte
      LDY   #$00
      STA   ut2_ph            ; save keyword pointer high byte
      PLA                     ; pull low byte
      STA   ut2_pl            ; save keyword pointer low byte
LAB_1540
      LDA   (ut2_pl),Y        ; get character
      DEX                     ; decrement character count
      BEQ   LAB_1508          ; if last character exit and print

      JSR   LAB_PRNA          ; go print the character
      INY                     ; increment index
      BNE   LAB_1540          ; loop for next character

; perform FOR

LAB_FOR
      LDA   #$80              ; set FNX
      STA   Sufnxf            ; set subscript/FNX flag
      JSR   LAB_LET           ; go do LET
      PLA                     ; pull return address
      PLA                     ; pull return address
      LDA   #$10              ; we need 16d bytes !
      JSR   LAB_1212          ; check room on stack for A bytes
      JSR   LAB_SNBS          ; scan for next BASIC statement ([:] or [EOL])
      CLC                     ; clear carry for add
      TYA                     ; copy index to A
      ADC   Bpntrl            ; add BASIC execute pointer low byte
      PHA                     ; push onto stack
      LDA   Bpntrh            ; get BASIC execute pointer high byte
      ADC   #$00              ; add carry
      PHA                     ; push onto stack
      LDA   Clineh            ; get current line high byte
      PHA                     ; push onto stack
      LDA   Clinel            ; get current line low byte
      PHA                     ; push onto stack
      LDA   #TK_TO            ; get "TO" token
      JSR   LAB_SCCA          ; scan for CHR$(A) , else do syntax error then warm start
      JSR   LAB_CTNM          ; check if source is numeric, else do type mismatch
      JSR   LAB_EVNM          ; evaluate expression and check is numeric,
                              ; else do type mismatch
; *** begin patch  2.22p5.1   TO expression may get sign bit flipped
; *** add
      JSR   LAB_27BA          ; round FAC1
; *** end   patch  2.22p5.1   TO expression may get sign bit flipped
      LDA   FAC1_s            ; get FAC1 sign (b7)
      ORA   #$7F              ; set all non sign bits
      AND   FAC1_1            ; and FAC1 mantissa1
      STA   FAC1_1            ; save FAC1 mantissa1
      LDA   #<LAB_159F        ; set return address low byte
      LDY   #>LAB_159F        ; set return address high byte
      STA   ut1_pl            ; save return address low byte
      STY   ut1_ph            ; save return address high byte
      JMP   LAB_1B66          ; round FAC1 and put on stack (returns to next instruction)

LAB_159F
      LDA   #<LAB_259C        ; set 1 pointer low addr (default step size)
      LDY   #>LAB_259C        ; set 1 pointer high addr
      JSR   LAB_UFAC          ; unpack memory (AY) into FAC1
      JSR   LAB_GBYT          ; scan memory
      CMP   #TK_STEP          ; compare with STEP token
      BNE   LAB_15B3          ; jump if not "STEP"

                              ;.was step so ..
      JSR   LAB_IGBY          ; increment and scan memory
      JSR   LAB_EVNM          ; evaluate expression and check is numeric,
                              ; else do type mismatch
LAB_15B3
      JSR   LAB_27CA          ; return A=FF,C=1/-ve A=01,C=0/+ve
      STA   FAC1_s            ; set FAC1 sign (b7)
                              ; this is +1 for +ve step and -1 for -ve step, in NEXT we
                              ; compare the FOR value and the TO value and return +1 if
                              ; FOR > TO, 0 if FOR = TO and -1 if FOR < TO. the value
                              ; here (+/-1) is then compared to that result and if they
                              ; are the same (+ve and FOR > TO or -ve and FOR < TO) then
                              ; the loop is done
                             
; *** begin patch  2.22p5.3   potential return address -$100 (page not incremented) ***
; *** add
;     IF [* & $FF] == $FD
;      NOP                     ; return address of JSR +1 (on  next page)
; *** end   patch  2.22p5.3   potential return address -$100 (page not incremented) ***
      JSR   LAB_1B5B          ; push sign, round FAC1 and put on stack
      LDA   Frnxth            ; get var pointer for FOR/NEXT high byte
      PHA                     ; push on stack
      LDA   Frnxtl            ; get var pointer for FOR/NEXT low byte
      PHA                     ; push on stack
      LDA   #TK_FOR           ; get FOR token
      PHA                     ; push on stack

; interpreter inner loop

LAB_15C2
      JSR   LAB_1629          ; do CRTL-C check vector
      LDA   Bpntrl            ; get BASIC execute pointer low byte
      LDY   Bpntrh            ; get BASIC execute pointer high byte

      LDX   Clineh            ; continue line is $FFxx for immediate mode
                              ; ($00xx for RUN from immediate mode)
      INX                     ; increment it (now $00 if immediate mode)
;*** fix p2: skip no longer necessary as the continue pointer is saved anyway
;      BEQ   LAB_15D1          ; branch if null (immediate mode)

      STA   Cpntrl            ; save continue pointer low byte
      STY   Cpntrh            ; save continue pointer high byte
LAB_15D1
      LDY   #$00              ; clear index
      LDA   (Bpntrl),Y        ; get next byte
      BEQ   LAB_15DC          ; branch if null [EOL]

      CMP   #':'              ; compare with ":"
      BEQ   LAB_15F6          ; branch if = (statement separator)

LAB_15D9
      JMP   LAB_SNER          ; else syntax error then warm start

                              ; have reached [EOL]
LAB_15DC
      LDY   #$02              ; set index
      LDA   (Bpntrl),Y        ; get next line pointer high byte
      CLC                     ; clear carry for no "BREAK" message
      BEQ   LAB_1651          ; if null go to immediate mode (was immediate or [EOT]
                              ; marker)

      INY                     ; increment index
      LDA   (Bpntrl),Y        ; get line # low byte
      STA   Clinel            ; save current line low byte
      INY                     ; increment index
      LDA   (Bpntrl),Y        ; get line # high byte
      STA   Clineh            ; save current line high byte
      TYA                     ; A now = 4
      ADC   Bpntrl            ; add BASIC execute pointer low byte
      STA   Bpntrl            ; save BASIC execute pointer low byte
      BCC   LAB_15F6          ; branch if no overflow

      INC   Bpntrh            ; else increment BASIC execute pointer high byte
LAB_15F6
      JSR   LAB_IGBY          ; increment and scan memory

LAB_15F9
      JSR   LAB_15FF          ; go interpret BASIC code from (Bpntrl)

LAB_15FC
      JMP   LAB_15C2          ; loop

; interpret BASIC code from (Bpntrl)

LAB_15FF
      BEQ   LAB_1628          ; exit if zero [EOL]

LAB_1602
      ASL                     ; *2 bytes per vector and normalise token
      BCS   LAB_1609          ; branch if was token

      JMP   LAB_LET           ; else go do implied LET

LAB_1609
      CMP   #(TK_TAB-$80)*2   ; compare normalised token * 2 with TAB
      BCS   LAB_15D9          ; branch if A>=TAB (do syntax error then warm start)
                              ; only tokens before TAB can start a line
      TAY                     ; copy to index
      LDA   LAB_CTBL+1,Y      ; get vector high byte
      PHA                     ; onto stack
      LDA   LAB_CTBL,Y        ; get vector low byte
      PHA                     ; onto stack
      JMP   LAB_IGBY          ; jump to increment and scan memory
                              ; then "return" to vector

; CTRL-C check jump. this is called as a subroutine but exits back via a jump if a
; key press is detected.

LAB_1629
      JMP   (VEC_CC)          ; ctrl c check vector

; if there was a key press it gets back here ..

LAB_1636
      CMP   #$03              ; compare with CTRL-C

; perform STOP

LAB_STOP
      BCS   LAB_163B          ; branch if token follows STOP
                              ; else just END
; END

LAB_END
      CLC                     ; clear the carry, indicate a normal program end
LAB_163B
      BNE   LAB_167A          ; if wasn't CTRL-C or there is a following byte return

      LDA   Bpntrh            ; get the BASIC execute pointer high byte
;*** fix p2: skip no longer necessary as the continue pointer is saved anyway
;      EOR   #>Ibuffs          ; compare with buffer address high byte (Cb unchanged)
;      BEQ   LAB_164F          ; branch if the BASIC pointer is in the input buffer
;                              ; (can't continue in immediate mode)
;                              ; else ..
;      EOR   #>Ibuffs          ; correct the bits
      LDY   Bpntrl            ; get BASIC execute pointer low byte
      STY   Cpntrl            ; save continue pointer low byte
      STA   Cpntrh            ; save continue pointer high byte
LAB_1647
      LDA   Clinel            ; get current line low byte
      LDY   Clineh            ; get current line high byte
      STA   Blinel            ; save break line low byte
      STY   Blineh            ; save break line high byte
LAB_164F
      PLA                     ; pull return address low
      PLA                     ; pull return address high
LAB_1651
      BCC   LAB_165E          ; if was program end just do warm start

                              ; else ..
      LDA   #<LAB_BMSG        ; point to "Break" low byte
      LDY   #>LAB_BMSG        ; point to "Break" high byte
      JMP   LAB_1269          ; print "Break" and do warm start

LAB_165E
      JMP   LAB_1274          ; go do warm start

; perform RESTORE

LAB_RESTORE
      BNE   LAB_RESTOREn      ; branch if next character not null (RESTORE n)

LAB_161A
      SEC                     ; set carry for subtract
      LDA   Smeml             ; get start of mem low byte
      SBC   #$01              ; -1
      LDY   Smemh             ; get start of mem high byte
      BCS   LAB_1624          ; branch if no underflow

LAB_uflow
      DEY                     ; else decrement high byte
LAB_1624
      STA   Dptrl             ; save DATA pointer low byte
      STY   Dptrh             ; save DATA pointer high byte
LAB_1628
      RTS

                              ; is RESTORE n
LAB_RESTOREn
      JSR   LAB_GFPN          ; get fixed-point number into temp integer
      JSR   LAB_SNBL          ; scan for next BASIC line
      LDA   Clineh            ; get current line high byte
      CMP   Itemph            ; compare with temporary integer high byte
      BCS   LAB_reset_search  ; branch if >= (start search from beginning)

      TYA                     ; else copy line index to A
      SEC                     ; set carry (+1)
      ADC   Bpntrl            ; add BASIC execute pointer low byte
      LDX   Bpntrh            ; get BASIC execute pointer high byte
      BCC   LAB_go_search     ; branch if no overflow to high byte

      INX                     ; increment high byte
      BCS   LAB_go_search     ; branch always (can never be carry clear)

; search for line # in temp (Itempl/Itemph) from start of mem pointer (Smeml)

LAB_reset_search
      LDA   Smeml             ; get start of mem low byte
      LDX   Smemh             ; get start of mem high byte

; search for line # in temp (Itempl/Itemph) from (AX)

LAB_go_search

      JSR   LAB_SHLN          ; search Basic for temp integer line number from AX
      BCS   LAB_line_found    ; if carry set go set pointer

      JMP   LAB_16F7          ; else go do "Undefined statement" error

LAB_line_found
                              ; carry already set for subtract
      LDA   Baslnl            ; get pointer low byte
      SBC   #$01              ; -1
      LDY   Baslnh            ; get pointer high byte
      BCS   LAB_1624          ; branch if no underflow (save DATA pointer and return)

      BCC   LAB_uflow         ; else decrement high byte then save DATA pointer and
                              ; return (branch always)

; perform NULL

LAB_NULL
      JSR   LAB_GTBY          ; get byte parameter
      STX   Nullct            ; save new NULL count
LAB_167A
      RTS

; perform CONT

LAB_CONT
      BNE   LAB_167A          ; if following byte exit to do syntax error

      LDY   Cpntrh            ; get continue pointer high byte
      CPY   #>Ibuffs          ; *** fix p2: test direct mode
      BNE   LAB_166C          ; go do continue if we can

      LDX   #$1E              ; error code $1E ("Can't continue" error)
      JMP   LAB_XERR          ; do error #X, then warm start

                              ; we can continue so ..
LAB_166C
      STY   Bpntrh            ; save BASIC execute pointer high byte
      LDA   Cpntrl            ; get continue pointer low byte
      STA   Bpntrl            ; save BASIC execute pointer low byte
      LDA   Blinel            ; get break line low byte
      LDY   Blineh            ; get break line high byte
      STA   Clinel            ; set current line low byte
      STY   Clineh            ; set current line high byte
      RTS

; perform RUN

LAB_RUN
      BNE   LAB_1696          ; branch if RUN n
      JMP   LAB_1477          ; reset execution to start, clear variables, flush stack and
                              ; return

; does RUN n

LAB_1696
      JSR   LAB_147A          ; go do "CLEAR"
      BEQ   LAB_16B0          ; get n and do GOTO n (branch always as CLEAR sets Z=1)

; perform DO

LAB_DO
      LDA   #$05              ; need 5 bytes for DO
      JSR   LAB_1212          ; check room on stack for A bytes
      LDA   Bpntrh            ; get BASIC execute pointer high byte
      PHA                     ; push on stack
      LDA   Bpntrl            ; get BASIC execute pointer low byte
      PHA                     ; push on stack
      LDA   Clineh            ; get current line high byte
      PHA                     ; push on stack
      LDA   Clinel            ; get current line low byte
      PHA                     ; push on stack
      LDA   #TK_DO            ; token for DO
      PHA                     ; push on stack
      JSR   LAB_GBYT          ; scan memory
      JMP   LAB_15C2          ; go do interpreter inner loop

; perform GOSUB

LAB_GOSUB
      LDA   #$05              ; need 5 bytes for GOSUB
      JSR   LAB_1212          ; check room on stack for A bytes
      LDA   Bpntrh            ; get BASIC execute pointer high byte
      PHA                     ; push on stack
      LDA   Bpntrl            ; get BASIC execute pointer low byte
      PHA                     ; push on stack
      LDA   Clineh            ; get current line high byte
      PHA                     ; push on stack
      LDA   Clinel            ; get current line low byte
      PHA                     ; push on stack
      LDA   #TK_GOSUB         ; token for GOSUB
      PHA                     ; push on stack
LAB_16B0
      JSR   LAB_GBYT          ; scan memory
      JSR   LAB_GOTO          ; perform GOTO n
      JMP   LAB_15C2          ; go do interpreter inner loop
                              ; (can't RTS, we used the stack!)

; perform GOTO

LAB_GOTO
      JSR   LAB_GFPN          ; get fixed-point number into temp integer
      JSR   LAB_SNBL          ; scan for next BASIC line
      LDA   Clineh            ; get current line high byte
      CMP   Itemph            ; compare with temporary integer high byte
      BCS   LAB_16D0          ; branch if >= (start search from beginning)

      TYA                     ; else copy line index to A
      SEC                     ; set carry (+1)
      ADC   Bpntrl            ; add BASIC execute pointer low byte
      LDX   Bpntrh            ; get BASIC execute pointer high byte
      BCC   LAB_16D4          ; branch if no overflow to high byte

      INX                     ; increment high byte
      BCS   LAB_16D4          ; branch always (can never be carry)

; search for line # in temp (Itempl/Itemph) from start of mem pointer (Smeml)

LAB_16D0
      LDA   Smeml             ; get start of mem low byte
      LDX   Smemh             ; get start of mem high byte

; search for line # in temp (Itempl/Itemph) from (AX)

LAB_16D4
      JSR   LAB_SHLN          ; search Basic for temp integer line number from AX
      BCC   LAB_16F7          ; if carry clear go do "Undefined statement" error
                              ; (unspecified statement)

                              ; carry already set for subtract
      LDA   Baslnl            ; get pointer low byte
      SBC   #$01              ; -1
      STA   Bpntrl            ; save BASIC execute pointer low byte
      LDA   Baslnh            ; get pointer high byte
      SBC   #$00              ; subtract carry
      STA   Bpntrh            ; save BASIC execute pointer high byte
LAB_16E5
      RTS

LAB_DONOK
      LDX   #$22              ; error code $22 ("LOOP without DO" error)
      JMP   LAB_XERR          ; do error #X, then warm start

; perform LOOP

LAB_LOOP
      TAY                     ; save following token
      TSX                     ; copy stack pointer
      LDA   LAB_STAK+3,X      ; get token byte from stack
      CMP   #TK_DO            ; compare with DO token
      BNE   LAB_DONOK         ; branch if no matching DO

      INX                     ; dump calling routine return address
      INX                     ; dump calling routine return address
      TXS                     ; correct stack
      TYA                     ; get saved following token back
      BEQ   LoopAlways        ; if no following token loop forever
                              ; (stack pointer in X)

      CMP   #':'              ; could be ':'
      BEQ   LoopAlways        ; if :... loop forever

      SBC   #TK_UNTIL         ; subtract token for UNTIL, we know carry is set here
      TAX                     ; copy to X (if it was UNTIL then Y will be correct)
      BEQ   DoRest            ; branch if was UNTIL

      DEX                     ; decrement result
      BNE   LAB_16FC          ; if not WHILE go do syntax error and warm start
                              ; only if the token was WHILE will this fail

      DEX                     ; set invert result byte
DoRest
      STX   Frnxth            ; save invert result byte
      JSR   LAB_IGBY          ; increment and scan memory
      JSR   LAB_EVEX          ; evaluate expression
      LDA   FAC1_e            ; get FAC1 exponent
      BEQ   DoCmp             ; if =0 go do straight compare

      LDA   #$FF              ; else set all bits
DoCmp
      TSX                     ; copy stack pointer
      EOR   Frnxth            ; EOR with invert byte
      BNE   LoopDone          ; if <> 0 clear stack and back to interpreter loop

                              ; loop condition wasn't met so do it again
LoopAlways
      LDA   LAB_STAK+2,X      ; get current line low byte
      STA   Clinel            ; save current line low byte
      LDA   LAB_STAK+3,X      ; get current line high byte
      STA   Clineh            ; save current line high byte
      LDA   LAB_STAK+4,X      ; get BASIC execute pointer low byte
      STA   Bpntrl            ; save BASIC execute pointer low byte
      LDA   LAB_STAK+5,X      ; get BASIC execute pointer high byte
      STA   Bpntrh            ; save BASIC execute pointer high byte
      JSR   LAB_GBYT          ; scan memory
      JMP   LAB_15C2          ; go do interpreter inner loop

                              ; clear stack and back to interpreter loop
LoopDone
      INX                     ; dump DO token
      INX                     ; dump current line low byte
      INX                     ; dump current line high byte
      INX                     ; dump BASIC execute pointer low byte
      INX                     ; dump BASIC execute pointer high byte
      TXS                     ; correct stack
      JMP   LAB_DATA          ; go perform DATA (find : or [EOL])

; do the return without gosub error

LAB_16F4
      LDX   #$04              ; error code $04 ("RETURN without GOSUB" error)
      .db $2C               ; makes next line BIT LAB_0EA2

LAB_16F7                      ; do undefined statement error
      LDX   #$0E              ; error code $0E ("Undefined statement" error)
      JMP   LAB_XERR          ; do error #X, then warm start

; perform RETURN

LAB_RETURN
      BNE   LAB_16E5          ; exit if following token (to allow syntax error)

LAB_16E8
      PLA                     ; dump calling routine return address
      PLA                     ; dump calling routine return address
      PLA                     ; pull token
      CMP   #TK_GOSUB         ; compare with GOSUB token
      BNE   LAB_16F4          ; branch if no matching GOSUB

LAB_16FF
      PLA                     ; pull current line low byte
      STA   Clinel            ; save current line low byte
      PLA                     ; pull current line high byte
      STA   Clineh            ; save current line high byte
      PLA                     ; pull BASIC execute pointer low byte
      STA   Bpntrl            ; save BASIC execute pointer low byte
      PLA                     ; pull BASIC execute pointer high byte
      STA   Bpntrh            ; save BASIC execute pointer high byte

                              ; now do the DATA statement as we could be returning into
                              ; the middle of an ON <var> GOSUB n,m,p,q line
                              ; (the return address used by the DATA statement is the one
                              ; pushed before the GOSUB was executed!)

; perform DATA

LAB_DATA
      JSR   LAB_SNBS          ; scan for next BASIC statement ([:] or [EOL])

                              ; set BASIC execute pointer
LAB_170F
      TYA                     ; copy index to A
      CLC                     ; clear carry for add
      ADC   Bpntrl            ; add BASIC execute pointer low byte
      STA   Bpntrl            ; save BASIC execute pointer low byte
      BCC   LAB_1719          ; skip next if no carry

      INC   Bpntrh            ; else increment BASIC execute pointer high byte
LAB_1719
      RTS

LAB_16FC
      JMP   LAB_SNER          ; do syntax error then warm start

; scan for next BASIC statement ([:] or [EOL])
; returns Y as index to [:] or [EOL]

LAB_SNBS
      LDX   #':'              ; set look for character = ":"
      .db $2C               ; makes next line BIT $00A2

; scan for next BASIC line
; returns Y as index to [EOL]

LAB_SNBL
      LDX   #$00              ; set alt search character = [EOL]
      LDY   #$00              ; set search character = [EOL]
      STY   Asrch             ; store search character
LAB_1725
      TXA                     ; get alt search character
      EOR   Asrch             ; toggle search character, effectively swap with $00
      STA   Asrch             ; save swapped search character
LAB_172D
      LDA   (Bpntrl),Y        ; get next byte
      BEQ   LAB_1719          ; exit if null [EOL]

      CMP   Asrch             ; compare with search character
      BEQ   LAB_1719          ; exit if found

      INY                     ; increment index
      CMP   #$22              ; compare current character with open quote
      BNE   LAB_172D          ; if not open quote go get next character

      BEQ   LAB_1725          ; if found go swap search character for alt search character

; perform IF

LAB_IF
      JSR   LAB_EVEX          ; evaluate the expression
      JSR   LAB_GBYT          ; scan memory
      CMP   #TK_THEN          ; compare with THEN token
      BEQ   LAB_174B          ; if it was THEN go do IF

                              ; wasn't IF .. THEN so must be IF .. GOTO
      CMP   #TK_GOTO          ; compare with GOTO token
      BNE   LAB_16FC          ; if it wasn't GOTO go do syntax error

      LDX   Bpntrl            ; save the basic pointer low byte
      LDY   Bpntrh            ; save the basic pointer high byte
      JSR   LAB_IGBY          ; increment and scan memory
      BCS   LAB_16FC          ; if not numeric go do syntax error

      STX   Bpntrl            ; restore the basic pointer low byte
      STY   Bpntrh            ; restore the basic pointer high byte
LAB_174B
      LDA   FAC1_e            ; get FAC1 exponent
      BEQ   LAB_174E          ; if the result was zero go look for an ELSE

      JSR   LAB_IGBY          ; else increment and scan memory
      BCS   LAB_174D          ; if not numeric go do var or keyword

LAB_174C
      JMP   LAB_GOTO          ; else was numeric so do GOTO n

                              ; is var or keyword
LAB_174D
; *** patch       allow NEXT, LOOP & RETURN to find FOR, DO or GOSUB structure on stack
; *** replace
;      CMP   #TK_RETURN        ; compare the byte with the token for RETURN
;      BNE   LAB_174G          ; if it wasn't RETURN go interpret BASIC code from (Bpntrl)
;                              ; and return to this code to process any following code
;
;      JMP   LAB_1602          ; else it was RETURN so interpret BASIC code from (Bpntrl)
;                              ; but don't return here
;
;LAB_174G
;      JSR   LAB_15FF          ; interpret BASIC code from (Bpntrl)
;
;; the IF was executed and there may be a following ELSE so the code needs to return
;; here to check and ignore the ELSE if present
;
;      LDY   #$00              ; clear the index
;      LDA   (Bpntrl),Y        ; get the next BASIC byte
;      CMP   #TK_ELSE          ; compare it with the token for ELSE
;      BEQ   LAB_DATA          ; if ELSE ignore the following statement
;
;; there was no ELSE so continue execution of IF <expr> THEN <stat> [: <stat>]. any
;; following ELSE will, correctly, cause a syntax error
;
;      RTS                     ; else return to the interpreter inner loop
;
; *** with
      PLA                     ; discard interpreter loop return address
      PLA                     ; so data structures are at the correct stack offset
      JSR   LAB_GBYT          ; restore token or variable
      JSR   LAB_15FF          ; interpret BASIC code from (Bpntrl)

; the IF was executed and there may be a following ELSE so the code needs to return
; here to check and ignore the ELSE if present

      LDY   #$00              ; clear the index
      LDA   (Bpntrl),Y        ; get the next BASIC byte
      CMP   #TK_ELSE          ; compare it with the token for ELSE
      BNE   LAB_no_ELSE       ; no - continue on this line
      JSR   LAB_DATA          ; yes - skip the rest of the line

; there was no ELSE so continue execution of IF <expr> THEN <stat> [: <stat>]. any
; following ELSE will, correctly, cause a syntax error

LAB_no_ELSE
      JMP LAB_15C2            ; return to the interpreter inner loop
; *** end patch  allow NEXT, LOOP & RETURN to find FOR, DO or GOSUB structure on stack

; perform ELSE after IF

LAB_174E
      LDY   #$00              ; clear the BASIC byte index
      LDX   #$01              ; clear the nesting depth
LAB_1750
      INY                     ; increment the BASIC byte index
      LDA   (Bpntrl),Y        ; get the next BASIC byte
      BEQ   LAB_1753          ; if EOL go add the pointer and return

      CMP   #TK_IF            ; compare the byte with the token for IF
      BNE   LAB_1752          ; if not IF token skip the depth increment

      INX                     ; else increment the nesting depth ..
      BNE   LAB_1750          ; .. and continue looking

LAB_1752
      CMP   #TK_ELSE          ; compare the byte with the token for ELSE
      BNE   LAB_1750          ; if not ELSE token continue looking

      DEX                     ; was ELSE so decrement the nesting depth
      BNE   LAB_1750          ; loop if still nested

      INY                     ; increment the BASIC byte index past the ELSE

; found the matching ELSE, now do <{n|statement}>

LAB_1753
      TYA                     ; else copy line index to A
      CLC                     ; clear carry for add
      ADC   Bpntrl            ; add the BASIC execute pointer low byte
      STA   Bpntrl            ; save the BASIC execute pointer low byte
      BCC   LAB_1754          ; branch if no overflow to high byte

      INC   Bpntrh            ; else increment the BASIC execute pointer high byte
LAB_1754
      JSR   LAB_GBYT          ; scan memory
      BCC   LAB_174C          ; if numeric do GOTO n
                              ; the code will return to the interpreter loop at the
                              ; tail end of the GOTO <n>

      JMP   LAB_15FF          ; interpret BASIC code from (Bpntrl)
                              ; the code will return to the interpreter loop at the
                              ; tail end of the <statement>

; perform REM, skip (rest of) line

LAB_REM
      JSR   LAB_SNBL          ; scan for next BASIC line
      JMP   LAB_170F          ; go set BASIC execute pointer and return, branch always

LAB_16FD
      JMP   LAB_SNER          ; do syntax error then warm start

; perform ON

LAB_ON
LAB_NONM
      JSR   LAB_GTBY          ; get byte parameter
      PHA                     ; push GOTO/GOSUB token
      CMP   #TK_GOSUB         ; compare with GOSUB token
      BEQ   LAB_176B          ; branch if GOSUB

      CMP   #TK_GOTO          ; compare with GOTO token
LAB_1767
      BNE   LAB_16FD          ; if not GOTO do syntax error then warm start


; next character was GOTO or GOSUB

LAB_176B
      DEC   FAC1_3            ; decrement index (byte value)
      BNE   LAB_1773          ; branch if not zero

      PLA                     ; pull GOTO/GOSUB token
      JMP   LAB_1602          ; go execute it

LAB_1773
      JSR   LAB_IGBY          ; increment and scan memory
      JSR   LAB_GFPN          ; get fixed-point number into temp integer (skip this n)
                              ; (we could LDX #',' and JSR LAB_SNBL+2, then we
                              ; just BNE LAB_176B for the loop. should be quicker ..
                              ; no we can't, what if we meet a colon or [EOL]?)
      CMP   #$2C              ; compare next character with ","
      BEQ   LAB_176B          ; loop if ","

LAB_177E
      PLA                     ; else pull keyword token (run out of options)
                              ; also dump +/-1 pointer low byte and exit
LAB_177F
      RTS

; takes n * 106 + 11 cycles where n is the number of digits

; get fixed-point number into temp integer

LAB_GFPN
      LDX   #$00              ; clear reg
      STX   Itempl            ; clear temporary integer low byte
LAB_1785
      STX   Itemph            ; save temporary integer high byte
      BCS   LAB_177F          ; return if carry set, end of scan, character was
                              ; not 0-9

      CPX   #$19              ; compare high byte with $19
      TAY                     ; ensure Zb = 0 if the branch is taken
      BCS   LAB_1767          ; branch if >=, makes max line # 63999 because next
                              ; bit does *$0A, = 64000, compare at target will fail
                              ; and do syntax error

      SBC   #'0'-1            ; subtract "0", $2F + carry, from byte
      TAY                     ; copy binary digit
      LDA   Itempl            ; get temporary integer low byte
      ASL                     ; *2 low byte
      ROL   Itemph            ; *2 high byte
      ASL                     ; *2 low byte
      ROL   Itemph            ; *2 high byte, *4
      ADC   Itempl            ; + low byte, *5
      STA   Itempl            ; save it
      TXA                     ; get high byte copy to A
      ADC   Itemph            ; + high byte, *5
      ASL   Itempl            ; *2 low byte, *10d
      ROL                     ; *2 high byte, *10d
      TAX                     ; copy high byte back to X
      TYA                     ; get binary digit back
      ADC   Itempl            ; add number low byte
      STA   Itempl            ; save number low byte
      BCC   LAB_17B3          ; if no overflow to high byte get next character

      INX                     ; else increment high byte
LAB_17B3
      JSR   LAB_IGBY          ; increment and scan memory
      JMP   LAB_1785          ; loop for next character

; perform DEC

LAB_DEC
      LDA   #<LAB_2AFD        ; set -1 pointer low byte
     .db $2C               ; BIT abs to skip the LDA below

; perform INC

LAB_INC
      LDA   #<LAB_259C        ; set 1 pointer low byte
LAB_17B5
      PHA                     ; save +/-1 pointer low byte
LAB_17B7
      JSR   LAB_GVAR          ; get var address
      LDX   Dtypef            ; get data type flag, $FF=string, $00=numeric
      BMI   IncrErr           ; exit if string

      STA   Lvarpl            ; save var address low byte
      STY   Lvarph            ; save var address high byte
      JSR   LAB_UFAC          ; unpack memory (AY) into FAC1
      PLA                     ; get +/-1 pointer low byte
      PHA                     ; save +/-1 pointer low byte
      LDY   #>LAB_259C        ; set +/-1 pointer high byte (both the same)
      JSR   LAB_246C          ; add (AY) to FAC1
      JSR   LAB_PFAC          ; pack FAC1 into variable (Lvarpl)

      JSR   LAB_GBYT          ; scan memory
      CMP   #','              ; compare with ","
      BNE   LAB_177E          ; exit if not "," (either end or error)

                              ; was "," so another INCR variable to do
      JSR   LAB_IGBY          ; increment and scan memory
      JMP   LAB_17B7          ; go do next var

IncrErr
      JMP   LAB_1ABC          ; do "Type mismatch" error then warm start

; perform LET

LAB_LET
      JSR   LAB_GVAR          ; get var address
      STA   Lvarpl            ; save var address low byte
      STY   Lvarph            ; save var address high byte
      LDA   #TK_EQUAL         ; get = token
      JSR   LAB_SCCA          ; scan for CHR$(A), else do syntax error then warm start
      LDA   Dtypef            ; get data type flag, $FF=string, $00=numeric
      PHA                     ; push data type flag
      JSR   LAB_EVEX          ; evaluate expression
      PLA                     ; pop data type flag
      ROL                     ; set carry if type = string
; *** begin patch  result of a string compare stores string pointer to variable
;                  but should store FAC1 (true/false value)
; *** replace
;      JSR   LAB_CKTM          ; type match check, set C for string
;      BNE   LAB_17D5          ; branch if string
; *** with
      JSR   LAB_CKTM          ; type match check, keep C (expected type)
      BCS   LAB_17D5          ; branch if string
; *** end patch

      JMP   LAB_PFAC          ; pack FAC1 into variable (Lvarpl) and return

; string LET

LAB_17D5
      LDY   #$02              ; set index to pointer high byte
      LDA   (des_pl),Y        ; get string pointer high byte
      CMP   Sstorh            ; compare bottom of string space high byte
      BCC   LAB_17F4          ; if less assign value and exit (was in program memory)

      BNE   LAB_17E6          ; branch if >
                              ; else was equal so compare low bytes
      DEY                     ; decrement index
      LDA   (des_pl),Y        ; get pointer low byte
      CMP   Sstorl            ; compare bottom of string space low byte
      BCC   LAB_17F4          ; if less assign value and exit (was in program memory)

                              ; pointer was >= to bottom of string space pointer
LAB_17E6
      LDY   des_ph            ; get descriptor pointer high byte
      CPY   Svarh             ; compare start of vars high byte
      BCC   LAB_17F4          ; branch if less (descriptor is on stack)

      BNE   LAB_17FB          ; branch if greater (descriptor is not on stack)

                              ; else high bytes were equal so ..
      LDA   des_pl            ; get descriptor pointer low byte
      CMP   Svarl             ; compare start of vars low byte
      BCS   LAB_17FB          ; branch if >= (descriptor is not on stack)

LAB_17F4
      LDA   des_pl            ; get descriptor pointer low byte
      LDY   des_ph            ; get descriptor pointer high byte
      JMP   LAB_1811          ; clean stack, copy descriptor to variable and return

                              ; make space and copy string
LAB_17FB
      LDY   #$00              ; index to length
      LDA   (des_pl),Y        ; get string length
      JSR   LAB_209C          ; copy string
      LDA   des_2l            ; get descriptor pointer low byte
      LDY   des_2h            ; get descriptor pointer high byte
      STA   ssptr_l           ; save descriptor pointer low byte
      STY   ssptr_h           ; save descriptor pointer high byte
      JSR   LAB_228A          ; copy string from descriptor (sdescr) to (Sutill)
      LDA   #<FAC1_e          ; set descriptor pointer low byte
      LDY   #>FAC1_e          ; get descriptor pointer high byte

                              ; clean stack and assign value to string variable
LAB_1811
      STA   des_2l            ; save descriptor_2 pointer low byte
      STY   des_2h            ; save descriptor_2 pointer high byte
      JSR   LAB_22EB          ; clean descriptor stack, YA = pointer
      LDY   #$00              ; index to length
      LDA   (des_2l),Y        ; get string length
      STA   (Lvarpl),Y        ; copy to let string variable
      INY                     ; index to string pointer low byte
      LDA   (des_2l),Y        ; get string pointer low byte
      STA   (Lvarpl),Y        ; copy to let string variable
      INY                     ; index to string pointer high byte
      LDA   (des_2l),Y        ; get string pointer high byte
      STA   (Lvarpl),Y        ; copy to let string variable
      RTS

; perform GET

LAB_GET
      JSR   LAB_GVAR          ; get var address
      STA   Lvarpl            ; save var address low byte
      STY   Lvarph            ; save var address high byte
      JSR   INGET             ; get input byte
      LDX   Dtypef            ; get data type flag, $FF=string, $00=numeric
      BMI   LAB_GETS          ; go get string character

                              ; was numeric get
      TAY                     ; copy character to Y
      JSR   LAB_1FD0          ; convert Y to byte in FAC1
      JMP   LAB_PFAC          ; pack FAC1 into variable (Lvarpl) and return

LAB_GETS
      PHA                     ; save character
      LDA   #$01              ; string is single byte
      BCS   LAB_IsByte        ; branch if byte received

      PLA                     ; string is null
LAB_IsByte
      JSR   LAB_MSSP          ; make string space A bytes long A=$AC=length,
                              ; X=$AD=Sutill=ptr low byte, Y=$AE=Sutilh=ptr high byte
      BEQ   LAB_NoSt          ; skip store if null string

      PLA                     ; get character back
      LDY   #$00              ; clear index
      STA   (str_pl),Y        ; save byte in string (byte IS string!)
LAB_NoSt
      JSR   LAB_RTST          ; check for space on descriptor stack then put address
                              ; and length on descriptor stack and update stack pointers

      JMP   LAB_17D5          ; do string LET and return

; perform PRINT

LAB_1829
      JSR   LAB_18C6          ; print string from Sutill/Sutilh
LAB_182C
      JSR   LAB_GBYT          ; scan memory

; PRINT

LAB_PRINT
      BEQ   LAB_CRLF          ; if nothing following just print CR/LF

LAB_1831
      CMP   #TK_TAB           ; compare with TAB( token
      BEQ   LAB_18A2          ; go do TAB/SPC

      CMP   #TK_SPC           ; compare with SPC( token
      BEQ   LAB_18A2          ; go do TAB/SPC

      CMP   #','              ; compare with ","
      BEQ   LAB_188B          ; go do move to next TAB mark

      CMP   #$3B              ; compare with ";" XXX
      BEQ   LAB_18BD          ; if ";" continue with PRINT processing

      JSR   LAB_EVEX          ; evaluate expression
      BIT   Dtypef            ; test data type flag, $FF=string, $00=numeric
      BMI   LAB_1829          ; branch if string

      JSR   LAB_296E          ; convert FAC1 to string
      JSR   LAB_20AE          ; print " terminated string to Sutill/Sutilh
      LDY   #$00              ; clear index

; don't check fit if terminal width byte is zero

      LDA   TWidth            ; get terminal width byte
      BEQ   LAB_185E          ; skip check if zero

      SEC                     ; set carry for subtract
      SBC   TPos              ; subtract terminal position
      SBC   (des_pl),Y        ; subtract string length
      BCS   LAB_185E          ; branch if less than terminal width

      JSR   LAB_CRLF          ; else print CR/LF
LAB_185E
      JSR   LAB_18C6          ; print string from Sutill/Sutilh
      BEQ   LAB_182C          ; always go continue processing line

; CR/LF return to BASIC from BASIC input handler

LAB_1866
      LDA   #$00              ; clear byte
      STA   Ibuffs,X          ; null terminate input
      LDX   #<Ibuffs          ; set X to buffer start-1 low byte
      LDY   #>Ibuffs          ; set Y to buffer start-1 high byte

; print CR/LF

LAB_CRLF
      LDA   #$0D              ; load [CR]
      JSR   LAB_PRNA          ; go print the character
      LDA   #$0A              ; load [LF]
      BNE   LAB_PRNA          ; go print the character and return, branch always

LAB_188B
      LDA   TPos              ; get terminal position
      CMP   Iclim             ; compare with input column limit
      BCC   LAB_1897          ; branch if less

      JSR   LAB_CRLF          ; else print CR/LF (next line)
      BNE   LAB_18BD          ; continue with PRINT processing (branch always)

LAB_1897
      SEC                     ; set carry for subtract
LAB_1898
      SBC   TabSiz            ; subtract TAB size
      BCS   LAB_1898          ; loop if result was +ve

      EOR   #$FF              ; complement it
      ADC   #$01              ; +1 (twos complement)
      BNE   LAB_18B6          ; always print A spaces (result is never $00)

                              ; do TAB/SPC
LAB_18A2
      PHA                     ; save token
      JSR   LAB_SGBY          ; scan and get byte parameter
      CMP   #$29              ; is next character )
      BNE   LAB_1910          ; if not do syntax error then warm start

      PLA                     ; get token back
      CMP   #TK_TAB           ; was it TAB ?
      BNE   LAB_18B7          ; if not go do SPC

                              ; calculate TAB offset
      TXA                     ; copy integer value to A
      SBC   TPos              ; subtract terminal position
      BCC   LAB_18BD          ; branch if result was < 0 (can't TAB backwards)

                              ; print A spaces
LAB_18B6
      TAX                     ; copy result to X
LAB_18B7
      TXA                     ; set flags on size for SPC
      BEQ   LAB_18BD          ; branch if result was = $0, already here

                              ; print X spaces
LAB_18BA
      JSR   LAB_18E0          ; print " "
      DEX                     ; decrement count
      BNE   LAB_18BA          ; loop if not all done

                              ; continue with PRINT processing
LAB_18BD
      JSR   LAB_IGBY          ; increment and scan memory
      BNE   LAB_1831          ; if more to print go do it

      RTS

; print null terminated string from memory

LAB_18C3
      JSR   LAB_20AE          ; print " terminated string to Sutill/Sutilh

; print string from Sutill/Sutilh

LAB_18C6
      JSR   LAB_22B6          ; pop string off descriptor stack, or from top of string
                              ; space returns with A = length, X=$71=pointer low byte,
                              ; Y=$72=pointer high byte
      LDY   #$00              ; reset index
      TAX                     ; copy length to X
      BEQ   LAB_188C          ; exit (RTS) if null string

LAB_18CD

      LDA   (ut1_pl),Y        ; get next byte
      JSR   LAB_PRNA          ; go print the character
      INY                     ; increment index
      DEX                     ; decrement count
      BNE   LAB_18CD          ; loop if not done yet

      RTS

                              ; Print single format character
; print " "

LAB_18E0
      LDA   #$20              ; load " "
      .db $2C               ; change next line to BIT LAB_3FA9

; print "?" character

LAB_18E3
      LDA   #$3F              ; load "?" character

; print character in A
; now includes the null handler
; also includes infinite line length code
; note! some routines expect this one to exit with Zb=0

LAB_PRNA
      CMP   #' '              ; compare with " "
      BCC   LAB_18F9          ; branch if less (non printing)

                              ; else printable character
      PHA                     ; save the character

; don't check fit if terminal width byte is zero

      LDA   TWidth            ; get terminal width
      BNE   LAB_18F0          ; branch if not zero (not infinite length)

; is "infinite line" so check TAB position

      LDA   TPos              ; get position
      SBC   TabSiz            ; subtract TAB size, carry set by CMP #$20 above
      BNE   LAB_18F7          ; skip reset if different

      STA   TPos              ; else reset position
      BEQ   LAB_18F7          ; go print character

LAB_18F0
      CMP   TPos              ; compare with terminal character position
      BNE   LAB_18F7          ; branch if not at end of line

      JSR   LAB_CRLF          ; else print CR/LF
LAB_18F7
      INC   TPos              ; increment terminal position
      PLA                     ; get character back
LAB_18F9
      JSR   V_OUTP            ; output byte via output vector
      CMP   #$0D              ; compare with [CR]
      BNE   LAB_188A          ; branch if not [CR]

                              ; else print nullct nulls after the [CR]
      STX   TempB             ; save buffer index
      LDX   Nullct            ; get null count
      BEQ   LAB_1886          ; branch if no nulls

      LDA   #$00              ; load [NULL]
LAB_1880
      JSR   LAB_PRNA          ; go print the character
      DEX                     ; decrement count
      BNE   LAB_1880          ; loop if not all done

      LDA   #$0D              ; restore the character (and set the flags)
LAB_1886
      STX   TPos              ; clear terminal position (X always = zero when we get here)
      LDX   TempB             ; restore buffer index
LAB_188A
      AND   #$FF              ; set the flags
LAB_188C
      RTS

; handle bad input data

LAB_1904
      LDA   Imode             ; get input mode flag, $00=INPUT, $00=READ
      BPL   LAB_1913          ; branch if INPUT (go do redo)

      LDA   Dlinel            ; get current DATA line low byte
      LDY   Dlineh            ; get current DATA line high byte
      STA   Clinel            ; save current line low byte
      STY   Clineh            ; save current line high byte
LAB_1910
      JMP   LAB_SNER          ; do syntax error then warm start

                              ; mode was INPUT
LAB_1913
      LDA   #<LAB_REDO        ; point to redo message (low addr)
      LDY   #>LAB_REDO        ; point to redo message (high addr)
      JSR   LAB_18C3          ; print null terminated string from memory
      LDA   Cpntrl            ; get continue pointer low byte
      LDY   Cpntrh            ; get continue pointer high byte
      STA   Bpntrl            ; save BASIC execute pointer low byte
      STY   Bpntrh            ; save BASIC execute pointer high byte
      RTS

; perform INPUT

LAB_INPUT
      CMP   #$22              ; compare next byte with open quote
      BNE   LAB_1934          ; branch if no prompt string

      JSR   LAB_1BC1          ; print "..." string
      LDA   #$3B              ; load A with ";"
      JSR   LAB_SCCA          ; scan for CHR$(A), else do syntax error then warm start
      JSR   LAB_18C6          ; print string from Sutill/Sutilh

                              ; done with prompt, now get data
LAB_1934
      JSR   LAB_CKRN          ; check not Direct, back here if ok
      JSR   LAB_INLN          ; print "? " and get BASIC input
      LDA   #$00              ; set mode = INPUT
      CMP   Ibuffs            ; test first byte in buffer
      BNE   LAB_1953          ; branch if not null input

; *** change p2: keep carry set to throw break message
;      CLC                     ; was null input so clear carry to exit program
      JMP   LAB_1647          ; go do BREAK exit

; perform READ

LAB_READ
      LDX   Dptrl             ; get DATA pointer low byte
      LDY   Dptrh             ; get DATA pointer high byte
      LDA   #$80              ; set mode = READ

LAB_1953
      STA   Imode             ; set input mode flag, $00=INPUT, $80=READ
      STX   Rdptrl            ; save READ pointer low byte
      STY   Rdptrh            ; save READ pointer high byte

                              ; READ or INPUT next variable from list
LAB_195B
      JSR   LAB_GVAR          ; get (var) address
      STA   Lvarpl            ; save address low byte
      STY   Lvarph            ; save address high byte
      LDA   Bpntrl            ; get BASIC execute pointer low byte
      LDY   Bpntrh            ; get BASIC execute pointer high byte
      STA   Itempl            ; save as temporary integer low byte
      STY   Itemph            ; save as temporary integer high byte
      LDX   Rdptrl            ; get READ pointer low byte
      LDY   Rdptrh            ; get READ pointer high byte
      STX   Bpntrl            ; set BASIC execute pointer low byte
      STY   Bpntrh            ; set BASIC execute pointer high byte
      JSR   LAB_GBYT          ; scan memory
      BNE   LAB_1988          ; branch if not null

                              ; pointer was to null entry
      BIT   Imode             ; test input mode flag, $00=INPUT, $80=READ
      BMI   LAB_19DD          ; branch if READ

                              ; mode was INPUT
      JSR   LAB_18E3          ; print "?" character (double ? for extended input)
      JSR   LAB_INLN          ; print "? " and get BASIC input
      STX   Bpntrl            ; set BASIC execute pointer low byte
      STY   Bpntrh            ; set BASIC execute pointer high byte
LAB_1985
      JSR   LAB_GBYT          ; scan memory
LAB_1988
      BIT   Dtypef            ; test data type flag, $FF=string, $00=numeric
      BPL   LAB_19B0          ; branch if numeric

                              ; else get string
      STA   Srchc             ; save search character
      CMP   #$22              ; was it " ?
      BEQ   LAB_1999          ; branch if so

      LDA   #':'              ; else search character is ":"
      STA   Srchc             ; set new search character
      LDA   #','              ; other search character is ","
      CLC                     ; clear carry for add
LAB_1999
      STA   Asrch             ; set second search character
      LDA   Bpntrl            ; get BASIC execute pointer low byte
      LDY   Bpntrh            ; get BASIC execute pointer high byte

      ADC   #$00              ; c is =1 if we came via the BEQ LAB_1999, else =0
      BCC   LAB_19A4          ; branch if no execute pointer low byte rollover

      INY                     ; else increment high byte
LAB_19A4
      JSR   LAB_20B4          ; print Srchc or Asrch terminated string to Sutill/Sutilh
      JSR   LAB_23F3          ; restore BASIC execute pointer from temp (Btmpl/Btmph)
      JSR   LAB_17D5          ; go do string LET
      JMP   LAB_19B6          ; go check string terminator

                              ; get numeric INPUT
LAB_19B0
      JSR   LAB_2887          ; get FAC1 from string
      JSR   LAB_PFAC          ; pack FAC1 into (Lvarpl)
LAB_19B6
      JSR   LAB_GBYT          ; scan memory
      BEQ   LAB_19C5          ; branch if null (last entry)

      CMP   #','              ; else compare with ","
      BEQ   LAB_19C2          ; branch if ","

      JMP   LAB_1904          ; else go handle bad input data

                              ; got good input data
LAB_19C2
      JSR   LAB_IGBY          ; increment and scan memory
LAB_19C5
      LDA   Bpntrl            ; get BASIC execute pointer low byte (temp READ/INPUT ptr)
      LDY   Bpntrh            ; get BASIC execute pointer high byte (temp READ/INPUT ptr)
      STA   Rdptrl            ; save for now
      STY   Rdptrh            ; save for now
      LDA   Itempl            ; get temporary integer low byte (temp BASIC execute ptr)
      LDY   Itemph            ; get temporary integer high byte (temp BASIC execute ptr)
      STA   Bpntrl            ; set BASIC execute pointer low byte
      STY   Bpntrh            ; set BASIC execute pointer high byte
      JSR   LAB_GBYT          ; scan memory
      BEQ   LAB_1A03          ; if null go do extra ignored message

      JSR   LAB_1C01          ; else scan for "," , else do syntax error then warm start
      JMP   LAB_195B          ; go INPUT next variable from list

                              ; find next DATA statement or do "Out of DATA" error
LAB_19DD
      JSR   LAB_SNBS          ; scan for next BASIC statement ([:] or [EOL])
      INY                     ; increment index
      TAX                     ; copy character ([:] or [EOL])
      BNE   LAB_19F6          ; branch if [:]

      LDX   #$06              ; set for "Out of DATA" error
      INY                     ; increment index, now points to next line pointer high byte
      LDA   (Bpntrl),Y        ; get next line pointer high byte
      BEQ   LAB_1A54          ; branch if end (eventually does error X)

      INY                     ; increment index
      LDA   (Bpntrl),Y        ; get next line # low byte
      STA   Dlinel            ; save current DATA line low byte
      INY                     ; increment index
      LDA   (Bpntrl),Y        ; get next line # high byte
      INY                     ; increment index
      STA   Dlineh            ; save current DATA line high byte
LAB_19F6
      LDA   (Bpntrl),Y        ; get byte
      INY                     ; increment index
      TAX                     ; copy to X
      JSR   LAB_170F          ; set BASIC execute pointer
      CPX   #TK_DATA          ; compare with "DATA" token
      BEQ   LAB_1985          ; was "DATA" so go do next READ

      BNE   LAB_19DD          ; go find next statement if not "DATA"

; end of INPUT/READ routine

LAB_1A03
      LDA   Rdptrl            ; get temp READ pointer low byte
      LDY   Rdptrh            ; get temp READ pointer high byte
      LDX   Imode             ; get input mode flag, $00=INPUT, $80=READ
      BPL   LAB_1A0E          ; branch if INPUT

      JMP   LAB_1624          ; save AY as DATA pointer and return

                              ; we were getting INPUT
LAB_1A0E
      LDY   #$00              ; clear index
      LDA   (Rdptrl),Y        ; get next byte
      BNE   LAB_1A1B          ; error if not end of INPUT

      RTS

                              ; user typed too much
LAB_1A1B
      LDA   #<LAB_IMSG        ; point to extra ignored message (low addr)
      LDY   #>LAB_IMSG        ; point to extra ignored message (high addr)
      JMP   LAB_18C3          ; print null terminated string from memory and return

; search the stack for FOR activity
; exit with z=1 if FOR else exit with z=0

LAB_11A1
      TSX                     ; copy stack pointer
      INX                     ; +1 pass return address
      INX                     ; +2 pass return address
      INX                     ; +3 pass calling routine return address
      INX                     ; +4 pass calling routine return address
LAB_11A6
      LDA   LAB_STAK+1,X      ; get token byte from stack
      CMP   #TK_FOR           ; is it FOR token
      BNE   LAB_11CE          ; exit if not FOR token

                              ; was FOR token
      LDA   Frnxth            ; get var pointer for FOR/NEXT high byte
      BNE   LAB_11BB          ; branch if not null

      LDA   LAB_STAK+2,X      ; get FOR variable pointer low byte
      STA   Frnxtl            ; save var pointer for FOR/NEXT low byte
      LDA   LAB_STAK+3,X      ; get FOR variable pointer high byte
      STA   Frnxth            ; save var pointer for FOR/NEXT high byte
LAB_11BB
      CMP   LAB_STAK+3,X      ; compare var pointer with stacked var pointer (high byte)
      BNE   LAB_11C7          ; branch if no match

      LDA   Frnxtl            ; get var pointer for FOR/NEXT low byte
      CMP   LAB_STAK+2,X      ; compare var pointer with stacked var pointer (low byte)
      BEQ   LAB_11CE          ; exit if match found

LAB_11C7
      TXA                     ; copy index
      CLC                     ; clear carry for add
      ADC   #$10              ; add FOR stack use size
      TAX                     ; copy back to index
      BNE   LAB_11A6          ; loop if not at start of stack

LAB_11CE
      RTS

; perform NEXT

LAB_NEXT
      BNE   LAB_1A46          ; branch if NEXT var

      LDY   #$00              ; else clear Y
      BEQ   LAB_1A49          ; branch always (no variable to search for)

; NEXT var

LAB_1A46
      JSR   LAB_GVAR          ; get variable address
LAB_1A49
      STA   Frnxtl            ; store variable pointer low byte
      STY   Frnxth            ; store variable pointer high byte
                              ; (both cleared if no variable defined)
      JSR   LAB_11A1          ; search the stack for FOR activity
      BEQ   LAB_1A56          ; branch if found

      LDX   #$00              ; else set error $00 ("NEXT without FOR" error)
LAB_1A54
      BEQ   LAB_1ABE          ; do error #X, then warm start

LAB_1A56
      TXS                     ; set stack pointer, X set by search, dumps return addresses

      TXA                     ; copy stack pointer
      SEC                     ; set carry for subtract
      SBC   #$F7              ; point to TO var
      STA   ut2_pl            ; save pointer to TO var for compare
      ADC   #$FB              ; point to STEP var

      LDY   #>LAB_STAK        ; point to stack page high byte
      JSR   LAB_UFAC          ; unpack memory (STEP value) into FAC1
      TSX                     ; get stack pointer back
      LDA   LAB_STAK+8,X      ; get step sign
      STA   FAC1_s            ; save FAC1 sign (b7)
      LDA   Frnxtl            ; get FOR variable pointer low byte
      LDY   Frnxth            ; get FOR variable pointer high byte
      JSR   LAB_246C          ; add (FOR variable) to FAC1
      JSR   LAB_PFAC          ; pack FAC1 into (FOR variable)
      LDY   #>LAB_STAK        ; point to stack page high byte
      JSR   LAB_27FA          ; compare FAC1 with (Y,ut2_pl) (TO value)
      TSX                     ; get stack pointer back
      CMP   LAB_STAK+8,X      ; compare step sign
      BEQ   LAB_1A9B          ; branch if = (loop complete)

                              ; loop back and do it all again
      LDA   LAB_STAK+$0D,X    ; get FOR line low byte
      STA   Clinel            ; save current line low byte
      LDA   LAB_STAK+$0E,X    ; get FOR line high byte
      STA   Clineh            ; save current line high byte
      LDA   LAB_STAK+$10,X    ; get BASIC execute pointer low byte
      STA   Bpntrl            ; save BASIC execute pointer low byte
      LDA   LAB_STAK+$0F,X    ; get BASIC execute pointer high byte
      STA   Bpntrh            ; save BASIC execute pointer high byte
LAB_1A98
      JMP   LAB_15C2          ; go do interpreter inner loop

                              ; loop complete so carry on
LAB_1A9B
      TXA                     ; stack copy to A
      ADC   #$0F              ; add $10 ($0F+carry) to dump FOR structure
      TAX                     ; copy back to index
      TXS                     ; copy to stack pointer
      JSR   LAB_GBYT          ; scan memory
      CMP   #','              ; compare with ","
      BNE   LAB_1A98          ; branch if not "," (go do interpreter inner loop)

                              ; was "," so another NEXT variable to do
      JSR   LAB_IGBY          ; else increment and scan memory
      JSR   LAB_1A46          ; do NEXT (var)

; evaluate expression and check is numeric, else do type mismatch

LAB_EVNM
      JSR   LAB_EVEX          ; evaluate expression

; check if source is numeric, else do type mismatch

LAB_CTNM
      CLC                     ; destination is numeric
      .db $24               ; makes next line BIT $38

; check if source is string, else do type mismatch

LAB_CTST
      SEC                     ; required type is string

; type match check, set C for string, clear C for numeric

LAB_CKTM
      BIT   Dtypef            ; test data type flag, $FF=string, $00=numeric
      BMI   LAB_1ABA          ; branch if data type is string

                              ; else data type was numeric
      BCS   LAB_1ABC          ; if required type is string do type mismatch error
LAB_1AB9
      RTS

                              ; data type was string, now check required type
LAB_1ABA
      BCS   LAB_1AB9          ; exit if required type is string

                              ; else do type mismatch error
LAB_1ABC
      LDX   #$18              ; error code $18 ("Type mismatch" error)
LAB_1ABE
      JMP   LAB_XERR          ; do error #X, then warm start

; evaluate expression

LAB_EVEX
      LDX   Bpntrl            ; get BASIC execute pointer low byte
      BNE   LAB_1AC7          ; skip next if not zero

      DEC   Bpntrh            ; else decrement BASIC execute pointer high byte
LAB_1AC7
      DEC   Bpntrl            ; decrement BASIC execute pointer low byte

LAB_EVEZ
      LDA   #$00              ; set null precedence (flag done)
LAB_1ACC
      PHA                     ; push precedence byte
      LDA   #$02              ; 2 bytes
      JSR   LAB_1212          ; check room on stack for A bytes
      JSR   LAB_GVAL          ; get value from line
      LDA   #$00              ; clear A
      STA   comp_f            ; clear compare function flag
LAB_1ADB
      JSR   LAB_GBYT          ; scan memory
LAB_1ADE
      SEC                     ; set carry for subtract
      SBC   #TK_GT            ; subtract token for > (lowest comparison function)
      BCC   LAB_1AFA          ; branch if < TK_GT

      CMP   #$03              ; compare with ">" to "<" tokens
      BCS   LAB_1AFA          ; branch if >= TK_SGN (highest evaluation function +1)

                              ; was token for > = or < (A = 0, 1 or 2)
      CMP   #$01              ; compare with token for =
      ROL                     ; *2, b0 = carry (=1 if token was = or <)
                              ; (A = 0, 3 or 5)
      EOR   #$01              ; toggle b0
                              ; (A = 1, 2 or 4. 1 if >, 2 if =, 4 if <)
      EOR   comp_f            ; EOR with compare function flag bits
      CMP   comp_f            ; compare with compare function flag
      BCC   LAB_1B53          ; if <(comp_f) do syntax error then warm start
                              ; was more than one <, = or >)

      STA   comp_f            ; save new compare function flag
      JSR   LAB_IGBY          ; increment and scan memory
      JMP   LAB_1ADE          ; go do next character

                              ; token is < ">" or > "<" tokens
LAB_1AFA
      LDX   comp_f            ; get compare function flag
      BNE   LAB_1B2A          ; branch if compare function

      BCS   LAB_1B78          ; go do functions

                              ; else was <  TK_GT so is operator or lower
      ADC   #TK_GT-TK_PLUS    ; add # of operators (+, -, *, /, ^, AND, OR or EOR)
      BCC   LAB_1B78          ; branch if < + operator

                              ; carry was set so token was +, -, *, /, ^, AND, OR or EOR
      BNE   LAB_1B0B          ; branch if not + token

      BIT   Dtypef            ; test data type flag, $FF=string, $00=numeric
      BPL   LAB_1B0B          ; branch if not string

                              ; will only be $00 if type is string and token was +
      JMP   LAB_224D          ; add strings, string 1 is in descriptor des_pl, string 2
                              ; is in line, and return

LAB_1B0B
      STA   ut1_pl            ; save it
      ASL                     ; *2
      ADC   ut1_pl            ; *3
      TAY                     ; copy to index
LAB_1B13
      PLA                     ; pull previous precedence
      CMP   LAB_OPPT,Y        ; compare with precedence byte
      BCS   LAB_1B7D          ; branch if A >=

      JSR   LAB_CTNM          ; check if source is numeric, else do type mismatch
LAB_1B1C
      PHA                     ; save precedence
LAB_1B1D
      JSR   LAB_1B43          ; get vector, execute function then continue evaluation
      PLA                     ; restore precedence
      LDY   prstk             ; get precedence stacked flag
      BPL   LAB_1B3C          ; branch if stacked values

      TAX                     ; copy precedence (set flags)
      BEQ   LAB_1B9D          ; exit if done

      BNE   LAB_1B86          ; else pop FAC2 and return, branch always

LAB_1B2A
      ROL   Dtypef            ; shift data type flag into Cb
      TXA                     ; copy compare function flag
      STA   Dtypef            ; clear data type flag, X is 0xxx xxxx
      ROL                     ; shift data type into compare function byte b0
      LDX   Bpntrl            ; get BASIC execute pointer low byte
      BNE   LAB_1B34          ; branch if no underflow

      DEC   Bpntrh            ; else decrement BASIC execute pointer high byte
LAB_1B34
      DEC   Bpntrl            ; decrement BASIC execute pointer low byte
TK_LT_PLUS  .EQU TK_LT-TK_PLUS
      LDY   #TK_LT_PLUS*3     ; set offset to last operator entry
      STA   comp_f            ; save new compare function flag
      BNE   LAB_1B13          ; branch always

LAB_1B3C
      CMP   LAB_OPPT,Y        ;.compare with stacked function precedence
      BCS   LAB_1B86          ; branch if A >=, pop FAC2 and return

      BCC   LAB_1B1C          ; branch always

;.get vector, execute function then continue evaluation

LAB_1B43
      LDA   LAB_OPPT+2,Y      ; get function vector high byte
      PHA                     ; onto stack
      LDA   LAB_OPPT+1,Y      ; get function vector low byte
      PHA                     ; onto stack
                              ; now push sign, round FAC1 and put on stack
; *** begin patch  2.22p5.3   potential return address -$100 (page not incremented) ***
; *** add
;X   .IF [* & $FF] == $FD
;X      NOP                     ; return address of JSR +1 (on  next page)
;X   xENDIF  
; *** end   patch  2.22p5.3   potential return address -$100 (page not incremented) ***
      JSR   LAB_1B5B          ; function will return here, then the next RTS will call
                              ; the function
      LDA   comp_f            ; get compare function flag
      PHA                     ; push compare evaluation byte
      LDA   LAB_OPPT,Y        ; get precedence byte
      JMP   LAB_1ACC          ; continue evaluating expression

LAB_1B53
      JMP   LAB_SNER          ; do syntax error then warm start

; push sign, round FAC1 and put on stack

LAB_1B5B
      PLA                     ; get return addr low byte
      STA   ut1_pl            ; save it
      INC   ut1_pl            ; increment it (was ret-1 pushed? yes!)
                              ; note! no check is made on the high byte! if the calling
                              ; routine assembles to a page edge then this all goes
                              ; horribly wrong !!!
      PLA                     ; get return addr high byte
      STA   ut1_ph            ; save it
      LDA   FAC1_s            ; get FAC1 sign (b7)
      PHA                     ; push sign

; round FAC1 and put on stack

; *** begin patch  2.22p5.1   TO expression may get sign bit flipped
; *** replace
;LAB_1B66
;      JSR   LAB_27BA          ; round FAC1
; *** with
      JSR   LAB_27BA          ; round FAC1
LAB_1B66
; *** end   patch  2.22p5.1   TO expression may get sign bit flipped
      LDA   FAC1_3            ; get FAC1 mantissa3
      PHA                     ; push on stack
      LDA   FAC1_2            ; get FAC1 mantissa2
      PHA                     ; push on stack
      LDA   FAC1_1            ; get FAC1 mantissa1
      PHA                     ; push on stack
      LDA   FAC1_e            ; get FAC1 exponent
      PHA                     ; push on stack
      JMP   (ut1_pl)          ; return, sort of

; do functions

LAB_1B78
      LDY   #$FF              ; flag function
      PLA                     ; pull precedence byte
LAB_1B7B
      BEQ   LAB_1B9D          ; exit if done

LAB_1B7D
      CMP   #$64              ; compare previous precedence with $64
      BEQ   LAB_1B84          ; branch if was $64 (< function)

      JSR   LAB_CTNM          ; check if source is numeric, else do type mismatch
LAB_1B84
      STY   prstk             ; save precedence stacked flag

                              ; pop FAC2 and return
LAB_1B86
      PLA                     ; pop byte
      LSR                     ; shift out comparison evaluation lowest bit
      STA   Cflag             ; save comparison evaluation flag
      PLA                     ; pop exponent
      STA   FAC2_e            ; save FAC2 exponent
      PLA                     ; pop mantissa1
      STA   FAC2_1            ; save FAC2 mantissa1
      PLA                     ; pop mantissa2
      STA   FAC2_2            ; save FAC2 mantissa2
      PLA                     ; pop mantissa3
      STA   FAC2_3            ; save FAC2 mantissa3
      PLA                     ; pop sign
      STA   FAC2_s            ; save FAC2 sign (b7)
      EOR   FAC1_s            ; EOR FAC1 sign (b7)
      STA   FAC_sc            ; save sign compare (FAC1 EOR FAC2)
LAB_1B9D
      LDA   FAC1_e            ; get FAC1 exponent
      RTS

; print "..." string to string util area

LAB_1BC1
      LDA   Bpntrl            ; get BASIC execute pointer low byte
      LDY   Bpntrh            ; get BASIC execute pointer high byte
      ADC   #$00              ; add carry to low byte
      BCC   LAB_1BCA          ; branch if no overflow

      INY                     ; increment high byte
LAB_1BCA
      JSR   LAB_20AE          ; print " terminated string to Sutill/Sutilh
      JMP   LAB_23F3          ; restore BASIC execute pointer from temp and return

; get value from line

LAB_GVAL
      JSR   LAB_IGBY          ; increment and scan memory
      BCS   LAB_1BAC          ; branch if not numeric character

                              ; else numeric string found (e.g. 123)
LAB_1BA9
      JMP   LAB_2887          ; get FAC1 from string and return

; get value from line .. continued

                              ; wasn't a number so ..
LAB_1BAC
      TAX                     ; set the flags
      BMI   LAB_1BD0          ; if -ve go test token values

                              ; else it is either a string, number, variable or (<expr>)
      CMP   #'$'              ; compare with "$"
      BEQ   LAB_1BA9          ; branch if "$", hex number

      CMP   #'%'              ; else compare with "%"
      BEQ   LAB_1BA9          ; branch if "%", binary number

      CMP   #'.'              ; compare with "."
      BEQ   LAB_1BA9          ; if so get FAC1 from string and return (e.g. was .123)

                              ; it wasn't any sort of number so ..
      CMP   #$22              ; compare with "
      BEQ   LAB_1BC1          ; branch if open quote

                              ; wasn't any sort of number so ..

; evaluate expression within parentheses

      CMP   #'('              ; compare with "("
      BNE   LAB_1C18          ; if not "(" get (var), return value in FAC1 and $ flag

LAB_1BF7
      JSR   LAB_EVEZ          ; evaluate expression, no decrement

; all the 'scan for' routines return the character after the sought character

; scan for ")" , else do syntax error then warm start

LAB_1BFB
      LDA   #$29              ; load A with ")"

; scan for CHR$(A) , else do syntax error then warm start

LAB_SCCA
      LDY   #$00              ; clear index
      CMP   (Bpntrl),Y        ; check next byte is = A
      BNE   LAB_SNER          ; if not do syntax error then warm start

      JMP   LAB_IGBY          ; increment and scan memory then return

; scan for "(" , else do syntax error then warm start

LAB_1BFE
      LDA   #$28              ; load A with "("
      BNE   LAB_SCCA          ; scan for CHR$(A), else do syntax error then warm start
                              ; (branch always)

; scan for "," , else do syntax error then warm start

LAB_1C01
      LDA   #$2C              ; load A with ","
      BNE   LAB_SCCA          ; scan for CHR$(A), else do syntax error then warm start
                              ; (branch always)

; syntax error then warm start

LAB_SNER
      LDX   #$02              ; error code $02 ("Syntax" error)
      JMP   LAB_XERR          ; do error #X, then warm start

; get value from line .. continued
; do tokens

LAB_1BD0
      CMP   #TK_MINUS         ; compare with token for -
      BEQ   LAB_1C11          ; branch if - token (do set-up for functions)

                              ; wasn't -n so ..
      CMP   #TK_PLUS          ; compare with token for +
      BEQ   LAB_GVAL          ; branch if + token (+n = n so ignore leading +)

      CMP   #TK_NOT           ; compare with token for NOT
      BNE   LAB_1BE7          ; branch if not token for NOT

                              ; was NOT token
TK_EQUAL_PLUS     .EQU TK_EQUAL-TK_PLUS
      LDY   #TK_EQUAL_PLUS*3  ; offset to NOT function
      BNE   LAB_1C13          ; do set-up for function then execute (branch always)

; do = compare

LAB_EQUAL
      JSR   LAB_EVIR          ; evaluate integer expression (no sign check)
      LDA   FAC1_3            ; get FAC1 mantissa3
      EOR   #$FF              ; invert it
      TAY                     ; copy it
      LDA   FAC1_2            ; get FAC1 mantissa2
      EOR   #$FF              ; invert it
      JMP   LAB_AYFC          ; save and convert integer AY to FAC1 and return

; get value from line .. continued

                              ; wasn't +, -, or NOT so ..
LAB_1BE7
      CMP   #TK_FN            ; compare with token for FN
      BNE   LAB_1BEE          ; branch if not token for FN

      JMP   LAB_201E          ; go evaluate FNx

; get value from line .. continued

                              ; wasn't +, -, NOT or FN so ..
LAB_1BEE
      SBC   #TK_SGN           ; subtract with token for SGN
      BCS   LAB_1C27          ; if a function token go do it

      JMP   LAB_SNER          ; else do syntax error

; set-up for functions

LAB_1C11
TK_GT_PLUS  .EQU TK_GT-TK_PLUS
      LDY   #TK_GT_PLUS*3     ; set offset from base to > operator
LAB_1C13
      PLA                     ; dump return address low byte
; *** begin patch  2.22p5.4  concatenate MINUS or NOT() crashes EhBASIC  ***
; *** replace
;      PLA                     ; dump return address high byte
;      JMP   LAB_1B1D          ; execute function then continue evaluation
; *** with
      TAX                     ; save to trap concatenate
      PLA                     ; dump return address high byte
      CPX   #<(LAB_224Da+2)   ; from concatenate low return address?
      BNE   LAB_1C13b         ; No - continue!
      CMP   #>(LAB_224Da+2)   ; from concatenate high return address?
      BEQ   LAB_1C13a         ; Yes - error!
LAB_1C13b
      JMP   LAB_1B1D          ; execute function then continue evaluation
LAB_1C13a
      JMP   LAB_1ABC          ; throw "type mismatch error" then warm start      
; *** end   patch  2.22p5.4  concatenate MINUS or NOT() crashes EhBASIC  ***

; variable name set-up
; get (var), return value in FAC_1 and $ flag

LAB_1C18
      JSR   LAB_GVAR          ; get (var) address
      STA   FAC1_2            ; save address low byte in FAC1 mantissa2
      STY   FAC1_3            ; save address high byte in FAC1 mantissa3
      LDX   Dtypef            ; get data type flag, $FF=string, $00=numeric
      BMI   LAB_1C25          ; if string then return (does RTS)

LAB_1C24
      JMP   LAB_UFAC          ; unpack memory (AY) into FAC1

LAB_1C25
; *** begin patch  string pointer high byte trashed when moved to stack
; *** add
      LSR   FAC1_r            ; clear bit 7 (<$80) = do not round up
; *** end patch 
      RTS

; get value from line .. continued
; only functions left so ..

; set up function references

; new for V2.0+ this replaces a lot of IF .. THEN .. ELSEIF .. THEN .. that was needed
; to process function calls. now the function vector is computed and pushed on the stack
; and the preprocess offset is read. if the preprocess offset is non zero then the vector
; is calculated and the routine called, if not this routine just does RTS. whichever
; happens the RTS at the end of this routine, or the end of the preprocess routine, calls
; the function code

; this also removes some less than elegant code that was used to bypass type checking
; for functions that returned strings

LAB_1C27
      ASL                     ; *2 (2 bytes per function address)
      TAY                     ; copy to index

      LDA   LAB_FTBM,Y        ; get function jump vector high byte
      PHA                     ; push functions jump vector high byte
      LDA   LAB_FTBL,Y        ; get function jump vector low byte
      PHA                     ; push functions jump vector low byte

      LDA   LAB_FTPM,Y        ; get function pre process vector high byte
      BEQ   LAB_1C56          ; skip pre process if null vector

      PHA                     ; push functions pre process vector high byte
      LDA   LAB_FTPL,Y        ; get function pre process vector low byte
      PHA                     ; push functions pre process vector low byte

LAB_1C56
      RTS                     ; do function, or pre process, call

; process string expression in parenthesis

LAB_PPFS
      JSR   LAB_1BF7          ; process expression in parenthesis
      JMP   LAB_CTST          ; check if source is string then do function,
                              ; else do type mismatch

; process numeric expression in parenthesis

LAB_PPFN
      JSR   LAB_1BF7          ; process expression in parenthesis
      JMP   LAB_CTNM          ; check if source is numeric then do function,
                              ; else do type mismatch

; set numeric data type and increment BASIC execute pointer

LAB_PPBI
      LSR   Dtypef            ; clear data type flag, $FF=string, $00=numeric
      JMP   LAB_IGBY          ; increment and scan memory then do function

; process string for LEFT$, RIGHT$ or MID$

LAB_LRMS
      JSR   LAB_EVEZ          ; evaluate (should be string) expression
      JSR   LAB_1C01          ; scan for ",", else do syntax error then warm start
      JSR   LAB_CTST          ; check if source is string, else do type mismatch

      PLA                     ; get function jump vector low byte
      TAX                     ; save functions jump vector low byte
      PLA                     ; get function jump vector high byte
      TAY                     ; save functions jump vector high byte
      LDA   des_ph            ; get descriptor pointer high byte
      PHA                     ; push string pointer high byte
      LDA   des_pl            ; get descriptor pointer low byte
      PHA                     ; push string pointer low byte
      TYA                     ; get function jump vector high byte back
      PHA                     ; save functions jump vector high byte
      TXA                     ; get function jump vector low byte back
      PHA                     ; save functions jump vector low byte
      JSR   LAB_GTBY          ; get byte parameter
      TXA                     ; copy byte parameter to A
      RTS                     ; go do function

; process numeric expression(s) for BIN$ or HEX$

LAB_BHSS
      JSR   LAB_EVEZ          ; process expression
      JSR   LAB_CTNM          ; check if source is numeric, else do type mismatch
      LDA   FAC1_e            ; get FAC1 exponent
      CMP   #$98              ; compare with exponent = 2^24
      BCS   LAB_BHER          ; branch if n>=2^24 (is too big)

      JSR   LAB_2831          ; convert FAC1 floating-to-fixed
      LDX   #$02              ; 3 bytes to do
LAB_CFAC
      LDA   FAC1_1,X          ; get byte from FAC1
      STA   nums_1,X          ; save byte to temp
      DEX                     ; decrement index
      BPL   LAB_CFAC          ; copy FAC1 mantissa to temp

      JSR   LAB_GBYT          ; get next BASIC byte
      LDX   #$00              ; set default to no leading "0"s
      CMP   #')'              ; compare with close bracket
      BEQ   LAB_1C54          ; if ")" go do rest of function

      JSR   LAB_SCGB          ; scan for "," and get byte
      JSR   LAB_GBYT          ; get last byte back
      CMP   #')'              ; is next character )
      BNE   LAB_BHER          ; if not ")" go do error

LAB_1C54
      RTS                     ; else do function

LAB_BHER
      JMP   LAB_FCER          ; do function call error then warm start

; perform EOR

; added operator format is the same as AND or OR, precedence is the same as OR

; this bit worked first time but it took a while to sort out the operator table
; pointers and offsets afterwards!

LAB_EOR
      JSR   GetFirst          ; get first integer expression (no sign check)
      EOR   XOAw_l            ; EOR with expression 1 low byte
      TAY                     ; save in Y
      LDA   FAC1_2            ; get FAC1 mantissa2
      EOR   XOAw_h            ; EOR with expression 1 high byte
      JMP   LAB_AYFC          ; save and convert integer AY to FAC1 and return

; perform OR

LAB_OR
      JSR   GetFirst          ; get first integer expression (no sign check)
      ORA   XOAw_l            ; OR with expression 1 low byte
      TAY                     ; save in Y
      LDA   FAC1_2            ; get FAC1 mantissa2
      ORA   XOAw_h            ; OR with expression 1 high byte
      JMP   LAB_AYFC          ; save and convert integer AY to FAC1 and return

; perform AND

LAB_AND
      JSR   GetFirst          ; get first integer expression (no sign check)
      AND   XOAw_l            ; AND with expression 1 low byte
      TAY                     ; save in Y
      LDA   FAC1_2            ; get FAC1 mantissa2
      AND   XOAw_h            ; AND with expression 1 high byte
      JMP   LAB_AYFC          ; save and convert integer AY to FAC1 and return

; get first value for OR, AND or EOR

GetFirst
      JSR   LAB_EVIR          ; evaluate integer expression (no sign check)
      LDA   FAC1_2            ; get FAC1 mantissa2
      STA   XOAw_h            ; save it
      LDA   FAC1_3            ; get FAC1 mantissa3
      STA   XOAw_l            ; save it
      JSR   LAB_279B          ; copy FAC2 to FAC1 (get 2nd value in expression)
      JSR   LAB_EVIR          ; evaluate integer expression (no sign check)
      LDA   FAC1_3            ; get FAC1 mantissa3
LAB_1C95
      RTS

; perform comparisons

; do < compare

LAB_LTHAN
      JSR   LAB_CKTM          ; type match check, set C for string
      BCS   LAB_1CAE          ; branch if string

                              ; do numeric < compare
      LDA   FAC2_s            ; get FAC2 sign (b7)
      ORA   #$7F              ; set all non sign bits
      AND   FAC2_1            ; and FAC2 mantissa1 (AND in sign bit)
      STA   FAC2_1            ; save FAC2 mantissa1
      LDA   #<FAC2_e          ; set pointer low byte to FAC2
      LDY   #>FAC2_e          ; set pointer high byte to FAC2
      JSR   LAB_27F8          ; compare FAC1 with FAC2 (AY)
      TAX                     ; copy result
      JMP   LAB_1CE1          ; go evaluate result

                              ; do string < compare
LAB_1CAE
      LSR   Dtypef            ; clear data type flag, $FF=string, $00=numeric
      DEC   comp_f            ; clear < bit in compare function flag
      JSR   LAB_22B6          ; pop string off descriptor stack, or from top of string
                              ; space returns with A = length, X=pointer low byte,
                              ; Y=pointer high byte
      STA   str_ln            ; save length
      STX   str_pl            ; save string pointer low byte
      STY   str_ph            ; save string pointer high byte
      LDA   FAC2_2            ; get descriptor pointer low byte
      LDY   FAC2_3            ; get descriptor pointer high byte
      JSR   LAB_22BA          ; pop (YA) descriptor off stack or from top of string space
                              ; returns with A = length, X=pointer low byte,
                              ; Y=pointer high byte
      STX   FAC2_2            ; save string pointer low byte
      STY   FAC2_3            ; save string pointer high byte
      TAX                     ; copy length
      SEC                     ; set carry for subtract
      SBC   str_ln            ; subtract string 1 length
      BEQ   LAB_1CD6          ; branch if str 1 length = string 2 length

      LDA   #$01              ; set str 1 length > string 2 length
      BCC   LAB_1CD6          ; branch if so

      LDX   str_ln            ; get string 1 length
      LDA   #$FF              ; set str 1 length < string 2 length
LAB_1CD6
      STA   FAC1_s            ; save length compare
      LDY   #$FF              ; set index
      INX                     ; adjust for loop
LAB_1CDB
      INY                     ; increment index
      DEX                     ; decrement count
      BNE   LAB_1CE6          ; branch if still bytes to do

      LDX   FAC1_s            ; get length compare back
LAB_1CE1
      BMI   LAB_1CF2          ; branch if str 1 < str 2

      CLC                     ; flag str 1 <= str 2
      BCC   LAB_1CF2          ; go evaluate result

LAB_1CE6
      LDA   (FAC2_2),Y        ; get string 2 byte
      CMP   (FAC1_1),Y        ; compare with string 1 byte
      BEQ   LAB_1CDB          ; loop if bytes =

      LDX   #$FF              ; set str 1 < string 2
      BCS   LAB_1CF2          ; branch if so

      LDX   #$01              ;  set str 1 > string 2
LAB_1CF2
      INX                     ; x = 0, 1 or 2
      TXA                     ; copy to A
      ROL                     ; *2 (1, 2 or 4)
      AND   Cflag             ; AND with comparison evaluation flag
      BEQ   LAB_1CFB          ; branch if 0 (compare is false)

      LDA   #$FF              ; else set result true
LAB_1CFB
      JMP   LAB_27DB          ; save A as integer byte and return

LAB_1CFE
      JSR   LAB_1C01          ; scan for ",", else do syntax error then warm start

; perform DIM

LAB_DIM
      TAX                     ; copy "DIM" flag to X
      JSR   LAB_1D10          ; search for variable
      JSR   LAB_GBYT          ; scan memory
      BNE   LAB_1CFE          ; scan for "," and loop if not null

      RTS

; perform << (left shift)

LAB_LSHIFT
      JSR   GetPair           ; get integer expression and byte (no sign check)
      LDA   FAC1_2            ; get expression high byte
      LDX   TempB             ; get shift count
      BEQ   NoShift           ; branch if zero

      CPX   #$10              ; compare bit count with 16d
      BCS   TooBig            ; branch if >=

Ls_loop
      ASL   FAC1_3            ; shift low byte
      ROL                     ; shift high byte
      DEX                     ; decrement bit count
      BNE   Ls_loop           ; loop if shift not complete

      LDY   FAC1_3            ; get expression low byte
      JMP   LAB_AYFC          ; save and convert integer AY to FAC1 and return

; perform >> (right shift)

LAB_RSHIFT
      JSR   GetPair           ; get integer expression and byte (no sign check)
      LDA   FAC1_2            ; get expression high byte
      LDX   TempB             ; get shift count
      BEQ   NoShift           ; branch if zero

      CPX   #$10              ; compare bit count with 16d
      BCS   TooBig            ; branch if >=

Rs_loop
      LSR                     ; shift high byte
      ROR   FAC1_3            ; shift low byte
      DEX                     ; decrement bit count
      BNE   Rs_loop           ; loop if shift not complete

NoShift
      LDY   FAC1_3            ; get expression low byte
      JMP   LAB_AYFC          ; save and convert integer AY to FAC1 and return

TooBig
      LDA   #$00              ; clear high byte
      TAY                     ; copy to low byte
      JMP   LAB_AYFC          ; save and convert integer AY to FAC1 and return

GetPair
      JSR   LAB_EVBY          ; evaluate byte expression, result in X
      STX   TempB             ; save it
      JSR   LAB_279B          ; copy FAC2 to FAC1 (get 2nd value in expression)
      JMP   LAB_EVIR          ; evaluate integer expression (no sign check)

; search for variable

; return pointer to variable in Cvaral/Cvarah

LAB_GVAR
      LDX   #$00              ; set DIM flag = $00
      JSR   LAB_GBYT          ; scan memory (1st character)
LAB_1D10
      STX   Defdim            ; save DIM flag
LAB_1D12
      STA   Varnm1            ; save 1st character
      AND   #$7F              ; clear FN flag bit
      JSR   LAB_CASC          ; check byte, return C=0 if<"A" or >"Z"
      BCS   LAB_1D1F          ; branch if ok

      JMP   LAB_SNER          ; else syntax error then warm start

                              ; was variable name so ..
LAB_1D1F
      LDX   #$00              ; clear 2nd character temp
      STX   Dtypef            ; clear data type flag, $FF=string, $00=numeric
      JSR   LAB_IGBY          ; increment and scan memory (2nd character)
      BCC   LAB_1D2D          ; branch if character = "0"-"9" (ok)

                              ; 2nd character wasn't "0" to "9" so ..
      JSR   LAB_CASC          ; check byte, return C=0 if<"A" or >"Z"
      BCC   LAB_1D38          ; branch if <"A" or >"Z" (go check if string)

LAB_1D2D
      TAX                     ; copy 2nd character

                              ; ignore further (valid) characters in the variable name
LAB_1D2E
      JSR   LAB_IGBY          ; increment and scan memory (3rd character)
      BCC   LAB_1D2E          ; loop if character = "0"-"9" (ignore)

      JSR   LAB_CASC          ; check byte, return C=0 if<"A" or >"Z"
      BCS   LAB_1D2E          ; loop if character = "A"-"Z" (ignore)

                              ; check if string variable
LAB_1D38
      CMP   #'$'              ; compare with "$"
      BNE   LAB_1D47          ; branch if not string

; to introduce a new variable type (% suffix for integers say) then this branch
; will need to go to that check and then that branch, if it fails, go to LAB_1D47

                              ; type is string
      LDA   #$FF              ; set data type = string
      STA   Dtypef            ; set data type flag, $FF=string, $00=numeric
      TXA                     ; get 2nd character back
      ORA   #$80              ; set top bit (indicate string var)
      TAX                     ; copy back to 2nd character temp
      JSR   LAB_IGBY          ; increment and scan memory

; after we have determined the variable type we need to come back here to determine
; if it's an array of type. this would plug in a%(b[,c[,d]])) integer arrays nicely


LAB_1D47                      ; gets here with character after var name in A
      STX   Varnm2            ; save 2nd character
      ORA   Sufnxf            ; or with subscript/FNX flag (or FN name)
      CMP   #'('              ; compare with "("
      BNE   LAB_1D53          ; branch if not "("

      JMP   LAB_1E17          ; go find, or make, array

; either find or create var
; var name (1st two characters only!) is in Varnm1,Varnm2

                              ; variable name wasn't var(... so look for plain var
LAB_1D53
      LDA   #$00              ; clear A
      STA   Sufnxf            ; clear subscript/FNX flag
      LDA   Svarl             ; get start of vars low byte
      LDX   Svarh             ; get start of vars high byte
      LDY   #$00              ; clear index
LAB_1D5D
      STX   Vrschh            ; save search address high byte
LAB_1D5F
      STA   Vrschl            ; save search address low byte
      CPX   Sarryh            ; compare high address with var space end
      BNE   LAB_1D69          ; skip next compare if <>

                              ; high addresses were = so compare low addresses
      CMP   Sarryl            ; compare low address with var space end
      BEQ   LAB_1D8B          ; if not found go make new var

LAB_1D69
      LDA   Varnm1            ; get 1st character of var to find
      CMP   (Vrschl),Y        ; compare with variable name 1st character
      BNE   LAB_1D77          ; branch if no match

                              ; 1st characters match so compare 2nd characters
      LDA   Varnm2            ; get 2nd character of var to find
      INY                     ; index to point to variable name 2nd character
      CMP   (Vrschl),Y        ; compare with variable name 2nd character
      BEQ   LAB_1DD7          ; branch if match (found var)

      DEY                     ; else decrement index (now = $00)
LAB_1D77
      CLC                     ; clear carry for add
      LDA   Vrschl            ; get search address low byte
      ADC   #$06              ; +6 (offset to next var name)
      BCC   LAB_1D5F          ; loop if no overflow to high byte

      INX                     ; else increment high byte
      BNE   LAB_1D5D          ; loop always (RAM doesn't extend to $FFFF !)

; check byte, return C=0 if<"A" or >"Z" or "a" to "z"

LAB_CASC
      CMP   #'a'              ; compare with "a"
      BCS   LAB_1D83          ; go check <"z"+1

; check byte, return C=0 if<"A" or >"Z"

LAB_1D82
      CMP   #'A'              ; compare with "A"
      BCC   LAB_1D8A          ; exit if less

                              ; carry is set
      SBC   #$5B              ; subtract "Z"+1
      SEC                     ; set carry
      SBC   #$A5              ; subtract $A5 (restore byte)
                              ; carry clear if byte>$5A
LAB_1D8A
      RTS

LAB_1D83
      SBC   #$7B              ; subtract "z"+1
      SEC                     ; set carry
      SBC   #$85              ; subtract $85 (restore byte)
                              ; carry clear if byte>$7A
      RTS

                              ; reached end of variable mem without match
                              ; .. so create new variable
LAB_1D8B
      PLA                     ; pop return address low byte
      PHA                     ; push return address low byte
LAB_1C18p2  .EQU LAB_1C18+2
      CMP   #<LAB_1C18p2      ; compare with expected calling routine return low byte
      BNE   LAB_1D98          ; if not get (var) go create new var

; This will only drop through if the call was from LAB_1C18 and is only called
; from there if it is searching for a variable from the RHS of a LET a=b statement
; it prevents the creation of variables not assigned a value.

; value returned by this is either numeric zero (exponent byte is $00) or null string
; (descriptor length byte is $00). in fact a pointer to any $00 byte would have done.

; doing this saves 6 bytes of variable memory and 168 machine cycles of time

; this is where you would put the undefined variable error call e.g.

;                             ; variable doesn't exist so flag error
;     LDX   #$24              ; error code $24 ("undefined variable" error)
;     JMP   LAB_XERR          ; do error #X then warm start

; the above code has been tested and works a treat! (it replaces the three code lines
; below)

                              ; else return dummy null value
      LDA   #<LAB_1D96        ; low byte point to $00,$00
                              ; (uses part of misc constants table)
      LDY   #>LAB_1D96        ; high byte point to $00,$00
      RTS

                              ; create new numeric variable
LAB_1D98
      LDA   Sarryl            ; get var mem end low byte
      LDY   Sarryh            ; get var mem end high byte
      STA   Ostrtl            ; save old block start low byte
      STY   Ostrth            ; save old block start high byte
      LDA   Earryl            ; get array mem end low byte
      LDY   Earryh            ; get array mem end high byte
      STA   Obendl            ; save old block end low byte
      STY   Obendh            ; save old block end high byte
      CLC                     ; clear carry for add
      ADC   #$06              ; +6 (space for one var)
      BCC   LAB_1DAE          ; branch if no overflow to high byte

      INY                     ; else increment high byte
LAB_1DAE
      STA   Nbendl            ; set new block end low byte
      STY   Nbendh            ; set new block end high byte
      JSR   LAB_11CF          ; open up space in memory
      LDA   Nbendl            ; get new start low byte
      LDY   Nbendh            ; get new start high byte (-$100)
      INY                     ; correct high byte
      STA   Sarryl            ; save new var mem end low byte
      STY   Sarryh            ; save new var mem end high byte
      LDY   #$00              ; clear index
      LDA   Varnm1            ; get var name 1st character
      STA   (Vrschl),Y        ; save var name 1st character
      INY                     ; increment index
      LDA   Varnm2            ; get var name 2nd character
      STA   (Vrschl),Y        ; save var name 2nd character
      LDA   #$00              ; clear A
      INY                     ; increment index
      STA   (Vrschl),Y        ; initialise var byte
      INY                     ; increment index
      STA   (Vrschl),Y        ; initialise var byte
      INY                     ; increment index
      STA   (Vrschl),Y        ; initialise var byte
      INY                     ; increment index
      STA   (Vrschl),Y        ; initialise var byte

                              ; found a match for var ((Vrschl) = ptr)
LAB_1DD7
      LDA   Vrschl            ; get var address low byte
      CLC                     ; clear carry for add
      ADC   #$02              ; +2 (offset past var name bytes)
      LDY   Vrschh            ; get var address high byte
      BCC   LAB_1DE1          ; branch if no overflow from add

      INY                     ; else increment high byte
LAB_1DE1
      STA   Cvaral            ; save current var address low byte
      STY   Cvarah            ; save current var address high byte
      RTS

; set-up array pointer (Adatal/h) to first element in array
; set Adatal,Adatah to Astrtl,Astrth+2*Dimcnt+#$05

LAB_1DE6
      LDA   Dimcnt            ; get # of dimensions (1, 2 or 3)
      ASL                     ; *2 (also clears the carry !)
      ADC   #$05              ; +5 (result is 7, 9 or 11 here)
      ADC   Astrtl            ; add array start pointer low byte
      LDY   Astrth            ; get array pointer high byte
      BCC   LAB_1DF2          ; branch if no overflow

      INY                     ; else increment high byte
LAB_1DF2
      STA   Adatal            ; save array data pointer low byte
      STY   Adatah            ; save array data pointer high byte
      RTS

; evaluate integer expression

LAB_EVIN
      JSR   LAB_IGBY          ; increment and scan memory
      JSR   LAB_EVNM          ; evaluate expression and check is numeric,
                              ; else do type mismatch

; evaluate integer expression (no check)

LAB_EVPI
      LDA   FAC1_s            ; get FAC1 sign (b7)
      BMI   LAB_1E12          ; do function call error if -ve

; evaluate integer expression (no sign check)

LAB_EVIR
      LDA   FAC1_e            ; get FAC1 exponent
      CMP   #$90              ; compare with exponent = 2^16 (n>2^15)
      BCC   LAB_1E14          ; branch if n<2^16 (is ok)

      LDA   #<LAB_1DF7        ; set pointer low byte to -32768
      LDY   #>LAB_1DF7        ; set pointer high byte to -32768
      JSR   LAB_27F8          ; compare FAC1 with (AY)
LAB_1E12
      BNE   LAB_FCER          ; if <> do function call error then warm start

LAB_1E14
      JMP   LAB_2831          ; convert FAC1 floating-to-fixed and return

; find or make array

LAB_1E17
      LDA   Defdim            ; get DIM flag
      PHA                     ; push it
      LDA   Dtypef            ; get data type flag, $FF=string, $00=numeric
      PHA                     ; push it
      LDY   #$00              ; clear dimensions count

; now get the array dimension(s) and stack it (them) before the data type and DIM flag

LAB_1E1F
      TYA                     ; copy dimensions count
      PHA                     ; save it
      LDA   Varnm2            ; get array name 2nd byte
      PHA                     ; save it
      LDA   Varnm1            ; get array name 1st byte
      PHA                     ; save it
      JSR   LAB_EVIN          ; evaluate integer expression
      PLA                     ; pull array name 1st byte
      STA   Varnm1            ; restore array name 1st byte
      PLA                     ; pull array name 2nd byte
      STA   Varnm2            ; restore array name 2nd byte
      PLA                     ; pull dimensions count
      TAY                     ; restore it
      TSX                     ; copy stack pointer
      LDA   LAB_STAK+2,X      ; get DIM flag
      PHA                     ; push it
      LDA   LAB_STAK+1,X      ; get data type flag
      PHA                     ; push it
      LDA   FAC1_2            ; get this dimension size high byte
      STA   LAB_STAK+2,X      ; stack before flag bytes
      LDA   FAC1_3            ; get this dimension size low byte
      STA   LAB_STAK+1,X      ; stack before flag bytes
      INY                     ; increment dimensions count
      JSR   LAB_GBYT          ; scan memory
      CMP   #','              ; compare with ","
      BEQ   LAB_1E1F          ; if found go do next dimension

      STY   Dimcnt            ; store dimensions count
      JSR   LAB_1BFB          ; scan for ")" , else do syntax error then warm start
      PLA                     ; pull data type flag
      STA   Dtypef            ; restore data type flag, $FF=string, $00=numeric
      PLA                     ; pull DIM flag
      STA   Defdim            ; restore DIM flag
      LDX   Sarryl            ; get array mem start low byte
      LDA   Sarryh            ; get array mem start high byte

; now check to see if we are at the end of array memory (we would be if there were
; no arrays).

LAB_1E5C
      STX   Astrtl            ; save as array start pointer low byte
      STA   Astrth            ; save as array start pointer high byte
      CMP   Earryh            ; compare with array mem end high byte
      BNE   LAB_1E68          ; branch if not reached array mem end

      CPX   Earryl            ; else compare with array mem end low byte
      BEQ   LAB_1EA1          ; go build array if not found

                              ; search for array
LAB_1E68
      LDY   #$00              ; clear index
      LDA   (Astrtl),Y        ; get array name first byte
      INY                     ; increment index to second name byte
      CMP   Varnm1            ; compare with this array name first byte
      BNE   LAB_1E77          ; branch if no match

      LDA   Varnm2            ; else get this array name second byte
      CMP   (Astrtl),Y        ; compare with array name second byte
      BEQ   LAB_1E8D          ; array found so branch

                              ; no match
LAB_1E77
      INY                     ; increment index
      LDA   (Astrtl),Y        ; get array size low byte
      CLC                     ; clear carry for add
      ADC   Astrtl            ; add array start pointer low byte
      TAX                     ; copy low byte to X
      INY                     ; increment index
      LDA   (Astrtl),Y        ; get array size high byte
      ADC   Astrth            ; add array mem pointer high byte
      BCC   LAB_1E5C          ; if no overflow go check next array

; do array bounds error

LAB_1E85
      LDX   #$10              ; error code $10 ("Array bounds" error)
	  .db	$2C               ; makes next bit BIT LAB_08A2

; do function call error

LAB_FCER
      LDX   #$08              ; error code $08 ("Function call" error)
LAB_1E8A
      JMP   LAB_XERR          ; do error #X, then warm start

                              ; found array, are we trying to dimension it?
LAB_1E8D
      LDX   #$12              ; set error $12 ("Double dimension" error)
      LDA   Defdim            ; get DIM flag
      BNE   LAB_1E8A          ; if we are trying to dimension it do error #X, then warm
                              ; start

; found the array and we're not dimensioning it so we must find an element in it

      JSR   LAB_1DE6          ; set-up array pointer (Adatal/h) to first element in array
                              ; (Astrtl,Astrth points to start of array)
      LDA   Dimcnt            ; get dimensions count
      LDY   #$04              ; set index to array's # of dimensions
      CMP   (Astrtl),Y        ; compare with no of dimensions
      BNE   LAB_1E85          ; if wrong do array bounds error, could do "Wrong
                              ; dimensions" error here .. if we want a different
                              ; error message

      JMP   LAB_1F28          ; found array so go get element
                              ; (could jump to LAB_1F28 as all LAB_1F24 does is take
                              ; Dimcnt and save it at (Astrtl),Y which is already the
                              ; same or we would have taken the BNE)

                              ; array not found, so build it
LAB_1EA1
      JSR   LAB_1DE6          ; set-up array pointer (Adatal/h) to first element in array
                              ; (Astrtl,Astrth points to start of array)
      JSR   LAB_121F          ; check available memory, "Out of memory" error if no room
                              ; addr to check is in AY (low/high)
      LDY   #$00              ; clear Y (don't need to clear A)
      STY   Aspth             ; clear array data size high byte
      LDA   Varnm1            ; get variable name 1st byte
      STA   (Astrtl),Y        ; save array name 1st byte
      INY                     ; increment index
      LDA   Varnm2            ; get variable name 2nd byte
      STA   (Astrtl),Y        ; save array name 2nd byte
      LDA   Dimcnt            ; get dimensions count
      LDY   #$04              ; index to dimension count
      STY   Asptl             ; set array data size low byte (four bytes per element)
      STA   (Astrtl),Y        ; set array's dimensions count

                              ; now calculate the size of the data space for the array
      CLC                     ; clear carry for add (clear on subsequent loops)
LAB_1EC0
      LDX   #$0B              ; set default dimension value low byte
      LDA   #$00              ; set default dimension value high byte
      BIT   Defdim            ; test default DIM flag
      BVC   LAB_1ED0          ; branch if b6 of Defdim is clear

      PLA                     ; else pull dimension value low byte
      ADC   #$01              ; +1 (allow for zeroeth element)
      TAX                     ; copy low byte to X
      PLA                     ; pull dimension value high byte
      ADC   #$00              ; add carry from low byte

LAB_1ED0
      INY                     ; index to dimension value high byte
      STA   (Astrtl),Y        ; save dimension value high byte
      INY                     ; index to dimension value high byte
      TXA                     ; get dimension value low byte
      STA   (Astrtl),Y        ; save dimension value low byte
      JSR   LAB_1F7C          ; does XY = (Astrtl),Y * (Asptl)
      STX   Asptl             ; save array data size low byte
      STA   Aspth             ; save array data size high byte
      LDY   ut1_pl            ; restore index (saved by subroutine)
      DEC   Dimcnt            ; decrement dimensions count
      BNE   LAB_1EC0          ; loop while not = 0

      ADC   Adatah            ; add size high byte to first element high byte
                              ; (carry is always clear here)
      BCS   LAB_1F45          ; if overflow go do "Out of memory" error

      STA   Adatah            ; save end of array high byte
      TAY                     ; copy end high byte to Y
      TXA                     ; get array size low byte
      ADC   Adatal            ; add array start low byte
      BCC   LAB_1EF3          ; branch if no carry

      INY                     ; else increment end of array high byte
      BEQ   LAB_1F45          ; if overflow go do "Out of memory" error

                              ; set-up mostly complete, now zero the array
LAB_1EF3
      JSR   LAB_121F          ; check available memory, "Out of memory" error if no room
                              ; addr to check is in AY (low/high)
      STA   Earryl            ; save array mem end low byte
      STY   Earryh            ; save array mem end high byte
      LDA   #$00              ; clear byte for array clear
      INC   Aspth             ; increment array size high byte (now block count)
      LDY   Asptl             ; get array size low byte (now index to block)
      BEQ   LAB_1F07          ; branch if low byte = $00

LAB_1F02
      DEY                     ; decrement index (do 0 to n-1)
      STA   (Adatal),Y        ; zero byte
      BNE   LAB_1F02          ; loop until this block done

LAB_1F07
      DEC   Adatah            ; decrement array pointer high byte
      DEC   Aspth             ; decrement block count high byte
      BNE   LAB_1F02          ; loop until all blocks done

      INC   Adatah            ; correct for last loop
      SEC                     ; set carry for subtract
      LDY   #$02              ; index to array size low byte
      LDA   Earryl            ; get array mem end low byte
      SBC   Astrtl            ; subtract array start low byte
      STA   (Astrtl),Y        ; save array size low byte
      INY                     ; index to array size high byte
      LDA   Earryh            ; get array mem end high byte
      SBC   Astrth            ; subtract array start high byte
      STA   (Astrtl),Y        ; save array size high byte
      LDA   Defdim            ; get default DIM flag
      BNE   LAB_1F7B          ; exit (RET) if this was a DIM command

                              ; else, find element
      INY                     ; index to # of dimensions

LAB_1F24
      LDA   (Astrtl),Y        ; get array's dimension count
      STA   Dimcnt            ; save it

; we have found, or built, the array. now we need to find the element

LAB_1F28
      LDA   #$00              ; clear byte
      STA   Asptl             ; clear array data pointer low byte
LAB_1F2C
      STA   Aspth             ; save array data pointer high byte
      INY                     ; increment index (point to array bound high byte)
      PLA                     ; pull array index low byte
      TAX                     ; copy to X
      STA   FAC1_2            ; save index low byte to FAC1 mantissa2
      PLA                     ; pull array index high byte
      STA   FAC1_3            ; save index high byte to FAC1 mantissa3
      CMP   (Astrtl),Y        ; compare with array bound high byte
      BCC   LAB_1F48          ; branch if within bounds

      BNE   LAB_1F42          ; if outside bounds do array bounds error

                              ; else high byte was = so test low bytes
      INY                     ; index to array bound low byte
      TXA                     ; get array index low byte
      CMP   (Astrtl),Y        ; compare with array bound low byte
      BCC   LAB_1F49          ; branch if within bounds

LAB_1F42
      JMP   LAB_1E85          ; else do array bounds error

LAB_1F45
      JMP   LAB_OMER          ; do "Out of memory" error then warm start

LAB_1F48
      INY                     ; index to array bound low byte
LAB_1F49
      LDA   Aspth             ; get array data pointer high byte
      ORA   Asptl             ; OR with array data pointer low byte
      BEQ   LAB_1F5A          ; branch if array data pointer = null (skip multiply)

      JSR   LAB_1F7C          ; does XY = (Astrtl),Y * (Asptl)
      TXA                     ; get result low byte
      ADC   FAC1_2            ; add index low byte from FAC1 mantissa2
      TAX                     ; save result low byte
      TYA                     ; get result high byte
      LDY   ut1_pl            ; restore index
LAB_1F5A
      ADC   FAC1_3            ; add index high byte from FAC1 mantissa3
      STX   Asptl             ; save array data pointer low byte
      DEC   Dimcnt            ; decrement dimensions count
      BNE   LAB_1F2C          ; loop if dimensions still to do

      ASL   Asptl             ; array data pointer low byte * 2
      ROL                     ; array data pointer high byte * 2
      ASL   Asptl             ; array data pointer low byte * 4
      ROL                     ; array data pointer high byte * 4
      TAY                     ; copy high byte
      LDA   Asptl             ; get low byte
      ADC   Adatal            ; add array data start pointer low byte
      STA   Cvaral            ; save as current var address low byte
      TYA                     ; get high byte back
      ADC   Adatah            ; add array data start pointer high byte
      STA   Cvarah            ; save as current var address high byte
      TAY                     ; copy high byte to Y
      LDA   Cvaral            ; get current var address low byte
LAB_1F7B
      RTS

; does XY = (Astrtl),Y * (Asptl)

LAB_1F7C
      STY   ut1_pl            ; save index
      LDA   (Astrtl),Y        ; get dimension size low byte
      STA   dims_l            ; save dimension size low byte
      DEY                     ; decrement index
      LDA   (Astrtl),Y        ; get dimension size high byte
      STA   dims_h            ; save dimension size high byte

      LDA   #$10              ; count = $10 (16 bit multiply)
      STA   numbit            ; save bit count
      LDX   #$00              ; clear result low byte
      LDY   #$00              ; clear result high byte
LAB_1F8F
      TXA                     ; get result low byte
      ASL                     ; *2
      TAX                     ; save result low byte
      TYA                     ; get result high byte
      ROL                     ; *2
      TAY                     ; save result high byte
      BCS   LAB_1F45          ; if overflow go do "Out of memory" error

      ASL   Asptl             ; shift multiplier low byte
      ROL   Aspth             ; shift multiplier high byte
      BCC   LAB_1FA8          ; skip add if no carry

      CLC                     ; else clear carry for add
      TXA                     ; get result low byte
      ADC   dims_l            ; add dimension size low byte
      TAX                     ; save result low byte
      TYA                     ; get result high byte
      ADC   dims_h            ; add dimension size high byte
      TAY                     ; save result high byte
      BCS   LAB_1F45          ; if overflow go do "Out of memory" error

LAB_1FA8
      DEC   numbit            ; decrement bit count
      BNE   LAB_1F8F          ; loop until all done

      RTS

; perform FRE()

LAB_FRE
      LDA   Dtypef            ; get data type flag, $FF=string, $00=numeric
      BPL   LAB_1FB4          ; branch if numeric

      JSR   LAB_22B6          ; pop string off descriptor stack, or from top of string
                              ; space returns with A = length, X=$71=pointer low byte,
                              ; Y=$72=pointer high byte

                              ; FRE(n) was numeric so do this
LAB_1FB4
      JSR   LAB_GARB          ; go do garbage collection
      SEC                     ; set carry for subtract
      LDA   Sstorl            ; get bottom of string space low byte
      SBC   Earryl            ; subtract array mem end low byte
      TAY                     ; copy result to Y
      LDA   Sstorh            ; get bottom of string space high byte
      SBC   Earryh            ; subtract array mem end high byte

; save and convert integer AY to FAC1

LAB_AYFC
      LSR   Dtypef            ; clear data type flag, $FF=string, $00=numeric
      STA   FAC1_1            ; save FAC1 mantissa1
      STY   FAC1_2            ; save FAC1 mantissa2
      LDX   #$90              ; set exponent=2^16 (integer)
      JMP   LAB_27E3          ; set exp=X, clear FAC1_3, normalise and return

; perform POS()

LAB_POS
      LDY   TPos              ; get terminal position

; convert Y to byte in FAC1

LAB_1FD0
      LDA   #$00              ; clear high byte
      BEQ   LAB_AYFC          ; always save and convert integer AY to FAC1 and return

; check not Direct (used by DEF and INPUT)

LAB_CKRN
      LDX   Clineh            ; get current line high byte
      INX                     ; increment it
      BNE   LAB_1F7B          ; return if can continue not direct mode

                              ; else do illegal direct error
LAB_1FD9
      LDX   #$16              ; error code $16 ("Illegal direct" error)
LAB_1FDB
      JMP   LAB_XERR          ; go do error #X, then warm start

; perform DEF

LAB_DEF
      JSR   LAB_200B          ; check FNx syntax
      STA   func_l            ; save function pointer low byte
      STY   func_h            ; save function pointer high byte
      JSR   LAB_CKRN          ; check not Direct (back here if ok)
      JSR   LAB_1BFE          ; scan for "(" , else do syntax error then warm start
      LDA   #$80              ; set flag for FNx
      STA   Sufnxf            ; save subscript/FNx flag
      JSR   LAB_GVAR          ; get (var) address
      JSR   LAB_CTNM          ; check if source is numeric, else do type mismatch
      JSR   LAB_1BFB          ; scan for ")" , else do syntax error then warm start
      LDA   #TK_EQUAL         ; get = token
      JSR   LAB_SCCA          ; scan for CHR$(A), else do syntax error then warm start
      LDA   Cvarah            ; get current var address high byte
      PHA                     ; push it
      LDA   Cvaral            ; get current var address low byte
      PHA                     ; push it
      LDA   Bpntrh            ; get BASIC execute pointer high byte
      PHA                     ; push it
      LDA   Bpntrl            ; get BASIC execute pointer low byte
      PHA                     ; push it
      JSR   LAB_DATA          ; go perform DATA
      JMP   LAB_207A          ; put execute pointer and variable pointer into function
                              ; and return

; check FNx syntax

LAB_200B
      LDA   #TK_FN            ; get FN" token
      JSR   LAB_SCCA          ; scan for CHR$(A) , else do syntax error then warm start
                              ; return character after A
      ORA   #$80              ; set FN flag bit
      STA   Sufnxf            ; save FN flag so array variable test fails
      JSR   LAB_1D12          ; search for FN variable
      JMP   LAB_CTNM          ; check if source is numeric and return, else do type
                              ; mismatch

                              ; Evaluate FNx
LAB_201E
      JSR   LAB_200B          ; check FNx syntax
      PHA                     ; push function pointer low byte
      TYA                     ; copy function pointer high byte
      PHA                     ; push function pointer high byte
      JSR   LAB_1BFE          ; scan for "(", else do syntax error then warm start
      JSR   LAB_EVEX          ; evaluate expression
      JSR   LAB_1BFB          ; scan for ")", else do syntax error then warm start
      JSR   LAB_CTNM          ; check if source is numeric, else do type mismatch
      PLA                     ; pop function pointer high byte
      STA   func_h            ; restore it
      PLA                     ; pop function pointer low byte
      STA   func_l            ; restore it
      LDX   #$20              ; error code $20 ("Undefined function" error)
      LDY   #$03              ; index to variable pointer high byte
      LDA   (func_l),Y        ; get variable pointer high byte
      BEQ   LAB_1FDB          ; if zero go do undefined function error

      STA   Cvarah            ; save variable address high byte
      DEY                     ; index to variable address low byte
      LDA   (func_l),Y        ; get variable address low byte
      STA   Cvaral            ; save variable address low byte
      TAX                     ; copy address low byte

                              ; now stack the function variable value before use
      INY                     ; index to mantissa_3
LAB_2043
      LDA   (Cvaral),Y        ; get byte from variable
      PHA                     ; stack it
      DEY                     ; decrement index
      BPL   LAB_2043          ; loop until variable stacked

      LDY   Cvarah            ; get variable address high byte
      JSR   LAB_2778          ; pack FAC1 (function expression value) into (XY)
                              ; (function variable), return Y=0, always
      LDA   Bpntrh            ; get BASIC execute pointer high byte
      PHA                     ; push it
      LDA   Bpntrl            ; get BASIC execute pointer low byte
      PHA                     ; push it
      LDA   (func_l),Y        ; get function execute pointer low byte
      STA   Bpntrl            ; save as BASIC execute pointer low byte
      INY                     ; index to high byte
      LDA   (func_l),Y        ; get function execute pointer high byte
      STA   Bpntrh            ; save as BASIC execute pointer high byte
      LDA   Cvarah            ; get variable address high byte
      PHA                     ; push it
      LDA   Cvaral            ; get variable address low byte
      PHA                     ; push it
      JSR   LAB_EVNM          ; evaluate expression and check is numeric,
                              ; else do type mismatch
      PLA                     ; pull variable address low byte
      STA   func_l            ; save variable address low byte
      PLA                     ; pull variable address high byte
      STA   func_h            ; save variable address high byte
      JSR   LAB_GBYT          ; scan memory
      BEQ   LAB_2074          ; branch if null (should be [EOL] marker)

      JMP   LAB_SNER          ; else syntax error then warm start

; restore Bpntrl,Bpntrh and function variable from stack

LAB_2074
      PLA                     ; pull BASIC execute pointer low byte
      STA   Bpntrl            ; restore BASIC execute pointer low byte
      PLA                     ; pull BASIC execute pointer high byte
      STA   Bpntrh            ; restore BASIC execute pointer high byte

; put execute pointer and variable pointer into function

LAB_207A
      LDY   #$00              ; clear index
      PLA                     ; pull BASIC execute pointer low byte
      STA   (func_l),Y        ; save to function
      INY                     ; increment index
      PLA                     ; pull BASIC execute pointer high byte
      STA   (func_l),Y        ; save to function
      INY                     ; increment index
      PLA                     ; pull current var address low byte
      STA   (func_l),Y        ; save to function
      INY                     ; increment index
      PLA                     ; pull current var address high byte
      STA   (func_l),Y        ; save to function
      RTS

; perform STR$()

LAB_STRS
      JSR   LAB_CTNM          ; check if source is numeric, else do type mismatch
      JSR   LAB_296E          ; convert FAC1 to string
      LDA   #<Decssp1         ; set result string low pointer
      LDY   #>Decssp1         ; set result string high pointer
      BEQ   LAB_20AE          ; print null terminated string to Sutill/Sutilh

; Do string vector
; copy des_pl/h to des_2l/h and make string space A bytes long

LAB_209C
      LDX   des_pl            ; get descriptor pointer low byte
      LDY   des_ph            ; get descriptor pointer high byte
      STX   des_2l            ; save descriptor pointer low byte
      STY   des_2h            ; save descriptor pointer high byte

; make string space A bytes long
; A=length, X=Sutill=ptr low byte, Y=Sutilh=ptr high byte

LAB_MSSP
      JSR   LAB_2115          ; make space in string memory for string A long
                              ; return X=Sutill=ptr low byte, Y=Sutilh=ptr high byte
      STX   str_pl            ; save string pointer low byte
      STY   str_ph            ; save string pointer high byte
      STA   str_ln            ; save length
      RTS

; Scan, set up string
; print " terminated string to Sutill/Sutilh

LAB_20AE
      LDX   #$22              ; set terminator to "
      STX   Srchc             ; set search character (terminator 1)
      STX   Asrch             ; set terminator 2

; print [Srchc] or [Asrch] terminated string to Sutill/Sutilh
; source is AY

LAB_20B4
      STA   ssptr_l           ; store string start low byte
      STY   ssptr_h           ; store string start high byte
      STA   str_pl            ; save string pointer low byte
      STY   str_ph            ; save string pointer high byte
      LDY   #$FF              ; set length to -1
LAB_20BE
      INY                     ; increment length
      LDA   (ssptr_l),Y       ; get byte from string
      BEQ   LAB_20CF          ; exit loop if null byte [EOS]

      CMP   Srchc             ; compare with search character (terminator 1)
      BEQ   LAB_20CB          ; branch if terminator

      CMP   Asrch             ; compare with terminator 2
      BNE   LAB_20BE          ; loop if not terminator 2

LAB_20CB
      CMP   #$22              ; compare with "
      BEQ   LAB_20D0          ; branch if " (carry set if = !)

LAB_20CF
      CLC                     ; clear carry for add (only if [EOL] terminated string)
LAB_20D0
      STY   str_ln            ; save length in FAC1 exponent
      TYA                     ; copy length to A
      ADC   ssptr_l           ; add string start low byte
      STA   Sendl             ; save string end low byte
      LDX   ssptr_h           ; get string start high byte
      BCC   LAB_20DC          ; branch if no low byte overflow

      INX                     ; else increment high byte
LAB_20DC
      STX   Sendh             ; save string end high byte
      LDA   ssptr_h           ; get string start high byte
; *** begin RAM above code / Ibuff above EhBASIC patch V2 ***
; *** replace
;      CMP   #>Ram_base        ; compare with start of program memory
;      BCS   LAB_RTST          ; branch if not in utility area
; *** with
      BEQ   LAB_MVST          ; fix STR$() using page zero via LAB_296E
      CMP   #>Ibuffs          ; compare with location of input buffer page
      BNE   LAB_RTST          ; branch if not in utility area
LAB_MVST      
; *** end   RAM above code / Ibuff above EhBASIC patch V2 ***

                              ; string in utility area, move to string memory
      TYA                     ; copy length to A
      JSR   LAB_209C          ; copy des_pl/h to des_2l/h and make string space A bytes
                              ; long
      LDX   ssptr_l           ; get string start low byte
      LDY   ssptr_h           ; get string start high byte
      JSR   LAB_2298          ; store string A bytes long from XY to (Sutill)

; check for space on descriptor stack then ..
; put string address and length on descriptor stack and update stack pointers

LAB_RTST
      LDX   next_s            ; get string stack pointer
      CPX   #des_sk+$09       ; compare with max+1
      BNE   LAB_20F8          ; branch if space on string stack

                              ; else do string too complex error
      LDX   #$1C              ; error code $1C ("String too complex" error)
LAB_20F5
      JMP   LAB_XERR          ; do error #X, then warm start

; put string address and length on descriptor stack and update stack pointers

LAB_20F8
      LDA   str_ln            ; get string length
      STA   PLUS_0,X          ; put on string stack
      LDA   str_pl            ; get string pointer low byte
      STA   PLUS_1,X          ; put on string stack
      LDA   str_ph            ; get string pointer high byte
      STA   PLUS_2,X          ; put on string stack
      LDY   #$00              ; clear Y
      STX   des_pl            ; save string descriptor pointer low byte
      STY   des_ph            ; save string descriptor pointer high byte (always $00)
      DEY                     ; Y = $FF
      STY   Dtypef            ; save data type flag, $FF=string
      STX   last_sl           ; save old stack pointer (current top item)
      INX                     ; update stack pointer
      INX                     ; update stack pointer
      INX                     ; update stack pointer
      STX   next_s            ; save new top item value
      RTS

; Build descriptor
; make space in string memory for string A long
; return X=Sutill=ptr low byte, Y=Sutill=ptr high byte

LAB_2115
      LSR   Gclctd            ; clear garbage collected flag (b7)

                              ; make space for string A long
LAB_2117
      PHA                     ; save string length
      EOR   #$FF              ; complement it
      SEC                     ; set carry for subtract (twos comp add)
      ADC   Sstorl            ; add bottom of string space low byte (subtract length)
      LDY   Sstorh            ; get bottom of string space high byte
      BCS   LAB_2122          ; skip decrement if no underflow

      DEY                     ; decrement bottom of string space high byte
LAB_2122
      CPY   Earryh            ; compare with array mem end high byte
      BCC   LAB_2137          ; do out of memory error if less

      BNE   LAB_212C          ; if not = skip next test

      CMP   Earryl            ; compare with array mem end low byte
      BCC   LAB_2137          ; do out of memory error if less

LAB_212C
      STA   Sstorl            ; save bottom of string space low byte
      STY   Sstorh            ; save bottom of string space high byte
      STA   Sutill            ; save string utility ptr low byte
      STY   Sutilh            ; save string utility ptr high byte
      TAX                     ; copy low byte to X
      PLA                     ; get string length back
      RTS

LAB_2137
      LDX   #$0C              ; error code $0C ("Out of memory" error)
      LDA   Gclctd            ; get garbage collected flag
      BMI   LAB_20F5          ; if set then do error code X

      JSR   LAB_GARB          ; else go do garbage collection
      LDA   #$80              ; flag for garbage collected
      STA   Gclctd            ; set garbage collected flag
      PLA                     ; pull length
      BNE   LAB_2117          ; go try again (loop always, length should never be = $00)

; garbage collection routine

LAB_GARB
      LDX   Ememl             ; get end of mem low byte
      LDA   Ememh             ; get end of mem high byte

; re-run routine from last ending

LAB_214B
      STX   Sstorl            ; set string storage low byte
      STA   Sstorh            ; set string storage high byte
      LDY   #$00              ; clear index
      STY   garb_h            ; clear working pointer high byte (flag no strings to move)
; *** begin patch  2.22p5.5  garbage collection may overlap temporary strings
; *** add
      STY   garb_l            ; clear working pointer low byte (flag no strings to move)
; *** begin patch  2.22p5.5  garbage collection may overlap temporary strings
      LDA   Earryl            ; get array mem end low byte
      LDX   Earryh            ; get array mem end high byte
      STA   Histrl            ; save as highest string low byte
      STX   Histrh            ; save as highest string high byte
      LDA   #des_sk           ; set descriptor stack pointer
      STA   ut1_pl            ; save descriptor stack pointer low byte
      STY   ut1_ph            ; save descriptor stack pointer high byte ($00)
LAB_2161
      CMP   next_s            ; compare with descriptor stack pointer
      BEQ   LAB_216A          ; branch if =

      JSR   LAB_21D7          ; go garbage collect descriptor stack
      BEQ   LAB_2161          ; loop always

                              ; done stacked strings, now do string vars
LAB_216A
      ASL   g_step            ; set step size = $06
      LDA   Svarl             ; get start of vars low byte
      LDX   Svarh             ; get start of vars high byte
      STA   ut1_pl            ; save as pointer low byte
      STX   ut1_ph            ; save as pointer high byte
LAB_2176
      CPX   Sarryh            ; compare start of arrays high byte
      BNE   LAB_217E          ; branch if no high byte match

      CMP   Sarryl            ; else compare start of arrays low byte
      BEQ   LAB_2183          ; branch if = var mem end

LAB_217E
      JSR   LAB_21D1          ; go garbage collect strings
      BEQ   LAB_2176          ; loop always

                              ; done string vars, now do string arrays
LAB_2183
      STA   Nbendl            ; save start of arrays low byte as working pointer
      STX   Nbendh            ; save start of arrays high byte as working pointer
      LDA   #$04              ; set step size
      STA   g_step            ; save step size
LAB_218B
      LDA   Nbendl            ; get pointer low byte
      LDX   Nbendh            ; get pointer high byte
LAB_218F
      CPX   Earryh            ; compare with array mem end high byte
      BNE   LAB_219A          ; branch if not at end

      CMP   Earryl            ; else compare with array mem end low byte
      BEQ   LAB_2216          ; tidy up and exit if at end

LAB_219A
      STA   ut1_pl            ; save pointer low byte
      STX   ut1_ph            ; save pointer high byte
      LDY   #$02              ; set index
      LDA   (ut1_pl),Y        ; get array size low byte
      ADC   Nbendl            ; add start of this array low byte
      STA   Nbendl            ; save start of next array low byte
      INY                     ; increment index
      LDA   (ut1_pl),Y        ; get array size high byte
      ADC   Nbendh            ; add start of this array high byte
      STA   Nbendh            ; save start of next array high byte
      LDY   #$01              ; set index
      LDA   (ut1_pl),Y        ; get name second byte
      BPL   LAB_218B          ; skip if not string array

; was string array so ..

      LDY   #$04              ; set index
      LDA   (ut1_pl),Y        ; get # of dimensions
      ASL                     ; *2
      ADC   #$05              ; +5 (array header size)
      JSR   LAB_2208          ; go set up for first element
LAB_21C4
      CPX   Nbendh            ; compare with start of next array high byte
      BNE   LAB_21CC          ; branch if <> (go do this array)

      CMP   Nbendl            ; else compare element pointer low byte with next array
                              ; low byte
      BEQ   LAB_218F          ; if equal then go do next array

LAB_21CC
      JSR   LAB_21D7          ; go defrag array strings
      BEQ   LAB_21C4          ; go do next array string (loop always)

; defrag string variables
; enter with XA = variable pointer
; return with XA = next variable pointer

LAB_21D1
      INY                     ; increment index (Y was $00)
      LDA   (ut1_pl),Y        ; get var name byte 2
      BPL   LAB_2206          ; if not string, step pointer to next var and return

      INY                     ; else increment index
LAB_21D7
      LDA   (ut1_pl),Y        ; get string length
      BEQ   LAB_2206          ; if null, step pointer to next string and return

      INY                     ; else increment index
      LDA   (ut1_pl),Y        ; get string pointer low byte
      TAX                     ; copy to X
      INY                     ; increment index
      LDA   (ut1_pl),Y        ; get string pointer high byte
      CMP   Sstorh            ; compare bottom of string space high byte
      BCC   LAB_21EC          ; branch if less

      BNE   LAB_2206          ; if greater, step pointer to next string and return

                              ; high bytes were = so compare low bytes
      CPX   Sstorl            ; compare bottom of string space low byte
      BCS   LAB_2206          ; if >=, step pointer to next string and return

                              ; string pointer is < string storage pointer (pos in mem)
LAB_21EC
      CMP   Histrh            ; compare to highest string high byte
      BCC   LAB_2207          ; if <, step pointer to next string and return

      BNE   LAB_21F6          ; if > update pointers, step to next and return

                              ; high bytes were = so compare low bytes
      CPX   Histrl            ; compare to highest string low byte
      BCC   LAB_2207          ; if <, step pointer to next string and return

                              ; string is in string memory space
LAB_21F6
      STX   Histrl            ; save as new highest string low byte
      STA   Histrh            ; save as new highest string high byte
      LDA   ut1_pl            ; get start of vars(descriptors) low byte
      LDX   ut1_ph            ; get start of vars(descriptors) high byte
      STA   garb_l            ; save as working pointer low byte
      STX   garb_h            ; save as working pointer high byte
      DEY                     ; decrement index DIFFERS
      DEY                     ; decrement index (should point to descriptor start)
      STY   g_indx            ; save index pointer

                              ; step pointer to next string
LAB_2206
      CLC                     ; clear carry for add
LAB_2207
      LDA   g_step            ; get step size
LAB_2208
      ADC   ut1_pl            ; add pointer low byte
      STA   ut1_pl            ; save pointer low byte
      BCC   LAB_2211          ; branch if no overflow

      INC   ut1_ph            ; else increment high byte
LAB_2211
      LDX   ut1_ph            ; get pointer high byte
      LDY   #$00              ; clear Y
      RTS

; search complete, now either exit or set-up and move string

LAB_2216
      DEC   g_step            ; decrement step size (now $03 for descriptor stack)
; *** begin patch  2.22p5.5  garbage collection may overlap temporary strings
; *** replace
;      LDX   garb_h            ; get string to move high byte
; *** with
      LDA   garb_h            ; any string to move?
      ORA   garb_l
; *** end   patch  2.22p5.5  garbage collection may overlap temporary strings
      BEQ   LAB_2211          ; exit if nothing to move

      LDY   g_indx            ; get index byte back (points to descriptor)
      CLC                     ; clear carry for add
      LDA   (garb_l),Y        ; get string length
      ADC   Histrl            ; add highest string low byte
      STA   Obendl            ; save old block end low pointer
      LDA   Histrh            ; get highest string high byte
      ADC   #$00              ; add any carry
      STA   Obendh            ; save old block end high byte
      LDA   Sstorl            ; get bottom of string space low byte
      LDX   Sstorh            ; get bottom of string space high byte
      STA   Nbendl            ; save new block end low byte
      STX   Nbendh            ; save new block end high byte
      JSR   LAB_11D6          ; open up space in memory, don't set array end
      LDY   g_indx            ; get index byte
      INY                     ; point to descriptor low byte
      LDA   Nbendl            ; get string pointer low byte
      STA   (garb_l),Y        ; save new string pointer low byte
      TAX                     ; copy string pointer low byte
      INC   Nbendh            ; correct high byte (move sets high byte -1)
      LDA   Nbendh            ; get new string pointer high byte
      INY                     ; point to descriptor high byte
      STA   (garb_l),Y        ; save new string pointer high byte
      JMP   LAB_214B          ; re-run routine from last ending
                              ; (but don't collect this string)

; concatenate
; add strings, string 1 is in descriptor des_pl, string 2 is in line

LAB_224D
      LDA   des_ph            ; get descriptor pointer high byte
      PHA                     ; put on stack
      LDA   des_pl            ; get descriptor pointer low byte
      PHA                     ; put on stack
; *** begin patch  2.22p5.4  concatenate MINUS or NOT() crashes EhBASIC  ***
; *** add extra label to verify originating function
LAB_224Da
; *** end patch    2.22p5.4  concatenate MINUS or NOT() crashes EhBASIC  ***
      JSR   LAB_GVAL          ; get value from line
      JSR   LAB_CTST          ; check if source is string, else do type mismatch
      PLA                     ; get descriptor pointer low byte back
      STA   ssptr_l           ; set pointer low byte
      PLA                     ; get descriptor pointer high byte back
      STA   ssptr_h           ; set pointer high byte
      LDY   #$00              ; clear index
      LDA   (ssptr_l),Y       ; get length_1 from descriptor
      CLC                     ; clear carry for add
      ADC   (des_pl),Y        ; add length_2
      BCC   LAB_226D          ; branch if no overflow

      LDX   #$1A              ; else set error code $1A ("String too long" error)
      JMP   LAB_XERR          ; do error #X, then warm start

LAB_226D
      JSR   LAB_209C          ; copy des_pl/h to des_2l/h and make string space A bytes
                              ; long
      JSR   LAB_228A          ; copy string from descriptor (sdescr) to (Sutill)
      LDA   des_2l            ; get descriptor pointer low byte
      LDY   des_2h            ; get descriptor pointer high byte
      JSR   LAB_22BA          ; pop (YA) descriptor off stack or from top of string space
                              ; returns with A = length, ut1_pl = pointer low byte,
                              ; ut1_ph = pointer high byte
      JSR   LAB_229C          ; store string A bytes long from (ut1_pl) to (Sutill)
      LDA   ssptr_l           ;.set descriptor pointer low byte
      LDY   ssptr_h           ;.set descriptor pointer high byte
      JSR   LAB_22BA          ; pop (YA) descriptor off stack or from top of string space
                              ; returns with A = length, X=ut1_pl=pointer low byte,
                              ; Y=ut1_ph=pointer high byte
      JSR   LAB_RTST          ; check for space on descriptor stack then put string
                              ; address and length on descriptor stack and update stack
                              ; pointers
      JMP   LAB_1ADB          ;.continue evaluation

; copy string from descriptor (sdescr) to (Sutill)

LAB_228A
      LDY   #$00              ; clear index
      LDA   (sdescr),Y        ; get string length
      PHA                     ; save on stack
      INY                     ; increment index
      LDA   (sdescr),Y        ; get source string pointer low byte
      TAX                     ; copy to X
      INY                     ; increment index
      LDA   (sdescr),Y        ; get source string pointer high byte
      TAY                     ; copy to Y
      PLA                     ; get length back

; store string A bytes long from YX to (Sutill)

LAB_2298
      STX   ut1_pl            ; save source string pointer low byte
      STY   ut1_ph            ; save source string pointer high byte

; store string A bytes long from (ut1_pl) to (Sutill)

LAB_229C
      TAX                     ; copy length to index (don't count with Y)
      BEQ   LAB_22B2          ; branch if = $0 (null string) no need to add zero length

      LDY   #$00              ; zero pointer (copy forward)
LAB_22A0
      LDA   (ut1_pl),Y        ; get source byte
      STA   (Sutill),Y        ; save destination byte

      INY                     ; increment index
      DEX                     ; decrement counter
      BNE   LAB_22A0          ; loop while <> 0

      TYA                     ; restore length from Y
LAB_22A9
      CLC                     ; clear carry for add
      ADC   Sutill            ; add string utility ptr low byte
      STA   Sutill            ; save string utility ptr low byte
      BCC   LAB_22B2          ; branch if no carry

      INC   Sutilh            ; else increment string utility ptr high byte
LAB_22B2
      RTS

; evaluate string

LAB_EVST
      JSR   LAB_CTST          ; check if source is string, else do type mismatch

; pop string off descriptor stack, or from top of string space
; returns with A = length, X=pointer low byte, Y=pointer high byte

LAB_22B6
      LDA   des_pl            ; get descriptor pointer low byte
      LDY   des_ph            ; get descriptor pointer high byte

; pop (YA) descriptor off stack or from top of string space
; returns with A = length, X=ut1_pl=pointer low byte, Y=ut1_ph=pointer high byte

LAB_22BA
      STA   ut1_pl            ; save descriptor pointer low byte
      STY   ut1_ph            ; save descriptor pointer high byte
      JSR   LAB_22EB          ; clean descriptor stack, YA = pointer
      PHP                     ; save status flags
      LDY   #$00              ; clear index
      LDA   (ut1_pl),Y        ; get length from string descriptor
      PHA                     ; put on stack
      INY                     ; increment index
      LDA   (ut1_pl),Y        ; get string pointer low byte from descriptor
      TAX                     ; copy to X
      INY                     ; increment index
      LDA   (ut1_pl),Y        ; get string pointer high byte from descriptor
      TAY                     ; copy to Y
      PLA                     ; get string length back
      PLP                     ; restore status
      BNE   LAB_22E6          ; branch if pointer <> last_sl,last_sh

      CPY   Sstorh            ; compare bottom of string space high byte
      BNE   LAB_22E6          ; branch if <>

      CPX   Sstorl            ; else compare bottom of string space low byte
      BNE   LAB_22E6          ; branch if <>

      PHA                     ; save string length
      CLC                     ; clear carry for add
      ADC   Sstorl            ; add bottom of string space low byte
      STA   Sstorl            ; save bottom of string space low byte
      BCC   LAB_22E5          ; skip increment if no overflow

      INC   Sstorh            ; increment bottom of string space high byte
LAB_22E5
      PLA                     ; restore string length
LAB_22E6
      STX   ut1_pl            ; save string pointer low byte
      STY   ut1_ph            ; save string pointer high byte
      RTS

; clean descriptor stack, YA = pointer
; checks if AY is on the descriptor stack, if so does a stack discard

LAB_22EB
      CPY   last_sh           ; compare pointer high byte
      BNE   LAB_22FB          ; exit if <>

      CMP   last_sl           ; compare pointer low byte
      BNE   LAB_22FB          ; exit if <>

      STA   next_s            ; save descriptor stack pointer
      SBC   #$03              ; -3
      STA   last_sl           ; save low byte -3
      LDY   #$00              ; clear high byte
LAB_22FB
      RTS

; perform CHR$()

LAB_CHRS
      JSR   LAB_EVBY          ; evaluate byte expression, result in X
      TXA                     ; copy to A
      PHA                     ; save character
      LDA   #$01              ; string is single byte
      JSR   LAB_MSSP          ; make string space A bytes long A=$AC=length,
                              ; X=$AD=Sutill=ptr low byte, Y=$AE=Sutilh=ptr high byte
      PLA                     ; get character back
      LDY   #$00              ; clear index
      STA   (str_pl),Y        ; save byte in string (byte IS string!)
      JMP   LAB_RTST          ; check for space on descriptor stack then put string
                              ; address and length on descriptor stack and update stack
                              ; pointers

; perform LEFT$()

LAB_LEFT
      PHA                     ; push byte parameter
      JSR   LAB_236F          ; pull string data and byte parameter from stack
                              ; return pointer in des_2l/h, byte in A (and X), Y=0
      CMP   (des_2l),Y        ; compare byte parameter with string length
      TYA                     ; clear A
      BEQ   LAB_2316          ; go do string copy (branch always)

; perform RIGHT$()

LAB_RIGHT
      PHA                     ; push byte parameter
      JSR   LAB_236F          ; pull string data and byte parameter from stack
                              ; return pointer in des_2l/h, byte in A (and X), Y=0
      CLC                     ; clear carry for add-1
      SBC   (des_2l),Y        ; subtract string length
      EOR   #$FF              ; invert it (A=LEN(expression$)-l)

LAB_2316
      BCC   LAB_231C          ; branch if string length > byte parameter

      LDA   (des_2l),Y        ; else make parameter = length
      TAX                     ; copy to byte parameter copy
      TYA                     ; clear string start offset
LAB_231C
      PHA                     ; save string start offset
LAB_231D
      TXA                     ; copy byte parameter (or string length if <)
LAB_231E
      PHA                     ; save string length
      JSR   LAB_MSSP          ; make string space A bytes long A=$AC=length,
                              ; X=$AD=Sutill=ptr low byte, Y=$AE=Sutilh=ptr high byte
      LDA   des_2l            ; get descriptor pointer low byte
      LDY   des_2h            ; get descriptor pointer high byte
      JSR   LAB_22BA          ; pop (YA) descriptor off stack or from top of string space
                              ; returns with A = length, X=ut1_pl=pointer low byte,
                              ; Y=ut1_ph=pointer high byte
      PLA                     ; get string length back
      TAY                     ; copy length to Y
      PLA                     ; get string start offset back
      CLC                     ; clear carry for add
      ADC   ut1_pl            ; add start offset to string start pointer low byte
      STA   ut1_pl            ; save string start pointer low byte
      BCC   LAB_2335          ; branch if no overflow

      INC   ut1_ph            ; else increment string start pointer high byte
LAB_2335
      TYA                     ; copy length to A
      JSR   LAB_229C          ; store string A bytes long from (ut1_pl) to (Sutill)
      JMP   LAB_RTST          ; check for space on descriptor stack then put string
                              ; address and length on descriptor stack and update stack
                              ; pointers

; perform MID$()

LAB_MIDS
      PHA                     ; push byte parameter
      LDA   #$FF              ; set default length = 255
      STA   mids_l            ; save default length
      JSR   LAB_GBYT          ; scan memory
      CMP   #')'              ; compare with ")"
      BEQ   LAB_2358          ; branch if = ")" (skip second byte get)

      JSR   LAB_1C01          ; scan for "," , else do syntax error then warm start
      JSR   LAB_GTBY          ; get byte parameter (use copy in mids_l)
LAB_2358
      JSR   LAB_236F          ; pull string data and byte parameter from stack
                              ; return pointer in des_2l/h, byte in A (and X), Y=0
      DEX                     ; decrement start index
      TXA                     ; copy to A
      PHA                     ; save string start offset
      CLC                     ; clear carry for sub-1
      LDX   #$00              ; clear output string length
      SBC   (des_2l),Y        ; subtract string length
      BCS   LAB_231D          ; if start>string length go do null string

      EOR   #$FF              ; complement -length
      CMP   mids_l            ; compare byte parameter
      BCC   LAB_231E          ; if length>remaining string go do RIGHT$

      LDA   mids_l            ; get length byte
      BCS   LAB_231E          ; go do string copy (branch always)

; pull string data and byte parameter from stack
; return pointer in des_2l/h, byte in A (and X), Y=0

LAB_236F
      JSR   LAB_1BFB          ; scan for ")" , else do syntax error then warm start
      PLA                     ; pull return address low byte (return address)
      STA   Fnxjpl            ; save functions jump vector low byte
      PLA                     ; pull return address high byte (return address)
      STA   Fnxjph            ; save functions jump vector high byte
      PLA                     ; pull byte parameter
      TAX                     ; copy byte parameter to X
      PLA                     ; pull string pointer low byte
      STA   des_2l            ; save it
      PLA                     ; pull string pointer high byte
      STA   des_2h            ; save it
      LDY   #$00              ; clear index
      TXA                     ; copy byte parameter
      BEQ   LAB_23A8          ; if null do function call error then warm start

      INC   Fnxjpl            ; increment function jump vector low byte
                              ; (JSR pushes return addr-1. this is all very nice
                              ; but will go tits up if either call is on a page
                              ; boundary!)
      JMP   (Fnxjpl)          ; in effect, RTS

; perform LCASE$()

LAB_LCASE
      JSR   LAB_EVST          ; evaluate string
      STA   str_ln            ; set string length
      TAY                     ; copy length to Y
      BEQ   NoString          ; branch if null string

      JSR   LAB_MSSP          ; make string space A bytes long A=length,
                              ; X=Sutill=ptr low byte, Y=Sutilh=ptr high byte
      STX   str_pl            ; save string pointer low byte
      STY   str_ph            ; save string pointer high byte
      TAY                     ; get string length back

LC_loop
      DEY                     ; decrement index
      LDA   (ut1_pl),Y        ; get byte from string
      JSR   LAB_1D82          ; is character "A" to "Z"
      BCC   NoUcase           ; branch if not upper case alpha

      ORA   #$20              ; convert upper to lower case
NoUcase
      STA   (Sutill),Y        ; save byte back to string
      TYA                     ; test index
      BNE   LC_loop           ; loop if not all done

      BEQ   NoString          ; tidy up and exit, branch always

; perform UCASE$()

LAB_UCASE
      JSR   LAB_EVST          ; evaluate string
      STA   str_ln            ; set string length
      TAY                     ; copy length to Y
      BEQ   NoString          ; branch if null string

      JSR   LAB_MSSP          ; make string space A bytes long A=length,
                              ; X=Sutill=ptr low byte, Y=Sutilh=ptr high byte
      STX   str_pl            ; save string pointer low byte
      STY   str_ph            ; save string pointer high byte
      TAY                     ; get string length back

UC_loop
      DEY                     ; decrement index
      LDA   (ut1_pl),Y        ; get byte from string
      JSR   LAB_CASC          ; is character "a" to "z" (or "A" to "Z")
      BCC   NoLcase           ; branch if not alpha

      AND   #$DF              ; convert lower to upper case
NoLcase
      STA   (Sutill),Y        ; save byte back to string
      TYA                     ; test index
      BNE   UC_loop           ; loop if not all done

NoString
      JMP   LAB_RTST          ; check for space on descriptor stack then put string
                              ; address and length on descriptor stack and update stack
                              ; pointers

; perform SADD()

LAB_SADD
      JSR   LAB_IGBY          ; increment and scan memory
      JSR   LAB_GVAR          ; get var address

      JSR   LAB_1BFB          ; scan for ")", else do syntax error then warm start
      JSR   LAB_CTST          ; check if source is string, else do type mismatch

      LDY   #$02              ; index to string pointer high byte
      LDA   (Cvaral),Y        ; get string pointer high byte
      TAX                     ; copy string pointer high byte to X
      DEY                     ; index to string pointer low byte
      LDA   (Cvaral),Y        ; get string pointer low byte
      TAY                     ; copy string pointer low byte to Y
      TXA                     ; copy string pointer high byte to A
      JMP   LAB_AYFC          ; save and convert integer AY to FAC1 and return

; perform LEN()

LAB_LENS
      JSR   LAB_ESGL          ; evaluate string, get length in A (and Y)
      JMP   LAB_1FD0          ; convert Y to byte in FAC1 and return

; evaluate string, get length in Y

LAB_ESGL
      JSR   LAB_EVST          ; evaluate string
      TAY                     ; copy length to Y
      RTS

; perform ASC()

LAB_ASC
      JSR   LAB_ESGL          ; evaluate string, get length in A (and Y)
      BEQ   LAB_23A8          ; if null do function call error then warm start

      LDY   #$00              ; set index to first character
      LDA   (ut1_pl),Y        ; get byte
      TAY                     ; copy to Y
      JMP   LAB_1FD0          ; convert Y to byte in FAC1 and return

; do function call error then warm start

LAB_23A8
      JMP   LAB_FCER          ; do function call error then warm start

; scan and get byte parameter

LAB_SGBY
      JSR   LAB_IGBY          ; increment and scan memory

; get byte parameter

LAB_GTBY
      JSR   LAB_EVNM          ; evaluate expression and check is numeric,
                              ; else do type mismatch

; evaluate byte expression, result in X

LAB_EVBY
      JSR   LAB_EVPI          ; evaluate integer expression (no check)

      LDY   FAC1_2            ; get FAC1 mantissa2
      BNE   LAB_23A8          ; if top byte <> 0 do function call error then warm start

      LDX   FAC1_3            ; get FAC1 mantissa3
      JMP   LAB_GBYT          ; scan memory and return

; perform VAL()

LAB_VAL
      JSR   LAB_ESGL          ; evaluate string, get length in A (and Y)
      BNE   LAB_23C5          ; branch if not null string

                              ; string was null so set result = $00
      JMP   LAB_24F1          ; clear FAC1 exponent and sign and return

LAB_23C5
; *** begin patch  2.22p5.7  VAL() may cause string variables to be trashed
; *** replace     
;      LDX   Bpntrl            ; get BASIC execute pointer low byte
;      LDY   Bpntrh            ; get BASIC execute pointer high byte
;      STX   Btmpl             ; save BASIC execute pointer low byte
;      STY   Btmph             ; save BASIC execute pointer high byte
;      LDX   ut1_pl            ; get string pointer low byte
;      STX   Bpntrl            ; save as BASIC execute pointer low byte
;      CLC                     ; clear carry
;      ADC   ut1_pl            ; add string length
;      STA   ut2_pl            ; save string end low byte
;      LDA   ut1_ph            ; get string pointer high byte
;      STA   Bpntrh            ; save as BASIC execute pointer high byte
;      ADC   #$00              ; add carry to high byte
;      STA   ut2_ph            ; save string end high byte
;      LDY   #$00              ; set index to $00
;      LDA   (ut2_pl),Y        ; get string end +1 byte
;      PHA                     ; push it
;      TYA                     ; clear A
;      STA   (ut2_pl),Y        ; terminate string with $00
;      JSR   LAB_GBYT          ; scan memory
;      JSR   LAB_2887          ; get FAC1 from string
;      PLA                     ; restore string end +1 byte
;      LDY   #$00              ; set index to zero
;      STA   (ut2_pl),Y        ; put string end byte back
; *** with
      PHA                     ; save length
      INY                     ; string length +1
      TYA
      JSR   LAB_MSSP          ; allocate temp string +1 bytes long
      PLA                     ; get length back
      JSR   LAB_229C          ; copy string (ut1_pl) -> (Sutill) for A bytes
      LDA   #0                ; add delimiter to end of string
      TAY
      STA   (Sutill),Y
      LDX   Bpntrl            ; save BASIC execute pointer low byte
      LDY   Bpntrh
      STX   Btmpl
      STY   Btmph
      LDX   str_pl            ; point to temporary string
      LDY   str_ph
      STX   Bpntrl
      STY   Bpntrh
      JSR   LAB_GBYT          ; scan memory
      JSR   LAB_2887          ; get FAC1 from string
; *** end patch    2.22p5.7  VAL() may cause string variables to be trashed

; restore BASIC execute pointer from temp (Btmpl/Btmph)

LAB_23F3
      LDX   Btmpl             ; get BASIC execute pointer low byte back
      LDY   Btmph             ; get BASIC execute pointer high byte back
      STX   Bpntrl            ; save BASIC execute pointer low byte
      STY   Bpntrh            ; save BASIC execute pointer high byte
      RTS

; get two parameters for POKE or WAIT

LAB_GADB
      JSR   LAB_EVNM          ; evaluate expression and check is numeric,
                              ; else do type mismatch
      JSR   LAB_F2FX          ; save integer part of FAC1 in temporary integer

; scan for "," and get byte, else do Syntax error then warm start

LAB_SCGB
      JSR   LAB_1C01          ; scan for "," , else do syntax error then warm start
      LDA   Itemph            ; save temporary integer high byte
      PHA                     ; on stack
      LDA   Itempl            ; save temporary integer low byte
      PHA                     ; on stack
      JSR   LAB_GTBY          ; get byte parameter
      PLA                     ; pull low byte
      STA   Itempl            ; restore temporary integer low byte
      PLA                     ; pull high byte
      STA   Itemph            ; restore temporary integer high byte
      RTS

; convert float to fixed routine. accepts any value that fits in 24 bits, +ve or
; -ve and converts it into a right truncated integer in Itempl and Itemph

; save unsigned 16 bit integer part of FAC1 in temporary integer

LAB_F2FX
      LDA   FAC1_e            ; get FAC1 exponent
      CMP   #$98              ; compare with exponent = 2^24
      BCS   LAB_23A8          ; if >= do function call error then warm start

LAB_F2FU
      JSR   LAB_2831          ; convert FAC1 floating-to-fixed
      LDA   FAC1_2            ; get FAC1 mantissa2
      LDY   FAC1_3            ; get FAC1 mantissa3
      STY   Itempl            ; save temporary integer low byte
      STA   Itemph            ; save temporary integer high byte
      RTS

; perform PEEK()

LAB_PEEK
      JSR   LAB_F2FX          ; save integer part of FAC1 in temporary integer
      LDX   #$00              ; clear index
      LDA   (Itempl,X)        ; get byte via temporary integer (addr)
      TAY                     ; copy byte to Y
      JMP   LAB_1FD0          ; convert Y to byte in FAC1 and return

; perform POKE

LAB_POKE
      JSR   LAB_GADB          ; get two parameters for POKE or WAIT
      TXA                     ; copy byte argument to A
      LDX   #$00              ; clear index
      STA   (Itempl,X)        ; save byte via temporary integer (addr)
      RTS

; perform DEEK()

LAB_DEEK
      JSR   LAB_F2FX          ; save integer part of FAC1 in temporary integer
      LDX   #$00              ; clear index
      LDA   (Itempl,X)        ; PEEK low byte
      TAY                     ; copy to Y
      INC   Itempl            ; increment pointer low byte
      BNE   Deekh             ; skip high increment if no rollover

      INC   Itemph            ; increment pointer high byte
Deekh
      LDA   (Itempl,X)        ; PEEK high byte
      JMP   LAB_AYFC          ; save and convert integer AY to FAC1 and return

; perform DOKE

LAB_DOKE
      JSR   LAB_EVNM          ; evaluate expression and check is numeric,
                              ; else do type mismatch
      JSR   LAB_F2FX          ; convert floating-to-fixed

      STY   Frnxtl            ; save pointer low byte (float to fixed returns word in AY)
      STA   Frnxth            ; save pointer high byte

      JSR   LAB_1C01          ; scan for "," , else do syntax error then warm start
      JSR   LAB_EVNM          ; evaluate expression and check is numeric,
                              ; else do type mismatch
      JSR   LAB_F2FX          ; convert floating-to-fixed

      TYA                     ; copy value low byte (float to fixed returns word in AY)
      LDX   #$00              ; clear index
      STA   (Frnxtl,X)        ; POKE low byte
      INC   Frnxtl            ; increment pointer low byte
      BNE   Dokeh             ; skip high increment if no rollover

      INC   Frnxth            ; increment pointer high byte
Dokeh
      LDA   Itemph            ; get value high byte
      STA   (Frnxtl,X)        ; POKE high byte
      JMP   LAB_GBYT          ; scan memory and return

; perform SWAP

LAB_SWAP
      JSR   LAB_GVAR          ; get var1 address
      STA   Lvarpl            ; save var1 address low byte
      STY   Lvarph            ; save var1 address high byte
      LDA   Dtypef            ; get data type flag, $FF=string, $00=numeric
      PHA                     ; save data type flag

      JSR   LAB_1C01          ; scan for "," , else do syntax error then warm start
      JSR   LAB_GVAR          ; get var2 address (pointer in Cvaral/h)
      PLA                     ; pull var1 data type flag
      EOR   Dtypef            ; compare with var2 data type
      BPL   SwapErr           ; exit if not both the same type

      LDY   #$03              ; four bytes to swap (either value or descriptor+1)
SwapLp
      LDA   (Lvarpl),Y        ; get byte from var1
      TAX                     ; save var1 byte
      LDA   (Cvaral),Y        ; get byte from var2
      STA   (Lvarpl),Y        ; save byte to var1
      TXA                     ; restore var1 byte
      STA   (Cvaral),Y        ; save byte to var2
      DEY                     ; decrement index
      BPL   SwapLp            ; loop until done

      RTS

SwapErr
      JMP   LAB_1ABC          ; do "Type mismatch" error then warm start

; perform CALL

LAB_CALL
      JSR   LAB_EVNM          ; evaluate expression and check is numeric,
                              ; else do type mismatch
      JSR   LAB_F2FX          ; convert floating-to-fixed
      LDA   #>CallExit        ; set return address high byte
      PHA                     ; put on stack
      LDA   #<CallExit-1      ; set return address low byte
      PHA                     ; put on stack
      JMP   (Itempl)          ; do indirect jump to user routine

; if the called routine exits correctly then it will return to here. this will then get
; the next byte for the interpreter and return

CallExit
      JMP   LAB_GBYT          ; scan memory and return

; perform WAIT

LAB_WAIT
      JSR   LAB_GADB          ; get two parameters for POKE or WAIT
      STX   Frnxtl            ; save byte
      LDX   #$00              ; clear mask
      JSR   LAB_GBYT          ; scan memory
      BEQ   LAB_2441          ; skip if no third argument

      JSR   LAB_SCGB          ; scan for "," and get byte, else SN error then warm start
LAB_2441
      STX   Frnxth            ; save EOR argument
LAB_2445
      LDA   (Itempl),Y        ; get byte via temporary integer (addr)
      EOR   Frnxth            ; EOR with second argument (mask)
      AND   Frnxtl            ; AND with first argument (byte)
      BEQ   LAB_2445          ; loop if result is zero

LAB_244D
      RTS

; perform subtraction, FAC1 from (AY)

LAB_2455
      JSR   LAB_264D          ; unpack memory (AY) into FAC2

; perform subtraction, FAC1 from FAC2

LAB_SUBTRACT
      LDA   FAC1_s            ; get FAC1 sign (b7)
      EOR   #$FF              ; complement it
      STA   FAC1_s            ; save FAC1 sign (b7)
      EOR   FAC2_s            ; EOR with FAC2 sign (b7)
      STA   FAC_sc            ; save sign compare (FAC1 EOR FAC2)
      LDA   FAC1_e            ; get FAC1 exponent
      JMP   LAB_ADD           ; go add FAC2 to FAC1

; perform addition

LAB_2467
      JSR   LAB_257B          ; shift FACX A times right (>8 shifts)
      BCC   LAB_24A8          ;.go subtract mantissas

; add 0.5 to FAC1

LAB_244E
      LDA   #<LAB_2A96        ; set 0.5 pointer low byte
      LDY   #>LAB_2A96        ; set 0.5 pointer high byte

; add (AY) to FAC1

LAB_246C
      JSR   LAB_264D          ; unpack memory (AY) into FAC2

; add FAC2 to FAC1

LAB_ADD
      BNE   LAB_2474          ; branch if FAC1 was not zero

; copy FAC2 to FAC1

LAB_279B
      LDA   FAC2_s            ; get FAC2 sign (b7)

; save FAC1 sign and copy ABS(FAC2) to FAC1

LAB_279D
      STA   FAC1_s            ; save FAC1 sign (b7)
      LDX   #$04              ; 4 bytes to copy
LAB_27A1
      LDA   FAC1_o,X          ; get byte from FAC2,X
      STA   FAC1_e-1,X        ; save byte at FAC1,X
      DEX                     ; decrement count
      BNE   LAB_27A1          ; loop if not all done

      STX   FAC1_r            ; clear FAC1 rounding byte
      RTS

                              ; FAC1 is non zero
LAB_2474
      LDX   FAC1_r            ; get FAC1 rounding byte
      STX   FAC2_r            ; save as FAC2 rounding byte
      LDX   #FAC2_e           ; set index to FAC2 exponent addr
      LDA   FAC2_e            ; get FAC2 exponent
LAB_247C
      TAY                     ; copy exponent
      BEQ   LAB_244D          ; exit if zero

      SEC                     ; set carry for subtract
      SBC   FAC1_e            ; subtract FAC1 exponent
      BEQ   LAB_24A8          ; branch if = (go add mantissa)

      BCC   LAB_2498          ; branch if <

                              ; FAC2>FAC1
      STY   FAC1_e            ; save FAC1 exponent
      LDY   FAC2_s            ; get FAC2 sign (b7)
      STY   FAC1_s            ; save FAC1 sign (b7)
      EOR   #$FF              ; complement A
      ADC   #$00              ; +1 (twos complement, carry is set)
      LDY   #$00              ; clear Y
      STY   FAC2_r            ; clear FAC2 rounding byte
      LDX   #FAC1_e           ; set index to FAC1 exponent addr
      BNE   LAB_249C          ; branch always

LAB_2498
      LDY   #$00              ; clear Y
      STY   FAC1_r            ; clear FAC1 rounding byte
LAB_249C
      CMP   #$F9              ; compare exponent diff with $F9
      BMI   LAB_2467          ; branch if range $79-$F8

      TAY                     ; copy exponent difference to Y
      LDA   FAC1_r            ; get FAC1 rounding byte
      LSR   PLUS_1,X          ; shift FAC? mantissa1
      JSR   LAB_2592          ; shift FACX Y times right

                              ; exponents are equal now do mantissa subtract
LAB_24A8
      BIT   FAC_sc            ; test sign compare (FAC1 EOR FAC2)
      BPL   LAB_24F8          ; if = add FAC2 mantissa to FAC1 mantissa and return

      LDY   #FAC1_e           ; set index to FAC1 exponent addr
      CPX   #FAC2_e           ; compare X to FAC2 exponent addr
      BEQ   LAB_24B4          ; branch if =

      LDY   #FAC2_e           ; else set index to FAC2 exponent addr

                              ; subtract smaller from bigger (take sign of bigger)
LAB_24B4
      SEC                     ; set carry for subtract
      EOR   #$FF              ; ones complement A
      ADC   FAC2_r            ; add FAC2 rounding byte
      STA   FAC1_r            ; save FAC1 rounding byte
      LDA   PLUS_3,Y          ; get FACY mantissa3
      SBC   PLUS_3,X          ; subtract FACX mantissa3
      STA   FAC1_3            ; save FAC1 mantissa3
      LDA   PLUS_2,Y          ; get FACY mantissa2
      SBC   PLUS_2,X          ; subtract FACX mantissa2
      STA   FAC1_2            ; save FAC1 mantissa2
      LDA   PLUS_1,Y          ; get FACY mantissa1
      SBC   PLUS_1,X          ; subtract FACX mantissa1
      STA   FAC1_1            ; save FAC1 mantissa1

; do ABS and normalise FAC1

LAB_24D0
      BCS   LAB_24D5          ; branch if number is +ve

      JSR   LAB_2537          ; negate FAC1

; normalise FAC1

LAB_24D5
      LDY   #$00              ; clear Y
      TYA                     ; clear A
      CLC                     ; clear carry for add
LAB_24D9
      LDX   FAC1_1            ; get FAC1 mantissa1
      BNE   LAB_251B          ; if not zero normalise FAC1

      LDX   FAC1_2            ; get FAC1 mantissa2
      STX   FAC1_1            ; save FAC1 mantissa1
      LDX   FAC1_3            ; get FAC1 mantissa3
      STX   FAC1_2            ; save FAC1 mantissa2
      LDX   FAC1_r            ; get FAC1 rounding byte
      STX   FAC1_3            ; save FAC1 mantissa3
      STY   FAC1_r            ; clear FAC1 rounding byte
      ADC   #$08              ; add x to exponent offset
      CMP   #$18              ; compare with $18 (max offset, all bits would be =0)
      BNE   LAB_24D9          ; loop if not max

; clear FAC1 exponent and sign

LAB_24F1
      LDA   #$00              ; clear A
LAB_24F3
      STA   FAC1_e            ; set FAC1 exponent

; save FAC1 sign

LAB_24F5
      STA   FAC1_s            ; save FAC1 sign (b7)
      RTS

; add FAC2 mantissa to FAC1 mantissa

LAB_24F8
      ADC   FAC2_r            ; add FAC2 rounding byte
      STA   FAC1_r            ; save FAC1 rounding byte
      LDA   FAC1_3            ; get FAC1 mantissa3
      ADC   FAC2_3            ; add FAC2 mantissa3
      STA   FAC1_3            ; save FAC1 mantissa3
      LDA   FAC1_2            ; get FAC1 mantissa2
      ADC   FAC2_2            ; add FAC2 mantissa2
      STA   FAC1_2            ; save FAC1 mantissa2
      LDA   FAC1_1            ; get FAC1 mantissa1
      ADC   FAC2_1            ; add FAC2 mantissa1
      STA   FAC1_1            ; save FAC1 mantissa1
      BCS   LAB_252A          ; if carry then normalise FAC1 for C=1

      RTS                     ; else just exit

LAB_2511
      ADC   #$01              ; add 1 to exponent offset
      ASL   FAC1_r            ; shift FAC1 rounding byte
      ROL   FAC1_3            ; shift FAC1 mantissa3
      ROL   FAC1_2            ; shift FAC1 mantissa2
      ROL   FAC1_1            ; shift FAC1 mantissa1

; normalise FAC1

LAB_251B
      BPL   LAB_2511          ; loop if not normalised

      SEC                     ; set carry for subtract
      SBC   FAC1_e            ; subtract FAC1 exponent
      BCS   LAB_24F1          ; branch if underflow (set result = $0)

      EOR   #$FF              ; complement exponent
      ADC   #$01              ; +1 (twos complement)
      STA   FAC1_e            ; save FAC1 exponent

; test and normalise FAC1 for C=0/1

LAB_2528
      BCC   LAB_2536          ; exit if no overflow

; normalise FAC1 for C=1

LAB_252A
      INC   FAC1_e            ; increment FAC1 exponent
      BEQ   LAB_2564          ; if zero do overflow error and warm start

      ROR   FAC1_1            ; shift FAC1 mantissa1
      ROR   FAC1_2            ; shift FAC1 mantissa2
      ROR   FAC1_3            ; shift FAC1 mantissa3
      ROR   FAC1_r            ; shift FAC1 rounding byte
LAB_2536
      RTS

; negate FAC1

LAB_2537
      LDA   FAC1_s            ; get FAC1 sign (b7)
      EOR   #$FF              ; complement it
      STA   FAC1_s            ; save FAC1 sign (b7)

; twos complement FAC1 mantissa

LAB_253D
      LDA   FAC1_1            ; get FAC1 mantissa1
      EOR   #$FF              ; complement it
      STA   FAC1_1            ; save FAC1 mantissa1
      LDA   FAC1_2            ; get FAC1 mantissa2
      EOR   #$FF              ; complement it
      STA   FAC1_2            ; save FAC1 mantissa2
      LDA   FAC1_3            ; get FAC1 mantissa3
      EOR   #$FF              ; complement it
      STA   FAC1_3            ; save FAC1 mantissa3
      LDA   FAC1_r            ; get FAC1 rounding byte
      EOR   #$FF              ; complement it
      STA   FAC1_r            ; save FAC1 rounding byte
      INC   FAC1_r            ; increment FAC1 rounding byte
      BNE   LAB_2563          ; exit if no overflow

; increment FAC1 mantissa

LAB_2559
      INC   FAC1_3            ; increment FAC1 mantissa3
      BNE   LAB_2563          ; finished if no rollover

      INC   FAC1_2            ; increment FAC1 mantissa2
      BNE   LAB_2563          ; finished if no rollover

      INC   FAC1_1            ; increment FAC1 mantissa1
LAB_2563
      RTS

; do overflow error (overflow exit)

LAB_2564
      LDX   #$0A              ; error code $0A ("Overflow" error)
      JMP   LAB_XERR          ; do error #X, then warm start

; shift FCAtemp << A+8 times

LAB_2569
      LDX   #FACt_1-1         ; set offset to FACtemp
LAB_256B
      LDY   PLUS_3,X          ; get FACX mantissa3
      STY   FAC1_r            ; save as FAC1 rounding byte
      LDY   PLUS_2,X          ; get FACX mantissa2
      STY   PLUS_3,X          ; save FACX mantissa3
      LDY   PLUS_1,X          ; get FACX mantissa1
      STY   PLUS_2,X          ; save FACX mantissa2
      LDY   FAC1_o            ; get FAC1 overflow byte
      STY   PLUS_1,X          ; save FACX mantissa1

; shift FACX -A times right (> 8 shifts)

LAB_257B
      ADC   #$08              ; add 8 to shift count
      BMI   LAB_256B          ; go do 8 shift if still -ve

      BEQ   LAB_256B          ; go do 8 shift if zero

      SBC   #$08              ; else subtract 8 again
      TAY                     ; save count to Y
      LDA   FAC1_r            ; get FAC1 rounding byte
      BCS   LAB_259A          ;.

LAB_2588
      ASL   PLUS_1,X          ; shift FACX mantissa1
      BCC   LAB_258E          ; branch if +ve

      INC   PLUS_1,X          ; this sets b7 eventually
LAB_258E
      ROR   PLUS_1,X          ; shift FACX mantissa1 (correct for ASL)
      ROR   PLUS_1,X          ; shift FACX mantissa1 (put carry in b7)

; shift FACX Y times right

LAB_2592
      ROR   PLUS_2,X          ; shift FACX mantissa2
      ROR   PLUS_3,X          ; shift FACX mantissa3
      ROR                     ; shift FACX rounding byte
      INY                     ; increment exponent diff
      BNE   LAB_2588          ; branch if range adjust not complete

LAB_259A
      CLC                     ; just clear it
      RTS

; perform LOG()

LAB_LOG
      JSR   LAB_27CA          ; test sign and zero
      BEQ   LAB_25C4          ; if zero do function call error then warm start

      BPL   LAB_25C7          ; skip error if +ve

LAB_25C4
      JMP   LAB_FCER          ; do function call error then warm start (-ve)

LAB_25C7
      LDA   FAC1_e            ; get FAC1 exponent
      SBC   #$7F              ; normalise it
      PHA                     ; save it
      LDA   #$80              ; set exponent to zero
      STA   FAC1_e            ; save FAC1 exponent
      LDA   #<LAB_25AD        ; set 1/root2 pointer low byte
      LDY   #>LAB_25AD        ; set 1/root2 pointer high byte
      JSR   LAB_246C          ; add (AY) to FAC1 (1/root2)
      LDA   #<LAB_25B1        ; set root2 pointer low byte
      LDY   #>LAB_25B1        ; set root2 pointer high byte
      JSR   LAB_26CA          ; convert AY and do (AY)/FAC1 (root2/(x+(1/root2)))
      LDA   #<LAB_259C        ; set 1 pointer low byte
      LDY   #>LAB_259C        ; set 1 pointer high byte
      JSR   LAB_2455          ; subtract (AY) from FAC1 ((root2/(x+(1/root2)))-1)
      LDA   #<LAB_25A0        ; set pointer low byte to counter
      LDY   #>LAB_25A0        ; set pointer high byte to counter
      JSR   LAB_2B6E          ; ^2 then series evaluation
      LDA   #<LAB_25B5        ; set -0.5 pointer low byte
      LDY   #>LAB_25B5        ; set -0.5 pointer high byte
      JSR   LAB_246C          ; add (AY) to FAC1
      PLA                     ; restore FAC1 exponent
      JSR   LAB_2912          ; evaluate new ASCII digit
      LDA   #<LAB_25B9        ; set LOG(2) pointer low byte
      LDY   #>LAB_25B9        ; set LOG(2) pointer high byte

; do convert AY, FCA1*(AY)

LAB_25FB
      JSR   LAB_264D          ; unpack memory (AY) into FAC2
LAB_MULTIPLY
      BEQ   LAB_264C          ; exit if zero

      JSR   LAB_2673          ; test and adjust accumulators
      LDA   #$00              ; clear A
      STA   FACt_1            ; clear temp mantissa1
      STA   FACt_2            ; clear temp mantissa2
      STA   FACt_3            ; clear temp mantissa3
      LDA   FAC1_r            ; get FAC1 rounding byte
      JSR   LAB_2622          ; go do shift/add FAC2
      LDA   FAC1_3            ; get FAC1 mantissa3
      JSR   LAB_2622          ; go do shift/add FAC2
      LDA   FAC1_2            ; get FAC1 mantissa2
      JSR   LAB_2622          ; go do shift/add FAC2
      LDA   FAC1_1            ; get FAC1 mantissa1
      JSR   LAB_2627          ; go do shift/add FAC2
      JMP   LAB_273C          ; copy temp to FAC1, normalise and return

LAB_2622
      BNE   LAB_2627          ; branch if byte <> zero
; *** begin patch  2.22p5.6  floating point multiply rounding bug
; *** replace
;      JMP   LAB_2569          ; shift FCAtemp << A+8 times
;
;                              ; else do shift and add
;LAB_2627
;      LSR                     ; shift byte
;      ORA   #$80              ; set top bit (mark for 8 times)
; *** with
      SEC
      JMP   LAB_2569          ; shift FACtemp << A+8 times

                              ; else do shift and add
LAB_2627
      SEC                     ; set top bit (mark for 8 times)
      ROR
; *** end patch    2.22p5.6  floating point multiply rounding bug
LAB_262A
      TAY                     ; copy result
      BCC   LAB_2640          ; skip next if bit was zero

      CLC                     ; clear carry for add
      LDA   FACt_3            ; get temp mantissa3
      ADC   FAC2_3            ; add FAC2 mantissa3
      STA   FACt_3            ; save temp mantissa3
      LDA   FACt_2            ; get temp mantissa2
      ADC   FAC2_2            ; add FAC2 mantissa2
      STA   FACt_2            ; save temp mantissa2
      LDA   FACt_1            ; get temp mantissa1
      ADC   FAC2_1            ; add FAC2 mantissa1
      STA   FACt_1            ; save temp mantissa1
LAB_2640
      ROR   FACt_1            ; shift temp mantissa1
      ROR   FACt_2            ; shift temp mantissa2
      ROR   FACt_3            ; shift temp mantissa3
      ROR   FAC1_r            ; shift temp rounding byte
      TYA                     ; get byte back
      LSR                     ; shift byte
      BNE   LAB_262A          ; loop if all bits not done

LAB_264C
      RTS

; unpack memory (AY) into FAC2

LAB_264D
      STA   ut1_pl            ; save pointer low byte
      STY   ut1_ph            ; save pointer high byte
      LDY   #$03              ; 4 bytes to get (0-3)
      LDA   (ut1_pl),Y        ; get mantissa3
      STA   FAC2_3            ; save FAC2 mantissa3
      DEY                     ; decrement index
      LDA   (ut1_pl),Y        ; get mantissa2
      STA   FAC2_2            ; save FAC2 mantissa2
      DEY                     ; decrement index
      LDA   (ut1_pl),Y        ; get mantissa1+sign
      STA   FAC2_s            ; save FAC2 sign (b7)
      EOR   FAC1_s            ; EOR with FAC1 sign (b7)
      STA   FAC_sc            ; save sign compare (FAC1 EOR FAC2)
      LDA   FAC2_s            ; recover FAC2 sign (b7)
      ORA   #$80              ; set 1xxx xxx (set normal bit)
      STA   FAC2_1            ; save FAC2 mantissa1
      DEY                     ; decrement index
      LDA   (ut1_pl),Y        ; get exponent byte
      STA   FAC2_e            ; save FAC2 exponent
      LDA   FAC1_e            ; get FAC1 exponent
      RTS

; test and adjust accumulators

LAB_2673
      LDA   FAC2_e            ; get FAC2 exponent
LAB_2675
      BEQ   LAB_2696          ; branch if FAC2 = $00 (handle underflow)

      CLC                     ; clear carry for add
      ADC   FAC1_e            ; add FAC1 exponent
      BCC   LAB_2680          ; branch if sum of exponents <$0100

      BMI   LAB_269B          ; do overflow error

      CLC                     ; clear carry for the add
      .db $2C               ; makes next line BIT $1410
LAB_2680
      BPL   LAB_2696          ; if +ve go handle underflow

      ADC   #$80              ; adjust exponent
      STA   FAC1_e            ; save FAC1 exponent
      BNE   LAB_268B          ; branch if not zero

      JMP   LAB_24F5          ; save FAC1 sign and return

LAB_268B
      LDA   FAC_sc            ; get sign compare (FAC1 EOR FAC2)
      STA   FAC1_s            ; save FAC1 sign (b7)
LAB_268F
      RTS

; handle overflow and underflow

LAB_2690
      LDA   FAC1_s            ; get FAC1 sign (b7)
      BPL   LAB_269B          ; do overflow error

                              ; handle underflow
LAB_2696
      PLA                     ; pop return address low byte
      PLA                     ; pop return address high byte
      JMP   LAB_24F1          ; clear FAC1 exponent and sign and return

; multiply by 10

LAB_269E
      JSR   LAB_27AB          ; round and copy FAC1 to FAC2
      TAX                     ; copy exponent (set the flags)
      BEQ   LAB_268F          ; exit if zero

      CLC                     ; clear carry for add
      ADC   #$02              ; add two to exponent (*4)
      BCS   LAB_269B          ; do overflow error if > $FF

      LDX   #$00              ; clear byte
      STX   FAC_sc            ; clear sign compare (FAC1 EOR FAC2)
      JSR   LAB_247C          ; add FAC2 to FAC1 (*5)
      INC   FAC1_e            ; increment FAC1 exponent (*10)
      BNE   LAB_268F          ; if non zero just do RTS

LAB_269B
      JMP   LAB_2564          ; do overflow error and warm start

; divide by 10

LAB_26B9
      JSR   LAB_27AB          ; round and copy FAC1 to FAC2
      LDA   #<LAB_26B5        ; set pointer to 10d low addr
      LDY   #>LAB_26B5        ; set pointer to 10d high addr
      LDX   #$00              ; clear sign

; divide by (AY) (X=sign)

LAB_26C2
      STX   FAC_sc            ; save sign compare (FAC1 EOR FAC2)
      JSR   LAB_UFAC          ; unpack memory (AY) into FAC1
      JMP   LAB_DIVIDE        ; do FAC2/FAC1

                              ; Perform divide-by
; convert AY and do (AY)/FAC1

LAB_26CA
      JSR   LAB_264D          ; unpack memory (AY) into FAC2

                              ; Perform divide-into
LAB_DIVIDE
      BEQ   LAB_2737          ; if zero go do /0 error

      JSR   LAB_27BA          ; round FAC1
      LDA   #$00              ; clear A
      SEC                     ; set carry for subtract
      SBC   FAC1_e            ; subtract FAC1 exponent (2s complement)
      STA   FAC1_e            ; save FAC1 exponent
      JSR   LAB_2673          ; test and adjust accumulators
      INC   FAC1_e            ; increment FAC1 exponent
      BEQ   LAB_269B          ; if zero do overflow error

      LDX   #$FF              ; set index for pre increment
      LDA   #$01              ; set bit to flag byte save
LAB_26E4
      LDY   FAC2_1            ; get FAC2 mantissa1
      CPY   FAC1_1            ; compare FAC1 mantissa1
      BNE   LAB_26F4          ; branch if <>

      LDY   FAC2_2            ; get FAC2 mantissa2
      CPY   FAC1_2            ; compare FAC1 mantissa2
      BNE   LAB_26F4          ; branch if <>

      LDY   FAC2_3            ; get FAC2 mantissa3
      CPY   FAC1_3            ; compare FAC1 mantissa3
LAB_26F4
      PHP                     ; save FAC2-FAC1 compare status
      ROL                     ; shift the result byte
      BCC   LAB_2702          ; if no carry skip the byte save

      LDY   #$01              ; set bit to flag byte save
      INX                     ; else increment the index to FACt
      CPX   #$02              ; compare with the index to FACt_3
      BMI   LAB_2701          ; if not last byte just go save it

      BNE   LAB_272B          ; if all done go save FAC1 rounding byte, normalise and
                              ; return

      LDY   #$40              ; set bit to flag byte save for the rounding byte
LAB_2701
      STA   FACt_1,X          ; write result byte to FACt_1 + index
      TYA                     ; copy the next save byte flag
LAB_2702
      PLP                     ; restore FAC2-FAC1 compare status
      BCC   LAB_2704          ; if FAC2 < FAC1 then skip the subtract

      TAY                     ; save FAC2-FAC1 compare status
      LDA   FAC2_3            ; get FAC2 mantissa3
      SBC   FAC1_3            ; subtract FAC1 mantissa3
      STA   FAC2_3            ; save FAC2 mantissa3
      LDA   FAC2_2            ; get FAC2 mantissa2
      SBC   FAC1_2            ; subtract FAC1 mantissa2
      STA   FAC2_2            ; save FAC2 mantissa2
      LDA   FAC2_1            ; get FAC2 mantissa1
      SBC   FAC1_1            ; subtract FAC1 mantissa1
      STA   FAC2_1            ; save FAC2 mantissa1
      TYA                     ; restore FAC2-FAC1 compare status

                              ; FAC2 = FAC2*2
LAB_2704
      ASL   FAC2_3            ; shift FAC2 mantissa3
      ROL   FAC2_2            ; shift FAC2 mantissa2
      ROL   FAC2_1            ; shift FAC2 mantissa1
      BCS   LAB_26F4          ; loop with no compare

      BMI   LAB_26E4          ; loop with compare

      BPL   LAB_26F4          ; loop always with no compare

; do A<<6, save as FAC1 rounding byte, normalise and return

LAB_272B
      LSR                     ; shift b1 - b0 ..
      ROR                     ; ..
      ROR                     ; .. to b7 - b6
      STA   FAC1_r            ; save FAC1 rounding byte
      PLP                     ; dump FAC2-FAC1 compare status
      JMP   LAB_273C          ; copy temp to FAC1, normalise and return

; do "Divide by zero" error

LAB_2737
      LDX   #$14              ; error code $14 ("Divide by zero" error)
      JMP   LAB_XERR          ; do error #X, then warm start

; copy temp to FAC1 and normalise

LAB_273C
      LDA   FACt_1            ; get temp mantissa1
      STA   FAC1_1            ; save FAC1 mantissa1
      LDA   FACt_2            ; get temp mantissa2
      STA   FAC1_2            ; save FAC1 mantissa2
      LDA   FACt_3            ; get temp mantissa3
      STA   FAC1_3            ; save FAC1 mantissa3
      JMP   LAB_24D5          ; normalise FAC1 and return

; unpack memory (AY) into FAC1

LAB_UFAC
      STA   ut1_pl            ; save pointer low byte
      STY   ut1_ph            ; save pointer high byte
      LDY   #$03              ; 4 bytes to do
      LDA   (ut1_pl),Y        ; get last byte
      STA   FAC1_3            ; save FAC1 mantissa3
      DEY                     ; decrement index
      LDA   (ut1_pl),Y        ; get last-1 byte
      STA   FAC1_2            ; save FAC1 mantissa2
      DEY                     ; decrement index
      LDA   (ut1_pl),Y        ; get second byte
      STA   FAC1_s            ; save FAC1 sign (b7)
      ORA   #$80              ; set 1xxx xxxx (add normal bit)
      STA   FAC1_1            ; save FAC1 mantissa1
      DEY                     ; decrement index
      LDA   (ut1_pl),Y        ; get first byte (exponent)
      STA   FAC1_e            ; save FAC1 exponent
      STY   FAC1_r            ; clear FAC1 rounding byte
      RTS

; pack FAC1 into Adatal

LAB_276E
      LDX   #<Adatal          ; set pointer low byte
LAB_2770
      LDY   #>Adatal          ; set pointer high byte
      BEQ   LAB_2778          ; pack FAC1 into (XY) and return

; pack FAC1 into (Lvarpl)

LAB_PFAC
      LDX   Lvarpl            ; get destination pointer low byte
      LDY   Lvarph            ; get destination pointer high byte

; pack FAC1 into (XY)

LAB_2778
      JSR   LAB_27BA          ; round FAC1
      STX   ut1_pl            ; save pointer low byte
      STY   ut1_ph            ; save pointer high byte
      LDY   #$03              ; set index
      LDA   FAC1_3            ; get FAC1 mantissa3
      STA   (ut1_pl),Y        ; store in destination
      DEY                     ; decrement index
      LDA   FAC1_2            ; get FAC1 mantissa2
      STA   (ut1_pl),Y        ; store in destination
      DEY                     ; decrement index
      LDA   FAC1_s            ; get FAC1 sign (b7)
      ORA   #$7F              ; set bits x111 1111
      AND   FAC1_1            ; AND in FAC1 mantissa1
      STA   (ut1_pl),Y        ; store in destination
      DEY                     ; decrement index
      LDA   FAC1_e            ; get FAC1 exponent
      STA   (ut1_pl),Y        ; store in destination
      STY   FAC1_r            ; clear FAC1 rounding byte
      RTS

; round and copy FAC1 to FAC2

LAB_27AB
      JSR   LAB_27BA          ; round FAC1

; copy FAC1 to FAC2

LAB_27AE
      LDX   #$05              ; 5 bytes to copy
LAB_27B0
      LDA   FAC1_e-1,X        ; get byte from FAC1,X
      STA   FAC1_o,X          ; save byte at FAC2,X
      DEX                     ; decrement count
      BNE   LAB_27B0          ; loop if not all done

      STX   FAC1_r            ; clear FAC1 rounding byte
LAB_27B9
      RTS

; round FAC1

LAB_27BA
      LDA   FAC1_e            ; get FAC1 exponent
      BEQ   LAB_27B9          ; exit if zero

      ASL   FAC1_r            ; shift FAC1 rounding byte
      BCC   LAB_27B9          ; exit if no overflow

; round FAC1 (no check)

LAB_27C2
      JSR   LAB_2559          ; increment FAC1 mantissa
      BNE   LAB_27B9          ; branch if no overflow

      JMP   LAB_252A          ; normalise FAC1 for C=1 and return

; get FAC1 sign
; return A=FF,C=1/-ve A=01,C=0/+ve

LAB_27CA
      LDA   FAC1_e            ; get FAC1 exponent
      BEQ   LAB_27D7          ; exit if zero (already correct SGN(0)=0)

; return A=FF,C=1/-ve A=01,C=0/+ve
; no = 0 check

LAB_27CE
      LDA   FAC1_s            ; else get FAC1 sign (b7)

; return A=FF,C=1/-ve A=01,C=0/+ve
; no = 0 check, sign in A

LAB_27D0
      ROL                     ; move sign bit to carry
      LDA   #$FF              ; set byte for -ve result
      BCS   LAB_27D7          ; return if sign was set (-ve)

      LDA   #$01              ; else set byte for +ve result
LAB_27D7
      RTS

; perform SGN()

LAB_SGN
      JSR   LAB_27CA          ; get FAC1 sign
                              ; return A=$FF/-ve A=$01/+ve
; save A as integer byte

LAB_27DB
      STA   FAC1_1            ; save FAC1 mantissa1
      LDA   #$00              ; clear A
      STA   FAC1_2            ; clear FAC1 mantissa2
      LDX   #$88              ; set exponent

; set exp=X, clearFAC1 mantissa3 and normalise

LAB_27E3
      LDA   FAC1_1            ; get FAC1 mantissa1
      EOR   #$FF              ; complement it
      ROL                     ; sign bit into carry

; set exp=X, clearFAC1 mantissa3 and normalise

LAB_STFA
      LDA   #$00              ; clear A
      STA   FAC1_3            ; clear FAC1 mantissa3
      STX   FAC1_e            ; set FAC1 exponent
      STA   FAC1_r            ; clear FAC1 rounding byte
      STA   FAC1_s            ; clear FAC1 sign (b7)
      JMP   LAB_24D0          ; do ABS and normalise FAC1

; perform ABS()

LAB_ABS
      LSR   FAC1_s            ; clear FAC1 sign (put zero in b7)
      RTS

; compare FAC1 with (AY)
; returns A=$00 if FAC1 = (AY)
; returns A=$01 if FAC1 > (AY)
; returns A=$FF if FAC1 < (AY)

LAB_27F8
      STA   ut2_pl            ; save pointer low byte
LAB_27FA
      STY   ut2_ph            ; save pointer high byte
      LDY   #$00              ; clear index
      LDA   (ut2_pl),Y        ; get exponent
      INY                     ; increment index
      TAX                     ; copy (AY) exponent to X
      BEQ   LAB_27CA          ; branch if (AY) exponent=0 and get FAC1 sign
                              ; A=FF,C=1/-ve A=01,C=0/+ve

      LDA   (ut2_pl),Y        ; get (AY) mantissa1 (with sign)
      EOR   FAC1_s            ; EOR FAC1 sign (b7)
      BMI   LAB_27CE          ; if signs <> do return A=FF,C=1/-ve
                              ; A=01,C=0/+ve and return

      CPX   FAC1_e            ; compare (AY) exponent with FAC1 exponent
      BNE   LAB_2828          ; branch if different

      LDA   (ut2_pl),Y        ; get (AY) mantissa1 (with sign)
      ORA   #$80              ; normalise top bit
      CMP   FAC1_1            ; compare with FAC1 mantissa1
      BNE   LAB_2828          ; branch if different

      INY                     ; increment index
      LDA   (ut2_pl),Y        ; get mantissa2
      CMP   FAC1_2            ; compare with FAC1 mantissa2
      BNE   LAB_2828          ; branch if different

      INY                     ; increment index
      LDA   #$7F              ; set for 1/2 value rounding byte
      CMP   FAC1_r            ; compare with FAC1 rounding byte (set carry)
      LDA   (ut2_pl),Y        ; get mantissa3
      SBC   FAC1_3            ; subtract FAC1 mantissa3
      BEQ   LAB_2850          ; exit if mantissa3 equal

; gets here if number <> FAC1

LAB_2828
      LDA   FAC1_s            ; get FAC1 sign (b7)
      BCC   LAB_282E          ; branch if FAC1 > (AY)

      EOR   #$FF              ; else toggle FAC1 sign
LAB_282E
      JMP   LAB_27D0          ; return A=FF,C=1/-ve A=01,C=0/+ve

; convert FAC1 floating-to-fixed

LAB_2831
      LDA   FAC1_e            ; get FAC1 exponent
      BEQ   LAB_287F          ; if zero go clear FAC1 and return

      SEC                     ; set carry for subtract
      SBC   #$98              ; subtract maximum integer range exponent
      BIT   FAC1_s            ; test FAC1 sign (b7)
      BPL   LAB_2845          ; branch if FAC1 +ve

                              ; FAC1 was -ve
      TAX                     ; copy subtracted exponent
      LDA   #$FF              ; overflow for -ve number
      STA   FAC1_o            ; set FAC1 overflow byte
      JSR   LAB_253D          ; twos complement FAC1 mantissa
      TXA                     ; restore subtracted exponent
LAB_2845
      LDX   #FAC1_e           ; set index to FAC1
      CMP   #$F9              ; compare exponent result
      BPL   LAB_2851          ; if < 8 shifts shift FAC1 A times right and return

      JSR   LAB_257B          ; shift FAC1 A times right (> 8 shifts)
      STY   FAC1_o            ; clear FAC1 overflow byte
LAB_2850
      RTS

; shift FAC1 A times right

LAB_2851
      TAY                     ; copy shift count
      LDA   FAC1_s            ; get FAC1 sign (b7)
      AND   #$80              ; mask sign bit only (x000 0000)
      LSR   FAC1_1            ; shift FAC1 mantissa1
      ORA   FAC1_1            ; OR sign in b7 FAC1 mantissa1
      STA   FAC1_1            ; save FAC1 mantissa1
      JSR   LAB_2592          ; shift FAC1 Y times right
      STY   FAC1_o            ; clear FAC1 overflow byte
      RTS

; perform INT()

LAB_INT
      LDA   FAC1_e            ; get FAC1 exponent
      CMP   #$98              ; compare with max int
      BCS   LAB_2886          ; exit if >= (already int, too big for fractional part!)

      JSR   LAB_2831          ; convert FAC1 floating-to-fixed
      STY   FAC1_r            ; save FAC1 rounding byte
      LDA   FAC1_s            ; get FAC1 sign (b7)
      STY   FAC1_s            ; save FAC1 sign (b7)
      EOR   #$80              ; toggle FAC1 sign
      ROL                     ; shift into carry
      LDA   #$98              ; set new exponent
      STA   FAC1_e            ; save FAC1 exponent
      LDA   FAC1_3            ; get FAC1 mantissa3
      STA   Temp3             ; save for EXP() function
      JMP   LAB_24D0          ; do ABS and normalise FAC1

; clear FAC1 and return

LAB_287F
      STA   FAC1_1            ; clear FAC1 mantissa1
      STA   FAC1_2            ; clear FAC1 mantissa2
      STA   FAC1_3            ; clear FAC1 mantissa3
      TAY                     ; clear Y
LAB_2886
      RTS

; get FAC1 from string
; this routine now handles hex and binary values from strings
; starting with "$" and "%" respectively

LAB_2887
      LDY   #$00              ; clear Y
      STY   Dtypef            ; clear data type flag, $FF=string, $00=numeric
      LDX   #$09              ; set index
LAB_288B
      STY   numexp,X          ; clear byte
      DEX                     ; decrement index
      BPL   LAB_288B          ; loop until numexp to negnum (and FAC1) = $00

      BCC   LAB_28FE          ; branch if 1st character numeric

; get FAC1 from string .. first character wasn't numeric

      CMP   #'-'              ; else compare with "-"
      BNE   LAB_289A          ; branch if not "-"

      STX   negnum            ; set flag for -ve number (X = $FF)
      BEQ   LAB_289C          ; branch always (go scan and check for hex/bin)

; get FAC1 from string .. first character wasn't numeric or -

LAB_289A
      CMP   #'+'              ; else compare with "+"
      BNE   LAB_289D          ; branch if not "+" (go check for hex/bin)

; was "+" or "-" to start, so get next character

LAB_289C
      JSR   LAB_IGBY          ; increment and scan memory
      BCC   LAB_28FE          ; branch if numeric character

; code here for hex and binary numbers

LAB_289D
      CMP   #'$'              ; else compare with "$"
      BNE   LAB_NHEX          ; branch if not "$"

      JMP   LAB_CHEX          ; branch if "$"

LAB_NHEX
      CMP   #'%'              ; else compare with "%"
      BNE   LAB_28A3          ; branch if not "%" (continue original code)

      JMP   LAB_CBIN          ; branch if "%"

LAB_289E
      JSR   LAB_IGBY          ; increment and scan memory (ignore + or get next number)
LAB_28A1
      BCC   LAB_28FE          ; branch if numeric character

; get FAC1 from string .. character wasn't numeric, -, +, hex or binary

LAB_28A3
      CMP   #'.'              ; else compare with "."
      BEQ   LAB_28D5          ; branch if "."

; get FAC1 from string .. character wasn't numeric, -, + or .

      CMP   #'E'              ; else compare with "E"
      BNE   LAB_28DB          ; branch if not "E"

                              ; was "E" so evaluate exponential part
      JSR   LAB_IGBY          ; increment and scan memory
      BCC   LAB_28C7          ; branch if numeric character

      CMP   #TK_MINUS         ; else compare with token for -
      BEQ   LAB_28C2          ; branch if token for -

      CMP   #'-'              ; else compare with "-"
      BEQ   LAB_28C2          ; branch if "-"

      CMP   #TK_PLUS          ; else compare with token for +
      BEQ   LAB_28C4          ; branch if token for +

      CMP   #'+'              ; else compare with "+"
      BEQ   LAB_28C4          ; branch if "+"

      BNE   LAB_28C9          ; branch always

LAB_28C2
      ROR   expneg            ; set exponent -ve flag (C, which=1, into b7)
LAB_28C4
      JSR   LAB_IGBY          ; increment and scan memory
LAB_28C7
      BCC   LAB_2925          ; branch if numeric character

LAB_28C9
      BIT   expneg            ; test exponent -ve flag
      BPL   LAB_28DB          ; if +ve go evaluate exponent

                              ; else do exponent = -exponent 
      LDA   #$00              ; clear result
      SEC                     ; set carry for subtract
      SBC   expcnt            ; subtract exponent byte
      JMP   LAB_28DD          ; go evaluate exponent

LAB_28D5
      ROR   numdpf            ; set decimal point flag
      BIT   numdpf            ; test decimal point flag
      BVC   LAB_289E          ; branch if only one decimal point so far

                              ; evaluate exponent
LAB_28DB
      LDA   expcnt            ; get exponent count byte
LAB_28DD
      SEC                     ; set carry for subtract
      SBC   numexp            ; subtract numerator exponent
      STA   expcnt            ; save exponent count byte
      BEQ   LAB_28F6          ; branch if no adjustment

      BPL   LAB_28EF          ; else if +ve go do FAC1*10^expcnt

                              ; else go do FAC1/10^(0-expcnt)
LAB_28E6
      JSR   LAB_26B9          ; divide by 10
      INC   expcnt            ; increment exponent count byte
      BNE   LAB_28E6          ; loop until all done

      BEQ   LAB_28F6          ; branch always

LAB_28EF
      JSR   LAB_269E          ; multiply by 10
      DEC   expcnt            ; decrement exponent count byte
      BNE   LAB_28EF          ; loop until all done

LAB_28F6
      LDA   negnum            ; get -ve flag
      BMI   LAB_28FB          ; if -ve do - FAC1 and return

      RTS

; do - FAC1 and return

LAB_28FB
      JMP   LAB_GTHAN         ; do - FAC1 and return

; do unsigned FAC1*10+number

LAB_28FE
      PHA                     ; save character
      BIT   numdpf            ; test decimal point flag
      BPL   LAB_2905          ; skip exponent increment if not set

      INC   numexp            ; else increment number exponent
LAB_2905
      JSR   LAB_269E          ; multiply FAC1 by 10
      PLA                     ; restore character
      AND   #$0F              ; convert to binary
      JSR   LAB_2912          ; evaluate new ASCII digit
      JMP   LAB_289E          ; go do next character

; evaluate new ASCII digit

LAB_2912
      PHA                     ; save digit
      JSR   LAB_27AB          ; round and copy FAC1 to FAC2
      PLA                     ; restore digit
      JSR   LAB_27DB          ; save A as integer byte
      LDA   FAC2_s            ; get FAC2 sign (b7)
      EOR   FAC1_s            ; toggle with FAC1 sign (b7)
      STA   FAC_sc            ; save sign compare (FAC1 EOR FAC2)
      LDX   FAC1_e            ; get FAC1 exponent
      JMP   LAB_ADD           ; add FAC2 to FAC1 and return

; evaluate next character of exponential part of number

LAB_2925
      LDA   expcnt            ; get exponent count byte
      CMP   #$0A              ; compare with 10 decimal
      BCC   LAB_2934          ; branch if less

      LDA   #$64              ; make all -ve exponents = -100 decimal (causes underflow)
      BIT   expneg            ; test exponent -ve flag
      BMI   LAB_2942          ; branch if -ve

      JMP   LAB_2564          ; else do overflow error

LAB_2934
      ASL                     ; * 2
      ASL                     ; * 4
      ADC   expcnt            ; * 5
      ASL                     ; * 10
      LDY   #$00              ; set index
      ADC   (Bpntrl),Y        ; add character (will be $30 too much!)
      SBC   #'0'-1            ; convert character to binary
LAB_2942
      STA   expcnt            ; save exponent count byte
      JMP   LAB_28C4          ; go get next character

; print " in line [LINE #]"

LAB_2953
      LDA   #<LAB_LMSG        ; point to " in line " message low byte
      LDY   #>LAB_LMSG        ; point to " in line " message high byte
      JSR   LAB_18C3          ; print null terminated string from memory

                              ; print Basic line #
      LDA   Clineh            ; get current line high byte
      LDX   Clinel            ; get current line low byte

; print XA as unsigned integer

LAB_295E
      STA   FAC1_1            ; save low byte as FAC1 mantissa1
      STX   FAC1_2            ; save high byte as FAC1 mantissa2
      LDX   #$90              ; set exponent to 16d bits
      SEC                     ; set integer is +ve flag
      JSR   LAB_STFA          ; set exp=X, clearFAC1 mantissa3 and normalise
      LDY   #$00              ; clear index
      TYA                     ; clear A
      JSR   LAB_297B          ; convert FAC1 to string, skip sign character save
      JMP   LAB_18C3          ; print null terminated string from memory and return

; convert FAC1 to ASCII string result in (AY)
; not any more, moved scratchpad to page 0

LAB_296E
      LDY   #$01              ; set index = 1
      LDA   #$20              ; character = " " (assume +ve)
      BIT   FAC1_s            ; test FAC1 sign (b7)
      BPL   LAB_2978          ; branch if +ve

      LDA   #$2D              ; else character = "-"
LAB_2978
      STA   Decss,Y           ; save leading character (" " or "-")
LAB_297B
      STA   FAC1_s            ; clear FAC1 sign (b7)
      STY   Sendl             ; save index
      INY                     ; increment index
      LDX   FAC1_e            ; get FAC1 exponent
      BNE   LAB_2989          ; branch if FAC1<>0

                              ; exponent was $00 so FAC1 is 0
      LDA   #'0'              ; set character = "0"
      JMP   LAB_2A89          ; save last character, [EOT] and exit

                              ; FAC1 is some non zero value
LAB_2989
      LDA   #$00              ; clear (number exponent count)
      CPX   #$81              ; compare FAC1 exponent with $81 (>1.00000)

      BCS   LAB_299A          ; branch if FAC1=>1

                              ; FAC1<1
      LDA   #<LAB_294F        ; set pointer low byte to 1,000,000
      LDY   #>LAB_294F        ; set pointer high byte to 1,000,000
      JSR   LAB_25FB          ; do convert AY, FCA1*(AY)
      LDA   #$FA              ; set number exponent count (-6)
LAB_299A
      STA   numexp            ; save number exponent count
LAB_299C
      LDA   #<LAB_294B        ; set pointer low byte to 999999.4375 (max before sci note)
      LDY   #>LAB_294B        ; set pointer high byte to 999999.4375
      JSR   LAB_27F8          ; compare FAC1 with (AY)
      BEQ   LAB_29C3          ; exit if FAC1 = (AY)

      BPL   LAB_29B9          ; go do /10 if FAC1 > (AY)

                              ; FAC1 < (AY)
LAB_29A7
      LDA   #<LAB_2947        ; set pointer low byte to 99999.9375
      LDY   #>LAB_2947        ; set pointer high byte to 99999.9375
      JSR   LAB_27F8          ; compare FAC1 with (AY)
      BEQ   LAB_29B2          ; branch if FAC1 = (AY) (allow decimal places)

      BPL   LAB_29C0          ; branch if FAC1 > (AY) (no decimal places)

                              ; FAC1 <= (AY)
LAB_29B2
      JSR   LAB_269E          ; multiply by 10
      DEC   numexp            ; decrement number exponent count
      BNE   LAB_29A7          ; go test again (branch always)

LAB_29B9
      JSR   LAB_26B9          ; divide by 10
      INC   numexp            ; increment number exponent count
      BNE   LAB_299C          ; go test again (branch always)

; now we have just the digits to do

LAB_29C0
      JSR   LAB_244E          ; add 0.5 to FAC1 (round FAC1)
LAB_29C3
      JSR   LAB_2831          ; convert FAC1 floating-to-fixed
      LDX   #$01              ; set default digits before dp = 1
      LDA   numexp            ; get number exponent count
      CLC                     ; clear carry for add
      ADC   #$07              ; up to 6 digits before point
      BMI   LAB_29D8          ; if -ve then 1 digit before dp

      CMP   #$08              ; A>=8 if n>=1E6
      BCS   LAB_29D9          ; branch if >= $08

                              ; carry is clear
      ADC   #$FF              ; take 1 from digit count
      TAX                     ; copy to A
      LDA   #$02              ;.set exponent adjust
LAB_29D8
      SEC                     ; set carry for subtract
LAB_29D9
      SBC   #$02              ; -2
      STA   expcnt            ;.save exponent adjust
      STX   numexp            ; save digits before dp count
      TXA                     ; copy to A
      BEQ   LAB_29E4          ; branch if no digits before dp

      BPL   LAB_29F7          ; branch if digits before dp

LAB_29E4
      LDY   Sendl             ; get output string index
      LDA   #$2E              ; character "."
      INY                     ; increment index
      STA   Decss,Y           ; save to output string
      TXA                     ;.
      BEQ   LAB_29F5          ;.

      LDA   #'0'              ; character "0"
      INY                     ; increment index
      STA   Decss,Y           ; save to output string
LAB_29F5
      STY   Sendl             ; save output string index
LAB_29F7
      LDY   #$00              ; clear index (point to 100,000)
      LDX   #$80              ; 
LAB_29FB
      LDA   FAC1_3            ; get FAC1 mantissa3
      CLC                     ; clear carry for add
      ADC   LAB_2A9C,Y        ; add -ve LSB
      STA   FAC1_3            ; save FAC1 mantissa3
      LDA   FAC1_2            ; get FAC1 mantissa2
      ADC   LAB_2A9B,Y        ; add -ve NMSB
      STA   FAC1_2            ; save FAC1 mantissa2
      LDA   FAC1_1            ; get FAC1 mantissa1
      ADC   LAB_2A9A,Y        ; add -ve MSB
      STA   FAC1_1            ; save FAC1 mantissa1
      INX                     ; 
      BCS   LAB_2A18          ; 

      BPL   LAB_29FB          ; not -ve so try again

      BMI   LAB_2A1A          ; 

LAB_2A18
      BMI   LAB_29FB          ; 

LAB_2A1A
      TXA                     ; 
      BCC   LAB_2A21          ; 

      EOR   #$FF              ; 
      ADC   #$0A              ; 
LAB_2A21
      ADC   #'0'-1            ; add "0"-1 to result
      INY                     ; increment index ..
      INY                     ; .. to next less ..
      INY                     ; .. power of ten
      STY   Cvaral            ; save as current var address low byte
      LDY   Sendl             ; get output string index
      INY                     ; increment output string index
      TAX                     ; copy character to X
      AND   #$7F              ; mask out top bit
      STA   Decss,Y           ; save to output string
      DEC   numexp            ; decrement # of characters before the dp
      BNE   LAB_2A3B          ; branch if still characters to do

                              ; else output the point
      LDA   #$2E              ; character "."
      INY                     ; increment output string index
      STA   Decss,Y           ; save to output string
LAB_2A3B
      STY   Sendl             ; save output string index
      LDY   Cvaral            ; get current var address low byte
      TXA                     ; get character back
      EOR   #$FF              ; 
      AND   #$80              ; 
      TAX                     ; 
      CPY   #$12              ; compare index with max
      BNE   LAB_29FB          ; loop if not max

                              ; now remove trailing zeroes
      LDY   Sendl             ; get output string index
LAB_2A4B
      LDA   Decss,Y           ; get character from output string
      DEY                     ; decrement output string index
      CMP   #'0'              ; compare with "0"
      BEQ   LAB_2A4B          ; loop until non "0" character found

      CMP   #'.'              ; compare with "."
      BEQ   LAB_2A58          ; branch if was dp

                              ; restore last character
      INY                     ; increment output string index
LAB_2A58
      LDA   #$2B              ; character "+"
      LDX   expcnt            ; get exponent count
      BEQ   LAB_2A8C          ; if zero go set null terminator and exit

                              ; exponent isn't zero so write exponent
      BPL   LAB_2A68          ; branch if exponent count +ve

      LDA   #$00              ; clear A
      SEC                     ; set carry for subtract
      SBC   expcnt            ; subtract exponent count adjust (convert -ve to +ve)
      TAX                     ; copy exponent count to X
      LDA   #'-'              ; character "-"
LAB_2A68
      STA   Decss+2,Y         ; save to output string
      LDA   #$45              ; character "E"
      STA   Decss+1,Y         ; save exponent sign to output string
      TXA                     ; get exponent count back
      LDX   #'0'-1            ; one less than "0" character
      SEC                     ; set carry for subtract
LAB_2A74
      INX                     ; increment 10's character
      SBC   #$0A              ;.subtract 10 from exponent count
      BCS   LAB_2A74          ; loop while still >= 0

      ADC   #':'              ; add character ":" ($30+$0A, result is 10 less that value)
      STA   Decss+4,Y         ; save to output string
      TXA                     ; copy 10's character
      STA   Decss+3,Y         ; save to output string
      LDA   #$00              ; set null terminator
      STA   Decss+5,Y         ; save to output string
      BEQ   LAB_2A91          ; go set string pointer (AY) and exit (branch always)

                              ; save last character, [EOT] and exit
LAB_2A89
      STA   Decss,Y           ; save last character to output string

                              ; set null terminator and exit
LAB_2A8C
      LDA   #$00              ; set null terminator
      STA   Decss+1,Y         ; save after last character

                              ; set string pointer (AY) and exit
LAB_2A91
      LDA   #<Decssp1         ; set result string low pointer
      LDY   #>Decssp1         ; set result string high pointer
      RTS

; perform power function

LAB_POWER
      BEQ   LAB_EXP           ; go do  EXP()

      LDA   FAC2_e            ; get FAC2 exponent
      BNE   LAB_2ABF          ; branch if FAC2<>0

      JMP   LAB_24F3          ; clear FAC1 exponent and sign and return

LAB_2ABF
      LDX   #<func_l          ; set destination pointer low byte
      LDY   #>func_l          ; set destination pointer high byte
      JSR   LAB_2778          ; pack FAC1 into (XY)
      LDA   FAC2_s            ; get FAC2 sign (b7)
      BPL   LAB_2AD9          ; branch if FAC2>0

                              ; else FAC2 is -ve and can only be raised to an
                              ; integer power which gives an x +j0 result
      JSR   LAB_INT           ; perform INT
      LDA   #<func_l          ; set source pointer low byte
      LDY   #>func_l          ; set source pointer high byte
      JSR   LAB_27F8          ; compare FAC1 with (AY)
      BNE   LAB_2AD9          ; branch if FAC1 <> (AY) to allow Function Call error
                              ; this will leave FAC1 -ve and cause a Function Call
                              ; error when LOG() is called

      TYA                     ; clear sign b7
      LDY   Temp3             ; save mantissa 3 from INT() function as sign in Y
                              ; for possible later negation, b0
LAB_2AD9
      JSR   LAB_279D          ; save FAC1 sign and copy ABS(FAC2) to FAC1
      TYA                     ; copy sign back ..
      PHA                     ; .. and save it
      JSR   LAB_LOG           ; do LOG(n)
      LDA   #<garb_l          ; set pointer low byte
      LDY   #>garb_l          ; set pointer high byte
      JSR   LAB_25FB          ; do convert AY, FCA1*(AY) (square the value)
      JSR   LAB_EXP           ; go do EXP(n)
      PLA                     ; pull sign from stack
      LSR                     ; b0 is to be tested, shift to Cb
      BCC   LAB_2AF9          ; if no bit then exit

                              ; Perform negation
; do - FAC1

LAB_GTHAN
      LDA   FAC1_e            ; get FAC1 exponent
      BEQ   LAB_2AF9          ; exit if FAC1_e = $00

      LDA   FAC1_s            ; get FAC1 sign (b7)
      EOR   #$FF              ; complement it
      STA   FAC1_s            ; save FAC1 sign (b7)
LAB_2AF9
      RTS

; perform EXP()   (x^e)

LAB_EXP
      LDA   #<LAB_2AFA        ; set 1.443 pointer low byte
      LDY   #>LAB_2AFA        ; set 1.443 pointer high byte
      JSR   LAB_25FB          ; do convert AY, FCA1*(AY)
      LDA   FAC1_r            ; get FAC1 rounding byte
      ADC   #$50              ; +$50/$100
      BCC   LAB_2B2B          ; skip rounding if no carry

      JSR   LAB_27C2          ; round FAC1 (no check)
LAB_2B2B
      STA   FAC2_r            ; save FAC2 rounding byte
      JSR   LAB_27AE          ; copy FAC1 to FAC2
      LDA   FAC1_e            ; get FAC1 exponent
      CMP   #$88              ; compare with EXP limit (256d)
      BCC   LAB_2B39          ; branch if less

LAB_2B36
      JSR   LAB_2690          ; handle overflow and underflow
LAB_2B39
      JSR   LAB_INT           ; perform INT
      LDA   Temp3             ; get mantissa 3 from INT() function
      CLC                     ; clear carry for add
      ADC   #$81              ; normalise +1
      BEQ   LAB_2B36          ; if $00 go handle overflow

      SEC                     ; set carry for subtract
      SBC   #$01              ; now correct for exponent
      PHA                     ; save FAC2 exponent

                              ; swap FAC1 and FAC2
      LDX   #$04              ; 4 bytes to do
LAB_2B49
      LDA   FAC2_e,X          ; get FAC2,X
      LDY   FAC1_e,X          ; get FAC1,X
      STA   FAC1_e,X          ; save FAC1,X
      STY   FAC2_e,X          ; save FAC2,X
      DEX                     ; decrement count/index
      BPL   LAB_2B49          ; loop if not all done

      LDA   FAC2_r            ; get FAC2 rounding byte
      STA   FAC1_r            ; save as FAC1 rounding byte
      JSR   LAB_SUBTRACT      ; perform subtraction, FAC2 from FAC1
      JSR   LAB_GTHAN         ; do - FAC1
      LDA   #<LAB_2AFE        ; set counter pointer low byte
      LDY   #>LAB_2AFE        ; set counter pointer high byte
      JSR   LAB_2B84          ; go do series evaluation
      LDA   #$00              ; clear A
      STA   FAC_sc            ; clear sign compare (FAC1 EOR FAC2)
      PLA                     ;.get saved FAC2 exponent
      JMP   LAB_2675          ; test and adjust accumulators and return

; ^2 then series evaluation

LAB_2B6E
      STA   Cptrl             ; save count pointer low byte
      STY   Cptrh             ; save count pointer high byte
      JSR   LAB_276E          ; pack FAC1 into Adatal
      LDA   #<Adatal          ; set pointer low byte (Y already $00)
      JSR   LAB_25FB          ; do convert AY, FCA1*(AY)
      JSR   LAB_2B88          ; go do series evaluation
      LDA   #<Adatal          ; pointer to original # low byte
      LDY   #>Adatal          ; pointer to original # high byte
      JMP   LAB_25FB          ; do convert AY, FCA1*(AY) and return

; series evaluation

LAB_2B84
      STA   Cptrl             ; save count pointer low byte
      STY   Cptrh             ; save count pointer high byte
LAB_2B88
      LDX   #<numexp          ; set pointer low byte
      JSR   LAB_2770          ; set pointer high byte and pack FAC1 into numexp
      LDA   (Cptrl),Y         ; get constants count
      STA   numcon            ; save constants count
      LDY   Cptrl             ; get count pointer low byte
      INY                     ; increment it (now constants pointer)
      TYA                     ; copy it
      BNE   LAB_2B97          ; skip next if no overflow

      INC   Cptrh             ; else increment high byte
LAB_2B97
      STA   Cptrl             ; save low byte
      LDY   Cptrh             ; get high byte
LAB_2B9B
      JSR   LAB_25FB          ; do convert AY, FCA1*(AY)
      LDA   Cptrl             ; get constants pointer low byte
      LDY   Cptrh             ; get constants pointer high byte
      CLC                     ; clear carry for add
      ADC   #$04              ; +4 to  low pointer (4 bytes per constant)
      BCC   LAB_2BA8          ; skip next if no overflow

      INY                     ; increment high byte
LAB_2BA8
      STA   Cptrl             ; save pointer low byte
      STY   Cptrh             ; save pointer high byte
      JSR   LAB_246C          ; add (AY) to FAC1
      LDA   #<numexp          ; set pointer low byte to partial @ numexp
      LDY   #>numexp          ; set pointer high byte to partial @ numexp
      DEC   numcon            ; decrement constants count
      BNE   LAB_2B9B          ; loop until all done

      RTS

; RND(n), 32 bit Galoise version. make n=0 for 19th next number in sequence or n<>0
; to get 19th next number in sequence after seed n. This version of the PRNG uses
; the Galois method and a sample of 65536 bytes produced gives the following values.

; Entropy = 7.997442 bits per byte
; Optimum compression would reduce these 65536 bytes by 0 percent

; Chi square distribution for 65536 samples is 232.01, and
; randomly would exceed this value 75.00 percent of the time

; Arithmetic mean value of data bytes is 127.6724, 127.5 would be random
; Monte Carlo value for Pi is 3.122871269, error 0.60 percent
; Serial correlation coefficient is -0.000370, totally uncorrelated would be 0.0

LAB_RND
      LDA   FAC1_e            ; get FAC1 exponent
      BEQ   NextPRN           ; do next random # if zero

                              ; else get seed into random number store
      LDX   #Rbyte4           ; set PRNG pointer low byte
      LDY   #$00              ; set PRNG pointer high byte
      JSR   LAB_2778          ; pack FAC1 into (XY)
NextPRN
      LDX   #$AF              ; set EOR byte
      LDY   #$13              ; do this nineteen times
LoopPRN
      ASL   Rbyte1            ; shift PRNG most significant byte
      ROL   Rbyte2            ; shift PRNG middle byte
      ROL   Rbyte3            ; shift PRNG least significant byte
      ROL   Rbyte4            ; shift PRNG extra byte
      BCC   Ninc1             ; branch if bit 32 clear

      TXA                     ; set EOR byte
      EOR   Rbyte1            ; EOR PRNG extra byte
      STA   Rbyte1            ; save new PRNG extra byte
Ninc1
      DEY                     ; decrement loop count
      BNE   LoopPRN           ; loop if not all done

      LDX   #$02              ; three bytes to copy
CopyPRNG
      LDA   Rbyte1,X          ; get PRNG byte
      STA   FAC1_1,X          ; save FAC1 byte
      DEX
      BPL   CopyPRNG          ; loop if not complete

      LDA   #$80              ; set the exponent
      STA   FAC1_e            ; save FAC1 exponent

      ASL                     ; clear A
      STA   FAC1_s            ; save FAC1 sign

      JMP   LAB_24D5          ; normalise FAC1 and return

; perform COS()

LAB_COS
      LDA   #<LAB_2C78        ; set (pi/2) pointer low byte
      LDY   #>LAB_2C78        ; set (pi/2) pointer high byte
      JSR   LAB_246C          ; add (AY) to FAC1

; perform SIN()

LAB_SIN
      JSR   LAB_27AB          ; round and copy FAC1 to FAC2
      LDA   #<LAB_2C7C        ; set (2*pi) pointer low byte
      LDY   #>LAB_2C7C        ; set (2*pi) pointer high byte
      LDX   FAC2_s            ; get FAC2 sign (b7)
      JSR   LAB_26C2          ; divide by (AY) (X=sign)
      JSR   LAB_27AB          ; round and copy FAC1 to FAC2
      JSR   LAB_INT           ; perform INT
      LDA   #$00              ; clear byte
      STA   FAC_sc            ; clear sign compare (FAC1 EOR FAC2)
      JSR   LAB_SUBTRACT      ; perform subtraction, FAC2 from FAC1
      LDA   #<LAB_2C80        ; set 0.25 pointer low byte
      LDY   #>LAB_2C80        ; set 0.25 pointer high byte
      JSR   LAB_2455          ; perform subtraction, (AY) from FAC1
      LDA   FAC1_s            ; get FAC1 sign (b7)
      PHA                     ; save FAC1 sign
      BPL   LAB_2C35          ; branch if +ve

                              ; FAC1 sign was -ve
      JSR   LAB_244E          ; add 0.5 to FAC1
      LDA   FAC1_s            ; get FAC1 sign (b7)
      BMI   LAB_2C38          ; branch if -ve

      LDA   Cflag             ; get comparison evaluation flag
      EOR   #$FF              ; toggle flag
      STA   Cflag             ; save comparison evaluation flag
LAB_2C35
      JSR   LAB_GTHAN         ; do - FAC1
LAB_2C38
      LDA   #<LAB_2C80        ; set 0.25 pointer low byte
      LDY   #>LAB_2C80        ; set 0.25 pointer high byte
      JSR   LAB_246C          ; add (AY) to FAC1
      PLA                     ; restore FAC1 sign
      BPL   LAB_2C45          ; branch if was +ve

                              ; else correct FAC1
      JSR   LAB_GTHAN         ; do - FAC1
LAB_2C45
      LDA   #<LAB_2C84        ; set pointer low byte to counter
      LDY   #>LAB_2C84        ; set pointer high byte to counter
      JMP   LAB_2B6E          ; ^2 then series evaluation and return

; perform TAN()

LAB_TAN
      JSR   LAB_276E          ; pack FAC1 into Adatal
      LDA   #$00              ; clear byte
      STA   Cflag             ; clear comparison evaluation flag
      JSR   LAB_SIN           ; go do SIN(n)
      LDX   #<func_l          ; set sin(n) pointer low byte
      LDY   #>func_l          ; set sin(n) pointer high byte
      JSR   LAB_2778          ; pack FAC1 into (XY)
      LDA   #<Adatal          ; set n pointer low addr
      LDY   #>Adatal          ; set n pointer high addr
      JSR   LAB_UFAC          ; unpack memory (AY) into FAC1
      LDA   #$00              ; clear byte
      STA   FAC1_s            ; clear FAC1 sign (b7)
      LDA   Cflag             ; get comparison evaluation flag
      JSR   LAB_2C74          ; save flag and go do series evaluation

      LDA   #<func_l          ; set sin(n) pointer low byte
      LDY   #>func_l          ; set sin(n) pointer high byte
      JMP   LAB_26CA          ; convert AY and do (AY)/FAC1

LAB_2C74
      PHA                     ; save comparison evaluation flag
      JMP   LAB_2C35          ; go do series evaluation

; perform USR()

LAB_USR
      JSR   Usrjmp            ; call user code
      JMP   LAB_1BFB          ; scan for ")", else do syntax error then warm start

; perform ATN()

LAB_ATN
      LDA   FAC1_s            ; get FAC1 sign (b7)
      PHA                     ; save sign
      BPL   LAB_2CA1          ; branch if +ve

      JSR   LAB_GTHAN         ; else do - FAC1
LAB_2CA1
      LDA   FAC1_e            ; get FAC1 exponent
      PHA                     ; push exponent
      CMP   #$81              ; compare with 1
      BCC   LAB_2CAF          ; branch if FAC1<1

      LDA   #<LAB_259C        ; set 1 pointer low byte
      LDY   #>LAB_259C        ; set 1 pointer high byte
      JSR   LAB_26CA          ; convert AY and do (AY)/FAC1
LAB_2CAF
      LDA   #<LAB_2CC9        ; set pointer low byte to counter
      LDY   #>LAB_2CC9        ; set pointer high byte to counter
      JSR   LAB_2B6E          ; ^2 then series evaluation
      PLA                     ; restore old FAC1 exponent
      CMP   #$81              ; compare with 1
      BCC   LAB_2CC2          ; branch if FAC1<1

      LDA   #<LAB_2C78        ; set (pi/2) pointer low byte
      LDY   #>LAB_2C78        ; set (pi/2) pointer high byte
      JSR   LAB_2455          ; perform subtraction, (AY) from FAC1
LAB_2CC2
      PLA                     ; restore FAC1 sign
      BPL   LAB_2D04          ; exit if was +ve

      JMP   LAB_GTHAN         ; else do - FAC1 and return

; perform BITSET

LAB_BITSET
      JSR   LAB_GADB          ; get two parameters for POKE or WAIT
      CPX   #$08              ; only 0 to 7 are allowed
      BCS   FCError           ; branch if > 7

      LDA   #$00              ; clear A
      SEC                     ; set the carry
S_Bits
      ROL                     ; shift bit
      DEX                     ; decrement bit number
      BPL   S_Bits            ; loop if still +ve

      INX                     ; make X = $00
      ORA   (Itempl,X)        ; or with byte via temporary integer (addr)
      STA   (Itempl,X)        ; save byte via temporary integer (addr)
LAB_2D04
      RTS

; perform BITCLR

LAB_BITCLR
      JSR   LAB_GADB          ; get two parameters for POKE or WAIT
      CPX   #$08              ; only 0 to 7 are allowed
      BCS   FCError           ; branch if > 7

      LDA   #$FF              ; set A
S_Bitc
      ROL                     ; shift bit
      DEX                     ; decrement bit number
      BPL   S_Bitc            ; loop if still +ve

      INX                     ; make X = $00
      AND   (Itempl,X)        ; and with byte via temporary integer (addr)
      STA   (Itempl,X)        ; save byte via temporary integer (addr)
      RTS

FCError
      JMP   LAB_FCER          ; do function call error then warm start

; perform BITTST()

LAB_BTST
      JSR   LAB_IGBY          ; increment BASIC pointer
      JSR   LAB_GADB          ; get two parameters for POKE or WAIT
      CPX   #$08              ; only 0 to 7 are allowed
      BCS   FCError           ; branch if > 7

      JSR   LAB_GBYT          ; get next BASIC byte
      CMP   #')'              ; is next character ")"
      BEQ   TST_OK            ; if ")" go do rest of function

      JMP   LAB_SNER          ; do syntax error then warm start

TST_OK
      JSR   LAB_IGBY          ; update BASIC execute pointer (to character past ")")
      LDA   #$00              ; clear A
      SEC                     ; set the carry
T_Bits
      ROL                     ; shift bit
      DEX                     ; decrement bit number
      BPL   T_Bits            ; loop if still +ve

      INX                     ; make X = $00
      AND   (Itempl,X)        ; AND with byte via temporary integer (addr)
      BEQ   LAB_NOTT          ; branch if zero (already correct)

      LDA   #$FF              ; set for -1 result
LAB_NOTT
      JMP   LAB_27DB          ; go do SGN tail

; perform BIN$()

LAB_BINS
      CPX   #$19              ; max + 1
      BCS   BinFErr           ; exit if too big ( > or = )

      STX   TempB             ; save # of characters ($00 = leading zero remove)
      LDA   #$18              ; need A byte long space
      JSR   LAB_MSSP          ; make string space A bytes long
      LDY   #$17              ; set index
      LDX   #$18              ; character count
NextB1
      LSR   nums_1            ; shift highest byte
      ROR   nums_2            ; shift middle byte
      ROR   nums_3            ; shift lowest byte bit 0 to carry
      TXA                     ; load with "0"/2
      ROL                     ; shift in carry
      STA   (str_pl),Y        ; save to temp string + index
      DEY                     ; decrement index
      BPL   NextB1            ; loop if not done

      LDA   TempB             ; get # of characters
      BEQ   EndBHS            ; branch if truncate

      TAX                     ; copy length to X
      SEC                     ; set carry for add !
      EOR   #$FF              ; 1's complement
      ADC   #$18              ; add 24d
      BEQ   GoPr2             ; if zero print whole string

      BNE   GoPr1             ; else go make output string
      
; this is the exit code and is also used by HEX$()
; truncate string to remove leading "0"s

EndBHS
      TAY                     ; clear index (A=0, X=length here)
NextB2
      LDA   (str_pl),Y        ; get character from string
      CMP   #'0'              ; compare with "0"
      BNE   GoPr              ; if not "0" then go print string from here

      DEX                     ; decrement character count
      BEQ   GoPr3             ; if zero then end of string so go print it

      INY                     ; else increment index
      BPL   NextB2            ; loop always

; make fixed length output string - ignore overflows!

GoPr3
      INX                     ; need at least 1 character
GoPr
      TYA                     ; copy result
GoPr1
      CLC                     ; clear carry for add
      ADC   str_pl            ; add low address
      STA   str_pl            ; save low address
      LDA   #$00              ; do high byte
      ADC   str_ph            ; add high address
      STA   str_ph            ; save high address
GoPr2
      STX   str_ln            ; X holds string length
      JSR   LAB_IGBY          ; update BASIC execute pointer (to character past ")")
      JMP   LAB_RTST          ; check for space on descriptor stack then put address
                              ; and length on descriptor stack and update stack pointers

BinFErr
      JMP   LAB_FCER          ; do function call error then warm start

; perform HEX$()

LAB_HEXS
      CPX   #$07              ; max + 1
      BCS   BinFErr           ; exit if too big ( > or = )

      STX   TempB             ; save # of characters

      LDA   #$06              ; need 6 bytes for string
      JSR   LAB_MSSP          ; make string space A bytes long
      LDY   #$05              ; set string index

; *** disable decimal mode patch - comment next line ***
;      SED                     ; need decimal mode for nibble convert
      LDA   nums_3            ; get lowest byte
      JSR   LAB_A2HX          ; convert A to ASCII hex byte and output
      LDA   nums_2            ; get middle byte
      JSR   LAB_A2HX          ; convert A to ASCII hex byte and output
      LDA   nums_1            ; get highest byte
      JSR   LAB_A2HX          ; convert A to ASCII hex byte and output
; *** disable decimal mode patch - comment next line ***
;      CLD                     ; back to binary

      LDX   #$06              ; character count
      LDA   TempB             ; get # of characters
      BEQ   EndBHS            ; branch if truncate

      TAX                     ; copy length to X
      SEC                     ; set carry for add !
      EOR   #$FF              ; 1's complement
      ADC   #$06              ; add 6d
      BEQ   GoPr2             ; if zero print whole string

      BNE   GoPr1             ; else go make output string (branch always)

; convert A to ASCII hex byte and output .. note set decimal mode before calling

LAB_A2HX
      TAX                     ; save byte
      AND   #$0F              ; mask off top bits
      JSR   LAB_AL2X          ; convert low nibble to ASCII and output
      TXA                     ; get byte back
      LSR                     ; /2  shift high nibble to low nibble
      LSR                     ; /4
      LSR                     ; /8
      LSR                     ; /16
LAB_AL2X
      CMP   #$0A              ; set carry for +1 if >9
; *** begin disable decimal mode patch ***
; *** insert
      BCC   LAB_AL20          ; skip adjust if <= 9
      ADC   #$06              ; adjust for A to F
LAB_AL20
; *** end   disable decimal mode patch ***
      ADC   #'0'              ; add ASCII "0"
      STA   (str_pl),Y        ; save to temp string
      DEY                     ; decrement counter
      RTS

LAB_NLTO
      STA   FAC1_e            ; save FAC1 exponent
      LDA   #$00              ; clear sign compare
LAB_MLTE
      STA   FAC_sc            ; save sign compare (FAC1 EOR FAC2)
      TXA                     ; restore character
      JSR   LAB_2912          ; evaluate new ASCII digit

; gets here if the first character was "$" for hex
; get hex number

LAB_CHEX
      JSR   LAB_IGBY          ; increment and scan memory
      BCC   LAB_ISHN          ; branch if numeric character

      ORA   #$20              ; case convert, allow "A" to "F" and "a" to "f"
      SBC   #'a'              ; subtract "a" (carry set here)
      CMP   #$06              ; compare normalised with $06 (max+1)
      BCS   LAB_EXCH          ; exit if >"f" or <"0"

      ADC   #$0A              ; convert to nibble
LAB_ISHN
      AND   #$0F              ; convert to binary
      TAX                     ; save nibble
      LDA   FAC1_e            ; get FAC1 exponent
      BEQ   LAB_MLTE          ; skip multiply if zero

      ADC   #$04              ; add four to exponent (*16 - carry clear here)
      BCC   LAB_NLTO          ; if no overflow do evaluate digit

LAB_MLTO
      JMP   LAB_2564          ; do overflow error and warm start

LAB_NXCH
      TAX                     ; save bit
      LDA   FAC1_e            ; get FAC1 exponent
      BEQ   LAB_MLBT          ; skip multiply if zero

      INC   FAC1_e            ; increment FAC1 exponent (*2)
      BEQ   LAB_MLTO          ; do overflow error if = $00

      LDA   #$00              ; clear sign compare
LAB_MLBT
      STA   FAC_sc            ; save sign compare (FAC1 EOR FAC2)
      TXA                     ; restore bit
      JSR   LAB_2912          ; evaluate new ASCII digit

; gets here if the first character was  "%" for binary
; get binary number

LAB_CBIN
      JSR   LAB_IGBY          ; increment and scan memory
      EOR   #'0'              ; convert "0" to 0 etc.
      CMP   #$02              ; compare with max+1
      BCC   LAB_NXCH          ; branch exit if < 2

LAB_EXCH
      JMP   LAB_28F6          ; evaluate -ve flag and return

; ctrl-c check routine. includes limited "life" byte save for INGET routine
; now also the code that checks to see if an interrupt has occurred

CTRLC
      LDA   ccflag            ; get [CTRL-C] check flag
      BNE   LAB_FBA2          ; exit if inhibited

      JSR   V_INPT            ; scan input device
      BCC   LAB_FBA0          ; exit if buffer empty

      STA   ccbyte            ; save received byte
      LDX   #$20              ; "life" timer for bytes
      STX   ccnull            ; set countdown
      JMP   LAB_1636          ; return to BASIC

LAB_FBA0
      LDX   ccnull            ; get countdown byte
      BEQ   LAB_FBA2          ; exit if finished

      DEC   ccnull            ; else decrement countdown
LAB_FBA2
LAB_CRTS
      RTS


; get byte from input device, no waiting
; returns with carry set if byte in A

INGET
      JSR   V_INPT            ; call scan input device
      BCS   LAB_FB95          ; if byte go reset timer

      LDA   ccnull            ; get countdown
      BEQ   LAB_FB96          ; exit if empty

      LDA   ccbyte            ; get last received byte
      SEC                     ; flag we got a byte
LAB_FB95
      LDX   #$00              ; clear X
      STX   ccnull            ; clear timer because we got a byte
LAB_FB96
      RTS

; MAX() MIN() pre process

LAB_MMPP
      JSR   LAB_EVEZ          ; process expression
      JMP   LAB_CTNM          ; check if source is numeric, else do type mismatch

; perform MAX()

LAB_MAX
      JSR   LAB_PHFA          ; push FAC1, evaluate expression,
                              ; pull FAC2 and compare with FAC1
      BPL   LAB_MAX           ; branch if no swap to do

      LDA   FAC2_1            ; get FAC2 mantissa1
      ORA   #$80              ; set top bit (clear sign from compare)
      STA   FAC2_1            ; save FAC2 mantissa1
      JSR   LAB_279B          ; copy FAC2 to FAC1
      BEQ   LAB_MAX           ; go do next (branch always)

; perform MIN()

LAB_MIN
      JSR   LAB_PHFA          ; push FAC1, evaluate expression,
                              ; pull FAC2 and compare with FAC1
      BMI   LAB_MIN           ; branch if no swap to do

      BEQ   LAB_MIN           ; branch if no swap to do

      LDA   FAC2_1            ; get FAC2 mantissa1
      ORA   #$80              ; set top bit (clear sign from compare)
      STA   FAC2_1            ; save FAC2 mantissa1
      JSR   LAB_279B          ; copy FAC2 to FAC1
      BEQ   LAB_MIN           ; go do next (branch always)

; exit routine. don't bother returning to the loop code
; check for correct exit, else so syntax error

LAB_MMEC
      CMP   #')'              ; is it end of function?
      BNE   LAB_MMSE          ; if not do MAX MIN syntax error

      PLA                     ; dump return address low byte
      PLA                     ; dump return address high byte
      JMP   LAB_IGBY          ; update BASIC execute pointer (to chr past ")")

LAB_MMSE
      JMP   LAB_SNER          ; do syntax error then warm start

; check for next, evaluate and return or exit
; this is the routine that does most of the work

LAB_PHFA
      JSR   LAB_GBYT          ; get next BASIC byte
      CMP   #','              ; is there more ?
      BNE   LAB_MMEC          ; if not go do end check

                              ; push FAC1
      JSR   LAB_27BA          ; round FAC1
      LDA   FAC1_s            ; get FAC1 sign
      ORA   #$7F              ; set all non sign bits
      AND   FAC1_1            ; AND FAC1 mantissa1 (AND in sign bit)
      PHA                     ; push on stack
      LDA   FAC1_2            ; get FAC1 mantissa2
      PHA                     ; push on stack
      LDA   FAC1_3            ; get FAC1 mantissa3
      PHA                     ; push on stack
      LDA   FAC1_e            ; get FAC1 exponent
      PHA                     ; push on stack

      JSR   LAB_IGBY          ; scan and get next BASIC byte (after ",")
      JSR   LAB_EVNM          ; evaluate expression and check is numeric,
                              ; else do type mismatch

                              ; pop FAC2 (MAX/MIN expression so far)
      PLA                     ; pop exponent
      STA   FAC2_e            ; save FAC2 exponent
      PLA                     ; pop mantissa3
      STA   FAC2_3            ; save FAC2 mantissa3
      PLA                     ; pop mantissa1
      STA   FAC2_2            ; save FAC2 mantissa2
      PLA                     ; pop sign/mantissa1
      STA   FAC2_1            ; save FAC2 sign/mantissa1
      STA   FAC2_s            ; save FAC2 sign

                              ; compare FAC1 with (packed) FAC2
      LDA   #<FAC2_e          ; set pointer low byte to FAC2
      LDY   #>FAC2_e          ; set pointer high byte to FAC2
      JMP   LAB_27F8          ; compare FAC1 with FAC2 (AY) and return
                              ; returns A=$00 if FAC1 = (AY)
                              ; returns A=$01 if FAC1 > (AY)
                              ; returns A=$FF if FAC1 < (AY)

; perform WIDTH

LAB_WDTH
      CMP   #','              ; is next byte ","
      BEQ   LAB_TBSZ          ; if so do tab size

      JSR   LAB_GTBY          ; get byte parameter
      TXA                     ; copy width to A
      BEQ   LAB_NSTT          ; branch if set for infinite line

      CPX   #$10              ; else make min width = 16d
      BCC   TabErr            ; if less do function call error and exit

; this next compare ensures that we can't exit WIDTH via an error leaving the
; tab size greater than the line length.

      CPX   TabSiz            ; compare with tab size
      BCS   LAB_NSTT          ; branch if >= tab size

      STX   TabSiz            ; else make tab size = terminal width
LAB_NSTT
      STX   TWidth            ; set the terminal width
      JSR   LAB_GBYT          ; get BASIC byte back
      BEQ   WExit             ; exit if no following

      CMP   #','              ; else is it ","
      BNE   LAB_MMSE          ; if not do syntax error

LAB_TBSZ
      JSR   LAB_SGBY          ; scan and get byte parameter
      TXA                     ; copy TAB size
      BMI   TabErr            ; if >127 do function call error and exit

      CPX   #$01              ; compare with min-1
      BCC   TabErr            ; if <=1 do function call error and exit

      LDA   TWidth            ; set flags for width
      BEQ   LAB_SVTB          ; skip check if infinite line

      CPX   TWidth            ; compare TAB with width
      BEQ   LAB_SVTB          ; ok if =

      BCS   TabErr            ; branch if too big

LAB_SVTB
      STX   TabSiz            ; save TAB size

; calculate tab column limit from TAB size. The Iclim is set to the last tab
; position on a line that still has at least one whole tab width between it
; and the end of the line.

WExit
      LDA   TWidth            ; get width
      BEQ   LAB_SULP          ; branch if infinite line

      CMP   TabSiz            ; compare with tab size
      BCS   LAB_WDLP          ; branch if >= tab size

      STA   TabSiz            ; else make tab size = terminal width
LAB_SULP
      SEC                     ; set carry for subtract
LAB_WDLP
      SBC   TabSiz            ; subtract tab size
      BCS   LAB_WDLP          ; loop while no borrow

      ADC   TabSiz            ; add tab size back
      CLC                     ; clear carry for add
      ADC   TabSiz            ; add tab size back again
      STA   Iclim             ; save for now
      LDA   TWidth            ; get width back
      SEC                     ; set carry for subtract
      SBC   Iclim             ; subtract remainder
      STA   Iclim             ; save tab column limit
LAB_NOSQ
      RTS

TabErr
      JMP   LAB_FCER          ; do function call error then warm start

; perform SQR()

LAB_SQR
      LDA   FAC1_s            ; get FAC1 sign
      BMI   TabErr            ; if -ve do function call error

      LDA   FAC1_e            ; get exponent
      BEQ   LAB_NOSQ          ; if zero just return

                              ; else do root
      JSR   LAB_27AB          ; round and copy FAC1 to FAC2
      LDA   #$00              ; clear A

      STA   FACt_3            ; clear remainder
      STA   FACt_2            ; ..
      STA   FACt_1            ; ..
      STA   TempB             ; ..

      STA   FAC1_3            ; clear root
      STA   FAC1_2            ; ..
      STA   FAC1_1            ; ..

      LDX   #$18              ; 24 pairs of bits to do
      LDA   FAC2_e            ; get exponent
      LSR                     ; check odd/even
      BCS   LAB_SQE2          ; if odd only 1 shift first time

LAB_SQE1
      ASL   FAC2_3            ; shift highest bit of number ..
      ROL   FAC2_2            ; ..
      ROL   FAC2_1            ; ..
      ROL   FACt_3            ; .. into remainder
      ROL   FACt_2            ; ..
      ROL   FACt_1            ; ..
      ROL   TempB             ; .. never overflows
LAB_SQE2
      ASL   FAC2_3            ; shift highest bit of number ..
      ROL   FAC2_2            ; ..
      ROL   FAC2_1            ; ..
      ROL   FACt_3            ; .. into remainder
      ROL   FACt_2            ; ..
      ROL   FACt_1            ; ..
      ROL   TempB             ; .. never overflows

      ASL   FAC1_3            ; root = root * 2
      ROL   FAC1_2            ; ..
      ROL   FAC1_1            ; .. never overflows

      LDA   FAC1_3            ; get root low byte
      ROL                     ; *2
      STA   Temp3             ; save partial low byte
      LDA   FAC1_2            ; get root low mid byte
      ROL                     ; *2
      STA   Temp3+1           ; save partial low mid byte
      LDA   FAC1_1            ; get root high mid byte
      ROL                     ; *2
      STA   Temp3+2           ; save partial high mid byte
      LDA   #$00              ; get root high byte (always $00)
      ROL                     ; *2
      STA   Temp3+3           ; save partial high byte

                              ; carry clear for subtract +1
      LDA   FACt_3            ; get remainder low byte
      SBC   Temp3             ; subtract partial low byte
      STA   Temp3             ; save partial low byte

      LDA   FACt_2            ; get remainder low mid byte
      SBC   Temp3+1           ; subtract partial low mid byte
      STA   Temp3+1           ; save partial low mid byte

      LDA   FACt_1            ; get remainder high mid byte
      SBC   Temp3+2           ; subtract partial high mid byte
      TAY                     ; copy partial high mid byte

      LDA   TempB             ; get remainder high byte
      SBC   Temp3+3           ; subtract partial high byte
      BCC   LAB_SQNS          ; skip sub if remainder smaller

      STA   TempB             ; save remainder high byte

      STY   FACt_1            ; save remainder high mid byte

      LDA   Temp3+1           ; get remainder low mid byte
      STA   FACt_2            ; save remainder low mid byte

      LDA   Temp3             ; get partial low byte
      STA   FACt_3            ; save remainder low byte

      INC   FAC1_3            ; increment root low byte (never any rollover)
LAB_SQNS
      DEX                     ; decrement bit pair count
      BNE   LAB_SQE1          ; loop if not all done

      SEC                     ; set carry for subtract
      LDA   FAC2_e            ; get exponent
      SBC   #$80              ; normalise
      ROR                     ; /2 and re-bias to $80
      ADC   #$00              ; add bit zero back in (allow for half shift)
      STA   FAC1_e            ; save it
      JMP   LAB_24D5          ; normalise FAC1 and return

; perform VARPTR()

LAB_VARPTR
      JSR   LAB_IGBY          ; increment and scan memory
      JSR   LAB_GVAR          ; get var address
      JSR   LAB_1BFB          ; scan for ")" , else do syntax error then warm start
      LDY   Cvaral            ; get var address low byte
      LDA   Cvarah            ; get var address high byte
      JMP   LAB_AYFC          ; save and convert integer AY to FAC1 and return

; perform PI

LAB_PI
      LDA   #<LAB_2C7C        ; set (2*pi) pointer low byte
      LDY   #>LAB_2C7C        ; set (2*pi) pointer high byte
      JSR   LAB_UFAC          ; unpack memory (AY) into FAC1
      DEC   FAC1_e            ; make result = PI
      RTS

; perform TWOPI

LAB_TWOPI
      LDA   #<LAB_2C7C        ; set (2*pi) pointer low byte
      LDY   #>LAB_2C7C        ; set (2*pi) pointer high byte
      JMP   LAB_UFAC          ; unpack memory (AY) into FAC1 and return

; system dependant i/o vectors
; these are in RAM and are set by the monitor at start-up

V_INPT
      JMP   (VEC_IN)          ; non halting scan input device
V_OUTP
      JMP   (VEC_OUT)         ; send byte to output device
V_LOAD
      JMP   (VEC_LD)          ; load BASIC program
V_SAVE
      JMP   (VEC_SV)          ; save BASIC program

; The rest are tables messages and code for RAM

; the rest of the code is tables and BASIC start-up code

PG2_TABS
	.BYTE	$00			; ctrl-c flag		-	$00 = enabled
	.BYTE	$00			; ctrl-c byte		-	GET needs this
	.BYTE	$00			; ctrl-c byte timeout	-	GET needs this
	.WORD	CTRLC			; ctrl c check vector
	.WORD	ACIAin		; byte in from simulated ACIA
	.WORD	ACIAout		; byte out to simulated ACIA
	.WORD	no_load		; null load vector for EhBASIC
	.WORD	no_save		; null save vector for EhBASIC
PG2_TABE

; character get subroutine for zero page

; For a 1.8432MHz 6502 including the JSR and RTS
; fastest (>=":") =  29 cycles =  15.7uS
; slowest (<":")  =  40 cycles =  21.7uS
; space skip      = +21 cycles = +11.4uS
; inc across page =  +4 cycles =  +2.2uS

; the target address for the LDA at LAB_2CF4 becomes the BASIC execute pointer once the
; block is copied to it's destination, any non zero page address will do at assembly
; time, to assemble a three byte instruction.

; page 0 initialisation table from $BC
; increment and scan memory

LAB_2CEE
      INC   Bpntrl            ; increment BASIC execute pointer low byte
      BNE   LAB_2CF4          ; branch if no carry
                              ; else
      INC   Bpntrh            ; increment BASIC execute pointer high byte

; page 0 initialisation table from $C2
; scan memory

LAB_2CF4
      LDA   $FFFF             ; get byte to scan (addr set by call routine)
      CMP   #TK_ELSE          ; compare with the token for ELSE
      BEQ   LAB_2D05          ; exit if ELSE, not numeric, carry set

      CMP   #':'              ; compare with ":"
      BCS   LAB_2D05          ; exit if >= ":", not numeric, carry set

      CMP   #' '              ; compare with " "
      BEQ   LAB_2CEE          ; if " " go do next

      SEC                     ; set carry for SBC
      SBC   #'0'              ; subtract "0"
      SEC                     ; set carry for SBC
      SBC   #$D0              ; subtract -"0"
                              ; clear carry if byte = "0"-"9"
LAB_2D05
      RTS

; page zero initialisation table $00-$12 inclusive

StrTab
      .db $4C               ; JMP opcode
      .word LAB_COLD          ; initial warm start vector (cold start)

      .db $00               ; these bytes are not used by BASIC
      .word $0000             ; 
      .word $0000             ; 
      .word $0000             ; 

      .db $4C               ; JMP opcode
      .word LAB_FCER          ; initial user function vector ("Function call" error)
      .db $00               ; default NULL count
      .db $00               ; clear terminal position
      .db $00               ; default terminal width byte
      .db $F2               ; default limit for TAB = 14
      .word Ram_base          ; start of user RAM
EndTab

LAB_MSZM
	.BYTE	$0D,$0A
	.TEXT	"Memory size "
	.BYTE	$00

LAB_SMSG
	.TEXT	" Bytes free"
	.BYTE 	$0D,$0A,$0A
	.TEXT	"Enhanced BASIC 2.22p5 for KIM Simulator"
	.BYTE 	$0A,$00

; numeric constants and series

					; constants and series for LOG(n)
LAB_25A0
	.BYTE	$02			; counter
	.BYTE	$80,$19,$56,$62	; 0.59898
	.BYTE	$80,$76,$22,$F3	; 0.96147
;##	.BYTE	$80,$76,$22,$F1	; 0.96147
	.BYTE	$82,$38,$AA,$40	; 2.88539
;##	.BYTE	$82,$38,$AA,$45	; 2.88539

LAB_25AD
	.BYTE	$80,$35,$04,$F3	; 0.70711	1/root 2
LAB_25B1
	.BYTE	$81,$35,$04,$F3	; 1.41421	root 2
LAB_25B5
	.BYTE	$80,$80,$00,$00	; -0.5
LAB_25B9
	.BYTE	$80,$31,$72,$18	; 0.69315	LOG(2)

					; numeric PRINT constants
LAB_2947
	.BYTE	$91,$43,$4F,$F8	; 99999.9375 (max value with at least one decimal)
LAB_294B
	.BYTE	$94,$74,$23,$F7	; 999999.4375 (max value before scientific notation)
LAB_294F
	.BYTE	$94,$74,$24,$00	; 1000000

					; EXP(n) constants and series
LAB_2AFA
	.BYTE	$81,$38,$AA,$3B	; 1.4427	(1/LOG base 2 e)
LAB_2AFE
	.BYTE	$06			; counter
	.BYTE	$74,$63,$90,$8C	; 2.17023e-4
	.BYTE	$77,$23,$0C,$AB	; 0.00124
	.BYTE	$7A,$1E,$94,$00	; 0.00968
	.BYTE	$7C,$63,$42,$80	; 0.05548
	.BYTE	$7E,$75,$FE,$D0	; 0.24023
	.BYTE	$80,$31,$72,$15	; 0.69315
	.BYTE	$81,$00,$00,$00	; 1.00000

;##	.BYTE	$07			; counter
;##	.BYTE	$74,$94,$2E,$40	; -1/7! (-1/5040)
;##	.BYTE	$77,$2E,$4F,$70	;  1/6! ( 1/720)
;##	.BYTE	$7A,$88,$02,$6E	; -1/5! (-1/120)
;##	.BYTE	$7C,$2A,$A0,$E6	;  1/4! ( 1/24)
;##	.BYTE	$7E,$AA,$AA,$50	; -1/3! (-1/6)
;##	.BYTE	$7F,$7F,$FF,$FF	;  1/2! ( 1/2)
;##	.BYTE	$81,$80,$00,$00	; -1/1! (-1/1)
;##	.BYTE	$81,$00,$00,$00	;  1/0! ( 1/1)

					; trigonometric constants and series
LAB_2C78
	.BYTE	$81,$49,$0F,$DB	; 1.570796371 (pi/2) as floating #
LAB_2C84
	.BYTE	$04			; counter
	.BYTE	$86,$1E,$D7,$FB	; 39.7109
;##	.BYTE	$86,$1E,$D7,$BA	; 39.7109
	.BYTE	$87,$99,$26,$65	;-76.575
;##	.BYTE	$87,$99,$26,$64	;-76.575
	.BYTE	$87,$23,$34,$58	; 81.6022
	.BYTE	$86,$A5,$5D,$E1	;-41.3417
;##	.BYTE	$86,$A5,$5D,$E0	;-41.3417
LAB_2C7C
	.BYTE	$83,$49,$0F,$DB	; 6.28319 (2*pi) as floating #
;##	.BYTE	$83,$49,$0F,$DA	; 6.28319 (2*pi) as floating #

LAB_2CC9
	.BYTE	$08			; counter
	.BYTE	$78,$3A,$C5,$37	; 0.00285
	.BYTE	$7B,$83,$A2,$5C	;-0.0160686
	.BYTE	$7C,$2E,$DD,$4D	; 0.0426915
	.BYTE	$7D,$99,$B0,$1E	;-0.0750429
	.BYTE	$7D,$59,$ED,$24	; 0.106409
	.BYTE	$7E,$91,$72,$00	;-0.142036
	.BYTE	$7E,$4C,$B9,$73	; 0.199926
	.BYTE	$7F,$AA,$AA,$53	;-0.333331

;##	.BYTE	$08			; counter
;##	.BYTE	$78,$3B,$D7,$4A	; 1/17
;##	.BYTE	$7B,$84,$6E,$02	;-1/15
;##	.BYTE	$7C,$2F,$C1,$FE	; 1/13
;##	.BYTE	$7D,$9A,$31,$74	;-1/11
;##	.BYTE	$7D,$5A,$3D,$84	; 1/9
;##	.BYTE	$7E,$91,$7F,$C8	;-1/7
;##	.BYTE	$7E,$4C,$BB,$E4	; 1/5
;##	.BYTE	$7F,$AA,$AA,$6C	;-1/3

LAB_1D96	.EQU *+1			; $00,$00 used for undefined variables
LAB_259C
	.BYTE	$81,$00,$00,$00	; 1.000000, used for INC
LAB_2AFD
	.BYTE	$81,$80,$00,$00	; -1.00000, used for DEC. must be on the same page as +1.00

					; misc constants
LAB_1DF7
	.BYTE	$90			;-32768 (uses first three bytes from 0.5)
LAB_2A96
	.BYTE	$80,$00,$00,$00	; 0.5
LAB_2C80
	.BYTE	$7F,$00,$00,$00	; 0.25
LAB_26B5
	.BYTE	$84,$20,$00,$00	; 10.0000 divide by 10 constant

; This table is used in converting numbers to ASCII.

LAB_2A9A
LAB_2A9B .EQU LAB_2A9A+1
LAB_2A9C .EQU LAB_2A9B+1
	.BYTE	$FE,$79,$60		; -100000
	.BYTE	$00,$27,$10		; 10000
	.BYTE	$FF,$FC,$18		; -1000
	.BYTE	$00,$00,$64		; 100
	.BYTE	$FF,$FF,$F6		; -10
	.BYTE	$00,$00,$01		; 1

LAB_CTBL
	.WORD	LAB_END-1		; END
	.WORD	LAB_FOR-1		; FOR
	.WORD	LAB_NEXT-1		; NEXT
	.WORD	LAB_DATA-1		; DATA
	.WORD	LAB_INPUT-1		; INPUT
	.WORD	LAB_DIM-1		; DIM
	.WORD	LAB_READ-1		; READ
	.WORD	LAB_LET-1		; LET
	.WORD	LAB_DEC-1		; DEC			new command
	.WORD	LAB_GOTO-1		; GOTO
	.WORD	LAB_RUN-1		; RUN
	.WORD	LAB_IF-1		; IF
	.WORD	LAB_RESTORE-1	; RESTORE		modified command
	.WORD	LAB_GOSUB-1		; GOSUB
	.WORD	LAB_RETURN-1	; RETURN
	.WORD	LAB_REM-1		; REM
	.WORD	LAB_STOP-1		; STOP
	.WORD	LAB_ON-1		; ON			modified command
	.WORD	LAB_NULL-1		; NULL		modified command
	.WORD	LAB_INC-1		; INC			new command
	.WORD	LAB_WAIT-1		; WAIT
	.WORD	V_LOAD-1		; LOAD
	.WORD	V_SAVE-1		; SAVE
	.WORD	LAB_DEF-1		; DEF
	.WORD	LAB_POKE-1		; POKE
	.WORD	LAB_DOKE-1		; DOKE		new command
	.WORD	LAB_CALL-1		; CALL		new command
	.WORD	LAB_DO-1		; DO			new command
	.WORD	LAB_LOOP-1		; LOOP		new command
	.WORD	LAB_PRINT-1		; PRINT
	.WORD	LAB_CONT-1		; CONT
	.WORD	LAB_LIST-1		; LIST
	.WORD	LAB_CLEAR-1		; CLEAR
	.WORD	LAB_NEW-1		; NEW
	.WORD	LAB_WDTH-1		; WIDTH		new command
	.WORD	LAB_GET-1		; GET			new command
	.WORD	LAB_SWAP-1		; SWAP		new command
	.WORD	LAB_BITSET-1	; BITSET		new command
	.WORD	LAB_BITCLR-1	; BITCLR		new command
	.WORD	LAB_BYE-1		; BYE			new command

; function pre process routine table

LAB_FTPL
LAB_FTPM	.EQU LAB_FTPL+$01
	.WORD	LAB_PPFN-1		; SGN(n)	process numeric expression in ()
	.WORD	LAB_PPFN-1		; INT(n)		"
	.WORD	LAB_PPFN-1		; ABS(n)		"
	.WORD	LAB_EVEZ-1		; USR(x)	process any expression
	.WORD	LAB_1BF7-1		; FRE(x)		"
	.WORD	LAB_1BF7-1		; POS(x)		"
	.WORD	LAB_PPFN-1		; SQR(n)	process numeric expression in ()
	.WORD	LAB_PPFN-1		; RND(n)		"
	.WORD	LAB_PPFN-1		; LOG(n)		"
	.WORD	LAB_PPFN-1		; EXP(n)		"
	.WORD	LAB_PPFN-1		; COS(n)		"
	.WORD	LAB_PPFN-1		; SIN(n)		"
	.WORD	LAB_PPFN-1		; TAN(n)		"
	.WORD	LAB_PPFN-1		; ATN(n)		"
	.WORD	LAB_PPFN-1		; PEEK(n)		"
	.WORD	LAB_PPFN-1		; DEEK(n)		"
	.WORD	$0000			; SADD()	none
	.WORD	LAB_PPFS-1		; LEN($)	process string expression in ()
	.WORD	LAB_PPFN-1		; STR$(n)	process numeric expression in ()
	.WORD	LAB_PPFS-1		; VAL($)	process string expression in ()
	.WORD	LAB_PPFS-1		; ASC($)		"
	.WORD	LAB_PPFS-1		; UCASE$($)		"
	.WORD	LAB_PPFS-1		; LCASE$($)		"
	.WORD	LAB_PPFN-1		; CHR$(n)	process numeric expression in ()
	.WORD	LAB_BHSS-1		; HEX$(n)		"
	.WORD	LAB_BHSS-1		; BIN$(n)		"
	.WORD	$0000			; BITTST()	none
	.WORD	LAB_MMPP-1		; MAX()	process numeric expression
	.WORD	LAB_MMPP-1		; MIN()		"
	.WORD	LAB_PPBI-1		; PI		advance pointer
	.WORD	LAB_PPBI-1		; TWOPI		"
	.WORD	$0000			; VARPTR()	none
	.WORD	LAB_LRMS-1		; LEFT$()	process string expression
	.WORD	LAB_LRMS-1		; RIGHT$()		"
	.WORD	LAB_LRMS-1		; MID$()		"

; action addresses for functions

LAB_FTBL
LAB_FTBM	.EQU LAB_FTBL+$01
	.WORD	LAB_SGN-1		; SGN()
	.WORD	LAB_INT-1		; INT()
	.WORD	LAB_ABS-1		; ABS()
	.WORD	LAB_USR-1		; USR()
	.WORD	LAB_FRE-1		; FRE()
	.WORD	LAB_POS-1		; POS()
	.WORD	LAB_SQR-1		; SQR()
	.WORD	LAB_RND-1		; RND()		modified function
	.WORD	LAB_LOG-1		; LOG()
	.WORD	LAB_EXP-1		; EXP()
	.WORD	LAB_COS-1		; COS()
	.WORD	LAB_SIN-1		; SIN()
	.WORD	LAB_TAN-1		; TAN()
	.WORD	LAB_ATN-1		; ATN()
	.WORD	LAB_PEEK-1		; PEEK()
	.WORD	LAB_DEEK-1		; DEEK()		new function
	.WORD	LAB_SADD-1		; SADD()		new function
	.WORD	LAB_LENS-1		; LEN()
	.WORD	LAB_STRS-1		; STR$()
	.WORD	LAB_VAL-1		; VAL()
	.WORD	LAB_ASC-1		; ASC()
	.WORD	LAB_UCASE-1		; UCASE$()		new function
	.WORD	LAB_LCASE-1		; LCASE$()		new function
	.WORD	LAB_CHRS-1		; CHR$()
	.WORD	LAB_HEXS-1		; HEX$()		new function
	.WORD	LAB_BINS-1		; BIN$()		new function
	.WORD	LAB_BTST-1		; BITTST()		new function
	.WORD	LAB_MAX-1		; MAX()		new function
	.WORD	LAB_MIN-1		; MIN()		new function
	.WORD	LAB_PI-1		; PI			new function
	.WORD	LAB_TWOPI-1		; TWOPI		new function
	.WORD	LAB_VARPTR-1	; VARPTR()		new function
	.WORD	LAB_LEFT-1		; LEFT$()
	.WORD	LAB_RIGHT-1		; RIGHT$()
	.WORD	LAB_MIDS-1		; MID$()

; hierarchy and action addresses for operator

LAB_OPPT
	.BYTE	$79			; +
	.WORD	LAB_ADD-1
	.BYTE	$79			; -
	.WORD	LAB_SUBTRACT-1
	.BYTE	$7B			; *
	.WORD	LAB_MULTIPLY-1
	.BYTE	$7B			; /
	.WORD	LAB_DIVIDE-1
	.BYTE	$7F			; ^
	.WORD	LAB_POWER-1
	.BYTE	$50			; AND
	.WORD	LAB_AND-1
	.BYTE	$46			; EOR			new operator
	.WORD	LAB_EOR-1
	.BYTE	$46			; OR
	.WORD	LAB_OR-1
	.BYTE	$56			; >>			new operator
	.WORD	LAB_RSHIFT-1
	.BYTE	$56			; <<			new operator
	.WORD	LAB_LSHIFT-1
	.BYTE	$7D			; >
	.WORD	LAB_GTHAN-1
	.BYTE	$5A			; =
	.WORD	LAB_EQUAL-1
	.BYTE	$64			; <
	.WORD	LAB_LTHAN-1

; keywords start with ..
; this is the first character table and must be in alphabetic order

TAB_1STC
	.BYTE	'*'
	.BYTE	'+'
	.BYTE	'-'
	.BYTE	'/'
	.BYTE	'<'
	.BYTE	'='
	.BYTE	'>'
	.BYTE	'?'
	.BYTE	'A'
	.BYTE	'B'
	.BYTE	'C'
	.BYTE	'D'
	.BYTE	'E'
	.BYTE	'F'
	.BYTE	'G'
	.BYTE	'H'
	.BYTE	'I'
	.BYTE	'L'
	.BYTE	'M'
	.BYTE	'N'
	.BYTE	'O'
	.BYTE	'P'
	.BYTE	'R'
	.BYTE	'S'
	.BYTE	'T'
	.BYTE	'U'
	.BYTE	'V'
	.BYTE	'W'
	.BYTE	'^'
	.BYTE	$00			; table terminator

; pointers to keyword tables

TAB_CHRT
	.WORD	TAB_STAR		; table for "*"
	.WORD	TAB_PLUS		; table for "+"
	.WORD	TAB_MNUS		; table for "-"
	.WORD	TAB_SLAS		; table for "/"
	.WORD	TAB_LESS		; table for "<"
	.WORD	TAB_EQUL		; table for "="
	.WORD	TAB_MORE		; table for ">"
	.WORD	TAB_QEST		; table for "?"
	.WORD	TAB_ASCA		; table for "A"
	.WORD	TAB_ASCB		; table for "B"
	.WORD	TAB_ASCC		; table for "C"
	.WORD	TAB_ASCD		; table for "D"
	.WORD	TAB_ASCE		; table for "E"
	.WORD	TAB_ASCF		; table for "F"
	.WORD	TAB_ASCG		; table for "G"
	.WORD	TAB_ASCH		; table for "H"
	.WORD	TAB_ASCI		; table for "I"
	.WORD	TAB_ASCL		; table for "L"
	.WORD	TAB_ASCM		; table for "M"
	.WORD	TAB_ASCN		; table for "N"
	.WORD	TAB_ASCO		; table for "O"
	.WORD	TAB_ASCP		; table for "P"
	.WORD	TAB_ASCR		; table for "R"
	.WORD	TAB_ASCS		; table for "S"
	.WORD	TAB_ASCT		; table for "T"
	.WORD	TAB_ASCU		; table for "U"
	.WORD	TAB_ASCV		; table for "V"
	.WORD	TAB_ASCW		; table for "W"
	.WORD	TAB_POWR		; table for "^"

; tables for each start character, note if a longer keyword with the same start
; letters as a shorter one exists then it must come first, else the list is in
; alphabetical order as follows ..

; [keyword,token
; [keyword,token]]
; end marker (#$00)

TAB_STAR
	.BYTE TK_MUL,$00		; *
TAB_PLUS
	.BYTE TK_PLUS,$00		; +
TAB_MNUS
	.BYTE TK_MINUS,$00	; -
TAB_SLAS
	.BYTE TK_DIV,$00		; /
TAB_LESS
LBB_LSHIFT
	.BYTE	'<',TK_LSHIFT	; <<	note - "<<" must come before "<"
	.BYTE TK_LT			; <
	.BYTE	$00
TAB_EQUL
	.BYTE TK_EQUAL,$00	; =
TAB_MORE
LBB_RSHIFT
	.BYTE	'>',TK_RSHIFT	; >>	note - ">>" must come before ">"
	.BYTE TK_GT			; >
	.BYTE	$00
TAB_QEST
	.BYTE TK_PRINT,$00	; ?
TAB_ASCA
LBB_ABS
	.TEXT	"BS("
	.BYTE	TK_ABS	; ABS(
LBB_AND
	.TEXT	"ND"
	.BYTE	TK_AND		; AND
LBB_ASC
	.TEXT	"SC("
	.BYTE	TK_ASC	; ASC(
LBB_ATN
	.TEXT	"TN("
	.BYTE	TK_ATN	; ATN(
	.BYTE	$00
TAB_ASCB
LBB_BINS
	.TEXT	"IN$("
	.BYTE	TK_BINS	; BIN$(
LBB_BITCLR
	.TEXT	"ITCLR"
	.BYTE	TK_BITCLR	; BITCLR
LBB_BITSET
	.TEXT	"ITSET"
	.BYTE	TK_BITSET	; BITSET
LBB_BITTST
	.TEXT	"ITTST("
	.BYTE	TK_BITTST	; BITTST(
LBB_BYE
	.TEXT	"YE"
	.BYTE	TK_BYE		; BYE
	.BYTE	$00
TAB_ASCC
LBB_CALL
	.TEXT	"ALL"
	.BYTE	TK_CALL	; CALL
LBB_CHRS
	.TEXT	"HR$("
	.BYTE	TK_CHRS	; CHR$(
LBB_CLEAR
	.TEXT	"LEAR"
	.BYTE	TK_CLEAR	; CLEAR
LBB_CONT
	.TEXT	"ONT"
	.BYTE	TK_CONT	; CONT
LBB_COS
	.TEXT	"OS("
	.BYTE	TK_COS	; COS(
	.BYTE	$00
TAB_ASCD
LBB_DATA
	.TEXT	"ATA"
	.BYTE	TK_DATA	; DATA
LBB_DEC
	.TEXT	"EC"
	.BYTE	TK_DEC		; DEC
LBB_DEEK
	.TEXT	"EEK("
	.BYTE	TK_DEEK	; DEEK(
LBB_DEF
	.TEXT	"EF"
	.BYTE	TK_DEF		; DEF
LBB_DIM
	.TEXT	"IM"
	.BYTE	TK_DIM		; DIM
LBB_DOKE
	.TEXT	"OKE"
	.BYTE	TK_DOKE	; DOKE note - "DOKE" must come before "DO"
LBB_DO
	.TEXT	"O"
	.BYTE	TK_DO		; DO
	.BYTE	$00
TAB_ASCE
LBB_ELSE
	.TEXT	"LSE"
	.BYTE	TK_ELSE	; ELSE
LBB_END
	.TEXT	"ND"
	.BYTE	TK_END		; END
LBB_EOR
	.TEXT	"OR"
	.BYTE	TK_EOR		; EOR
LBB_EXP
	.TEXT	"XP("
	.BYTE	TK_EXP	; EXP(
	.BYTE	$00
TAB_ASCF
LBB_FN
	.TEXT	"N"
	.BYTE	TK_FN		; FN
LBB_FOR
	.TEXT	"OR"
	.BYTE	TK_FOR		; FOR
LBB_FRE
	.TEXT	"RE("
	.BYTE	TK_FRE	; FRE(
	.BYTE	$00
TAB_ASCG
LBB_GET
	.TEXT	"ET"
	.BYTE	TK_GET		; GET
LBB_GOSUB
	.TEXT	"OSUB"
	.BYTE	TK_GOSUB	; GOSUB
LBB_GOTO
	.TEXT	"OTO"
	.BYTE	TK_GOTO	; GOTO
	.BYTE	$00
TAB_ASCH
LBB_HEXS
	.TEXT	"EX$("
	.BYTE	TK_HEXS	; HEX$(
	.BYTE	$00
TAB_ASCI
LBB_IF
	.TEXT	"F"
	.BYTE	TK_IF		; IF
LBB_INC
	.TEXT	"NC"
	.BYTE	TK_INC		; INC
LBB_INPUT
	.TEXT	"NPUT"
	.BYTE	TK_INPUT	; INPUT
LBB_INT
	.TEXT	"NT("
	.BYTE	TK_INT	; INT(
	.BYTE	$00
TAB_ASCL
LBB_LCASES
	.TEXT	"CASE$("
	.BYTE	TK_LCASES
					; LCASE$(
LBB_LEFTS
	.TEXT	"EFT$("
	.BYTE	TK_LEFTS	; LEFT$(
LBB_LEN
	.TEXT	"EN("
	.BYTE	TK_LEN	; LEN(
LBB_LET
	.TEXT	"ET"
	.BYTE	TK_LET		; LET
LBB_LIST
	.TEXT	"IST"
	.BYTE	TK_LIST	; LIST
LBB_LOAD
	.TEXT	"OAD"
	.BYTE	TK_LOAD	; LOAD
LBB_LOG
	.TEXT	"OG("
	.BYTE	TK_LOG	; LOG(
LBB_LOOP
	.TEXT	"OOP"
	.BYTE	TK_LOOP	; LOOP
	.BYTE	$00
TAB_ASCM
LBB_MAX
	.TEXT	"AX("
	.BYTE	TK_MAX	; MAX(
LBB_MIDS
	.TEXT	"ID$("
	.BYTE	TK_MIDS	; MID$(
LBB_MIN
	.TEXT	"IN("
	.BYTE	TK_MIN	; MIN(
	.BYTE	$00
TAB_ASCN
LBB_NEW
	.TEXT	"EW"
	.BYTE	TK_NEW		; NEW
LBB_NEXT
	.TEXT	"EXT"
	.BYTE	TK_NEXT	; NEXT
LBB_NOT
	.TEXT	"OT"
	.BYTE	TK_NOT		; NOT
LBB_NULL
	.TEXT	"ULL"
	.BYTE	TK_NULL	; NULL
	.BYTE	$00
TAB_ASCO
LBB_OFF
	.TEXT	"FF"
	.BYTE	TK_OFF		; OFF
LBB_ON
	.TEXT	"N"
	.BYTE	TK_ON		; ON
LBB_OR
	.TEXT	"R"
	.BYTE	TK_OR		; OR
	.BYTE	$00
TAB_ASCP
LBB_PEEK
	.TEXT	"EEK("
	.BYTE	TK_PEEK	; PEEK(
LBB_PI
	.TEXT	"I"
	.BYTE	TK_PI		; PI
LBB_POKE
	.TEXT	"OKE"
	.BYTE	TK_POKE	; POKE
LBB_POS
	.TEXT	"OS("
	.BYTE	TK_POS	; POS(
LBB_PRINT
	.TEXT	"RINT"
	.BYTE	TK_PRINT	; PRINT
	.BYTE	$00
TAB_ASCR
LBB_READ
	.TEXT	"EAD"
	.BYTE	TK_READ	; READ
LBB_REM
	.TEXT	"EM"
	.BYTE	TK_REM		; REM
LBB_RESTORE
	.TEXT	"ESTORE"
	.BYTE	TK_RESTORE
					; RESTORE
LBB_RETURN
	.TEXT	"ETURN"
	.BYTE	TK_RETURN	; RETURN
LBB_RIGHTS
	.TEXT	"IGHT$("
	.BYTE	TK_RIGHTS
					; RIGHT$(
LBB_RND
	.TEXT	"ND("
	.BYTE	TK_RND	; RND(
LBB_RUN
	.TEXT	"UN"
	.BYTE	TK_RUN		; RUN
	.BYTE	$00
TAB_ASCS
LBB_SADD
	.TEXT	"ADD("
	.BYTE	TK_SADD	; SADD(
LBB_SAVE
	.TEXT	"AVE"
	.BYTE	TK_SAVE	; SAVE
LBB_SGN
	.TEXT	"GN("
	.BYTE	TK_SGN	; SGN(
LBB_SIN
	.TEXT	"IN("
	.BYTE	TK_SIN	; SIN(
LBB_SPC
	.TEXT	"PC("
	.BYTE	TK_SPC	; SPC(
LBB_SQR
	.TEXT	"QR("
	.BYTE	TK_SQR	; SQR(
LBB_STEP
	.TEXT	"TEP"
	.BYTE	TK_STEP	; STEP
LBB_STOP
	.TEXT	"TOP"
	.BYTE	TK_STOP	; STOP
LBB_STRS
	.TEXT	"TR$("
	.BYTE	TK_STRS	; STR$(
LBB_SWAP
	.TEXT	"WAP"
	.BYTE	TK_SWAP	; SWAP
	.BYTE	$00
TAB_ASCT
LBB_TAB
	.TEXT	"AB("
	.BYTE	TK_TAB	; TAB(
LBB_TAN
	.TEXT	"AN("
	.BYTE	TK_TAN	; TAN(
LBB_THEN
	.TEXT	"HEN"
	.BYTE	TK_THEN	; THEN
LBB_TO
	.TEXT	"O"
	.BYTE	TK_TO		; TO
LBB_TWOPI
	.TEXT	"WOPI"
	.BYTE	TK_TWOPI	; TWOPI
	.BYTE	$00
TAB_ASCU
LBB_UCASES
	.TEXT	"CASE$("
	.BYTE	TK_UCASES
					; UCASE$(
LBB_UNTIL
	.TEXT	"NTIL"
	.BYTE	TK_UNTIL	; UNTIL
LBB_USR
	.TEXT	"SR("
	.BYTE	TK_USR	; USR(
	.BYTE	$00
TAB_ASCV
LBB_VAL
	.TEXT	"AL("
	.BYTE 	TK_VAL	; VAL(
LBB_VPTR
	.TEXT	"ARPTR("
	.BYTE	TK_VPTR	; VARPTR(
	.BYTE	$00
TAB_ASCW
LBB_WAIT
	.TEXT	"AIT"
	.BYTE	TK_WAIT	; WAIT
LBB_WHILE
	.TEXT	"HILE"
	.BYTE	TK_WHILE	; WHILE
LBB_WIDTH
	.TEXT	"IDTH"
	.BYTE	TK_WIDTH	; WIDTH
	.BYTE	$00
TAB_POWR
	.BYTE	TK_POWER,$00	; ^

; new decode table for LIST
; Table is ..
; byte - keyword length, keyword first character
; word - pointer to rest of keyword from dictionary

; note if length is 1 then the pointer is ignored

LAB_KEYT
	.BYTE	3,'E'
	.WORD	LBB_END		; END
	.BYTE	3,'F'
	.WORD	LBB_FOR		; FOR
	.BYTE	4,'N'
	.WORD	LBB_NEXT		; NEXT
	.BYTE	4,'D'
	.WORD	LBB_DATA		; DATA
	.BYTE	5,'I'
	.WORD	LBB_INPUT		; INPUT
	.BYTE	3,'D'
	.WORD	LBB_DIM		; DIM
	.BYTE	4,'R'
	.WORD	LBB_READ		; READ
	.BYTE	3,'L'
	.WORD	LBB_LET		; LET
	.BYTE	3,'D'
	.WORD	LBB_DEC		; DEC
	.BYTE	4,'G'
	.WORD	LBB_GOTO		; GOTO
	.BYTE	3,'R'
	.WORD	LBB_RUN		; RUN
	.BYTE	2,'I'
	.WORD	LBB_IF		; IF
	.BYTE	7,'R'
	.WORD	LBB_RESTORE		; RESTORE
	.BYTE	5,'G'
	.WORD	LBB_GOSUB		; GOSUB
	.BYTE	6,'R'
	.WORD	LBB_RETURN		; RETURN
	.BYTE	3,'R'
	.WORD	LBB_REM		; REM
	.BYTE	4,'S'
	.WORD	LBB_STOP		; STOP
	.BYTE	2,'O'
	.WORD	LBB_ON		; ON
	.BYTE	4,'N'
	.WORD	LBB_NULL		; NULL
	.BYTE	3,'I'
	.WORD	LBB_INC		; INC
	.BYTE	4,'W'
	.WORD	LBB_WAIT		; WAIT
	.BYTE	4,'L'
	.WORD	LBB_LOAD		; LOAD
	.BYTE	4,'S'
	.WORD	LBB_SAVE		; SAVE
	.BYTE	3,'D'
	.WORD	LBB_DEF		; DEF
	.BYTE	4,'P'
	.WORD	LBB_POKE		; POKE
	.BYTE	4,'D'
	.WORD	LBB_DOKE		; DOKE
	.BYTE	4,'C'
	.WORD	LBB_CALL		; CALL
	.BYTE	2,'D'
	.WORD	LBB_DO		; DO
	.BYTE	4,'L'
	.WORD	LBB_LOOP		; LOOP
	.BYTE	5,'P'
	.WORD	LBB_PRINT		; PRINT
	.BYTE	4,'C'
	.WORD	LBB_CONT		; CONT
	.BYTE	4,'L'
	.WORD	LBB_LIST		; LIST
	.BYTE	5,'C'
	.WORD	LBB_CLEAR		; CLEAR
	.BYTE	3,'N'
	.WORD	LBB_NEW		; NEW
	.BYTE	5,'W'
	.WORD	LBB_WIDTH		; WIDTH
	.BYTE	3,'G'
	.WORD	LBB_GET		; GET
	.BYTE	4,'S'
	.WORD	LBB_SWAP		; SWAP
	.BYTE	6,'B'
	.WORD	LBB_BITSET		; BITSET
	.BYTE	6,'B'
	.WORD	LBB_BITCLR		; BITCLR
	.BYTE 	3,'B'
	.WORD	LBB_BYE		; BYE

; secondary commands (can't start a statement)

	.BYTE	4,'T'
	.WORD	LBB_TAB		; TAB
	.BYTE	4,'E'
	.WORD	LBB_ELSE		; ELSE
	.BYTE	2,'T'
	.WORD	LBB_TO		; TO
	.BYTE	2,'F'
	.WORD	LBB_FN		; FN
	.BYTE	4,'S'
	.WORD	LBB_SPC		; SPC
	.BYTE	4,'T'
	.WORD	LBB_THEN		; THEN
	.BYTE	3,'N'
	.WORD	LBB_NOT		; NOT
	.BYTE	4,'S'
	.WORD	LBB_STEP		; STEP
	.BYTE	5,'U'
	.WORD	LBB_UNTIL		; UNTIL
	.BYTE	5,'W'
	.WORD	LBB_WHILE		; WHILE
	.BYTE	3,'O'
	.WORD	LBB_OFF		; OFF

; opperators

	.BYTE	1,'+'
	.WORD	$0000			; +
	.BYTE	1,'-'
	.WORD	$0000			; -
	.BYTE	1,'*'
	.WORD	$0000			; *
	.BYTE	1,'/'
	.WORD	$0000			; /
	.BYTE	1,'^'
	.WORD	$0000			; ^
	.BYTE	3,'A'
	.WORD	LBB_AND		; AND
	.BYTE	3,'E'
	.WORD	LBB_EOR		; EOR
	.BYTE	2,'O'
	.WORD	LBB_OR		; OR
	.BYTE	2,'>'
	.WORD	LBB_RSHIFT		; >>
	.BYTE	2,'<'
	.WORD	LBB_LSHIFT		; <<
	.BYTE	1,'>'
	.WORD	$0000			; >
	.BYTE	1,'='
	.WORD	$0000			; =
	.BYTE	1,'<'
	.WORD	$0000			; <

; functions

	.BYTE	4,'S'			;
	.WORD	LBB_SGN		; SGN
	.BYTE	4,'I'			;
	.WORD	LBB_INT		; INT
	.BYTE	4,'A'			;
	.WORD	LBB_ABS		; ABS
	.BYTE	4,'U'			;
	.WORD	LBB_USR		; USR
	.BYTE	4,'F'			;
	.WORD	LBB_FRE		; FRE
	.BYTE	4,'P'			;
	.WORD	LBB_POS		; POS
	.BYTE	4,'S'			;
	.WORD	LBB_SQR		; SQR
	.BYTE	4,'R'			;
	.WORD	LBB_RND		; RND
	.BYTE	4,'L'			;
	.WORD	LBB_LOG		; LOG
	.BYTE	4,'E'			;
	.WORD	LBB_EXP		; EXP
	.BYTE	4,'C'			;
	.WORD	LBB_COS		; COS
	.BYTE	4,'S'			;
	.WORD	LBB_SIN		; SIN
	.BYTE	4,'T'			;
	.WORD	LBB_TAN		; TAN
	.BYTE	4,'A'			;
	.WORD	LBB_ATN		; ATN
	.BYTE	5,'P'			;
	.WORD	LBB_PEEK		; PEEK
	.BYTE	5,'D'			;
	.WORD	LBB_DEEK		; DEEK
	.BYTE	5,'S'			;
	.WORD	LBB_SADD		; SADD
	.BYTE	4,'L'			;
	.WORD	LBB_LEN		; LEN
	.BYTE	5,'S'			;
	.WORD	LBB_STRS		; STR$
	.BYTE	4,'V'			;
	.WORD	LBB_VAL		; VAL
	.BYTE	4,'A'			;
	.WORD	LBB_ASC		; ASC
	.BYTE	7,'U'			;
	.WORD	LBB_UCASES		; UCASE$
	.BYTE	7,'L'			;
	.WORD	LBB_LCASES		; LCASE$
	.BYTE	5,'C'			;
	.WORD	LBB_CHRS		; CHR$
	.BYTE	5,'H'			;
	.WORD	LBB_HEXS		; HEX$
	.BYTE	5,'B'			;
	.WORD	LBB_BINS		; BIN$
	.BYTE	7,'B'			;
	.WORD	LBB_BITTST		; BITTST
	.BYTE	4,'M'			;
	.WORD	LBB_MAX		; MAX
	.BYTE	4,'M'			;
	.WORD	LBB_MIN		; MIN
	.BYTE	2,'P'			;
	.WORD	LBB_PI		; PI
	.BYTE	5,'T'			;
	.WORD	LBB_TWOPI		; TWOPI
	.BYTE	7,'V'			;
	.WORD	LBB_VPTR		; VARPTR
	.BYTE	6,'L'			;
	.WORD	LBB_LEFTS		; LEFT$
	.BYTE	7,'R'			;
	.WORD	LBB_RIGHTS		; RIGHT$
	.BYTE	5,'M'			;
	.WORD	LBB_MIDS		; MID$

; BASIC messages, mostly error messages

LAB_BAER
	.WORD	ERR_NF		;$00 NEXT without FOR
	.WORD	ERR_SN		;$02 syntax
	.WORD	ERR_RG		;$04 RETURN without GOSUB
	.WORD	ERR_OD		;$06 out of data
	.WORD	ERR_FC		;$08 function call
	.WORD	ERR_OV		;$0A overflow
	.WORD	ERR_OM		;$0C out of memory
	.WORD	ERR_US		;$0E undefined statement
	.WORD	ERR_BS		;$10 array bounds
	.WORD	ERR_DD		;$12 double dimension array
	.WORD	ERR_D0		;$14 divide by 0
	.WORD	ERR_ID		;$16 illegal direct
	.WORD	ERR_TM		;$18 type mismatch
	.WORD	ERR_LS		;$1A long string
	.WORD	ERR_ST		;$1C string too complex
	.WORD	ERR_CN		;$1E continue error
	.WORD	ERR_UF		;$20 undefined function
	.WORD 	ERR_LD		;$22 LOOP without DO

; I may implement these two errors to force definition of variables and
; dimensioning of arrays before use.

;	.WORD ERR_UV		;$24 undefined variable

; the above error has been tested and works (see code and comments below LAB_1D8B)

;	.WORD ERR_UA		;$26 undimensioned array

ERR_NF	.TEXT	"NEXT without FOR"
	.BYTE $00
ERR_SN	.TEXT	"Syntax"
	.BYTE $00
ERR_RG	.TEXT	"RETURN without GOSUB"
	.BYTE $00
ERR_OD	.TEXT	"Out of DATA"
	.BYTE$00
ERR_FC	.TEXT	"Function call"
	.BYTE $00
ERR_OV	.TEXT	"Overflow"
	.BYTE$00
ERR_OM	.TEXT	"Out of memory"
	.BYTE $00
ERR_US	.TEXT	"Undefined statement"
	.BYTE $00
ERR_BS	.TEXT	"Array bounds"
	.BYTE $00
ERR_DD	.TEXT	"Double dimension"
	.BYTE $00
ERR_D0	.TEXT	"Divide by zero"
	.BYTE $00
ERR_ID	.TEXT	"Illegal direct"
	.BYTE $00
ERR_TM	.TEXT	"Type mismatch"
	.BYTE $00
ERR_LS	.TEXT	"String too long"
	.BYTE $00
ERR_ST	.TEXT	"String too complex"
	.BYTE $00
ERR_CN	.TEXT	"Can't continue"
	.BYTE $00
ERR_UF	.TEXT	"Undefined function"
	.BYTE $00
ERR_LD	.TEXT	"LOOP without DO"
	.BYTE $00

;ERR_UV	.BYTE	"Undefined variable",$00

; the above error has been tested and works (see code and comments below LAB_1D8B)

;ERR_UA	.BYTE	"Undimensioned array",$00

LAB_BMSG	.BYTE	$0D,$0A
			.TEXT	"Break"
			.BYTE	$00
LAB_EMSG	.TEXT	" Error"
			.BYTE	$00
LAB_LMSG	.TEXT	" in line "
	.BYTE	$00
LAB_RMSG	.BYTE	$0D,$0A
			.TEXT	"Ready"
	.BYTE	$0D,$0A
	.BYTE	$00

LAB_IMSG	.TEXT	" Extra ignored"
	.BYTE	$0D,$0A
	.BYTE	$00
LAB_REDO	.TEXT	" Redo from start"
	.BYTE 	$0D,$0A
	.BYTE	$00

AA_end_basic

; reset vector points here

RES_vec
	CLD				; clear decimal mode
	LDX	#$FF		; empty stack
	TXS				; set the stack
	
; This fixes an apparent bug. 
; The cause looks to be calling the LAB_18C3 subroutine to print a string prior
; to Emem being initialized. I may be missing something since I have not
; see comments by others on this issue. If memory is cleared or the page zero
; space does not randomly point to some RAM,the first Cold reset does not print
; the "Memmory size" message properly it only prints a "  
; Setting Sstrol to page 0 space unused by enBasic fixes the
; problem in the simulator version. I set Ememl as well while I am at it.
; This problem only occurs on the very first Cold start from empty memory.
; All subsequent Cold start work because page Zero has been initiated already.


	LDA	#$00		; point to $0050 which is page 0 space unused by enBasic
	LDY	#$50		; this will get reset after the memory test 
	STA	Ememl		; set end of mem low byte
	STY	Ememh		; set end of mem high byte
	STA	Sstorl		; set bottom of string space low byte
	STY	Sstorh		; set bottom of string space high byte
	JSR	ACIAINIT	; initialize the ACIA for completeness

; set up vectors and interrupt code, copy them to page 2

	LDY	#END_CODE-LAB_vec	; set index/count
LAB_stlp
	LDA	LAB_vec-1,Y	; get byte from interrupt code
	STA	VEC_IN-1,Y	; save to RAM
	DEY				; decrement index/count
	BNE	LAB_stlp	; loop if more to do

; now do the signon message, Y = $00 here

	LDY	#$00
LAB_signon

	LDA	LAB_mess,Y	; get byte from sign on message
	BEQ	LAB_nokey	; exit loop if done
	JSR	V_OUTP		; output character
	INY				; increment index
	BNE	LAB_signon	; loop, branch always

LAB_nokey
	JSR	V_INPT		; call scan input device
	BCC	LAB_nokey	; loop if no key
	AND	#$DF		; mask xx0x xxxx, ensure upper case
	CMP	#'W'		; compare with [W]arm start
	BEQ	LAB_dowarm	; branch if [W]arm start
	CMP	#'C'		; compare with [C]old start
	BNE	RES_vec		; loop if not [C]old start
	JMP	LAB_COLD	; do EhBASIC cold start
LAB_dowarm
	JMP	LAB_WARM	; do EhBASIC warm start
	
LAB_mess
	.BYTE	$0D,$0A
	.TEXT	"6502 EhBASIC [C]old/[W]arm?"
	.BYTE	$00
;
; New BYE command - exit to KIM monitor - need to do a COLD start 
;
LAB_BYE
	JMP	$1C4F	; Not elegant, just a brute force jump to the monitor
;
; byte in/out to kim-1 simulator using simulated   
; 6850 ACIA functions at $1620
;
ACIAbase	.EQU	$1620
ACIAC		.EQU	ACIAbase	; ACIA Control register (write)
ACIAS		.EQU	ACIAbase	; ACIA Status register (read)
ACIAT		.EQU	ACIAS+1		; ACIA data register (write) to transmit a character
ACIAR		.EQU	ACIAS+1		; ACIA data register (read) to recieve a character

ACIAINIT
	LDA		#$03	; included for completeness
	STA		ACIAC	; reset the acia
	LDA		#$11
	STA 	ACIAC	; CR0 =1 divide by 16  CR4 = 1 8 bits 2 stop bits
	RTS

ACIAout
	PHA				; save character to be sent
WaitE
	LDA		ACIAC	; wait for transmitter to be empty
	AND		#$02	; check bit 1 TDR
	BEQ		WaitE	
	PLA				; recover character
	STA 	ACIAT	; send character
	RTS

ACIAin
	LDA	ACIAS		; get 6850 status register
	AND	#$01		; check recieve register full status
	BEQ	SKIP		; branch on no character
	LDA	ACIAR		; get the char in the recieve register
	SEC				; set carry to indicate a recieved character		
	RTS				; go back with carry set and charater in A
SKIP	
	CLC				; clear carry to indicate no character
no_load				; empty load vector for EhBASIC
no_save				; empty save vector for EhBASIC
	RTS				; return with carry clear and A corrupted

; vector tables

LAB_vec
	.WORD	ACIAin		; byte in from simulated ACIA
	.WORD	ACIAout		; byte out to simulated ACIA
	.WORD	no_load		; null load vector for EhBASIC
	.WORD	no_save		; null save vector for EhBASIC

END_CODE

	.END