Initial revision
[ssr] / StraySrc / Libraries / Sapphire / csapph / s / cmath
1 ;
2 ; cmath.s
3 ;
4 ; Standard maths routines for Sapphire
5 ;
6 ; © 1995 Straylight
7 ;
8
9 ;----- Standard header ------------------------------------------------------
10
11 GET libs:header
12 ; GET libs:swis
13
14 GET libs:stream
15
16 ;----- Macros ---------------------------------------------------------------
17
18 MACRO
19 $label ONEARG
20 [ "$label"<>""
21 EXPORT $label
22 ALIGN
23 $label
24 ]
25 STMFD R13!,{R0,R1}
26 LDFD F0,[R13],#8
27 MEND
28
29 MACRO
30 $label TWOARG
31 [ "$label"<>""
32 EXPORT $label
33 ALIGN
34 $label
35 ]
36 STMFD R13!,{R0-R3}
37 LDFD F0,[R13],#8
38 LDFD F1,[R13],#8
39 MEND
40
41 MACRO
42 $label UNOP $op
43 $label ONEARG
44 $op.E F0,F0
45 MOVS PC,R14
46 MEND
47
48 MACRO
49 CTOP
50 MOV R1,#0
51 RFS R12
52 WFS R1
53 MEND
54
55 MACRO
56 CBOT
57 RFS R1
58 WFS R12
59 TST R1,#&0F
60 MOVEQS PC,R14
61 B cmath__error
62 MEND
63
64 MACRO
65 COP $op
66 CTOP
67 $op
68 CBOT
69 MEND
70
71 MACRO
72 $label CUNOP $op
73 $label ONEARG
74 COP "$op.E F0,F0"
75 MEND
76
77 MACRO
78 $label CBINOP $op
79 $label TWOARG
80 COP "$op.E F0,F0,F1"
81 MEND
82
83 MACRO
84 WS $addr,$reg,$tmp
85 IMPORT |__sph_workoff|,WEAK
86 ALIGN
87 LDR $reg,$addr
88 DCD |__sph_workoff| + &E51B0004 + ($tmp<<12)
89 MEND
90
91 ;----- Error numbers --------------------------------------------------------
92
93 ^ 1
94 EDOM # 1
95 ERANGE # 1
96
97 ;----- Main code ------------------------------------------------------------
98
99 AREA |Sapphire$$Code|,CODE,READONLY
100
101 ; --- Simple FP ops ---
102 ;
103 ; These map onto FP instructions in a simple way. Some of
104 ; the simpler ops are actually inlined by the compiler
105 ; anyway.
106
107 sin UNOP SIN
108 cos UNOP COS
109 atan UNOP ATN
110
111 tan CUNOP TAN
112 asin CUNOP ASN
113 acos CUNOP ACS
114
115 atan2 TWOARG
116 COP "POLE F0,F1,F0"
117
118 exp CUNOP EXP
119 log CUNOP LGN
120 log10 CUNOP LOG
121
122 |__sapph_sqrt| CUNOP SQT
123 pow CBINOP POW
124
125 fabs UNOP ABS
126
127 fmod TWOARG
128 CTOP
129 DVFE F2,F0,F1
130 RNDEZ F2,F2
131 MUFE F1,F2,F1
132 SUFE F0,F0,F1
133 CBOT
134
135 ; --- Rounding functions ---
136
137 ceil ONEARG
138 RNDEP F0,F0
139 MOVS PC,R14
140
141 floor ONEARG
142 RNDEM F0,F0
143 MOVS PC,R14
144
145 modf ONEARG
146 RNDEZ F1,F0
147 SUFE F0,F0,F1
148 STFD F1,[R2,#0]
149 MOVS PC,R14
150
151 ; --- Hyperbolic functions ---
152
153 sinh ONEARG
154 CTOP
155 MNFE F1,F0
156 EXPE F0,F0
157 EXPE F1,F1
158 SUFE F0,F0,F1
159 DVFE F0,F0,#2
160 CBOT
161
162 cosh ONEARG
163 CTOP
164 MNFE F1,F0
165 EXPE F0,F0
166 EXPE F1,F1
167 ADFE F0,F0,F1
168 DVFE F0,F0,#2
169 CBOT
170
171 tanh ONEARG
172 CTOP
173 MNFE F1,F0
174 EXPE F0,F0
175 EXPE F1,F1
176 ADFE F2,F0,F1
177 SUFE F0,F0,F1
178 DVFE F0,F0,F2
179 CBOT
180
181 ; --- Horrific FP-number-building functions ---
182
183 EXPORT frexp
184 frexp ROUT
185
186 MOVS R3,R0,LSL #1
187 CMPEQ R1,#0
188 MOVNE R3,R0,LSR #20
189 BICNE R3,R3,#&800
190 ADDNE R3,R3,#2
191 SUBNE R3,R3,#1024
192 BICNE R0,R0,#&40000000
193 BICNE R0,R0,#&00100000
194 ORRNE R0,R0,#&3FC00000
195 ORRNE R0,R0,#&00200000
196 STR R3,[R2,#0]
197 ONEARG
198 NRME F0,F0
199 MOVS PC,R14
200
201 LTORG
202
203 EXPORT ldexp
204 ldexp ROUT
205
206 ADD R2,R2,#1024
207 SUB R2,R2,#1
208 MOV R2,R2,LSL #21
209 MOV R2,R2,LSR #1
210 MOV R3,#0
211 TWOARG
212 CTOP
213 MUFE F0,F0,F1
214 CBOT
215
216 LTORG
217
218 ; --- Error handling ---
219
220 ; --- cmath__error ---
221 ;
222 ; On entry: R1 == error status indicator
223 ;
224 ; On exit: errno set up nicely
225 ;
226 ; Use: Handles errors in maths routines.
227
228 cmath__error ROUT
229
230 TST R1,#&3 ;Check for IVO and DVZ
231 MOVNE R0,#EDOM ;Domain error
232 BNE %50cmath__error ;So return that then
233
234 TST R1,#&8 ;Check for UFL condition
235 MVFNEE F0,#0 ;Underflowed -- zero result
236 MOVNE R0,#ERANGE ;And return a range error
237 BNE %50cmath__error ;And return the result
238
239 CMFE F0,#0 ;Is result positive?
240 LDFGTD F0,cmath__huge ;Yes -- get positive huge
241 LDFLED F0,cmath__nhuge ;No -- get negative huge
242 MOV R0,#ERANGE ;And return a range error
243
244 50cmath__error
245 WS cmath__wSpace,R12,R3 ;Find workspace location
246 STR R0,[R12,R3] ;Store the error value
247 MOVS PC,R14 ;And return to caller
248
249 EXPORT cmath__huge
250 cmath__huge DCD &7FEFFFFF,-1
251 cmath__nhuge DCD &FFEFFFFF,-1
252
253 LTORG
254
255 ; --- cmath_errno ---
256 ;
257 ; On entry: --
258 ;
259 ; On exit: R0 == address of `errno'
260 ;
261 ; Use: Finds the address of the `errno' variable.
262
263 EXPORT cmath_errno
264 cmath_errno ROUT
265
266 WS cmath__wSpace,R12,R0
267 ADD R0,R12,R0
268 MOVS PC,R14
269
270 LTORG
271
272 cmath__wSpace DCD 0
273
274 ;----- Workspace ------------------------------------------------------------
275
276 ^ 0,R12
277 cmath__wStart # 0
278
279 cmath__errno # 4 ;Global `errno' variable
280
281 cmath__wSize EQU {VAR}-cmath__wStart
282
283 AREA |Sapphire$$LibData|,CODE,READONLY
284
285 DCD cmath__wSize
286 DCD cmath__wSpace
287 DCD 0
288 DCD 0
289
290 ;----- That's all, folks ----------------------------------------------------
291
292 END