Mercurial > hg > xemacs-beta
annotate src/data.c @ 5905:85fd1ab80057
Fix a bug in #'parse-integer with negative bignums and non-nil JUNK-ALLOWED
src/ChangeLog addition:
2015-05-08 Aidan Kehoe <kehoea@parhasard.net>
* data.c (parse_integer):
Fix a bug here with the interaction of negative bignums and a
non-zero JUNK-ALLOWED argument.
tests/ChangeLog addition:
2015-05-08 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-tests.el:
Check for a bug just fixed with the interaction of negative
bignums and :junk-allowed non-nil.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Fri, 08 May 2015 16:24:57 +0100 |
| parents | 5afddd952c46 |
| children | 6174848f3e6c |
| 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); | |
|
5903
5afddd952c46
Return ratios in canonical form too, #'string-to-number
Aidan Kehoe <kehoea@parhasard.net>
parents:
5886
diff
changeset
|
1364 return Fcanonicalize_number (make_ratio_rt (scratch_ratio)); |
| 1983 | 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. */ |
|
5905
85fd1ab80057
Fix a bug in #'parse-integer with negative bignums and non-nil JUNK-ALLOWED
Aidan Kehoe <kehoea@parhasard.net>
parents:
5903
diff
changeset
|
1902 if (negativland) |
|
85fd1ab80057
Fix a bug in #'parse-integer with negative bignums and non-nil JUNK-ALLOWED
Aidan Kehoe <kehoea@parhasard.net>
parents:
5903
diff
changeset
|
1903 { |
|
85fd1ab80057
Fix a bug in #'parse-integer with negative bignums and non-nil JUNK-ALLOWED
Aidan Kehoe <kehoea@parhasard.net>
parents:
5903
diff
changeset
|
1904 bignum_set_long (scratch_bignum, -1L); |
|
85fd1ab80057
Fix a bug in #'parse-integer with negative bignums and non-nil JUNK-ALLOWED
Aidan Kehoe <kehoea@parhasard.net>
parents:
5903
diff
changeset
|
1905 bignum_mul (XBIGNUM_DATA (result), XBIGNUM_DATA (result), |
|
85fd1ab80057
Fix a bug in #'parse-integer with negative bignums and non-nil JUNK-ALLOWED
Aidan Kehoe <kehoea@parhasard.net>
parents:
5903
diff
changeset
|
1906 scratch_bignum); |
|
85fd1ab80057
Fix a bug in #'parse-integer with negative bignums and non-nil JUNK-ALLOWED
Aidan Kehoe <kehoea@parhasard.net>
parents:
5903
diff
changeset
|
1907 } |
|
85fd1ab80057
Fix a bug in #'parse-integer with negative bignums and non-nil JUNK-ALLOWED
Aidan Kehoe <kehoea@parhasard.net>
parents:
5903
diff
changeset
|
1908 return result; |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1909 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1910 #endif |
|
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 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
|
1913 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1914 /* 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
|
1915 error. Return nil. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1916 return Qnil; |
|
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 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1919 if (negativland) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1920 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1921 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
|
1922 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
|
1923 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1924 else |
|
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 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
|
1927 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
|
1928 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1929 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1930 return result; |
|
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 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1933 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
|
1934 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
|
1935 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
|
1936 } |
|
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 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
|
1939 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
|
1940 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1941 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
|
1942 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
|
1943 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1944 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
|
1945 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
|
1946 characters. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1947 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1948 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
|
1949 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
|
1950 correspondence to use. |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1951 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1952 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
|
1953 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
|
1954 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
|
1955 |
|
5867
e0f1dfaa821e
Add the non-ASCII digit support, now #'parse-integer can handle it.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5864
diff
changeset
|
1956 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
|
1957 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
|
1958 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
|
1959 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
|
1960 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
|
1961 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
|
1962 |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1963 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
|
1964 */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1965 (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
|
1966 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1967 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
|
1968 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
|
1969 Bytecount byte_len; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1970 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
|
1971 EMACS_INT radixing; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1972 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1973 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
|
1974 (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
|
1975 (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
|
1976 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1977 CHECK_STRING (string); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1978 CHECK_NATNUM (start); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1979 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
|
1980 if (!NILP (end)) |
|
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_NATNUM (end); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1983 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
|
1984 } |
|
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 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
|
1987 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1988 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
|
1989 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1990 else |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1991 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1992 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
|
1993 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1994 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1995 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
|
1996 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
|
1997 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
|
1998 / MAX_ICHAR_LEN) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
1999 /* 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
|
2000 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
|
2001 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
|
2002 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
|
2003 a fixnum. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2004 : 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
|
2005 radixing = XFIXNUM (radix); |
|
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 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
|
2008 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
|
2009 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
|
2010 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2011 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
|
2012 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2013 INC_IBYTEPTR (cursor); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2014 if (ii < starting) |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2015 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2016 startp = cursor; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2017 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2018 ii++; |
|
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 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2021 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
|
2022 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2023 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
|
2024 } |
|
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 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
|
2027 !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
|
2028 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2029 /* 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
|
2030 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
|
2031 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
2032 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
|
2033 (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
|
2034 } |
| 428 | 2035 |
| 2036 DEFUN ("+", Fplus, 0, MANY, 0, /* | |
| 2037 Return sum of any number of arguments. | |
| 2038 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
|
2039 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2040 arguments: (&rest ARGS) |
| 428 | 2041 */ |
| 2042 (int nargs, Lisp_Object *args)) | |
| 2043 { | |
| 1983 | 2044 #ifdef WITH_NUMBER_TYPES |
| 2045 REGISTER int i; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2046 Lisp_Object accum = make_fixnum (0), addend; |
| 1983 | 2047 |
| 2048 for (i = 0; i < nargs; i++) | |
| 2049 { | |
| 2050 addend = args[i]; | |
| 2051 switch (promote_args (&accum, &addend)) | |
| 2052 { | |
| 2053 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2054 accum = make_integer (XREALFIXNUM (accum) + XREALFIXNUM (addend)); |
| 1983 | 2055 break; |
| 2056 #ifdef HAVE_BIGNUM | |
| 2057 case BIGNUM_T: | |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5582
diff
changeset
|
2058 bignum_add (XBIGNUM_DATA (accum), XBIGNUM_DATA (accum), |
| 1983 | 2059 XBIGNUM_DATA (addend)); |
| 2060 break; | |
| 2061 #endif | |
| 2062 #ifdef HAVE_RATIO | |
| 2063 case RATIO_T: | |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5582
diff
changeset
|
2064 ratio_add (XRATIO_DATA (accum), XRATIO_DATA (accum), |
| 1983 | 2065 XRATIO_DATA (addend)); |
| 2066 break; | |
| 2067 #endif | |
| 2068 case FLOAT_T: | |
| 2069 accum = make_float (XFLOAT_DATA (accum) + XFLOAT_DATA (addend)); | |
| 2070 break; | |
| 2071 #ifdef HAVE_BIGFLOAT | |
| 2072 case BIGFLOAT_T: | |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5582
diff
changeset
|
2073 bigfloat_set_prec (XBIGFLOAT_DATA (accum), |
| 1983 | 2074 max (XBIGFLOAT_GET_PREC (addend), |
| 2075 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
|
2076 bigfloat_add (XBIGFLOAT_DATA (accum), XBIGFLOAT_DATA (accum), |
| 1983 | 2077 XBIGFLOAT_DATA (addend)); |
| 2078 break; | |
| 2079 #endif | |
| 2080 } | |
| 2081 } | |
| 2082 return Fcanonicalize_number (accum); | |
| 2083 #else /* !WITH_NUMBER_TYPES */ | |
| 428 | 2084 EMACS_INT iaccum = 0; |
| 2085 Lisp_Object *args_end = args + nargs; | |
| 2086 | |
| 2087 while (args < args_end) | |
| 2088 { | |
| 2089 int_or_double iod; | |
| 2090 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2091 if (iod.int_p) | |
| 2092 iaccum += iod.c.ival; | |
| 2093 else | |
| 2094 { | |
| 2095 double daccum = (double) iaccum + iod.c.dval; | |
| 2096 while (args < args_end) | |
| 2097 daccum += number_char_or_marker_to_double (*args++); | |
| 2098 return make_float (daccum); | |
| 2099 } | |
| 2100 } | |
| 2101 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2102 return make_fixnum (iaccum); |
| 1983 | 2103 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 2104 } |
| 2105 | |
| 2106 DEFUN ("-", Fminus, 1, MANY, 0, /* | |
| 2107 Negate number or subtract numbers, characters or markers. | |
| 2108 With one arg, negates it. With more than one arg, | |
| 2109 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
|
2110 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2111 arguments: (FIRST &rest ARGS) |
| 428 | 2112 */ |
| 2113 (int nargs, Lisp_Object *args)) | |
| 2114 { | |
| 1983 | 2115 #ifdef WITH_NUMBER_TYPES |
| 2116 REGISTER int i; | |
| 2117 Lisp_Object accum = args[0], subtrahend; | |
| 2118 | |
| 2119 if (nargs == 1) | |
| 2120 { | |
| 2121 if (CHARP (accum)) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2122 accum = make_fixnum (XCHAR (accum)); |
| 1983 | 2123 else if (MARKERP (accum)) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2124 accum = make_fixnum (marker_position (accum)); |
| 1983 | 2125 |
| 2126 /* Invert the sign of accum */ | |
| 2127 CHECK_NUMBER (accum); | |
| 2128 switch (get_number_type (accum)) | |
| 2129 { | |
| 2130 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2131 return make_integer (-XREALFIXNUM (accum)); |
| 1983 | 2132 #ifdef HAVE_BIGNUM |
| 2133 case BIGNUM_T: | |
| 2134 bignum_neg (scratch_bignum, XBIGNUM_DATA (accum)); | |
| 2135 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
| 2136 #endif | |
| 2137 #ifdef HAVE_RATIO | |
| 2138 case RATIO_T: | |
| 2139 ratio_neg (scratch_ratio, XRATIO_DATA (accum)); | |
| 2140 return make_ratio_rt (scratch_ratio); | |
| 2141 #endif | |
| 2142 case FLOAT_T: | |
| 2143 return make_float (-XFLOAT_DATA (accum)); | |
| 2144 #ifdef HAVE_BIGFLOAT | |
| 2145 case BIGFLOAT_T: | |
| 2146 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (accum)); | |
| 2147 bigfloat_neg (scratch_bigfloat, XBIGFLOAT_DATA (accum)); | |
| 2148 return make_bigfloat_bf (scratch_bigfloat); | |
| 2149 #endif | |
| 2150 } | |
| 2151 } | |
| 2152 else | |
| 2153 { | |
| 2154 /* Subtrace the remaining arguments from accum */ | |
| 2155 for (i = 1; i < nargs; i++) | |
| 2156 { | |
| 2157 subtrahend = args[i]; | |
| 2158 switch (promote_args (&accum, &subtrahend)) | |
| 2159 { | |
| 2160 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2161 accum = make_integer (XREALFIXNUM (accum) - XREALFIXNUM (subtrahend)); |
| 1983 | 2162 break; |
| 2163 #ifdef HAVE_BIGNUM | |
| 2164 case BIGNUM_T: | |
| 2165 bignum_sub (scratch_bignum, XBIGNUM_DATA (accum), | |
| 2166 XBIGNUM_DATA (subtrahend)); | |
| 2167 accum = make_bignum_bg (scratch_bignum); | |
| 2168 break; | |
| 2169 #endif | |
| 2170 #ifdef HAVE_RATIO | |
| 2171 case RATIO_T: | |
| 2172 ratio_sub (scratch_ratio, XRATIO_DATA (accum), | |
| 2173 XRATIO_DATA (subtrahend)); | |
| 2174 accum = make_ratio_rt (scratch_ratio); | |
| 2175 break; | |
| 2176 #endif | |
| 2177 case FLOAT_T: | |
| 2178 accum = | |
| 2179 make_float (XFLOAT_DATA (accum) - XFLOAT_DATA (subtrahend)); | |
| 2180 break; | |
| 2181 #ifdef HAVE_BIGFLOAT | |
| 2182 case BIGFLOAT_T: | |
| 2183 bigfloat_set_prec (scratch_bigfloat, | |
| 2184 max (XBIGFLOAT_GET_PREC (subtrahend), | |
| 2185 XBIGFLOAT_GET_PREC (accum))); | |
| 2186 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (accum), | |
| 2187 XBIGFLOAT_DATA (subtrahend)); | |
| 2188 accum = make_bigfloat_bf (scratch_bigfloat); | |
| 2189 break; | |
| 2190 #endif | |
| 2191 } | |
| 2192 } | |
| 2193 } | |
| 2194 return Fcanonicalize_number (accum); | |
| 2195 #else /* !WITH_NUMBER_TYPES */ | |
| 428 | 2196 EMACS_INT iaccum; |
| 2197 double daccum; | |
| 2198 Lisp_Object *args_end = args + nargs; | |
| 2199 int_or_double iod; | |
| 2200 | |
| 2201 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2202 if (iod.int_p) | |
| 2203 iaccum = nargs > 1 ? iod.c.ival : - iod.c.ival; | |
| 2204 else | |
| 2205 { | |
| 2206 daccum = nargs > 1 ? iod.c.dval : - iod.c.dval; | |
| 2207 goto do_float; | |
| 2208 } | |
| 2209 | |
| 2210 while (args < args_end) | |
| 2211 { | |
| 2212 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2213 if (iod.int_p) | |
| 2214 iaccum -= iod.c.ival; | |
| 2215 else | |
| 2216 { | |
| 2217 daccum = (double) iaccum - iod.c.dval; | |
| 2218 goto do_float; | |
| 2219 } | |
| 2220 } | |
| 2221 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2222 return make_fixnum (iaccum); |
| 428 | 2223 |
| 2224 do_float: | |
| 2225 for (; args < args_end; args++) | |
| 2226 daccum -= number_char_or_marker_to_double (*args); | |
| 2227 return make_float (daccum); | |
| 1983 | 2228 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 2229 } |
| 2230 | |
| 2231 DEFUN ("*", Ftimes, 0, MANY, 0, /* | |
| 2232 Return product of any number of arguments. | |
| 2233 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
|
2234 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2235 arguments: (&rest ARGS) |
| 428 | 2236 */ |
| 2237 (int nargs, Lisp_Object *args)) | |
| 2238 { | |
| 1983 | 2239 #ifdef WITH_NUMBER_TYPES |
| 2240 REGISTER int i; | |
| 2241 /* Start with a bignum to avoid overflow */ | |
| 2242 Lisp_Object accum = make_bignum (1L), multiplier; | |
| 2243 | |
| 2244 for (i = 0; i < nargs; i++) | |
| 2245 { | |
| 2246 multiplier = args[i]; | |
| 2247 switch (promote_args (&accum, &multiplier)) | |
| 2248 { | |
| 2249 #ifdef HAVE_BIGNUM | |
| 2250 case BIGNUM_T: | |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5582
diff
changeset
|
2251 bignum_mul (XBIGNUM_DATA (accum), XBIGNUM_DATA (accum), |
| 1983 | 2252 XBIGNUM_DATA (multiplier)); |
| 2253 break; | |
| 2254 #endif | |
| 2255 #ifdef HAVE_RATIO | |
| 2256 case RATIO_T: | |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5582
diff
changeset
|
2257 ratio_mul (XRATIO_DATA (accum), XRATIO_DATA (accum), |
| 1983 | 2258 XRATIO_DATA (multiplier)); |
| 2259 break; | |
| 2260 #endif | |
| 2261 case FLOAT_T: | |
| 2262 accum = make_float (XFLOAT_DATA (accum) * XFLOAT_DATA (multiplier)); | |
| 2263 break; | |
| 2264 #ifdef HAVE_BIGFLOAT | |
| 2265 case BIGFLOAT_T: | |
|
5736
3192994c49ca
Convert C (un)signed long long values to bignums properly.
Jerry James <james@xemacs.org>
parents:
5582
diff
changeset
|
2266 bigfloat_set_prec (XBIGFLOAT_DATA (accum), |
| 1983 | 2267 max (XBIGFLOAT_GET_PREC (multiplier), |
| 2268 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
|
2269 bigfloat_mul (XBIGFLOAT_DATA (accum), XBIGFLOAT_DATA (accum), |
| 1983 | 2270 XBIGFLOAT_DATA (multiplier)); |
| 2271 break; | |
| 2272 #endif | |
| 2273 } | |
| 2274 } | |
| 2275 return Fcanonicalize_number (accum); | |
| 2276 #else /* !WITH_NUMBER_TYPES */ | |
| 428 | 2277 EMACS_INT iaccum = 1; |
| 2278 Lisp_Object *args_end = args + nargs; | |
| 2279 | |
| 2280 while (args < args_end) | |
| 2281 { | |
| 2282 int_or_double iod; | |
| 2283 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2284 if (iod.int_p) | |
| 2285 iaccum *= iod.c.ival; | |
| 2286 else | |
| 2287 { | |
| 2288 double daccum = (double) iaccum * iod.c.dval; | |
| 2289 while (args < args_end) | |
| 2290 daccum *= number_char_or_marker_to_double (*args++); | |
| 2291 return make_float (daccum); | |
| 2292 } | |
| 2293 } | |
| 2294 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2295 return make_fixnum (iaccum); |
| 1983 | 2296 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 2297 } |
| 2298 | |
| 1983 | 2299 #ifdef HAVE_RATIO |
| 2300 DEFUN ("div", Fdiv, 1, MANY, 0, /* | |
| 2301 Same as `/', but dividing integers creates a ratio instead of truncating. | |
| 2302 Note that this is a departure from Common Lisp, where / creates ratios when | |
| 2303 dividing integers. Having a separate function lets us avoid breaking existing | |
| 2304 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
|
2305 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2306 arguments: (FIRST &rest ARGS) |
| 1983 | 2307 */ |
| 2308 (int nargs, Lisp_Object *args)) | |
| 2309 { | |
| 2310 REGISTER int i; | |
| 2311 Lisp_Object accum, divisor; | |
| 2312 | |
| 2313 if (nargs == 1) | |
| 2314 { | |
| 2315 i = 0; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2316 accum = make_fixnum (1); |
| 1983 | 2317 } |
| 2318 else | |
| 2319 { | |
| 2320 i = 1; | |
| 2321 accum = args[0]; | |
| 2322 } | |
| 2323 for (; i < nargs; i++) | |
| 2324 { | |
| 2325 divisor = args[i]; | |
| 2326 switch (promote_args (&accum, &divisor)) | |
| 2327 { | |
| 2328 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2329 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
|
2330 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
|
2331 bignum_set_long (scratch_bignum2, XREALFIXNUM (divisor)); |
| 1983 | 2332 accum = make_ratio_bg (scratch_bignum, scratch_bignum2); |
| 2333 break; | |
| 2334 case BIGNUM_T: | |
| 2335 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0) goto divide_by_zero; | |
| 2336 accum = make_ratio_bg (XBIGNUM_DATA (accum), XBIGNUM_DATA (divisor)); | |
| 2337 break; | |
| 2338 case RATIO_T: | |
| 2339 if (ratio_sign (XRATIO_DATA (divisor)) == 0) goto divide_by_zero; | |
| 2340 ratio_div (scratch_ratio, XRATIO_DATA (accum), | |
| 2341 XRATIO_DATA (divisor)); | |
| 2342 accum = make_ratio_rt (scratch_ratio); | |
| 2343 break; | |
| 2344 case FLOAT_T: | |
| 2345 if (XFLOAT_DATA (divisor) == 0.0) goto divide_by_zero; | |
| 2346 accum = make_float (XFLOAT_DATA (accum) / XFLOAT_DATA (divisor)); | |
| 2347 break; | |
| 2348 #ifdef HAVE_BIGFLOAT | |
| 2349 case BIGFLOAT_T: | |
| 2350 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0) | |
| 2351 goto divide_by_zero; | |
| 2352 bigfloat_set_prec (scratch_bigfloat, | |
| 2353 max (XBIGFLOAT_GET_PREC (divisor), | |
| 2354 XBIGFLOAT_GET_PREC (accum))); | |
| 2355 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (accum), | |
| 2356 XBIGFLOAT_DATA (divisor)); | |
| 2357 accum = make_bigfloat_bf (scratch_bigfloat); | |
| 2358 break; | |
| 2359 #endif | |
| 2360 } | |
| 2361 } | |
| 2362 return Fcanonicalize_number (accum); | |
| 2363 | |
| 2364 divide_by_zero: | |
| 2365 Fsignal (Qarith_error, Qnil); | |
| 2366 return Qnil; /* not (usually) reached */ | |
| 2367 } | |
| 2368 #endif /* HAVE_RATIO */ | |
| 2369 | |
| 428 | 2370 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
|
2371 Return FIRST divided by all the remaining arguments. |
| 428 | 2372 The arguments must be numbers, characters or markers. |
| 2373 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
|
2374 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2375 arguments: (FIRST &rest ARGS) |
| 428 | 2376 */ |
| 2377 (int nargs, Lisp_Object *args)) | |
| 2378 { | |
| 1983 | 2379 #ifdef WITH_NUMBER_TYPES |
| 2380 REGISTER int i; | |
| 2381 Lisp_Object accum, divisor; | |
| 2382 | |
| 2383 if (nargs == 1) | |
| 2384 { | |
| 2385 i = 0; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2386 accum = make_fixnum (1); |
| 1983 | 2387 } |
| 2388 else | |
| 2389 { | |
| 2390 i = 1; | |
| 2391 accum = args[0]; | |
| 2392 } | |
| 2393 for (; i < nargs; i++) | |
| 2394 { | |
| 2395 divisor = args[i]; | |
| 2396 switch (promote_args (&accum, &divisor)) | |
| 2397 { | |
| 2398 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2399 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
|
2400 accum = make_integer (XREALFIXNUM (accum) / XREALFIXNUM (divisor)); |
| 1983 | 2401 break; |
| 2402 #ifdef HAVE_BIGNUM | |
| 2403 case BIGNUM_T: | |
| 2404 if (bignum_sign (XBIGNUM_DATA (divisor)) == 0) goto divide_by_zero; | |
| 2405 bignum_div (scratch_bignum, XBIGNUM_DATA (accum), | |
| 2406 XBIGNUM_DATA (divisor)); | |
| 2407 accum = make_bignum_bg (scratch_bignum); | |
| 2408 break; | |
| 2409 #endif | |
| 2410 #ifdef HAVE_RATIO | |
| 2411 case RATIO_T: | |
| 2412 if (ratio_sign (XRATIO_DATA (divisor)) == 0) goto divide_by_zero; | |
| 2413 ratio_div (scratch_ratio, XRATIO_DATA (accum), | |
| 2414 XRATIO_DATA (divisor)); | |
| 2415 accum = make_ratio_rt (scratch_ratio); | |
| 2416 break; | |
| 2417 #endif | |
| 2418 case FLOAT_T: | |
| 2419 if (XFLOAT_DATA (divisor) == 0.0) goto divide_by_zero; | |
| 2420 accum = make_float (XFLOAT_DATA (accum) / XFLOAT_DATA (divisor)); | |
| 2421 break; | |
| 2422 #ifdef HAVE_BIGFLOAT | |
| 2423 case BIGFLOAT_T: | |
| 2424 if (bigfloat_sign (XBIGFLOAT_DATA (divisor)) == 0) | |
| 2425 goto divide_by_zero; | |
| 2426 bigfloat_set_prec (scratch_bigfloat, | |
| 2427 max (XBIGFLOAT_GET_PREC (divisor), | |
| 2428 XBIGFLOAT_GET_PREC (accum))); | |
| 2429 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (accum), | |
| 2430 XBIGFLOAT_DATA (divisor)); | |
| 2431 accum = make_bigfloat_bf (scratch_bigfloat); | |
| 2432 break; | |
| 2433 #endif | |
| 2434 } | |
| 2435 } | |
| 2436 return Fcanonicalize_number (accum); | |
| 2437 #else /* !WITH_NUMBER_TYPES */ | |
| 428 | 2438 EMACS_INT iaccum; |
| 2439 double daccum; | |
| 2440 Lisp_Object *args_end = args + nargs; | |
| 2441 int_or_double iod; | |
| 2442 | |
| 2443 if (nargs == 1) | |
| 2444 iaccum = 1; | |
| 2445 else | |
| 2446 { | |
| 2447 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2448 if (iod.int_p) | |
| 2449 iaccum = iod.c.ival; | |
| 2450 else | |
| 2451 { | |
| 2452 daccum = iod.c.dval; | |
| 2453 goto divide_floats; | |
| 2454 } | |
| 2455 } | |
| 2456 | |
| 2457 while (args < args_end) | |
| 2458 { | |
| 2459 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2460 if (iod.int_p) | |
| 2461 { | |
| 2462 if (iod.c.ival == 0) goto divide_by_zero; | |
| 2463 iaccum /= iod.c.ival; | |
| 2464 } | |
| 2465 else | |
| 2466 { | |
| 2467 if (iod.c.dval == 0) goto divide_by_zero; | |
| 2468 daccum = (double) iaccum / iod.c.dval; | |
| 2469 goto divide_floats; | |
| 2470 } | |
| 2471 } | |
| 2472 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2473 return make_fixnum (iaccum); |
| 428 | 2474 |
| 2475 divide_floats: | |
| 2476 for (; args < args_end; args++) | |
| 2477 { | |
| 2478 double dval = number_char_or_marker_to_double (*args); | |
| 2479 if (dval == 0) goto divide_by_zero; | |
| 2480 daccum /= dval; | |
| 2481 } | |
| 2482 return make_float (daccum); | |
| 1983 | 2483 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 2484 |
| 2485 divide_by_zero: | |
| 2486 Fsignal (Qarith_error, Qnil); | |
| 801 | 2487 return Qnil; /* not (usually) reached */ |
| 428 | 2488 } |
| 2489 | |
| 2490 DEFUN ("max", Fmax, 1, MANY, 0, /* | |
| 2491 Return largest of all the arguments. | |
| 1983 | 2492 All arguments must be real numbers, characters or markers. |
| 428 | 2493 The value is always a number; markers and characters are converted |
| 2494 to numbers. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2495 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2496 arguments: (FIRST &rest ARGS) |
| 428 | 2497 */ |
| 2498 (int nargs, Lisp_Object *args)) | |
| 2499 { | |
| 1983 | 2500 #ifdef WITH_NUMBER_TYPES |
| 2501 REGISTER int i, maxindex = 0; | |
| 2502 | |
| 2503 while (!(CHARP (args[0]) || MARKERP (args[0]) || REALP (args[0]))) | |
| 2504 args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]); | |
| 2505 if (CHARP (args[0])) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2506 args[0] = make_fixnum (XCHAR (args[0])); |
| 1983 | 2507 else if (MARKERP (args[0])) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2508 args[0] = make_fixnum (marker_position (args[0])); |
| 1983 | 2509 for (i = 1; i < nargs; i++) |
| 2510 { | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2511 switch (promote_args (args + maxindex, args + i)) |
| 1983 | 2512 { |
| 2513 case FIXNUM_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2514 if (XREALFIXNUM (args[maxindex]) < XREALFIXNUM (args[i])) |
| 1983 | 2515 maxindex = i; |
| 2516 break; | |
| 2517 #ifdef HAVE_BIGNUM | |
| 2518 case BIGNUM_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2519 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
|
2520 XBIGNUM_DATA (args[i]))) |
| 1983 | 2521 maxindex = i; |
| 2522 break; | |
| 2523 #endif | |
| 2524 #ifdef HAVE_RATIO | |
| 2525 case RATIO_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2526 if (ratio_lt (XRATIO_DATA (args[maxindex]), XRATIO_DATA (args[i]))) |
| 1983 | 2527 maxindex = i; |
| 2528 break; | |
| 2529 #endif | |
| 2530 case FLOAT_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2531 if (XFLOAT_DATA (args[maxindex]) < XFLOAT_DATA (args[i])) |
| 1983 | 2532 maxindex = i; |
| 2533 break; | |
| 2534 #ifdef HAVE_BIGFLOAT | |
| 2535 case BIGFLOAT_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2536 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
|
2537 XBIGFLOAT_DATA (args[i]))) |
| 1983 | 2538 maxindex = i; |
| 2539 break; | |
| 2540 #endif | |
| 2541 } | |
| 2542 } | |
| 2543 return args[maxindex]; | |
| 2544 #else /* !WITH_NUMBER_TYPES */ | |
| 428 | 2545 EMACS_INT imax; |
| 2546 double dmax; | |
| 2547 Lisp_Object *args_end = args + nargs; | |
| 2548 int_or_double iod; | |
| 2549 | |
| 2550 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2551 if (iod.int_p) | |
| 2552 imax = iod.c.ival; | |
| 2553 else | |
| 2554 { | |
| 2555 dmax = iod.c.dval; | |
| 2556 goto max_floats; | |
| 2557 } | |
| 2558 | |
| 2559 while (args < args_end) | |
| 2560 { | |
| 2561 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2562 if (iod.int_p) | |
| 2563 { | |
| 2564 if (imax < iod.c.ival) imax = iod.c.ival; | |
| 2565 } | |
| 2566 else | |
| 2567 { | |
| 2568 dmax = (double) imax; | |
| 2569 if (dmax < iod.c.dval) dmax = iod.c.dval; | |
| 2570 goto max_floats; | |
| 2571 } | |
| 2572 } | |
| 2573 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2574 return make_fixnum (imax); |
| 428 | 2575 |
| 2576 max_floats: | |
| 2577 while (args < args_end) | |
| 2578 { | |
| 2579 double dval = number_char_or_marker_to_double (*args++); | |
| 2580 if (dmax < dval) dmax = dval; | |
| 2581 } | |
| 2582 return make_float (dmax); | |
| 1983 | 2583 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 2584 } |
| 2585 | |
| 2586 DEFUN ("min", Fmin, 1, MANY, 0, /* | |
| 2587 Return smallest of all the arguments. | |
| 2588 All arguments must be numbers, characters or markers. | |
| 2589 The value is always a number; markers and characters are converted | |
| 2590 to numbers. | |
|
4693
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2591 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2592 arguments: (FIRST &rest ARGS) |
| 428 | 2593 */ |
| 2594 (int nargs, Lisp_Object *args)) | |
| 2595 { | |
| 1983 | 2596 #ifdef WITH_NUMBER_TYPES |
| 2597 REGISTER int i, minindex = 0; | |
| 2598 | |
| 2599 while (!(CHARP (args[0]) || MARKERP (args[0]) || REALP (args[0]))) | |
| 2600 args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]); | |
| 2601 if (CHARP (args[0])) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2602 args[0] = make_fixnum (XCHAR (args[0])); |
| 1983 | 2603 else if (MARKERP (args[0])) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2604 args[0] = make_fixnum (marker_position (args[0])); |
| 1983 | 2605 for (i = 1; i < nargs; i++) |
| 2606 { | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2607 switch (promote_args (args + minindex, args + i)) |
| 1983 | 2608 { |
| 2609 case FIXNUM_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2610 if (XREALFIXNUM (args[minindex]) > XREALFIXNUM (args[i])) |
| 1983 | 2611 minindex = i; |
| 2612 break; | |
| 2613 #ifdef HAVE_BIGNUM | |
| 2614 case BIGNUM_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2615 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
|
2616 XBIGNUM_DATA (args[i]))) |
| 1983 | 2617 minindex = i; |
| 2618 break; | |
| 2619 #endif | |
| 2620 #ifdef HAVE_RATIO | |
| 2621 case RATIO_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2622 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
|
2623 XRATIO_DATA (args[i]))) |
| 1983 | 2624 minindex = i; |
| 2625 break; | |
| 2626 #endif | |
| 2627 case FLOAT_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2628 if (XFLOAT_DATA (args[minindex]) > XFLOAT_DATA (args[i])) |
| 1983 | 2629 minindex = i; |
| 2630 break; | |
| 2631 #ifdef HAVE_BIGFLOAT | |
| 2632 case BIGFLOAT_T: | |
|
5768
3bfcdeb65578
Return a fixnum as documented with marker arg, #'max, #'min
Aidan Kehoe <kehoea@parhasard.net>
parents:
5762
diff
changeset
|
2633 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
|
2634 XBIGFLOAT_DATA (args[i]))) |
| 1983 | 2635 minindex = i; |
| 2636 break; | |
| 2637 #endif | |
| 2638 } | |
| 2639 } | |
| 2640 return args[minindex]; | |
| 2641 #else /* !WITH_NUMBER_TYPES */ | |
| 428 | 2642 EMACS_INT imin; |
| 2643 double dmin; | |
| 2644 Lisp_Object *args_end = args + nargs; | |
| 2645 int_or_double iod; | |
| 2646 | |
| 2647 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2648 if (iod.int_p) | |
| 2649 imin = iod.c.ival; | |
| 2650 else | |
| 2651 { | |
| 2652 dmin = iod.c.dval; | |
| 2653 goto min_floats; | |
| 2654 } | |
| 2655 | |
| 2656 while (args < args_end) | |
| 2657 { | |
| 2658 number_char_or_marker_to_int_or_double (*args++, &iod); | |
| 2659 if (iod.int_p) | |
| 2660 { | |
| 2661 if (imin > iod.c.ival) imin = iod.c.ival; | |
| 2662 } | |
| 2663 else | |
| 2664 { | |
| 2665 dmin = (double) imin; | |
| 2666 if (dmin > iod.c.dval) dmin = iod.c.dval; | |
| 2667 goto min_floats; | |
| 2668 } | |
| 2669 } | |
| 2670 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2671 return make_fixnum (imin); |
| 428 | 2672 |
| 2673 min_floats: | |
| 2674 while (args < args_end) | |
| 2675 { | |
| 2676 double dval = number_char_or_marker_to_double (*args++); | |
| 2677 if (dmin > dval) dmin = dval; | |
| 2678 } | |
| 2679 return make_float (dmin); | |
| 1983 | 2680 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 2681 } |
| 2682 | |
| 2683 DEFUN ("logand", Flogand, 0, MANY, 0, /* | |
| 2684 Return bitwise-and of all the arguments. | |
| 2685 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
|
2686 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2687 arguments: (&rest ARGS) |
| 428 | 2688 */ |
| 2689 (int nargs, Lisp_Object *args)) | |
| 2690 { | |
| 1983 | 2691 #ifdef HAVE_BIGNUM |
| 2692 REGISTER int i; | |
| 2693 Lisp_Object result, other; | |
| 2694 | |
| 2695 if (nargs == 0) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2696 return make_fixnum (~0); |
| 1983 | 2697 |
| 2698 while (!(CHARP (args[0]) || MARKERP (args[0]) || INTEGERP (args[0]))) | |
| 2699 args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]); | |
| 2700 | |
| 2701 result = args[0]; | |
| 2702 if (CHARP (result)) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2703 result = make_fixnum (XCHAR (result)); |
| 1983 | 2704 else if (MARKERP (result)) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2705 result = make_fixnum (marker_position (result)); |
| 1983 | 2706 for (i = 1; i < nargs; i++) |
| 2707 { | |
| 2708 while (!(CHARP (args[i]) || MARKERP (args[i]) || INTEGERP (args[i]))) | |
| 2709 args[i] = wrong_type_argument (Qnumber_char_or_marker_p, args[i]); | |
| 2710 other = args[i]; | |
| 1995 | 2711 switch (promote_args (&result, &other)) |
| 1983 | 2712 { |
| 2713 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2714 result = make_fixnum (XREALFIXNUM (result) & XREALFIXNUM (other)); |
| 1983 | 2715 break; |
| 2716 case BIGNUM_T: | |
| 2717 bignum_and (scratch_bignum, XBIGNUM_DATA (result), | |
| 2718 XBIGNUM_DATA (other)); | |
| 2719 result = make_bignum_bg (scratch_bignum); | |
| 2720 break; | |
| 2721 } | |
| 2722 } | |
| 2723 return Fcanonicalize_number (result); | |
| 2724 #else /* !HAVE_BIGNUM */ | |
| 428 | 2725 EMACS_INT bits = ~0; |
| 2726 Lisp_Object *args_end = args + nargs; | |
| 2727 | |
| 2728 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
|
2729 bits &= fixnum_char_or_marker_to_int (*args++); |
| 428 | 2730 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2731 return make_fixnum (bits); |
| 1983 | 2732 #endif /* HAVE_BIGNUM */ |
| 428 | 2733 } |
| 2734 | |
| 2735 DEFUN ("logior", Flogior, 0, MANY, 0, /* | |
| 2736 Return bitwise-or of all the arguments. | |
| 2737 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
|
2738 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2739 arguments: (&rest ARGS) |
| 428 | 2740 */ |
| 2741 (int nargs, Lisp_Object *args)) | |
| 2742 { | |
| 1983 | 2743 #ifdef HAVE_BIGNUM |
| 2744 REGISTER int i; | |
| 2745 Lisp_Object result, other; | |
| 2746 | |
| 2747 if (nargs == 0) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2748 return make_fixnum (0); |
| 1983 | 2749 |
| 2750 while (!(CHARP (args[0]) || MARKERP (args[0]) || INTEGERP (args[0]))) | |
| 2751 args[0] = wrong_type_argument (Qnumber_char_or_marker_p, args[0]); | |
| 2752 | |
| 2753 result = args[0]; | |
| 2754 if (CHARP (result)) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2755 result = make_fixnum (XCHAR (result)); |
| 1983 | 2756 else if (MARKERP (result)) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2757 result = make_fixnum (marker_position (result)); |
| 1983 | 2758 for (i = 1; i < nargs; i++) |
| 2759 { | |
| 2760 while (!(CHARP (args[i]) || MARKERP (args[i]) || INTEGERP (args[i]))) | |
| 2761 args[i] = wrong_type_argument (Qnumber_char_or_marker_p, args[i]); | |
| 2762 other = args[i]; | |
| 2763 switch (promote_args (&result, &other)) | |
| 2764 { | |
| 2765 case FIXNUM_T: | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2766 result = make_fixnum (XREALFIXNUM (result) | XREALFIXNUM (other)); |
| 1983 | 2767 break; |
| 2768 case BIGNUM_T: | |
| 2769 bignum_ior (scratch_bignum, XBIGNUM_DATA (result), | |
| 2770 XBIGNUM_DATA (other)); | |
| 2771 result = make_bignum_bg (scratch_bignum); | |
| 2772 break; | |
| 2773 } | |
| 2774 } | |
| 2775 return Fcanonicalize_number (result); | |
| 2776 #else /* !HAVE_BIGNUM */ | |
| 428 | 2777 EMACS_INT bits = 0; |
| 2778 Lisp_Object *args_end = args + nargs; | |
| 2779 | |
| 2780 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
|
2781 bits |= fixnum_char_or_marker_to_int (*args++); |
| 428 | 2782 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2783 return make_fixnum (bits); |
| 1983 | 2784 #endif /* HAVE_BIGNUM */ |
| 428 | 2785 } |
| 2786 | |
| 2787 DEFUN ("logxor", Flogxor, 0, MANY, 0, /* | |
| 2788 Return bitwise-exclusive-or of all the arguments. | |
| 2789 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
|
2790 |
|
80cd90837ac5
Add argument information to remaining MANY or UNEVALLED C subrs.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3355
diff
changeset
|
2791 arguments: (&rest ARGS) |
| 428 | 2792 */ |
| 2793 (int nargs, Lisp_Object *args)) | |
| 2794 { | |
| 1983 | 2795 #ifdef HAVE_BIGNUM |
| 2796 REGISTER int i; | |
| 2797 Lisp_Object result, other; | |
| 2798 | |
| 2799 if (nargs == 0) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2800 return make_fixnum (0); |
| 1983 | 2801 |
| 2802 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
|
2803 args[0] = wrong_type_argument (Qinteger_char_or_marker_p, args[0]); |
| 1983 | 2804 |
| 2805 result = args[0]; | |
| 2806 if (CHARP (result)) | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2807 result = make_fixnum (XCHAR (result)); |
| 1983 | 2808 else if (MARKERP (result)) |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2809 result = make_fixnum (marker_position (result)); |
| 1983 | 2810 for (i = 1; i < nargs; i++) |
| 2811 { | |
| 2812 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
|
2813 args[i] = wrong_type_argument (Qinteger_char_or_marker_p, args[i]); |
| 1983 | 2814 other = args[i]; |
| 2815 if (promote_args (&result, &other) == FIXNUM_T) | |
| 2816 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2817 result = make_fixnum (XREALFIXNUM (result) ^ XREALFIXNUM (other)); |
| 1983 | 2818 } |
| 2819 else | |
| 2820 { | |
| 2821 bignum_xor (scratch_bignum, XBIGNUM_DATA (result), | |
| 2822 XBIGNUM_DATA (other)); | |
| 2823 result = make_bignum_bg (scratch_bignum); | |
| 2824 } | |
| 2825 } | |
| 2826 return Fcanonicalize_number (result); | |
| 2827 #else /* !HAVE_BIGNUM */ | |
| 428 | 2828 EMACS_INT bits = 0; |
| 2829 Lisp_Object *args_end = args + nargs; | |
| 2830 | |
| 2831 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
|
2832 bits ^= fixnum_char_or_marker_to_int (*args++); |
| 428 | 2833 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2834 return make_fixnum (bits); |
| 1983 | 2835 #endif /* !HAVE_BIGNUM */ |
| 428 | 2836 } |
| 2837 | |
| 2838 DEFUN ("lognot", Flognot, 1, 1, 0, /* | |
| 2839 Return the bitwise complement of NUMBER. | |
| 2840 NUMBER may be an integer, marker or character converted to integer. | |
| 2841 */ | |
| 2842 (number)) | |
| 2843 { | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
2844 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
|
2845 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
|
2846 |
| 1983 | 2847 #ifdef HAVE_BIGNUM |
| 2848 if (BIGNUMP (number)) | |
| 2849 { | |
| 2850 bignum_not (scratch_bignum, XBIGNUM_DATA (number)); | |
| 2851 return make_bignum_bg (scratch_bignum); | |
| 2852 } | |
| 2853 #endif /* HAVE_BIGNUM */ | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
2854 |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2855 return make_fixnum (~ fixnum_char_or_marker_to_int (number)); |
| 428 | 2856 } |
| 2857 | |
| 2858 DEFUN ("%", Frem, 2, 2, 0, /* | |
| 2859 Return remainder of first arg divided by second. | |
| 2860 Both must be integers, characters or markers. | |
| 2861 */ | |
| 444 | 2862 (number1, number2)) |
| 428 | 2863 { |
| 1983 | 2864 #ifdef HAVE_BIGNUM |
| 2865 while (!(CHARP (number1) || MARKERP (number1) || INTEGERP (number1))) | |
| 2866 number1 = wrong_type_argument (Qnumber_char_or_marker_p, number1); | |
| 2867 while (!(CHARP (number2) || MARKERP (number2) || INTEGERP (number2))) | |
| 2868 number2 = wrong_type_argument (Qnumber_char_or_marker_p, number2); | |
| 2869 | |
| 2870 if (promote_args (&number1, &number2) == FIXNUM_T) | |
| 2871 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2872 if (XREALFIXNUM (number2) == 0) |
| 1983 | 2873 Fsignal (Qarith_error, Qnil); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2874 return make_fixnum (XREALFIXNUM (number1) % XREALFIXNUM (number2)); |
| 1983 | 2875 } |
| 2876 else | |
| 2877 { | |
| 2878 if (bignum_sign (XBIGNUM_DATA (number2)) == 0) | |
| 2879 Fsignal (Qarith_error, Qnil); | |
| 2880 bignum_mod (scratch_bignum, XBIGNUM_DATA (number1), | |
| 2881 XBIGNUM_DATA (number2)); | |
| 2882 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
| 2883 } | |
| 2884 #else /* !HAVE_BIGNUM */ | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
2885 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
|
2886 EMACS_INT ival2 = fixnum_char_or_marker_to_int (number2); |
| 428 | 2887 |
| 2888 if (ival2 == 0) | |
| 2889 Fsignal (Qarith_error, Qnil); | |
| 2890 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2891 return make_fixnum (ival1 % ival2); |
| 1983 | 2892 #endif /* HAVE_BIGNUM */ |
| 428 | 2893 } |
| 2894 | |
| 2895 /* Note, ANSI *requires* the presence of the fmod() library routine. | |
| 2896 If your system doesn't have it, complain to your vendor, because | |
| 2897 that is a bug. */ | |
| 2898 | |
| 2899 #ifndef HAVE_FMOD | |
| 2900 double | |
| 2901 fmod (double f1, double f2) | |
| 2902 { | |
| 2903 if (f2 < 0.0) | |
| 2904 f2 = -f2; | |
| 2905 return f1 - f2 * floor (f1/f2); | |
| 2906 } | |
| 2907 #endif /* ! HAVE_FMOD */ | |
| 2908 | |
| 2909 | |
| 2910 DEFUN ("mod", Fmod, 2, 2, 0, /* | |
| 2911 Return X modulo Y. | |
| 2912 The result falls between zero (inclusive) and Y (exclusive). | |
| 2913 Both X and Y must be numbers, characters or markers. | |
| 2914 If either argument is a float, a float will be returned. | |
| 2915 */ | |
| 2916 (x, y)) | |
| 2917 { | |
| 1983 | 2918 #ifdef WITH_NUMBER_TYPES |
| 2919 while (!(CHARP (x) || MARKERP (x) || REALP (x))) | |
| 2920 x = wrong_type_argument (Qnumber_char_or_marker_p, x); | |
| 2921 while (!(CHARP (y) || MARKERP (y) || REALP (y))) | |
| 2922 y = wrong_type_argument (Qnumber_char_or_marker_p, y); | |
| 2923 switch (promote_args (&x, &y)) | |
| 2924 { | |
| 2925 case FIXNUM_T: | |
| 2926 { | |
| 2927 EMACS_INT ival; | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2928 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
|
2929 ival = XREALFIXNUM (x) % XREALFIXNUM (y); |
| 1983 | 2930 /* 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
|
2931 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
|
2932 ival += XREALFIXNUM (y); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
2933 return make_fixnum (ival); |
| 1983 | 2934 } |
| 2935 #ifdef HAVE_BIGNUM | |
| 2936 case BIGNUM_T: | |
| 2937 if (bignum_sign (XBIGNUM_DATA (y)) == 0) goto divide_by_zero; | |
| 2938 bignum_mod (scratch_bignum, XBIGNUM_DATA (x), XBIGNUM_DATA (y)); | |
| 2939 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); | |
| 2940 #endif | |
| 2941 #ifdef HAVE_RATIO | |
| 2942 case RATIO_T: | |
| 2943 if (ratio_sign (XRATIO_DATA (y)) == 0) goto divide_by_zero; | |
| 2944 ratio_div (scratch_ratio, XRATIO_DATA (x), XRATIO_DATA (y)); | |
| 2945 bignum_div (scratch_bignum, ratio_numerator (scratch_ratio), | |
| 2946 ratio_denominator (scratch_ratio)); | |
| 2947 ratio_set_bignum (scratch_ratio, scratch_bignum); | |
| 2948 ratio_mul (scratch_ratio, scratch_ratio, XRATIO_DATA (y)); | |
| 2949 ratio_sub (scratch_ratio, XRATIO_DATA (x), scratch_ratio); | |
| 2950 return Fcanonicalize_number (make_ratio_rt (scratch_ratio)); | |
| 2951 #endif | |
| 2952 case FLOAT_T: | |
| 2953 { | |
| 2954 double dval; | |
| 2955 if (XFLOAT_DATA (y) == 0.0) goto divide_by_zero; | |
| 2956 dval = fmod (XFLOAT_DATA (x), XFLOAT_DATA (y)); | |
| 2957 /* If the "remainder" comes out with the wrong sign, fix it. */ | |
| 2958 if (XFLOAT_DATA (y) < 0 ? dval > 0 : dval < 0) | |
| 2959 dval += XFLOAT_DATA (y); | |
| 2960 return make_float (dval); | |
| 2961 } | |
| 2962 #ifdef HAVE_BIGFLOAT | |
| 2963 case BIGFLOAT_T: | |
| 2964 bigfloat_set_prec (scratch_bigfloat, | |
| 2965 max (XBIGFLOAT_GET_PREC (x), XBIGFLOAT_GET_PREC (y))); | |
| 2966 bigfloat_div (scratch_bigfloat, XBIGFLOAT_DATA (x), XBIGFLOAT_DATA (y)); | |
| 2967 bigfloat_trunc (scratch_bigfloat, scratch_bigfloat); | |
| 2968 bigfloat_mul (scratch_bigfloat, scratch_bigfloat, XBIGFLOAT_DATA (y)); | |
| 2969 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (x), scratch_bigfloat); | |
| 2970 return make_bigfloat_bf (scratch_bigfloat); | |
| 2971 #endif | |
| 2972 } | |
| 2973 #else /* !WITH_NUMBER_TYPES */ | |
| 428 | 2974 int_or_double iod1, iod2; |
| 2975 number_char_or_marker_to_int_or_double (x, &iod1); | |
| 2976 number_char_or_marker_to_int_or_double (y, &iod2); | |
| 2977 | |
| 2978 if (!iod1.int_p || !iod2.int_p) | |
| 2979 { | |
| 2980 double dval1 = iod1.int_p ? (double) iod1.c.ival : iod1.c.dval; | |
| 2981 double dval2 = iod2.int_p ? (double) iod2.c.ival : iod2.c.dval; | |
| 2982 if (dval2 == 0) goto divide_by_zero; | |
| 2983 dval1 = fmod (dval1, dval2); | |
| 2984 | |
| 2985 /* If the "remainder" comes out with the wrong sign, fix it. */ | |
| 2986 if (dval2 < 0 ? dval1 > 0 : dval1 < 0) | |
| 2987 dval1 += dval2; | |
| 2988 | |
| 2989 return make_float (dval1); | |
| 2990 } | |
| 1104 | 2991 |
| 428 | 2992 { |
| 2993 EMACS_INT ival; | |
| 2994 if (iod2.c.ival == 0) goto divide_by_zero; | |
| 2995 | |
| 2996 ival = iod1.c.ival % iod2.c.ival; | |
| 2997 | |
| 2998 /* If the "remainder" comes out with the wrong sign, fix it. */ | |
| 2999 if (iod2.c.ival < 0 ? ival > 0 : ival < 0) | |
| 3000 ival += iod2.c.ival; | |
| 3001 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3002 return make_fixnum (ival); |
| 428 | 3003 } |
| 1983 | 3004 #endif /* WITH_NUMBER_TYPES */ |
| 428 | 3005 |
| 3006 divide_by_zero: | |
| 3007 Fsignal (Qarith_error, Qnil); | |
| 801 | 3008 return Qnil; /* not (usually) reached */ |
| 428 | 3009 } |
| 3010 | |
| 3011 DEFUN ("ash", Fash, 2, 2, 0, /* | |
| 3012 Return VALUE with its bits shifted left by COUNT. | |
| 3013 If COUNT is negative, shifting is actually to the right. | |
| 3014 In this case, the sign bit is duplicated. | |
| 1983 | 3015 This function cannot be applied to bignums, as there is no leftmost sign bit |
| 3016 to be duplicated. Use `lsh' instead. | |
| 428 | 3017 */ |
| 3018 (value, count)) | |
| 3019 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3020 CHECK_FIXNUM_COERCE_CHAR (value); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3021 CONCHECK_FIXNUM (count); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3022 |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3023 return make_fixnum (XFIXNUM (count) > 0 ? |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3024 XFIXNUM (value) << XFIXNUM (count) : |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3025 XFIXNUM (value) >> -XFIXNUM (count)); |
| 428 | 3026 } |
| 3027 | |
| 3028 DEFUN ("lsh", Flsh, 2, 2, 0, /* | |
| 3029 Return VALUE with its bits shifted left by COUNT. | |
| 3030 If COUNT is negative, shifting is actually to the right. | |
| 3031 In this case, zeros are shifted in on the left. | |
| 3032 */ | |
| 3033 (value, count)) | |
| 3034 { | |
| 1983 | 3035 #ifdef HAVE_BIGNUM |
| 3036 while (!(CHARP (value) || MARKERP (value) || INTEGERP (value))) | |
| 3037 wrong_type_argument (Qnumber_char_or_marker_p, value); | |
| 3038 CONCHECK_INTEGER (count); | |
| 3039 | |
| 3040 if (promote_args (&value, &count) == FIXNUM_T) | |
| 3041 { | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3042 if (XREALFIXNUM (count) <= 0) |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3043 return make_fixnum (XREALFIXNUM (value) >> -XREALFIXNUM (count)); |
| 1983 | 3044 /* Use bignums to avoid overflow */ |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3045 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
|
3046 bignum_lshift (scratch_bignum, scratch_bignum2, XREALFIXNUM (count)); |
| 1983 | 3047 return Fcanonicalize_number (make_bignum_bg (scratch_bignum)); |
| 3048 } | |
| 3049 else | |
| 3050 { | |
| 3051 if (bignum_sign (XBIGNUM_DATA (count)) <= 0) | |
| 3052 { | |
| 3053 bignum_neg (scratch_bignum, XBIGNUM_DATA (count)); | |
| 3054 if (!bignum_fits_ulong_p (scratch_bignum)) | |
| 3055 args_out_of_range (Qnumber_char_or_marker_p, count); | |
| 3056 bignum_rshift (scratch_bignum2, XBIGNUM_DATA (value), | |
| 3057 bignum_to_ulong (scratch_bignum)); | |
| 3058 } | |
| 3059 else | |
| 3060 { | |
| 3061 if (!bignum_fits_ulong_p (XBIGNUM_DATA (count))) | |
| 3062 args_out_of_range (Qnumber_char_or_marker_p, count); | |
| 3063 bignum_lshift (scratch_bignum2, XBIGNUM_DATA (value), | |
| 3064 bignum_to_ulong (XBIGNUM_DATA (count))); | |
| 3065 } | |
| 3066 return Fcanonicalize_number (make_bignum_bg (scratch_bignum2)); | |
| 3067 } | |
| 3068 #else /* !HAVE_BIGNUM */ | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3069 CHECK_FIXNUM_COERCE_CHAR (value); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3070 CONCHECK_FIXNUM (count); |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3071 |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3072 return make_fixnum (XFIXNUM (count) > 0 ? |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3073 XUINT (value) << XFIXNUM (count) : |
|
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3074 XUINT (value) >> -XFIXNUM (count)); |
| 1983 | 3075 #endif /* HAVE_BIGNUM */ |
| 428 | 3076 } |
| 3077 | |
| 3078 DEFUN ("1+", Fadd1, 1, 1, 0, /* | |
| 3079 Return NUMBER plus one. NUMBER may be a number, character or marker. | |
| 3080 Markers and characters are converted to integers. | |
| 3081 */ | |
| 3082 (number)) | |
| 3083 { | |
| 3084 retry: | |
| 3085 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3086 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
|
3087 if (CHARP (number)) return make_integer ((EMACS_INT) XCHAR (number) + 1); |
| 1983 | 3088 if (MARKERP (number)) return make_integer (marker_position (number) + 1); |
| 428 | 3089 if (FLOATP (number)) return make_float (XFLOAT_DATA (number) + 1.0); |
| 1983 | 3090 #ifdef HAVE_BIGNUM |
| 3091 if (BIGNUMP (number)) | |
| 3092 { | |
| 3093 bignum_set_long (scratch_bignum, 1L); | |
| 3094 bignum_add (scratch_bignum2, XBIGNUM_DATA (number), scratch_bignum); | |
| 3095 return Fcanonicalize_number (make_bignum_bg (scratch_bignum2)); | |
| 3096 } | |
| 3097 #endif | |
| 3098 #ifdef HAVE_RATIO | |
| 3099 if (RATIOP (number)) | |
| 3100 { | |
| 3101 ratio_set_long (scratch_ratio, 1L); | |
| 3102 ratio_add (scratch_ratio, XRATIO_DATA (number), scratch_ratio); | |
| 3103 /* No need to canonicalize after adding 1 */ | |
| 3104 return make_ratio_rt (scratch_ratio); | |
| 3105 } | |
| 3106 #endif | |
| 3107 #ifdef HAVE_BIGFLOAT | |
| 3108 if (BIGFLOATP (number)) | |
| 3109 { | |
| 3110 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); | |
| 3111 bigfloat_set_long (scratch_bigfloat, 1L); | |
| 3112 bigfloat_add (scratch_bigfloat, XBIGFLOAT_DATA (number), | |
| 3113 scratch_bigfloat); | |
| 3114 return make_bigfloat_bf (scratch_bigfloat); | |
| 3115 } | |
| 3116 #endif | |
| 428 | 3117 |
| 3118 number = wrong_type_argument (Qnumber_char_or_marker_p, number); | |
| 3119 goto retry; | |
| 3120 } | |
| 3121 | |
| 3122 DEFUN ("1-", Fsub1, 1, 1, 0, /* | |
| 3123 Return NUMBER minus one. NUMBER may be a number, character or marker. | |
| 3124 Markers and characters are converted to integers. | |
| 3125 */ | |
| 3126 (number)) | |
| 3127 { | |
| 3128 retry: | |
| 3129 | |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
3130 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
|
3131 if (CHARP (number)) return make_integer ((EMACS_INT) XCHAR (number) - 1); |
| 1983 | 3132 if (MARKERP (number)) return make_integer (marker_position (number) - 1); |
| 428 | 3133 if (FLOATP (number)) return make_float (XFLOAT_DATA (number) - 1.0); |
| 1983 | 3134 #ifdef HAVE_BIGNUM |
| 3135 if (BIGNUMP (number)) | |
| 3136 { | |
| 3137 bignum_set_long (scratch_bignum, 1L); | |
| 3138 bignum_sub (scratch_bignum2, XBIGNUM_DATA (number), scratch_bignum); | |
| 3139 return Fcanonicalize_number (make_bignum_bg (scratch_bignum2)); | |
| 3140 } | |
| 3141 #endif | |
| 3142 #ifdef HAVE_RATIO | |
| 3143 if (RATIOP (number)) | |
| 3144 { | |
| 3145 ratio_set_long (scratch_ratio, 1L); | |
| 3146 ratio_sub (scratch_ratio, XRATIO_DATA (number), scratch_ratio); | |
| 3147 /* No need to canonicalize after subtracting 1 */ | |
| 3148 return make_ratio_rt (scratch_ratio); | |
| 3149 } | |
| 3150 #endif | |
| 3151 #ifdef HAVE_BIGFLOAT | |
| 3152 if (BIGFLOATP (number)) | |
| 3153 { | |
| 3154 bigfloat_set_prec (scratch_bigfloat, XBIGFLOAT_GET_PREC (number)); | |
| 3155 bigfloat_set_long (scratch_bigfloat, 1L); | |
| 3156 bigfloat_sub (scratch_bigfloat, XBIGFLOAT_DATA (number), | |
| 3157 scratch_bigfloat); | |
| 3158 return make_bigfloat_bf (scratch_bigfloat); | |
| 3159 } | |
| 3160 #endif | |
| 428 | 3161 |
| 3162 number = wrong_type_argument (Qnumber_char_or_marker_p, number); | |
| 3163 goto retry; | |
| 3164 } | |
| 3165 | |
| 3166 | |
| 3167 /************************************************************************/ | |
| 3168 /* weak lists */ | |
| 3169 /************************************************************************/ | |
| 3170 | |
| 3171 /* A weak list is like a normal list except that elements automatically | |
| 3172 disappear when no longer in use, i.e. when no longer GC-protected. | |
| 3173 The basic idea is that we don't mark the elements during GC, but | |
| 3174 wait for them to be marked elsewhere. If they're not marked, we | |
| 3175 remove them. This is analogous to weak hash tables; see the explanation | |
| 3176 there for more info. */ | |
| 3177 | |
| 3178 static Lisp_Object Vall_weak_lists; /* Gemarke es nicht!!! */ | |
| 3179 | |
| 3180 static Lisp_Object encode_weak_list_type (enum weak_list_type type); | |
| 3181 | |
| 3182 static Lisp_Object | |
| 2286 | 3183 mark_weak_list (Lisp_Object UNUSED (obj)) |
| 428 | 3184 { |
| 3185 return Qnil; /* nichts ist gemarkt */ | |
| 3186 } | |
| 3187 | |
| 3188 static void | |
| 2286 | 3189 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
|
3190 int escapeflag) |
| 428 | 3191 { |
| 3192 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
|
3193 { |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3194 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
|
3195 } |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3196 |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3197 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
|
3198 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
|
3199 printcharfun, escapeflag); |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3200 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
|
3201 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
|
3202 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); |
| 428 | 3203 } |
| 3204 | |
| 3205 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
|
3206 weak_list_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) |
| 428 | 3207 { |
| 3208 struct weak_list *w1 = XWEAK_LIST (obj1); | |
| 3209 struct weak_list *w2 = XWEAK_LIST (obj2); | |
| 3210 | |
| 3211 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
|
3212 internal_equal_0 (w1->list, w2->list, depth + 1, foldcase)); |
| 428 | 3213 } |
| 3214 | |
| 665 | 3215 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
|
3216 weak_list_hash (Lisp_Object obj, int depth, Boolint equalp) |
| 428 | 3217 { |
| 3218 struct weak_list *w = XWEAK_LIST (obj); | |
| 3219 | |
| 665 | 3220 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
|
3221 internal_hash (w->list, depth + 1, equalp)); |
| 428 | 3222 } |
| 3223 | |
| 3224 Lisp_Object | |
| 3225 make_weak_list (enum weak_list_type type) | |
| 3226 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
3227 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
|
3228 struct weak_list *wl = XWEAK_LIST (result); |
| 428 | 3229 |
| 3230 wl->list = Qnil; | |
| 3231 wl->type = type; | |
| 3232 wl->next_weak = Vall_weak_lists; | |
| 3233 Vall_weak_lists = result; | |
| 3234 return result; | |
| 3235 } | |
| 3236 | |
| 1204 | 3237 static const struct memory_description weak_list_description[] = { |
| 1598 | 3238 { XD_LISP_OBJECT, offsetof (struct weak_list, list), |
| 2551 | 3239 0, { 0 }, XD_FLAG_NO_KKCC }, |
| 1598 | 3240 { XD_LO_LINK, offsetof (struct weak_list, next_weak), |
| 2551 | 3241 0, { 0 }, XD_FLAG_NO_KKCC }, |
| 428 | 3242 { XD_END } |
| 3243 }; | |
| 3244 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
3245 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
|
3246 mark_weak_list, print_weak_list, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
3247 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
|
3248 weak_list_description, |
|
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
3249 struct weak_list); |
| 428 | 3250 /* |
| 3251 -- we do not mark the list elements (either the elements themselves | |
| 3252 or the cons cells that hold them) in the normal marking phase. | |
| 3253 -- at the end of marking, we go through all weak lists that are | |
| 3254 marked, and mark the cons cells that hold all marked | |
| 3255 objects, and possibly parts of the objects themselves. | |
| 3256 (See alloc.c, "after-mark".) | |
| 3257 -- after that, we prune away all the cons cells that are not marked. | |
| 3258 | |
| 3259 WARNING WARNING WARNING WARNING WARNING: | |
| 3260 | |
| 3261 The code in the following two functions is *unbelievably* tricky. | |
| 3262 Don't mess with it. You'll be sorry. | |
| 3263 | |
| 3264 Linked lists just majorly suck, d'ya know? | |
| 3265 */ | |
| 3266 | |
| 3267 int | |
| 3268 finish_marking_weak_lists (void) | |
| 3269 { | |
| 3270 Lisp_Object rest; | |
| 3271 int did_mark = 0; | |
| 3272 | |
| 3273 for (rest = Vall_weak_lists; | |
| 3274 !NILP (rest); | |
| 3275 rest = XWEAK_LIST (rest)->next_weak) | |
| 3276 { | |
| 3277 Lisp_Object rest2; | |
| 3278 enum weak_list_type type = XWEAK_LIST (rest)->type; | |
| 3279 | |
| 3280 if (! marked_p (rest)) | |
| 3281 /* The weak list is probably garbage. Ignore it. */ | |
| 3282 continue; | |
| 3283 | |
| 3284 for (rest2 = XWEAK_LIST (rest)->list; | |
| 3285 /* We need to be trickier since we're inside of GC; | |
| 3286 use CONSP instead of !NILP in case of user-visible | |
| 3287 imperfect lists */ | |
| 3288 CONSP (rest2); | |
| 3289 rest2 = XCDR (rest2)) | |
| 3290 { | |
| 3291 Lisp_Object elem; | |
| 3292 /* If the element is "marked" (meaning depends on the type | |
| 3293 of weak list), we need to mark the cons containing the | |
| 3294 element, and maybe the element itself (if only some part | |
| 3295 was already marked). */ | |
| 3296 int need_to_mark_cons = 0; | |
| 3297 int need_to_mark_elem = 0; | |
| 3298 | |
| 3299 /* If a cons is already marked, then its car is already marked | |
| 3300 (either because of an external pointer or because of | |
| 3301 a previous call to this function), and likewise for all | |
| 3302 the rest of the elements in the list, so we can stop now. */ | |
| 3303 if (marked_p (rest2)) | |
| 3304 break; | |
| 3305 | |
| 3306 elem = XCAR (rest2); | |
| 3307 | |
| 3308 switch (type) | |
| 3309 { | |
| 3310 case WEAK_LIST_SIMPLE: | |
| 3311 if (marked_p (elem)) | |
| 3312 need_to_mark_cons = 1; | |
| 3313 break; | |
| 3314 | |
| 3315 case WEAK_LIST_ASSOC: | |
| 3316 if (!CONSP (elem)) | |
| 3317 { | |
| 3318 /* just leave bogus elements there */ | |
| 3319 need_to_mark_cons = 1; | |
| 3320 need_to_mark_elem = 1; | |
| 3321 } | |
| 3322 else if (marked_p (XCAR (elem)) && | |
| 3323 marked_p (XCDR (elem))) | |
| 3324 { | |
| 3325 need_to_mark_cons = 1; | |
| 3326 /* We still need to mark elem, because it's | |
| 3327 probably not marked. */ | |
| 3328 need_to_mark_elem = 1; | |
| 3329 } | |
| 3330 break; | |
| 3331 | |
| 3332 case WEAK_LIST_KEY_ASSOC: | |
| 3333 if (!CONSP (elem)) | |
| 3334 { | |
| 3335 /* just leave bogus elements there */ | |
| 3336 need_to_mark_cons = 1; | |
| 3337 need_to_mark_elem = 1; | |
| 3338 } | |
| 3339 else if (marked_p (XCAR (elem))) | |
| 3340 { | |
| 3341 need_to_mark_cons = 1; | |
| 3342 /* We still need to mark elem and XCDR (elem); | |
| 3343 marking elem does both */ | |
| 3344 need_to_mark_elem = 1; | |
| 3345 } | |
| 3346 break; | |
| 3347 | |
| 3348 case WEAK_LIST_VALUE_ASSOC: | |
| 3349 if (!CONSP (elem)) | |
| 3350 { | |
| 3351 /* just leave bogus elements there */ | |
| 3352 need_to_mark_cons = 1; | |
| 3353 need_to_mark_elem = 1; | |
| 3354 } | |
| 3355 else if (marked_p (XCDR (elem))) | |
| 3356 { | |
| 3357 need_to_mark_cons = 1; | |
| 3358 /* We still need to mark elem and XCAR (elem); | |
| 3359 marking elem does both */ | |
| 3360 need_to_mark_elem = 1; | |
| 3361 } | |
| 3362 break; | |
| 3363 | |
| 442 | 3364 case WEAK_LIST_FULL_ASSOC: |
| 3365 if (!CONSP (elem)) | |
| 3366 { | |
| 3367 /* just leave bogus elements there */ | |
| 3368 need_to_mark_cons = 1; | |
| 3369 need_to_mark_elem = 1; | |
| 3370 } | |
| 3371 else if (marked_p (XCAR (elem)) || | |
| 3372 marked_p (XCDR (elem))) | |
| 3373 { | |
| 3374 need_to_mark_cons = 1; | |
| 3375 /* We still need to mark elem and XCAR (elem); | |
| 3376 marking elem does both */ | |
| 3377 need_to_mark_elem = 1; | |
| 3378 } | |
| 3379 break; | |
| 3380 | |
| 428 | 3381 default: |
| 2500 | 3382 ABORT (); |
| 428 | 3383 } |
| 3384 | |
| 3385 if (need_to_mark_elem && ! marked_p (elem)) | |
| 3386 { | |
| 1598 | 3387 #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
|
3388 kkcc_gc_stack_push_lisp_object_0 (elem); |
| 1598 | 3389 #else /* NOT USE_KKCC */ |
| 428 | 3390 mark_object (elem); |
| 1598 | 3391 #endif /* NOT USE_KKCC */ |
| 428 | 3392 did_mark = 1; |
| 3393 } | |
| 3394 | |
| 3395 /* We also need to mark the cons that holds the elem or | |
| 3396 assoc-pair. We do *not* want to call (mark_object) here | |
| 3397 because that will mark the entire list; we just want to | |
| 3398 mark the cons itself. | |
| 3399 */ | |
| 3400 if (need_to_mark_cons) | |
| 3401 { | |
| 3402 Lisp_Cons *c = XCONS (rest2); | |
| 3403 if (!CONS_MARKED_P (c)) | |
| 3404 { | |
| 3405 MARK_CONS (c); | |
| 3406 did_mark = 1; | |
| 3407 } | |
| 3408 } | |
| 3409 } | |
| 3410 | |
| 3411 /* In case of imperfect list, need to mark the final cons | |
| 3412 because we're not removing it */ | |
| 3413 if (!NILP (rest2) && ! marked_p (rest2)) | |
| 3414 { | |
| 1598 | 3415 #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
|
3416 kkcc_gc_stack_push_lisp_object_0 (rest2); |
| 1598 | 3417 #else /* NOT USE_KKCC */ |
| 428 | 3418 mark_object (rest2); |
| 1598 | 3419 #endif /* NOT USE_KKCC */ |
| 428 | 3420 did_mark = 1; |
| 3421 } | |
| 3422 } | |
| 3423 | |
| 3424 return did_mark; | |
| 3425 } | |
| 3426 | |
| 3427 void | |
| 3428 prune_weak_lists (void) | |
| 3429 { | |
| 3430 Lisp_Object rest, prev = Qnil; | |
| 3431 | |
| 3432 for (rest = Vall_weak_lists; | |
| 3433 !NILP (rest); | |
| 3434 rest = XWEAK_LIST (rest)->next_weak) | |
| 3435 { | |
| 3436 if (! (marked_p (rest))) | |
| 3437 { | |
| 3438 /* This weak list itself is garbage. Remove it from the list. */ | |
| 3439 if (NILP (prev)) | |
| 3440 Vall_weak_lists = XWEAK_LIST (rest)->next_weak; | |
| 3441 else | |
| 3442 XWEAK_LIST (prev)->next_weak = | |
| 3443 XWEAK_LIST (rest)->next_weak; | |
| 3444 } | |
| 3445 else | |
| 3446 { | |
| 3447 Lisp_Object rest2, prev2 = Qnil; | |
| 3448 Lisp_Object tortoise; | |
| 3449 int go_tortoise = 0; | |
| 3450 | |
| 3451 for (rest2 = XWEAK_LIST (rest)->list, tortoise = rest2; | |
| 3452 /* We need to be trickier since we're inside of GC; | |
| 3453 use CONSP instead of !NILP in case of user-visible | |
| 3454 imperfect lists */ | |
| 3455 CONSP (rest2);) | |
| 3456 { | |
| 3457 /* It suffices to check the cons for marking, | |
| 3458 regardless of the type of weak list: | |
| 3459 | |
| 3460 -- if the cons is pointed to somewhere else, | |
| 3461 then it should stay around and will be marked. | |
| 3462 -- otherwise, if it should stay around, it will | |
| 3463 have been marked in finish_marking_weak_lists(). | |
| 3464 -- otherwise, it's not marked and should disappear. | |
| 3465 */ | |
| 3466 if (! marked_p (rest2)) | |
| 3467 { | |
| 3468 /* bye bye :-( */ | |
| 3469 if (NILP (prev2)) | |
| 3470 XWEAK_LIST (rest)->list = XCDR (rest2); | |
| 3471 else | |
| 3472 XCDR (prev2) = XCDR (rest2); | |
| 3473 rest2 = XCDR (rest2); | |
| 3474 /* Ouch. Circularity checking is even trickier | |
| 3475 than I thought. When we cut out a link | |
| 3476 like this, we can't advance the turtle or | |
| 3477 it'll catch up to us. Imagine that we're | |
| 3478 standing on floor tiles and moving forward -- | |
| 3479 what we just did here is as if the floor | |
| 3480 tile under us just disappeared and all the | |
| 3481 ones ahead of us slid one tile towards us. | |
| 3482 In other words, we didn't move at all; | |
| 3483 if the tortoise was one step behind us | |
| 3484 previously, it still is, and therefore | |
| 3485 it must not move. */ | |
| 3486 } | |
| 3487 else | |
| 3488 { | |
| 3489 prev2 = rest2; | |
| 3490 | |
| 3491 /* Implementing circularity checking is trickier here | |
| 3492 than in other places because we have to guarantee | |
| 3493 that we've processed all elements before exiting | |
| 3494 due to a circularity. (In most places, an error | |
| 3495 is issued upon encountering a circularity, so it | |
| 3496 doesn't really matter if all elements are processed.) | |
| 3497 The idea is that we process along with the hare | |
| 3498 rather than the tortoise. If at any point in | |
| 3499 our forward process we encounter the tortoise, | |
| 3500 we must have already visited the spot, so we exit. | |
| 3501 (If we process with the tortoise, we can fail to | |
| 3502 process cases where a cons points to itself, or | |
| 3503 where cons A points to cons B, which points to | |
| 3504 cons A.) */ | |
| 3505 | |
| 3506 rest2 = XCDR (rest2); | |
| 3507 if (go_tortoise) | |
| 3508 tortoise = XCDR (tortoise); | |
| 3509 go_tortoise = !go_tortoise; | |
| 3510 if (EQ (rest2, tortoise)) | |
| 3511 break; | |
| 3512 } | |
| 3513 } | |
| 3514 | |
| 3515 prev = rest; | |
| 3516 } | |
| 3517 } | |
| 3518 } | |
| 3519 | |
| 3520 static enum weak_list_type | |
| 3521 decode_weak_list_type (Lisp_Object symbol) | |
| 3522 { | |
| 3523 CHECK_SYMBOL (symbol); | |
| 3524 if (EQ (symbol, Qsimple)) return WEAK_LIST_SIMPLE; | |
| 3525 if (EQ (symbol, Qassoc)) return WEAK_LIST_ASSOC; | |
| 3526 if (EQ (symbol, Qold_assoc)) return WEAK_LIST_ASSOC; /* EBOLA ALERT! */ | |
| 3527 if (EQ (symbol, Qkey_assoc)) return WEAK_LIST_KEY_ASSOC; | |
| 3528 if (EQ (symbol, Qvalue_assoc)) return WEAK_LIST_VALUE_ASSOC; | |
| 442 | 3529 if (EQ (symbol, Qfull_assoc)) return WEAK_LIST_FULL_ASSOC; |
| 428 | 3530 |
| 563 | 3531 invalid_constant ("Invalid weak list type", symbol); |
| 1204 | 3532 RETURN_NOT_REACHED (WEAK_LIST_SIMPLE); |
| 428 | 3533 } |
| 3534 | |
| 3535 static Lisp_Object | |
| 3536 encode_weak_list_type (enum weak_list_type type) | |
| 3537 { | |
| 3538 switch (type) | |
| 3539 { | |
| 3540 case WEAK_LIST_SIMPLE: return Qsimple; | |
| 3541 case WEAK_LIST_ASSOC: return Qassoc; | |
| 3542 case WEAK_LIST_KEY_ASSOC: return Qkey_assoc; | |
| 3543 case WEAK_LIST_VALUE_ASSOC: return Qvalue_assoc; | |
| 442 | 3544 case WEAK_LIST_FULL_ASSOC: return Qfull_assoc; |
| 428 | 3545 default: |
| 2500 | 3546 ABORT (); |
| 428 | 3547 } |
| 3548 | |
| 801 | 3549 return Qnil; /* not (usually) reached */ |
| 428 | 3550 } |
| 3551 | |
| 3552 DEFUN ("weak-list-p", Fweak_list_p, 1, 1, 0, /* | |
| 3553 Return non-nil if OBJECT is a weak list. | |
| 3554 */ | |
| 3555 (object)) | |
| 3556 { | |
| 3557 return WEAK_LISTP (object) ? Qt : Qnil; | |
| 3558 } | |
| 3559 | |
| 3560 DEFUN ("make-weak-list", Fmake_weak_list, 0, 1, 0, /* | |
| 3561 Return a new weak list object of type TYPE. | |
| 3562 A weak list object is an object that contains a list. This list behaves | |
| 3563 like any other list except that its elements do not count towards | |
| 456 | 3564 garbage collection -- if the only pointer to an object is inside a weak |
| 428 | 3565 list (other than pointers in similar objects such as weak hash tables), |
| 3566 the object is garbage collected and automatically removed from the list. | |
| 3567 This is used internally, for example, to manage the list holding the | |
| 3568 children of an extent -- an extent that is unused but has a parent will | |
| 3569 still be reclaimed, and will automatically be removed from its parent's | |
| 3570 list of children. | |
| 3571 | |
| 3572 Optional argument TYPE specifies the type of the weak list, and defaults | |
| 3573 to `simple'. Recognized types are | |
| 3574 | |
| 3575 `simple' Objects in the list disappear if not pointed to. | |
| 3576 `assoc' Objects in the list disappear if they are conses | |
| 3577 and either the car or the cdr of the cons is not | |
| 3578 pointed to. | |
| 3579 `key-assoc' Objects in the list disappear if they are conses | |
| 3580 and the car is not pointed to. | |
| 3581 `value-assoc' Objects in the list disappear if they are conses | |
| 3582 and the cdr is not pointed to. | |
| 442 | 3583 `full-assoc' Objects in the list disappear if they are conses |
| 3584 and neither the car nor the cdr is pointed to. | |
| 428 | 3585 */ |
| 3586 (type)) | |
| 3587 { | |
| 3588 if (NILP (type)) | |
| 3589 type = Qsimple; | |
| 3590 | |
| 3591 return make_weak_list (decode_weak_list_type (type)); | |
| 3592 } | |
| 3593 | |
| 3594 DEFUN ("weak-list-type", Fweak_list_type, 1, 1, 0, /* | |
| 3595 Return the type of the given weak-list object. | |
| 3596 */ | |
| 3597 (weak)) | |
| 3598 { | |
| 3599 CHECK_WEAK_LIST (weak); | |
| 3600 return encode_weak_list_type (XWEAK_LIST (weak)->type); | |
| 3601 } | |
| 3602 | |
| 3603 DEFUN ("weak-list-list", Fweak_list_list, 1, 1, 0, /* | |
| 3604 Return the list contained in a weak-list object. | |
| 3605 */ | |
| 3606 (weak)) | |
| 3607 { | |
| 3608 CHECK_WEAK_LIST (weak); | |
| 3609 return XWEAK_LIST_LIST (weak); | |
| 3610 } | |
| 3611 | |
| 3612 DEFUN ("set-weak-list-list", Fset_weak_list_list, 2, 2, 0, /* | |
| 3613 Change the list contained in a weak-list object. | |
| 3614 */ | |
| 3615 (weak, new_list)) | |
| 3616 { | |
| 3617 CHECK_WEAK_LIST (weak); | |
| 3618 XWEAK_LIST_LIST (weak) = new_list; | |
| 3619 return new_list; | |
| 3620 } | |
| 3621 | |
| 888 | 3622 |
| 858 | 3623 /************************************************************************/ |
| 3624 /* weak boxes */ | |
| 3625 /************************************************************************/ | |
| 3626 | |
| 3627 static Lisp_Object Vall_weak_boxes; /* Gemarke es niemals ever!!! */ | |
| 3628 | |
| 3629 void | |
| 3630 prune_weak_boxes (void) | |
| 3631 { | |
| 3632 Lisp_Object rest, prev = Qnil; | |
| 888 | 3633 int removep = 0; |
| 858 | 3634 |
| 3635 for (rest = Vall_weak_boxes; | |
| 3636 !NILP(rest); | |
| 3637 rest = XWEAK_BOX (rest)->next_weak_box) | |
| 3638 { | |
| 3639 if (! (marked_p (rest))) | |
| 888 | 3640 /* This weak box itself is garbage. */ |
| 3641 removep = 1; | |
| 3642 | |
| 3643 if (! marked_p (XWEAK_BOX (rest)->value)) | |
| 3644 { | |
| 3645 XSET_WEAK_BOX (rest, Qnil); | |
| 3646 removep = 1; | |
| 3647 } | |
| 3648 | |
| 3649 if (removep) | |
| 3650 { | |
| 3651 /* Remove weak box from list. */ | |
| 3652 if (NILP (prev)) | |
| 3653 Vall_weak_boxes = XWEAK_BOX (rest)->next_weak_box; | |
| 3654 else | |
| 3655 XWEAK_BOX (prev)->next_weak_box = XWEAK_BOX (rest)->next_weak_box; | |
| 3656 removep = 0; | |
| 3657 } | |
| 3658 else | |
| 3659 prev = rest; | |
| 858 | 3660 } |
| 3661 } | |
| 3662 | |
| 3663 static Lisp_Object | |
| 2286 | 3664 mark_weak_box (Lisp_Object UNUSED (obj)) |
| 858 | 3665 { |
| 3666 return Qnil; | |
| 3667 } | |
| 3668 | |
| 3669 static void | |
|
5325
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3670 print_weak_box (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
| 858 | 3671 { |
| 3672 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
|
3673 { |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3674 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
|
3675 } |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3676 |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3677 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
|
3678 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
|
3679 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); |
| 858 | 3680 } |
| 3681 | |
| 3682 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
|
3683 weak_box_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) |
| 858 | 3684 { |
| 888 | 3685 struct weak_box *wb1 = XWEAK_BOX (obj1); |
| 3686 struct weak_box *wb2 = XWEAK_BOX (obj2); | |
| 858 | 3687 |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
4885
diff
changeset
|
3688 return (internal_equal_0 (wb1->value, wb2->value, depth + 1, foldcase)); |
| 858 | 3689 } |
| 3690 | |
| 3691 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
|
3692 weak_box_hash (Lisp_Object obj, int depth, Boolint equalp) |
| 858 | 3693 { |
| 888 | 3694 struct weak_box *wb = XWEAK_BOX (obj); |
| 858 | 3695 |
|
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
|
3696 return internal_hash (wb->value, depth + 1, equalp); |
| 858 | 3697 } |
| 3698 | |
| 3699 Lisp_Object | |
| 3700 make_weak_box (Lisp_Object value) | |
| 3701 { | |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
3702 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
|
3703 struct weak_box *wb = XWEAK_BOX (result); |
| 858 | 3704 |
| 3705 wb->value = value; | |
| 3706 result = wrap_weak_box (wb); | |
| 3707 wb->next_weak_box = Vall_weak_boxes; | |
| 3708 Vall_weak_boxes = result; | |
| 3709 return result; | |
| 3710 } | |
| 3711 | |
| 1204 | 3712 static const struct memory_description weak_box_description[] = { |
| 858 | 3713 { XD_LO_LINK, offsetof (struct weak_box, value) }, |
| 888 | 3714 { XD_END} |
| 858 | 3715 }; |
| 3716 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
3717 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
|
3718 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
|
3719 weak_box_hash, weak_box_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
3720 struct weak_box); |
| 858 | 3721 |
| 3722 DEFUN ("make-weak-box", Fmake_weak_box, 1, 1, 0, /* | |
| 3723 Return a new weak box from value CONTENTS. | |
| 3724 The weak box is a reference to CONTENTS which may be extracted with | |
| 3725 `weak-box-ref'. However, the weak box does not contribute to the | |
| 3726 reachability of CONTENTS. When CONTENTS is garbage-collected, | |
| 3727 `weak-box-ref' will return NIL. | |
| 3728 */ | |
| 3729 (value)) | |
| 3730 { | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3731 return make_weak_box (value); |
| 858 | 3732 } |
| 3733 | |
| 3734 DEFUN ("weak-box-ref", Fweak_box_ref, 1, 1, 0, /* | |
| 3735 Return the contents of weak box WEAK-BOX. | |
| 3736 If the contents have been GCed, return NIL. | |
| 3737 */ | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3738 (weak_box)) |
| 858 | 3739 { |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3740 return XWEAK_BOX (weak_box)->value; |
| 858 | 3741 } |
| 3742 | |
| 3743 DEFUN ("weak-box-p", Fweak_boxp, 1, 1, 0, /* | |
| 3744 Return non-nil if OBJECT is a weak box. | |
| 3745 */ | |
| 3746 (object)) | |
| 3747 { | |
| 3748 return WEAK_BOXP (object) ? Qt : Qnil; | |
| 3749 } | |
| 3750 | |
| 888 | 3751 /************************************************************************/ |
| 3752 /* ephemerons */ | |
| 3753 /************************************************************************/ | |
| 3754 | |
| 993 | 3755 /* The concept of ephemerons is due to: |
| 3756 * Barry Hayes: Ephemerons: A New Finalization Mechanism. OOPSLA 1997: 176-183 | |
| 3757 * The original idea is due to George Bosworth of Digitalk, Inc. | |
| 3758 * | |
| 3759 * For a discussion of finalization and weakness that also reviews | |
| 3760 * ephemerons, refer to: | |
| 3761 * Simon Peyton Jones, Simon Marlow, Conal Elliot: | |
| 3762 * Stretching the storage manager | |
| 3763 * Implementation of Functional Languages, 1999 | |
| 3764 */ | |
| 3765 | |
| 888 | 3766 static Lisp_Object Vall_ephemerons; /* Gemarke es niemals ever!!! */ |
| 1590 | 3767 static Lisp_Object Vnew_all_ephemerons; |
| 888 | 3768 static Lisp_Object Vfinalize_list; |
| 3769 | |
| 1590 | 3770 void |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3771 init_marking_ephemerons (void) |
| 1590 | 3772 { |
| 3773 Vnew_all_ephemerons = Qnil; | |
| 3774 } | |
| 3775 | |
| 3776 /* Move all live ephemerons with live keys over to | |
| 3777 * Vnew_all_ephemerons, marking the values and finalizers along the | |
| 3778 * way. */ | |
| 3779 | |
| 3780 int | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3781 continue_marking_ephemerons (void) |
| 1590 | 3782 { |
| 3783 Lisp_Object rest = Vall_ephemerons, next, prev = Qnil; | |
| 3784 int did_mark = 0; | |
| 3785 | |
| 3786 while (!NILP (rest)) | |
| 3787 { | |
| 3788 next = XEPHEMERON_NEXT (rest); | |
| 3789 | |
| 3790 if (marked_p (rest)) | |
| 3791 { | |
| 3792 MARK_CONS (XCONS (XEPHEMERON (rest)->cons_chain)); | |
| 3793 if (marked_p (XEPHEMERON (rest)->key)) | |
| 3794 { | |
| 1598 | 3795 #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
|
3796 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
|
3797 (XCAR (XEPHEMERON (rest)->cons_chain)); |
| 1598 | 3798 #else /* NOT USE_KKCC */ |
| 1590 | 3799 mark_object (XCAR (XEPHEMERON (rest)->cons_chain)); |
| 1598 | 3800 #endif /* NOT USE_KKCC */ |
| 1590 | 3801 did_mark = 1; |
| 3802 XSET_EPHEMERON_NEXT (rest, Vnew_all_ephemerons); | |
| 3803 Vnew_all_ephemerons = rest; | |
| 3804 if (NILP (prev)) | |
| 3805 Vall_ephemerons = next; | |
| 3806 else | |
| 3807 XSET_EPHEMERON_NEXT (prev, next); | |
| 3808 } | |
| 3809 else | |
| 3810 prev = rest; | |
| 3811 } | |
| 3812 else | |
| 3813 prev = rest; | |
| 3814 | |
| 3815 rest = next; | |
| 3816 } | |
| 3817 | |
| 3818 return did_mark; | |
| 3819 } | |
| 3820 | |
| 3821 /* At this point, everything that's in Vall_ephemerons is dead. | |
| 3822 * Well, almost: we still need to run the finalizers, so we need to | |
| 3823 * resurrect them. | |
| 3824 */ | |
| 3825 | |
| 888 | 3826 int |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3827 finish_marking_ephemerons (void) |
| 888 | 3828 { |
| 1590 | 3829 Lisp_Object rest = Vall_ephemerons, next, prev = Qnil; |
| 888 | 3830 int did_mark = 0; |
| 3831 | |
| 3832 while (! NILP (rest)) | |
| 3833 { | |
| 3834 next = XEPHEMERON_NEXT (rest); | |
| 3835 | |
| 3836 if (marked_p (rest)) | |
| 1590 | 3837 /* The ephemeron itself is live, but its key is garbage */ |
| 888 | 3838 { |
| 1590 | 3839 /* tombstone */ |
| 3840 XSET_EPHEMERON_VALUE (rest, Qnil); | |
| 3841 | |
| 3842 if (! NILP (XEPHEMERON_FINALIZER (rest))) | |
| 888 | 3843 { |
| 1590 | 3844 MARK_CONS (XCONS (XEPHEMERON (rest)->cons_chain)); |
| 1598 | 3845 #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
|
3846 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
|
3847 (XCAR (XEPHEMERON (rest)->cons_chain)); |
| 1598 | 3848 #else /* NOT USE_KKCC */ |
| 1590 | 3849 mark_object (XCAR (XEPHEMERON (rest)->cons_chain)); |
| 1598 | 3850 #endif /* NOT USE_KKCC */ |
| 1590 | 3851 |
| 3852 /* Register the finalizer */ | |
| 3853 XSET_EPHEMERON_NEXT (rest, Vfinalize_list); | |
| 3854 Vfinalize_list = XEPHEMERON (rest)->cons_chain; | |
| 3855 did_mark = 1; | |
| 888 | 3856 } |
| 3857 | |
| 3858 /* Remove it from the list. */ | |
| 3859 if (NILP (prev)) | |
| 3860 Vall_ephemerons = next; | |
| 3861 else | |
| 3862 XSET_EPHEMERON_NEXT (prev, next); | |
| 3863 } | |
| 3864 else | |
| 3865 prev = rest; | |
| 3866 | |
| 3867 rest = next; | |
| 3868 } | |
| 1590 | 3869 |
| 3870 return did_mark; | |
| 3871 } | |
| 3872 | |
| 3873 void | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3874 prune_ephemerons (void) |
| 1590 | 3875 { |
| 3876 Vall_ephemerons = Vnew_all_ephemerons; | |
| 888 | 3877 } |
| 3878 | |
| 3879 Lisp_Object | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3880 zap_finalize_list (void) |
| 888 | 3881 { |
| 3882 Lisp_Object finalizers = Vfinalize_list; | |
| 3883 | |
| 3884 Vfinalize_list = Qnil; | |
| 3885 | |
| 3886 return finalizers; | |
| 3887 } | |
| 3888 | |
| 3889 static Lisp_Object | |
| 2286 | 3890 mark_ephemeron (Lisp_Object UNUSED (obj)) |
| 888 | 3891 { |
| 3892 return Qnil; | |
| 3893 } | |
| 3894 | |
| 3895 static void | |
|
5325
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3896 print_ephemeron (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) |
| 888 | 3897 { |
| 3898 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
|
3899 { |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3900 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
|
3901 } |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3902 |
|
47298dcf2e8f
Be more helpful in printing ephemerons, weak lists, and weak boxes.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5307
diff
changeset
|
3903 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
|
3904 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
|
3905 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
|
3906 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
|
3907 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
|
3908 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
|
3909 write_fmt_string (printcharfun, " 0x%x>", LISP_OBJECT_UID (obj)); |
| 888 | 3910 } |
| 3911 | |
| 3912 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
|
3913 ephemeron_equal (Lisp_Object obj1, Lisp_Object obj2, int depth, int foldcase) |
| 888 | 3914 { |
| 3915 return | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3916 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
|
3917 depth + 1, foldcase); |
| 888 | 3918 } |
| 3919 | |
| 3920 static Hashcode | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3921 ephemeron_hash (Lisp_Object obj, int depth, Boolint equalp) |
| 888 | 3922 { |
|
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
|
3923 return internal_hash (XEPHEMERON_REF (obj), depth + 1, equalp); |
| 888 | 3924 } |
| 3925 | |
| 3926 Lisp_Object | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
3927 make_ephemeron (Lisp_Object key, Lisp_Object value, Lisp_Object finalizer) |
| 888 | 3928 { |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
3929 Lisp_Object temp = Qnil; |
| 888 | 3930 struct gcpro gcpro1, gcpro2; |
|
5127
a9c41067dd88
more cleanups, terminology clarification, lots of doc work
Ben Wing <ben@xemacs.org>
parents:
5125
diff
changeset
|
3931 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
|
3932 struct ephemeron *eph = XEPHEMERON (result); |
| 888 | 3933 |
| 3934 eph->key = Qnil; | |
| 3935 eph->cons_chain = Qnil; | |
| 3936 eph->value = Qnil; | |
| 3937 | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
3938 result = wrap_ephemeron (eph); |
| 888 | 3939 GCPRO2 (result, temp); |
| 3940 | |
| 3941 eph->key = key; | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
3942 temp = Fcons (value, finalizer); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
3943 eph->cons_chain = Fcons (temp, Vall_ephemerons); |
| 888 | 3944 eph->value = value; |
| 3945 | |
| 3946 Vall_ephemerons = result; | |
| 3947 | |
| 3948 UNGCPRO; | |
| 3949 return result; | |
| 3950 } | |
| 3951 | |
| 1598 | 3952 /* Ephemerons are special cases in the KKCC mark algorithm, so nothing |
| 3953 is marked here. */ | |
| 1204 | 3954 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
|
3955 { XD_LISP_OBJECT, offsetof (struct ephemeron, key), |
| 2551 | 3956 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
|
3957 { XD_LISP_OBJECT, offsetof (struct ephemeron, cons_chain), |
| 2551 | 3958 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
|
3959 { XD_LISP_OBJECT, offsetof (struct ephemeron, value), |
| 2551 | 3960 0, { 0 }, XD_FLAG_NO_KKCC }, |
| 888 | 3961 { XD_END } |
| 3962 }; | |
| 3963 | |
|
5118
e0db3c197671
merge up to latest default branch, doesn't compile yet
Ben Wing <ben@xemacs.org>
diff
changeset
|
3964 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
|
3965 mark_ephemeron, print_ephemeron, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
3966 0, ephemeron_equal, ephemeron_hash, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
3967 ephemeron_description, |
|
623d57b7fbe8
separate regular and disksave finalization, print method fixes.
Ben Wing <ben@xemacs.org>
parents:
5118
diff
changeset
|
3968 struct ephemeron); |
| 888 | 3969 |
| 3970 DEFUN ("make-ephemeron", Fmake_ephemeron, 2, 3, 0, /* | |
| 1590 | 3971 Return a new ephemeron with key KEY, value VALUE, and finalizer FINALIZER. |
| 3972 The ephemeron is a reference to VALUE which may be extracted with | |
| 3973 `ephemeron-ref'. VALUE is only reachable through the ephemeron as | |
| 888 | 3974 long as KEY is reachable; the ephemeron does not contribute to the |
| 3975 reachability of KEY. When KEY becomes unreachable while the ephemeron | |
| 1590 | 3976 itself is still reachable, VALUE is queued for finalization: FINALIZER |
| 3977 will possibly be called on VALUE some time in the future. Moreover, | |
| 888 | 3978 future calls to `ephemeron-ref' will return NIL. |
| 3979 */ | |
| 3980 (key, value, finalizer)) | |
| 3981 { | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3982 return make_ephemeron (key, value, finalizer); |
| 888 | 3983 } |
| 3984 | |
| 3985 DEFUN ("ephemeron-ref", Fephemeron_ref, 1, 1, 0, /* | |
| 3986 Return the contents of ephemeron EPHEMERON. | |
| 3987 If the contents have been GCed, return NIL. | |
| 3988 */ | |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3989 (ephemeron)) |
| 888 | 3990 { |
|
5752
70a3f4ff8da8
Improve coding style, variable names, data.c, sequence.c
Aidan Kehoe <kehoea@parhasard.net>
parents:
5736
diff
changeset
|
3991 return XEPHEMERON_REF (ephemeron); |
| 888 | 3992 } |
| 3993 | |
| 3994 DEFUN ("ephemeron-p", Fephemeronp, 1, 1, 0, /* | |
| 3995 Return non-nil if OBJECT is an ephemeron. | |
| 3996 */ | |
| 3997 (object)) | |
| 3998 { | |
| 3999 return EPHEMERONP (object) ? Qt : Qnil; | |
| 4000 } | |
| 428 | 4001 |
| 4002 /************************************************************************/ | |
| 4003 /* initialization */ | |
| 4004 /************************************************************************/ | |
| 4005 | |
| 4006 static SIGTYPE | |
| 4007 arith_error (int signo) | |
| 4008 { | |
| 4009 EMACS_REESTABLISH_SIGNAL (signo, arith_error); | |
| 4010 EMACS_UNBLOCK_SIGNAL (signo); | |
| 563 | 4011 signal_error (Qarith_error, 0, Qunbound); |
| 428 | 4012 } |
| 4013 | |
| 4014 void | |
| 4015 init_data_very_early (void) | |
| 4016 { | |
| 4017 /* Don't do this if just dumping out. | |
| 4018 We don't want to call `signal' in this case | |
| 4019 so that we don't have trouble with dumping | |
| 4020 signal-delivering routines in an inconsistent state. */ | |
| 4021 if (!initialized) | |
| 4022 return; | |
| 613 | 4023 EMACS_SIGNAL (SIGFPE, arith_error); |
| 428 | 4024 #ifdef uts |
| 613 | 4025 EMACS_SIGNAL (SIGEMT, arith_error); |
| 428 | 4026 #endif /* uts */ |
| 4027 } | |
| 4028 | |
| 4029 void | |
| 4030 init_errors_once_early (void) | |
| 4031 { | |
| 442 | 4032 DEFSYMBOL (Qerror_conditions); |
| 4033 DEFSYMBOL (Qerror_message); | |
| 428 | 4034 |
| 4035 /* We declare the errors here because some other deferrors depend | |
| 4036 on some of the errors below. */ | |
| 4037 | |
| 4038 /* ERROR is used as a signaler for random errors for which nothing | |
| 4039 else is right */ | |
| 4040 | |
| 442 | 4041 DEFERROR (Qerror, "error", Qnil); |
| 4042 DEFERROR_STANDARD (Qquit, Qnil); | |
| 428 | 4043 |
| 563 | 4044 DEFERROR_STANDARD (Qinvalid_argument, Qerror); |
| 4045 | |
| 4046 DEFERROR_STANDARD (Qsyntax_error, Qinvalid_argument); | |
| 442 | 4047 DEFERROR_STANDARD (Qinvalid_read_syntax, Qsyntax_error); |
| 563 | 4048 DEFERROR_STANDARD (Qstructure_formation_error, Qsyntax_error); |
| 4049 DEFERROR_STANDARD (Qlist_formation_error, Qstructure_formation_error); | |
| 442 | 4050 DEFERROR_STANDARD (Qmalformed_list, Qlist_formation_error); |
| 4051 DEFERROR_STANDARD (Qmalformed_property_list, Qmalformed_list); | |
| 4052 DEFERROR_STANDARD (Qcircular_list, Qlist_formation_error); | |
| 4053 DEFERROR_STANDARD (Qcircular_property_list, Qcircular_list); | |
| 428 | 4054 |
| 442 | 4055 DEFERROR_STANDARD (Qwrong_type_argument, Qinvalid_argument); |
| 4056 DEFERROR_STANDARD (Qargs_out_of_range, Qinvalid_argument); | |
| 4057 DEFERROR_STANDARD (Qwrong_number_of_arguments, Qinvalid_argument); | |
| 4058 DEFERROR_STANDARD (Qinvalid_function, Qinvalid_argument); | |
| 563 | 4059 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
|
4060 DEFERROR_STANDARD (Qinvalid_keyword_argument, Qinvalid_argument); |
| 442 | 4061 DEFERROR (Qno_catch, "No catch for tag", Qinvalid_argument); |
| 4062 | |
| 563 | 4063 DEFERROR_STANDARD (Qinvalid_state, Qerror); |
| 442 | 4064 DEFERROR (Qvoid_function, "Symbol's function definition is void", |
| 4065 Qinvalid_state); | |
| 4066 DEFERROR (Qcyclic_function_indirection, | |
| 4067 "Symbol's chain of function indirections contains a loop", | |
| 4068 Qinvalid_state); | |
| 4069 DEFERROR (Qvoid_variable, "Symbol's value as variable is void", | |
| 4070 Qinvalid_state); | |
| 4071 DEFERROR (Qcyclic_variable_indirection, | |
| 4072 "Symbol's chain of variable indirections contains a loop", | |
| 4073 Qinvalid_state); | |
| 563 | 4074 DEFERROR_STANDARD (Qstack_overflow, Qinvalid_state); |
| 4075 DEFERROR_STANDARD (Qinternal_error, Qinvalid_state); | |
| 4076 DEFERROR_STANDARD (Qout_of_memory, Qinvalid_state); | |
| 428 | 4077 |
| 563 | 4078 DEFERROR_STANDARD (Qinvalid_operation, Qerror); |
| 4079 DEFERROR_STANDARD (Qinvalid_change, Qinvalid_operation); | |
| 442 | 4080 DEFERROR (Qsetting_constant, "Attempt to set a constant symbol", |
| 4081 Qinvalid_change); | |
| 563 | 4082 DEFERROR_STANDARD (Qprinting_unreadable_object, Qinvalid_operation); |
| 4083 DEFERROR (Qunimplemented, "Feature not yet implemented", Qinvalid_operation); | |
| 442 | 4084 |
| 563 | 4085 DEFERROR_STANDARD (Qediting_error, Qinvalid_operation); |
| 442 | 4086 DEFERROR_STANDARD (Qbeginning_of_buffer, Qediting_error); |
| 4087 DEFERROR_STANDARD (Qend_of_buffer, Qediting_error); | |
| 4088 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
|
4089 DEFERROR (Qextent_read_only, "Extent is read-only", Qediting_error); |
| 442 | 4090 |
| 4091 DEFERROR (Qio_error, "IO Error", Qinvalid_operation); | |
| 563 | 4092 DEFERROR_STANDARD (Qfile_error, Qio_error); |
| 4093 DEFERROR (Qend_of_file, "End of file or stream", Qfile_error); | |
| 4094 DEFERROR_STANDARD (Qconversion_error, Qio_error); | |
| 580 | 4095 DEFERROR_STANDARD (Qtext_conversion_error, Qconversion_error); |
| 442 | 4096 |
| 4097 DEFERROR (Qarith_error, "Arithmetic error", Qinvalid_operation); | |
| 4098 DEFERROR (Qrange_error, "Arithmetic range error", Qarith_error); | |
| 4099 DEFERROR (Qdomain_error, "Arithmetic domain error", Qarith_error); | |
| 4100 DEFERROR (Qsingularity_error, "Arithmetic singularity error", Qdomain_error); | |
| 4101 DEFERROR (Qoverflow_error, "Arithmetic overflow error", Qdomain_error); | |
| 4102 DEFERROR (Qunderflow_error, "Arithmetic underflow error", Qdomain_error); | |
| 428 | 4103 } |
| 4104 | |
| 4105 void | |
| 4106 syms_of_data (void) | |
| 4107 { | |
|
5117
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
4108 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
|
4109 INIT_LISP_OBJECT (ephemeron); |
|
3742ea8250b5
Checking in final CVS version of workspace 'ben-lisp-object'
Ben Wing <ben@xemacs.org>
parents:
3017
diff
changeset
|
4110 INIT_LISP_OBJECT (weak_box); |
| 442 | 4111 |
| 4112 DEFSYMBOL (Qlambda); | |
| 4113 DEFSYMBOL (Qlistp); | |
| 4114 DEFSYMBOL (Qtrue_list_p); | |
| 4115 DEFSYMBOL (Qconsp); | |
| 4116 DEFSYMBOL (Qsubrp); | |
| 4117 DEFSYMBOL (Qsymbolp); | |
| 4118 DEFSYMBOL (Qintegerp); | |
| 4119 DEFSYMBOL (Qcharacterp); | |
| 4120 DEFSYMBOL (Qnatnump); | |
| 1983 | 4121 DEFSYMBOL (Qnonnegativep); |
| 442 | 4122 DEFSYMBOL (Qstringp); |
| 4123 DEFSYMBOL (Qarrayp); | |
| 4124 DEFSYMBOL (Qsequencep); | |
| 4125 DEFSYMBOL (Qbufferp); | |
| 4126 DEFSYMBOL (Qbitp); | |
| 4127 DEFSYMBOL_MULTIWORD_PREDICATE (Qbit_vectorp); | |
| 4128 DEFSYMBOL (Qvectorp); | |
| 4129 DEFSYMBOL (Qchar_or_string_p); | |
| 4130 DEFSYMBOL (Qmarkerp); | |
| 4131 DEFSYMBOL (Qinteger_or_marker_p); | |
| 4132 DEFSYMBOL (Qinteger_or_char_p); | |
| 4133 DEFSYMBOL (Qinteger_char_or_marker_p); | |
| 4134 DEFSYMBOL (Qnumberp); | |
| 4135 DEFSYMBOL (Qnumber_char_or_marker_p); | |
| 4136 DEFSYMBOL (Qcdr); | |
| 563 | 4137 DEFSYMBOL (Qerror_lacks_explanatory_string); |
| 442 | 4138 DEFSYMBOL_MULTIWORD_PREDICATE (Qweak_listp); |
| 4139 DEFSYMBOL (Qfloatp); | |
| 428 | 4140 |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4141 DEFKEYWORD (Q_radix); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4142 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
|
4143 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
|
4144 |
| 428 | 4145 DEFSUBR (Fwrong_type_argument); |
| 4146 | |
| 1983 | 4147 #ifdef HAVE_RATIO |
| 4148 DEFSUBR (Fdiv); | |
| 4149 #endif | |
| 428 | 4150 DEFSUBR (Feq); |
| 4151 DEFSUBR (Fnull); | |
| 4152 Ffset (intern ("not"), intern ("null")); | |
| 4153 DEFSUBR (Flistp); | |
| 4154 DEFSUBR (Fnlistp); | |
| 4155 DEFSUBR (Ftrue_list_p); | |
| 4156 DEFSUBR (Fconsp); | |
| 4157 DEFSUBR (Fatom); | |
| 4158 DEFSUBR (Fchar_or_string_p); | |
| 4159 DEFSUBR (Fcharacterp); | |
| 4160 DEFSUBR (Fchar_int_p); | |
| 4161 DEFSUBR (Fchar_to_int); | |
| 4162 DEFSUBR (Fint_to_char); | |
| 4163 DEFSUBR (Fchar_or_char_int_p); | |
| 1983 | 4164 DEFSUBR (Ffixnump); |
| 428 | 4165 DEFSUBR (Fintegerp); |
| 4166 DEFSUBR (Finteger_or_marker_p); | |
| 4167 DEFSUBR (Finteger_or_char_p); | |
| 4168 DEFSUBR (Finteger_char_or_marker_p); | |
| 4169 DEFSUBR (Fnumberp); | |
| 4170 DEFSUBR (Fnumber_or_marker_p); | |
| 4171 DEFSUBR (Fnumber_char_or_marker_p); | |
| 4172 DEFSUBR (Ffloatp); | |
| 4173 DEFSUBR (Fnatnump); | |
| 1983 | 4174 DEFSUBR (Fnonnegativep); |
| 428 | 4175 DEFSUBR (Fsymbolp); |
| 4176 DEFSUBR (Fkeywordp); | |
| 4177 DEFSUBR (Fstringp); | |
| 4178 DEFSUBR (Fvectorp); | |
| 4179 DEFSUBR (Fbitp); | |
| 4180 DEFSUBR (Fbit_vector_p); | |
| 4181 DEFSUBR (Farrayp); | |
| 4182 DEFSUBR (Fsequencep); | |
| 4183 DEFSUBR (Fmarkerp); | |
| 4184 DEFSUBR (Fsubrp); | |
| 4185 DEFSUBR (Fsubr_min_args); | |
| 4186 DEFSUBR (Fsubr_max_args); | |
| 4187 DEFSUBR (Fsubr_interactive); | |
| 4188 DEFSUBR (Ftype_of); | |
| 4189 DEFSUBR (Fcar); | |
| 4190 DEFSUBR (Fcdr); | |
| 4191 DEFSUBR (Fcar_safe); | |
| 4192 DEFSUBR (Fcdr_safe); | |
| 4193 DEFSUBR (Fsetcar); | |
| 4194 DEFSUBR (Fsetcdr); | |
| 4195 DEFSUBR (Findirect_function); | |
| 4196 DEFSUBR (Faref); | |
| 4197 DEFSUBR (Faset); | |
| 4198 | |
| 4199 DEFSUBR (Fnumber_to_string); | |
| 4200 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
|
4201 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
|
4202 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
|
4203 DEFSUBR (Fdigit_char); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4204 DEFSUBR (Fparse_integer); |
| 428 | 4205 DEFSUBR (Feqlsign); |
| 4206 DEFSUBR (Flss); | |
| 4207 DEFSUBR (Fgtr); | |
| 4208 DEFSUBR (Fleq); | |
| 4209 DEFSUBR (Fgeq); | |
| 4210 DEFSUBR (Fneq); | |
| 4211 DEFSUBR (Fzerop); | |
| 4212 DEFSUBR (Fplus); | |
| 4213 DEFSUBR (Fminus); | |
| 4214 DEFSUBR (Ftimes); | |
| 4215 DEFSUBR (Fquo); | |
| 4216 DEFSUBR (Frem); | |
| 4217 DEFSUBR (Fmod); | |
| 4218 DEFSUBR (Fmax); | |
| 4219 DEFSUBR (Fmin); | |
| 4220 DEFSUBR (Flogand); | |
| 4221 DEFSUBR (Flogior); | |
| 4222 DEFSUBR (Flogxor); | |
| 4223 DEFSUBR (Flsh); | |
| 4224 DEFSUBR (Fash); | |
| 4225 DEFSUBR (Fadd1); | |
| 4226 DEFSUBR (Fsub1); | |
| 4227 DEFSUBR (Flognot); | |
| 4228 | |
| 4229 DEFSUBR (Fweak_list_p); | |
| 4230 DEFSUBR (Fmake_weak_list); | |
| 4231 DEFSUBR (Fweak_list_type); | |
| 4232 DEFSUBR (Fweak_list_list); | |
| 4233 DEFSUBR (Fset_weak_list_list); | |
| 858 | 4234 |
| 888 | 4235 DEFSUBR (Fmake_ephemeron); |
| 4236 DEFSUBR (Fephemeron_ref); | |
| 4237 DEFSUBR (Fephemeronp); | |
| 858 | 4238 DEFSUBR (Fmake_weak_box); |
| 4239 DEFSUBR (Fweak_box_ref); | |
| 4240 DEFSUBR (Fweak_boxp); | |
| 428 | 4241 } |
| 4242 | |
| 4243 void | |
| 4244 vars_of_data (void) | |
| 4245 { | |
| 4246 /* This must not be staticpro'd */ | |
| 4247 Vall_weak_lists = Qnil; | |
| 452 | 4248 dump_add_weak_object_chain (&Vall_weak_lists); |
| 428 | 4249 |
| 888 | 4250 Vall_ephemerons = Qnil; |
| 4251 dump_add_weak_object_chain (&Vall_ephemerons); | |
| 4252 | |
| 4253 Vfinalize_list = Qnil; | |
| 4254 staticpro (&Vfinalize_list); | |
| 4255 | |
| 858 | 4256 Vall_weak_boxes = Qnil; |
| 4257 dump_add_weak_object_chain (&Vall_weak_boxes); | |
| 4258 | |
|
4885
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
4259 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
|
4260 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
|
4261 */); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
4262 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
|
4263 |
|
6772ce4d982b
Fix hash tables, #'member*, #'assoc*, #'eql compiler macros if bignums
Aidan Kehoe <kehoea@parhasard.net>
parents:
4846
diff
changeset
|
4264 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
|
4265 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
|
4266 */); |
|
5581
56144c8593a8
Mechanically change INT to FIXNUM in our sources.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5510
diff
changeset
|
4267 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
|
4268 |
|
5864
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4269 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
|
4270 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
|
4271 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4272 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
|
4273 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
|
4274 `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
|
4275 */); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4276 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
|
4277 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
|
4278 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4279 int ii = 0; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4280 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4281 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
|
4282 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4283 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
|
4284 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4285 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4286 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
|
4287 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4288 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
|
4289 = make_fixnum(ii); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4290 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
|
4291 = make_fixnum(ii); |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4292 } |
|
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 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4295 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
|
4296 int ii; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4297 Ichar cc; |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4298 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
|
4299 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4300 /* 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
|
4301 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
|
4302 bytes. */ |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4303 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
|
4304 { |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4305 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
|
4306 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
|
4307 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4308 |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4309 /* 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
|
4310 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
|
4311 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
|
4312 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
|
4313 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
|
4314 = 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
|
4315 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
|
4316 } |
|
750fab17b299
Make #'parse-integer Lisp-visible, extend it, allowing non-ASCII digits.
Aidan Kehoe <kehoea@parhasard.net>
parents:
5769
diff
changeset
|
4317 |
| 428 | 4318 #ifdef DEBUG_XEMACS |
| 4319 DEFVAR_BOOL ("debug-issue-ebola-notices", &debug_issue_ebola_notices /* | |
| 4320 If non-zero, note when your code may be suffering from char-int confoundance. | |
| 4321 That is to say, if XEmacs encounters a usage of `eq', `memq', `equal', | |
| 4322 etc. where an int and a char with the same value are being compared, | |
| 4323 it will issue a notice on stderr to this effect, along with a backtrace. | |
| 4324 In such situations, the result would be different in XEmacs 19 versus | |
| 4325 XEmacs 20, and you probably don't want this. | |
| 4326 | |
| 4327 Note that in order to see these notices, you have to byte compile your | |
| 4328 code under XEmacs 20 -- any code byte-compiled under XEmacs 19 will | |
| 4329 have its chars and ints all confounded in the byte code, making it | |
| 4330 impossible to accurately determine Ebola infection. | |
| 4331 */ ); | |
| 4332 | |
| 4333 debug_issue_ebola_notices = 0; | |
| 4334 | |
| 4335 DEFVAR_INT ("debug-ebola-backtrace-length", | |
| 4336 &debug_ebola_backtrace_length /* | |
| 4337 Length (in stack frames) of short backtrace printed out in Ebola notices. | |
| 4338 See `debug-issue-ebola-notices'. | |
| 4339 */ ); | |
| 4340 debug_ebola_backtrace_length = 32; | |
| 4341 | |
| 4342 #endif /* DEBUG_XEMACS */ | |
| 4343 } |