(C5-694E): Delete M-35963.
[chise/xemacs-chise.git] / src / alloc.c
index f10c14b..38b7755 100644 (file)
@@ -159,16 +159,6 @@ Lisp_Object Vgc_pointer_glyph;
 static const char gc_default_message[] = "Garbage collecting";
 Lisp_Object Qgarbage_collecting;
 
-#ifndef VIRT_ADDR_VARIES
-extern
-#endif /* VIRT_ADDR_VARIES */
- EMACS_INT malloc_sbrk_used;
-
-#ifndef VIRT_ADDR_VARIES
-extern
-#endif /* VIRT_ADDR_VARIES */
- EMACS_INT malloc_sbrk_unused;
-
 /* Non-zero means we're in the process of doing the dump */
 int purify_flag;
 
@@ -500,17 +490,17 @@ disksave_object_finalization_1 (void)
    about expressions in src/.gdbinit.  See src/.gdbinit or src/.dbxrc
    to see how this is used.  */
 
-EMACS_UINT dbg_valmask = ((1UL << VALBITS) - 1) << GCBITS;
-EMACS_UINT dbg_typemask = (1UL << GCTYPEBITS) - 1;
+const EMACS_UINT dbg_valmask = ((1UL << VALBITS) - 1) << GCBITS;
+const EMACS_UINT dbg_typemask = (1UL << GCTYPEBITS) - 1;
 
 #ifdef USE_UNION_TYPE
-unsigned char dbg_USE_UNION_TYPE = 1;
+const unsigned char dbg_USE_UNION_TYPE = 1;
 #else
-unsigned char dbg_USE_UNION_TYPE = 0;
+const unsigned char dbg_USE_UNION_TYPE = 0;
 #endif
 
-unsigned char dbg_valbits = VALBITS;
-unsigned char dbg_gctypebits = GCTYPEBITS;
+const unsigned char dbg_valbits = VALBITS;
+const unsigned char dbg_gctypebits = GCTYPEBITS;
 
 /* Macros turned into functions for ease of debugging.
    Debuggers don't know about macros! */
@@ -1058,9 +1048,9 @@ list6 (Lisp_Object obj0, Lisp_Object obj1, Lisp_Object obj2, Lisp_Object obj3,
 }
 
 DEFUN ("make-list", Fmake_list, 2, 2, 0, /*
-Return a new list of length LENGTH, with each element being INIT.
+Return a new list of length LENGTH, with each element being OBJECT.
 */
-       (length, init))
+       (length, object))
 {
   CHECK_NATNUM (length);
 
@@ -1069,7 +1059,7 @@ Return a new list of length LENGTH, with each element being INIT.
     size_t size = XINT (length);
 
     while (size--)
-      val = Fcons (init, val);
+      val = Fcons (object, val);
     return val;
   }
 }
@@ -1180,13 +1170,13 @@ make_vector_internal (size_t sizei)
 }
 
 Lisp_Object
-make_vector (size_t length, Lisp_Object init)
+make_vector (size_t length, Lisp_Object object)
 {
   Lisp_Vector *vecp = make_vector_internal (length);
   Lisp_Object *p = vector_data (vecp);
 
   while (length--)
-    *p++ = init;
+    *p++ = object;
 
   {
     Lisp_Object vector;
@@ -1264,13 +1254,13 @@ make_vector_newer (Lisp_Object v)
 #endif
 
 DEFUN ("make-vector", Fmake_vector, 2, 2, 0, /*
-Return a new vector of length LENGTH, with each element being INIT.
+Return a new vector of length LENGTH, with each element being OBJECT.
 See also the function `vector'.
 */
-       (length, init))
+       (length, object))
 {
   CONCHECK_NATNUM (length);
-  return make_vector (XINT (length), init);
+  return make_vector (XINT (length), object);
 }
 
 DEFUN ("vector", Fvector, 0, MANY, 0, /*
@@ -1419,14 +1409,14 @@ make_bit_vector_internal (size_t sizei)
 }
 
 Lisp_Object
-make_bit_vector (size_t length, Lisp_Object init)
+make_bit_vector (size_t length, Lisp_Object bit)
 {
   Lisp_Bit_Vector *p = make_bit_vector_internal (length);
   size_t num_longs = BIT_VECTOR_LONG_STORAGE (length);
 
-  CHECK_BIT (init);
+  CHECK_BIT (bit);
 
-  if (ZEROP (init))
+  if (ZEROP (bit))
     memset (p->bits, 0, num_longs * sizeof (long));
   else
     {
@@ -1462,19 +1452,20 @@ make_bit_vector_from_byte_vector (unsigned char *bytevec, size_t length)
 }
 
 DEFUN ("make-bit-vector", Fmake_bit_vector, 2, 2, 0, /*
-Return a new bit vector of length LENGTH. with each bit being INIT.
-Each element is set to INIT.  See also the function `bit-vector'.
+Return a new bit vector of length LENGTH. with each bit set to BIT.
+BIT must be one of the integers 0 or 1.  See also the function `bit-vector'.
 */
-       (length, init))
+       (length, bit))
 {
   CONCHECK_NATNUM (length);
 
-  return make_bit_vector (XINT (length), init);
+  return make_bit_vector (XINT (length), bit);
 }
 
 DEFUN ("bit-vector", Fbit_vector, 0, MANY, 0, /*
 Return a newly created bit vector with specified arguments as elements.
 Any number of arguments, even zero arguments, are allowed.
+Each argument must be one of the integers 0 or 1.
 */
        (int nargs, Lisp_Object *args))
 {
@@ -1561,7 +1552,6 @@ This is terrible behavior which is retained for compatibility with old
   /* Check for valid formal parameter list now, to allow us to use
      SPECBIND_FAST_UNSAFE() later in funcall_compiled_function(). */
   {
-    Lisp_Object symbol, tail;
     EXTERNAL_LIST_LOOP_3 (symbol, arglist, tail)
       {
        CHECK_SYMBOL (symbol);
@@ -2156,21 +2146,21 @@ set_string_char (Lisp_String *s, Charcount i, Emchar c)
 #endif /* MULE */
 
 DEFUN ("make-string", Fmake_string, 2, 2, 0, /*
-Return a new string of length LENGTH, with each character being INIT.
-LENGTH must be an integer and INIT must be a character.
+Return a new string consisting of LENGTH copies of CHARACTER.
+LENGTH must be a non-negative integer.
 */
-       (length, init))
+       (length, character))
 {
   CHECK_NATNUM (length);
-  CHECK_CHAR_COERCE_INT (init);
+  CHECK_CHAR_COERCE_INT (character);
   {
     Bufbyte init_str[MAX_EMCHAR_LEN];
-    int len = set_charptr_emchar (init_str, XCHAR (init));
+    int len = set_charptr_emchar (init_str, XCHAR (character));
     Lisp_Object val = make_uninit_string (len * XINT (length));
 
     if (len == 1)
       /* Optimize the single-byte case */
-      memset (XSTRING_DATA (val), XCHAR (init), XSTRING_LENGTH (val));
+      memset (XSTRING_DATA (val), XCHAR (character), XSTRING_LENGTH (val));
     else
       {
        size_t i;
@@ -2410,8 +2400,7 @@ allocate_managed_lcrecord (Lisp_Object lcrecord_list)
     {
       Lisp_Object val;
 
-      XSETOBJ (val, Lisp_Type_Record,
-              alloc_lcrecord (list->size, list->implementation));
+      XSETOBJ (val, alloc_lcrecord (list->size, list->implementation));
       return val;
     }
 }
@@ -2450,9 +2439,9 @@ Make a copy of OBJECT in pure storage.
 Recursively copies contents of vectors and cons cells.
 Does not copy symbols.
 */
-       (obj))
+       (object))
 {
-  return obj;
+  return object;
 }
 
 \f
@@ -2463,9 +2452,8 @@ Does not copy symbols.
 /* All the built-in lisp object types are enumerated in `enum lrecord_type'.
    Additional ones may be defined by a module (none yet).  We leave some
    room in `lrecord_implementations_table' for such new lisp object types. */
-#define MODULE_DEFINABLE_TYPE_COUNT 32
-const struct lrecord_implementation *lrecord_implementations_table[lrecord_type_count + MODULE_DEFINABLE_TYPE_COUNT];
-
+const struct lrecord_implementation *lrecord_implementations_table[(unsigned int)lrecord_type_last_built_in_type + MODULE_DEFINABLE_TYPE_COUNT];
+unsigned int lrecord_type_count = (unsigned int)lrecord_type_last_built_in_type;
 /* Object marker functions are in the lrecord_implementation structure.
    But copying them to a parallel array is much more cache-friendly.
    This hack speeds up (garbage-collect) by about 5%. */
@@ -2810,12 +2798,10 @@ sweep_bit_vectors_1 (Lisp_Object *prev,
 #define SWEEP_FIXED_TYPE_BLOCK(typename, obj_type)                     \
 do {                                                                   \
   struct typename##_block *SFTB_current;                               \
-  struct typename##_block **SFTB_prev;                                 \
   int SFTB_limit;                                                      \
   int num_free = 0, num_used = 0;                                      \
                                                                        \
-  for (SFTB_prev = &current_##typename##_block,                                \
-       SFTB_current = current_##typename##_block,                      \
+  for (SFTB_current = current_##typename##_block,                      \
        SFTB_limit = current_##typename##_block_index;                  \
        SFTB_current;                                                   \
        )                                                               \
@@ -2845,7 +2831,6 @@ do {                                                                      \
              UNMARK_##typename (SFTB_victim);                          \
            }                                                           \
        }                                                               \
-      SFTB_prev = &(SFTB_current->prev);                               \
       SFTB_current = SFTB_current->prev;                               \
       SFTB_limit = countof (current_##typename##_block->block);                \
     }                                                                  \
@@ -3069,7 +3054,7 @@ void
 free_marker (Lisp_Marker *ptr)
 {
   /* Perhaps this will catch freeing an already-freed marker. */
-  gc_checking_assert (ptr->lheader.type = lrecord_type_marker);
+  gc_checking_assert (ptr->lheader.type == lrecord_type_marker);
 
 #ifndef ALLOC_NO_POOLS
   FREE_FIXED_TYPE_WHEN_NOT_IN_GC (marker, Lisp_Marker, ptr);
@@ -3838,7 +3823,7 @@ If this value exceeds `gc-cons-threshold', a garbage collection happens.
 }
 
 #if 0
-DEFUN ("memory-limit", Fmemory_limit, 0, 0, "", /*
+DEFUN ("memory-limit", Fmemory_limit, 0, 0, 0, /*
 Return the address of the last byte Emacs has allocated, divided by 1024.
 This may be helpful in debugging Emacs's memory usage.
 The value is divided by 1024 to make sure it will fit in a lisp integer.
@@ -4043,10 +4028,6 @@ reinit_alloc_once_early (void)
 #else
   gc_cons_threshold = 15000; /* debugging */
 #endif
-#ifdef VIRT_ADDR_VARIES
-  malloc_sbrk_unused = 1<<22;  /* A large number */
-  malloc_sbrk_used = 100000;   /* as reasonable as any number */
-#endif /* VIRT_ADDR_VARIES */
   lrecord_uid_counter = 259;
   debug_string_purity = 0;
   gcprolist = 0;
@@ -4084,8 +4065,6 @@ init_alloc_once_early (void)
   staticidx = 0;
 }
 
-int pure_bytes_used = 0;
-
 void
 reinit_alloc (void)
 {
@@ -4095,9 +4074,9 @@ reinit_alloc (void)
 void
 syms_of_alloc (void)
 {
-  defsymbol (&Qpre_gc_hook, "pre-gc-hook");
-  defsymbol (&Qpost_gc_hook, "post-gc-hook");
-  defsymbol (&Qgarbage_collecting, "garbage-collecting");
+  DEFSYMBOL (Qpre_gc_hook);
+  DEFSYMBOL (Qpost_gc_hook);
+  DEFSYMBOL (Qgarbage_collecting);
 
   DEFSUBR (Fcons);
   DEFSUBR (Flist);
@@ -4137,20 +4116,6 @@ prevent garbage collection during a part of the program.
 See also `consing-since-gc'.
 */ );
 
-  DEFVAR_INT ("pure-bytes-used", &pure_bytes_used /*
-Number of bytes of sharable Lisp data allocated so far.
-*/ );
-
-#if 0
-  DEFVAR_INT ("data-bytes-used", &malloc_sbrk_used /*
-Number of bytes of unshared memory allocated in this session.
-*/ );
-
-  DEFVAR_INT ("data-bytes-free", &malloc_sbrk_unused /*
-Number of bytes of unshared memory remaining available in this session.
-*/ );
-#endif
-
 #ifdef DEBUG_XEMACS
   DEFVAR_INT ("debug-allocation", &debug_allocation /*
 If non-zero, print out information to stderr about all objects allocated.