;
; 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
