Mercurial > emacs
diff src/alloc.c @ 89483:2f877ed80fa6
*** empty log message ***
author | Kenichi Handa <handa@m17n.org> |
---|---|
date | Mon, 08 Sep 2003 12:53:41 +0000 |
parents | 375f2633d815 ac49af641799 |
children | c9f7a2f363ca |
line wrap: on
line diff
--- a/src/alloc.c Mon Sep 08 11:56:09 2003 +0000 +++ b/src/alloc.c Mon Sep 08 12:53:41 2003 +0000 @@ -52,7 +52,7 @@ #include "keyboard.h" #include "frame.h" #include "blockinput.h" -#include "charset.h" +#include "character.h" #include "syssignal.h" #include <setjmp.h> @@ -766,6 +766,23 @@ mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); #endif + /* If the memory just allocated cannot be addressed thru a Lisp + object's pointer, and it needs to be, that's equivalent to + running out of memory. */ + if (type != MEM_TYPE_NON_LISP) + { + Lisp_Object tem; + char *end = (char *) base + ABLOCKS_BYTES - 1; + XSETCONS (tem, end); + if ((char *) XCONS (tem) != end) + { + lisp_malloc_loser = base; + free (base); + UNBLOCK_INPUT; + memory_full (); + } + } + /* Initialize the blocks and put them on the free list. Is `base' was not properly aligned, we can't use the last block. */ for (i = 0; i < (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1); i++) @@ -788,21 +805,6 @@ val = free_ablock; free_ablock = free_ablock->x.next_free; - /* If the memory just allocated cannot be addressed thru a Lisp - object's pointer, and it needs to be, - that's equivalent to running out of memory. */ - if (val && type != MEM_TYPE_NON_LISP) - { - Lisp_Object tem; - XSETCONS (tem, (char *) val + nbytes - 1); - if ((char *) XCONS (tem) != (char *) val + nbytes - 1) - { - lisp_malloc_loser = val; - free (val); - val = 0; - } - } - #if GC_MARK_STACK && !defined GC_MALLOC_CHECK if (val && type != MEM_TYPE_NON_LISP) mem_insert (val, (char *) val + nbytes, type); @@ -1896,7 +1898,7 @@ CHECK_NUMBER (init); c = XINT (init); - if (SINGLE_BYTE_CHAR_P (c)) + if (ASCII_CHAR_P (c)) { nbytes = XINT (length); val = make_uninit_string (nbytes); @@ -2622,49 +2624,6 @@ } -DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0, - doc: /* Return a newly created char-table, with purpose PURPOSE. -Each element is initialized to INIT, which defaults to nil. -PURPOSE should be a symbol which has a `char-table-extra-slots' property. -The property's value should be an integer between 0 and 10. */) - (purpose, init) - register Lisp_Object purpose, init; -{ - Lisp_Object vector; - Lisp_Object n; - CHECK_SYMBOL (purpose); - n = Fget (purpose, Qchar_table_extra_slots); - CHECK_NUMBER (n); - if (XINT (n) < 0 || XINT (n) > 10) - args_out_of_range (n, Qnil); - /* Add 2 to the size for the defalt and parent slots. */ - vector = Fmake_vector (make_number (CHAR_TABLE_STANDARD_SLOTS + XINT (n)), - init); - XCHAR_TABLE (vector)->top = Qt; - XCHAR_TABLE (vector)->parent = Qnil; - XCHAR_TABLE (vector)->purpose = purpose; - XSETCHAR_TABLE (vector, XCHAR_TABLE (vector)); - return vector; -} - - -/* Return a newly created sub char table with default value DEFALT. - Since a sub char table does not appear as a top level Emacs Lisp - object, we don't need a Lisp interface to make it. */ - -Lisp_Object -make_sub_char_table (defalt) - Lisp_Object defalt; -{ - Lisp_Object vector - = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), Qnil); - XCHAR_TABLE (vector)->top = Qnil; - XCHAR_TABLE (vector)->defalt = defalt; - XSETCHAR_TABLE (vector, XCHAR_TABLE (vector)); - return vector; -} - - DEFUN ("vector", Fvector, Svector, 0, MANY, 0, doc: /* Return a newly created vector with specified arguments as elements. Any number of arguments, even zero arguments, are allowed. @@ -5024,6 +4983,7 @@ since all markable slots in current buffer marked anyway. */ /* Don't need to do Lisp_Objfwd, since the places they point are protected with staticpro. */ + case Lisp_Misc_Save_Value: break; case Lisp_Misc_Overlay: @@ -5771,7 +5731,6 @@ defsubr (&Smake_byte_code); defsubr (&Smake_list); defsubr (&Smake_vector); - defsubr (&Smake_char_table); defsubr (&Smake_string); defsubr (&Smake_bool_vector); defsubr (&Smake_symbol);