-ARCHIVE- $8087.a86 6374
;	floating point routines

	pagewidth	80

;	to assemble this file you need the following file supplied by
;	Digital research with V1.1 of cpm-86.  HOWEVER it needs a 
;	'wait' command (db 09bh) added as the first instruction of each
;	codemacro before you use it.  See the intel doc for more data

;	the following code macro was wrong in the library

codemacro	FCOMPP
	db	09bh
	dw	0d9deh
endm

	include	8087.lib

DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

;	negate a number

dollar_dneg:

	mov	bx,sp		;get base address in stack
	test	8[bx],07ff0h	;is number zero ?
	jz	dneg01		;yes, don't negate
	xor	byte ptr 9[bx],080h	;and negate it
dneg01:
	ret

;	convert a double to long
;	leaving the double on the stack
;	and the long in ax and dx
;	must not destroy si

dollar_lcvtd:

	finit			;precaution for now
	push	bp
	mov	bp,sp
	fld	word ptr 4[bp]	;load the value
	mov	ax,7ffh
	push	ax
	push	ax
	fldcw	word ptr 0fffch[bp]	;no rounding
	fistp	byte ptr 0fffch[bp]
	fwait
	pop	ax
	pop	dx		;thats our result
	pop	bp
	ret			;all done

;	subtract the double float on top of stack from next double

;	entry	two doubles on stack
;	exit	difference on stack
;	must preserv si

dollar_dsub:

	finit			;precaution for now
	push	bp
	mov	bp,sp
	fld	word ptr 12[bp]
	fld	word ptr 4[bp]
	fsub
	fstp	word ptr 12[bp]
	fwait
	pop	bp
	ret	8

;	add two double float numbers and return result on stack

;	entry	two doubles on stack
;	exit 	the sum is on the stack
;	must preserv si

dollar_dadd:

	finit			;precaution for now
	push	bp
	mov	bp,sp
	fld	word ptr 12[bp]
	fld	word ptr 4[bp]
	fadd
	fstp	word ptr 12[bp]
	fwait
	pop	bp
	ret	8

;	convert signed long to double
;	entry	long on stack

dollar_dcvtl:

	finit			;precaution for now
	pop	ax
	sub	sp,4
	push	ax
	push	bp
	mov	bp,sp
	fild	byte ptr 8[bp]
	jmps	dcvti00		;do the rest

;	convert signed integer to double
;	entry	integer on stack

dollar_dcvti:

	finit			;precaution for now
	pop	ax
	sub	sp,6
	push	ax
	push	bp
	mov	bp,sp
	fild	word ptr 10[bp]
dcvti00:
	fstp	word ptr 4[bp]
	pop	bp
	fwait
	ret

;	convert an unsigned long to double
;	entry	number on the stack

dollar_dcvtul:

	finit			;precaution for now
	pop	cx
	pop	ax
	pop	dx
	jmps	dcvtui00		;do the rest

;	convert unsigned integer to double
;	entry	integer on stack

dollar_dcvtui:

	finit			;precaution for now
	pop	cx
	pop	ax
	xor	dx,dx			;sign extend it
dcvtui00:
	xor	bx,bx
	push	bx
	push	bx
	push	dx
	push	ax
	push	cx
	push	bp
	mov	bp,sp
	fildli	word ptr 4[bp]
	fstp	word ptr 4[bp]
	fwait
	pop	bp
	ret

;	multiply two double float numbers and return result on stack

;	entry	two doubles on stack
;	exit 	the product is on the stack
;	must preserv di


dollar_dmul:

	finit			;precaution for now
	push	bp
	mov	bp,sp
	fld	word ptr 4[bp]
	fld	word ptr 12[bp]
	fmul
	fstp	word ptr 12[bp]
	fwait
	pop	bp
	ret	8

;	divide two double float numbers and return result on stack

;	entry	two doubles on stack
;	exit 	the result is on the stack
;	must preserv di


dollar_ddiv:

	finit			;precaution for now
	push	bp
	mov	bp,sp
	fld	word ptr 12[bp]
	fld	word ptr 4[bp]
	fdiv
	fstp	word ptr 12[bp]
	pop	bp
	fwait
	ret	8

;	double precision floating point comparison routines

dollar_dceq:			;return true if equal
	mov	dl,2
	jmps	dcomp

dollar_dcne:			;return true if not equal
	mov	dl,5
	jmps	dcomp

dollar_dcls:			;return true if less
	mov	dl,1
	jmps	dcomp

dollar_dcle:			;return true if less or equal
	mov	dl,3
	jmps	dcomp

dollar_dcgr:			;return true if greater
	mov	dl,4
	jmps	dcomp

dollar_dcge:			;return true if greater or equal
	mov	dl,6
;	jmps	dcomp

;	actual routine to do comparison of two doubles on stack

dcomp:
	finit			;precaution for now
	push	bp
	mov	bp,sp
	fld	word ptr 12[bp]
	fld	word ptr 4[bp]
	fcompp
	fstsw	word ptr 4[bp]
	fwait
	mov	ah,5[bp]
	sahf
	jb	dcomp02
	je	dcomp01
	sar	dl,1
dcomp01:
	sar	dl,1
dcomp02:
	xchg	al,dl
	and	ax,1
	mov	18[bp],ax
	pop	bp
	ret	14

;	load a real to the stack

;	entry	address of real in reg si
;	exit	double on stack
;	must preserv si

dollar_fload:

	finit			;precaution for now
	fld	byte ptr [si]		;load the value
	jmps	dload1			;all common processing

;	load a double to the stack

;	entry	address of double in reg si
;	exit	double on stack
;	must preserv si

dollar_dload:

	finit			;precaution for now
	fld	word ptr [si]		;load the value
dload1:
	pop	ax			;get the return address
	sub	sp,8			;make some space
	push	ax
	push	bp
	mov	bp,sp
	fstp	word ptr 4[bp]		;stack the value
	pop	bp
	fwait				;wait for it
	ret				;all done

;	store a float from the stack

;	entry	di, address to store float
;	exit	float stored and still on stack (as a double)


dollar_fstore:

	finit			;precaution for now
	push	bp
	mov	bp,sp
	fld	word ptr 4[bp]		;get the value
	fstp	byte ptr [di]		;and store it
	pop	bp
	fwait
	ret

;	store a double from the stack

;	entry	di, addres to store double
;	exit	stored and also on the stack

dollar_dstore:

	finit			;precaution for now
	push	bp
	mov	bp,sp
	fld	word ptr 4[bp]		;get the value
	fstp	word ptr [di]		;and store it
	pop	bp
	fwait
	ret

	eseg

	dw	dollar_dload
	db	DEFCGBL,'$dload',0
	dw	dollar_dstore
	db	DEFCGBL,'$dstore',0
	dw	dollar_fload
	db	DEFCGBL,'$fload',0
	dw	dollar_fstore
	db	DEFCGBL,'$fstore',0

	dw	dollar_dneg
	db	DEFCGBL,'$dneg',0
	dw	dollar_lcvtd
	db	DEFCGBL,'$lcvtd',0
	dw	dollar_dsub
	db	DEFCGBL,'$dsub',0
	dw	dollar_dadd
	db	DEFCGBL,'$dadd',0
	dw	dollar_dcvtl
	db	DEFCGBL,'$dcvtl',0
	dw	dollar_dcvti
	db	DEFCGBL,'$dcvti',0
	dw	dollar_dcvtul
	db	DEFCGBL,'$dcvtul',0
	dw	dollar_dcvtui
	db	DEFCGBL,'$dcvtui',0
	dw	dollar_dmul
	db	DEFCGBL,'$dmul',0
	dw	dollar_ddiv
	db	DEFCGBL,'$ddiv',0

	dw	dollar_dceq
	db	DEFCGBL,'$dceq',0
	dw	dollar_dcne
	db	DEFCGBL,'$dcne',0
	dw	dollar_dcls
	db	DEFCGBL,'$dcls',0
	dw	dollar_dcle
	db	DEFCGBL,'$dcle',0
	dw	dollar_dcgr
	db	DEFCGBL,'$dcgr',0
	dw	dollar_dcge
	db	DEFCGBL,'$dcge',0

	dw	0,0

	end
-ARCHIVE- $bfext.a86 684
;	bit field extract

;	entry	word containing bit field is on the stack

;	exit	extracted value is on the stack



DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code


	cseg

dollar_bfext:

	pop	bx			;get the return address
	pop	ax			;get word containing bits
	mov	cl,cs:[bx]		;get the shift count
	inc	bx
	shr	ax,cl			;do the shift
	and	ax,cs:[bx]		;keep the bits we want
	inc	bx
	inc	bx
	push	ax
	push	bx
	ret				;all done

	eseg

	dw	dollar_bfext
	db	DEFCGBL,'$bfext',0
	dw	0,0

	end
-ARCHIVE- $bfinss.a86 1015
;	bit field insert and store

;	entry	word containing bit field is on the stack
;		reg si contains the address to store result

;	exit	value stored, reg ax unchanged



DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code


	cseg

dollar_bfinss:

	push	ax			;save the field value
	push	bp			;save the frame pointer
	mov	bp,sp			;get frame pointer
	mov	bx,4[bp]		;get the return address
	mov	cl,cs:[bx]		;get the shift count
	inc	bx
	shl	ax,cl			;do the shift
	mov	cx,cs:[bx]		;get the bit mask
	inc	bx
	inc	bx
	mov	4[bp],bx		;restore the return address
	and	ax,cx			;keep the bits we want
	not	cx			;keep the other bits
	and	cx,[si]			;the source data
	or	cx,ax			;the field is back
	mov	[si],cx			;put it back
	pop	bp;
	pop	ax
	ret				;all done

	eseg

	dw	dollar_bfinss
	db	DEFCGBL,'$bfinss',0
	dw	0,0

	end
-ARCHIVE- $floatpp.a86 15460
;	floating point routines


DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

;	negate a number

dollar_dneg:

	mov	bx,sp		;get base address in stack
	test	8[bx],07ff0h	;is number zero ?
	jz	dneg01		;yes, don't negate
	xor	byte ptr 9[bx],080h	;and negate it
dneg01:
	ret

;	convert a double to long
;	leaving the double on the stack
;	and the long in ax and dx

dollar_lcvtd:

	push	si		;have to save si
	push	bp
	mov	bp,sp
	sub	sp,10		;working space
	mov	cx,4		;words
	lea	si,6[bp]	;source
	mov	di,sp		;destination
	call	msw		;perform move string words
	mov	ax,-4[bp]	;get sign of number
	and	ax,8000h
	xor	-4[bp],ax	;make number positive
	mov	-2[bp],ax	;and save for exit
	mov	ax,4330h	;unnormalise number
	push	ax
	xor	ax,ax
	push	ax
	push	ax
	push	ax
	call	dollar_dadd	;do it
	mov	ax,-10[bp]
	mov	dx,-8[bp]
	mov	bx,-2[bp]	;was it negative
	or	bx,bx
	jz	lcd01		;nope
	neg	dx
	neg	ax
	sbb	dx,0
lcd01:
	mov	sp,bp
	pop	bp
	pop 	si		;restore si
	ret			;all done


;	subtract the double float on top of stack from next double

;	entry	two doubles on stack
;	exit	difference on stack
;	must preserv si

dollar_dsub:

	mov	bx,sp		;get stack address
	mov	ax,08000h
	xor	16[bx],ax	;invert sign to subtract


;	add two double float numbers and return result on stack

;	entry	two doubles on stack
;	exit 	the sum is on the stack
;	must preserv si

dollar_dadd:

	push	si		;save it for exit
	push	bp
	mov	bp,sp		;establish frame pointer
	mov	ax,07ff0h
	test	ax,12[bp]	;top operand zero ?
	jz	das00		;yes, just exit
	test	ax,20[bp]	;or the other
	jnz	das01		;nope

	mov	cx,4		;words
	lea	si,6[bp]	;source
	lea	di,14[bp]
	call	msw		;perform move string words
das00:
	jmp	das99		;all done
das01:
	sub	sp,24		;room for temps
	lea	si,6[bp]	;unpack the top operand
	mov	di,sp
	call	unpack
	lea	si,14[bp]
	lea	di,-12[bp]
	call	unpack		;second operand

	mov	si,sp		;prepare to scale
	lea	di,-12[bp]
	mov	ax,2[si]
	sub	ax,2[di]
	jz	das10		;no scaling required
	jns	das02		;no reverse reqd
	xchg	di,si		;exchange registers
	neg	ax		;restore exponent in register
das02:
	add	2[di],ax	;adjust exponent
	mov	cl,4		;make exponent an integer
	shr	ax,cl
	mov	cx,ax		;get the shift count
das03:
	mov	bx,6		;offset and count
	clc
das04:
	rcr	word ptr 4[bx+di],1
	dec	bx
	dec	bx
	jns	das04		;shift it down
	loop	das03		;for all bits
das10:
	mov	cx,4		;loop count
	mov	bx,cx		;initialise offset
	mov	ax,[di]		;add or subtract ?
	xor	ax,[si]
	js	das12		;it is subtract
	clc
das11:
	mov	ax,[bx+si]	;get a word
	adc	[bx+di],ax
	inc	bx		;add 2 without changing carry
	inc	bx
	loop	das11
	jmp	das20
das12:
	clc
das13:
	mov	ax,[bx+si]	;get a word
	sbb	[bx+di],ax	;do subtract
	inc	bx		;add 2 without changing carry
	inc	bx
	loop	das13

	mov	ax,10[di]	;is result negative ?
	or	ax,ax
	jns	das20		;nope
	xor	ax,ax
	mov	cx,4
	mov	bx,cx
	stc			;set carry
das14:
	not	word ptr [bx+di];negate word 
	adc	[bx+di],ax	;the hard way
	inc	bx
	inc	bx
	loop	das14
	mov	ah,080h
	xor	[di],ax		;and reverse sign
das20:				;pack the result
	push	di
	call	normalize	;normalize the result
	pop	si
	lea	di,14[bp]	;destination address
	call	repack		;pack the result

das99:
	test	20[bp],07ff0h	;is result zero
	jnz	das999		;nope
	mov	word ptr 20[bp],0	;set result to zero
das999:
	mov	sp,bp
	pop	bp
	pop	si		;restore si
	ret	8		;all done


;	convert an unsigned long to double
;	entry	number on the stack

dollar_dcvtul:

	pop	si
	pop	ax
	pop	dx
	jmps	dcvtui00		;do the rest

;	convert unsigned integer to double
;	entry	integer on stack

dollar_dcvtui:

	pop	si		;get return address
	pop	ax		;get integer
	xor	dx,dx
dcvtui00:
	xor	bx,bx
	push	bx
	push	bx
	jmps	dcvti01

;	convert signed long to double
;	entry	long on stack

dollar_dcvtl:

	pop	si
	pop	ax
	pop	dx
	jmps	dcvti00		;do the rest

;	convert signed integer to double
;	entry	integer on stack

dollar_dcvti:

	pop	si		;get return address
	pop	ax		;get integer
	cwd			;sign extend it
dcvti00:
	xor	bx,bx
	push	bx
	push	bx
	or	dx,dx		;is it negative
	jns	dcvti01		;nope
	neg	dx
	neg	ax
	sbb	dx,0
	or	bh,080h		;set sign
dcvti01:
	push	dx
	push	ax
	mov	ax,04330h	;basic exponent
	push	ax
	push	bx		;sign
	mov	di,sp
	push	si
	push	di
	call	normalize
	pop	si
	mov	di,si
	add	di,4
	call	repack
	ret	4


;	subroutine to move a string of words
;	entry	cx, number of words to move
;		si, source address relative to ds
;		di, dest address rel to ds

msw:
	cld			;set the direction flag
	mov	ax,ds
	mov	es,ax		;set the es register
	rep movs	ax,ax
	ret


;	subroutine to unpack a double
;	entry	si, address of double
;		di, where to unpack it

unpack:
	push	di
	mov	cx,4		;number of words to move
	add	di,cx		;correct offset
	call	msw
	pop	di		;thats the data copied
	mov	ax,10[di]	;get most significant word
	mov	bx,ax		;copy it
	and	ax,07ff0h	;get exponent
	mov	2[di],ax	;save it
	mov	ax,bx
	and	ax,08000h	;get sign
	mov	[di],ax		;save it too
	and	bx,0fh
	or	bx,010h		;set significant bit of mantissa
	mov	10[di],bx
	ret


;	subroutine to repack a double
;	entry	si, source of data
;		di, destination address

repack:

	push	si
	push	di
	mov	cx,4
	add	si,cx
	call	msw
	pop	di
	pop	si
	mov	ax,10[si]
	and	ax,0fh
	or	ax,[si]
	or	ax,2[si]
	mov	6[di],ax
	ret


;	normalize an unpacked double

;	entry	di, address of unpcaked number to be normalised


normalize:

	mov	ax,4[di]	;see if zero
	or	ax,6[di]
	or	ax,8[di]
	or	ax,10[di]
	jnz	norf10
	mov	[di],ax		;set it all to zero
	mov	2[di],ax
	jmp	norf99		;all done
norf10:
	mov	bx,010h		;adjust exponent constant
	mov	ax,0ffe0h	;see if too large
norf11:
	test	ax,10[di]	;get the most significant word
	jz	norf20		;nope
	shr	word ptr 10[di],1	;shift it right
	rcr	word ptr 8[di],1
	rcr	word ptr 6[di],1
	rcr	word ptr 4[di],1
	add	word ptr 2[di],bx
	jmp	norf11
norf20:
	mov	ax,010h
norf21:
	test	ax,10[di]
	jnz	norf99		;all done
	shl	word ptr 4[di],1
	rcl	word ptr 6[di],1
	rcl	word ptr 8[di],1
	rcl	word ptr 10[di],1
	sub	2[di],bx		;adjust exponent
	jmp	norf21
norf99:
	ret



;	multiply two double float numbers and return result on stack

;	entry	two doubles on stack
;	exit 	the product is on the stack
;	must preserv di


dollar_dmul:

	push	di		;save di for posterity
	push	bp
	mov	bp,sp		;establish frame pointer
	mov	ax,07ff0h
	test	ax,20[bp]	;second operand zero ?
	jz	mul00		;yes, just exit
	test	ax,12[bp]	;or the other
	jnz	mul01		;nope

	mov	cx,4		;words
	lea	si,6[bp]	;source
	lea	di,14[bp]
	call	msw		;perform move string words
mul00:
	jmp	mul99		;all done
mul01:
	sub	sp,24		;room for temps
	lea	si,6[bp]	;unpack the top operand
	mov	di,sp
	call	unpack
	lea	si,14[bp]
	lea	di,-12[bp]
	call	unpack		;second operand

	xor	bx,bx		;set up working area for multiply
	push	bx
	push	bx
	push	bx
	push	bx
	push	bx
	push	bx
	mov	si,sp		;create base for operation
	call	mulxx		;calc reloaction address
mulxx:
	pop	di
;WARNING--FOLLOWING TWO INSTRUCTIONS CANNOT BE COMBINED--BUG IN ASM86
	add	di,offset multab
	sub	di,offset mulxx	;address of mult table
;WARNING--SEE ABOVE
	mov	cx,13		;number of entries in table
mul02:
	mov	bl,cs:[di]	;get offset of operand 1
	mov	ax,[bx+si]	;get it
	or	ax,ax		;if zero, fast continue
	jz	mul04
	mov	bl,cs:1[di]	;get offset of other operand
	mul	word ptr [bx+si]	;unsigned multiply
	mov	bl,cs:2[di]	;get result address
	add	[bx+si],ax	;add in result
	inc	bx
	inc	bx
	adc	[bx+si],dx	;upper half
	jae	mul04		;all carry done (carry == 0)
mul03:
	inc	bx
	inc	bx
	inc	word ptr [bx+si]	;do the carry
	jz	mul03		;still more carry
mul04:
	add	di,3		;to next frame
	loop	mul02		;do all words
	mov	ax,-10[bp]	;calc the result exponent
	sub	ax,04030h	;adjust for exponent and shift in mult routine
	add	ax,-22[bp]
	mov	-34[bp],ax	;and store it
	mov	ax,-12[bp]	;get sign of result
	xor	ax,-24[bp]
	mov	-36[bp],ax

	mov	di,sp
	call	normalize	;normalize the result
	mov	si,sp
	lea	di,14[bp]	;destination address
	call	repack		;pack the result

mul99:
	mov	sp,bp
	pop	bp
	pop	di		;restore di
	ret	8		;all done


;	multiplication table required above

multab:
	db	+24+10,+12+10,+10
	db	+24+8,+12+10,+8
	db	+24+10,+12+8,+8
	db	+24+8,+12+8,+6
	db	+24+6,+12+10,+6
	db	+24+6,+12+8,+4
	db	+24+6,+12+6,+2
	db	+24+10,+12+6,+6
	db	+24+8,+12+6,+4
	db	+24+4,+12+10,+4
	db	+24+4,+12+8,+2
	db	+24+10,+12+4,+4
	db	+24+8,+12+4,+2



;	divide two double float numbers and return result on stack

;	entry	two doubles on stack
;	exit 	the result is on the stack
;	must preserv di


dollar_ddiv:

	push	di		;save di for posterity
	push	bp
	mov	bp,sp		;establish frame pointer
	mov	ax,07ff0h
	test	ax,12[bp]	;second operand zero ?
	jnz	div000		;nope, test other operand
	mov	cx,4
	lea	si,6[bp]
	lea	di,14[bp]
	call	msw
	jmps	div00
div000:
	test	ax,20[bp]	;or the other
	jnz	div01		;nope

	mov	ax,0ffffh	;set overflow with large number
	mov	14[bp],ax
	mov	16[bp],ax
	mov	18[bp],ax
	and	ah,07fh
	or	20[bp],ax	;preserve sign
div00:
	jmp	div99		;all done
div01:
	sub	sp,12
	lea	si,6[bp]	;get operand
	mov	di,sp
	call	unpack
	pop	bx		;save sign
	pop	cx		;and exponent
	xor	ax,ax		;some scratch space
	push	ax
	push	ax
	push	ax
	push	ax
	push	cx
	push	bx		;put it back

	sub	sp,12		;room for other temp
	lea	si,14[bp]	;unpack the top operand
	mov	di,sp
	call	unpack

	mov	cx,53		;number of bits to divide
div02:
	push	cx		;save bit count
	mov	cx,4		;number of words to compare
	lea	si,-22[bp]
	lea	di,-2[bp]
div03:
	mov	ax,[si]		;get divisor word
	cmp	ax,[di]		;compare to dividend
	jb	div04		;yes it divides
	ja	div06		;no it does not
	dec	si		;a solid maybe
	dec	si
	dec	di
	dec	di
	loop	div03
div04:				;yes it does
	mov	cx,4
	lea	si,-28[bp]
	lea	di,-8[bp]
	clc
div05:
	mov	ax,[si]
	sbb	[di],ax
	inc	si
	inc	si
	inc	di
	inc	di
	loop	div05
	stc
div06:
	mov	cx,8		;number of words to shift
	lea	si,-16[bp]
div07:
	rcl	word ptr [si],1
	inc	si
	inc	si
	loop	div07

	pop	cx
	loop	div02		;next bit

	mov	ax,-30[bp]	;calc the result exponent
	sub	ax,03ff0h	;adjust for exponent and shift in div routine
	sub	-18[bp],ax	;store adjusted exponent

	mov	ax,-32[bp]	;get sign of result
	xor	-20[bp],ax	;and save it

	lea	di,-20[bp]
	call	normalize	;normalize the result
	lea	si,-20[bp]
	lea	di,14[bp]	;destination address
	call	repack		;pack the result

div99:
	mov	sp,bp
	pop	bp
	pop	di		;restore di
	ret	8		;all done

;	double precision floating point comparison routines

dollar_dceq:			;return true if equal
	mov	ax,202H
	jmps	dcomp		;do internal comparison routine

dollar_dcne:			;return true if not equal
	mov	ax,505H
	jmps	dcomp		;do internal comparison routine

dollar_dcls:			;return true if less
	mov	ax,401H
	jmps	dcomp		;do internal comparison routine

dollar_dcle:			;return true if less or equal
	mov	ax,603H
	jmps	dcomp		;do internal comparison routine

dollar_dcgr:			;return true if greater
	mov	ax,104H
	jmps	dcomp		;do internal comparison routine

dollar_dcge:			;return true if greater or equal
	mov	ax,306H
;	jmps	dcomp		;do internal comparison routine


;	actual routine to do comparison of two doubles on stack

dcomp:
	mov	bx,sp		;get a stack pointer
	mov	ch,9[bx]
	mov	dh,17[bx]
	mov	cl,ch
	or	cl,dh
	jns	dcomp00		;both positive, continue
	mov	cl,ch
	xor	cl,dh
	jns	dcomp000	;both negative
	cmp	dh,ch
	jge	dcomp031
	jmps	dcomp04
dcomp000:
	mov	al,ah		;invert test conditions
dcomp00:
	mov	cx,4
dcomp01:
	mov	dx,16[bx]
	cmp	8[bx],dx
	jnz	dcomp03
	dec	bx
	dec	bx
	loop	dcomp01

dcomp02:			;numbers are equal, set result
	and	al,2
	jz	dcomp99		;false
	jmps	dcomp98		;true
dcomp03:			;numbers are not equal
	ja	dcomp04		;greater
dcomp031:
	and	al,1
	jz	dcomp99
	jmps	dcomp98		;true
dcomp04:
	and	al,4
	jz	dcomp99
;	jmps	dcomp98

dcomp98:			;set true
	mov	al,1
dcomp99:
	xor	ah,ah		;clear the top byte
	or	ax,ax		;set the flags
	mov	bx,sp
	mov	16[bx],ax	;result to stack
	ret	14		;dump the rest

;	load a double to the stack

;	entry	address of double in reg si
;	exit	double on stack
;	must preserv si

dollar_dload:

	pop	di			;return address to di
	push	word ptr 6[si]		;put exponent
	push	word ptr 4[si]
	push	word ptr 2[si]
	push	word ptr [si]		;least significant word
	jmp	di			;return

;	store a double from the stack

;	entry	di, addres to store double
;	exit	stored and also on the stack

dollar_dstore:

	pop	si			;get return address
	pop	ax
	pop	dx
	pop	bx
	pop	cx
	mov	[di],ax
	mov	2[di],dx
	mov	4[di],bx
	mov	6[di],cx
	push	cx
	push	bx
	push	dx
	push	ax
	jmp	si			;return

;	load a real to the stack

;	entry	address of real in reg si
;	exit	double on stack
;	must preserv si


dollar_fload:

	pop	di			;get return address
	mov	ax,2[si]		;get exponent
	mov	dx,[si]			;low word
	xor	bx,bx			;zero it
	mov	cx,3			;number of bits to shift
ldr01:	sar	ax,1
	rcr	dx,1
	rcr	bx,1
	loop	ldr01			;three times
	and	ax,08fffh		;clear exponent bits
	jnz	ldr02			;it's real
	push	ax
	push	ax
	push	ax
	jmps	ldr03			;final and return
ldr02:
	add	ax,(3ffh-7fh) shl 4	;adjust exponent
	push	ax
	push	dx
	push	bx
	xor	ax,ax
ldr03:
	push	ax
	jmp	di			;return


;	store a float from the stack

;	entry	di, address to store float
;	exit	float stored and still on stack (as a double)


dollar_fstore:

	mov	si,sp			;make pointer to stack
	mov	ax,8[si]		;get exponent part
	and	ax,07ff0h		;only
	sub	ax,3ff0h		;remove bias
	cmp	ax,07f0h
	jg	fst10			;too large to save
	cmp	ax,-07f0h
	jl	fst20			;too small to save
	mov	ax,8[si]		;get exponent part
	sub	ax,3ff0h-7f0h		;reduce exponent range
	jns	fst01			;not negative
	or	ah,10h			;set new sign bit
fst01:
	mov	dx,6[si]
	mov	bx,4[si]
	mov	cx,3			;shift it left
fst02:
	shl	bx,1
	rcl	dx,1
	rcl	ax,1
	loop	fst02
	jmps	fst99			;and out we go
fst10:
	mov	ax,8[si]		;keep sign
	or	ax,7fffh
	mov	dx,0ffffh		;largest possable number
	jmps	fst99
fst20:
	xor	ax,ax			;result is zero (really underflow)
	cbw
fst99:
	mov	[di],dx			;low order word
	mov	2[di],ax		;high order word
	ret

	eseg

	dw	dollar_dload
	db	DEFCGBL,'$dload',0
	dw	dollar_dstore
	db	DEFCGBL,'$dstore',0
	dw	dollar_fload
	db	DEFCGBL,'$fload',0
	dw	dollar_fstore
	db	DEFCGBL,'$fstore',0

	dw	dollar_dneg
	db	DEFCGBL,'$dneg',0
	dw	dollar_lcvtd
	db	DEFCGBL,'$lcvtd',0
	dw	dollar_dsub
	db	DEFCGBL,'$dsub',0
	dw	dollar_dadd
	db	DEFCGBL,'$dadd',0
	dw	dollar_dcvtl
	db	DEFCGBL,'$dcvtl',0
	dw	dollar_dcvti
	db	DEFCGBL,'$dcvti',0
	dw	dollar_dcvtul
	db	DEFCGBL,'$dcvtul',0
	dw	dollar_dcvtui
	db	DEFCGBL,'$dcvtui',0
	dw	dollar_dmul
	db	DEFCGBL,'$dmul',0
	dw	dollar_ddiv
	db	DEFCGBL,'$ddiv',0

	dw	dollar_dceq
	db	DEFCGBL,'$dceq',0
	dw	dollar_dcne
	db	DEFCGBL,'$dcne',0
	dw	dollar_dcls
	db	DEFCGBL,'$dcls',0
	dw	dollar_dcle
	db	DEFCGBL,'$dcle',0
	dw	dollar_dcgr
	db	DEFCGBL,'$dcgr',0
	dw	dollar_dcge
	db	DEFCGBL,'$dcge',0

	dw	0,0

	end
-ARCHIVE- $iswitch.a86 868
;	code to process an integer switch statement

;	entry	0, return address
;		1, value to compare


DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code


	cseg

dollar_iswitch:

	pop	di		;get address of data
	pop	ax		;and the value to check
	push	es		;save the register
	mov	bx,cs		;get code seg value
	mov	es,bx		;all set up
	mov	cx,es:[di]	;number of entries
	mov	bx,cx		;for exit
	sal	bx,1
	add	di,bx		;the last shall be first
	inc	cx		;for the default
	std			;set the direction flag
	repne scas ax		;compare it
	pop	es		;restore register es
	add	di,4
	add	di,bx
	add	di,cs:[di]
	jmp	di		;go to it

	eseg

	dw	dollar_iswitch
	db	DEFCGBL,'$iswitch',0
	dw	0,0

	end

-ARCHIVE- $ldivmod.a86 1771
;	does division of two signed longs


DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code


	cseg

dollar_lsdiv:

	xor	al,al			;signed div
	jmps	dm01

dollar_ludiv:

	mov	al,1			;unsigned div
	jmps	dm01

dollar_lsmod:

	mov	al,2			;signed mod
	jmps	dm01

dollar_lumod:

	mov	al,3

dm01:

	push	bp
	mov	bp,sp
	push	di			;save for caller
	cbw				;zero top byte
	xchg	ax,bx			;save flags

	mov	ax,4[bp]
	mov	dx,6[bp]
	mov	si,8[bp]
	mov	di,10[bp]

	test	bl,1			;signed ?
	jnz	dm03			;nope
	or	dx,dx
	jns	dm02
	neg	dx
	neg	ax
	sbb	dx,0
	inc	bh
dm02:
	or	di,di
	jns	dm03
	neg	di
	neg	si
	sbb	di,0
	xor	bh,3
dm03:
	push	bx
	mov	cx,32		;loop counter
	xor	bx,bx		;set to zero
	push	bx
dm04:
	xchg	cx,-6[bp]	;get back dividend
	sal	ax,1		;left 1 bit
	rcl	dx,1
	rcl	bx,1
	rcl	cx,1
	cmp	di,cx		;will it go
	ja	dm06		;nope
	jb	dm05		;yes
	cmp	si,bx		;maybe
	ja	dm06
dm05:
	sub	bx,si
	sbb	cx,di
	inc	ax		;bit to result
dm06:
	xchg	cx,-6[bp]	;check loop counter
	loop	dm04
	pop	si		;get remainder
	pop	cx		;get control
	test	cl,2		;if mod, result to ax,dx
	jz	dm07
	xchg	ax,bx
	mov	dx,si
	test	ch,2		;if high bit set
	jz	dm07
	xor	ch,1		;invert low bit
dm07:
	test	cl,1		;signed ?
	jnz	dm08		;nope
	test	ch,1		;reverse sign ?
	jz	dm08		;nope
	neg	dx
	neg	ax
	sbb	dx,0
dm08:
	mov	8[bp],ax
	mov	10[bp],dx
	pop	di
	pop	bp
	ret	4

	eseg

	dw	dollar_lsdiv
	db	DEFCGBL,'$lsdiv',0
	dw	dollar_lsmod
	db	DEFCGBL,'$lsmod',0
	dw	dollar_ludiv
	db	DEFCGBL,'$ludiv',0
	dw	dollar_lumod
	db	DEFCGBL,'$lumod',0
	dw	0,0

	end
-ARCHIVE- $llshift.a86 683
;	long left shift

;	entry	ax and dx contain value to be left shifted
;		cx contains the number of bits to shift

;	exit	shifted value in ax and dx



DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code


	cseg

dollar_llshift:

	jcxz	lls09			;don't shift anything
	cmp	cx,32			;max number of bits
	jbe	lls01			;valid
	mov	cx,32			;set to maximum
lls01:
	shl	ax,1
	rcl	dx,1
	loop	lls01			;do it for all bits
lls09:
	ret

	eseg

	dw	dollar_llshift
	db	DEFCGBL,'$llshift',0
	dw	0,0

	end
-ARCHIVE- $lmul.a86 805
;	multiply two longs

;	entry	1,two longs on the stack
;	exit	1,result on stack, other long popped from stack


DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code


	cseg

dollar_lmul:
	push	bp
	mov	bp,sp
	mov	ax,10[bp]	;get high
	mul	word ptr 4[bp]	;* low
	mov	10[bp],ax	;partial result
	mov	ax,6[bp]	;other high
	mul	word ptr 8[bp]	;other low
	add	10[bp],ax	;more partial result
	mov	ax,4[bp]	;low
	mul	word ptr 8[bp]	;other low
	mov	8[bp],ax	;result
	add	10[bp],dx	;finish partial result
	pop	bp		;get back frame pointer
	ret	4		;dump one long

	eseg

	dw	dollar_lmul
	db	DEFCGBL,'$lmul',0
	dw	0,0

	end
-ARCHIVE- $lrsshft.a86 689
;	long right signed shift

;	entry	ax and dx contain value to be shifted
;		cx contains the number of bits to shift

;	exit	shifted value in ax and dx



DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code


	cseg

dollar_lrsshift:

	jcxz	lrs09			;don't shift anything
	cmp	cx,32			;max number of bits
	jbe	lrs01			;valid
	mov	cx,32			;set to maximum
lrs01:
	sar	dx,1
	rcr	ax,1
	loop	lrs01			;do it for all bits
lrs09:
	ret

	eseg

	dw	dollar_lrsshift
	db	DEFCGBL,'$lrsshift',0
	dw	0,0

	end
-ARCHIVE- $lrushft.a86 691
;	long right unsigned shift

;	entry	ax and dx contain value to be shifted
;		cx contains the number of bits to shift

;	exit	shifted value in ax and dx



DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code


	cseg

dollar_lrushift:

	jcxz	lru09			;don't shift anything
	cmp	cx,32			;max number of bits
	jbe	lru01			;valid
	mov	cx,32			;set to maximum
lru01:
	shr	dx,1
	rcr	ax,1
	loop	lru01			;do it for all bits
lru09:
	ret

	eseg

	dw	dollar_lrushift
	db	DEFCGBL,'$lrushift',0
	dw	0,0

	end
-ARCHIVE- $main.a86 5066
	title	'c86 basic support package'

;	this is the starting point for all C programs

	dseg

;	the following data structure is created and initialised by the linker
;	it specifies the size and address of uninitialised global storage
;	it is available to various routines as "_sysuglo"

sysuglo	rw	0	;control structure generated by the linker
gfirst	rw	1	;address of first uninitialised global byte
glen	rw	1	;length of the uninitialised global region

;	the following data structure is known as "_sysvals" by various
;	parts of the system, including alloc and $entry?

	org	0

sysvals	rw	0	;a control data structure for a C program
sreserv	dw	80h	;minumum stack space above heap before HEAP ERROR
htop	dw	80h	;top of heap (includes reserv) for HEAP ERROR check
savess	dw	0	;place to save entry reg ss during execution
savesp	dw	0	;place to save entry reg sp during execution
hem	db	13,10,'NO CORE$'

;	the following symbol may be used to determine the o/s type

under_systype	dw	0	;for cp/m-86

;	the following symbol controls trace-back at _exit time

under_exittbc	db	0	;0=none, 1=error, 0xff=always
		db	0,0,0,0ah,0dh,'$'	;data area for above

DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

;	$main	entry point for c programs

dollar_main:
	mov	bx,offset sysvals	;get control block address
glo_adj_1	equ	$-2		;for linker
	mov	savess[bx],ss		;save the stack seg
	mov	savesp[bx],sp		;and the stack pointer

	mov	ax,ds			;set our seg reg values
	mov	es,ax
	mov	ss,ax
	mov	sp,.6			;data seg size from cpm
	and	sp,0fffeh		;force it even for alignment
	mov	bp,sp			;set bp too

;	clear the uninitialized global storage region

	cld				;to go up
	mov	di,gfirst		;start of static uninitialised area
glo_fix_1	equ	$-2
	mov	cx,glen			;# of bytes to clear
glo_fix_2	equ	$-2
	add	htop[bx],di		;calc heap top for alloc
	add	htop[bx],cx
	cmp	htop[bx],sp		;enough room to run ?
	jae	heap_error		;nope
	xor	ax,ax			;zero ax
	rep	stos	al		;clear the area

;	call the routine _main to do other initialisation

umain	equ	$+1
	call	$+3			;enter c system at '_main'
	jmps	under_exit_1

;	a heap error has occured

heap_error:
	mov	cl,9
	mov	dx,offset hem		;address of message
hem_adj equ	$-2			;for relocation by linker
	int	224			;say buy more core
	mov	ax,8000h		;set error flag
	jmps	under_exit_1		;go to the exit mechanism


;	_exit	abort exit point for c programs

under_exit:
	push	bp
	mov	bp,sp
	mov	ax,4[bp]		;get exit value
under_exit_1:
	mov	bl,under_exittbc	;get the trace back control byte
tbc_adj_1	equ	$-2
	or	bl,bl
	jz	tb_none		;traceback is off
	js	tb_go		;do it
	or	ax,ax		;any error returned
	jz	tb_none		;nope
tb_go:
	push	ax		;save the exit value
tb_loop:
	mov	dx,2[bp]	;get a call address
	mov	si,4		;hex digits per word
	lea	bx,under_exittbc	;get the data address
tbc_adj_2	equ	$-2
tb_digit:
	mov	al,dl		;get a digit
	mov	cl,4
	shr	dx,cl		;strip the digit
	and	al,0fh		;keep low nibble
	add	al,090h
	daa
	adc	al,040h
	daa
	dec	si		;count the digit
	mov	[bx+si],al	;store the digit
	jnz	tb_digit
	mov	dx,bx
	mov	cl,9
	int	0e0h
	cmp	[bp],bp
	jbe	tb_done
	mov	bp,[bp]		;up the stack
	jmps	tb_loop
tb_done:
	pop	ax		;restore ax
tb_none:
	mov	ss,savess	;restore reg ss
glo_adj_2	equ	$-2
	mov	sp,savesp	;restore the stack
glo_adj_3	equ	$-2
	retf				;and a far return

;	set up on entry to a function

dollar_entry0:
	pop	si		;get address we came from
	xor	ax,ax		;no locals in this procedure
	jmps	entry1
dollar_entry1:
	pop	si		;get address we came from
	cld
	db	2eh		;seg override prefix to cs:
	lods	al		;get offset
	mov	ah,0		;as a word value
entry1:
	push	bp		;save frame pointer
	mov	bp,sp		;get new frame pointer
	sub	sp,ax		;adjust stack
	cmp	sp,htop		;how is heap space
glo_adj_4	equ	$-2
	jbe	heap_error	;crash
	jmp	si		;go to program
dollar_entry2:
	pop	si		;get address we came from
	cld
	db	2eh		;seg override prefix to cs:
	lods	ax		;get the offset
	jmps	entry1

;	define the addresses to relocate in the above code

	eseg

	dw	dollar_main
	db	DEFCGBL,'$main',0
	dw	under_exit
	db	DEFCGBL,'_exit',0
	dw	dollar_entry0
	db	DEFCGBL,'$entry0',0
	dw	dollar_entry1
	db	DEFCGBL,'$entry1',0
	dw	dollar_entry2
	db	DEFCGBL,'$entry2',0
	dw	umain
	db	RELCGBL,'_main',0
	dw	sysvals
	db	DEFDGBL,'_sysvals',0
	dw	under_systype
	db	DEFDGBL,'_systype',0
	dw	under_exittbc
	db	DEFDGBL,'_exittbc',0

	dw	tbc_adj_1
	db	ABSCGBL,'_sysvals',0	;gives correct final address
	dw	tbc_adj_2
	db	ABSCGBL,'_sysvals',0

	dw	hem_adj
	db	ABSCGBL,'_sysvals',0
	dw	glo_adj_1
	db	ABSCGBL,'_sysvals',0
	dw	glo_adj_2
	db	ABSCGBL,'_sysvals',0
	dw	glo_adj_3
	db	ABSCGBL,'_sysvals',0
	dw	glo_adj_4
	db	ABSCGBL,'_sysvals',0
	dw	glo_fix_1
	db	ABSCGBL,'_sysuglo',0
	dw	glo_fix_2
	db	ABSCGBL,'_sysuglo',0
	dw	0,0

	end
-ARCHIVE- bdos.a86 508
;	call bdos for simple services


DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

;	bdos	call bdos to execute a call


bdos:
	push	bp
	mov	bp,sp
	mov	cx,4[bp]
	mov	dx,6[bp]
	int	224
	pop	bp
	ret



;	define the addresses to relocate in the above code

	eseg

	dw	bdos
	db	DEFCGBL,'bdos',0
	dw	0,0

	end
-ARCHIVE- farcall.a86 1692
;	execute a far call with registers set up

;	entry	1, offset to call with respect to
;		2, cs to call
;		3, pointer to register values for call
;		4, pointer to area to save returned register values

;	exit 	machine status register value returned as func value

;	structure for register values is
;		struct regval{ unsigned ax,bx,cx,dx,si,di,ds,es;};

DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code


	cseg

farcall:
	push	ds		;save important registers
	push	es
	push	bp
	mov	bp,sp		;set our arg pointer

	mov	bx,12[bp]	;get source registers
	call	dollar_mtor	;set up registers
	callf	dword ptr 8[bp]	;execute the function

	pushf			;save result flags for return
	call	dollar_rtom	;return the registers to memory
	pop	ax		;result flags for user
	pop	bp
	pop	es
	pop	ds		;restore segment registers
	ret			;all done


;	transfer memory to registers

;	entry	bx contains memory address
;	exit	values in registers

dollar_mtor:

	mov	cx,8
mtor01:
	push	word ptr [bx]
	inc	bx
	inc	bx
	loop	mtor01		;push all 8 words
	pop	es
	pop	ds
	pop	di
	pop	si
	pop	dx
	pop	cx
	pop	bx
	pop	ax
	ret

;	transfer registers to memory

;	entry	registers contain values

dollar_rtom:

	push	es
	push	ds
	push	di
	push	si
	push	dx
	push	cx
	push	bx
	push	ax
	mov	bx,14[bp]		;get destination address
	mov	cx,8
rtom01:
	pop	ss:word ptr [bx]
	inc	bx
	inc	bx
	loop	rtom01
	ret			;dump the storage address

	eseg

	dw	farcall
	db	DEFCGBL,'farcall',0
	dw	0,0

	end
-ARCHIVE- inportb.a86 564
;	read an b bit value from a port

;	input	a port number
;	returns the input byte, zero filled


DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

inportb:
	push	bp
	mov	bp,sp		;set the frame pointer
	mov	dx,4[bp]	;get the port number
	in	al,dx		;get a byte value
	mov	ah,0		;zero the top byte
	pop	bp
	ret

	eseg

	dw	inportb
	db	DEFCGBL,'inportb',0
	dw	0,0

	end
-ARCHIVE- inportw.a86 520
;	read an w bit value from a port

;	input	a port number
;	returns the input word


DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

inportw:
	push	bp
	mov	bp,sp		;set the frame pointer
	mov	dx,4[bp]	;get the port number
	in	ax,dx		;get a byte value
	pop	bp
	ret

	eseg

	dw	inportw
	db	DEFCGBL,'inportw',0
	dw	0,0

	end
-ARCHIVE- intrserv.a86 1775
	title	'interrupt support package'

;	initialisation for this routine provided by intrinit.c

;	CONSTANTS REQUIRED FOR PSUEDO RELOCATABLE ASSEMBLY UNDER CPM-86

DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

;	when we reach the following entry point
;	we have executed the code created by initintr
;	and the following conditions are true (we hope)

;	cs is set to our cs value
;	the stack contains
;		0, the value we need in register sp
;		2, the value we need in our ds register
;

;	entry point for interrupt service routines

intrserv:

	push	bp
	mov	bp,sp		;so we can see stack
	push	ds
	mov	ds,4[bp]	;sets up ds
	push	bx
	mov	bx,2[bp]	;stack rubbish
	sub	bx,9		;some room yet
	mov	[bx],ss		;save stack seg
	mov	2[bx],sp	;and the stack pointer
	mov	ss,4[bp]	;got ss setup
	mov	sp,bx		;and sp yet
	push	ax		;save other registers
	push	cx
	push	dx
	push	si
	push	di
	push	es
	mov	es,4[bp]
	call	word ptr 10[bx]		;execute the function
	pop	es
	pop	di
	pop	si
	pop	dx
	pop	cx
	pop	ax
	mov	bx,sp			;set up to restore stack
	mov	ss,[bx]
	mov	sp,2[bx]		;stack restored
	pop	bx
	pop	ds
	pop	bp
	retf			;all done

;	routine to poke a word into memory (somewhere)

;	entry	1, offset of place to poke
;		2, segment of place to poke
;		3, value to poke

pokew:
	push	bp
	mov	bp,sp
	push	es		;save the register
	les	si,4[bp]	;get where
	mov	ax,8[bp]	;get what
	mov	es:[si],ax	;its there
	pop	es		;restore es
	pop	bp
	ret			;all done

	eseg

	dw	intrserv
	db	DEFCGBL,'intrserv',0
	dw	pokew
	db	DEFCGBL,'pokew',0
	dw	0,0

	end
-ARCHIVE- longjmp.a86 466
;	restore the environment saved by setjmp


;	entry	1, address of environment
;		2, value to return after restoration

DEFGBL	equ	0c1h

	cseg

longjmp:
	pop	ax		;dump the return address
	pop	bx		;get address of environment
	pop	ax		;get the return value
	mov	sp,[bx]		;reset the stack pointer
	mov	bp,2[bx]	;and bp
	mov	bx,4[bx]	;get the return address
	jmp	bx		;and away we go.....

	eseg

	dw	longjmp
	db	DEFGBL,'longjmp',0
	dw	0,0

	end
-ARCHIVE- movblock.a86 2221
;	'move a block of memory'
;	similar to movmem except that
;		1, uses a word move if count, source and dest are all even
;		2, needs segment values for source and dest also
;		3, turns off interrupts for word moves of less than 2 words


DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

;	movblock

;	entry	1, the source address relative to
;		2, the source segment
;		3, the destination address relative to
;		4, the destination segment
;		5, the number of bytes to move (value must not exceed Xffc0)

movblock:
	push	bp
	mov	bp,sp
	push	ds
	push	es
	pushf			;and the flags

	mov	si,4[bp]	;the source address
	mov	bx,si
	mov	cl,4
	shr	bx,cl
	add	bx,6[bp]	;canonical segment for block move

	mov	di,8[bp]	;the destination address
	mov	dx,di
	mov	cl,4
	shr	dx,cl
	add	dx,10[bp]	;canonical segment for block move

	mov	ax,0fh
	and	si,ax
	and	di,ax		;keep low 4 bits only

	mov	cx,12[bp]	;the number of bytes to move

	mov	ax,1		;see if we can use word move
	test	ax,cx		;odd number of bytes ?
	jnz	mb01		;yes
	test	ax,si		;odd source address
	jnz	mb01		;yes
	test	ax,di		;odd destination address ?
	jnz	mb01
	xor	ax,ax		;yes we can (flag for later)
mb01:

	cmp	bx,dx		;which way to do the move ?
	jb	mb03
	ja	mb02
	cmp	si,di		;which way to do the move ?
	jb	mb03		;do it in reverse order
mb02:
	cld
	jmps	mb04		;must be this
mb03:
	add	si,cx		;point to other end of string
	dec	si
	add	di,cx
	dec	di
	std			;backwards in memory
	or	ax,ax		;see if a word move
	jnz	mb04		;nope
	dec	si
	dec	di
mb04:
	mov	ds,bx
	mov	es,dx		;seg regs set up
	or	ax,ax		;check for a word move
	jz	mb05		;do a word move
	rep	movs	al,al	;do the move
	jmps	mb07
mb05:
	shr	cx,1		;counts words
	cmp	cx,2		;if exactly 2 words
	jnz	mb06
	cli			;turn off interrupts
mb06:
	rep	movs	ax,ax
mb07:
	popf			;restore flags and interrupts
	pop	es
	pop	ds
	pop	bp
	ret

;	define the addresses to relocate in the above code

	eseg

	dw	movblock
	db	DEFCGBL,'movblock',0
	dw	0,0

	end
-ARCHIVE- movmem.a86 981
;	'move a block of memory'


DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

;	movmem

;	entry	1,the source address
;		2,the destination address
;		3,the number of bytes to move

movmem:
	push	bp
	mov	bp,sp
	mov	ax,ds		;ensure that extra seg is correct
	mov	es,ax
	mov	si,4[bp];	;the source address
	mov	di,6[bp]	;the destination address
	mov	cx,8[bp]	;the number of bytes to move
	cmp	si,di		;which way to do the move ?
	jb	movmem01	;do it in reverse order
	cld
	jmps	movmem02	;must be this
movmem01:
	add	si,cx		;point to other end of string
	dec	si
	add	di,cx
	dec	di
	std			;backwards in memory
movmem02:
	rep	movs	al,al	;do the move
	pop	bp
	ret

;	define the addresses to relocate in the above code

	eseg

	dw	movmem
	db	DEFCGBL,'movmem',0
	dw	0,0

	end
-ARCHIVE- outportb.a86 623
;	write an 8 bit value to port

;	input	a port number
;		the value to write 
;	returns the input byte, zero filled


DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

outportb:
	push	bp
	mov	bp,sp		;set the frame pointer
	mov	dx,4[bp]	;get the port number
	mov	ax,6[bp]	;get the value to output
	mov	ah,0		;zero the top byte
	out	dx,al		;put it out
	pop	bp
	ret

	eseg

	dw	outportb
	db	DEFCGBL,'outportb',0
	dw	0,0

	end
-ARCHIVE- outportw.a86 580
;	write an 16 bit value to port

;	input	a port number
;		the value to write 
;	returns the input word


DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

outportw:
	push	bp
	mov	bp,sp		;set the frame pointer
	mov	dx,4[bp]	;get the port number
	mov	ax,6[bp]	;get the value to output
	out	dx,ax		;put it out
	pop	bp
	ret

	eseg

	dw	outportw
	db	DEFCGBL,'outportw',0
	dw	0,0

	end
-ARCHIVE- peek.a86 684
;	peek at a work in memory somewhere

;	CONSTANTS REQUIRED FOR PSUEDO RELOCATABLE ASSEMBLY UNDER CPM-86

DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

;	entry	1, offset of place to peek
;		2, segment of place to peek

;	exit	ax contains copy of content of memory location

peek:
	push	bp
	mov	bp,sp
	push	es		;save the register
	les	si,4[bp]	;get where
	mov	ax,es:[si]	;get what
	pop	es		;restore es
	pop	bp
	ret			;all done

	eseg

	dw	peek
	db	DEFCGBL,'peek',0
	dw	0,0

	end
-ARCHIVE- pokeb.a86 704
;	poke a byte into memory somewhere

;	CONSTANTS REQUIRED FOR PSUEDO RELOCATABLE ASSEMBLY UNDER CPM-86

DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

;	entry	1, offset of place to poke
;		2, segment of place to poke
;		3, value to poke (as the low byte of a word)

pokeb:
	push	bp
	mov	bp,sp
	push	es		;save the register
	les	si,4[bp]	;get where
	mov	ax,8[bp]	;get what
	mov	es:[si],al	;its there
	pop	es		;restore es
	pop	bp
	ret			;all done

	eseg

	dw	pokeb
	db	DEFCGBL,'pokeb',0
	dw	0,0

	end
-ARCHIVE- pokew.a86 676
;	poke a word into memory somewhere

;	CONSTANTS REQUIRED FOR PSUEDO RELOCATABLE ASSEMBLY UNDER CPM-86

DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

;	entry	1, offset of place to poke
;		2, segment of place to poke
;		3, value to poke

pokew:
	push	bp
	mov	bp,sp
	push	es		;save the register
	les	si,4[bp]	;get where
	mov	ax,8[bp]	;get what
	mov	es:[si],ax	;its there
	pop	es		;restore es
	pop	bp
	ret			;all done

	eseg

	dw	pokew
	db	DEFCGBL,'pokew',0
	dw	0,0

	end
-ARCHIVE- segread.a86 733
;	'read the segment registers'

DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

;	entry	1, the address of a 4 word structure to hold the seg values
;
;	the format of the region is
;	struct regs {
;		unsigned cs;
;		unsigned ss;
;		unsigned ds;
;		unsigned es;
;	};

segread:
	mov	si,sp		;get argument
	mov	si,2[si]	;pointer to data
	mov	[si],cs
	mov	2[si],ss
	mov	4[si],ds
	mov	6[si],es
	ret			;all done you bet

;	define the addresses to relocate in the above code

	eseg

	dw	segread
	db	DEFCGBL,'segread',0
	dw	0,0

	end
-ARCHIVE- setjmp.a86 510
;	save the environment for later restoration by longjmp


;	entry	1, address of a buffer to save the environment

;	exit	ax contains zero

DEFGBL	equ	0c1h

	cseg

setjmp:
	pop	si		;get the return address
	pop	bx		;get the address of save area
	push	bx		;but keep it for later
	mov	[bx],sp		;save sp in block
	mov	2[bx],bp	;and bp
	mov	4[bx],si	;and the return address
	xor	ax,ax		;always returns zero
	jmp	si		;and we are done

	eseg

	dw	setjmp
	db	DEFGBL,'setjmp',0
	dw	0,0

	end
-ARCHIVE- setmem.a86 812
;	'set memory to a specified character'


DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code

	cseg

;	setmem

;	entry	1,the address of first character to be set
;		2,the number of bytes to set (unsigned int)
;		3,the desired value

setmem:
	push	bp
	mov	bp,sp
	mov	ax,ds		;ensure that extra seg is correct
	mov	es,ax
	cld			;and clear the direction flag
	mov	di,4[bp]	;the address to set
	mov	cx,6[bp]	;the number of bytes to set
	mov	al,8[bp]	;the value to set
	rep	stos	al	;set the area
	pop	bp
	ret

;	define the addresses to relocate in the above code

	eseg

	dw	setmem
	db	DEFCGBL,'setmem',0
	dw	0,0

	end
-ARCHIVE- sysint.a86 2232
;	execute an interrupt with registers set up

;	entry	1, pointer to register values for call
;		2, pointer to area to save returned register values

;	exit 	machine status register value returned as func value

;	structure for register values is
;		struct regval{ unsigned ax,bx,cx,dx,si,di,ds,es;};

DEFCGBL	equ	0c1h		;define a global in code segment
DEFDGBL equ	0c2h		;define a global in data segment
RELCGBL	equ	0c3h		;relative address of global in code
ABSCGBL equ	0c4h		;absolute reference to global in code


	cseg

sysint:
	push	ds		;save important registers
	push	es
	push	bp
	mov	bp,sp		;set our arg pointer
	mov	ax,12[bp]	;get return address value for MUCH later
	push	ax
	pushf			;push the flags for return
	pop	dx		;make a copy of flags
	push	dx
	push	cs		;and the code segment
	call	dummy		;push the ip
dummy:
	pop	ax		;get ip value
	sub	ax,offset dummy
	add	ax,offset sysint1
	push	ax		;return address
	and	dh,0ch		;clear I and T flag bits
	push	dx
	xor	bx,bx		;clear bx
	mov	es,bx		;and es
	mov	bl,8[bp]	;get int trap number
	shl	bx,1		;*2
	shl	bx,1		;*2 again (thats 4)
	push	es:word ptr 2[bx]
	push	es:word ptr [bx]		;thats the entry data
	mov	bx,10[bp]	;get source registers
	call	dollar_mtor	;set up registers
	iret			;simulate an interrupt
sysint1:
	pushf			;save result flags for return
	call	dollar_rtom	;return the registers to memory
	pop	ax		;result flags for user
	pop	bp		;dump return address
	pop	bp
	pop	es
	pop	ds		;restore segment registers
	ret			;all done



;	transfer memory to registers

;	entry	bx contains memory address
;	exit	values in registers

dollar_mtor:

	mov	cx,8
mtor01:
	push	word ptr [bx]
	inc	bx
	inc	bx
	loop	mtor01		;push all 8 words
	pop	es
	pop	ds
	pop	di
	pop	si
	pop	dx
	pop	cx
	pop	bx
	pop	ax
	ret

;	transfer registers to memory

;	entry	registers contain values

dollar_rtom:

	push	es
	push	ds
	push	di
	push	si
	push	dx
	push	cx
	push	bx
	push	ax
	mov	bp,sp
	mov	bx,20[bp]		;get destination address
	mov	cx,8
rtom01:
	pop	ss:word ptr [bx]
	inc	bx
	inc	bx
	loop	rtom01
	ret			;dump the storage address

	eseg

	dw	sysint
	db	DEFCGBL,'sysint',0
	dw	0,0

	end