;
; Borland assembler header
;
; Microsoft MASM subroutines for setting coprocessor precision
;
.286
.287
PREC_TEXT	SEGMENT  BYTE PUBLIC 'CODE'
PREC_TEXT	ENDS
DGROUP	group	_DATA,_BSS
	assume	cs:PREC_TEXT,ds:DGROUP
_DATA	segment word public 'DATA'
d@	label	byte
d@w	label	word
_DATA	ends
_BSS	segment word public 'BSS'
b@	label	byte
b@w	label	word
_BSS	ends

; exception masks (1 = masked)
;   1  invalid operation
;   2  denormalized operand
;   4  zero divide
;   8  overflow
;  10  underflow
;  20  precision

_DATA SEGMENT

; double precision setting
;;ctlwrd dw 01230h ; note this traps on denormal operands!
;;ctld dw 0133fh   ; this doesn't trap
ctld dw 01230h

; single precision
ctls dw 01030h

; long double precision
ctlld dw 01320h

_DATA ENDS

PREC_TEXT	segment byte public 'CODE'
	assume	cs:PREC_TEXT,ds:DGROUP
; Set coprocessor to single precision float
	PUBLIC	_sprec
_sprec	PROC FAR
	fclex
	fwait
	finit
	fwait
	fldcw word ptr ctls
	fwait
	ret
_sprec ENDP

; set coprocessor to long double precision
	PUBLIC	_ldprec
_ldprec PROC far
	fclex
	fwait
	finit
	fwait
	fldcw word ptr ctlld
	fwait
	ret
_ldprec ENDP

; set coprocessor to double precision
	PUBLIC	_dprec
_dprec PROC far
	fclex
	fwait
	finit
	fwait
	fldcw word ptr ctld
	fwait
	ret
_dprec ENDP


; get a double promoted to long double size
; getld( &doub, &ldoub );
	PUBLIC	_getld
_getld	PROC far
	push bp
	mov bp,sp
	push bx
	mov bx, word ptr [bp+4]
;	fld st(0)
	fld qword ptr [bx]
	mov bx, word ptr [bp+6]
	fstp tbyte ptr [bx]
	mov bx, word ptr [bp+4]
	fld qword ptr [bx]
	mov bx, word ptr [bp+8]
	fstp qword ptr [bx]
	pop bx
	pop bp
	ret
_getld	ENDP

	PUBLIC	_getprec
_getprec	PROC far
	push bp
	mov bp,sp
	sub sp,4
	fstcw [bp-4]
	fwait
	mov ax,[bp-4]
	add sp,4
	pop bp
	ret
_getprec	ENDP


	PUBLIC	_fpclear
_fpclear	PROC far
	push bp
	mov bp,sp
	fnclex
	fwait
	pop bp
	ret
_fpclear	ENDP


	PUBLIC	_noexcept
_noexcept	PROC far
	push bp
	mov bp,sp
	push ax
	sub sp,4
	fnclex
	fwait
	fstcw [bp-4]
	fwait
	mov ax,[bp-4]
	and ax,0FFC0h
	or ax,003fh
	mov [bp-4],ax
	fldcw [bp-4]
	add sp,4
	pop ax
	pop bp
	ret
_noexcept	ENDP

; single precision square root
; assumes coprocessor precision already set up
; return value in static __fac
	PUBLIC	_sqrtf
_sqrtf	PROC FAR
	push bp
	mov bp,sp
	fld	DWORD PTR [bp+6]
	fsqrt
	fwait	
	mov	sp,bp
	pop bp
	ret
_sqrtf	ENDP

; double precision square root
; assumes coprocessor precision already set up
; return value in static __fac
	PUBLIC	_sqrt
_sqrt	PROC FAR
	push bp
	mov bp,sp
	fld	QWORD PTR [bp+6]
	fsqrt
	fwait	
	mov	sp,bp
	pop bp
	ret
_sqrt	ENDP


; long double precision square root
; assumes coprocessor precision already set up
; return value in fp register
	PUBLIC	_sqrtl
_sqrtl	PROC FAR
	push bp
	mov bp,sp
	fld tbyte ptr [bp+6]
	fsqrt
	fwait	
	mov	sp,bp
	pop bp
	ret
_sqrtl	ENDP


PREC_TEXT	ends
_DATA	segment word public 'DATA'
s@	label	byte
_DATA	ends
PREC_TEXT	segment byte public 'CODE'
PREC_TEXT	ends
_s@	equ	s@
	public _sprec
	public _dprec
	public _ldprec
	end