mirror of https://github.com/wwarthen/RomWBW.git
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
2587 lines
38 KiB
2587 lines
38 KiB
TITLE BBC BASIC (C) R.T.RUSSELL 1981-2024
|
|
NAME ('EVAL')
|
|
;
|
|
;BBC BASIC INTERPRETER - Z80 VERSION
|
|
;EVALUATE EXPRESSION MODULE - "EVAL"
|
|
;(C) COPYRIGHT R.T.RUSSELL 1981-2024
|
|
;
|
|
;THE NAME BBC BASIC IS USED WITH THE PERMISSION
|
|
;OF THE BRITISH BROADCASTING CORPORATION AND IS
|
|
;NOT TRANSFERRABLE TO A FORKED OR DERIVED WORK.
|
|
;
|
|
;VERSION 2.3, 07-05-1984
|
|
;VERSION 3.0, 08-03-1987
|
|
;VERSION 5.0, 14-05-2024
|
|
;
|
|
;BINARY FLOATING POINT REPRESENTATION:
|
|
; 32 BIT SIGN-MAGNITUDE NORMALIZED MANTISSA
|
|
; 8 BIT EXCESS-128 SIGNED EXPONENT
|
|
; SIGN BIT REPLACES MANTISSA MSB (IMPLIED "1")
|
|
; MANTISSA=0 & EXPONENT=0 IMPLIES VALUE IS ZERO.
|
|
;
|
|
;BINARY INTEGER REPRESENTATION:
|
|
; 32 BIT 2'S-COMPLEMENT SIGNED INTEGER
|
|
; "EXPONENT" BYTE = 0 (WHEN PRESENT)
|
|
;
|
|
;NORMAL REGISTER ALLOCATION: MANTISSA - HLH'L'
|
|
; EXPONENT - C
|
|
;
|
|
GLOBAL EXPR
|
|
GLOBAL EXPRN
|
|
GLOBAL EXPRI
|
|
GLOBAL EXPRS
|
|
GLOBAL ITEMI
|
|
GLOBAL CONS
|
|
GLOBAL LOADS
|
|
GLOBAL VAL0
|
|
GLOBAL SFIX
|
|
GLOBAL STR
|
|
GLOBAL HEXSTR
|
|
GLOBAL LOAD4
|
|
GLOBAL LOADN
|
|
GLOBAL DLOAD5
|
|
GLOBAL TEST
|
|
GLOBAL ZERO
|
|
GLOBAL COMMA
|
|
GLOBAL BRAKET
|
|
GLOBAL DECODE
|
|
GLOBAL PUSHS
|
|
GLOBAL POPS
|
|
GLOBAL SEARCH
|
|
GLOBAL SCP
|
|
GLOBAL LETARR
|
|
;
|
|
EXTRN MUL16
|
|
EXTRN ERROR
|
|
EXTRN SYNTAX
|
|
EXTRN CHANEL
|
|
EXTRN CHNL
|
|
EXTRN STOREN
|
|
EXTRN STORE4
|
|
EXTRN STORE5
|
|
EXTRN STACCS
|
|
EXTRN CHECK
|
|
EXTRN USR
|
|
EXTRN VAR
|
|
EXTRN FN
|
|
EXTRN XEQ
|
|
EXTRN NXT
|
|
EXTRN X14OR5
|
|
EXTRN MODIFY
|
|
EXTRN MODIFS
|
|
EXTRN TERMQ
|
|
;
|
|
EXTRN GETVAR
|
|
EXTRN LEXAN2
|
|
EXTRN RANGE
|
|
EXTRN GETTOP
|
|
;
|
|
EXTRN STAVAR
|
|
EXTRN PAGE
|
|
EXTRN LOMEM
|
|
EXTRN HIMEM
|
|
EXTRN RANDOM
|
|
EXTRN COUNT
|
|
EXTRN LISTON
|
|
EXTRN PC
|
|
EXTRN ERL
|
|
EXTRN ERR
|
|
EXTRN ACCS
|
|
EXTRN ERRTXT
|
|
EXTRN KEYWDS
|
|
EXTRN KEYWDL
|
|
EXTRN FREE
|
|
EXTRN BUFFER
|
|
;
|
|
EXTRN OSRDCH
|
|
EXTRN OSOPEN
|
|
EXTRN OSBGET
|
|
EXTRN OSSTAT
|
|
EXTRN GETCSR
|
|
EXTRN GETIME
|
|
EXTRN GETIMS
|
|
EXTRN GETEXT
|
|
EXTRN GETPTR
|
|
EXTRN OSKEY
|
|
;
|
|
EXTRN POINT
|
|
EXTRN ADVAL
|
|
EXTRN TINTFN
|
|
EXTRN MODEFN
|
|
EXTRN WIDFN
|
|
;
|
|
EXTRN FPP
|
|
;
|
|
FUNTOK EQU 8DH ;1st FUNCTION TOKEN
|
|
TMOD EQU 83H
|
|
TLEN EQU 0A9H
|
|
TTO EQU 0B8H
|
|
TDIM EQU 0DEH
|
|
TEND EQU 0E0H
|
|
TMODE EQU 0EBH
|
|
TREPORT EQU 0F6H
|
|
TWIDTH EQU 0FEH
|
|
TTINT EQU 0AH
|
|
TBY EQU 0FH
|
|
;
|
|
;TABLE OF ADDRESSES FOR FUNCTIONS:
|
|
;
|
|
FUNTBL: DEFW DECODE ;Line number
|
|
DEFW OPENIN ;OPENIN
|
|
DEFW PTR ;PTR
|
|
DEFW PAGEV ;PAGE
|
|
DEFW TIMEV ;TIME
|
|
DEFW LOMEMV ;LOMEM
|
|
DEFW HIMEMV ;HIMEM
|
|
DEFW ABS ;ABS
|
|
DEFW ACS ;ACS
|
|
DEFW ADVAL ;ADVAL
|
|
DEFW ASC ;ASC
|
|
DEFW ASN ;ASN
|
|
DEFW ATN ;ATN
|
|
DEFW BGET ;BGET
|
|
DEFW COS ;COS
|
|
DEFW COUNTV ;COUNT
|
|
DEFW DEG ;DEG
|
|
DEFW ERLV ;ERL
|
|
DEFW ERRV ;ERR
|
|
DEFW EVAL ;EVAL
|
|
DEFW EXP ;EXP
|
|
DEFW EXT ;EXT
|
|
DEFW ZERO ;FALSE
|
|
DEFW FN ;FN
|
|
DEFW GET ;GET
|
|
DEFW INKEY ;INKEY
|
|
DEFW INSTR ;INSTR(
|
|
DEFW INT ;INT
|
|
DEFW LEN ;LEN
|
|
DEFW LN ;LN
|
|
DEFW LOG ;LOG
|
|
DEFW CPL ;NOT
|
|
DEFW OPENUP ;OPENUP
|
|
DEFW OPENOT ;OPENOUT
|
|
DEFW PI ;PI
|
|
DEFW POINT ;POINT(
|
|
DEFW POS ;POS
|
|
DEFW RAD ;RAD
|
|
DEFW RND ;RND
|
|
DEFW SGN ;SGN
|
|
DEFW SIN ;SIN
|
|
DEFW SQR ;SQR
|
|
DEFW TAN ;TAN
|
|
DEFW TOPV ;TO(P)
|
|
DEFW TRUE ;TRUE
|
|
DEFW USR ;USR
|
|
DEFW VAL ;VAL
|
|
DEFW VPOS ;VPOS
|
|
DEFW CHRS ;CHR$
|
|
DEFW GETS ;GET$
|
|
DEFW INKEYS ;INKEY$
|
|
DEFW LEFTS ;LEFT$(
|
|
DEFW MIDS ;MID$(
|
|
DEFW RIGHTS ;RIGHT$(
|
|
DEFW STRS ;STR$
|
|
DEFW STRING ;STRING$(
|
|
DEFW EOF ;EOF
|
|
DEFW SUM ;SUM
|
|
;
|
|
TCMD EQU FUNTOK+($-FUNTBL)/2
|
|
;
|
|
CR EQU 0DH
|
|
LF EQU 0AH
|
|
AND EQU 80H
|
|
DIV EQU 81H
|
|
EOR EQU 82H
|
|
MOD EQU 83H
|
|
OR EQU 84H
|
|
;
|
|
SOPTBL: DEFW SLE ;<= (STRING)
|
|
DEFW SNE ;<>
|
|
DEFW SGE ;>=
|
|
DEFW SLT ;<
|
|
DEFW SEQ ;=
|
|
DEFW SGT ;>
|
|
;
|
|
;EXPR - VARIABLE-TYPE EXPRESSION EVALUATION
|
|
; Expression type is returned in A'F':
|
|
; Numeric - A' bit 7=0, F' sign bit cleared.
|
|
; String - A' bit 7=1, F' sign bit set.
|
|
;Floating-point or integer result returned in HLH'L'C
|
|
; Integer result denoted by C=0 and HLH'L' non-zero.
|
|
;String result returned in string accumulator, DE set.
|
|
;
|
|
;Hierarchy is: (1) Variables, functions,
|
|
; constants, bracketed expressions.
|
|
; (2) ^
|
|
; (3) * / MOD DIV
|
|
; (4) + -
|
|
; (5) = <> <= >= > <
|
|
; (6) AND
|
|
; (7) EOR OR
|
|
;
|
|
EXPR: CALL EXPR1 ;GET FIRST OPERAND
|
|
EXPR0A: CP EOR ;CHECK OPERATOR
|
|
JR Z,EXPR0B
|
|
CP OR
|
|
RET NZ
|
|
EXPR0B: CALL SAVE ;SAVE FIRST OPERAND
|
|
CALL EXPR1 ;GET SECOND OPERAND
|
|
CALL DOIT ;DO OPERATION
|
|
JR EXPR0A ;CONTINUE
|
|
;
|
|
EXPR1: CALL EXPR2
|
|
EXPR1A: CP AND
|
|
RET NZ
|
|
CALL SAVE
|
|
CALL EXPR2
|
|
CALL DOIT
|
|
JR EXPR1A
|
|
;
|
|
EXPR2: CALL EXPR3
|
|
CALL RELOPQ
|
|
RET NZ
|
|
LD B,A
|
|
INC IY ;BUMP OVER OPERATOR
|
|
CALL NXT
|
|
CALL RELOPQ ;COMPOUND OPERATOR?
|
|
JR NZ,EXPR2B
|
|
INC IY
|
|
CP B
|
|
JR Z,SHIFT ;SHIFT OR ==
|
|
ADD A,B
|
|
LD B,A
|
|
EXPR2B: LD A,B
|
|
EX AF,AF'
|
|
JP M,EXPR2S
|
|
EX AF,AF'
|
|
SUB 4
|
|
CP '>'-4
|
|
JR NZ,EXPR2C
|
|
ADD A,2
|
|
EXPR2C: AND 0FH
|
|
EXPR2D: CALL SAVE1
|
|
CALL EXPR3
|
|
CALL DOIT ;Must NOT be "JP DOIT"
|
|
RET
|
|
;
|
|
SHIFT: CP '='
|
|
JR Z,EXPR2B ;==
|
|
CALL NXT
|
|
CALL RELOPQ
|
|
JR NZ,SHIFT1
|
|
CP B
|
|
JP NZ,SYNTAX
|
|
INC IY
|
|
INC B
|
|
SHIFT1: LD A,B
|
|
SUB 18
|
|
JR EXPR2D
|
|
;
|
|
EXPR2S: EX AF,AF'
|
|
DEC A
|
|
AND 7
|
|
CALL PUSHS ;SAVE STRING ON STACK
|
|
PUSH AF ;SAVE OPERATOR
|
|
CALL EXPR3 ;SECOND STRING
|
|
EX AF,AF'
|
|
JP P,MISMAT
|
|
POP AF
|
|
LD C,E ;LENGTH OF STRING #2
|
|
POP DE
|
|
LD HL,0
|
|
ADD HL,SP
|
|
LD B,E ;LENGTH OF STRING #1
|
|
PUSH DE
|
|
LD DE,ACCS
|
|
EX DE,HL
|
|
CALL DISPT2
|
|
POP DE
|
|
EX DE,HL
|
|
LD H,0
|
|
ADD HL,SP
|
|
LD SP,HL
|
|
EX DE,HL
|
|
XOR A ;NUMERIC MARKER
|
|
LD C,A ;INTEGER MARKER
|
|
EX AF,AF'
|
|
LD A,(IY)
|
|
RET
|
|
;
|
|
EXPR3: CALL EXPR4
|
|
EXPR3A: CP '-'
|
|
JR Z,EXPR3B
|
|
CP '+'
|
|
RET NZ
|
|
EX AF,AF'
|
|
JP M,EXPR3S
|
|
EX AF,AF'
|
|
EXPR3B: CALL SAVE
|
|
CALL EXPR4
|
|
CALL DOIT
|
|
JR EXPR3A
|
|
;
|
|
EXPR3S: EX AF,AF'
|
|
INC IY ;BUMP PAST '+'
|
|
CALL PUSHS ;SAVE STRING ON STACK
|
|
CALL EXPR4 ;SECOND STRING
|
|
EX AF,AF'
|
|
JP P,MISMAT
|
|
LD C,E ;C=LENGTH
|
|
POP DE
|
|
PUSH DE
|
|
LD HL,ACCS
|
|
LD D,H
|
|
LD A,C
|
|
OR A
|
|
JR Z,EXP3S3
|
|
LD B,L
|
|
LD L,A ;SOURCE
|
|
ADD A,E
|
|
LD E,A ;DESTINATION
|
|
LD A,19
|
|
JR C,ERROR2 ;"String too long"
|
|
PUSH DE
|
|
DEC E
|
|
DEC L
|
|
LDDR ;COPY
|
|
POP DE
|
|
EXP3S3: EXX
|
|
POP BC
|
|
CALL POPS ;RESTORE FROM STACK
|
|
EXX
|
|
OR 80H ;FLAG STRING
|
|
EX AF,AF'
|
|
LD A,(IY)
|
|
JR EXPR3A
|
|
;
|
|
EXPR4: CALL EXPR5
|
|
EXPR4A: CP '*'
|
|
JR Z,EXPR4B
|
|
CP '/'
|
|
JR Z,EXPR4B
|
|
CP MOD
|
|
JR Z,EXPR4B
|
|
CP DIV
|
|
RET NZ
|
|
EXPR4B: CALL SAVE
|
|
CALL EXPR5
|
|
CALL DOIT
|
|
JR EXPR4A
|
|
;
|
|
EXPR5: CALL ITEM
|
|
OR A ;TEST TYPE
|
|
EX AF,AF' ;SAVE TYPE
|
|
EXPR5A: CALL NXT
|
|
CP '^'
|
|
RET NZ
|
|
CALL SAVE
|
|
CALL ITEM
|
|
OR A
|
|
EX AF,AF'
|
|
CALL DOIT
|
|
JR EXPR5A
|
|
;
|
|
EXPRN: CALL EXPR
|
|
EX AF,AF'
|
|
RET P
|
|
JR MISMAT
|
|
;
|
|
EXPRI: CALL EXPR
|
|
EX AF,AF'
|
|
JP P,SFIX
|
|
JR MISMAT
|
|
;
|
|
EXPRS: CALL EXPR
|
|
EX AF,AF'
|
|
RET M
|
|
JR MISMAT
|
|
;
|
|
NEGATE: EXX
|
|
LD A,H
|
|
CPL
|
|
LD H,A
|
|
LD A,L
|
|
CPL
|
|
LD L,A
|
|
EXX
|
|
LD A,H
|
|
CPL
|
|
LD H,A
|
|
LD A,L
|
|
CPL
|
|
LD L,A
|
|
ADD1: EXX
|
|
INC HL
|
|
LD A,H
|
|
OR L
|
|
EXX
|
|
LD A,0 ;NUMERIC MARKER
|
|
RET NZ
|
|
INC HL
|
|
RET
|
|
;
|
|
BADHEX: LD A,28
|
|
ERROR2: JP ERROR ;"Bad HEX or binary"
|
|
;
|
|
ITEMI: CALL ITEM
|
|
OR A
|
|
JP P,SFIX
|
|
JR MISMAT
|
|
;
|
|
ITEMS: CALL ITEM
|
|
OR A
|
|
RET M
|
|
MISMAT: LD A,6
|
|
JR ERROR2 ;"Type mismatch"
|
|
;
|
|
ITEM1: CALL EXPR ;BRACKETED EXPR
|
|
CALL BRAKET
|
|
EX AF,AF'
|
|
RET
|
|
;
|
|
ITEMN: CALL ITEM
|
|
OR A
|
|
RET P
|
|
JR MISMAT
|
|
;
|
|
;HEX - Get hexadecimal constant.
|
|
; Inputs: ASCII string at (IY)
|
|
; Outputs: Integer result in H'L'HL, C=0, A7=0.
|
|
; IY updated (points to delimiter)
|
|
;
|
|
HEX: CALL ZERO
|
|
CALL HEXDIG
|
|
JR C,BADHEX
|
|
HEX1: INC IY
|
|
AND 0FH
|
|
LD B,4
|
|
HEX2: EXX
|
|
ADD HL,HL
|
|
EXX
|
|
ADC HL,HL
|
|
DJNZ HEX2
|
|
EXX
|
|
OR L
|
|
LD L,A
|
|
EXX
|
|
CALL HEXDIG
|
|
JR NC,HEX1
|
|
XOR A
|
|
RET
|
|
;
|
|
;BIN - Get binary constant.
|
|
; Inputs: ASCII string at (IY)
|
|
; Outputs: Integer result in H'L'HL, C=0, A=0.
|
|
; IY updated (points to delimiter)
|
|
;
|
|
BIN: CALL ZERO
|
|
CALL BINDIG
|
|
JR C,BADHEX
|
|
BIN1: INC IY
|
|
RR A
|
|
EXX
|
|
ADC HL,HL
|
|
EXX
|
|
ADC HL,HL
|
|
CALL BINDIG
|
|
JR NC,BIN1
|
|
XOR A
|
|
RET
|
|
;
|
|
;MINUS - Unary minus.
|
|
; Inputs: IY = text pointer
|
|
; Outputs: Numeric result, same type as argument.
|
|
; Result in H'L'HLC
|
|
;
|
|
MINUS: CALL ITEMN
|
|
MINUS0: DEC C
|
|
INC C
|
|
JR Z,NEGATE ;ZERO/INTEGER
|
|
LD A,H
|
|
XOR 80H ;CHANGE SIGN (FP)
|
|
LD H,A
|
|
XOR A ;NUMERIC MARKER
|
|
RET
|
|
;
|
|
ADDROF: CALL VAR
|
|
PUSH HL
|
|
EXX
|
|
POP HL
|
|
JP COUNT1
|
|
;
|
|
;ITEM - VARIABLE TYPE NUMERIC OR STRING ITEM.
|
|
;Item type is returned in A: Bit 7=0 numeric.
|
|
; Bit 7=1 string.
|
|
;Numeric item returned in HLH'L'C.
|
|
;String item returned in string accumulator,
|
|
; DE addresses byte after last (E=length).
|
|
;
|
|
ITEM: CALL CHECK
|
|
CALL NXT
|
|
INC IY
|
|
CP FUNTOK
|
|
JR C,ITEM0
|
|
CP TCMD
|
|
JP C,DISPAT ;FUNCTIONS
|
|
JP EXTRAS ;DIM, END, MODE, REPORT$, WIDTH
|
|
;
|
|
ITEM0: CP ':'
|
|
JR NC,ITEM2 ;VARIABLES
|
|
CP '0'
|
|
JR NC,CON ;NUMERIC CONSTANT
|
|
CP '('
|
|
JR Z,ITEM1 ;EXPRESSION
|
|
CP '-'
|
|
JR Z,MINUS ;UNARY MINUS
|
|
CP '+'
|
|
JR Z,ITEMN ;UNARY PLUS
|
|
CP '.'
|
|
JR Z,CON ;NUMERIC CONSTANT
|
|
CP '&'
|
|
JR Z,HEX ;HEX CONSTANT
|
|
CP '%'
|
|
JR Z,BIN ;BINARY CONSTANT
|
|
CP '"'
|
|
JR Z,CONS ;STRING CONSTANT
|
|
CP TTINT
|
|
JP Z,TINT ;TINT FUNCTION
|
|
ITEM2: CP TMOD
|
|
JP Z,MODFUN ;MOD
|
|
CP '^'
|
|
JR Z,ADDROF ;^ OPERATOR
|
|
DEC IY
|
|
CALL GETVAR ;VARIABLE
|
|
JR NZ,NOSUCH
|
|
BIT 6,A
|
|
JR NZ,ARRAY
|
|
OR A
|
|
JP M,LOADS ;STRING VARIABLE
|
|
LOADN: BIT 2,A
|
|
LD C,0
|
|
JR Z,LOAD1 ;BYTE VARIABLE
|
|
BIT 0,A
|
|
JR Z,LOAD4 ;INTEGER VARIABLE
|
|
LOAD5: LD C,(IX+4)
|
|
LOAD4: EXX
|
|
LD L,(IX+0)
|
|
LD H,(IX+1)
|
|
EXX
|
|
LD L,(IX+2)
|
|
LD H,(IX+3)
|
|
RET
|
|
;
|
|
LOAD1: LD HL,0
|
|
EXX
|
|
LD H,0
|
|
LD L,(IX+0)
|
|
EXX
|
|
RET
|
|
;
|
|
NOSUCH: JP C,SYNTAX
|
|
LD A,(LISTON)
|
|
BIT 5,A
|
|
LD A,26
|
|
JR NZ,ERROR0 ;"No such variable"
|
|
NOS1: INC IY
|
|
CALL RANGE
|
|
JR NC,NOS1
|
|
LD IX,PC
|
|
XOR A
|
|
LD C,A
|
|
JR LOAD4
|
|
;
|
|
;CON - Get unsigned numeric constant from ASCII string.
|
|
; Inputs: ASCII string at (IY-1)
|
|
; Outputs: Variable-type result in HLH'L'C
|
|
; IY updated (points to delimiter)
|
|
; A7 = 0 (numeric marker)
|
|
;
|
|
CON: DEC IY
|
|
PUSH IY
|
|
POP IX
|
|
LD A,36
|
|
CALL FPP
|
|
JR C,ERROR0
|
|
PUSH IX
|
|
POP IY
|
|
XOR A
|
|
RET
|
|
;
|
|
;CONS - Get string constant from ASCII string.
|
|
; Inputs: ASCII string at (IY)
|
|
; Outputs: Result in string accumulator.
|
|
; D = MS byte of ACCS, E = string length
|
|
; A7 = 1 (string marker)
|
|
; IY updated
|
|
;
|
|
CONS: LD DE,ACCS
|
|
CONS3: LD A,(IY)
|
|
INC IY
|
|
CP '"'
|
|
JR Z,CONS2
|
|
CONS1: LD (DE),A
|
|
INC E
|
|
CP CR
|
|
JR NZ,CONS3
|
|
LD A,9
|
|
ERROR0: JP ERROR ;"Missing """
|
|
;
|
|
CONS2: LD A,(IY)
|
|
CP '"'
|
|
INC IY
|
|
JR Z,CONS1
|
|
DEC IY
|
|
LD A,80H ;STRING MARKER
|
|
RET
|
|
;
|
|
ARRAY: LD A,14 ;'Bad use of array'
|
|
JP ERROR
|
|
;
|
|
; ARRLEN - Get start address and number of elements of an array
|
|
; Inputs: HL addresses array descriptor
|
|
; Outputs: HL = address of first element
|
|
; DE = total number of elements
|
|
; A = 0
|
|
; Destroys: A,B,C,D,E,H,L,flags
|
|
;
|
|
ARRLEN: LD A,(HL) ;Number of dimensions
|
|
INC HL
|
|
OR A
|
|
JR Z,ARRAY
|
|
LD DE,1
|
|
ARLOOP: LD C,(HL)
|
|
INC HL
|
|
LD B,(HL) ;BC = size of this dimension
|
|
INC HL
|
|
EX DE,HL
|
|
PUSH AF
|
|
PUSH DE
|
|
CALL MUL16 ;HL=HL*BC
|
|
POP DE
|
|
POP AF
|
|
EX DE,HL
|
|
DEC A
|
|
JR NZ,ARLOOP
|
|
RET
|
|
;
|
|
GETARR: CALL NXT
|
|
CALL GETVAR
|
|
JR NZ,NOSUCH
|
|
BIT 6,A
|
|
SCF
|
|
JR Z,NOSUCH
|
|
AND 8FH
|
|
LD B,A ;Type + size
|
|
GETAR1: LD A,(HL)
|
|
INC HL
|
|
LD H,(HL)
|
|
LD L,A
|
|
AND 0FEH
|
|
OR H
|
|
JR Z,ARRAY ;Bad use of array
|
|
RET
|
|
;
|
|
GETARB: CALL NXT
|
|
CP '('
|
|
JR NZ,GETARR
|
|
INC IY
|
|
CALL GETARR
|
|
CALL BRAKET
|
|
RET
|
|
;
|
|
DLOADN: BIT 2,A
|
|
LD B,0
|
|
JR Z,DLOAD1 ;BYTE VARIABLE
|
|
BIT 0,A
|
|
JR Z,DLOAD4 ;INTEGER VARIABLE
|
|
DLOAD5: LD B,(IX+4)
|
|
DLOAD4: EXX
|
|
LD E,(IX+0)
|
|
LD D,(IX+1)
|
|
EXX
|
|
LD E,(IX+2)
|
|
LD D,(IX+3)
|
|
RET
|
|
;
|
|
DLOAD1: LD DE,0
|
|
EXX
|
|
LD D,0
|
|
LD E,(IX+0)
|
|
EXX
|
|
RET
|
|
;
|
|
LOADS: LD DE,ACCS
|
|
RRA
|
|
JR NC,LOADS2 ;FIXED STRING
|
|
CALL LOAD4
|
|
EXX
|
|
LD A,L
|
|
EXX
|
|
OR A
|
|
LD C,A
|
|
LD A,80H ;STRING MARKER
|
|
RET Z
|
|
LD B,0
|
|
LDIR
|
|
RET
|
|
;
|
|
LOADS2: LD A,(HL)
|
|
LD (DE),A
|
|
INC HL
|
|
CP CR
|
|
REPDUN: LD A,80H ;STRING MARKER
|
|
RET Z
|
|
INC E
|
|
JR NZ,LOADS2
|
|
RET ;RETURN NULL STRING
|
|
;
|
|
; Version 5 extensions:
|
|
;
|
|
EXTRAS: CP TMODE
|
|
JP Z,MODEFN ;MODE
|
|
CP TWIDTH
|
|
JP Z,WIDFN ;WIDTH
|
|
CP TREPORT
|
|
JR Z,REPORS ;REPORT$
|
|
CP TEND
|
|
JR Z,ENDFUN ;END
|
|
CP TDIM
|
|
JR Z,DIMFUN ;DIM
|
|
SYNERR: JP SYNTAX ; 'Syntax error'
|
|
;
|
|
; END (function)
|
|
;
|
|
ENDFUN: LD HL,(FREE)
|
|
JP COUNT1
|
|
;
|
|
; REPORT$
|
|
;
|
|
REPORS: LD A,(IY)
|
|
CP '$'
|
|
JR NZ,SYNERR
|
|
INC IY
|
|
LD HL,(ERRTXT)
|
|
LD DE,ACCS
|
|
REPCPY: LD A,(HL)
|
|
OR A
|
|
JR Z,REPDUN
|
|
LDI
|
|
CP 160
|
|
JP PE,REPCPY
|
|
CP LF
|
|
JR Z,REPCPY
|
|
DEC E
|
|
PUSH HL
|
|
LD HL,KEYWDS
|
|
LD BC,KEYWDL
|
|
CPIR
|
|
LD B,160
|
|
CP 145
|
|
JP PE,REPTOK
|
|
INC B
|
|
REPTOK: LD A,(HL)
|
|
LDI
|
|
CP B
|
|
JP PE,REPTOK
|
|
POP HL
|
|
DEC E
|
|
JR REPCPY
|
|
;
|
|
; DIM(array()[,sub])
|
|
;
|
|
DIMFUN: CALL NXT
|
|
CP '('
|
|
JR NZ,DIMF0
|
|
INC IY
|
|
CALL DIMF0
|
|
CALL BRAKET
|
|
RET
|
|
;
|
|
DIMF0: CALL GETARR
|
|
PUSH HL
|
|
CALL NXT
|
|
LD E,0
|
|
CP ','
|
|
JR NZ,DIMF1
|
|
INC IY
|
|
CALL EXPRI
|
|
EXX
|
|
EX DE,HL
|
|
INC E
|
|
DEC E
|
|
JR Z,BADSUB
|
|
DIMF1: POP HL
|
|
LD A,(HL)
|
|
INC HL
|
|
CP E
|
|
JR C,BADSUB
|
|
DEC E
|
|
JP M,DIMF3
|
|
ADD HL,DE
|
|
ADD HL,DE
|
|
LD A,(HL)
|
|
INC HL
|
|
LD H,(HL)
|
|
LD L,A
|
|
DEC HL
|
|
DIMF2: JP COUNT1
|
|
|
|
DIMF3: LD L,A
|
|
LD H,0
|
|
JR DIMF2
|
|
;
|
|
BADSUB: LD A,15
|
|
JP ERROR ;"Bad subscript"
|
|
;
|
|
;VARIABLE-TYPE FUNCTIONS:
|
|
;
|
|
;Result returned in HLH'L'C (floating point)
|
|
;Result returned in HLH'L' (C=0) (integer)
|
|
;Result returned in string accumulator & DE (string)
|
|
;All registers destroyed.
|
|
;IY (text pointer) updated.
|
|
;Bit 7 of A indicates type: 0 = numeric, 1 = string.
|
|
;
|
|
;
|
|
;POS - horizontal cursor position.
|
|
;VPOS - vertical cursor position.
|
|
;EOF - return status of file.
|
|
;BGET - read byte from file.
|
|
;INKEY - as GET but wait only n centiseconds.
|
|
;GET - wait for keypress and return ASCII value.
|
|
;GET(n) - input from Z80 port n.
|
|
;ASC - ASCII value of string.
|
|
;LEN - length of string.
|
|
;LOMEM - location of dynamic variables.
|
|
;HIMEM - top of available RAM.
|
|
;PAGE - start of current text page.
|
|
;TOP - address of first free byte after program.
|
|
;ERL - line number where last error occurred.
|
|
;ERR - number of last error.
|
|
;COUNT - number of printing characters since CR.
|
|
;Results are integer numeric.
|
|
;
|
|
TINT: CALL TINTFN
|
|
JR COUNT1
|
|
POS: CALL GETCSR
|
|
EX DE,HL
|
|
JR COUNT1
|
|
VPOS: CALL GETCSR
|
|
JR COUNT1
|
|
EOF: CALL CHANEL
|
|
CALL OSSTAT
|
|
JP Z,TRUE
|
|
JP ZERO
|
|
BGET: CALL CHANEL ;CHANNEL NUMBER
|
|
CALL OSBGET
|
|
LD L,A
|
|
JR COUNT0
|
|
INKEY: CALL INKEYS
|
|
JR ASC0
|
|
GET: CALL NXT
|
|
CP '('
|
|
JR NZ,GET0
|
|
CALL ITEMI ;PORT ADDRESS
|
|
EXX
|
|
LD B,H
|
|
LD C,L
|
|
IN L,(C) ;INPUT FROM PORT BC
|
|
JR COUNT0
|
|
GET0: CALL GETS
|
|
JR ASC1
|
|
ASC: CALL ITEMS
|
|
ASC0: XOR A
|
|
CP E
|
|
JP Z,TRUE ;NULL STRING
|
|
ASC1: LD HL,(ACCS)
|
|
JR COUNT0
|
|
LEN: CALL ITEMS
|
|
EX DE,HL
|
|
JR COUNT0
|
|
LOMEMV: LD HL,(LOMEM)
|
|
JR COUNT1
|
|
HIMEMV: LD HL,(HIMEM)
|
|
JR COUNT1
|
|
PAGEV: LD HL,(PAGE)
|
|
JR COUNT1
|
|
TOPV: LD A,(IY)
|
|
INC IY ;SKIP "P"
|
|
CP 'P'
|
|
JP NZ,SYNTAX ;"Syntax Error"
|
|
CALL GETTOP
|
|
JR COUNT1
|
|
ERLV: LD HL,(ERL)
|
|
JR COUNT1
|
|
ERRV: LD HL,(ERR)
|
|
JR COUNT0
|
|
COUNTV: LD HL,(COUNT)
|
|
COUNT0: LD H,0
|
|
COUNT1: EXX
|
|
XOR A
|
|
LD C,A ;INTEGER MARKER
|
|
LD H,A
|
|
LD L,A
|
|
RET
|
|
;
|
|
;OPENIN - Open a file for reading.
|
|
;OPENOUT - Open a file for writing.
|
|
;OPENUP - Open a file for reading or writing.
|
|
;Result is integer channel number (0 if error)
|
|
;
|
|
OPENOT: XOR A
|
|
DEFB 21H ;SKIP NEXT 2 BYTES
|
|
OPENUP: LD A,2
|
|
DEFB 21H ;SKIP NEXT 2 BYTES
|
|
OPENIN: LD A,1
|
|
PUSH AF ;SAVE OPEN TYPE
|
|
CALL ITEMS ;FILENAME
|
|
LD A,CR
|
|
LD (DE),A
|
|
POP AF ;RESTORE OPEN TYPE
|
|
ADD A,-1 ;AFFECT FLAGS
|
|
LD HL,ACCS
|
|
CALL OSOPEN
|
|
LD L,A
|
|
JR COUNT0
|
|
;
|
|
;EXT - Return length of file.
|
|
;PTR - Return current file pointer.
|
|
;Results are integer numeric.
|
|
;
|
|
EXT: CALL CHANEL
|
|
CALL GETEXT
|
|
JR TIME0
|
|
;
|
|
PTR: CALL CHANEL
|
|
CALL GETPTR
|
|
JR TIME0
|
|
;
|
|
;TIME - Return current value of elapsed time.
|
|
;Result is integer numeric.
|
|
;
|
|
TIMEV: LD A,(IY)
|
|
CP '$'
|
|
JR Z,TIMEVS
|
|
CALL GETIME
|
|
TIME0: PUSH DE
|
|
EXX
|
|
POP HL
|
|
XOR A
|
|
LD C,A
|
|
RET
|
|
;
|
|
;TIME$ - Return date/time string.
|
|
;Result is string
|
|
;
|
|
TIMEVS: INC IY ;SKIP $
|
|
CALL GETIMS
|
|
LD A,80H ;MARK STRING
|
|
RET
|
|
;
|
|
;String comparison:
|
|
;
|
|
SLT: CALL SCP
|
|
RET NC
|
|
JR TRUE
|
|
;
|
|
SGT: CALL SCP
|
|
RET Z
|
|
RET C
|
|
JR TRUE
|
|
;
|
|
SGE: CALL SCP
|
|
RET C
|
|
JR TRUE
|
|
;
|
|
SLE: CALL SCP
|
|
JR Z,TRUE
|
|
RET NC
|
|
JR TRUE
|
|
;
|
|
SNE: CALL SCP
|
|
RET Z
|
|
JR TRUE
|
|
;
|
|
SEQ: CALL SCP
|
|
RET NZ
|
|
TRUE: LD A,-1
|
|
EXX
|
|
LD H,A
|
|
LD L,A
|
|
EXX
|
|
LD H,A
|
|
LD L,A
|
|
INC A
|
|
LD C,A
|
|
RET
|
|
;
|
|
;PI - Return PI (3.141592654)
|
|
;Result is floating-point numeric.
|
|
;
|
|
PI: LD A,35
|
|
JR FPP1
|
|
;
|
|
;ABS - Absolute value
|
|
;Result is numeric, variable type.
|
|
;
|
|
ABS: LD A,16
|
|
JR FPPN
|
|
;
|
|
;NOT - Complement integer.
|
|
;Result is integer numeric.
|
|
;
|
|
CPL: LD A,26
|
|
JR FPPN
|
|
;
|
|
;DEG - Convert radians to degrees
|
|
;Result is floating-point numeric.
|
|
;
|
|
DEG: LD A,21
|
|
JR FPPN
|
|
;
|
|
;RAD - Convert degrees to radians
|
|
;Result is floating-point numeric.
|
|
;
|
|
RAD: LD A,27
|
|
JR FPPN
|
|
;
|
|
;SGN - Return -1, 0 or +1
|
|
;Result is integer numeric.
|
|
;
|
|
SGN: LD A,28
|
|
JR FPPN
|
|
;
|
|
;INT - Floor function
|
|
;Result is integer numeric.
|
|
;
|
|
INT: LD A,23
|
|
JR FPPN
|
|
;
|
|
;SQR - square root
|
|
;Result is floating-point numeric.
|
|
;
|
|
SQR: LD A,30
|
|
JR FPPN
|
|
;
|
|
;TAN - Tangent function
|
|
;Result is floating-point numeric.
|
|
;
|
|
TAN: LD A,31
|
|
JR FPPN
|
|
;
|
|
;COS - Cosine function
|
|
;Result is floating-point numeric.
|
|
;
|
|
COS: LD A,20
|
|
JR FPPN
|
|
;
|
|
;SIN - Sine function
|
|
;Result is floating-point numeric.
|
|
;
|
|
SIN: LD A,29
|
|
JR FPPN
|
|
;
|
|
;EXP - Exponential function
|
|
;Result is floating-point numeric.
|
|
;
|
|
EXP: LD A,22
|
|
JR FPPN
|
|
;
|
|
;LN - Natural log.
|
|
;Result is floating-point numeric.
|
|
;
|
|
LN: LD A,24
|
|
JR FPPN
|
|
;
|
|
;LOG - base-10 logarithm.
|
|
;Result is floating-point numeric.
|
|
;
|
|
LOG: LD A,25
|
|
JR FPPN
|
|
;
|
|
;ASN - Arc-sine
|
|
;Result is floating-point numeric.
|
|
;
|
|
ASN: LD A,18
|
|
JR FPPN
|
|
;
|
|
;ATN - arc-tangent
|
|
;Result is floating-point numeric.
|
|
;
|
|
ATN: LD A,19
|
|
JR FPPN
|
|
;
|
|
;ACS - arc-cosine
|
|
;Result is floating point numeric.
|
|
;
|
|
ACS: LD A,17
|
|
FPPN: PUSH AF
|
|
CALL ITEMN
|
|
POP AF
|
|
FPP1: CALL FPP
|
|
JP C,ERROR
|
|
XOR A
|
|
RET
|
|
;
|
|
;SFIX - Convert to fixed-point notation
|
|
;
|
|
SFIX: LD A,38
|
|
JR FPP1
|
|
;
|
|
;SFLOAT - Convert to floating-point notation
|
|
;
|
|
SFLOAT: LD A,39
|
|
JR FPP1
|
|
;
|
|
;VAL - Return numeric value of string.
|
|
;Result is variable type numeric.
|
|
;
|
|
VAL: CALL ITEMS
|
|
VAL0: XOR A
|
|
LD (DE),A
|
|
LD IX,ACCS
|
|
LD A,36
|
|
JR FPP1
|
|
;
|
|
;EVAL - Pass string to expression evaluator.
|
|
;Result is variable type (numeric or string).
|
|
;
|
|
EVAL: CALL ITEMS
|
|
LD A,CR
|
|
LD (DE),A
|
|
PUSH IY
|
|
LD DE,ACCS
|
|
LD IY,ACCS
|
|
LD C,0
|
|
CALL LEXAN2 ;TOKENISE
|
|
LD (DE),A
|
|
INC DE
|
|
XOR A
|
|
CALL PUSHS ;PUT ON STACK
|
|
LD IY,2
|
|
ADD IY,SP
|
|
CALL EXPR
|
|
POP IY
|
|
ADD IY,SP
|
|
LD SP,IY ;ADJUST STACK POINTER
|
|
POP IY
|
|
EX AF,AF'
|
|
RET
|
|
;
|
|
;RND - Random number function.
|
|
; RND gives random integer 0-&FFFFFFFF
|
|
; RND(-n) seeds random number & returns -n.
|
|
; RND(0) returns last value in RND(1) form.
|
|
; RND(1) returns floating-point 0-0.99999999.
|
|
; RND(n) returns random integer 1-n.
|
|
;
|
|
RND: LD IX,RANDOM
|
|
CALL NXT
|
|
CP '('
|
|
JR Z,RND5 ;ARGUMENT FOLLOWS
|
|
CALL LOAD5
|
|
RND1: RR C
|
|
LD B,32
|
|
RND2: EXX ;CALCULATE NEXT
|
|
ADC HL,HL
|
|
EXX
|
|
ADC HL,HL
|
|
BIT 3,L
|
|
JR Z,RND3
|
|
CCF
|
|
RND3: DJNZ RND2
|
|
RND4: RL C ;SAVE CARRY
|
|
CALL STORE5 ;STORE NEW NUMBER
|
|
XOR A
|
|
LD C,A
|
|
RET
|
|
RND5: CALL ITEMI
|
|
LD IX,RANDOM
|
|
BIT 7,H ;NEGATIVE?
|
|
SCF
|
|
JR NZ,RND4 ;SEED
|
|
CALL TEST
|
|
PUSH AF
|
|
LD B,C
|
|
EX DE,HL
|
|
EXX
|
|
EX DE,HL
|
|
CALL LOAD5
|
|
CALL NZ,RND1 ;NEXT IF NON-ZERO
|
|
EXX ;SCRAMBLE (CARE!)
|
|
LD C,7FH
|
|
RND6: BIT 7,H ;FLOAT
|
|
JR NZ,RND7
|
|
EXX
|
|
ADD HL,HL
|
|
EXX
|
|
ADC HL,HL
|
|
DEC C
|
|
JR NZ,RND6
|
|
RND7: RES 7,H ;POSITIVE 0-0.999999
|
|
POP AF
|
|
RET Z ;ZERO ARGUMENT
|
|
EXX
|
|
LD A,E
|
|
DEC A
|
|
OR D
|
|
EXX
|
|
OR E
|
|
OR D
|
|
RET Z ;ARGUMENT=1
|
|
LD B,0 ;INTEGER MARKER
|
|
LD A,10
|
|
CALL FPP ;MULTIPLY
|
|
JP C,ERROR
|
|
CALL SFIX
|
|
JP ADD1
|
|
;
|
|
;SUMLEN(array())
|
|
;
|
|
SUMLEN: INC IY ;Skip LEN
|
|
CALL GETARB
|
|
BIT 7,B
|
|
JP Z,MISMAT ;Type mismatch
|
|
CALL ARRLEN
|
|
PUSH HL
|
|
POP IX ;IX addresses array
|
|
XOR A
|
|
LD H,A
|
|
LD L,A
|
|
LD B,A
|
|
SUMLN1: LD C,(IX)
|
|
ADD HL,BC
|
|
LD C,4
|
|
ADD IX,BC
|
|
DEC DE ;Count elements
|
|
LD A,D
|
|
OR E
|
|
JR NZ,SUMLN1
|
|
JP COUNT1
|
|
;
|
|
;SUM(array())
|
|
;
|
|
SUM: CALL NXT
|
|
CP TLEN
|
|
JR Z,SUMLEN
|
|
CALL GETARB
|
|
BIT 7,B
|
|
JR NZ,SUMSTR
|
|
PUSH BC
|
|
CALL ARRLEN
|
|
PUSH HL
|
|
POP IX ;IX addresses array
|
|
CALL ZERO
|
|
POP AF ;A = element size
|
|
SUMUP: PUSH DE
|
|
PUSH AF
|
|
CALL DLOADN
|
|
LD A,11
|
|
CALL FPP
|
|
JP C,ERROR
|
|
POP AF
|
|
LD D,0
|
|
LD E,A
|
|
ADD IX,DE ;Bump to next element
|
|
POP DE
|
|
DEC DE ;Count elements
|
|
LD B,A
|
|
LD A,D
|
|
OR E
|
|
LD A,B
|
|
JR NZ,SUMUP
|
|
RET
|
|
;
|
|
;SUM(string array)
|
|
;
|
|
SUMSTR: CALL ARRLEN
|
|
PUSH HL
|
|
POP IX ;IX addresses array
|
|
EX DE,HL
|
|
LD DE,ACCS
|
|
LD B,0
|
|
SUMST1: PUSH HL
|
|
LD C,(IX)
|
|
LD A,C
|
|
OR A
|
|
JR Z,SUMST2
|
|
ADD A,E
|
|
LD A,19
|
|
JP C,ERROR ;"String too long"
|
|
LD L,(IX+2)
|
|
LD H,(IX+3)
|
|
LDIR
|
|
SUMST2: POP HL
|
|
LD C,4
|
|
ADD IX,BC
|
|
DEC HL ;Count elements
|
|
LD A,H
|
|
OR L
|
|
JR NZ,SUMST1
|
|
OR 80H
|
|
RET
|
|
;
|
|
;MOD(array())
|
|
;
|
|
MODFUN: CALL GETARB
|
|
BIT 7,B
|
|
JP NZ,MISMAT
|
|
PUSH BC
|
|
CALL ARRLEN
|
|
PUSH HL
|
|
POP IX ;IX addresses array
|
|
CALL ZERO
|
|
POP AF ;A = element size
|
|
MODUP: PUSH DE
|
|
PUSH AF
|
|
PUSH BC
|
|
PUSH HL
|
|
EXX
|
|
PUSH HL
|
|
EXX
|
|
CALL LOADN
|
|
XOR A
|
|
LD B,A
|
|
LD D,A
|
|
LD E,A
|
|
EXX
|
|
LD D,A
|
|
LD E,2
|
|
EXX
|
|
LD A,14
|
|
PUSH IX
|
|
CALL FPP ;Square
|
|
POP IX
|
|
JP C,ERROR
|
|
EXX
|
|
EX DE,HL
|
|
POP HL
|
|
EXX
|
|
EX DE,HL
|
|
POP HL
|
|
LD A,C
|
|
POP BC
|
|
LD B,A
|
|
LD A,11
|
|
CALL FPP ;Accumulate
|
|
JP C,ERROR
|
|
POP AF
|
|
LD D,0
|
|
LD E,A
|
|
ADD IX,DE ;Bump to next element
|
|
POP DE
|
|
DEC DE ;Count elements
|
|
LD B,A
|
|
LD A,D
|
|
OR E
|
|
LD A,B
|
|
JR NZ,MODUP
|
|
LD A,30
|
|
CALL FPP ;Square root
|
|
XOR A
|
|
RET
|
|
;
|
|
;INSTR - String search.
|
|
;Result is integer numeric.
|
|
;
|
|
INSTR: CALL EXPRS ;STRING TO SEARCH
|
|
CALL COMMA
|
|
CALL PUSHS ;SAVE STRING ON STACK
|
|
CALL EXPRS ;SUB-STRING
|
|
POP BC
|
|
LD HL,0
|
|
ADD HL,SP ;HL ADDRESSES MAIN
|
|
PUSH BC ;C = MAIN STRING LENGTH
|
|
LD B,E ;B = SUB-STRING LENGTH
|
|
CALL NXT
|
|
CP ','
|
|
LD A,0
|
|
JR NZ,INSTR1
|
|
INC IY ;SKIP COMMA
|
|
PUSH BC ;SAVE LENGTHS
|
|
PUSH HL ;SAVE MAIN ADDRESS
|
|
CALL PUSHS
|
|
CALL EXPRI
|
|
POP BC
|
|
CALL POPS
|
|
POP HL ;RESTORE MAIN ADDRESS
|
|
POP BC ;RESTORE LENGTHS
|
|
EXX
|
|
LD A,L
|
|
EXX
|
|
OR A
|
|
JR Z,INSTR1
|
|
DEC A
|
|
INSTR1: LD DE,ACCS ;DE ADDRESSES SUB
|
|
CALL SEARCH
|
|
POP DE
|
|
JR Z,INSTR2 ;N.B. CARRY CLEARED
|
|
SBC HL,HL
|
|
ADD HL,SP
|
|
INSTR2: SBC HL,SP
|
|
EX DE,HL
|
|
LD H,0
|
|
ADD HL,SP
|
|
LD SP,HL
|
|
EX DE,HL
|
|
CALL BRAKET
|
|
JP COUNT1
|
|
;
|
|
;SEARCH - Search string for sub-string
|
|
; Inputs: Main string at HL length C
|
|
; Sub-string at DE length B
|
|
; Starting offset A
|
|
; Outputs: NZ - not found
|
|
; Z - found at location HL-1
|
|
; Carry always cleared
|
|
;
|
|
SEARCH: PUSH BC
|
|
LD B,0
|
|
LD C,A
|
|
ADD HL,BC ;NEW START ADDRESS
|
|
POP BC
|
|
SUB C
|
|
JR NC,SRCH4
|
|
NEG
|
|
LD C,A ;REMAINING LENGTH
|
|
SRCH1: LD A,(DE)
|
|
PUSH BC
|
|
LD B,0
|
|
CPIR ;FIND FIRST CHARACTER
|
|
LD A,C
|
|
POP BC
|
|
JR NZ,SRCH4
|
|
LD C,A
|
|
DEC B ;Bug fix
|
|
CP B ;Bug fix
|
|
INC B ;Bug fix
|
|
JR C,SRCH4 ;Bug fix
|
|
PUSH BC
|
|
PUSH DE
|
|
PUSH HL
|
|
DEC B
|
|
JR Z,SRCH3 ;FOUND !
|
|
SRCH2: INC DE
|
|
LD A,(DE)
|
|
CP (HL)
|
|
JR NZ,SRCH3
|
|
INC HL
|
|
DJNZ SRCH2
|
|
SRCH3: POP HL
|
|
POP DE
|
|
POP BC
|
|
JR NZ,SRCH1
|
|
XOR A ;Z, NC
|
|
RET ;FOUND
|
|
;
|
|
SRCH4: OR 0FFH ;NZ, NC
|
|
RET ;NOT FOUND
|
|
;
|
|
;CHR$ - Return character with given ASCII value.
|
|
;Result is string.
|
|
;
|
|
CHRS: CALL ITEMI
|
|
EXX
|
|
LD A,L
|
|
JR GET1
|
|
;
|
|
;GET$ - Return key pressed as string, or read from file
|
|
;Result is string.
|
|
;
|
|
GETS: CALL NXT
|
|
CP '#'
|
|
JR Z,GET2
|
|
CALL OSRDCH
|
|
GET1: SCF
|
|
JR INKEY1
|
|
;
|
|
GET2: CALL CHNL ;File channel
|
|
CALL NXT
|
|
CP TBY
|
|
JR Z,GET3
|
|
CP TTO
|
|
JR NZ,GET4
|
|
GET3: INC IY
|
|
PUSH AF
|
|
PUSH DE
|
|
CALL ITEMI ;Get BY or TO qualifier
|
|
EXX
|
|
LD B,H
|
|
LD C,L
|
|
POP DE
|
|
POP AF
|
|
GET4: LD HL,ACCS
|
|
CP TTO
|
|
JR Z,GET5
|
|
LD D,C ;Maximum count
|
|
LD BC,100H ;Default
|
|
CP TBY
|
|
JR Z,GET6
|
|
GET5: LD D,0
|
|
SET 1,B ;Flag no count
|
|
GET6: PUSH BC
|
|
CALL OSBGET
|
|
POP BC
|
|
JR C,GET9 ;EOF
|
|
BIT 1,B
|
|
JR Z,GET8
|
|
CP C
|
|
JR Z,GET9 ;NUL (or supplied term)
|
|
BIT 7,B
|
|
JR NZ,GET7
|
|
BIT 0,B
|
|
JR Z,GET8
|
|
CP LF
|
|
JR Z,GET9 ;LF
|
|
GET7: CP CR
|
|
JR Z,GET9 ;CR
|
|
GET8: LD (HL),A
|
|
INC L
|
|
DEC D
|
|
JR NZ,GET6
|
|
GET9: EX DE,HL
|
|
LD A,80H
|
|
RET
|
|
;
|
|
;INKEY$ - Wait up to n centiseconds for keypress.
|
|
; Return key pressed as string or null
|
|
; string if time elapsed.
|
|
;Result is string.
|
|
;
|
|
INKEYS: CALL ITEMI
|
|
EXX
|
|
CALL OSKEY
|
|
INKEY1: LD DE,ACCS
|
|
LD (DE),A
|
|
LD A,80H
|
|
RET NC
|
|
INC E
|
|
RET
|
|
;
|
|
;MID$ - Return sub-string.
|
|
;Result is string.
|
|
;
|
|
MIDS: CALL EXPRS
|
|
CALL COMMA
|
|
CALL PUSHS ;SAVE STRING ON STACK
|
|
CALL EXPRI
|
|
POP BC
|
|
CALL POPS
|
|
EXX
|
|
LD A,L
|
|
EXX
|
|
OR A
|
|
JR Z,MIDS1
|
|
DEC A
|
|
LD L,A
|
|
SUB E
|
|
LD E,0
|
|
JR NC,MIDS1
|
|
NEG
|
|
LD C,A
|
|
CALL RIGHT1
|
|
MIDS1: CALL NXT
|
|
CP ','
|
|
JR Z,LEFT1
|
|
CALL BRAKET
|
|
LD A,80H
|
|
RET
|
|
;
|
|
;LEFT$ - Return left part of string.
|
|
;Carry cleared if entire string returned.
|
|
;Result is string.
|
|
;
|
|
LEFTS: CALL EXPRS
|
|
CALL NXT
|
|
CP ','
|
|
JR Z,LEFT1
|
|
CALL BRAKET
|
|
LD A,E
|
|
OR A
|
|
JR Z,LEFT3
|
|
DEC E
|
|
JR LEFT3
|
|
;
|
|
LEFT1: INC IY
|
|
CALL PUSHS ;SAVE STRING ON STACK
|
|
CALL EXPRI
|
|
POP BC
|
|
CALL POPS
|
|
CALL BRAKET
|
|
EXX
|
|
LD A,L
|
|
EXX
|
|
CP E
|
|
JR NC,LEFT3
|
|
LD L,E ;FOR RIGHT$
|
|
LEFT2: LD E,A
|
|
LEFT3: LD A,80H ;STRING MARKER
|
|
RET
|
|
;
|
|
;RIGHT$ - Return right part of string.
|
|
;Result is string.
|
|
;
|
|
RIGHTS: CALL EXPRS
|
|
CALL NXT
|
|
CP ','
|
|
JR Z,RIGHT0
|
|
CALL BRAKET
|
|
LD A,E
|
|
OR A
|
|
JR Z,LEFT3
|
|
DEC A
|
|
LD C,1
|
|
JR RIGHT2
|
|
;
|
|
RIGHT0: CALL LEFT1
|
|
RET NC
|
|
INC E
|
|
DEC E
|
|
RET Z
|
|
LD C,E
|
|
LD A,L
|
|
SUB E
|
|
RIGHT2: LD L,A
|
|
RIGHT1: LD B,0
|
|
LD H,D
|
|
LD E,B
|
|
LDIR ;MOVE
|
|
LD A,80H
|
|
RET
|
|
;
|
|
;STRING$ - Return n concatenations of a string.
|
|
;Result is string.
|
|
;
|
|
STRING: CALL EXPRI
|
|
CALL COMMA
|
|
EXX
|
|
LD A,L
|
|
EXX
|
|
PUSH AF
|
|
CALL EXPRS
|
|
CALL BRAKET
|
|
POP AF
|
|
OR A
|
|
JR Z,LEFT2 ;N=0
|
|
DEC A
|
|
LD C,A
|
|
LD A,80H ;STRING MARKER
|
|
RET Z
|
|
INC E
|
|
DEC E
|
|
RET Z ;NULL STRING
|
|
LD B,E
|
|
LD H,D
|
|
LD L,0
|
|
STRIN1: PUSH BC
|
|
STRIN2: LD A,(HL)
|
|
INC HL
|
|
LD (DE),A
|
|
INC E
|
|
LD A,19
|
|
JP Z,ERROR ;"String too long"
|
|
DJNZ STRIN2
|
|
POP BC
|
|
DEC C
|
|
JR NZ,STRIN1
|
|
LD A,80H
|
|
RET
|
|
;
|
|
;SUBROUTINES
|
|
;
|
|
;TEST - Test HLH'L' for zero
|
|
; Outputs: Z-flag set & A=0 if zero
|
|
; Destroys: A,F
|
|
;
|
|
TEST: LD A,H
|
|
OR L
|
|
EXX
|
|
OR H
|
|
OR L
|
|
EXX
|
|
RET
|
|
;
|
|
;DECODE - Decode line number in pseudo-binary.
|
|
; Inputs: IY = Text pointer.
|
|
; Outputs: HL=0, H'L'=line number, C=0.
|
|
; Destroys: A,C,H,L,H',L',IY,F
|
|
;
|
|
DECODE: EXX
|
|
LD A,(IY)
|
|
INC IY
|
|
RLA
|
|
RLA
|
|
LD H,A
|
|
AND 0C0H
|
|
XOR (IY)
|
|
INC IY
|
|
LD L,A
|
|
LD A,H
|
|
RLA
|
|
RLA
|
|
AND 0C0H
|
|
XOR (IY)
|
|
INC IY
|
|
LD H,A
|
|
EXX
|
|
XOR A
|
|
LD C,A
|
|
LD H,A
|
|
LD L,A
|
|
RET
|
|
;
|
|
;HEXSTR - convert numeric value to HEX string.
|
|
; Inputs: HLH'L'C = integer or floating-point number
|
|
; Outputs: String in string accumulator.
|
|
; E = string length. D = ACCS/256
|
|
;
|
|
HEXSTS: INC IY ;SKIP TILDE
|
|
CALL ITEMN
|
|
CALL HEXSTR
|
|
LD A,80H
|
|
RET
|
|
;
|
|
HEXSTR: CALL SFIX
|
|
LD BC,8
|
|
LD DE,ACCS
|
|
HEXST1: PUSH BC
|
|
LD B,4
|
|
XOR A
|
|
HEXST2: EXX
|
|
ADD HL,HL
|
|
EXX
|
|
ADC HL,HL
|
|
RLA
|
|
DJNZ HEXST2
|
|
POP BC
|
|
DEC C
|
|
RET M
|
|
JR Z,HEXST3
|
|
OR A
|
|
JR NZ,HEXST3
|
|
CP B
|
|
JR Z,HEXST1
|
|
HEXST3: ADD A,90H
|
|
DAA
|
|
ADC A,40H
|
|
DAA
|
|
LD (DE),A
|
|
INC DE
|
|
LD B,A
|
|
JR HEXST1
|
|
;
|
|
;Function STR - convert numeric value to ASCII string.
|
|
; Inputs: HLH'L'C = integer or floating-point number.
|
|
; Outputs: String in string accumulator.
|
|
; E = length, D = ACCS/256
|
|
; A = 80H (type=string)
|
|
;
|
|
;First normalise for decimal output:
|
|
;
|
|
STRS: CALL NXT
|
|
CP '~'
|
|
JR Z,HEXSTS
|
|
CALL ITEMN
|
|
LD IX,STAVAR
|
|
LD A,(IX+3)
|
|
OR A
|
|
LD IX,G9-1 ;G9 FORMAT
|
|
JR Z,STR0
|
|
STR: LD IX,STAVAR
|
|
STR0: LD DE,ACCS
|
|
LD A,37
|
|
CALL FPP
|
|
JP C,ERROR
|
|
BIT 0,(IX+2)
|
|
STR1: LD A,80H ;STRING MARKER
|
|
RET Z
|
|
LD A,C
|
|
ADD A,4
|
|
STR2: CP E
|
|
JR Z,STR1
|
|
EX DE,HL
|
|
LD (HL),' ' ;TRAILING SPACE
|
|
INC HL
|
|
EX DE,HL
|
|
JR STR2
|
|
;
|
|
G9: DEFW 9
|
|
;
|
|
;STRING COMPARE
|
|
;Compare string (DE) length B with string (HL) length C.
|
|
;Result preset to false.
|
|
;
|
|
SCP: CALL SCP0
|
|
ZERO: LD A,0
|
|
EXX
|
|
LD H,A
|
|
LD L,A
|
|
EXX
|
|
LD H,A
|
|
LD L,A
|
|
LD C,A
|
|
RET
|
|
;
|
|
SCP0: INC B
|
|
INC C
|
|
SCP1: DEC B
|
|
JR Z,SCP2
|
|
DEC C
|
|
JR Z,SCP3
|
|
LD A,(DE)
|
|
CP (HL)
|
|
RET NZ
|
|
INC DE
|
|
INC HL
|
|
JR SCP1
|
|
SCP2: OR A
|
|
DEC C
|
|
RET Z
|
|
SCF
|
|
RET
|
|
SCP3: OR A
|
|
INC C
|
|
RET
|
|
;
|
|
;PUSH$ - SAVE STRING ON STACK.
|
|
; Inputs: String in string accumulator.
|
|
; E = string length.
|
|
; A - saved on stack.
|
|
; Destroys: B,C,D,E,H,L,IX,SP,F
|
|
;
|
|
PUSHS: LD HL,ACCS
|
|
CALL CHECK
|
|
POP IX ;RETURN ADDRESS
|
|
OR A ;CLEAR CARRY
|
|
LD D,H
|
|
LD C,E
|
|
SBC HL,DE
|
|
ADD HL,SP
|
|
LD SP,HL
|
|
LD B,A
|
|
PUSH BC
|
|
JR Z,PUSHS1 ;ZERO LENGTH
|
|
EX DE,HL
|
|
LD B,0
|
|
LD L,B ;L=0
|
|
LDIR ;COPY TO STACK
|
|
CALL CHECK
|
|
PUSHS1: JP (IX) ;"RETURN"
|
|
;
|
|
;POP$ - RESTORE STRING FROM STACK.
|
|
; Inputs: C = string length.
|
|
; Outputs: String in string accumulator.
|
|
; E = string length.
|
|
; Destroys: B,C,D,E,H,L,IX,SP,F
|
|
;
|
|
POPS: POP IX ;RETURN ADDRESS
|
|
LD HL,0
|
|
LD B,H ;B=0
|
|
ADD HL,SP
|
|
LD DE,ACCS
|
|
INC C
|
|
DEC C
|
|
JR Z,POPS1 ;ZERO LENGTH
|
|
LDIR ;COPY FROM STACK
|
|
POPS1: LD SP,HL
|
|
JP (IX) ;"RETURN"
|
|
;
|
|
BINDIG: LD A,(IY)
|
|
CP '0'
|
|
RET C
|
|
CP '1'+1
|
|
CCF
|
|
RET C
|
|
SUB '0'
|
|
RET
|
|
;
|
|
HEXDIG: LD A,(IY)
|
|
CP '0'
|
|
RET C
|
|
CP '9'+1
|
|
CCF
|
|
RET NC
|
|
CP 'A'
|
|
RET C
|
|
SUB 'A'-10
|
|
CP 16
|
|
CCF
|
|
RET
|
|
;
|
|
RELOPQ: CP '>'
|
|
RET NC
|
|
CP '='
|
|
RET NC
|
|
CP '<'
|
|
RET
|
|
;
|
|
COMMA: CALL NXT
|
|
INC IY
|
|
CP ','
|
|
RET Z
|
|
LD A,5
|
|
JR ERROR1 ;"Missing ,"
|
|
;
|
|
BRAKET: CALL NXT
|
|
INC IY
|
|
CP ')'
|
|
RET Z
|
|
LD A,27
|
|
ERROR1: JP ERROR ;"Missing )"
|
|
;
|
|
SAVE: INC IY
|
|
AND 0FH
|
|
SAVE1: EX AF,AF'
|
|
JP M,MISMAT
|
|
EX AF,AF'
|
|
EX (SP),HL
|
|
EXX
|
|
PUSH HL
|
|
EXX
|
|
PUSH AF
|
|
PUSH BC
|
|
JP (HL)
|
|
;
|
|
DOIT: EX AF,AF'
|
|
JP M,MISMAT
|
|
EXX
|
|
POP BC ;RETURN ADDRESS
|
|
EXX
|
|
LD A,C
|
|
POP BC
|
|
LD B,A
|
|
POP AF ;OPERATOR
|
|
EXX
|
|
EX DE,HL
|
|
POP HL
|
|
EXX
|
|
EX DE,HL
|
|
POP HL
|
|
EXX
|
|
PUSH BC
|
|
EXX
|
|
CALL FPP
|
|
JR C,ERROR1
|
|
XOR A
|
|
EX AF,AF' ;TYPE
|
|
LD A,(IY)
|
|
RET
|
|
;
|
|
DISPT2: PUSH HL
|
|
LD HL,SOPTBL
|
|
JR DISPT0
|
|
;
|
|
DISPAT: PUSH HL
|
|
SUB FUNTOK
|
|
LD HL,FUNTBL
|
|
DISPT0: PUSH BC
|
|
ADD A,A
|
|
LD C,A
|
|
LD B,0
|
|
ADD HL,BC
|
|
LD A,(HL)
|
|
INC HL
|
|
LD H,(HL)
|
|
LD L,A
|
|
POP BC
|
|
EX (SP),HL
|
|
RET ;OFF TO ROUTINE
|
|
;
|
|
STOREA: LD A,D
|
|
PUSH DE
|
|
PUSH HL
|
|
EX (SP),IX
|
|
OR A
|
|
JP M,STORA1
|
|
CALL LOADN
|
|
EX (SP),IX
|
|
CALL MODIFY
|
|
POP HL
|
|
POP DE
|
|
LD C,D
|
|
LD B,0
|
|
RET
|
|
;
|
|
STORA1: PUSH DE
|
|
CALL LOADS
|
|
POP HL
|
|
EX (SP),IX
|
|
CALL MODIFS
|
|
POP HL
|
|
POP DE
|
|
LD BC,4
|
|
RET
|
|
;
|
|
; Assign to whole array:
|
|
; array1() = array expression
|
|
; array1() = n1,n2,n3,n4...
|
|
; array1() = n (n copied into all elements)
|
|
;
|
|
; Inputs: D = type (65, 68, 69, 193)
|
|
; E = opcode ('=' for store, '+','-' etc. for modify)
|
|
; HL = IX = VARPTR
|
|
; IY = text pointer
|
|
;
|
|
LETARR: RES 6,D ;Lose array marker
|
|
PUSH DE ;Save type & opcode
|
|
CALL GETAR1 ;Get and check indirect link
|
|
CALL ARRLEN ;DE = elements, HL addresses first
|
|
POP BC
|
|
LD A,B ;A = type
|
|
PUSH DE
|
|
PUSH BC
|
|
PUSH HL
|
|
CALL X14OR5 ;DE = size in bytes
|
|
LD B,D
|
|
LD C,E
|
|
POP IX
|
|
POP DE
|
|
;
|
|
; (SP) = number of elements
|
|
; BC = size in bytes
|
|
; DE = type & opcode
|
|
; IX = address of first element
|
|
;
|
|
; allocate space on stack and zero it:
|
|
;
|
|
XOR A ;Clear carry and zero error code
|
|
LD HL,0
|
|
ADD HL,SP ;HL = SP
|
|
SBC HL,BC
|
|
JP C,ERROR ;'No room'
|
|
PUSH BC
|
|
LD BC,(FREE)
|
|
INC B ;Safety margin
|
|
SBC HL,BC
|
|
ADD HL,BC
|
|
POP BC
|
|
JP C,ERROR ;'No room'
|
|
LD SP,HL
|
|
LETA0: LD (HL),0
|
|
INC HL
|
|
DEC BC
|
|
LD A,B
|
|
OR C
|
|
JR NZ,LETA0 ;Clear allocated stack
|
|
LD C,(HL)
|
|
INC HL
|
|
LD B,(HL)
|
|
LD H,A
|
|
LD L,A
|
|
ADD HL,SP
|
|
;
|
|
; CALL NXT
|
|
; CP TEVAL ;;EVAL not currently supported
|
|
;
|
|
CALL EXPRA
|
|
LD SP,HL ;Update stack pointer
|
|
POP BC ;Level stack
|
|
JP XEQ
|
|
;
|
|
; EXPRA - Evaluate array expression, strictly left-to-right;
|
|
; Note: String array arithmetic (concatenation) is not supported
|
|
; because it would require a way of recovering freed string space.
|
|
;
|
|
; Inputs: BC = number of elements
|
|
; DE = type & opcode
|
|
; HL = address of temporary stack space
|
|
; IX = address of first element of array
|
|
; Outputs: HL = value to set stack pointer to
|
|
;
|
|
EXPRA: LD A,'='
|
|
DEC IY
|
|
EXPRA1: INC IY
|
|
PUSH DE
|
|
PUSH BC
|
|
PUSH HL
|
|
PUSH IX
|
|
LD E,A ;For unary minus
|
|
CALL NXT
|
|
CALL ITEMA
|
|
POP IX
|
|
POP HL
|
|
POP BC
|
|
POP DE
|
|
CALL NXT
|
|
CP ',' ;List?
|
|
JR Z,EXPRA3
|
|
CALL TERMQ
|
|
JR NZ,EXPRA1
|
|
;
|
|
; Update destination array from stack:
|
|
;
|
|
EXPRA2: PUSH BC
|
|
CALL STOREA ;(IX) <- (HL)
|
|
ADD HL,BC
|
|
ADD IX,BC
|
|
POP BC
|
|
DEC BC
|
|
LD A,B
|
|
OR C
|
|
JR NZ,EXPRA2
|
|
RET
|
|
;
|
|
; Update destination array from list (n.b. not transferred via stack):
|
|
;
|
|
EXPRA3: PUSH BC
|
|
CALL STOREA ;(IX) <- (HL)
|
|
EXPRA4: INC IY ;Bump past comma
|
|
ADD HL,BC
|
|
ADD IX,BC
|
|
POP BC
|
|
DEC BC
|
|
LD A,B
|
|
OR C
|
|
RET Z
|
|
PUSH BC
|
|
PUSH DE
|
|
PUSH HL
|
|
PUSH IX
|
|
BIT 7,D
|
|
JR NZ,EXPRA5
|
|
PUSH DE
|
|
CALL EXPRN
|
|
POP DE
|
|
POP IX
|
|
PUSH IX
|
|
CALL MODIFY
|
|
JR EXPRA6
|
|
;
|
|
EXPRA5: PUSH DE
|
|
CALL EXPRS
|
|
POP HL
|
|
POP IX
|
|
PUSH IX
|
|
CALL MODIFS
|
|
EXPRA6: POP IX
|
|
POP HL
|
|
POP DE
|
|
LD BC,4
|
|
BIT 7,D
|
|
JR NZ,EXPRA7
|
|
LD C,D
|
|
EXPRA7: CALL NXT
|
|
CP ','
|
|
JR Z,EXPRA4
|
|
POP DE
|
|
EXPRA8: ADD HL,BC ;Skip remaining elements
|
|
DEC DE
|
|
LD A,D
|
|
OR E
|
|
JR NZ,EXPRA8
|
|
RET
|
|
;
|
|
; ITEMA: evaluate and operate on array item
|
|
; Inputs: A = operator
|
|
; D = type
|
|
; E = operator
|
|
; BC = number of elements
|
|
; HL = pointer to destination on stack
|
|
; IY = text pointer
|
|
; Outputs: IY updated
|
|
; Destroys: Everything except SP
|
|
;
|
|
ITEMA: CP '-'
|
|
JR NZ,ITEMA1 ;Not unary minus
|
|
LD A,E
|
|
CP '='
|
|
JR NZ,ITEMA1 ;Not unary minus
|
|
INC IY ;Bump past '-'
|
|
CALL NXT
|
|
LD E,'-' ;Unary minus
|
|
ITEMA1: PUSH HL ;Pointer to destination
|
|
PUSH BC ;Number of elements
|
|
PUSH DE ;Type and previous operator
|
|
PUSH IY ;In case normal expression
|
|
CALL GETVAR
|
|
JR NZ,ITEMA4 ;Non-array expression
|
|
BIT 6,A
|
|
JR Z,ITEMA4 ;Not a whole array
|
|
POP BC ;Junk saved text pointer
|
|
POP DE ;Type & operator
|
|
RES 6,A
|
|
CP D
|
|
JP NZ,MISMAT ;'Type mismatch'
|
|
PUSH DE ;Save type & operator again
|
|
CALL GETAR1
|
|
CALL ARRLEN
|
|
LD B,D ;BC = number of elements
|
|
LD C,E
|
|
POP DE ;Restore type & operator
|
|
EX (SP),HL
|
|
CALL NXT
|
|
POP IX ;Pointer to source
|
|
CP '.'
|
|
JP Z,ARRDOT ;Dot product
|
|
OR A
|
|
SBC HL,BC ;Same number of elements?
|
|
JP NZ,MISMAT ;'Type mismatch'
|
|
POP HL ;Pointer to destination
|
|
BIT 7,D
|
|
JR NZ,ITEMA3
|
|
;
|
|
; Process numeric array item:
|
|
;
|
|
ITEMA2: PUSH BC
|
|
PUSH HL
|
|
LD A,D
|
|
CALL LOADN
|
|
EX (SP),IX
|
|
PUSH DE
|
|
CALL MODIFY
|
|
POP DE
|
|
EX (SP),IX
|
|
POP HL
|
|
LD C,D
|
|
LD B,0
|
|
ADD IX,BC
|
|
ADD HL,BC
|
|
POP BC
|
|
DEC BC
|
|
LD A,B
|
|
OR C
|
|
JR NZ,ITEMA2
|
|
RET
|
|
;
|
|
; Process string array item (just copy descriptors):
|
|
;
|
|
ITEMA3: EX DE,HL ;DE = destination
|
|
LD H,B
|
|
LD L,C
|
|
ADD HL,HL
|
|
ADD HL,HL
|
|
LD B,H
|
|
LD C,L
|
|
PUSH IX
|
|
POP HL ;HL = source
|
|
LDIR
|
|
RET
|
|
;
|
|
; Process numeric non-array item:
|
|
;
|
|
ITEMA4: POP IY ;Restore text pointer
|
|
BIT 7,D
|
|
JR NZ,ITEMA5
|
|
CALL EXPR4 ;; should be EXP345
|
|
LD A,C ;Exponent
|
|
POP DE ;Type / operator
|
|
POP BC ;Count
|
|
POP IX
|
|
ITEMA7: PUSH HL
|
|
PUSH BC
|
|
PUSH DE
|
|
EXX
|
|
PUSH HL
|
|
EXX
|
|
PUSH AF
|
|
LD C,A
|
|
CALL MODIFY
|
|
POP AF
|
|
EXX
|
|
POP HL
|
|
EXX
|
|
POP DE
|
|
LD C,D
|
|
LD B,0
|
|
ADD IX,BC
|
|
POP BC
|
|
DEC BC
|
|
SBC HL,HL
|
|
SBC HL,BC
|
|
POP HL
|
|
JR NZ,ITEMA7 ;Copy into every element!
|
|
RET
|
|
;
|
|
; Process string non-array item:
|
|
;
|
|
ITEMA5: CALL EXPRS
|
|
LD A,E
|
|
OR A
|
|
JR Z,ITEMA0
|
|
LD HL,ACCS
|
|
LD DE,BUFFER
|
|
LD C,A
|
|
LD B,0
|
|
LDIR
|
|
ITEMA0: POP DE
|
|
POP BC
|
|
POP IX
|
|
EXX
|
|
LD L,A
|
|
EXX
|
|
LD DE,4
|
|
LD HL,BUFFER
|
|
ITEMA6: CALL STORE4
|
|
ADD IX,DE
|
|
DEC BC
|
|
LD A,B
|
|
OR C
|
|
JR NZ,ITEMA6 ;Copy into every element!
|
|
RET
|
|
;
|
|
; Array dot-product:
|
|
;
|
|
ARRDOT: INC IY ;Bump past dot
|
|
LD A,D ;Type
|
|
OR A
|
|
JP M,MISMAT ;'Type mismatch'
|
|
EX DE,HL
|
|
POP HL
|
|
;
|
|
; A = type
|
|
; DE = no. of elements in destination array (outer loop counter)
|
|
; IX = pointer to first source array data
|
|
; HL = pointer to destination data
|
|
; IY = text pointer
|
|
;
|
|
PUSH DE
|
|
PUSH HL
|
|
PUSH IX
|
|
PUSH AF
|
|
CALL GETARR
|
|
CALL ARRLEN
|
|
POP AF
|
|
EX DE,HL
|
|
LD L,(IX)
|
|
LD H,(IX+1) ;Indirect pointer
|
|
LD L,(HL) ;No. of dimensions
|
|
DEC L
|
|
EX DE,HL
|
|
POP IX
|
|
POP BC
|
|
POP DE
|
|
;
|
|
PUSH IY ;Save text pointer
|
|
PUSH BC ;Save destination pointer
|
|
PUSH HL
|
|
POP IY
|
|
;
|
|
; Get row counts:
|
|
;
|
|
LD HL,1
|
|
JR Z,ARR1D
|
|
LD H,(IY-1)
|
|
LD L,(IY-2)
|
|
ARR1D: PUSH AF
|
|
PUSH DE
|
|
LD C,A
|
|
LD B,0
|
|
CALL MUL16
|
|
POP DE
|
|
POP AF
|
|
LD B,(IX-1)
|
|
LD C,(IX-2)
|
|
;
|
|
; A = type, Z-flag set if first array is one-dimensional
|
|
; BC = no. of rows of first source array (inner loop counter)
|
|
; DE = no. of elements in destination array (outer loop counter)
|
|
; HL = no. of rows of second source array * size of each element
|
|
; IX = pointer to first source array
|
|
; IY = pointer to second source array
|
|
; (SP) = pointer to destination data
|
|
;
|
|
; Dot-product outer loop:
|
|
;
|
|
OUTER: PUSH BC ;1
|
|
PUSH DE ;2
|
|
PUSH HL ;3
|
|
PUSH IX ;4
|
|
PUSH IY ;5
|
|
LD D,B
|
|
LD E,C
|
|
PUSH AF
|
|
CALL ZERO ;Zero accumulator
|
|
POP AF
|
|
INNER: PUSH DE ;6
|
|
PUSH BC ;Save accumulator
|
|
PUSH HL
|
|
EXX
|
|
PUSH HL
|
|
EXX
|
|
;
|
|
CALL LOADN ;Load from (IX)
|
|
PUSH IX
|
|
EX (SP),IY
|
|
POP IX
|
|
;
|
|
CALL DLOADN ;Load from (IY)
|
|
PUSH IX
|
|
EX (SP),IY
|
|
POP IX
|
|
;
|
|
PUSH AF
|
|
LD A,10
|
|
CALL FPP ;Multiply
|
|
JP C,ERROR
|
|
POP AF
|
|
;
|
|
EXX ;Restore accumulator
|
|
EX DE,HL
|
|
POP HL
|
|
EXX
|
|
EX DE,HL
|
|
POP HL
|
|
EX AF,AF'
|
|
LD A,C
|
|
POP BC
|
|
LD B,A
|
|
EX AF,AF'
|
|
;
|
|
PUSH AF
|
|
LD A,11
|
|
CALL FPP ;Accumulate
|
|
JP C,ERROR
|
|
POP AF
|
|
;
|
|
; Bump pointers:
|
|
;
|
|
POP DE ;5
|
|
;
|
|
EXX
|
|
LD C,A
|
|
LD B,0
|
|
ADD IX,BC
|
|
POP DE
|
|
POP BC
|
|
EX (SP),HL
|
|
EX DE,HL
|
|
ADD IY,DE
|
|
EX DE,HL
|
|
EX (SP),HL
|
|
PUSH BC
|
|
PUSH DE
|
|
EXX
|
|
;
|
|
; Count inner loops:
|
|
;
|
|
DEC DE ;Inner loop counter
|
|
INC E
|
|
DEC E
|
|
JR NZ,INNER
|
|
INC D
|
|
DEC D
|
|
JR NZ,INNER
|
|
;
|
|
POP IY ;4
|
|
POP IX ;3
|
|
;
|
|
; Swap pointers:
|
|
;
|
|
EXX
|
|
EX AF,AF'
|
|
POP AF
|
|
POP BC
|
|
POP DE
|
|
EX (SP),IX
|
|
PUSH DE
|
|
PUSH BC
|
|
PUSH AF
|
|
EX AF,AF'
|
|
EXX
|
|
;
|
|
; Save to destination array and bump pointer:
|
|
;
|
|
PUSH AF
|
|
PUSH DE
|
|
CALL STOREN
|
|
POP DE
|
|
POP AF
|
|
LD C,A
|
|
LD B,0
|
|
ADD IX,BC
|
|
;
|
|
; Swap pointers:
|
|
;
|
|
EXX
|
|
EX AF,AF'
|
|
POP AF
|
|
POP BC
|
|
POP DE
|
|
EX (SP),IX
|
|
PUSH DE
|
|
PUSH BC
|
|
PUSH AF
|
|
EX AF,AF'
|
|
EXX
|
|
;
|
|
POP HL ;2
|
|
POP DE ;1 Outer loop counter
|
|
POP BC ;0
|
|
DEC DE ;Count outer loops
|
|
;
|
|
; Adjust IX & IY
|
|
;
|
|
PUSH BC
|
|
PUSH DE
|
|
PUSH HL
|
|
LD C,A
|
|
LD B,0
|
|
ADD IY,BC
|
|
PUSH AF
|
|
PUSH HL
|
|
EX DE,HL
|
|
CALL MUL16
|
|
EX DE,HL
|
|
POP BC
|
|
CALL MOD16
|
|
POP AF
|
|
OR A
|
|
LD BC,0
|
|
SBC HL,BC
|
|
POP HL
|
|
POP DE
|
|
POP BC
|
|
JR NZ,MODNZ
|
|
PUSH DE
|
|
PUSH HL
|
|
EX DE,HL
|
|
PUSH IY
|
|
POP HL
|
|
OR A
|
|
SBC HL,DE
|
|
PUSH HL
|
|
POP IY
|
|
LD L,A
|
|
LD H,0
|
|
PUSH AF
|
|
CALL MUL16
|
|
POP AF
|
|
EX DE,HL
|
|
ADD IX,DE
|
|
POP HL
|
|
POP DE
|
|
MODNZ:
|
|
;
|
|
; Count outer loops:
|
|
;
|
|
INC E
|
|
DEC E
|
|
JP NZ,OUTER
|
|
INC D
|
|
DEC D
|
|
JP NZ,OUTER
|
|
;
|
|
; Exit:
|
|
;
|
|
POP HL
|
|
POP IY
|
|
RET
|
|
;
|
|
; HL = DE MOD BC
|
|
;
|
|
MOD16: XOR A
|
|
LD H,A
|
|
LD L,A
|
|
LD A,17
|
|
MOD160: SBC HL,BC
|
|
JR NC,MOD161
|
|
ADD HL,BC
|
|
MOD161: CCF
|
|
RL E
|
|
RL D
|
|
DEC A
|
|
RET Z
|
|
ADC HL,HL
|
|
JR MOD160
|
|
;
|
|
END
|
|
|