; > Functions
; BASIC functions

; 30-Jan-2008: Program functions done: PAGE, TOP, LOMEM, END, HIMEM
;              ERL, ERR, COUNT, WIDTH, FALSE, TRUE, REPORT
; 10-Feb-2008: Done simple functions, ASC, LEN, CHR$, PI, NOT, SGN, ABS
; 30-Aug-2008: Added binary functions to dispatch table
;              OR, EOR, AND, +, -, *, /, DIV
;              NumberToString does hex and integer decimal
; 04-Sep-2008: STRING$, STR$, LEFT$, RIGHT$, VAL, EVAL, LineNum, USR, CALL
; 12-Sep-2008: NumberToString does octal and binary conversions.
;              MID$ works, made start on INSTR.


; Function address table
; ======================
; On entry to function subroutines,
; r5=>first non-space after command token
; r0=first non-space character after command token - (r5)
; r2=function token for unary operators
; r2/r3/r4=current value for binary operators
; Binary operators have sp=> retaddr, previous value r2,r3,r4
; Unary functions have sp=> retaddr
;
; On exit from function subroutines,
; r4=b0-b15 or string start
; r3=b16-b31 or string length
; r2=type and real exponent
;    b15=0 - numeric
;    0000 - integer
;    00xx - real, xx=exponent
;    b15=1 - string
;    8000 - normal string
;    8100 - $address, <cr>-terminated
;    8200 - $$address, <null>-terminated
;
; flags must be set from r2 on exit
;
.FunctionTable
EQUW fnAND-$		; &80 - AND
EQUW fnDIV-$		; &81 - DIV
EQUW fnEOR-$		; &82 - EOR
EQUW fnMOD-$		; &83 - MOD
EQUW fnOR-$		; &84 - OR
EQUW errNoSuchVar-$	; &28 - (
EQUW errNoSuchVar-$	; &29 - )
EQUW fnMultiply-$	; &2A - *
EQUW fnAdd-$		; &2B - +
EQUW errNoSuchVar-$	; &2C - ,
EQUW fnSubtract-$	; &2D - -
EQUW fnPower-$		; &5E - ^
EQUW fnDivide-$		; &2F - /
EQUW fnLineNum-$	; &8D - linenum
EQUW fnOPENIN-$		; &8E - OPENIN
EQUW fnPTR-$		; &8F - PTR
EQUW fnPAGE-$		; &90 - PAGE
EQUW fnTIME-$		; &91 - TIME      (Interface)
EQUW fnLOMEM-$		; &92 - LOMEM
EQUW fnHIMEM-$		; &93 - HIMEM
EQUW fnABS-$		; &94 - ABS
EQUW fnACS-$		; &95 - ACS
EQUW fnADVAL-$		; &96 - ADVAL     (Interface)
EQUW fnASC-$		; &97 - ASC
EQUW fnASN-$		; &98 - ASN
EQUW fnATN-$		; &99 - ATN
EQUW fnBGET-$		; &9A - BGET      (Interface)
EQUW fnCOS-$		; &9B - COS
EQUW fnCOUNT-$		; &9C - COUNT
EQUW fnDEG-$		; &9D - DEG
EQUW fnERL-$		; &9E - ERL
EQUW fnERR-$		; &9F - ERR
EQUW fnEVAL-$		; &A0 - EVAL
EQUW fnEXP-$		; &A1 - EXP
EQUW fnEXT-$		; &A2 - EXT       (Interface)
EQUW fnFALSE-$		; &A3 - FALSE
EQUW fnFN-$		; &A4 - FN        (Commands)
EQUW fnGET-$		; &A5 - GET       (Interface)
EQUW fnINKEY-$		; &A6 - INKEY     (Interface)
EQUW fnINSTR-$		; &A7 - INSTR(
EQUW fnINT-$		; &A8 - INT       (Evaluate)
EQUW fnLEN-$		; &A9 - LEN
EQUW fnLN-$		; &AA - LN
EQUW fnLOG-$		; &AB - LOG
EQUW fnNOT-$		; &AC - NOT
EQUW fnOPENUP-$		; &AD - OPENUP    (Interface)
EQUW fnOPENOUT-$	; &AE - OPENOUT   (Interface)
EQUW fnPI-$		; &AF - PI
EQUW fnPOINT-$		; &B0 - POINT(    (Interface)
EQUW fnPOS-$		; &B1 - POS       (Interface)
EQUW fnRAD-$		; &B2 - RAD
EQUW fnRND-$		; &B3 - RND
EQUW fnSGN-$		; &B4 - SGN
EQUW fnSIN-$		; &B5 - SIN
EQUW fnSQR-$		; &B6 - SQR
EQUW fnTAN-$		; &B7 - TAN
EQUW fnTO-$		; &B8 - TO
EQUW fnTRUE-$		; &B9 - TRUE
EQUW fnUSR-$		; &BA - USR
EQUW fnVAL-$		; &BB - VAL
EQUW fnVPOS-$		; &BC - VPOS      (Interface)
EQUW fnCHRs-$		; &BD - CHR$
EQUW fnGETs-$		; &BE - GET$      (Interface)
EQUW fnINKEYs-$		; &BF - INKEY$    (Interface)
EQUW fnLEFTs-$		; &C0 - LEFT$(
EQUW fnMIDs-$		; &C1 - MID$(
EQUW fnRIGHTs-$		; &C2 - RIGHT$(
EQUW fnSTRs-$		; &C3 - STR$(
EQUW fnSTRINGs-$	; &C4 - STRING$(
EQUW fnEOF-$		; &C5 - EOF       (Interface)
EQUW errNoSuchVar-$	; &C6 - AUTO
EQUW errNoSuchVar-$	; &C7 - DELETE
EQUW errNoSuchVar-$	; &C8 - LOAD
EQUW errNoSuchVar-$	; &C9 - LIST
EQUW errNoSuchVar-$	; &CA - NEW
EQUW errNoSuchVar-$	; &CB - OLD
EQUW errNoSuchVar-$	; &CC - RENUMBER
EQUW errNoSuchVar-$	; &CD - SAVE
EQUW errNoSuchVar-$	; &CE - PUT/EDIT
EQUW fnPTR-$		; &CF - PTR       (Interface)
EQUW fnPAGE-$		; &D0 - PAGE
EQUW fnTIME-$		; &D1 - TIME      (Interface)
EQUW fnLOMEM-$		; &D2 - LOMEM
EQUW fnHIMEM-$		; &D3 - HIMEM
EQUW errNoSuchVar-$	; &D4 - SOUND
EQUW errNoSuchVar-$	; &D5 - BPUT
EQUW errNoSuchVar-$	; &D6 - CALL
EQUW errNoSuchVar-$	; &D7 - CHAIN
EQUW errNoSuchVar-$	; &D8 - CLEAR
EQUW errNoSuchVar-$	; &D9 - CLOSE
EQUW errNoSuchVar-$	; &DA - CLG
EQUW errNoSuchVar-$	; &DB - CLS
EQUW errNoSuchVar-$	; &DC - DATA
EQUW errNoSuchVar-$	; &DD - DEF
EQUW fnDIM-$		; &DE - DIM
EQUW errNoSuchVar-$	; &DF - DRAW
EQUW fnEND-$		; &E0 - END
EQUW errNoSuchVar-$	; &E1 - ENDPROC
EQUW errNoSuchVar-$	; &E2 - ENVELOPE
EQUW errNoSuchVar-$	; &E3 - FOR
EQUW errNoSuchVar-$	; &E4 - GOSUB
EQUW errNoSuchVar-$	; &E5 - GOTO
EQUW errNoSuchVar-$	; &E6 - GCOL
EQUW errNoSuchVar-$	; &E7 - IF
EQUW errNoSuchVar-$	; &E8 - INPUT
EQUW errNoSuchVar-$	; &E9 - LET
EQUW errNoSuchVar-$	; &EA - LOCAL
EQUW fnMODE-$		; &EB - MODE      (Interface)
EQUW errNoSuchVar-$	; &EC - MOVE
EQUW errNoSuchVar-$	; &ED - NEXT
EQUW errNoSuchVar-$	; &EE - ON
EQUW fnVDU-$		; &EF - VDU       (Interface)
EQUW errNoSuchVar-$	; &F0 - PLOT
EQUW errNoSuchVar-$	; &F1 - PRINT
EQUW errNoSuchVar-$	; &F2 - PROC
EQUW errNoSuchVar-$	; &F3 - READ
EQUW errNoSuchVar-$	; &F4 - REM
EQUW errNoSuchVar-$	; &F5 - REPEAT
EQUW fnREPORT-$		; &F6 - REPORT
EQUW errNoSuchVar-$	; &F7 - RESTORE
EQUW errNoSuchVar-$	; &F8 - RETURN
EQUW errNoSuchVar-$	; &F9 - RUN
EQUW errNoSuchVar-$	; &FA - STOP
EQUW errNoSuchVar-$	; &FB - COLOUR
EQUW errNoSuchVar-$	; &FC - TRACE
EQUW errNoSuchVar-$	; &FD - UNTIL
EQUW fnWIDTH-$		; &FE - WIDTH
EQUW fnOSCLI-$		; &FF - OSCLI     (Interface)

.errNoSuchVar
jsr pc,Error
equb 26,"No such variable",0
align


; String functions
; ================
.fnREPORT
cmpb r0,#ASC"$"		; Check for '$'
beq fnREPORTs
jmp errNoSuchVar
.fnREPORTs
inc r5			; Step past '$'
mov SV_FAULT,r4
inc r4			; r4=>error string
mov r4,r3
.fnREPORTlp
tstb (r3)+		; Look for zero terminator
bne fnREPORTlp
sub r4,r3
dec r3			; r3=string length
mov #&8000,r2		; r2=type=string
rts pc

.fnCHRs
jsr pc,EvalIntVal
movb r4,SV_STRING	; Put char in string buffer
adr SV_STRING,r4	; Point to string
mov #1,r3		; Length=1
mov #&8000,r2		; Type=String
rts pc

.fnConversion
sec			; Preset 'conversion flag found'
mov r1,-(sp)		; Save current flag
bis #&8400,r1		; Set flag to hex
cmp r0,#ASC"~"
beq fnConvGo		; Convert to hex string
sub #&0100,r1		; Set flag to octal
cmp r0,#ASC"#"
beq fnConvGo		; Convert to oct string
sub #&0200,r1		; Set flag to binary
cmp r0,#ASC"/"
beq fnConvGo		; Convert to binary string
bic #&FF00,r1		; Set flag to decimal
dec r5			; Balance following inc
mov (sp),r1		; Get saved flag
clc			; Set 'no conversion flag'
.fnConvGo
tst (sp)+		; Drop saved flag
inc r5			; Step past conversion flag
rts pc

.fnSTRs
clr r1			; Set to decimal
jsr pc,fnConversion	; Check for ~/# character and set r1 to conversion flag
mov r1,-(sp)		; Save dec/hex flag
jsr pc,EvalNumVal
mov (sp)+,r1		; Get dec/hex flag back
			; Fall through into number conversion


; Convert a number to a string
; ----------------------------
; On entry: r1=hex/oct/bin flag in b15-b8
;           r2=exponent
;           r3,r4=integer/mantissa
; On exit:  r5 preserved
;           r4=>string
;           r3=length
;           r2='string' type, flags set
;           r1 preserved
;           r0 corrupted
.NumberToString
mov  r1,-(sp)		; Save field width/base flag and check b15
bpl  DecimalToString	; b15 clear, convert to decimal
jsr  pc,EnsureInteger	; If float, convert to integer

clr  -(sp)		; 4(sp)=leading zero flag
swab r1			; Get base to bottom byte
bic  #&FFF0,r1		; Reduce to 1,3,4
mov  r1,-(sp)		; 2(sp)=bits per digit
mov  #31,-(sp)		; (sp)=number of bits-1
mov  r1,r2		; r2=bits for this digit
adr  SV_STRING,r1	; Point to string buffer
bit  #2,r2
beq  NumToStrLp1	; Not octal, go ahead
dec  r2			; Only two bits in first octal digit
.NumToStrLp1
clr  r0			; Clear digit accumulator
.NumToStrLp2
rol  r4			; Rotate bits into r0
rol  r3
rol  r0
dec  (sp)		; Dec bit counter
dec  r2			; Dec bits for this digit
bne  NumToStrLp2
tst  r0
bne  NumToStrDigit	; Not zero, output digit
mov  4(sp),r0		; Check leading zero flag
beq  NumToStrNxt	; Nothing output yet
.NumToStrDigit
bis  #ASC"0",r0		; Convert to digit
cmp  r0,#ASC"9"+1
bcs  NumToStrOut
add  #7,r0		; Convert hex digit
.NumToStrOut
movb r0,(r1)+		; Put character in string buffer
mov  #ASC"0",4(sp)	; Output zeros from now on
.NumToStrNxt
mov  2(sp),r2		; Set number of bits for next digit
tst  (sp)		; All digits done yet?
bpl  NumToStrLp1	; Loop back for more
tst  (sp)+		; Pop bit count
tst  (sp)+		; Pop bits per digit
tst  (sp)+		; Still no leading zeros?
bne  NumToStrDone
movb #ASC"0",(r1)+	; Output '0' for &0
.NumToStrDone
adr  SV_STRING,r4	; r4=>string
sub  r4,r1
mov  r1,r3		; r3=length
mov  (sp)+,r1		; r1=field width+hex flag
mov  #&8000,r2		; r2='string', flags set
rts  pc			; r0 corrupted

.DecimalToString
jsr  pc,EnsureInteger	; Force float to integer
.IntegerToString
adr  SV_STRING,r1	; Point to string buffer
tst  r3			; Check sign bit
bpl  DecimalNotNeg
movb #ASC"-",(r1)+	; Put '-' sign in string buffer
mov  r1,-(sp)
jsr  pc,NegateNumber
mov  (sp)+,r1
.DecimalNotNeg
movb #0,(r1)		; Flag 'no digits yet'
adr  DecimalUnits,r2	; Point to divisors
.DecimalNextDigit
clr  r0			; Set digit to zero
.DecimalLoop
cmp  2(r2),r3
bcs  DecimalSub		; eg, r3/r4 > &3B9Axxxx, must be &3B9B or higher
beq  DecCheckLow	; eg, r3/r4 = &3B9Axxxx, check low word
bcc  DecimalDigit	; eg, r3/r4 =< &3B9Axxxx, must be < &3B9A0000
.DecCheckLow
cmp  (r2),r4
bcs  DecimalSub		; eg, r3/r4 > &3B9ACA00
beq  DecimalSub		; eg, r3/r4 = &3B9ACA00
bcc  DecimalDigit	; eg, r3/r4 =< &3B9ACA00, must be <&3B9ACA00
.DecimalSub
sub  (r2),r4
sbc  r3
sub  2(r2),r3		; r3/r4=r3/r4-divisor
inc  r0			; Increment digit
br   DecimalLoop
.DecimalDigit
tst  r0			; r0=digit
bne  DecimalNotZero
tstb (r1)		; Any digits yet?
beq  DecimalLeadingZero
.DecimalNotZero
add  #ASC"0",r0
movb r0,(r1)+		; Store digit
movb #13,(r1)		; Flag 'some digits done'
.DecimalLeadingZero
add  #4,r2		; Point to next divisor
tst  (r2)		; End of divisor table?
bne  DecimalNextDigit	; Do more units
add  #ASC"0",r4
movb r4,(r1)+		; Store final digit
br   NumToStrDone

.DecimalUnits
equd 1000000000
equd 100000000
equd 10000000
equd 1000000
equd 100000
equd 10000
equd 1000
equd 100
equd 10
equw 0

.fnLEFTs
.fnRIGHTs
mov r2,-(sp)		; Save LEFT$/RIGHT$ token
jsr pc,EvalString
mov (sp)+,r0
jsr pc,StackStringAndOp
mov r0,-(sp)
jsr pc,EvalComma
jsr pc,CheckClose
mov (sp)+,r0
mov r4,r1
jsr pc,UnstackStringDropOp
; r0=LEFT$/RIGHT$ token
; r1=wanted length
; r2=x
; r3=length
; r4=start
mov r3,r2
cmp r1,r3
bcc fnLEFTall
cmp r0,#tknLEFTs
beq fnLEFTdo
add r3,r4
sub r1,r4
.fnLEFTdo
mov r1,r2
.fnLEFTall
mov r2,r3
mov #&8000,r2
rts pc

.fnSTRINGs
jsr pc,EvalInteger
mov r4,-(sp)
jsr pc,CheckComma
jsr pc,EvalString
jsr pc,CheckClose
;jsr pc,EnsureString	; Ensure string is at start of string buffer
mov r3,r0		; r0=source length
mov (sp)+,r4		; r4=multiplier
clr r3			; r3=dest length
tst r4
beq fnSTRINGzero	; zero length
adr SV_STRING,r2
mov r2,r1
; r0=source length
; r1=source string
; r2=dest string
; r3=new length
; r4=multiplier
mov r1,-(sp)
mov r0,-(sp)
.fnSTRINGlp1
mov (sp),r0
mov 2(sp),r1
.fnSTRINGlp2
movb (r1)+,(r2)+
inc r3
bit #&FF00,r3
bne errStringTooLong
dec r0
bne fnSTRINGlp2
dec r4
bne fnSTRINGlp1
tst (sp)+
tst (sp)+
.fnSTRINGzero
adr SV_STRING,r4
mov #&8000,r2
rts pc

.fnINSTR		; Parse parameters, just return FALSE
jsr pc,EvalString
jsr pc,StackStringAndOp
jsr pc,CheckComma
jsr pc,EvalString
jsr pc,StackStringAndOp
mov #1,r4		; Prepare start position=1
cmpb r0,#ASC")"
beq fnINSTR1
jsr pc,EvalComma
.fnINSTR1
jsr pc,CheckClose
mov r4,r0		; r0=start position
bne fnINSTR2
inc r0			; If start=0, make start=1
.fnINSTR2
jsr pc,UnstackStringDropOp
tst r3
beq fnINSTRnull		; match string=""
tst 4(sp)
beq fnINSTRnull		; source string=""
cmp r3,4(sp)
bcc fnINSTRnull		; LEN(match$)>LEN(source$)
cmp r0,4(sp)
bcc fnINSTRnull		; start>LEN(source$)

; sp+6 =>source string
; 4(sp)= source length
; r4=>   match string
; r3=    match length
; r0=    match start

jsr pc,UnstackStringDropOp	;;; unfinished
jmp fnTRUE			;;;

.fnINSTRnull
jsr pc,UnstackStringDropOp
jmp fnFALSE

.fnMIDs
jsr  pc,EvalString	; MID$(string
jsr  pc,StackStringAndOp
jsr  pc,EvalComma	; MID$(string,start
mov  #255,r1		; Prepare wanted=255
cmpb r0,#ASC")"
beq  fnMID2		; MID$(string,start)
mov  r4,-(sp)		; Save start
jsr  pc,EvalComma	; MID$(string,start,length
mov  r4,r1		; r1=wanted length
mov  (sp)+,r4		; r4=start
.fnMID2
jsr  pc,CheckClose	; MID$(string,start[,length])
bic  #&FF00,r1		; length MOD 256
mov  r4,r0
bne  fnMID3
inc  r0			; If start=0, make start=1
.fnMID3
; r1=wanted length
; r0=start position
jsr  pc,UnstackStringDropOp
; r0=start position
; r1=wanted length
; r2=type
; r3=source length
; r4=>source string
mov  r1,r2
add  r0,r2		; r2=wanted length+start position
cmp  r2,r3		; end position>source length?
beq  fnMIDshort		; end=length
bcs  fnMIDshort		; end<length
mov  r3,r2
sub  r0,r2		; r2=source length-start position
mov  r2,r1
inc  r1			; wanted length=source end-wanted start+1
.fnMIDshort
; r0=start position
; r1=validated wanted length
; r3=source length
; r4=>source string
cmp  r0,r3
beq  fnMIDok
bcc  fnMIDlong		; start>end
.fnMIDok
add  r0,r4		; Add start position
dec  r4			; r4=new string start
mov  r1,r3		; r3=new string length
mov  #&8000,r2		; r2=string type
rts  pc
.fnMIDlong
clr  r3			; Null string
mov  #&8000,r2		; r2=string type
rts  pc

.errStringTooLong
jsr  pc,Error
equb 19
equs "String too long",0
align


; Numeric operations
; ==================

; Subtraction - <number> - <number>
; ---------------------------------
; On entry, r2/r3/r4 = RHS value
;           sp=>retaddr, r2/r4/r3 = LHS value
.fnSubtract
jsr  pc,NegateNumber	; Change to <number> + -<number>
			; Fall through into Addition 

; Addition - <value> + <value>
; ============================
; On entry, r2/r3/r4 = RHS value
;           sp=>retaddr, r2/r4/r3 = LHS value
.fnAdd
tst  r2
bmi  fnAddString	; <value> + <string>
bne  fnAddFloat		; <value> + <float>
			; <value> + <integer>
tst  2(sp)
bmi  errTypeMis		; <string> + <integer>
bne  fnAddFloat1	; <float> + <integer>

			; <integer> + <integer>
mov  (sp)+,r1		; Pop return address
tst  (sp)+		; Drop exponent
add  (sp)+,r4		; Add b0-b15
adc  r3			; Add carry from b0-b15
add  (sp)+,r3		; Add b16-b31
tst  r2			; Set flags
jmp  (r1)		; Return via r1

.fnAddFloat		; <value> + <float>
tst  2(sp)
bmi  errTypeMis		; <string> + <float>
			; <number> + <float> or
.fnAddFloat1		; <float> + <integer>
; ** unfinished **
mov (sp)+,r1		; Pop return address
mov (sp)+,r2		; Pop previous value from stack
mov (sp)+,r4
mov (sp)+,r3
tst r2
jmp (r1)		; Return via r1
;jsr  pc,EnsureFloat		; Ensure current value is a float
;jsr  pc,EnsureFloatStack	; Ensure stacked value is a float

.fnAddString		; <value> + <string>
tst  2(sp)
bpl  errTypeMis		; <number> + <string>

; sp=> retaddr, type, length, string
mov  r3,r0
add  4(sp),r0		; Find combined length
cmp  r0,#256		; String too long?
bcc  errStringTooLong
adr  SV_STRING,r1	; Point to string buffer
add  r0,r1		; Add length of joined string
tst  r3
beq  fnAddStr1		; Current string is zero length
add  r3,r4		; Point to end of current string
.fnAddStrLp1
movb -(r4),-(r1)	; Copy character to end of string buffer
dec  r3
bne  fnAddStrLp1	; Loop to copy current string
.fnAddStr1
mov  (sp)+,r1		; Pop return address
jsr  pc,UnstackString	; Pop string from stack to start of string buffer
mov  r0,r3		; r3=combined string length
tst  r2			; r4=string start, set flags
jmp  (r1)		; Return via r1

.errTypeMis
jmp  errTypeMismatch

; Multiplication - <number> * <number>
; ------------------------------------
; On entry, r2/r3/r4 = RHS value
;           sp=>retaddr, r2/r4/r3 = LHS value
.fnMultiply
mov  r3,r1
mov  r4,r0
clr  r3
clr  r4
tst  4(sp)
bne  fnMultiplyLp
tst  6(sp)
bne  fnMultiplyLp
beq  fnMultiplyZero	; 0*num = 0
.fnMultiplyLp
add  r0,r4
adc  r3
add  r1,r3
tst  4(sp)
bne  fnMultiply1
dec  6(sp)
.fnMultiply1
dec  4(sp)
bne  fnMultiplyLp
tst  6(sp)
bne  fnMultiplyLp
.fnMultiplyZero
mov  (sp)+,r1		; Pop return address
add  #6,sp		; Pop LHS from stack
clr  r2			; Type=integer
jmp  (r1)		; Return via r1

; Division - <number> / <number>
; ------------------------------
; On entry, r2/r3/r4 = RHS value
;           sp=>retaddr, r2/r4/r3 = LHS value
.fnDIV
.fnDivide
jsr  pc,NegateNumber
tst  r4
bne  fnDivideNotZero
tst  r3
bne  fnDivideNotZero
jsr  pc,Error
equb 18,"Divide by zero",0
align
.fnDivideNotZero
mov  4(sp),r1		; Swap LHS and RHS
mov  6(sp),r2
mov  r3,6(sp)
mov  r4,4(sp)
mov  #&FFFF,r3
mov  r3,r4
tst  r1
bne  fnDivideLp
tst  r2
bne  fnDivideLp
jmp  fnFALSE		; 0/num = 0
.fnDivideLp
inc  r4
bne  fnDivideLp2
inc  r3
.fnDivideLp2
add  4(sp),r1
adc  r2
add  6(sp),r2
bcs  fnDivideLp
mov  (sp)+,r1		; Pop return address
add  #6,sp		; Pop LHS from stack
clr  r2			; Type=integer
jmp  (r1)		; Return via r1

.fnMOD
.fnPower
mov (sp)+,r1		; Pop return address
mov (sp)+,r2		; Pop previous value from stack
mov (sp)+,r4
mov (sp)+,r3
tst r2
jmp  (r1)		; Return via r1


; Numeric functions
; =================
.fnABS
jsr pc,EvalNumVal
beq fnABSint		; Jump if integer
bic #&80,r3		; Ensure float sign bit=0
tst r2			; Set flags
rts pc
.fnABSint
tst r3			; Check integer b31
bmi fnNOT1		; Complement if negative
tst r2			; Set flags
rts pc

.fnNOT
jsr pc,EvalIntVal
.fnNOT1
com r4
com r3
tst r2			; Set flags
rts pc

.fnSGN
jsr pc,EvalNumVal
bne fnSGN1		; Jump if float
tst r3
bne fnSGN1		; Integer<>&00xx, test sign
tst r4
beq fnFALSE		; Integer=0, jump to return 0
.fnSGN1
tst r3			; b15=integer b31 or float sign bit
bmi fnTRUE		; <0 - return -1
mov #1,r4		; >0 - return 1
br fn16bit

.fnPI
mov #&DAA2,r4		; mantissa=&xxxxDAA2
mov #&490F,r3		; mantissa=&490Fxxxx
mov #&0082,r2		; real exponent=&82
rts pc

.fnVAL
jsr pc,EvalStrValCR
mov r5,-(sp)		; Save program pointer
mov r4,r5
jsr pc,EvalDecimal
mov (sp)+,r5		; Restore program pointer
tst r2			; Set flags
rts pc

.fnEVAL
jsr pc,EvalStrValCR
mov r5,-(sp)		; Save program pointer
mov r4,r5		; src=dst=string
jsr pc,Tokenise
adr SV_STRING,r5	; Point to resultant string
jsr pc,Evaluate		; Call full evaluator
mov (sp)+,r5		; Restore program pointer
tst r2			; Set flags
rts pc

; Trigonometrical functions
; =========================
.fnACS
.fnASN
.fnATN
.fnCOS
.fnDEG
.fnRAD
.fnSIN
.fnTAN


; Logarithmic functions
; =====================
.fnEXP
.fnLN
.fnLOG
.fnSQR
jsr pc,EvalNumVal


; Array function
; ==============
.fnDIM
tst r2
rts pc


; Program environment functions
; =============================
.fnLineNum
movb (r5)+,r0
asl r0
asl r0
mov r0,r3
bic #&3F,r3
movb (r5)+,r1
xor r1,r3
asl r0
asl r0
bic #&3F,r0
movb (r5)+,r4
xor r0,r4
swab r4
bic #&FF00,r3
bic #&00FF,r4
bis r3,r4
clr r3
clr r2
rts pc

.fnPAGE
mov SV_PAGE,r4
br  fn16bit

.fnTO
movb (r5)+,r0
cmpb r0,#ASC"P"
beq fnTOP
jmp errNoSuchVar
.fnTOP
mov SV_TOP,r4
br fn16bit

.fnLOMEM
mov SV_LOMEM,r4
br  fn16bit

.fnEND
mov SV_VAREND,r4
br  fn16bit

.fnHIMEM
mov SV_HIMEM,r4
br  fn16bit

.fnERL
mov SV_ERL,r4
br  fn16bit

.fnERR
movb SV_ERR,r4
br  fn8bit

.fnCOUNT
movb SV_COUNT,r4
br  fn8bit

.fnWIDTH
movb SV_WIDTH,r4
.fn8bit
bic #&FF00,r4
br  fn16bit

.fnFALSE
clr r4
.fn16bit
clr r3
clr r2			; Set type=integer and set flags
rts pc

.fnTRUE
mov #&FFFF,r4
mov r4,r3
clr r2
rts pc


; These are here to be near their branch destinations
; ---------------------------------------------------
.fnASC
jsr pc,EvalStrVal
tst r3			; Null string?
beq fnTRUE		; Null string, return -1
movb (r4),r4		; Get first byte
br fn8bit

.fnLEN
jsr pc,EvalStrVal
mov r3,r4		; Move length to value
br  fn16bit


; Logical/bitwise operations
; ==========================
.fnOR
mov (sp)+,r1		; Pop return address
tst (sp)+		; Drop exponent
bis (sp)+,r4
bis (sp)+,r3
tst r2
jmp (r1)		; Return via r1

.fnEOR
mov (sp)+,r1		; Pop return address
tst (sp)+		; Drop exponent
xor r3,(sp)
xor r4,2(sp)
mov (sp)+,r4
mov (sp)+,r3
tst r2
jmp (r1)		; Return via r1

.fnAND
mov (sp)+,r1		; Pop return address
tst (sp)+		; Drop exponent
com (sp)
com 2(sp)
bic (sp)+,r4
bic (sp)+,r3
tst r2
jmp (r1)		; Return via r1


; Random Number functions
; =======================
; =RND - return random integer 0..FFFFFFFF
; =RND(<0) - initialise seed, return n
; =RND(0) - return last RND(1) value
; =RND(1) - real random 0..1
; =RND(>1) - integer random 1..n

.fnRND
cmp r0,#ASC"("
beq fnRNDnum
;
; =RND - update seed, return 32-bit seed
.fnRNDupdate
mov #&20,r2
.fnRNDlp
movb SV_RAND+2,r0
asrb r0
asrb r0
asrb r0
movb SV_RAND+4,r1
xor  r1,r0
rorb r0
rol  SV_RAND+0
rol  SV_RAND+2
rolb SV_RAND+4
dec  r2
bne  fnRNDlp
;
; =RND(0) - return last seed as 32-bit integer
.fnRNDzero
clr r2
.fnRNDreturn
mov SV_RAND+0,r4
mov SV_RAND+2,r3
tst r2
rts pc
;
; =RND(n)
.fnRNDnum
jsr pc,EvalInteger
mov r3,r0
bmi fnRNDminus
;
; =RND(>-1)
bis r4,r0
beq fnRNDzero
;
; =RND(>0)
.fnRNDnonzero
tst r3
bne fnRNDplus
cmp r4,#1
bne fnRNDplus
;
; =RND(1) - update seed, return seed as 40-bit real
jsr pc,fnRNDupdate
mov #&0080,r2		; real, exponent=&80
br  fnRNDreturn
;
; =RND(>1) - update seed, use as real, multiply by n, return n as 32-bitint
.fnRNDplus
mov r3,-(sp)
mov r4,-(sp)
clr -(sp)		; stack n
jsr pc,fnRNDupdate
mov #&0080,r2		; real, exponent=&80
jsr pc,fnMultiply
jmp EnsureInteger
;
; =RND(<0) - set seed, return n
.fnRNDminus
mov r4,SV_RAND+0
mov r3,SV_RAND+2
clr SV_RAND+4
clr r2
rts pc


; Calling machine code
; ====================
.cmdCALL
jsr pc,EvalInteger
br  fnUSRgo
.fnUSR
jsr pc,EvalIntVal
.fnUSRgo
mov r5,-(sp)		; Save program pointer
jsr pc,CallCode		; Call address at R4
mov (sp)+,r5		; Restore program pointer
mov r0,r4		; Move result to accumulator
mov r1,r3
clr r2			; Result is an integer
rts pc

.CallCode
mov SV_VARS+4,r0	; r0=A%
tst r3
bne CallCodeRaw		; dest>&FFFF
cmp r4,#&FF00
bcc CallCodeMOS		; dest>&FF00, dest<&10000
.CallCodeRaw
mov r4,-(sp)		; Stack destination address
mov SV_VARS+8,r1	; r1=B%
mov SV_VARS+12,r2	; r2=C%
mov SV_VARS+16,r3	; r3=D%
mov SV_VARS+20,r4	; r4=E%
mov SV_VARS+24,r5	; r5=F%
rts pc			; Jump to destination

.CallCodeMOS
jsr  pc,CallMOS
; r0=>b0-b7
; r1=>b8-b15
; r2=>b16-b31
bic  #&FF00,r0		; result b0-b7=b0-b7 of returned r0
swab r1
bic  #&00FF,r1
bis  r1,r0		; result b8-b15=b0-b7 of returned r1
mov  r2,r1		; result b16-b31=b0-b15 of returned r2
rts  pc

.CallMOS
mov  SV_VARS+96,r1	; r1=X%
mov  SV_VARS+100,r2	; r2=Y%
cmp  r1,#256
bcc  CallMOS2		; X%>255, use as is
swab r2
bis  r2,r1		; r1=X%+256*Y%
swab r2
.CallMOS2
sub  #&FFCD,r4		; R4=offset from MOS jump block
add  r4,r4		; Double offset to 4 bytes per address, 6 bytes per entry
adr  MOSJumpBlock-2,r3	; Point to MOS jump block
add  r3,r4		; Point to emulated entry point
jmp  (r4)		; Jump to entry point

; addr-&CD *2 space   
; FFCE  1   2   6  OSFIND
; FFD1  4   8   6  OSGBPB
; FFD4  7  14   6  OSBPUT
; FFD7 10  20   6  OSBGET
; FFDA 13  26   6  OSARGS
; FFDD 16  32   6  OSFILE
; FFE0 19  38   6  OSRDCH
; FFE3 22  44   6  OSASCI
; FFE7 26  52   6  OSNEWL
; FFEC 31  62   4  OSWRCR
; FFEE 33  66   6  OSWRCH
; FFF1 36  72   6  OSWORD
; FFF4 39  78   6  OSBYTE
; FFF7 42  84   .  OSCLI

.MOSJumpBlock
JMP IO_FIND	; CE CF - r0=A%, r1=X%+256*Y%=>string
rts pc		; D0
JMP IO_GBPB	; D1 D2 - r0=A%, r1=X%+256*Y%=>block  
rts pc		; D3
MOV R2,R1	; D4    -        r1=Y%=handle
JMP IO_BPUT	; D5 D6 - r0=A%, r1=Y%=handle
MOV R2,R1	; D7    -        r1=Y%=handle
JMP IO_BGET	; D8 D9 - r0=A%, r1=Y%=handle
MOV R1,R2	; DA    - Need to swap X% and Y% for OSARGS
br _ffda	; DB
rts pc		; DC
JMP IO_FILE	; DD DE - r0=A%, r1=X%+256*Y%=>block
rts pc		; DF
JMP IO_RDCH	; E0 E1 - entry values ignored        
rts pc		; E2
JMP IO_ASCI	; E3 E4 - r0=A%                       
rts pc		; E5
rts pc		; E6
JMP IO_NEWL	; E7 E8 - entry values ignored        
rts pc		; E9
rts pc		; EA
rts pc		; EB
JMP IO_WRCR	; EC ED - entry values ignored        
JMP IO_WRCH	; EE EF - r0=A%                       
rts pc		; F0
JMP IO_WORD	; F1 F2 - r0=A%, r1=X%+256*Y%=>block  
rts pc		; F3
JMP IO_BYTE	; F4 F5 - r0=A%, r1=X%, r2=Y%         
rts pc		; F6
MOV R1,R0	; F7    - r0=X%+256*Y%=>string        
JMP IO_CLI	; F8 F9 - r0=>string                  

._ffda
MOV SV_VARS+100,R1
JMP IO_ARGS		; r0=A%, r1=Y%, r2=X%