52 |
#include "keyboard.h" |
#include "keyboard.h" |
53 |
#include "frame.h" |
#include "frame.h" |
54 |
#include "blockinput.h" |
#include "blockinput.h" |
55 |
#include "charset.h" |
#include "character.h" |
56 |
#include "syssignal.h" |
#include "syssignal.h" |
57 |
#include <setjmp.h> |
#include <setjmp.h> |
58 |
|
|
766 |
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); |
mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); |
767 |
#endif |
#endif |
768 |
|
|
769 |
|
/* If the memory just allocated cannot be addressed thru a Lisp |
770 |
|
object's pointer, and it needs to be, that's equivalent to |
771 |
|
running out of memory. */ |
772 |
|
if (type != MEM_TYPE_NON_LISP) |
773 |
|
{ |
774 |
|
Lisp_Object tem; |
775 |
|
char *end = (char *) base + ABLOCKS_BYTES - 1; |
776 |
|
XSETCONS (tem, end); |
777 |
|
if ((char *) XCONS (tem) != end) |
778 |
|
{ |
779 |
|
lisp_malloc_loser = base; |
780 |
|
free (base); |
781 |
|
UNBLOCK_INPUT; |
782 |
|
memory_full (); |
783 |
|
} |
784 |
|
} |
785 |
|
|
786 |
/* Initialize the blocks and put them on the free list. |
/* Initialize the blocks and put them on the free list. |
787 |
Is `base' was not properly aligned, we can't use the last block. */ |
Is `base' was not properly aligned, we can't use the last block. */ |
788 |
for (i = 0; i < (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1); i++) |
for (i = 0; i < (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1); i++) |
805 |
val = free_ablock; |
val = free_ablock; |
806 |
free_ablock = free_ablock->x.next_free; |
free_ablock = free_ablock->x.next_free; |
807 |
|
|
|
/* 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; |
|
|
} |
|
|
} |
|
|
|
|
808 |
#if GC_MARK_STACK && !defined GC_MALLOC_CHECK |
#if GC_MARK_STACK && !defined GC_MALLOC_CHECK |
809 |
if (val && type != MEM_TYPE_NON_LISP) |
if (val && type != MEM_TYPE_NON_LISP) |
810 |
mem_insert (val, (char *) val + nbytes, type); |
mem_insert (val, (char *) val + nbytes, type); |
1898 |
CHECK_NUMBER (init); |
CHECK_NUMBER (init); |
1899 |
|
|
1900 |
c = XINT (init); |
c = XINT (init); |
1901 |
if (SINGLE_BYTE_CHAR_P (c)) |
if (ASCII_CHAR_P (c)) |
1902 |
{ |
{ |
1903 |
nbytes = XINT (length); |
nbytes = XINT (length); |
1904 |
val = make_uninit_string (nbytes); |
val = make_uninit_string (nbytes); |
2624 |
} |
} |
2625 |
|
|
2626 |
|
|
|
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; |
|
|
} |
|
|
|
|
|
|
|
2627 |
DEFUN ("vector", Fvector, Svector, 0, MANY, 0, |
DEFUN ("vector", Fvector, Svector, 0, MANY, 0, |
2628 |
doc: /* Return a newly created vector with specified arguments as elements. |
doc: /* Return a newly created vector with specified arguments as elements. |
2629 |
Any number of arguments, even zero arguments, are allowed. |
Any number of arguments, even zero arguments, are allowed. |
4983 |
since all markable slots in current buffer marked anyway. */ |
since all markable slots in current buffer marked anyway. */ |
4984 |
/* Don't need to do Lisp_Objfwd, since the places they point |
/* Don't need to do Lisp_Objfwd, since the places they point |
4985 |
are protected with staticpro. */ |
are protected with staticpro. */ |
4986 |
|
case Lisp_Misc_Save_Value: |
4987 |
break; |
break; |
4988 |
|
|
4989 |
case Lisp_Misc_Overlay: |
case Lisp_Misc_Overlay: |
5731 |
defsubr (&Smake_byte_code); |
defsubr (&Smake_byte_code); |
5732 |
defsubr (&Smake_list); |
defsubr (&Smake_list); |
5733 |
defsubr (&Smake_vector); |
defsubr (&Smake_vector); |
|
defsubr (&Smake_char_table); |
|
5734 |
defsubr (&Smake_string); |
defsubr (&Smake_string); |
5735 |
defsubr (&Smake_bool_vector); |
defsubr (&Smake_bool_vector); |
5736 |
defsubr (&Smake_symbol); |
defsubr (&Smake_symbol); |