4933 lines
60 KiB
ArmAsm
4933 lines
60 KiB
ArmAsm
#
|
|
! This program is an EM interpreter for the Z80.
|
|
! Register pair bc is used to hold lb.
|
|
! Register ix is used to hold the EM program counter.
|
|
! The interpreter assumes 16-bit words and 16-bit pointers.
|
|
|
|
! #define CPM1 1
|
|
|
|
! Definitions:
|
|
zone = 8 ! size of subroutine call block (address + old lb)
|
|
bdos = 5 ! standard entry into I/O-routines
|
|
boot = 0
|
|
fcb = 0x5c ! file descriptor of EM-1 file (5C hex)
|
|
|
|
reset=0
|
|
delete=19
|
|
makefile=22
|
|
close=16
|
|
readconsole = 10
|
|
writeconsole = 2
|
|
open = 15
|
|
read = 20
|
|
write = 21
|
|
setdma = 26
|
|
printstring = 9
|
|
seqread = 20
|
|
randomread = 33
|
|
seqwrite = 21
|
|
randomwrite = 34
|
|
consolein = 1
|
|
diconio = 6
|
|
RAW=0 !0 for cooked,1 for raw io
|
|
|
|
timebuf=0xFFDE
|
|
|
|
b_lolp = 176
|
|
b_loln = 179
|
|
b_lof = 161
|
|
b_loi = 168
|
|
b_lal = 130
|
|
b_lil = 146
|
|
b_stlm = 227
|
|
b_stf = 214
|
|
b_sti = 218
|
|
b_inl = 112
|
|
b_cal = 63
|
|
b_asp = 44
|
|
b_zrl = 249
|
|
|
|
EARRAY = 0
|
|
ERANGE = 1
|
|
EILLINS=18
|
|
EILLSIZE=19
|
|
ECASE=20
|
|
EMON=25
|
|
|
|
!--------------------------- Initialization ---------------------------
|
|
|
|
.base 0x100
|
|
|
|
jp init ! 3 byte instruction.
|
|
|
|
!------------------------- MAIN DISPATCH ------------------------------
|
|
!
|
|
! must be put in a suitable place in memory to reduce memory usage
|
|
! must be put on a page boundary
|
|
|
|
|
|
dispat = . - 3 ! base of dispatch table
|
|
! .byte loc.0 /256
|
|
! .byte loc.1 /256
|
|
! .byte loc.2 /256
|
|
.byte loc.3 /256
|
|
.byte loc.4 /256
|
|
.byte loc.5 /256
|
|
.byte loc.6 /256
|
|
.byte loc.7 /256
|
|
.byte loc.8 /256
|
|
.byte loc.9 /256
|
|
.byte loc.10 /256
|
|
.byte loc.11 /256
|
|
.byte loc.12 /256
|
|
.byte loc.13 /256
|
|
.byte loc.14 /256
|
|
.byte loc.15 /256
|
|
.byte loc.16 /256
|
|
.byte loc.17 /256
|
|
.byte loc.18 /256
|
|
.byte loc.19 /256
|
|
.byte loc.20 /256
|
|
.byte loc.21 /256
|
|
.byte loc.22 /256
|
|
.byte loc.23 /256
|
|
.byte loc.24 /256
|
|
.byte loc.25 /256
|
|
.byte loc.26 /256
|
|
.byte loc.27 /256
|
|
.byte loc.28 /256
|
|
.byte loc.29 /256
|
|
.byte loc.30 /256
|
|
.byte loc.31 /256
|
|
.byte loc.32 /256
|
|
.byte loc.33 /256
|
|
.byte aar.2 /256
|
|
.byte adf.s0 /256
|
|
.byte adi.2 /256
|
|
.byte adi.4 /256
|
|
.byte adp.l /256
|
|
.byte adp.1 /256
|
|
.byte adp.2 /256
|
|
.byte adp.s0 /256
|
|
.byte adp.sm1 /256
|
|
.byte ads.2 /256
|
|
.byte and.2 /256
|
|
.byte asp.2 /256
|
|
.byte asp.4 /256
|
|
.byte asp.6 /256
|
|
.byte asp.8 /256
|
|
.byte asp.10 /256
|
|
.byte asp.w0 /256
|
|
.byte beq.l /256
|
|
.byte beq.s0 /256
|
|
.byte bge.s0 /256
|
|
.byte bgt.s0 /256
|
|
.byte ble.s0 /256
|
|
.byte blm.s0 /256
|
|
.byte blt.s0 /256
|
|
.byte bne.s0 /256
|
|
.byte bra.l /256
|
|
.byte bra.sm1 /256
|
|
.byte bra.sm2 /256
|
|
.byte bra.s0 /256
|
|
.byte bra.s1 /256
|
|
.byte cal.1 /256
|
|
.byte cal.2 /256
|
|
.byte cal.3 /256
|
|
.byte cal.4 /256
|
|
.byte cal.5 /256
|
|
.byte cal.6 /256
|
|
.byte cal.7 /256
|
|
.byte cal.8 /256
|
|
.byte cal.9 /256
|
|
.byte cal.10 /256
|
|
.byte cal.11 /256
|
|
.byte cal.12 /256
|
|
.byte cal.13 /256
|
|
.byte cal.14 /256
|
|
.byte cal.15 /256
|
|
.byte cal.16 /256
|
|
.byte cal.17 /256
|
|
.byte cal.18 /256
|
|
.byte cal.19 /256
|
|
.byte cal.20 /256
|
|
.byte cal.21 /256
|
|
.byte cal.22 /256
|
|
.byte cal.23 /256
|
|
.byte cal.24 /256
|
|
.byte cal.25 /256
|
|
.byte cal.26 /256
|
|
.byte cal.27 /256
|
|
.byte cal.28 /256
|
|
.byte cal.s0 /256
|
|
.byte cff.z /256
|
|
.byte cif.z /256
|
|
.byte cii.z /256
|
|
.byte cmf.s0 /256
|
|
.byte cmi.2 /256
|
|
.byte cmi.4 /256
|
|
.byte cmp.z /256
|
|
.byte cms.s0 /256
|
|
.byte csa.2 /256
|
|
.byte csb.2 /256
|
|
.byte dec.z /256
|
|
.byte dee.w0 /256
|
|
.byte del.wm1 /256
|
|
.byte dup.2 /256
|
|
.byte dvf.s0 /256
|
|
.byte dvi.2 /256
|
|
.byte fil.l /256
|
|
.byte inc.z /256
|
|
.byte ine.l /256
|
|
.byte ine.w0 /256
|
|
.byte inl.m2 /256
|
|
.byte inl.m4 /256
|
|
.byte inl.m6 /256
|
|
.byte inl.wm1 /256
|
|
.byte inn.s0 /256
|
|
.byte ior.2 /256
|
|
.byte ior.s0 /256
|
|
.byte lae.l /256
|
|
.byte lae.w0 /256
|
|
.byte lae.w1 /256
|
|
.byte lae.w2 /256
|
|
.byte lae.w3 /256
|
|
.byte lae.w4 /256
|
|
.byte lae.w5 /256
|
|
.byte lae.w6 /256
|
|
.byte lal.p /256
|
|
.byte lal.n /256
|
|
.byte lal.0 /256
|
|
.byte lal.m1 /256
|
|
.byte lal.w0 /256
|
|
.byte lal.wm1 /256
|
|
.byte lal.wm2 /256
|
|
.byte lar.2 /256
|
|
.byte ldc.0 /256
|
|
.byte lde.l /256
|
|
.byte lde.w0 /256
|
|
.byte ldl.0 /256
|
|
.byte ldl.wm1 /256
|
|
.byte lfr.2 /256
|
|
.byte lfr.4 /256
|
|
.byte lfr.s0 /256
|
|
.byte lil.wm1 /256
|
|
.byte lil.w0 /256
|
|
.byte lil.0 /256
|
|
.byte lil.2 /256
|
|
.byte lin.l /256
|
|
.byte lin.s0 /256
|
|
.byte lni.z /256
|
|
.byte loc.l /256
|
|
.byte loc.m1 /256
|
|
.byte loc.s0 /256
|
|
.byte loc.sm1 /256
|
|
.byte loe.l /256
|
|
.byte loe.w0 /256
|
|
.byte loe.w1 /256
|
|
.byte loe.w2 /256
|
|
.byte loe.w3 /256
|
|
.byte loe.w4 /256
|
|
.byte lof.l /256
|
|
.byte lof.2 /256
|
|
.byte lof.4 /256
|
|
.byte lof.6 /256
|
|
.byte lof.8 /256
|
|
.byte lof.s0 /256
|
|
.byte loi.l /256
|
|
.byte loi.1 /256
|
|
.byte loi.2 /256
|
|
.byte loi.4 /256
|
|
.byte loi.6 /256
|
|
.byte loi.8 /256
|
|
.byte loi.s0 /256
|
|
.byte lol.p /256
|
|
.byte lol.n /256
|
|
.byte lol.0 /256
|
|
.byte lol.2 /256
|
|
.byte lol.4 /256
|
|
.byte lol.6 /256
|
|
.byte lol.m2 /256
|
|
.byte lol.m4 /256
|
|
.byte lol.m6 /256
|
|
.byte lol.m8 /256
|
|
.byte lol.m10 /256
|
|
.byte lol.m12 /256
|
|
.byte lol.m14 /256
|
|
.byte lol.m16 /256
|
|
.byte lol.w0 /256
|
|
.byte lol.wm1 /256
|
|
.byte lxa.1 /256
|
|
.byte lxl.1 /256
|
|
.byte lxl.2 /256
|
|
.byte mlf.s0 /256
|
|
.byte mli.2 /256
|
|
.byte mli.4 /256
|
|
.byte rck.2 /256
|
|
.byte ret.0 /256
|
|
.byte ret.2 /256
|
|
.byte ret.s0 /256
|
|
.byte rmi.2 /256
|
|
.byte sar.2 /256
|
|
.byte sbf.s0 /256
|
|
.byte sbi.2 /256
|
|
.byte sbi.4 /256
|
|
.byte sdl.wm1 /256
|
|
.byte set.s0 /256
|
|
.byte sil.wm1 /256
|
|
.byte sil.w0 /256
|
|
.byte sli.2 /256
|
|
.byte ste.l /256
|
|
.byte ste.w0 /256
|
|
.byte ste.w1 /256
|
|
.byte ste.w2 /256
|
|
.byte stf.l /256
|
|
.byte stf.2 /256
|
|
.byte stf.4 /256
|
|
.byte stf.s0 /256
|
|
.byte sti.1 /256
|
|
.byte sti.2 /256
|
|
.byte sti.4 /256
|
|
.byte sti.6 /256
|
|
.byte sti.8 /256
|
|
.byte sti.s0 /256
|
|
.byte stl.p /256
|
|
.byte stl.n /256
|
|
.byte stl.p0 /256
|
|
.byte stl.p2 /256
|
|
.byte stl.m2 /256
|
|
.byte stl.m4 /256
|
|
.byte stl.m6 /256
|
|
.byte stl.m8 /256
|
|
.byte stl.m10 /256
|
|
.byte stl.wm1 /256
|
|
.byte teq.z /256
|
|
.byte tgt.z /256
|
|
.byte tlt.z /256
|
|
.byte tne.z /256
|
|
.byte zeq.l /256
|
|
.byte zeq.s0 /256
|
|
.byte zeq.s1 /256
|
|
.byte zer.s0 /256
|
|
.byte zge.s0 /256
|
|
.byte zgt.s0 /256
|
|
.byte zle.s0 /256
|
|
.byte zlt.s0 /256
|
|
.byte zne.s0 /256
|
|
.byte zne.sm1 /256
|
|
.byte zre.l /256
|
|
.byte zre.w0 /256
|
|
.byte zrl.m2 /256
|
|
.byte zrl.m4 /256
|
|
.byte zrl.wm1 /256
|
|
.byte zrl.n /256
|
|
.byte loop1 /256
|
|
.byte loop2 /256
|
|
|
|
.errnz .-dispat-256
|
|
|
|
.byte loc.0 %256
|
|
.byte loc.1 %256
|
|
.byte loc.2 %256
|
|
.byte loc.3 %256
|
|
.byte loc.4 %256
|
|
.byte loc.5 %256
|
|
.byte loc.6 %256
|
|
.byte loc.7 %256
|
|
.byte loc.8 %256
|
|
.byte loc.9 %256
|
|
.byte loc.10 %256
|
|
.byte loc.11 %256
|
|
.byte loc.12 %256
|
|
.byte loc.13 %256
|
|
.byte loc.14 %256
|
|
.byte loc.15 %256
|
|
.byte loc.16 %256
|
|
.byte loc.17 %256
|
|
.byte loc.18 %256
|
|
.byte loc.19 %256
|
|
.byte loc.20 %256
|
|
.byte loc.21 %256
|
|
.byte loc.22 %256
|
|
.byte loc.23 %256
|
|
.byte loc.24 %256
|
|
.byte loc.25 %256
|
|
.byte loc.26 %256
|
|
.byte loc.27 %256
|
|
.byte loc.28 %256
|
|
.byte loc.29 %256
|
|
.byte loc.30 %256
|
|
.byte loc.31 %256
|
|
.byte loc.32 %256
|
|
.byte loc.33 %256
|
|
.byte aar.2 %256
|
|
.byte adf.s0 %256
|
|
.byte adi.2 %256
|
|
.byte adi.4 %256
|
|
.byte adp.l %256
|
|
.byte adp.1 %256
|
|
.byte adp.2 %256
|
|
.byte adp.s0 %256
|
|
.byte adp.sm1 %256
|
|
.byte ads.2 %256
|
|
.byte and.2 %256
|
|
.byte asp.2 %256
|
|
.byte asp.4 %256
|
|
.byte asp.6 %256
|
|
.byte asp.8 %256
|
|
.byte asp.10 %256
|
|
.byte asp.w0 %256
|
|
.byte beq.l %256
|
|
.byte beq.s0 %256
|
|
.byte bge.s0 %256
|
|
.byte bgt.s0 %256
|
|
.byte ble.s0 %256
|
|
.byte blm.s0 %256
|
|
.byte blt.s0 %256
|
|
.byte bne.s0 %256
|
|
.byte bra.l %256
|
|
.byte bra.sm1 %256
|
|
.byte bra.sm2 %256
|
|
.byte bra.s0 %256
|
|
.byte bra.s1 %256
|
|
.byte cal.1 %256
|
|
.byte cal.2 %256
|
|
.byte cal.3 %256
|
|
.byte cal.4 %256
|
|
.byte cal.5 %256
|
|
.byte cal.6 %256
|
|
.byte cal.7 %256
|
|
.byte cal.8 %256
|
|
.byte cal.9 %256
|
|
.byte cal.10 %256
|
|
.byte cal.11 %256
|
|
.byte cal.12 %256
|
|
.byte cal.13 %256
|
|
.byte cal.14 %256
|
|
.byte cal.15 %256
|
|
.byte cal.16 %256
|
|
.byte cal.17 %256
|
|
.byte cal.18 %256
|
|
.byte cal.19 %256
|
|
.byte cal.20 %256
|
|
.byte cal.21 %256
|
|
.byte cal.22 %256
|
|
.byte cal.23 %256
|
|
.byte cal.24 %256
|
|
.byte cal.25 %256
|
|
.byte cal.26 %256
|
|
.byte cal.27 %256
|
|
.byte cal.28 %256
|
|
.byte cal.s0 %256
|
|
.byte cff.z %256
|
|
.byte cif.z %256
|
|
.byte cii.z %256
|
|
.byte cmf.s0 %256
|
|
.byte cmi.2 %256
|
|
.byte cmi.4 %256
|
|
.byte cmp.z %256
|
|
.byte cms.s0 %256
|
|
.byte csa.2 %256
|
|
.byte csb.2 %256
|
|
.byte dec.z %256
|
|
.byte dee.w0 %256
|
|
.byte del.wm1 %256
|
|
.byte dup.2 %256
|
|
.byte dvf.s0 %256
|
|
.byte dvi.2 %256
|
|
.byte fil.l %256
|
|
.byte inc.z %256
|
|
.byte ine.l %256
|
|
.byte ine.w0 %256
|
|
.byte inl.m2 %256
|
|
.byte inl.m4 %256
|
|
.byte inl.m6 %256
|
|
.byte inl.wm1 %256
|
|
.byte inn.s0 %256
|
|
.byte ior.2 %256
|
|
.byte ior.s0 %256
|
|
.byte lae.l %256
|
|
.byte lae.w0 %256
|
|
.byte lae.w1 %256
|
|
.byte lae.w2 %256
|
|
.byte lae.w3 %256
|
|
.byte lae.w4 %256
|
|
.byte lae.w5 %256
|
|
.byte lae.w6 %256
|
|
.byte lal.p %256
|
|
.byte lal.n %256
|
|
.byte lal.0 %256
|
|
.byte lal.m1 %256
|
|
.byte lal.w0 %256
|
|
.byte lal.wm1 %256
|
|
.byte lal.wm2 %256
|
|
.byte lar.2 %256
|
|
.byte ldc.0 %256
|
|
.byte lde.l %256
|
|
.byte lde.w0 %256
|
|
.byte ldl.0 %256
|
|
.byte ldl.wm1 %256
|
|
.byte lfr.2 %256
|
|
.byte lfr.4 %256
|
|
.byte lfr.s0 %256
|
|
.byte lil.wm1 %256
|
|
.byte lil.w0 %256
|
|
.byte lil.0 %256
|
|
.byte lil.2 %256
|
|
.byte lin.l %256
|
|
.byte lin.s0 %256
|
|
.byte lni.z %256
|
|
.byte loc.l %256
|
|
.byte loc.m1 %256
|
|
.byte loc.s0 %256
|
|
.byte loc.sm1 %256
|
|
.byte loe.l %256
|
|
.byte loe.w0 %256
|
|
.byte loe.w1 %256
|
|
.byte loe.w2 %256
|
|
.byte loe.w3 %256
|
|
.byte loe.w4 %256
|
|
.byte lof.l %256
|
|
.byte lof.2 %256
|
|
.byte lof.4 %256
|
|
.byte lof.6 %256
|
|
.byte lof.8 %256
|
|
.byte lof.s0 %256
|
|
.byte loi.l %256
|
|
.byte loi.1 %256
|
|
.byte loi.2 %256
|
|
.byte loi.4 %256
|
|
.byte loi.6 %256
|
|
.byte loi.8 %256
|
|
.byte loi.s0 %256
|
|
.byte lol.p %256
|
|
.byte lol.n %256
|
|
.byte lol.0 %256
|
|
.byte lol.2 %256
|
|
.byte lol.4 %256
|
|
.byte lol.6 %256
|
|
.byte lol.m2 %256
|
|
.byte lol.m4 %256
|
|
.byte lol.m6 %256
|
|
.byte lol.m8 %256
|
|
.byte lol.m10 %256
|
|
.byte lol.m12 %256
|
|
.byte lol.m14 %256
|
|
.byte lol.m16 %256
|
|
.byte lol.w0 %256
|
|
.byte lol.wm1 %256
|
|
.byte lxa.1 %256
|
|
.byte lxl.1 %256
|
|
.byte lxl.2 %256
|
|
.byte mlf.s0 %256
|
|
.byte mli.2 %256
|
|
.byte mli.4 %256
|
|
.byte rck.2 %256
|
|
.byte ret.0 %256
|
|
.byte ret.2 %256
|
|
.byte ret.s0 %256
|
|
.byte rmi.2 %256
|
|
.byte sar.2 %256
|
|
.byte sbf.s0 %256
|
|
.byte sbi.2 %256
|
|
.byte sbi.4 %256
|
|
.byte sdl.wm1 %256
|
|
.byte set.s0 %256
|
|
.byte sil.wm1 %256
|
|
.byte sil.w0 %256
|
|
.byte sli.2 %256
|
|
.byte ste.l %256
|
|
.byte ste.w0 %256
|
|
.byte ste.w1 %256
|
|
.byte ste.w2 %256
|
|
.byte stf.l %256
|
|
.byte stf.2 %256
|
|
.byte stf.4 %256
|
|
.byte stf.s0 %256
|
|
.byte sti.1 %256
|
|
.byte sti.2 %256
|
|
.byte sti.4 %256
|
|
.byte sti.6 %256
|
|
.byte sti.8 %256
|
|
.byte sti.s0 %256
|
|
.byte stl.p %256
|
|
.byte stl.n %256
|
|
.byte stl.p0 %256
|
|
.byte stl.p2 %256
|
|
.byte stl.m2 %256
|
|
.byte stl.m4 %256
|
|
.byte stl.m6 %256
|
|
.byte stl.m8 %256
|
|
.byte stl.m10 %256
|
|
.byte stl.wm1 %256
|
|
.byte teq.z %256
|
|
.byte tgt.z %256
|
|
.byte tlt.z %256
|
|
.byte tne.z %256
|
|
.byte zeq.l %256
|
|
.byte zeq.s0 %256
|
|
.byte zeq.s1 %256
|
|
.byte zer.s0 %256
|
|
.byte zge.s0 %256
|
|
.byte zgt.s0 %256
|
|
.byte zle.s0 %256
|
|
.byte zlt.s0 %256
|
|
.byte zne.s0 %256
|
|
.byte zne.sm1 %256
|
|
.byte zre.l %256
|
|
.byte zre.w0 %256
|
|
.byte zrl.m2 %256
|
|
.byte zrl.m4 %256
|
|
.byte zrl.wm1 %256
|
|
.byte zrl.n %256
|
|
.byte loop1 %256
|
|
.byte loop2 %256
|
|
|
|
.errnz .-dispat-512
|
|
|
|
!----------------- END OF MAIN DISPATCH -------------------------------
|
|
|
|
init:
|
|
ld sp,(bdos+1) ! address of fbase
|
|
ld hl,dispat
|
|
ld (hl),loc.0/256
|
|
inc hl
|
|
ld (hl),loc.1/256
|
|
inc hl
|
|
ld (hl),loc.2/256
|
|
call uxinit
|
|
warmstart:
|
|
ld sp,(bdos+1) ! address of fbase
|
|
call makeargv
|
|
ld de,0x80
|
|
ld c,setdma
|
|
call bdos
|
|
ld c,open
|
|
ld de,fcb
|
|
call bdos
|
|
inc a
|
|
jr z,bademfile
|
|
ld c,read
|
|
ld de,fcb
|
|
call bdos
|
|
or a
|
|
jr nz,bademfile ! no file
|
|
ld de,header
|
|
ld hl,0x90 ! start of 2nd half of header
|
|
ld bc,10 ! we copy only first 5 words
|
|
ldir
|
|
ld de,(ntext) ! size of program text in bytes
|
|
ld hl,0
|
|
sbc hl,de
|
|
add hl,sp
|
|
ld sp,hl ! save space for program
|
|
ld (pb),hl ! set procedure base
|
|
ld a,0xa0
|
|
ld (nextp),a
|
|
ld de,(ntext)
|
|
xor a
|
|
ld h,a
|
|
ld l,a
|
|
sbc hl,de
|
|
ex de,hl
|
|
ld h,a
|
|
ld l,a
|
|
add hl,sp
|
|
1: call getb
|
|
ld (hl),c
|
|
inc hl
|
|
inc e
|
|
jr nz,1b
|
|
inc d
|
|
jr nz,1b
|
|
! now program text has been read,so start read-
|
|
ld iy,0 ! ing data descriptors, (nextp) (was hl) is
|
|
ld ix,eb+eb%2 ! pointer into DMA,ix is pointer into global
|
|
! data area,iy is #bytes pushed in last instr (used for repeat)
|
|
rddata: ld hl,(ndata)
|
|
ld a,h
|
|
or l
|
|
jr z,prdes ! no data left
|
|
dec hl
|
|
ld (ndata),hl
|
|
call getb ! read 1 byte (here:init type) into register c
|
|
dec c
|
|
jp p,2f
|
|
call getw
|
|
push iy
|
|
pop hl
|
|
ld a,h
|
|
or l
|
|
jr z,5f ! size of block is zero, so no work
|
|
push hl
|
|
push bc
|
|
3: pop hl ! #repeats
|
|
pop bc ! block size
|
|
push bc
|
|
ld a,h
|
|
or l
|
|
jr z,4f ! ready
|
|
dec hl
|
|
push hl
|
|
push ix
|
|
pop hl
|
|
add ix,bc
|
|
dec hl
|
|
ld d,h
|
|
ld e,l
|
|
add hl,bc
|
|
ex de,hl
|
|
lddr
|
|
jr 3b
|
|
4: pop bc
|
|
5: ld iy,0 ! now last instruction = repeat = type 0
|
|
jr rddata
|
|
2: ld b,c ! here other types come
|
|
jr nz,2f ! Z-flag was (re-)set when decrementing c
|
|
call getb ! uninitialized words, fetch #words
|
|
sla c
|
|
rl b
|
|
ld iy,0
|
|
add iy,bc
|
|
add ix,bc
|
|
4: jr rddata
|
|
2: call getb ! remaining types, first fetch #bytes/words
|
|
ld a,b
|
|
cp 7
|
|
jr z,rdflt
|
|
jp p,bademfile ! floats are not accepted,nor are illegal types
|
|
ld b,0
|
|
cp 1
|
|
jr z,2f
|
|
cp 5
|
|
jp m,1f
|
|
2: ld iy,0 ! initialized bytes, simply copy from EM-1 file
|
|
add iy,bc
|
|
ld b,c ! #bytes
|
|
3:
|
|
call getb
|
|
ld (ix),c
|
|
inc ix
|
|
djnz 3b
|
|
jr 4b
|
|
1: cp 2
|
|
jr z,2f
|
|
cp 3
|
|
jr z,3f
|
|
ld hl,(pb)
|
|
jr 4f
|
|
3: ld hl,eb+eb%2
|
|
jr 4f
|
|
2: ld hl,0
|
|
4: ld (ntext),hl ! ntext is used here to hold base address of
|
|
ld iy,0 ! correct type: data,instr or 0 (plain numbers)
|
|
add iy,bc
|
|
add iy,bc
|
|
ld b,c
|
|
1:
|
|
push bc
|
|
ex de,hl ! save e into l
|
|
call getw
|
|
ex de,hl
|
|
ld hl,(ntext)
|
|
add hl,bc
|
|
ld (ix),l
|
|
inc ix
|
|
ld (ix),h
|
|
inc ix
|
|
pop bc
|
|
djnz 1b
|
|
2: jr rddata
|
|
rdflt:
|
|
ld a,c
|
|
cp 4
|
|
jr nz,bademfile
|
|
push ix
|
|
pop hl
|
|
1: call getb
|
|
ld a,c
|
|
ld (hl),a
|
|
inc hl
|
|
or a
|
|
jr nz,1b
|
|
push ix
|
|
pop hl
|
|
call atof
|
|
ld b,4
|
|
1: ld a,(hl)
|
|
ld (ix),a
|
|
inc ix
|
|
inc hl
|
|
djnz 1b
|
|
jr rddata
|
|
|
|
bademfile:
|
|
ld c,printstring
|
|
ld de,1f
|
|
call bdos
|
|
jp 0
|
|
1: .ascii 'load file error\r\n$'
|
|
|
|
! now all data has been read,so on with the procedure descriptors
|
|
prdes:
|
|
ld (hp),ix ! initialize heap pointer
|
|
ld de,(nproc)
|
|
ld hl,0
|
|
xor a
|
|
sbc hl,de
|
|
add hl,hl
|
|
add hl,hl ! 4 bytes per proc-descriptor
|
|
add hl,sp
|
|
ld sp,hl ! save space for procedure descriptors
|
|
push hl
|
|
pop ix
|
|
ld (pd),hl ! initialize base
|
|
ld hl,(nproc)
|
|
1: ld a,h
|
|
or l
|
|
jr z,2f
|
|
dec hl
|
|
call getb
|
|
ld (ix),c
|
|
inc ix
|
|
call getb
|
|
ld (ix),c
|
|
inc ix
|
|
call getw
|
|
ex de,hl
|
|
ld hl,(pb)
|
|
add hl,bc
|
|
ld (ix),l
|
|
inc ix
|
|
ld (ix),h
|
|
inc ix
|
|
ex de,hl
|
|
jr 1b
|
|
2:
|
|
ld de,(entry) ! get ready for start of program
|
|
ld ix,0 ! reta, jumping here will stop execution
|
|
push ix
|
|
ld hl,argv
|
|
push hl
|
|
ld hl,(argc)
|
|
push hl
|
|
jr cal ! call EM-1 main program
|
|
|
|
getw: call getb
|
|
ld b,c
|
|
call getb
|
|
ld a,b
|
|
ld b,c
|
|
ld c,a
|
|
ret
|
|
getb: push hl ! getb reads 1 byte in register c from standard
|
|
push de
|
|
ld a,(nextp) ! DMA buffer and refills if necessary
|
|
or a
|
|
jr nz,1f
|
|
push bc
|
|
ld c,read
|
|
ld de,fcb
|
|
call bdos
|
|
or a
|
|
jr nz,bademfile
|
|
pop bc
|
|
ld a,0x80
|
|
1: ld l,a
|
|
ld h,0
|
|
ld c,(hl)
|
|
inc a
|
|
ld (nextp),a
|
|
pop de
|
|
pop hl
|
|
ret
|
|
|
|
!------------------------- Main loop of the interpreter ---------------
|
|
|
|
phl: push hl
|
|
loop:
|
|
.errnz dispat%256
|
|
ld l,(ix) ! l = opcode byte
|
|
inc ix ! advance program counter
|
|
ld h,dispat/256 ! hl=address of high byte of jumpaddress
|
|
ld d,(hl) ! d=high byte of jump address
|
|
inc h ! hl=address of low byte of jumpaddress
|
|
ld e,(hl) ! de=jumpaddress
|
|
xor a ! clear a and carry
|
|
ld h,a ! and clear h
|
|
ex de,hl ! d:=0; hl:=jumpaddress
|
|
jp (hl) ! go execute the routine
|
|
|
|
loop1: ld e,(ix) ! e = opcode byte
|
|
inc ix ! advance EM program counter to next byte
|
|
ld hl,dispat1 ! hl = address of dispatching table
|
|
xor a
|
|
ld d,a
|
|
add hl,de ! compute address of routine for this opcode
|
|
add hl,de ! hl = address of routine to dispatch to
|
|
ld d,(hl) ! e = low byte of routine address
|
|
inc hl ! hl now points to 2nd byte of routine address
|
|
ld h,(hl) ! h = high byte of routine address
|
|
ld l,d ! hl = address of routine
|
|
ld d,a
|
|
jp (hl) ! go execute the routine
|
|
|
|
loop2: ld e,(ix) ! e = opcode byte
|
|
inc ix ! advance EM program counter to next byte
|
|
ld hl,dispat2 ! hl = address of dispatching table
|
|
xor a
|
|
ld d,a
|
|
add hl,de ! compute address of routine for this opcode
|
|
add hl,de ! hl = address of routine to dispatch to
|
|
ld d,(hl) ! e = low byte of routine address
|
|
inc hl ! hl now points to 2nd byte of routine address
|
|
ld h,(hl) ! h = high byte of routine address
|
|
ld l,d ! hl = address of routine
|
|
ld d,a
|
|
jp (hl) ! go execute the routine
|
|
|
|
! Note that d and a are both still 0, and the carry bit is cleared.
|
|
! The execution routines make heavy use of these properties.
|
|
! The reason that the carry bit is cleared is a little subtle, since the
|
|
! two instructions add hl,de affect it. However, since dispat is being
|
|
! added twice a number < 256, no carry can occur.
|
|
|
|
|
|
|
|
!---------------------- Routines to compute addresses of locals -------
|
|
|
|
! There are four addressing routines, corresponding to four ways the
|
|
! offset can be represented:
|
|
! loml: 16-bit offset. Codes 1-32767 mean offsets -2 to -65534 bytes
|
|
! loms: 8-bit offset. Codes 1-255 mean offsets -2 to -510 bytes
|
|
! lopl: 16-bit offset. Codes 0-32767 mean offsets 0 to +65534 bytes
|
|
! lops: 8-bit offset. Codes 0-255 mean offsets 0 to +510 bytes
|
|
|
|
loml: ld d,(ix) ! loml is for 16-bit offsets with implied minus
|
|
inc ix
|
|
jr 1f
|
|
loms:
|
|
dec d
|
|
1: ld e,(ix) ! loms is for 8-bit offsets with implied minus
|
|
inc ix
|
|
ld h,b
|
|
ld l,c ! hl = bc
|
|
add hl,de
|
|
add hl,de ! hl now equals lb - byte offset
|
|
jp (iy)
|
|
|
|
lopl: ld d,(ix) ! lopl is for 16-bit offsets >= 0
|
|
inc ix
|
|
lops: ld h,d
|
|
ld l,(ix) ! fetch low order byte of offset
|
|
inc ix
|
|
add hl,hl ! convert offset to bytes
|
|
ld de,zone ! to account of return address zone
|
|
add hl,de
|
|
add hl,bc ! hl now equals lb - byte offset
|
|
jp (iy)
|
|
|
|
|
|
|
|
!---------------------------- LOADS -----------------------------------
|
|
|
|
! LOC, LPI
|
|
loc.l: lpi.l:
|
|
ld d,(ix) ! loc with 16-bit offset
|
|
inc ix
|
|
loc.s0: ld e,(ix) ! loc with 8-bit offset
|
|
inc ix
|
|
loc.0: loc.1: loc.2: loc.3: loc.4: loc.5: loc.6: loc.7:
|
|
loc.8: loc.9: loc.10: loc.11: loc.12: loc.13: loc.14: loc.15:
|
|
loc.16: loc.17: loc.18: loc.19: loc.20: loc.21: loc.22: loc.23:
|
|
loc.24: loc.25: loc.26: loc.27: loc.28: loc.29: loc.30: loc.31:
|
|
loc.32: loc.33:
|
|
push de
|
|
jr loop
|
|
|
|
loc.m1: ld hl,-1
|
|
jr phl
|
|
|
|
|
|
loc.sm1:dec d ! for constants -256...-1
|
|
jr loc.s0
|
|
|
|
|
|
! LDC
|
|
ldc.f: ld h,(ix)
|
|
inc ix
|
|
ld l,(ix)
|
|
inc ix
|
|
push hl
|
|
ld h,(ix)
|
|
inc ix
|
|
ld l,(ix)
|
|
inc ix
|
|
jr phl
|
|
ldc.l: ld h,(ix)
|
|
inc ix
|
|
ld l,(ix)
|
|
inc ix
|
|
ld e,d
|
|
bit 7,h
|
|
jr z,1f
|
|
dec de
|
|
1:
|
|
push de
|
|
jr phl
|
|
|
|
ldc.0: ld e,d
|
|
push de
|
|
push de
|
|
jr loop
|
|
|
|
|
|
! LOL
|
|
|
|
lol.0: lol.1: lol.2: lol.3: lol.4: lol.5: lol.6:
|
|
ld hl,-b_lolp-b_lolp+zone
|
|
add hl,de
|
|
add hl,de
|
|
add hl,bc
|
|
jr ipsh
|
|
|
|
lol.m2: lol.m4: lol.m6: lol.m8: lol.m10: lol.m12: lol.m14: lol.m16:
|
|
ld hl,b_loln+b_loln
|
|
sbc hl,de
|
|
xor a ! clear carry bit
|
|
sbc hl,de
|
|
add hl,bc ! hl = lb - byte offset
|
|
|
|
ipsh: ld e,(hl)
|
|
inc hl
|
|
ld d,(hl)
|
|
push de
|
|
jr loop
|
|
|
|
lol.wm1:ld iy,ipsh
|
|
jr loms
|
|
lol.n: ld iy,ipsh
|
|
jr loml
|
|
lol.w0: ld iy,ipsh
|
|
jr lops
|
|
lol.p: ld iy,ipsh
|
|
jr lopl
|
|
|
|
|
|
! LOE
|
|
|
|
loe.w4: inc d
|
|
loe.w3: inc d
|
|
loe.w2: inc d
|
|
loe.w1: inc d
|
|
loe.w0: ld e,(ix)
|
|
inc ix
|
|
ld hl,eb+eb%2
|
|
add hl,de
|
|
add hl,de
|
|
jr ipsh
|
|
|
|
loe.l: ld d,(ix)
|
|
inc ix
|
|
jr loe.w0
|
|
|
|
|
|
|
|
! LOF
|
|
lof.2: lof.4: lof.6: lof.8:
|
|
ld hl,-b_lof-b_lof ! assume lof 1 means stack +2, not -2
|
|
add hl,de
|
|
add hl,de
|
|
1: pop de
|
|
add hl,de
|
|
jr ipsh
|
|
|
|
lof.s0: ld h,d
|
|
2: ld l,(ix)
|
|
inc ix
|
|
jr 1b
|
|
|
|
lof.l: ld h,(ix)
|
|
inc ix
|
|
jr 2b
|
|
|
|
|
|
|
|
! LAL
|
|
lal.m1: ld h,b
|
|
ld l,c
|
|
dec hl
|
|
jr phl
|
|
lal.0: ld h,b
|
|
ld l,c
|
|
ld de,zone
|
|
add hl,de
|
|
jr phl
|
|
|
|
lal.wm2:dec d
|
|
lal.wm1:ld iy,phl
|
|
jr loms
|
|
lal.w0: ld iy,phl
|
|
jr lops
|
|
lal.n: ld h,(ix)
|
|
inc ix
|
|
ld l,(ix)
|
|
inc ix
|
|
add hl,bc
|
|
jr phl
|
|
|
|
lal.p: ld h,(ix)
|
|
inc ix
|
|
ld l,(ix)
|
|
inc ix
|
|
add hl,bc
|
|
ld de,zone
|
|
add hl,de
|
|
jr phl
|
|
|
|
|
|
|
|
! LAE
|
|
|
|
lae.w8: inc d
|
|
lae.w7: inc d
|
|
lae.w6: inc d
|
|
lae.w5: inc d
|
|
lae.w4: inc d
|
|
lae.w3: inc d
|
|
lae.w2: inc d
|
|
lae.w1: inc d
|
|
lae.w0: ld e,(ix)
|
|
inc ix
|
|
ld hl,eb+eb%2
|
|
add hl,de
|
|
add hl,de
|
|
jr phl
|
|
|
|
lae.l: ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
ld hl,eb+eb%2
|
|
add hl,de
|
|
jr phl
|
|
|
|
|
|
|
|
! LIL
|
|
lil.0: lil.2:
|
|
ld hl,-b_lil-b_lil+zone
|
|
add hl,de
|
|
add hl,de
|
|
add hl,bc
|
|
1: ld e,(hl)
|
|
inc hl
|
|
ld h,(hl)
|
|
ld l,e
|
|
jr ipsh
|
|
|
|
lil.wm1:ld iy,1b
|
|
jr loms
|
|
lil.n: ld iy,1b
|
|
jr loml
|
|
lil.w0: ld iy,1b
|
|
jr lops
|
|
lil.p: ld iy,1b
|
|
jr lopl
|
|
|
|
|
|
|
|
! LXL, LXA
|
|
lxl.1:
|
|
ld a,1
|
|
jr 7f
|
|
|
|
lxl.2:
|
|
ld a,2
|
|
jr 7f
|
|
|
|
lxl.l: ld d,(ix)
|
|
inc ix
|
|
lxl.s: ld a,(ix)
|
|
inc ix
|
|
7: ld iy,phl
|
|
5: ld h,b
|
|
ld l,c
|
|
or a
|
|
jr z,3f
|
|
2: inc hl
|
|
inc hl
|
|
inc hl
|
|
inc hl
|
|
inc hl
|
|
inc hl
|
|
inc hl
|
|
inc hl
|
|
.errnz .-2b-zone
|
|
ld e,(hl)
|
|
inc hl
|
|
ld h,(hl)
|
|
ld l,e
|
|
dec a
|
|
jr nz,2b
|
|
3: cp d
|
|
jr z,4f
|
|
dec d
|
|
jr 2b
|
|
4: jp (iy)
|
|
|
|
lxa.1:
|
|
ld a,1
|
|
jr 7f
|
|
|
|
lxa.l: ld d,(ix)
|
|
inc ix
|
|
lxa.s: ld a,(ix)
|
|
inc ix
|
|
7: ld iy,1f
|
|
jr 5b
|
|
1: ld de,zone
|
|
add hl,de
|
|
jr phl
|
|
|
|
lpb.z:
|
|
pop hl
|
|
.errnz zone/256
|
|
ld e,zone
|
|
add hl,de
|
|
jr phl
|
|
|
|
dch.z:
|
|
ld e,2
|
|
jr loi
|
|
|
|
exg.z:
|
|
pop de
|
|
jr exg
|
|
exg.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
exg.s0:
|
|
ld e,(ix)
|
|
inc ix
|
|
exg:
|
|
push bc
|
|
pop iy
|
|
ld hl,0
|
|
add hl,sp
|
|
ld b,h
|
|
ld c,l
|
|
add hl,de
|
|
1:
|
|
ld a,(bc)
|
|
ex af,af2
|
|
ld a,(hl)
|
|
ld (bc),a
|
|
ex af,af2
|
|
ld (hl),a
|
|
inc bc
|
|
inc hl
|
|
dec de
|
|
ld a,d
|
|
or e
|
|
jr nz,1b
|
|
push iy
|
|
pop bc
|
|
jr loop
|
|
|
|
|
|
! LDL
|
|
ldl.0: ld de,zone
|
|
ld h,b
|
|
ld l,c
|
|
add hl,de
|
|
dipsh: inc hl
|
|
inc hl
|
|
inc hl
|
|
ld d,(hl)
|
|
dec hl
|
|
ld e,(hl)
|
|
dec hl
|
|
push de
|
|
ld d,(hl)
|
|
dec hl
|
|
ld e,(hl)
|
|
push de
|
|
jr loop
|
|
|
|
ldl.wm1:ld iy,dipsh
|
|
jr loms
|
|
ldl.n: ld iy,dipsh
|
|
jr loml
|
|
ldl.w0: ld iy,dipsh
|
|
jr lops
|
|
ldl.p: ld iy,dipsh
|
|
jr lopl
|
|
|
|
|
|
! LDE
|
|
lde.l: ld d,(ix)
|
|
inc ix
|
|
jr lde.w0
|
|
|
|
lde.w3: inc d
|
|
lde.w2: inc d
|
|
lde.w1: inc d
|
|
lde.w0: ld e,(ix)
|
|
inc ix
|
|
ld hl,eb+eb%2
|
|
add hl,de
|
|
add hl,de
|
|
jr dipsh
|
|
|
|
|
|
! LDF
|
|
ldf.l: ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
pop hl
|
|
add hl,de
|
|
jr dipsh
|
|
|
|
|
|
! LOI,LOS
|
|
los.z:
|
|
ld iy,los.2
|
|
jr pop2
|
|
los.l: call long2
|
|
los.2: pop de
|
|
loi: pop hl
|
|
add hl,de
|
|
dec hl
|
|
srl d
|
|
rr e
|
|
jr nc,1f
|
|
ld a,e
|
|
or d
|
|
jr nz,eilsize
|
|
ld e,(hl) ! here the 1-byte case is caught
|
|
push de
|
|
jr loop
|
|
1: push bc
|
|
pop iy
|
|
2: ld b,(hl)
|
|
dec hl
|
|
ld c,(hl)
|
|
dec hl
|
|
push bc
|
|
dec de
|
|
ld a,d
|
|
or e
|
|
jr nz,2b
|
|
loiend: push iy
|
|
pop bc
|
|
jr loop
|
|
|
|
loi.1: loi.2: loi.4: loi.6: loi.8:
|
|
ld hl,-b_loi-b_loi
|
|
add hl,de
|
|
adc hl,de ! again we use that the carry is cleared
|
|
jr nz,1f
|
|
inc hl ! in case loi.0 object size is 1 byte!
|
|
1: ex de,hl
|
|
jr loi
|
|
|
|
loi.l: ld d,(ix)
|
|
inc ix
|
|
loi.s0: ld e,(ix)
|
|
inc ix
|
|
jr loi
|
|
|
|
|
|
! ------------------------------ STORES --------------------------------
|
|
|
|
! STL
|
|
stl.p2: ld hl,2
|
|
jr 4f
|
|
stl.p0: ld hl,0
|
|
4: ld de,zone
|
|
add hl,de
|
|
add hl,bc
|
|
jr ipop
|
|
|
|
stl.m2: stl.m4: stl.m6: stl.m8: stl.m10:
|
|
ld hl,b_stlm+b_stlm
|
|
stl.zrl:sbc hl,de
|
|
xor a
|
|
sbc hl,de
|
|
add hl,bc
|
|
ipop: pop de
|
|
ld (hl),e
|
|
inc hl
|
|
ld (hl),d
|
|
jr loop
|
|
|
|
stl.wm1:ld iy,ipop
|
|
jr loms
|
|
stl.n: ld iy,ipop
|
|
jr loml
|
|
stl.w0: ld iy,ipop
|
|
jr lops
|
|
stl.p: ld iy,ipop
|
|
jr lopl
|
|
|
|
|
|
|
|
|
|
! STE
|
|
|
|
ste.w3: inc d
|
|
ste.w2: inc d
|
|
ste.w1: inc d
|
|
ste.w0: ld e,(ix)
|
|
inc ix
|
|
ld hl,eb+eb%2
|
|
add hl,de
|
|
add hl,de
|
|
jr ipop
|
|
|
|
ste.l: ld d,(ix)
|
|
inc ix
|
|
jr ste.w0
|
|
|
|
|
|
|
|
! STF
|
|
stf.2: stf.4: stf.6:
|
|
ld hl,-b_stf-b_stf
|
|
add hl,de
|
|
add hl,de
|
|
1: pop de
|
|
add hl,de
|
|
jr ipop
|
|
|
|
stf.s0: ld h,d
|
|
2: ld l,(ix)
|
|
inc ix
|
|
jr 1b
|
|
|
|
stf.l: ld h,(ix)
|
|
inc ix
|
|
jr 2b
|
|
|
|
|
|
|
|
! SIL
|
|
1: ld e,(hl)
|
|
inc hl
|
|
ld h,(hl)
|
|
ld l,e
|
|
jr ipop
|
|
|
|
sil.wm1:ld iy,1b
|
|
jr loms
|
|
sil.n: ld iy,1b
|
|
jr loml
|
|
sil.w0: ld iy,1b
|
|
jr lops
|
|
sil.p: ld iy,1b
|
|
jr lopl
|
|
|
|
|
|
! STI, STS
|
|
sts.z:
|
|
ld iy,sts.2
|
|
jr pop2
|
|
sts.l: call long2
|
|
sts.2: pop de
|
|
sti: pop hl
|
|
srl d
|
|
rr e
|
|
jr nc,1f
|
|
ld a,e
|
|
or d
|
|
jr nz,eilsize
|
|
pop de ! here the 1-byte case is caught
|
|
ld (hl),e
|
|
jr loop
|
|
1: push bc
|
|
pop iy
|
|
2: pop bc
|
|
ld (hl),c
|
|
inc hl
|
|
ld (hl),b
|
|
inc hl
|
|
dec de
|
|
ld a,e
|
|
or d
|
|
jr nz,2b
|
|
jr loiend
|
|
|
|
sti.1: sti.2: sti.4: sti.6: sti.8:
|
|
ld hl,-b_sti-b_sti
|
|
add hl,de
|
|
adc hl,de ! again we use that the carry is cleared
|
|
jr nz,1f
|
|
inc hl ! in case sti.0 object size is 1 byte!
|
|
1: ex de,hl
|
|
jr sti
|
|
|
|
sti.l: ld d,(ix)
|
|
inc ix
|
|
sti.s0: ld e,(ix)
|
|
inc ix
|
|
jr sti
|
|
|
|
|
|
! SDL
|
|
sdl.wm1:ld iy,1f
|
|
jr loms
|
|
sdl.n: ld iy,1f
|
|
jr loml
|
|
sdl.w0: ld iy,1f
|
|
jr lops
|
|
sdl.p: ld iy,1f
|
|
jr lopl
|
|
|
|
|
|
! SDE
|
|
sde.l: ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
ld hl,eb+eb%2
|
|
2: add hl,de
|
|
1: pop de
|
|
ld (hl),e
|
|
inc hl
|
|
ld (hl),d
|
|
inc hl
|
|
jr ipop
|
|
|
|
|
|
! SDF
|
|
sdf.l: ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
pop hl
|
|
jr 2b
|
|
|
|
|
|
!------------------------- SINGLE PRECISION ARITHMETIC ---------------
|
|
|
|
! ADI, ADP, ADS, ADU
|
|
|
|
adi.z: adu.z:
|
|
pop de
|
|
9:
|
|
call chk24
|
|
.word adi.2,adi.4
|
|
adi.l: adu.l:
|
|
ld d,(ix) ! I guess a routine chk24.l could do this job
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
jr 9b
|
|
ads.z:
|
|
ld iy,adi.2
|
|
jr pop2
|
|
ads.l:
|
|
call long2
|
|
ads.2: adi.2: adu.2:
|
|
pop de
|
|
1: pop hl
|
|
add hl,de
|
|
jr phl
|
|
|
|
adp.l: ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
jr 1b
|
|
|
|
adp.sm1:dec d
|
|
adp.s0: ld e,(ix)
|
|
inc ix
|
|
jr 1b
|
|
|
|
adp.2: pop hl
|
|
inc hl
|
|
jr 1f
|
|
inc.z:
|
|
adp.1: pop hl
|
|
1: inc hl
|
|
jr phl
|
|
|
|
|
|
! SBI, SBP, SBS, SBU (but what is SBP?)
|
|
|
|
sbi.z: sbu.z:
|
|
pop de
|
|
9:
|
|
call chk24
|
|
.word sbi.2,sbi.4
|
|
sbi.l: sbu.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
jr 9b
|
|
sbs.z:
|
|
ld iy,sbi.2
|
|
jr pop2
|
|
sbs.l:
|
|
call long2
|
|
sbi.2:
|
|
pop de
|
|
pop hl
|
|
sbc hl,de
|
|
jr phl
|
|
|
|
|
|
! NGI
|
|
ngi.z:
|
|
pop de
|
|
9:
|
|
call chk24
|
|
.word ngi.2,ngi.4
|
|
ngi.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
jr 9b
|
|
ngi.2: ld hl,0
|
|
pop de
|
|
sbc hl,de
|
|
jr phl
|
|
|
|
|
|
! MLI, MLU Johan version
|
|
mli.z: mlu.z:
|
|
pop de
|
|
9:
|
|
call chk24
|
|
.word mli.2,mli.4
|
|
mli.l: mlu.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
jr 9b
|
|
mli.2: mlu.2:
|
|
ld iy,loop
|
|
mliint: pop de
|
|
pop hl
|
|
push bc
|
|
ld b,h
|
|
ld c,l
|
|
ld hl,0
|
|
ld a,16
|
|
0:
|
|
bit 7,d
|
|
jr z,1f
|
|
add hl,bc
|
|
1:
|
|
dec a
|
|
jr z,2f
|
|
ex de,hl
|
|
add hl,hl
|
|
ex de,hl
|
|
add hl,hl
|
|
jr 0b
|
|
2:
|
|
pop bc
|
|
push hl
|
|
jp (iy)
|
|
|
|
|
|
! DVI, DVU
|
|
dvi.z:
|
|
pop de
|
|
9:
|
|
call chk24
|
|
.word dvi.2,dvi.4
|
|
dvi.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
jr 9b
|
|
dvi.2:
|
|
pop hl
|
|
pop de
|
|
push bc
|
|
ld b,h
|
|
ld c,l
|
|
xor a
|
|
ld h,a
|
|
ld l,a
|
|
sbc hl,bc
|
|
jp m,1f
|
|
ld b,h
|
|
ld c,l
|
|
cpl
|
|
1:
|
|
or a
|
|
ld hl,0
|
|
sbc hl,de
|
|
jp m,1f
|
|
ex de,hl
|
|
cpl
|
|
1:
|
|
push af
|
|
ld hl,0
|
|
ld a,16
|
|
0:
|
|
add hl,hl
|
|
ex de,hl
|
|
add hl,hl
|
|
ex de,hl
|
|
jr nc,1f
|
|
inc hl
|
|
or a
|
|
1:
|
|
sbc hl,bc
|
|
inc de
|
|
jp p,2f
|
|
add hl,bc
|
|
dec de
|
|
2:
|
|
dec a
|
|
jr nz,0b
|
|
pop af
|
|
or a
|
|
jr z,1f
|
|
ld hl,0
|
|
sbc hl,de
|
|
ex de,hl
|
|
1:
|
|
pop bc
|
|
push de
|
|
jr loop
|
|
|
|
|
|
dvu.z:
|
|
pop de
|
|
9:
|
|
call chk24
|
|
.word dvu.2,dvu.4
|
|
dvu.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
jr 9b
|
|
dvu.2:
|
|
pop hl
|
|
pop de
|
|
push bc
|
|
ld b,h
|
|
ld c,l
|
|
ld hl,0
|
|
ld a,16
|
|
0:
|
|
add hl,hl
|
|
ex de,hl
|
|
add hl,hl
|
|
ex de,hl
|
|
jr nc,1f
|
|
inc hl
|
|
or a
|
|
1:
|
|
sbc hl,bc
|
|
inc de
|
|
jp p,2f
|
|
add hl,bc
|
|
dec de
|
|
2:
|
|
dec a
|
|
jr nz,0b
|
|
pop bc
|
|
push de
|
|
jr loop
|
|
|
|
|
|
! RMI, RMU
|
|
rmi.z:
|
|
pop de
|
|
9:
|
|
call chk24
|
|
.word rmi.2,rmi.4
|
|
rmi.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
jr 9b
|
|
rmi.2:
|
|
pop hl
|
|
pop de
|
|
push bc
|
|
ld b,h
|
|
ld c,l
|
|
xor a
|
|
ld h,a
|
|
ld l,a
|
|
sbc hl,bc
|
|
jp m,1f
|
|
ld b,h
|
|
ld c,l
|
|
1:
|
|
or a
|
|
ld hl,0
|
|
sbc hl,de
|
|
jp m,1f
|
|
ex de,hl
|
|
cpl
|
|
1:
|
|
push af
|
|
ld hl,0
|
|
ld a,16
|
|
0:
|
|
add hl,hl
|
|
ex de,hl
|
|
add hl,hl
|
|
ex de,hl
|
|
jr nc,1f
|
|
inc hl
|
|
or a
|
|
1:
|
|
sbc hl,bc
|
|
inc de
|
|
jp p,2f
|
|
add hl,bc
|
|
dec de
|
|
2:
|
|
dec a
|
|
jr nz,0b
|
|
ex de,hl
|
|
pop af
|
|
or a
|
|
jr z,1f
|
|
ld hl,0
|
|
sbc hl,de
|
|
ex de,hl
|
|
1:
|
|
pop bc
|
|
push de
|
|
jr loop
|
|
|
|
|
|
rmu.4:
|
|
ld iy,.dvu4
|
|
jr 1f
|
|
rmi.4:
|
|
ld iy,.dvi4
|
|
1:
|
|
ld (retarea),bc
|
|
ld (retarea+2),ix
|
|
ld hl,1f
|
|
push hl
|
|
push iy
|
|
ret
|
|
1:
|
|
pop hl
|
|
pop hl
|
|
push bc
|
|
push de
|
|
ld bc,(retarea)
|
|
ld ix,(retarea+2)
|
|
jr loop
|
|
rmu.z:
|
|
pop de
|
|
9:
|
|
call chk24
|
|
.word rmu.2,rmu.4
|
|
rmu.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
jr 9b
|
|
rmu.2:
|
|
pop hl
|
|
pop de
|
|
push bc
|
|
ld b,h
|
|
ld c,l
|
|
ld hl,0
|
|
ld a,16
|
|
0:
|
|
add hl,hl
|
|
ex de,hl
|
|
add hl,hl
|
|
ex de,hl
|
|
jr nc,1f
|
|
inc hl
|
|
or a
|
|
1:
|
|
sbc hl,bc
|
|
inc de
|
|
jp p,2f
|
|
add hl,bc
|
|
dec de
|
|
2:
|
|
dec a
|
|
jr nz,0b
|
|
pop bc
|
|
jr phl
|
|
|
|
! SLI, SLU
|
|
|
|
slu.z: sli.z:
|
|
pop de
|
|
9:
|
|
call chk24
|
|
.word sli.2,sli.4
|
|
slu.l:
|
|
sli.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
jr 9b
|
|
sli.2:
|
|
pop de
|
|
pop hl
|
|
ld a,d
|
|
or a
|
|
jr z,1f
|
|
ld e,15
|
|
2: add hl,hl
|
|
1: dec e
|
|
jp m,phl
|
|
jr 2b
|
|
|
|
sli.4:
|
|
slu.4:
|
|
pop de
|
|
pop iy
|
|
pop hl
|
|
inc d
|
|
dec d
|
|
jr z,1f
|
|
ld e,31
|
|
1:
|
|
dec e
|
|
jp m,2f
|
|
add iy,iy
|
|
adc hl,hl
|
|
jr 1b
|
|
2:
|
|
push hl
|
|
push iy
|
|
jr loop
|
|
|
|
! SRI, SRU
|
|
|
|
sri.z:
|
|
pop de
|
|
9:
|
|
call chk24
|
|
.word sri.2,sri.4
|
|
sri.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
jr 9b
|
|
sri.2: pop de
|
|
pop hl
|
|
ld a,d
|
|
or a
|
|
jr z,1f
|
|
ld e,15
|
|
2: sra h
|
|
rr l
|
|
1: dec e
|
|
jp m,phl
|
|
jr 2b
|
|
|
|
|
|
sri.4:
|
|
pop de
|
|
ld a,e
|
|
inc d
|
|
dec d
|
|
pop de
|
|
pop hl
|
|
jr z,1f
|
|
ld a,31
|
|
1:
|
|
dec a
|
|
jp m,2f
|
|
sra h
|
|
rr l
|
|
rr d
|
|
rr e
|
|
jr 1b
|
|
2:
|
|
push hl
|
|
push de
|
|
jr loop
|
|
|
|
sru.z:
|
|
pop de
|
|
9:
|
|
call chk24
|
|
.word sru.2,sru.4
|
|
sru.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
jr 9b
|
|
sru.2: pop de
|
|
pop hl
|
|
ld a,d
|
|
or a
|
|
jr z,1f
|
|
ld e,15
|
|
2: srl h
|
|
rr l
|
|
1: dec e
|
|
jp m,phl
|
|
jr 2b
|
|
|
|
sru.4:
|
|
pop de
|
|
ld a,e
|
|
inc d
|
|
dec d
|
|
pop de
|
|
pop hl
|
|
jr z,1f
|
|
ld a,31
|
|
1:
|
|
dec a
|
|
jp m,2f
|
|
srl h
|
|
rr l
|
|
rr d
|
|
rr e
|
|
jr 1b
|
|
2:
|
|
push hl
|
|
push de
|
|
jr loop
|
|
|
|
! ROL, ROR
|
|
rol.z:
|
|
pop de
|
|
9:
|
|
call chk24
|
|
.word rol.2,rol.4
|
|
rol.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
jr 9b
|
|
rol.2: pop de
|
|
pop hl
|
|
ld a,e
|
|
and 15
|
|
jr z,phl
|
|
ld de,0
|
|
1: add hl,hl
|
|
adc hl,de
|
|
dec a
|
|
jr nz,1b
|
|
jr phl
|
|
|
|
|
|
rol.4:
|
|
pop de
|
|
pop iy
|
|
pop hl
|
|
ld a,e
|
|
and 31
|
|
jr z,3f
|
|
1:
|
|
add iy,iy
|
|
adc hl,hl
|
|
jr nc,2f
|
|
inc iy
|
|
2:
|
|
dec a
|
|
jr nz,1b
|
|
3:
|
|
push hl
|
|
push iy
|
|
|
|
ror.z:
|
|
pop de
|
|
9:
|
|
call chk24
|
|
.word ror.2,ror.4
|
|
ror.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
jr 9b
|
|
ror.2: pop de
|
|
pop hl
|
|
ld a,e
|
|
and 15
|
|
jr z,phl
|
|
1: srl h
|
|
rr l
|
|
jr nc,2f
|
|
set 7,h
|
|
2: dec a
|
|
jr nz,1b
|
|
jr phl
|
|
|
|
|
|
ror.4:
|
|
pop de
|
|
ld a,e
|
|
pop de
|
|
pop hl
|
|
and 31
|
|
jr z,0f
|
|
1:
|
|
srl h
|
|
rr l
|
|
rr d
|
|
rr e
|
|
jr nc,2f
|
|
set 7,h
|
|
2:
|
|
dec a
|
|
jr nz,1b
|
|
0:
|
|
push hl
|
|
push de
|
|
jr loop
|
|
pop2: ld de,2
|
|
pop hl
|
|
sbc hl,de
|
|
jr nz,eilsize
|
|
xor a
|
|
ld d,a
|
|
jp (iy)
|
|
|
|
|
|
chk24:
|
|
! this routine is used to call indirectly
|
|
! a routine for either 2 or 4 byte operation
|
|
! ( e.g. mli.2 or mli.4)
|
|
! de contains 2 or 4
|
|
! iy points to a descriptor containing
|
|
! the addresses of both routines
|
|
pop iy ! address of descriptor
|
|
ld a,d ! high byte must be 0
|
|
or a
|
|
jr nz,unimpld
|
|
ld a,e
|
|
cp 2
|
|
jr z,1f
|
|
inc iy
|
|
inc iy ! points to word containing
|
|
! address of 4 byte routine
|
|
cp 4
|
|
jr nz,unimpld
|
|
1:
|
|
ld h,(iy+1)
|
|
ld l,(iy)
|
|
xor a
|
|
jp (hl)
|
|
!--------------------- INCREMENT, DECREMENT, ZERO ----------------------
|
|
|
|
! INC
|
|
inl.m2: inl.m4: inl.m6:
|
|
ld hl, b_inl+b_inl
|
|
sbc hl,de
|
|
xor a
|
|
sbc hl,de
|
|
add hl,bc
|
|
1: inc (hl)
|
|
jr nz,loop
|
|
inc hl
|
|
inc (hl)
|
|
jr loop
|
|
|
|
inl.wm1:ld iy,1b
|
|
jr loms
|
|
inl.n: ld iy,1b
|
|
jr loml
|
|
inl.p: ld iy,1b
|
|
jr lopl
|
|
|
|
|
|
! INE
|
|
|
|
ine.w3: inc d
|
|
ine.w2: inc d
|
|
ine.w1: inc d
|
|
ine.w0: ld e,(ix)
|
|
inc ix
|
|
ld hl,eb+eb%2
|
|
add hl,de
|
|
add hl,de
|
|
jr 1b
|
|
|
|
ine.l: ld d,(ix)
|
|
inc ix
|
|
jr ine.w0
|
|
|
|
|
|
! DEC
|
|
dec.z: pop hl
|
|
dec hl
|
|
push hl
|
|
jr loop
|
|
|
|
1: ld e,(hl)
|
|
inc hl
|
|
ld d,(hl)
|
|
dec de
|
|
ld (hl),d
|
|
dec hl
|
|
ld (hl),e
|
|
jr loop
|
|
|
|
del.wm1:ld iy,1b
|
|
jr loms
|
|
del.n: ld iy,1b
|
|
jr loml
|
|
del.p: ld iy,1b
|
|
jr lopl
|
|
|
|
|
|
! DEE
|
|
|
|
dee.w3: inc d
|
|
dee.w2: inc d
|
|
dee.w1: inc d
|
|
dee.w0: ld e,(ix)
|
|
inc ix
|
|
ld hl,eb+eb%2
|
|
add hl,de
|
|
add hl,de
|
|
jr 1b
|
|
|
|
dee.l: ld d,(ix)
|
|
inc ix
|
|
jr dee.w0
|
|
|
|
|
|
! ZERO
|
|
zri2: zru2:
|
|
ld h,d
|
|
ld l,d
|
|
jr phl
|
|
|
|
|
|
zrf.z:
|
|
zer.z: pop de
|
|
2: ld hl,0
|
|
sra d
|
|
rr e
|
|
1: push hl
|
|
dec de
|
|
ld a,e
|
|
or d
|
|
jr nz,1b
|
|
jr loop
|
|
|
|
zrf.l:
|
|
zer.l: ld d,(ix)
|
|
inc ix
|
|
zer.s0: ld e,(ix)
|
|
inc ix
|
|
jr 2b
|
|
|
|
|
|
zrl.m2: zrl.m4:
|
|
ld h,d
|
|
ld l,d
|
|
push hl
|
|
ld hl,b_zrl+b_zrl
|
|
jr stl.zrl
|
|
|
|
zrl.wm1:
|
|
ld h,d
|
|
ld l,d
|
|
push hl
|
|
jr stl.wm1
|
|
|
|
zrl.n:
|
|
ld h,d
|
|
ld l,d
|
|
push hl
|
|
jr stl.n
|
|
|
|
zrl.w0:
|
|
ld h,d
|
|
ld l,d
|
|
push hl
|
|
jr stl.w0
|
|
|
|
zrl.p:
|
|
ld h,d
|
|
ld l,d
|
|
push hl
|
|
jr stl.p
|
|
|
|
|
|
|
|
zre.w0:
|
|
ld h,d
|
|
ld l,d
|
|
push hl
|
|
jr ste.w0
|
|
|
|
zre.l:
|
|
ld h,d
|
|
ld l,d
|
|
push hl
|
|
jr ste.l
|
|
|
|
|
|
! ------------------------- CONVERT GROUP ------------------------------
|
|
|
|
! CII, CIU
|
|
cii.z: ciu.z:
|
|
pop hl
|
|
pop de
|
|
sbc hl,de ! hl and de can only have values 2 or 4, that's
|
|
! why a single subtract can split the 3 cases
|
|
jr z,loop ! equal, so do nothing
|
|
jp p,2f
|
|
3: pop hl ! smaller, so shrink size from double to single
|
|
pop de
|
|
jr phl
|
|
2: pop hl ! larger, so expand (for cii with sign extend)
|
|
res 1,e
|
|
bit 7,h
|
|
jr z,1f
|
|
dec de
|
|
1: push de
|
|
jr phl
|
|
|
|
! CUI, CUU
|
|
cui.z: cuu.z:
|
|
pop hl
|
|
pop de
|
|
sbc hl,de
|
|
jr z,loop
|
|
jp m,3b
|
|
res 1,e
|
|
pop hl
|
|
jr 1b
|
|
|
|
|
|
! ------------------------------ SETS ---------------------------------
|
|
|
|
! SET
|
|
set.z: pop hl
|
|
doset: pop de
|
|
push bc
|
|
pop iy
|
|
ld b,h
|
|
ld c,l
|
|
xor a
|
|
0: push af
|
|
inc sp
|
|
dec c
|
|
jr nz,0b
|
|
dec b
|
|
jp p,0b
|
|
push iy
|
|
pop bc
|
|
ex de,hl
|
|
ld a,l
|
|
sra h
|
|
jp m,unimpld
|
|
rr l
|
|
sra h
|
|
rr l
|
|
sra h
|
|
rr l
|
|
push hl
|
|
or a
|
|
sbc hl,de
|
|
pop hl
|
|
jp p,unimpld
|
|
add hl,sp
|
|
ld (hl),1
|
|
and 7
|
|
jr 1f
|
|
0: sla (hl)
|
|
dec a
|
|
1: jr nz,0b
|
|
jr loop
|
|
|
|
set.l: ld d,(ix)
|
|
inc ix
|
|
set.s0: ld e,(ix)
|
|
inc ix
|
|
ex de,hl
|
|
jr doset
|
|
|
|
|
|
! INN
|
|
inn.z: pop hl
|
|
jr 1f
|
|
inn.l: ld d,(ix)
|
|
inc ix
|
|
inn.s0: ld e,(ix)
|
|
inc ix
|
|
ex de,hl
|
|
1:
|
|
pop de
|
|
add hl,sp
|
|
push hl
|
|
pop iy
|
|
ex de,hl
|
|
ld a,l
|
|
sra h
|
|
jp m,0f
|
|
rr l
|
|
sra h
|
|
rr l
|
|
sra h
|
|
rr l
|
|
add hl,sp
|
|
push hl
|
|
or a ! clear carry
|
|
sbc hl,de
|
|
pop hl
|
|
jp m,1f
|
|
0: xor a
|
|
jr 4f
|
|
1: ld e,(hl)
|
|
and 7
|
|
jr 2f
|
|
3: rrc e
|
|
dec a
|
|
2: jr nz,3b
|
|
ld a,e
|
|
and 1
|
|
4: ld l,a
|
|
ld h,0
|
|
ld sp,iy
|
|
jr phl
|
|
|
|
|
|
|
|
! ------------------------- LOGICAL GROUP -----------------------------
|
|
|
|
! AND
|
|
and.z: pop de
|
|
doand: ld h,d
|
|
ld l,e
|
|
add hl,sp
|
|
push bc
|
|
ld b,h
|
|
ld c,l
|
|
ex de,hl
|
|
add hl,de
|
|
1: dec hl
|
|
dec de
|
|
ld a,(de)
|
|
and (hl)
|
|
ld (hl),a
|
|
xor a
|
|
sbc hl,bc
|
|
jr z,2f
|
|
add hl,bc
|
|
jr 1b
|
|
2: ld h,b
|
|
ld l,c
|
|
pop bc
|
|
ld sp,hl
|
|
jr loop
|
|
|
|
and.l: ld d,(ix)
|
|
inc ix
|
|
and.s0: ld e,(ix)
|
|
inc ix
|
|
jr doand
|
|
|
|
and.2: ld e,2
|
|
jr doand
|
|
|
|
! IOR
|
|
ior.z: pop de
|
|
ior: ld h,d
|
|
ld l,e
|
|
add hl,sp
|
|
push bc
|
|
ld b,h
|
|
ld c,l
|
|
ex de,hl
|
|
add hl,de
|
|
1: dec hl
|
|
dec de
|
|
ld a,(de)
|
|
or (hl)
|
|
ld (hl),a
|
|
xor a
|
|
sbc hl,bc
|
|
jr z,2f
|
|
add hl,bc
|
|
jr 1b
|
|
2: ld h,b
|
|
ld l,c
|
|
pop bc
|
|
ld sp,hl
|
|
jr loop
|
|
|
|
ior.l: ld d,(ix)
|
|
inc ix
|
|
ior.s0: ld e,(ix)
|
|
inc ix
|
|
jr ior
|
|
|
|
ior.2: ld e,2
|
|
jr ior
|
|
|
|
! XOR
|
|
xor.z: pop de
|
|
exor: ld h,d
|
|
ld l,e
|
|
add hl,sp
|
|
push bc
|
|
ld b,h
|
|
ld c,l
|
|
ex de,hl
|
|
add hl,de
|
|
1: dec hl
|
|
dec de
|
|
ld a,(de)
|
|
xor (hl)
|
|
ld (hl),a
|
|
xor a
|
|
sbc hl,bc
|
|
jr z,2f
|
|
add hl,bc
|
|
jr 1b
|
|
2: ld h,b
|
|
ld l,c
|
|
pop bc
|
|
ld sp,hl
|
|
jr loop
|
|
|
|
xor.l: ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
jr exor
|
|
|
|
! COM
|
|
com.z: pop hl
|
|
com: add hl,sp
|
|
1: dec hl
|
|
ld a,(hl)
|
|
cpl
|
|
ld (hl),a
|
|
xor a
|
|
sbc hl,sp
|
|
jr z,loop
|
|
add hl,sp
|
|
jr 1b
|
|
|
|
com.l: ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
ex de,hl
|
|
jr com
|
|
|
|
|
|
! ------------------------- COMPARE GROUP ------------------------------
|
|
|
|
! CMI
|
|
|
|
|
|
cmi.2: pop de
|
|
pop hl
|
|
ld a,h
|
|
xor d ! check sign bit to catch overflow with subtract
|
|
jp m,1f
|
|
sbc hl,de
|
|
jr phl
|
|
1: xor d ! now a equals (original) h again
|
|
jp m,phl
|
|
set 0,l ! to catch case hl=0>de bit 0 is set explicitly
|
|
jr phl
|
|
|
|
|
|
|
|
! CMU, CMP
|
|
|
|
cmi.4: inc a
|
|
ld de,4
|
|
jr docmu
|
|
cmp.z: ld de,2
|
|
jr docmu
|
|
cmi.z: inc a
|
|
cmu.z:
|
|
pop de
|
|
jr docmu
|
|
|
|
cmi.l: inc a
|
|
cmu.l: ld d,(ix)
|
|
inc ix
|
|
ld e,(ix)
|
|
inc ix
|
|
docmu: push bc
|
|
pop iy
|
|
ld b,d
|
|
ld c,e
|
|
ld hl,0
|
|
add hl,sp
|
|
add hl,bc
|
|
dec hl
|
|
ld d,h
|
|
ld e,l
|
|
add hl,bc
|
|
ld (retarea),hl ! save new sp-1
|
|
or a
|
|
jr z,1f
|
|
ld a,(de)
|
|
cp (hl)
|
|
dec hl
|
|
dec de
|
|
dec bc
|
|
jr z,1f
|
|
jp p,4f
|
|
jp pe,5f
|
|
jr 6f
|
|
1:
|
|
ld a,(de)
|
|
cp (hl)
|
|
dec de
|
|
dec hl
|
|
dec bc
|
|
jr nz,2f
|
|
ld a,b
|
|
or c
|
|
jr nz,1b
|
|
ld d,a
|
|
ld e,a
|
|
jr 3f
|
|
2:
|
|
jr nc,5f
|
|
6:
|
|
ld de,1
|
|
jr 3f
|
|
4:
|
|
jp pe,6b
|
|
5:
|
|
ld de,-1
|
|
3:
|
|
ld hl,(retarea)
|
|
inc hl
|
|
ld sp,hl
|
|
push de
|
|
push iy
|
|
pop bc
|
|
jr loop
|
|
|
|
|
|
|
|
! CMS
|
|
|
|
cms.z: pop hl
|
|
jr 1f
|
|
cms.l: ld d,(ix)
|
|
inc ix
|
|
cms.s0: ld e,(ix)
|
|
inc ix
|
|
ex de,hl
|
|
1: push bc
|
|
pop iy
|
|
ld b,h
|
|
ld c,l
|
|
add hl,sp
|
|
0:
|
|
dec sp
|
|
pop af
|
|
cpi
|
|
jr nz,1f
|
|
ld a,b
|
|
or c
|
|
jr nz,0b
|
|
ld de,0
|
|
jr 2f
|
|
1:
|
|
add hl,bc
|
|
ld de,1
|
|
2:
|
|
ld sp,hl
|
|
push de
|
|
push iy
|
|
pop bc
|
|
jr loop
|
|
|
|
|
|
! TLT, TLE, TEQ, TNE, TGE, TGT
|
|
tlt.z:
|
|
ld h,d
|
|
ld l,d
|
|
pop de
|
|
bit 7,d
|
|
jr z,1f
|
|
inc l
|
|
1:
|
|
jr phl
|
|
|
|
tle.z: ld hl,1
|
|
pop de
|
|
xor a
|
|
add a,d
|
|
jp m,phl
|
|
jr nz,1f
|
|
xor a
|
|
add a,e
|
|
jr z,2f
|
|
1: dec l
|
|
2:
|
|
jr phl
|
|
|
|
teq.z:
|
|
ld h,d
|
|
ld l,d
|
|
pop de
|
|
ld a,d
|
|
or e
|
|
jr nz,1f
|
|
inc l
|
|
1:
|
|
jr phl
|
|
|
|
tne.z:
|
|
ld h,d
|
|
ld l,d
|
|
pop de
|
|
ld a,d
|
|
or e
|
|
jr z,1f
|
|
inc l
|
|
1:
|
|
jr phl
|
|
|
|
tge.z:
|
|
ld h,d
|
|
ld l,d
|
|
pop de
|
|
bit 7,d
|
|
jr nz,1f
|
|
inc l
|
|
1:
|
|
jr phl
|
|
|
|
tgt.z:
|
|
ld h,d
|
|
ld l,d
|
|
pop de
|
|
xor a
|
|
add a,d
|
|
jp m,phl
|
|
jr nz,1f
|
|
xor a
|
|
add a,e
|
|
jr z,2f
|
|
1: inc l
|
|
2:
|
|
jr phl
|
|
|
|
|
|
! ------------------------- BRANCH GROUP -------------------------------
|
|
|
|
! BLT, BLE, BEQ, BNE, BGE, BGT, BRA
|
|
|
|
b.pl: ld d,(ix)
|
|
inc ix
|
|
b.ps: ld e,(ix)
|
|
inc ix
|
|
push ix
|
|
pop hl
|
|
add hl,de
|
|
pop de
|
|
ex (sp),hl
|
|
xor a
|
|
jp (iy)
|
|
|
|
|
|
bra.l: ld d,(ix)
|
|
inc ix
|
|
jr bra.s0
|
|
|
|
bra.sm2:dec d
|
|
bra.sm1:dec d
|
|
dec d
|
|
bra.s1: inc d
|
|
bra.s0: ld e,(ix)
|
|
inc ix
|
|
add ix,de
|
|
jr loop
|
|
|
|
|
|
bgo: pop ix ! take branch
|
|
jr loop
|
|
|
|
|
|
blt.s0: ld iy,blt
|
|
jr b.ps
|
|
blt.l: ld iy,blt
|
|
jr b.pl
|
|
blt: ld a,h
|
|
xor d
|
|
jp m,1f
|
|
sbc hl,de
|
|
jr 2f
|
|
1: xor d
|
|
2: jp m,bgo
|
|
pop de
|
|
jr loop
|
|
|
|
|
|
ble.s0: ld iy,ble
|
|
jr b.ps
|
|
ble.l: ld iy,ble
|
|
jr b.pl
|
|
ble: ex de,hl
|
|
jr bge
|
|
|
|
|
|
beq.s0: ld iy,beq
|
|
jr b.ps
|
|
beq.l: ld iy,beq
|
|
jr b.pl
|
|
beq: sbc hl,de
|
|
jr z,bgo
|
|
pop de ! keep stack clean, so dump unused jump address
|
|
jr loop
|
|
|
|
|
|
bne.s0: ld iy,bne
|
|
jr b.ps
|
|
bne.l: ld iy,bne
|
|
jr b.pl
|
|
bne: sbc hl,de
|
|
jr nz,bgo
|
|
pop de ! keep stack clean, so dump unused jump address
|
|
jr loop
|
|
|
|
|
|
bge.s0: ld iy,bge
|
|
jr b.ps
|
|
bge.l: ld iy,bge
|
|
jr b.pl
|
|
bge: ld a,h
|
|
xor d ! check sign bit to catch overflow with subtract
|
|
jp m,1f
|
|
sbc hl,de
|
|
jr 2f
|
|
1: xor d ! now a equals (original) h again
|
|
2: jp p,bgo
|
|
pop de ! keep stack clean, so dump unused jump address
|
|
jr loop
|
|
|
|
|
|
bgt.s0: ld iy,bgt
|
|
jr b.ps
|
|
bgt.l: ld iy,bgt
|
|
jr b.pl
|
|
bgt: ex de,hl
|
|
jr blt
|
|
|
|
|
|
|
|
! ZLT, ZLE, ZEQ, ZNE, ZGE, ZGT
|
|
|
|
|
|
z.pl: ld d,(ix)
|
|
inc ix
|
|
z.ps: ld e,(ix)
|
|
inc ix
|
|
push ix
|
|
pop hl
|
|
add hl,de
|
|
ex de,hl
|
|
pop hl
|
|
xor a
|
|
add a,h
|
|
jp (iy)
|
|
|
|
|
|
|
|
zlt.l: ld iy,zlt
|
|
jr z.pl
|
|
zlt.s0: ld iy,zlt
|
|
jr z.ps
|
|
zlt: jp m,zgo
|
|
jr loop
|
|
|
|
|
|
zle.l: ld iy,zle
|
|
jr z.pl
|
|
zle.s0: ld iy,zle
|
|
jr z.ps
|
|
zle: jp m,zgo
|
|
jr nz,loop
|
|
xor a
|
|
add a,l
|
|
jr z,zgo
|
|
jr loop
|
|
|
|
|
|
zeq.l: ld iy,zeq
|
|
jr z.pl
|
|
zeq.s1: inc d
|
|
zeq.s0: ld iy,zeq
|
|
jr z.ps
|
|
zeq: ld a,l
|
|
or h
|
|
jr nz,loop
|
|
zgo: push de
|
|
pop ix
|
|
jr loop
|
|
|
|
|
|
zne.sm1:dec d
|
|
jr zne.s0
|
|
zne.l: ld iy,zne
|
|
jr z.pl
|
|
zne.s0: ld iy,zne
|
|
jr z.ps
|
|
zne: ld a,l
|
|
or h
|
|
jr nz,zgo
|
|
jr loop
|
|
|
|
|
|
zge.l: ld iy,zge
|
|
jr z.pl
|
|
zge.s0: ld iy,zge
|
|
jr z.ps
|
|
zge: jp m,loop
|
|
jr zgo
|
|
|
|
|
|
zgt.l: ld iy,zgt
|
|
jr z.pl
|
|
zgt.s0: ld iy,zgt
|
|
jr z.ps
|
|
zgt: jp m,loop
|
|
jr nz,zgo
|
|
xor a
|
|
add a,l
|
|
jr z,loop
|
|
jr zgo
|
|
|
|
|
|
! ------------------- ARRAY REFERENCE GROUP ---------------------------
|
|
|
|
! AAR
|
|
aar.z:
|
|
ld iy,aar.2
|
|
jr pop2
|
|
aar.l: call long2
|
|
aar.2: ld hl,loop
|
|
aarint: pop iy ! descriptor
|
|
ex (sp),hl ! save return address and hl:=index
|
|
ld e,(iy+0)
|
|
ld d,(iy+1) ! de := lwb
|
|
ld a,h
|
|
xor d
|
|
jp m,1f
|
|
sbc hl,de
|
|
jr 2f
|
|
1: sbc hl,de
|
|
xor d
|
|
2: call m,e.array
|
|
ld e,(iy+2)
|
|
ld d,(iy+3) ! de := upb - lwb
|
|
push hl
|
|
ex de,hl
|
|
ld a,h
|
|
xor d
|
|
jp m,1f
|
|
sbc hl,de
|
|
jr 2f
|
|
1: xor d
|
|
2: ex de,hl
|
|
pop hl
|
|
call m,e.array
|
|
1: ld e,(iy+4)
|
|
ld d,(iy+5)
|
|
pop iy
|
|
ex (sp),iy
|
|
push iy ! exchange base address and return address
|
|
push de
|
|
push de
|
|
push hl
|
|
ld iy,1f
|
|
jr mliint
|
|
1: pop de
|
|
pop iy
|
|
pop hl
|
|
push iy
|
|
add hl,de
|
|
pop de
|
|
ex (sp),hl
|
|
jp (hl)
|
|
|
|
lar.l: call long2
|
|
lar.2: ld hl,loi
|
|
jr aarint
|
|
lar.z:
|
|
ld iy,lar.2
|
|
jr pop2
|
|
|
|
|
|
sar.l: call long2
|
|
sar.2: ld hl,sti
|
|
jr aarint
|
|
sar.z:
|
|
ld iy,sar.2
|
|
jr pop2
|
|
|
|
|
|
! --------------------- PROCEDURE CALL/RETURN --------------------------
|
|
|
|
! CAL
|
|
|
|
cal.1: cal.2: cal.3: cal.4: cal.5: cal.6: cal.7: cal.8:
|
|
cal.9: cal.10: cal.11: cal.12: cal.13: cal.14: cal.15: cal.16:
|
|
cal.17: cal.18: cal.19: cal.20: cal.21: cal.22: cal.23: cal.24:
|
|
cal.25: cal.26: cal.27: cal.28:
|
|
ld hl,-b_cal
|
|
add hl,de
|
|
ex de,hl
|
|
jr cal
|
|
|
|
cal.l: ld d,(ix)
|
|
inc ix
|
|
cal.s0: ld e,(ix)
|
|
inc ix
|
|
cal: push ix ! entry point for main program of interpreter
|
|
push bc
|
|
ld hl,(eb+eb%2)
|
|
push hl
|
|
ld hl,(eb+eb%2+4)
|
|
push hl
|
|
! temporary tracing facility
|
|
! NOP it if you don't want it
|
|
push de
|
|
ld de,(eb+eb%2+4)
|
|
ld hl,(eb+eb%2)
|
|
call prline
|
|
pop de
|
|
! end of temporary tracing
|
|
ld hl,0
|
|
add hl,sp
|
|
ld b,h
|
|
ld c,l
|
|
ld hl,(pd)
|
|
ex de,hl
|
|
add hl,hl
|
|
add hl,hl
|
|
add hl,de
|
|
push hl
|
|
pop iy
|
|
ld e,(iy+0)
|
|
ld d,(iy+1)
|
|
ld l,c
|
|
ld h,b
|
|
xor a
|
|
sbc hl,de
|
|
ld sp,hl
|
|
ld e,(iy+2)
|
|
ld d,(iy+3)
|
|
ld ix,0
|
|
add ix,de
|
|
jr loop
|
|
|
|
|
|
! CAI
|
|
|
|
cai.z: pop de
|
|
jr cal
|
|
|
|
|
|
! LFR
|
|
lfr.z: pop de
|
|
2: ld a,e
|
|
rr a
|
|
cp 5
|
|
jp p,eilsize ! only result sizes <= 8 are allowed
|
|
ld hl,retarea
|
|
add hl,de
|
|
1: dec hl
|
|
ld d,(hl)
|
|
dec hl
|
|
ld e,(hl)
|
|
push de
|
|
dec a
|
|
jr nz,1b
|
|
jr loop
|
|
|
|
lfr.l: ld d,(ix)
|
|
inc ix
|
|
lfr.s0: ld e,(ix)
|
|
inc ix
|
|
jr 2b
|
|
|
|
lfr.2: ld hl,(retarea)
|
|
jr phl
|
|
|
|
lfr.4: ld de,4
|
|
jr 2b
|
|
|
|
|
|
! RET
|
|
ret.2: ld a,1
|
|
jr 3f
|
|
|
|
ret.z: pop de
|
|
2: ld a,d
|
|
or e
|
|
jr z,ret.0
|
|
rr a
|
|
cp 5
|
|
jp p,eilsize ! only result sizes <= 8 bytes are allowed
|
|
3: ld hl,retarea
|
|
1: pop de
|
|
ld (hl),e
|
|
inc hl
|
|
ld (hl),d
|
|
inc hl
|
|
dec a
|
|
jr nz,1b
|
|
ret.0:
|
|
ld h,b
|
|
ld l,c
|
|
ld sp,hl
|
|
pop hl
|
|
ld (eb+eb%2+4),hl
|
|
pop hl
|
|
ld (eb+eb%2),hl
|
|
pop bc ! old LB
|
|
pop ix ! reta
|
|
push ix ! check to see if reta = boot (= 0)
|
|
pop hl
|
|
ld a,l
|
|
or h
|
|
jr nz,loop ! not done yet
|
|
call uxfinish
|
|
jr boot
|
|
|
|
ret.l: ld d,(ix)
|
|
inc ix
|
|
ret.s0: ld e,(ix)
|
|
inc ix
|
|
jr 2b
|
|
|
|
|
|
! ------------------------- MISCELLANEOUS -----------------------------
|
|
|
|
! SIG, TRP, RTT
|
|
|
|
sig.z:
|
|
ld hl,(trapproc)
|
|
ex (sp),hl
|
|
ld (trapproc),hl
|
|
jr loop
|
|
|
|
trp.z:
|
|
ex (sp),hl
|
|
push de
|
|
push af
|
|
push ix
|
|
push iy
|
|
push bc
|
|
! ld iy,trapproc
|
|
! ld a,(iy)
|
|
! or (iy+1)
|
|
! jr nz,1f
|
|
ld iy,2f+13
|
|
call octnr
|
|
ld c,printstring
|
|
ld de,2f
|
|
call bdos
|
|
ld de,(eb+eb%2+4)
|
|
ld hl,(eb+eb%2)
|
|
call prline
|
|
0:
|
|
pop iy ! LB
|
|
ld a,(iy+6)
|
|
or (iy+7) ! reta
|
|
jr nz,3f
|
|
call uxfinish
|
|
jp boot
|
|
3:
|
|
ld c,(iy+4)
|
|
ld b,(iy+5)
|
|
push bc ! next LB
|
|
ld e,(iy)
|
|
ld d,(iy+1) ! file name
|
|
ld l,(iy+2)
|
|
ld h,(iy+3) ! lineno
|
|
call prline
|
|
jr 0b
|
|
!1:
|
|
! ld ix,0
|
|
! push hl
|
|
! ld hl,(trapproc)
|
|
! push hl
|
|
! ld hl,0
|
|
! ld (trapproc),hl
|
|
! jr cai.z
|
|
2: .ascii 'error 0xxxxxx\r\n$'
|
|
|
|
prline:
|
|
! prints lineno (hl) and filename (de)
|
|
push de
|
|
ld iy,2f+12
|
|
call octnr
|
|
ld c,printstring
|
|
ld de,2f
|
|
call bdos
|
|
pop de
|
|
ld hl,4f
|
|
0:
|
|
ld a,(de)
|
|
or a
|
|
jr z,1f
|
|
ld (hl),a
|
|
inc de
|
|
inc hl
|
|
jr 0b
|
|
1:
|
|
ld (hl),36 ! '$'
|
|
ld de,4f
|
|
ld c,printstring
|
|
call bdos
|
|
ld de,3f
|
|
ld c,printstring
|
|
call bdos
|
|
ret
|
|
2: .ascii 'line 0xxxxxx in $'
|
|
3: .ascii '\r\n$'
|
|
4: .space 12
|
|
|
|
rtt.z=ret.0
|
|
|
|
|
|
|
|
! NOP
|
|
! changed into output routine to print linenumber
|
|
! in octal (6 digits)
|
|
|
|
nop.z: push bc
|
|
ld iy,1f+12
|
|
ld hl,(eb+eb%2)
|
|
call octnr
|
|
ld iy,1f+20
|
|
ld hl,0
|
|
add hl,sp
|
|
call octnr
|
|
ld c,printstring
|
|
ld de,1f
|
|
call bdos
|
|
pop bc
|
|
jr loop
|
|
1: .ascii 'test 0xxxxxx 0xxxxxx\r\n$'
|
|
|
|
octnr:
|
|
ld b,6
|
|
1: ld a,7
|
|
and l
|
|
add a,'0'
|
|
dec iy
|
|
ld (iy+0),a
|
|
srl h
|
|
rr l
|
|
srl h
|
|
rr l
|
|
srl h
|
|
rr l
|
|
djnz 1b
|
|
ret
|
|
|
|
|
|
! DUP
|
|
|
|
dup.2: pop hl
|
|
push hl
|
|
jr phl
|
|
|
|
dus.z:
|
|
ld iy,1f
|
|
jr pop2
|
|
dus.l: call long2
|
|
1: push bc
|
|
pop iy
|
|
pop bc
|
|
jr dodup
|
|
dup.l:
|
|
push bc
|
|
pop iy
|
|
ld b,(ix)
|
|
inc ix
|
|
ld c,(ix)
|
|
inc ix
|
|
dodup: ld h,d
|
|
ld l,d ! ld hl,0
|
|
add hl,sp
|
|
ld d,h
|
|
ld e,l
|
|
xor a
|
|
sbc hl,bc
|
|
ld sp,hl
|
|
ex de,hl
|
|
ldir
|
|
push iy
|
|
pop bc
|
|
jr loop
|
|
|
|
|
|
! BLM, BLS
|
|
bls.z:
|
|
ld iy,blm
|
|
jr pop2
|
|
bls.l: call long2
|
|
blm:
|
|
push bc
|
|
pop iy
|
|
pop bc
|
|
pop de
|
|
pop hl
|
|
ldir
|
|
push iy
|
|
pop bc
|
|
jr loop
|
|
|
|
blm.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
blm.s0: ld e,(ix)
|
|
inc ix
|
|
push de
|
|
jr blm
|
|
|
|
|
|
! ASP, ASS
|
|
ass.z:
|
|
ld iy,1f
|
|
jr pop2
|
|
ass.l: call long2
|
|
1: pop hl
|
|
jr 1f
|
|
asp.l:
|
|
ld h,(ix)
|
|
inc ix
|
|
ld l,(ix)
|
|
inc ix
|
|
asp: add hl,hl
|
|
1: add hl,sp
|
|
ld sp,hl
|
|
jr loop
|
|
|
|
|
|
asp.2: asp.4: asp.6: asp.8: asp.10:
|
|
ld hl,-b_asp
|
|
add hl,de
|
|
jr asp
|
|
|
|
asp.w0: ld e,(ix)
|
|
inc ix
|
|
ex de,hl
|
|
jr asp
|
|
|
|
|
|
! CSA
|
|
|
|
csa.z:
|
|
ld iy,csa.2
|
|
jr pop2
|
|
csa.l: call long2
|
|
csa.2:
|
|
!! temporary version while bug in cem remains
|
|
! pop iy
|
|
! pop de
|
|
! push bc
|
|
! ld c,(iy)
|
|
! ld b,(iy+1)
|
|
! ld l,(iy+4)
|
|
! ld h,(iy+5)
|
|
! xor a
|
|
! sbc hl,de
|
|
! jp m,1f
|
|
! ex de,hl
|
|
! ld e,(iy+2)
|
|
! ld d,(iy+3)
|
|
! xor a
|
|
! sbc hl,de
|
|
! jp m,1f
|
|
! end of temporary piece
|
|
pop iy
|
|
pop hl
|
|
push bc
|
|
ld c,(iy)
|
|
ld b,(iy+1)
|
|
ld e,(iy+2)
|
|
ld d,(iy+3)
|
|
xor a
|
|
sbc hl,de
|
|
jp m,1f
|
|
ex de,hl
|
|
ld l,(iy+4)
|
|
ld h,(iy+5)
|
|
xor a
|
|
sbc hl,de
|
|
jp m,1f
|
|
ex de,hl
|
|
add hl,hl
|
|
ld de,6
|
|
add hl,de
|
|
ex de,hl
|
|
add iy,de
|
|
ld l,(iy)
|
|
ld h,(iy+1)
|
|
ld a,h
|
|
or l
|
|
jr nz,2f
|
|
1: ld a,b
|
|
or c
|
|
jr z,e.case
|
|
ld l,c
|
|
ld h,b
|
|
2: pop bc
|
|
push hl
|
|
pop ix
|
|
jr loop
|
|
! CSB
|
|
|
|
csb.z:
|
|
ld iy,csb.2
|
|
jr pop2
|
|
csb.l: call long2
|
|
csb.2:
|
|
pop ix
|
|
pop iy
|
|
ld e,(ix)
|
|
inc ix
|
|
ld d,(ix)
|
|
inc ix
|
|
push de
|
|
ex (sp),iy
|
|
pop de
|
|
push bc
|
|
ld c,(ix)
|
|
inc ix
|
|
ld b,(ix)
|
|
inc ix
|
|
1:
|
|
ld a,b
|
|
or c
|
|
jr z,noteq
|
|
ld a,(ix+0)
|
|
cp e
|
|
jr nz,2f
|
|
ld a,(ix+1)
|
|
cp d
|
|
jr nz,2f
|
|
ld l,(ix+2)
|
|
ld h,(ix+3)
|
|
jr 3f
|
|
2: inc ix
|
|
inc ix
|
|
inc ix
|
|
inc ix
|
|
dec bc
|
|
jr 1b
|
|
noteq: push iy
|
|
pop hl
|
|
3: ld a,l
|
|
or h
|
|
jr z,e.case
|
|
2:
|
|
pop bc
|
|
push hl
|
|
pop ix
|
|
jr loop
|
|
|
|
|
|
! LIN
|
|
lin.l: ld d,(ix)
|
|
inc ix
|
|
lin.s0: ld e,(ix)
|
|
inc ix
|
|
ld (eb+eb%2),de
|
|
jr loop
|
|
|
|
|
|
! FIL
|
|
fil.z: pop hl
|
|
1:
|
|
ld (eb+eb%2+4),hl
|
|
jr loop
|
|
|
|
fil.l: ld h,(ix)
|
|
inc ix
|
|
ld l,(ix)
|
|
inc ix
|
|
ld de,eb+eb%2
|
|
add hl,de
|
|
jr 1b
|
|
|
|
|
|
! LNI
|
|
lni.z: ld hl,(eb+eb%2)
|
|
inc hl
|
|
ld (eb+eb%2),hl
|
|
jr loop
|
|
|
|
|
|
! RCK
|
|
rck.z:
|
|
ld iy,rck.2
|
|
jr pop2
|
|
rck.l: call long2
|
|
rck.2:
|
|
pop iy
|
|
3: pop hl
|
|
push hl
|
|
ld e,(iy)
|
|
ld d,(iy+1)
|
|
ld a,h
|
|
xor d ! check sign bit to catch overflow with subtract
|
|
jp m,1f
|
|
sbc hl,de
|
|
jr 2f
|
|
1: xor d ! now a equals (original) h again
|
|
2: call m,e.rck
|
|
pop de
|
|
push de
|
|
ld l,(iy+2)
|
|
ld h,(iy+3)
|
|
ld a,h
|
|
xor d ! check sign bit to catch overflow with subtract
|
|
jp m,1f
|
|
sbc hl,de
|
|
jr 2f
|
|
1: xor d ! now a equals (original) h again
|
|
2: call m,e.rck
|
|
jr loop
|
|
|
|
|
|
! LIM
|
|
lim.z: ld hl,(ignmask)
|
|
jr phl
|
|
|
|
|
|
! SIM
|
|
sim.z: pop de
|
|
ld (ignmask),de
|
|
jr loop
|
|
|
|
|
|
! LOR
|
|
|
|
lor.s0: ld e,(ix)
|
|
inc ix
|
|
ld a,d
|
|
or e
|
|
jr nz,1f
|
|
push bc
|
|
jr loop
|
|
1: ld hl,-1
|
|
adc hl,de
|
|
jr nz,1f
|
|
add hl,sp
|
|
jr phl
|
|
1: ld hl,(hp)
|
|
jr phl
|
|
|
|
|
|
! STR
|
|
|
|
str.s0: ld e,(ix)
|
|
inc ix
|
|
ld a,d
|
|
or e
|
|
jr nz,1f
|
|
pop bc
|
|
jr loop
|
|
1: pop hl
|
|
dec de
|
|
ld a,d
|
|
or e
|
|
jr nz,1f
|
|
ld sp,hl
|
|
jr loop
|
|
1: ld (hp),hl
|
|
jr loop
|
|
|
|
! Floating point calling routines
|
|
|
|
loadfregs:
|
|
pop hl
|
|
pop de
|
|
ld (fpac),de
|
|
pop de
|
|
ld (fpac+2),de
|
|
pop de
|
|
ld (fpop),de
|
|
pop de
|
|
ld (fpop+2),de
|
|
jp (hl)
|
|
|
|
dofltop:
|
|
call loadfregs
|
|
push bc
|
|
push ix
|
|
ld hl,1f
|
|
push hl
|
|
push iy
|
|
ret ! really a call
|
|
1:
|
|
pop ix
|
|
pop bc
|
|
ld hl,(fpac+2)
|
|
push hl
|
|
ld hl,(fpac)
|
|
jr phl
|
|
|
|
pop4:
|
|
pop hl
|
|
or h
|
|
jr nz,9f
|
|
ld a,l
|
|
cp 4
|
|
jr nz,9f
|
|
jp (iy)
|
|
arg4:
|
|
or d
|
|
jr nz,9f
|
|
ld a,(ix)
|
|
inc ix
|
|
cp 4
|
|
jr nz,9f
|
|
jp (iy)
|
|
9: jr unimpld
|
|
|
|
adf.z: ld iy,doadf
|
|
jr pop4
|
|
adf.l: ld d,(ix)
|
|
inc ix
|
|
adf.s0: ld iy,doadf
|
|
jr arg4
|
|
doadf:
|
|
ld iy,fpadd ! routine to call
|
|
jr dofltop
|
|
|
|
sbf.z: ld iy,dosbf
|
|
jr pop4
|
|
sbf.l: ld d,(ix)
|
|
inc ix
|
|
sbf.s0: ld iy,dosbf
|
|
jr arg4
|
|
dosbf:
|
|
ld iy,fpsub ! routine to call
|
|
jr dofltop
|
|
|
|
mlf.z: ld iy,domlf
|
|
jr pop4
|
|
mlf.l: ld d,(ix)
|
|
inc ix
|
|
mlf.s0: ld iy,domlf
|
|
jr arg4
|
|
domlf:
|
|
ld iy,fpmult ! routine to call
|
|
jr dofltop
|
|
|
|
dvf.z: ld iy,dodvf
|
|
jr pop4
|
|
dvf.l: ld d,(ix)
|
|
inc ix
|
|
dvf.s0: ld iy,dodvf
|
|
jr arg4
|
|
dodvf:
|
|
ld iy,fpdiv ! routine to call
|
|
jr dofltop
|
|
|
|
cmf.z: ld iy,docmf
|
|
jr pop4
|
|
cmf.l: ld d,(ix)
|
|
inc ix
|
|
cmf.s0: ld iy,docmf
|
|
jr arg4
|
|
docmf:
|
|
call loadfregs
|
|
push bc
|
|
push ix
|
|
call fpcmf
|
|
pop ix
|
|
pop bc
|
|
ld hl,(fpac)
|
|
jr phl
|
|
cfi.z:
|
|
pop de
|
|
call chk24
|
|
.word 1f,0f
|
|
1: ld iy,1f
|
|
jr pop4
|
|
1: pop hl
|
|
ld (fpac),hl
|
|
pop hl
|
|
ld (fpac+2),hl
|
|
push bc
|
|
push ix
|
|
call fpcfi
|
|
pop ix
|
|
pop bc
|
|
ld hl,(fpac)
|
|
jr phl
|
|
0: ld iy,1f
|
|
jr pop4
|
|
1: pop hl
|
|
ld (fpac),hl
|
|
pop hl
|
|
ld (fpac+2),hl!
|
|
push bc
|
|
push ix
|
|
call fpcfd
|
|
jr 8f
|
|
cif.z:
|
|
ld iy,1f
|
|
jr pop4
|
|
1:
|
|
pop de
|
|
call chk24
|
|
.word 1f,0f
|
|
1: pop hl
|
|
ld (fpac),hl
|
|
push bc
|
|
push ix
|
|
call fpcif
|
|
8: pop ix
|
|
pop bc
|
|
ld hl,(fpac+2)
|
|
push hl
|
|
ld hl,(fpac)
|
|
jr phl
|
|
0: pop hl
|
|
ld (fpac),hl
|
|
pop hl
|
|
ld (fpac+2),hl
|
|
push bc
|
|
push ix
|
|
call fpcdf
|
|
jr 8b
|
|
|
|
ngf.l: ld d,(ix)
|
|
inc ix
|
|
ld iy,1f
|
|
jr arg4
|
|
ngf.z:
|
|
ld iy,1f
|
|
jr pop4
|
|
1: pop hl
|
|
ld (fpac),hl
|
|
pop hl
|
|
ld (fpac+2),hl
|
|
push bc
|
|
push ix
|
|
call fpcomp
|
|
jr 8b
|
|
|
|
fif.z:
|
|
ld iy,1f
|
|
jr pop4
|
|
fif.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
ld iy,1f
|
|
jr arg4
|
|
1: call loadfregs
|
|
push bc
|
|
push ix
|
|
call fpfif
|
|
pop ix
|
|
pop bc
|
|
ld hl,(fpac+2)
|
|
push hl
|
|
ld hl,(fpac)
|
|
push hl
|
|
ld hl,(fpop+2)
|
|
push hl
|
|
ld hl,(fpop)
|
|
jr phl
|
|
|
|
fef.z:
|
|
ld iy,1f
|
|
jr pop4
|
|
fef.l:
|
|
ld d,(ix)
|
|
inc ix
|
|
ld iy,1f
|
|
jr arg4
|
|
1: pop hl
|
|
ld (fpop),hl
|
|
pop hl
|
|
ld (fpop+2),hl
|
|
push bc
|
|
push ix
|
|
call fpfef
|
|
pop ix
|
|
pop bc
|
|
ld hl,(fpop+2)
|
|
push hl
|
|
ld hl,(fpop)
|
|
push hl
|
|
ld hl,(fpac)
|
|
jr phl
|
|
|
|
! double aritmetic
|
|
|
|
adi.4:
|
|
push bc
|
|
pop iy
|
|
pop hl
|
|
pop de
|
|
pop bc
|
|
add hl,bc
|
|
ex de,hl
|
|
pop bc
|
|
adc hl,bc
|
|
push hl
|
|
push de
|
|
push iy
|
|
pop bc
|
|
jr loop
|
|
sbi.4:
|
|
push bc
|
|
pop iy
|
|
pop bc
|
|
pop de
|
|
pop hl
|
|
sbc hl,bc
|
|
ex de,hl
|
|
ld b,h
|
|
ld c,l
|
|
pop hl
|
|
9:
|
|
sbc hl,bc
|
|
push hl
|
|
push de
|
|
push iy
|
|
pop bc
|
|
jr loop
|
|
ngi.4:
|
|
push bc
|
|
pop iy
|
|
ld hl,0
|
|
pop de
|
|
sbc hl,de
|
|
ex de,hl
|
|
ld hl,0
|
|
pop bc
|
|
jr 9b
|
|
mli.4:
|
|
ld iy,.mli4
|
|
0:
|
|
ld (retarea),bc
|
|
ld (retarea+2),ix
|
|
ld hl,1f
|
|
push hl
|
|
push iy
|
|
ret
|
|
1:
|
|
ld bc,(retarea)
|
|
ld ix,(retarea+2)
|
|
jr loop
|
|
dvu.4:
|
|
ld iy,.dvu4
|
|
jr 0b
|
|
|
|
dvi.4:
|
|
ld iy,.dvi4
|
|
jr 0b
|
|
|
|
! list of not yet implemented instructions
|
|
cuf.z:
|
|
cff.z:
|
|
cfu.z:
|
|
unimpld: ! used in dispatch table to
|
|
! catch unimplemented instructions
|
|
ld hl,EILLINS
|
|
9: push hl
|
|
jr trp.z
|
|
|
|
eilsize:
|
|
ld hl,EILLSIZE
|
|
jr 9b
|
|
|
|
e.case:
|
|
ld hl,ECASE
|
|
jr 9b
|
|
e.mon:
|
|
ld hl,EMON
|
|
jr 9b
|
|
e.array:
|
|
push af
|
|
ld a,(ignmask)
|
|
bit 0,a
|
|
jr nz,8f
|
|
ld hl,EARRAY
|
|
jr 9b
|
|
e.rck:
|
|
push af
|
|
ld a,(ignmask)
|
|
bit 1,a
|
|
jr nz,8f
|
|
ld hl,ERANGE
|
|
jr 9b
|
|
8:
|
|
pop af
|
|
ret
|
|
|
|
long2: ld a,(ix)
|
|
inc ix
|
|
or a
|
|
jr nz,unimpld
|
|
ld a,(ix)
|
|
inc ix
|
|
cp 2
|
|
jr nz,unimpld
|
|
xor a ! clear carry
|
|
ret
|
|
|
|
! monitor instruction
|
|
! a small collection of UNIX system calls implemented under CP/M
|
|
|
|
ux_indir=e.mon
|
|
ux_fork=e.mon
|
|
ux_wait=e.mon
|
|
ux_link=e.mon
|
|
ux_exec=e.mon
|
|
ux_chdir=e.mon
|
|
ux_mknod=e.mon
|
|
ux_chmod=e.mon
|
|
ux_chown=e.mon
|
|
ux_break=e.mon
|
|
ux_stat=e.mon
|
|
ux_seek=e.mon
|
|
ux_mount=e.mon
|
|
ux_umount=e.mon
|
|
ux_setuid=e.mon
|
|
ux_getuid=e.mon
|
|
ux_stime=e.mon
|
|
ux_ptrace=e.mon
|
|
ux_alarm=e.mon
|
|
ux_fstat=e.mon
|
|
ux_pause=e.mon
|
|
ux_utime=e.mon
|
|
ux_stty=e.mon
|
|
ux_gtty=e.mon
|
|
ux_access=e.mon
|
|
ux_nice=e.mon
|
|
ux_sync=e.mon
|
|
ux_kill=e.mon
|
|
ux_dup=e.mon
|
|
ux_pipe=e.mon
|
|
ux_times=e.mon
|
|
ux_prof=e.mon
|
|
ux_unused=e.mon
|
|
ux_setgid=e.mon
|
|
ux_getgid=e.mon
|
|
ux_sig=e.mon
|
|
ux_umask=e.mon
|
|
ux_chroot=e.mon
|
|
|
|
EPERM = 1
|
|
ENOENT = 2
|
|
ESRCH = 3
|
|
EINTR = 4
|
|
EIO = 5
|
|
ENXIO = 6
|
|
E2BIG = 7
|
|
ENOEXEC = 8
|
|
EBADF = 9
|
|
ECHILD = 10
|
|
EAGAIN = 11
|
|
ENOMEM = 12
|
|
EACCES = 13
|
|
EFAULT = 14
|
|
ENOTBLK = 15
|
|
EBUSY = 16
|
|
EEXIST = 17
|
|
EXDEV = 18
|
|
ENODEV = 19
|
|
ENOTDIR = 20
|
|
EISDIR = 21
|
|
EINVAL = 22
|
|
ENFILE = 23
|
|
EMFILE = 24
|
|
ENOTTY = 25
|
|
ETXTBSY = 26
|
|
EFBIG = 27
|
|
ENOSPC = 28
|
|
ESPIPE = 29
|
|
EROFS = 30
|
|
EMLINK = 31
|
|
EPIPE = 32
|
|
EDOM = 33
|
|
! Structure of filearea maintained by this implementation
|
|
! First iobuffer of 128 bytes
|
|
! Then the fcb area of 36 bytes
|
|
! The number of bytes left in the buffer, 1 byte
|
|
! The iopointer into the buffer, 2 bytes
|
|
! The openflag 0 unused, 1 reading, 2 writing, 1 byte
|
|
! The filedescriptor starting at 3, 1 byte
|
|
! The number of CTRL-Zs that have been absorbed, 1 byte
|
|
! The byte read after a sequence of CTRL-Zs, 1 byte
|
|
|
|
maxfiles=8
|
|
filesize=128+36+1+2+1+1+1+1
|
|
|
|
filefcb=0 ! pointers point to fcb
|
|
position=33
|
|
nleft=36
|
|
iopointer=37
|
|
openflag=39
|
|
fildes=40
|
|
zcount=41
|
|
zsave=42
|
|
|
|
.errnz filefcb
|
|
|
|
0: .space maxfiles*filesize
|
|
filearea = 0b+128
|
|
sibuf:
|
|
.word 0
|
|
.space 82
|
|
siptr: .space 2
|
|
saveargs:
|
|
.space 128
|
|
argv: .space 40 ! not more than 20 args
|
|
argc: .space 2
|
|
ttymode:.byte 9,9,8,21;.short 06310+RAW*040 ! raw = 040
|
|
|
|
uxinit:
|
|
xor a
|
|
ld c,maxfiles
|
|
ld hl,0b
|
|
1: ld b,filesize
|
|
2: ld (hl),a
|
|
inc hl
|
|
djnz 2b
|
|
dec c
|
|
jr nz,1b
|
|
ret
|
|
|
|
uxfinish:
|
|
ld a,maxfiles-1
|
|
1: push af
|
|
call closefil
|
|
pop af
|
|
dec a
|
|
cp 0377
|
|
jr nz,1b
|
|
ret
|
|
|
|
makeargv:
|
|
ld hl,0x80
|
|
ld de,saveargs
|
|
ld bc,128
|
|
ldir
|
|
ld hl,saveargs
|
|
ld e,(hl)
|
|
inc hl
|
|
ld d,0
|
|
add hl,de
|
|
ld (hl),0
|
|
ld hl,saveargs+1
|
|
ld ix,argv
|
|
1: ld a,(hl)
|
|
or a
|
|
jr z,9f
|
|
cp ' '
|
|
jr nz,2f
|
|
4: ld (hl),0
|
|
inc hl
|
|
jr 1b
|
|
2: ld (ix),l
|
|
inc ix
|
|
ld (ix),h
|
|
inc ix
|
|
3: inc hl
|
|
ld a,(hl)
|
|
or a
|
|
jr z,9f
|
|
cp ' '
|
|
jr nz,3b
|
|
jr 4b
|
|
9: push ix
|
|
pop hl
|
|
ld de,-argv
|
|
add hl,de
|
|
srl h;rr l
|
|
ld (argc),hl
|
|
ld (ix+0),0
|
|
ld (ix+1),0
|
|
ret
|
|
|
|
mon.z:
|
|
pop de ! system call number
|
|
xor a
|
|
or d
|
|
jr nz,unimpld ! too big
|
|
ld a,e
|
|
and 0300 ! only 64 system calls
|
|
jr nz,unimpld
|
|
sla e
|
|
ld hl,systab
|
|
add hl,de
|
|
ld e,(hl)
|
|
inc hl
|
|
ld d,(hl)
|
|
ex de,hl
|
|
jp (hl)
|
|
|
|
systab:
|
|
.word ux_indir
|
|
.word ux_exit
|
|
.word ux_fork
|
|
.word ux_read
|
|
.word ux_write
|
|
.word ux_open
|
|
.word ux_close
|
|
.word ux_wait
|
|
.word ux_creat
|
|
.word ux_link
|
|
.word ux_unlink
|
|
.word ux_exec
|
|
.word ux_chdir
|
|
.word ux_time
|
|
.word ux_mknod
|
|
.word ux_chmod
|
|
.word ux_chown
|
|
.word ux_break
|
|
.word ux_stat
|
|
.word ux_seek
|
|
.word ux_getpid
|
|
.word ux_mount
|
|
.word ux_umount
|
|
.word ux_setuid
|
|
.word ux_getuid
|
|
.word ux_stime
|
|
.word ux_ptrace
|
|
.word ux_alarm
|
|
.word ux_fstat
|
|
.word ux_pause
|
|
.word ux_utime
|
|
.word ux_stty
|
|
.word ux_gtty
|
|
.word ux_access
|
|
.word ux_nice
|
|
.word ux_ftime
|
|
.word ux_sync
|
|
.word ux_kill
|
|
.word unimpld
|
|
.word unimpld
|
|
.word unimpld
|
|
.word ux_dup
|
|
.word ux_pipe
|
|
.word ux_times
|
|
.word ux_prof
|
|
.word ux_unused
|
|
.word ux_setgid
|
|
.word ux_getgid
|
|
.word ux_sig
|
|
.word unimpld
|
|
.word unimpld
|
|
.word unimpld
|
|
.word unimpld
|
|
.word unimpld
|
|
.word ux_ioctl
|
|
.word unimpld
|
|
.word unimpld
|
|
.word unimpld
|
|
.word unimpld
|
|
.word ux_exece
|
|
.word ux_umask
|
|
.word ux_chroot
|
|
.word unimpld
|
|
.word unimpld
|
|
|
|
emptyfile:
|
|
! searches for a free filestructure
|
|
! returns pointer in iy, 0 if not found
|
|
ld iy,filearea
|
|
ld l,maxfiles
|
|
1:
|
|
xor a
|
|
or (iy+openflag)
|
|
jr nz,3f
|
|
ld a,maxfiles+3
|
|
sub l
|
|
ld (iy+fildes),a
|
|
#ifdef CPM1
|
|
push bc
|
|
push iy
|
|
ld de,-128
|
|
add iy,de
|
|
push iy
|
|
pop de
|
|
ld c,setdma
|
|
call bdos
|
|
pop iy
|
|
pop bc
|
|
or a ! to clear C
|
|
#endif
|
|
ret
|
|
3:
|
|
ld de,filesize
|
|
add iy,de
|
|
dec l
|
|
jr nz,1b
|
|
scf
|
|
ret
|
|
|
|
findfile:
|
|
ld iy,filearea
|
|
ld de,filesize
|
|
0:
|
|
dec a
|
|
ret m
|
|
add iy,de
|
|
jr 0b
|
|
|
|
getchar:
|
|
push bc
|
|
push de
|
|
push hl
|
|
dec (iy+nleft)
|
|
jp p,0f
|
|
push iy
|
|
pop hl
|
|
ld de,-128
|
|
add hl,de
|
|
ld (iy+iopointer),l
|
|
ld (iy+iopointer+1),h
|
|
ex de,hl
|
|
push iy
|
|
ld c,setdma
|
|
call bdos
|
|
#ifdef CPM1
|
|
ld c,seqread
|
|
#else
|
|
ld c,randomread
|
|
#endif
|
|
pop de
|
|
call bdos
|
|
or a
|
|
jr z,1f
|
|
ld (iy+zcount),0
|
|
pop hl
|
|
pop de
|
|
pop bc
|
|
scf
|
|
ret
|
|
1:
|
|
inc (iy+position)
|
|
jr nz,2f
|
|
inc (iy+position+1)
|
|
2:
|
|
ld a,127
|
|
ld (iy+nleft),a
|
|
0:
|
|
ld h,(iy+iopointer+1)
|
|
ld l,(iy+iopointer)
|
|
ld a,(hl)
|
|
inc hl
|
|
ld (iy+iopointer),l
|
|
ld (iy+iopointer+1),h
|
|
pop hl
|
|
pop de
|
|
pop bc
|
|
ret
|
|
or a
|
|
|
|
putchar:
|
|
push hl
|
|
ld h,(iy+iopointer+1)
|
|
ld l,(iy+iopointer)
|
|
ld (hl),a
|
|
dec (iy+nleft)
|
|
jr z,0f
|
|
inc hl
|
|
ld (iy+iopointer+1),h
|
|
ld (iy+iopointer),l
|
|
pop hl
|
|
ret
|
|
0:
|
|
pop hl
|
|
flsbuf:
|
|
push hl
|
|
push de
|
|
push bc
|
|
push iy
|
|
pop hl
|
|
ld de,-128
|
|
add hl,de
|
|
ld (iy+iopointer+1),h
|
|
ld (iy+iopointer),l
|
|
ex de,hl
|
|
push iy
|
|
ld c,setdma
|
|
call bdos
|
|
pop de
|
|
#ifdef CPM1
|
|
ld c,seqwrite
|
|
#else
|
|
ld c,randomwrite
|
|
#endif
|
|
call bdos
|
|
or a
|
|
jr z,1f
|
|
pop bc
|
|
pop de
|
|
pop hl
|
|
scf
|
|
ret
|
|
1:
|
|
inc (iy+position)
|
|
jr nz,2f
|
|
inc (iy+position+1)
|
|
2:
|
|
ld a,128
|
|
ld (iy+nleft),a
|
|
ld b,a
|
|
push iy
|
|
pop hl
|
|
ld de,-128
|
|
add hl,de
|
|
ld a,26 ! ctrl z
|
|
1: ld (hl),a
|
|
inc hl
|
|
djnz 1b
|
|
pop bc
|
|
pop de
|
|
pop hl
|
|
or a
|
|
ret
|
|
|
|
parsename:
|
|
! parses file name pointed to by hl and fills in fcb
|
|
! of the file pointed to by iy.
|
|
! recognizes filenames as complicated as 'b:file.zot'
|
|
! and as simple as 'x'
|
|
|
|
push bc
|
|
push iy
|
|
pop de
|
|
xor a
|
|
push de
|
|
ld b,36 ! sizeof fcb
|
|
0: ld (de),a
|
|
inc de
|
|
djnz 0b
|
|
pop de
|
|
inc hl
|
|
ld a,(hl)
|
|
dec hl
|
|
cp ':' ! drive specified ?
|
|
jr nz,1f
|
|
ld a,(hl)
|
|
inc hl
|
|
inc hl
|
|
dec a
|
|
and 15
|
|
inc a ! now 1<= a <= 16
|
|
ld (de),a
|
|
1: inc de
|
|
ld b,8 ! filename maximum of 8 characters
|
|
1: ld a,(hl)
|
|
or a
|
|
jr nz,8f
|
|
dec hl
|
|
ld a,'.'
|
|
8:
|
|
inc hl
|
|
cp '.'
|
|
jr z,2f
|
|
and 0177 ! no parity
|
|
bit 6,a
|
|
jr z,9f
|
|
and 0337 ! UPPER case
|
|
9:
|
|
ld (de),a
|
|
inc de
|
|
djnz 1b
|
|
ld a,(hl)
|
|
inc hl
|
|
cp '.'
|
|
jr z,3f
|
|
ld a,' '
|
|
ld (de),a
|
|
inc de
|
|
ld (de),a
|
|
inc de
|
|
ld (de),a
|
|
pop bc
|
|
ret ! filenames longer than 8 are truncated
|
|
2: ld a,' ' ! fill with spaces
|
|
0: ld (de),a
|
|
inc de
|
|
djnz 0b
|
|
3: ld b,3 ! length of extension
|
|
1: ld a,(hl)
|
|
inc hl
|
|
or a
|
|
jr z,4f
|
|
cp 0100
|
|
jp m,2f
|
|
and 0137
|
|
2: ld (de),a
|
|
inc de
|
|
djnz 1b
|
|
pop bc
|
|
ret
|
|
4: ld a,' '
|
|
0: ld (de),a
|
|
inc de
|
|
djnz 0b
|
|
pop bc
|
|
ret
|
|
|
|
! various routines
|
|
ux_close:
|
|
pop hl
|
|
ld a,l
|
|
sub 3
|
|
jp m,1f
|
|
cp maxfiles
|
|
call m,closefil
|
|
1: ld hl,0
|
|
jr phl
|
|
|
|
closefil:
|
|
call findfile
|
|
ld a,(iy+openflag)
|
|
or a
|
|
jr z,3f
|
|
ld (iy+openflag),0
|
|
cp 1
|
|
jr z,2f
|
|
ld a,(iy+nleft)
|
|
cp 128
|
|
jr z,2f
|
|
call flsbuf
|
|
2:
|
|
push bc
|
|
push iy
|
|
pop de
|
|
ld c,close
|
|
call bdos
|
|
pop bc
|
|
3: ret
|
|
|
|
ux_ioctl:
|
|
pop hl
|
|
ld a,l
|
|
sub 3
|
|
jp p,1f
|
|
pop hl
|
|
ld a,h
|
|
cp 't'
|
|
jr nz,e.mon
|
|
ld a,l
|
|
cp 8
|
|
jr z,tiocgetp
|
|
cp 9
|
|
jr z,tiocsetp
|
|
jr e.mon
|
|
1: pop hl
|
|
pop hl
|
|
ld hl,-1
|
|
jr phl
|
|
tiocgetp:
|
|
pop de
|
|
ld hl,ttymode
|
|
2: push bc
|
|
ld bc,6
|
|
ldir
|
|
ld h,b
|
|
ld l,c
|
|
pop bc
|
|
jr phl
|
|
tiocsetp:
|
|
pop hl
|
|
ld de,ttymode
|
|
jr 2b
|
|
|
|
ux_time:
|
|
call time4
|
|
jr loop
|
|
|
|
ux_ftime:
|
|
pop hl
|
|
ld (retarea+6),hl
|
|
call time4
|
|
ld hl,(retarea+6)
|
|
pop de
|
|
ld (hl),e
|
|
inc hl
|
|
ld (hl),d
|
|
inc hl
|
|
pop de
|
|
ld (hl),e
|
|
inc hl
|
|
ld (hl),d
|
|
inc hl
|
|
xor a
|
|
ld (hl),a
|
|
inc hl
|
|
ld (hl),a
|
|
inc hl
|
|
ld (hl),a
|
|
inc hl
|
|
ld (hl),a
|
|
inc hl
|
|
ld (hl),a
|
|
inc hl
|
|
ld (hl),a
|
|
jr loop
|
|
|
|
time4:
|
|
pop hl
|
|
ld (retarea),bc
|
|
ld (retarea+2),ix
|
|
ld (retarea+4),hl
|
|
ld hl,(timebuf+2)
|
|
push hl
|
|
ld hl,(timebuf)
|
|
push hl
|
|
ld hl,0
|
|
push hl
|
|
ld hl,50
|
|
push hl
|
|
call .dvu4
|
|
ld bc,(retarea)
|
|
ld ix,(retarea+2)
|
|
ld hl,(retarea+4)
|
|
jp (hl)
|
|
ux_exit:
|
|
call uxfinish
|
|
ld c,reset
|
|
call bdos
|
|
! no return
|
|
|
|
ux_creat:
|
|
call emptyfile
|
|
jr c,openfailed
|
|
pop hl
|
|
call parsename
|
|
pop hl ! file mode, not used under CP/M
|
|
push bc
|
|
push iy
|
|
push iy
|
|
pop de
|
|
ld c,delete
|
|
call bdos
|
|
pop de
|
|
ld c,makefile
|
|
call bdos
|
|
pop bc
|
|
ld l,1
|
|
jr afteropen
|
|
ux_open:
|
|
call emptyfile
|
|
jr nc,1f
|
|
openfailed:
|
|
pop hl
|
|
pop hl ! remove params
|
|
ld hl,EMFILE
|
|
push hl
|
|
jr phl
|
|
1:
|
|
pop hl ! filename
|
|
call parsename
|
|
push bc
|
|
ld c,open
|
|
push iy
|
|
pop de
|
|
call bdos
|
|
pop bc
|
|
pop hl
|
|
afteropen:
|
|
inc a
|
|
jr nz,1f
|
|
ld hl,ENOENT
|
|
push hl
|
|
jr phl
|
|
1:
|
|
inc l
|
|
ld (iy+openflag),l
|
|
xor a
|
|
ld (iy+nleft),a
|
|
ld (iy+zcount),a
|
|
ld (iy+zsave),26
|
|
bit 1,l
|
|
jr z,2f
|
|
ld (iy+nleft),128
|
|
2:
|
|
ld (iy+position),a
|
|
ld (iy+position+1),a
|
|
push iy
|
|
pop hl
|
|
push bc
|
|
ld b,128
|
|
3: dec hl
|
|
ld (hl),26
|
|
djnz 3b
|
|
pop bc
|
|
ld (iy+iopointer+1),h
|
|
ld (iy+iopointer),l
|
|
ld h,a
|
|
ld l,(iy+fildes)
|
|
push hl
|
|
ld l,a
|
|
jr phl
|
|
|
|
ux_read:
|
|
pop hl
|
|
ld a,l
|
|
sub 3
|
|
jp p,readfile
|
|
ld a,(ttymode+4)
|
|
bit 5,a
|
|
jr z,1f ! not raw
|
|
push bc
|
|
#ifdef CPM1
|
|
!raw echo interface
|
|
ld c,consolein
|
|
call bdos
|
|
#else
|
|
!no echo interface
|
|
4:
|
|
ld c,diconio
|
|
ld e,0xff
|
|
call bdos
|
|
or a
|
|
jr z,4b
|
|
!end of no echo interface
|
|
#endif
|
|
pop bc
|
|
pop hl
|
|
ld (hl),a
|
|
pop hl
|
|
ld hl,1
|
|
push hl
|
|
ld hl,0
|
|
jr phl
|
|
1:
|
|
ld hl,sibuf+1 ! read from console assumed
|
|
dec (hl)
|
|
jp p,2f
|
|
dec hl ! go read console line
|
|
ld (hl),80 ! max line length
|
|
push bc
|
|
push hl
|
|
ld c,readconsole
|
|
ex de,hl
|
|
call bdos
|
|
ld c,writeconsole
|
|
ld e,'\n'
|
|
call bdos
|
|
pop hl
|
|
pop bc
|
|
inc hl
|
|
inc (hl)
|
|
ld (siptr),hl ! ready for transfer
|
|
push hl
|
|
ld e,(hl)
|
|
ld d,0
|
|
add hl,de
|
|
ld (hl),'\r'
|
|
inc hl
|
|
ld (hl),'\n'
|
|
pop hl
|
|
2:
|
|
push bc
|
|
pop iy
|
|
ld b,(hl)
|
|
inc b ! bytes remaining
|
|
pop hl ! copy to
|
|
pop de ! bytes wanted (probably 512)
|
|
push iy
|
|
ld iy,(siptr) ! copy from
|
|
xor a ! find out minimum of ramaining and wanted
|
|
or d
|
|
jr nz,3f ! more than 255 wanted (forget that)
|
|
ld a,b
|
|
cp e
|
|
jp m,3f ! not enough remaining
|
|
ld b,e
|
|
3:
|
|
ld c,b ! keep copy
|
|
0:
|
|
inc iy
|
|
ld a,(iy)
|
|
ld (hl),a
|
|
inc hl
|
|
djnz 0b
|
|
ld a,(sibuf+1)
|
|
sub c
|
|
inc a
|
|
ld (sibuf+1),a
|
|
ld (siptr),iy
|
|
pop hl
|
|
push bc
|
|
ld c,b
|
|
push bc ! load 0
|
|
ld b,h
|
|
ld c,l
|
|
jr loop
|
|
readfile:
|
|
call findfile
|
|
pop de
|
|
pop hl ! count
|
|
push bc
|
|
ld bc,0
|
|
0:
|
|
xor a
|
|
or l
|
|
jr z,1f
|
|
dec l
|
|
3:
|
|
! warning: this may not work if zcount overflows
|
|
ld a,(iy+zcount)
|
|
or a
|
|
jr nz,5f
|
|
ld a,(iy+zsave)
|
|
cp 26
|
|
jr z,4f
|
|
ld (iy+zsave),26
|
|
jr 8f
|
|
4:
|
|
call getchar
|
|
jr c,2f
|
|
ld (de),a
|
|
sub 26 ! CTRL-Z
|
|
jr z,7f
|
|
ld a,(iy+zcount)
|
|
or a
|
|
jr z,6f
|
|
ld a,(de)
|
|
ld (iy+zsave),a
|
|
5:
|
|
ld a,26
|
|
dec (iy+zcount)
|
|
8:
|
|
ld (de),a
|
|
6:
|
|
inc de
|
|
inc bc
|
|
jr 0b
|
|
1:
|
|
dec l
|
|
dec h
|
|
jp p,3b
|
|
2:
|
|
pop hl
|
|
push bc
|
|
ld b,h
|
|
ld c,l
|
|
ld hl,0
|
|
jr phl
|
|
7:
|
|
inc (iy+zcount)
|
|
jr 4b
|
|
|
|
ux_write:
|
|
pop hl
|
|
ld a,l
|
|
sub 3
|
|
jp p,writefile
|
|
pop hl ! buffer address
|
|
pop de ! count
|
|
push de
|
|
ld iy,0
|
|
push iy
|
|
push bc
|
|
ld b,e ! count now in 'db'
|
|
0:
|
|
ld a,b
|
|
or a
|
|
jr nz,1f
|
|
ld a,d
|
|
or a
|
|
jr nz,2f
|
|
pop bc
|
|
jr loop
|
|
2:
|
|
dec d
|
|
1:
|
|
dec b
|
|
ld e,(hl)
|
|
inc hl
|
|
push bc
|
|
push de
|
|
push hl
|
|
ld c,writeconsole
|
|
call bdos
|
|
pop hl
|
|
pop de
|
|
pop bc
|
|
jr 0b
|
|
writefile:
|
|
call findfile
|
|
pop de
|
|
pop hl ! count
|
|
push bc
|
|
ld bc,0
|
|
0:
|
|
xor a
|
|
or l
|
|
jr z,1f
|
|
dec l
|
|
3:
|
|
ld a,(de)
|
|
inc de
|
|
call putchar
|
|
jr c,4f
|
|
inc bc
|
|
jr 0b
|
|
1:
|
|
dec l
|
|
dec h
|
|
jp p,3b
|
|
ld iy,0
|
|
2:
|
|
pop hl
|
|
push bc
|
|
ld b,h
|
|
ld c,l
|
|
push iy
|
|
jr loop
|
|
4:
|
|
ld iy,ENOSPC
|
|
jr 2b
|
|
|
|
ux_unlink:
|
|
pop hl
|
|
ld iy,fcb
|
|
call parsename
|
|
push bc
|
|
ld c,delete
|
|
ld de,fcb
|
|
call bdos
|
|
pop bc
|
|
inc a
|
|
jr nz,1f
|
|
ld hl,ENOENT
|
|
jr phl
|
|
1:
|
|
ld hl,0
|
|
jr phl
|
|
|
|
ux_getpid:
|
|
ld hl,12345 ! nice number
|
|
jr phl
|
|
|
|
ux_exece:
|
|
ld iy,fcb
|
|
pop hl
|
|
call parsename
|
|
pop hl
|
|
ld b,h;ld c,l
|
|
pop iy
|
|
ld ix,0x82
|
|
ld (ix-1),' '
|
|
4: ld h,b;ld l,c
|
|
3: ld e,(hl)
|
|
inc hl
|
|
ld d,(hl)
|
|
inc hl
|
|
ld b,h;ld c,l
|
|
ex de,hl
|
|
ld a,h
|
|
or l
|
|
jr z,1f
|
|
2:
|
|
ld a,(hl)
|
|
inc hl
|
|
ld (ix),a
|
|
inc ix
|
|
or a
|
|
jr nz,2b
|
|
ld (ix-1),' '
|
|
jr 4b
|
|
1:
|
|
ld (ix),'X'
|
|
ld (ix+1),'\r'
|
|
ld (ix+2),'\n'
|
|
ld (ix+3),'$'
|
|
ld de,0x81
|
|
push ix
|
|
ld c,printstring
|
|
call bdos
|
|
pop hl
|
|
ld de,-129
|
|
add hl,de
|
|
ld a,l
|
|
ld (0x80),a
|
|
jr warmstart
|
|
|
|
|
|
|
|
|
|
dispat1: ! base for escaped opcodes
|
|
.word aar.l, aar.z, adf.l, adf.z, adi.l, adi.z, ads.l, ads.z
|
|
.word adu.l, adu.z, and.l, and.z, asp.l, ass.l, ass.z, bge.l
|
|
.word bgt.l, ble.l, blm.l, bls.l, bls.z, blt.l, bne.l, cai.z
|
|
.word cal.l, cfi.z, cfu.z, ciu.z, cmf.l, cmf.z, cmi.l, cmi.z
|
|
.word cms.l, cms.z, cmu.l, cmu.z, com.l, com.z, csa.l, csa.z
|
|
.word csb.l, csb.z, cuf.z, cui.z, cuu.z, dee.l, del.p, del.n
|
|
.word dup.l, dus.l, dus.z, dvf.l, dvf.z, dvi.l, dvi.z, dvu.l
|
|
.word dvu.z, fef.l, fef.z, fif.l, fif.z, inl.p, inl.n, inn.l
|
|
.word inn.z, ior.l, ior.z, lar.l, lar.z, ldc.l, ldf.l, ldl.p
|
|
.word ldl.n, lfr.l, lil.p, lil.n, lim.z, los.l, los.z, lor.s0
|
|
.word lpi.l, lxa.l, lxl.l, mlf.l, mlf.z, mli.l, mli.z, mlu.l
|
|
.word mlu.z, mon.z, ngf.l, ngf.z, ngi.l, ngi.z, nop.z, rck.l
|
|
.word rck.z, ret.l, rmi.l, rmi.z, rmu.l, rmu.z, rol.l, rol.z
|
|
.word ror.l, ror.z, rtt.z, sar.l, sar.z, sbf.l, sbf.z, sbi.l
|
|
.word sbi.z, sbs.l, sbs.z, sbu.l, sbu.z, sde.l, sdf.l, sdl.p
|
|
.word sdl.n, set.l, set.z, sig.z, sil.p, sil.n, sim.z, sli.l
|
|
.word sli.z, slu.l, slu.z, sri.l, sri.z, sru.l, sru.z, sti.l
|
|
.word sts.l, sts.z, str.s0, tge.z, tle.z, trp.z, xor.l, xor.z
|
|
.word zer.l, zer.z, zge.l, zgt.l, zle.l, zlt.l, zne.l, zrf.l
|
|
.word zrf.z, zrl.p, dch.z, exg.s0, exg.l, exg.z, lpb.z
|
|
|
|
dispat2: ! base for 4 byte offsets
|
|
.word ldc.f
|
|
|
|
|
|
ignmask: .word 0 ! ignore mask (variable)
|
|
retarea: .word 0 ! base of buffer for result values (max 8 bytes)
|
|
.word 0
|
|
.word 0
|
|
.word 0
|
|
|
|
trapproc:
|
|
.word 0
|
|
|
|
nextp: .byte 0
|
|
|
|
header:
|
|
ntext: .word 0
|
|
ndata: .word 0
|
|
nproc: .word 0
|
|
entry: .word 0
|
|
nline: .word 0
|
|
|
|
hp: .word 0
|
|
pb: .word 0
|
|
pd: .word 0
|