Mercurial > hg > xemacs-beta
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, |