DEVICE ZXSPECTRUM1024
include "in_zxzvm.asm"
macro SYSERR
jp syserr
;call syserr
endm
macro NC_SYSERR
jp nc,syserr
;call nc,syserr
endm
macro NZ_SYSERR
jp nz,syserr
;call nz,syserr
endm
peek64 equ ZXPK64
org 7000h ;Program Segment Prefix (aka Zero Page). Those
begin
jp main ;things are so useful!
zinum: defb 7 ;<< v0.02 >> Pretend to be a C128
param equ 705Ch ;Where the FCB parameter would be.
org 7100h
main: ld (isp),sp ;Save BASIC's SP
ld hl,0
ld (cycles),hl
ld de,param
call ZXINIT ;Initialise the I/O code
NC_SYSERR;jp nc,syserr
call ZXVER
ld hl,vererr
cp VMVER
NZ_SYSERR;jp nz,syserr
call ZXIHDR
NC_SYSERR;jp nc,syserr
call init_hdr
NC_SYSERR;jp nc,syserr
call init_scr
NC_SYSERR;jp nc,syserr
call init_rnd
NC_SYSERR;jp nc,syserr
call init_stack
NC_SYSERR;jp nc,syserr
call test_mem ;<< v0.02 Check we can write Z-memory
NC_SYSERR;jp nc,syserr ;>> v0.02
ld a,1
ld (running),a
call showpc
zloop: call zinst
push hl ;<< v0.02
push af
ld hl,(cycles)
inc hl
ld (cycles),hl ;CALL ZXRCPU once every 2048 z-cycles.
ld a,h
cp 8
jr c,zlp0
ld hl,0
ld (cycles),hl
call ZXRCPU
zlp0: ; v0.02 >>
zlp1: pop af
pop hl
call showpc
jp nc,zmstop
ld a,(running) ;Running = 1 to continue
dec a ; = 0 to quit
jr z,zloop ; = 2 to restart
inc a
jr z,zmexit
cp 2
jr z,zmreset
jp stub
;
zmstop: push hl
call flush_buf
call showstk
ld de,anykey
ld c,9
call ZXFDOS
ld c,6
ld e,0FDh
call ZXFDOS
pop hl
SYSERR;jp syserr
;
zmexit: call flush_buf
ld de,anykey
ld c,9
call ZXFDOS
ld c,6
ld e,0FDh
call ZXFDOS
scf
call ZXEXIT
ld sp,(isp)
ret ;<< v0.02 >> Spectrum-specific code removed
; ;from ZXZVM
zmreset:
call ZXRST ;Restart
NC_SYSERR;jp nc,syserr
call ZXIHDR
NC_SYSERR;jp nc,syserr
call init_hdr
NC_SYSERR;jp nc,syserr
call init_scr
NC_SYSERR;jp nc,syserr
call init_rnd
NC_SYSERR;jp nc,syserr
call init_stack
NC_SYSERR;jp nc,syserr
ld a,1
ld (running),a
jp zloop
stub: ld a,8
ld (5C3Ah),a
ld hl,msg1
syserr: xor a
call ZXEXIT
;pop hl
;rst 0 ;QUIT
;nop
;
;ZXEXIT should not return if called with Carry reset. But in case it does,
; reboot!
;
rst 0
di
halt
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Numerical data
;
cycles: defw 0 ;No. of Z-machine cycles executed modulo 2048
isp: defw 0 ;BASIC's SP
zsp: defw 0 ;Z-machine stack pointer
zstop: defw 0 ;Top of Z-machine stack
rsp: defw 0 ;Routine stack pointer
rstop: defw 0 ;Top of routine stack
zpc: defw 0,0 ;Z-machine program counter
zipc: defw 0,0 ;Address of last opcode (as opposed to data)
zver: defb 0 ;Version of the Z-Machine
inst: defw 0 ;Current instruction
running:
defb 0 ;SET to 1 while the Z-machine is running
;
;Some strings
;
msg1: defb '9 Stub encountere'
defb 0E4h ;'d'+80h
;
vererr: defb 'A Version mismatc'
defb 0E8h ;'h'+80h
;
memerr: defb '4 Memory test faile' ;<< v0.02
defb 0E4h ;'d'+80h;>> v0.02
;
anykey: defb 13,10,'Press SPACE to finish',13,10,'$'
;
zvbad: defb 'A Story type '
zvbuf: defb '000'
;
;;;;;;;;;;;;;;;;;;; SET up the header ;;;;;;;;;;;;;;;;;;;;;
;
init_hdr:
ld e,0
ld hl,0
call ZXPEEK ;Get Z-file version
ld (zver),a
ld de,zvbuf
ld l,a
ld h,0 ;CREATE the "invalid version" error
call spdec3
ex de,hl
dec hl
set 7,(hl) ;Fatal error, so set bit 7 of last char
ld hl,zvbad
ld a,(zver) ;v5 only?
cp 8
jr z,verok
cp 3 ;<< v0.04 v3 support
jr z,verok ;>> v0.04
cp 4 ;<< v1.10 v4 support
jr z,verok ;>> v1.10
cp 5
jp nz,ihdr8
verok: ld hl,001Eh ;Interpreter no.
ld a,(zinum) ;The interpreter number we pretend to be
call ZXPOKE
ld hl,001Fh
ld a,'I' ;<< v1.03 >> Our release number
call ZXPOKE
;
;Get g_addr, address of globals table; also strings & routines
;
ld e,0
ld hl,08h
call ZXPKWI
ld (d_addr),bc ;Dictionary
call ZXPKWI
ld (obj_addr),bc
call ZXPKWI
ld (g_addr),bc
;
ld hl,28h
call ZXPKWI
ld (r_offs),bc
call ZXPKWI
ld (s_offs),bc
;
;Work out which upack_addr to use
;
ld a,(zver)
ld l,a
ld h,0
add hl,hl
ld de,upack_table
add hl,de
ld e,(hl)
inc hl
ld d,(hl)
ld (upack_addr+1),de
;
;Compute property sizes
;
ld a,(zver)
cp 4
jr c,psv3
ld a,03Fh
ld (psmask),a
ld (pnmask),a
ld hl,14
ld (objlen),hl
ld hl,126
ld (ptlen),hl
jr psv4
psv3: ld a,0E0h
ld (psmask),a
ld a,01Fh
ld (pnmask),a
ld hl,9
ld (objlen),hl
ld hl,62
ld (ptlen),hl
psv4: scf
ret
;
ihdr8: and a
ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
init_scr:
ld a,-1 ;erase_window(-1)
call ZXERAW
xor a
ld (abbrev),a
ld (alpha),a
ld (dalpha),a
ld (shift),a
ld (multi),a
ld (timer),a
call inibuf ;Initialise I/O buffering
scf
ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Initialise the random number generator
;
init_rnd:
xor a
ld (rmode),a
ld hl,0
call random ;Seed the generator
scf
ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Stack frame format (little-endian):
;
;+0: DD pc ;Previous ZPC
;+4: DS 30 ;Local variables
;+34: DB call type ;0=function, 1=procedure, 2=interrupt
;+35: DB pcount ;Count of parameters
;+36: DW rsp ;Routine stack pointer
;
init_stack:
call ZXTMEM
inc hl ;1st unusable byte
ld (zsp),hl
ld (zstop),hl
ld de,-2048 ;2k call stack
add hl,de
ld (rsp),hl ;Routine stack
ld (rstop),hl
call mkframe ;Returns HL->frame
ret nc
push hl
pop ix ;IX -> frame
ld de,(rsp)
ld (ix+36),e
ld (ix+37),d ;Routine stack pointer
ld (ix+34),1 ;Procedure
ld (ix+35),0 ;No local variables
ld hl,6
ld e,0 ;00000006
call ZXPKWD ;PC high
ld (zpc),bc
ld bc,0
ld (zpc+2),bc
scf
ret
;
mkframe:
push de
ld hl,(zsp)
ld de,-38 ;Frame size
add hl,de
ld (zsp),hl
push hl
ld de,(rstop) ;CALL stack hits routine stack?
and a
sbc hl,de
pop hl
ccf
jp nc,spfail1 ;Stack overflow!
push hl
ld e,38
mframe1:
ld (hl),0 ;Initialise the frame to zeroes.
inc hl
dec e
jr nz,mframe1
pop hl
pop de
ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
zinst: ld hl,(zpc)
ld (zipc),hl ;Last opcode location
ld hl,(zpc+2)
ld (zipc+2),hl
call zpcipeek ;Get instruction byte
ret nc
ld (inst),a
cp 0FAh
jp z,v2_inst ;8-operand VAR
cp 0ECh
jp z,v2_inst
cp 0E0h
jp nc,var_inst
cp 0C0h
jp nc,op2_vainst
cp 0BEh
jp z,ext_inst
cp 0B0h
jp nc,op0_inst
cp 080h
jp nc,op1_inst
;
;It's a 2OP.
;
call parse_2op ;This decodes the parameters.
ld a,2
ld (v_argc),a
op2_main:
ld a,(inst)
and 1Fh
ld de,two_ops
jr dispatch
;
op2_vainst:
call zpcipeek ;Operand types
ret nc
call parse_var ;2OP with VAR parameters
jr op2_main
;
op1_inst:
ld a,1 ;<< v1.00 SET argument count correctly
ld (v_argc),a ;>> v1.00
call parse_1op
ld a,(inst)
and 0Fh
ld de,one_ops
jr dispatch
;
op0_inst:
xor a ;<< v1.00 SET argument count correctly
ld (v_argc),a ;>> v1.00
ld a,(inst)
and 0Fh
ld de,zero_ops
jr dispatch
;
ext_inst:
ld a,(zver) ;Aren't allowed extended opcodes in v1-v4
cp 5
jp c,fail
call zpcipeek ;Get real opcode
ret nc
ld (inst+1),a
call zpcipeek ;Operand types
ret nc
call parse_var
ld a,(inst+1)
bit 7,a
jp nz,ext_high
ld de,ext_ops
cp MAXEXT ;IN range?
jr c,dispatch
jr z,dispatch
jp fail
v2_inst:
call zpcipeek
ret nc
ld b,a
call zpcipeek
ret nc
ld c,a
call parse_v2
jr var_main
;
var_inst:
call zpcipeek ;Operand types
ret nc
call parse_var ;Count in argc, args in arg1-arg4
var_main:
ld a,(inst)
and 1Fh
ld de,var_ops
dispatch:
ld l,a
ld h,0
add hl,hl
add hl,de
ld e,(hl)
inc hl
ld d,(hl)
ex de,hl
jp (hl)
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Utility code to read the Z-machine's memory
;
ipeek: call ZXPEEK
push af
inc hl
ld a,h
or l
jr nz,ipeek1
inc e
ipeek1: pop af
ret
;
zpcipeek:
push hl
push de
ld hl,(zpc)
ld de,(zpc+2)
call ipeek
ld (zpc),hl
ld (zpc+2),de
pop de
pop hl
ret
;
zpcpeek:
push hl
push de
ld hl,(zpc)
ld de,(zpc+2)
call ZXPEEK
pop de
pop hl
ret
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; << v0.02 Check that Z-machine memory is writable. IF not, then
; we can't run.
;
test_mem:
ld hl,40h
call ZXPK64
ld d,a ;Correct value
cpl
ld e,a ;Different value
call ZXPOKE
call ZXPK64
cp e ;Has the change registered?
jr nz,tm_fail
ld a,d ;Change back to the correct value.
call ZXPOKE
call ZXPK64
cp d ;Has the change back registered?
jr nz,tm_fail
scf
ret
;
tm_fail:
ld hl,memerr
xor a
ret
; >> v0.02
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;Other source files
;
include "vmdebug.asm" ;Debugging ops
include "vmvar.asm" ;Access to variables & operand decoding
include "vm0ops.asm" ;0OP: operations
include "vm1ops.asm" ;1OP: operations
include "vm2ops.asm" ;2OP: operations
include "vmvops.asm" ;VAR: operations
include "vmeops.asm" ;EXT: operations
include "vmarith.asm" ;Arithmetic operations
include "vmobj.asm" ;Object operations
include "vmprop.asm" ;Property operations
include "vmzchar.asm" ;I/O and buffering
include "vmdict.asm" ;Dictionary oprations
include "in_wrhex.asm" ;Output hex and decimal numbers
end
savebin "vm.bin",begin,end-begin
;LABELSLIST "../../us/user.l"