/* --- Copyright University of Sussex 1994. All rights reserved. ---------- * File: S.axpvms/src/afloat.s * Purpose: * Author: John Gibson, Oct 12 1994 */ .title "afloat.o" ;;; must be the object file name ;;; ----------------- FLOATING POINT ROUTINES ----------------------------- #_< #_INCLUDE 'asm.ph' section $-Sys; constant procedure Float_qrem ; vars _in_math_lib ; define_extern_name __pop_in_math_lib = ident _in_math_lib, ; endsection; lconstant macro ( _DD_1 = @@DD_1, _DD_2 = @@DD_2, _svb_INMATHLIB = [_SVB_OFFS(Sys$- _in_math_lib)(rsvb)], ); >_# ASM_CODE_PSECT ;;; ------------------------------------------------------------------------ ;;; _pfcopy(__________dst_addr, __________src_addr) ;;; copy a double float from one address to another .align quad DEF_C_LAB (_pfcopy) ldl rt0, (rusp) ;;; __________src_addr ldl rt1, 4(rusp) ;;; __________dst_addr ldg f0, (rt0) lda rusp, 8(rusp) stg f0, (rt1) ret (rret) ;;; --- BASIC ARITHMETIC ------------------------------------------------- .align quad fpe_error: stl rfalse, (rusp) ret (rret) /* These routines return their 1st arg (_________dfaddr1) rather than true (just quicker, and nothing relies on them returning true). false is returned for overflow, etc. */ #_< define lconstant macro ARITH_ROUTINE S op; lvars op, S; [ ldl \t rt0, _4(rusp) \n \t ldl \t rt1, (rusp) \n ;;; _________dfaddr2 \t ldg \t f0, (rt0) \n \t ldg \t f1, (rt1) \n \t lda \t rusp, _4(rusp) \n % "fpe_s_" <> op % : \n \t ^op \t f0, f1, f0 \n \t stg \t f0, (rt0) \n \t trapb \n ;;; signal any error % "fpe_e_" <> op % : \n \t ret \t (rret) \n ;;; return _________dfaddr1 ].dl enddefine; >_# ;;; _pfadd(_________dfaddr1, _________dfaddr2) -> _________dfaddr1 or false ;;; add _________dfaddr2 destructively into _________dfaddr1 .align quad DEF_C_LAB (_pfadd) ARITH_ROUTINE addg ;;; _pfsub(_________dfaddr1, _________dfaddr2) -> _________dfaddr1 or false ;;; subtract _________dfaddr2 destructively from _________dfaddr1 .align quad DEF_C_LAB (_pfsub) ARITH_ROUTINE subg ;;; _pfmult(_________dfaddr1, _________dfaddr2) -> _________dfaddr1 or false ;;; multiply _________dfaddr1 destructively by _________dfaddr2 .align quad DEF_C_LAB (_pfmult) ARITH_ROUTINE mulg ;;; _pfdiv(_________dfaddr1, _________dfaddr2) -> _________dfaddr1 or false ;;; divide _________dfaddr1 destructively by _________dfaddr2 .align quad DEF_C_LAB (_pfdiv) ARITH_ROUTINE divg ;;; --- OTHER ARITHMETIC OPERATIONS --------------------------------------- ;;; _pfabs(________dfaddr) (absolute value) .align quad DEF_C_LAB (_pfabs) ldl rt0, (rusp) ;;; ________dfaddr ldg f0, (rt0) lda rusp, 4(rusp) cpys f31, f0, f0 ;;; set 0 sign bit stg f0, (rt0) ret (rret) ;;; _pfnegate(________dfaddr) (negate) .align quad DEF_C_LAB (_pfnegate) ldl rt0, (rusp) ;;; ________dfaddr ldg f0, (rt0) lda rusp, 4(rusp) cpysn f0, f0, f0 ;;; negate sign bit stg f0, (rt0) ret (rret) ;;; Dummy that just chains to Float_qrem .align quad DEF_C_LAB (_pfqrem) ldl rpb, _SVB_OFFS(Sys$-Float_qrem)(rsvb) ldl rt0, (rpb) jmp (rt0) ;;; --- PREDICATES -------------------------------------------------------- #_< define lconstant macro CMP_ROUTINE S cmp_op S br_op; lvars cmp_op, br_op, S; [ ldl \t rt0, _4(rusp) \n ;;; _________dfaddr1 \t ldl \t rt1, (rusp) \n ;;; _________dfaddr2 \t ldg \t f0, (rt0) \n \t ldg \t f1, (rt1) \n \t lda \t rusp, _4(rusp) \n \t ^cmp_op \t f0, f1, f0 \n \t ^br_op \t f0, 1$ \n \t lda \t rt0, _TRUEOFFS(rfalse) \n \t stl \t rt0, (rusp) \n \t ret \t (rret) \n 1$: \t stl \t rfalse, (rusp) \n \t ret \t (rret) \n ].dl enddefine; >_# ;;; _pfeq(_________dfaddr1, _________dfaddr2) -> ____bool .align quad DEF_C_LAB (_pfeq) CMP_ROUTINE cmpgeq fbeq ;;; _pfsgr(_________dfaddr1, _________dfaddr2) -> ____bool .align quad DEF_C_LAB (_pfsgr) CMP_ROUTINE cmpgle fbne ;;; _pfsgreq(_________dfaddr1, _________dfaddr2) -> ____bool .align quad DEF_C_LAB (_pfsgreq) CMP_ROUTINE cmpglt fbne #_< define lconstant macro TST_ROUTINE S br_op; lvars br_op, S; [ ldl \t rt0, (rusp) \n ;;; ________dfaddr \t lda \t rt1, _TRUEOFFS(rfalse) \n \t ldg \t f0, (rt0) \n \t ^br_op \t f0, 1$ \n \t stl \t rt1, (rusp) \n \t ret \t (rret) \n 1$: \t stl \t rfalse, (rusp) \n \t ret \t (rret) \n ].dl enddefine; >_# ;;; _pfneg(________dfaddr) -> ____bool .align quad DEF_C_LAB (_pfneg) TST_ROUTINE fbge ;;; _pfzero(________dfaddr) -> ____bool .align quad DEF_C_LAB (_pfzero) TST_ROUTINE fbne ;;; --- CONVERSION ------------------------------------------------------- ;;; ---- Routines to float sysints, decimals and ddecimals ;;; _pf_sfloat_dec(_______decimal) -> ________sfloat .align quad DEF_C_LAB (_pf_sfloat_dec) ldl rt0, (rusp) ;;; _______decimal bic rt0, #1, rt0 ;;; clear tag bit extwl rt0, #2, rt1 ;;; hi 16-bits -> lo inswl rt0, #2, rt0 ;;; lo 16-bits -> hi or rt0, rt1, rt0 ;;; or to make ________sfloat stl rt0, (rusp) ;;; return it ret (rret) ;;; _pf_dfloat_int(_____int, ________dfaddr) .align quad DEF_C_LAB (_pf_dfloat_int) lds f0, 4(rusp) ;;; long _____int ldl rt2, (rusp) ;;; ________dfaddr cvtlq f0, f0 ;;; extend _____int to quad cvtqg f0, f0 ;;; quad _____int -> ________dfloat lda rusp, 8(rusp) stg f0, (rt2) ;;; store at ________dfaddr ret (rret) ;;; _pf_dfloat_dec(_______decimal, ________dfaddr) .align quad DEF_C_LAB (_pf_dfloat_dec) ldl rt0, 4(rusp) ;;; _______decimal ldl rt2, (rusp) ;;; ________dfaddr bic rt0, #1, rt0 ;;; clear tag bit on _______decimal extwl rt0, #2, rt1 ;;; hi 16-bits -> lo inswl rt0, #2, rt0 ;;; lo 16-bits -> hi or rt0, rt1, rt0 ;;; or to make ________sfloat stl rt0, (rt2) ;;; store in mem ldf f0, (rt2) ;;; reload as float lda rusp, 8(rusp) stg f0, (rt2) ;;; store ________dfloat at ________dfaddr ret (rret) ;;; _pf_dfloat_ddec(________ddecimal, ________dfaddr) .align quad DEF_C_LAB (_pf_dfloat_ddec) ldl rt0, 4(rusp) ;;; ________ddecimal ldl rt3, (rusp) ;;; ________dfaddr ldl rt1, _DD_1(rt0) ldl rt2, _DD_2(rt0) lda rusp, 8(rusp) stl rt1, (rt3) stl rt2, 4(rt3) ret (rret) ;;; ---- Routines to convert back from a double float ;;; _pf_intof(________dfaddr) -> (_____int, ________dfaddr) or -> false ;;; get integer part of double floating as an integer .align quad DEF_C_LAB (_pf_intof) ldl rt0, (rusp) ;;; ________dfaddr ldg f0, (rt0) ;;; load the g float ldl rt1, (rt0) ;;; get expo part for overflow check cvtgq/c f0, f1 ;;; g float -> quad int sll rt1, #49, rt1 ;;; get exponent for check srl rt1, #53, rt1 cvtql f1, f1 ;;; quad int -> long int mov #1024+32, rt2 subl rt1, rt2, rt1 ;;; expo - (1024+32) bge rt1, 2$ ;;; overflow poss if expo >= (1024+32) ;;; else OK 1$: sts f1, (rusp) ;;; store int result stl rt0, -4(rusp) ;;; return ________dfaddr also lda rusp, -4(rusp) ret (rret) ;;; expo >= (1024+32), overflow possible 2$: bgt rt1, 3$ ;;; overflow if expo > (1024+32) ;;; expo = (1024+32) -- overflows if +ve, or -ve and result not -ve fbgt f0, 3$ ;;; overflows if positive fblt f1, 1$ ;;; else OK if result negative (-2**31) ;;; overflow 3$: stl rfalse, (rusp) ret (rret) ;;; _pf_cvt_to_dec(________dfaddr) -> _______decimal or false ;;; convert double to decimal (rounded to 21 bit mantissa), ;;; or return false if too large .align quad DEF_C_LAB (_pf_cvt_to_dec) ldl rt0, (rusp) ;;; ________dfaddr mov #^X3000, rt1 ;;; 23rd and 24th bits in mantissa ldl rt2, 4(rt0) ;;; part with ls 32 bits ldg f0, (rt0) ;;; get original to test zero bis rt2, rt1, rt3 ;;; set 23rd and 24th bits of mantissa stl rt3, 4(rt0) ;;; and replace in mem ldg f1, (rt0) ;;; then after loading as float ... stl rt2, 4(rt0) ;;; ... restore part we altered fcmovne f0, f1, f0 ;;; rounded flt to f0 if org nonzero fpe_s_cvtdec: cvtgf f0, f0 ;;; convert g float to f float ;;; can use "sts" to swap hi and lo 16-bits (can't use "lds" the ;;; other way round, because an exponent of 255 would get interpreted ;;; as IEEE Inf) sts f0, (rusp) ;;; store with halves swapped ldl rt0, (rusp) ;;; reload into int reg bis rt0, #1, rt0 ;;; set simple tag bit bic rt0, #2, rt0 ;;; clear integer tag bit stl rt0, (rusp) ;;; return _______decimal trapb ;;; signal any error fpe_e_cvtdec: ret (rret) ;;; _pf_cvt_to_ddec(________dfaddr, ________ddecimal) ;;; fill in given ddecimal .align quad DEF_C_LAB (_pf_cvt_to_ddec) ldl rt0, 4(rusp) ;;; ________dfaddr ldl rt3, (rusp) ;;; ________ddecimal ldl rt1, (rt0) ldl rt2, 4(rt0) lda rusp, 8(rusp) stl rt1, _DD_1(rt3) stl rt2, _DD_2(rt3) ret (rret) ;;; _pfmodf(__________fracaddr, ________dfaddr) ;;; frac part of ________dfaddr into __________fracaddr, int part back into ________dfaddr .align quad DEF_C_LAB (_pfmodf) ldl rt0, (rusp) ;;; ________dfaddr ldl rt1, 4(rusp) ;;; __________fracaddr ldg f0, (rt0) ;;; load the g float lda rusp, 8(rusp) stt f0, (rt0) ;;; store image of float reg ldq rt2, (rt0) ;;; ... and load into int reg sll rt2, #1, rt3 ;;; clear sign bit ... srl rt3, #53, rt3 ;;; ... and shift to get exponent alone mov #1025, rt4 subl rt4, rt3, rt3 ;;; 1025 - expo bgt rt3, 1$ ;;; br if expo <= 1024, no int part ;;; has nonzero int part addl rt3, #52, rt3 ;;; number of fractional ls bits ble rt3, 2$ ;;; if <= 0, no fractional bits srl rt2, rt3, rt2 ;;; clear the frac bits sll rt2, rt3, rt2 stq rt2, (rt0) ;;; store revised image ... ldt f1, (rt0) ;;; ... and back into float reg subg f0, f1, f0 ;;; subtract int part from original stg f1, (rt0) ;;; store int part in ________dfaddr stg f0, (rt1) ;;; and frac remainder in __________fracaddr ret (rret) ;;; entirely fractional 1$: stg f0, (rt1) ;;; store num in __________fracaddr stg f31, (rt0) ;;; and zero in ________dfaddr ret (rret) ;;; entirely integral 2$: stg f0, (rt0) ;;; store num in ________dfaddr stg f31, (rt1) ;;; and zero in __________fracaddr ret (rret) ;;; --- Routines to extract/update sfloat and dfloat field values ---- ;;; _pf_extend_s_to_d(________dfaddr) -> ________dfaddr or false ;;; extend single at ________dfaddr into double (VAX floats have no ;;; infinities so it never returns false) .align quad DEF_C_LAB (_pf_extend_s_to_d) ldl rt0, (rusp) ;;; ________dfaddr ldf f0, (rt0) stg f0, (rt0) ret (rret) ;;; _pf_check_d(________dfaddr) -> ________dfaddr or false ;;; check normal double at ________dfaddr (VAX floats have no ;;; infinities so nothing to do) .align quad DEF_C_LAB (_pf_check_d) ret (rret) ;;; _pf_round_d_to_s(________dfaddr) -> ________dfaddr or false ;;; round double to single back into ________dfaddr .align quad DEF_C_LAB (_pf_round_d_to_s) ldl rt0, (rusp) ;;; ________dfaddr ldg f0, (rt0) fpe_s_rdtos: cvtgf f0, f0 ;;; *** OVERFLOW *** stf f0, (rt0) trapb ;;; signal any error fpe_e_rdtos: ret (rret) ;;; --- GET/SET EXPONENT -------------------------------------------------- ;;; get and set exponent ___E of a double float, where ___E is ;;; the number of bits needed for the integer part, e.g. 1 for 1.0, ;;; 0 for 0.5, -1 for 0.05, etc. ;;; _pf_expof(________dfaddr) -> ___E .align quad DEF_C_LAB (_pf_expof) ldl rt0, (rusp) ;;; ________dfaddr mov #1024, rt1 ldl rt0, (rt0) ;;; part with exponent sll rt0, #49, rt0 srl rt0, #53, rt0 ;;; exponent subl rt0, rt1, rt0 ;;; ___E = expo - 1024 stl rt0, (rusp) ;;; return it ret (rret) ;;; ___E -> _pf_expof(________dfaddr) -> ________dfaddr or false ;;; (false if ___E too big/small ) .align quad DEF_C_LAB (-> _pf_expof) ldl rt0, 4(rusp) ;;; ___E mov #1024, rt2 ldl rt1, (rusp) ;;; ________dfaddr lda rusp, 4(rusp) addl rt0, rt2, rt0 ;;; new expo = ___E + 1024 ble rt0, 1$ ;;; underflow if 0 or neg mov #^X7FF0, rt2 ;;; mask for float exponent ldl rt3, (rt1) ;;; get part of float with exponent sll rt0, #4, rt0 ;;; new expo in position bic rt0, rt2, rt4 ;;; overflow if nonzero bne rt4, 1$ bic rt3, rt2, rt3 ;;; clear old expo or rt3, rt0, rt3 ;;; or in new stl rt3, (rt1) ;;; update float in mem ret (rret) 1$: stl rfalse, (rusp) ret (rret) ;;; --- USING LIBRARY MATHS FUNCTIONS ------------------------------------ ;;; _math1(________dfaddr, __________function) -> ________dfaddr or false ;;; result back into ________dfaddr .align quad DEF_C_LAB (_math1) ldl rpb, (rusp) ;;; __________function desc into r27 ldl r16, 4(rusp) ;;; ________dfaddr into first arg reg lda rusp, 4(rusp) mov #1, r25 ;;; arg count in AI reg do_call: mov sp, rt0 ;;; save sp bic sp, #15, sp ;;; octaword-align stack lda sp, -8*4(sp) ;;; enough for octa-aligned tmp frame stl rt0, 1*4(sp) ;;; save saved sp stl rsvb, 2*4(sp) ;;; save special var block stl rret, 3*4(sp) ;;; save return stl rnpl0, 4*4(sp) ;;; save 'unoffical' local (r20) stl rnpl1, 5*4(sp) ;;; " " " (r21) ldq rt0, 8(rpb) ;;; get __________function entry from desc mov #1, rt1 stl rusp, (sp) ;;; save usp stl rt1, _svb_INMATHLIB ;;; set Sys$- _in_math_lib to 1 jsr rret, (rt0) ;;; call the function ldl rsvb, 2*4(sp) ;;; restore special var block ldl rret, 3*4(sp) ;;; restore return ldl rnpl0, 4*4(sp) ;;; restore unoffical local ldl rnpl1, 5*4(sp) ;;; " " " ldl rusp, (sp) ;;; recover rusp ldl rfalse, _svb_FALSE ;;; restore rfalse ldl rt1, _svb_INMATHLIB ;;; get _in_math_lib ldl rt0, (rusp) ;;; ________dfaddr again stl rzero, _svb_INMATHLIB ;;; clear _in_math_lib stg f0, (rt0) ;;; store result at ________dfaddr cmovlbc rt1, rfalse, rt0 ;;; replace ________dfaddr with false if error ldl sp, 1*4(sp) ;;; restore stack stl rt0, (rusp) ;;; the result ldl rpb, _SF_OWNER(sp) ;;; restore caller's pb ret (rret) ;;; _math2(_________dfaddr1, _________dfaddr2, __________function) -> _________dfaddr1 or false ;;; result back into _________dfaddr1 .align quad DEF_C_LAB (_math2) ldl rpb, (rusp) ;;; __________function desc into r27 ldl r16, 8(rusp) ;;; _________dfaddr1 into first arg reg ldl r17, 4(rusp) ;;; _________dfaddr2 into second arg reg lda rusp, 8(rusp) mov #2, r25 ;;; arg count in AI reg br do_call ;;; --------------------------------------------------------------------- ASM_NWRIT_PSECT __pop_fpe_table:: .long fpe_s_addg, fpe_e_addg, fpe_error .long fpe_s_subg, fpe_e_subg, fpe_error .long fpe_s_mulg, fpe_e_mulg, fpe_error .long fpe_s_divg, fpe_e_divg, fpe_error .long fpe_s_cvtdec, fpe_e_cvtdec, fpe_error .long fpe_s_rdtos, fpe_e_rdtos, fpe_error .long 0, 0, 0 .end