mirror of
https://github.com/PDP-10/its.git
synced 2026-01-18 17:16:59 +00:00
72 lines
1.9 KiB
Plaintext
Executable File
72 lines
1.9 KiB
Plaintext
Executable File
|
|
|
|
;;;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
|
|
|