	;MASM MODE
	.386
	.MODEL use32 small

	public	fpcommand

	extrn	_hasfloat : byte
include  prints.ase 
include  input.ase 
include  mtrap.ase 
include  breaks.ase 
include exec.ase

	.data
ten	dd	10
work	dw	?
floatstat dw	54 dup (0)
enames	db	"IDZOUP"


	.code
precmsg	dd	offset _TEXT:prsing,offset _TEXT:reserved
	dd	offset _TEXT:prdbl,offset _TEXT:prxt
roundmsg dd	offset _TEXT:rdnear,offset _TEXT:rdminus
	dd	offset _TEXT:rdplus,offset _TEXT:rdzer
prsing	db	"Single",0
prdbl	db	"Double",0
prxt	db	"Extended",0
reserved db	"Reserved",0
rdnear	db	"Nearest",0
rdzer	db	"Zero",0
rdplus	db	"Plus Infinity",0
rdminus db	"Minus Infinity",0

;
; check for floating point unit
;
;
; fp commands
;
fpcommand	proc
	test	[_hasfloat],1
	jnz	okfloat
	Msg	<13,10,"No FP unit">
	clc
	ret
okfloat:
	fnsave	[floatstat]
	fwait
	call	WadeSpace
	jz	dumpstack
	cmp	al,'s'
	jnz	flerr
	inc	esi
	call	WadeSpace
	jnz	flerr
	frstor [floatstat]
	fwait
	Msg	<13,10,"Masked exceptions: ">
	mov	dx,word ptr [floatstat]
	call	except
	Msg	<13,10,"Active exceptions: ">
	mov	dx,word ptr [floatstat+4]
	call	except
	Msg	<13,10,"Precision:         ">
	movzx	ebx,byte ptr [floatstat+1]
	and	bl,3
	mov	ebx,[ebx*4+precmsg]
	call	olMessage
	Msg	<13,10,"Rounding:          ">
	movzx	ebx,byte ptr [floatstat+1]
	and	bl,0ch
	mov	ebx,[ebx+roundmsg]
	call	olMessage
	Msg	<13,10,"FPU Status flags:  ">
	test	word ptr [floatstat+4],100h
	jz	notc0
	Msg	"C0 "
notc0:
	test	word ptr [floatstat+4],200h
	jz	notc1
	Msg	"C1 "
notc1:
	test	word ptr [floatstat+4],400h
	jz	notc2
	Msg	"C2 "
notc2:
	test	word ptr [floatstat+4],4000h
	jz	notc3
	Msg	"C3 "
notc3:
	clc
	ret
dumpstack:
	movzx	eax,word ptr [floatstat+4]
	shr	ax,11
	and	ax,7
	sub	eax,7
	neg	eax
	mul	[ten]
	mov	ebx,offset DGROUP:floatstat+28
	add	ebx,eax
	mov	ecx,8
dsl:
	push	ebx
	push	ecx
	call	dumpval
	pop	ecx
	pop	ebx
	sub	ebx,10
	loop	dsl
	frstor [floatstat]
	fwait
	clc
	ret
flerr:
	stc
	ret
fpcommand	endp
except	PROC
	mov	esi,offset DGROUP:enames
	mov	ecx,6
exlp:
	shr	dx,1
	lodsb
	jnc	nhr
	push	edx
   	mov	dl,al
	call	PutChar
	mov	dl,'E'
	call	PutChar
	call	PrintSpace
	pop	edx
nhr:
	loop	exlp
	ret
except	ENDP
;
; dump the value of a stack register
;
dumpval	PROC
	call	crlf
	dec	cl
	mov	dl,cl
	add	dl,'0'
	call	PutChar
	mov	ax,word ptr [floatstat+4]
	shr	ax,11
	and	al,7
	cmp	al,cl
	jnz	nottop
       	mov	dl,'*'
	call	PutChar
	jmp	join
nottop:
	call	PrintSpace
join:
	mov	dl,')'
	call	PutChar
	call	PrintSpace
	call	PrintSpace
	call	PrintSpace
	mov	ax,word ptr [floatstat+8]
	shr	ax,cl
	shr	ax,cl
	and	al,3
	cmp	al,3
	jnz	notempty
	Msg	"<Empty>"
	clc
	ret

notempty:
	cmp	al,2
	jnz	notnan
isnan:
	Msg	"<Nan>"
	clc
	ret
notnan:
	cmp	al,1
	jnz	notzero
	mov	dl,'0'
	call	PutChar
	clc
	ret
notzero:
	fld	tbyte ptr [bx]
	call	PrintFloating
	fcomp
	clc
	ret
dumpval	ENDP
;
; actual FP print routines
;
PrintFloating	PROC
	call	fextract
	or	eax,eax
	jz	notdenorm
	Msg	"<Denorm>"
	ret
notdenorm:
	or	edx,edx
	jns	noneg
	call	putneg
noneg:
	cmp	ebx,8		; getter be less than 16!!!!
	jg	highexp
	cmp	ebx,-4
	jle	lowexp
	or	ebx,ebx
	jge	gte0
;
; print for less than one but not exponential
;
	push	ebx
	call	putzer
	call	putper
	pop	ecx
	neg	ecx
	dec	ecx
	jcxz	nozr
	inc	ecx
zrl:
	call	putzer
	loop	zrl
nozr:
	mov	ecx,16
nl2:
	call	fnd
	call	putdig
	loop	nl2
	ret
;
; print for greater than or equal to one but not exponential
;
gte0:
	push	ebx
	mov	ecx,ebx
	call	fnd
	call	putdig
	jcxz	gte0nl
gtel1:
	call	fnd
	call	putdig
	loop	gtel1
gte0nl:
	call	putper
	pop	ecx
	sub	ecx,16
	neg	ecx
gtel2:
	call	fnd
	call	putdig
	loop	gtel2
	ret
;
; hack to justify negative exponents
;
lowexp:
	dec	ebx
	call	fnd
;
; exponential print
;
highexp:
	push	ebx
	call	fnd
	call	putdig
	call	putper
	mov	ecx,16
hel1:
	call	fnd
	call	putdig
	loop	hel1
	mov	dl,'E'
	call	PutChar
	pop	eax
	or	eax,eax
	jns	nonegx
	push	eax
	call	putneg
	pop	eax
	neg	eax
nonegx:
	sub	ecx,ecx
elp1:
	sub	edx,edx
	div	[ten]
	push	edx
	inc	ecx
	or	eax,eax
	jnz	elp1
elp2:
	pop	eax
	call	putdig
	loop	elp2
	ret
putdig:
	mov	dl,al
	add	dl,'0'
	call	PutChar
       	ret
putper:
	mov	dl,'.'
	call	PutChar
	ret
putneg:
	mov	dl,'-'
	call	PutChar
	ret
putzer:
	mov	dl,'0'
	call	PutChar
	ret
PrintFloating	ENDP
;
; get exponent and mantissa and sign
;
; enter:
;   st(0) = value
;
; returns:
;   ax = 0	; ok val
;   
;     st(0) = mantissa
;     bx = exp
;     dx = sign   ( +-1)
;
;   ax = -1	; infinity or dnormal
;
fextract 	PROC
	enter	8,0
	fstcw	[bp-2]
	mov	ax,[bp-2]
	or	ah,0ch		; round toward zero
	mov	[bp-4],ax
	fldcw	[bp-4]

	ftst
	fnstsw	ax
	fnclex			; just in case ... 
	sahf
	mov	eax,-1   	; first check for out of range
	jp	fxx
	jnz	dosign		; now check for zero
	sub	bx,bx
	sub	dx,dx
	jmp	fxx

dosign:
	mov	edx,1		; nonzero, finally get sign
	jnc	pos
	fabs       		; we will work with positive nums hereafter
	mov	edx,-1
pos:
	fldlg2       		; log to base 10
	fxch
	fyl2x
	
	fld	st(0)		; get int part
	frndint
	fist	dword ptr [bp-8]
	pop	ebx

	fsubp			; fraction
	fldl2t			; convert back to base 2
	fmulp

	fld	st(0)		; lovely exponentiation
	frndint
	fxch
	fld	st(1)
	fsubp
	f2xm1			;
	fld1
	faddp
	fscale
	fxch
	fcomp
	sub	eax,eax
fxx:
	fnclex
	fldcw	[bp-2]
	fwait
	leave
	ret
fextract	ENDP
;
; get next digit from mantissa
;
; enter:
;   mantissa from fextract on stack
;
; exit:
;   eax = next digit (base 10)
;   stack = new mantissa
;
fnd	PROC
	ENTER	8,0
	fstcw	[bp-2]
	mov	ax,[bp-2]
	or	ah,0ch		; round toward zero
	mov	[bp-4],ax
	fldcw	[bp-4]

	fld	st(0)		; next digit
	frndint
	fist	dword ptr [bp-8]

	fsubp			; new mantissa
	fimul	dword ptr [ten]

	fnclex
	fldcw	[bp-2]
	fwait
	pop	eax		; cute trick to get result :)
	leave
	ret
fnd	ENDP
end