Mercurial > hg > xemacs-beta

comparison src/floatfns.c @ 272:c5d627a313b1 r21-0b34

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0b34
author cvs
date Mon, 13 Aug 2007 10:28:48 +0200
parents 3d6bfa290dbd
children 558f606b08ae
comparison
equal deleted inserted replaced
271:c7b7086b0a39 272:c5d627a313b1
156 arith_error (float_error_fn_name, float_error_arg); 156 arith_error (float_error_fn_name, float_error_arg);
157 break; 157 break;
158 } 158 }
159 } 159 }
160 160
161
162 161
163 static Lisp_Object mark_float (Lisp_Object, void (*) (Lisp_Object)); 162 static Lisp_Object
164 extern void print_float (Lisp_Object, Lisp_Object, int); 163 mark_float (Lisp_Object obj, void (*markobj) (Lisp_Object))
165 static int float_equal (Lisp_Object o1, Lisp_Object o2, int depth); 164 {
166 static unsigned long float_hash (Lisp_Object obj, int depth); 165 return (Qnil);
166 }
167
168 static int
169 float_equal (Lisp_Object o1, Lisp_Object o2, int depth)
170 {
171 return (extract_float (o1) == extract_float (o2));
172 }
173
174 static unsigned long
175 float_hash (Lisp_Object obj, int depth)
176 {
177 /* mod the value down to 32-bit range */
178 /* #### change for 64-bit machines */
179 return (unsigned long) fmod (extract_float (obj), 4e9);
180 }
181
167 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("float", float, 182 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("float", float,
168 mark_float, print_float, 0, float_equal, 183 mark_float, print_float, 0, float_equal,
169 float_hash, struct Lisp_Float); 184 float_hash, struct Lisp_Float);
170
171 static Lisp_Object
172 mark_float (Lisp_Object obj, void (*markobj) (Lisp_Object))
173 {
174 return (Qnil);
175 }
176
177 static int
178 float_equal (Lisp_Object o1, Lisp_Object o2, int depth)
179 {
180 return (extract_float (o1) == extract_float (o2));
181 }
182
183 static unsigned long
184 float_hash (Lisp_Object obj, int depth)
185 {
186 /* mod the value down to 32-bit range */
187 /* #### change for 64-bit machines */
188 return (unsigned long) fmod (extract_float (obj), 4e9);
189 }
190
191 185
192 /* Extract a Lisp number as a `double', or signal an error. */ 186 /* Extract a Lisp number as a `double', or signal an error. */
193 187
194 double 188 double
195 extract_float (Lisp_Object num) 189 extract_float (Lisp_Object num)
454 while (y > 0) 448 while (y > 0)
455 { 449 {
456 if (y & 1) 450 if (y & 1)
457 acc *= x; 451 acc *= x;
458 x *= x; 452 x *= x;
459 y = (unsigned EMACS_INT) y >> 1; 453 y = (EMACS_UINT) y >> 1;
460 } 454 }
461 } 455 }
462 return (make_int (acc)); 456 return (make_int (acc));
463 } 457 }
464 #ifdef LISP_FLOAT_TYPE 458 #ifdef LISP_FLOAT_TYPE
702 if (f == 0.0) 696 if (f == 0.0)
703 return (make_int (- (((EMACS_UINT) 1) << (VALBITS - 1)))); /* most-negative-fixnum */ 697 return (make_int (- (((EMACS_UINT) 1) << (VALBITS - 1)))); /* most-negative-fixnum */
704 #ifdef HAVE_LOGB 698 #ifdef HAVE_LOGB
705 { 699 {
706 Lisp_Object val; 700 Lisp_Object val;
707 IN_FLOAT (val = make_int (logb (f)), "logb", arg); 701 IN_FLOAT (val = make_int ((int) logb (f)), "logb", arg);
708 return (val); 702 return (val);
709 } 703 }
710 #else 704 #else
711 #ifdef HAVE_FREXP 705 #ifdef HAVE_FREXP
712 { 706 {
933 /* Another idea was to replace the library function `infnan' 927 /* Another idea was to replace the library function `infnan'
934 where SIGILL is signaled. */ 928 where SIGILL is signaled. */
935 929
936 #endif /* FLOAT_CATCH_SIGILL */ 930 #endif /* FLOAT_CATCH_SIGILL */
937 931
938 #ifdef HAVE_MATHERR 932 #if defined (HAVE_MATHERR) && !defined(__cplusplus)
939 int 933 int
940 matherr (struct exception *x) 934 matherr (struct exception *x)
941 { 935 {
942 Lisp_Object args; 936 Lisp_Object args;
943 if (! in_float) 937 if (! in_float)
957 case SING: Fsignal (Qsingularity_error, args); break; 951 case SING: Fsignal (Qsingularity_error, args); break;
958 case OVERFLOW: Fsignal (Qoverflow_error, args); break; 952 case OVERFLOW: Fsignal (Qoverflow_error, args); break;
959 case UNDERFLOW: Fsignal (Qunderflow_error, args); break; 953 case UNDERFLOW: Fsignal (Qunderflow_error, args); break;
960 default: Fsignal (Qarith_error, args); break; 954 default: Fsignal (Qarith_error, args); break;
961 } 955 }
962 return (1); /* don't set errno or print a message */ 956 return 1; /* don't set errno or print a message */
963 } 957 }
964 #endif /* HAVE_MATHERR */ 958 #endif /* HAVE_MATHERR */
965 #endif /* LISP_FLOAT_TYPE */ 959 #endif /* LISP_FLOAT_TYPE */
966 960
967 961