xemacs-beta: src/data.c comparison

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

Import from CVS: tag r21-0b34

author	cvs
date	Mon, 13 Aug 2007 10:28:48 +0200
parents	11cf20601dec
children	6330739388db

comparison

equal deleted inserted replaced

-:c7b7086b0a39
+:c5d627a313b1
 #include <config.h>
 #include "lisp.h"
 #include "buffer.h"
 #include "bytecode.h"
 #include "syssignal.h"
 #ifdef LISP_FLOAT_TYPE
 /* Need to define a differentiating symbol -- see sysfloat.h */
 # define THIS_FILENAME data_c
 # include "sysfloat.h"
 #endif /* LISP_FLOAT_TYPE */
 Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
-Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
+Lisp_Object Qerror_conditions, Qerror_message;
-Lisp_Object Qsignal, Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
+Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
 Lisp_Object Qvoid_variable, Qcyclic_variable_indirection;
 Lisp_Object Qvoid_function, Qcyclic_function_indirection;
 Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
 Lisp_Object Qmalformed_list, Qmalformed_property_list;
 Lisp_Object Qcircular_list, Qcircular_property_list;
 Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
 Lisp_Object Qio_error, Qend_of_file;
 Lisp_Object Qarith_error, Qrange_error, Qdomain_error;
 Lisp_Object Qsingularity_error, Qoverflow_error, Qunderflow_error;
 Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
-Lisp_Object Qintegerp, Qnatnump, Qsymbolp, Qkeywordp, Qlistp, Qconsp, Qsubrp;
+Lisp_Object Qintegerp, Qnatnump, Qsymbolp, Qkeywordp;
-Lisp_Object Qcharacterp, Qstringp, Qarrayp, Qsequencep, Qbufferp;
+Lisp_Object Qlistp, Qtrue_list_p, Qweak_listp;
-Lisp_Object Qcompiled_functionp;
+Lisp_Object Qconsp, Qsubrp, Qcompiled_functionp;
-Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
+Lisp_Object Qcharacterp, Qstringp, Qarrayp, Qsequencep, Qvectorp;
+Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qbufferp;
 Lisp_Object Qinteger_or_char_p, Qinteger_char_or_marker_p;
-Lisp_Object Qbit_vectorp, Qbitp;
+Lisp_Object Qnumberp, Qnumber_or_marker_p, Qnumber_char_or_marker_p;
+Lisp_Object Qbit_vectorp, Qbitp, Qcons, Qkeyword, Qcdr, Qignore;
-/* Qstring, Qinteger, Qsymbol, Qvector defined in general.c */
-Lisp_Object Qcons, Qkeyword;
-Lisp_Object Qcdr;
-Lisp_Object Qignore;
 #ifdef LISP_FLOAT_TYPE
 Lisp_Object Qfloatp;
 #endif
-Lisp_Object Qnumberp, Qnumber_or_marker_p, Qnumber_char_or_marker_p;
-Lisp_Object Qweak_listp;
 #ifdef DEBUG_XEMACS
 int debug_issue_ebola_notices;
 void
 check_int_range (int val, int min, int max)
 {
 if (val < min || val > max)
-args_out_of_range_3 (make_int (val), make_int (min),
+args_out_of_range_3 (make_int (val), make_int (min), make_int (max));
-			 make_int (max));
+}
-}
-#ifndef make_int
-Lisp_Object
-make_int (EMACS_INT num)
-{
-Lisp_Object val;
-#ifdef USE_MINIMAL_TAGBITS
-XSETINT(val, num);
-#else
-/* Don't use XSETINT here -- it's defined in terms of make_int ().  */
-XSETOBJ (val, Lisp_Type_Int, num);
-#endif
-return val;
-}
-#endif /* ! defined (make_int) */
 /* On some machines, XINT needs a temporary location.
 Here it is, in case it is needed.  */
 EMACS_INT sign_extend_temp;
 return num | ((-1L) << VALBITS);
 else
 return num & ((1L << VALBITS) - 1);
 }
-/* characters do not need to sign extend so there's no need for special
-futzing like with ints. */
-#ifndef make_char
-Lisp_Object
-make_char (Emchar num)
-{
-Lisp_Object val;
-#ifdef USE_MINIMAL_TAGBITS
-XSETCHAR (val, num);
-#else
-XSETOBJ (val, Lisp_Type_Char, num);
-#endif
-return val;
-}
-#endif /* ! make_char */
 /* Data type predicates */
 DEFUN ("eq", Feq, 2, 2, 0, /*
-T if the two args are the same Lisp object.
+Return t if the two args are the same Lisp object.
 */
 (obj1, obj2))
 {
 return EQ_WITH_EBOLA_NOTICE (obj1, obj2) ? Qt : Qnil;
 }
 DEFUN ("old-eq", Fold_eq, 2, 2, 0, /*
-T if the two args are (in most cases) the same Lisp object.
+Return t if the two args are (in most cases) the same Lisp object.
 Special kludge: A character is considered `old-eq' to its equivalent integer
 even though they are not the same object and are in fact of different
 types.  This is ABSOLUTELY AND UTTERLY HORRENDOUS but is necessary to
 preserve byte-code compatibility with v19.  This kludge is known as the
 /* #### blasphemy */
 return HACKEQ_UNSAFE (obj1, obj2) ? Qt : Qnil;
 }
 DEFUN ("null", Fnull, 1, 1, 0, /*
-T if OBJECT is nil.
+Return t if OBJECT is nil.
 */
 (object))
 {
 return NILP (object) ? Qt : Qnil;
 }
 DEFUN ("consp", Fconsp, 1, 1, 0, /*
-T if OBJECT is a cons cell.
+Return t if OBJECT is a cons cell.
 */
 (object))
 {
 return CONSP (object) ? Qt : Qnil;
 }
 DEFUN ("atom", Fatom, 1, 1, 0, /*
-T if OBJECT is not a cons cell.  This includes nil.
+Return t if OBJECT is not a cons cell.  Atoms include nil.
 */
 (object))
 {
 return CONSP (object) ? Qnil : Qt;
 }
 DEFUN ("listp", Flistp, 1, 1, 0, /*
-T if OBJECT is a list.  This includes nil.
+Return t if OBJECT is a list.  Lists includes nil.
 */
 (object))
 {
-return CONSP (object) || NILP (object) ? Qt : Qnil;
+return LISTP (object) ? Qt : Qnil;
 }
 DEFUN ("nlistp", Fnlistp, 1, 1, 0, /*
-T if OBJECT is not a list.  Lists include nil.
+Return t if OBJECT is not a list.  Lists include nil.
 */
 (object))
 {
-return CONSP (object) || NILP (object) ? Qnil : Qt;
+return LISTP (object) ? Qnil : Qt;
+}
+DEFUN ("true-list-p", Ftrue_list_p, 1, 1, 0, /*
+Return t if OBJECT is a non-dotted, i.e. nil-terminated, list.
+*/
+(object))
+{
+return TRUE_LIST_P (object) ? Qt : Qnil;
 }
 DEFUN ("symbolp", Fsymbolp, 1, 1, 0, /*
-T if OBJECT is a symbol.
+Return t if OBJECT is a symbol.
 */
 (object))
 {
 return SYMBOLP (object) ? Qt : Qnil;
 }
 DEFUN ("keywordp", Fkeywordp, 1, 1, 0, /*
-T if OBJECT is a keyword.
+Return t if OBJECT is a keyword.
 */
 (object))
 {
 return KEYWORDP (object) ? Qt : Qnil;
 }
 DEFUN ("vectorp", Fvectorp, 1, 1, 0, /*
-T if OBJECT is a vector.
+REturn t if OBJECT is a vector.
 */
 (object))
 {
 return VECTORP (object) ? Qt : Qnil;
 }
 DEFUN ("bit-vector-p", Fbit_vector_p, 1, 1, 0, /*
-T if OBJECT is a bit vector.
+Return t if OBJECT is a bit vector.
 */
 (object))
 {
 return BIT_VECTORP (object) ? Qt : Qnil;
 }
 DEFUN ("stringp", Fstringp, 1, 1, 0, /*
-T if OBJECT is a string.
+Return t if OBJECT is a string.
 */
 (object))
 {
 return STRINGP (object) ? Qt : Qnil;
 }
 DEFUN ("arrayp", Farrayp, 1, 1, 0, /*
-T if OBJECT is an array (string, vector, or bit vector).
+Return t if OBJECT is an array (string, vector, or bit vector).
 */
 (object))
 {
-return (VECTORP     (object) ||
+return (VECTORP	(object) ||
-	  STRINGP     (object) ||
+	  STRINGP	(object) ||
-	  BIT_VECTORP (object))
+	  BIT_VECTORP	(object))
 ? Qt : Qnil;
 }
 DEFUN ("sequencep", Fsequencep, 1, 1, 0, /*
-T if OBJECT is a sequence (list or array).
+Return t if OBJECT is a sequence (list or array).
 */
 (object))
 {
-return (CONSP       (object) ||
+return (CONSP		(object) ||
-	  NILP        (object) ||
+	  NILP		(object) ||
-	  VECTORP     (object) ||
+	  VECTORP	(object) ||
-	  STRINGP     (object) ||
+	  STRINGP	(object) ||
-	  BIT_VECTORP (object))
+	  BIT_VECTORP	(object))
 ? Qt : Qnil;
 }
 DEFUN ("markerp", Fmarkerp, 1, 1, 0, /*
-T if OBJECT is a marker (editor pointer).
+Return t if OBJECT is a marker (editor pointer).
 */
 (object))
 {
 return MARKERP (object) ? Qt : Qnil;
 }
 DEFUN ("subrp", Fsubrp, 1, 1, 0, /*
-T if OBJECT is a built-in function.
+Return t if OBJECT is a built-in function.
 */
 (object))
 {
 return SUBRP (object) ? Qt : Qnil;
 }
 prompt = XSUBR (subr)->prompt;
 return prompt ? list2 (Qinteractive, build_string (prompt)) : Qnil;
 }
 DEFUN ("compiled-function-p", Fcompiled_function_p, 1, 1, 0, /*
-t if OBJECT is a byte-compiled function object.
+Return t if OBJECT is a byte-compiled function object.
 */
 (object))
 {
 return COMPILED_FUNCTIONP (object) ? Qt : Qnil;
 }
 DEFUN ("characterp", Fcharacterp, 1, 1, 0, /*
-t if OBJECT is a character.
+Return t if OBJECT is a character.
 Unlike in XEmacs v19 and Emacs, a character is its own primitive type.
 Any character can be converted into an equivalent integer using
 `char-to-int'.  To convert the other way, use `int-to-char'; however,
 only some integers can be converted into characters.  Such an integer
 is called a `char-int'; see `char-int-p'.
 else
 return Qnil;
 }
 DEFUN ("char-int-p", Fchar_int_p, 1, 1, 0, /*
-t if OBJECT is an integer that can be converted into a character.
+Return t if OBJECT is an integer that can be converted into a character.
 See `char-to-int'.
 */
 (object))
 {
 return CHAR_INTP (object) ? Qt : Qnil;
 }
 DEFUN ("char-or-char-int-p", Fchar_or_char_int_p, 1, 1, 0, /*
-t if OBJECT is a character or an integer that can be converted into one.
+Return t if OBJECT is a character or an integer that can be converted into one.
 */
 (object))
 {
 return CHAR_OR_CHAR_INTP (object) ? Qt : Qnil;
 }
 DEFUN ("char-or-string-p", Fchar_or_string_p, 1, 1, 0, /*
-t if OBJECT is a character (or a char-int) or a string.
+Return t if OBJECT is a character (or a char-int) or a string.
 It is semi-hateful that we allow a char-int here, as it goes against
 the name of this function, but it makes the most sense considering the
 other steps we take to maintain compatibility with the old character/integer
 confoundedness in older versions of E-Lisp.
 */
 {
 return CHAR_OR_CHAR_INTP (object) || STRINGP (object) ? Qt : Qnil;
 }
 DEFUN ("integerp", Fintegerp, 1, 1, 0, /*
-t if OBJECT is an integer.
+Return t if OBJECT is an integer.
 */
 (object))
 {
 return INTP (object) ? Qt : Qnil;
 }
 DEFUN ("integer-or-marker-p", Finteger_or_marker_p, 1, 1, 0, /*
-t if OBJECT is an integer or a marker (editor pointer).
+Return t if OBJECT is an integer or a marker (editor pointer).
 */
 (object))
 {
 return INTP (object) || MARKERP (object) ? Qt : Qnil;
 }
 DEFUN ("integer-or-char-p", Finteger_or_char_p, 1, 1, 0, /*
-t if OBJECT is an integer or a character.
+Return t if OBJECT is an integer or a character.
 */
 (object))
 {
 return INTP (object) || CHARP (object) ? Qt : Qnil;
 }
 DEFUN ("integer-char-or-marker-p", Finteger_char_or_marker_p, 1, 1, 0, /*
-t if OBJECT is an integer, character or a marker (editor pointer).
+Return t if OBJECT is an integer, character or a marker (editor pointer).
 */
 (object))
 {
 return INTP (object) || CHARP (object) || MARKERP (object) ? Qt : Qnil;
 }
 DEFUN ("natnump", Fnatnump, 1, 1, 0, /*
-t if OBJECT is a nonnegative integer.
+Return t if OBJECT is a nonnegative integer.
 */
 (object))
 {
 return NATNUMP (object) ? Qt : Qnil;
 }
 DEFUN ("bitp", Fbitp, 1, 1, 0, /*
-t if OBJECT is a bit (0 or 1).
+Return t if OBJECT is a bit (0 or 1).
 */
 (object))
 {
 return BITP (object) ? Qt : Qnil;
 }
 DEFUN ("numberp", Fnumberp, 1, 1, 0, /*
-t if OBJECT is a number (floating point or integer).
+Return t if OBJECT is a number (floating point or integer).
 */
 (object))
 {
 return INT_OR_FLOATP (object) ? Qt : Qnil;
 }
 DEFUN ("number-or-marker-p", Fnumber_or_marker_p, 1, 1, 0, /*
-t if OBJECT is a number or a marker.
+Return t if OBJECT is a number or a marker.
 */
 (object))
 {
 return INT_OR_FLOATP (object) || MARKERP (object) ? Qt : Qnil;
 }
 DEFUN ("number-char-or-marker-p", Fnumber_char_or_marker_p, 1, 1, 0, /*
-t if OBJECT is a number, character or a marker.
+Return t if OBJECT is a number, character or a marker.
 */
 (object))
 {
 return (INT_OR_FLOATP (object) ||
 	  CHARP         (object) ||
 ? Qt : Qnil;
 }
 #ifdef LISP_FLOAT_TYPE
 DEFUN ("floatp", Ffloatp, 1, 1, 0, /*
-t if OBJECT is a floating point number.
+Return t if OBJECT is a floating point number.
 */
 (object))
 {
 return FLOATP (object) ? Qt : Qnil;
 }
 if (CONSP (list))
 	return XCAR (list);
 else if (NILP (list))
 	return Qnil;
 else
-	list = wrong_type_argument (Qconsp, list);
+	list = wrong_type_argument (Qlistp, list);
 }
 }
 DEFUN ("car-safe", Fcar_safe, 1, 1, 0, /*
 Return the car of OBJECT if it is a cons cell, or else nil.
 if (CONSP (list))
 	return XCDR (list);
 else if (NILP (list))
 	return Qnil;
 else
-	list = wrong_type_argument (Qconsp, list);
+	list = wrong_type_argument (Qlistp, list);
 }
 }
 DEFUN ("cdr-safe", Fcdr_safe, 1, 1, 0, /*
-Return the cdr of OBJECT if it is a cons cell, or else  nil.
+Return the cdr of OBJECT if it is a cons cell, else nil.
 */
 (object))
 {
 return CONSP (object) ? XCDR (object) : Qnil;
 }
 DEFUN ("setcar", Fsetcar, 2, 2, 0, /*
-Set the car of CONSCELL to be NEWCAR.  Returns NEWCAR.
+Set the car of CONSCELL to be NEWCAR.  Return NEWCAR.
 */
 (conscell, newcar))
 {
 if (!CONSP (conscell))
 conscell = wrong_type_argument (Qconsp, conscell);
 XCAR (conscell) = newcar;
 return newcar;
 }
 DEFUN ("setcdr", Fsetcdr, 2, 2, 0, /*
-Set the cdr of CONSCELL to be NEWCDR.  Returns NEWCDR.
+Set the cdr of CONSCELL to be NEWCDR.  Return NEWCDR.
 */
 (conscell, newcdr))
 {
 if (!CONSP (conscell))
 conscell = wrong_type_argument (Qconsp, conscell);
 if (idxval >= bit_vector_length (XBIT_VECTOR (array))) goto lose;
 return make_int (bit_vector_bit (XBIT_VECTOR (array), idxval));
 }
 else if (STRINGP (array))
 {
-if (idxval >= string_char_length (XSTRING (array))) goto lose;
+if (idxval >= XSTRING_CHAR_LENGTH (array)) goto lose;
 return make_char (string_char (XSTRING (array), idxval));
 }
 #ifdef LOSING_BYTECODE
 else if (COMPILED_FUNCTIONP (array))
 {
 set_bit_vector_bit (XBIT_VECTOR (array), idxval, !ZEROP (newval));
 }
 else                          /* string */
 {
 CHECK_CHAR_COERCE_INT (newval);
-if (idxval >= string_char_length (XSTRING (array))) goto lose;
+if (idxval >= XSTRING_CHAR_LENGTH (array)) goto lose;
 set_string_char (XSTRING (array), idxval, XCHAR (newval));
 bump_string_modiff (array);
 }
 return newval;
 CHECK_INT_OR_FLOAT_COERCE_CHAR_OR_MARKER (num2);
 #ifdef LISP_FLOAT_TYPE
 if (FLOATP (num1) || FLOATP (num2))
 {
-double f1 = (FLOATP (num1)) ? float_data (XFLOAT (num1)) : XINT (num1);
+double f1 = FLOATP (num1) ? float_data (XFLOAT (num1)) : XINT (num1);
-double f2 = (FLOATP (num2)) ? float_data (XFLOAT (num2)) : XINT (num2);
+double f2 = FLOATP (num2) ? float_data (XFLOAT (num2)) : XINT (num2);
 switch (comparison)
 	{
 	case equal:         return f1 == f2 ? Qt : Qnil;
 	case notequal:      return f1 != f2 ? Qt : Qnil;
 abort ();
 return Qnil;	/* suppress compiler warning */
 }
 DEFUN ("=", Feqlsign, 2, 2, 0, /*
-T if two args, both numbers, characters or markers, are equal.
+Return t if two args, both numbers, characters or markers, are equal.
 */
 (num1, num2))
 {
 return arithcompare (num1, num2, equal);
 }
 DEFUN ("<", Flss, 2, 2, 0, /*
-T if first arg is less than second arg.
+Return t if first arg is less than second arg.
 Both must be numbers, characters or markers.
 */
 (num1, num2))
 {
 return arithcompare (num1, num2, less);
 }
 DEFUN (">", Fgtr, 2, 2, 0, /*
-T if first arg is greater than second arg.
+Return t if first arg is greater than second arg.
 Both must be numbers, characters or markers.
 */
 (num1, num2))
 {
 return arithcompare (num1, num2, grtr);
 }
 DEFUN ("<=", Fleq, 2, 2, 0, /*
-T if first arg is less than or equal to second arg.
+Return t if first arg is less than or equal to second arg.
 Both must be numbers, characters or markers.
 */
 (num1, num2))
 {
 return arithcompare (num1, num2, less_or_equal);
 }
 DEFUN (">=", Fgeq, 2, 2, 0, /*
-T if first arg is greater than or equal to second arg.
+Return t if first arg is greater than or equal to second arg.
 Both must be numbers, characters or markers.
 */
 (num1, num2))
 {
 return arithcompare (num1, num2, grtr_or_equal);
 }
 DEFUN ("/=", Fneq, 2, 2, 0, /*
-T if first arg is not equal to second arg.
+Return t if first arg is not equal to second arg.
 Both must be numbers, characters or markers.
 */
 (num1, num2))
 {
 return arithcompare (num1, num2, notequal);
 return Qt;
 }
 xxxDEFUN ("=", Feqlsign, 1, MANY, 0, /*
-T if all the arguments are equal.
+Return t if all the arguments are equal.
 The arguments may be numbers, characters or markers.
 */
 (int nargs, Lisp_Object *args))
 {
 return arithcompare (equal, nargs, args);
 }
 xxxDEFUN ("<", Flss, 1, MANY, 0, /*
-T if the sequence of arguments is monotonically increasing.
+Return t if the sequence of arguments is monotonically increasing.
 The arguments may be numbers, characters or markers.
 */
 (int nargs, Lisp_Object *args))
 {
 return arithcompare (less, nargs, args);
 }
 xxxDEFUN (">", Fgtr, 1, MANY, 0, /*
-T if the sequence of arguments is monotonically decreasing.
+Return t if the sequence of arguments is monotonically decreasing.
 The arguments may be numbers, characters or markers.
 */
 (int nargs, Lisp_Object *args))
 {
 return arithcompare (grtr, nargs, args);
 }
 xxxDEFUN ("<=", Fleq, 1, MANY, 0, /*
-T if the sequence of arguments is monotonically nondecreasing.
+Return t if the sequence of arguments is monotonically nondecreasing.
 The arguments may be numbers, characters or markers.
 */
 (int nargs, Lisp_Object *args))
 {
 return arithcompare (less_or_equal, nargs, args);
 }
 xxxDEFUN (">=", Fgeq, 1, MANY, 0, /*
-T if the sequence of arguments is monotonically nonincreasing.
+Return t if the sequence of arguments is monotonically nonincreasing.
 The arguments may be numbers, characters or markers.
 */
 (int nargs, Lisp_Object *args))
 {
 return arithcompare_many (grtr_or_equal, nargs, args);
 }
 xxxDEFUN ("/=", Fneq, 1, MANY, 0, /*
-T if the sequence of arguments is monotonically increasing.
+Return t if the sequence of arguments is monotonically increasing.
 The arguments may be numbers, characters or markers.
 */
 (int nargs, Lisp_Object *args))
 {
 return arithcompare_many (notequal, nargs, args);
 }
 #endif /* 0 - disabled for now */
 DEFUN ("zerop", Fzerop, 1, 1, 0, /*
-T if NUMBER is zero.
+Return t if NUMBER is zero.
 */
 (number))
 {
 CHECK_INT_OR_FLOAT (number);
 #ifdef LISP_FLOAT_TYPE
 if (FLOATP (number))
 return float_data (XFLOAT (number)) == 0.0 ? Qt : Qnil;
 #endif /* LISP_FLOAT_TYPE */
-return XINT (number) == 0 ? Qt : Qnil;
+return EQ (number, Qzero) ? Qt : Qnil;
 }
 /* Convert between a 32-bit value and a cons of two 16-bit values.
 This is used to pass 32-bit integers to and from the user.
 Use time_to_lisp() and lisp_to_time() for time values.
 }
 static int
 digit_to_number (int character, int base)
 {
-int digit;
+/* Assumes ASCII */
+int digit = ((character >= '0' && character <= '9') ? character - '0'      :
-if (character >= '0' && character <= '9')
+	       (character >= 'a' && character <= 'z') ? character - 'a' + 10 :
-digit = character - '0';
+	       (character >= 'A' && character <= 'Z') ? character - 'A' + 10 :
-else if (character >= 'a' && character <= 'z')
+	       -1);
-digit = character - 'a' + 10;
-else if (character >= 'A' && character <= 'Z')
+return digit >= base ? -1 : digit;
-digit = character - 'A' + 10;
-else
-return -1;
-if (digit >= base)
-return -1;
-else
-return digit;
 }
 DEFUN ("string-to-number", Fstring_to_number, 1, 2, 0, /*
 Convert STRING to a number by parsing it as a decimal number.
 This parses both integers and floating point numbers.
 #endif /* LISP_FLOAT_TYPE */
 if (b == 10)
 {
 /* Use the system-provided functions for base 10. */
-Lisp_Object value;
+#if SIZEOF_EMACS_INT == SIZEOF_INT
-if (sizeof (int) == sizeof (EMACS_INT))
+return make_int (atoi (p));
-	XSETINT (value, atoi (p));
+#elif SIZEOF_EMACS_INT == SIZEOF_LONG
-else if (sizeof (long) == sizeof (EMACS_INT))
+return make_int (atol (p));
-	XSETINT (value, atol (p));
+#elif SIZEOF_EMACS_INT == SIZEOF_LONG_LONG
-else
+return make_int (atoll (p));
-	abort ();
+#endif
-return value;
 }
 else
 {
 int digit, negative = 1;
 EMACS_INT v = 0;
 If COUNT is negative, shifting is actually to the right.
 In this case, zeros are shifted in on the left.
 */
 (value, count))
 {
-Lisp_Object val;
 CHECK_INT_COERCE_CHAR (value);
 CHECK_INT (count);
-{
+return make_int (XINT (count) > 0 ?
-int C_count = XINT (count);
+		   XUINT (value) <<  XINT (count) :
-/* EMACS_UINT C_value = (EMACS_UINT) XUINT (value);*/
+		   XUINT (value) >> -XINT (count));
-EMACS_UINT C_value = (EMACS_UINT) XUINT (value);
-XSETINT (val, C_count > 0 ? C_value << C_count : C_value >> -C_count);
-}
-return val;
 }
 DEFUN ("1+", Fadd1, 1, 1, 0, /*
 Return NUMBER plus one.  NUMBER may be a number or a marker.
 Markers and characters are converted to integers.
 The basic idea is that we don't mark the elements during GC, but
 wait for them to be marked elsewhere.  If they're not marked, we
 remove them.  This is analogous to weak hashtables; see the explanation
 there for more info. */
-static Lisp_Object mark_weak_list (Lisp_Object, void (*) (Lisp_Object));
-static void print_weak_list (Lisp_Object, Lisp_Object, int);
-static int weak_list_equal (Lisp_Object, Lisp_Object, int depth);
-static unsigned long weak_list_hash (Lisp_Object obj, int depth);
-DEFINE_LRECORD_IMPLEMENTATION ("weak-list", weak_list,
-mark_weak_list, print_weak_list,
-			       0, weak_list_equal, weak_list_hash,
-			       struct weak_list);
 static Lisp_Object Vall_weak_lists; /* Gemarke es nicht!!! */
 static Lisp_Object encode_weak_list_type (enum weak_list_type type);
 static Lisp_Object
 }
 Lisp_Object
 make_weak_list (enum weak_list_type type)
 {
-Lisp_Object result = Qnil;
+Lisp_Object result;
 struct weak_list *wl =
 alloc_lcrecord_type (struct weak_list, lrecord_weak_list);
 wl->list = Qnil;
 wl->type = type;
 wl->next_weak = Vall_weak_lists;
 Vall_weak_lists = result;
 return result;
 }
+DEFINE_LRECORD_IMPLEMENTATION ("weak-list", weak_list,
+			       mark_weak_list, print_weak_list,
+			       0, weak_list_equal, weak_list_hash,
+			       struct weak_list);
 /*
 -- we do not mark the list elements (either the elements themselves
 or the cons cells that hold them) in the normal marking phase.
 -- at the end of marking, we go through all weak lists that are
 marked, and mark the cons cells that hold all marked
 {
 return WEAK_LISTP (object) ? Qt : Qnil;
 }
 DEFUN ("make-weak-list", Fmake_weak_list, 0, 1, 0, /*
-Create a new weak list.
+Return a new weak list object of type TYPE.
 A weak list object is an object that contains a list.  This list behaves
 like any other list except that its elements do not count towards
 garbage collection -- if the only pointer to an object in inside a weak
 list (other than pointers in similar objects such as weak hash tables),
 the object is garbage collected and automatically removed from the list.
 void
 syms_of_data (void)
 {
 defsymbol (&Qcons, "cons");
 defsymbol (&Qkeyword, "keyword");
-/* Qstring, Qinteger, Qsymbol, Qvector defined in general.c */
 defsymbol (&Qquote, "quote");
 defsymbol (&Qlambda, "lambda");
-defsymbol (&Qsignal, "signal");
-defsymbol (&Qtop_level, "top-level");
 defsymbol (&Qignore, "ignore");
 defsymbol (&Qlistp, "listp");
+defsymbol (&Qtrue_list_p, "true-list-p");
 defsymbol (&Qconsp, "consp");
 defsymbol (&Qsubrp, "subrp");
 defsymbol (&Qsymbolp, "symbolp");
 defsymbol (&Qkeywordp, "keywordp");
 defsymbol (&Qintegerp, "integerp");
 defsymbol (&Qchar_or_string_p, "char-or-string-p");
 defsymbol (&Qmarkerp, "markerp");
 defsymbol (&Qinteger_or_marker_p, "integer-or-marker-p");
 defsymbol (&Qinteger_or_char_p, "integer-or-char-p");
 defsymbol (&Qinteger_char_or_marker_p, "integer-char-or-marker-p");
+defsymbol (&Qnumberp, "numberp");
+defsymbol (&Qnumber_or_marker_p, "number-or-marker-p");
+defsymbol (&Qnumber_char_or_marker_p, "number-char-or-marker-p");
+defsymbol (&Qcdr, "cdr");
+defsymbol (&Qweak_listp, "weak-list-p");
 #ifdef LISP_FLOAT_TYPE
 defsymbol (&Qfloatp, "floatp");
 #endif /* LISP_FLOAT_TYPE */
-defsymbol (&Qnumberp, "numberp");
-defsymbol (&Qnumber_or_marker_p, "number-or-marker-p");
-defsymbol (&Qnumber_char_or_marker_p, "number-char-or-marker-p");
-defsymbol (&Qcdr, "cdr");
-defsymbol (&Qweak_listp, "weak-list-p");
 DEFSUBR (Fwrong_type_argument);
 DEFSUBR (Feq);
 DEFSUBR (Fold_eq);
 DEFSUBR (Fnull);
 DEFSUBR (Flistp);
 DEFSUBR (Fnlistp);
+DEFSUBR (Ftrue_list_p);
 DEFSUBR (Fconsp);
 DEFSUBR (Fatom);
 DEFSUBR (Fchar_or_string_p);
 DEFSUBR (Fcharacterp);
 DEFSUBR (Fchar_int_p);

Mercurial > hg > xemacs-beta

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