ack/mach/z80/int/em.s
1987-02-03 13:23:38 +00:00

4679 lines
54 KiB
ArmAsm

#
.sect .text
.sect .rom
.sect .data
.sect .bss
.sect .text
! 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 ---------------------------
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
.data1 0 ! fourth byte
dispat = . - 4 ! base of dispatch table
! .data2 loc.0
! .data2 loc.1
.data2 loc.2
.data2 loc.3
.data2 loc.4
.data2 loc.5
.data2 loc.6
.data2 loc.7
.data2 loc.8
.data2 loc.9
.data2 loc.10
.data2 loc.11
.data2 loc.12
.data2 loc.13
.data2 loc.14
.data2 loc.15
.data2 loc.16
.data2 loc.17
.data2 loc.18
.data2 loc.19
.data2 loc.20
.data2 loc.21
.data2 loc.22
.data2 loc.23
.data2 loc.24
.data2 loc.25
.data2 loc.26
.data2 loc.27
.data2 loc.28
.data2 loc.29
.data2 loc.30
.data2 loc.31
.data2 loc.32
.data2 loc.33
.data2 aar.2
.data2 adf.s0
.data2 adi.2
.data2 adi.4
.data2 adp.l
.data2 adp.1
.data2 adp.2
.data2 adp.s0
.data2 adp.sm1
.data2 ads.2
.data2 and.2
.data2 asp.2
.data2 asp.4
.data2 asp.6
.data2 asp.8
.data2 asp.10
.data2 asp.w0
.data2 beq.l
.data2 beq.s0
.data2 bge.s0
.data2 bgt.s0
.data2 ble.s0
.data2 blm.s0
.data2 blt.s0
.data2 bne.s0
.data2 bra.l
.data2 bra.sm1
.data2 bra.sm2
.data2 bra.s0
.data2 bra.s1
.data2 cal.1
.data2 cal.2
.data2 cal.3
.data2 cal.4
.data2 cal.5
.data2 cal.6
.data2 cal.7
.data2 cal.8
.data2 cal.9
.data2 cal.10
.data2 cal.11
.data2 cal.12
.data2 cal.13
.data2 cal.14
.data2 cal.15
.data2 cal.16
.data2 cal.17
.data2 cal.18
.data2 cal.19
.data2 cal.20
.data2 cal.21
.data2 cal.22
.data2 cal.23
.data2 cal.24
.data2 cal.25
.data2 cal.26
.data2 cal.27
.data2 cal.28
.data2 cal.s0
.data2 cff.z
.data2 cif.z
.data2 cii.z
.data2 cmf.s0
.data2 cmi.2
.data2 cmi.4
.data2 cmp.z
.data2 cms.s0
.data2 csa.2
.data2 csb.2
.data2 dec.z
.data2 dee.w0
.data2 del.wm1
.data2 dup.2
.data2 dvf.s0
.data2 dvi.2
.data2 fil.l
.data2 inc.z
.data2 ine.l
.data2 ine.w0
.data2 inl.m2
.data2 inl.m4
.data2 inl.m6
.data2 inl.wm1
.data2 inn.s0
.data2 ior.2
.data2 ior.s0
.data2 lae.l
.data2 lae.w0
.data2 lae.w1
.data2 lae.w2
.data2 lae.w3
.data2 lae.w4
.data2 lae.w5
.data2 lae.w6
.data2 lal.p
.data2 lal.n
.data2 lal.0
.data2 lal.m1
.data2 lal.w0
.data2 lal.wm1
.data2 lal.wm2
.data2 lar.2
.data2 ldc.0
.data2 lde.l
.data2 lde.w0
.data2 ldl.0
.data2 ldl.wm1
.data2 lfr.2
.data2 lfr.4
.data2 lfr.s0
.data2 lil.wm1
.data2 lil.w0
.data2 lil.0
.data2 lil.2
.data2 lin.l
.data2 lin.s0
.data2 lni.z
.data2 loc.l
.data2 loc.m1
.data2 loc.s0
.data2 loc.sm1
.data2 loe.l
.data2 loe.w0
.data2 loe.w1
.data2 loe.w2
.data2 loe.w3
.data2 loe.w4
.data2 lof.l
.data2 lof.2
.data2 lof.4
.data2 lof.6
.data2 lof.8
.data2 lof.s0
.data2 loi.l
.data2 loi.1
.data2 loi.2
.data2 loi.4
.data2 loi.6
.data2 loi.8
.data2 loi.s0
.data2 lol.p
.data2 lol.n
.data2 lol.0
.data2 lol.2
.data2 lol.4
.data2 lol.6
.data2 lol.m2
.data2 lol.m4
.data2 lol.m6
.data2 lol.m8
.data2 lol.m10
.data2 lol.m12
.data2 lol.m14
.data2 lol.m16
.data2 lol.w0
.data2 lol.wm1
.data2 lxa.1
.data2 lxl.1
.data2 lxl.2
.data2 mlf.s0
.data2 mli.2
.data2 mli.4
.data2 rck.2
.data2 ret.0
.data2 ret.2
.data2 ret.s0
.data2 rmi.2
.data2 sar.2
.data2 sbf.s0
.data2 sbi.2
.data2 sbi.4
.data2 sdl.wm1
.data2 set.s0
.data2 sil.wm1
.data2 sil.w0
.data2 sli.2
.data2 ste.l
.data2 ste.w0
.data2 ste.w1
.data2 ste.w2
.data2 stf.l
.data2 stf.2
.data2 stf.4
.data2 stf.s0
.data2 sti.1
.data2 sti.2
.data2 sti.4
.data2 sti.6
.data2 sti.8
.data2 sti.s0
.data2 stl.p
.data2 stl.n
.data2 stl.p0
.data2 stl.p2
.data2 stl.m2
.data2 stl.m4
.data2 stl.m6
.data2 stl.m8
.data2 stl.m10
.data2 stl.wm1
.data2 teq.z
.data2 tgt.z
.data2 tlt.z
.data2 tne.z
.data2 zeq.l
.data2 zeq.s0
.data2 zeq.s1
.data2 zer.s0
.data2 zge.s0
.data2 zgt.s0
.data2 zle.s0
.data2 zlt.s0
.data2 zne.s0
.data2 zne.sm1
.data2 zre.l
.data2 zre.w0
.data2 zrl.m2
.data2 zrl.m4
.data2 zrl.wm1
.data2 zrl.n
.data2 loop1
.data2 loop2
!----------------- END OF MAIN DISPATCH -------------------------------
xxx:
.data2 loc.0
.data2 loc.1
init:
ld sp,(bdos+1) ! address of fbase
ld hl,xxx
ld de,dispat
ld bc,4
ldir
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 ! 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
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: ld e,(ix) ! e = opcode byte
inc ix ! advance EM program counter to next byte
ld hl,dispat ! 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
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
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
add hl,de
add hl,de
jr phl
lae.l: ld d,(ix)
inc ix
ld e,(ix)
inc ix
ld hl,eb
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
.assert [ .-2b-zone] == 0
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
.assert [ zone/256] == 0
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
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
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
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
.data2 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
.data2 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
.data2 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
.data2 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
.data2 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
.data2 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
.data2 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
.data2 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
.data2 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
.data2 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
.data2 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
.data2 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
.data2 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
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
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)
push hl
ld hl,(ebp4)
push hl
! temporary tracing facility
! NOP it if you don't want it
push de
ld de,(ebp4)
ld hl,(eb)
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 (ebp4),hl
pop hl
ld (eb),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,(ebp4)
ld hl,(eb)
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)
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),de
jr loop
! FIL
fil.z: pop hl
1:
ld (ebp4),hl
jr loop
fil.l: ld h,(ix)
inc ix
ld l,(ix)
inc ix
ld de,eb
add hl,de
jr 1b
! LNI
lni.z: ld hl,(eb)
inc hl
ld (eb),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
.data2 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
.data2 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
.assert [ filefcb] == 0
0: .space maxfiles*filesize
filearea = 0b+128
sibuf:
.data2 0
.space 82
siptr: .space 2
saveargs:
.space 128
argv: .space 40 ! not more than 20 args
argc: .space 2
ttymode:.data1 9,9,8,21;.data2 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
or a
sbc 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:
.data2 ux_indir
.data2 ux_exit
.data2 ux_fork
.data2 ux_read
.data2 ux_write
.data2 ux_open
.data2 ux_close
.data2 ux_wait
.data2 ux_creat
.data2 ux_link
.data2 ux_unlink
.data2 ux_exec
.data2 ux_chdir
.data2 ux_time
.data2 ux_mknod
.data2 ux_chmod
.data2 ux_chown
.data2 ux_break
.data2 ux_stat
.data2 ux_seek
.data2 ux_getpid
.data2 ux_mount
.data2 ux_umount
.data2 ux_setuid
.data2 ux_getuid
.data2 ux_stime
.data2 ux_ptrace
.data2 ux_alarm
.data2 ux_fstat
.data2 ux_pause
.data2 ux_utime
.data2 ux_stty
.data2 ux_gtty
.data2 ux_access
.data2 ux_nice
.data2 ux_ftime
.data2 ux_sync
.data2 ux_kill
.data2 unimpld
.data2 unimpld
.data2 unimpld
.data2 ux_dup
.data2 ux_pipe
.data2 ux_times
.data2 ux_prof
.data2 ux_unused
.data2 ux_setgid
.data2 ux_getgid
.data2 ux_sig
.data2 unimpld
.data2 unimpld
.data2 unimpld
.data2 unimpld
.data2 unimpld
.data2 ux_ioctl
.data2 unimpld
.data2 unimpld
.data2 unimpld
.data2 unimpld
.data2 ux_exece
.data2 ux_umask
.data2 ux_chroot
.data2 unimpld
.data2 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
.data2 aar.l, aar.z, adf.l, adf.z, adi.l, adi.z, ads.l, ads.z
.data2 adu.l, adu.z, and.l, and.z, asp.l, ass.l, ass.z, bge.l
.data2 bgt.l, ble.l, blm.l, bls.l, bls.z, blt.l, bne.l, cai.z
.data2 cal.l, cfi.z, cfu.z, ciu.z, cmf.l, cmf.z, cmi.l, cmi.z
.data2 cms.l, cms.z, cmu.l, cmu.z, com.l, com.z, csa.l, csa.z
.data2 csb.l, csb.z, cuf.z, cui.z, cuu.z, dee.l, del.p, del.n
.data2 dup.l, dus.l, dus.z, dvf.l, dvf.z, dvi.l, dvi.z, dvu.l
.data2 dvu.z, fef.l, fef.z, fif.l, fif.z, inl.p, inl.n, inn.l
.data2 inn.z, ior.l, ior.z, lar.l, lar.z, ldc.l, ldf.l, ldl.p
.data2 ldl.n, lfr.l, lil.p, lil.n, lim.z, los.l, los.z, lor.s0
.data2 lpi.l, lxa.l, lxl.l, mlf.l, mlf.z, mli.l, mli.z, mlu.l
.data2 mlu.z, mon.z, ngf.l, ngf.z, ngi.l, ngi.z, nop.z, rck.l
.data2 rck.z, ret.l, rmi.l, rmi.z, rmu.l, rmu.z, rol.l, rol.z
.data2 ror.l, ror.z, rtt.z, sar.l, sar.z, sbf.l, sbf.z, sbi.l
.data2 sbi.z, sbs.l, sbs.z, sbu.l, sbu.z, sde.l, sdf.l, sdl.p
.data2 sdl.n, set.l, set.z, sig.z, sil.p, sil.n, sim.z, sli.l
.data2 sli.z, slu.l, slu.z, sri.l, sri.z, sru.l, sru.z, sti.l
.data2 sts.l, sts.z, str.s0, tge.z, tle.z, trp.z, xor.l, xor.z
.data2 zer.l, zer.z, zge.l, zgt.l, zle.l, zlt.l, zne.l, zrf.l
.data2 zrf.z, zrl.p, dch.z, exg.s0, exg.l, exg.z, lpb.z
dispat2: ! base for 4 byte offsets
.data2 ldc.f
ignmask: .data2 0 ! ignore mask (variable)
retarea: .data2 0 ! base of buffer for result values (max 8 bytes)
.data2 0
.data2 0
.data2 0
trapproc:
.data2 0
nextp: .data1 0
header:
ntext: .data2 0
ndata: .data2 0
nproc: .data2 0
entry: .data2 0
nline: .data2 0
hp: .data2 0
pb: .data2 0
pd: .data2 0