Mercurial > hg > xemacs-beta

comparison src/data.c @ 442:abe6d1db359e r21-2-36

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-36
author cvs
date Mon, 13 Aug 2007 11:35:02 +0200
parents 8de8e3f6228a
children 576fb035e263
comparison
equal deleted inserted replaced
441:72a7cfa4a488 442:abe6d1db359e
1 /* Primitive operations on Lisp data types for XEmacs Lisp interpreter. 1 /* Primitive operations on Lisp data types for XEmacs Lisp interpreter.
2 Copyright (C) 1985, 1986, 1988, 1992, 1993, 1994, 1995 2 Copyright (C) 1985, 1986, 1988, 1992, 1993, 1994, 1995
3 Free Software Foundation, Inc. 3 Free Software Foundation, Inc.
4 Copyright (C) 2000 Ben Wing.
4 5
5 This file is part of XEmacs. 6 This file is part of XEmacs.
6 7
7 XEmacs is free software; you can redistribute it and/or modify it 8 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the 9 under the terms of the GNU General Public License as published by the
37 # include "sysfloat.h" 38 # include "sysfloat.h"
38 #endif /* LISP_FLOAT_TYPE */ 39 #endif /* LISP_FLOAT_TYPE */
39 40
40 Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound; 41 Lisp_Object Qnil, Qt, Qquote, Qlambda, Qunbound;
41 Lisp_Object Qerror_conditions, Qerror_message; 42 Lisp_Object Qerror_conditions, Qerror_message;
42 Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range; 43 Lisp_Object Qerror, Qquit, Qsyntax_error, Qinvalid_read_syntax;
44 Lisp_Object Qlist_formation_error;
45 Lisp_Object Qmalformed_list, Qmalformed_property_list;
46 Lisp_Object Qcircular_list, Qcircular_property_list;
47 Lisp_Object Qinvalid_argument, Qwrong_type_argument, Qargs_out_of_range;
48 Lisp_Object Qwrong_number_of_arguments, Qinvalid_function, Qno_catch;
49 Lisp_Object Qinternal_error, Qinvalid_state;
43 Lisp_Object Qvoid_variable, Qcyclic_variable_indirection; 50 Lisp_Object Qvoid_variable, Qcyclic_variable_indirection;
44 Lisp_Object Qvoid_function, Qcyclic_function_indirection; 51 Lisp_Object Qvoid_function, Qcyclic_function_indirection;
45 Lisp_Object Qsetting_constant, Qinvalid_read_syntax; 52 Lisp_Object Qinvalid_operation, Qinvalid_change;
46 Lisp_Object Qmalformed_list, Qmalformed_property_list; 53 Lisp_Object Qsetting_constant;
47 Lisp_Object Qcircular_list, Qcircular_property_list; 54 Lisp_Object Qediting_error;
48 Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch; 55 Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
49 Lisp_Object Qio_error, Qend_of_file; 56 Lisp_Object Qio_error, Qend_of_file;
50 Lisp_Object Qarith_error, Qrange_error, Qdomain_error; 57 Lisp_Object Qarith_error, Qrange_error, Qdomain_error;
51 Lisp_Object Qsingularity_error, Qoverflow_error, Qunderflow_error; 58 Lisp_Object Qsingularity_error, Qoverflow_error, Qunderflow_error;
52 Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
53 Lisp_Object Qintegerp, Qnatnump, Qsymbolp; 59 Lisp_Object Qintegerp, Qnatnump, Qsymbolp;
54 Lisp_Object Qlistp, Qtrue_list_p, Qweak_listp; 60 Lisp_Object Qlistp, Qtrue_list_p, Qweak_listp;
55 Lisp_Object Qconsp, Qsubrp; 61 Lisp_Object Qconsp, Qsubrp;
56 Lisp_Object Qcharacterp, Qstringp, Qarrayp, Qsequencep, Qvectorp; 62 Lisp_Object Qcharacterp, Qstringp, Qarrayp, Qsequencep, Qvectorp;
57 Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qbufferp; 63 Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qbufferp;
355 If non-nil, the return value will be a list whose first element is 361 If non-nil, the return value will be a list whose first element is
356 `interactive' and whose second element is the interactive spec. 362 `interactive' and whose second element is the interactive spec.
357 */ 363 */
358 (subr)) 364 (subr))
359 { 365 {
360 CONST char *prompt; 366 const char *prompt;
361 CHECK_SUBR (subr); 367 CHECK_SUBR (subr);
362 prompt = XSUBR (subr)->prompt; 368 prompt = XSUBR (subr)->prompt;
363 return prompt ? list2 (Qinteractive, build_string (prompt)) : Qnil; 369 return prompt ? list2 (Qinteractive, build_string (prompt)) : Qnil;
364 } 370 }
365 371
636 If OBJECT is a symbol, find the end of its function chain and 642 If OBJECT is a symbol, find the end of its function chain and
637 return the value found there. If OBJECT is not a symbol, just 643 return the value found there. If OBJECT is not a symbol, just
638 return it. If there is a cycle in the function chain, signal a 644 return it. If there is a cycle in the function chain, signal a
639 cyclic-function-indirection error. 645 cyclic-function-indirection error.
640 646
641 This is like Findirect_function, except that it doesn't signal an 647 This is like Findirect_function when VOID_FUNCTION_ERRORP is true.
642 error if the chain ends up unbound. */ 648 When VOID_FUNCTION_ERRORP is false, no error is signaled if the end
649 of the chain ends up being Qunbound. */
643 Lisp_Object 650 Lisp_Object
644 indirect_function (Lisp_Object object, int errorp) 651 indirect_function (Lisp_Object object, int void_function_errorp)
645 { 652 {
646 #define FUNCTION_INDIRECTION_SUSPICION_LENGTH 16 653 #define FUNCTION_INDIRECTION_SUSPICION_LENGTH 16
647 Lisp_Object tortoise, hare; 654 Lisp_Object tortoise, hare;
648 int count; 655 int count;
649 656
657 tortoise = XSYMBOL (tortoise)->function; 664 tortoise = XSYMBOL (tortoise)->function;
658 if (EQ (hare, tortoise)) 665 if (EQ (hare, tortoise))
659 return Fsignal (Qcyclic_function_indirection, list1 (object)); 666 return Fsignal (Qcyclic_function_indirection, list1 (object));
660 } 667 }
661 668
662 if (errorp && UNBOUNDP (hare)) 669 if (void_function_errorp && UNBOUNDP (hare))
663 return signal_void_function_error (object); 670 return signal_void_function_error (object);
664 671
665 return hare; 672 return hare;
666 } 673 }
667 674
1062 atoi do this anyway, so we might as well make Emacs lisp consistent. */ 1069 atoi do this anyway, so we might as well make Emacs lisp consistent. */
1063 while (*p == ' ' || *p == '\t') 1070 while (*p == ' ' || *p == '\t')
1064 p++; 1071 p++;
1065 1072
1066 #ifdef LISP_FLOAT_TYPE 1073 #ifdef LISP_FLOAT_TYPE
1067 if (isfloat_string (p)) 1074 if (isfloat_string (p) && b == 10)
1068 return make_float (atof (p)); 1075 return make_float (atof (p));
1069 #endif /* LISP_FLOAT_TYPE */ 1076 #endif /* LISP_FLOAT_TYPE */
1070 1077
1071 if (b == 10) 1078 if (b == 10)
1072 { 1079 {
1734 /* just leave bogus elements there */ 1741 /* just leave bogus elements there */
1735 need_to_mark_cons = 1; 1742 need_to_mark_cons = 1;
1736 need_to_mark_elem = 1; 1743 need_to_mark_elem = 1;
1737 } 1744 }
1738 else if (marked_p (XCDR (elem))) 1745 else if (marked_p (XCDR (elem)))
1746 {
1747 need_to_mark_cons = 1;
1748 /* We still need to mark elem and XCAR (elem);
1749 marking elem does both */
1750 need_to_mark_elem = 1;
1751 }
1752 break;
1753
1754 case WEAK_LIST_FULL_ASSOC:
1755 if (!CONSP (elem))
1756 {
1757 /* just leave bogus elements there */
1758 need_to_mark_cons = 1;
1759 need_to_mark_elem = 1;
1760 }
1761 else if (marked_p (XCAR (elem)) ||
1762 marked_p (XCDR (elem)))
1739 { 1763 {
1740 need_to_mark_cons = 1; 1764 need_to_mark_cons = 1;
1741 /* We still need to mark elem and XCAR (elem); 1765 /* We still need to mark elem and XCAR (elem);
1742 marking elem does both */ 1766 marking elem does both */
1743 need_to_mark_elem = 1; 1767 need_to_mark_elem = 1;
1882 if (EQ (symbol, Qsimple)) return WEAK_LIST_SIMPLE; 1906 if (EQ (symbol, Qsimple)) return WEAK_LIST_SIMPLE;
1883 if (EQ (symbol, Qassoc)) return WEAK_LIST_ASSOC; 1907 if (EQ (symbol, Qassoc)) return WEAK_LIST_ASSOC;
1884 if (EQ (symbol, Qold_assoc)) return WEAK_LIST_ASSOC; /* EBOLA ALERT! */ 1908 if (EQ (symbol, Qold_assoc)) return WEAK_LIST_ASSOC; /* EBOLA ALERT! */
1885 if (EQ (symbol, Qkey_assoc)) return WEAK_LIST_KEY_ASSOC; 1909 if (EQ (symbol, Qkey_assoc)) return WEAK_LIST_KEY_ASSOC;
1886 if (EQ (symbol, Qvalue_assoc)) return WEAK_LIST_VALUE_ASSOC; 1910 if (EQ (symbol, Qvalue_assoc)) return WEAK_LIST_VALUE_ASSOC;
1911 if (EQ (symbol, Qfull_assoc)) return WEAK_LIST_FULL_ASSOC;
1887 1912
1888 signal_simple_error ("Invalid weak list type", symbol); 1913 signal_simple_error ("Invalid weak list type", symbol);
1889 return WEAK_LIST_SIMPLE; /* not reached */ 1914 return WEAK_LIST_SIMPLE; /* not reached */
1890 } 1915 }
1891 1916
1896 { 1921 {
1897 case WEAK_LIST_SIMPLE: return Qsimple; 1922 case WEAK_LIST_SIMPLE: return Qsimple;
1898 case WEAK_LIST_ASSOC: return Qassoc; 1923 case WEAK_LIST_ASSOC: return Qassoc;
1899 case WEAK_LIST_KEY_ASSOC: return Qkey_assoc; 1924 case WEAK_LIST_KEY_ASSOC: return Qkey_assoc;
1900 case WEAK_LIST_VALUE_ASSOC: return Qvalue_assoc; 1925 case WEAK_LIST_VALUE_ASSOC: return Qvalue_assoc;
1926 case WEAK_LIST_FULL_ASSOC: return Qfull_assoc;
1901 default: 1927 default:
1902 abort (); 1928 abort ();
1903 } 1929 }
1904 1930
1905 return Qnil; /* not reached */ 1931 return Qnil; /* not reached */
1934 pointed to. 1960 pointed to.
1935 `key-assoc' Objects in the list disappear if they are conses 1961 `key-assoc' Objects in the list disappear if they are conses
1936 and the car is not pointed to. 1962 and the car is not pointed to.
1937 `value-assoc' Objects in the list disappear if they are conses 1963 `value-assoc' Objects in the list disappear if they are conses
1938 and the cdr is not pointed to. 1964 and the cdr is not pointed to.
1965 `full-assoc' Objects in the list disappear if they are conses
1966 and neither the car nor the cdr is pointed to.
1939 */ 1967 */
1940 (type)) 1968 (type))
1941 { 1969 {
1942 if (NILP (type)) 1970 if (NILP (type))
1943 type = Qsimple; 1971 type = Qsimple;
2004 } 2032 }
2005 2033
2006 void 2034 void
2007 init_errors_once_early (void) 2035 init_errors_once_early (void)
2008 { 2036 {
2009 defsymbol (&Qerror_conditions, "error-conditions"); 2037 DEFSYMBOL (Qerror_conditions);
2010 defsymbol (&Qerror_message, "error-message"); 2038 DEFSYMBOL (Qerror_message);
2011 2039
2012 /* We declare the errors here because some other deferrors depend 2040 /* We declare the errors here because some other deferrors depend
2013 on some of the errors below. */ 2041 on some of the errors below. */
2014 2042
2015 /* ERROR is used as a signaler for random errors for which nothing 2043 /* ERROR is used as a signaler for random errors for which nothing
2016 else is right */ 2044 else is right */
2017 2045
2018 deferror (&Qerror, "error", "error", Qnil); 2046 DEFERROR (Qerror, "error", Qnil);
2019 deferror (&Qquit, "quit", "Quit", Qnil); 2047 DEFERROR_STANDARD (Qquit, Qnil);
2020 2048
2021 deferror (&Qwrong_type_argument, "wrong-type-argument", 2049 DEFERROR (Qunimplemented, "Feature not yet implemented", Qerror);
2022 "Wrong type argument", Qerror); 2050 DEFERROR_STANDARD (Qsyntax_error, Qerror);
2023 deferror (&Qargs_out_of_range, "args-out-of-range", "Args out of range", 2051 DEFERROR_STANDARD (Qinvalid_read_syntax, Qsyntax_error);
2052 DEFERROR_STANDARD (Qlist_formation_error, Qsyntax_error);
2053
2054 /* Generated by list traversal macros */
2055 DEFERROR_STANDARD (Qmalformed_list, Qlist_formation_error);
2056 DEFERROR_STANDARD (Qmalformed_property_list, Qmalformed_list);
2057 DEFERROR_STANDARD (Qcircular_list, Qlist_formation_error);
2058 DEFERROR_STANDARD (Qcircular_property_list, Qcircular_list);
2059
2060 DEFERROR_STANDARD (Qinvalid_argument, Qerror);
2061 DEFERROR_STANDARD (Qwrong_type_argument, Qinvalid_argument);
2062 DEFERROR_STANDARD (Qargs_out_of_range, Qinvalid_argument);
2063 DEFERROR_STANDARD (Qwrong_number_of_arguments, Qinvalid_argument);
2064 DEFERROR_STANDARD (Qinvalid_function, Qinvalid_argument);
2065 DEFERROR (Qno_catch, "No catch for tag", Qinvalid_argument);
2066
2067 DEFERROR_STANDARD (Qinternal_error, Qerror);
2068
2069 DEFERROR (Qinvalid_state, "Properties or values have been set incorrectly",
2024 Qerror); 2070 Qerror);
2025 deferror (&Qvoid_function, "void-function", 2071 DEFERROR (Qvoid_function, "Symbol's function definition is void",
2026 "Symbol's function definition is void", Qerror); 2072 Qinvalid_state);
2027 deferror (&Qcyclic_function_indirection, "cyclic-function-indirection", 2073 DEFERROR (Qcyclic_function_indirection,
2028 "Symbol's chain of function indirections contains a loop", Qerror); 2074 "Symbol's chain of function indirections contains a loop",
2029 deferror (&Qvoid_variable, "void-variable", 2075 Qinvalid_state);
2030 "Symbol's value as variable is void", Qerror); 2076 DEFERROR (Qvoid_variable, "Symbol's value as variable is void",
2031 deferror (&Qcyclic_variable_indirection, "cyclic-variable-indirection", 2077 Qinvalid_state);
2032 "Symbol's chain of variable indirections contains a loop", Qerror); 2078 DEFERROR (Qcyclic_variable_indirection,
2033 deferror (&Qsetting_constant, "setting-constant", 2079 "Symbol's chain of variable indirections contains a loop",
2034 "Attempt to set a constant symbol", Qerror); 2080 Qinvalid_state);
2035 deferror (&Qinvalid_read_syntax, "invalid-read-syntax", 2081
2036 "Invalid read syntax", Qerror); 2082 DEFERROR (Qinvalid_operation,
2037 2083 "Operation not allowed or error during operation", Qerror);
2038 /* Generated by list traversal macros */ 2084 DEFERROR (Qinvalid_change, "Attempt to set properties or values incorrectly",
2039 deferror (&Qmalformed_list, "malformed-list", 2085 Qinvalid_operation);
2040 "Malformed list", Qerror); 2086 DEFERROR (Qsetting_constant, "Attempt to set a constant symbol",
2041 deferror (&Qmalformed_property_list, "malformed-property-list", 2087 Qinvalid_change);
2042 "Malformed property list", Qmalformed_list); 2088
2043 deferror (&Qcircular_list, "circular-list", 2089 DEFERROR (Qediting_error, "Invalid operation during editing",
2044 "Circular list", Qerror); 2090 Qinvalid_operation);
2045 deferror (&Qcircular_property_list, "circular-property-list", 2091 DEFERROR_STANDARD (Qbeginning_of_buffer, Qediting_error);
2046 "Circular property list", Qcircular_list); 2092 DEFERROR_STANDARD (Qend_of_buffer, Qediting_error);
2047 2093 DEFERROR (Qbuffer_read_only, "Buffer is read-only", Qediting_error);
2048 deferror (&Qinvalid_function, "invalid-function", "Invalid function", 2094
2049 Qerror); 2095 DEFERROR (Qio_error, "IO Error", Qinvalid_operation);
2050 deferror (&Qwrong_number_of_arguments, "wrong-number-of-arguments", 2096 DEFERROR (Qend_of_file, "End of file or stream", Qio_error);
2051 "Wrong number of arguments", Qerror); 2097
2052 deferror (&Qno_catch, "no-catch", "No catch for tag", 2098 DEFERROR (Qarith_error, "Arithmetic error", Qinvalid_operation);
2053 Qerror); 2099 DEFERROR (Qrange_error, "Arithmetic range error", Qarith_error);
2054 deferror (&Qbeginning_of_buffer, "beginning-of-buffer", 2100 DEFERROR (Qdomain_error, "Arithmetic domain error", Qarith_error);
2055 "Beginning of buffer", Qerror); 2101 DEFERROR (Qsingularity_error, "Arithmetic singularity error", Qdomain_error);
2056 deferror (&Qend_of_buffer, "end-of-buffer", "End of buffer", Qerror); 2102 DEFERROR (Qoverflow_error, "Arithmetic overflow error", Qdomain_error);
2057 deferror (&Qbuffer_read_only, "buffer-read-only", "Buffer is read-only", 2103 DEFERROR (Qunderflow_error, "Arithmetic underflow error", Qdomain_error);
2058 Qerror);
2059
2060 deferror (&Qio_error, "io-error", "IO Error", Qerror);
2061 deferror (&Qend_of_file, "end-of-file", "End of stream", Qio_error);
2062
2063 deferror (&Qarith_error, "arith-error", "Arithmetic error", Qerror);
2064 deferror (&Qrange_error, "range-error", "Arithmetic range error",
2065 Qarith_error);
2066 deferror (&Qdomain_error, "domain-error", "Arithmetic domain error",
2067 Qarith_error);
2068 deferror (&Qsingularity_error, "singularity-error",
2069 "Arithmetic singularity error", Qdomain_error);
2070 deferror (&Qoverflow_error, "overflow-error",
2071 "Arithmetic overflow error", Qdomain_error);
2072 deferror (&Qunderflow_error, "underflow-error",
2073 "Arithmetic underflow error", Qdomain_error);
2074 } 2104 }
2075 2105
2076 void 2106 void
2077 syms_of_data (void) 2107 syms_of_data (void)
2078 { 2108 {
2079 defsymbol (&Qquote, "quote"); 2109 INIT_LRECORD_IMPLEMENTATION (weak_list);
2080 defsymbol (&Qlambda, "lambda"); 2110
2081 defsymbol (&Qlistp, "listp"); 2111 DEFSYMBOL (Qquote);
2082 defsymbol (&Qtrue_list_p, "true-list-p"); 2112 DEFSYMBOL (Qlambda);
2083 defsymbol (&Qconsp, "consp"); 2113 DEFSYMBOL (Qlistp);
2084 defsymbol (&Qsubrp, "subrp"); 2114 DEFSYMBOL (Qtrue_list_p);
2085 defsymbol (&Qsymbolp, "symbolp"); 2115 DEFSYMBOL (Qconsp);
2086 defsymbol (&Qintegerp, "integerp"); 2116 DEFSYMBOL (Qsubrp);
2087 defsymbol (&Qcharacterp, "characterp"); 2117 DEFSYMBOL (Qsymbolp);
2088 defsymbol (&Qnatnump, "natnump"); 2118 DEFSYMBOL (Qintegerp);
2089 defsymbol (&Qstringp, "stringp"); 2119 DEFSYMBOL (Qcharacterp);
2090 defsymbol (&Qarrayp, "arrayp"); 2120 DEFSYMBOL (Qnatnump);
2091 defsymbol (&Qsequencep, "sequencep"); 2121 DEFSYMBOL (Qstringp);
2092 defsymbol (&Qbufferp, "bufferp"); 2122 DEFSYMBOL (Qarrayp);
2093 defsymbol (&Qbitp, "bitp"); 2123 DEFSYMBOL (Qsequencep);
2094 defsymbol (&Qbit_vectorp, "bit-vector-p"); 2124 DEFSYMBOL (Qbufferp);
2095 defsymbol (&Qvectorp, "vectorp"); 2125 DEFSYMBOL (Qbitp);
2096 defsymbol (&Qchar_or_string_p, "char-or-string-p"); 2126 DEFSYMBOL_MULTIWORD_PREDICATE (Qbit_vectorp);
2097 defsymbol (&Qmarkerp, "markerp"); 2127 DEFSYMBOL (Qvectorp);
2098 defsymbol (&Qinteger_or_marker_p, "integer-or-marker-p"); 2128 DEFSYMBOL (Qchar_or_string_p);
2099 defsymbol (&Qinteger_or_char_p, "integer-or-char-p"); 2129 DEFSYMBOL (Qmarkerp);
2100 defsymbol (&Qinteger_char_or_marker_p, "integer-char-or-marker-p"); 2130 DEFSYMBOL (Qinteger_or_marker_p);
2101 defsymbol (&Qnumberp, "numberp"); 2131 DEFSYMBOL (Qinteger_or_char_p);
2102 defsymbol (&Qnumber_char_or_marker_p, "number-char-or-marker-p"); 2132 DEFSYMBOL (Qinteger_char_or_marker_p);
2103 defsymbol (&Qcdr, "cdr"); 2133 DEFSYMBOL (Qnumberp);
2104 defsymbol (&Qweak_listp, "weak-list-p"); 2134 DEFSYMBOL (Qnumber_char_or_marker_p);
2135 DEFSYMBOL (Qcdr);
2136 DEFSYMBOL_MULTIWORD_PREDICATE (Qweak_listp);
2105 2137
2106 #ifdef LISP_FLOAT_TYPE 2138 #ifdef LISP_FLOAT_TYPE
2107 defsymbol (&Qfloatp, "floatp"); 2139 DEFSYMBOL (Qfloatp);
2108 #endif /* LISP_FLOAT_TYPE */ 2140 #endif /* LISP_FLOAT_TYPE */
2109 2141
2110 DEFSUBR (Fwrong_type_argument); 2142 DEFSUBR (Fwrong_type_argument);
2111 2143
2112 DEFSUBR (Feq); 2144 DEFSUBR (Feq);