Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 5307:c096d8051f89

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Have NATNUMP give t for positive bignums; check limits appropriately. src/ChangeLog addition: 2010-11-20 Aidan Kehoe <kehoea@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@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.
author Aidan Kehoe <kehoea@parhasard.net>
date Sat, 20 Nov 2010 16:49:11 +0000
parents 7d06a8bf47d2
children 22c4e67a2e69 8d29f1c4bb98
comparison
equal deleted inserted replaced
5306:cde1608596d0 5307:c096d8051f89
93 93
94 #ifdef DEBUG_XEMACS 94 #ifdef DEBUG_XEMACS
95 static Fixnum debug_allocation; 95 static Fixnum debug_allocation;
96 static Fixnum debug_allocation_backtrace_length; 96 static Fixnum debug_allocation_backtrace_length;
97 #endif 97 #endif
98
99 Fixnum Varray_dimension_limit, Varray_total_size_limit, Varray_rank_limit;
98 100
99 int need_to_check_c_alloca; 101 int need_to_check_c_alloca;
100 int need_to_signal_post_gc; 102 int need_to_signal_post_gc;
101 int funcall_allocation_flag; 103 int funcall_allocation_flag;
102 Bytecount __temp_alloca_size__; 104 Bytecount __temp_alloca_size__;
1498 DEFUN ("make-list", Fmake_list, 2, 2, 0, /* 1500 DEFUN ("make-list", Fmake_list, 2, 2, 0, /*
1499 Return a new list of length LENGTH, with each element being OBJECT. 1501 Return a new list of length LENGTH, with each element being OBJECT.
1500 */ 1502 */
1501 (length, object)) 1503 (length, object))
1502 { 1504 {
1503 CHECK_NATNUM (length); 1505 Lisp_Object val = Qnil;
1504 1506 Elemcount size;
1505 { 1507
1506 Lisp_Object val = Qnil; 1508 check_integer_range (length, Qzero, make_integer (EMACS_INT_MAX));
1507 EMACS_INT size = XINT (length); 1509
1508 1510 size = XINT (length);
1509 while (size--) 1511
1510 val = Fcons (object, val); 1512 while (size--)
1511 return val; 1513 val = Fcons (object, val);
1512 } 1514
1515 return val;
1513 } 1516 }
1514 1517
1515 1518
1516 /************************************************************************/ 1519 /************************************************************************/
1517 /* Float allocation */ 1520 /* Float allocation */
1741 Return a new vector of length LENGTH, with each element being OBJECT. 1744 Return a new vector of length LENGTH, with each element being OBJECT.
1742 See also the function `vector'. 1745 See also the function `vector'.
1743 */ 1746 */
1744 (length, object)) 1747 (length, object))
1745 { 1748 {
1746 CONCHECK_NATNUM (length); 1749 check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT));
1747 return make_vector (XINT (length), object); 1750 return make_vector (XINT (length), object);
1748 } 1751 }
1749 1752
1750 DEFUN ("vector", Fvector, 0, MANY, 0, /* 1753 DEFUN ("vector", Fvector, 0, MANY, 0, /*
1751 Return a newly created vector with specified ARGS as elements. 1754 Return a newly created vector with specified ARGS as elements.
1923 Return a new bit vector of length LENGTH. with each bit set to BIT. 1926 Return a new bit vector of length LENGTH. with each bit set to BIT.
1924 BIT must be one of the integers 0 or 1. See also the function `bit-vector'. 1927 BIT must be one of the integers 0 or 1. See also the function `bit-vector'.
1925 */ 1928 */
1926 (length, bit)) 1929 (length, bit))
1927 { 1930 {
1928 CONCHECK_NATNUM (length); 1931 check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT));
1929
1930 return make_bit_vector (XINT (length), bit); 1932 return make_bit_vector (XINT (length), bit);
1931 } 1933 }
1932 1934
1933 DEFUN ("bit-vector", Fbit_vector, 0, MANY, 0, /* 1935 DEFUN ("bit-vector", Fbit_vector, 0, MANY, 0, /*
1934 Return a newly created bit vector with specified ARGS as elements. 1936 Return a newly created bit vector with specified ARGS as elements.
2050 2052
2051 if (!NILP (constants)) 2053 if (!NILP (constants))
2052 CHECK_VECTOR (constants); 2054 CHECK_VECTOR (constants);
2053 f->constants = constants; 2055 f->constants = constants;
2054 2056
2055 CHECK_NATNUM (stack_depth); 2057 check_integer_range (stack_depth, Qzero, make_int (USHRT_MAX));
2056 f->stack_depth = (unsigned short) XINT (stack_depth); 2058 f->stack_depth = (unsigned short) XINT (stack_depth);
2057 2059
2058 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK 2060 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2059 f->annotated = Vload_file_name_internal; 2061 f->annotated = Vload_file_name_internal;
2060 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */ 2062 #endif /* COMPILED_FUNCTION_ANNOTATION_HACK */
2882 Return a new string consisting of LENGTH copies of CHARACTER. 2884 Return a new string consisting of LENGTH copies of CHARACTER.
2883 LENGTH must be a non-negative integer. 2885 LENGTH must be a non-negative integer.
2884 */ 2886 */
2885 (length, character)) 2887 (length, character))
2886 { 2888 {
2887 CHECK_NATNUM (length); 2889 check_integer_range (length, Qzero, make_int (ARRAY_DIMENSION_LIMIT));
2888 CHECK_CHAR_COERCE_INT (character); 2890 CHECK_CHAR_COERCE_INT (character);
2889 { 2891 {
2890 Ibyte init_str[MAX_ICHAR_LEN]; 2892 Ibyte init_str[MAX_ICHAR_LEN];
2891 int len = set_itext_ichar (init_str, XCHAR (character)); 2893 int len = set_itext_ichar (init_str, XCHAR (character));
2892 Lisp_Object val = make_uninit_string (len * XINT (length)); 2894 Lisp_Object val = make_uninit_string (len * XINT (length));
5737 } 5739 }
5738 5740
5739 void 5741 void
5740 vars_of_alloc (void) 5742 vars_of_alloc (void)
5741 { 5743 {
5744 DEFVAR_CONST_INT ("array-rank-limit", &Varray_rank_limit /*
5745 The exclusive upper bound on the number of dimensions an array may have.
5746
5747 XEmacs does not support multidimensional arrays, meaning this constant is,
5748 for the moment, 2.
5749 */);
5750 Varray_rank_limit = 2;
5751
5752 DEFVAR_CONST_INT ("array-dimension-limit", &Varray_dimension_limit /*
5753 The exclusive upper bound of an array's dimension.
5754 Note that XEmacs may not have enough memory available to create an array
5755 with this dimension.
5756 */);
5757 Varray_dimension_limit = ARRAY_DIMENSION_LIMIT;
5758
5759 DEFVAR_CONST_INT ("array-total-size-limit", &Varray_total_size_limit /*
5760 The exclusive upper bound on the number of elements an array may contain.
5761
5762 In Common Lisp, this is distinct from `array-dimension-limit', because
5763 arrays can have more than one dimension. In XEmacs this is not the case,
5764 and multi-dimensional arrays need to be implemented by the user with arrays
5765 of arrays.
5766
5767 Note that XEmacs may not have enough memory available to create an array
5768 with this dimension.
5769 */);
5770 Varray_total_size_limit = ARRAY_DIMENSION_LIMIT;
5771
5742 #ifdef DEBUG_XEMACS 5772 #ifdef DEBUG_XEMACS
5743 DEFVAR_INT ("debug-allocation", &debug_allocation /* 5773 DEFVAR_INT ("debug-allocation", &debug_allocation /*
5744 If non-zero, print out information to stderr about all objects allocated. 5774 If non-zero, print out information to stderr about all objects allocated.
5745 See also `debug-allocation-backtrace-length'. 5775 See also `debug-allocation-backtrace-length'.
5746 */ ); 5776 */ );