d0p1/ack
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity
ack/mach/z80/int/em.s

4933 lines
60 KiB
ArmAsm
Raw Normal View History

Initial revision
1984-06-25 16:22:03 +00:00
#
! 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
Reference in a new issue Copy permalink