Mercurial > hg > xemacs-beta

comparison src/alloc.c @ 5438:8d29f1c4bb98

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