comparison src/data.c @ 5125:b5df3737028a ben-lisp-object

merge
author Ben Wing <ben@xemacs.org>
date Wed, 24 Feb 2010 01:58:04 -0600
parents 623d57b7fbe8 b46c89ccbed3
children a9c41067dd88
comparison
equal deleted inserted replaced
5124:623d57b7fbe8 5125:b5df3737028a
63 Lisp_Object Qbit_vectorp, Qbitp, Qcdr; 63 Lisp_Object Qbit_vectorp, Qbitp, Qcdr;
64 64
65 Lisp_Object Qerror_lacks_explanatory_string; 65 Lisp_Object Qerror_lacks_explanatory_string;
66 Lisp_Object Qfloatp; 66 Lisp_Object Qfloatp;
67 67
68 Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum;
69
68 #ifdef DEBUG_XEMACS 70 #ifdef DEBUG_XEMACS
69 71
70 int debug_issue_ebola_notices; 72 int debug_issue_ebola_notices;
71 73
72 Fixnum debug_ebola_backtrace_length; 74 Fixnum debug_ebola_backtrace_length;
77 if (debug_issue_ebola_notices 79 if (debug_issue_ebola_notices
78 && ((CHARP (obj1) && INTP (obj2)) || (CHARP (obj2) && INTP (obj1)))) 80 && ((CHARP (obj1) && INTP (obj2)) || (CHARP (obj2) && INTP (obj1))))
79 { 81 {
80 /* #### It would be really nice if this were a proper warning 82 /* #### It would be really nice if this were a proper warning
81 instead of brain-dead print to Qexternal_debugging_output. */ 83 instead of brain-dead print to Qexternal_debugging_output. */
82 write_c_string 84 write_msg_string
83 (Qexternal_debugging_output, 85 (Qexternal_debugging_output,
84 "Comparison between integer and character is constant nil ("); 86 "Comparison between integer and character is constant nil (");
85 Fprinc (obj1, Qexternal_debugging_output); 87 Fprinc (obj1, Qexternal_debugging_output);
86 write_c_string (Qexternal_debugging_output, " and "); 88 write_msg_string (Qexternal_debugging_output, " and ");
87 Fprinc (obj2, Qexternal_debugging_output); 89 Fprinc (obj2, Qexternal_debugging_output);
88 write_c_string (Qexternal_debugging_output, ")\n"); 90 write_msg_string (Qexternal_debugging_output, ")\n");
89 debug_short_backtrace (debug_ebola_backtrace_length); 91 debug_short_backtrace (debug_ebola_backtrace_length);
90 } 92 }
91 return EQ (obj1, obj2); 93 return EQ (obj1, obj2);
92 } 94 }
93 95
293 DEFUN ("arrayp", Farrayp, 1, 1, 0, /* 295 DEFUN ("arrayp", Farrayp, 1, 1, 0, /*
294 Return t if OBJECT is an array (string, vector, or bit vector). 296 Return t if OBJECT is an array (string, vector, or bit vector).
295 */ 297 */
296 (object)) 298 (object))
297 { 299 {
298 return (VECTORP (object) || 300 return ARRAYP (object) ? Qt : Qnil;
299 STRINGP (object) ||
300 BIT_VECTORP (object))
301 ? Qt : Qnil;
302 } 301 }
303 302
304 DEFUN ("sequencep", Fsequencep, 1, 1, 0, /* 303 DEFUN ("sequencep", Fsequencep, 1, 1, 0, /*
305 Return t if OBJECT is a sequence (list or array). 304 Return t if OBJECT is a sequence (list or array).
306 */ 305 */
307 (object)) 306 (object))
308 { 307 {
309 return (LISTP (object) || 308 return SEQUENCEP (object) ? Qt : Qnil;
310 VECTORP (object) ||
311 STRINGP (object) ||
312 BIT_VECTORP (object))
313 ? Qt : Qnil;
314 } 309 }
315 310
316 DEFUN ("markerp", Fmarkerp, 1, 1, 0, /* 311 DEFUN ("markerp", Fmarkerp, 1, 1, 0, /*
317 Return t if OBJECT is a marker (editor pointer). 312 Return t if OBJECT is a marker (editor pointer).
318 */ 313 */
338 return make_int (XSUBR (subr)->min_args); 333 return make_int (XSUBR (subr)->min_args);
339 } 334 }
340 335
341 DEFUN ("subr-max-args", Fsubr_max_args, 1, 1, 0, /* 336 DEFUN ("subr-max-args", Fsubr_max_args, 1, 1, 0, /*
342 Return maximum number of args built-in function SUBR may be called with, 337 Return maximum number of args built-in function SUBR may be called with,
343 or nil if it takes an arbitrary number of arguments or is a special form. 338 or nil if it takes an arbitrary number of arguments or is a special operator.
344 */ 339 */
345 (subr)) 340 (subr))
346 { 341 {
347 int nargs; 342 int nargs;
348 CHECK_SUBR (subr); 343 CHECK_SUBR (subr);
361 (subr)) 356 (subr))
362 { 357 {
363 const CIbyte *prompt; 358 const CIbyte *prompt;
364 CHECK_SUBR (subr); 359 CHECK_SUBR (subr);
365 prompt = XSUBR (subr)->prompt; 360 prompt = XSUBR (subr)->prompt;
366 return prompt ? list2 (Qinteractive, build_msg_string (prompt)) : Qnil; 361 return prompt ? list2 (Qinteractive, build_msg_cistring (prompt)) : Qnil;
367 } 362 }
368 363
369 364
370 DEFUN ("characterp", Fcharacterp, 1, 1, 0, /* 365 DEFUN ("characterp", Fcharacterp, 1, 1, 0, /*
371 Return t if OBJECT is a character. 366 Return t if OBJECT is a character.
418 determine whether this is the case. If the integer cannot be converted, 413 determine whether this is the case. If the integer cannot be converted,
419 nil is returned. 414 nil is returned.
420 */ 415 */
421 (integer)) 416 (integer))
422 { 417 {
423 CHECK_INT (integer); 418 CHECK_INTEGER (integer);
424 if (CHAR_INTP (integer)) 419 if (CHAR_INTP (integer))
425 return make_char (XINT (integer)); 420 return make_char (XINT (integer));
426 else 421 else
427 return Qnil; 422 return Qnil;
428 } 423 }
454 (object)) 449 (object))
455 { 450 {
456 return CHAR_OR_CHAR_INTP (object) || STRINGP (object) ? Qt : Qnil; 451 return CHAR_OR_CHAR_INTP (object) || STRINGP (object) ? Qt : Qnil;
457 } 452 }
458 453
459 #ifdef HAVE_BIGNUM
460 /* In this case, integerp is defined in number.c. */
461 DEFUN ("fixnump", Ffixnump, 1, 1, 0, /* 454 DEFUN ("fixnump", Ffixnump, 1, 1, 0, /*
462 Return t if OBJECT is a fixnum. 455 Return t if OBJECT is a fixnum.
456
457 In this implementation, a fixnum is an immediate integer, and has a
458 maximum value described by the constant `most-positive-fixnum'. This
459 contrasts with bignums, integers where the values are limited by your
460 available memory.
463 */ 461 */
464 (object)) 462 (object))
465 { 463 {
466 return INTP (object) ? Qt : Qnil; 464 return INTP (object) ? Qt : Qnil;
467 } 465 }
468 #else
469 DEFUN ("integerp", Fintegerp, 1, 1, 0, /* 466 DEFUN ("integerp", Fintegerp, 1, 1, 0, /*
470 Return t if OBJECT is an integer. 467 Return t if OBJECT is an integer, nil otherwise.
471 */ 468
472 (object)) 469 On builds without bignum support, this function is identical to `fixnump'.
473 { 470 */
474 return INTP (object) ? Qt : Qnil; 471 (object))
475 } 472 {
476 #endif 473 return INTEGERP (object) ? Qt : Qnil;
474 }
477 475
478 DEFUN ("integer-or-marker-p", Finteger_or_marker_p, 1, 1, 0, /* 476 DEFUN ("integer-or-marker-p", Finteger_or_marker_p, 1, 1, 0, /*
479 Return t if OBJECT is an integer or a marker (editor pointer). 477 Return t if OBJECT is an integer or a marker (editor pointer).
480 */ 478 */
481 (object)) 479 (object))
482 { 480 {
483 return INTP (object) || MARKERP (object) ? Qt : Qnil; 481 return INTEGERP (object) || MARKERP (object) ? Qt : Qnil;
484 } 482 }
485 483
486 DEFUN ("integer-or-char-p", Finteger_or_char_p, 1, 1, 0, /* 484 DEFUN ("integer-or-char-p", Finteger_or_char_p, 1, 1, 0, /*
487 Return t if OBJECT is an integer or a character. 485 Return t if OBJECT is an integer or a character.
488 */ 486 */
489 (object)) 487 (object))
490 { 488 {
491 return INTP (object) || CHARP (object) ? Qt : Qnil; 489 return INTEGERP (object) || CHARP (object) ? Qt : Qnil;
492 } 490 }
493 491
494 DEFUN ("integer-char-or-marker-p", Finteger_char_or_marker_p, 1, 1, 0, /* 492 DEFUN ("integer-char-or-marker-p", Finteger_char_or_marker_p, 1, 1, 0, /*
495 Return t if OBJECT is an integer, character or a marker (editor pointer). 493 Return t if OBJECT is an integer, character or a marker (editor pointer).
496 */ 494 */
497 (object)) 495 (object))
498 { 496 {
499 return INTP (object) || CHARP (object) || MARKERP (object) ? Qt : Qnil; 497 return INTEGERP (object) || CHARP (object) || MARKERP (object) ? Qt : Qnil;
500 } 498 }
501 499
502 DEFUN ("natnump", Fnatnump, 1, 1, 0, /* 500 DEFUN ("natnump", Fnatnump, 1, 1, 0, /*
503 Return t if OBJECT is a nonnegative integer. 501 Return t if OBJECT is a nonnegative integer.
504 */ 502 */
540 DEFUN ("numberp", Fnumberp, 1, 1, 0, /* 538 DEFUN ("numberp", Fnumberp, 1, 1, 0, /*
541 Return t if OBJECT is a number (floating point or integer). 539 Return t if OBJECT is a number (floating point or integer).
542 */ 540 */
543 (object)) 541 (object))
544 { 542 {
545 #ifdef WITH_NUMBER_TYPES
546 return NUMBERP (object) ? Qt : Qnil; 543 return NUMBERP (object) ? Qt : Qnil;
547 #else
548 return INT_OR_FLOATP (object) ? Qt : Qnil;
549 #endif
550 } 544 }
551 545
552 DEFUN ("number-or-marker-p", Fnumber_or_marker_p, 1, 1, 0, /* 546 DEFUN ("number-or-marker-p", Fnumber_or_marker_p, 1, 1, 0, /*
553 Return t if OBJECT is a number or a marker. 547 Return t if OBJECT is a number or a marker.
554 */ 548 */
555 (object)) 549 (object))
556 { 550 {
557 return INT_OR_FLOATP (object) || MARKERP (object) ? Qt : Qnil; 551 return NUMBERP (object) || MARKERP (object) ? Qt : Qnil;
558 } 552 }
559 553
560 DEFUN ("number-char-or-marker-p", Fnumber_char_or_marker_p, 1, 1, 0, /* 554 DEFUN ("number-char-or-marker-p", Fnumber_char_or_marker_p, 1, 1, 0, /*
561 Return t if OBJECT is a number, character or a marker. 555 Return t if OBJECT is a number, character or a marker.
562 */ 556 */
563 (object)) 557 (object))
564 { 558 {
565 return (INT_OR_FLOATP (object) || 559 return (NUMBERP (object) || CHARP (object) || MARKERP (object))
566 CHARP (object) ||
567 MARKERP (object))
568 ? Qt : Qnil; 560 ? Qt : Qnil;
569 } 561 }
570 562
571 DEFUN ("floatp", Ffloatp, 1, 1, 0, /* 563 DEFUN ("floatp", Ffloatp, 1, 1, 0, /*
572 Return t if OBJECT is a floating point number. 564 Return t if OBJECT is a floating point number.
738 730
739 retry: 731 retry:
740 732
741 if (INTP (index_)) idx = XINT (index_); 733 if (INTP (index_)) idx = XINT (index_);
742 else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */ 734 else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */
735 #ifdef HAVE_BIGNUM
736 else if (BIGNUMP (index_))
737 {
738 Lisp_Object canon = Fcanonicalize_number (index_);
739 if (EQ (canon, index_))
740 {
741 /* We don't support non-fixnum indices. */
742 goto range_error;
743 }
744 index_ = canon;
745 goto retry;
746 }
747 #endif
743 else 748 else
744 { 749 {
745 index_ = wrong_type_argument (Qinteger_or_char_p, index_); 750 index_ = wrong_type_argument (Qinteger_or_char_p, index_);
746 goto retry; 751 goto retry;
747 } 752 }
793 798
794 retry: 799 retry:
795 800
796 if (INTP (index_)) idx = XINT (index_); 801 if (INTP (index_)) idx = XINT (index_);
797 else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */ 802 else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */
803 #ifdef HAVE_BIGNUM
804 else if (BIGNUMP (index_))
805 {
806 Lisp_Object canon = Fcanonicalize_number (index_);
807 if (EQ (canon, index_))
808 {
809 /* We don't support non-fixnum indices. */
810 goto range_error;
811 }
812 index_ = canon;
813 goto retry;
814 }
815 #endif
798 else 816 else
799 { 817 {
800 index_ = wrong_type_argument (Qinteger_or_char_p, index_); 818 index_ = wrong_type_argument (Qinteger_or_char_p, index_);
801 goto retry; 819 goto retry;
802 } 820 }
882 } 900 }
883 } 901 }
884 #endif /* WITH_NUMBER_TYPES */ 902 #endif /* WITH_NUMBER_TYPES */
885 903
886 static EMACS_INT 904 static EMACS_INT
887 integer_char_or_marker_to_int (Lisp_Object obj) 905 fixnum_char_or_marker_to_int (Lisp_Object obj)
888 { 906 {
889 retry: 907 retry:
890 if (INTP (obj)) return XINT (obj); 908 if (INTP (obj)) return XINT (obj);
891 else if (CHARP (obj)) return XCHAR (obj); 909 else if (CHARP (obj)) return XCHAR (obj);
892 else if (MARKERP (obj)) return marker_position (obj); 910 else if (MARKERP (obj)) return marker_position (obj);
893 else 911 else
894 { 912 {
913 /* On bignum builds, we can only be called from #'lognot, which
914 protects against this happening: */
915 assert (!BIGNUMP (obj));
895 obj = wrong_type_argument (Qinteger_char_or_marker_p, obj); 916 obj = wrong_type_argument (Qinteger_char_or_marker_p, obj);
896 goto retry; 917 goto retry;
897 } 918 }
898 } 919 }
899 920
1190 NUMBER may be an integer or a floating point number. 1211 NUMBER may be an integer or a floating point number.
1191 If supported, it may also be a ratio. 1212 If supported, it may also be a ratio.
1192 */ 1213 */
1193 (number)) 1214 (number))
1194 { 1215 {
1195 #ifdef WITH_NUMBER_TYPES
1196 CHECK_NUMBER (number); 1216 CHECK_NUMBER (number);
1197 #else
1198 CHECK_INT_OR_FLOAT (number);
1199 #endif
1200 1217
1201 if (FLOATP (number)) 1218 if (FLOATP (number))
1202 { 1219 {
1203 char pigbuf[350]; /* see comments in float_to_string */ 1220 Ascbyte pigbuf[350]; /* see comments in float_to_string */
1204 1221
1205 float_to_string (pigbuf, XFLOAT_DATA (number)); 1222 float_to_string (pigbuf, XFLOAT_DATA (number));
1206 return build_string (pigbuf); 1223 return build_ascstring (pigbuf);
1207 } 1224 }
1208 #ifdef HAVE_BIGNUM 1225 #ifdef HAVE_BIGNUM
1209 if (BIGNUMP (number)) 1226 if (BIGNUMP (number))
1210 { 1227 {
1211 char *str = bignum_to_string (XBIGNUM_DATA (number), 10); 1228 Ascbyte *str = bignum_to_string (XBIGNUM_DATA (number), 10);
1212 Lisp_Object retval = build_string (str); 1229 Lisp_Object retval = build_ascstring (str);
1213 xfree (str, char *); 1230 xfree (str);
1214 return retval; 1231 return retval;
1215 } 1232 }
1216 #endif 1233 #endif
1217 #ifdef HAVE_RATIO 1234 #ifdef HAVE_RATIO
1218 if (RATIOP (number)) 1235 if (RATIOP (number))
1219 { 1236 {
1220 char *str = ratio_to_string (XRATIO_DATA (number), 10); 1237 Ascbyte *str = ratio_to_string (XRATIO_DATA (number), 10);
1221 Lisp_Object retval = build_string (str); 1238 Lisp_Object retval = build_ascstring (str);
1222 xfree (str, char *); 1239 xfree (str);
1223 return retval; 1240 return retval;
1224 } 1241 }
1225 #endif 1242 #endif
1226 #ifdef HAVE_BIGFLOAT 1243 #ifdef HAVE_BIGFLOAT
1227 if (BIGFLOATP (number)) 1244 if (BIGFLOATP (number))
1228 { 1245 {
1229 char *str = bigfloat_to_string (XBIGFLOAT_DATA (number), 10); 1246 Ascbyte *str = bigfloat_to_string (XBIGFLOAT_DATA (number), 10);
1230 Lisp_Object retval = build_string (str); 1247 Lisp_Object retval = build_ascstring (str);
1231 xfree (str, char *); 1248 xfree (str);
1232 return retval; 1249 return retval;
1233 } 1250 }
1234 #endif 1251 #endif
1235 1252
1236 { 1253 {
1237 char buffer[DECIMAL_PRINT_SIZE (long)]; 1254 Ascbyte buffer[DECIMAL_PRINT_SIZE (long)];
1238 1255
1239 long_to_string (buffer, XINT (number)); 1256 long_to_string (buffer, XINT (number));
1240 return build_string (buffer); 1257 return build_ascstring (buffer);
1241 } 1258 }
1242 } 1259 }
1243 1260
1244 #ifndef HAVE_BIGNUM 1261 #ifndef HAVE_BIGNUM
1245 static int 1262 static int
2130 #else /* !HAVE_BIGNUM */ 2147 #else /* !HAVE_BIGNUM */
2131 EMACS_INT bits = ~0; 2148 EMACS_INT bits = ~0;
2132 Lisp_Object *args_end = args + nargs; 2149 Lisp_Object *args_end = args + nargs;
2133 2150
2134 while (args < args_end) 2151 while (args < args_end)
2135 bits &= integer_char_or_marker_to_int (*args++); 2152 bits &= fixnum_char_or_marker_to_int (*args++);
2136 2153
2137 return make_int (bits); 2154 return make_int (bits);
2138 #endif /* HAVE_BIGNUM */ 2155 #endif /* HAVE_BIGNUM */
2139 } 2156 }
2140 2157
2182 #else /* !HAVE_BIGNUM */ 2199 #else /* !HAVE_BIGNUM */
2183 EMACS_INT bits = 0; 2200 EMACS_INT bits = 0;
2184 Lisp_Object *args_end = args + nargs; 2201 Lisp_Object *args_end = args + nargs;
2185 2202
2186 while (args < args_end) 2203 while (args < args_end)
2187 bits |= integer_char_or_marker_to_int (*args++); 2204 bits |= fixnum_char_or_marker_to_int (*args++);
2188 2205
2189 return make_int (bits); 2206 return make_int (bits);
2190 #endif /* HAVE_BIGNUM */ 2207 #endif /* HAVE_BIGNUM */
2191 } 2208 }
2192 2209
2204 2221
2205 if (nargs == 0) 2222 if (nargs == 0)
2206 return make_int (0); 2223 return make_int (0);
2207 2224
2208 while (!(CHARP (args[0]) || MARKERP (args[0]) || INTEGERP (args[0]))) 2225 while (!(CHARP (args[0]) || MARKERP (args[0]) || INTEGERP (args[0])))
2209 args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]); 2226 args[0] = wrong_type_argument (Qinteger_char_or_marker_p, args[0]);
2210 2227
2211 result = args[0]; 2228 result = args[0];
2212 if (CHARP (result)) 2229 if (CHARP (result))
2213 result = make_int (XCHAR (result)); 2230 result = make_int (XCHAR (result));
2214 else if (MARKERP (result)) 2231 else if (MARKERP (result))
2215 result = make_int (marker_position (result)); 2232 result = make_int (marker_position (result));
2216 for (i = 1; i < nargs; i++) 2233 for (i = 1; i < nargs; i++)
2217 { 2234 {
2218 while (!(CHARP (args[i]) || MARKERP (args[i]) || INTEGERP (args[i]))) 2235 while (!(CHARP (args[i]) || MARKERP (args[i]) || INTEGERP (args[i])))
2219 args[i] = wrong_type_argument (Qnumber_char_or_marker_p, args[i]); 2236 args[i] = wrong_type_argument (Qinteger_char_or_marker_p, args[i]);
2220 other = args[i]; 2237 other = args[i];
2221 if (promote_args (&result, &other) == FIXNUM_T) 2238 if (promote_args (&result, &other) == FIXNUM_T)
2222 { 2239 {
2223 result = make_int (XREALINT (result) ^ XREALINT (other)); 2240 result = make_int (XREALINT (result) ^ XREALINT (other));
2224 } 2241 }
2233 #else /* !HAVE_BIGNUM */ 2250 #else /* !HAVE_BIGNUM */
2234 EMACS_INT bits = 0; 2251 EMACS_INT bits = 0;
2235 Lisp_Object *args_end = args + nargs; 2252 Lisp_Object *args_end = args + nargs;
2236 2253
2237 while (args < args_end) 2254 while (args < args_end)
2238 bits ^= integer_char_or_marker_to_int (*args++); 2255 bits ^= fixnum_char_or_marker_to_int (*args++);
2239 2256
2240 return make_int (bits); 2257 return make_int (bits);
2241 #endif /* !HAVE_BIGNUM */ 2258 #endif /* !HAVE_BIGNUM */
2242 } 2259 }
2243 2260
2245 Return the bitwise complement of NUMBER. 2262 Return the bitwise complement of NUMBER.
2246 NUMBER may be an integer, marker or character converted to integer. 2263 NUMBER may be an integer, marker or character converted to integer.
2247 */ 2264 */
2248 (number)) 2265 (number))
2249 { 2266 {
2267 while (!(CHARP (number) || MARKERP (number) || INTEGERP (number)))
2268 number = wrong_type_argument (Qinteger_char_or_marker_p, number);
2269
2250 #ifdef HAVE_BIGNUM 2270 #ifdef HAVE_BIGNUM
2251 if (BIGNUMP (number)) 2271 if (BIGNUMP (number))
2252 { 2272 {
2253 bignum_not (scratch_bignum, XBIGNUM_DATA (number)); 2273 bignum_not (scratch_bignum, XBIGNUM_DATA (number));
2254 return make_bignum_bg (scratch_bignum); 2274 return make_bignum_bg (scratch_bignum);
2255 } 2275 }
2256 #endif /* HAVE_BIGNUM */ 2276 #endif /* HAVE_BIGNUM */
2257 return make_int (~ integer_char_or_marker_to_int (number)); 2277
2278 return make_int (~ fixnum_char_or_marker_to_int (number));
2258 } 2279 }
2259 2280
2260 DEFUN ("%", Frem, 2, 2, 0, /* 2281 DEFUN ("%", Frem, 2, 2, 0, /*
2261 Return remainder of first arg divided by second. 2282 Return remainder of first arg divided by second.
2262 Both must be integers, characters or markers. 2283 Both must be integers, characters or markers.
2282 bignum_mod (scratch_bignum, XBIGNUM_DATA (number1), 2303 bignum_mod (scratch_bignum, XBIGNUM_DATA (number1),
2283 XBIGNUM_DATA (number2)); 2304 XBIGNUM_DATA (number2));
2284 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); 2305 return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
2285 } 2306 }
2286 #else /* !HAVE_BIGNUM */ 2307 #else /* !HAVE_BIGNUM */
2287 EMACS_INT ival1 = integer_char_or_marker_to_int (number1); 2308 EMACS_INT ival1 = fixnum_char_or_marker_to_int (number1);
2288 EMACS_INT ival2 = integer_char_or_marker_to_int (number2); 2309 EMACS_INT ival2 = fixnum_char_or_marker_to_int (number2);
2289 2310
2290 if (ival2 == 0) 2311 if (ival2 == 0)
2291 Fsignal (Qarith_error, Qnil); 2312 Fsignal (Qarith_error, Qnil);
2292 2313
2293 return make_int (ival1 % ival2); 2314 return make_int (ival1 % ival2);
2590 static void 2611 static void
2591 print_weak_list (Lisp_Object obj, Lisp_Object printcharfun, 2612 print_weak_list (Lisp_Object obj, Lisp_Object printcharfun,
2592 int UNUSED (escapeflag)) 2613 int UNUSED (escapeflag))
2593 { 2614 {
2594 if (print_readably) 2615 if (print_readably)
2595 printing_unreadable_object ("#<weak-list>"); 2616 printing_unreadable_lcrecord (obj, 0);
2596 2617
2597 write_fmt_string_lisp (printcharfun, "#<weak-list %s %S>", 2, 2618 write_fmt_string_lisp (printcharfun, "#<weak-list %s %S>", 2,
2598 encode_weak_list_type (XWEAK_LIST (obj)->type), 2619 encode_weak_list_type (XWEAK_LIST (obj)->type),
2599 XWEAK_LIST (obj)->list); 2620 XWEAK_LIST (obj)->list);
2600 } 2621 }
2601 2622
2602 static int 2623 static int
2603 weak_list_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 2624 weak_list_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase)
2604 { 2625 {
2605 struct weak_list *w1 = XWEAK_LIST (obj1); 2626 struct weak_list *w1 = XWEAK_LIST (obj1);
2606 struct weak_list *w2 = XWEAK_LIST (obj2); 2627 struct weak_list *w2 = XWEAK_LIST (obj2);
2607 2628
2608 return ((w1->type == w2->type) && 2629 return ((w1->type == w2->type) &&
2609 internal_equal (w1->list, w2->list, depth + 1)); 2630 internal_equal_0 (w1->list, w2->list, depth + 1, foldcase));
2610 } 2631 }
2611 2632
2612 static Hashcode 2633 static Hashcode
2613 weak_list_hash (Lisp_Object obj, int depth) 2634 weak_list_hash (Lisp_Object obj, int depth)
2614 { 2635 {
3062 { 3083 {
3063 return Qnil; 3084 return Qnil;
3064 } 3085 }
3065 3086
3066 static void 3087 static void
3067 print_weak_box (Lisp_Object UNUSED (obj), Lisp_Object printcharfun, 3088 print_weak_box (Lisp_Object obj, Lisp_Object printcharfun,
3068 int UNUSED (escapeflag)) 3089 int UNUSED (escapeflag))
3069 { 3090 {
3070 if (print_readably) 3091 if (print_readably)
3071 printing_unreadable_object ("#<weak_box>"); 3092 printing_unreadable_lcrecord (obj, 0);
3072 write_fmt_string (printcharfun, "#<weak_box>"); 3093 write_fmt_string (printcharfun, "#<weak-box>"); /* #### fix */
3073 } 3094 }
3074 3095
3075 static int 3096 static int
3076 weak_box_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 3097 weak_box_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase)
3077 { 3098 {
3078 struct weak_box *wb1 = XWEAK_BOX (obj1); 3099 struct weak_box *wb1 = XWEAK_BOX (obj1);
3079 struct weak_box *wb2 = XWEAK_BOX (obj2); 3100 struct weak_box *wb2 = XWEAK_BOX (obj2);
3080 3101
3081 return (internal_equal (wb1->value, wb2->value, depth + 1)); 3102 return (internal_equal_0 (wb1->value, wb2->value, depth + 1, foldcase));
3082 } 3103 }
3083 3104
3084 static Hashcode 3105 static Hashcode
3085 weak_box_hash (Lisp_Object obj, int depth) 3106 weak_box_hash (Lisp_Object obj, int depth)
3086 { 3107 {
3284 { 3305 {
3285 return Qnil; 3306 return Qnil;
3286 } 3307 }
3287 3308
3288 static void 3309 static void
3289 print_ephemeron (Lisp_Object UNUSED (obj), Lisp_Object printcharfun, 3310 print_ephemeron (Lisp_Object obj, Lisp_Object printcharfun,
3290 int UNUSED (escapeflag)) 3311 int UNUSED (escapeflag))
3291 { 3312 {
3292 if (print_readably) 3313 if (print_readably)
3293 printing_unreadable_object ("#<ephemeron>"); 3314 printing_unreadable_lcrecord (obj, 0);
3294 write_fmt_string (printcharfun, "#<ephemeron>"); 3315 write_fmt_string (printcharfun, "#<ephemeron>"); /* #### fix */
3295 } 3316 }
3296 3317
3297 static int 3318 static int
3298 ephemeron_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) 3319 ephemeron_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase)
3299 { 3320 {
3300 return 3321 return
3301 internal_equal (XEPHEMERON_REF (obj1), XEPHEMERON_REF(obj2), depth + 1); 3322 internal_equal_0 (XEPHEMERON_REF (obj1), XEPHEMERON_REF(obj2), depth + 1,
3323 foldcase);
3302 } 3324 }
3303 3325
3304 static Hashcode 3326 static Hashcode
3305 ephemeron_hash(Lisp_Object obj, int depth) 3327 ephemeron_hash(Lisp_Object obj, int depth)
3306 { 3328 {
3539 DEFSUBR (Fcharacterp); 3561 DEFSUBR (Fcharacterp);
3540 DEFSUBR (Fchar_int_p); 3562 DEFSUBR (Fchar_int_p);
3541 DEFSUBR (Fchar_to_int); 3563 DEFSUBR (Fchar_to_int);
3542 DEFSUBR (Fint_to_char); 3564 DEFSUBR (Fint_to_char);
3543 DEFSUBR (Fchar_or_char_int_p); 3565 DEFSUBR (Fchar_or_char_int_p);
3544 #ifdef HAVE_BIGNUM
3545 DEFSUBR (Ffixnump); 3566 DEFSUBR (Ffixnump);
3546 #else
3547 DEFSUBR (Fintegerp); 3567 DEFSUBR (Fintegerp);
3548 #endif
3549 DEFSUBR (Finteger_or_marker_p); 3568 DEFSUBR (Finteger_or_marker_p);
3550 DEFSUBR (Finteger_or_char_p); 3569 DEFSUBR (Finteger_or_char_p);
3551 DEFSUBR (Finteger_char_or_marker_p); 3570 DEFSUBR (Finteger_char_or_marker_p);
3552 DEFSUBR (Fnumberp); 3571 DEFSUBR (Fnumberp);
3553 DEFSUBR (Fnumber_or_marker_p); 3572 DEFSUBR (Fnumber_or_marker_p);
3633 staticpro (&Vfinalize_list); 3652 staticpro (&Vfinalize_list);
3634 3653
3635 Vall_weak_boxes = Qnil; 3654 Vall_weak_boxes = Qnil;
3636 dump_add_weak_object_chain (&Vall_weak_boxes); 3655 dump_add_weak_object_chain (&Vall_weak_boxes);
3637 3656
3657 DEFVAR_CONST_INT ("most-negative-fixnum", &Vmost_negative_fixnum /*
3658 The fixnum closest in value to negative infinity.
3659 */);
3660 Vmost_negative_fixnum = EMACS_INT_MIN;
3661
3662 DEFVAR_CONST_INT ("most-positive-fixnum", &Vmost_positive_fixnum /*
3663 The fixnum closest in value to positive infinity.
3664 */);
3665 Vmost_positive_fixnum = EMACS_INT_MAX;
3666
3638 #ifdef DEBUG_XEMACS 3667 #ifdef DEBUG_XEMACS
3639 DEFVAR_BOOL ("debug-issue-ebola-notices", &debug_issue_ebola_notices /* 3668 DEFVAR_BOOL ("debug-issue-ebola-notices", &debug_issue_ebola_notices /*
3640 If non-zero, note when your code may be suffering from char-int confoundance. 3669 If non-zero, note when your code may be suffering from char-int confoundance.
3641 That is to say, if XEmacs encounters a usage of `eq', `memq', `equal', 3670 That is to say, if XEmacs encounters a usage of `eq', `memq', `equal',
3642 etc. where an int and a char with the same value are being compared, 3671 etc. where an int and a char with the same value are being compared,