; ; cmath.s ; ; Standard maths routines for Sapphire ; ; © 1995 Straylight ; ;----- Standard header ------------------------------------------------------ GET libs:header ; GET libs:swis GET libs:stream ;----- Macros --------------------------------------------------------------- MACRO $label ONEARG [ "$label"<>"" EXPORT $label ALIGN $label ] STMFD R13!,{R0,R1} LDFD F0,[R13],#8 MEND MACRO $label TWOARG [ "$label"<>"" EXPORT $label ALIGN $label ] STMFD R13!,{R0-R3} LDFD F0,[R13],#8 LDFD F1,[R13],#8 MEND MACRO $label UNOP $op $label ONEARG $op.E F0,F0 MOVS PC,R14 MEND MACRO CTOP MOV R1,#0 RFS R12 WFS R1 MEND MACRO CBOT RFS R1 WFS R12 TST R1,#&0F MOVEQS PC,R14 B cmath__error MEND MACRO COP $op CTOP $op CBOT MEND MACRO $label CUNOP $op $label ONEARG COP "$op.E F0,F0" MEND MACRO $label CBINOP $op $label TWOARG COP "$op.E F0,F0,F1" MEND MACRO WS $addr,$reg,$tmp IMPORT |__sph_workoff|,WEAK ALIGN LDR $reg,$addr DCD |__sph_workoff| + &E51B0004 + ($tmp<<12) MEND ;----- Error numbers -------------------------------------------------------- ^ 1 EDOM # 1 ERANGE # 1 ;----- Main code ------------------------------------------------------------ AREA |Sapphire$$Code|,CODE,READONLY ; --- Simple FP ops --- ; ; These map onto FP instructions in a simple way. Some of ; the simpler ops are actually inlined by the compiler ; anyway. sin UNOP SIN cos UNOP COS atan UNOP ATN tan CUNOP TAN asin CUNOP ASN acos CUNOP ACS atan2 TWOARG COP "POLE F0,F1,F0" exp CUNOP EXP log CUNOP LGN log10 CUNOP LOG |__sapph_sqrt| CUNOP SQT pow CBINOP POW fabs UNOP ABS fmod TWOARG CTOP DVFE F2,F0,F1 RNDEZ F2,F2 MUFE F1,F2,F1 SUFE F0,F0,F1 CBOT ; --- Rounding functions --- ceil ONEARG RNDEP F0,F0 MOVS PC,R14 floor ONEARG RNDEM F0,F0 MOVS PC,R14 modf ONEARG RNDEZ F1,F0 SUFE F0,F0,F1 STFD F1,[R2,#0] MOVS PC,R14 ; --- Hyperbolic functions --- sinh ONEARG CTOP MNFE F1,F0 EXPE F0,F0 EXPE F1,F1 SUFE F0,F0,F1 DVFE F0,F0,#2 CBOT cosh ONEARG CTOP MNFE F1,F0 EXPE F0,F0 EXPE F1,F1 ADFE F0,F0,F1 DVFE F0,F0,#2 CBOT tanh ONEARG CTOP MNFE F1,F0 EXPE F0,F0 EXPE F1,F1 ADFE F2,F0,F1 SUFE F0,F0,F1 DVFE F0,F0,F2 CBOT ; --- Horrific FP-number-building functions --- EXPORT frexp frexp ROUT MOVS R3,R0,LSL #1 CMPEQ R1,#0 MOVNE R3,R0,LSR #20 BICNE R3,R3,#&800 ADDNE R3,R3,#2 SUBNE R3,R3,#1024 BICNE R0,R0,#&40000000 BICNE R0,R0,#&00100000 ORRNE R0,R0,#&3FC00000 ORRNE R0,R0,#&00200000 STR R3,[R2,#0] ONEARG NRME F0,F0 MOVS PC,R14 LTORG EXPORT ldexp ldexp ROUT ADD R2,R2,#1024 SUB R2,R2,#1 MOV R2,R2,LSL #21 MOV R2,R2,LSR #1 MOV R3,#0 TWOARG CTOP MUFE F0,F0,F1 CBOT LTORG ; --- Error handling --- ; --- cmath__error --- ; ; On entry: R1 == error status indicator ; ; On exit: errno set up nicely ; ; Use: Handles errors in maths routines. cmath__error ROUT TST R1,#&3 ;Check for IVO and DVZ MOVNE R0,#EDOM ;Domain error BNE %50cmath__error ;So return that then TST R1,#&8 ;Check for UFL condition MVFNEE F0,#0 ;Underflowed -- zero result MOVNE R0,#ERANGE ;And return a range error BNE %50cmath__error ;And return the result CMFE F0,#0 ;Is result positive? LDFGTD F0,cmath__huge ;Yes -- get positive huge LDFLED F0,cmath__nhuge ;No -- get negative huge MOV R0,#ERANGE ;And return a range error 50cmath__error WS cmath__wSpace,R12,R3 ;Find workspace location STR R0,[R12,R3] ;Store the error value MOVS PC,R14 ;And return to caller EXPORT cmath__huge cmath__huge DCD &7FEFFFFF,-1 cmath__nhuge DCD &FFEFFFFF,-1 LTORG ; --- cmath_errno --- ; ; On entry: -- ; ; On exit: R0 == address of `errno' ; ; Use: Finds the address of the `errno' variable. EXPORT cmath_errno cmath_errno ROUT WS cmath__wSpace,R12,R0 ADD R0,R12,R0 MOVS PC,R14 LTORG cmath__wSpace DCD 0 ;----- Workspace ------------------------------------------------------------ ^ 0,R12 cmath__wStart # 0 cmath__errno # 4 ;Global `errno' variable cmath__wSize EQU {VAR}-cmath__wStart AREA |Sapphire$$LibData|,CODE,READONLY DCD cmath__wSize DCD cmath__wSpace DCD 0 DCD 0 ;----- That's all, folks ---------------------------------------------------- END