/[emacs]/emacs/src/alloc.c
ViewVC logotype

Diff of /emacs/src/alloc.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.318 by monnier, Mon Jul 21 20:03:18 2003 UTC revision 1.318.2.1 by handa, Mon Sep 8 12:48:09 2003 UTC
# Line 52  Boston, MA 02111-1307, USA.  */ Line 52  Boston, MA 02111-1307, USA.  */
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    
# Line 766  lisp_align_malloc (nbytes, type) Line 766  lisp_align_malloc (nbytes, type)
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++)
# Line 788  lisp_align_malloc (nbytes, type) Line 805  lisp_align_malloc (nbytes, type)
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);
# Line 1896  Both LENGTH and INIT must be numbers.  * Line 1898  Both LENGTH and INIT must be numbers.  *
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);
# Line 2622  See also the function `vector'.  */) Line 2624  See also the function `vector'.  */)
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.
# Line 5024  mark_object (arg) Line 4983  mark_object (arg)
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:
# Line 5771  The time is in seconds as a floating poi Line 5731  The time is in seconds as a floating poi
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);

Legend:
Removed from v.1.318  
changed lines
  Added in v.1.318.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26