Initial revision

mach/z80/int/Makefile

@@ -0,0 +1,4 @@
+CFLAGS=-O
+
+dl:	dl.o
+	cc -n -o dl dl.o

mach/z80/int/READ_ME

@@ -0,0 +1,23 @@
+The interpreter contained here is tested under CP/M on a RC702 Z80
+microcomputer. Make it by typing `doas'.
+E.out files to interpret must be made with a special Pascal library
+using whatever means available, because the UNIX and CP/M conventions
+about end of file and end of line differ.
+Then the following sequence can be used to transmit it to CP/M.
+cv <e.out >file.cv
+dl file.cv file.hex
+< Transmission to file.hex under CP/M using pip >
+LOAD FILE
+
+The resulting file.com can be used as an argument to the interpreter.
+This implementation has been tested but is not guaranteed to be complete.
+Simple UNIX-system calls have been implemented but anything except
+terminal I/O has not been thoroughly tested.
+Please send any errors in the implementation to
+Hans van Staveren
+Vrije Universiteit
+Wiskundig Seminarium
+De Boelelaan 1081
+1081 HV  Amsterdam
+Holland
+..!decvax!mcvax!vu44!sater

mach/z80/int/atof.s

@@ -0,0 +1,280 @@
+	.data
+! Set of variables
+
+big:	.byte 0
+	.byte 0
+	.byte 0x40
+	.byte 24	! 2^23
+negfrac:.space 1
+negexp:	.space 1
+begzero:
+nd:	.space 2
+fl:	.space 6
+	exp=fl+4
+eexp:	.space 2
+flexp:	.space 4
+exp5:	.space 4
+endzero:
+ten:	.byte 0
+	.byte 0
+	.byte 0x50
+	.byte 4		! 10
+dig:	.byte 0
+	.byte 0
+fildig:	.byte 0		! here a number from 0 to 31 will be converted flt.
+	.byte 7
+bexp:	.space 2
+
+	.text
+atof:			! entry with stringpointer in hl
+			! exit with pointer to float in hl
+	push ix
+	push iy
+	push bc
+	push de
+	push af
+	ld b,1
+1:
+	ld a,(hl)
+	inc hl
+	cp ' '
+	jr z,1b
+	cp '-'
+	jr nz,1f
+	ld b,-1
+	jr 2f
+1:	cp '+'
+	jr z,2f
+	dec hl
+2:	ld a,b
+	ld (negfrac),a
+	xor a
+	ld de,begzero
+	ld b,endzero-begzero
+1:	ld (de),a
+	inc de
+	djnz 1b
+1:	ld a,(hl)
+	inc hl
+	sub '0'
+	jr c,1f
+	cp 10
+	jr nc,1f
+	ld (fildig),a
+	call cmpbigfl
+	jr z,2f
+	call mulandadd
+	jr 3f
+2:	ld de,(exp)
+	inc de
+	ld (exp),de
+3:	ld de,(nd)
+	inc de
+	ld (nd),de
+	jr 1b
+1:	cp '.'-'0'
+	jr nz,4f
+1:	ld a,(hl)
+	inc hl
+	sub '0'
+	jr c,4f
+	cp 10
+	jr nc,4f
+	ld (fildig),a
+	call cmpbigfl
+	jr z,2f
+	call mulandadd
+	ld de,(exp)
+	dec de
+	ld (exp),de
+2:	ld de,(nd)
+	inc de
+	ld (nd),de
+	jr 1b
+4:
+	ld b,1
+	cp 'E'-'0'
+	jr z,1f
+	cp 'e'-'0'
+	jr nz,5f
+1:	ld a,(hl)
+	inc hl
+	cp '+'
+	jr z,1f
+	cp '-'
+	jr nz,2f
+	ld b,-1
+	jr 1f
+2:	dec hl
+1:	ld a,b
+	ld (negexp),a
+	exx
+	xor a
+	ld h,a
+	ld l,a
+	ld b,a
+	ld d,a
+	ld e,a
+	exx
+1:	ld a,(hl)
+	inc hl
+	sub '0'
+	jr c,1f
+	cp 10
+	jr nc,1f
+	exx
+	ld c,a
+	add hl,hl
+	add hl,hl
+	add hl,de
+	add hl,hl
+	add hl,bc
+	ld d,h
+	ld e,l
+	exx
+	jr 1b
+1:	exx
+	ld hl,negexp
+	or a
+	bit 7,(hl)
+	ld hl,(exp)
+	jr z,1f
+	sbc hl,de
+	jr 2f
+1:	add hl,de
+2:	ld (exp),hl
+	exx
+5:	ld a,1
+	ld de,(exp)
+	push de
+	bit 7,d
+	jr z,1f
+	neg
+	ld hl,0
+	or a
+	sbc hl,de
+	ex de,hl
+1:	ld (negexp),a
+	ld (exp),de
+	pop de
+	ld hl,(nd)
+	add hl,de
+	ld de,-33		! -LOGHUGE ?
+	xor a
+	sbc hl,de
+	jp p,1f
+	ld hl,fl
+	ld b,6
+2:	ld (hl),a
+	inc hl
+	djnz 2b
+1:	ld hl,0x0140	! 1.0
+	ld (flexp+2),hl
+	ld hl,0x0350	! 5.0
+	ld (exp5+2),hl
+	ld hl,(exp)
+	ld (bexp),hl
+1:	bit 0,l
+	jr z,2f
+	call xflt
+	.word flexp,exp5,fpmult,4,flexp
+2:	sra h
+	rr l
+	ld a,h
+	or l
+	jr z,3f
+	call xflt
+	.word exp5,exp5,fpmult,4,exp5
+	jr 1b
+3:	ld hl,negexp
+	ld a,(bexp)
+	bit 7,(hl)
+	jr z,1f
+	call xflt
+	.word flexp,fl,fpdiv,4,fl
+	neg
+	jr 2f
+1:	call xflt
+	.word flexp,fl,fpmult,4,fl
+2:	ld b,a
+	ld a,(fl+3)
+	add a,b
+	ld (fl+3),a
+	ld a,(negfrac)
+	bit 7,a
+	jr z,1f
+	call xflt
+	.word fl,fl,fpcomp,4,fl
+1:	call xflt
+	.word fl,fl,fpnorm,4,fl
+	ld hl,fl
+	pop af
+	pop de
+	pop bc
+	pop iy
+	pop ix
+	ret
+
+cmpbigfl:
+	call xflt
+	.word big,fl,fpcmf,0
+	ld a,(fpac+1)
+	bit 7,a
+	ret
+mulandadd:
+	call xflt
+	.word fl,ten,fpmult,4,fl
+	ld a,7
+	ld (fildig+1),a
+	call xflt
+	.word dig,dig,fpnorm,4,dig
+	call xflt
+	.word fl,dig,fpadd,4,fl
+	ret
+
+xflt:
+	ex (sp),iy
+	push af
+	push bc
+	push de
+	push hl
+	ld h,(iy+1)
+	ld l,(iy+0)
+	ld de,fpac
+	ld bc,4
+	ldir
+	ld h,(iy+3)
+	ld l,(iy+2)
+	ld de,fpop
+	ld bc,4
+	ldir
+	push iy
+	ld hl,1f
+	push hl
+	ld h,(iy+5)
+	ld l,(iy+4)
+	jp (hl)
+1:	pop iy
+	ld b,(iy+7)
+	ld c,(iy+6)
+	ld a,b
+	or c
+	jr z,1f
+	inc iy
+	inc iy
+	ld hl,fpac
+	ld d,(iy+7)
+	ld e,(iy+6)
+	ldir
+1:	push iy
+	pop hl
+	ld de,8
+	add hl,de
+	push hl
+	pop iy
+	pop hl
+	pop de
+	pop bc
+	pop af
+	ex (sp),iy
+	ret

mach/z80/int/cv.c

@@ -0,0 +1,34 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include <stdio.h>
+
+unsigned memaddr = 0x100;
+
+main() {
+	char buf[256];
+	register i,len;
+
+	while((len=read(0,buf,sizeof(buf))) > 0) {
+		putw(memaddr,stdout);
+		putw(0,stdout);
+		putw(len,stdout);
+		memaddr += len;
+		for(i=0;i<len;i++)
+			putc(buf[i],stdout);
+	}
+}

mach/z80/int/dl.c

@@ -0,0 +1,200 @@
+/*
+ * (c) copyright 1983 by the Vrije Universiteit, Amsterdam, The Netherlands.
+ *
+ *          This product is part of the Amsterdam Compiler Kit.
+ *
+ * Permission to use, sell, duplicate or disclose this software must be
+ * obtained in writing. Requests for such permissions may be sent to
+ *
+ *      Dr. Andrew S. Tanenbaum
+ *      Wiskundig Seminarium
+ *      Vrije Universiteit
+ *      Postbox 7161
+ *      1007 MC Amsterdam
+ *      The Netherlands
+ *
+ */
+
+#include	<sgtty.h>
+#include	<stdio.h>
+#include	<assert.h>
+
+struct sgttyb	tty;
+
+#define	DATTYPE		0
+#define	EOFTYPE		1
+#define	SEGTYPE		2
+#define	PCTYPE		3
+
+#define	MAXBYTE		32
+
+int	check;
+int	echo;
+int	istty;
+int	bytecount;
+int	ttyfd;
+
+char	*progname;
+
+char	hex[] = "0123456789ABCDEF";
+
+main(argc,argv) char **argv; {
+	register nd,pc,sg,osg,first;
+	register char *s;
+	int uid;
+
+	progname = argv[0];
+	if (argc > 3)
+		fatal("usage: %s [object [tty]]\n",argv[0]);
+	s = "a.out";
+	if (argc >= 2)
+		s = argv[1];
+	if (freopen(s,"r",stdin) == NULL)
+		fatal("can't open %s",s);
+	s = "/dev/tty05";
+	if (argc >= 3)
+		s = argv[2];
+	if ((ttyfd = open(s,2)) < 0)
+		if ((ttyfd = creat(s,0666)) < 0)
+			fatal("can't open %s",s);
+	if (gtty(ttyfd,&tty) == 0) {
+		echo++;
+		istty++;
+		tty.sg_ispeed = tty.sg_ospeed = B2400;
+		tty.sg_flags = RAW;
+		stty(ttyfd,&tty);
+	} else {
+		freopen(s,"w",stdout);
+	}
+	first = 1; osg = 0;
+	uid = getuid();
+	lock(1);
+	for (;;) {
+		pc = get2c(stdin);
+		if (feof(stdin))
+			break;
+		sg = get2c(stdin);
+		nd = get2c(stdin);
+		if (first) {
+			put('L'); reply();
+			put('S'); reply();
+			first = 0;
+		}
+		if (sg != osg) {
+			segment(sg);
+			osg = sg;
+		}
+		while (nd > MAXBYTE) {
+			data(MAXBYTE,pc);
+			nd -= MAXBYTE;
+			pc += MAXBYTE;
+		}
+		if (nd > 0)
+			data(nd,pc);
+		assert(feof(stdin) == 0);
+	}
+	if (first == 0)
+		eof();
+/* 	lock(0); */
+/* 	setuid(uid); */
+/* 	if (echo) */
+/* 		for (;;) */
+/* 			reply(); */
+}
+
+segment(sg) {
+
+	newline(2,0,SEGTYPE);
+	word(sg);
+	endline();
+}
+
+startad(pc) {
+
+	newline(4,0,PCTYPE);
+	word(0);
+	word(pc);
+	endline();
+}
+
+data(nd,pc) {
+
+	newline(nd,pc,DATTYPE);
+	do
+		byte(getc(stdin));
+	while (--nd);
+	endline();
+}
+
+eof() {
+
+	newline(0,0,EOFTYPE);
+	byte(0xFF);
+	put('\n');
+}
+
+newline(n,pc,typ) {
+
+	check = 0;
+	bytecount = n+5;
+	put('\n');	/* added instruction */
+	put(':');
+	byte(n);
+	word(pc);
+	byte(typ);
+}
+
+endline() {
+
+	byte(-check);
+	assert(bytecount == 0);
+	assert(check == 0);
+}
+
+word(w) {
+
+	byte(w>>8);
+	byte(w);
+}
+
+byte(b) {
+
+	check += b;
+	--bytecount;
+	put(hex[(b>>4) & 017]);
+	put(hex[b & 017]);
+}
+
+put(c) {
+
+	if (istty)
+		write(ttyfd,&c,1);
+	else
+		putchar(c);
+}
+
+reply() {
+	register i;
+	int c;
+
+	if (echo == 0)
+		return;
+	i = read(ttyfd,&c,1);
+	assert(i > 0);
+	write(1,&c,1);
+}
+
+get2c(f) FILE *f; {
+	register c;
+
+	c = getc(f);
+	return((getc(f) << 8) | c);
+}
+
+fatal(s,a) {
+
+	fprintf(stderr,"%s: ",progname);
+	fprintf(stderr,s,a);
+	fprintf(stderr,"\n");
+	exit(-1);
+}

mach/z80/int/doas

@@ -0,0 +1,3 @@
+/usr/em/mach/z80/as/as -d em.s atof.s fpp.s mli4.s dvu4.s dvi4.s eb.s >em.list
+dl a.out int.hex
+dosort int.hex

mach/z80/int/dosort

@@ -0,0 +1,9 @@
+case $# in
+1) ;;
+*) echo "usage $0 file";exit ;;
+esac
+head -1 $1>$$.head
+tail -1 $1>$$.tail
+tail +2 $1|sort +0.3|tail +2>$$.middle
+cat $$.head $$.middle $$.tail >$1
+rm $$.head $$.middle $$.tail

mach/z80/int/dvi4.s

@@ -0,0 +1,74 @@
+.dvi4:
+	pop hl
+	ld (retaddr),hl
+	xor a
+	ld (.flag1),a
+	ld (.flag2),a
+	ld ix,0
+	add ix,sp
+	ld b,(ix+7)		! dividend
+	bit 7,b
+	jr z,1f
+	ld c,(ix+6)
+	ld d,(ix+5)
+	ld e,(ix+4)
+	call .negbd
+	ld (ix+7),b
+	ld (ix+6),c
+	ld (ix+5),d
+	ld (ix+4),e
+	ld a,1
+	ld (.flag1),a
+1:
+	ld b,(ix+3)
+	bit 7,b
+	jr z,2f
+	call .negst
+	ld a,1
+	ld (.flag2),a
+2:
+	call .dvu4
+	ld a,(.flag1)
+	or a
+	jr z,3f
+	call .negbd
+3:
+	ld (.savebc),bc
+	ld (.savede),de
+	ld a,(.flag2)
+	ld b,a
+	ld a,(.flag1)
+	xor b
+	jr z,4f
+	call .negst
+4:
+	ld bc,(.savebc)
+	ld de,(.savede)
+	ld hl,(retaddr)
+	jp (hl)
+.negbd:
+	xor a
+	ld h,a
+	ld l,a
+	sbc hl,de
+	ex de,hl
+	ld h,a
+	ld l,a
+	sbc hl,bc
+	ld b,h
+	ld c,l
+	ret
+.negst:
+	pop iy
+	pop de
+	pop bc
+	call .negbd
+	push bc
+	push de
+	jp (iy)
+.data
+	.flag1: .byte 0
+	.flag2: .byte 0
+	retaddr:.word 0
+	.savebc: .word 0
+	.savede: .word 0

mach/z80/int/dvu4.s

@@ -0,0 +1,137 @@
+.define .dvu4
+
+! 4-byte divide routine for z80
+! parameters:
+!    stack: divisor
+!	    dividend
+!    stack: quotient (out)
+!    bc de: remainder (out)  (high part in bc)
+
+
+
+! a n-byte divide may be implemented
+! using 2 (virtual) registers:
+!  - a n-byte register containing
+!    the divisor
+!  - a 2n-byte shiftregister (VSR)
+!
+! Initially, the VSR contains the dividend
+! in its low (right) n bytes and zeroes in its
+! high n bytes. The dividend is shifted
+! left into a "window" bit by bit. After
+! each shift, the contents of the window
+! is compared with the divisor. If it is
+! higher or equal, the divisor is subtracted from
+! it and a "1" bit is inserted in the
+! VSR from the right side; else a "0" bit
+! is inserted. These bits are shifted left
+! too during subsequent iterations.
+! At the end, the rightmost part of VSR
+! contains the quotient.
+! For n=4, we need 2*4+4 = 12 bytes of
+! registers. Unfortunately we only have
+! 5 2-byte registers on the z80
+! (bc,de,hl,ix and iy). Therefore we use
+! an overlay technique for the rightmost
+! 4 bytes of the VSR. The 32 iterations
+! are split up into two groups: during
+! the first 16 iterations we use the high
+! order 16 bits of the dividend; during
+! the last 16 iterations we use the
+! low order 16 bits.
+! register allocation:
+!   VSR        iy hl ix
+!   divisor   -de bc
+.dvu4:
+	! initialization
+	pop hl		! save return address
+	ld (.retaddr),hl
+	pop bc		! low part (2 bytes)
+			! of divisor in bc
+	xor a		! clear carry, a := 0
+	ld h,a		! hl := 0
+	ld l,a
+	ld (.flag),a	! first pass main loop
+	pop de		! high part divisor
+	sbc hl,de	! inverse of high part
+	ex de,hl	! of divisor in de
+	pop hl		! save low part of
+			! dividend in memory
+	ld (.low),hl	! used during second
+			! iteration over main loop
+	pop ix		! high part of dividend
+	push iy		! save LB
+	ld h,a		! hl := 0
+	ld l,a
+	ld iy,0		! now the VSR is initialized
+
+	! main loop, done twice
+1:
+	ld a,16
+	! sub-loop, done 16 times
+2:
+	add iy,iy	! shift VSR left
+	add ix,ix
+	adc hl,hl
+	jp nc,3f
+	inc iy
+3:
+	or a		! subtract divisor from
+			! window (iy hl)
+	ld (.iysave),iy
+	sbc hl,bc
+	jr nc,4f	! decrement iy if there
+			! was no borrow
+	dec iy
+4:
+	add iy,de	! there is no "sbc iy,ss"
+			! on the z80, so de was
+			! inverted during init.
+	inc ix
+	! see if the result is non-negative,
+	! otherwise undo the subtract.
+	! note that this uncooperating machine
+	! does not set its S -or Z flag after
+	! a 16-bit add.
+	ex (sp),iy	! does anyone see a better
+	ex (sp),hl	! solution ???
+	bit 7,h
+	ex (sp),hl
+	ex (sp),iy
+	jp z,5f
+	! undo the subtract
+	add hl,bc
+	ld iy,(.iysave)
+	dec ix
+5:
+	dec a
+	jr nz,2b
+	ld a,(.flag)	! see if this was first or
+			! second iteration of main loop
+	or a		! 0=first, 1=second
+	jr nz,6f
+	inc a		! a := 1
+	ld (.flag),a	! flag := 1
+	ld (.result),ix ! save high part of result
+	ld ix,(.low)	! initialize second
+			! iteration, ix := low
+			! part of dividend
+	jr 1b
+6:
+	! clean up
+	push iy		! transfer remainder
+	pop bc		! from iy-hl to bc-de
+	ex de,hl
+	pop iy		! restore LB
+	ld hl,(.result) ! high part of result
+	push hl
+	push ix		! low part of result
+	ld hl,(.retaddr)
+	jp (hl)		! return
+
+.data
+.flag:		.byte 0
+.low:		.word 0
+.iysave:	.word 0
+.retaddr:	.word 0
+.result:	.word 0

mach/z80/int/eb.s

@@ -0,0 +1,2 @@
+	.bss
+eb:

mach/z80/int/fpp.s

@@ -0,0 +1,474 @@
+! floating point pakket voor Z80
+! geimplementeerd zoals beschreven in 
+! Electronica top internationaal.
+! September 1979
+! Auteur: Hr. R. Beverdam, Zuidbroekweg 9,7642 NW  Wierden
+
+xa:	.space 1
+fpac:
+fal:	.space 1
+fan:	.space 1
+fam:	.space 1
+fax:	.space 1
+xo:	.space 1
+fpop:
+fol:	.space 1
+fon:	.space 1
+fom:	.space 1
+fox:	.space 1
+	.errnz xa/256-fox/256
+
+fpsub:
+	call fpcomp		! inverteer fpacc
+fpadd:
+	ld de,(fam)		! d fax,e fam
+	ld bc,(fom)		! b fox,c fom
+	ld a,e			! test fpacc
+	or a			! 0?
+	jr z,movop		! ja: som=fpop dus verplaats
+	xor a
+	add a,c
+	ret z			! som is dus fpacc, klaar
+	ld a,b
+	sub d			! a:=fox-fax
+	ld l,a			! bewaar verschil exponenten
+	jp p,skpneg		! maak positief
+	neg
+skpneg:
+	cp 0x18			! verschil meer dan 23?
+	ld a,l
+	jp m,lineup		! spring indien binnen bereik
+	and a			! getallen te groot tov elkaar
+	ret m			! klaar als fpacc het grootst
+movop:
+	ld hl,fol		! verplaats fpop naar fpacc
+	ld de,fal		! want fpop is het antwoord
+	ld bc,4
+	ldir
+	ret
+lineup:
+	and a			! kijk welke groter is
+	jp m,shifto		! spring als fpop>fpac
+	inc a			! bereken sa
+	ld b,a			! save sa in b register
+	ld a,1			! so 1
+	push af			! bewaar so op stapel
+	jr shacop		! gr schuiven
+shifto:
+	neg			! bereken fox-fax
+eqexp:
+	inc a			! so 1+(fox-fax)
+	push af			! bewaar so op stapel
+	ld b,1			! sa 1
+shacop:
+	ld hl,(fal)		! l fal,h fan
+	xor a			! xa 0
+moracc:
+	sra e			! schuif fam
+	rr h			! fan
+	rr l			! fal
+	rra			! xa
+	inc d			! update voor fax
+	djnz moracc		! herhaal sa keer
+	ld (xa),a		! berg alles
+	ld (fal),hl		! weg in
+	ld (fam),de		! fpacc en xa
+	pop af			! haal so terug van stapel
+	ld b,a			! en zet in b register
+	xor a			! xo 0
+	ld hl,(fol)		! l fol,h fon
+morop:
+	sra c			! schuif: fom
+	rr h			!         fon
+	rr l			!         
+	rra			!         xo
+	djnz morop		! herhaal so keer
+	ld (xo),a
+	ld (fol),hl
+	ld (fom),bc		! berg alles weg in fpop en xo
+	ld de,xa
+	ld hl,xo
+	ld b,4
+	or a			! reset carry
+addmor:
+	ld a,(de)		! haal een byte
+	adc a,(hl)		! tel er een bij op
+	ld (de),a		! en berg de som weer op
+	inc e
+	inc l
+	djnz addmor		! herhaal dit 4 keer
+	jr fpnorm
+
+fpmult:
+	call setsgn
+	add a,(hl)		! bereken exponent produkt
+	ld (hl),a		! fax exponent produkt
+	ld l,fom%256
+	ex de,hl		! gebruik de als wijzer
+	xor a
+	ld h,a
+	ld l,a			! hoogste 16 bits van pp worden nul
+	exx
+	ld bc,(fal)
+	ld de,(fam)		! haal mc in registers
+	ld d,a			! d:=0 tbv 16-bit add
+	ld h,a
+	ld l,a			! middelste 16 bits van pp worden nul
+	ld ix,0			! laagste 16 bits ook
+	exx
+	ld c,3
+mult:
+	ld a,(de)		! haal een byte van mr
+	dec e
+	ld b,8			! bits in a byte
+shift:
+	rla			! schuif vooste bit in carry
+	exx
+	jr nc,noadd		! vooste bit is 0, dan niet optellen
+	add ix,bc		! pp:=pp+mc
+	adc hl,de		! continued
+noadd:
+	add ix,ix
+	adc hl,hl
+	exx
+	adc hl,hl		! dit schoof het hele partiele produkt <
+	djnz shift		! herhaal voor alle 8 bits
+	dec c
+	jr nz,mult		! herhaal voor 3 bytes
+	exx
+	rl l
+	rla
+	add a,h
+	ld (fal),a
+	ld a,d
+	exx
+	adc a,l
+	ld (fan),a		! rond getal in pp af en berg resultaat op
+	ld a,c
+	adc a,h
+	ld (fam),a
+	call fpnorm
+exmldv:
+	ld hl,xa
+	ld c,(hl)
+	jp resign		! fix sign
+
+fpdiv:
+	call setsgn
+	sub (hl)
+	ld (hl),a		! berg exponent quotient op
+	ld hl,(fol)
+	push hl
+	pop ix
+	ld de,(fal)
+	ld a,(fam)
+	or a			! fpacc = 0 ?
+	jr z,fperr		! fout, deling door nul
+	ld b,a			! b:=fam
+	ld a,(fom)
+	ld c,a
+	exx
+	ld hl,fam
+	ld e,3
+divide:
+	ld b,8
+mordiv:
+	exx
+	and a
+	sbc hl,de
+	sbc a,b			! probeer de aftrekking
+	jp m,nogo		! gaat niet
+	push hl
+	pop ix
+	ld c,a
+	ex af,af2		! quotient in tweede accumulator
+	scf
+	jr quorot
+nogo:
+	ex af,af2
+	or a
+quorot:
+	rla			! volgende bit in quotient
+	ex af,af2
+	add ix,ix		! schuif eventueel vernieuwde
+	rl c			! dd naar links
+	push ix
+	pop hl
+	ld a,c			! zet nieuwe dd in rekenregisters
+	exx
+	djnz mordiv		! herhaal 8 keer
+	ex af,af2
+	ld (hl),a		! zet een byte van het quotient in het geheugen
+	dec l
+	ex af,af2
+	dec e
+	jr nz,divide		! herhaal 3 keer
+	ld bc,(fal)
+	ld hl,(fam)		! haal quotient terug in cpu
+	bit 7,l
+	jp z,exmldv		! als niet te groot tekenherstellen
+	ld a,1			! wel te groot
+	add a,c			! eerst getal afronden
+	ld c,a
+	ld a,e
+	adc a,b
+	ld b,a
+	ld a,e
+	adc a,l
+	ld l,a
+shft:
+	inc h			! nu getal naar rechts schuiven
+	rr l
+	rr b
+	rr c
+	or a
+	bit 7,l
+	jr nz,shft		! door afronding weer te groot
+	ld (fal),bc
+	ld (fam),hl
+	jr exmldv		! inspecteer teken
+setsgn:
+	ld a,(fom)		! ******** setsgn ************
+	ld c,1			! teken -1
+	rlca			! fpop 0 ?
+	jr nc,tstacc		! nee
+	rrc c			! ja, dus teken:=teken*(-1)
+	ld hl,fol		! en inverteer fpop
+	call complm
+tstacc:
+	ld a,(fam)
+	rlca			! fpacc 0?
+	jr nc,init		! nee
+	rrc c			! ja dus teken:=teken*(-1)
+	call fpcomp
+init:
+	ld hl,xa		! initialiseer nog een paar registers
+	ld (hl),c
+	ld a,(fox)
+	ld l,fax%256
+	ret
+
+fpcif:
+	ld de,(fpac)		! integer to convert
+	xor a
+	sra d
+	rr e
+	rr a
+	ld (fan),de
+	ld (fal),a
+	ld a,16
+	ld (fax),a
+	jr fpnorm
+
+fpcfi:
+	ld a,(fax)
+	dec a
+	jp m,fpzero		! really integer zero here
+	sub 15
+	jp p,fperr		! overflow
+	ld de,(fan)
+	inc a
+	neg
+	jr z,2f
+	ld b,a
+	ld a,(fal)
+1:
+	sra d
+	rr e
+	rr a
+	djnz 1b
+2:
+	bit 7,d
+	jr z,0f
+	inc de
+0:
+	ld (fpac),de
+	ret
+
+fpcdf:
+	ld de,(fpac)
+	ld bc,(fpac+2)
+	ld h,31
+3:
+	ld a,b
+	and 0300
+	jr z,1f
+	cp 0300
+	jr z,1f
+	or a
+	jp p,2f
+	sra b
+	rr c
+	rr d
+	inc h
+2:
+	ld a,h
+	ld (fax),a
+	ld (fan),bc
+	ld a,d
+	ld (fal),a
+	ret
+1:
+	sla e
+	rl d
+	rl c
+	rl b
+	dec h
+	jr 3b
+
+fpcfd:
+	ld a,(fax)
+	dec a
+	jp m,fpzero
+	cp 32
+	jp p,fperr
+	sub 31
+	cpl
+	ld bc,(fan)
+	ld de,(fal)
+	ld d,e
+	ld e,0
+1:
+	dec a
+	jp m,2f
+	sra b
+	rr c
+	rr d
+	rr e
+	jr 1b
+2:
+	bit 7,b
+	jr z,3f
+	sla e
+	rl d
+	rl c
+	rl b
+3:
+	ld (fpac+2),bc
+	ld (fpac),de
+	ret
+fpfef:
+	ld a,(fox)
+	ld (fpac),a
+9:
+	bit 7,a
+	jr z,1f
+	ld a,0xFF
+	jr 2f
+1:
+	xor a
+2:
+	ld (fpac+1),a
+	xor a
+	ld (fox),a
+	ret
+fpcmf:
+	call fpsub
+	ld a,(fam)
+	ld (fpac),a
+	jr 9b
+fpfif:
+	call fpmult
+	ld a,(fax)
+	dec a
+	jp m,intzero
+	inc a
+	ld b,a
+	xor a
+	ld c,0200
+	ld d,a
+	ld e,a
+1:
+	sra c
+	rr d
+	rr e
+	djnz 1b
+	ld hl,fam
+	ld b,(hl)
+	ld a,c
+	and b
+	ld (fom),a
+	ld a,c
+	xor 0177
+	and b
+	ld (hl),a
+	dec l
+	ld b,(hl)
+	ld a,d
+	and b
+	ld (fon),a
+	ld a,d
+	cpl
+	and b
+	ld (hl),a
+	dec l
+	ld b,(hl)
+	ld a,e
+	and b
+	ld (fol),a
+	ld a,e
+	cpl
+	and b
+	ld (hl),a
+	ld a,(fax)
+	ld (fox),a
+	jr fpnorm
+intzero:
+	xor a
+	ld hl,fol
+	ld b,4
+1:	ld (hl),a
+	inc hl
+	djnz 1b
+	ret
+
+fpzero:
+	xor a
+	ld h,a
+	ld l,a
+	ld (fal),hl
+	ld (fam),hl
+	ret
+
+fpnorm:
+	ld a,(fam)
+	ld c,a
+	or a			! fpacc < 0 ?
+	call m,fpcomp		! ja -- inverteer
+	ld hl,(fal)
+	ld de,(fam)
+	ld a,l
+	or h
+	or e
+	jr z,fpzero		! als hele facc 0 is
+	ld a,e
+mortst:
+	bit 6,a			! test meest significante bit
+	jr nz,catch		! stop als bit is 1
+	add hl,hl		! schuif links zolang bit = 0
+	adc a,a
+	dec d			! pas fax ook aan
+	jr mortst
+catch:
+	ld e,a			! herstel nu fpacc in geheugen
+	ld (fal),hl
+	ld (fam),de
+resign:
+	bit 7,c			! test op teken
+	ret z			! positief, geen actie
+fpcomp:
+	ld hl,fal
+complm:
+	ld b,3			! inverteer alleen mantisse
+	xor a
+morcom:
+	sbc a,(hl)
+	ld (hl),a
+	inc hl
+	ld a,0
+	djnz morcom
+	or a
+	ret
+fperr:
+	scf
+	ret

mach/z80/int/mli4.s

@@ -0,0 +1,75 @@
+.define .mli4
+
+! 32-bit multiply routine for z80
+! parameters:
+!   on stack
+
+
+
+! register utilization:
+!   ix: least significant 2 bytes of result
+!   hl: most  significant 2 bytes of result
+!   bc: least significant 2 bytes of multiplicand
+!   de: most  significant 2 bytes of multiplicand
+!   iy: 2 bytes of multiplier (first most significant,
+!	later least significant)
+!   a:  bit count
+.mli4:
+	!initialization
+	pop hl		! return address
+	pop de
+	ld (.mplier+2),de! least significant bytes of
+			! multiplier
+	pop de
+	ld (.mplier),de	! most sign. bytes
+	pop de		! least significant bytes of
+			! multiplicand
+	pop bc		! most sign. bytes
+	push hl		! return address
+	push iy		! LB
+	ld ix,0
+	xor a
+	ld h,a		! clear result
+	ld l,a
+	ld (.flag),a	! indicate that this is
+			! first pass of main loop
+	ld iy,(.mplier)
+	! main loop, done twice, once for each part (2 bytes)
+	! of multiplier
+1:
+	ld a,16
+	! sub-loop, done 16 times
+2:
+	add iy,iy	! shift left multiplier
+	jr nc,3f	! skip if most sign. bit is 0
+	add ix,de	! 32-bit add
+	adc hl,bc
+3:
+	dec a
+	jr z,4f		! done with this part of multiplier
+	add ix,ix	! 32-bit shift left
+	adc hl,hl
+	jr 2b
+4:
+	! see if we have just processed the first part
+	! of the multiplier (flag = 0) or the second
+	! part (flag = 1)
+	ld a,(.flag)
+	or a
+	jr nz,5f
+	inc a		! a := 1
+	ld (.flag),a	! set flag
+	ld iy,(.mplier+2)! least significant 2 bytes now in iy
+	add ix,ix	! 32-bit shift left
+	adc hl,hl
+	jr 1b
+5:
+	! clean up
+	pop iy		! restore LB
+	ex (sp),hl	! put most sign. 2 bytes of result
+			! on stack;  put return address in hl
+	push ix		! least sign. 2 bytes of result
+	jp (hl)		! return
+.data
+.flag:  .byte 0
+.mplier: .space 4