Mercurial > hg > xemacs-beta

comparison src/floatfns.c @ 185:3d6bfa290dbd r20-3b19

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b19
author cvs
date Mon, 13 Aug 2007 09:55:28 +0200
parents cf808b4c4290
children c5d627a313b1
comparison
equal deleted inserted replaced
184:bcd2674570bf 185:3d6bfa290dbd
117 Fsignal (Qdomain_error, list2 (build_string ((op)), (arg))) 117 Fsignal (Qdomain_error, list2 (build_string ((op)), (arg)))
118 #define domain_error2(op,a1,a2) \ 118 #define domain_error2(op,a1,a2) \
119 Fsignal (Qdomain_error, list3 (build_string ((op)), (a1), (a2))) 119 Fsignal (Qdomain_error, list3 (build_string ((op)), (a1), (a2)))
120 120
121 121
122 /* Convert float to Lisp_Int if it fits, else signal a range error 122 /* Convert float to Lisp Integer if it fits, else signal a range
123 using the given arguments. */ 123 error using the given arguments. */
124 static Lisp_Object 124 static Lisp_Object
125 float_to_int (double x, CONST char *name, Lisp_Object num, Lisp_Object num2) 125 float_to_int (double x, CONST char *name, Lisp_Object num, Lisp_Object num2)
126 { 126 {
127 if (x >= ((EMACS_INT) 1 << (VALBITS-1)) 127 if (x >= ((EMACS_INT) 1 << (VALBITS-1))
128 || x <= - ((EMACS_INT) 1 << (VALBITS-1)) - (EMACS_INT) 1) 128 || x <= - ((EMACS_INT) 1 << (VALBITS-1)) - (EMACS_INT) 1)
139 static void 139 static void
140 in_float_error (void) 140 in_float_error (void)
141 { 141 {
142 switch (errno) 142 switch (errno)
143 { 143 {
144 case 0: 144 case 0:
145 break; 145 break;
146 case EDOM: 146 case EDOM:
147 if (in_float == 2) 147 if (in_float == 2)
148 domain_error2 (float_error_fn_name, float_error_arg, float_error_arg2); 148 domain_error2 (float_error_fn_name, float_error_arg, float_error_arg2);
149 else 149 else
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 161
162 162
163 static Lisp_Object mark_float (Lisp_Object, void (*) (Lisp_Object)); 163 static Lisp_Object mark_float (Lisp_Object, void (*) (Lisp_Object));
164 extern void print_float (Lisp_Object, Lisp_Object, int); 164 extern void print_float (Lisp_Object, Lisp_Object, int);
165 static int float_equal (Lisp_Object o1, Lisp_Object o2, int depth); 165 static int float_equal (Lisp_Object o1, Lisp_Object o2, int depth);
166 static unsigned long float_hash (Lisp_Object obj, int depth); 166 static unsigned long float_hash (Lisp_Object obj, int depth);
436 (INTP (arg2))) /* don't promote, if both are ints */ 436 (INTP (arg2))) /* don't promote, if both are ints */
437 { 437 {
438 EMACS_INT acc, x, y; 438 EMACS_INT acc, x, y;
439 x = XINT (arg1); 439 x = XINT (arg1);
440 y = XINT (arg2); 440 y = XINT (arg2);
441 441
442 if (y < 0) 442 if (y < 0)
443 { 443 {
444 if (x == 1) 444 if (x == 1)
445 acc = 1; 445 acc = 1;
446 else if (x == -1) 446 else if (x == -1)
708 return (val); 708 return (val);
709 } 709 }
710 #else 710 #else
711 #ifdef HAVE_FREXP 711 #ifdef HAVE_FREXP
712 { 712 {
713 int exqp; 713 int exqp;
714 IN_FLOAT (frexp (f, &exqp), "logb", arg); 714 IN_FLOAT (frexp (f, &exqp), "logb", arg);
715 return (make_int (exqp - 1)); 715 return (make_int (exqp - 1));
716 } 716 }
717 #else 717 #else
718 { 718 {
934 where SIGILL is signaled. */ 934 where SIGILL is signaled. */
935 935
936 #endif /* FLOAT_CATCH_SIGILL */ 936 #endif /* FLOAT_CATCH_SIGILL */
937 937
938 #ifdef HAVE_MATHERR 938 #ifdef HAVE_MATHERR
939 int 939 int
940 matherr (struct exception *x) 940 matherr (struct exception *x)
941 { 941 {
942 Lisp_Object args; 942 Lisp_Object args;
943 if (! in_float) 943 if (! in_float)
944 /* Not called from emacs-lisp float routines; do the default thing. */ 944 /* Not called from emacs-lisp float routines; do the default thing. */
969 init_floatfns_very_early (void) 969 init_floatfns_very_early (void)
970 { 970 {
971 #ifdef LISP_FLOAT_TYPE 971 #ifdef LISP_FLOAT_TYPE
972 # ifdef FLOAT_CATCH_SIGILL 972 # ifdef FLOAT_CATCH_SIGILL
973 signal (SIGILL, float_error); 973 signal (SIGILL, float_error);
974 # endif 974 # endif
975 in_float = 0; 975 in_float = 0;
976 #endif /* LISP_FLOAT_TYPE */ 976 #endif /* LISP_FLOAT_TYPE */
977 } 977 }
978 978
979 void 979 void
980 syms_of_floatfns (void) 980 syms_of_floatfns (void)
981 { 981 {
982 982
983 /* Trig functions. */ 983 /* Trig functions. */
984 984
985 #ifdef LISP_FLOAT_TYPE 985 #ifdef LISP_FLOAT_TYPE
986 DEFSUBR (Facos); 986 DEFSUBR (Facos);
987 DEFSUBR (Fasin); 987 DEFSUBR (Fasin);
988 DEFSUBR (Fatan); 988 DEFSUBR (Fatan);
989 DEFSUBR (Fcos); 989 DEFSUBR (Fcos);
990 DEFSUBR (Fsin); 990 DEFSUBR (Fsin);
991 DEFSUBR (Ftan); 991 DEFSUBR (Ftan);
992 #endif /* LISP_FLOAT_TYPE */ 992 #endif /* LISP_FLOAT_TYPE */
993 993
994 /* Bessel functions */ 994 /* Bessel functions */
995 995
996 #if 0 996 #if 0
997 DEFSUBR (Fbessel_y0); 997 DEFSUBR (Fbessel_y0);
998 DEFSUBR (Fbessel_y1); 998 DEFSUBR (Fbessel_y1);
999 DEFSUBR (Fbessel_yn); 999 DEFSUBR (Fbessel_yn);
1000 DEFSUBR (Fbessel_j0); 1000 DEFSUBR (Fbessel_j0);