/[gcl]/gcl/o/num_co.c
ViewVC logotype

Diff of /gcl/o/num_co.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.4 by camm, Thu Jun 6 16:41:52 2002 UTC revision 1.5 by camm, Sat Jul 20 07:10:55 2002 UTC
# Line 94  object plus_half, minus_half; Line 94  object plus_half, minus_half;
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    
# Line 123  int *hp, *lp, *ep, *sp; Line 122  int *hp, *lp, *ep, *sp;
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);
# Line 183  int *hp, *lp, *ep, *sp; Line 182  int *hp, *lp, *ep, *sp;
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;
# Line 209  int *mp, *ep, *sp; Line 207  int *mp, *ep, *sp;
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;
# Line 227  int *mp, *ep, *sp; Line 225  int *mp, *ep, *sp;
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);
# Line 254  double d; Line 251  double d;
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    
# Line 273  int e; Line 268  int e;
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
# Line 288  int e; Line 283  int e;
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)
# Line 353  double d; Line 347  double d;
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)
# Line 420  Lfloat() Line 414  Lfloat()
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]);
# Line 428  Lnumerator() Line 423  Lnumerator()
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]);
# Line 438  Ldenominator() Line 434  Ldenominator()
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)
# Line 556  TWO_ARG: Line 553  TWO_ARG:
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)
# Line 677  TWO_ARG: Line 677  TWO_ARG:
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;
# Line 759  TWO_ARG: Line 762  TWO_ARG:
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)
# Line 889  TWO_ARG: Line 895  TWO_ARG:
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();
# Line 907  Lrem() Line 917  Lrem()
917  }  }
918    
919    
920  Ldecode_float()  void
921    Ldecode_float(void)
922  {  {
923          object x;          object x;
924          double d;          double d;
# Line 940  Ldecode_float() Line 951  Ldecode_float()
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]);
# Line 965  Lscale_float() Line 977  Lscale_float()
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    
# Line 976  Lscale_float() Line 988  Lscale_float()
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]);
# Line 1004  Lfloat_radix() Line 1017  Lfloat_radix()
1017  #endif  #endif
1018  }  }
1019    
1020  Lfloat_sign()  void
1021    Lfloat_sign(void)
1022  {  {
1023          object x;          object x;
1024          int narg;          int narg;
# Line 1042  Lfloat_sign() Line 1056  Lfloat_sign()
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]);
# Line 1052  Lfloat_digits() Line 1067  Lfloat_digits()
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    
# Line 1085  Lfloat_precision() Line 1101  Lfloat_precision()
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;
# Line 1110  Linteger_decode_float() Line 1127  Linteger_decode_float()
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;
# Line 1132  Lcomplex() Line 1150  Lcomplex()
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]);
# Line 1143  Lrealpart() Line 1162  Lrealpart()
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    
# Line 1165  Limagpart() Line 1185  Limagpart()
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;

Legend:
Removed from v.1.4  
changed lines
  Added in v.1.5

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26