;;;Functions for *$ //$ and scaling for use with compiled code.
;;;Overflow is caught, and underflow gives 0.0 or an error depending
;;;on the setting of the ZUNDERFLOW switch
    ;;; Originally written by CFFK
    ;;; Functions +f and -f added by JONL on 7 DEC 76

;;;in file put:
;;;(and (not (get '*f 'subr)) 
;;;  	(mapc '(lambda (x) (putprop x '(arith fasl dsk liblsp) 'autoload))
;;;	      '(*f //f _f +f -f)))

;;;declarations needed:
;;;(declare (flonum (*f flonum flonum) (//f flonum flonum) 
;;;		    (_f flonum fixnum) (+f flonum flonum) (-f flonum flonum))
;;;	    (*expr *f //f _f +f -f)) 


(declare (flonum (*f flonum flonum) (//f flonum flonum) 
		 (_f flonum fixnum) (+f flonum flonum) (-f flonum flonum))
	 (*expr *f //f _f +f -f))
 

(lap *f subr)
(args *f (nil . 2))
	(push p (% 0 0 float1))
	(movei r 0)
	(jrst 2 @ (% 0 0 nexta))	;zero all overflow and underflow flags
(entry //f subr)
(args //f (nil . 2))
	(push p (% 0 0 float1))
	(movei r 1)
	(jrst 2 @ (% 0 0 nexta))	;zero all overflow and underflow flags
(entry _f subr)
(args _f (nil . 2))
	(push p (% 0 0 float1))
	(movei r 2)
	(jrst 2 @ (% 0 0 nexta))	;zero all overflow and underflow flags
(entry +f subr)
(args +f (nil . 2))
	(push p (% 0 0 float1))
	(movei r 3)
	(jrst 2 @ (% 0 0 nexta))	;zero all overflow and underflow flags
(entry -f subr)
(args -f (nil . 2))
	(push p (% 0 0 float1))
	(movei r 4)
	(jrst 2 @ (% 0 0 nexta))	;zero all overflow and underflow flags

nexta	(move tt 0 a)			;first arg into tt
	(move d 0 b)			;second arg into d
	(xct 0 instbl r)		;do floating point operation
	(jfcl 10 uflow)			;overflow detected?
ans	(popj p)			;return with result in tt
uflow	(jsp t (* 1))
	(tlnn t 100)
	(lerr 0 (% sixbit |floating-point overflow from f-series functions!|))
	(skipn 0 (special zunderflow))
	(lerr 0 (% sixbit |floating-point underflow from f-series functions!|))
	(movei tt 0)
	(jrst 0 ans)

instbl	(fmpr tt d)
	(fdvr tt d)
	(fsc tt 0 d)
	(fadr tt d)
	(fsbr tt d)

nil