diff options
| author | Kenichi Handa | 2003-09-08 12:53:41 +0000 |
|---|---|---|
| committer | Kenichi Handa | 2003-09-08 12:53:41 +0000 |
| commit | 8f924df7df019cce90537647de2627581043b5c4 (patch) | |
| tree | 6c40bd05679425e710d6b2e5649eae3da5e40a52 /src/alloc.c | |
| parent | 463f5630a5e7cbe7f042bc1175d1fa1c4e98860f (diff) | |
| parent | 9d4807432a01f9b3cc519fcfa3ea92a70ffa7f43 (diff) | |
| download | emacs-8f924df7df019cce90537647de2627581043b5c4.tar.gz emacs-8f924df7df019cce90537647de2627581043b5c4.zip | |
*** empty log message ***
Diffstat (limited to 'src/alloc.c')
| -rw-r--r-- | src/alloc.c | 81 |
1 files changed, 20 insertions, 61 deletions
diff --git a/src/alloc.c b/src/alloc.c index 102bc637b58..4ebb97aec18 100644 --- a/src/alloc.c +++ b/src/alloc.c | |||
| @@ -52,7 +52,7 @@ Boston, MA 02111-1307, USA. */ | |||
| 52 | #include "keyboard.h" | 52 | #include "keyboard.h" |
| 53 | #include "frame.h" | 53 | #include "frame.h" |
| 54 | #include "blockinput.h" | 54 | #include "blockinput.h" |
| 55 | #include "charset.h" | 55 | #include "character.h" |
| 56 | #include "syssignal.h" | 56 | #include "syssignal.h" |
| 57 | #include <setjmp.h> | 57 | #include <setjmp.h> |
| 58 | 58 | ||
| @@ -766,6 +766,23 @@ lisp_align_malloc (nbytes, type) | |||
| 766 | mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); | 766 | mallopt (M_MMAP_MAX, MMAP_MAX_AREAS); |
| 767 | #endif | 767 | #endif |
| 768 | 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 | |||
| 769 | /* Initialize the blocks and put them on the free list. | 786 | /* Initialize the blocks and put them on the free list. |
| 770 | Is `base' was not properly aligned, we can't use the last block. */ | 787 | Is `base' was not properly aligned, we can't use the last block. */ |
| 771 | for (i = 0; i < (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1); i++) | 788 | for (i = 0; i < (aligned ? ABLOCKS_SIZE : ABLOCKS_SIZE - 1); i++) |
| @@ -788,21 +805,6 @@ lisp_align_malloc (nbytes, type) | |||
| 788 | val = free_ablock; | 805 | val = free_ablock; |
| 789 | free_ablock = free_ablock->x.next_free; | 806 | free_ablock = free_ablock->x.next_free; |
| 790 | 807 | ||
| 791 | /* If the memory just allocated cannot be addressed thru a Lisp | ||
| 792 | object's pointer, and it needs to be, | ||
| 793 | that's equivalent to running out of memory. */ | ||
| 794 | if (val && type != MEM_TYPE_NON_LISP) | ||
| 795 | { | ||
| 796 | Lisp_Object tem; | ||
| 797 | XSETCONS (tem, (char *) val + nbytes - 1); | ||
| 798 | if ((char *) XCONS (tem) != (char *) val + nbytes - 1) | ||
| 799 | { | ||
| 800 | lisp_malloc_loser = val; | ||
| 801 | free (val); | ||
| 802 | val = 0; | ||
| 803 | } | ||
| 804 | } | ||
| 805 | |||
| 806 | #if GC_MARK_STACK && !defined GC_MALLOC_CHECK | 808 | #if GC_MARK_STACK && !defined GC_MALLOC_CHECK |
| 807 | if (val && type != MEM_TYPE_NON_LISP) | 809 | if (val && type != MEM_TYPE_NON_LISP) |
| 808 | mem_insert (val, (char *) val + nbytes, type); | 810 | mem_insert (val, (char *) val + nbytes, type); |
| @@ -1896,7 +1898,7 @@ Both LENGTH and INIT must be numbers. */) | |||
| 1896 | CHECK_NUMBER (init); | 1898 | CHECK_NUMBER (init); |
| 1897 | 1899 | ||
| 1898 | c = XINT (init); | 1900 | c = XINT (init); |
| 1899 | if (SINGLE_BYTE_CHAR_P (c)) | 1901 | if (ASCII_CHAR_P (c)) |
| 1900 | { | 1902 | { |
| 1901 | nbytes = XINT (length); | 1903 | nbytes = XINT (length); |
| 1902 | val = make_uninit_string (nbytes); | 1904 | val = make_uninit_string (nbytes); |
| @@ -2622,49 +2624,6 @@ See also the function `vector'. */) | |||
| 2622 | } | 2624 | } |
| 2623 | 2625 | ||
| 2624 | 2626 | ||
| 2625 | DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0, | ||
| 2626 | doc: /* Return a newly created char-table, with purpose PURPOSE. | ||
| 2627 | Each element is initialized to INIT, which defaults to nil. | ||
| 2628 | PURPOSE should be a symbol which has a `char-table-extra-slots' property. | ||
| 2629 | The property's value should be an integer between 0 and 10. */) | ||
| 2630 | (purpose, init) | ||
| 2631 | register Lisp_Object purpose, init; | ||
| 2632 | { | ||
| 2633 | Lisp_Object vector; | ||
| 2634 | Lisp_Object n; | ||
| 2635 | CHECK_SYMBOL (purpose); | ||
| 2636 | n = Fget (purpose, Qchar_table_extra_slots); | ||
| 2637 | CHECK_NUMBER (n); | ||
| 2638 | if (XINT (n) < 0 || XINT (n) > 10) | ||
| 2639 | args_out_of_range (n, Qnil); | ||
| 2640 | /* Add 2 to the size for the defalt and parent slots. */ | ||
| 2641 | vector = Fmake_vector (make_number (CHAR_TABLE_STANDARD_SLOTS + XINT (n)), | ||
| 2642 | init); | ||
| 2643 | XCHAR_TABLE (vector)->top = Qt; | ||
| 2644 | XCHAR_TABLE (vector)->parent = Qnil; | ||
| 2645 | XCHAR_TABLE (vector)->purpose = purpose; | ||
| 2646 | XSETCHAR_TABLE (vector, XCHAR_TABLE (vector)); | ||
| 2647 | return vector; | ||
| 2648 | } | ||
| 2649 | |||
| 2650 | |||
| 2651 | /* Return a newly created sub char table with default value DEFALT. | ||
| 2652 | Since a sub char table does not appear as a top level Emacs Lisp | ||
| 2653 | object, we don't need a Lisp interface to make it. */ | ||
| 2654 | |||
| 2655 | Lisp_Object | ||
| 2656 | make_sub_char_table (defalt) | ||
| 2657 | Lisp_Object defalt; | ||
| 2658 | { | ||
| 2659 | Lisp_Object vector | ||
| 2660 | = Fmake_vector (make_number (SUB_CHAR_TABLE_STANDARD_SLOTS), Qnil); | ||
| 2661 | XCHAR_TABLE (vector)->top = Qnil; | ||
| 2662 | XCHAR_TABLE (vector)->defalt = defalt; | ||
| 2663 | XSETCHAR_TABLE (vector, XCHAR_TABLE (vector)); | ||
| 2664 | return vector; | ||
| 2665 | } | ||
| 2666 | |||
| 2667 | |||
| 2668 | DEFUN ("vector", Fvector, Svector, 0, MANY, 0, | 2627 | DEFUN ("vector", Fvector, Svector, 0, MANY, 0, |
| 2669 | doc: /* Return a newly created vector with specified arguments as elements. | 2628 | doc: /* Return a newly created vector with specified arguments as elements. |
| 2670 | Any number of arguments, even zero arguments, are allowed. | 2629 | Any number of arguments, even zero arguments, are allowed. |
| @@ -5024,6 +4983,7 @@ mark_object (arg) | |||
| 5024 | since all markable slots in current buffer marked anyway. */ | 4983 | since all markable slots in current buffer marked anyway. */ |
| 5025 | /* Don't need to do Lisp_Objfwd, since the places they point | 4984 | /* Don't need to do Lisp_Objfwd, since the places they point |
| 5026 | are protected with staticpro. */ | 4985 | are protected with staticpro. */ |
| 4986 | case Lisp_Misc_Save_Value: | ||
| 5027 | break; | 4987 | break; |
| 5028 | 4988 | ||
| 5029 | case Lisp_Misc_Overlay: | 4989 | case Lisp_Misc_Overlay: |
| @@ -5771,7 +5731,6 @@ The time is in seconds as a floating point value. */); | |||
| 5771 | defsubr (&Smake_byte_code); | 5731 | defsubr (&Smake_byte_code); |
| 5772 | defsubr (&Smake_list); | 5732 | defsubr (&Smake_list); |
| 5773 | defsubr (&Smake_vector); | 5733 | defsubr (&Smake_vector); |
| 5774 | defsubr (&Smake_char_table); | ||
| 5775 | defsubr (&Smake_string); | 5734 | defsubr (&Smake_string); |
| 5776 | defsubr (&Smake_bool_vector); | 5735 | defsubr (&Smake_bool_vector); |
| 5777 | defsubr (&Smake_symbol); | 5736 | defsubr (&Smake_symbol); |