*** empty log message ***

mach/z8000/libem/aar.s

@@ -0,0 +1,13 @@
+.define aar
+
+!R1 contains description address
+!R3 contains element number
+!base address is on stack
+aar:
+	sub	R3, 0(R1)
+	mult	RR2, 4(R1)
+	inc	R15, $4
+	add	R3, *RR14
+	ld	*RR14, R3
+	dec	R15, $4
+	ret

mach/z8000/libem/blm.s

@@ -0,0 +1,26 @@
+.define blm
+
+!size in R0
+blm:
+	popl	saveret, *RR14
+	ldm	savereg, R4, $10
+	ldk	R2, $0
+	ld	R4, R2
+	pop	R3, *RR14		!RR2: dst address
+	pop	R5, *RR14		!RR4: src address
+	ld	R1, R0
+	sra	R0
+	jr	EQ, 2f
+	    !now avoid wrong copy in case the pieces overlap
+	cp	R5, R3
+	jr	EQ, 2f
+	jr	LT, 1f
+	ldir	*RR2, *RR4, R0
+	jr	2f
+1:	dec	R1, $2
+	add	R3, R1
+	add	R5, R1
+	lddr	*RR2, *RR4, R0
+2:	ldm	R4, savereg, $10
+	pushl	*RR14, saveret
+	ret

mach/z8000/libem/cii.s

@@ -0,0 +1,24 @@
+.define cii
+
+cii:
+	popl	saveret, *RR14
+	pop	R2, *RR14
+	pop	R1, *RR14
+	sub	R2, R1		!expansion in bytes
+	jr	LE, 1f
+	sra	R2		!expansion in words > 0
+	jr	NC, 2f
+	pop	R1, *RR14	!expand	1 --> 2
+	extsb	R1
+	push	*RR14, R1
+	test	R2
+	jr	EQ, 4f
+2:				!expand	>= 1 word
+	ld	R1, *RR14
+	exts	RR0
+3:	push	*RR14, R0
+	djnz	R2, 3b
+	jr	4f
+1:	sub	R15, R2
+4:	pushl	*RR14, saveret
+	ret

mach/z8000/libem/cmi.s

@@ -0,0 +1,14 @@
+.define cmi
+
+!size in R0
+cmi:
+	cp	R0, $2
+	jr	NE, 1f
+	popl	RR2, *RR14
+	pop	R1, *RR14
+	pop	R0, *RR14
+	sub	R0, R1
+	jp	*RR2
+1:	cp	R0, $4
+	jr	EQ, cmi4
+	jr	unknown

mach/z8000/libem/cmi4.s

@@ -0,0 +1,15 @@
+.define cmi4
+
+cmi4:
+	popl	saveret, *RR14
+	popl	RR0, *RR14
+	popl	RR2, *RR14
+	subl	RR2, RR0
+	ldk	R0, $0
+	ldl	RR2, saveret
+	jr	LT, 1f
+	jp	EQ, *RR2
+	inc	R0
+	jp	*RR2
+1:	dec	R0
+	jp	*RR2

mach/z8000/libem/cms.s

@@ -0,0 +1,19 @@
+.define cms
+
+cms:
+	popl	saveret, *RR14
+	ldm	savereg, R4, $10
+	ldl	RR2, RR14
+	add	R3, R0
+	ldl	RR4, RR2
+	add	R5, R0
+	sra	R0
+2:	pop	R1, *RR14
+	cp	R1, *RR2
+	jr	NE, 1f
+	inc	R3, $2
+	djnz	R0, 2b
+1:	ld	R15, R5
+	ldm	R4, savereg, $10
+	pushl	*RR14, saveret
+	ret

mach/z8000/libem/cmu.s

@@ -0,0 +1,20 @@
+.define cmu
+
+!size in R0
+cmu:
+	cp	R0, $2
+	jr	NE, 1f
+	popl	RR2, *RR14
+	pop	R1, *RR14
+	pop	R0, *RR14
+	cp	R0, R1
+	ldk	R0, $0
+	jr	ULT, 2f
+	jp	EQ, *RR2
+	inc	R0
+	jp	*RR2
+2:	dec	R0
+	jp	*RR2
+1:	cp	R0, $4
+	jr	EQ, cmu4
+	jr	unknown

mach/z8000/libem/cmu4.s

@@ -0,0 +1,15 @@
+.define cmu4
+
+cmu4:
+	popl	saveret, *RR14
+	popl	RR0, *RR14
+	popl	RR2, *RR14
+	cpl	RR2, RR0
+	ldk	R0, $0
+	ldl	RR2, saveret
+	jr	ULT, 1f
+	jp	EQ, *RR2
+	inc	R0
+	jp	*RR2
+1:	dec	R0
+	jp	*RR2

mach/z8000/libem/csa.s

@@ -0,0 +1,19 @@
+.define csa
+
+!R1 contains address of jump table
+!R2 contains case index
+csa:
+	sub	R2, 2(R1)
+	jr	LT, 1f
+	cp	R2, 4(R1)
+	jr	UGT, 1f
+	sla	R2
+	add	R1, R2
+	ld	R2, 06(R1)
+	cp	R2, $0
+	jr	EQ, 2f
+	jp	0(R2)
+1:	ld	R1, 0(R1)
+	jp	NE, 0(R1)
+2:	push	*RR14, $ECASE
+	jr	fatal

mach/z8000/libem/csb.s

@@ -0,0 +1,21 @@
+.define csb
+
+!R1 contains address of jump table
+!R2 contains case index
+csb:
+	ld	R3, 0(R1)	!default pointer
+	ld	R0, 2(R1)	!number of entries
+	test	R0
+	jr	EQ, 1f
+3:	inc	R1, $4
+	cp	R2, 0(R1)
+	jr	EQ, 2f
+	djnz	R0, 3b
+1:	ld	R1, R3		!default pointer
+	jr	4f
+2:	ld	R1, 2(R1)
+4:	test	R1
+	jr	EQ, 5f
+	jp	0(R1)
+5:	push	*RR14, $ECASE
+	jr	fatal

mach/z8000/libem/cuu.s

@@ -0,0 +1,15 @@
+.define cuu
+
+cuu:
+	popl	RR2, *RR14
+	pop	R0, *RR14
+	pop	R1, *RR14
+	sub	R0, R1		!expansion in bytes
+	jr	LE, 1f
+	sra	R0		!expansion in words
+	jp	EQ, *RR2
+2:	push	*RR14, $0
+	djnz	R0, 2b
+	jp	*RR2
+1:	sub	R15, R0
+	jp	*RR2

mach/z8000/libem/dup.s

@@ -0,0 +1,12 @@
+.define dup
+
+dup:
+	popl	saveret, *RR14
+	dec	R15, $2
+	ldl	RR2, RR14
+	add	R3, R0
+	sra	R0
+	lddr	*RR14, *RR2, R0
+	inc	R15, $2
+	pushl	*RR14, saveret
+	ret

mach/z8000/libem/dvu2.s

@@ -0,0 +1,17 @@
+.define dvu2
+
+dvu2:
+	popl	saveret, *RR14
+	pop	R2, *RR14
+	pop	R1, *RR14
+	test	R2
+	jr	MI, 1f
+	ldk	R0, $0
+	div	RR0, R2
+2:	pushl	*RR14, saveret
+	ret
+1:	cp	R2, R1
+	ldk	R1, $0
+	jr	UGT, 2b
+	inc	R1
+	jr	2b

mach/z8000/libem/dvu4.s

@@ -0,0 +1,19 @@
+.define dvu4
+
+dvu4:
+	popl	saveret, *RR14
+	ldm	savereg, R4, $10
+	popl	RR4, *RR14
+	popl	RR2, *RR14
+	testl	RR4
+	jr	MI, 1f
+	ldl	RR0, $0
+	divl	RQ0, RR4
+	jr	2f
+1:	cpl	RR4, RR2
+	ldl	RR2, $0
+	jr	UGT, 2f
+	inc	R3
+2:	ldm	R4, savereg, $10
+	pushl	*RR14, saveret
+	ret

mach/z8000/libem/end.s

@@ -0,0 +1,11 @@
+.define	endtext, enddata, endbss, _etext, _edata, _end
+
+	.text
+endtext:
+_etext:
+	.data
+enddata:
+_edata:
+	.bss
+endbss:
+_end:

mach/z8000/libem/exg.s

@@ -0,0 +1,18 @@
+.define exg
+
+!size (bytes) in R0
+exg:
+	ldm	savereg, R4, $10
+	ldl	RR2, RR14
+	inc	R3, $2
+	ldl	RR4, RR2
+	add	R5, R0
+	sra	R0
+1:	ld	R1, *RR2
+	ex	R1, *RR4
+	ld	*RR4, R1
+	inc	R3, $2
+	inc	R5, $2
+	djnz	R0, 1b
+	ldm	R4, savereg, $10
+	ret

mach/z8000/libem/gto.s

@@ -0,0 +1,8 @@
+.define gto
+
+gto:
+	pop	R3, *RR14
+	ld	R13, 4(R3)
+	ld	R15, 2(R3)
+	ld	R3, 0(R3)
+	jp	0(R3)

mach/z8000/libem/head_em.s

@@ -0,0 +1,57 @@
+.define  EXIT, F_DUM
+.define  ERANGE, ESET, EHEAP, EILLINS, EODDZ, ECASE, EBADMON
+.define  hol0, trppc, trpim, reghp, argv, envp
+
+EXIT	= 0
+F_DUM	= 0
+
+ERANGE  = 1
+ESET    = 2
+EHEAP   = 17
+EILLINS	= 18
+EODDZ	= 19
+ECASE   = 20
+EBADMON = 25
+
+.text
+			!clear .bss
+	ldk	R2, $0
+	ld	R3, $endbss
+	ld	R0, R3
+	sub	R0, $begbss
+	jr	EQ, 1f
+	sra	R0
+	push	*RR2, $0
+	dec	R0
+	jr	EQ, 1f
+	ldl	RR4, RR2
+	dec	R5, $2
+	lddr	*RR4, *RR2, R0
+1:
+	ldb	RL0, $10		! echo newline
+	sc	$4
+	ldl	RR14, $0
+	push	*RR14, envp
+	push	*RR14, argv
+	push	*RR14, $1
+	calr	_m_a_i_n
+	ldl	RR14, $0xC00017FC
+	sc	$0
+
+.bss
+begbss:
+.data
+hol0:
+	.word 0,0			! line no
+	.word 0,0			! file
+trppc:
+	.word 0
+trpim:
+	.word 0
+argv:
+envp:
+	.word 1f
+	.word 0
+1:	.asciz	"program"
+reghp:
+	.word endbss

mach/z8000/libem/inn.s

@@ -0,0 +1,23 @@
+.define inn
+
+!bitnr in R1
+!size (bytes) in R2
+inn:
+	ld	R3, R2
+	sra	R2
+	ldk	R0, $0
+	div	RR0, $020	!R0: bitnr, R1: wordnr
+	cp	R1, R2
+	jr	UGE, 1f		!R1 must be < R2
+	inc	R1, $2		!R1 contains nr of words from top stack
+	sla	R1
+	ld	R1, RR14(R1)
+	bit	R1, R0
+	jr	EQ, 1f
+	ldk	R0, $1
+	jr	2f
+1:	ldk	R0, $0
+2:	ld	R1, R3
+	popl	RR2, *RR14
+	add	R15, R1
+	jp	*RR2

mach/z8000/libem/lar.s

@@ -0,0 +1,23 @@
+.define lar
+
+!R1 contains description address
+!R3 contains element number
+!base address is on stack
+lar:
+	popl	saveret, *RR14
+	sub	R3, 0(R1)
+	ld	R0, 4(R1)		!nr of bytes per element
+	mult	RR2, R0
+	add	R3, *RR14
+	add	R3, R0
+	sra	R0			!nr of words per element
+	jr	EQ, 1f
+	dec	R3, $2
+	lddr	*RR14, *RR2, R0
+	inc	R15, $2
+	jr	2f
+1:	ldb	RL2, -1(R3)
+	ldb	RH2, $0
+	ld	*RR14, R2
+2:	ldl	RR2, saveret
+	jp	*RR2

mach/z8000/libem/los2.s

@@ -0,0 +1,20 @@
+.define los2
+
+los2:
+	popl	saveret, *RR14
+	pop	R0, *RR14		!object size
+	ldk	R2, $0
+	pop	R3, *RR14		!address of object
+	cp	R0, $1
+	jr	NE, 1f
+	ldb	RL0, *RR2
+	push	*RR14, R0
+	jr	2f
+1:	add	R3, R0
+	dec	R3, $2
+	dec	R15, $2
+	sra	R0
+	lddr	*RR14, *RR2, R0
+	inc	R15, $2
+2:	pushl	*RR14, saveret
+	ret

mach/z8000/libem/mon.s

@@ -0,0 +1,83 @@
+.define mon
+
+mon:
+	popl	saveret, *RR14
+	pop	R0, *RR14	! iocode
+	cp	R0, $1		! exit
+	jr	NE, read
+	inc	R15, $2
+	sc	$EXIT
+read:	cp	R0, $3		! read
+	jr	NE, write
+	pop	R0, *RR14	! dummy;  all input from stdin
+	pop	R1, *RR14	! ptr to buffer
+	pop	R2, *RR14	! nr of bytes to be read
+	ld	R3, R1
+	cp	R2, $0
+	jr	EQ, 6f
+1:	sc	$2		! read character into RL0
+	cpb	RL0, $004	! \^D
+	jr	EQ, 6f
+	cpb	RL0, $015	! \cr
+	jr	NE, 2f
+	ldb	RL0, $012
+2:	sc	$4		! echo
+	cpb	RL0, $010	! \^H
+	jr	NE, 3f
+	cp	R1, R3
+	jr	EQ, 5f
+	dec	R1
+	jr	5f
+3:	cpb	RL0, $0100	! \@
+	jr	NE, 4f
+	ld	R1, R3
+	ldb	RL0, $012
+	sc	$4
+	jr	5f
+4:	ldb	0(R1), RL0
+	inc	R1
+	cpb	RL0, $012	! \nl
+	jr	EQ, 6f
+5:	djnz	R2, 1b
+6:	sub	R1, R3		! nr of bytes read
+	push	*RR14, R1
+	push	*RR14, $0
+	jr	retu
+write:	cp	R0, $4		! write
+	jr	NE, open
+	pop	R0, *RR14	! dummy;  all output to stdout
+	pop	R1, *RR14	! ptr to buffer
+	pop	R2, *RR14	! nr of bytes to be written
+	ld	R3, R2
+	cp	R2, $0
+	jr	EQ, 8f
+9:	ld	R0, $5000	! counter to delay printing a little
+7:	djnz	R0, 7b
+	ldb	RL0, 0(R1)
+	sc	$4
+	inc	R1
+	djnz	R2, 9b
+8:	sub	R3, R2		! nr of bytes written
+	push	*RR14, R3
+	push	*RR14, $0
+	jr	retu
+open:	cp	R0, $5		! open
+	jr	close
+	jr	NE, close
+	ld	*RR14, $0
+	ld	2(R15), $0
+	jr	retu
+close:	cp	R0, $6		! close
+	jr	NE, ioctl
+	ld	*RR14, $0
+	jr	retu
+ioctl:	cp	R0, $54		! ioctl
+	jr	NE, err
+	inc	R15, $4
+	ld	*RR14, $0
+retu:	ldl	RR2, saveret
+	jp	*RR2
+err:	push	*RR14, saveret
+	push	*RR14, $EBADMON
+	calr	trp
+	ret

mach/z8000/libem/noop.s

@@ -0,0 +1,9 @@
+.define noop
+
+noop:
+	push	*RR14, hol0
+	push	*RR14, $fmt
+	calr	prf
+	ret
+.data
+fmt:	.asciz	"test %d\n"

mach/z8000/libem/prf.s

@@ -0,0 +1,36 @@
+.define prf
+
+prf:
+	ld	R0, hol0+4	!pointer to filename
+	cp	R0, $0
+	jr	EQ, 1f
+	ld	R2, R0
+	ld	R1, $40
+3:	    !test filename on bad characters
+	ldb	R3, 0(R2)
+	cpb	R3, $0
+	jr	EQ, 2f
+	cpb	R3, $0177
+	jr	GE, 1f
+	cpb	R3, $040
+	jr	LT, 1f
+	inc	R2
+	djnz	R1, 3b
+	clrb	0(R2)
+2:	push	*RR14, hol0
+	ld	R1, R15
+	push	*RR14, R1
+	push	*RR14, R0
+	push	*RR14, $fmt1
+	calr	printf
+	popl	saveprf, *RR14	!return address
+	calr	printf		!because of call from 'noop'
+	pushl	*RR14, saveprf
+	ret
+1:	ld	R0, $name
+	jr	2b
+.data
+fmt1:	.asciz	"%s, sp = %x, line %d:\n"
+name:	.asciz	"_unknown file_"
+saveprf:
+	.long 0

mach/z8000/libem/printf.s

@@ -0,0 +1,82 @@
+.define printf
+
+printf:
+	popl	saveret, *RR14
+	ldm	savereg, R4, $10
+	ld	R3, $buff	!R3 is pointer to a buffer, in which 
+				!we built the string to be printed.
+	pop	R2, *RR14	!R2 is pointer to format-string
+prloop:
+	ldb	RL0, 0(R2)
+	testb	RL0
+	jr	EQ, ready
+	inc	R2
+	cpb	RL0, $045	! '%'?
+	jr	NE, 1f
+	ldb	RL0, 0(R2)
+	inc	R2
+	cpb	RL0, $0163	! 's'?
+	jr	EQ, 3f
+	cpb	RL0, $0170	! 'x'?
+	ld	R4, $16		! print number hexadecimal
+	jr	EQ, 2f
+	cpb	RL0, $0144	! 'd'?
+	ld	R4, $10		! print number decimal
+	jr	EQ, 2f
+	cpb	RL0, $0157	! 'o'?
+	ld	R4, $8		! print number octal
+	jr	EQ, 2f
+1:	ldb	0(R3), RL0
+	inc	R3
+	jr	prloop
+2:	    !in case of %x, %d or %o
+	pop	R1, *RR14
+	test	R1
+	jr	PL, 4f
+	cp	R4, $10
+	jr	NE, 4f		! print only '-' in case of %d
+	ldb	0(R3), $055	! '-'
+	inc	R3
+	neg	R1
+4:	calr	printn
+	jr	prloop
+3:	    !in case of %s
+	pop	R1, *RR14
+6:	ldb	RL0, 0(R1)
+	testb	RL0
+	jr	EQ, prloop
+	inc	R1
+	ldb	0(R3), RL0
+	inc	R3
+	jr	6b
+ready:	    !now really print the string we built in the buffer
+	ldb	0(R3), RL0	!end string with '\0'
+	sub	R3, $buff-1	!R3 contains the number of characters
+	ld	R1, $buff
+7:	ldb	RL0, 0(R1)
+	inc	R1
+	sc	$4
+	djnz	R3, 7b
+	ldm	R4, savereg, $10
+	pushl	*RR14, saveret
+	ret
+
+printn:
+	ldk	R0, $0
+	div	RR0, R4		!%x, %d or %o determined by R4
+	test	R1
+	jr	EQ, 5f		!if quotient is '0' printn is ready
+	push	*RR14, R0	!push remainder onto the stack
+	calr	printn
+	pop	R0, *RR14
+5:	add	R0, $060
+	cp	R0, $071	!'9'
+	jr	LE, 8f
+	add	R0, $7
+8:	ldb	0(R3), RL0
+	inc	R3
+	ret
+
+.data
+buff:
+	.space 256

mach/z8000/libem/rck.s

@@ -0,0 +1,11 @@
+.define rck
+
+rck:
+	ld	R0, RR14($4)
+	cp	R0, 0(R1)
+	jr	LT, 1f
+	cp	R0, 2(R1)
+	jr	LE, 2f
+1:	push	*RR14, $ERANGE
+	calr	trp
+2:	ret

mach/z8000/libem/rmu2.s

@@ -0,0 +1,17 @@
+.define rmu2
+
+rmu2:
+	popl	saveret, *RR14
+	pop	R2, *RR14
+	pop	R1, *RR14
+	test	R2
+	jr	MI, 1f
+	ldk	R0, $0
+	div	RR0, R2
+2:	pushl	*RR14, saveret
+	ret
+1:	ld	R0, R1
+	cp	R2, R1
+	jp	UGT, 2b
+	sub	R0, R2
+	jp	2b

mach/z8000/libem/rmu4.s

@@ -0,0 +1,19 @@
+.define rmu4
+
+rmu4:
+	popl	saveret, *RR14
+	ldm	savereg, R4, $10
+	popl	RR4, *RR14
+	popl	RR2, *RR14
+	testl	RR4
+	jr	MI, 1f
+	ldl	RR0, $0
+	divl	RQ0, RR4
+	jr	2f
+1:	ldl	RR0, RR2
+	cpl	RR4, RR2
+	jr	UGT, 2f
+	sub	RR0, RR4
+2:	ldm	R4, savereg, $10
+	pushl	*RR14, saveret
+	ret

mach/z8000/libem/sar.s

@@ -0,0 +1,20 @@
+.define sar
+
+!R1 contains description address
+!R3 contains element number
+!base address is on stack
+sar:
+	popl	saveret, *RR14
+	sub	R3, 0(R1)
+	ld	R0, 4(R1)		!nr of bytes per element
+	mult	RR2, R0
+	add	R3, *RR14
+	inc	R15, $2
+	sra	R0			!nr of words per element
+	jr	EQ, 1f
+	ldir	*RR2, *RR14, R0
+	jr	2f
+1:	pop	R1, *RR14
+	ldb	*RR2, RL1
+2:	ldl	RR2, saveret
+	jp	*RR2

mach/z8000/libem/save.s

@@ -0,0 +1,8 @@
+.define saveret
+.define savereg
+
+.data
+saveret:
+	.long 0
+savereg:
+	.space 20

mach/z8000/libem/strhp.s

@@ -0,0 +1,10 @@
+.define strhp
+
+strhp:
+	popl	RR2, *RR14
+	pop	R0, *RR14
+	ld	reghp, R0	!heappointer must be < stackpointer.
+	cp	R0, R15
+	jp	ULT, *RR2
+	push	*RR14, $EHEAP
+	jr	fatal

mach/z8000/libem/sts2.s

@@ -0,0 +1,16 @@
+.define sts2
+
+sts2:
+	popl	saveret, *RR14
+	pop	R0, *RR14		!object size
+	ldk	R2, $0
+	pop	R3, *RR14		!address of object
+	cp	R0, $1
+	jr	NE, 1f
+	pop	R0, *RR14
+	ldb	*RR2, RL0
+	jr	2f
+1:	sra	R0
+	ldir	*RR2, *RR14, R0
+2:	pushl	*RR14, saveret
+	ret

mach/z8000/libem/trp.s

@@ -0,0 +1,38 @@
+.define trp, fatal
+
+fatal:
+	calr	trp
+	sc	$EXIT
+
+trp:
+	push	*RR14, R1
+	inc	R15, $2
+	popl	saveret, *RR14
+	pop	R1, *RR14	!trap number in R1
+	pushl	*RR14, saveret
+	push	*RR14, R0
+	dec	R15, $2
+	cp	R1, $16
+	jr	UGE, 1f
+	ld	R0, trpim
+	bit	R0, R1
+	jr	NE, 2f		!ignore
+1:	sub	R15, $24
+	ldm	*RR14, R2, $12
+	push	*RR14, R1
+	ld	R1, trppc
+	cp	R1, $0
+	jr	EQ, 3f
+	clr	trppc
+	call	0(R1)
+	inc	R15, $2
+	ldm	R2, *RR14, $12
+	add	R15, $24
+2:	pop	R1, *RR14
+	pop	R0, *RR14
+	ret
+3:	push	*RR14, $err
+	calr	printf
+	sc	$EXIT
+.data
+err:	.asciz	"trap error %d\n"

mach/z8000/libem/unknown.s

@@ -0,0 +1,5 @@
+.define unknown
+
+unknown:
+	push	*RR14, $EODDZ
+	jr	fatal

mach/z8000/libem/xset.s

@@ -0,0 +1,22 @@
+.define xset
+
+!bitnr in R1
+!size (bytes) in R0
+xset:
+	popl	saveret, *RR14
+	sra	R0
+	ld	R2, R0
+1:	push	*RR14, $0
+	djnz	R0, 1b
+	div	RR0, $020		!R0: bitnr, R1: wordnr
+	cp	R1, R2
+	jr	UGE, 2f
+	ldk	R2, $0
+	set	R2, R0
+	sla	R1
+	ld	RR14(R1), R2
+3:	pushl	*RR14, saveret
+	ret
+2:	push	*RR14, $ESET
+	calr	trp
+	jr	3b