1 /*
2 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
3 %
4 % File: PXK:FLOAT.C
5 % Description: Miscellaneous floating point support routines for armv6 (Raspberry Pi)
6 % Author: Leigh Stoller
7 % Created: 29-Oct-86
8 % Modified:
9 % Mode: Text
10 % Package:
11 % Status: Open Source: BSD License
12 %
13 % (c) Copyright 1982, University of Utah
14 %
15 % Redistribution and use in source and binary forms, with or without
16 % modification, are permitted provided that the following conditions are met:
17 %
18 % * Redistributions of source code must retain the relevant copyright
19 % notice, this list of conditions and the following disclaimer.
20 % * Redistributions in binary form must reproduce the above copyright
21 % notice, this list of conditions and the following disclaimer in the
22 % documentation and/or other materials provided with the distribution.
23 %
24 % THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
25 % AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
26 % THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
27 % PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR
28 % CONTRIBUTORS
29 % BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
30 % CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
31 % SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
32 % INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
33 % CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
34 % ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
35 % POSSIBILITY OF SUCH DAMAGE.
36 %
37 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
38 %
39 % Revisions:
40 %
41 % 05-May-87 (Leigh Stoller)
42 % Added C defintions for external float routines used in fast-math.sl.
43 %
44 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
45 */
46
47 #include <stdio.h>
48 #include <string.h>
49 #include <math.h>
50 #include <fenv.h>
51
52 #ifdef USE_CRLIBM
53 #include "crlibm.h"
54
55 #define sin sin_rn
56 #define cos cos_rn
57 #define tan tan_rn
58 #define asin asin_rn
59 #define acos acos_rn
60 #define atan atan_rn
61 #define exp exp_rn
62 #define log log_rn
63
64 #endif
65
66 /* Tag( uxfloat )
67 */
68 void
uxfloat(f,i)69 uxfloat(f,i)
70 double *f;
71 int i;
72 {
73 *f = i;
74 }
75
76 /* Tag( uxfix )
77 */
uxfix(f)78 int uxfix(f)
79 double *f;
80 {
81 return *f;
82 }
83
84 /* Tag( uxassign )
85 */
86 void
uxassign(f1,f2)87 uxassign(f1,f2)
88 double *f1, *f2;
89 {
90 *f1 = *f2;
91 }
92
93 fexcept_t flagp;
94
95 int
uxminus(f1,f2)96 uxminus(f1,f2)
97 double *f1, *f2;
98 {
99 *f1 = -*f2;
100 fegetexceptflag(&flagp, FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID);
101 if(flagp != 0) {feclearexcept(FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID); return (0);}
102 return (1);
103 }
104
105 /* Tag( uxplus2 )
106 */
107 int
uxplus2(f1,f2,f3)108 uxplus2(f1,f2,f3)
109 double *f1, *f2, *f3;
110 {
111 *f1 = *f2 + *f3;
112 fegetexceptflag(&flagp, FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID);
113 if(flagp != 0) {feclearexcept(FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID); return (0);}
114 return (1);
115 }
116
117 /* Tag( uxdifference )
118 */
119 int
uxdifference(f1,f2,f3)120 uxdifference(f1,f2,f3)
121 double *f1, *f2, *f3;
122 {
123 *f1 = *f2 - *f3;
124 fegetexceptflag(&flagp, FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID);
125 if(flagp != 0) {feclearexcept(FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID); return (0);}
126 return (1);
127 }
128
129 /* Tag( uxtimes2 )
130 */
131 int
uxtimes2(f1,f2,f3)132 uxtimes2(f1,f2,f3)
133 double *f1, *f2, *f3;
134 {
135 *f1 = *f2 * *f3;
136 fegetexceptflag(&flagp, FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID);
137 if(flagp != 0) {feclearexcept(FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID); return (0);}
138 return (1);
139 }
140
141 /* Tag( uxquotient )
142 */
143 int
uxquotient(f1,f2,f3)144 uxquotient(f1,f2,f3)
145 double *f1, *f2, *f3;
146 {
147 *f1 = *f2 / *f3;
148 fegetexceptflag(&flagp, FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID);
149 if(flagp != 0) {feclearexcept(FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID); return (0);}
150 return (1);
151 }
152
153 /* Tag( uxgreaterp )
154 */
uxgreaterp(f1,f2,val1,val2)155 int uxgreaterp(f1,f2,val1,val2)
156 double *f1, *f2;
157 int val1, val2;
158 {
159 if (*f1 > *f2)
160 return val1;
161 else
162 return val2;
163 }
164
165 /* Tag( uxlessp )
166 */
uxlessp(f1,f2,val1,val2)167 int uxlessp(f1,f2,val1,val2)
168 double *f1, *f2;
169 int val1, val2;
170 {
171 if (*f1 < *f2)
172 return val1;
173 else
174 return val2;
175 }
176
177 /* Tag( uxwritefloat )
178 */
179 void
uxwritefloat(buf,flt,convstr)180 uxwritefloat(buf, flt, convstr)
181 char *buf; /* String buffer to return float int */
182 double *flt; /* Pointer to the float */
183 char *convstr; /* String containing conversion field for sprintf */
184 {
185 char *temps, *dot, *e;
186 char tempbuf[102]; /* reasonable size limit */
187 double tempf;
188
189 temps = buf + 4; /* Skip over lisp string length to write data */
190
191 snprintf(temps, 99, convstr, *flt);
192
193 if (finite(*flt))
194 {
195 /* Make sure that there is a trailing .0
196 */
197 dot = rindex(temps, '.');
198 if (dot == NULL)
199 /* Check to see if the number is in scientific notation. If so, we need
200 * add the .0 into the middle of the string, just before the e.
201 */
202 if ((e = rindex(temps, 'e')) || (e = rindex(temps, 'E')))
203 {
204 strcpy(tempbuf, e); /* save save exponent part */
205 *e = '\0';
206 strcat(temps, ".0"); /* Add .0 onto original string */
207 strcat(temps, tempbuf); /* add the exponent part onto the end */
208 }
209 else
210 {
211 strcat(temps, ".0");
212 }
213 }
214 /* Install the length of the string into the Lisp header word
215 */
216 *((int *)buf) = strlen(temps) - 1;
217 }
218
219
220 /* Tag( uxdoubletofloat )
221 */
222 void
uuxdoubletofloat(dbl,flt)223 uuxdoubletofloat (dbl,flt)
224 double *dbl;
225 float *flt;
226 {
227 *flt = (float) *dbl;
228 }
229
230 void
uuxfloattodouble(flt,dbl)231 uuxfloattodouble (flt,dbl)
232 float *flt;
233 double *dbl;
234 {
235 *dbl = (double) *flt;
236 }
237
238 /* Functions for fast-math.sl (Unix C replacement for mathlib.) */
239 int
uuxsin(r,x)240 uuxsin (r, x)
241 double *r, *x;
242 {
243 *r = sin( *x );
244 fegetexceptflag(&flagp, FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID);
245 if(flagp != 0) {feclearexcept(FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID); return (0);}
246 return (1);
247 }
248
249 int
uuxcos(r,x)250 uuxcos (r, x)
251 double *r, *x;
252 {
253 *r = cos( *x );
254 }
255
256 int
uuxtan(r,x)257 uuxtan (r, x)
258 double *r, *x;
259 {
260 *r = tan( *x );
261 fegetexceptflag(&flagp, FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID);
262 if(flagp != 0) {feclearexcept(FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID); return (0);}
263 return (1);
264 }
265
266 int
uuxasin(r,x)267 uuxasin (r, x)
268 double *r, *x;
269 {
270 *r = asin( *x );
271 fegetexceptflag(&flagp, FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID);
272 if(flagp != 0) {feclearexcept(FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID); return (0);}
273 return (1);
274 }
275
276 int
uuxacos(r,x)277 uuxacos (r, x)
278 double *r, *x;
279 {
280 *r = acos( *x );
281 }
282
283 int
uuxatan(r,x)284 uuxatan (r, x)
285 double *r, *x;
286 {
287 *r = atan( *x );
288 fegetexceptflag(&flagp, FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID);
289 if(flagp != 0) {feclearexcept(FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID); return (0);}
290 return (1);
291 }
292
293 int
uuxsqrt(r,x)294 uuxsqrt (r, x)
295 double *r, *x;
296 {
297 *r = sqrt( *x );
298 fegetexceptflag(&flagp, FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID);
299 if(flagp != 0) {feclearexcept(FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID); return (0);}
300 return (1);
301 }
302
303 int
uuxexp(r,x)304 uuxexp (r, x)
305 double *r, *x;
306 {
307 *r = exp( *x );
308 fegetexceptflag(&flagp, FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID);
309 if(flagp != 0) {feclearexcept(FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID); return (0);}
310 return (1);
311 }
312
313 int
uuxlog(r,x)314 uuxlog (r, x)
315 double *r, *x;
316 {
317 *r = log( *x );
318 fegetexceptflag(&flagp, FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID);
319 if(flagp != 0) {feclearexcept(FE_OVERFLOW | FE_DIVBYZERO | FE_INVALID); return (0);}
320 return (1);
321 }
322
323 int
uuxatan2(r,y,x)324 uuxatan2 (r, y, x)
325 double *r, *y, *x;
326 {
327 *r = atan2( *y, *x );
328 fegetexceptflag(&flagp, FE_OVERFLOW | FE_DIVBYZERO);
329 if(flagp != 0) {feclearexcept(FE_OVERFLOW | FE_DIVBYZERO); return (0);}
330 return (1);
331 }
332