*** empty log message ***

mach/i80/libem/aar2.s

@@ -0,0 +1,42 @@
+.define .aar2
+
+! Load address of array element, decriptor contains 2-bytes integers
+! Expects on stack:	pointer to array descriptor
+! 			index
+!			base address
+! Yields on stack:	address of array element
+
+.aar2:
+	pop h
+	shld .retadr1
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	pop h		! hl = pointer to descriptor
+        pop d           ! de = index
+	mov a,e		! bc = index - lower bound
+	sub m
+	inx h
+	mov c,a
+	mov a,d
+	sbb m
+	inx h
+	mov b,a
+	push b		! first operand to multiply
+	inx h
+	inx h
+	mov c,m		! bc = size
+	inx h
+	mov b,m
+	push b		! second operand to multiply
+	call .mli2	! de = size * (index - lower bound)
+	pop h		! hl = base address
+	dad d		! hl = address of array[index]
+	push h
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr1
+	pchl

mach/i80/libem/adi4.s

@@ -0,0 +1,23 @@
+.define .adi4
+
+! Add two 32 bits signed or unsigned integers
+! Expects on stack: operands
+! Yields on stack:  result
+
+.adi4:	pop h
+	shld .retadr	! get return address out of the way
+	pop d
+	pop h
+	xthl
+	dad d
+	shld .tmp1
+	pop d
+	pop h
+	jnc 1f
+	inx h
+1:	dad d
+	push h
+	lhld .tmp1
+	push h
+	lhld .retadr
+	pchl

mach/i80/libem/and.s

@@ -0,0 +1,37 @@
+.define .and
+
+! Any size logical-'and'.
+! Expects:	size in de-registers
+!		operands on stack
+! Yields:	result on stack
+
+.and:	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	lxi h,0
+	dad sp
+	mov c,l
+	mov b,h		!now bc points to top of first operand
+	dad d		!and hl points to top of second perand
+	push h		!this will be the new stackpointer
+1:	ldax b
+	ana m
+	mov m,a
+	inx h
+	inx b
+	dcx d
+	mov a,e
+	ora d
+	jnz 1b
+
+	pop h
+	sphl
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libem/blm.s

@@ -0,0 +1,31 @@
+.define .blm
+
+! Block move
+! Expects in de-reg:	size of block
+! Expects on stack:	destination address
+!			source address
+
+.blm:	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	pop h		! hl = destination address
+	pop b		! bc = source address
+
+1:	ldax b
+	mov m,a
+	inx b
+	inx h
+	dcx d
+	mov a,d
+	ora e
+	jnz 1b
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl
+

mach/i80/libem/cii.s

@@ -0,0 +1,84 @@
+.define .cii
+
+! Convert integer to integer
+! Expects in a-reg:	1 for signed integer to signed integer (cii)
+!			0 for unsigned integer to unsigned integer (cuu)
+! Expects on stack:	destination size
+!			source size
+!			source
+! Yields on stack:	result
+
+.cii:	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	sta .areg	! save a-register
+	pop b
+	mov e,c
+	pop b		! c = source size
+	mov b,e		! b = destination size
+	mov a,b
+	cmp c
+	jz 3f		! destination size = source size
+	jc shrink	! destination size < source size
+
+! if destination size > source size only:
+	lxi h,0
+	dad sp
+	mov e,l
+	mov d,h		! de = stackpointer
+	mov a,b
+	sub c		! c = (still) source size
+	mov b,a		! b = destination size - source size
+	cma
+	mov l,a
+	mvi h,255
+	inx h
+	dad d		! hl = stackpointer - (dest. size - source size)
+	sphl		! new stackpointer
+
+1:	ldax d		! move source downwards
+	mov m,a
+	inx d
+	inx h
+	dcr c
+	jnz 1b
+
+	ral		! a-reg still contains most significant byte of source
+	jnc 1f		! jump if is a positive integer
+	lda .areg
+	ora a
+	jz 1f		! jump if it is a cuu
+	mvi c,255	! c-reg contains filler byte
+
+1:	mov m,c		! fill
+	inx h
+	dcr b
+	jnz 1b
+	jmp 3f		! done
+
+!if destination size < source size only:
+shrink:	mov l,c		! load source size in hl
+	mvi h,0
+	dad sp
+	mov d,h
+	mov e,l		! de points just above source
+	mov l,b		! load destination size in hl
+	mvi h,0
+	dad sp		! hl points just above "destination"
+
+1:	dcx d		! move upwards
+	dcx h
+	mov a,m
+	stax d
+	dcr b
+	jnz 1b
+	sphl
+
+3:	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libem/cmi4.s

@@ -0,0 +1,66 @@
+.define .cmi4
+
+! Compare 32 bits integers
+! Expects:	operands on stack
+!		a-register = 1 for signed integers
+!		a-register = 0 for unsigned integers
+! Yields in de-registers: -1 if second operand < first operand
+!			   0 if second operand = first operand
+!			   1 if second operand > first operand
+
+.cmi4:	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	lxi b,4
+	lxi h,0
+	dad sp
+	dad b
+	dcx h
+	mov d,h
+	mov e,l		!now de points to the first operand
+	dad b		!and hl to the second
+	ora a		!is it a cmi or cmu?
+	jz 1f
+
+!for cmi only:
+	mov a,m
+	ral
+	jnc 2f
+	ldax d		!second operand is negative
+	ral
+	jc 1f		!jump if both operands are negative
+	lxi d,-1	!second operand is smaller
+	jmp 4f
+2:	ldax d		!second operand is positive
+	ral
+	jnc 1f		!jump if both operand are positive
+	lxi d,1		!second operand is larger
+	jmp 4f
+
+!cmi and cmu rejoin here
+1:	ldax d
+	cmp m
+	jz 3f
+	jnc 2f
+	lxi d,1		!second operand is larger
+	jmp 4f
+2:	lxi d,-1	!second operand is smaller
+	jmp 4f
+3:	dcx d
+	dcx h
+	dcr c
+	jnz 1b
+	lxi d,0		!operands are equal
+
+4:	lxi h,8
+	dad sp
+	sphl
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libem/cms.s

@@ -0,0 +1,35 @@
+.define .cms
+
+! Any size compare
+! Expects:	size in de-registers
+!		operands on stack
+! Yields in de-registers: 0 if operands are equal
+!			  1 if operands are not equal
+
+.cms:
+	pop h
+	shld .retadr
+
+	mov l,e
+	mov h,d
+	mov a,l
+	rar
+	cc eoddz	!trap is size is odd
+	dad sp		!now hl points to second operand
+			!and sp points to the first.
+1:	dcx sp
+	pop psw		!get next byte in accumulator
+	cmp m
+	inx h
+	dcx d
+	jnz 2f		!jump if bytes are not equal
+	mov a,d
+	ora e
+	jnz 1b
+	jmp 3f
+2:	dad d
+	lxi d,1
+3:	sphl
+
+	lhld .retadr
+	pchl

mach/i80/libem/com.s

@@ -0,0 +1,20 @@
+.define .com
+
+! Complement bytes on top of stack.
+! Expects in de-registers: number of bytes
+
+.com:	pop h
+	shld .retadr
+	lxi h,0
+	dad sp
+1:	mov a,m
+	cma
+	mov m,a
+	inx h
+	dcx d
+	mov a,e
+	ora d
+	jnz 1b
+	lhld .retadr
+	pchl
+

mach/i80/libem/csa.s

@@ -0,0 +1,52 @@
+.define .csa
+
+! Case jump
+! Expects on stack:	address of case descriptor
+!			case index
+! This is not a subroutine, but just a piece of code that computes
+! the jump address and jumps to it.
+! Traps if resulting address is zero.
+
+.csa:	pop h		!hl = address of case descriptor
+	pop d		!de = index
+	push b		!save localbase
+	mov c,m
+	inx h
+	mov b,m
+	inx h
+	push b		!save default pointer on stack
+	mov a,e
+	sub m
+	inx h
+	mov c,a
+	mov a,d
+	sbb m
+	inx h
+	mov b,a		!bc = index - lower bound
+	jc 1f		!get default pointer
+	mov a,m
+	inx h
+	sub c
+	mov a,m
+	inx h
+	sbb b
+	jc 1f		!upper-lower should be >= index-lower
+	dad b
+	dad b		!hl now points to the wanted pointer
+	mov a,m
+	inx h
+	mov h,m
+	mov l,a		!hl = pointer for index
+	ora h
+	jz 1f		!get default pointer if pointer = 0
+	pop b		!remove default pointer
+	pop b		!localbase
+	pchl		!jump!!!!
+
+1:	pop h		!get default pointer
+	mov a,l
+	ora h
+	cz ecase	!trap
+	pop b		!restore localbase
+	pchl		!jump!!!!
+

mach/i80/libem/csb.s

@@ -0,0 +1,53 @@
+.define .csb
+
+! Table lookup jump
+! Expects on stack:	address of case descriptor
+!			case index
+! This is not a subroutine, but just a piece of code that computes
+! the jump address and jumps to it.
+! Traps if resulting address is zero.
+
+.csb:	pop h		!hl = pointer to descriptor
+	pop d		!de = case index
+	push b		!save localbase
+	mov c,m		!bc = default pointer
+	inx h
+	mov b,m
+	inx h
+	push b		!save default on stack
+	mov c,m		!bc = number of entries
+	inx h
+	mov b,m
+	inx h
+!loop: try to find the case index in the descriptor
+1:	mov a,b
+	ora c
+	jz 4f		!done, index not found
+	mov a,m		!do we have the right index?
+	inx h
+	cmp e
+	jnz 2f		!no
+	mov a,m
+	inx h
+	cmp d
+	jnz 3f		!no
+	mov a,m
+	inx h
+	mov h,m
+	mov l,a
+	pop psw		!remove default pointer
+	jmp 5f
+
+2:	inx h		!skip high byte of index
+3:	inx h		!skip jump address
+	inx h
+	dcx b
+	jmp 1b
+
+4:	pop h		!take default exit
+5:	pop b		!restore localbase
+	mov a,l		!jump address is zero?
+	ora h
+	cz ecase	!trap
+	pchl		!jump!!!!
+

mach/i80/libem/dup.s

@@ -0,0 +1,34 @@
+.define .dup
+
+! Duplicate top bytes of stack
+! Expects in de-registers: number of bytes to duplicate
+
+.dup:	mov a,e		!trap if number is odd
+	rar
+	cc eoddz
+
+	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	mov h,d
+	mov l,e
+	dad sp
+1:	dcx h
+	mov b,m
+	dcx h
+	mov c,m
+	push b
+	dcx d
+	dcx d		!number of bytes must be a word-multiple i.e. even
+	mov a,d
+	ora e
+	jnz 1b
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libem/dvi2.s

@@ -0,0 +1,114 @@
+
+.define .dvi2
+
+! 16 bits signed and unsigned integer divide and remainder routine
+! Bit 0 of a-reg is set iff quotient has to be delivered
+! Bit 7 of a-reg is set iff the operands are signed, so:
+! Expects in a-reg:	0 if called by rmu 2
+!			1 if called by dvu 2
+!			128 if called by rmi 2
+!			129 if called by dvi 2
+! Expects on stack:	divisor
+!			dividend
+! Yields in de-reg:	quotient or remainder
+
+.dvi2:	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	sta .areg
+	pop b		! bc = divisor
+	mov a,b		! trap if divisor = 0
+	ora c
+	cz eidivz
+	pop d		! de = dividend
+
+	mvi h,0
+	lda .areg
+	ral
+	jnc 0f		! jump if unsigned
+
+	mov a,d
+	ral
+	jnc 1f		! jump if dividend >= 0
+	mvi h,129	! indicate dividend is negative
+	xra a		! negate dividend
+	sub e
+	mov e,a
+	mvi a,0
+	sbb d
+	mov d,a
+			! de is positive now
+
+1:	mov a,b
+	ral
+	jc 2f		! jump if divisor < 0
+0:	inr h		! indicate negation
+	xra a		! negate divisor
+	sub c
+	mov c,a
+	mvi a,0
+	sbb b
+	mov b,a
+			! bc is negative now 
+
+2:	push h		! save h-reg
+	lxi h,0		! initial value of remainder
+	mvi a,16	! initialize loop counter
+
+3:	push psw	! save loop counter
+	dad h		! shift left: hl <- de <- 0
+	xchg
+	dad h
+	xchg
+	jnc 4f
+	inx h
+
+4:	push h		! save remainder
+	dad b		! subtract divisor (add negative)
+	jnc 5f
+	xthl
+	inx d
+
+5:	pop h
+	pop psw		! restore loop counter
+	dcr a
+	jnz 3b
+
+	pop b		! b-reg becomes what once was h-reg
+	lda .areg
+	rar		! what has to be delivered: quotient or remainder?
+	jnc 6f
+
+! for dvi 2 and dvu 2 only:
+	mov a,b
+	rar
+	jc 8f		! jump if divisor and dividend had same sign
+	xra a		! negate quotient
+	sub e
+	mov e,a
+	mvi a,0
+	sbb d
+	mov d,a
+	jmp 8f
+
+! for rmi 2 and rmu 2 only:
+6:	mov a,b
+	ral
+	jnc 7f		! negate remainder if dividend was negative
+	xra a
+	sub l
+	mov l,a
+	mvi a,0
+	sbb h
+	mov h,a
+7:	mov d,h		! return remainder
+	mov e,l
+
+8:	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libem/dvi4.s

@@ -0,0 +1,145 @@
+.define .dvi4
+
+! 32 bits integer divide and remainder routine
+! Bit 0 of a-reg is set iff quotient has to be delivered
+! Bit 7 of a-reg is set iff the operands are signed, so:
+! Expects in a-reg:	0 if called by rmu 4
+!			1 if called by dvu 4
+!			128 if called by rmi 4
+!			129 if called by dvi 4
+! Expects on stack:	divisor
+!			dividend
+! Yields on stack:	quotient or remainder
+
+.dvi4:	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	sta .areg
+	pop h			! store divisor
+	shld block3
+	xchg
+	pop h
+	shld block3+2
+	dad d
+	jc 1f
+	mov a,l
+	ora h
+	cz eidivz		! trap if divisor = 0
+
+1:	pop h			! store dividend
+	shld block1
+	pop h
+	shld block1+2
+	lxi h,0			! store initial value of remainder
+	shld block2
+	shld block2+2
+
+	mvi b,0
+	lda .areg
+	ral
+	jnc 2f			! jump if unsigned
+
+	lda block1+3
+	ral
+	jnc 1f
+	mvi b,129
+	lxi h,block1
+	call compl		! dividend is positive now
+
+1:	lda block3+3
+	ral
+	jnc 2f
+	inr b
+	lxi h,block3
+	call compl		! divisor is positive now
+
+2:	push b			! save b-reg
+	mvi b,32
+
+dv0:	lxi h,block1		! left shift: block2 <- block1 <- 0
+	mvi c,8
+	xra a
+1:	mov a,m
+	ral
+	mov m,a
+	inx h
+	dcr c
+	jnz 1b
+	lxi h,block2+3		! which is larger: divisor or remainder?
+	lxi d,block3+3
+	mvi c,4
+1:	ldax d
+	cmp m
+	jz 0f
+	jnc 3f
+	jmp 4f
+0:	dcx d
+	dcx h
+	dcr c
+	jnz 1b
+
+4:	lxi d,block2		! remainder is larger or equal: subtract divisor
+	lxi h,block3
+	mvi c,4
+	xra a
+1:	ldax d
+	sbb m
+	stax d
+	inx d
+	inx h
+	dcr c
+	jnz 1b
+	lxi h,block1
+	inr m
+
+3:	dcr b
+	jnz dv0			! keep looping
+
+	pop b
+	lda .areg		! quotient or remainder?
+	rar
+	jnc 4f
+
+! for dvi 4 and dvu 4 only:
+	mov a,b
+	rar
+	lxi h,block1		! complement quotient if divisor
+	cc compl		! and dividend have different signs
+	lhld block1+2		! push quotient
+	push h
+	lhld block1
+	push h
+	jmp 5f
+
+! for rmi 4 and rmu 4 only:
+4:	mov a,b
+	ral
+	lxi h,block2
+	cc compl		! negate remainder if dividend was negative
+	lhld block2+2
+	push h
+	lhld block2
+	push h
+
+5:	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl
+
+! make 2's complement of 4 bytes pointed to by hl.
+compl:	push b
+	mvi c,4
+	xra a
+1:	mvi a,0
+	sbb m
+	mov m,a
+	inx h
+	dcr c
+	jnz 1b
+	pop b
+	ret
+

mach/i80/libem/exg.s

@@ -0,0 +1,40 @@
+.define .exg
+
+! Exchange top bytes of stack
+! Expects in de-registers the number of bytes to be exchanged.
+
+.exg:	mov a,e
+	rar
+	cc eoddz		!trap if numer of bytes is odd
+	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	lxi h,0
+	dad sp
+	mov b,h
+	mov c,l			!now bc points to first operand
+	dad d			!and hl to the second
+	push d			!place number of bytes on top of stack
+1:	mov d,m
+	ldax b
+	mov m,a
+	mov a,d
+	stax b
+	xthl			!caused by a lack of registers
+	dcx h			!decrement top of stack
+	mov a,h
+	ora l
+	xthl
+	inx h
+	inx b
+	jnz 1b
+
+	pop d
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libem/inn.s

@@ -0,0 +1,61 @@
+.define .inn
+
+! Any size bit test on set.
+! Expects in de-reg:	size of set (in bytes)
+! Expects on stack:	bit number
+!			set to be tested
+! Yields in de-reg.:	0 if bit is reset or bit number out of range
+!			1 if bit is set
+
+.inn:	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	pop h
+	xchg		!hl = size, de = bit number
+	mov a,d		!test if bit number is negative
+	ral
+	jc 3f
+	mov a,e
+	ani 7
+	mov b,a		!save bits 0-2 of bit number in b-reg
+	mvi c,3
+1:	xra a
+	mov a,d		!shift bit number right 3 times
+	rar
+	mov d,a
+	mov a,e
+	rar
+	mov e,a
+	dcr c
+	jnz 1b
+
+	mov a,l		!test if bit number is small enough
+	sub e
+	mov a,h
+	sbb d
+	jc 3f
+	xchg
+	dad sp
+	xchg
+	ldax d		!a-register = wanted byte
+2:	dcr b		!dcr doesn't affect carry bit
+	jm 4f
+	rar
+	jmp 2b
+
+3:	xra a		!return 0 if bit number out of range
+4:	ani 1
+	mov e,a
+	mvi d,0
+	dad sp
+	sphl
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl
+

mach/i80/libem/ior.s

@@ -0,0 +1,38 @@
+.define .ior
+
+
+! Any size inclusive-or.
+! Expects:	size in de-registers
+!		operands on stack
+! Yields:	result on stack
+
+.ior:	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	lxi h,0
+	dad sp
+	mov c,l
+	mov b,h		!now bc points to top of first operand
+	dad d		!and hl points to top of second operand
+	push h		!this will be the new stackpointer
+1:	ldax b
+	ora m
+	mov m,a
+	inx h
+	inx b
+	dcx d
+	mov a,e
+	ora d
+	jnz 1b
+
+	pop h
+	sphl
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libem/lar2.s

@@ -0,0 +1,71 @@
+.define .lar2
+
+! Load array element, descriptor contains 2-bytes integers
+! Expects on stack:	pointer to array descriptor
+!			index
+!			base address
+! Yields on stack:	array element
+! Adapted from .aar2 and .loi
+
+.lar2:
+	pop h
+	shld .retadr1
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	pop h		! hl = pointer to descriptor
+        pop d           ! de = index
+	mov a,e		! bc = index - lower bound
+	sub m
+	inx h
+	mov c,a
+	mov a,d
+	sbb m
+	inx h
+	mov b,a
+	push b		! first operand to multiply
+	inx h
+	inx h
+	mov c,m		! bc = size
+	inx h
+	mov b,m
+	push b		! second operand to multiply
+	call .mli2	! de = size * (index - lower bound)
+	pop h		! hl = base address
+	dad d		! hl = address of array[index]
+	dad b		! hl= load pointer
+	xra a		! clear carry bit
+	mov a,b		! divide bc by 2
+	rar
+	mov b,a
+	mov a,c
+	rar
+	mov c,a
+	jnc 1f
+	
+! for 1 byte array element only:
+	mov a,c		! trap if bc odd and <>1
+	ora b
+	cnz eoddz
+	dcx h
+	mov e,m
+	mvi d,0
+	push d
+	jmp 2f
+
+1:	dcx h
+	mov d,m
+	dcx h
+	mov e,m
+	push d
+	dcx b
+	mov a,b
+	ora c
+	jnz 1b
+
+2:	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr1
+	pchl

mach/i80/libem/loi.s

@@ -0,0 +1,50 @@
+.define .loi
+
+! Load indirect
+! Expects in de-registers: number of bytes to be loaded
+!			   (this number should be 1 or even )
+! Expects on stack:	   base address
+! Yields on stack:	   result
+
+.loi:	pop h
+	shld .retadr
+	mov l,c		! free bc for scratch
+	mov h,b
+	shld .bcreg
+
+	pop h		! hl = base address
+	dad d		! hl = load pointer
+	xra a		! clear carry bit
+	mov a,d		! divide d by 2
+	rar
+	mov d,a
+	mov a,e
+	rar
+	mov e,a
+	jnc 1f
+
+! if 1 byte has to be loaded only:
+	mov a,d
+	ora e
+	cnz eoddz	! trap if number is odd and <> 1
+	dcx h
+	mov c,m
+	mvi b,0
+	push b
+	jmp 2f
+
+1:	dcx h
+	mov b,m
+	dcx h
+	mov c,m
+	push b
+	dcx d		! is count exhausted?
+	mov a,d
+	ora e
+	jnz 1b
+
+2:	lhld .bcreg
+	mov c,l
+	mov b,h
+	lhld .retadr
+	pchl

mach/i80/libem/mli2.s

@@ -0,0 +1,80 @@
+.define .mli2
+
+!  16 bits signed integer multiply
+!  the algorithm multiples A * B, where A = A0*2^8 + A1 and B = B0*2^8 + B1
+!  product is thus A0*B0*2^16 + 2^8 * (A0 * B1 + B0 * A1) + A0 * B0
+!  hence either A0 = 0 or B0 = 0 or overflow.
+!  initial part of code determines which high byte is 0 (also for negative #s)
+!  then the multiply is reduced to 8 x 16 bits, with the 8 bit number in the
+!  a register, the 16 bit number in the hl register, and the product in de
+!  Expects operands on stack
+!  Yields result in de-registers
+
+.mli2:	pop h
+	shld .retadr	! get the return address out of the way
+	lxi h,255
+	pop d
+	mov a,d		! check hi byte for 0
+	cmp h		! h = 0
+	jz 1f		! jump if de is a positive 8 bit number
+	cmp l
+	jz 5f		! jump if de is a negative 8 bit number
+	xchg
+	shld .tmp1	! we ran out of scratch registers
+	pop h
+	mov a,h
+	cmp e
+	jz 7f		! jump if second operand is 8 bit negative
+	jmp 6f		! assume second operand is 8 bit positive
+
+1:	mov a,e		! 8 bit positive number in a
+	pop h		! 16 bit number in hl
+
+! here is the main loop of the multiplication.  the a register is shifted
+! right 1 bit to load the carry bit for testing.
+! as soon as the a register goes to zero, the loop terminates.
+! in most cases this requires fewer than 8 iterations.
+2:	lxi d,0
+	ora a
+3:	rar		! load carry bit from a
+	jnc 4f		! add hl to de if low bit was a 1
+	xchg
+	dad d
+	xchg
+4:	dad h
+	ora a		! sets zero correct and resets carry bit
+	jnz 3b		! if a has more bits, continue the loop
+	lhld .retadr	! go get return address
+	pchl
+
+! the 8 bit operand is negative. negate both operands
+5:	pop h
+	mov a,l
+	cma
+	mov l,a
+	mov a,h
+	cma
+	mov h,a
+	inx h		! 16 bit negate is 1s complement + 1
+	xra a
+	sub e		! negate 8 bit operand
+	jmp 2b
+
+! second operand is small and positive
+6:	mov a,l
+	lhld .tmp1
+	jmp 2b
+
+! second operand is small and negative
+7:	mov e,l
+	lhld .tmp1
+	mov a,l
+	cma
+	mov l,a
+	mov a,h
+	cma
+	mov h,a
+	inx h
+	xra a
+	sub e
+	jmp 2b

mach/i80/libem/mli4.s

@@ -0,0 +1,72 @@
+.define .mli4
+
+! 32 bits signed and unsigned integer multiply routine
+! Expects operands on stack
+! Yields product on stack
+
+.mli4:	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	pop h			! store multiplier
+	shld block1
+	pop h
+	shld block1+2
+	pop h			! store multiplicand
+	shld block2
+	pop h
+	shld block2+2
+	lxi h,0
+	shld block3		! product = 0
+	shld block3+2
+	lxi b,0
+lp1:	lxi h,block1
+	dad b
+	mov a,m			! get next byte of multiplier
+	mvi b,8
+lp2:	rar
+	jnc 2f
+	lhld block2		! add multiplicand to product
+	xchg
+	lhld block3
+	dad d
+	shld block3
+	lhld block2+2
+	jnc 1f
+	inx h
+1:	xchg
+	lhld block3+2
+	dad d
+	shld block3+2
+
+2:	lhld block2		! shift multiplicand left
+	dad h
+	shld block2
+	lhld block2+2
+	jnc 3f
+	dad h
+	inx h
+	jmp 4f
+3:	dad h
+4:	shld block2+2
+
+	dcr b
+	jnz lp2
+
+	inr c
+	mov a,c
+	cpi 4
+	jnz lp1
+
+	lhld block3+2
+	push h
+	lhld block3
+	push h
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libem/mlu2.s

@@ -0,0 +1,46 @@
+.define .mlu2
+
+! 16 bits unsigned multiply routine
+! Expects operands on stack
+! Yields result in de-registers
+! This routine could also be used for signed integers, but it won't
+! because there is a more clever one just for signed integers.
+
+.mlu2:
+	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	pop b		! bc = multiplier
+	pop d		! de = multiplicand
+	lxi h,0		! hl = product
+
+1:	mov a,b		! if multiplier = 0 then finished
+	ora c
+	jz 3f
+
+	xra a		! reset carry
+	mov a,b		! shift multiplier right
+	rar
+	mov b,a
+	mov a,c
+	rar
+	mov c,a
+
+	jnc 2f		!if carry set: add multiplicand to product
+	dad d
+
+2:	xchg		! shift multiplicand left
+	dad h
+	xchg
+	jmp 1b		! keep looping
+
+3:	xchg		! de becomes product
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libem/ngi4.s

@@ -0,0 +1,26 @@
+.define .ngi4
+
+! Exchange 32 bits integer by its two's complement
+! Expects operand on stack
+! Yields result on stack
+
+.ngi4:	pop d
+	lxi h,0
+	dad sp
+	xra a
+	sub m
+	mov m,a
+	inx h
+	mvi a,0
+	sbb m
+	mov m,a
+	inx h
+	mvi a,0
+	sbb m
+	mov m,a
+	inx h
+	mvi a,0
+	sbb m
+	mov m,a
+	push d
+	ret

mach/i80/libem/nop.s

@@ -0,0 +1,25 @@
+.define .nop
+
+.nop:	push b
+	lhld hol0+4
+	mov d,h
+	mov e,l
+	call prstring
+	lxi d,lin
+	call prstring
+	lhld hol0
+	call prdec
+	lxi d,stpr
+	call prstring
+	lxi h,0
+	dad sp
+	call prdec
+	lxi d,newline
+	call prstring
+	pop b
+	ret
+
+
+lin:	.asciz "   lin:"
+stpr:	.asciz "   sp:"
+newline:.asciz "\n"

mach/i80/libem/rck.s

@@ -0,0 +1,52 @@
+.define .rck
+
+! Range check
+! Expects on stack: address of range check descriptor
+!		    index
+! Yields index on stack unchanged
+! Causes a trap if index is out of bounds
+
+.rck:	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	pop h			! hl = return address
+	pop d			! de = index
+	mov c,m			! bc = lower bound
+	inx h
+	mov b,m
+	inx h
+	mov a,d
+	xor b
+	jm 1f			! jump if index and l.b. have different signs
+	mov a,e
+	sub c
+	mov a,d
+	sbb b
+	jmp 2f
+
+1:	xor b			! now a = d again
+2:	cm erange		! trap if index too small
+
+	mov c,m
+	inx h
+	mov b,m
+	mov a,d
+	xor b
+	jm 1f			! jump if index and u.b. have different signs
+	mov a,c
+	sub e
+	mov a,b
+	sbb d
+	jmp 2f
+
+1:	xor d			! now a = b
+2:	cm erange		! trap if index is too large
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libem/rol4.s

@@ -0,0 +1,47 @@
+.define .rol4
+
+! Rotate 4 bytes left
+! Expects in de-reg:	number of rotates
+! Expects on stack:	operand
+! Yields on stack:	result
+
+.rol4	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+.rol4:	pop h		! low-order bytes of operand
+	pop b		! high order bytes of operand
+
+	mov a,e
+	ani 31
+	jz 2f
+	mov e,a
+
+	mov a,b
+	ral
+1:	mov a,l
+	ral
+	mov l,a
+	mov a,h
+	ral
+	mov h,a
+	mov a,c
+	ral
+	mov c,a
+	mov a,b
+	ral
+	mov b,a
+
+	dcr e
+	jnz 1b		! keep looping
+
+2:	push b
+	push h
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libem/ror4.s

@@ -0,0 +1,47 @@
+.define .ror4
+
+! Rotate 4 bytes right
+! Expects in de-reg:	number of rotates
+! Expects on stack:	operand
+! Yields on stack:	result
+
+.ror4	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+.ror4:	pop h		! low-order bytes of operand
+	pop b		! high order bytes of operand
+
+	mov a,e
+	ani 31
+	jz 2f
+	mov e,a
+
+	mov a,l
+	rar
+1:	mov a,b
+	rar
+	mov b,a
+	mov a,c
+	rar
+	mov c,a
+	mov a,h
+	rar
+	mov h,a
+	mov a,l
+	rar
+	mov l,a
+
+	dcr e
+	jnz 1b		! keep looping
+
+2:	push b
+	push h
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libem/sar2.s

@@ -0,0 +1,68 @@
+.define .sar2
+
+! Store array element, descriptor contains 2-bytes integers
+! Expects on stack:	pointer to array descriptor
+!			index
+!			base address
+!			array element
+! Adapted from .aar2 and .sti
+
+.sar2:
+	pop h
+	shld .retadr1
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	pop h		! hl = pointer to descriptor
+        pop d           ! de = index
+	mov a,e		! bc = index - lower bound
+	sub m
+	inx h
+	mov c,a
+	mov a,d
+	sbb m
+	inx h
+	mov b,a
+	push b		! first operand to multiply
+	inx h
+	inx h
+	mov c,m		! bc = size
+	inx h
+	mov b,m
+	push b		! second operand to multiply
+	call .mli2	! de = size * (index - lower bound)
+	pop h		! hl = base address
+	dad d		! hl = address of array[index]
+	xra a
+	mov a,b
+	rar
+	mov b,a
+	mov a,c
+	rar
+	mov c,a		! bc = word count
+	jnc 1f
+
+! if 1 byte array element only:
+	mov a,c		! trap if bc odd and <>1
+	ora b
+	cnz eoddz
+	pop d
+	mov m,e
+	jmp 2f
+
+1:	pop d
+	mov m,e
+	inx h
+	mov m,d
+	inx h
+	dcx b
+	mov a,b
+	ora c
+	jnz 1b
+
+2:	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr1
+	pchl

mach/i80/libem/sbi4.s

@@ -0,0 +1,37 @@
+.define .sbi4
+
+! Subtract two 32 bits signed or unsigned integers.
+! Expects operands on stack
+! Yields result on stack
+
+.sbi4:	
+	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	lxi h,0
+	dad sp		!now hl points to the first operand
+	mov d,h
+	mov e,l
+	inx d
+	inx d
+	inx d
+	inx d		!and de points to the second.
+	mvi b,4
+	xra a
+1:	ldax d
+	sbb m
+	stax d
+	inx d
+	inx h
+	dcr b
+	jnz 1b
+	sphl
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libem/set.s

@@ -0,0 +1,65 @@
+.define .set
+
+! Create set with one bit on
+! Expects in de-reg:	size of set to be created
+! Expects on stack:	bit number
+! Yields on stack:	resulting set
+
+.set:	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	mov a,e
+	rar
+	cc eoddz	! trap if size is odd
+	xchg		! hl = size of set
+	pop d		! de = bit number
+	mov a,e		! c = bit number in byte
+	ani 7
+	sta .areg	! save bit number in byte
+
+	mvi b,3		! de = byte number
+1:	xra a
+	mov a,d
+	rar
+	mov d,a
+	mov a,e
+	rar
+	mov e,a
+	dcr b
+	jnz 1b
+
+	mov a,l		! trap if bit number is too large
+	sub e
+	mov a,h
+	sbb d
+	cc eset
+
+	lxi b,0		! make empty set on stack
+1:	push b
+	dcx h
+	dcx h
+	mov a,l
+	ora h
+	jnz 1b
+
+	lxi h,0
+	dad sp
+	dad d		! hl points to byte that will contain a one
+	lda .areg
+	mov c,a		! c = bit number in byte
+	mvi a,1
+1:	dcr c
+	jm 2f
+	rlc
+	jmp 1b
+
+2:	mov m,a
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libem/set2.s

@@ -0,0 +1,36 @@
+.define .set2
+
+! Create 16 bits set with one bit on
+! Expects in de-reg:	bit number
+! Yields in de-reg:	resulting set
+
+.set2:	mov a,d		!trap if bit number >= 16
+	ora a
+	cnz eset
+	mov a,e
+	cpi 16
+	cnc eset
+
+	pop h
+	shld .retadr
+	mov a,e
+	ani 7
+	mov d,a
+	mvi a,1
+1:	dcr d
+	jm 2f
+	rlc
+	jmp 1b
+2:	mov d,a
+	mov a,e
+	ani 8
+	jnz 3f		! jump if bit 3 is set
+
+	mov e,d
+	mvi d,0
+	jmp 4f
+
+3:	mvi e,0
+
+4:	lhld .retadr
+	pchl

mach/i80/libem/sli2.s

@@ -0,0 +1,28 @@
+.define .sli2
+
+! Shift 16 bits integer left
+! Expects on stack:	number of shifts
+!			number to be shifted
+! Yields in de-reg:	result
+
+.sli2:	pop h
+	shld .retadr
+
+	pop d		!de = number of shifts
+	pop h		!hl= number to be shifted
+	mov a,d		!if de>15 return zero
+	ora a
+	jnz 2f
+	mov a,e
+	cpi 16
+	jnc 2f
+1:	dcr e
+	jm 3f
+	dad h
+	jmp 1b
+
+2:	lxi h,0
+3:	xchg		!result in de-registers
+
+	lhld .retadr
+	pchl

mach/i80/libem/sli4.s

@@ -0,0 +1,45 @@
+.define .sli4
+
+! Shift 32 bits integer left
+! Expects on stack:	number of shifts
+!			number to be shifted
+! Yields on stack:	result
+
+.sli4:
+	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	pop b		!number of shifts
+	pop d		!low-order bytes of number to be shifted
+	pop h		!high-order bytes
+	mov a,b		!if bc>=32 return 0
+	ora a
+	jnz 2f
+	mov a,c
+	cpi 32
+	jnc 2f
+1:	dcr c
+	jm 3f
+	dad h
+	xchg
+	dad h
+	xchg
+	jnc 1b
+	inx h
+	jmp 1b
+
+2:	lxi h,0
+	lxi d,0
+
+3:	push h
+	push d
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl
+

mach/i80/libem/sri2.s

@@ -0,0 +1,43 @@
+.define .sri2
+
+! Shift 16 bits signed or unsigned integer right
+! Expects in a-reg.:	1 if signed integer
+!			0 if unsigned integer
+! Expects on stack:	number of shifts
+!			number to be shifted
+! Yields in de-reg.:	result
+
+.sri2:	pop h
+	shld .retadr
+
+	pop h		!hl = number of shifts
+	pop d		!de = number to be shifted
+	mvi h,0
+	ora a
+	jz 1f		!jump if unsigned integer
+	mov a,d
+	ral
+	jnc 1f		!jump if positive signed integer
+	mvi h,255	!now h=1 if negative signed number, h=0 otherwise.
+
+1:	mov a,l		!return 0 or -1 if hl>=16
+	cpi 16
+	jnc 3f
+
+2:	dcr l
+	jm 4f
+	mov a,h
+	rar		!set carry bit correct
+	mov a,d
+	rar
+	mov d,a
+	mov a,e
+	rar
+	mov e,a
+	jmp 2b
+
+3:	mov d,h
+	mov e,h
+
+4:	lhld .retadr
+	pchl

mach/i80/libem/sri4.s

@@ -0,0 +1,61 @@
+.define .sri4
+
+! Shift 32 bits signed or unsigned integer right
+! Expects in a-reg.:	1 if signed integer
+!			0 if unsigned integer
+! Expects on stack:	number of shifts
+!			number to be shifted
+! Yields on stack:	result
+
+.sri4:	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	pop b		!number of shifts
+	pop d		!low-order bytes of number to be shifted
+	pop h		!high-order bytes
+	mvi b,0
+	ora a
+	jz 1f		!jump if unsigned integer
+	mov a,h
+	ral
+	jnc 1f		!jump if positive signed integer
+	mvi b,255
+
+1:	mov a,c
+	cpi 32
+	jnc 3f
+
+2:	dcr c
+	jm 4f
+	mov a,b
+	rar
+	mov a,h
+	rar
+	mov h,a
+	mov a,l
+	rar
+	mov l,a
+	mov a,d
+	rar
+	mov d,a
+	mov a,e
+	rar
+	mov e,a
+	jmp 2b
+
+3:	mov d,b
+	mov e,b
+	mov h,b
+	mov l,b
+
+4:	push h
+	push d
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libem/sti.s

@@ -0,0 +1,46 @@
+.define .sti
+
+! Store indirect
+! Expects on stack:	number of bytes to be stored
+!			bytes to be stored
+	
+.sti:	pop h
+	shld .retadr
+	mov l,c
+	mov h,b
+	shld .bcreg	! save bc
+
+	pop h
+	xra a
+	mov a,d
+	rar
+	mov d,a
+	mov a,e
+	rar
+	mov e,a		! de = word count
+	jnc 1f
+
+! if 1 byte array element only:
+	mov a,d		! trap if de odd and <>1
+	ora e
+	cnz eoddz
+	pop b
+	mov m,c
+	jmp 2f
+	
+1:	pop b
+	mov m,c
+	inx h
+	mov m,b
+	inx h
+	dcx d
+	mov a,d
+	ora e
+	jnz 1b
+
+2:	lhld .bcreg
+	mov c,l
+	mov b,h
+	lhld .retadr
+	pchl
+

mach/i80/libem/xor.s

@@ -0,0 +1,38 @@
+.define .xor
+
+
+! Any size exclusive-or.
+! Expects:	size in de-registers
+!		operands on stack
+! Yields:	result on stack
+
+.xor:	pop h
+	shld .retadr
+	mov h,b
+	mov l,c
+	shld .bcreg
+
+	lxi h,0
+	dad sp
+	mov c,l
+	mov b,h		!now bc points to top of first operand
+	dad d		!and hl points to top of second operand
+	push h		!this will be the new stackpointer
+1:	ldax b
+	xra m
+	mov m,a
+	inx h
+	inx b
+	dcx d
+	mov a,e
+	ora d
+	jnz 1b
+
+	pop h
+	sphl
+
+	lhld .bcreg
+	mov b,h
+	mov c,l
+	lhld .retadr
+	pchl

mach/i80/libmon/inn2.s

@@ -0,0 +1,38 @@
+.define .inn2
+
+! Bit test on 16 bits set
+! Expects on stack:	bit number
+!			set to be tested
+! Yields in de-registers:	0 if bit is reset or bit number out of range
+!				1 if bit is set
+
+.inn2:	pop h
+	shld .retadr
+
+	pop d		!bit number
+	pop h		!set to be tested
+	mov a,e
+	cpi 16
+	jnc 3f
+	cpi 8
+	jnc 1f
+	mov e,a
+	mov a,l		!l-reg contains the wanted bit
+	jmp 2f
+
+1:	sbi 8
+	mov e,a
+	mov a,h		!h-reg contains the wanted bit
+
+2:	dcr e
+	jm 4f
+	rar
+	jmp 2b
+
+3:	xra a		!return 0 if bit number out of range
+4:	ani 1
+	mov e,a
+	mvi d,0
+
+	lhld .retadr
+	pchl

mach/i80/libmon/prdec.s

@@ -0,0 +1,57 @@
+.define prdec
+
+! print hl-reg as a decimal number.
+
+prdec:	push h
+	push d
+	push b
+	push psw
+	lxi d,table
+	mvi b,4
+1:	call convert
+	ori 0x30
+	call putchar
+	dcr b
+	jnz 1b
+	mov a,l
+	ori 0x30
+	call putchar
+	pop psw
+	pop b
+	pop d
+	pop h
+	ret
+
+convert:
+	push b
+	mov b,h
+	mov c,l
+	xchg
+	mov e,m
+	inx h
+	mov d,m
+	inx h
+	push h		! save pointer to new value
+	mov h,b
+	mov l,c
+	mvi b,255
+1:	inr b
+	mov a,l
+	sub e
+	mov l,a
+	mov a,h
+	sbb d
+	mov h,a
+	jnc 1b
+	dad d
+	mov a,b
+	pop d
+	pop b
+	ret
+
+table:
+	.short	10000
+	.short	1000
+	.short  100
+	.short	10
+

mach/i80/libmon/prstring.s

@@ -0,0 +1,18 @@
+.define prstring
+
+! print a string of characters to the console
+! entry: de-reg points to the string
+! 	 string terminator is 0x00
+! exit:	 de-reg points to string terminator
+
+prstring:
+	push psw
+1:	ldax d
+	ora a
+	jz 2f
+	call putchar
+	inx d
+	jmp 1b
+2:	pop psw
+	ret
+

mach/i80/libmon/tail.s

@@ -0,0 +1,7 @@
+.define endtext, enddata, endbss
+.text
+endtext:	.align 2
+.data
+enddata:	.align 2
+.bss
+endbss:		.align 2

mach/i80/libmon/trp.s

@@ -0,0 +1,218 @@
+.define .trp
+.define earray, erange, eset, eiovfl, efovfl, efunfl, eidivz, eidivz
+.define efdivz, eiund, efund, econv, estack, eheap, eillins, eoddz
+.define ecase, ememflt, ebadptr, ebadpc, ebadlae, ebadmon, ebadlin, ebadgto
+.define eunimpl
+
+! Trap routine
+! Expects trap number on stack.
+! Just returns if trap has to be ignored.
+! Otherwise it calls a user-defined trap handler if provided.
+! When no user-defined trap handler is provided or when the user-defined
+! trap handler causes a new trap, a message is printed
+! and control is returned to the monitor.
+
+	EARRAY	=  0
+	ERANGE	=  1
+	ESET	=  2
+	EIOVFL	=  3
+	EFOVFL	=  4
+	EFUNFL	=  5
+	EIDIVZ	=  6
+	EFDIVZ	=  7
+	EIUND	=  8
+	EFUND	=  9
+	ECONV	= 10
+	ESTACK  = 16
+	EHEAP	= 17
+	EILLINS = 18
+	EODDZ	= 19
+	ECASE	= 20
+	EMEMFLT	= 21
+	EBADPTR = 22
+	EBADPC  = 23
+	EBADLAE = 24
+	EBADMON = 25
+	EBADLIN = 26
+	EBADGTO = 27
+	EUNIMPL = 63		! unimplemented em-instruction called
+
+earray:	lxi h,EARRAY
+	push h
+	call .trp
+	ret
+
+erange:	lxi h,ERANGE
+	push h
+	call .trp
+	ret
+
+eset:	lxi h,ESET
+	push h
+	call .trp
+	ret
+
+eiovfl:	lxi h,EIOVFL
+	push h
+	call .trp
+	ret
+
+efovfl:	lxi h,EFOVFL
+	push h
+	call .trp
+	ret
+
+efunfl:	lxi h,EFUNFL
+	push h
+	call .trp
+	ret
+
+eidivz:	lxi h,EIDIVZ
+	push h
+	call .trp
+	ret
+
+efdivz:	lxi h,EFDIVZ
+	push h
+	call .trp
+	ret
+
+eiund:	lxi h,EIUND
+	push h
+	call .trp
+	ret
+
+efund:	lxi h,EFUND
+	push h
+	call .trp
+	ret
+
+econv:	lxi h,ECONV
+	push h
+	call .trp
+	ret
+
+estack:	lxi h,ESTACK
+	push h
+	call .trp
+	ret
+
+eheap:	lxi h,EHEAP
+	push h
+	call .trp
+	ret
+
+eillins:lxi h,EILLINS
+	push h
+	call .trp
+	ret
+
+eoddz:	lxi h,EODDZ
+	push h
+	call .trp
+	ret
+
+ecase:	lxi h,ECASE
+	push h
+	call .trp
+	ret
+
+ememflt:lxi h,EMEMFLT
+	push h
+	call .trp
+	ret
+
+ebadptr:lxi h,EBADPTR
+	push h
+	call .trp
+	ret
+
+ebadpc:	lxi h,EBADPC
+	push h
+	call .trp
+	ret
+
+ebadlae:lxi h,EBADLAE
+	push h
+	call .trp
+	ret
+
+ebadmon:lxi h,EBADMON
+	push h
+	call .trp
+	ret
+
+ebadlin:lxi h,EBADLIN
+	push h
+	call .trp
+	ret
+
+ebadgto:lxi h,EBADGTO
+	push h
+	call .trp
+	ret
+
+eunimpl:lxi h,EUNIMPL
+	push h
+	call .trp
+	ret
+
+.trp:
+	pop h
+	xthl
+	push h			! trap number and return address exchanged
+	mov a,l
+	cpi 16
+	jnc 3f			! jump if trap cannot be ignored
+
+! check if trap has to be ignored
+	xchg			! de = trap number
+	lhld .ignmask
+	push h			! hl = set to be tested
+	push d
+	call .inn2		! de = 1 if bit is set, 0 otherwise
+	mov a,e
+	rar
+	jnc 3f			! jump if trap should not be ignored
+	pop h			! remove trap number
+	ret			! OGEN DICHT EN ... SPRING!!!
+
+3:
+	lhld .trapproc		! user defined trap handler?
+	mov a,l
+	ora h
+	jz 1f			! jump if there was not
+	xra a
+	sta .trapproc		! .trapproc := 0
+	sta .trapproc+1
+	lxi d,2f		
+	push d
+	pchl			! call user defined trap handler
+2:
+	pop d
+	ret
+1:
+	mvi a,0x0A		!newline
+	call putchar
+	lxi d,text1
+	call prstring
+	pop h
+	call prdec
+	lxi d,text2
+	call prstring
+	lhld hol0
+	call prdec
+	lxi d,text3
+	call prstring
+	lhld hol0+4
+	xchg
+	call prstring
+	mvi a,0x0A		!newline
+	call putchar
+	jmp .stop
+
+
+text1:	.asciz "trap number "
+text2:	.asciz "\nline "
+text3:	.asciz " of file "
+