[COMMIT] Fix my last change when both --with-union-type and --with-xft, thanks Robert.
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
Ar an dara lá is fiche de mí na Samhain, scríobh robert delius royar:
> I get a compilation failure below:
> [...]
> font-mgr.c: In function 'Ffc_pattern_get':
> font-mgr.c:443: error: incompatible type for argument 1 of '__gmpz_get_si'
> make[1]: *** [font-mgr.o] Error 1
> make: *** [src] Error 2
Found the error and fixed it, thank you Robert!
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1290621297 0
# Node ID 17c381a2f377655bd241d72fda5fca656fa67104
# Parent c096d8051f893c2a283f1c7f306a8340e470ed45
Fix my last change when both --with-union-type and --with-xft, thanks Robert.
2010-11-24 Aidan Kehoe <kehoea(a)parhasard.net>
* font-mgr.c (Ffc_pattern_get): Fix my last change when both
--with-union-type and --with-xft are specified, thank you Robert
Delius Royar!
diff -r c096d8051f89 -r 17c381a2f377 src/ChangeLog
--- a/src/ChangeLog Sat Nov 20 16:49:11 2010 +0000
+++ b/src/ChangeLog Wed Nov 24 17:54:57 2010 +0000
＠＠ -1,3 +1,9 ＠＠
+2010-11-24 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * font-mgr.c (Ffc_pattern_get): Fix my last change when both
+ --with-union-type and --with-xft are specified, thank you Robert
+ Delius Royar!
+
2010-11-20 Aidan Kehoe <kehoea(a)parhasard.net>
* abbrev.c (Fexpand_abbrev):
diff -r c096d8051f89 -r 17c381a2f377 src/font-mgr.c
--- a/src/font-mgr.c Sat Nov 20 16:49:11 2010 +0000
+++ b/src/font-mgr.c Wed Nov 24 17:54:57 2010 +0000
＠＠ -440,7 +440,7 ＠＠
{
#ifdef HAVE_BIGNUM
check_integer_range (id, Qzero, make_integer (INT_MAX));
- int_id = BIGNUMP (id) ? bignum_to_int (id) : XINT (id);
+ int_id = BIGNUMP (id) ? bignum_to_int (XBIGNUM_DATA (id)) : XINT (id);
#else
check_integer_range (id, Qzero, make_integer (EMACS_INT_MAX));
int_id = XINT (id);
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Fix my last change when both --with-union-type and --with-xft, thanks Robert.
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
changeset: 5308:17c381a2f377
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Wed Nov 24 17:54:57 2010 +0000
files: src/ChangeLog src/font-mgr.c
description:
Fix my last change when both --with-union-type and --with-xft, thanks Robert.
2010-11-24 Aidan Kehoe <kehoea(a)parhasard.net>
* font-mgr.c (Ffc_pattern_get): Fix my last change when both
--with-union-type and --with-xft are specified, thank you Robert
Delius Royar!
diff -r c096d8051f89 -r 17c381a2f377 src/ChangeLog
--- a/src/ChangeLog Sat Nov 20 16:49:11 2010 +0000
+++ b/src/ChangeLog Wed Nov 24 17:54:57 2010 +0000
＠＠ -1,3 +1,9 ＠＠
+2010-11-24 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * font-mgr.c (Ffc_pattern_get): Fix my last change when both
+ --with-union-type and --with-xft are specified, thank you Robert
+ Delius Royar!
+
2010-11-20 Aidan Kehoe <kehoea(a)parhasard.net>
* abbrev.c (Fexpand_abbrev):
diff -r c096d8051f89 -r 17c381a2f377 src/font-mgr.c
--- a/src/font-mgr.c Sat Nov 20 16:49:11 2010 +0000
+++ b/src/font-mgr.c Wed Nov 24 17:54:57 2010 +0000
＠＠ -440,7 +440,7 ＠＠
{
#ifdef HAVE_BIGNUM
check_integer_range (id, Qzero, make_integer (INT_MAX));
- int_id = BIGNUMP (id) ? bignum_to_int (id) : XINT (id);
+ int_id = BIGNUMP (id) ? bignum_to_int (XBIGNUM_DATA (id)) : XINT (id);
#else
check_integer_range (id, Qzero, make_integer (EMACS_INT_MAX));
int_id = XINT (id);
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[PATCH] Have NATNUMP give t for positive bignums; check limits appropriately.
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
This is annoyingly invasive, and doesn’t lead to any real benefit for users,
just for programmers. It still should go in, though. The issue is that
NATNUMP() currently gives zero for positive bignums, while #'natnump gives
one. So there are many places where you get errors that look like
(wrong-type-argument natnump <some big positive number>); this changes many
of them to give range errors instead. In other places it is appropriate to
accept a bignum of the appropriate size, e.g. in #'accept-process-output for
the timer arguments, where a fixnum does not have enough precision.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1290271751 0
# Node ID c096d8051f893c2a283f1c7f306a8340e470ed45
# Parent cde1608596d0b70c29939d8f4701299c3cf4aa1e
Have NATNUMP give t for positive bignums; check limits appropriately.
src/ChangeLog addition:
2010-11-20 Aidan Kehoe <kehoea(a)parhasard.net>
* abbrev.c (Fexpand_abbrev):
* alloc.c:
* alloc.c (Fmake_list):
* alloc.c (Fmake_vector):
* alloc.c (Fmake_bit_vector):
* alloc.c (Fmake_byte_code):
* alloc.c (Fmake_string):
* alloc.c (vars_of_alloc):
* bytecode.c (UNUSED):
* bytecode.c (Fbyte_code):
* chartab.c (decode_char_table_range):
* cmds.c (Fself_insert_command):
* data.c (check_integer_range):
* data.c (Fnatnump):
* data.c (Fnonnegativep):
* data.c (Fstring_to_number):
* elhash.c (hash_table_size_validate):
* elhash.c (decode_hash_table_size):
* eval.c (Fbacktrace_frame):
* event-stream.c (lisp_number_to_milliseconds):
* event-stream.c (Faccept_process_output):
* event-stream.c (Frecent_keys):
* event-stream.c (Fdispatch_event):
* events.c (Fmake_event):
* events.c (Fevent_timestamp):
* events.c (Fevent_timestamp_lessp):
* events.h:
* events.h (struct command_builder):
* file-coding.c (gzip_putprop):
* fns.c:
* fns.c (check_sequence_range):
* fns.c (Frandom):
* fns.c (Fnthcdr):
* fns.c (Flast):
* fns.c (Fnbutlast):
* fns.c (Fbutlast):
* fns.c (Fmember):
* fns.c (Ffill):
* fns.c (Freduce):
* fns.c (replace_string_range_1):
* fns.c (Freplace):
* font-mgr.c (Ffc_pattern_get):
* frame-msw.c (msprinter_set_frame_properties):
* glyphs.c (check_valid_xbm_inline):
* indent.c (Fmove_to_column):
* intl-win32.c (mswindows_multibyte_to_unicode_putprop):
* lisp.h:
* lisp.h (ARRAY_DIMENSION_LIMIT):
* lread.c (decode_mode_1):
* mule-ccl.c (ccl_get_compiled_code):
* number.h:
* process-unix.c (unix_open_multicast_group):
* process.c (Fset_process_window_size):
* profile.c (Fstart_profiling):
* unicode.c (Funicode_to_char):
Change NATNUMP to return 1 for positive bignums; changes uses of
it and of CHECK_NATNUM appropriately, usually by checking for an
integer in an appropriate range.
Add array-dimension-limit and use it in #'make-vector,
#'make-string. Add array-total-size-limit, array-rank-limit while
we're at it, for the sake of any Common Lisp-oriented code that
uses these limits.
Rename check_int_range to check_integer_range, have it take
Lisp_Objects (and thus bignums) instead.
Remove bignum_butlast(), just set int_n to an appropriately large
integer if N is a bignum.
Accept bignums in check_sequence_range(), change the functions
that use check_sequence_range() appropriately.
Move the definition of NATNUMP() to number.h; document why it's a
reasonable name, contradicting an old comment.
tests/ChangeLog addition:
2010-11-20 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el:
* automated/lisp-tests.el (featurep):
* automated/lisp-tests.el (wrong-type-argument):
* automated/mule-tests.el (featurep):
Check for args-out-of-range errors instead of wrong-type-argument
errors in various places when code is handed a large bignum
instead of a fixnum.
Also check for the wrong-type-argument errors when giving the same
code a non-integer value.
diff -r cde1608596d0 -r c096d8051f89 src/ChangeLog
--- a/src/ChangeLog Wed Nov 17 14:37:26 2010 +0000
+++ b/src/ChangeLog Sat Nov 20 16:49:11 2010 +0000
＠＠ -1,3 +1,76 ＠＠
+2010-11-20 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * abbrev.c (Fexpand_abbrev):
+ * alloc.c:
+ * alloc.c (Fmake_list):
+ * alloc.c (Fmake_vector):
+ * alloc.c (Fmake_bit_vector):
+ * alloc.c (Fmake_byte_code):
+ * alloc.c (Fmake_string):
+ * alloc.c (vars_of_alloc):
+ * bytecode.c (UNUSED):
+ * bytecode.c (Fbyte_code):
+ * chartab.c (decode_char_table_range):
+ * cmds.c (Fself_insert_command):
+ * data.c (check_integer_range):
+ * data.c (Fnatnump):
+ * data.c (Fnonnegativep):
+ * data.c (Fstring_to_number):
+ * elhash.c (hash_table_size_validate):
+ * elhash.c (decode_hash_table_size):
+ * eval.c (Fbacktrace_frame):
+ * event-stream.c (lisp_number_to_milliseconds):
+ * event-stream.c (Faccept_process_output):
+ * event-stream.c (Frecent_keys):
+ * event-stream.c (Fdispatch_event):
+ * events.c (Fmake_event):
+ * events.c (Fevent_timestamp):
+ * events.c (Fevent_timestamp_lessp):
+ * events.h:
+ * events.h (struct command_builder):
+ * file-coding.c (gzip_putprop):
+ * fns.c:
+ * fns.c (check_sequence_range):
+ * fns.c (Frandom):
+ * fns.c (Fnthcdr):
+ * fns.c (Flast):
+ * fns.c (Fnbutlast):
+ * fns.c (Fbutlast):
+ * fns.c (Fmember):
+ * fns.c (Ffill):
+ * fns.c (Freduce):
+ * fns.c (replace_string_range_1):
+ * fns.c (Freplace):
+ * font-mgr.c (Ffc_pattern_get):
+ * frame-msw.c (msprinter_set_frame_properties):
+ * glyphs.c (check_valid_xbm_inline):
+ * indent.c (Fmove_to_column):
+ * intl-win32.c (mswindows_multibyte_to_unicode_putprop):
+ * lisp.h:
+ * lisp.h (ARRAY_DIMENSION_LIMIT):
+ * lread.c (decode_mode_1):
+ * mule-ccl.c (ccl_get_compiled_code):
+ * number.h:
+ * process-unix.c (unix_open_multicast_group):
+ * process.c (Fset_process_window_size):
+ * profile.c (Fstart_profiling):
+ * unicode.c (Funicode_to_char):
+ Change NATNUMP to return 1 for positive bignums; changes uses of
+ it and of CHECK_NATNUM appropriately, usually by checking for an
+ integer in an appropriate range.
+ Add array-dimension-limit and use it in #'make-vector,
+ #'make-string. Add array-total-size-limit, array-rank-limit while
+ we're at it, for the sake of any Common Lisp-oriented code that
+ uses these limits.
+ Rename check_int_range to check_integer_range, have it take
+ Lisp_Objects (and thus bignums) instead.
+ Remove bignum_butlast(), just set int_n to an appropriately large
+ integer if N is a bignum.
+ Accept bignums in check_sequence_range(), change the functions
+ that use check_sequence_range() appropriately.
+ Move the definition of NATNUMP() to number.h; document why it's a
+ reasonable name, contradicting an old comment.
+
2010-11-17 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (bignum_butlast): New.
diff -r cde1608596d0 -r c096d8051f89 src/abbrev.c
--- a/src/abbrev.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/abbrev.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -343,7 +343,7 ＠＠
count = Qzero;
else
CHECK_NATNUM (count);
- symbol_plist (abbrev_symbol) = make_int (1 + XINT (count));
+ symbol_plist (abbrev_symbol) = Fadd1 (count);
/* Count the case in the original text. */
abbrev_count_case (buf, abbrev_start, abbrev_length, &lccount, &uccount);
diff -r cde1608596d0 -r c096d8051f89 src/alloc.c
--- a/src/alloc.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/alloc.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -96,6 +96,8 ＠＠
static Fixnum debug_allocation_backtrace_length;
#endif
+Fixnum Varray_dimension_limit, Varray_total_size_limit, Varray_rank_limit;
+
int need_to_check_c_alloca;
int need_to_signal_post_gc;
int funcall_allocation_flag;
＠＠ -1500,16 +1502,17 ＠＠
*/
(length, object))
{
- CHECK_NATNUM (length);
-
- {
- Lisp_Object val = Qnil;
- EMACS_INT size = XINT (length);
-
- while (size--)
- val = Fcons (object, val);
- return val;
- }
+ Lisp_Object val = Qnil;
+ Elemcount size;
+
+ check_integer_range (length, Qzero, make_integer (EMACS_INT_MAX));
+
+ size = XINT (length);
+
+ while (size--)
+ val = Fcons (object, val);
+
+ return val;
}
＠＠ -1743,7 +1746,7 ＠＠
*/
(length, object))
{
- CONCHECK_NATNUM (length);
+ check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT));
return make_vector (XINT (length), object);
}
＠＠ -1925,8 +1928,7 ＠＠
*/
(length, bit))
{
- CONCHECK_NATNUM (length);
-
+ check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT));
return make_bit_vector (XINT (length), bit);
}
＠＠ -2052,7 +2054,7 ＠＠
CHECK_VECTOR (constants);
f->constants = constants;
- CHECK_NATNUM (stack_depth);
+ check_integer_range (stack_depth, Qzero, make_int (USHRT_MAX));
f->stack_depth = (unsigned short) XINT (stack_depth);
#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
＠＠ -2884,7 +2886,7 ＠＠
*/
(length, character))
{
- CHECK_NATNUM (length);
+ check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT));
CHECK_CHAR_COERCE_INT (character);
{
Ibyte init_str[MAX_ICHAR_LEN];
＠＠ -5739,6 +5741,34 ＠＠
void
vars_of_alloc (void)
{
+ DEFVAR_CONST_INT ("array-rank-limit", &Varray_rank_limit /*
+The exclusive upper bound on the number of dimensions an array may have.
+
+XEmacs does not support multidimensional arrays, meaning this constant is,
+for the moment, 2.
+*/);
+ Varray_rank_limit = 2;
+
+ DEFVAR_CONST_INT ("array-dimension-limit", &Varray_dimension_limit /*
+The exclusive upper bound of an array's dimension.
+Note that XEmacs may not have enough memory available to create an array
+with this dimension.
+*/);
+ Varray_dimension_limit = ARRAY_DIMENSION_LIMIT;
+
+ DEFVAR_CONST_INT ("array-total-size-limit", &Varray_total_size_limit /*
+The exclusive upper bound on the number of elements an array may contain.
+
+In Common Lisp, this is distinct from `array-dimension-limit', because
+arrays can have more than one dimension. In XEmacs this is not the case,
+and multi-dimensional arrays need to be implemented by the user with arrays
+of arrays.
+
+Note that XEmacs may not have enough memory available to create an array
+with this dimension.
+*/);
+ Varray_total_size_limit = ARRAY_DIMENSION_LIMIT;
+
#ifdef DEBUG_XEMACS
DEFVAR_INT ("debug-allocation", &debug_allocation /*
If non-zero, print out information to stderr about all objects allocated.
diff -r cde1608596d0 -r c096d8051f89 src/bytecode.c
--- a/src/bytecode.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/bytecode.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -1731,8 +1731,9 ＠＠
{
Lisp_Object upper = POP, first = TOP, speccount;
- CHECK_NATNUM (upper);
- CHECK_NATNUM (first);
+ check_integer_range (upper, Qzero,
+ make_integer (Vmultiple_values_limit));
+ check_integer_range (first, Qzero, upper);
speccount = make_int (bind_multiple_value_limits (XINT (first),
XINT (upper)));
＠＠ -2757,7 +2758,7 ＠＠
CHECK_STRING (instructions);
CHECK_VECTOR (constants);
- CHECK_NATNUM (stack_depth);
+ check_integer_range (stack_depth, Qzero, make_int (USHRT_MAX));
/* Optimize the `instructions' string, just like when executing a
regular compiled function, but don't save it for later since this is
diff -r cde1608596d0 -r c096d8051f89 src/chartab.c
--- a/src/chartab.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/chartab.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -257,10 +257,12 ＠＠
sferror ("Charset in row vector must be multi-byte",
outrange->charset);
case CHARSET_TYPE_94X94:
- check_int_range (outrange->row, 33, 126);
+ check_integer_range (make_int (outrange->row), make_int (33),
+ make_int (126));
break;
case CHARSET_TYPE_96X96:
- check_int_range (outrange->row, 32, 127);
+ check_integer_range (make_int (outrange->row), make_int (32),
+ make_int (127));
break;
default:
ABORT ();
diff -r cde1608596d0 -r c096d8051f89 src/cmds.c
--- a/src/cmds.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/cmds.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -334,7 +334,9 ＠＠
Lisp_Object c;
EMACS_INT n;
- CHECK_NATNUM (count);
+ /* Can't insert more than most-positive-fixnum characters, the buffer
+ won't hold that many. */
+ check_integer_range (count, Qzero, make_int (EMACS_INT_MAX));
n = XINT (count);
if (CHAR_OR_CHAR_INTP (Vlast_command_char))
diff -r cde1608596d0 -r c096d8051f89 src/data.c
--- a/src/data.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/data.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -158,10 +158,18 ＠＠
}
void
-check_int_range (EMACS_INT val, EMACS_INT min, EMACS_INT max)
+check_integer_range (Lisp_Object val, Lisp_Object min, Lisp_Object max)
{
- if (val < min || val > max)
- args_out_of_range_3 (make_int (val), make_int (min), make_int (max));
+ Lisp_Object args[] = { min, val, max };
+ int ii;
+
+ for (ii = 0; ii < countof (args); ii++)
+ {
+ CHECK_INTEGER (args[ii]);
+ }
+
+ if (NILP (Fleq (countof (args), args)))
+ args_out_of_range_3 (val, min, max);
}
＠＠ -504,11 +512,7 ＠＠
*/
(object))
{
- return NATNUMP (object)
-#ifdef HAVE_BIGNUM
- || (BIGNUMP (object) && bignum_sign (XBIGNUM_DATA (object)) >= 0)
-#endif
- ? Qt : Qnil;
+ return NATNUMP (object) ? Qt : Qnil;
}
DEFUN ("nonnegativep", Fnonnegativep, 1, 1, 0, /*
＠＠ -517,9 +521,6 ＠＠
(object))
{
return NATNUMP (object)
-#ifdef HAVE_BIGNUM
- || (BIGNUMP (object) && bignum_sign (XBIGNUM_DATA (object)) >= 0)
-#endif
#ifdef HAVE_RATIO
|| (RATIOP (object) && ratio_sign (XRATIO_DATA (object)) >= 0)
#endif
＠＠ -1295,9 +1296,8 ＠＠
b = 10;
else
{
- CHECK_INT (base);
+ check_integer_range (base, make_int (2), make_int (16));
b = XINT (base);
- check_int_range (b, 2, 16);
}
p = XSTRING_DATA (string);
diff -r cde1608596d0 -r c096d8051f89 src/elhash.c
--- a/src/elhash.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/elhash.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -733,10 +733,27 ＠＠
Error_Behavior errb)
{
if (NATNUMP (value))
- return 1;
+ {
+ if (BIGNUMP (value))
+ {
+ /* hash_table_size() can't handle excessively large sizes. */
+ maybe_signal_error_1 (Qargs_out_of_range,
+ list3 (value, Qzero,
+ make_integer (EMACS_INT_MAX)),
+ Qhash_table, errb);
+ return 0;
+ }
+ else
+ {
+ return 1;
+ }
+ }
+ else
+ {
+ maybe_signal_error_1 (Qwrong_type_argument, list2 (Qnatnump, value),
+ Qhash_table, errb);
+ }
- maybe_signal_error_1 (Qwrong_type_argument, list2 (Qnatnump, value),
- Qhash_table, errb);
return 0;
}
diff -r cde1608596d0 -r c096d8051f89 src/eval.c
--- a/src/eval.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/eval.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -4923,17 +4923,19 ＠＠
}
argv[0] = IGNORE_MULTIPLE_VALUES (Feval (XCAR (args)));
- CHECK_NATNUM (argv[0]);
- first = XINT (argv[0]);
GCPRO1 (argv[0]);
gcpro1.nvars = 1;
args = XCDR (args);
-
argv[1] = IGNORE_MULTIPLE_VALUES (Feval (XCAR (args)));
- CHECK_NATNUM (argv[1]);
+
+ check_integer_range (argv[1], Qzero, make_int (EMACS_INT_MAX));
+ check_integer_range (argv[0], Qzero, argv[1]);
+
upper = XINT (argv[1]);
+ first = XINT (argv[0]);
+
gcpro1.nvars = 2;
/* The unintuitive order of things here is for the sake of the bytecode;
＠＠ -7205,7 +7207,7 ＠＠
REGISTER int i;
Lisp_Object tem;
- CHECK_NATNUM (nframes);
+ check_integer_range (nframes, Qzero, make_integer (EMACS_INT_MAX));
/* Find the frame requested. */
for (i = XINT (nframes); backlist && (i-- > 0);)
diff -r cde1608596d0 -r c096d8051f89 src/event-stream.c
--- a/src/event-stream.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/event-stream.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -1238,18 +1238,30 ＠＠
static unsigned long
lisp_number_to_milliseconds (Lisp_Object secs, int allow_0)
{
- double fsecs;
- CHECK_INT_OR_FLOAT (secs);
- fsecs = XFLOATINT (secs);
- if (fsecs < 0)
- invalid_argument ("timeout is negative", secs);
- if (!allow_0 && fsecs == 0)
- invalid_argument ("timeout is non-positive", secs);
- if (fsecs >= (((unsigned int) 0xFFFFFFFF) / 1000))
- invalid_argument
- ("timeout would exceed 32 bits when represented in milliseconds", secs);
-
- return (unsigned long) (1000 * fsecs);
+ Lisp_Object args[] = { allow_0 ? Qzero : make_int (1),
+ secs,
+ /* (((unsigned int) 0xFFFFFFFF) / 1000) - 1 */
+ make_int (4294967 - 1) };
+
+ if (!allow_0 && FLOATP (secs) && XFLOAT_DATA (secs) > 0)
+ {
+ args[0] = secs;
+ }
+
+ if (NILP (Fleq (countof (args), args)))
+ {
+ args_out_of_range_3 (secs, args[0], args[2]);
+ }
+
+ args[0] = make_int (1000);
+ args[0] = Ftimes (2, args);
+
+ if (INTP (args[0]))
+ {
+ return XINT (args[0]);
+ }
+
+ return (unsigned long) extract_float (args[0]);
}
DEFUN ("add-timeout", Fadd_timeout, 3, 4, 0, /*
＠＠ -2615,7 +2627,8 ＠＠
msecs = lisp_number_to_milliseconds (timeout_secs, 1);
if (!NILP (timeout_msecs))
{
- CHECK_NATNUM (timeout_msecs);
+ check_integer_range (timeout_msecs, Qzero,
+ make_integer (EMACS_INT_MAX));
msecs += XINT (timeout_msecs);
}
if (msecs)
＠＠ -3704,7 +3717,8 ＠＠
nwanted = recent_keys_ring_size;
else
{
- CHECK_NATNUM (number);
+ check_integer_range (number, Qzero,
+ make_integer (ARRAY_DIMENSION_LIMIT));
nwanted = XINT (number);
}
＠＠ -4519,7 +4533,7 ＠＠
else /* key sequence is bound to a command */
{
int magic_undo = 0;
- int magic_undo_count = 20;
+ Elemcount magic_undo_count = 20;
Vthis_command = leaf;
＠＠ -4539,7 +4553,21 ＠＠
{
Lisp_Object prop = Fget (leaf, Qself_insert_defer_undo, Qnil);
if (NATNUMP (prop))
- magic_undo = 1, magic_undo_count = XINT (prop);
+ {
+ magic_undo = 1;
+ if (INTP (prop))
+ {
+ magic_undo_count = XINT (prop);
+ }
+#ifdef HAVE_BIGNUM
+ else if (BIGNUMP (prop)
+ && bignum_fits_emacs_int_p (XBIGNUM_DATA (prop)))
+ {
+ magic_undo_count
+ = bignum_to_emacs_int (XBIGNUM_DATA (prop));
+ }
+#endif
+ }
else if (!NILP (prop))
magic_undo = 1;
else if (EQ (leaf, Qself_insert_command))
diff -r cde1608596d0 -r c096d8051f89 src/events.c
--- a/src/events.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/events.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -641,8 +641,7 ＠＠
}
else if (EQ (keyword, Qbutton))
{
- CHECK_NATNUM (value);
- check_int_range (XINT (value), 0, 7);
+ check_integer_range (value, Qzero, make_int (26));
switch (EVENT_TYPE (e))
{
＠＠ -737,8 +736,23 ＠＠
}
else if (EQ (keyword, Qtimestamp))
{
- CHECK_NATNUM (value);
- SET_EVENT_TIMESTAMP (e, XINT (value));
+#ifdef HAVE_BIGNUM
+ check_integer_range (value, Qzero, make_integer (UINT_MAX));
+ if (BIGNUMP (value))
+ {
+ SET_EVENT_TIMESTAMP (e, bignum_to_uint (XBIGNUM_DATA (value)));
+ }
+#else
+ check_integer_range (value, Qzero, make_integer (EMACS_INT_MAX));
+#endif
+ if (INTP (value))
+ {
+ SET_EVENT_TIMESTAMP (e, XINT (value));
+ }
+ else
+ {
+ ABORT ();
+ }
}
else if (EQ (keyword, Qfunction))
{
＠＠ -1747,7 +1761,9 ＠＠
{
CHECK_LIVE_EVENT (event);
/* This junk is so that timestamps don't get to be negative, but contain
- as many bits as this particular emacs will allow.
+ as many bits as this particular emacs will allow. We could return
+ bignums on builds that support them, but that involves consing and
+ doesn't work on builds that don't support bignums.
*/
return make_int (EMACS_INT_MAX & XEVENT_TIMESTAMP (event));
}
＠＠ -1763,8 +1779,9 ＠＠
{
EMACS_INT t1, t2;
- CHECK_NATNUM (time1);
- CHECK_NATNUM (time2);
+ check_integer_range (time1, Qzero, make_integer (EMACS_INT_MAX));
+ check_integer_range (time2, Qzero, make_integer (EMACS_INT_MAX));
+
t1 = XINT (time1);
t2 = XINT (time2);
diff -r cde1608596d0 -r c096d8051f89 src/events.h
--- a/src/events.h Wed Nov 17 14:37:26 2010 +0000
+++ b/src/events.h Sat Nov 20 16:49:11 2010 +0000
＠＠ -1159,7 +1159,7 ＠＠
boundary: up to 20 consecutive self-inserts can happen before an undo-
boundary is pushed. This variable is that counter.
*/
- int self_insert_countdown;
+ Elemcount self_insert_countdown;
};
#endif /* INCLUDED_events_h_ */
diff -r cde1608596d0 -r c096d8051f89 src/file-coding.c
--- a/src/file-coding.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/file-coding.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -4310,8 +4310,7 ＠＠
data->level = -1;
else
{
- CHECK_INT (value);
- check_int_range (XINT (value), 0, 9);
+ check_integer_range (value, Qzero, make_int (9));
data->level = XINT (value);
}
}
diff -r cde1608596d0 -r c096d8051f89 src/fileio.c
--- a/src/fileio.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/fileio.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -3294,7 +3294,7 ＠＠
Lisp_Object insval = call1 (p, make_int (inserted));
if (!NILP (insval))
{
- CHECK_NATNUM (insval);
+ check_integer_range (insval, Qzero, make_int (EMACS_INT_MAX));
inserted = XINT (insval);
}
}
diff -r cde1608596d0 -r c096d8051f89 src/fns.c
--- a/src/fns.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/fns.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -78,13 +78,11 ＠＠
check_sequence_range (Lisp_Object sequence, Lisp_Object start,
Lisp_Object end, Lisp_Object length)
{
- Elemcount starting = XINT (start), ending, len = XINT (length);
-
- ending = NILP (end) ? XINT (length) : XINT (end);
-
- if (!(0 <= starting && starting <= ending && ending <= len))
- {
- args_out_of_range_3 (sequence, start, make_int (ending));
+ Lisp_Object args[] = { Qzero, start, NILP (end) ? length : end, length };
+
+ if (NILP (Fleq (countof (args), args)))
+ {
+ args_out_of_range_3 (sequence, start, end);
}
}
＠＠ -228,6 +226,13 ＠＠
seed_random (qxe_getpid () + time (NULL));
if (NATNUMP (limit) && !ZEROP (limit))
{
+#ifdef HAVE_BIGNUM
+ if (BIGNUMP (limit))
+ {
+ bignum_random (scratch_bignum, XBIGNUM_DATA (limit));
+ return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
+ }
+#endif
/* Try to take our random number from the higher bits of VAL,
not the lower, since (says Gentzel) the low bits of `random'
are less random than the higher ones. We do this by using the
＠＠ -240,13 +245,6 ＠＠
val = get_random () / denominator;
while (val >= XINT (limit));
}
-#ifdef HAVE_BIGNUM
- else if (BIGNUMP (limit))
- {
- bignum_random (scratch_bignum, XBIGNUM_DATA (limit));
- return Fcanonicalize_number (make_bignum_bg (scratch_bignum));
- }
-#endif
else
val = get_random ();
＠＠ -1436,7 +1434,7 ＠＠
REGISTER EMACS_INT i;
REGISTER Lisp_Object tail = list;
CHECK_NATNUM (n);
- for (i = XINT (n); i; i--)
+ for (i = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n); i; i--)
{
if (CONSP (tail))
tail = XCDR (tail);
＠＠ -1556,7 +1554,7 ＠＠
else
{
CHECK_NATNUM (n);
- int_n = XINT (n);
+ int_n = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n);
}
for (retval = tortoise = hare = list, count = 0;
＠＠ -1576,9 +1574,6 ＠＠
return retval;
}
-static Lisp_Object bignum_butlast (Lisp_Object list, Lisp_Object number,
- Boolint copy);
-
DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /*
Modify LIST to remove the last N (default 1) elements.
＠＠ -1593,13 +1588,8 ＠＠
if (!NILP (n))
{
- if (BIGNUMP (n))
- {
- return bignum_butlast (list, n, 0);
- }
-
CHECK_NATNUM (n);
- int_n = XINT (n);
+ int_n = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n);
}
if (CONSP (list))
＠＠ -1646,13 +1636,8 ＠＠
if (!NILP (n))
{
- if (BIGNUMP (n))
- {
- return bignum_butlast (list, n, 1);
- }
-
CHECK_NATNUM (n);
- int_n = XINT (n);
+ int_n = BIGNUMP (n) ? 1 + EMACS_INT_MAX : XINT (n);
}
if (CONSP (list))
＠＠ -1686,42 +1671,6 ＠＠
return retval;
}
-/* This is sufficient to implement #'butlast and #'nbutlast with bignum N
- under XEmacs, because #'list-length and #'safe-length can never return a
- bignum. This means that #'nbutlast never has to modify and #'butlast
- never has to copy. */
-static Lisp_Object
-bignum_butlast (Lisp_Object list, Lisp_Object number, Boolint copy)
-{
- Boolint malformed = EQ (Fsafe_length (list), Qzero);
- Boolint circular = !malformed && EQ (Flist_length (list), Qnil);
-
- assert (BIGNUMP (number));
-
-#ifdef HAVE_BIGNUM
-
- if (bignum_sign (XBIGNUM_DATA (number)) < 0)
- {
- dead_wrong_type_argument (Qnatnump, number);
- }
-
- number = Fcanonicalize_number (number);
-
- if (INTP (number))
- {
- return copy ? Fbutlast (list, number) : Fnbutlast (list, number);
- }
-
-#endif
-
- if (circular)
- {
- signal_circular_list_error (list);
- }
-
- return Qnil;
-}
-
DEFUN ("member", Fmember, 2, 2, 0, /*
Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
The value is actually the tail of LIST whose car is ELT.
＠＠ -4224,17 +4173,15 ＠＠
{
Lisp_Object sequence = args[0];
Lisp_Object item = args[1];
- Elemcount starting = 0, ending = EMACS_INT_MAX, ii, len;
+ Elemcount starting = 0, ending = EMACS_INT_MAX + 1, ii, len;
PARSE_KEYWORDS (Ffill, nargs, args, 2, (start, end), (start = Qzero));
CHECK_NATNUM (start);
- starting = XINT (start);
-
if (!NILP (end))
{
CHECK_NATNUM (end);
- ending = XINT (end);
+ ending = BIGNUMP (end) ? EMACS_INT_MAX + 1 : XINT (end);
}
retry:
＠＠ -4254,6 +4201,7 ＠＠
check_sequence_range (sequence, start, end, make_int (len));
ending = min (ending, len);
+ starting = XINT (start);
for (ii = starting; ii < ending; ++ii)
{
＠＠ -4272,6 +4220,7 ＠＠
check_sequence_range (sequence, start, end, make_int (len));
ending = min (ending, len);
+ starting = XINT (start);
for (ii = starting; ii < ending; ++ii)
{
＠＠ -4281,6 +4230,7 ＠＠
else if (LISTP (sequence))
{
Elemcount counting = 0;
+ starting = BIGNUMP (start) ? EMACS_INT_MAX + 1 : XINT (start);
EXTERNAL_LIST_LOOP_3 (elt, sequence, tail)
{
＠＠ -5235,7 +5185,7 ＠＠
(int nargs, Lisp_Object *args))
{
Lisp_Object function = args[0], sequence = args[1], accum = Qunbound;
- Elemcount starting, ending = EMACS_INT_MAX, ii = 0;
+ Elemcount starting, ending = EMACS_INT_MAX + 1, ii = 0;
PARSE_KEYWORDS (Freduce, nargs, args, 5,
(start, end, from_end, initial_value, key),
＠＠ -5243,7 +5193,7 ＠＠
CHECK_SEQUENCE (sequence);
CHECK_NATNUM (start);
-
+ starting = BIGNUMP (start) ? EMACS_INT_MAX + 1 : XINT (start);
CHECK_KEY_ARGUMENT (key);
#define KEY(key, item) (EQ (Qidentity, key) ? item : \
＠＠ -5251,16 +5201,10 ＠＠
#define CALL2(function, accum, item) \
IGNORE_MULTIPLE_VALUES (call2 (function, accum, item))
- starting = XINT (start);
if (!NILP (end))
{
CHECK_NATNUM (end);
- ending = XINT (end);
- }
-
- if (!(starting <= ending))
- {
- check_sequence_range (sequence, start, end, Flength (sequence));
+ ending = BIGNUMP (end) ? EMACS_INT_MAX + 1 : XINT (end);
}
if (VECTORP (sequence))
＠＠ -5432,6 +5376,8 ＠＠
check_sequence_range (sequence, start, end, make_int (len));
ending = min (ending, len);
+ starting = XINT (start);
+
cursor = string_char_addr (sequence, ending - 1);
cursor_offset = cursor - XSTRING_DATA (sequence);
＠＠ -5679,7 +5625,8 ＠＠
Ibyte *destp = XSTRING_DATA (dest), *p = destp,
*pend = p + XSTRING_LENGTH (dest), *pcursor, item_buf[MAX_ICHAR_LEN];
Bytecount prefix_bytecount, source_len = source_limit - source;
- Charcount ii = 0, starting = XINT (start), ending, len;
+ Charcount ii = 0, ending, len;
+ Charcount starting = BIGNUMP (start) ? EMACS_INT_MAX + 1 : XINT (start);
Elemcount delta;
while (ii < starting && p < pend)
＠＠ -5702,7 +5649,7 ＠＠
}
else
{
- ending = XINT (end);
+ ending = BIGNUMP (end) ? EMACS_INT_MAX + 1 : XINT (end);
while (ii < ending && pcursor < pend)
{
INC_IBYTEPTR (pcursor);
＠＠ -5782,8 +5729,8 ＠＠
{
Lisp_Object sequence1 = args[0], sequence2 = args[1],
result = sequence1;
- Elemcount starting1, ending1 = EMACS_INT_MAX, starting2;
- Elemcount ending2 = EMACS_INT_MAX, counting = 0, startcounting;
+ Elemcount starting1, ending1 = EMACS_INT_MAX + 1, starting2;
+ Elemcount ending2 = EMACS_INT_MAX + 1, counting = 0, startcounting;
Boolint sequence1_listp, sequence2_listp,
overwriting = EQ (sequence1, sequence2);
＠＠ -5796,30 +5743,20 ＠＠
CHECK_SEQUENCE (sequence2);
CHECK_NATNUM (start1);
- starting1 = XINT (start1);
+ starting1 = BIGNUMP (start1) ? EMACS_INT_MAX + 1 : XINT (start1);
CHECK_NATNUM (start2);
- starting2 = XINT (start2);
+ starting2 = BIGNUMP (start2) ? EMACS_INT_MAX + 1 : XINT (start2);
if (!NILP (end1))
{
CHECK_NATNUM (end1);
- ending1 = XINT (end1);
-
- if (!(starting1 <= ending1))
- {
- args_out_of_range_3 (sequence1, start1, end1);
- }
+ ending1 = BIGNUMP (end1) ? EMACS_INT_MAX + 1 : XINT (end1);
}
if (!NILP (end2))
{
CHECK_NATNUM (end2);
- ending2 = XINT (end2);
-
- if (!(starting2 <= ending2))
- {
- args_out_of_range_3 (sequence1, start2, end2);
- }
+ ending2 = BIGNUMP (end2) ? EMACS_INT_MAX + 1 : XINT (end2);
}
sequence1_listp = LISTP (sequence1);
diff -r cde1608596d0 -r c096d8051f89 src/font-mgr.c
--- a/src/font-mgr.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/font-mgr.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -411,6 +411,7 ＠＠
Extbyte *fc_property;
FcResult fc_result;
FcValue fc_value;
+ int int_id = 0;
/*
process arguments
＠＠ -435,14 +436,21 ＠＠
dead_wrong_type_argument (Qstringp, property);
}
- if (!NILP (id)) CHECK_NATNUM (id);
+ if (!NILP (id))
+ {
+#ifdef HAVE_BIGNUM
+ check_integer_range (id, Qzero, make_integer (INT_MAX));
+ int_id = BIGNUMP (id) ? bignum_to_int (id) : XINT (id);
+#else
+ check_integer_range (id, Qzero, make_integer (EMACS_INT_MAX));
+ int_id = XINT (id);
+#endif
+ }
if (!NILP (type)) CHECK_SYMBOL (type);
/* get property */
fc_result = FcPatternGet (XFC_PATTERN_PTR (pattern),
- fc_property,
- NILP (id) ? 0 : XINT (id),
- &fc_value);
+ fc_property, int_id, &fc_value);
switch (fc_result)
{
diff -r cde1608596d0 -r c096d8051f89 src/frame-msw.c
--- a/src/frame-msw.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/frame-msw.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -1093,8 +1093,15 ＠＠
maybe_error_if_job_active (f);
if (!NILP (val))
{
- CHECK_NATNUM (val);
- FRAME_MSPRINTER_CHARWIDTH (f) = XINT (val);
+#ifdef HAVE_BIGNUM
+ check_integer_range (val, Qzero, make_integer (INT_MAX));
+ FRAME_MSPRINTER_CHARWIDTH (f) =
+ BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) :
+ XINT (val);
+#else
+ CHECK_NATNUM (val);
+ FRAME_MSPRINTER_CHARWIDTH (f) = XINT (val);
+#endif
}
}
if (EQ (prop, Qheight))
＠＠ -1102,33 +1109,68 ＠＠
maybe_error_if_job_active (f);
if (!NILP (val))
{
+#ifdef HAVE_BIGNUM
+ check_integer_range (val, Qzero, make_integer (INT_MAX));
+ FRAME_MSPRINTER_CHARHEIGHT (f) =
+ BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) :
+ XINT (val);
+#else
CHECK_NATNUM (val);
FRAME_MSPRINTER_CHARHEIGHT (f) = XINT (val);
+#endif
}
}
else if (EQ (prop, Qleft_margin))
{
maybe_error_if_job_active (f);
+#ifdef HAVE_BIGNUM
+ check_integer_range (val, Qzero, make_integer (INT_MAX));
+ FRAME_MSPRINTER_LEFT_MARGIN (f) =
+ BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) :
+ XINT (val);
+#else
CHECK_NATNUM (val);
FRAME_MSPRINTER_LEFT_MARGIN (f) = XINT (val);
+#endif
}
else if (EQ (prop, Qtop_margin))
{
maybe_error_if_job_active (f);
+#ifdef HAVE_BIGNUM
+ check_integer_range (val, Qzero, make_integer (INT_MAX));
+ FRAME_MSPRINTER_TOP_MARGIN (f) =
+ BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) :
+ XINT (val);
+#else
CHECK_NATNUM (val);
FRAME_MSPRINTER_TOP_MARGIN (f) = XINT (val);
+#endif
}
else if (EQ (prop, Qright_margin))
{
maybe_error_if_job_active (f);
+#ifdef HAVE_BIGNUM
+ check_integer_range (val, Qzero, make_integer (INT_MAX));
+ FRAME_MSPRINTER_RIGHT_MARGIN (f) =
+ BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) :
+ XINT (val);
+#else
CHECK_NATNUM (val);
FRAME_MSPRINTER_RIGHT_MARGIN (f) = XINT (val);
+#endif
}
else if (EQ (prop, Qbottom_margin))
{
maybe_error_if_job_active (f);
+#ifdef HAVE_BIGNUM
+ check_integer_range (val, Qzero, make_integer (INT_MAX));
+ FRAME_MSPRINTER_BOTTOM_MARGIN (f) =
+ BIGNUMP (val) ? bignum_to_int (XBIGNUM_DATA (val)) :
+ XINT (val);
+#else
CHECK_NATNUM (val);
FRAME_MSPRINTER_BOTTOM_MARGIN (f) = XINT (val);
+#endif
}
}
}
diff -r cde1608596d0 -r c096d8051f89 src/glyphs.c
--- a/src/glyphs.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/glyphs.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -2630,7 +2630,7 ＠＠
static void
check_valid_xbm_inline (Lisp_Object data)
{
- Lisp_Object width, height, bits;
+ Lisp_Object width, height, bits, args[2];
if (!CONSP (data) ||
!CONSP (XCDR (data)) ||
＠＠ -2650,7 +2650,16 ＠＠
if (!NATNUMP (height))
invalid_argument ("Height must be a natural number", height);
- if (((XINT (width) * XINT (height)) / 8) > string_char_length (bits))
+ args[0] = width;
+ args[1] = height;
+
+ args[0] = Ftimes (countof (args), args);
+ args[1] = make_integer (8);
+
+ args[0] = Fquo (countof (args), args);
+ args[1] = make_integer (string_char_length (bits));
+
+ if (!NILP (Fgtr (countof (args), args)))
invalid_argument ("data is too short for width and height",
vector3 (width, height, bits));
}
diff -r cde1608596d0 -r c096d8051f89 src/indent.c
--- a/src/indent.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/indent.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -412,7 +412,8 ＠＠
buffer = wrap_buffer (buf);
if (tab_width <= 0 || tab_width > 1000) tab_width = 8;
- CHECK_NATNUM (column);
+
+ check_integer_range (column, Qzero, make_integer (EMACS_INT_MAX));
goal = XINT (column);
retry:
diff -r cde1608596d0 -r c096d8051f89 src/intl-win32.c
--- a/src/intl-win32.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/intl-win32.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -1792,9 +1792,14 ＠＠
data->cp_type = MULTIBYTE_MAC;
else
{
- CHECK_NATNUM (value);
data->locale_type = MULTIBYTE_SPECIFIED_CODE_PAGE;
- data->cp = XINT (value);
+#ifdef HAVE_BIGNUM
+ check_integer_range (value, Qzero, make_integer (INT_MAX));
+ data->cp = BIGNUMP (value) ? bignum_to_int (XBIGNUM_DATA (value)) : XINT (value);
+#else
+ CHECK_NATNUM (value);
+ data->cp = XINT (value);
+#endif
}
}
else if (EQ (key, Qlocale))
diff -r cde1608596d0 -r c096d8051f89 src/lisp.h
--- a/src/lisp.h Wed Nov 17 14:37:26 2010 +0000
+++ b/src/lisp.h Sat Nov 20 16:49:11 2010 +0000
＠＠ -1679,6 +1679,10 ＠＠
#define INT_VALBITS (BITS_PER_EMACS_INT - INT_GCBITS)
#define VALBITS (BITS_PER_EMACS_INT - GCBITS)
+/* This is badly named; it's not the maximum value that an EMACS_INT can
+ have, it's the maximum value that a Lisp-visible fixnum can have (half
+ the maximum value an EMACS_INT can have) and as such would be better
+ called MOST_POSITIVE_FIXNUM. Similarly for MOST_NEGATIVE_FIXNUM. */
#define EMACS_INT_MAX ((EMACS_INT) ((1UL << (INT_VALBITS - 1)) -1UL))
#define EMACS_INT_MIN (-(EMACS_INT_MAX) - 1)
/* WARNING: evaluates its arg twice. */
＠＠ -2923,22 +2927,6 ＠＠
x = wrong_type_argument (Qfixnump, x); \
} while (0)
-/* NOTE NOTE NOTE! This definition of "natural number" is mathematically
- wrong. Mathematically, a natural number is a positive integer; 0
- isn't included. This would be better called NONNEGINT(). */
-
-#define NATNUMP(x) (INTP (x) && XINT (x) >= 0)
-
-#define CHECK_NATNUM(x) do { \
- if (!NATNUMP (x)) \
- dead_wrong_type_argument (Qnatnump, x); \
-} while (0)
-
-#define CONCHECK_NATNUM(x) do { \
- if (!NATNUMP (x)) \
- x = wrong_type_argument (Qnatnump, x); \
-} while (0)
-
END_C_DECLS
/* -------------- properties of internally-formatted text ------------- */
＠＠ -4318,6 +4306,8 ＠＠
void disksave_object_finalization (void);
void finish_object_memory_usage_stats (void);
extern int purify_flag;
+#define ARRAY_DIMENSION_LIMIT EMACS_INT_MAX
+extern Fixnum Varray_dimension_limit;
#ifndef NEW_GC
extern EMACS_INT gc_generation_number[1];
#endif /* not NEW_GC */
＠＠ -4505,7 +4495,7 ＠＠
MODULE_API Lisp_Object wrong_type_argument (Lisp_Object, Lisp_Object);
MODULE_API
DECLARE_DOESNT_RETURN (dead_wrong_type_argument (Lisp_Object, Lisp_Object));
-void check_int_range (EMACS_INT, EMACS_INT, EMACS_INT);
+void check_integer_range (Lisp_Object, Lisp_Object, Lisp_Object);
EXFUN (Fint_to_char, 1);
EXFUN (Fchar_to_int, 1);
＠＠ -4531,11 +4521,11 ＠＠
Qnonnegativep, Qnumber_char_or_marker_p, Qnumberp, Qquote, Qtrue_list_p;
extern MODULE_API Lisp_Object Qintegerp;
-extern Lisp_Object Qarith_error, Qbeginning_of_buffer, Qbuffer_read_only,
- Qcircular_list, Qcircular_property_list, Qconversion_error,
- Qcyclic_variable_indirection, Qdomain_error, Qediting_error,
- Qend_of_buffer, Qend_of_file, Qerror, Qfile_error, Qinternal_error,
- Qinvalid_change, Qinvalid_constant, Qinvalid_function,
+extern Lisp_Object Qargs_out_of_range, Qarith_error, Qbeginning_of_buffer,
+ Qbuffer_read_only, Qcircular_list, Qcircular_property_list,
+ Qconversion_error, Qcyclic_variable_indirection, Qdomain_error,
+ Qediting_error, Qend_of_buffer, Qend_of_file, Qerror, Qfile_error,
+ Qinternal_error, Qinvalid_change, Qinvalid_constant, Qinvalid_function,
Qinvalid_keyword_argument, Qinvalid_operation,
Qinvalid_read_syntax, Qinvalid_state, Qio_error, Qlist_formation_error,
Qmalformed_list, Qmalformed_property_list, Qno_catch, Qout_of_memory,
＠＠ -4544,6 +4534,7 ＠＠
Qstructure_formation_error, Qtext_conversion_error, Qunderflow_error,
Qvoid_function, Qvoid_variable, Qwrong_number_of_arguments,
Qwrong_type_argument;
+
extern Lisp_Object Qcdr;
extern Lisp_Object Qerror_lacks_explanatory_string;
extern Lisp_Object Qfile_error;
＠＠ -5010,6 +5001,7 ＠＠
MODULE_API void warn_when_safe (Lisp_Object, Lisp_Object, const Ascbyte *,
...) PRINTF_ARGS (3, 4);
extern int backtrace_with_internal_sections;
+extern Fixnum Vmultiple_values_limit;
extern Lisp_Object Qand_optional;
extern Lisp_Object Qand_rest;
diff -r cde1608596d0 -r c096d8051f89 src/lread.c
--- a/src/lread.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/lread.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -844,9 +844,9 ＠＠
return W_OK;
else if (EQ (mode, Qreadable))
return R_OK;
- else if (INTP (mode))
+ else if (INTEGERP (mode))
{
- check_int_range (XINT (mode), 0, 7);
+ check_integer_range (mode, Qzero, make_int (7));
return XINT (mode);
}
else
diff -r cde1608596d0 -r c096d8051f89 src/mule-ccl.c
--- a/src/mule-ccl.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/mule-ccl.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -2123,7 +2123,7 ＠＠
val = Fget (ccl_prog, Qccl_program_idx, Qnil);
if (! NATNUMP (val)
- || XINT (val) >= XVECTOR_LENGTH (Vccl_program_table))
+ || -1 != bytecode_arithcompare (val, Flength (Vccl_program_table)))
return Qnil;
slot = XVECTOR_DATA (Vccl_program_table)[XINT (val)];
if (! VECTORP (slot)
diff -r cde1608596d0 -r c096d8051f89 src/number.h
--- a/src/number.h Wed Nov 17 14:37:26 2010 +0000
+++ b/src/number.h Sat Nov 20 16:49:11 2010 +0000
＠＠ -153,6 +153,40 ＠＠
EXFUN (Fevenp, 1);
EXFUN (Foddp, 1);
+/* There are varying mathematical definitions of what a natural number is,
+ differing about whether 0 is inside or outside the set. The Oxford
+ English Dictionary, second edition, does say that they are whole numbers,
+ not fractional, but it doesn't give a bound, and gives a quotation
+ talking about the natural numbers from 1 to 100. Since 100 is certainly
+ *not* the upper bound on natural numbers, we can't take 1 as the lower
+ bound from that example. The Real Academia Española's dictionary, not of
+ English but certainly sharing the western academic tradition, says of
+ "número natural":
+
+ 1. m. Mat. Cada uno de los elementos de la sucesión 0, 1, 2, 3...
+
+ that is, "each of the elements of the succession 0, 1, 2, 3 ...". The
+ various Wikipedia articles in languages I can read agree. It's
+ reasonable to call this macro and the associated Lisp function
+ NATNUMP. */
+
+#ifdef HAVE_BIGNUM
+#define NATNUMP(x) ((INTP (x) && XINT (x) >= 0) || \
+ (BIGNUMP (x) && bignum_sign (XBIGNUM_DATA (x)) >= 0))
+#else
+#define NATNUMP(x) (INTP (x) && XINT (x) >= 0)
+#endif
+
+#define CHECK_NATNUM(x) do { \
+ if (!NATNUMP (x)) \
+ dead_wrong_type_argument (Qnatnump, x); \
+} while (0)
+
+#define CONCHECK_NATNUM(x) do { \
+ if (!NATNUMP (x)) \
+ x = wrong_type_argument (Qnatnump, x); \
+} while (0)
+
/********************************** Ratios **********************************/
#ifdef HAVE_RATIO
diff -r cde1608596d0 -r c096d8051f89 src/process-unix.c
--- a/src/process-unix.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/process-unix.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -2120,10 +2120,10 ＠＠
CHECK_STRING (dest);
- CHECK_NATNUM (port);
+ check_integer_range (port, Qzero, make_integer (USHRT_MAX));
theport = htons ((unsigned short) XINT (port));
- CHECK_NATNUM (ttl);
+ check_integer_range (ttl, Qzero, make_integer (UCHAR_MAX));
thettl = (unsigned char) XINT (ttl);
if ((udp = getprotobyname ("udp")) == NULL)
diff -r cde1608596d0 -r c096d8051f89 src/process.c
--- a/src/process.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/process.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -977,8 +977,8 ＠＠
(process, height, width))
{
CHECK_PROCESS (process);
- CHECK_NATNUM (height);
- CHECK_NATNUM (width);
+ check_integer_range (height, Qzero, make_integer (EMACS_INT_MAX));
+ check_integer_range (width, Qzero, make_integer (EMACS_INT_MAX));
return
MAYBE_INT_PROCMETH (set_window_size,
(XPROCESS (process), XINT (height), XINT (width))) <= 0
diff -r cde1608596d0 -r c096d8051f89 src/profile.c
--- a/src/profile.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/profile.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -365,8 +365,16 ＠＠
msecs = default_profiling_interval;
else
{
- CHECK_NATNUM (microsecs);
+#ifdef HAVE_BIGNUM
+ check_integer_range (microsecs, make_int (1000), make_integer (INT_MAX));
+ msecs =
+ BIGNUMP (microsecs) ? bignum_to_int (XBIGNUM_DATA (microsecs)) :
+ XINT (microsecs);
+#else
+ check_integer_range (microsecs, make_int (1000),
+ make_integer (EMACS_INT_MAX));
msecs = XINT (microsecs);
+#endif
}
if (msecs <= 0)
msecs = 1000;
diff -r cde1608596d0 -r c096d8051f89 src/unicode.c
--- a/src/unicode.c Wed Nov 17 14:37:26 2010 +0000
+++ b/src/unicode.c Sat Nov 20 16:49:11 2010 +0000
＠＠ -1371,7 +1371,8 ＠＠
int ichar, unicode;
CHECK_CHAR (character);
- CHECK_NATNUM (code);
+
+ check_integer_range (code, Qzero, make_integer (EMACS_INT_MAX));
unicode = XINT (code);
ichar = XCHAR (character);
＠＠ -1447,7 +1448,7 ＠＠
int lbs[NUM_LEADING_BYTES];
int c;
- CHECK_NATNUM (code);
+ check_integer_range (code, Qzero, make_integer (EMACS_INT_MAX));
c = XINT (code);
{
EXTERNAL_LIST_LOOP_2 (elt, charsets)
＠＠ -1473,7 +1474,7 ＠＠
return make_char (ret);
}
#else
- CHECK_NATNUM (code);
+ check_integer_range (code, Qzero, make_integer (EMACS_INT_MAX));
return Fint_to_char (code);
#endif /* MULE */
}
diff -r cde1608596d0 -r c096d8051f89 tests/ChangeLog
--- a/tests/ChangeLog Wed Nov 17 14:37:26 2010 +0000
+++ b/tests/ChangeLog Sat Nov 20 16:49:11 2010 +0000
＠＠ -1,3 +1,15 ＠＠
+2010-11-20 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * automated/lisp-tests.el:
+ * automated/lisp-tests.el (featurep):
+ * automated/lisp-tests.el (wrong-type-argument):
+ * automated/mule-tests.el (featurep):
+ Check for args-out-of-range errors instead of wrong-type-argument
+ errors in various places when code is handed a large bignum
+ instead of a fixnum.
+ Also check for the wrong-type-argument errors when giving the same
+ code a non-integer value.
+
2010-11-06 Aidan Kehoe <kehoea(a)parhasard.net>
* automated/lisp-tests.el (list-nreverse):
diff -r cde1608596d0 -r c096d8051f89 tests/automated/lisp-tests.el
--- a/tests/automated/lisp-tests.el Wed Nov 17 14:37:26 2010 +0000
+++ b/tests/automated/lisp-tests.el Sat Nov 20 16:49:11 2010 +0000
＠＠ -213,6 +213,16 ＠＠
(Assert (eq (butlast '()) nil))
(Assert (eq (nbutlast '()) nil))
+(when (featurep 'bignum)
+ (let* ((x (list* 0 1 2 3 4 5 6.0 ?7 ?8 (vector 'a 'b 'c)))
+ (y (butlast x (* 2 most-positive-fixnum)))
+ (z (nbutlast x (* 3 most-positive-fixnum))))
+ (Assert (eq nil y) "checking butlast with a large bignum gives nil")
+ (Assert (eq nil z) "checking nbutlast with a large bignum gives nil")
+ (Check-Error wrong-type-argument
+ (nbutlast x (1- most-negative-fixnum))
+ "checking nbutlast with a negative bignum errors")))
+
;;-----------------------------------------------------
;; Test `copy-list'
;;-----------------------------------------------------
＠＠ -2511,4 +2521,152 ＠＠
(mapcar fourth-bit
(loop for i from 0 to 6000 collect i)))))))
+(Check-Error wrong-type-argument (self-insert-command 'self-insert-command))
+(Check-Error wrong-type-argument (make-list 'make-list 'make-list))
+(Check-Error wrong-type-argument (make-vector 'make-vector 'make-vector))
+(Check-Error wrong-type-argument (make-bit-vector 'make-bit-vector
+ 'make-bit-vector))
+(Check-Error wrong-type-argument (make-byte-code '(&rest ignore) "\xc0\x87" [4]
+ 'ignore))
+(Check-Error wrong-type-argument (make-string ?a ?a))
+(Check-Error wrong-type-argument (nth-value 'nth-value (truncate pi e)))
+(Check-Error wrong-type-argument (make-hash-table :test #'eql :size :size))
+(Check-Error wrong-type-argument
+ (accept-process-output nil 'accept-process-output))
+(Check-Error wrong-type-argument
+ (accept-process-output nil 2000 'accept-process-output))
+(Check-Error wrong-type-argument
+ (self-insert-command 'self-insert-command))
+(Check-Error wrong-type-argument (string-to-number "16" 'string-to-number))
+(Check-Error wrong-type-argument (move-to-column 'move-to-column))
+(stop-profiling)
+(Check-Error wrong-type-argument (start-profiling (float most-positive-fixnum)))
+(stop-profiling)
+(Check-Error wrong-type-argument
+ (fill '(1 2 3 4 5) 1 :start (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+ (fill [1 2 3 4 5] 1 :start (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+ (fill "1 2 3 4 5" ?1 :start (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+ (fill #*10101010 1 :start (float most-positive-fixnum))
+(Check-Error wrong-type-argument
+ (fill '(1 2 3 4 5) 1 :end (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+ (fill [1 2 3 4 5] 1 :end (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+ (fill "1 2 3 4 5" ?1 :end (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+ (fill #*10101010 1 :end (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+ (reduce #'cons '(1 2 3 4 5) :start (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+ (reduce #'cons [1 2 3 4 5] :start (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+ (reduce #'cons "1 2 3 4 5" :start (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+ (reduce #'cons #*10101010 :start (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+ (reduce #'cons '(1 2 3 4 5) :end (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+ (reduce #'cons [1 2 3 4 5] :end (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+ (reduce #'cons "1 2 3 4 5" :end (float most-positive-fixnum)))
+(Check-Error wrong-type-argument
+ (reduce #'cons #*10101010 :end (float most-positive-fixnum)))
+
+(when (featurep 'bignum)
+ (Check-Error args-out-of-range
+ (self-insert-command (* 2 most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (make-list (* 3 most-positive-fixnum) 'make-list))
+ (Check-Error args-out-of-range
+ (make-vector (* 4 most-positive-fixnum) 'make-vector))
+ (Check-Error args-out-of-range
+ (make-bit-vector (+ 2 most-positive-fixnum) 'make-bit-vector))
+ (Check-Error args-out-of-range
+ (make-byte-code '(&rest ignore) "\xc0\x87" [4]
+ (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (make-byte-code '(&rest ignore) "\xc0\x87" [4]
+ #x10000))
+ (Check-Error args-out-of-range
+ (make-string (* 4 most-positive-fixnum) ?a))
+ (Check-Error args-out-of-range
+ (nth-value most-positive-fixnum (truncate pi e)))
+ (Check-Error args-out-of-range
+ (make-hash-table :test #'equalp :size (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (accept-process-output nil 4294967))
+ (Check-Error args-out-of-range
+ (accept-process-output nil 10 (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (self-insert-command (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (string-to-number "16" (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (recent-keys (1+ most-positive-fixnum)))
+ (when (featurep 'xbm)
+ (Check-Error-Message
+ invalid-argument
+ "^data is too short for width and height"
+ (set-face-background-pixmap
+ 'left-margin
+ `[xbm :data (20 ,(* 2 most-positive-fixnum) "random-text")])))
+ (Check-Error args-out-of-range
+ (move-to-column (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (move-to-column (1- most-negative-fixnum)))
+ (stop-profiling)
+ (when (< most-positive-fixnum (lsh 1 32))
+ ;; We only support machines with integers of 32 bits or more. If
+ ;; most-positive-fixnum is less than 2^32, we're on a 32-bit machine,
+ ;; and it's appropriate to test start-profiling with a bignum.
+ (Assert (eq nil (start-profiling (* most-positive-fixnum 2)))))
+ (stop-profiling)
+ (Check-Error args-out-of-range
+ (fill '(1 2 3 4 5) 1 :start (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (fill [1 2 3 4 5] 1 :start (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (fill "1 2 3 4 5" ?1 :start (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (fill #*10101010 1 :start (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (fill '(1 2 3 4 5) 1 :end (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (fill [1 2 3 4 5] 1 :end (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (fill "1 2 3 4 5" ?1 :end (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (fill #*10101010 1 :end (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (reduce #'cons '(1 2 3 4 5) :start (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (reduce #'cons [1 2 3 4 5] :start (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (reduce #'cons "1 2 3 4 5" :start (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (reduce #'cons #*10101010 :start (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (reduce #'cons '(1 2 3 4 5) :end (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (reduce #'cons [1 2 3 4 5] :end (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (reduce #'cons "1 2 3 4 5" :end (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (reduce #'cons #*10101010 :end (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (replace '(1 2 3 4 5) [5 4 3 2 1]
+:start1 (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (replace '(1 2 3 4 5) [5 4 3 2 1]
+:start2 (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (replace '(1 2 3 4 5) [5 4 3 2 1]
+:end1 (1+ most-positive-fixnum)))
+ (Check-Error args-out-of-range
+ (replace '(1 2 3 4 5) [5 4 3 2 1]
+:end2 (1+ most-positive-fixnum))))
+
;;; end of lisp-tests.el
diff -r cde1608596d0 -r c096d8051f89 tests/automated/mule-tests.el
--- a/tests/automated/mule-tests.el Wed Nov 17 14:37:26 2010 +0000
+++ b/tests/automated/mule-tests.el Sat Nov 20 16:49:11 2010 +0000
＠＠ -461,7 +461,7 ＠＠
(Assert (eq code (char-to-unicode scaron)))
(Assert (eq scaron (unicode-to-char code '(latin-iso8859-2)))))
finally (set-unicode-conversion scaron initial-unicode))
- (Check-Error wrong-type-argument (set-unicode-conversion scaron -10000)))
+ (Check-Error args-out-of-range (set-unicode-conversion scaron -10000)))
(dolist (utf-8-char
'("\xc6\x92" ;; U+0192 LATIN SMALL LETTER F WITH HOOK
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 1 comments
Fix the OpenBSD 64-bit build
14 years, 1 month
Stephen J. Turnbull
Stephen J. Turnbull
asjo(a)koldfront.dk (Adam Sjøgren) suggests one of the following
patches. See the thread starting at
http://list-archive.xemacs.org/pipermail/xemacs-beta/2010-November/020395...
2010-11-16 Adam Sjøgren <asjo(a)koldfront.dk>
* unexelf.c (ElfW): Use 64-bits on OpenBSD when _LP64 is true.
------------------------------------------------------------------------
On Thu, 11 Nov 2010 21:26:40 +0100, Adam wrote:
>> Notice that is "Elf32" instead of "Elf64". Somehow, we managed to get
>> the wrong word size in our definition of ElfW. Is sys/exec_elf.h
>> supposed to provide that definition? See lines 477 to 499 in
>> unexelf.c.
_LP64 is 1, so perhaps OpenBSD should be somehow included in lines
481-487, to take care of it?
Maybe something like this:
--- a/src/unexelf.c Tue Nov 02 20:19:39 2010 +0100
+++ b/src/unexelf.c Thu Nov 11 23:00:20 2010 +0100
＠＠ -478,7 +478,7 ＠＠
# include <sys/exec_elf.h>
#endif
-#if defined(__FreeBSD__) && (defined(__alpha__) || defined(_LP64))
+#if (defined(__FreeBSD__) && (defined(__alpha__) || defined(_LP64))) || (defined(__OpenBSD__) && defined(_LP64))
# ifdef __STDC__
# define ElfW(type) Elf64_##type
# else
(I am merely guessing; I have no clue, so don't hesitate to hit me with
a cluebat.)
------------------------------------------------------------------------
Didn't quite gather any comments. So maybe this is more like it:
--- a/src/unexelf.c Tue Nov 02 20:19:39 2010 +0100
+++ b/src/unexelf.c Tue Nov 16 21:40:23 2010 +0100
＠＠ -491,10 +491,18 ＠＠
#endif
#ifndef ElfW
-# ifdef __STDC__
-# define ElfW(type) Elf32_##type
+# ifdef _LP64
+# ifdef __STDC__
+# define ElfW(type) Elf64_##type
+# else
+# define ElfW(type) Elf64_/**/type
+# endif
# else
-# define ElfW(type) Elf32_/**/type
+# ifdef __STDC__
+# define ElfW(type) Elf32_##type
+# else
+# define ElfW(type) Elf32_/**/type
+# endif
# endif
#endif
------------------------------------------------------------------------
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 2 participants
- 1 comments
[COMMIT] Handle bignum N correctly, #'butlast, #'nbutlast.
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1290004646 0
# Node ID cde1608596d0b70c29939d8f4701299c3cf4aa1e
# Parent 09fed7053634cd8ab9c1a79add8533ac93d8023d
Handle bignum N correctly, #'butlast, #'nbutlast.
2010-11-17 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (bignum_butlast): New.
(Fnbutlast, Fbutlast): Use it.
In #'butlast and #'nbutlast, if N is a bignum, we should always
return nil. Bug revealed by Paul Dietz' test suite, thank you
Paul.
diff -r 09fed7053634 -r cde1608596d0 src/ChangeLog
--- a/src/ChangeLog Wed Nov 17 14:30:03 2010 +0000
+++ b/src/ChangeLog Wed Nov 17 14:37:26 2010 +0000
＠＠ -1,3 +1,11 ＠＠
+2010-11-17 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (bignum_butlast): New.
+ (Fnbutlast, Fbutlast): Use it.
+ In #'butlast and #'nbutlast, if N is a bignum, we should always
+ return nil. Bug revealed by Paul Dietz' test suite, thank you
+ Paul.
+
2010-11-15 Aidan Kehoe <kehoea(a)parhasard.net>
* .gdbinit.in: Remove lrecord_type_popup_data,
diff -r 09fed7053634 -r cde1608596d0 src/fns.c
--- a/src/fns.c Wed Nov 17 14:30:03 2010 +0000
+++ b/src/fns.c Wed Nov 17 14:37:26 2010 +0000
＠＠ -1576,6 +1576,9 ＠＠
return retval;
}
+static Lisp_Object bignum_butlast (Lisp_Object list, Lisp_Object number,
+ Boolint copy);
+
DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /*
Modify LIST to remove the last N (default 1) elements.
＠＠ -1590,6 +1593,11 ＠＠
if (!NILP (n))
{
+ if (BIGNUMP (n))
+ {
+ return bignum_butlast (list, n, 0);
+ }
+
CHECK_NATNUM (n);
int_n = XINT (n);
}
＠＠ -1638,6 +1646,11 ＠＠
if (!NILP (n))
{
+ if (BIGNUMP (n))
+ {
+ return bignum_butlast (list, n, 1);
+ }
+
CHECK_NATNUM (n);
int_n = XINT (n);
}
＠＠ -1673,6 +1686,42 ＠＠
return retval;
}
+/* This is sufficient to implement #'butlast and #'nbutlast with bignum N
+ under XEmacs, because #'list-length and #'safe-length can never return a
+ bignum. This means that #'nbutlast never has to modify and #'butlast
+ never has to copy. */
+static Lisp_Object
+bignum_butlast (Lisp_Object list, Lisp_Object number, Boolint copy)
+{
+ Boolint malformed = EQ (Fsafe_length (list), Qzero);
+ Boolint circular = !malformed && EQ (Flist_length (list), Qnil);
+
+ assert (BIGNUMP (number));
+
+#ifdef HAVE_BIGNUM
+
+ if (bignum_sign (XBIGNUM_DATA (number)) < 0)
+ {
+ dead_wrong_type_argument (Qnatnump, number);
+ }
+
+ number = Fcanonicalize_number (number);
+
+ if (INTP (number))
+ {
+ return copy ? Fbutlast (list, number) : Fnbutlast (list, number);
+ }
+
+#endif
+
+ if (circular)
+ {
+ signal_circular_list_error (list);
+ }
+
+ return Qnil;
+}
+
DEFUN ("member", Fmember, 2, 2, 0, /*
Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
The value is actually the tail of LIST whose car is ELT.
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Handle slightly more complex type specifications, #'coerce, #'typep.
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
This is necessary (but not sufficient) for various of Paul Dietz’ tests to
work.
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1290004203 0
# Node ID 09fed7053634cd8ab9c1a79add8533ac93d8023d
# Parent 6784adb405ad56d87bd69e31c3e5a15c1977d813
Handle slightly more complex type specifications, #'coerce, #'typep.
2010-11-17 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el (coerce):
In the argument list, name the first argument OBJECT, not X; the
former name was always used in the doc string and is clearer.
Handle vector type specifications which include the length of the
target sequence, error if there's a mismatch.
* cl-macs.el (cl-make-type-test): Handle type specifications
starting with the symbol 'eql.
diff -r 6784adb405ad -r 09fed7053634 lisp/ChangeLog
--- a/lisp/ChangeLog Mon Nov 15 19:31:06 2010 +0000
+++ b/lisp/ChangeLog Wed Nov 17 14:30:03 2010 +0000
＠＠ -1,3 +1,13 ＠＠
+2010-11-17 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-extra.el (coerce):
+ In the argument list, name the first argument OBJECT, not X; the
+ former name was always used in the doc string and is clearer.
+ Handle vector type specifications which include the length of the
+ target sequence, error if there's a mismatch.
+ * cl-macs.el (cl-make-type-test): Handle type specifications
+ starting with the symbol 'eql.
+
2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
diff -r 6784adb405ad -r 09fed7053634 lisp/cl-extra.el
--- a/lisp/cl-extra.el Mon Nov 15 19:31:06 2010 +0000
+++ b/lisp/cl-extra.el Wed Nov 17 14:30:03 2010 +0000
＠＠ -53,47 +53,67 ＠＠
;;; Type coercion.
-(defun coerce (x type)
+(defun coerce (object type)
"Coerce OBJECT to type TYPE.
TYPE is a Common Lisp type specifier."
- (cond ((eq type 'list) (if (listp x) x (append x nil)))
- ((eq type 'vector) (if (vectorp x) x (vconcat x)))
- ((eq type 'string) (if (stringp x) x (concat x)))
- ((eq type 'array) (if (arrayp x) x (vconcat x)))
- ((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0))
- ((and (eq type 'character) (symbolp x)) (coerce (symbol-name x) type))
+ (cond ((eq type 'list) (if (listp object) object (append object nil)))
+ ((eq type 'vector) (if (vectorp object) object (vconcat object)))
+ ((eq type 'string) (if (stringp object) object (concat object)))
+ ((eq type 'array) (if (arrayp object) object (vconcat object)))
+ ((and (eq type 'character) (stringp object)
+ (eql (length object) 1)) (aref object 0))
+ ((and (eq type 'character) (symbolp object))
+ (coerce (symbol-name object) type))
;; XEmacs addition character <-> integer coercions
- ((and (eq type 'character) (char-int-p x)) (int-char x))
- ((and (memq type '(integer fixnum)) (characterp x)) (char-int x))
- ((eq type 'float) (float x))
+ ((and (eq type 'character) (char-int-p object)) (int-char object))
+ ((and (memq type '(integer fixnum)) (characterp object))
+ (char-int object))
+ ((eq type 'float) (float object))
;; XEmacs addition: enhanced numeric type coercions
((and-fboundp 'coerce-number
(memq type '(integer ratio bigfloat fixnum))
- (coerce-number x type)))
+ (coerce-number object type)))
;; XEmacs addition: bit-vector coercion
((or (eq type 'bit-vector)
(eq type 'simple-bit-vector))
- (if (bit-vector-p x) x (apply 'bit-vector (append x nil))))
+ (if (bit-vector-p object)
+ object
+ (apply 'bit-vector (append object nil))))
;; XEmacs addition: weak-list coercion
((eq type 'weak-list)
- (if (weak-list-p x) x
+ (if (weak-list-p object) object
(let ((wl (make-weak-list)))
- (set-weak-list-list wl (if (listp x) x (append x nil)))
+ (set-weak-list-list wl (if (listp object)
+ object
+ (append object nil)))
wl)))
((and
- (consp type)
- (or (eq (car type) 'vector)
- (eq (car type) 'simple-array)
- (eq (car type) 'simple-vector))
- (cond
- ((equal (cdr-safe type) '(*))
- (coerce x 'vector))
- ((equal (cdr-safe type) '(bit))
- (coerce x 'bit-vector))
- ((equal (cdr-safe type) '(character))
- (coerce x 'string)))))
- ((typep x type) x)
- (t (error "Can't coerce %s to type %s" x type))))
+ (memq (car-safe type) '(vector simple-array))
+ (loop
+ for (ignore elements length) = type
+ initially (declare (special ignore))
+ return (if (or (memq length '(* nil)) (eql length (length object)))
+ (cond
+ ((memq elements '(t * nil))
+ (coerce object 'vector))
+ ((memq elements '(string-char character))
+ (coerce object 'string))
+ ((eq elements 'bit)
+ (coerce object 'bit-vector)))
+ (error
+ 'wrong-type-argument
+ "Type specifier length must equal sequence length"
+ type)))))
+ ((eq (car-safe type) 'simple-vector)
+ (coerce object (list* 'vector t (cdr type))))
+ ((memq (car-safe type)
+ '(string simple-string base-string simple-base-string))
+ (coerce object (list* 'vector 'character (cdr type))))
+ ((eq (car-safe type) 'bit-vector)
+ (coerce object (list* 'vector 'bit (cdr type))))
+ ((typep object type) object)
+ (t (error 'invalid-operation
+ "Can't coerce object to type" object type))))
;; XEmacs; #'equalp is in C.
diff -r 6784adb405ad -r 09fed7053634 lisp/cl-macs.el
--- a/lisp/cl-macs.el Mon Nov 15 19:31:06 2010 +0000
+++ b/lisp/cl-macs.el Wed Nov 17 14:30:03 2010 +0000
＠＠ -3116,6 +3116,8 ＠＠
(cdr type))))
((memq (car-safe type) '(member member*))
(list 'and (list 'member* val (list 'quote (cdr type))) t))
+ ((eq (car-safe type) 'eql)
+ (list 'eql (cadr type) val))
((eq (car-safe type) 'satisfies) (list (cadr type) val))
(t (error "Bad type spec: %s" type)))))
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Handle bignum N correctly, #'butlast, #'nbutlast.
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
changeset: 5306:cde1608596d0
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Wed Nov 17 14:37:26 2010 +0000
files: src/ChangeLog src/fns.c
description:
Handle bignum N correctly, #'butlast, #'nbutlast.
2010-11-17 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (bignum_butlast): New.
(Fnbutlast, Fbutlast): Use it.
In #'butlast and #'nbutlast, if N is a bignum, we should always
return nil. Bug revealed by Paul Dietz' test suite, thank you
Paul.
diff -r 09fed7053634 -r cde1608596d0 src/ChangeLog
--- a/src/ChangeLog Wed Nov 17 14:30:03 2010 +0000
+++ b/src/ChangeLog Wed Nov 17 14:37:26 2010 +0000
＠＠ -1,3 +1,11 ＠＠
+2010-11-17 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * fns.c (bignum_butlast): New.
+ (Fnbutlast, Fbutlast): Use it.
+ In #'butlast and #'nbutlast, if N is a bignum, we should always
+ return nil. Bug revealed by Paul Dietz' test suite, thank you
+ Paul.
+
2010-11-15 Aidan Kehoe <kehoea(a)parhasard.net>
* .gdbinit.in: Remove lrecord_type_popup_data,
diff -r 09fed7053634 -r cde1608596d0 src/fns.c
--- a/src/fns.c Wed Nov 17 14:30:03 2010 +0000
+++ b/src/fns.c Wed Nov 17 14:37:26 2010 +0000
＠＠ -1576,6 +1576,9 ＠＠
return retval;
}
+static Lisp_Object bignum_butlast (Lisp_Object list, Lisp_Object number,
+ Boolint copy);
+
DEFUN ("nbutlast", Fnbutlast, 1, 2, 0, /*
Modify LIST to remove the last N (default 1) elements.
＠＠ -1590,6 +1593,11 ＠＠
if (!NILP (n))
{
+ if (BIGNUMP (n))
+ {
+ return bignum_butlast (list, n, 0);
+ }
+
CHECK_NATNUM (n);
int_n = XINT (n);
}
＠＠ -1638,6 +1646,11 ＠＠
if (!NILP (n))
{
+ if (BIGNUMP (n))
+ {
+ return bignum_butlast (list, n, 1);
+ }
+
CHECK_NATNUM (n);
int_n = XINT (n);
}
＠＠ -1671,6 +1684,42 ＠＠
}
return retval;
+}
+
+/* This is sufficient to implement #'butlast and #'nbutlast with bignum N
+ under XEmacs, because #'list-length and #'safe-length can never return a
+ bignum. This means that #'nbutlast never has to modify and #'butlast
+ never has to copy. */
+static Lisp_Object
+bignum_butlast (Lisp_Object list, Lisp_Object number, Boolint copy)
+{
+ Boolint malformed = EQ (Fsafe_length (list), Qzero);
+ Boolint circular = !malformed && EQ (Flist_length (list), Qnil);
+
+ assert (BIGNUMP (number));
+
+#ifdef HAVE_BIGNUM
+
+ if (bignum_sign (XBIGNUM_DATA (number)) < 0)
+ {
+ dead_wrong_type_argument (Qnatnump, number);
+ }
+
+ number = Fcanonicalize_number (number);
+
+ if (INTP (number))
+ {
+ return copy ? Fbutlast (list, number) : Fnbutlast (list, number);
+ }
+
+#endif
+
+ if (circular)
+ {
+ signal_circular_list_error (list);
+ }
+
+ return Qnil;
}
DEFUN ("member", Fmember, 2, 2, 0, /*
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Handle slightly more complex type specifications, #'coerce, #'typep.
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
changeset: 5305:09fed7053634
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Wed Nov 17 14:30:03 2010 +0000
files: lisp/ChangeLog lisp/cl-extra.el lisp/cl-macs.el
description:
Handle slightly more complex type specifications, #'coerce, #'typep.
2010-11-17 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-extra.el (coerce):
In the argument list, name the first argument OBJECT, not X; the
former name was always used in the doc string and is clearer.
Handle vector type specifications which include the length of the
target sequence, error if there's a mismatch.
* cl-macs.el (cl-make-type-test): Handle type specifications
starting with the symbol 'eql.
diff -r 6784adb405ad -r 09fed7053634 lisp/ChangeLog
--- a/lisp/ChangeLog Mon Nov 15 19:31:06 2010 +0000
+++ b/lisp/ChangeLog Wed Nov 17 14:30:03 2010 +0000
＠＠ -1,3 +1,13 ＠＠
+2010-11-17 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * cl-extra.el (coerce):
+ In the argument list, name the first argument OBJECT, not X; the
+ former name was always used in the doc string and is clearer.
+ Handle vector type specifications which include the length of the
+ target sequence, error if there's a mismatch.
+ * cl-macs.el (cl-make-type-test): Handle type specifications
+ starting with the symbol 'eql.
+
2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
* cl-macs.el (eql): Don't remove the byte-compile property of this
diff -r 6784adb405ad -r 09fed7053634 lisp/cl-extra.el
--- a/lisp/cl-extra.el Mon Nov 15 19:31:06 2010 +0000
+++ b/lisp/cl-extra.el Wed Nov 17 14:30:03 2010 +0000
＠＠ -53,47 +53,67 ＠＠
;;; Type coercion.
-(defun coerce (x type)
+(defun coerce (object type)
"Coerce OBJECT to type TYPE.
TYPE is a Common Lisp type specifier."
- (cond ((eq type 'list) (if (listp x) x (append x nil)))
- ((eq type 'vector) (if (vectorp x) x (vconcat x)))
- ((eq type 'string) (if (stringp x) x (concat x)))
- ((eq type 'array) (if (arrayp x) x (vconcat x)))
- ((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0))
- ((and (eq type 'character) (symbolp x)) (coerce (symbol-name x) type))
+ (cond ((eq type 'list) (if (listp object) object (append object nil)))
+ ((eq type 'vector) (if (vectorp object) object (vconcat object)))
+ ((eq type 'string) (if (stringp object) object (concat object)))
+ ((eq type 'array) (if (arrayp object) object (vconcat object)))
+ ((and (eq type 'character) (stringp object)
+ (eql (length object) 1)) (aref object 0))
+ ((and (eq type 'character) (symbolp object))
+ (coerce (symbol-name object) type))
;; XEmacs addition character <-> integer coercions
- ((and (eq type 'character) (char-int-p x)) (int-char x))
- ((and (memq type '(integer fixnum)) (characterp x)) (char-int x))
- ((eq type 'float) (float x))
+ ((and (eq type 'character) (char-int-p object)) (int-char object))
+ ((and (memq type '(integer fixnum)) (characterp object))
+ (char-int object))
+ ((eq type 'float) (float object))
;; XEmacs addition: enhanced numeric type coercions
((and-fboundp 'coerce-number
(memq type '(integer ratio bigfloat fixnum))
- (coerce-number x type)))
+ (coerce-number object type)))
;; XEmacs addition: bit-vector coercion
((or (eq type 'bit-vector)
(eq type 'simple-bit-vector))
- (if (bit-vector-p x) x (apply 'bit-vector (append x nil))))
+ (if (bit-vector-p object)
+ object
+ (apply 'bit-vector (append object nil))))
;; XEmacs addition: weak-list coercion
((eq type 'weak-list)
- (if (weak-list-p x) x
+ (if (weak-list-p object) object
(let ((wl (make-weak-list)))
- (set-weak-list-list wl (if (listp x) x (append x nil)))
+ (set-weak-list-list wl (if (listp object)
+ object
+ (append object nil)))
wl)))
((and
- (consp type)
- (or (eq (car type) 'vector)
- (eq (car type) 'simple-array)
- (eq (car type) 'simple-vector))
- (cond
- ((equal (cdr-safe type) '(*))
- (coerce x 'vector))
- ((equal (cdr-safe type) '(bit))
- (coerce x 'bit-vector))
- ((equal (cdr-safe type) '(character))
- (coerce x 'string)))))
- ((typep x type) x)
- (t (error "Can't coerce %s to type %s" x type))))
+ (memq (car-safe type) '(vector simple-array))
+ (loop
+ for (ignore elements length) = type
+ initially (declare (special ignore))
+ return (if (or (memq length '(* nil)) (eql length (length object)))
+ (cond
+ ((memq elements '(t * nil))
+ (coerce object 'vector))
+ ((memq elements '(string-char character))
+ (coerce object 'string))
+ ((eq elements 'bit)
+ (coerce object 'bit-vector)))
+ (error
+ 'wrong-type-argument
+ "Type specifier length must equal sequence length"
+ type)))))
+ ((eq (car-safe type) 'simple-vector)
+ (coerce object (list* 'vector t (cdr type))))
+ ((memq (car-safe type)
+ '(string simple-string base-string simple-base-string))
+ (coerce object (list* 'vector 'character (cdr type))))
+ ((eq (car-safe type) 'bit-vector)
+ (coerce object (list* 'vector 'bit (cdr type))))
+ ((typep object type) object)
+ (t (error 'invalid-operation
+ "Can't coerce object to type" object type))))
;; XEmacs; #'equalp is in C.
diff -r 6784adb405ad -r 09fed7053634 lisp/cl-macs.el
--- a/lisp/cl-macs.el Mon Nov 15 19:31:06 2010 +0000
+++ b/lisp/cl-macs.el Wed Nov 17 14:30:03 2010 +0000
＠＠ -3116,6 +3116,8 ＠＠
(cdr type))))
((memq (car-safe type) '(member member*))
(list 'and (list 'member* val (list 'quote (cdr type))) t))
+ ((eq (car-safe type) 'eql)
+ (list 'eql (cadr type) val))
((eq (car-safe type) 'satisfies) (list (cadr type) val))
(t (error "Bad type spec: %s" type)))))
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
[COMMIT] Remove lrecord_type_popup_data, lrecord_type_window_configuration, .gdbinit.in
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
APPROVE COMMIT
NOTE: This patch has been committed.
# HG changeset patch
# User Aidan Kehoe <kehoea(a)parhasard.net>
# Date 1289849466 0
# Node ID 6784adb405ad56d87bd69e31c3e5a15c1977d813
# Parent 4c4085177ca574759fe9206b6d3919be5f4409b4
Remove lrecord_type_popup_data, lrecord_type_window_configuration, .gdbinit.in
2010-11-15 Aidan Kehoe <kehoea(a)parhasard.net>
* .gdbinit.in: Remove lrecord_type_popup_data,
lrecord_type_window_configuration from this file, they're not
used, and their presence breaks pobj in GDB at runtime for me.
diff -r 4c4085177ca5 -r 6784adb405ad src/.gdbinit.in.in
--- a/src/.gdbinit.in.in Sun Nov 14 14:54:09 2010 +0000
+++ b/src/.gdbinit.in.in Mon Nov 15 19:31:06 2010 +0000
＠＠ -411,9 +411,6 ＠＠
if $lrecord_type == lrecord_type_opaque_ptr
pptype Lisp_Opaque_Ptr
else
- if $lrecord_type == lrecord_type_popup_data
- pptype popup_data
- else
if $lrecord_type == lrecord_type_process
pptype Lisp_Process
else
＠＠ -456,9 +453,6 ＠＠
if $lrecord_type == lrecord_type_window
pstructtype window
else
- if $lrecord_type == lrecord_type_window_configuration
- pstructtype window_config
- else
if $lrecord_type == lrecord_type_fc_pattern
pstructtype fc_pattern
else
＠＠ -485,8 +479,6 ＠＠
end
end
end
- end
- end
## Repeat after me... gdb sux, gdb sux, gdb sux...
end
end
diff -r 4c4085177ca5 -r 6784adb405ad src/ChangeLog
--- a/src/ChangeLog Sun Nov 14 14:54:09 2010 +0000
+++ b/src/ChangeLog Mon Nov 15 19:31:06 2010 +0000
＠＠ -1,3 +1,9 ＠＠
+2010-11-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * .gdbinit.in: Remove lrecord_type_popup_data,
+ lrecord_type_window_configuration from this file, they're not
+ used, and their presence breaks pobj in GDB at runtime for me.
+
2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Fnreverse):
--
“Apart from the nine-banded armadillo, man is the only natural host of
Mycobacterium leprae, although it can be grown in the footpads of mice.”
-- Kumar & Clark, Clinical Medicine, summarising improbable leprosy research
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments
commit: Remove lrecord_type_popup_data, lrecord_type_window_configuration, .gdbinit.in
14 years, 1 month
Aidan Kehoe
Aidan Kehoe
changeset: 5304:6784adb405ad
tag: tip
user: Aidan Kehoe <kehoea(a)parhasard.net>
date: Mon Nov 15 19:31:06 2010 +0000
files: src/.gdbinit.in.in src/ChangeLog
description:
Remove lrecord_type_popup_data, lrecord_type_window_configuration, .gdbinit.in
2010-11-15 Aidan Kehoe <kehoea(a)parhasard.net>
* .gdbinit.in: Remove lrecord_type_popup_data,
lrecord_type_window_configuration from this file, they're not
used, and their presence breaks pobj in GDB at runtime for me.
diff -r 4c4085177ca5 -r 6784adb405ad src/.gdbinit.in.in
--- a/src/.gdbinit.in.in Sun Nov 14 14:54:09 2010 +0000
+++ b/src/.gdbinit.in.in Mon Nov 15 19:31:06 2010 +0000
＠＠ -411,9 +411,6 ＠＠
if $lrecord_type == lrecord_type_opaque_ptr
pptype Lisp_Opaque_Ptr
else
- if $lrecord_type == lrecord_type_popup_data
- pptype popup_data
- else
if $lrecord_type == lrecord_type_process
pptype Lisp_Process
else
＠＠ -456,9 +453,6 ＠＠
if $lrecord_type == lrecord_type_window
pstructtype window
else
- if $lrecord_type == lrecord_type_window_configuration
- pstructtype window_config
- else
if $lrecord_type == lrecord_type_fc_pattern
pstructtype fc_pattern
else
＠＠ -470,8 +464,6 ＠＠
## Barf, gag, retch
end
end
- end
- end
end
end
end
diff -r 4c4085177ca5 -r 6784adb405ad src/ChangeLog
--- a/src/ChangeLog Sun Nov 14 14:54:09 2010 +0000
+++ b/src/ChangeLog Mon Nov 15 19:31:06 2010 +0000
＠＠ -1,3 +1,9 ＠＠
+2010-11-15 Aidan Kehoe <kehoea(a)parhasard.net>
+
+ * .gdbinit.in: Remove lrecord_type_popup_data,
+ lrecord_type_window_configuration from this file, they're not
+ used, and their presence breaks pobj in GDB at runtime for me.
+
2010-11-14 Aidan Kehoe <kehoea(a)parhasard.net>
* fns.c (Fnreverse):
_______________________________________________
XEmacs-Patches mailing list
XEmacs-Patches(a)xemacs.org
http://lists.xemacs.org/mailman/listinfo/xemacs-patches
- 1 participants
- 0 comments