94 |
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL |
LLLLLLLLLLLLLLLLLLLLLLLLLLLLLLLL |
95 |
*/ |
*/ |
96 |
#endif |
#endif |
97 |
integer_decode_double(d, hp, lp, ep, sp) |
void |
98 |
double d; |
integer_decode_double(double d, int *hp, int *lp, int *ep, int *sp) |
|
int *hp, *lp, *ep, *sp; |
|
99 |
{ |
{ |
100 |
int h, l; |
int h, l; |
101 |
|
|
122 |
#ifdef IEEEFLOAT |
#ifdef IEEEFLOAT |
123 |
if (ISNORMAL(d)) { |
if (ISNORMAL(d)) { |
124 |
*ep = ((h & 0x7ff00000) >> 20) - 1022 - 53; |
*ep = ((h & 0x7ff00000) >> 20) - 1022 - 53; |
125 |
h = (h & 0x000fffff | 0x00100000); |
h = ((h & 0x000fffff) | 0x00100000); |
126 |
} else { |
} else { |
127 |
*ep = ((h & 0x7fe00000) >> 20) - 1022 - 53 + 1; |
*ep = ((h & 0x7fe00000) >> 20) - 1022 - 53 + 1; |
128 |
h = (h & 0x001fffff); |
h = (h & 0x001fffff); |
182 |
SEEEEEEEMMMMMMMMMMMMMMMMMMMMMMMM |
SEEEEEEEMMMMMMMMMMMMMMMMMMMMMMMM |
183 |
*/ |
*/ |
184 |
#endif |
#endif |
185 |
integer_decode_float(d, mp, ep, sp) |
void |
186 |
double d; |
integer_decode_float(double d, int *mp, int *ep, int *sp) |
|
int *mp, *ep, *sp; |
|
187 |
{ |
{ |
188 |
float f; |
float f; |
189 |
int m; |
int m; |
207 |
#ifdef IEEEFLOAT |
#ifdef IEEEFLOAT |
208 |
if (ISNORMAL(f)) { |
if (ISNORMAL(f)) { |
209 |
*ep = ((m & 0x7f800000) >> 23) - 126 - 24; |
*ep = ((m & 0x7f800000) >> 23) - 126 - 24; |
210 |
*mp = m & 0x007fffff | 0x00800000; |
*mp = (m & 0x007fffff) | 0x00800000; |
211 |
} else { |
} else { |
212 |
*ep = ((m & 0x7f000000) >> 23) - 126 - 24 + 1; |
*ep = ((m & 0x7f000000) >> 23) - 126 - 24 + 1; |
213 |
*mp = m & 0x00ffffff; |
*mp = m & 0x00ffffff; |
225 |
} |
} |
226 |
|
|
227 |
int |
int |
228 |
double_exponent(d) |
double_exponent(double d) |
|
double d; |
|
229 |
{ |
{ |
230 |
if (d == 0.0) |
if (d == 0.0) |
231 |
return(0); |
return(0); |
251 |
} |
} |
252 |
|
|
253 |
double |
double |
254 |
set_exponent(d, e) |
set_exponent(double d, int e) |
|
double d; |
|
|
int e; |
|
255 |
{ |
{ |
256 |
double dummy; |
double dummy; |
257 |
|
|
268 |
#ifdef NS32K |
#ifdef NS32K |
269 |
|
|
270 |
#else |
#else |
271 |
= *((int *)(&d) + HIND) & 0x800fffff | ((e + 1022) << 20) & 0x7ff00000; |
= (*((int *)(&d) + HIND) & 0x800fffff) | (((e + 1022) << 20) & 0x7ff00000); |
272 |
#endif |
#endif |
273 |
#endif |
#endif |
274 |
#ifdef MV |
#ifdef MV |
283 |
|
|
284 |
|
|
285 |
object |
object |
286 |
double_to_integer(d) |
double_to_integer(double d) |
|
double d; |
|
287 |
{ |
{ |
288 |
int h, l, e, s; |
int h, l, e, s; |
289 |
object x, y; |
object x; |
290 |
object shift_integer(); |
object shift_integer(object x, int w); |
291 |
vs_mark; |
vs_mark; |
292 |
|
|
293 |
if (d == 0.0) |
if (d == 0.0) |
347 |
} |
} |
348 |
|
|
349 |
object |
object |
350 |
num_remainder(x, y, q) |
num_remainder(object x, object y, object q) |
|
object x, y, q; |
|
351 |
{ |
{ |
352 |
object z; |
object z; |
353 |
|
|
354 |
z = number_times(q, y); |
z = number_times(q, y); |
355 |
vs_push(z); |
vs_push(z); |
356 |
z = number_minus(x, z); |
z = number_minus(x, z); |
357 |
vs_pop; |
vs_popp; |
358 |
return(z); |
return(z); |
359 |
} |
} |
360 |
|
|
361 |
/* Coerce X to single-float if one arg, |
/* Coerce X to single-float if one arg, |
362 |
otherwise coerce to same float type as second arg */ |
otherwise coerce to same float type as second arg */ |
363 |
|
|
364 |
Lfloat() |
void |
365 |
|
Lfloat(void) |
366 |
{ |
{ |
367 |
double d; |
double d; |
368 |
int narg; |
int narg; |
369 |
object x; |
object x; |
370 |
enum type t; |
enum type t=t_other; |
371 |
|
|
372 |
narg = vs_top - vs_base; |
narg = vs_top - vs_base; |
373 |
if (narg < 1) |
if (narg < 1) |
414 |
vs_push(x); |
vs_push(x); |
415 |
} |
} |
416 |
|
|
417 |
Lnumerator() |
void |
418 |
|
Lnumerator(void) |
419 |
{ |
{ |
420 |
check_arg(1); |
check_arg(1); |
421 |
check_type_rational(&vs_base[0]); |
check_type_rational(&vs_base[0]); |
423 |
vs_base[0] = vs_base[0]->rat.rat_num; |
vs_base[0] = vs_base[0]->rat.rat_num; |
424 |
} |
} |
425 |
|
|
426 |
Ldenominator() |
void |
427 |
|
Ldenominator(void) |
428 |
{ |
{ |
429 |
check_arg(1); |
check_arg(1); |
430 |
check_type_rational(&vs_base[0]); |
check_type_rational(&vs_base[0]); |
434 |
vs_base[0] = small_fixnum(1); |
vs_base[0] = small_fixnum(1); |
435 |
} |
} |
436 |
|
|
437 |
Lfloor() |
void |
438 |
|
Lfloor(void) |
439 |
{ |
{ |
440 |
object x, y, q, q1; |
object x, y, q, q1; |
441 |
double d; |
double d; |
442 |
int n; |
int n; |
443 |
object one_minus(); |
object one_minus(object x); |
444 |
|
|
445 |
n = vs_top - vs_base; |
n = vs_top - vs_base; |
446 |
if (n == 0) |
if (n == 0) |
553 |
vs_push(q1); |
vs_push(q1); |
554 |
vs_push(num_remainder(x, y, q1)); |
vs_push(num_remainder(x, y, q1)); |
555 |
return; |
return; |
556 |
|
default: |
557 |
|
break; |
558 |
} |
} |
559 |
} |
} |
560 |
|
|
561 |
Lceiling() |
void |
562 |
|
Lceiling(void) |
563 |
{ |
{ |
564 |
object x, y, q, q1; |
object x, y, q, q1; |
565 |
double d; |
double d; |
566 |
int n; |
int n; |
567 |
object one_plus(); |
object one_plus(object x); |
568 |
|
|
569 |
n = vs_top - vs_base; |
n = vs_top - vs_base; |
570 |
if (n == 0) |
if (n == 0) |
677 |
vs_push(q1); |
vs_push(q1); |
678 |
vs_push(num_remainder(x, y, q1)); |
vs_push(num_remainder(x, y, q1)); |
679 |
return; |
return; |
680 |
|
default: |
681 |
|
break; |
682 |
} |
} |
683 |
} |
} |
684 |
|
|
685 |
Ltruncate() |
void |
686 |
|
Ltruncate(void) |
687 |
{ |
{ |
688 |
object x, y, q, q1; |
object x, y, q, q1; |
689 |
int n; |
int n; |
762 |
vs_push(q1); |
vs_push(q1); |
763 |
vs_push(num_remainder(x, y, q1)); |
vs_push(num_remainder(x, y, q1)); |
764 |
return; |
return; |
765 |
|
default: |
766 |
|
break; |
767 |
} |
} |
768 |
} |
} |
769 |
|
|
770 |
Lround() |
void |
771 |
|
Lround(void) |
772 |
{ |
{ |
773 |
object x, y, q, q1, r; |
object x, y, q, q1, r; |
774 |
double d; |
double d; |
775 |
int n, c; |
int n, c; |
776 |
object one_plus(), one_minus(); |
object one_plus(object x), one_minus(object x); |
777 |
|
|
778 |
n = vs_top - vs_base; |
n = vs_top - vs_base; |
779 |
if (n == 0) |
if (n == 0) |
895 |
vs_push(q1); |
vs_push(q1); |
896 |
vs_push(num_remainder(x, y, q1)); |
vs_push(num_remainder(x, y, q1)); |
897 |
return; |
return; |
898 |
|
default: |
899 |
|
break; |
900 |
} |
} |
901 |
} |
} |
902 |
|
|
903 |
Lmod() |
void |
904 |
|
Lmod(void) |
905 |
{ |
{ |
906 |
check_arg(2); |
check_arg(2); |
907 |
Lfloor(); |
Lfloor(); |
908 |
vs_base++; |
vs_base++; |
909 |
} |
} |
910 |
|
|
911 |
Lrem() |
void |
912 |
|
Lrem(void) |
913 |
{ |
{ |
914 |
check_arg(2); |
check_arg(2); |
915 |
Ltruncate(); |
Ltruncate(); |
917 |
} |
} |
918 |
|
|
919 |
|
|
920 |
Ldecode_float() |
void |
921 |
|
Ldecode_float(void) |
922 |
{ |
{ |
923 |
object x; |
object x; |
924 |
double d; |
double d; |
951 |
} |
} |
952 |
} |
} |
953 |
|
|
954 |
Lscale_float() |
void |
955 |
|
Lscale_float(void) |
956 |
{ |
{ |
957 |
object x; |
object x; |
958 |
double d; |
double d; |
959 |
int e, k; |
int e, k=0; |
960 |
|
|
961 |
check_arg(2); |
check_arg(2); |
962 |
check_type_float(&vs_base[0]); |
check_type_float(&vs_base[0]); |
977 |
|
|
978 |
#endif |
#endif |
979 |
#ifdef IEEEFLOAT |
#ifdef IEEEFLOAT |
980 |
if (type_of(x) == t_shortfloat && (e <= -126 || e >= 130) || |
if ((type_of(x) == t_shortfloat && (e <= -126 || e >= 130)) || |
981 |
type_of(x) == t_longfloat && (e <= -1022 || e >= 1026)) |
(type_of(x) == t_longfloat && (e <= -1022 || e >= 1026))) |
982 |
#endif |
#endif |
983 |
#ifdef MV |
#ifdef MV |
984 |
|
|
988 |
#endif |
#endif |
989 |
FEerror("~S is an illegal exponent.", 1, vs_base[1]); |
FEerror("~S is an illegal exponent.", 1, vs_base[1]); |
990 |
d = set_exponent(d, e); |
d = set_exponent(d, e); |
991 |
vs_pop; |
vs_popp; |
992 |
if (type_of(x) == t_shortfloat) |
if (type_of(x) == t_shortfloat) |
993 |
vs_base[0] = make_shortfloat((shortfloat)d); |
vs_base[0] = make_shortfloat((shortfloat)d); |
994 |
else |
else |
995 |
vs_base[0] = make_longfloat(d); |
vs_base[0] = make_longfloat(d); |
996 |
} |
} |
997 |
|
|
998 |
Lfloat_radix() |
void |
999 |
|
Lfloat_radix(void) |
1000 |
{ |
{ |
1001 |
check_arg(1); |
check_arg(1); |
1002 |
check_type_float(&vs_base[0]); |
check_type_float(&vs_base[0]); |
1017 |
#endif |
#endif |
1018 |
} |
} |
1019 |
|
|
1020 |
Lfloat_sign() |
void |
1021 |
|
Lfloat_sign(void) |
1022 |
{ |
{ |
1023 |
object x; |
object x; |
1024 |
int narg; |
int narg; |
1056 |
vs_push(make_longfloat(f)); |
vs_push(make_longfloat(f)); |
1057 |
} |
} |
1058 |
|
|
1059 |
Lfloat_digits() |
void |
1060 |
|
Lfloat_digits(void) |
1061 |
{ |
{ |
1062 |
check_arg(1); |
check_arg(1); |
1063 |
check_type_float(&vs_base[0]); |
check_type_float(&vs_base[0]); |
1067 |
vs_base[0] = small_fixnum(53); |
vs_base[0] = small_fixnum(53); |
1068 |
} |
} |
1069 |
|
|
1070 |
Lfloat_precision() |
void |
1071 |
|
Lfloat_precision(void) |
1072 |
{ |
{ |
1073 |
object x; |
object x; |
1074 |
|
|
1101 |
#endif |
#endif |
1102 |
} |
} |
1103 |
|
|
1104 |
Linteger_decode_float() |
void |
1105 |
|
Linteger_decode_float(void) |
1106 |
{ |
{ |
1107 |
object x; |
object x; |
1108 |
int h, l, e, s; |
int h, l, e, s; |
1127 |
} |
} |
1128 |
} |
} |
1129 |
|
|
1130 |
Lcomplex() |
void |
1131 |
|
Lcomplex(void) |
1132 |
{ |
{ |
1133 |
object x, r, i; |
object r, i; |
1134 |
int narg; |
int narg; |
1135 |
|
|
1136 |
narg = vs_top - vs_base; |
narg = vs_top - vs_base; |
1150 |
vs_push(make_complex(r, i)); |
vs_push(make_complex(r, i)); |
1151 |
} |
} |
1152 |
|
|
1153 |
Lrealpart() |
void |
1154 |
|
Lrealpart(void) |
1155 |
{ |
{ |
1156 |
object r, x; |
object x; |
1157 |
|
|
1158 |
check_arg(1); |
check_arg(1); |
1159 |
check_type_number(&vs_base[0]); |
check_type_number(&vs_base[0]); |
1162 |
vs_base[0] = x->cmp.cmp_real; |
vs_base[0] = x->cmp.cmp_real; |
1163 |
} |
} |
1164 |
|
|
1165 |
Limagpart() |
void |
1166 |
|
Limagpart(void) |
1167 |
{ |
{ |
1168 |
object x; |
object x; |
1169 |
|
|
1185 |
case t_complex: |
case t_complex: |
1186 |
vs_base[0] = x->cmp.cmp_imag; |
vs_base[0] = x->cmp.cmp_imag; |
1187 |
break; |
break; |
1188 |
|
default: |
1189 |
|
break; |
1190 |
} |
} |
1191 |
} |
} |
1192 |
|
|
1193 |
static float sf1,sf2; |
static float sf1,sf2; |
1194 |
static sf_eql() |
static int sf_eql(void) |
1195 |
{return(sf1==sf2);} |
{return(sf1==sf2);} |
1196 |
|
|
1197 |
|
|
1198 |
|
|
1199 |
int lf_eqlp(); |
int lf_eqlp(double *p, double *q); |
1200 |
#define LF_EQL(a,b) (lf1=a,lf2=b,lf_eqlp(&lf1,&lf2)) |
#define LF_EQL(a,b) (lf1=a,lf2=b,lf_eqlp(&lf1,&lf2)) |
1201 |
#define SF_EQL(a,b) (sf1=a,sf2=b,sf_eql()) |
#define SF_EQL(a,b) (sf1=a,sf2=b,sf_eql()) |
1202 |
|
|
1203 |
void _assure_in_memory (); |
void _assure_in_memory (void *p); |
1204 |
|
|
1205 |
#define FMEM(f) _assure_in_memory(&f) |
#define FMEM(f) _assure_in_memory(&f) |
1206 |
init_num_co() |
void |
1207 |
|
init_num_co(void) |
1208 |
{ |
{ |
|
int l[2]; |
|
1209 |
float smallest_float, smallest_norm_float, biggest_float; |
float smallest_float, smallest_norm_float, biggest_float; |
1210 |
double smallest_double, smallest_norm_double, biggest_double; |
double smallest_double, smallest_norm_double, biggest_double; |
1211 |
float float_epsilon, float_negative_epsilon; |
float float_epsilon, float_negative_epsilon; |