Mercurial > hg > xemacs-beta
diff 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 |
line wrap: on
line diff
--- a/src/data.c Wed Jan 20 07:05:57 2010 -0600 +++ b/src/data.c Wed Feb 24 01:58:04 2010 -0600 @@ -65,6 +65,8 @@ Lisp_Object Qerror_lacks_explanatory_string; Lisp_Object Qfloatp; +Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum; + #ifdef DEBUG_XEMACS int debug_issue_ebola_notices; @@ -79,13 +81,13 @@ { /* #### It would be really nice if this were a proper warning instead of brain-dead print to Qexternal_debugging_output. */ - write_c_string + write_msg_string (Qexternal_debugging_output, "Comparison between integer and character is constant nil ("); Fprinc (obj1, Qexternal_debugging_output); - write_c_string (Qexternal_debugging_output, " and "); + write_msg_string (Qexternal_debugging_output, " and "); Fprinc (obj2, Qexternal_debugging_output); - write_c_string (Qexternal_debugging_output, ")\n"); + write_msg_string (Qexternal_debugging_output, ")\n"); debug_short_backtrace (debug_ebola_backtrace_length); } return EQ (obj1, obj2); @@ -295,10 +297,7 @@ */ (object)) { - return (VECTORP (object) || - STRINGP (object) || - BIT_VECTORP (object)) - ? Qt : Qnil; + return ARRAYP (object) ? Qt : Qnil; } DEFUN ("sequencep", Fsequencep, 1, 1, 0, /* @@ -306,11 +305,7 @@ */ (object)) { - return (LISTP (object) || - VECTORP (object) || - STRINGP (object) || - BIT_VECTORP (object)) - ? Qt : Qnil; + return SEQUENCEP (object) ? Qt : Qnil; } DEFUN ("markerp", Fmarkerp, 1, 1, 0, /* @@ -340,7 +335,7 @@ DEFUN ("subr-max-args", Fsubr_max_args, 1, 1, 0, /* Return maximum number of args built-in function SUBR may be called with, -or nil if it takes an arbitrary number of arguments or is a special form. +or nil if it takes an arbitrary number of arguments or is a special operator. */ (subr)) { @@ -363,7 +358,7 @@ const CIbyte *prompt; CHECK_SUBR (subr); prompt = XSUBR (subr)->prompt; - return prompt ? list2 (Qinteractive, build_msg_string (prompt)) : Qnil; + return prompt ? list2 (Qinteractive, build_msg_cistring (prompt)) : Qnil; } @@ -420,7 +415,7 @@ */ (integer)) { - CHECK_INT (integer); + CHECK_INTEGER (integer); if (CHAR_INTP (integer)) return make_char (XINT (integer)); else @@ -456,31 +451,34 @@ return CHAR_OR_CHAR_INTP (object) || STRINGP (object) ? Qt : Qnil; } -#ifdef HAVE_BIGNUM -/* In this case, integerp is defined in number.c. */ DEFUN ("fixnump", Ffixnump, 1, 1, 0, /* Return t if OBJECT is a fixnum. + +In this implementation, a fixnum is an immediate integer, and has a +maximum value described by the constant `most-positive-fixnum'. This +contrasts with bignums, integers where the values are limited by your +available memory. */ (object)) { return INTP (object) ? Qt : Qnil; } -#else DEFUN ("integerp", Fintegerp, 1, 1, 0, /* -Return t if OBJECT is an integer. +Return t if OBJECT is an integer, nil otherwise. + +On builds without bignum support, this function is identical to `fixnump'. */ (object)) { - return INTP (object) ? Qt : Qnil; + return INTEGERP (object) ? Qt : Qnil; } -#endif DEFUN ("integer-or-marker-p", Finteger_or_marker_p, 1, 1, 0, /* Return t if OBJECT is an integer or a marker (editor pointer). */ (object)) { - return INTP (object) || MARKERP (object) ? Qt : Qnil; + return INTEGERP (object) || MARKERP (object) ? Qt : Qnil; } DEFUN ("integer-or-char-p", Finteger_or_char_p, 1, 1, 0, /* @@ -488,7 +486,7 @@ */ (object)) { - return INTP (object) || CHARP (object) ? Qt : Qnil; + return INTEGERP (object) || CHARP (object) ? Qt : Qnil; } DEFUN ("integer-char-or-marker-p", Finteger_char_or_marker_p, 1, 1, 0, /* @@ -496,7 +494,7 @@ */ (object)) { - return INTP (object) || CHARP (object) || MARKERP (object) ? Qt : Qnil; + return INTEGERP (object) || CHARP (object) || MARKERP (object) ? Qt : Qnil; } DEFUN ("natnump", Fnatnump, 1, 1, 0, /* @@ -542,11 +540,7 @@ */ (object)) { -#ifdef WITH_NUMBER_TYPES return NUMBERP (object) ? Qt : Qnil; -#else - return INT_OR_FLOATP (object) ? Qt : Qnil; -#endif } DEFUN ("number-or-marker-p", Fnumber_or_marker_p, 1, 1, 0, /* @@ -554,7 +548,7 @@ */ (object)) { - return INT_OR_FLOATP (object) || MARKERP (object) ? Qt : Qnil; + return NUMBERP (object) || MARKERP (object) ? Qt : Qnil; } DEFUN ("number-char-or-marker-p", Fnumber_char_or_marker_p, 1, 1, 0, /* @@ -562,9 +556,7 @@ */ (object)) { - return (INT_OR_FLOATP (object) || - CHARP (object) || - MARKERP (object)) + return (NUMBERP (object) || CHARP (object) || MARKERP (object)) ? Qt : Qnil; } @@ -740,6 +732,19 @@ if (INTP (index_)) idx = XINT (index_); else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */ +#ifdef HAVE_BIGNUM + else if (BIGNUMP (index_)) + { + Lisp_Object canon = Fcanonicalize_number (index_); + if (EQ (canon, index_)) + { + /* We don't support non-fixnum indices. */ + goto range_error; + } + index_ = canon; + goto retry; + } +#endif else { index_ = wrong_type_argument (Qinteger_or_char_p, index_); @@ -795,6 +800,19 @@ if (INTP (index_)) idx = XINT (index_); else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */ +#ifdef HAVE_BIGNUM + else if (BIGNUMP (index_)) + { + Lisp_Object canon = Fcanonicalize_number (index_); + if (EQ (canon, index_)) + { + /* We don't support non-fixnum indices. */ + goto range_error; + } + index_ = canon; + goto retry; + } +#endif else { index_ = wrong_type_argument (Qinteger_or_char_p, index_); @@ -884,7 +902,7 @@ #endif /* WITH_NUMBER_TYPES */ static EMACS_INT -integer_char_or_marker_to_int (Lisp_Object obj) +fixnum_char_or_marker_to_int (Lisp_Object obj) { retry: if (INTP (obj)) return XINT (obj); @@ -892,6 +910,9 @@ else if (MARKERP (obj)) return marker_position (obj); else { + /* On bignum builds, we can only be called from #'lognot, which + protects against this happening: */ + assert (!BIGNUMP (obj)); obj = wrong_type_argument (Qinteger_char_or_marker_p, obj); goto retry; } @@ -1192,52 +1213,48 @@ */ (number)) { -#ifdef WITH_NUMBER_TYPES CHECK_NUMBER (number); -#else - CHECK_INT_OR_FLOAT (number); -#endif if (FLOATP (number)) { - char pigbuf[350]; /* see comments in float_to_string */ + Ascbyte pigbuf[350]; /* see comments in float_to_string */ float_to_string (pigbuf, XFLOAT_DATA (number)); - return build_string (pigbuf); + return build_ascstring (pigbuf); } #ifdef HAVE_BIGNUM if (BIGNUMP (number)) { - char *str = bignum_to_string (XBIGNUM_DATA (number), 10); - Lisp_Object retval = build_string (str); - xfree (str, char *); + Ascbyte *str = bignum_to_string (XBIGNUM_DATA (number), 10); + Lisp_Object retval = build_ascstring (str); + xfree (str); return retval; } #endif #ifdef HAVE_RATIO if (RATIOP (number)) { - char *str = ratio_to_string (XRATIO_DATA (number), 10); - Lisp_Object retval = build_string (str); - xfree (str, char *); + Ascbyte *str = ratio_to_string (XRATIO_DATA (number), 10); + Lisp_Object retval = build_ascstring (str); + xfree (str); return retval; } #endif #ifdef HAVE_BIGFLOAT if (BIGFLOATP (number)) { - char *str = bigfloat_to_string (XBIGFLOAT_DATA (number), 10); - Lisp_Object retval = build_string (str); - xfree (str, char *); + Ascbyte *str = bigfloat_to_string (XBIGFLOAT_DATA (number), 10); + Lisp_Object retval = build_ascstring (str); + xfree (str); return retval; } #endif { - char buffer[DECIMAL_PRINT_SIZE (long)]; + Ascbyte buffer[DECIMAL_PRINT_SIZE (long)]; long_to_string (buffer, XINT (number)); - return build_string (buffer); + return build_ascstring (buffer); } } @@ -2132,7 +2149,7 @@ Lisp_Object *args_end = args + nargs; while (args < args_end) - bits &= integer_char_or_marker_to_int (*args++); + bits &= fixnum_char_or_marker_to_int (*args++); return make_int (bits); #endif /* HAVE_BIGNUM */ @@ -2184,7 +2201,7 @@ Lisp_Object *args_end = args + nargs; while (args < args_end) - bits |= integer_char_or_marker_to_int (*args++); + bits |= fixnum_char_or_marker_to_int (*args++); return make_int (bits); #endif /* HAVE_BIGNUM */ @@ -2206,7 +2223,7 @@ return make_int (0); while (!(CHARP (args[0]) || MARKERP (args[0]) || INTEGERP (args[0]))) - args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]); + args[0] = wrong_type_argument (Qinteger_char_or_marker_p, args[0]); result = args[0]; if (CHARP (result)) @@ -2216,7 +2233,7 @@ for (i = 1; i < nargs; i++) { while (!(CHARP (args[i]) || MARKERP (args[i]) || INTEGERP (args[i]))) - args[i] = wrong_type_argument (Qnumber_char_or_marker_p, args[i]); + args[i] = wrong_type_argument (Qinteger_char_or_marker_p, args[i]); other = args[i]; if (promote_args (&result, &other) == FIXNUM_T) { @@ -2235,7 +2252,7 @@ Lisp_Object *args_end = args + nargs; while (args < args_end) - bits ^= integer_char_or_marker_to_int (*args++); + bits ^= fixnum_char_or_marker_to_int (*args++); return make_int (bits); #endif /* !HAVE_BIGNUM */ @@ -2247,6 +2264,9 @@ */ (number)) { + while (!(CHARP (number) || MARKERP (number) || INTEGERP (number))) + number = wrong_type_argument (Qinteger_char_or_marker_p, number); + #ifdef HAVE_BIGNUM if (BIGNUMP (number)) { @@ -2254,7 +2274,8 @@ return make_bignum_bg (scratch_bignum); } #endif /* HAVE_BIGNUM */ - return make_int (~ integer_char_or_marker_to_int (number)); + + return make_int (~ fixnum_char_or_marker_to_int (number)); } DEFUN ("%", Frem, 2, 2, 0, /* @@ -2284,8 +2305,8 @@ return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); } #else /* !HAVE_BIGNUM */ - EMACS_INT ival1 = integer_char_or_marker_to_int (number1); - EMACS_INT ival2 = integer_char_or_marker_to_int (number2); + EMACS_INT ival1 = fixnum_char_or_marker_to_int (number1); + EMACS_INT ival2 = fixnum_char_or_marker_to_int (number2); if (ival2 == 0) Fsignal (Qarith_error, Qnil); @@ -2592,7 +2613,7 @@ int UNUSED (escapeflag)) { if (print_readably) - printing_unreadable_object ("#<weak-list>"); + printing_unreadable_lcrecord (obj, 0); write_fmt_string_lisp (printcharfun, "#<weak-list %s %S>", 2, encode_weak_list_type (XWEAK_LIST (obj)->type), @@ -2600,13 +2621,13 @@ } static int -weak_list_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) +weak_list_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) { struct weak_list *w1 = XWEAK_LIST (obj1); struct weak_list *w2 = XWEAK_LIST (obj2); return ((w1->type == w2->type) && - internal_equal (w1->list, w2->list, depth + 1)); + internal_equal_0 (w1->list, w2->list, depth + 1, foldcase)); } static Hashcode @@ -3064,21 +3085,21 @@ } static void -print_weak_box (Lisp_Object UNUSED (obj), Lisp_Object printcharfun, +print_weak_box (Lisp_Object obj, Lisp_Object printcharfun, int UNUSED (escapeflag)) { if (print_readably) - printing_unreadable_object ("#<weak_box>"); - write_fmt_string (printcharfun, "#<weak_box>"); + printing_unreadable_lcrecord (obj, 0); + write_fmt_string (printcharfun, "#<weak-box>"); /* #### fix */ } static int -weak_box_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) +weak_box_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) { struct weak_box *wb1 = XWEAK_BOX (obj1); struct weak_box *wb2 = XWEAK_BOX (obj2); - return (internal_equal (wb1->value, wb2->value, depth + 1)); + return (internal_equal_0 (wb1->value, wb2->value, depth + 1, foldcase)); } static Hashcode @@ -3286,19 +3307,20 @@ } static void -print_ephemeron (Lisp_Object UNUSED (obj), Lisp_Object printcharfun, +print_ephemeron (Lisp_Object obj, Lisp_Object printcharfun, int UNUSED (escapeflag)) { if (print_readably) - printing_unreadable_object ("#<ephemeron>"); - write_fmt_string (printcharfun, "#<ephemeron>"); + printing_unreadable_lcrecord (obj, 0); + write_fmt_string (printcharfun, "#<ephemeron>"); /* #### fix */ } static int -ephemeron_equal (Lisp_Object obj1, Lisp_Object obj2, int depth) +ephemeron_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) { return - internal_equal (XEPHEMERON_REF (obj1), XEPHEMERON_REF(obj2), depth + 1); + internal_equal_0 (XEPHEMERON_REF (obj1), XEPHEMERON_REF(obj2), depth + 1, + foldcase); } static Hashcode @@ -3541,11 +3563,8 @@ DEFSUBR (Fchar_to_int); DEFSUBR (Fint_to_char); DEFSUBR (Fchar_or_char_int_p); -#ifdef HAVE_BIGNUM DEFSUBR (Ffixnump); -#else DEFSUBR (Fintegerp); -#endif DEFSUBR (Finteger_or_marker_p); DEFSUBR (Finteger_or_char_p); DEFSUBR (Finteger_char_or_marker_p); @@ -3635,6 +3654,16 @@ Vall_weak_boxes = Qnil; dump_add_weak_object_chain (&Vall_weak_boxes); + DEFVAR_CONST_INT ("most-negative-fixnum", &Vmost_negative_fixnum /* +The fixnum closest in value to negative infinity. +*/); + Vmost_negative_fixnum = EMACS_INT_MIN; + + DEFVAR_CONST_INT ("most-positive-fixnum", &Vmost_positive_fixnum /* +The fixnum closest in value to positive infinity. +*/); + Vmost_positive_fixnum = EMACS_INT_MAX; + #ifdef DEBUG_XEMACS DEFVAR_BOOL ("debug-issue-ebola-notices", &debug_issue_ebola_notices /* If non-zero, note when your code may be suffering from char-int confoundance.