Mercurial > hg > xemacs-beta
annotate src/data.c @ 5887:6eca500211f4
Prototype for X509_check_host() has changed, detect this in configure.ac
ChangeLog addition:
2015-04-09 Aidan Kehoe <kehoea@parhasard.net>
* configure.ac:
If X509_check_host() is available, check the number of arguments
it takes. Don't use it if it takes any number of arguments other
than five. Also don't use it if <openssl/x509v3.h> does not
declare it, since if that is so there is no portable way to tell
how many arguments it should take, and so we would end up smashing
the stack.
* configure: Regenerate.
src/ChangeLog addition:
2015-04-09 Aidan Kehoe <kehoea@parhasard.net>
* tls.c:
#include <openssl/x509v3.h> for its prototype for
X509_check_host().
* tls.c (tls_open):
Pass the new fifth argument to X509_check_host().
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Thu, 09 Apr 2015 14:27:02 +0100 |
| parents | c96000075e49 |
| children | 5afddd952c46 |
| rev | line source |
|---|---|
| 428 | 1 /* Primitive operations on Lisp data types for XEmacs Lisp interpreter. |
| 2 Copyright (C) 1985, 1986, 1988, 1992, 1993, 1994, 1995 | |
| 3 Free Software Foundation, Inc. | |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
4 Copyright (C) 2000, 2001, 2002, 2003, 2005, 2010 Ben Wing. |
| 428 | 5 |
| 6 This file is part of XEmacs. | |
| 7 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5207
diff
changeset
|
8 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 9 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5207
diff
changeset
|
10 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5207
diff
changeset
|
11 option) any later version. |
| 428 | 12 |
| 13 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 16 for more details. | |
| 17 | |
| 18 You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5207
diff
changeset
|
19 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 20 |
| 21 /* Synched up with: Mule 2.0, FSF 19.30. Some of FSF's data.c is in | |
| 22 XEmacs' symbols.c. */ | |
| 23 | |
| 24 /* This file has been Mule-ized. */ | |
| 25 | |
| 26 #include <config.h> | |
| 27 #include "lisp.h" | |
| 28 | |
| 29 #include "buffer.h" | |
| 30 #include "bytecode.h" | |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
31 #include "gc.h" |
| 428 | 32 #include "syssignal.h" |
| 771 | 33 #include "sysfloat.h" |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
34 #include "syntax.h" |
| 428 | 35 |
|
5207
1096ef427b56
Error on too many arguments to #'function, #'quote.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5191
diff
changeset
|
36 Lisp_Object Qnil, Qt, Qlambda, Qunbound; |
| 428 | 37 Lisp_Object Qerror_conditions, Qerror_message; |
| 442 | 38 Lisp_Object Qerror, Qquit, Qsyntax_error, Qinvalid_read_syntax; |
| 563 | 39 Lisp_Object Qlist_formation_error, Qstructure_formation_error; |
| 442 | 40 Lisp_Object Qmalformed_list, Qmalformed_property_list; |
| 41 Lisp_Object Qcircular_list, Qcircular_property_list; | |
| 563 | 42 Lisp_Object Qinvalid_argument, Qinvalid_constant, Qwrong_type_argument; |
| 43 Lisp_Object Qargs_out_of_range; | |
|
5084
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4998
diff
changeset
|
44 Lisp_Object Qwrong_number_of_arguments, Qinvalid_function; |
|
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4998
diff
changeset
|
45 Lisp_Object Qinvalid_keyword_argument, Qno_catch; |
| 563 | 46 Lisp_Object Qinternal_error, Qinvalid_state, Qstack_overflow, Qout_of_memory; |
| 428 | 47 Lisp_Object Qvoid_variable, Qcyclic_variable_indirection; |
| 48 Lisp_Object Qvoid_function, Qcyclic_function_indirection; | |
| 563 | 49 Lisp_Object Qinvalid_operation, Qinvalid_change, Qprinting_unreadable_object; |
| 442 | 50 Lisp_Object Qsetting_constant; |
| 51 Lisp_Object Qediting_error; | |
|
5381
4f39e57a82b4
Improve read-only error reporting.
Didier Verna <didier@lrde.epita.fr>
parents:
5374
diff
changeset
|
52 Lisp_Object Qbeginning_of_buffer, Qend_of_buffer; |
|
4f39e57a82b4
Improve read-only error reporting.
Didier Verna <didier@lrde.epita.fr>
parents:
5374
diff
changeset
|
53 Lisp_Object Qbuffer_read_only, Qextent_read_only; |
| 563 | 54 Lisp_Object Qio_error, Qfile_error, Qconversion_error, Qend_of_file; |
| 580 | 55 Lisp_Object Qtext_conversion_error; |
| 428 | 56 Lisp_Object Qarith_error, Qrange_error, Qdomain_error; |
| 57 Lisp_Object Qsingularity_error, Qoverflow_error, Qunderflow_error; | |
| 1983 | 58 Lisp_Object Qintegerp, Qnatnump, Qnonnegativep, Qsymbolp; |
| 428 | 59 Lisp_Object Qlistp, Qtrue_list_p, Qweak_listp; |
| 60 Lisp_Object Qconsp, Qsubrp; | |
| 61 Lisp_Object Qcharacterp, Qstringp, Qarrayp, Qsequencep, Qvectorp; | |
| 62 Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qbufferp; | |
| 63 Lisp_Object Qinteger_or_char_p, Qinteger_char_or_marker_p; | |
| 64 Lisp_Object Qnumberp, Qnumber_char_or_marker_p; | |
| 65 Lisp_Object Qbit_vectorp, Qbitp, Qcdr; | |
| 66 | |
| 563 | 67 Lisp_Object Qerror_lacks_explanatory_string; |
| 428 | 68 Lisp_Object Qfloatp; |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
69 Lisp_Object Q_junk_allowed, Q_radix, Q_radix_table; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
70 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
71 Lisp_Object Vdigit_fixnum_map, Vfixnum_to_char_map; |
| 428 | 72 |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
73 Fixnum Vmost_negative_fixnum, Vmost_positive_fixnum; |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
74 |
| 428 | 75 #ifdef DEBUG_XEMACS |
| 76 | |
| 77 int debug_issue_ebola_notices; | |
| 78 | |
| 458 | 79 Fixnum debug_ebola_backtrace_length; |
| 428 | 80 |
| 81 int | |
| 82 eq_with_ebola_notice (Lisp_Object obj1, Lisp_Object obj2) | |
| 83 { | |
| 84 if (debug_issue_ebola_notices | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
85 && ((CHARP (obj1) && FIXNUMP (obj2)) || (CHARP (obj2) && FIXNUMP (obj1)))) |
| 428 | 86 { |
| 87 /* #### It would be really nice if this were a proper warning | |
| 1551 | 88 instead of brain-dead print to Qexternal_debugging_output. */ |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
89 write_msg_string |
| 826 | 90 (Qexternal_debugging_output, |
| 91 "Comparison between integer and character is constant nil ("); | |
| 428 | 92 Fprinc (obj1, Qexternal_debugging_output); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
93 write_msg_string (Qexternal_debugging_output, " and "); |
| 428 | 94 Fprinc (obj2, Qexternal_debugging_output); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
95 write_msg_string (Qexternal_debugging_output, ")\n"); |
| 428 | 96 debug_short_backtrace (debug_ebola_backtrace_length); |
| 97 } | |
| 98 return EQ (obj1, obj2); | |
| 99 } | |
| 100 | |
| 101 #endif /* DEBUG_XEMACS */ | |
| 102 | |
| 103 | |
| 104 | |
| 105 Lisp_Object | |
| 106 wrong_type_argument (Lisp_Object predicate, Lisp_Object value) | |
| 107 { | |
| 108 /* This function can GC */ | |
| 109 REGISTER Lisp_Object tem; | |
| 110 do | |
| 111 { | |
| 112 value = Fsignal (Qwrong_type_argument, list2 (predicate, value)); | |
| 113 tem = call1 (predicate, value); | |
| 114 } | |
| 115 while (NILP (tem)); | |
| 116 return value; | |
| 117 } | |
| 118 | |
| 119 DOESNT_RETURN | |
| 120 dead_wrong_type_argument (Lisp_Object predicate, Lisp_Object value) | |
| 121 { | |
| 563 | 122 signal_error_1 (Qwrong_type_argument, list2 (predicate, value)); |
| 428 | 123 } |
| 124 | |
| 125 DEFUN ("wrong-type-argument", Fwrong_type_argument, 2, 2, 0, /* | |
| 126 Signal an error until the correct type value is given by the user. | |
| 127 This function loops, signalling a continuable `wrong-type-argument' error | |
| 128 with PREDICATE and VALUE as the data associated with the error and then | |
| 129 calling PREDICATE on the returned value, until the value gotten satisfies | |
| 130 PREDICATE. At that point, the gotten value is returned. | |
| 131 */ | |
| 132 (predicate, value)) | |
| 133 { | |
| 134 return wrong_type_argument (predicate, value); | |
| 135 } | |
| 136 | |
| 137 DOESNT_RETURN | |
| 138 c_write_error (Lisp_Object obj) | |
| 139 { | |
| 563 | 140 signal_error (Qsetting_constant, |
| 141 "Attempt to modify read-only object (c)", obj); | |
| 428 | 142 } |
| 143 | |
| 144 DOESNT_RETURN | |
| 145 lisp_write_error (Lisp_Object obj) | |
| 146 { | |
| 563 | 147 signal_error (Qsetting_constant, |
| 148 "Attempt to modify read-only object (lisp)", obj); | |
| 428 | 149 } |
| 150 | |
| 151 DOESNT_RETURN | |
| 152 args_out_of_range (Lisp_Object a1, Lisp_Object a2) | |
| 153 { | |
| 563 | 154 signal_error_1 (Qargs_out_of_range, list2 (a1, a2)); |
| 428 | 155 } |
| 156 | |
| 157 DOESNT_RETURN | |
| 158 args_out_of_range_3 (Lisp_Object a1, Lisp_Object a2, Lisp_Object a3) | |
| 159 { | |
| 563 | 160 signal_error_1 (Qargs_out_of_range, list3 (a1, a2, a3)); |
| 428 | 161 } |
| 162 | |
| 163 void | |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5207
diff
changeset
|
164 check_integer_range (Lisp_Object val, Lisp_Object min, Lisp_Object max) |
| 428 | 165 { |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5207
diff
changeset
|
166 Lisp_Object args[] = { min, val, max }; |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5207
diff
changeset
|
167 int ii; |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5207
diff
changeset
|
168 |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5207
diff
changeset
|
169 for (ii = 0; ii < countof (args); ii++) |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5207
diff
changeset
|
170 { |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5207
diff
changeset
|
171 CHECK_INTEGER (args[ii]); |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5207
diff
changeset
|
172 } |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5207
diff
changeset
|
173 |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5207
diff
changeset
|
174 if (NILP (Fleq (countof (args), args))) |
|
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5207
diff
changeset
|
175 args_out_of_range_3 (val, min, max); |
| 428 | 176 } |
| 177 | |
| 178 | |
| 179 /* Data type predicates */ | |
| 180 | |
| 181 DEFUN ("eq", Feq, 2, 2, 0, /* | |
| 182 Return t if the two args are the same Lisp object. | |
| 183 */ | |
| 444 | 184 (object1, object2)) |
| 428 | 185 { |
| 444 | 186 return EQ_WITH_EBOLA_NOTICE (object1, object2) ? Qt : Qnil; |
| 428 | 187 } |
| 188 | |
| 189 DEFUN ("null", Fnull, 1, 1, 0, /* | |
| 190 Return t if OBJECT is nil. | |
| 191 */ | |
| 192 (object)) | |
| 193 { | |
| 194 return NILP (object) ? Qt : Qnil; | |
| 195 } | |
| 196 | |
| 197 DEFUN ("consp", Fconsp, 1, 1, 0, /* | |
| 198 Return t if OBJECT is a cons cell. `nil' is not a cons cell. | |
| 3343 | 199 |
| 3355 | 200 See the documentation for `cons' or the Lisp manual for more details on what |
| 201 a cons cell is. | |
| 428 | 202 */ |
| 203 (object)) | |
| 204 { | |
| 205 return CONSP (object) ? Qt : Qnil; | |
| 206 } | |
| 207 | |
| 208 DEFUN ("atom", Fatom, 1, 1, 0, /* | |
| 209 Return t if OBJECT is not a cons cell. `nil' is not a cons cell. | |
| 3355 | 210 |
| 211 See the documentation for `cons' or the Lisp manual for more details on what | |
| 212 a cons cell is. | |
| 428 | 213 */ |
| 214 (object)) | |
| 215 { | |
| 216 return CONSP (object) ? Qnil : Qt; | |
| 217 } | |
| 218 | |
| 219 DEFUN ("listp", Flistp, 1, 1, 0, /* | |
| 220 Return t if OBJECT is a list. `nil' is a list. | |
| 3343 | 221 |
| 3355 | 222 A list is either the Lisp object nil (a symbol), interpreted as the empty |
| 223 list in this context, or a cons cell whose CDR refers to either nil or a | |
| 224 cons cell. A "proper list" contains no cycles. | |
| 428 | 225 */ |
| 226 (object)) | |
| 227 { | |
| 228 return LISTP (object) ? Qt : Qnil; | |
| 229 } | |
| 230 | |
| 231 DEFUN ("nlistp", Fnlistp, 1, 1, 0, /* | |
| 232 Return t if OBJECT is not a list. `nil' is a list. | |
| 233 */ | |
| 234 (object)) | |
| 235 { | |
| 236 return LISTP (object) ? Qnil : Qt; | |
| 237 } | |
| 238 | |
| 239 DEFUN ("true-list-p", Ftrue_list_p, 1, 1, 0, /* | |
| 1551 | 240 Return t if OBJECT is an acyclic, nil-terminated (ie, not dotted), list. |
| 428 | 241 */ |
| 242 (object)) | |
| 243 { | |
| 244 return TRUE_LIST_P (object) ? Qt : Qnil; | |
| 245 } | |
| 246 | |
| 247 DEFUN ("symbolp", Fsymbolp, 1, 1, 0, /* | |
| 248 Return t if OBJECT is a symbol. | |
| 3343 | 249 |
| 250 A symbol is a Lisp object with a name. It can optionally have any and all of | |
| 251 a value, a property list and an associated function. | |
| 428 | 252 */ |
| 253 (object)) | |
| 254 { | |
| 255 return SYMBOLP (object) ? Qt : Qnil; | |
| 256 } | |
| 257 | |
| 258 DEFUN ("keywordp", Fkeywordp, 1, 1, 0, /* | |
| 259 Return t if OBJECT is a keyword. | |
| 260 */ | |
| 261 (object)) | |
| 262 { | |
| 263 return KEYWORDP (object) ? Qt : Qnil; | |
| 264 } | |
| 265 | |
| 266 DEFUN ("vectorp", Fvectorp, 1, 1, 0, /* | |
| 267 Return t if OBJECT is a vector. | |
| 268 */ | |
| 269 (object)) | |
| 270 { | |
| 271 return VECTORP (object) ? Qt : Qnil; | |
| 272 } | |
| 273 | |
| 274 DEFUN ("bit-vector-p", Fbit_vector_p, 1, 1, 0, /* | |
| 275 Return t if OBJECT is a bit vector. | |
| 276 */ | |
| 277 (object)) | |
| 278 { | |
| 279 return BIT_VECTORP (object) ? Qt : Qnil; | |
| 280 } | |
| 281 | |
| 282 DEFUN ("stringp", Fstringp, 1, 1, 0, /* | |
| 283 Return t if OBJECT is a string. | |
| 284 */ | |
| 285 (object)) | |
| 286 { | |
| 287 return STRINGP (object) ? Qt : Qnil; | |
| 288 } | |
| 289 | |
| 290 DEFUN ("arrayp", Farrayp, 1, 1, 0, /* | |
| 291 Return t if OBJECT is an array (string, vector, or bit vector). | |
| 292 */ | |
| 293 (object)) | |
| 294 { | |
|
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4885
diff
changeset
|
295 return ARRAYP (object) ? Qt : Qnil; |
| 428 | 296 } |
| 297 | |
| 298 DEFUN ("sequencep", Fsequencep, 1, 1, 0, /* | |
| 299 Return t if OBJECT is a sequence (list or array). | |
| 300 */ | |
| 301 (object)) | |
| 302 { | |
|
4995
8431b52e43b1
Move the various map* functions to C; add #'map-into.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4885
diff
changeset
|
303 return SEQUENCEP (object) ? Qt : Qnil; |
| 428 | 304 } |
| 305 | |
| 306 DEFUN ("markerp", Fmarkerp, 1, 1, 0, /* | |
| 307 Return t if OBJECT is a marker (editor pointer). | |
| 308 */ | |
| 309 (object)) | |
| 310 { | |
| 311 return MARKERP (object) ? Qt : Qnil; | |
| 312 } | |
| 313 | |
| 314 DEFUN ("subrp", Fsubrp, 1, 1, 0, /* | |
| 315 Return t if OBJECT is a built-in function. | |
| 316 */ | |
| 317 (object)) | |
| 318 { | |
| 319 return SUBRP (object) ? Qt : Qnil; | |
| 320 } | |
| 321 | |
| 322 DEFUN ("subr-min-args", Fsubr_min_args, 1, 1, 0, /* | |
| 323 Return minimum number of args built-in function SUBR may be called with. | |
| 324 */ | |
| 325 (subr)) | |
| 326 { | |
| 327 CHECK_SUBR (subr); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
328 return make_fixnum (XSUBR (subr)->min_args); |
| 428 | 329 } |
| 330 | |
| 331 DEFUN ("subr-max-args", Fsubr_max_args, 1, 1, 0, /* | |
| 332 Return maximum number of args built-in function SUBR may be called with, | |
|
4905
755ae5b97edb
Change "special form" to "special operator" in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4885
diff
changeset
|
333 or nil if it takes an arbitrary number of arguments or is a special operator. |
| 428 | 334 */ |
| 335 (subr)) | |
| 336 { | |
| 337 int nargs; | |
| 338 CHECK_SUBR (subr); | |
| 339 nargs = XSUBR (subr)->max_args; | |
| 340 if (nargs == MANY || nargs == UNEVALLED) | |
| 341 return Qnil; | |
| 342 else | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
343 return make_fixnum (nargs); |
| 428 | 344 } |
| 345 | |
| 346 DEFUN ("subr-interactive", Fsubr_interactive, 1, 1, 0, /* | |
| 444 | 347 Return the interactive spec of the subr object SUBR, or nil. |
| 428 | 348 If non-nil, the return value will be a list whose first element is |
| 349 `interactive' and whose second element is the interactive spec. | |
| 350 */ | |
| 351 (subr)) | |
| 352 { | |
| 867 | 353 const CIbyte *prompt; |
| 428 | 354 CHECK_SUBR (subr); |
| 355 prompt = XSUBR (subr)->prompt; | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
356 return prompt ? list2 (Qinteractive, build_msg_cistring (prompt)) : Qnil; |
| 428 | 357 } |
| 358 | |
| 359 | |
| 360 DEFUN ("characterp", Fcharacterp, 1, 1, 0, /* | |
| 361 Return t if OBJECT is a character. | |
| 362 Unlike in XEmacs v19 and FSF Emacs, a character is its own primitive type. | |
| 363 Any character can be converted into an equivalent integer using | |
| 364 `char-int'. To convert the other way, use `int-char'; however, | |
| 365 only some integers can be converted into characters. Such an integer | |
| 366 is called a `char-int'; see `char-int-p'. | |
| 367 | |
| 368 Some functions that work on integers (e.g. the comparison functions | |
| 369 <, <=, =, /=, etc. and the arithmetic functions +, -, *, etc.) | |
| 370 accept characters and implicitly convert them into integers. In | |
| 371 general, functions that work on characters also accept char-ints and | |
| 372 implicitly convert them into characters. WARNING: Neither of these | |
| 373 behaviors is very desirable, and they are maintained for backward | |
| 374 compatibility with old E-Lisp programs that confounded characters and | |
| 375 integers willy-nilly. These behaviors may change in the future; therefore, | |
| 376 do not rely on them. Instead, use the character-specific functions such | |
| 377 as `char='. | |
| 378 */ | |
| 379 (object)) | |
| 380 { | |
| 381 return CHARP (object) ? Qt : Qnil; | |
| 382 } | |
| 383 | |
| 384 DEFUN ("char-to-int", Fchar_to_int, 1, 1, 0, /* | |
| 444 | 385 Convert CHARACTER into an equivalent integer. |
| 428 | 386 The resulting integer will always be non-negative. The integers in |
| 387 the range 0 - 255 map to characters as follows: | |
| 388 | |
| 389 0 - 31 Control set 0 | |
| 390 32 - 127 ASCII | |
| 391 128 - 159 Control set 1 | |
| 392 160 - 255 Right half of ISO-8859-1 | |
| 393 | |
| 394 If support for Mule does not exist, these are the only valid character | |
| 395 values. When Mule support exists, the values assigned to other characters | |
| 396 may vary depending on the particular version of XEmacs, the order in which | |
| 397 character sets were loaded, etc., and you should not depend on them. | |
| 398 */ | |
| 444 | 399 (character)) |
| 428 | 400 { |
| 444 | 401 CHECK_CHAR (character); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
402 return make_fixnum (XCHAR (character)); |
| 428 | 403 } |
| 404 | |
| 405 DEFUN ("int-to-char", Fint_to_char, 1, 1, 0, /* | |
| 444 | 406 Convert integer INTEGER into the equivalent character. |
| 428 | 407 Not all integers correspond to valid characters; use `char-int-p' to |
| 408 determine whether this is the case. If the integer cannot be converted, | |
| 409 nil is returned. | |
| 410 */ | |
| 411 (integer)) | |
| 412 { | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
413 CHECK_INTEGER (integer); |
| 428 | 414 if (CHAR_INTP (integer)) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
415 return make_char (XFIXNUM (integer)); |
| 428 | 416 else |
| 417 return Qnil; | |
| 418 } | |
| 419 | |
| 420 DEFUN ("char-int-p", Fchar_int_p, 1, 1, 0, /* | |
| 421 Return t if OBJECT is an integer that can be converted into a character. | |
| 422 See `char-int'. | |
| 423 */ | |
| 424 (object)) | |
| 425 { | |
| 426 return CHAR_INTP (object) ? Qt : Qnil; | |
| 427 } | |
| 428 | |
| 429 DEFUN ("char-or-char-int-p", Fchar_or_char_int_p, 1, 1, 0, /* | |
| 430 Return t if OBJECT is a character or an integer that can be converted into one. | |
| 431 */ | |
| 432 (object)) | |
| 433 { | |
| 434 return CHAR_OR_CHAR_INTP (object) ? Qt : Qnil; | |
| 435 } | |
| 436 | |
| 437 DEFUN ("char-or-string-p", Fchar_or_string_p, 1, 1, 0, /* | |
| 438 Return t if OBJECT is a character (or a char-int) or a string. | |
| 439 It is semi-hateful that we allow a char-int here, as it goes against | |
| 440 the name of this function, but it makes the most sense considering the | |
| 441 other steps we take to maintain compatibility with the old character/integer | |
| 442 confoundedness in older versions of E-Lisp. | |
| 443 */ | |
| 444 (object)) | |
| 445 { | |
| 446 return CHAR_OR_CHAR_INTP (object) || STRINGP (object) ? Qt : Qnil; | |
| 447 } | |
| 448 | |
| 1983 | 449 DEFUN ("fixnump", Ffixnump, 1, 1, 0, /* |
| 450 Return t if OBJECT is a fixnum. | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
451 |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
452 In this implementation, a fixnum is an immediate integer, and has a |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
453 maximum value described by the constant `most-positive-fixnum'. This |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
454 contrasts with bignums, integers where the values are limited by your |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
455 available memory. |
| 1983 | 456 */ |
| 457 (object)) | |
| 458 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
459 return FIXNUMP (object) ? Qt : Qnil; |
| 1983 | 460 } |
| 428 | 461 DEFUN ("integerp", Fintegerp, 1, 1, 0, /* |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
462 Return t if OBJECT is an integer, nil otherwise. |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
463 |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
464 On builds without bignum support, this function is identical to `fixnump'. |
| 428 | 465 */ |
| 466 (object)) | |
| 467 { | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
468 return INTEGERP (object) ? Qt : Qnil; |
| 428 | 469 } |
| 470 | |
| 471 DEFUN ("integer-or-marker-p", Finteger_or_marker_p, 1, 1, 0, /* | |
| 472 Return t if OBJECT is an integer or a marker (editor pointer). | |
| 473 */ | |
| 474 (object)) | |
| 475 { | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
476 return INTEGERP (object) || MARKERP (object) ? Qt : Qnil; |
| 428 | 477 } |
| 478 | |
| 479 DEFUN ("integer-or-char-p", Finteger_or_char_p, 1, 1, 0, /* | |
| 480 Return t if OBJECT is an integer or a character. | |
| 481 */ | |
| 482 (object)) | |
| 483 { | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
484 return INTEGERP (object) || CHARP (object) ? Qt : Qnil; |
| 428 | 485 } |
| 486 | |
| 487 DEFUN ("integer-char-or-marker-p", Finteger_char_or_marker_p, 1, 1, 0, /* | |
| 488 Return t if OBJECT is an integer, character or a marker (editor pointer). | |
| 489 */ | |
| 490 (object)) | |
| 491 { | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
492 return INTEGERP (object) || CHARP (object) || MARKERP (object) ? Qt : Qnil; |
| 428 | 493 } |
| 494 | |
| 495 DEFUN ("natnump", Fnatnump, 1, 1, 0, /* | |
| 496 Return t if OBJECT is a nonnegative integer. | |
| 497 */ | |
| 498 (object)) | |
| 499 { | |
|
5307
c096d8051f89
Have NATNUMP give t for positive bignums; check limits appropriately.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5207
diff
changeset
|
500 return NATNUMP (object) ? Qt : Qnil; |
| 1983 | 501 } |
| 502 | |
| 503 DEFUN ("nonnegativep", Fnonnegativep, 1, 1, 0, /* | |
| 504 Return t if OBJECT is a nonnegative number. | |
| 505 */ | |
| 506 (object)) | |
| 507 { | |
| 508 return NATNUMP (object) | |
| 509 #ifdef HAVE_RATIO | |
| 510 || (RATIOP (object) && ratio_sign (XRATIO_DATA (object)) >= 0) | |
| 511 #endif | |
| 512 #ifdef HAVE_BIGFLOAT | |
| 513 || (BIGFLOATP (object) && bigfloat_sign (XBIGFLOAT_DATA (object)) >= 0) | |
| 514 #endif | |
| 515 ? Qt : Qnil; | |
| 428 | 516 } |
| 517 | |
| 518 DEFUN ("bitp", Fbitp, 1, 1, 0, /* | |
| 519 Return t if OBJECT is a bit (0 or 1). | |
| 520 */ | |
| 521 (object)) | |
| 522 { | |
| 523 return BITP (object) ? Qt : Qnil; | |
| 524 } | |
| 525 | |
| 526 DEFUN ("numberp", Fnumberp, 1, 1, 0, /* | |
| 527 Return t if OBJECT is a number (floating point or integer). | |
| 528 */ | |
| 529 (object)) | |
| 530 { | |
| 1983 | 531 return NUMBERP (object) ? Qt : Qnil; |
| 428 | 532 } |
| 533 | |
| 534 DEFUN ("number-or-marker-p", Fnumber_or_marker_p, 1, 1, 0, /* | |
| 535 Return t if OBJECT is a number or a marker. | |
| 536 */ | |
| 537 (object)) | |
| 538 { | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
539 return NUMBERP (object) || MARKERP (object) ? Qt : Qnil; |
| 428 | 540 } |
| 541 | |
| 542 DEFUN ("number-char-or-marker-p", Fnumber_char_or_marker_p, 1, 1, 0, /* | |
| 543 Return t if OBJECT is a number, character or a marker. | |
| 544 */ | |
| 545 (object)) | |
| 546 { | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
547 return (NUMBERP (object) || CHARP (object) || MARKERP (object)) |
| 428 | 548 ? Qt : Qnil; |
| 549 } | |
| 550 | |
| 551 DEFUN ("floatp", Ffloatp, 1, 1, 0, /* | |
| 552 Return t if OBJECT is a floating point number. | |
| 553 */ | |
| 554 (object)) | |
| 555 { | |
| 556 return FLOATP (object) ? Qt : Qnil; | |
| 557 } | |
| 558 | |
| 559 DEFUN ("type-of", Ftype_of, 1, 1, 0, /* | |
| 560 Return a symbol representing the type of OBJECT. | |
| 561 */ | |
| 562 (object)) | |
| 563 { | |
| 564 switch (XTYPE (object)) | |
| 565 { | |
| 566 case Lisp_Type_Record: | |
| 567 return intern (XRECORD_LHEADER_IMPLEMENTATION (object)->name); | |
| 568 | |
| 569 case Lisp_Type_Char: return Qcharacter; | |
| 570 | |
|
5582
873d7425c1ad
Change integer to fixnum in a few places where it wasn't possible mechanically.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5581
diff
changeset
|
571 default: return Qfixnum; |
| 428 | 572 } |
| 573 } | |
| 574 | |
| 575 | |
| 576 /* Extract and set components of lists */ | |
| 577 | |
| 578 DEFUN ("car", Fcar, 1, 1, 0, /* | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
579 Return the car of LIST. If LIST is nil, return nil. |
| 3343 | 580 The car of a list or a dotted pair is its first element. |
| 581 | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
582 Error if LIST is not nil and not a cons cell. See also `car-safe'. |
| 428 | 583 */ |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
584 (list)) |
| 428 | 585 { |
| 586 while (1) | |
| 587 { | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
588 if (CONSP (list)) |
|
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
589 return XCAR (list); |
|
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
590 else if (NILP (list)) |
| 428 | 591 return Qnil; |
| 592 else | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
593 list = wrong_type_argument (Qlistp, list); |
| 428 | 594 } |
| 595 } | |
| 596 | |
| 597 DEFUN ("car-safe", Fcar_safe, 1, 1, 0, /* | |
| 598 Return the car of OBJECT if it is a cons cell, or else nil. | |
| 599 */ | |
| 600 (object)) | |
| 601 { | |
| 602 return CONSP (object) ? XCAR (object) : Qnil; | |
| 603 } | |
| 604 | |
| 605 DEFUN ("cdr", Fcdr, 1, 1, 0, /* | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
606 Return the cdr of LIST. If LIST is nil, return nil. |
| 3343 | 607 The cdr of a list is the list without its first element. The cdr of a |
| 608 dotted pair (A . B) is the second element, B. | |
| 609 | |
| 428 | 610 Error if arg is not nil and not a cons cell. See also `cdr-safe'. |
| 611 */ | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
612 (list)) |
| 428 | 613 { |
| 614 while (1) | |
| 615 { | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
616 if (CONSP (list)) |
|
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
617 return XCDR (list); |
|
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
618 else if (NILP (list)) |
| 428 | 619 return Qnil; |
| 620 else | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
621 list = wrong_type_argument (Qlistp, list); |
| 428 | 622 } |
| 623 } | |
| 624 | |
| 625 DEFUN ("cdr-safe", Fcdr_safe, 1, 1, 0, /* | |
| 626 Return the cdr of OBJECT if it is a cons cell, else nil. | |
| 627 */ | |
| 628 (object)) | |
| 629 { | |
| 630 return CONSP (object) ? XCDR (object) : Qnil; | |
| 631 } | |
| 632 | |
| 633 DEFUN ("setcar", Fsetcar, 2, 2, 0, /* | |
| 444 | 634 Set the car of CONS-CELL to be NEWCAR. Return NEWCAR. |
| 3343 | 635 The car of a list or a dotted pair is its first element. |
| 428 | 636 */ |
| 444 | 637 (cons_cell, newcar)) |
| 428 | 638 { |
| 444 | 639 if (!CONSP (cons_cell)) |
| 640 cons_cell = wrong_type_argument (Qconsp, cons_cell); | |
| 428 | 641 |
| 444 | 642 XCAR (cons_cell) = newcar; |
| 428 | 643 return newcar; |
| 644 } | |
| 645 | |
| 646 DEFUN ("setcdr", Fsetcdr, 2, 2, 0, /* | |
| 444 | 647 Set the cdr of CONS-CELL to be NEWCDR. Return NEWCDR. |
| 3343 | 648 The cdr of a list is the list without its first element. The cdr of a |
| 649 dotted pair (A . B) is the second element, B. | |
| 428 | 650 */ |
| 444 | 651 (cons_cell, newcdr)) |
| 428 | 652 { |
| 444 | 653 if (!CONSP (cons_cell)) |
| 654 cons_cell = wrong_type_argument (Qconsp, cons_cell); | |
| 428 | 655 |
| 444 | 656 XCDR (cons_cell) = newcdr; |
| 428 | 657 return newcdr; |
| 658 } | |
| 659 | |
| 660 /* Find the function at the end of a chain of symbol function indirections. | |
| 661 | |
| 662 If OBJECT is a symbol, find the end of its function chain and | |
| 663 return the value found there. If OBJECT is not a symbol, just | |
| 664 return it. If there is a cycle in the function chain, signal a | |
| 665 cyclic-function-indirection error. | |
| 666 | |
| 442 | 667 This is like Findirect_function when VOID_FUNCTION_ERRORP is true. |
| 668 When VOID_FUNCTION_ERRORP is false, no error is signaled if the end | |
| 669 of the chain ends up being Qunbound. */ | |
| 428 | 670 Lisp_Object |
| 442 | 671 indirect_function (Lisp_Object object, int void_function_errorp) |
| 428 | 672 { |
| 673 #define FUNCTION_INDIRECTION_SUSPICION_LENGTH 16 | |
| 674 Lisp_Object tortoise, hare; | |
| 675 int count; | |
| 676 | |
| 677 for (hare = tortoise = object, count = 0; | |
| 678 SYMBOLP (hare); | |
| 679 hare = XSYMBOL (hare)->function, count++) | |
| 680 { | |
| 681 if (count < FUNCTION_INDIRECTION_SUSPICION_LENGTH) continue; | |
| 682 | |
| 683 if (count & 1) | |
| 684 tortoise = XSYMBOL (tortoise)->function; | |
| 685 if (EQ (hare, tortoise)) | |
| 686 return Fsignal (Qcyclic_function_indirection, list1 (object)); | |
| 687 } | |
| 688 | |
| 442 | 689 if (void_function_errorp && UNBOUNDP (hare)) |
| 436 | 690 return signal_void_function_error (object); |
| 428 | 691 |
| 692 return hare; | |
| 693 } | |
| 694 | |
| 695 DEFUN ("indirect-function", Findirect_function, 1, 1, 0, /* | |
| 696 Return the function at the end of OBJECT's function chain. | |
| 697 If OBJECT is a symbol, follow all function indirections and return | |
| 698 the final function binding. | |
| 699 If OBJECT is not a symbol, just return it. | |
| 700 Signal a void-function error if the final symbol is unbound. | |
| 701 Signal a cyclic-function-indirection error if there is a loop in the | |
| 702 function chain of symbols. | |
| 703 */ | |
| 704 (object)) | |
| 705 { | |
| 706 return indirect_function (object, 1); | |
| 707 } | |
| 708 | |
| 709 /* Extract and set vector and string elements */ | |
| 710 | |
| 711 DEFUN ("aref", Faref, 2, 2, 0, /* | |
| 712 Return the element of ARRAY at index INDEX. | |
| 713 ARRAY may be a vector, bit vector, or string. INDEX starts at 0. | |
| 714 */ | |
| 715 (array, index_)) | |
| 716 { | |
| 717 EMACS_INT idx; | |
| 718 | |
| 719 retry: | |
| 720 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
721 if (FIXNUMP (index_)) idx = XFIXNUM (index_); |
| 428 | 722 else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */ |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
723 #ifdef HAVE_BIGNUM |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
724 else if (BIGNUMP (index_)) |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
725 { |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
726 Lisp_Object canon = Fcanonicalize_number (index_); |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
727 if (EQ (canon, index_)) |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
728 { |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
729 /* We don't support non-fixnum indices. */ |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
730 goto range_error; |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
731 } |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
732 index_ = canon; |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
733 goto retry; |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
734 } |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
735 #endif |
| 428 | 736 else |
| 737 { | |
| 738 index_ = wrong_type_argument (Qinteger_or_char_p, index_); | |
| 739 goto retry; | |
| 740 } | |
| 741 | |
| 742 if (idx < 0) goto range_error; | |
| 743 | |
| 744 if (VECTORP (array)) | |
| 745 { | |
| 746 if (idx >= XVECTOR_LENGTH (array)) goto range_error; | |
| 747 return XVECTOR_DATA (array)[idx]; | |
| 748 } | |
| 749 else if (BIT_VECTORP (array)) | |
| 750 { | |
| 647 | 751 if (idx >= (EMACS_INT) bit_vector_length (XBIT_VECTOR (array))) |
| 752 goto range_error; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
753 return make_fixnum (bit_vector_bit (XBIT_VECTOR (array), idx)); |
| 428 | 754 } |
| 755 else if (STRINGP (array)) | |
| 756 { | |
| 826 | 757 if (idx >= string_char_length (array)) goto range_error; |
| 867 | 758 return make_char (string_ichar (array, idx)); |
| 428 | 759 } |
| 760 else | |
| 761 { | |
| 762 check_losing_bytecode ("aref", array); | |
| 763 array = wrong_type_argument (Qarrayp, array); | |
| 764 goto retry; | |
| 765 } | |
| 766 | |
| 767 range_error: | |
| 768 args_out_of_range (array, index_); | |
| 1204 | 769 RETURN_NOT_REACHED (Qnil); |
| 428 | 770 } |
| 771 | |
| 772 DEFUN ("aset", Faset, 3, 3, 0, /* | |
| 773 Store into the element of ARRAY at index INDEX the value NEWVAL. | |
| 774 ARRAY may be a vector, bit vector, or string. INDEX starts at 0. | |
| 775 */ | |
| 776 (array, index_, newval)) | |
| 777 { | |
| 778 EMACS_INT idx; | |
| 779 | |
| 780 retry: | |
| 781 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
782 if (FIXNUMP (index_)) idx = XFIXNUM (index_); |
| 428 | 783 else if (CHARP (index_)) idx = XCHAR (index_); /* yuck! */ |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
784 #ifdef HAVE_BIGNUM |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
785 else if (BIGNUMP (index_)) |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
786 { |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
787 Lisp_Object canon = Fcanonicalize_number (index_); |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
788 if (EQ (canon, index_)) |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
789 { |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
790 /* We don't support non-fixnum indices. */ |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
791 goto range_error; |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
792 } |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
793 index_ = canon; |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
794 goto retry; |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
795 } |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
796 #endif |
| 428 | 797 else |
| 798 { | |
| 799 index_ = wrong_type_argument (Qinteger_or_char_p, index_); | |
| 800 goto retry; | |
| 801 } | |
| 802 | |
| 803 if (idx < 0) goto range_error; | |
| 804 | |
| 771 | 805 CHECK_LISP_WRITEABLE (array); |
| 428 | 806 if (VECTORP (array)) |
| 807 { | |
| 808 if (idx >= XVECTOR_LENGTH (array)) goto range_error; | |
| 809 XVECTOR_DATA (array)[idx] = newval; | |
| 810 } | |
| 811 else if (BIT_VECTORP (array)) | |
| 812 { | |
| 647 | 813 if (idx >= (EMACS_INT) bit_vector_length (XBIT_VECTOR (array))) |
| 814 goto range_error; | |
| 428 | 815 CHECK_BIT (newval); |
| 816 set_bit_vector_bit (XBIT_VECTOR (array), idx, !ZEROP (newval)); | |
| 817 } | |
| 818 else if (STRINGP (array)) | |
| 819 { | |
| 820 CHECK_CHAR_COERCE_INT (newval); | |
| 826 | 821 if (idx >= string_char_length (array)) goto range_error; |
| 793 | 822 set_string_char (array, idx, XCHAR (newval)); |
| 428 | 823 bump_string_modiff (array); |
| 824 } | |
| 825 else | |
| 826 { | |
| 827 array = wrong_type_argument (Qarrayp, array); | |
| 828 goto retry; | |
| 829 } | |
| 830 | |
| 831 return newval; | |
| 832 | |
| 833 range_error: | |
| 834 args_out_of_range (array, index_); | |
| 1204 | 835 RETURN_NOT_REACHED (Qnil); |
| 428 | 836 } |
| 837 | |
| 838 | |
| 839 /**********************************************************************/ | |
| 840 /* Arithmetic functions */ | |
| 841 /**********************************************************************/ | |
| 2001 | 842 #ifndef WITH_NUMBER_TYPES |
| 428 | 843 typedef struct |
| 844 { | |
| 845 int int_p; | |
| 846 union | |
| 847 { | |
| 848 EMACS_INT ival; | |
| 849 double dval; | |
| 850 } c; | |
| 851 } int_or_double; | |
| 852 | |
| 853 static void | |
| 854 number_char_or_marker_to_int_or_double (Lisp_Object obj, int_or_double *p) | |
| 855 { | |
| 856 retry: | |
| 857 p->int_p = 1; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
858 if (FIXNUMP (obj)) p->c.ival = XFIXNUM (obj); |
| 428 | 859 else if (CHARP (obj)) p->c.ival = XCHAR (obj); |
| 860 else if (MARKERP (obj)) p->c.ival = marker_position (obj); | |
| 861 else if (FLOATP (obj)) p->c.dval = XFLOAT_DATA (obj), p->int_p = 0; | |
| 862 else | |
| 863 { | |
| 864 obj = wrong_type_argument (Qnumber_char_or_marker_p, obj); | |
| 865 goto retry; | |
| 866 } | |
| 867 } | |
| 868 | |
| 869 static double | |
| 870 number_char_or_marker_to_double (Lisp_Object obj) | |
| 871 { | |
| 872 retry: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
873 if (FIXNUMP (obj)) return (double) XFIXNUM (obj); |
| 428 | 874 else if (CHARP (obj)) return (double) XCHAR (obj); |
| 875 else if (MARKERP (obj)) return (double) marker_position (obj); | |
| 876 else if (FLOATP (obj)) return XFLOAT_DATA (obj); | |
| 877 else | |
| 878 { | |
| 879 obj = wrong_type_argument (Qnumber_char_or_marker_p, obj); | |
| 880 goto retry; | |
| 881 } | |
| 882 } | |
| 2001 | 883 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 884 |
| 885 static EMACS_INT | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
886 fixnum_char_or_marker_to_int (Lisp_Object obj) |
| 428 | 887 { |
| 888 retry: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
889 if (FIXNUMP (obj)) return XFIXNUM (obj); |
| 428 | 890 else if (CHARP (obj)) return XCHAR (obj); |
| 891 else if (MARKERP (obj)) return marker_position (obj); | |
| 892 else | |
| 893 { | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
894 /* On bignum builds, we can only be called from #'lognot, which |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
895 protects against this happening: */ |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
896 assert (!BIGNUMP (obj)); |
| 428 | 897 obj = wrong_type_argument (Qinteger_char_or_marker_p, obj); |
| 898 goto retry; | |
| 899 } | |
| 900 } | |
| 901 | |
| 1983 | 902 #ifdef WITH_NUMBER_TYPES |
| 903 | |
| 904 #ifdef HAVE_BIGNUM | |
| 905 #define BIGNUM_CASE(op) \ | |
|
5769
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
906 case LAZY_BIGNUM_T: \ |
| 1983 | 907 if (!bignum_##op (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2))) \ |
| 908 return Qnil; \ | |
| 909 break; | |
| 910 #else | |
| 911 #define BIGNUM_CASE(op) | |
| 912 #endif /* HAVE_BIGNUM */ | |
| 913 | |
| 914 #ifdef HAVE_RATIO | |
| 915 #define RATIO_CASE(op) \ | |
|
5769
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
916 case LAZY_RATIO_T: \ |
| 1983 | 917 if (!ratio_##op (XRATIO_DATA (obj1), XRATIO_DATA (obj2))) \ |
| 918 return Qnil; \ | |
| 919 break; | |
| 920 #else | |
| 921 #define RATIO_CASE(op) | |
| 922 #endif /* HAVE_RATIO */ | |
| 923 | |
| 924 #ifdef HAVE_BIGFLOAT | |
| 925 #define BIGFLOAT_CASE(op) \ | |
|
5769
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
926 case LAZY_BIGFLOAT_T: \ |
| 1983 | 927 if (!bigfloat_##op (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2))) \ |
| 928 return Qnil; \ | |
| 929 break; | |
| 930 #else | |
| 931 #define BIGFLOAT_CASE(op) | |
| 932 #endif /* HAVE_BIGFLOAT */ | |
| 933 | |
| 934 #define ARITHCOMPARE_MANY(c_op,op) \ | |
| 935 { \ | |
| 936 REGISTER int i; \ | |
| 937 Lisp_Object obj1, obj2; \ | |
| 938 \ | |
| 939 for (i = 1; i < nargs; i++) \ | |
| 940 { \ | |
| 941 obj1 = args[i - 1]; \ | |
| 942 obj2 = args[i]; \ | |
|
5769
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
943 switch (promote_args_lazy (&obj1, &obj2)) \ |
| 1983 | 944 { \ |
|
5769
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
945 case LAZY_FIXNUM_T: \ |
|
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
946 if (!(XREALFIXNUM (obj1) c_op XREALFIXNUM (obj2))) \ |
| 1983 | 947 return Qnil; \ |
| 948 break; \ | |
| 949 BIGNUM_CASE (op) \ | |
| 950 RATIO_CASE (op) \ | |
|
5769
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
951 case LAZY_FLOAT_T: \ |
| 1983 | 952 if (!(XFLOAT_DATA (obj1) c_op XFLOAT_DATA (obj2))) \ |
| 953 return Qnil; \ | |
| 954 break; \ | |
| 955 BIGFLOAT_CASE (op) \ | |
|
5769
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
956 case LAZY_MARKER_T: \ |
|
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
957 if (!(byte_marker_position (obj1) c_op \ |
|
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
958 byte_marker_position (obj2))) \ |
|
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
959 return Qnil; \ |
|
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
960 break; \ |
| 1983 | 961 } \ |
| 962 } \ | |
| 963 return Qt; \ | |
| 964 } | |
| 965 #else /* !WITH_NUMBER_TYPES */ | |
|
5769
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
966 /* We don't convert markers lazily here, although we could. It's more |
|
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
967 important that we do this lazily in bytecode, which is the case; see |
|
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
968 bytecode_arithcompare(). |
|
ffc0c5a66ab1
Be lazy converting markers to integers, bytecode_{arithcompare,arithop}().
Aidan Kehoe <kehoea@parhasard.net>
parents:
5768
diff
changeset
|
969 */ |
| 1983 | 970 #define ARITHCOMPARE_MANY(c_op,op) \ |
| 428 | 971 { \ |
| 972 int_or_double iod1, iod2, *p = &iod1, *q = &iod2; \ | |
| 973 Lisp_Object *args_end = args + nargs; \ | |
| 974 \ | |
| 975 number_char_or_marker_to_int_or_double (*args++, p); \ | |
| 976 \ | |
| 977 while (args < args_end) \ | |
| 978 { \ | |
| 979 number_char_or_marker_to_int_or_double (*args++, q); \ | |
| 980 \ | |
| 981 if (!((p->int_p && q->int_p) ? \ | |
| 1983 | 982 (p->c.ival c_op q->c.ival) : \ |
| 983 ((p->int_p ? (double) p->c.ival : p->c.dval) c_op \ | |
| 428 | 984 (q->int_p ? (double) q->c.ival : q->c.dval)))) \ |
| 985 return Qnil; \ | |
| 986 \ | |
| 987 { /* swap */ int_or_double *r = p; p = q; q = r; } \ | |
| 988 } \ | |
| 989 return Qt; \ | |
| 990 } | |
| 1983 | 991 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 992 |
| 993 DEFUN ("=", Feqlsign, 1, MANY, 0, /* | |
| 994 Return t if all the arguments are numerically equal. | |
| 995 The arguments may be numbers, characters or markers. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
996 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
997 arguments: (FIRST &rest ARGS) |
| 428 | 998 */ |
| 999 (int nargs, Lisp_Object *args)) | |
| 1000 { | |
| 1983 | 1001 ARITHCOMPARE_MANY (==, eql) |
| 428 | 1002 } |
| 1003 | |
| 1004 DEFUN ("<", Flss, 1, MANY, 0, /* | |
| 1005 Return t if the sequence of arguments is monotonically increasing. | |
| 3343 | 1006 |
| 1007 (That is, if there is a second argument, it must be numerically greater than | |
| 1008 the first. If there is a third, it must be numerically greater than the | |
| 1009 second, and so on.) At least one argument is required. | |
| 1010 | |
| 1011 The arguments may be numbers, characters or markers. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
1012 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
1013 arguments: (FIRST &rest ARGS) |
| 428 | 1014 */ |
| 1015 (int nargs, Lisp_Object *args)) | |
| 1016 { | |
| 1983 | 1017 ARITHCOMPARE_MANY (<, lt) |
| 428 | 1018 } |
| 1019 | |
| 1020 DEFUN (">", Fgtr, 1, MANY, 0, /* | |
| 1021 Return t if the sequence of arguments is monotonically decreasing. | |
| 3343 | 1022 |
| 1023 (That is, if there is a second argument, it must be numerically less than | |
| 1024 the first. If there is a third, it must be numerically less than the | |
| 1025 second, and so forth.) At least one argument is required. | |
| 1026 | |
| 428 | 1027 The arguments may be numbers, characters or markers. |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
1028 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
1029 arguments: (FIRST &rest ARGS) |
| 428 | 1030 */ |
| 1031 (int nargs, Lisp_Object *args)) | |
| 1032 { | |
| 1983 | 1033 ARITHCOMPARE_MANY (>, gt) |
| 428 | 1034 } |
| 1035 | |
| 1036 DEFUN ("<=", Fleq, 1, MANY, 0, /* | |
| 1037 Return t if the sequence of arguments is monotonically nondecreasing. | |
| 1038 The arguments may be numbers, characters or markers. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
1039 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
1040 arguments: (FIRST &rest ARGS) |
| 428 | 1041 */ |
| 1042 (int nargs, Lisp_Object *args)) | |
| 1043 { | |
| 1983 | 1044 ARITHCOMPARE_MANY (<=, le) |
| 428 | 1045 } |
| 1046 | |
| 1047 DEFUN (">=", Fgeq, 1, MANY, 0, /* | |
| 1048 Return t if the sequence of arguments is monotonically nonincreasing. | |
| 1049 The arguments may be numbers, characters or markers. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
1050 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
1051 arguments: (FIRST &rest ARGS) |
| 428 | 1052 */ |
| 1053 (int nargs, Lisp_Object *args)) | |
| 1054 { | |
| 1983 | 1055 ARITHCOMPARE_MANY (>=, ge) |
| 428 | 1056 } |
| 1057 | |
| 1983 | 1058 /* Unlike all the other comparisons, this is an O(N*N) algorithm. But who |
| 1059 cares? Inspection of all elisp code distributed by xemacs.org shows that | |
| 1060 it is almost always called with 2 arguments, rarely with 3, and never with | |
| 1061 more than 3. The constant factors of algorithms with better asymptotic | |
| 1062 complexity are higher, which means that those algorithms will run SLOWER | |
| 1063 than this one in the common case. Optimize the common case! */ | |
| 428 | 1064 DEFUN ("/=", Fneq, 1, MANY, 0, /* |
| 1065 Return t if no two arguments are numerically equal. | |
| 1066 The arguments may be numbers, characters or markers. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
1067 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
1068 arguments: (FIRST &rest ARGS) |
| 428 | 1069 */ |
| 1070 (int nargs, Lisp_Object *args)) | |
| 1071 { | |
| 1983 | 1072 #ifdef WITH_NUMBER_TYPES |
| 1073 REGISTER int i, j; | |
| 1074 Lisp_Object obj1, obj2; | |
| 1075 | |
| 1076 for (i = 0; i < nargs - 1; i++) | |
| 1077 { | |
| 1078 obj1 = args[i]; | |
| 1079 for (j = i + 1; j < nargs; j++) | |
| 1080 { | |
| 1081 obj2 = args[j]; | |
| 1082 switch (promote_args (&obj1, &obj2)) | |
| 1083 { | |
| 1084 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1085 if (XREALFIXNUM (obj1) == XREALFIXNUM (obj2)) |
| 1983 | 1086 return Qnil; |
| 1087 break; | |
| 1088 #ifdef HAVE_BIGNUM | |
| 1089 case BIGNUM_T: | |
| 1090 if (bignum_eql (XBIGNUM_DATA (obj1), XBIGNUM_DATA (obj2))) | |
| 1091 return Qnil; | |
| 1092 break; | |
| 1093 #endif | |
| 1094 #ifdef HAVE_RATIO | |
| 1095 case RATIO_T: | |
| 1096 if (ratio_eql (XRATIO_DATA (obj1), XRATIO_DATA (obj2))) | |
| 1097 return Qnil; | |
| 1098 break; | |
| 1099 #endif | |
| 1100 case FLOAT_T: | |
| 1101 if (XFLOAT_DATA (obj1) == XFLOAT_DATA (obj2)) | |
| 1102 return Qnil; | |
| 1103 break; | |
| 1104 #ifdef HAVE_BIGFLOAT | |
| 1105 case BIGFLOAT_T: | |
| 1106 if (bigfloat_eql (XBIGFLOAT_DATA (obj1), XBIGFLOAT_DATA (obj2))) | |
| 1107 return Qnil; | |
| 1108 break; | |
| 1109 #endif | |
| 1110 } | |
| 1111 } | |
| 1112 } | |
| 1113 return Qt; | |
| 1114 #else /* !WITH_NUMBER_TYPES */ | |
| 428 | 1115 Lisp_Object *args_end = args + nargs; |
| 1116 Lisp_Object *p, *q; | |
| 1117 | |
| 1118 /* Unlike all the other comparisons, this is an N*N algorithm. | |
| 1119 We could use a hash table for nargs > 50 to make this linear. */ | |
| 1120 for (p = args; p < args_end; p++) | |
| 1121 { | |
| 1122 int_or_double iod1, iod2; | |
| 1123 number_char_or_marker_to_int_or_double (*p, &iod1); | |
| 1124 | |
| 1125 for (q = p + 1; q < args_end; q++) | |
| 1126 { | |
| 1127 number_char_or_marker_to_int_or_double (*q, &iod2); | |
| 1128 | |
| 1129 if (!((iod1.int_p && iod2.int_p) ? | |
| 1130 (iod1.c.ival != iod2.c.ival) : | |
| 1131 ((iod1.int_p ? (double) iod1.c.ival : iod1.c.dval) != | |
| 1132 (iod2.int_p ? (double) iod2.c.ival : iod2.c.dval)))) | |
| 1133 return Qnil; | |
| 1134 } | |
| 1135 } | |
| 1136 return Qt; | |
| 1983 | 1137 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 1138 } |
| 1139 | |
| 1140 DEFUN ("zerop", Fzerop, 1, 1, 0, /* | |
| 1141 Return t if NUMBER is zero. | |
| 1142 */ | |
| 1143 (number)) | |
| 1144 { | |
| 1145 retry: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1146 if (FIXNUMP (number)) |
| 428 | 1147 return EQ (number, Qzero) ? Qt : Qnil; |
| 1983 | 1148 #ifdef HAVE_BIGNUM |
| 1149 else if (BIGNUMP (number)) | |
| 1150 return bignum_sign (XBIGNUM_DATA (number)) == 0 ? Qt : Qnil; | |
| 1151 #endif | |
| 1152 #ifdef HAVE_RATIO | |
| 1153 else if (RATIOP (number)) | |
| 1154 return ratio_sign (XRATIO_DATA (number)) == 0 ? Qt : Qnil; | |
| 1155 #endif | |
| 428 | 1156 else if (FLOATP (number)) |
| 1157 return XFLOAT_DATA (number) == 0.0 ? Qt : Qnil; | |
| 1983 | 1158 #ifdef HAVE_BIGFLOAT |
| 1159 else if (BIGFLOATP (number)) | |
| 1160 return bigfloat_sign (XBIGFLOAT_DATA (number)) == 0 ? Qt : Qnil; | |
| 1161 #endif | |
| 428 | 1162 else |
| 1163 { | |
| 1164 number = wrong_type_argument (Qnumberp, number); | |
| 1165 goto retry; | |
| 1166 } | |
| 1167 } | |
| 1168 | |
| 1169 /* Convert between a 32-bit value and a cons of two 16-bit values. | |
| 1170 This is used to pass 32-bit integers to and from the user. | |
| 1171 Use time_to_lisp() and lisp_to_time() for time values. | |
| 1172 | |
| 1173 If you're thinking of using this to store a pointer into a Lisp Object | |
| 1174 for internal purposes (such as when calling record_unwind_protect()), | |
| 1175 try using make_opaque_ptr()/get_opaque_ptr() instead. */ | |
| 1176 Lisp_Object | |
| 1177 word_to_lisp (unsigned int item) | |
| 1178 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1179 return Fcons (make_fixnum (item >> 16), make_fixnum (item & 0xffff)); |
| 428 | 1180 } |
| 1181 | |
| 1182 unsigned int | |
| 1183 lisp_to_word (Lisp_Object item) | |
| 1184 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1185 if (FIXNUMP (item)) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1186 return XFIXNUM (item); |
| 428 | 1187 else |
| 1188 { | |
| 1189 Lisp_Object top = Fcar (item); | |
| 1190 Lisp_Object bot = Fcdr (item); | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1191 CHECK_FIXNUM (top); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1192 CHECK_FIXNUM (bot); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1193 return (XFIXNUM (top) << 16) | (XFIXNUM (bot) & 0xffff); |
| 428 | 1194 } |
| 1195 } | |
| 1196 | |
| 1197 | |
| 1198 DEFUN ("number-to-string", Fnumber_to_string, 1, 1, 0, /* | |
| 444 | 1199 Convert NUMBER to a string by printing it in decimal. |
| 428 | 1200 Uses a minus sign if negative. |
| 444 | 1201 NUMBER may be an integer or a floating point number. |
| 1983 | 1202 If supported, it may also be a ratio. |
| 428 | 1203 */ |
| 444 | 1204 (number)) |
| 428 | 1205 { |
| 1983 | 1206 CHECK_NUMBER (number); |
| 428 | 1207 |
| 444 | 1208 if (FLOATP (number)) |
| 428 | 1209 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1210 Ascbyte pigbuf[350]; /* see comments in float_to_string */ |
| 428 | 1211 |
| 444 | 1212 float_to_string (pigbuf, XFLOAT_DATA (number)); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1213 return build_ascstring (pigbuf); |
| 428 | 1214 } |
| 1983 | 1215 #ifdef HAVE_BIGNUM |
| 1216 if (BIGNUMP (number)) | |
| 1217 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1218 Ascbyte *str = bignum_to_string (XBIGNUM_DATA (number), 10); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1219 Lisp_Object retval = build_ascstring (str); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
1220 xfree (str); |
| 1983 | 1221 return retval; |
| 1222 } | |
| 1223 #endif | |
| 1224 #ifdef HAVE_RATIO | |
| 1225 if (RATIOP (number)) | |
| 1226 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1227 Ascbyte *str = ratio_to_string (XRATIO_DATA (number), 10); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1228 Lisp_Object retval = build_ascstring (str); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
1229 xfree (str); |
| 1983 | 1230 return retval; |
| 1231 } | |
| 1232 #endif | |
| 1233 #ifdef HAVE_BIGFLOAT | |
| 1234 if (BIGFLOATP (number)) | |
| 1235 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1236 Ascbyte *str = bigfloat_to_string (XBIGFLOAT_DATA (number), 10); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1237 Lisp_Object retval = build_ascstring (str); |
|
4976
16112448d484
Rename xfree(FOO, TYPE) -> xfree(FOO)
Ben Wing <ben@xemacs.org>
parents:
4962
diff
changeset
|
1238 xfree (str); |
| 1983 | 1239 return retval; |
| 1240 } | |
| 1241 #endif | |
| 428 | 1242 |
| 603 | 1243 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1244 Ascbyte buffer[DECIMAL_PRINT_SIZE (long)]; |
| 603 | 1245 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1246 long_to_string (buffer, XFIXNUM (number)); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4846
diff
changeset
|
1247 return build_ascstring (buffer); |
| 603 | 1248 } |
| 428 | 1249 } |
| 1250 | |
| 2001 | 1251 #ifndef HAVE_BIGNUM |
| 428 | 1252 static int |
| 1253 digit_to_number (int character, int base) | |
| 1254 { | |
| 1255 /* Assumes ASCII */ | |
| 1256 int digit = ((character >= '0' && character <= '9') ? character - '0' : | |
| 1257 (character >= 'a' && character <= 'z') ? character - 'a' + 10 : | |
| 1258 (character >= 'A' && character <= 'Z') ? character - 'A' + 10 : | |
| 1259 -1); | |
| 1260 | |
| 1261 return digit >= base ? -1 : digit; | |
| 1262 } | |
| 2001 | 1263 #endif |
| 428 | 1264 |
| 1265 DEFUN ("string-to-number", Fstring_to_number, 1, 2, 0, /* | |
| 444 | 1266 Convert STRING to a number by parsing it as a number in base BASE. |
| 428 | 1267 This parses both integers and floating point numbers. |
| 1983 | 1268 If they are supported, it also reads ratios. |
| 428 | 1269 It ignores leading spaces and tabs. |
| 1270 | |
| 444 | 1271 If BASE is nil or omitted, base 10 is used. |
| 1272 BASE must be an integer between 2 and 16 (inclusive). | |
| 428 | 1273 Floating point numbers always use base 10. |
| 1274 */ | |
| 1275 (string, base)) | |
| 1276 { | |
| 1995 | 1277 Ibyte *p; |
| 428 | 1278 int b; |
| 1279 | |
| 1280 CHECK_STRING (string); | |
| 1281 | |
| 1282 if (NILP (base)) | |
| 1283 b = 10; | |
| 1284 else | |
| 1285 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1286 check_integer_range (base, make_fixnum (2), make_fixnum (16)); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1287 b = XFIXNUM (base); |
| 428 | 1288 } |
| 1289 | |
| 1995 | 1290 p = XSTRING_DATA (string); |
| 428 | 1291 |
| 1292 /* Skip any whitespace at the front of the number. Some versions of | |
| 1293 atoi do this anyway, so we might as well make Emacs lisp consistent. */ | |
| 1294 while (*p == ' ' || *p == '\t') | |
| 1295 p++; | |
| 1296 | |
| 1995 | 1297 if (isfloat_string ((const char *) p) && b == 10) |
| 1983 | 1298 { |
| 1299 #ifdef HAVE_BIGFLOAT | |
| 1300 if (ZEROP (Vdefault_float_precision)) | |
| 1301 #endif | |
| 1995 | 1302 return make_float (atof ((const char *) p)); |
| 1983 | 1303 #ifdef HAVE_BIGFLOAT |
| 1304 else | |
| 1305 { | |
| 2013 | 1306 /* The GMP version of bigfloat_set_string (mpf_set_str) has the |
| 1307 following limitation: if p starts with a '+' sign, it does | |
| 1308 nothing; i.e., it leaves its bigfloat argument untouched. | |
| 1309 Therefore, move p past any leading '+' signs. */ | |
| 2010 | 1310 if (*p == '+') |
| 1311 p++; | |
| 1983 | 1312 bigfloat_set_prec (scratch_bigfloat, bigfloat_get_default_prec ()); |
| 1995 | 1313 bigfloat_set_string (scratch_bigfloat, (const char *) p, b); |
| 1983 | 1314 return make_bigfloat_bf (scratch_bigfloat); |
| 1315 } | |
| 1316 #endif | |
| 1317 } | |
| 1318 | |
| 1319 #ifdef HAVE_RATIO | |
| 1320 if (qxestrchr (p, '/') != NULL) | |
| 1321 { | |
| 2013 | 1322 /* The GMP version of ratio_set_string (mpq_set_str) has the following |
| 1323 limitations: | |
| 1324 - If p starts with a '+' sign, it does nothing; i.e., it leaves its | |
| 1325 ratio argument untouched. | |
| 1326 - If p has a '+' sign after the '/' (e.g., 300/+400), it sets the | |
| 1327 numerator from the string, but *leaves the denominator unchanged*. | |
| 1328 - If p has trailing nonnumeric characters, it sets the numerator from | |
| 1329 the string, but leaves the denominator unchanged. | |
| 1330 - If p has more than one '/', (e.g., 1/2/3), then it sets the | |
| 1331 numerator from the string, but leaves the denominator unchanged. | |
| 1332 | |
| 1333 Therefore, move p past any leading '+' signs, temporarily drop a null | |
| 1334 after the numeric characters we are trying to convert, and then put | |
| 1335 the nulled character back afterward. I am not going to fix problem | |
| 1336 #2; just don't write ratios that look like that. */ | |
| 1337 Ibyte *end, save; | |
| 1338 | |
| 2010 | 1339 if (*p == '+') |
| 1340 p++; | |
| 2013 | 1341 |
| 2014 | 1342 end = p; |
| 1343 if (*end == '-') | |
| 1344 end++; | |
| 1345 while ((*end >= '0' && *end <= '9') || | |
| 2013 | 1346 (b > 10 && *end >= 'a' && *end <= 'a' + b - 11) || |
| 2014 | 1347 (b > 10 && *end >= 'A' && *end <= 'A' + b - 11)) |
| 1348 end++; | |
| 2013 | 1349 if (*end == '/') |
| 2014 | 1350 { |
| 1351 end++; | |
| 1352 if (*end == '-') | |
| 1353 end++; | |
| 1354 while ((*end >= '0' && *end <= '9') || | |
| 1355 (b > 10 && *end >= 'a' && *end <= 'a' + b - 11) || | |
| 1356 (b > 10 && *end >= 'A' && *end <= 'A' + b - 11)) | |
| 1357 end++; | |
| 1358 } | |
| 2013 | 1359 save = *end; |
| 1360 *end = '\0'; | |
| 1995 | 1361 ratio_set_string (scratch_ratio, (const char *) p, b); |
| 2013 | 1362 *end = save; |
| 1363 ratio_canonicalize (scratch_ratio); | |
| 1983 | 1364 return make_ratio_rt (scratch_ratio); |
| 1365 } | |
| 1366 #endif /* HAVE_RATIO */ | |
| 1367 | |
| 1368 #ifdef HAVE_BIGNUM | |
| 2013 | 1369 { |
| 1370 /* The GMP version of bignum_set_string (mpz_set_str) has the following | |
| 1371 limitations: | |
| 1372 - If p starts with a '+' sign, it does nothing; i.e., it leaves its | |
| 1373 bignum argument untouched. | |
| 1374 - If p is the empty string, it does nothing. | |
| 1375 - If p has trailing nonnumeric characters, it does nothing. | |
| 1376 | |
| 1377 Therefore, move p past any leading '+' signs, temporarily drop a null | |
| 1378 after the numeric characters we are trying to convert, special case the | |
| 1379 empty string, and then put the nulled character back afterward. */ | |
| 1380 Ibyte *end, save; | |
| 1381 Lisp_Object retval; | |
| 1382 | |
| 1383 if (*p == '+') | |
| 1384 p++; | |
| 2014 | 1385 end = p; |
| 1386 if (*end == '-') | |
| 1387 end++; | |
| 1388 while ((*end >= '0' && *end <= '9') || | |
| 2013 | 1389 (b > 10 && *end >= 'a' && *end <= 'a' + b - 11) || |
| 2014 | 1390 (b > 10 && *end >= 'A' && *end <= 'A' + b - 11)) |
| 1391 end++; | |
| 2013 | 1392 save = *end; |
| 1393 *end = '\0'; | |
| 1394 if (*p == '\0') | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1395 retval = make_fixnum (0); |
| 2013 | 1396 else |
| 1397 { | |
| 1398 bignum_set_string (scratch_bignum, (const char *) p, b); | |
| 1399 retval = Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
| 1400 } | |
| 1401 *end = save; | |
| 1402 return retval; | |
| 1403 } | |
| 1983 | 1404 #else |
| 428 | 1405 if (b == 10) |
| 1406 { | |
| 1407 /* Use the system-provided functions for base 10. */ | |
| 1408 #if SIZEOF_EMACS_INT == SIZEOF_INT | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1409 return make_fixnum (atoi ((char*) p)); |
| 428 | 1410 #elif SIZEOF_EMACS_INT == SIZEOF_LONG |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1411 return make_fixnum (atol ((char*) p)); |
| 428 | 1412 #elif SIZEOF_EMACS_INT == SIZEOF_LONG_LONG |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1413 return make_fixnum (atoll ((char*) p)); |
| 428 | 1414 #endif |
| 1415 } | |
| 1416 else | |
| 1417 { | |
| 444 | 1418 int negative = 1; |
| 428 | 1419 EMACS_INT v = 0; |
| 1420 | |
| 1421 if (*p == '-') | |
| 1422 { | |
| 1423 negative = -1; | |
| 1424 p++; | |
| 1425 } | |
| 1426 else if (*p == '+') | |
| 1427 p++; | |
| 1428 while (1) | |
| 1429 { | |
| 444 | 1430 int digit = digit_to_number (*p++, b); |
| 428 | 1431 if (digit < 0) |
| 1432 break; | |
| 1433 v = v * b + digit; | |
| 1434 } | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
1435 return make_fixnum (negative * v); |
| 428 | 1436 } |
| 1983 | 1437 #endif /* HAVE_BIGNUM */ |
| 428 | 1438 } |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1439 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1440 static int |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1441 find_highest_value (struct chartab_range * range, Lisp_Object UNUSED (table), |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1442 Lisp_Object val, void *extra_arg) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1443 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1444 Lisp_Object *highest_pointer = (Lisp_Object *) extra_arg; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1445 Lisp_Object max_seen = *highest_pointer; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1446 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1447 CHECK_FIXNUM (val); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1448 if (range->type != CHARTAB_RANGE_CHAR) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1449 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1450 invalid_argument ("Not an appropriate char table range", Qunbound); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1451 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1452 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1453 if (XFIXNUM (max_seen) < XFIXNUM (val)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1454 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1455 *highest_pointer = val; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1456 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1457 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1458 return 0; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1459 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1460 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1461 static int |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1462 fill_ichar_array (struct chartab_range *range, Lisp_Object UNUSED (table), |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1463 Lisp_Object val, void *extra_arg) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1464 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1465 Ichar *cctable = (Ichar *) extra_arg; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1466 EMACS_INT valint = XFIXNUM (val); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1467 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1468 /* Save the value if it hasn't been seen yet. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1469 if (-1 == cctable[valint]) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1470 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1471 cctable[valint] = range->ch; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1472 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1473 else |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1474 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1475 /* Otherwise, save it if the existing value is not uppercase, and this |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1476 one is. Use the standard case table rather than any buffer-specific |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1477 one because a) this can be called early before current_buffer is |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1478 available and b) it's better to have these independent of particular |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1479 buffer case tables. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1480 if (current_buffer != NULL && UPCASE (0, range->ch) == range->ch |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1481 && UPCASE (0, cctable[valint]) != cctable[valint]) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1482 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1483 cctable[valint] = range->ch; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1484 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1485 /* Maybe our own case infrastructure is not available yet. Use the C |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1486 library's. */ |
|
5870
df50aaeddca5
Don't tickle an unreasonable but standard C lib limitation, thank you Vin!
Aidan Kehoe <kehoea@parhasard.net>
parents:
5867
diff
changeset
|
1487 else if (current_buffer == NULL) |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1488 { |
|
5870
df50aaeddca5
Don't tickle an unreasonable but standard C lib limitation, thank you Vin!
Aidan Kehoe <kehoea@parhasard.net>
parents:
5867
diff
changeset
|
1489 /* The C library can't necessarily handle values outside of |
|
df50aaeddca5
Don't tickle an unreasonable but standard C lib limitation, thank you Vin!
Aidan Kehoe <kehoea@parhasard.net>
parents:
5867
diff
changeset
|
1490 the range EOF to CHAR_MAX, inclusive. */ |
|
df50aaeddca5
Don't tickle an unreasonable but standard C lib limitation, thank you Vin!
Aidan Kehoe <kehoea@parhasard.net>
parents:
5867
diff
changeset
|
1491 assert (range->ch == EOF || range->ch <= CHAR_MAX); |
|
df50aaeddca5
Don't tickle an unreasonable but standard C lib limitation, thank you Vin!
Aidan Kehoe <kehoea@parhasard.net>
parents:
5867
diff
changeset
|
1492 if (isupper (range->ch) && !isupper (cctable[valint])) |
|
df50aaeddca5
Don't tickle an unreasonable but standard C lib limitation, thank you Vin!
Aidan Kehoe <kehoea@parhasard.net>
parents:
5867
diff
changeset
|
1493 { |
|
df50aaeddca5
Don't tickle an unreasonable but standard C lib limitation, thank you Vin!
Aidan Kehoe <kehoea@parhasard.net>
parents:
5867
diff
changeset
|
1494 cctable[valint] = range->ch; |
|
df50aaeddca5
Don't tickle an unreasonable but standard C lib limitation, thank you Vin!
Aidan Kehoe <kehoea@parhasard.net>
parents:
5867
diff
changeset
|
1495 } |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1496 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1497 /* Otherwise, save it if this character has a numerically lower value |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1498 (preferring ASCII over fullwidth Chinese and so on). */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1499 else if (range->ch < cctable[valint]) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1500 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1501 cctable[valint] = range->ch; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1502 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1503 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1504 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1505 return 0; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1506 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1507 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1508 static Lisp_Object |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1509 build_fixnum_to_char_map (Lisp_Object radix_table) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1510 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1511 Lisp_Object highest_value, result; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1512 struct chartab_range ctr = { CHARTAB_RANGE_ALL, 0, Qnil, 0 }; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1513 Ichar *cctable; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1514 EMACS_INT ii, cclen; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1515 Ibyte *data; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1516 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1517 /* What's the greatest fixnum value seen? In passing, check all the char |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1518 table values are fixnums. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1519 CHECK_FIXNUM (XCHAR_TABLE (radix_table)->default_); |
|
5873
5a311f1f46aa
Don't extract a fixnum value unnecessarily, thank you Robert Delius Royar
Aidan Kehoe <kehoea@parhasard.net>
parents:
5871
diff
changeset
|
1520 highest_value = XCHAR_TABLE (radix_table)->default_; |
|
5a311f1f46aa
Don't extract a fixnum value unnecessarily, thank you Robert Delius Royar
Aidan Kehoe <kehoea@parhasard.net>
parents:
5871
diff
changeset
|
1521 |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1522 map_char_table (radix_table, &ctr, find_highest_value, &highest_value); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1523 cclen = XFIXNUM (highest_value) + 1; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1524 |
|
5876
0cebf04c18b5
Use cast for malloc call to satisfy VS6
Vin Shelton <acs@xemacs.org>
parents:
5873
diff
changeset
|
1525 cctable = (Ichar *)malloc (sizeof (Ichar) * cclen); |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1526 if (cctable == NULL) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1527 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1528 out_of_memory ("Could not allocate data for `digit-char'", Qunbound); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1529 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1530 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1531 for (ii = 0; ii < cclen; ++ii) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1532 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1533 cctable[ii] = (Ichar) -1; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1534 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1535 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1536 map_char_table (radix_table, &ctr, fill_ichar_array, cctable); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1537 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1538 for (ii = 0; ii < cclen; ++ii) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1539 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1540 if (cctable[ii] < 0) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1541 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1542 free (cctable); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1543 invalid_argument ("No digit specified for weight", make_fixnum (ii)); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1544 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1545 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1546 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1547 result = Fmake_string (make_fixnum (cclen * MAX_ICHAR_LEN), make_char (0)); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1548 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1549 data = XSTRING_DATA (result); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1550 for (ii = 0; ii < cclen; ii++) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1551 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1552 set_itext_ichar (data + (MAX_ICHAR_LEN * ii), cctable[ii]); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1553 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1554 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1555 init_string_ascii_begin (result); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1556 bump_string_modiff (result); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1557 sledgehammer_check_ascii_begin (result); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1558 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1559 free (cctable); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1560 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1561 return result; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1562 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1563 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1564 DEFUN ("set-digit-fixnum-map", Fset_digit_fixnum_map, 1, 1, 0, /* |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1565 Set the value of `digit-fixnum-map', which see. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1566 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1567 Also check that RADIX-TABLE is well-formed from the perspective of |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1568 `parse-integer' and `digit-char-p', and create an internal inverse mapping |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1569 for `digit-char', so that all three functions behave consistently. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1570 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1571 RADIX-TABLE itself is not saved, a read-only copy of it is made and returned. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1572 */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1573 (radix_table)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1574 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1575 Lisp_Object ftctable = Qnil; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1576 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1577 CHECK_CHAR_TABLE (radix_table); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1578 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1579 /* Create a table for `digit-char', checking the consistency of |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1580 radix_table while doing so. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1581 ftctable = build_fixnum_to_char_map (radix_table); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1582 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1583 Vdigit_fixnum_map = Fcopy_char_table (radix_table); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1584 LISP_READONLY (Vdigit_fixnum_map) = 1; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1585 Vfixnum_to_char_map = ftctable; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1586 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1587 return Vdigit_fixnum_map; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1588 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1589 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1590 DEFUN ("digit-char-p", Fdigit_char_p, 1, 3, 0, /* |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1591 Return non-nil if CHARACTER represents a digit in base RADIX. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1592 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1593 RADIX defaults to ten. The actual non-nil value returned is the integer |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1594 value of the character in base RADIX. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1595 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1596 RADIX-TABLE, if non-nil, is a character table describing characters' numeric |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1597 values. See `parse-integer' and `digit-fixnum-map'. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1598 */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1599 (character, radix, radix_table)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1600 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1601 Lisp_Object got = Qnil; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1602 EMACS_INT radixing, val; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1603 Ichar cc; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1604 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1605 CHECK_CHAR (character); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1606 cc = XCHAR (character); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1607 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1608 if (!NILP (radix)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1609 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1610 check_integer_range (radix, Qzero, |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1611 NILP (radix_table) ? |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1612 /* If we are using the default radix table, the |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1613 maximum possible value for the radix is |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1614 available to us now. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1615 make_fixnum |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1616 (XSTRING_LENGTH (Vfixnum_to_char_map) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1617 / MAX_ICHAR_LEN) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1618 /* Otherwise, calculating that is expensive. Check |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1619 at least that the radix is not a bignum, the |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1620 maximum count of characters available will not |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1621 exceed the size of a fixnum. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1622 : make_fixnum (MOST_POSITIVE_FIXNUM)); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1623 radixing = XFIXNUM (radix); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1624 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1625 else |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1626 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1627 radixing = 10; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1628 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1629 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1630 if (NILP (radix_table)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1631 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1632 radix_table = Vdigit_fixnum_map; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1633 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1634 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1635 got = get_char_table (cc, radix_table); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1636 CHECK_FIXNUM (got); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1637 val = XFIXNUM (got); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1638 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1639 if (val < 0 || val >= radixing) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1640 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1641 return Qnil; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1642 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1643 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1644 return make_fixnum (val); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1645 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1646 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1647 DEFUN ("digit-char", Fdigit_char, 1, 3, 0, /* |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1648 Return a character representing the integer WEIGHT in base RADIX. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1649 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1650 RADIX defaults to ten. If no such character exists, return nil. `digit-char' |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1651 prefers an upper case character if available. RADIX must be a non-negative |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1652 integer of value less than the maximum value in RADIX-TABLE. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1653 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1654 RADIX-TABLE, if non-nil, is a character table describing characters' numeric |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1655 values. It defaults to the value of `digit-fixnum-map'; see the documentation |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1656 for that variable and for `parse-integer'. This is not specified by Common |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1657 Lisp, and using a value other than the default in `digit-char' is expensive, |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1658 since the inverse map needs to be calculated. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1659 */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1660 (weight, radix, radix_table)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1661 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1662 EMACS_INT radixing = 10, weighting; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1663 Lisp_Object fixnum_to_char_table = Qnil; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1664 Ichar cc; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1665 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1666 CHECK_NATNUM (weight); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1667 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1668 if (!NILP (radix_table) && !EQ (radix_table, Vdigit_fixnum_map)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1669 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1670 CHECK_CHAR_TABLE (radix_table); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1671 /* The result of this isn't GCPROd, but the rest of this function |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1672 won't GC and continue. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1673 fixnum_to_char_table = build_fixnum_to_char_map (radix_table); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1674 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1675 else |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1676 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1677 fixnum_to_char_table = Vfixnum_to_char_map; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1678 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1679 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1680 if (!NILP (radix)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1681 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1682 check_integer_range (radix, Qzero, |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1683 make_fixnum (XSTRING_LENGTH (fixnum_to_char_table) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1684 / MAX_ICHAR_LEN)); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1685 radixing = XFIXNUM (radix); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1686 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1687 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1688 /* If weight is in its canonical form (and there's no reason to think it |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1689 isn't), Vfixnum_to_char_map can't be long enough to handle |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1690 this. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1691 if (BIGNUMP (weight)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1692 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1693 return Qnil; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1694 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1695 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1696 weighting = XFIXNUM (weight); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1697 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1698 if (weighting < radixing) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1699 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1700 cc = itext_ichar (XSTRING_DATA (fixnum_to_char_table) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1701 + MAX_ICHAR_LEN * weighting); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1702 return make_char (cc); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1703 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1704 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1705 return Qnil; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1706 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1707 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1708 Lisp_Object |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1709 parse_integer (const Ibyte *buf, Ibyte **buf_end_out, Bytecount len, |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1710 EMACS_INT base, Boolint junk_allowed, Lisp_Object radix_table) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1711 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1712 const Ibyte *lim = buf + len, *p = buf; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1713 EMACS_UINT num = 0, onum = (EMACS_UINT) -1; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1714 EMACS_UINT fixnum_limit = MOST_POSITIVE_FIXNUM; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1715 EMACS_INT cint = 0; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1716 Boolint negativland = 0; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1717 Ichar c = -1; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1718 Lisp_Object result = Qnil, got = Qnil; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1719 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1720 if (NILP (radix_table)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1721 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1722 radix_table = Vdigit_fixnum_map; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1723 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1724 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1725 /* This function ignores the current buffer's syntax table. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1726 Respecting it will probably introduce more bugs than it fixes. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1727 update_mirror_syntax_if_dirty (XCHAR_TABLE (Vstandard_syntax_table)-> |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1728 mirror_table); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1729 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1730 /* Ignore leading whitespace, if that leading whitespace has no |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1731 numeric value. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1732 while (p < lim) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1733 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1734 c = itext_ichar (p); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1735 if (!(((got = get_char_table (c, radix_table), FIXNUMP (got)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1736 && ((cint = XFIXNUM (got), cint < 0) || cint >= base)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1737 && (SYNTAX (XCHAR_TABLE (Vstandard_syntax_table)->mirror_table, |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1738 c) == Swhitespace))) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1739 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1740 break; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1741 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1742 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1743 INC_IBYTEPTR (p); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1744 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1745 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1746 /* Drop sign information if appropriate. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1747 if (c == '-') |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1748 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1749 negativland = 1; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1750 fixnum_limit = - MOST_NEGATIVE_FIXNUM; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1751 INC_IBYTEPTR (p); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1752 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1753 else if (c == '+') |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1754 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1755 got = get_char_table (c, radix_table); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1756 cint = FIXNUMP (got) ? XFIXNUM (got) : -1; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1757 /* If ?+ has no integer weight, drop it. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1758 if (cint < 0 || cint >= base) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1759 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1760 INC_IBYTEPTR (p); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1761 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1762 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1763 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1764 while (p < lim) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1765 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1766 c = itext_ichar (p); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1767 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1768 got = get_char_table (c, radix_table); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1769 if (!FIXNUMP (got)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1770 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1771 goto loser; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1772 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1773 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1774 cint = XFIXNUM (got); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1775 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1776 if (cint < 0 || cint >= base) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1777 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1778 goto loser; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1779 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1780 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1781 onum = num; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1782 num *= base; |
|
5886
c96000075e49
Be more careful about C integer overflow, #'parse-integer.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5876
diff
changeset
|
1783 if (num > fixnum_limit || num < onum) |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1784 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1785 goto overflow; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1786 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1787 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1788 num += cint; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1789 if (num > fixnum_limit) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1790 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1791 goto overflow; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1792 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1793 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1794 INC_IBYTEPTR (p); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1795 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1796 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1797 if (onum == (EMACS_UINT) -1) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1798 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1799 /* No digits seen, we may need to error. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1800 goto loser; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1801 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1802 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1803 if (negativland) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1804 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1805 result = make_fixnum (- (EMACS_INT) num); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1806 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1807 else |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1808 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1809 result = make_fixnum (num); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1810 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1811 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1812 *buf_end_out = (Ibyte *) p; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1813 return result; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1814 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1815 overflow: |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1816 #ifndef HAVE_BIGNUM |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1817 return Fsignal (Qinvalid_argument, |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1818 list3 (build_msg_string ("Integer constant overflow"), |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1819 make_string (buf, len), make_fixnum (base))); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1820 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1821 #else /* HAVE_BIGNUM */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1822 result = make_bignum_emacs_uint (onum); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1823 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1824 bignum_set_emacs_int (scratch_bignum, base); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1825 bignum_set_emacs_int (scratch_bignum2, cint); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1826 bignum_mul (XBIGNUM_DATA (result), XBIGNUM_DATA (result), scratch_bignum); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1827 bignum_add (XBIGNUM_DATA (result), XBIGNUM_DATA (result), scratch_bignum2); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1828 INC_IBYTEPTR (p); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1829 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1830 assert (!bignum_fits_emacs_int_p (XBIGNUM_DATA (result)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1831 || (fixnum_limit |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1832 < (EMACS_UINT) bignum_to_emacs_int (XBIGNUM_DATA (result)))); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1833 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1834 while (p < lim) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1835 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1836 c = itext_ichar (p); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1837 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1838 got = get_char_table (c, radix_table); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1839 if (!FIXNUMP (got)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1840 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1841 goto loser; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1842 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1843 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1844 cint = XFIXNUM (got); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1845 if (cint < 0 || cint >= base) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1846 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1847 goto loser; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1848 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1849 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1850 bignum_set_emacs_int (scratch_bignum2, cint); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1851 bignum_mul (XBIGNUM_DATA (result), XBIGNUM_DATA (result), |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1852 scratch_bignum); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1853 bignum_add (XBIGNUM_DATA (result), XBIGNUM_DATA (result), |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1854 scratch_bignum2); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1855 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1856 INC_IBYTEPTR (p); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1857 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1858 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1859 if (negativland) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1860 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1861 bignum_set_long (scratch_bignum, -1L); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1862 bignum_mul (XBIGNUM_DATA (result), XBIGNUM_DATA (result), |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1863 scratch_bignum); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1864 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1865 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1866 *buf_end_out = (Ibyte *) p; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1867 return result; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1868 #endif /* HAVE_BIGNUM */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1869 loser: |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1870 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1871 if (p < lim && !junk_allowed) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1872 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1873 /* JUNK-ALLOWED is zero. If we have stopped parsing because we |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1874 encountered whitespace, then we need to check that the rest if the |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1875 string is whitespace and whitespace alone if we are not to error. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1876 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1877 Perhaps surprisingly, if JUNK-ALLOWED is zero, the parse is regarded |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1878 as including the trailing whitespace, so the second value returned is |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1879 always the length of the string. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1880 while (p < lim) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1881 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1882 c = itext_ichar (p); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1883 if (!(SYNTAX (XCHAR_TABLE (Vstandard_syntax_table)->mirror_table, c) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1884 == Swhitespace)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1885 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1886 break; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1887 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1888 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1889 INC_IBYTEPTR (p); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1890 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1891 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1892 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1893 *buf_end_out = (Ibyte *) p; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1894 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1895 if (junk_allowed || (p == lim && onum != (EMACS_UINT) -1)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1896 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1897 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1898 #ifdef HAVE_BIGNUM |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1899 if (!NILP (result)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1900 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1901 /* Bignum terminated by whitespace or by non-digit. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1902 return Fcanonicalize_number (result); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1903 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1904 #endif |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1905 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1906 if (onum == (EMACS_UINT) -1) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1907 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1908 /* No integer digits seen, but junk allowed, so no indication to |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1909 error. Return nil. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1910 return Qnil; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1911 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1912 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1913 if (negativland) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1914 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1915 assert ((- (EMACS_INT) num) >= MOST_NEGATIVE_FIXNUM); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1916 result = make_fixnum (- (EMACS_INT) num); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1917 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1918 else |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1919 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1920 assert ((EMACS_INT) num <= MOST_POSITIVE_FIXNUM); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1921 result = make_fixnum (num); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1922 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1923 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1924 return result; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1925 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1926 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1927 return Fsignal (Qinvalid_argument, |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1928 list3 (build_msg_string ("Invalid integer syntax"), |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1929 make_string (buf, len), make_fixnum (base))); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1930 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1931 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1932 DEFUN ("parse-integer", Fparse_integer, 1, MANY, 0, /* |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1933 Parse and return the integer represented by STRING using RADIX. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1934 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1935 START and END are bounding index designators, as used in `remove*'. START |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1936 defaults to 0 and END defaults to nil, meaning the end of STRING. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1937 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1938 If JUNK-ALLOWED is nil, error if STRING does not consist in its entirety of |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1939 the representation of an integer, with or without surrounding whitespace |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1940 characters. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1941 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1942 If RADIX-TABLE is non-nil, it is a char table mapping from characters to |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1943 fixnums used with RADIX. Otherwise, `digit-fixnum-map' provides the |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1944 correspondence to use. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1945 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1946 RADIX must always be a non-negative fixnum. RADIX-TABLE constrains its |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1947 possible values further, and the maximum RADIX available is always the largest |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1948 positive value available RADIX-TABLE. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1949 |
|
5867
e0f1dfaa821e
Add the non-ASCII digit support, now #'parse-integer can handle it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5864
diff
changeset
|
1950 If RADIX-TABLE (or `digit-fixnum-map') assigns a numeric value to `-', its |
|
e0f1dfaa821e
Add the non-ASCII digit support, now #'parse-integer can handle it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5864
diff
changeset
|
1951 digit value will be ignored if ?- is the first character in a string. The |
|
e0f1dfaa821e
Add the non-ASCII digit support, now #'parse-integer can handle it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5864
diff
changeset
|
1952 number will be treated as negative. To work around this, double it, or assign |
|
e0f1dfaa821e
Add the non-ASCII digit support, now #'parse-integer can handle it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5864
diff
changeset
|
1953 another character the value zero and prefix non-negative strings with that. A |
|
e0f1dfaa821e
Add the non-ASCII digit support, now #'parse-integer can handle it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5864
diff
changeset
|
1954 digit value for ?+ will be respected even if it is the first character in the |
|
e0f1dfaa821e
Add the non-ASCII digit support, now #'parse-integer can handle it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5864
diff
changeset
|
1955 representation of an integer. |
|
e0f1dfaa821e
Add the non-ASCII digit support, now #'parse-integer can handle it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5864
diff
changeset
|
1956 |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1957 arguments: (STRING &key (START 0) end (RADIX 10) junk-allowed radix-table) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1958 */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1959 (int nargs, Lisp_Object *args)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1960 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1961 Lisp_Object string = args[0], result; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1962 Charcount starting = 0, ending = MOST_POSITIVE_FIXNUM + 1, ii = 0; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1963 Bytecount byte_len; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1964 Ibyte *startp, *cursor, *end_read, *limit, *saved_start; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1965 EMACS_INT radixing; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1966 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1967 PARSE_KEYWORDS (Fparse_integer, nargs, args, 5, |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1968 (start, end, radix, junk_allowed, radix_table), |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1969 (start = Qzero, radix = make_fixnum (10))); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1970 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1971 CHECK_STRING (string); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1972 CHECK_NATNUM (start); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1973 starting = BIGNUMP (start) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (start); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1974 if (!NILP (end)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1975 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1976 CHECK_NATNUM (end); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1977 ending = BIGNUMP (end) ? 1 + MOST_POSITIVE_FIXNUM : XFIXNUM (end); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1978 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1979 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1980 if (!NILP (radix_table)) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1981 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1982 CHECK_CHAR_TABLE (radix_table); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1983 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1984 else |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1985 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1986 radix_table = Vdigit_fixnum_map; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1987 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1988 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1989 check_integer_range (radix, Qzero, |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1990 EQ (radix_table, Vdigit_fixnum_map) ? |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1991 make_fixnum (XSTRING_LENGTH (Vfixnum_to_char_map) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1992 / MAX_ICHAR_LEN) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1993 /* Non-default radix table; calculating the upper limit |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1994 is is expensive. Check at least that the radix is |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1995 not a bignum, the maximum count of characters |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1996 available in our XEmacs will not exceed the size of |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1997 a fixnum. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1998 : make_fixnum (MOST_POSITIVE_FIXNUM)); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1999 radixing = XFIXNUM (radix); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2000 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2001 startp = cursor = saved_start = XSTRING_DATA (string); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2002 byte_len = XSTRING_LENGTH (string); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2003 limit = startp + byte_len; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2004 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2005 while (cursor < limit && ii < ending) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2006 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2007 INC_IBYTEPTR (cursor); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2008 if (ii < starting) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2009 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2010 startp = cursor; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2011 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2012 ii++; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2013 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2014 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2015 if (ii < starting || (ii < ending && !NILP (end))) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2016 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2017 check_sequence_range (string, start, end, Flength (string)); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2018 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2019 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2020 result = parse_integer (startp, &end_read, cursor - startp, radixing, |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2021 !NILP (junk_allowed), radix_table); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2022 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2023 /* This code hasn't been written to handle relocating string data. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2024 assert (saved_start == XSTRING_DATA (string)); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2025 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2026 return values2 (result, make_fixnum (string_index_byte_to_char |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2027 (string, end_read - saved_start))); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2028 } |
| 428 | 2029 |
| 2030 DEFUN ("+", Fplus, 0, MANY, 0, /* | |
| 2031 Return sum of any number of arguments. | |
| 2032 The arguments should all be numbers, characters or markers. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2033 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2034 arguments: (&rest ARGS) |
| 428 | 2035 */ |
| 2036 (int nargs, Lisp_Object *args)) | |
| 2037 { | |
| 1983 | 2038 #ifdef WITH_NUMBER_TYPES |
| 2039 REGISTER int i; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2040 Lisp_Object accum = make_fixnum (0), addend; |
| 1983 | 2041 |
| 2042 for (i = 0; i < nargs; i++) | |
| 2043 { | |
| 2044 addend = args[i]; | |
| 2045 switch (promote_args (&accum, &addend)) | |
| 2046 { | |
| 2047 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2048 accum = make_integer (XREALFIXNUM (accum) + XREALFIXNUM (addend)); |
| 1983 | 2049 break; |
| 2050 #ifdef HAVE_BIGNUM | |
| 2051 case BIGNUM_T: | |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5582
diff
changeset
|
2052 bignum_add (XBIGNUM_DATA (accum), XBIGNUM_DATA (accum), |
| 1983 | 2053 XBIGNUM_DATA (addend)); |
| 2054 break; | |
| 2055 #endif | |
| 2056 #ifdef HAVE_RATIO | |
| 2057 case RATIO_T: | |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5582
diff
changeset
|
2058 ratio_add (XRATIO_DATA (accum), XRATIO_DATA (accum), |
| 1983 | 2059 XRATIO_DATA (addend)); |
| 2060 break; | |
| 2061 #endif | |
| 2062 case FLOAT_T: | |
| 2063 accum = make_float (XFLOAT_DATA (accum) + XFLOAT_DATA (addend)); | |
| 2064 break; | |
| 2065 #ifdef HAVE_BIGFLOAT | |
| 2066 case BIGFLOAT_T: | |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5582
diff
changeset
|
2067 bigfloat_set_prec (XBIGFLOAT_DATA (accum), |
| 1983 | 2068 max (XBIGFLOAT_GET_PREC (addend), |
| 2069 XBIGFLOAT_GET_PREC (accum))); | |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5582
diff
changeset
|
2070 bigfloat_add (XBIGFLOAT_DATA (accum), XBIGFLOAT_DATA (accum), |
| 1983 | 2071 XBIGFLOAT_DATA (addend)); |
| 2072 break; | |
| 2073 #endif | |
| 2074 } | |
| 2075 } | |
| 2076 return Fcanonicalize_number (accum); | |
| 2077 #else /* !WITH_NUMBER_TYPES */ | |
| 428 | 2078 EMACS_INT iaccum = 0; |
| 2079 Lisp_Object *args_end = args + nargs; | |
| 2080 | |
| 2081 while (args < args_end) | |
| 2082 { | |
| 2083 int_or_double iod; | |
| 2084 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2085 if (iod.int_p) | |
| 2086 iaccum += iod.c.ival; | |
| 2087 else | |
| 2088 { | |
| 2089 double daccum = (double) iaccum + iod.c.dval; | |
| 2090 while (args < args_end) | |
| 2091 daccum += number_char_or_marker_to_double (*args++); | |
| 2092 return make_float (daccum); | |
| 2093 } | |
| 2094 } | |
| 2095 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2096 return make_fixnum (iaccum); |
| 1983 | 2097 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 2098 } |
| 2099 | |
| 2100 DEFUN ("-", Fminus, 1, MANY, 0, /* | |
| 2101 Negate number or subtract numbers, characters or markers. | |
| 2102 With one arg, negates it. With more than one arg, | |
| 2103 subtracts all but the first from the first. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2104 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2105 arguments: (FIRST &rest ARGS) |
| 428 | 2106 */ |
| 2107 (int nargs, Lisp_Object *args)) | |
| 2108 { | |
| 1983 | 2109 #ifdef WITH_NUMBER_TYPES |
| 2110 REGISTER int i; | |
| 2111 Lisp_Object accum = args[0], subtrahend; | |
| 2112 | |
| 2113 if (nargs == 1) | |
| 2114 { | |
| 2115 if (CHARP (accum)) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2116 accum = make_fixnum (XCHAR (accum)); |
| 1983 | 2117 else if (MARKERP (accum)) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2118 accum = make_fixnum (marker_position (accum)); |
| 1983 | 2119 |
| 2120 /* Invert the sign of accum */ | |
| 2121 CHECK_NUMBER (accum); | |
| 2122 switch (get_number_type (accum)) | |
| 2123 { | |
| 2124 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2125 return make_integer (-XREALFIXNUM (accum)); |
| 1983 | 2126 #ifdef HAVE_BIGNUM |
| 2127 case BIGNUM_T: | |
| 2128 bignum_neg (scratch_bignum, XBIGNUM_DATA (accum)); | |
| 2129 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
| 2130 #endif | |
| 2131 #ifdef HAVE_RATIO | |
| 2132 case RATIO_T: | |
| 2133 ratio_neg (scratch_ratio, XRATIO_DATA (accum)); | |
| 2134 return make_ratio_rt (scratch_ratio); | |
| 2135 #endif | |
| 2136 case FLOAT_T: | |
| 2137 return make_float (-XFLOAT_DATA (accum)); | |
| 2138 #ifdef HAVE_BIGFLOAT | |
| 2139 case BIGFLOAT_T: | |
| 2140 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (accum)); | |
| 2141 bigfloat_neg (scratch_bigfloat, XBIGFLOAT_DATA (accum)); | |
| 2142 return make_bigfloat_bf (scratch_bigfloat); | |
| 2143 #endif | |
| 2144 } | |
| 2145 } | |
| 2146 else | |
| 2147 { | |
| 2148 /* Subtrace the remaining arguments from accum */ | |
| 2149 for (i = 1; i < nargs; i++) | |
| 2150 { | |
| 2151 subtrahend = args[i]; | |
| 2152 switch (promote_args (&accum, &subtrahend)) | |
| 2153 { | |
| 2154 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2155 accum = make_integer (XREALFIXNUM (accum) - XREALFIXNUM (subtrahend)); |
| 1983 | 2156 break; |
| 2157 #ifdef HAVE_BIGNUM | |
| 2158 case BIGNUM_T: | |
| 2159 bignum_sub (scratch_bignum, XBIGNUM_DATA (accum), | |
| 2160 XBIGNUM_DATA (subtrahend)); | |
| 2161 accum = make_bignum_bg (scratch_bignum); | |
| 2162 break; | |
| 2163 #endif | |
| 2164 #ifdef HAVE_RATIO | |
| 2165 case RATIO_T: | |
| 2166 ratio_sub (scratch_ratio, XRATIO_DATA (accum), | |
| 2167 XRATIO_DATA (subtrahend)); | |
| 2168 accum = make_ratio_rt (scratch_ratio); | |
| 2169 break; | |
| 2170 #endif | |
| 2171 case FLOAT_T: | |
| 2172 accum = | |
| 2173 make_float (XFLOAT_DATA (accum) - XFLOAT_DATA (subtrahend)); | |
| 2174 break; | |
| 2175 #ifdef HAVE_BIGFLOAT | |
| 2176 case BIGFLOAT_T: | |
| 2177 bigfloat_set_prec (scratch_bigfloat, | |
| 2178 max (XBIGFLOAT_GET_PREC (subtrahend), | |
| 2179 XBIGFLOAT_GET_PREC (accum))); | |
| 2180 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (accum), | |
| 2181 XBIGFLOAT_DATA (subtrahend)); | |
| 2182 accum = make_bigfloat_bf (scratch_bigfloat); | |
| 2183 break; | |
| 2184 #endif | |
| 2185 } | |
| 2186 } | |
| 2187 } | |
| 2188 return Fcanonicalize_number (accum); | |
| 2189 #else /* !WITH_NUMBER_TYPES */ | |
| 428 | 2190 EMACS_INT iaccum; |
| 2191 double daccum; | |
| 2192 Lisp_Object *args_end = args + nargs; | |
| 2193 int_or_double iod; | |
| 2194 | |
| 2195 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2196 if (iod.int_p) | |
| 2197 iaccum = nargs > 1 ? iod.c.ival : - iod.c.ival; | |
| 2198 else | |
| 2199 { | |
| 2200 daccum = nargs > 1 ? iod.c.dval : - iod.c.dval; | |
| 2201 goto do_float; | |
| 2202 } | |
| 2203 | |
| 2204 while (args < args_end) | |
| 2205 { | |
| 2206 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2207 if (iod.int_p) | |
| 2208 iaccum -= iod.c.ival; | |
| 2209 else | |
| 2210 { | |
| 2211 daccum = (double) iaccum - iod.c.dval; | |
| 2212 goto do_float; | |
| 2213 } | |
| 2214 } | |
| 2215 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2216 return make_fixnum (iaccum); |
| 428 | 2217 |
| 2218 do_float: | |
| 2219 for (; args < args_end; args++) | |
| 2220 daccum -= number_char_or_marker_to_double (*args); | |
| 2221 return make_float (daccum); | |
| 1983 | 2222 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 2223 } |
| 2224 | |
| 2225 DEFUN ("*", Ftimes, 0, MANY, 0, /* | |
| 2226 Return product of any number of arguments. | |
| 2227 The arguments should all be numbers, characters or markers. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2228 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2229 arguments: (&rest ARGS) |
| 428 | 2230 */ |
| 2231 (int nargs, Lisp_Object *args)) | |
| 2232 { | |
| 1983 | 2233 #ifdef WITH_NUMBER_TYPES |
| 2234 REGISTER int i; | |
| 2235 /* Start with a bignum to avoid overflow */ | |
| 2236 Lisp_Object accum = make_bignum (1L), multiplier; | |
| 2237 | |
| 2238 for (i = 0; i < nargs; i++) | |
| 2239 { | |
| 2240 multiplier = args[i]; | |
| 2241 switch (promote_args (&accum, &multiplier)) | |
| 2242 { | |
| 2243 #ifdef HAVE_BIGNUM | |
| 2244 case BIGNUM_T: | |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5582
diff
changeset
|
2245 bignum_mul (XBIGNUM_DATA (accum), XBIGNUM_DATA (accum), |
| 1983 | 2246 XBIGNUM_DATA (multiplier)); |
| 2247 break; | |
| 2248 #endif | |
| 2249 #ifdef HAVE_RATIO | |
| 2250 case RATIO_T: | |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5582
diff
changeset
|
2251 ratio_mul (XRATIO_DATA (accum), XRATIO_DATA (accum), |
| 1983 | 2252 XRATIO_DATA (multiplier)); |
| 2253 break; | |
| 2254 #endif | |
| 2255 case FLOAT_T: | |
| 2256 accum = make_float (XFLOAT_DATA (accum) * XFLOAT_DATA (multiplier)); | |
| 2257 break; | |
| 2258 #ifdef HAVE_BIGFLOAT | |
| 2259 case BIGFLOAT_T: | |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5582
diff
changeset
|
2260 bigfloat_set_prec (XBIGFLOAT_DATA (accum), |
| 1983 | 2261 max (XBIGFLOAT_GET_PREC (multiplier), |
| 2262 XBIGFLOAT_GET_PREC (accum))); | |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5582
diff
changeset
|
2263 bigfloat_mul (XBIGFLOAT_DATA (accum), XBIGFLOAT_DATA (accum), |
| 1983 | 2264 XBIGFLOAT_DATA (multiplier)); |
| 2265 break; | |
| 2266 #endif | |
| 2267 } | |
| 2268 } | |
| 2269 return Fcanonicalize_number (accum); | |
| 2270 #else /* !WITH_NUMBER_TYPES */ | |
| 428 | 2271 EMACS_INT iaccum = 1; |
| 2272 Lisp_Object *args_end = args + nargs; | |
| 2273 | |
| 2274 while (args < args_end) | |
| 2275 { | |
| 2276 int_or_double iod; | |
| 2277 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2278 if (iod.int_p) | |
| 2279 iaccum *= iod.c.ival; | |
| 2280 else | |
| 2281 { | |
| 2282 double daccum = (double) iaccum * iod.c.dval; | |
| 2283 while (args < args_end) | |
| 2284 daccum *= number_char_or_marker_to_double (*args++); | |
| 2285 return make_float (daccum); | |
| 2286 } | |
| 2287 } | |
| 2288 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2289 return make_fixnum (iaccum); |
| 1983 | 2290 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 2291 } |
| 2292 | |
| 1983 | 2293 #ifdef HAVE_RATIO |
| 2294 DEFUN ("div", Fdiv, 1, MANY, 0, /* | |
| 2295 Same as `/', but dividing integers creates a ratio instead of truncating. | |
| 2296 Note that this is a departure from Common Lisp, where / creates ratios when | |
| 2297 dividing integers. Having a separate function lets us avoid breaking existing | |
| 2298 Emacs Lisp code that expects / to do integer division. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2299 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2300 arguments: (FIRST &rest ARGS) |
| 1983 | 2301 */ |
| 2302 (int nargs, Lisp_Object *args)) | |
| 2303 { | |
| 2304 REGISTER int i; | |
| 2305 Lisp_Object accum, divisor; | |
| 2306 | |
| 2307 if (nargs == 1) | |
| 2308 { | |
| 2309 i = 0; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2310 accum = make_fixnum (1); |
| 1983 | 2311 } |
| 2312 else | |
| 2313 { | |
| 2314 i = 1; | |
| 2315 accum = args[0]; | |
| 2316 } | |
| 2317 for (; i < nargs; i++) | |
| 2318 { | |
| 2319 divisor = args[i]; | |
| 2320 switch (promote_args (&accum, &divisor)) | |
| 2321 { | |
| 2322 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2323 if (XREALFIXNUM (divisor) == 0) goto divide_by_zero; |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2324 bignum_set_long (scratch_bignum, XREALFIXNUM (accum)); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2325 bignum_set_long (scratch_bignum2, XREALFIXNUM (divisor)); |
| 1983 | 2326 accum = make_ratio_bg (scratch_bignum, scratch_bignum2); |
| 2327 break; | |
| 2328 case BIGNUM_T: | |
| 2329 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0) goto divide_by_zero; | |
| 2330 accum = make_ratio_bg (XBIGNUM_DATA (accum), XBIGNUM_DATA (divisor)); | |
| 2331 break; | |
| 2332 case RATIO_T: | |
| 2333 if (ratio_sign (XRATIO_DATA (divisor)) == 0) goto divide_by_zero; | |
| 2334 ratio_div (scratch_ratio, XRATIO_DATA (accum), | |
| 2335 XRATIO_DATA (divisor)); | |
| 2336 accum = make_ratio_rt (scratch_ratio); | |
| 2337 break; | |
| 2338 case FLOAT_T: | |
| 2339 if (XFLOAT_DATA (divisor) == 0.0) goto divide_by_zero; | |
| 2340 accum = make_float (XFLOAT_DATA (accum) / XFLOAT_DATA (divisor)); | |
| 2341 break; | |
| 2342 #ifdef HAVE_BIGFLOAT | |
| 2343 case BIGFLOAT_T: | |
| 2344 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0) | |
| 2345 goto divide_by_zero; | |
| 2346 bigfloat_set_prec (scratch_bigfloat, | |
| 2347 max (XBIGFLOAT_GET_PREC (divisor), | |
| 2348 XBIGFLOAT_GET_PREC (accum))); | |
| 2349 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (accum), | |
| 2350 XBIGFLOAT_DATA (divisor)); | |
| 2351 accum = make_bigfloat_bf (scratch_bigfloat); | |
| 2352 break; | |
| 2353 #endif | |
| 2354 } | |
| 2355 } | |
| 2356 return Fcanonicalize_number (accum); | |
| 2357 | |
| 2358 divide_by_zero: | |
| 2359 Fsignal (Qarith_error, Qnil); | |
| 2360 return Qnil; /* not (usually) reached */ | |
| 2361 } | |
| 2362 #endif /* HAVE_RATIO */ | |
| 2363 | |
| 428 | 2364 DEFUN ("/", Fquo, 1, MANY, 0, /* |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2365 Return FIRST divided by all the remaining arguments. |
| 428 | 2366 The arguments must be numbers, characters or markers. |
| 2367 With one argument, reciprocates the argument. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2368 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2369 arguments: (FIRST &rest ARGS) |
| 428 | 2370 */ |
| 2371 (int nargs, Lisp_Object *args)) | |
| 2372 { | |
| 1983 | 2373 #ifdef WITH_NUMBER_TYPES |
| 2374 REGISTER int i; | |
| 2375 Lisp_Object accum, divisor; | |
| 2376 | |
| 2377 if (nargs == 1) | |
| 2378 { | |
| 2379 i = 0; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2380 accum = make_fixnum (1); |
| 1983 | 2381 } |
| 2382 else | |
| 2383 { | |
| 2384 i = 1; | |
| 2385 accum = args[0]; | |
| 2386 } | |
| 2387 for (; i < nargs; i++) | |
| 2388 { | |
| 2389 divisor = args[i]; | |
| 2390 switch (promote_args (&accum, &divisor)) | |
| 2391 { | |
| 2392 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2393 if (XREALFIXNUM (divisor) == 0) goto divide_by_zero; |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2394 accum = make_integer (XREALFIXNUM (accum) / XREALFIXNUM (divisor)); |
| 1983 | 2395 break; |
| 2396 #ifdef HAVE_BIGNUM | |
| 2397 case BIGNUM_T: | |
| 2398 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0) goto divide_by_zero; | |
| 2399 bignum_div (scratch_bignum, XBIGNUM_DATA (accum), | |
| 2400 XBIGNUM_DATA (divisor)); | |
| 2401 accum = make_bignum_bg (scratch_bignum); | |
| 2402 break; | |
| 2403 #endif | |
| 2404 #ifdef HAVE_RATIO | |
| 2405 case RATIO_T: | |
| 2406 if (ratio_sign (XRATIO_DATA (divisor)) == 0) goto divide_by_zero; | |
| 2407 ratio_div (scratch_ratio, XRATIO_DATA (accum), | |
| 2408 XRATIO_DATA (divisor)); | |
| 2409 accum = make_ratio_rt (scratch_ratio); | |
| 2410 break; | |
| 2411 #endif | |
| 2412 case FLOAT_T: | |
| 2413 if (XFLOAT_DATA (divisor) == 0.0) goto divide_by_zero; | |
| 2414 accum = make_float (XFLOAT_DATA (accum) / XFLOAT_DATA (divisor)); | |
| 2415 break; | |
| 2416 #ifdef HAVE_BIGFLOAT | |
| 2417 case BIGFLOAT_T: | |
| 2418 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0) | |
| 2419 goto divide_by_zero; | |
| 2420 bigfloat_set_prec (scratch_bigfloat, | |
| 2421 max (XBIGFLOAT_GET_PREC (divisor), | |
| 2422 XBIGFLOAT_GET_PREC (accum))); | |
| 2423 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (accum), | |
| 2424 XBIGFLOAT_DATA (divisor)); | |
| 2425 accum = make_bigfloat_bf (scratch_bigfloat); | |
| 2426 break; | |
| 2427 #endif | |
| 2428 } | |
| 2429 } | |
| 2430 return Fcanonicalize_number (accum); | |
| 2431 #else /* !WITH_NUMBER_TYPES */ | |
| 428 | 2432 EMACS_INT iaccum; |
| 2433 double daccum; | |
| 2434 Lisp_Object *args_end = args + nargs; | |
| 2435 int_or_double iod; | |
| 2436 | |
| 2437 if (nargs == 1) | |
| 2438 iaccum = 1; | |
| 2439 else | |
| 2440 { | |
| 2441 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2442 if (iod.int_p) | |
| 2443 iaccum = iod.c.ival; | |
| 2444 else | |
| 2445 { | |
| 2446 daccum = iod.c.dval; | |
| 2447 goto divide_floats; | |
| 2448 } | |
| 2449 } | |
| 2450 | |
| 2451 while (args < args_end) | |
| 2452 { | |
| 2453 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2454 if (iod.int_p) | |
| 2455 { | |
| 2456 if (iod.c.ival == 0) goto divide_by_zero; | |
| 2457 iaccum /= iod.c.ival; | |
| 2458 } | |
| 2459 else | |
| 2460 { | |
| 2461 if (iod.c.dval == 0) goto divide_by_zero; | |
| 2462 daccum = (double) iaccum / iod.c.dval; | |
| 2463 goto divide_floats; | |
| 2464 } | |
| 2465 } | |
| 2466 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2467 return make_fixnum (iaccum); |
| 428 | 2468 |
| 2469 divide_floats: | |
| 2470 for (; args < args_end; args++) | |
| 2471 { | |
| 2472 double dval = number_char_or_marker_to_double (*args); | |
| 2473 if (dval == 0) goto divide_by_zero; | |
| 2474 daccum /= dval; | |
| 2475 } | |
| 2476 return make_float (daccum); | |
| 1983 | 2477 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 2478 |
| 2479 divide_by_zero: | |
| 2480 Fsignal (Qarith_error, Qnil); | |
| 801 | 2481 return Qnil; /* not (usually) reached */ |
| 428 | 2482 } |
| 2483 | |
| 2484 DEFUN ("max", Fmax, 1, MANY, 0, /* | |
| 2485 Return largest of all the arguments. | |
| 1983 | 2486 All arguments must be real numbers, characters or markers. |
| 428 | 2487 The value is always a number; markers and characters are converted |
| 2488 to numbers. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2489 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2490 arguments: (FIRST &rest ARGS) |
| 428 | 2491 */ |
| 2492 (int nargs, Lisp_Object *args)) | |
| 2493 { | |
| 1983 | 2494 #ifdef WITH_NUMBER_TYPES |
| 2495 REGISTER int i, maxindex = 0; | |
| 2496 | |
| 2497 while (!(CHARP (args[0]) || MARKERP (args[0]) || REALP (args[0]))) | |
| 2498 args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]); | |
| 2499 if (CHARP (args[0])) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2500 args[0] = make_fixnum (XCHAR (args[0])); |
| 1983 | 2501 else if (MARKERP (args[0])) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2502 args[0] = make_fixnum (marker_position (args[0])); |
| 1983 | 2503 for (i = 1; i < nargs; i++) |
| 2504 { | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2505 switch (promote_args (args + maxindex, args + i)) |
| 1983 | 2506 { |
| 2507 case FIXNUM_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2508 if (XREALFIXNUM (args[maxindex]) < XREALFIXNUM (args[i])) |
| 1983 | 2509 maxindex = i; |
| 2510 break; | |
| 2511 #ifdef HAVE_BIGNUM | |
| 2512 case BIGNUM_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2513 if (bignum_lt (XBIGNUM_DATA (args[maxindex]), |
|
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2514 XBIGNUM_DATA (args[i]))) |
| 1983 | 2515 maxindex = i; |
| 2516 break; | |
| 2517 #endif | |
| 2518 #ifdef HAVE_RATIO | |
| 2519 case RATIO_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2520 if (ratio_lt (XRATIO_DATA (args[maxindex]), XRATIO_DATA (args[i]))) |
| 1983 | 2521 maxindex = i; |
| 2522 break; | |
| 2523 #endif | |
| 2524 case FLOAT_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2525 if (XFLOAT_DATA (args[maxindex]) < XFLOAT_DATA (args[i])) |
| 1983 | 2526 maxindex = i; |
| 2527 break; | |
| 2528 #ifdef HAVE_BIGFLOAT | |
| 2529 case BIGFLOAT_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2530 if (bigfloat_lt (XBIGFLOAT_DATA (args[maxindex]), |
|
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2531 XBIGFLOAT_DATA (args[i]))) |
| 1983 | 2532 maxindex = i; |
| 2533 break; | |
| 2534 #endif | |
| 2535 } | |
| 2536 } | |
| 2537 return args[maxindex]; | |
| 2538 #else /* !WITH_NUMBER_TYPES */ | |
| 428 | 2539 EMACS_INT imax; |
| 2540 double dmax; | |
| 2541 Lisp_Object *args_end = args + nargs; | |
| 2542 int_or_double iod; | |
| 2543 | |
| 2544 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2545 if (iod.int_p) | |
| 2546 imax = iod.c.ival; | |
| 2547 else | |
| 2548 { | |
| 2549 dmax = iod.c.dval; | |
| 2550 goto max_floats; | |
| 2551 } | |
| 2552 | |
| 2553 while (args < args_end) | |
| 2554 { | |
| 2555 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2556 if (iod.int_p) | |
| 2557 { | |
| 2558 if (imax < iod.c.ival) imax = iod.c.ival; | |
| 2559 } | |
| 2560 else | |
| 2561 { | |
| 2562 dmax = (double) imax; | |
| 2563 if (dmax < iod.c.dval) dmax = iod.c.dval; | |
| 2564 goto max_floats; | |
| 2565 } | |
| 2566 } | |
| 2567 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2568 return make_fixnum (imax); |
| 428 | 2569 |
| 2570 max_floats: | |
| 2571 while (args < args_end) | |
| 2572 { | |
| 2573 double dval = number_char_or_marker_to_double (*args++); | |
| 2574 if (dmax < dval) dmax = dval; | |
| 2575 } | |
| 2576 return make_float (dmax); | |
| 1983 | 2577 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 2578 } |
| 2579 | |
| 2580 DEFUN ("min", Fmin, 1, MANY, 0, /* | |
| 2581 Return smallest of all the arguments. | |
| 2582 All arguments must be numbers, characters or markers. | |
| 2583 The value is always a number; markers and characters are converted | |
| 2584 to numbers. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2585 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2586 arguments: (FIRST &rest ARGS) |
| 428 | 2587 */ |
| 2588 (int nargs, Lisp_Object *args)) | |
| 2589 { | |
| 1983 | 2590 #ifdef WITH_NUMBER_TYPES |
| 2591 REGISTER int i, minindex = 0; | |
| 2592 | |
| 2593 while (!(CHARP (args[0]) || MARKERP (args[0]) || REALP (args[0]))) | |
| 2594 args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]); | |
| 2595 if (CHARP (args[0])) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2596 args[0] = make_fixnum (XCHAR (args[0])); |
| 1983 | 2597 else if (MARKERP (args[0])) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2598 args[0] = make_fixnum (marker_position (args[0])); |
| 1983 | 2599 for (i = 1; i < nargs; i++) |
| 2600 { | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2601 switch (promote_args (args + minindex, args + i)) |
| 1983 | 2602 { |
| 2603 case FIXNUM_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2604 if (XREALFIXNUM (args[minindex]) > XREALFIXNUM (args[i])) |
| 1983 | 2605 minindex = i; |
| 2606 break; | |
| 2607 #ifdef HAVE_BIGNUM | |
| 2608 case BIGNUM_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2609 if (bignum_gt (XBIGNUM_DATA (args[minindex]), |
|
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2610 XBIGNUM_DATA (args[i]))) |
| 1983 | 2611 minindex = i; |
| 2612 break; | |
| 2613 #endif | |
| 2614 #ifdef HAVE_RATIO | |
| 2615 case RATIO_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2616 if (ratio_gt (XRATIO_DATA (args[minindex]), |
|
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2617 XRATIO_DATA (args[i]))) |
| 1983 | 2618 minindex = i; |
| 2619 break; | |
| 2620 #endif | |
| 2621 case FLOAT_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2622 if (XFLOAT_DATA (args[minindex]) > XFLOAT_DATA (args[i])) |
| 1983 | 2623 minindex = i; |
| 2624 break; | |
| 2625 #ifdef HAVE_BIGFLOAT | |
| 2626 case BIGFLOAT_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2627 if (bigfloat_gt (XBIGFLOAT_DATA (args[minindex]), |
|
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2628 XBIGFLOAT_DATA (args[i]))) |
| 1983 | 2629 minindex = i; |
| 2630 break; | |
| 2631 #endif | |
| 2632 } | |
| 2633 } | |
| 2634 return args[minindex]; | |
| 2635 #else /* !WITH_NUMBER_TYPES */ | |
| 428 | 2636 EMACS_INT imin; |
| 2637 double dmin; | |
| 2638 Lisp_Object *args_end = args + nargs; | |
| 2639 int_or_double iod; | |
| 2640 | |
| 2641 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2642 if (iod.int_p) | |
| 2643 imin = iod.c.ival; | |
| 2644 else | |
| 2645 { | |
| 2646 dmin = iod.c.dval; | |
| 2647 goto min_floats; | |
| 2648 } | |
| 2649 | |
| 2650 while (args < args_end) | |
| 2651 { | |
| 2652 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2653 if (iod.int_p) | |
| 2654 { | |
| 2655 if (imin > iod.c.ival) imin = iod.c.ival; | |
| 2656 } | |
| 2657 else | |
| 2658 { | |
| 2659 dmin = (double) imin; | |
| 2660 if (dmin > iod.c.dval) dmin = iod.c.dval; | |
| 2661 goto min_floats; | |
| 2662 } | |
| 2663 } | |
| 2664 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2665 return make_fixnum (imin); |
| 428 | 2666 |
| 2667 min_floats: | |
| 2668 while (args < args_end) | |
| 2669 { | |
| 2670 double dval = number_char_or_marker_to_double (*args++); | |
| 2671 if (dmin > dval) dmin = dval; | |
| 2672 } | |
| 2673 return make_float (dmin); | |
| 1983 | 2674 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 2675 } |
| 2676 | |
| 2677 DEFUN ("logand", Flogand, 0, MANY, 0, /* | |
| 2678 Return bitwise-and of all the arguments. | |
| 2679 Arguments may be integers, or markers or characters converted to integers. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2680 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2681 arguments: (&rest ARGS) |
| 428 | 2682 */ |
| 2683 (int nargs, Lisp_Object *args)) | |
| 2684 { | |
| 1983 | 2685 #ifdef HAVE_BIGNUM |
| 2686 REGISTER int i; | |
| 2687 Lisp_Object result, other; | |
| 2688 | |
| 2689 if (nargs == 0) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2690 return make_fixnum (~0); |
| 1983 | 2691 |
| 2692 while (!(CHARP (args[0]) || MARKERP (args[0]) || INTEGERP (args[0]))) | |
| 2693 args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]); | |
| 2694 | |
| 2695 result = args[0]; | |
| 2696 if (CHARP (result)) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2697 result = make_fixnum (XCHAR (result)); |
| 1983 | 2698 else if (MARKERP (result)) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2699 result = make_fixnum (marker_position (result)); |
| 1983 | 2700 for (i = 1; i < nargs; i++) |
| 2701 { | |
| 2702 while (!(CHARP (args[i]) || MARKERP (args[i]) || INTEGERP (args[i]))) | |
| 2703 args[i] = wrong_type_argument (Qnumber_char_or_marker_p, args[i]); | |
| 2704 other = args[i]; | |
| 1995 | 2705 switch (promote_args (&result, &other)) |
| 1983 | 2706 { |
| 2707 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2708 result = make_fixnum (XREALFIXNUM (result) & XREALFIXNUM (other)); |
| 1983 | 2709 break; |
| 2710 case BIGNUM_T: | |
| 2711 bignum_and (scratch_bignum, XBIGNUM_DATA (result), | |
| 2712 XBIGNUM_DATA (other)); | |
| 2713 result = make_bignum_bg (scratch_bignum); | |
| 2714 break; | |
| 2715 } | |
| 2716 } | |
| 2717 return Fcanonicalize_number (result); | |
| 2718 #else /* !HAVE_BIGNUM */ | |
| 428 | 2719 EMACS_INT bits = ~0; |
| 2720 Lisp_Object *args_end = args + nargs; | |
| 2721 | |
| 2722 while (args < args_end) | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
2723 bits &= fixnum_char_or_marker_to_int (*args++); |
| 428 | 2724 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2725 return make_fixnum (bits); |
| 1983 | 2726 #endif /* HAVE_BIGNUM */ |
| 428 | 2727 } |
| 2728 | |
| 2729 DEFUN ("logior", Flogior, 0, MANY, 0, /* | |
| 2730 Return bitwise-or of all the arguments. | |
| 2731 Arguments may be integers, or markers or characters converted to integers. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2732 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2733 arguments: (&rest ARGS) |
| 428 | 2734 */ |
| 2735 (int nargs, Lisp_Object *args)) | |
| 2736 { | |
| 1983 | 2737 #ifdef HAVE_BIGNUM |
| 2738 REGISTER int i; | |
| 2739 Lisp_Object result, other; | |
| 2740 | |
| 2741 if (nargs == 0) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2742 return make_fixnum (0); |
| 1983 | 2743 |
| 2744 while (!(CHARP (args[0]) || MARKERP (args[0]) || INTEGERP (args[0]))) | |
| 2745 args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]); | |
| 2746 | |
| 2747 result = args[0]; | |
| 2748 if (CHARP (result)) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2749 result = make_fixnum (XCHAR (result)); |
| 1983 | 2750 else if (MARKERP (result)) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2751 result = make_fixnum (marker_position (result)); |
| 1983 | 2752 for (i = 1; i < nargs; i++) |
| 2753 { | |
| 2754 while (!(CHARP (args[i]) || MARKERP (args[i]) || INTEGERP (args[i]))) | |
| 2755 args[i] = wrong_type_argument (Qnumber_char_or_marker_p, args[i]); | |
| 2756 other = args[i]; | |
| 2757 switch (promote_args (&result, &other)) | |
| 2758 { | |
| 2759 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2760 result = make_fixnum (XREALFIXNUM (result) | XREALFIXNUM (other)); |
| 1983 | 2761 break; |
| 2762 case BIGNUM_T: | |
| 2763 bignum_ior (scratch_bignum, XBIGNUM_DATA (result), | |
| 2764 XBIGNUM_DATA (other)); | |
| 2765 result = make_bignum_bg (scratch_bignum); | |
| 2766 break; | |
| 2767 } | |
| 2768 } | |
| 2769 return Fcanonicalize_number (result); | |
| 2770 #else /* !HAVE_BIGNUM */ | |
| 428 | 2771 EMACS_INT bits = 0; |
| 2772 Lisp_Object *args_end = args + nargs; | |
| 2773 | |
| 2774 while (args < args_end) | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
2775 bits |= fixnum_char_or_marker_to_int (*args++); |
| 428 | 2776 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2777 return make_fixnum (bits); |
| 1983 | 2778 #endif /* HAVE_BIGNUM */ |
| 428 | 2779 } |
| 2780 | |
| 2781 DEFUN ("logxor", Flogxor, 0, MANY, 0, /* | |
| 2782 Return bitwise-exclusive-or of all the arguments. | |
| 2783 Arguments may be integers, or markers or characters converted to integers. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2784 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2785 arguments: (&rest ARGS) |
| 428 | 2786 */ |
| 2787 (int nargs, Lisp_Object *args)) | |
| 2788 { | |
| 1983 | 2789 #ifdef HAVE_BIGNUM |
| 2790 REGISTER int i; | |
| 2791 Lisp_Object result, other; | |
| 2792 | |
| 2793 if (nargs == 0) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2794 return make_fixnum (0); |
| 1983 | 2795 |
| 2796 while (!(CHARP (args[0]) || MARKERP (args[0]) || INTEGERP (args[0]))) | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
2797 args[0] = wrong_type_argument (Qinteger_char_or_marker_p, args[0]); |
| 1983 | 2798 |
| 2799 result = args[0]; | |
| 2800 if (CHARP (result)) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2801 result = make_fixnum (XCHAR (result)); |
| 1983 | 2802 else if (MARKERP (result)) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2803 result = make_fixnum (marker_position (result)); |
| 1983 | 2804 for (i = 1; i < nargs; i++) |
| 2805 { | |
| 2806 while (!(CHARP (args[i]) || MARKERP (args[i]) || INTEGERP (args[i]))) | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
2807 args[i] = wrong_type_argument (Qinteger_char_or_marker_p, args[i]); |
| 1983 | 2808 other = args[i]; |
| 2809 if (promote_args (&result, &other) == FIXNUM_T) | |
| 2810 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2811 result = make_fixnum (XREALFIXNUM (result) ^ XREALFIXNUM (other)); |
| 1983 | 2812 } |
| 2813 else | |
| 2814 { | |
| 2815 bignum_xor (scratch_bignum, XBIGNUM_DATA (result), | |
| 2816 XBIGNUM_DATA (other)); | |
| 2817 result = make_bignum_bg (scratch_bignum); | |
| 2818 } | |
| 2819 } | |
| 2820 return Fcanonicalize_number (result); | |
| 2821 #else /* !HAVE_BIGNUM */ | |
| 428 | 2822 EMACS_INT bits = 0; |
| 2823 Lisp_Object *args_end = args + nargs; | |
| 2824 | |
| 2825 while (args < args_end) | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
2826 bits ^= fixnum_char_or_marker_to_int (*args++); |
| 428 | 2827 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2828 return make_fixnum (bits); |
| 1983 | 2829 #endif /* !HAVE_BIGNUM */ |
| 428 | 2830 } |
| 2831 | |
| 2832 DEFUN ("lognot", Flognot, 1, 1, 0, /* | |
| 2833 Return the bitwise complement of NUMBER. | |
| 2834 NUMBER may be an integer, marker or character converted to integer. | |
| 2835 */ | |
| 2836 (number)) | |
| 2837 { | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
2838 while (!(CHARP (number) || MARKERP (number) || INTEGERP (number))) |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
2839 number = wrong_type_argument (Qinteger_char_or_marker_p, number); |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
2840 |
| 1983 | 2841 #ifdef HAVE_BIGNUM |
| 2842 if (BIGNUMP (number)) | |
| 2843 { | |
| 2844 bignum_not (scratch_bignum, XBIGNUM_DATA (number)); | |
| 2845 return make_bignum_bg (scratch_bignum); | |
| 2846 } | |
| 2847 #endif /* HAVE_BIGNUM */ | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
2848 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2849 return make_fixnum (~ fixnum_char_or_marker_to_int (number)); |
| 428 | 2850 } |
| 2851 | |
| 2852 DEFUN ("%", Frem, 2, 2, 0, /* | |
| 2853 Return remainder of first arg divided by second. | |
| 2854 Both must be integers, characters or markers. | |
| 2855 */ | |
| 444 | 2856 (number1, number2)) |
| 428 | 2857 { |
| 1983 | 2858 #ifdef HAVE_BIGNUM |
| 2859 while (!(CHARP (number1) || MARKERP (number1) || INTEGERP (number1))) | |
| 2860 number1 = wrong_type_argument (Qnumber_char_or_marker_p, number1); | |
| 2861 while (!(CHARP (number2) || MARKERP (number2) || INTEGERP (number2))) | |
| 2862 number2 = wrong_type_argument (Qnumber_char_or_marker_p, number2); | |
| 2863 | |
| 2864 if (promote_args (&number1, &number2) == FIXNUM_T) | |
| 2865 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2866 if (XREALFIXNUM (number2) == 0) |
| 1983 | 2867 Fsignal (Qarith_error, Qnil); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2868 return make_fixnum (XREALFIXNUM (number1) % XREALFIXNUM (number2)); |
| 1983 | 2869 } |
| 2870 else | |
| 2871 { | |
| 2872 if (bignum_sign (XBIGNUM_DATA (number2)) == 0) | |
| 2873 Fsignal (Qarith_error, Qnil); | |
| 2874 bignum_mod (scratch_bignum, XBIGNUM_DATA (number1), | |
| 2875 XBIGNUM_DATA (number2)); | |
| 2876 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
| 2877 } | |
| 2878 #else /* !HAVE_BIGNUM */ | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
2879 EMACS_INT ival1 = fixnum_char_or_marker_to_int (number1); |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
2880 EMACS_INT ival2 = fixnum_char_or_marker_to_int (number2); |
| 428 | 2881 |
| 2882 if (ival2 == 0) | |
| 2883 Fsignal (Qarith_error, Qnil); | |
| 2884 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2885 return make_fixnum (ival1 % ival2); |
| 1983 | 2886 #endif /* HAVE_BIGNUM */ |
| 428 | 2887 } |
| 2888 | |
| 2889 /* Note, ANSI *requires* the presence of the fmod() library routine. | |
| 2890 If your system doesn't have it, complain to your vendor, because | |
| 2891 that is a bug. */ | |
| 2892 | |
| 2893 #ifndef HAVE_FMOD | |
| 2894 double | |
| 2895 fmod (double f1, double f2) | |
| 2896 { | |
| 2897 if (f2 < 0.0) | |
| 2898 f2 = -f2; | |
| 2899 return f1 - f2 * floor (f1/f2); | |
| 2900 } | |
| 2901 #endif /* ! HAVE_FMOD */ | |
| 2902 | |
| 2903 | |
| 2904 DEFUN ("mod", Fmod, 2, 2, 0, /* | |
| 2905 Return X modulo Y. | |
| 2906 The result falls between zero (inclusive) and Y (exclusive). | |
| 2907 Both X and Y must be numbers, characters or markers. | |
| 2908 If either argument is a float, a float will be returned. | |
| 2909 */ | |
| 2910 (x, y)) | |
| 2911 { | |
| 1983 | 2912 #ifdef WITH_NUMBER_TYPES |
| 2913 while (!(CHARP (x) || MARKERP (x) || REALP (x))) | |
| 2914 x = wrong_type_argument (Qnumber_char_or_marker_p, x); | |
| 2915 while (!(CHARP (y) || MARKERP (y) || REALP (y))) | |
| 2916 y = wrong_type_argument (Qnumber_char_or_marker_p, y); | |
| 2917 switch (promote_args (&x, &y)) | |
| 2918 { | |
| 2919 case FIXNUM_T: | |
| 2920 { | |
| 2921 EMACS_INT ival; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2922 if (XREALFIXNUM (y) == 0) goto divide_by_zero; |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2923 ival = XREALFIXNUM (x) % XREALFIXNUM (y); |
| 1983 | 2924 /* If the "remainder" comes out with the wrong sign, fix it. */ |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2925 if (XREALFIXNUM (y) < 0 ? ival > 0 : ival < 0) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2926 ival += XREALFIXNUM (y); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2927 return make_fixnum (ival); |
| 1983 | 2928 } |
| 2929 #ifdef HAVE_BIGNUM | |
| 2930 case BIGNUM_T: | |
| 2931 if (bignum_sign (XBIGNUM_DATA (y)) == 0) goto divide_by_zero; | |
| 2932 bignum_mod (scratch_bignum, XBIGNUM_DATA (x), XBIGNUM_DATA (y)); | |
| 2933 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
| 2934 #endif | |
| 2935 #ifdef HAVE_RATIO | |
| 2936 case RATIO_T: | |
| 2937 if (ratio_sign (XRATIO_DATA (y)) == 0) goto divide_by_zero; | |
| 2938 ratio_div (scratch_ratio, XRATIO_DATA (x), XRATIO_DATA (y)); | |
| 2939 bignum_div (scratch_bignum, ratio_numerator (scratch_ratio), | |
| 2940 ratio_denominator (scratch_ratio)); | |
| 2941 ratio_set_bignum (scratch_ratio, scratch_bignum); | |
| 2942 ratio_mul (scratch_ratio, scratch_ratio, XRATIO_DATA (y)); | |
| 2943 ratio_sub (scratch_ratio, XRATIO_DATA (x), scratch_ratio); | |
| 2944 return Fcanonicalize_number (make_ratio_rt (scratch_ratio)); | |
| 2945 #endif | |
| 2946 case FLOAT_T: | |
| 2947 { | |
| 2948 double dval; | |
| 2949 if (XFLOAT_DATA (y) == 0.0) goto divide_by_zero; | |
| 2950 dval = fmod (XFLOAT_DATA (x), XFLOAT_DATA (y)); | |
| 2951 /* If the "remainder" comes out with the wrong sign, fix it. */ | |
| 2952 if (XFLOAT_DATA (y) < 0 ? dval > 0 : dval < 0) | |
| 2953 dval += XFLOAT_DATA (y); | |
| 2954 return make_float (dval); | |
| 2955 } | |
| 2956 #ifdef HAVE_BIGFLOAT | |
| 2957 case BIGFLOAT_T: | |
| 2958 bigfloat_set_prec (scratch_bigfloat, | |
| 2959 max (XBIGFLOAT_GET_PREC (x), XBIGFLOAT_GET_PREC (y))); | |
| 2960 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (x), XBIGFLOAT_DATA (y)); | |
| 2961 bigfloat_trunc (scratch_bigfloat, scratch_bigfloat); | |
| 2962 bigfloat_mul (scratch_bigfloat, scratch_bigfloat, XBIGFLOAT_DATA (y)); | |
| 2963 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (x), scratch_bigfloat); | |
| 2964 return make_bigfloat_bf (scratch_bigfloat); | |
| 2965 #endif | |
| 2966 } | |
| 2967 #else /* !WITH_NUMBER_TYPES */ | |
| 428 | 2968 int_or_double iod1, iod2; |
| 2969 number_char_or_marker_to_int_or_double (x, &iod1); | |
| 2970 number_char_or_marker_to_int_or_double (y, &iod2); | |
| 2971 | |
| 2972 if (!iod1.int_p || !iod2.int_p) | |
| 2973 { | |
| 2974 double dval1 = iod1.int_p ? (double) iod1.c.ival : iod1.c.dval; | |
| 2975 double dval2 = iod2.int_p ? (double) iod2.c.ival : iod2.c.dval; | |
| 2976 if (dval2 == 0) goto divide_by_zero; | |
| 2977 dval1 = fmod (dval1, dval2); | |
| 2978 | |
| 2979 /* If the "remainder" comes out with the wrong sign, fix it. */ | |
| 2980 if (dval2 < 0 ? dval1 > 0 : dval1 < 0) | |
| 2981 dval1 += dval2; | |
| 2982 | |
| 2983 return make_float (dval1); | |
| 2984 } | |
| 1104 | 2985 |
| 428 | 2986 { |
| 2987 EMACS_INT ival; | |
| 2988 if (iod2.c.ival == 0) goto divide_by_zero; | |
| 2989 | |
| 2990 ival = iod1.c.ival % iod2.c.ival; | |
| 2991 | |
| 2992 /* If the "remainder" comes out with the wrong sign, fix it. */ | |
| 2993 if (iod2.c.ival < 0 ? ival > 0 : ival < 0) | |
| 2994 ival += iod2.c.ival; | |
| 2995 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2996 return make_fixnum (ival); |
| 428 | 2997 } |
| 1983 | 2998 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 2999 |
| 3000 divide_by_zero: | |
| 3001 Fsignal (Qarith_error, Qnil); | |
| 801 | 3002 return Qnil; /* not (usually) reached */ |
| 428 | 3003 } |
| 3004 | |
| 3005 DEFUN ("ash", Fash, 2, 2, 0, /* | |
| 3006 Return VALUE with its bits shifted left by COUNT. | |
| 3007 If COUNT is negative, shifting is actually to the right. | |
| 3008 In this case, the sign bit is duplicated. | |
| 1983 | 3009 This function cannot be applied to bignums, as there is no leftmost sign bit |
| 3010 to be duplicated. Use `lsh' instead. | |
| 428 | 3011 */ |
| 3012 (value, count)) | |
| 3013 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3014 CHECK_FIXNUM_COERCE_CHAR (value); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3015 CONCHECK_FIXNUM (count); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3016 |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3017 return make_fixnum (XFIXNUM (count) > 0 ? |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3018 XFIXNUM (value) << XFIXNUM (count) : |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3019 XFIXNUM (value) >> -XFIXNUM (count)); |
| 428 | 3020 } |
| 3021 | |
| 3022 DEFUN ("lsh", Flsh, 2, 2, 0, /* | |
| 3023 Return VALUE with its bits shifted left by COUNT. | |
| 3024 If COUNT is negative, shifting is actually to the right. | |
| 3025 In this case, zeros are shifted in on the left. | |
| 3026 */ | |
| 3027 (value, count)) | |
| 3028 { | |
| 1983 | 3029 #ifdef HAVE_BIGNUM |
| 3030 while (!(CHARP (value) || MARKERP (value) || INTEGERP (value))) | |
| 3031 wrong_type_argument (Qnumber_char_or_marker_p, value); | |
| 3032 CONCHECK_INTEGER (count); | |
| 3033 | |
| 3034 if (promote_args (&value, &count) == FIXNUM_T) | |
| 3035 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3036 if (XREALFIXNUM (count) <= 0) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3037 return make_fixnum (XREALFIXNUM (value) >> -XREALFIXNUM (count)); |
| 1983 | 3038 /* Use bignums to avoid overflow */ |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3039 bignum_set_long (scratch_bignum2, XREALFIXNUM (value)); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3040 bignum_lshift (scratch_bignum, scratch_bignum2, XREALFIXNUM (count)); |
| 1983 | 3041 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
| 3042 } | |
| 3043 else | |
| 3044 { | |
| 3045 if (bignum_sign (XBIGNUM_DATA (count)) <= 0) | |
| 3046 { | |
| 3047 bignum_neg (scratch_bignum, XBIGNUM_DATA (count)); | |
| 3048 if (!bignum_fits_ulong_p (scratch_bignum)) | |
| 3049 args_out_of_range (Qnumber_char_or_marker_p, count); | |
| 3050 bignum_rshift (scratch_bignum2, XBIGNUM_DATA (value), | |
| 3051 bignum_to_ulong (scratch_bignum)); | |
| 3052 } | |
| 3053 else | |
| 3054 { | |
| 3055 if (!bignum_fits_ulong_p (XBIGNUM_DATA (count))) | |
| 3056 args_out_of_range (Qnumber_char_or_marker_p, count); | |
| 3057 bignum_lshift (scratch_bignum2, XBIGNUM_DATA (value), | |
| 3058 bignum_to_ulong (XBIGNUM_DATA (count))); | |
| 3059 } | |
| 3060 return Fcanonicalize_number (make_bignum_bg (scratch_bignum2)); | |
| 3061 } | |
| 3062 #else /* !HAVE_BIGNUM */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3063 CHECK_FIXNUM_COERCE_CHAR (value); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3064 CONCHECK_FIXNUM (count); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3065 |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3066 return make_fixnum (XFIXNUM (count) > 0 ? |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3067 XUINT (value) << XFIXNUM (count) : |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3068 XUINT (value) >> -XFIXNUM (count)); |
| 1983 | 3069 #endif /* HAVE_BIGNUM */ |
| 428 | 3070 } |
| 3071 | |
| 3072 DEFUN ("1+", Fadd1, 1, 1, 0, /* | |
| 3073 Return NUMBER plus one. NUMBER may be a number, character or marker. | |
| 3074 Markers and characters are converted to integers. | |
| 3075 */ | |
| 3076 (number)) | |
| 3077 { | |
| 3078 retry: | |
| 3079 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3080 if (FIXNUMP (number)) return make_integer (XFIXNUM (number) + 1); |
|
5762
427a72c6ee17
Eliminate several compiler (clang) warnings.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5752
diff
changeset
|
3081 if (CHARP (number)) return make_integer ((EMACS_INT) XCHAR (number) + 1); |
| 1983 | 3082 if (MARKERP (number)) return make_integer (marker_position (number) + 1); |
| 428 | 3083 if (FLOATP (number)) return make_float (XFLOAT_DATA (number) + 1.0); |
| 1983 | 3084 #ifdef HAVE_BIGNUM |
| 3085 if (BIGNUMP (number)) | |
| 3086 { | |
| 3087 bignum_set_long (scratch_bignum, 1L); | |
| 3088 bignum_add (scratch_bignum2, XBIGNUM_DATA (number), scratch_bignum); | |
| 3089 return Fcanonicalize_number (make_bignum_bg (scratch_bignum2)); | |
| 3090 } | |
| 3091 #endif | |
| 3092 #ifdef HAVE_RATIO | |
| 3093 if (RATIOP (number)) | |
| 3094 { | |
| 3095 ratio_set_long (scratch_ratio, 1L); | |
| 3096 ratio_add (scratch_ratio, XRATIO_DATA (number), scratch_ratio); | |
| 3097 /* No need to canonicalize after adding 1 */ | |
| 3098 return make_ratio_rt (scratch_ratio); | |
| 3099 } | |
| 3100 #endif | |
| 3101 #ifdef HAVE_BIGFLOAT | |
| 3102 if (BIGFLOATP (number)) | |
| 3103 { | |
| 3104 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); | |
| 3105 bigfloat_set_long (scratch_bigfloat, 1L); | |
| 3106 bigfloat_add (scratch_bigfloat, XBIGFLOAT_DATA (number), | |
| 3107 scratch_bigfloat); | |
| 3108 return make_bigfloat_bf (scratch_bigfloat); | |
| 3109 } | |
| 3110 #endif | |
| 428 | 3111 |
| 3112 number = wrong_type_argument (Qnumber_char_or_marker_p, number); | |
| 3113 goto retry; | |
| 3114 } | |
| 3115 | |
| 3116 DEFUN ("1-", Fsub1, 1, 1, 0, /* | |
| 3117 Return NUMBER minus one. NUMBER may be a number, character or marker. | |
| 3118 Markers and characters are converted to integers. | |
| 3119 */ | |
| 3120 (number)) | |
| 3121 { | |
| 3122 retry: | |
| 3123 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3124 if (FIXNUMP (number)) return make_integer (XFIXNUM (number) - 1); |
|
5762
427a72c6ee17
Eliminate several compiler (clang) warnings.
Stephen J. Turnbull <stephen@xemacs.org>
parents:
5752
diff
changeset
|
3125 if (CHARP (number)) return make_integer ((EMACS_INT) XCHAR (number) - 1); |
| 1983 | 3126 if (MARKERP (number)) return make_integer (marker_position (number) - 1); |
| 428 | 3127 if (FLOATP (number)) return make_float (XFLOAT_DATA (number) - 1.0); |
| 1983 | 3128 #ifdef HAVE_BIGNUM |
| 3129 if (BIGNUMP (number)) | |
| 3130 { | |
| 3131 bignum_set_long (scratch_bignum, 1L); | |
| 3132 bignum_sub (scratch_bignum2, XBIGNUM_DATA (number), scratch_bignum); | |
| 3133 return Fcanonicalize_number (make_bignum_bg (scratch_bignum2)); | |
| 3134 } | |
| 3135 #endif | |
| 3136 #ifdef HAVE_RATIO | |
| 3137 if (RATIOP (number)) | |
| 3138 { | |
| 3139 ratio_set_long (scratch_ratio, 1L); | |
| 3140 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio); | |
| 3141 /* No need to canonicalize after subtracting 1 */ | |
| 3142 return make_ratio_rt (scratch_ratio); | |
| 3143 } | |
| 3144 #endif | |
| 3145 #ifdef HAVE_BIGFLOAT | |
| 3146 if (BIGFLOATP (number)) | |
| 3147 { | |
| 3148 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); | |
| 3149 bigfloat_set_long (scratch_bigfloat, 1L); | |
| 3150 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), | |
| 3151 scratch_bigfloat); | |
| 3152 return make_bigfloat_bf (scratch_bigfloat); | |
| 3153 } | |
| 3154 #endif | |
| 428 | 3155 |
| 3156 number = wrong_type_argument (Qnumber_char_or_marker_p, number); | |
| 3157 goto retry; | |
| 3158 } | |
| 3159 | |
| 3160 | |
| 3161 /************************************************************************/ | |
| 3162 /* weak lists */ | |
| 3163 /************************************************************************/ | |
| 3164 | |
| 3165 /* A weak list is like a normal list except that elements automatically | |
| 3166 disappear when no longer in use, i.e. when no longer GC-protected. | |
| 3167 The basic idea is that we don't mark the elements during GC, but | |
| 3168 wait for them to be marked elsewhere. If they're not marked, we | |
| 3169 remove them. This is analogous to weak hash tables; see the explanation | |
| 3170 there for more info. */ | |
| 3171 | |
| 3172 static Lisp_Object Vall_weak_lists; /* Gemarke es nicht!!! */ | |
| 3173 | |
| 3174 static Lisp_Object encode_weak_list_type (enum weak_list_type type); | |
| 3175 | |
| 3176 static Lisp_Object | |
| 2286 | 3177 mark_weak_list (Lisp_Object UNUSED (obj)) |
| 428 | 3178 { |
| 3179 return Qnil; /* nichts ist gemarkt */ | |
| 3180 } | |
| 3181 | |
| 3182 static void | |
| 2286 | 3183 print_weak_list (Lisp_Object obj, Lisp_Object printcharfun, |
|
5325
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3184 int escapeflag) |
| 428 | 3185 { |
| 3186 if (print_readably) | |
|
5325
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3187 { |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3188 printing_unreadable_lisp_object (obj, 0); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3189 } |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3190 |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3191 write_ascstring (printcharfun, "#<weak-list :type "); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3192 print_internal (encode_weak_list_type (XWEAK_LIST (obj)->type), |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3193 printcharfun, escapeflag); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3194 write_ascstring (printcharfun, " :list "); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3195 print_internal (XWEAK_LIST (obj)->list, printcharfun, escapeflag); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3196 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); |
| 428 | 3197 } |
| 3198 | |
| 3199 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4885
diff
changeset
|
3200 weak_list_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) |
| 428 | 3201 { |
| 3202 struct weak_list *w1 = XWEAK_LIST (obj1); | |
| 3203 struct weak_list *w2 = XWEAK_LIST (obj2); | |
| 3204 | |
| 3205 return ((w1->type == w2->type) && | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4885
diff
changeset
|
3206 internal_equal_0 (w1->list, w2->list, depth + 1, foldcase)); |
| 428 | 3207 } |
| 3208 | |
| 665 | 3209 static Hashcode |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
3210 weak_list_hash (Lisp_Object obj, int depth, Boolint equalp) |
| 428 | 3211 { |
| 3212 struct weak_list *w = XWEAK_LIST (obj); | |
| 3213 | |
| 665 | 3214 return HASH2 ((Hashcode) w->type, |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
3215 internal_hash (w->list, depth + 1, equalp)); |
| 428 | 3216 } |
| 3217 | |
| 3218 Lisp_Object | |
| 3219 make_weak_list (enum weak_list_type type) | |
| 3220 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
3221 Lisp_Object result = ALLOC_NORMAL_LISP_OBJECT (weak_list); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
3222 struct weak_list *wl = XWEAK_LIST (result); |
| 428 | 3223 |
| 3224 wl->list = Qnil; | |
| 3225 wl->type = type; | |
| 3226 wl->next_weak = Vall_weak_lists; | |
| 3227 Vall_weak_lists = result; | |
| 3228 return result; | |
| 3229 } | |
| 3230 | |
| 1204 | 3231 static const struct memory_description weak_list_description[] = { |
| 1598 | 3232 { XD_LISP_OBJECT, offsetof (struct weak_list, list), |
| 2551 | 3233 0, { 0 }, XD_FLAG_NO_KKCC }, |
| 1598 | 3234 { XD_LO_LINK, offsetof (struct weak_list, next_weak), |
| 2551 | 3235 0, { 0 }, XD_FLAG_NO_KKCC }, |
| 428 | 3236 { XD_END } |
| 3237 }; | |
| 3238 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
3239 DEFINE_DUMPABLE_LISP_OBJECT ("weak-list", weak_list, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
3240 mark_weak_list, print_weak_list, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
3241 0, weak_list_equal, weak_list_hash, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
3242 weak_list_description, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
3243 struct weak_list); |
| 428 | 3244 /* |
| 3245 -- we do not mark the list elements (either the elements themselves | |
| 3246 or the cons cells that hold them) in the normal marking phase. | |
| 3247 -- at the end of marking, we go through all weak lists that are | |
| 3248 marked, and mark the cons cells that hold all marked | |
| 3249 objects, and possibly parts of the objects themselves. | |
| 3250 (See alloc.c, "after-mark".) | |
| 3251 -- after that, we prune away all the cons cells that are not marked. | |
| 3252 | |
| 3253 WARNING WARNING WARNING WARNING WARNING: | |
| 3254 | |
| 3255 The code in the following two functions is *unbelievably* tricky. | |
| 3256 Don't mess with it. You'll be sorry. | |
| 3257 | |
| 3258 Linked lists just majorly suck, d'ya know? | |
| 3259 */ | |
| 3260 | |
| 3261 int | |
| 3262 finish_marking_weak_lists (void) | |
| 3263 { | |
| 3264 Lisp_Object rest; | |
| 3265 int did_mark = 0; | |
| 3266 | |
| 3267 for (rest = Vall_weak_lists; | |
| 3268 !NILP (rest); | |
| 3269 rest = XWEAK_LIST (rest)->next_weak) | |
| 3270 { | |
| 3271 Lisp_Object rest2; | |
| 3272 enum weak_list_type type = XWEAK_LIST (rest)->type; | |
| 3273 | |
| 3274 if (! marked_p (rest)) | |
| 3275 /* The weak list is probably garbage. Ignore it. */ | |
| 3276 continue; | |
| 3277 | |
| 3278 for (rest2 = XWEAK_LIST (rest)->list; | |
| 3279 /* We need to be trickier since we're inside of GC; | |
| 3280 use CONSP instead of !NILP in case of user-visible | |
| 3281 imperfect lists */ | |
| 3282 CONSP (rest2); | |
| 3283 rest2 = XCDR (rest2)) | |
| 3284 { | |
| 3285 Lisp_Object elem; | |
| 3286 /* If the element is "marked" (meaning depends on the type | |
| 3287 of weak list), we need to mark the cons containing the | |
| 3288 element, and maybe the element itself (if only some part | |
| 3289 was already marked). */ | |
| 3290 int need_to_mark_cons = 0; | |
| 3291 int need_to_mark_elem = 0; | |
| 3292 | |
| 3293 /* If a cons is already marked, then its car is already marked | |
| 3294 (either because of an external pointer or because of | |
| 3295 a previous call to this function), and likewise for all | |
| 3296 the rest of the elements in the list, so we can stop now. */ | |
| 3297 if (marked_p (rest2)) | |
| 3298 break; | |
| 3299 | |
| 3300 elem = XCAR (rest2); | |
| 3301 | |
| 3302 switch (type) | |
| 3303 { | |
| 3304 case WEAK_LIST_SIMPLE: | |
| 3305 if (marked_p (elem)) | |
| 3306 need_to_mark_cons = 1; | |
| 3307 break; | |
| 3308 | |
| 3309 case WEAK_LIST_ASSOC: | |
| 3310 if (!CONSP (elem)) | |
| 3311 { | |
| 3312 /* just leave bogus elements there */ | |
| 3313 need_to_mark_cons = 1; | |
| 3314 need_to_mark_elem = 1; | |
| 3315 } | |
| 3316 else if (marked_p (XCAR (elem)) && | |
| 3317 marked_p (XCDR (elem))) | |
| 3318 { | |
| 3319 need_to_mark_cons = 1; | |
| 3320 /* We still need to mark elem, because it's | |
| 3321 probably not marked. */ | |
| 3322 need_to_mark_elem = 1; | |
| 3323 } | |
| 3324 break; | |
| 3325 | |
| 3326 case WEAK_LIST_KEY_ASSOC: | |
| 3327 if (!CONSP (elem)) | |
| 3328 { | |
| 3329 /* just leave bogus elements there */ | |
| 3330 need_to_mark_cons = 1; | |
| 3331 need_to_mark_elem = 1; | |
| 3332 } | |
| 3333 else if (marked_p (XCAR (elem))) | |
| 3334 { | |
| 3335 need_to_mark_cons = 1; | |
| 3336 /* We still need to mark elem and XCDR (elem); | |
| 3337 marking elem does both */ | |
| 3338 need_to_mark_elem = 1; | |
| 3339 } | |
| 3340 break; | |
| 3341 | |
| 3342 case WEAK_LIST_VALUE_ASSOC: | |
| 3343 if (!CONSP (elem)) | |
| 3344 { | |
| 3345 /* just leave bogus elements there */ | |
| 3346 need_to_mark_cons = 1; | |
| 3347 need_to_mark_elem = 1; | |
| 3348 } | |
| 3349 else if (marked_p (XCDR (elem))) | |
| 3350 { | |
| 3351 need_to_mark_cons = 1; | |
| 3352 /* We still need to mark elem and XCAR (elem); | |
| 3353 marking elem does both */ | |
| 3354 need_to_mark_elem = 1; | |
| 3355 } | |
| 3356 break; | |
| 3357 | |
| 442 | 3358 case WEAK_LIST_FULL_ASSOC: |
| 3359 if (!CONSP (elem)) | |
| 3360 { | |
| 3361 /* just leave bogus elements there */ | |
| 3362 need_to_mark_cons = 1; | |
| 3363 need_to_mark_elem = 1; | |
| 3364 } | |
| 3365 else if (marked_p (XCAR (elem)) || | |
| 3366 marked_p (XCDR (elem))) | |
| 3367 { | |
| 3368 need_to_mark_cons = 1; | |
| 3369 /* We still need to mark elem and XCAR (elem); | |
| 3370 marking elem does both */ | |
| 3371 need_to_mark_elem = 1; | |
| 3372 } | |
| 3373 break; | |
| 3374 | |
| 428 | 3375 default: |
| 2500 | 3376 ABORT (); |
| 428 | 3377 } |
| 3378 | |
| 3379 if (need_to_mark_elem && ! marked_p (elem)) | |
| 3380 { | |
| 1598 | 3381 #ifdef USE_KKCC |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
3382 kkcc_gc_stack_push_lisp_object_0 (elem); |
| 1598 | 3383 #else /* NOT USE_KKCC */ |
| 428 | 3384 mark_object (elem); |
| 1598 | 3385 #endif /* NOT USE_KKCC */ |
| 428 | 3386 did_mark = 1; |
| 3387 } | |
| 3388 | |
| 3389 /* We also need to mark the cons that holds the elem or | |
| 3390 assoc-pair. We do *not* want to call (mark_object) here | |
| 3391 because that will mark the entire list; we just want to | |
| 3392 mark the cons itself. | |
| 3393 */ | |
| 3394 if (need_to_mark_cons) | |
| 3395 { | |
| 3396 Lisp_Cons *c = XCONS (rest2); | |
| 3397 if (!CONS_MARKED_P (c)) | |
| 3398 { | |
| 3399 MARK_CONS (c); | |
| 3400 did_mark = 1; | |
| 3401 } | |
| 3402 } | |
| 3403 } | |
| 3404 | |
| 3405 /* In case of imperfect list, need to mark the final cons | |
| 3406 because we're not removing it */ | |
| 3407 if (!NILP (rest2) && ! marked_p (rest2)) | |
| 3408 { | |
| 1598 | 3409 #ifdef USE_KKCC |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
3410 kkcc_gc_stack_push_lisp_object_0 (rest2); |
| 1598 | 3411 #else /* NOT USE_KKCC */ |
| 428 | 3412 mark_object (rest2); |
| 1598 | 3413 #endif /* NOT USE_KKCC */ |
| 428 | 3414 did_mark = 1; |
| 3415 } | |
| 3416 } | |
| 3417 | |
| 3418 return did_mark; | |
| 3419 } | |
| 3420 | |
| 3421 void | |
| 3422 prune_weak_lists (void) | |
| 3423 { | |
| 3424 Lisp_Object rest, prev = Qnil; | |
| 3425 | |
| 3426 for (rest = Vall_weak_lists; | |
| 3427 !NILP (rest); | |
| 3428 rest = XWEAK_LIST (rest)->next_weak) | |
| 3429 { | |
| 3430 if (! (marked_p (rest))) | |
| 3431 { | |
| 3432 /* This weak list itself is garbage. Remove it from the list. */ | |
| 3433 if (NILP (prev)) | |
| 3434 Vall_weak_lists = XWEAK_LIST (rest)->next_weak; | |
| 3435 else | |
| 3436 XWEAK_LIST (prev)->next_weak = | |
| 3437 XWEAK_LIST (rest)->next_weak; | |
| 3438 } | |
| 3439 else | |
| 3440 { | |
| 3441 Lisp_Object rest2, prev2 = Qnil; | |
| 3442 Lisp_Object tortoise; | |
| 3443 int go_tortoise = 0; | |
| 3444 | |
| 3445 for (rest2 = XWEAK_LIST (rest)->list, tortoise = rest2; | |
| 3446 /* We need to be trickier since we're inside of GC; | |
| 3447 use CONSP instead of !NILP in case of user-visible | |
| 3448 imperfect lists */ | |
| 3449 CONSP (rest2);) | |
| 3450 { | |
| 3451 /* It suffices to check the cons for marking, | |
| 3452 regardless of the type of weak list: | |
| 3453 | |
| 3454 -- if the cons is pointed to somewhere else, | |
| 3455 then it should stay around and will be marked. | |
| 3456 -- otherwise, if it should stay around, it will | |
| 3457 have been marked in finish_marking_weak_lists(). | |
| 3458 -- otherwise, it's not marked and should disappear. | |
| 3459 */ | |
| 3460 if (! marked_p (rest2)) | |
| 3461 { | |
| 3462 /* bye bye :-( */ | |
| 3463 if (NILP (prev2)) | |
| 3464 XWEAK_LIST (rest)->list = XCDR (rest2); | |
| 3465 else | |
| 3466 XCDR (prev2) = XCDR (rest2); | |
| 3467 rest2 = XCDR (rest2); | |
| 3468 /* Ouch. Circularity checking is even trickier | |
| 3469 than I thought. When we cut out a link | |
| 3470 like this, we can't advance the turtle or | |
| 3471 it'll catch up to us. Imagine that we're | |
| 3472 standing on floor tiles and moving forward -- | |
| 3473 what we just did here is as if the floor | |
| 3474 tile under us just disappeared and all the | |
| 3475 ones ahead of us slid one tile towards us. | |
| 3476 In other words, we didn't move at all; | |
| 3477 if the tortoise was one step behind us | |
| 3478 previously, it still is, and therefore | |
| 3479 it must not move. */ | |
| 3480 } | |
| 3481 else | |
| 3482 { | |
| 3483 prev2 = rest2; | |
| 3484 | |
| 3485 /* Implementing circularity checking is trickier here | |
| 3486 than in other places because we have to guarantee | |
| 3487 that we've processed all elements before exiting | |
| 3488 due to a circularity. (In most places, an error | |
| 3489 is issued upon encountering a circularity, so it | |
| 3490 doesn't really matter if all elements are processed.) | |
| 3491 The idea is that we process along with the hare | |
| 3492 rather than the tortoise. If at any point in | |
| 3493 our forward process we encounter the tortoise, | |
| 3494 we must have already visited the spot, so we exit. | |
| 3495 (If we process with the tortoise, we can fail to | |
| 3496 process cases where a cons points to itself, or | |
| 3497 where cons A points to cons B, which points to | |
| 3498 cons A.) */ | |
| 3499 | |
| 3500 rest2 = XCDR (rest2); | |
| 3501 if (go_tortoise) | |
| 3502 tortoise = XCDR (tortoise); | |
| 3503 go_tortoise = !go_tortoise; | |
| 3504 if (EQ (rest2, tortoise)) | |
| 3505 break; | |
| 3506 } | |
| 3507 } | |
| 3508 | |
| 3509 prev = rest; | |
| 3510 } | |
| 3511 } | |
| 3512 } | |
| 3513 | |
| 3514 static enum weak_list_type | |
| 3515 decode_weak_list_type (Lisp_Object symbol) | |
| 3516 { | |
| 3517 CHECK_SYMBOL (symbol); | |
| 3518 if (EQ (symbol, Qsimple)) return WEAK_LIST_SIMPLE; | |
| 3519 if (EQ (symbol, Qassoc)) return WEAK_LIST_ASSOC; | |
| 3520 if (EQ (symbol, Qold_assoc)) return WEAK_LIST_ASSOC; /* EBOLA ALERT! */ | |
| 3521 if (EQ (symbol, Qkey_assoc)) return WEAK_LIST_KEY_ASSOC; | |
| 3522 if (EQ (symbol, Qvalue_assoc)) return WEAK_LIST_VALUE_ASSOC; | |
| 442 | 3523 if (EQ (symbol, Qfull_assoc)) return WEAK_LIST_FULL_ASSOC; |
| 428 | 3524 |
| 563 | 3525 invalid_constant ("Invalid weak list type", symbol); |
| 1204 | 3526 RETURN_NOT_REACHED (WEAK_LIST_SIMPLE); |
| 428 | 3527 } |
| 3528 | |
| 3529 static Lisp_Object | |
| 3530 encode_weak_list_type (enum weak_list_type type) | |
| 3531 { | |
| 3532 switch (type) | |
| 3533 { | |
| 3534 case WEAK_LIST_SIMPLE: return Qsimple; | |
| 3535 case WEAK_LIST_ASSOC: return Qassoc; | |
| 3536 case WEAK_LIST_KEY_ASSOC: return Qkey_assoc; | |
| 3537 case WEAK_LIST_VALUE_ASSOC: return Qvalue_assoc; | |
| 442 | 3538 case WEAK_LIST_FULL_ASSOC: return Qfull_assoc; |
| 428 | 3539 default: |
| 2500 | 3540 ABORT (); |
| 428 | 3541 } |
| 3542 | |
| 801 | 3543 return Qnil; /* not (usually) reached */ |
| 428 | 3544 } |
| 3545 | |
| 3546 DEFUN ("weak-list-p", Fweak_list_p, 1, 1, 0, /* | |
| 3547 Return non-nil if OBJECT is a weak list. | |
| 3548 */ | |
| 3549 (object)) | |
| 3550 { | |
| 3551 return WEAK_LISTP (object) ? Qt : Qnil; | |
| 3552 } | |
| 3553 | |
| 3554 DEFUN ("make-weak-list", Fmake_weak_list, 0, 1, 0, /* | |
| 3555 Return a new weak list object of type TYPE. | |
| 3556 A weak list object is an object that contains a list. This list behaves | |
| 3557 like any other list except that its elements do not count towards | |
| 456 | 3558 garbage collection -- if the only pointer to an object is inside a weak |
| 428 | 3559 list (other than pointers in similar objects such as weak hash tables), |
| 3560 the object is garbage collected and automatically removed from the list. | |
| 3561 This is used internally, for example, to manage the list holding the | |
| 3562 children of an extent -- an extent that is unused but has a parent will | |
| 3563 still be reclaimed, and will automatically be removed from its parent's | |
| 3564 list of children. | |
| 3565 | |
| 3566 Optional argument TYPE specifies the type of the weak list, and defaults | |
| 3567 to `simple'. Recognized types are | |
| 3568 | |
| 3569 `simple' Objects in the list disappear if not pointed to. | |
| 3570 `assoc' Objects in the list disappear if they are conses | |
| 3571 and either the car or the cdr of the cons is not | |
| 3572 pointed to. | |
| 3573 `key-assoc' Objects in the list disappear if they are conses | |
| 3574 and the car is not pointed to. | |
| 3575 `value-assoc' Objects in the list disappear if they are conses | |
| 3576 and the cdr is not pointed to. | |
| 442 | 3577 `full-assoc' Objects in the list disappear if they are conses |
| 3578 and neither the car nor the cdr is pointed to. | |
| 428 | 3579 */ |
| 3580 (type)) | |
| 3581 { | |
| 3582 if (NILP (type)) | |
| 3583 type = Qsimple; | |
| 3584 | |
| 3585 return make_weak_list (decode_weak_list_type (type)); | |
| 3586 } | |
| 3587 | |
| 3588 DEFUN ("weak-list-type", Fweak_list_type, 1, 1, 0, /* | |
| 3589 Return the type of the given weak-list object. | |
| 3590 */ | |
| 3591 (weak)) | |
| 3592 { | |
| 3593 CHECK_WEAK_LIST (weak); | |
| 3594 return encode_weak_list_type (XWEAK_LIST (weak)->type); | |
| 3595 } | |
| 3596 | |
| 3597 DEFUN ("weak-list-list", Fweak_list_list, 1, 1, 0, /* | |
| 3598 Return the list contained in a weak-list object. | |
| 3599 */ | |
| 3600 (weak)) | |
| 3601 { | |
| 3602 CHECK_WEAK_LIST (weak); | |
| 3603 return XWEAK_LIST_LIST (weak); | |
| 3604 } | |
| 3605 | |
| 3606 DEFUN ("set-weak-list-list", Fset_weak_list_list, 2, 2, 0, /* | |
| 3607 Change the list contained in a weak-list object. | |
| 3608 */ | |
| 3609 (weak, new_list)) | |
| 3610 { | |
| 3611 CHECK_WEAK_LIST (weak); | |
| 3612 XWEAK_LIST_LIST (weak) = new_list; | |
| 3613 return new_list; | |
| 3614 } | |
| 3615 | |
| 888 | 3616 |
| 858 | 3617 /************************************************************************/ |
| 3618 /* weak boxes */ | |
| 3619 /************************************************************************/ | |
| 3620 | |
| 3621 static Lisp_Object Vall_weak_boxes; /* Gemarke es niemals ever!!! */ | |
| 3622 | |
| 3623 void | |
| 3624 prune_weak_boxes (void) | |
| 3625 { | |
| 3626 Lisp_Object rest, prev = Qnil; | |
| 888 | 3627 int removep = 0; |
| 858 | 3628 |
| 3629 for (rest = Vall_weak_boxes; | |
| 3630 !NILP(rest); | |
| 3631 rest = XWEAK_BOX (rest)->next_weak_box) | |
| 3632 { | |
| 3633 if (! (marked_p (rest))) | |
| 888 | 3634 /* This weak box itself is garbage. */ |
| 3635 removep = 1; | |
| 3636 | |
| 3637 if (! marked_p (XWEAK_BOX (rest)->value)) | |
| 3638 { | |
| 3639 XSET_WEAK_BOX (rest, Qnil); | |
| 3640 removep = 1; | |
| 3641 } | |
| 3642 | |
| 3643 if (removep) | |
| 3644 { | |
| 3645 /* Remove weak box from list. */ | |
| 3646 if (NILP (prev)) | |
| 3647 Vall_weak_boxes = XWEAK_BOX (rest)->next_weak_box; | |
| 3648 else | |
| 3649 XWEAK_BOX (prev)->next_weak_box = XWEAK_BOX (rest)->next_weak_box; | |
| 3650 removep = 0; | |
| 3651 } | |
| 3652 else | |
| 3653 prev = rest; | |
| 858 | 3654 } |
| 3655 } | |
| 3656 | |
| 3657 static Lisp_Object | |
| 2286 | 3658 mark_weak_box (Lisp_Object UNUSED (obj)) |
| 858 | 3659 { |
| 3660 return Qnil; | |
| 3661 } | |
| 3662 | |
| 3663 static void | |
|
5325
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3664 print_weak_box (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
| 858 | 3665 { |
| 3666 if (print_readably) | |
|
5325
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3667 { |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3668 printing_unreadable_lisp_object (obj, 0); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3669 } |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3670 |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3671 write_ascstring (printcharfun, "#<weak-box "); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3672 print_internal (XWEAK_BOX (obj)->value, printcharfun, escapeflag); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3673 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); |
| 858 | 3674 } |
| 3675 | |
| 3676 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4885
diff
changeset
|
3677 weak_box_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) |
| 858 | 3678 { |
| 888 | 3679 struct weak_box *wb1 = XWEAK_BOX (obj1); |
| 3680 struct weak_box *wb2 = XWEAK_BOX (obj2); | |
| 858 | 3681 |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4885
diff
changeset
|
3682 return (internal_equal_0 (wb1->value, wb2->value, depth + 1, foldcase)); |
| 858 | 3683 } |
| 3684 | |
| 3685 static Hashcode | |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
3686 weak_box_hash (Lisp_Object obj, int depth, Boolint equalp) |
| 858 | 3687 { |
| 888 | 3688 struct weak_box *wb = XWEAK_BOX (obj); |
| 858 | 3689 |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
3690 return internal_hash (wb->value, depth + 1, equalp); |
| 858 | 3691 } |
| 3692 | |
| 3693 Lisp_Object | |
| 3694 make_weak_box (Lisp_Object value) | |
| 3695 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
3696 Lisp_Object result = ALLOC_NORMAL_LISP_OBJECT (weak_box); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
3697 struct weak_box *wb = XWEAK_BOX (result); |
| 858 | 3698 |
| 3699 wb->value = value; | |
| 3700 result = wrap_weak_box (wb); | |
| 3701 wb->next_weak_box = Vall_weak_boxes; | |
| 3702 Vall_weak_boxes = result; | |
| 3703 return result; | |
| 3704 } | |
| 3705 | |
| 1204 | 3706 static const struct memory_description weak_box_description[] = { |
| 858 | 3707 { XD_LO_LINK, offsetof (struct weak_box, value) }, |
| 888 | 3708 { XD_END} |
| 858 | 3709 }; |
| 3710 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
3711 DEFINE_NODUMP_LISP_OBJECT ("weak-box", weak_box, mark_weak_box, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
3712 print_weak_box, 0, weak_box_equal, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
3713 weak_box_hash, weak_box_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
3714 struct weak_box); |
| 858 | 3715 |
| 3716 DEFUN ("make-weak-box", Fmake_weak_box, 1, 1, 0, /* | |
| 3717 Return a new weak box from value CONTENTS. | |
| 3718 The weak box is a reference to CONTENTS which may be extracted with | |
| 3719 `weak-box-ref'. However, the weak box does not contribute to the | |
| 3720 reachability of CONTENTS. When CONTENTS is garbage-collected, | |
| 3721 `weak-box-ref' will return NIL. | |
| 3722 */ | |
| 3723 (value)) | |
| 3724 { | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3725 return make_weak_box (value); |
| 858 | 3726 } |
| 3727 | |
| 3728 DEFUN ("weak-box-ref", Fweak_box_ref, 1, 1, 0, /* | |
| 3729 Return the contents of weak box WEAK-BOX. | |
| 3730 If the contents have been GCed, return NIL. | |
| 3731 */ | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3732 (weak_box)) |
| 858 | 3733 { |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3734 return XWEAK_BOX (weak_box)->value; |
| 858 | 3735 } |
| 3736 | |
| 3737 DEFUN ("weak-box-p", Fweak_boxp, 1, 1, 0, /* | |
| 3738 Return non-nil if OBJECT is a weak box. | |
| 3739 */ | |
| 3740 (object)) | |
| 3741 { | |
| 3742 return WEAK_BOXP (object) ? Qt : Qnil; | |
| 3743 } | |
| 3744 | |
| 888 | 3745 /************************************************************************/ |
| 3746 /* ephemerons */ | |
| 3747 /************************************************************************/ | |
| 3748 | |
| 993 | 3749 /* The concept of ephemerons is due to: |
| 3750 * Barry Hayes: Ephemerons: A New Finalization Mechanism. OOPSLA 1997: 176-183 | |
| 3751 * The original idea is due to George Bosworth of Digitalk, Inc. | |
| 3752 * | |
| 3753 * For a discussion of finalization and weakness that also reviews | |
| 3754 * ephemerons, refer to: | |
| 3755 * Simon Peyton Jones, Simon Marlow, Conal Elliot: | |
| 3756 * Stretching the storage manager | |
| 3757 * Implementation of Functional Languages, 1999 | |
| 3758 */ | |
| 3759 | |
| 888 | 3760 static Lisp_Object Vall_ephemerons; /* Gemarke es niemals ever!!! */ |
| 1590 | 3761 static Lisp_Object Vnew_all_ephemerons; |
| 888 | 3762 static Lisp_Object Vfinalize_list; |
| 3763 | |
| 1590 | 3764 void |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3765 init_marking_ephemerons (void) |
| 1590 | 3766 { |
| 3767 Vnew_all_ephemerons = Qnil; | |
| 3768 } | |
| 3769 | |
| 3770 /* Move all live ephemerons with live keys over to | |
| 3771 * Vnew_all_ephemerons, marking the values and finalizers along the | |
| 3772 * way. */ | |
| 3773 | |
| 3774 int | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3775 continue_marking_ephemerons (void) |
| 1590 | 3776 { |
| 3777 Lisp_Object rest = Vall_ephemerons, next, prev = Qnil; | |
| 3778 int did_mark = 0; | |
| 3779 | |
| 3780 while (!NILP (rest)) | |
| 3781 { | |
| 3782 next = XEPHEMERON_NEXT (rest); | |
| 3783 | |
| 3784 if (marked_p (rest)) | |
| 3785 { | |
| 3786 MARK_CONS (XCONS (XEPHEMERON (rest)->cons_chain)); | |
| 3787 if (marked_p (XEPHEMERON (rest)->key)) | |
| 3788 { | |
| 1598 | 3789 #ifdef USE_KKCC |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
3790 kkcc_gc_stack_push_lisp_object_0 |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
3791 (XCAR (XEPHEMERON (rest)->cons_chain)); |
| 1598 | 3792 #else /* NOT USE_KKCC */ |
| 1590 | 3793 mark_object (XCAR (XEPHEMERON (rest)->cons_chain)); |
| 1598 | 3794 #endif /* NOT USE_KKCC */ |
| 1590 | 3795 did_mark = 1; |
| 3796 XSET_EPHEMERON_NEXT (rest, Vnew_all_ephemerons); | |
| 3797 Vnew_all_ephemerons = rest; | |
| 3798 if (NILP (prev)) | |
| 3799 Vall_ephemerons = next; | |
| 3800 else | |
| 3801 XSET_EPHEMERON_NEXT (prev, next); | |
| 3802 } | |
| 3803 else | |
| 3804 prev = rest; | |
| 3805 } | |
| 3806 else | |
| 3807 prev = rest; | |
| 3808 | |
| 3809 rest = next; | |
| 3810 } | |
| 3811 | |
| 3812 return did_mark; | |
| 3813 } | |
| 3814 | |
| 3815 /* At this point, everything that's in Vall_ephemerons is dead. | |
| 3816 * Well, almost: we still need to run the finalizers, so we need to | |
| 3817 * resurrect them. | |
| 3818 */ | |
| 3819 | |
| 888 | 3820 int |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3821 finish_marking_ephemerons (void) |
| 888 | 3822 { |
| 1590 | 3823 Lisp_Object rest = Vall_ephemerons, next, prev = Qnil; |
| 888 | 3824 int did_mark = 0; |
| 3825 | |
| 3826 while (! NILP (rest)) | |
| 3827 { | |
| 3828 next = XEPHEMERON_NEXT (rest); | |
| 3829 | |
| 3830 if (marked_p (rest)) | |
| 1590 | 3831 /* The ephemeron itself is live, but its key is garbage */ |
| 888 | 3832 { |
| 1590 | 3833 /* tombstone */ |
| 3834 XSET_EPHEMERON_VALUE (rest, Qnil); | |
| 3835 | |
| 3836 if (! NILP (XEPHEMERON_FINALIZER (rest))) | |
| 888 | 3837 { |
| 1590 | 3838 MARK_CONS (XCONS (XEPHEMERON (rest)->cons_chain)); |
| 1598 | 3839 #ifdef USE_KKCC |
|
5169
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
3840 kkcc_gc_stack_push_lisp_object_0 |
|
6c6d78781d59
cleanup of code related to xfree(), better KKCC backtrace capabilities, document XD_INLINE_LISP_OBJECT_BLOCK_PTR, fix some memory leaks, other code cleanup
Ben Wing <ben@xemacs.org>
parents:
5142
diff
changeset
|
3841 (XCAR (XEPHEMERON (rest)->cons_chain)); |
| 1598 | 3842 #else /* NOT USE_KKCC */ |
| 1590 | 3843 mark_object (XCAR (XEPHEMERON (rest)->cons_chain)); |
| 1598 | 3844 #endif /* NOT USE_KKCC */ |
| 1590 | 3845 |
| 3846 /* Register the finalizer */ | |
| 3847 XSET_EPHEMERON_NEXT (rest, Vfinalize_list); | |
| 3848 Vfinalize_list = XEPHEMERON (rest)->cons_chain; | |
| 3849 did_mark = 1; | |
| 888 | 3850 } |
| 3851 | |
| 3852 /* Remove it from the list. */ | |
| 3853 if (NILP (prev)) | |
| 3854 Vall_ephemerons = next; | |
| 3855 else | |
| 3856 XSET_EPHEMERON_NEXT (prev, next); | |
| 3857 } | |
| 3858 else | |
| 3859 prev = rest; | |
| 3860 | |
| 3861 rest = next; | |
| 3862 } | |
| 1590 | 3863 |
| 3864 return did_mark; | |
| 3865 } | |
| 3866 | |
| 3867 void | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3868 prune_ephemerons (void) |
| 1590 | 3869 { |
| 3870 Vall_ephemerons = Vnew_all_ephemerons; | |
| 888 | 3871 } |
| 3872 | |
| 3873 Lisp_Object | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3874 zap_finalize_list (void) |
| 888 | 3875 { |
| 3876 Lisp_Object finalizers = Vfinalize_list; | |
| 3877 | |
| 3878 Vfinalize_list = Qnil; | |
| 3879 | |
| 3880 return finalizers; | |
| 3881 } | |
| 3882 | |
| 3883 static Lisp_Object | |
| 2286 | 3884 mark_ephemeron (Lisp_Object UNUSED (obj)) |
| 888 | 3885 { |
| 3886 return Qnil; | |
| 3887 } | |
| 3888 | |
| 3889 static void | |
|
5325
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3890 print_ephemeron (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
| 888 | 3891 { |
| 3892 if (print_readably) | |
|
5325
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3893 { |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3894 printing_unreadable_lisp_object (obj, 0); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3895 } |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3896 |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3897 write_ascstring (printcharfun, "#<ephemeron :key "); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3898 print_internal (XEPHEMERON (obj)->key, printcharfun, escapeflag); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3899 write_ascstring (printcharfun, " :value "); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3900 print_internal (XEPHEMERON (obj)->value, printcharfun, escapeflag); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3901 write_ascstring (printcharfun, " :finalizer "); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3902 print_internal (XEPHEMERON_FINALIZER (obj), printcharfun, escapeflag); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3903 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); |
| 888 | 3904 } |
| 3905 | |
| 3906 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4885
diff
changeset
|
3907 ephemeron_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) |
| 888 | 3908 { |
| 3909 return | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3910 internal_equal_0 (XEPHEMERON_REF (obj1), XEPHEMERON_REF (obj2), |
|
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3911 depth + 1, foldcase); |
| 888 | 3912 } |
| 3913 | |
| 3914 static Hashcode | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3915 ephemeron_hash (Lisp_Object obj, int depth, Boolint equalp) |
| 888 | 3916 { |
|
5191
71ee43b8a74d
Add #'equalp as a hash test by default; add #'define-hash-table-test, GNU API
Aidan Kehoe <kehoea@parhasard.net>
parents:
5169
diff
changeset
|
3917 return internal_hash (XEPHEMERON_REF (obj), depth + 1, equalp); |
| 888 | 3918 } |
| 3919 | |
| 3920 Lisp_Object | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
3921 make_ephemeron (Lisp_Object key, Lisp_Object value, Lisp_Object finalizer) |
| 888 | 3922 { |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
3923 Lisp_Object temp = Qnil; |
| 888 | 3924 struct gcpro gcpro1, gcpro2; |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
3925 Lisp_Object result = ALLOC_NORMAL_LISP_OBJECT (ephemeron); |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
3926 struct ephemeron *eph = XEPHEMERON (result); |
| 888 | 3927 |
| 3928 eph->key = Qnil; | |
| 3929 eph->cons_chain = Qnil; | |
| 3930 eph->value = Qnil; | |
| 3931 | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
3932 result = wrap_ephemeron (eph); |
| 888 | 3933 GCPRO2 (result, temp); |
| 3934 | |
| 3935 eph->key = key; | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
3936 temp = Fcons (value, finalizer); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
3937 eph->cons_chain = Fcons (temp, Vall_ephemerons); |
| 888 | 3938 eph->value = value; |
| 3939 | |
| 3940 Vall_ephemerons = result; | |
| 3941 | |
| 3942 UNGCPRO; | |
| 3943 return result; | |
| 3944 } | |
| 3945 | |
| 1598 | 3946 /* Ephemerons are special cases in the KKCC mark algorithm, so nothing |
| 3947 is marked here. */ | |
| 1204 | 3948 static const struct memory_description ephemeron_description[] = { |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3949 { XD_LISP_OBJECT, offsetof (struct ephemeron, key), |
| 2551 | 3950 0, { 0 }, XD_FLAG_NO_KKCC }, |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3951 { XD_LISP_OBJECT, offsetof (struct ephemeron, cons_chain), |
| 2551 | 3952 0, { 0 }, XD_FLAG_NO_KKCC }, |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3953 { XD_LISP_OBJECT, offsetof (struct ephemeron, value), |
| 2551 | 3954 0, { 0 }, XD_FLAG_NO_KKCC }, |
| 888 | 3955 { XD_END } |
| 3956 }; | |
| 3957 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
3958 DEFINE_NODUMP_LISP_OBJECT ("ephemeron", ephemeron, |
|
5124
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
3959 mark_ephemeron, print_ephemeron, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
3960 0, ephemeron_equal, ephemeron_hash, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
3961 ephemeron_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
3962 struct ephemeron); |
| 888 | 3963 |
| 3964 DEFUN ("make-ephemeron", Fmake_ephemeron, 2, 3, 0, /* | |
| 1590 | 3965 Return a new ephemeron with key KEY, value VALUE, and finalizer FINALIZER. |
| 3966 The ephemeron is a reference to VALUE which may be extracted with | |
| 3967 `ephemeron-ref'. VALUE is only reachable through the ephemeron as | |
| 888 | 3968 long as KEY is reachable; the ephemeron does not contribute to the |
| 3969 reachability of KEY. When KEY becomes unreachable while the ephemeron | |
| 1590 | 3970 itself is still reachable, VALUE is queued for finalization: FINALIZER |
| 3971 will possibly be called on VALUE some time in the future. Moreover, | |
| 888 | 3972 future calls to `ephemeron-ref' will return NIL. |
| 3973 */ | |
| 3974 (key, value, finalizer)) | |
| 3975 { | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3976 return make_ephemeron (key, value, finalizer); |
| 888 | 3977 } |
| 3978 | |
| 3979 DEFUN ("ephemeron-ref", Fephemeron_ref, 1, 1, 0, /* | |
| 3980 Return the contents of ephemeron EPHEMERON. | |
| 3981 If the contents have been GCed, return NIL. | |
| 3982 */ | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3983 (ephemeron)) |
| 888 | 3984 { |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3985 return XEPHEMERON_REF (ephemeron); |
| 888 | 3986 } |
| 3987 | |
| 3988 DEFUN ("ephemeron-p", Fephemeronp, 1, 1, 0, /* | |
| 3989 Return non-nil if OBJECT is an ephemeron. | |
| 3990 */ | |
| 3991 (object)) | |
| 3992 { | |
| 3993 return EPHEMERONP (object) ? Qt : Qnil; | |
| 3994 } | |
| 428 | 3995 |
| 3996 /************************************************************************/ | |
| 3997 /* initialization */ | |
| 3998 /************************************************************************/ | |
| 3999 | |
| 4000 static SIGTYPE | |
| 4001 arith_error (int signo) | |
| 4002 { | |
| 4003 EMACS_REESTABLISH_SIGNAL (signo, arith_error); | |
| 4004 EMACS_UNBLOCK_SIGNAL (signo); | |
| 563 | 4005 signal_error (Qarith_error, 0, Qunbound); |
| 428 | 4006 } |
| 4007 | |
| 4008 void | |
| 4009 init_data_very_early (void) | |
| 4010 { | |
| 4011 /* Don't do this if just dumping out. | |
| 4012 We don't want to call `signal' in this case | |
| 4013 so that we don't have trouble with dumping | |
| 4014 signal-delivering routines in an inconsistent state. */ | |
| 4015 if (!initialized) | |
| 4016 return; | |
| 613 | 4017 EMACS_SIGNAL (SIGFPE, arith_error); |
| 428 | 4018 #ifdef uts |
| 613 | 4019 EMACS_SIGNAL (SIGEMT, arith_error); |
| 428 | 4020 #endif /* uts */ |
| 4021 } | |
| 4022 | |
| 4023 void | |
| 4024 init_errors_once_early (void) | |
| 4025 { | |
| 442 | 4026 DEFSYMBOL (Qerror_conditions); |
| 4027 DEFSYMBOL (Qerror_message); | |
| 428 | 4028 |
| 4029 /* We declare the errors here because some other deferrors depend | |
| 4030 on some of the errors below. */ | |
| 4031 | |
| 4032 /* ERROR is used as a signaler for random errors for which nothing | |
| 4033 else is right */ | |
| 4034 | |
| 442 | 4035 DEFERROR (Qerror, "error", Qnil); |
| 4036 DEFERROR_STANDARD (Qquit, Qnil); | |
| 428 | 4037 |
| 563 | 4038 DEFERROR_STANDARD (Qinvalid_argument, Qerror); |
| 4039 | |
| 4040 DEFERROR_STANDARD (Qsyntax_error, Qinvalid_argument); | |
| 442 | 4041 DEFERROR_STANDARD (Qinvalid_read_syntax, Qsyntax_error); |
| 563 | 4042 DEFERROR_STANDARD (Qstructure_formation_error, Qsyntax_error); |
| 4043 DEFERROR_STANDARD (Qlist_formation_error, Qstructure_formation_error); | |
| 442 | 4044 DEFERROR_STANDARD (Qmalformed_list, Qlist_formation_error); |
| 4045 DEFERROR_STANDARD (Qmalformed_property_list, Qmalformed_list); | |
| 4046 DEFERROR_STANDARD (Qcircular_list, Qlist_formation_error); | |
| 4047 DEFERROR_STANDARD (Qcircular_property_list, Qcircular_list); | |
| 428 | 4048 |
| 442 | 4049 DEFERROR_STANDARD (Qwrong_type_argument, Qinvalid_argument); |
| 4050 DEFERROR_STANDARD (Qargs_out_of_range, Qinvalid_argument); | |
| 4051 DEFERROR_STANDARD (Qwrong_number_of_arguments, Qinvalid_argument); | |
| 4052 DEFERROR_STANDARD (Qinvalid_function, Qinvalid_argument); | |
| 563 | 4053 DEFERROR_STANDARD (Qinvalid_constant, Qinvalid_argument); |
|
5084
6afe991b8135
Add a PARSE_KEYWORDS macro, use it in #'make-hash-table.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4998
diff
changeset
|
4054 DEFERROR_STANDARD (Qinvalid_keyword_argument, Qinvalid_argument); |
| 442 | 4055 DEFERROR (Qno_catch, "No catch for tag", Qinvalid_argument); |
| 4056 | |
| 563 | 4057 DEFERROR_STANDARD (Qinvalid_state, Qerror); |
| 442 | 4058 DEFERROR (Qvoid_function, "Symbol's function definition is void", |
| 4059 Qinvalid_state); | |
| 4060 DEFERROR (Qcyclic_function_indirection, | |
| 4061 "Symbol's chain of function indirections contains a loop", | |
| 4062 Qinvalid_state); | |
| 4063 DEFERROR (Qvoid_variable, "Symbol's value as variable is void", | |
| 4064 Qinvalid_state); | |
| 4065 DEFERROR (Qcyclic_variable_indirection, | |
| 4066 "Symbol's chain of variable indirections contains a loop", | |
| 4067 Qinvalid_state); | |
| 563 | 4068 DEFERROR_STANDARD (Qstack_overflow, Qinvalid_state); |
| 4069 DEFERROR_STANDARD (Qinternal_error, Qinvalid_state); | |
| 4070 DEFERROR_STANDARD (Qout_of_memory, Qinvalid_state); | |
| 428 | 4071 |
| 563 | 4072 DEFERROR_STANDARD (Qinvalid_operation, Qerror); |
| 4073 DEFERROR_STANDARD (Qinvalid_change, Qinvalid_operation); | |
| 442 | 4074 DEFERROR (Qsetting_constant, "Attempt to set a constant symbol", |
| 4075 Qinvalid_change); | |
| 563 | 4076 DEFERROR_STANDARD (Qprinting_unreadable_object, Qinvalid_operation); |
| 4077 DEFERROR (Qunimplemented, "Feature not yet implemented", Qinvalid_operation); | |
| 442 | 4078 |
| 563 | 4079 DEFERROR_STANDARD (Qediting_error, Qinvalid_operation); |
| 442 | 4080 DEFERROR_STANDARD (Qbeginning_of_buffer, Qediting_error); |
| 4081 DEFERROR_STANDARD (Qend_of_buffer, Qediting_error); | |
| 4082 DEFERROR (Qbuffer_read_only, "Buffer is read-only", Qediting_error); | |
|
5381
4f39e57a82b4
Improve read-only error reporting.
Didier Verna <didier@lrde.epita.fr>
parents:
5374
diff
changeset
|
4083 DEFERROR (Qextent_read_only, "Extent is read-only", Qediting_error); |
| 442 | 4084 |
| 4085 DEFERROR (Qio_error, "IO Error", Qinvalid_operation); | |
| 563 | 4086 DEFERROR_STANDARD (Qfile_error, Qio_error); |
| 4087 DEFERROR (Qend_of_file, "End of file or stream", Qfile_error); | |
| 4088 DEFERROR_STANDARD (Qconversion_error, Qio_error); | |
| 580 | 4089 DEFERROR_STANDARD (Qtext_conversion_error, Qconversion_error); |
| 442 | 4090 |
| 4091 DEFERROR (Qarith_error, "Arithmetic error", Qinvalid_operation); | |
| 4092 DEFERROR (Qrange_error, "Arithmetic range error", Qarith_error); | |
| 4093 DEFERROR (Qdomain_error, "Arithmetic domain error", Qarith_error); | |
| 4094 DEFERROR (Qsingularity_error, "Arithmetic singularity error", Qdomain_error); | |
| 4095 DEFERROR (Qoverflow_error, "Arithmetic overflow error", Qdomain_error); | |
| 4096 DEFERROR (Qunderflow_error, "Arithmetic underflow error", Qdomain_error); | |
| 428 | 4097 } |
| 4098 | |
| 4099 void | |
| 4100 syms_of_data (void) | |
| 4101 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
4102 INIT_LISP_OBJECT (weak_list); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
4103 INIT_LISP_OBJECT (ephemeron); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
4104 INIT_LISP_OBJECT (weak_box); |
| 442 | 4105 |
| 4106 DEFSYMBOL (Qlambda); | |
| 4107 DEFSYMBOL (Qlistp); | |
| 4108 DEFSYMBOL (Qtrue_list_p); | |
| 4109 DEFSYMBOL (Qconsp); | |
| 4110 DEFSYMBOL (Qsubrp); | |
| 4111 DEFSYMBOL (Qsymbolp); | |
| 4112 DEFSYMBOL (Qintegerp); | |
| 4113 DEFSYMBOL (Qcharacterp); | |
| 4114 DEFSYMBOL (Qnatnump); | |
| 1983 | 4115 DEFSYMBOL (Qnonnegativep); |
| 442 | 4116 DEFSYMBOL (Qstringp); |
| 4117 DEFSYMBOL (Qarrayp); | |
| 4118 DEFSYMBOL (Qsequencep); | |
| 4119 DEFSYMBOL (Qbufferp); | |
| 4120 DEFSYMBOL (Qbitp); | |
| 4121 DEFSYMBOL_MULTIWORD_PREDICATE (Qbit_vectorp); | |
| 4122 DEFSYMBOL (Qvectorp); | |
| 4123 DEFSYMBOL (Qchar_or_string_p); | |
| 4124 DEFSYMBOL (Qmarkerp); | |
| 4125 DEFSYMBOL (Qinteger_or_marker_p); | |
| 4126 DEFSYMBOL (Qinteger_or_char_p); | |
| 4127 DEFSYMBOL (Qinteger_char_or_marker_p); | |
| 4128 DEFSYMBOL (Qnumberp); | |
| 4129 DEFSYMBOL (Qnumber_char_or_marker_p); | |
| 4130 DEFSYMBOL (Qcdr); | |
| 563 | 4131 DEFSYMBOL (Qerror_lacks_explanatory_string); |
| 442 | 4132 DEFSYMBOL_MULTIWORD_PREDICATE (Qweak_listp); |
| 4133 DEFSYMBOL (Qfloatp); | |
| 428 | 4134 |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4135 DEFKEYWORD (Q_radix); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4136 DEFKEYWORD (Q_junk_allowed); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4137 DEFKEYWORD (Q_radix_table); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4138 |
| 428 | 4139 DEFSUBR (Fwrong_type_argument); |
| 4140 | |
| 1983 | 4141 #ifdef HAVE_RATIO |
| 4142 DEFSUBR (Fdiv); | |
| 4143 #endif | |
| 428 | 4144 DEFSUBR (Feq); |
| 4145 DEFSUBR (Fnull); | |
| 4146 Ffset (intern ("not"), intern ("null")); | |
| 4147 DEFSUBR (Flistp); | |
| 4148 DEFSUBR (Fnlistp); | |
| 4149 DEFSUBR (Ftrue_list_p); | |
| 4150 DEFSUBR (Fconsp); | |
| 4151 DEFSUBR (Fatom); | |
| 4152 DEFSUBR (Fchar_or_string_p); | |
| 4153 DEFSUBR (Fcharacterp); | |
| 4154 DEFSUBR (Fchar_int_p); | |
| 4155 DEFSUBR (Fchar_to_int); | |
| 4156 DEFSUBR (Fint_to_char); | |
| 4157 DEFSUBR (Fchar_or_char_int_p); | |
| 1983 | 4158 DEFSUBR (Ffixnump); |
| 428 | 4159 DEFSUBR (Fintegerp); |
| 4160 DEFSUBR (Finteger_or_marker_p); | |
| 4161 DEFSUBR (Finteger_or_char_p); | |
| 4162 DEFSUBR (Finteger_char_or_marker_p); | |
| 4163 DEFSUBR (Fnumberp); | |
| 4164 DEFSUBR (Fnumber_or_marker_p); | |
| 4165 DEFSUBR (Fnumber_char_or_marker_p); | |
| 4166 DEFSUBR (Ffloatp); | |
| 4167 DEFSUBR (Fnatnump); | |
| 1983 | 4168 DEFSUBR (Fnonnegativep); |
| 428 | 4169 DEFSUBR (Fsymbolp); |
| 4170 DEFSUBR (Fkeywordp); | |
| 4171 DEFSUBR (Fstringp); | |
| 4172 DEFSUBR (Fvectorp); | |
| 4173 DEFSUBR (Fbitp); | |
| 4174 DEFSUBR (Fbit_vector_p); | |
| 4175 DEFSUBR (Farrayp); | |
| 4176 DEFSUBR (Fsequencep); | |
| 4177 DEFSUBR (Fmarkerp); | |
| 4178 DEFSUBR (Fsubrp); | |
| 4179 DEFSUBR (Fsubr_min_args); | |
| 4180 DEFSUBR (Fsubr_max_args); | |
| 4181 DEFSUBR (Fsubr_interactive); | |
| 4182 DEFSUBR (Ftype_of); | |
| 4183 DEFSUBR (Fcar); | |
| 4184 DEFSUBR (Fcdr); | |
| 4185 DEFSUBR (Fcar_safe); | |
| 4186 DEFSUBR (Fcdr_safe); | |
| 4187 DEFSUBR (Fsetcar); | |
| 4188 DEFSUBR (Fsetcdr); | |
| 4189 DEFSUBR (Findirect_function); | |
| 4190 DEFSUBR (Faref); | |
| 4191 DEFSUBR (Faset); | |
| 4192 | |
| 4193 DEFSUBR (Fnumber_to_string); | |
| 4194 DEFSUBR (Fstring_to_number); | |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4195 DEFSUBR (Fset_digit_fixnum_map); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4196 DEFSUBR (Fdigit_char_p); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4197 DEFSUBR (Fdigit_char); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4198 DEFSUBR (Fparse_integer); |
| 428 | 4199 DEFSUBR (Feqlsign); |
| 4200 DEFSUBR (Flss); | |
| 4201 DEFSUBR (Fgtr); | |
| 4202 DEFSUBR (Fleq); | |
| 4203 DEFSUBR (Fgeq); | |
| 4204 DEFSUBR (Fneq); | |
| 4205 DEFSUBR (Fzerop); | |
| 4206 DEFSUBR (Fplus); | |
| 4207 DEFSUBR (Fminus); | |
| 4208 DEFSUBR (Ftimes); | |
| 4209 DEFSUBR (Fquo); | |
| 4210 DEFSUBR (Frem); | |
| 4211 DEFSUBR (Fmod); | |
| 4212 DEFSUBR (Fmax); | |
| 4213 DEFSUBR (Fmin); | |
| 4214 DEFSUBR (Flogand); | |
| 4215 DEFSUBR (Flogior); | |
| 4216 DEFSUBR (Flogxor); | |
| 4217 DEFSUBR (Flsh); | |
| 4218 DEFSUBR (Fash); | |
| 4219 DEFSUBR (Fadd1); | |
| 4220 DEFSUBR (Fsub1); | |
| 4221 DEFSUBR (Flognot); | |
| 4222 | |
| 4223 DEFSUBR (Fweak_list_p); | |
| 4224 DEFSUBR (Fmake_weak_list); | |
| 4225 DEFSUBR (Fweak_list_type); | |
| 4226 DEFSUBR (Fweak_list_list); | |
| 4227 DEFSUBR (Fset_weak_list_list); | |
| 858 | 4228 |
| 888 | 4229 DEFSUBR (Fmake_ephemeron); |
| 4230 DEFSUBR (Fephemeron_ref); | |
| 4231 DEFSUBR (Fephemeronp); | |
| 858 | 4232 DEFSUBR (Fmake_weak_box); |
| 4233 DEFSUBR (Fweak_box_ref); | |
| 4234 DEFSUBR (Fweak_boxp); | |
| 428 | 4235 } |
| 4236 | |
| 4237 void | |
| 4238 vars_of_data (void) | |
| 4239 { | |
| 4240 /* This must not be staticpro'd */ | |
| 4241 Vall_weak_lists = Qnil; | |
| 452 | 4242 dump_add_weak_object_chain (&Vall_weak_lists); |
| 428 | 4243 |
| 888 | 4244 Vall_ephemerons = Qnil; |
| 4245 dump_add_weak_object_chain (&Vall_ephemerons); | |
| 4246 | |
| 4247 Vfinalize_list = Qnil; | |
| 4248 staticpro (&Vfinalize_list); | |
| 4249 | |
| 858 | 4250 Vall_weak_boxes = Qnil; |
| 4251 dump_add_weak_object_chain (&Vall_weak_boxes); | |
| 4252 | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
4253 DEFVAR_CONST_INT ("most-negative-fixnum", &Vmost_negative_fixnum /* |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
4254 The fixnum closest in value to negative infinity. |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
4255 */); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
4256 Vmost_negative_fixnum = MOST_NEGATIVE_FIXNUM; |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
4257 |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
4258 DEFVAR_CONST_INT ("most-positive-fixnum", &Vmost_positive_fixnum /* |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
4259 The fixnum closest in value to positive infinity. |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
4260 */); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
4261 Vmost_positive_fixnum = MOST_POSITIVE_FIXNUM; |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
4262 |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4263 DEFVAR_CONST_LISP ("digit-fixnum-map", &Vdigit_fixnum_map /* |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4264 Table used to determine a character's numeric value when parsing. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4265 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4266 This is a character table with fixnum values. A value of -1 indicates this |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4267 character does not have an assigned numeric value. See `parse-integer', |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4268 `digit-char-p', and `digit-char'. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4269 */); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4270 Vdigit_fixnum_map = Fmake_char_table (Qgeneric); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4271 set_char_table_default (Vdigit_fixnum_map, make_fixnum (-1)); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4272 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4273 int ii = 0; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4274 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4275 for (ii = 0; ii < 10; ++ii) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4276 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4277 XCHAR_TABLE (Vdigit_fixnum_map)->ascii['0' + ii] = make_fixnum(ii); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4278 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4279 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4280 for (ii = 10; ii < 36; ++ii) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4281 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4282 XCHAR_TABLE (Vdigit_fixnum_map)->ascii['a' + (ii - 10)] |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4283 = make_fixnum(ii); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4284 XCHAR_TABLE (Vdigit_fixnum_map)->ascii['A' + (ii - 10)] |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4285 = make_fixnum(ii); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4286 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4287 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4288 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4289 Ascbyte *fixnum_tab = alloca_ascbytes (36 * MAX_ICHAR_LEN), *ptr; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4290 int ii; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4291 Ichar cc; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4292 memset ((void *)fixnum_tab, 0, 36 * MAX_ICHAR_LEN); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4293 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4294 /* The whole point of fixnum_to_character_table is access as an array, |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4295 avoid O(N) issues by giving every character MAX_ICHAR_LEN of |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4296 bytes. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4297 for (ii = 0, ptr = fixnum_tab; ii < 36; ++ii, ptr += MAX_ICHAR_LEN) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4298 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4299 cc = ii < 10 ? '0' + ii : 'A' + (ii - 10); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4300 set_itext_ichar ((Ibyte *) ptr, cc); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4301 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4302 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4303 /* Sigh, we can't call build_fixnum_to_char_map() on Vdigit_fixnum_map, |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4304 this is too early in the boot sequence to map across a char table. Do |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4305 it by hand. */ |
|
5871
58e72e27fb81
Don't rely on zero termination for Vfixnum_to_char_map, thank you Vin.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5870
diff
changeset
|
4306 ASSERT_ASCTEXT_ASCII_LEN (fixnum_tab, 36 * MAX_ICHAR_LEN); |
|
58e72e27fb81
Don't rely on zero termination for Vfixnum_to_char_map, thank you Vin.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5870
diff
changeset
|
4307 Vfixnum_to_char_map |
|
58e72e27fb81
Don't rely on zero termination for Vfixnum_to_char_map, thank you Vin.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5870
diff
changeset
|
4308 = make_string ((const Ibyte*) fixnum_tab, 36 * MAX_ICHAR_LEN); |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4309 staticpro (&Vfixnum_to_char_map); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4310 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4311 |
| 428 | 4312 #ifdef DEBUG_XEMACS |
| 4313 DEFVAR_BOOL ("debug-issue-ebola-notices", &debug_issue_ebola_notices /* | |
| 4314 If non-zero, note when your code may be suffering from char-int confoundance. | |
| 4315 That is to say, if XEmacs encounters a usage of `eq', `memq', `equal', | |
| 4316 etc. where an int and a char with the same value are being compared, | |
| 4317 it will issue a notice on stderr to this effect, along with a backtrace. | |
| 4318 In such situations, the result would be different in XEmacs 19 versus | |
| 4319 XEmacs 20, and you probably don't want this. | |
| 4320 | |
| 4321 Note that in order to see these notices, you have to byte compile your | |
| 4322 code under XEmacs 20 -- any code byte-compiled under XEmacs 19 will | |
| 4323 have its chars and ints all confounded in the byte code, making it | |
| 4324 impossible to accurately determine Ebola infection. | |
| 4325 */ ); | |
| 4326 | |
| 4327 debug_issue_ebola_notices = 0; | |
| 4328 | |
| 4329 DEFVAR_INT ("debug-ebola-backtrace-length", | |
| 4330 &debug_ebola_backtrace_length /* | |
| 4331 Length (in stack frames) of short backtrace printed out in Ebola notices. | |
| 4332 See `debug-issue-ebola-notices'. | |
| 4333 */ ); | |
| 4334 debug_ebola_backtrace_length = 32; | |
| 4335 | |
| 4336 #endif /* DEBUG_XEMACS */ | |
| 4337 } |