Blame |
Last modification |
View Log
| Download
| RSS feed
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
ctype: defb 0 ;CALL type of current call operation (0/1/2/3)
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
var_ops: ;VAR:0 1 2 3 4 5 6 7
defw call_fv, zstorew, zstoreb,zpprop, zread, prchar, prnum,z_rand
defw zput, zpull, split_w, sel_w,call_fv, erase_w,erase_l,setcur
defw getcpos, style, sbfmde, ostrm, istrm, sfx, rchr, scantbl
defw znot, call_pv, call_pv, ztok, zencode, cpytab, prtbl,ck_arg
;
call_pv:
ld a,1
jr call_gen
;
callfv2:
ld b,8
ld hl,v_arg1
lp2: ld e,(hl)
inc hl
ld d,(hl)
inc hl
inc hl
inc hl
djnz lp2
call_fv:
xor a
call_gen:
ld (ctype),a
ld hl,(v_arg1) ;Packed routine address
ld a,h
or l ;<< v0.04 Return false if HL = 0
jr nz,call_g1
scf
jp ret_hl
call_g1: ;>> v0.04
call upack_addr ;Unpack it
call ipeek
ld b,a ;B = no. of local variables
ld a,(v_argc)
dec a
ld c,a ;C = no. of parameters
cp b ;IF C <= B, ok
jr c,cfv1
jr z,cfv1
ld c,b ;Ignore surplus parameters
cfv1: push hl
push de ;EHL -> start of routine
call mkframe
jp nc,spfail2
push hl
pop ix ;IX -> new frame
ld hl,(zpc)
ld (ix+0),l
ld (ix+1),h
ld hl,(zpc+2)
ld (ix+2),l
ld (ix+3),h ;Old ZPC into frame
ld (ix+35),c ;No. of parameters
ld a,c
or a
jr z,noarg
push ix
ld hl,v_arg2
arglp: ld a,(hl) ;Args copied into frame
ld (ix+4),a
inc hl
inc ix
ld a,(hl)
ld (ix+4),a
inc ix
inc hl
inc hl
inc hl
dec c
jr nz,arglp
pop ix
noarg: ld hl,(rsp)
ld a,(ctype)
ld (ix+34),a ;Procedure, function or interrupt?
ld (ix+36),l
ld (ix+37),h ;Routine stack pointer
pop hl
ld (zpc+2),hl
pop hl ;New ZPC
ld (zpc),hl
ld a,(zver) ;<< v0.04 support for v3-style calls
cp 5 ;<< v1.10 v4 uses v3-style calls >>
ccf
ret c ;v1-v4: SET up the initial values of locals
ld hl,(v_arg1) ;Packed routine address
call upack_addr ;Unpack it
call ipeek
or a
scf
ret z ;No locals
ld b,a ;B = no. of local variables
ld hl,(zsp)
ld de,4
add hl,de ;HL->local vars
ld a,(v_argc) ;A = no. of parameters (which override the
;initial values)
ld d,a ;D = no. of parameters
argl: push bc
call zpcipeek ;Get default parameter into BC
ld b,a
call zpcipeek
ld c,a
ld a,d
dec d
jr z,argl1 ;Argument was provided. Skip.
inc hl
inc hl
jr argl2
;
argl1: inc d ;To counterbalance the dec d above, so that
ld (hl),c ;the test works the next time round
inc hl ;Copy in the initial values, flipping them
ld (hl),b ;to little-endian as we go
inc hl
argl2: pop bc
djnz argl
scf
ret ;>> v0.04
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
ck_arg: ld ix,(zsp)
ld a,(v_arg1) ;Argument number to check
cp (ix+35) ;No. of arguments
jp z,branch
jp c,branch ;IF A <= no. of args, it is provided.
jp nbranch ;Not provided.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;PUSH and pop...
;
zput: ld hl,(v_arg1)
call zpush
scf
ret
;
zpull: call zpop ;HL = value
ld a,(v_arg1) ;A = variable number
scf
jp put_var
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
zstorew:
ld hl,(v_arg1)
ld de,(v_arg2)
add hl,de
add hl,de
ld bc,(v_arg3)
ld a,b
call trap_poke ; << v0.03 >> trap writes to location 11h
inc hl
ld a,c
jr trap_poke ; << v0.03 >> trap writes to location 11h
;
zstoreb:
ld hl,(v_arg1)
ld de,(v_arg2)
add hl,de
ld a,(v_arg3)
;
;<< v0.03 IF there's a write to Flags 2 (at address 11h) then flush buffers
;
trap_poke:
push af
ld a,h
or a
jr nz,trap1
ld a,l
cp 11h
jr nz,trap1
push hl
call flush_buf
call ZXUSCR
pop hl
trap1: pop af
call ZXPOKE
scf
ret
;
; >> v0.03
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
zpprop: ld de,(v_arg1) ;DE = object no.
ld a,d ;<< v1.01
or e
scf
ret z ;>> v1.01 Object 0 errors
ld bc,(v_arg2) ;C = property no.
ld hl,(v_arg3) ;HL = value
jp putprop
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Screen operations. These mostly map directly to ZXIO functions
;
erase_w:
call flush_buf
ld a,(v_arg1)
jp ZXERAW
;
erase_l:
ld a,(v_arg1)
dec a
scf
ret nz
call flush_buf
jp ZXERAL
;
split_w:
call flush_buf
ld a,(v_arg1)
jp ZXSWND
sel_w: call flush_buf
ld a,(v_arg1)
xor 1
ld (cwin),a
xor 1
jp ZXUWND
;
getcpos:
call flush_buf
call ZXGETX
push hl
call ZXGETY
ex de,hl
pop bc
ld d,0 ;DE = Y
ld b,0 ;BC = X
ld hl,(v_arg1)
ld a,b
call ZXPOKE
inc hl
ld a,c
call ZXPOKE
inc hl
ld a,d
call ZXPOKE
inc hl
ld a,e
call ZXPOKE
scf
ret
;
style: call flush_buf
ld a,(v_arg1)
jp ZXSTYL
;
setcur: call flush_buf
ld a,(v_arg1)
ld b,a
ld a,(v_arg2)
ld c,a
jp ZXSCUR
;
prchar: ld hl,(v_arg1)
call ll_zchr
scf
ret
;
sbfmde: ld a,(v_arg1) ;SET buffer mode
ld (bufmde),a
or a
call z,flush_buf
scf
ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
prnum:
ld de,numbuf
ld hl,(v_arg1)
bit 7,h ;Negative?
jr z,prnum1
ld a,'-'
ld (de),a
inc de
call neghl
prnum1: call spdec
ld a,'$'
ld (de),a
ld de,numbuf
opbuf: ld a,(de)
cp '$'
scf
ret z
ld l,a
ld h,0
push de
call ll_zchr
pop de
inc de
jr opbuf
numbuf:
defb '-00000$'
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Text entry interrupt...
;
tr_a1: defw 0
tr_a2: defw 0
tr_a3: defw 0
tr_a4: defw 0 ;Arguments
;
timer: defb 0 ;IN the timer already?
;
rch_timer:
ld c,3 ;Timer called from read_char
ld de,(v_arg3)
ld (tr_a3),de
ld hl,(v_arg4)
ld (tr_a4),hl
ld a,(timer)
or a
ret nz
inc a
ld (timer),a
jr rch_t1
;
timer_int:
ld c,2 ;Timer called from read_line
ld a,(timer)
or a
ret nz
inc a
ld (timer),a
;
;DE = routine, HL = time
;
ld (tr_a3),hl
ld (tr_a4),de
rch_t1: ld hl,(v_arg1)
ld (tr_a1),hl
ld hl,(v_arg2)
ld (tr_a2),hl
ld (v_arg1),de ;Routine address
ld a,1
ld (v_argc),a
pop hl ;Return address, we don't use this.
ld a,c
jp call_gen
;
rchr_iret:
ld hl,(tr_a1)
ld (v_arg1),hl
ld hl,(tr_a2)
ld (v_arg2),hl
ld hl,(tr_a3)
ld (v_arg3),hl
ld a,3
ld (v_argc),a
ld a,(timer)
dec a
ld (timer),a
ld a,d
or e
jp z,rchr
ld hl,0
scf
jp ret_hl
;
timer_iret:
ld hl,(tr_a1)
ld (v_arg1),hl
ld hl,(tr_a2)
ld (v_arg2),hl
ld hl,(tr_a3)
ld (v_arg3),hl
ld hl,(tr_a4)
ld (v_arg4),hl
ld a,4
ld (v_argc),a
ld a,(timer)
dec a
ld (timer),a
ld a,d
or e
jr nz,iterm
;
;The input routine wants the z-program to have printed its data for it again
;after a return from a timer interrupt...
;
ld hl,(v_arg1)
inc hl
call peek64 ;Length of line
or a
jr z,zread
ld b,a
ld a,(zver)
cp 5
jr nc,iplp1
iplp4: call peek64 ;<< v1.10 reprint input line in the v4 model
or a
jp z,sreadt ;Reprint the line
inc hl
push hl
push bc
ld l,a
ld h,0
call ll_zchr
pop bc
pop hl
jr iplp4 ;>> v1.10 end reprint input line
iplp1: inc hl
call peek64 ;Print it
push hl
push bc
ld l,a
ld h,0
call ll_zchr
pop bc
pop hl
djnz iplp1
jr zread
;
;Terminate input at once...
;
iterm: ld hl,(v_arg1) ;Input buffer
call peek64
ld b,a ;B = no. of bytes
inc b ;+1 for length
xor a
ztlp: inc hl
call ZXPOKE ;Zap the buffer
djnz ztlp
jr aread2
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Reading text
;
zread: ld a,(zver)
cp 5
jr c,sread
aread: ld hl,(v_arg1)
ld a,(v_argc)
ld de,0
cp 3
jr c,aread1
ld de,(v_arg3)
aread1: call flush_buf
call ZXINP ;Input line
ld a,b
or a ;Timeout
jr nz,aread2
ld hl,(v_arg3) ;Timeout
ld a,h
or l
jr z,aread2
ld de,(v_arg4)
ld a,d
or e
call nz,timer_int ;This function only returns if unsuccessful.
aread2:
ld hl,(v_arg1) ;<< v0.04 remove invalid characters
inc hl ;Length
call ZXPK64 ;A = actual length
or a
jr z,areadw ;No length?
ld b,a
areadv: inc hl
call ZXPK64 ;Character
call valid_char
call ZXPOKE
djnz areadv ;>> v0.04
areadw: ld hl,0dh
call ll_zchr
ld hl,(v_arg2)
ld a,h
or l
jr z,nopse
;
;Tokenise?
;
push bc
ld bc,0
ld a,c
ld hl,(v_arg1)
ld de,(v_arg2)
call tokenise
pop bc
nopse: ld l,b
ld h,0
scf
jp ret_hl
;
;<< v0.04 read for v3
;
;I'm going to do v3 input by converting the input format to v5-style before,
;and back afterwards. There's enough room, because the 1 byte for length
;matches the 1-byte terminator.
;
sreadt: call sstatus ;<< v1.10 rewritten for timer events in v4
call line_from_v5
ld hl,(v_arg1)
jr sreads
sread: call sstatus
ld hl,(v_arg1)
inc hl
xor a
call ZXPOKE ;Write current length = 0 (no passed data)
dec hl
sreads: ld de,0
ld a,(zver)
cp 4
jr c,sreadu
ld a,(v_argc)
ld de,0
cp 3
jr c,sreadu
ld de,(v_arg3) ;>> v1.10
sreadu: call flush_buf ;
call ZXINP ;Input line
push bc ;<< v1.10
call line_to_v5
pop bc ;>> v1.10
ld a,b ;<< v1.10 Handle timeouts in v4 input
or a ;Timeout
jr nz,sreadr
ld hl,(v_arg3) ;Timeout
ld a,h
or l
jr z,sreadr
ld de,(v_arg4)
ld a,d
or e
call nz,timer_int ;This function only returns if unsuccessful.
;>> v1.10
sreadr: ld hl,0dh
call ll_zchr
;
; << v1.10 >> v5 -> v4 line converter was here
;
sread1: ld hl,(v_arg2)
ld a,h
or l
scf
ret z
;
;Tokenise?
;
push bc
ld bc,0
ld a,c
ld hl,(v_arg1)
ld de,(v_arg2)
call tokenise
pop bc
scf
ret
;>> v0.04
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Read a character
;
rchr: ld a,(v_argc)
cp 2
ld de,0
jr c,rchr1
ld de,(v_arg2)
rchr1: call flush_buf
call ZXRCHR
or a
call z,rch_timer
call valid_char
ld l,a
ld h,0
scf
jp ret_hl
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Output and input streams
;
ostrm: ld a,(v_arg1)
ld hl,(v_arg2)
jp ll_strm
;
istrm: ld a,(v_arg1)
ld hl,(v_arg2)
scf ;Instruction has no effect
ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
sfx: ld hl,(v_arg1)
ld de,(v_arg2)
ld bc,(v_arg3)
call ZXSND
scf
ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
z_rand: ld hl,(v_arg1)
call random
scf
jp ret_hl
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
znot: ld hl,(v_arg1)
ld a,h
cpl
ld h,a
ld a,l
cpl
ld l,a
scf
jp ret_hl
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Tokenise & encode text
;
ztok: ld a,(v_arg4)
ld hl,(v_arg1)
ld de,(v_arg2)
ld bc,(v_arg3)
jp tokenise
;
zencode:
ld hl,(v_arg1) ;Text in
ld de,(v_arg3) ;offset
add hl,de
ld a,(v_arg2)
ld b,a
call encode
ld a,(encptr)
ld hl,(v_arg4) ;Destination
ld de,encbuf
zenc1: or a
scf
ret z
push af ;Transfer 3 Z-characters
ld a,(de)
ld b,a
call ZXPOKE
inc hl
inc de
ld a,(de)
ld c,a
call ZXPOKE
inc hl
inc de
pop af
sub 3 ;3 characters moved
ret c
jr zenc1
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Scan table for byte or word pattern
;
scantbl:
ld a,(v_argc)
cp 4
ld a,82h
jr c,scant1
ld a,(v_arg4)
scant1: bit 7,a
jr z,scanbyt
and 7Fh ;<< v1.10: Only bits 0-7 are entry size >>
ld e,a
ld d,0 ;DE = step between table entries
ld bc,(v_arg3)
ld hl,(v_arg2)
scanw1:
push de
call peek64
ld d,a
inc hl
call peek64
ld e,a ;DE = word from table
dec hl
push hl
ld hl,(v_arg1)
call cphlde
pop hl
pop de
jr z,tmatch
add hl,de
dec bc
ld a,b
or c
jr nz,scanw1
jr tnmatch
;
scanbyt:
ld e,a
ld d,0 ;DE = step between table entries
ld bc,(v_arg3) ;Table length
ld hl,(v_arg2)
scanb1: push de
call peek64
ld e,a
ld a,(v_arg1)
cp e ;Byte to find
pop de
jr z,tmatch
add hl,de
dec bc
ld a,b
or c
jr nz,scanb1
tnmatch:
ld hl,0
call ret_hl
jp nbranch
;
tmatch: call ret_hl
jp branch
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Copy_table
;
cpytab: ld hl,(v_arg2) ;Destination
ld a,l
or h
jr z,zerotab
ld de,(v_arg1) ;Source
ld bc,(v_arg3) ;Count
bit 7,b
jr nz,fwdcpy
;
;IF source < dest, use backward copy
;
call cphlde
jr c,fwdcpy
bwdcpy: add hl,bc
ex de,hl
add hl,bc
ex de,hl
bcpylp: dec de
dec hl
ex de,hl
call peek64
ex de,hl
call ZXPOKE
dec bc
ld a,b
or c
jr nz,bcpylp
scf
ret
;
fwdcpy: call absbc
fcpylp: ex de,hl
call peek64 ;Read from source
ex de,hl
call ZXPOKE ;Write to dest
inc hl
inc de
dec bc
ld a,b
or c
jr nz,fcpylp
scf
ret
;
zerotab:
ld hl,(v_arg1)
ld bc,(v_arg3) ;Size
call absbc
zerot1: xor a
call ZXPOKE
inc hl
dec bc
ld a,b
or c
jr nz,zerot1
scf
ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
prtbl: call flush_buf ;<< v0.04 >> Ensure the screen is up to date
ld a,(v_argc)
cp 3
jr nc,prtbl0 ;<< v0.04 >> IF there is 1 line, initialise
ld a,1 ; properly
ld (v_arg3),a
prtbl0: ld hl,(v_arg3) ;<< v1.04 deal with degenerate case
ld a,h ; when height is 0
or l
scf
ret z ;>> v1.04
call ZXGETX
ld e,l
call ZXGETY
ld d,l ;D=Y E=X
ld bc,(v_arg2) ;<< v1.02 rewritten for lines
ld hl,(v_arg1) ; longer than 256 chars
xor a
ld a,b ;<< v1.04 deal with degenerate case
or c ; when width is 0
scf
ret z ;>> v1.04
prtbl1: call doline
push de
ld de,(v_arg4)
add hl,de
pop de
inc a
inc d ;Next line
push hl
ld hl,v_arg3
dec (hl)
pop hl
jr nz,prtbl1 ;>> v1.02
scf
ret
;
doline: push de ;<< v1.02 rewritten for lines >256 chars
push bc
or a ;<< v0.04 Don't position the cursor if on 1st line
jr z,doln1 ;>> v0.04
ld b,d
ld c,e
inc b
inc c ;1-based
call ZXSCUR
pop bc
push bc
doln1: push bc
call peek64 ;ZSCII character
push hl
ld l,a
ld h,0
call ll_zchr
pop hl
inc hl ;HL = address of character to read
pop bc
dec bc
ld a,b
or c
jr nz,doln1
pop bc
pop de ;>> v1.02
ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; << v1.10: New line conversion functions
;
; Convert line from v3 format to v5.
;
line_to_v5:
ld hl,(v_arg1) ;input buffer
inc hl ;Length
call ZXPK64 ;A = actual length
or a
ret z ;No input; the 0 becomes a terminating null
ld b,a
sreadv: inc hl
call ZXPK64 ;Character
call valid_char ;Ensure it's valid
dec hl
call ZXPOKE ;Write it to previous slot
inc hl
djnz sreadv
sreadw:
xor a
jp ZXPOKE ;Terminating 0
;
; Convert line from v5 format to v3. Only used when recovering from a
; timeout.
;
line_from_v5:
ld hl,(v_arg1)
inc hl
ld bc,0 ;B = length, C = character being moved up
lv501: call ZXPK64
or a
jr z,l5eol
ld e,a ;E = character just read
ld a,c
call ZXPOKE ;Write character from previous slot
ld c,e ;C = next character to write back
inc hl
inc b
jr lv501
;
l5eol: ld a,c
call ZXPOKE ;Write back the last character
ld hl,(v_arg1)
inc hl
ld a,b ;A = count
jp ZXPOKE
;