comparison src/alloc.c @ 39988:eac4e9ae201c

Change doc-string comments to `new style' [w/`doc:' keyword].

39987:9c096889e4c6

/* This file is part of the core Lisp implementation, and thus must
   deal with the real data structures.  If the Lisp implementation is
   replaced, this file likely will not be used.  */

#undef HIDE_LISP_IMPLEMENTATION
#define DOC_STRINGS_IN_COMMENTS
#include "lisp.h"
#include "process.h"
#include "intervals.h"
#include "puresize.h"
#include "buffer.h"

  current_sblock = tb;
}


DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,
  /* Return a newly created string of length LENGTH, with each element being INIT.
Both LENGTH and INIT must be numbers.  */
       (length, init))
     Lisp_Object length, init;
{
  register Lisp_Object val;
  register unsigned char *p, *end;
  int c, nbytes;

  return val;
}


DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
  /* Return a new bool-vector of length LENGTH, using INIT for as each element.
LENGTH must be a number.  INIT matters only in whether it is t or nil.  */
       (length, init))
     Lisp_Object length, init;
{
  register Lisp_Object val;
  struct Lisp_Bool_Vector *p;
  int real_init, i;

  cons_free_list = ptr;
}


DEFUN ("cons", Fcons, Scons, 2, 2, 0,
  /* Create a new cons, give it CAR and CDR as components, and return it.  */
       (car, cdr))
     Lisp_Object car, cdr;
{
  register Lisp_Object val;

  if (cons_free_list)

						       Fcons (arg5, Qnil)))));
}


DEFUN ("list", Flist, Slist, 0, MANY, 0,
  /* Return a newly created list with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.  */
       (nargs, args))
     int nargs;
     register Lisp_Object *args;
{
  register Lisp_Object val;
  val = Qnil;

  return val;
}


DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
  /* Return a newly created list of length LENGTH, with each element being INIT.  */
       (length, init))
     register Lisp_Object length, init;
{
  register Lisp_Object val;
  register int size;

  return v;
}


DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
  /* Return a newly created vector of length LENGTH, with each element being INIT.
See also the function `vector'.  */
       (length, init))
     register Lisp_Object length, init;
{
  Lisp_Object vector;
  register EMACS_INT sizei;
  register int index;

  return vector;
}


DEFUN ("make-char-table", Fmake_char_table, Smake_char_table, 1, 2, 0,
  /* 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, 1);

  return vector;
}


DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
  /* Return a newly created vector with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.  */
       (nargs, args))
     register int nargs;
     Lisp_Object *args;
{
  register Lisp_Object len, val;
  register int index;

  return val;
}


DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
  /* Create a byte-code object with specified arguments as elements.
The arguments should be the arglist, bytecode-string, constant vector,
stack size, (optional) doc string, and (optional) interactive spec.
The first four arguments are required; at most six have any
significance.  */
       (nargs, args))
     register int nargs;
     Lisp_Object *args;
{
  register Lisp_Object len, val;
  register int index;

  n_symbol_blocks = 1;
}


DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
  /* Return a newly allocated uninterned symbol whose name is NAME.
Its value and function definition are void, and its property list is nil.  */
       (name))
     Lisp_Object name;
{
  register Lisp_Object val;
  register struct Lisp_Symbol *p;

  misc_objects_consed++;
  return val;
}

DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
  /* Return a newly allocated marker which does not point at any place.  */
       ())
{
  register Lisp_Object val;
  register struct Lisp_Marker *p;

  val = allocate_misc ();

/* Average number of live objects per GC.  */

static double avg_live;

DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "",
       /* Show information about live and zombie objects.  */
       ())
{
  Lisp_Object args[7];
  args[0] = build_string ("%d GCs, avg live/zombies = %.2f/%.2f (%f%%), max %d/%d");
  args[1] = make_number (ngcs);
  args[2] = make_float (avg_live);

  /* Mark Lisp data pointed to.  This is necessary because, in some
     situations, the C compiler optimizes Lisp objects away, so that
     only a pointer to them remains.  Example:

     DEFUN ("testme", Ftestme, Stestme, 0, 0, 0, "")
          ()
     {
       Lisp_Object obj = build_string ("test");
       struct Lisp_String *s = XSTRING (obj);
       Fgarbage_collect ();
       fprintf (stderr, "test `%s'\n", s->data);

  return new;
}


DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
       /* Make a copy of OBJECT in pure storage.
Recursively copies contents of vectors and cons cells.
Does not copy symbols.  Copies strings without text properties.  */
       (obj))
     register Lisp_Object obj;
{
  if (NILP (Vpurify_flag))
    return obj;

  return count;
}


DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
       /* Reclaim storage for Lisp objects no longer needed.
Returns info on amount of space in use:
 ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
  (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS
  (USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS)
  (USED-STRINGS . FREE-STRINGS))
Garbage collection happens automatically if you cons more than
`gc-cons-threshold' bytes of Lisp data since previous garbage collection.  */
       ())
{
  register struct gcpro *tail;
  register struct specbinding *bind;
  struct catchtag *catch;
  struct handler *handler;


/* Debugging aids.  */

DEFUN ("memory-limit", Fmemory_limit, Smemory_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.
We divide the value by 1024 to make sure it fits in a Lisp integer.  */
       ())
{
  Lisp_Object end;

  XSETINT (end, (EMACS_INT) sbrk (0) / 1024);

  return end;
}

DEFUN ("memory-use-counts", Fmemory_use_counts, Smemory_use_counts, 0, 0, 0,
  /* Return a list of counters that measure how much consing there has been.
Each of these counters increments for a certain kind of object.
The counters wrap around from the largest positive integer to zero.
Garbage collection does not decrease them.
The elements of the value are as follows:
  (CONSES FLOATS VECTOR-CELLS SYMBOLS STRING-CHARS MISCS INTERVALS STRINGS)
All are in units of 1 = one object consed
except for VECTOR-CELLS and STRING-CHARS, which count the total length of
objects consed.
MISCS include overlays, markers, and some internal types.
Frames, windows, buffers, and subprocesses count as vectors
  (but the contents of a buffer's text do not count here).  */
       ())
{
  Lisp_Object consed[8];

  consed[0] = make_number (min (MOST_POSITIVE_FIXNUM, cons_cells_consed));
  consed[1] = make_number (min (MOST_POSITIVE_FIXNUM, floats_consed));

}

void
syms_of_alloc ()
{
  DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold
    /* *Number of bytes of consing between garbage collections.
Garbage collection can happen automatically once this many bytes have been
allocated since the last garbage collection.  All data types count.

Garbage collection happens automatically only when `eval' is called.

By binding this temporarily to a large number, you can effectively
prevent garbage collection during a part of the program.  */);

  DEFVAR_INT ("pure-bytes-used", &pure_bytes_used
    /* Number of bytes of sharable Lisp data allocated so far.  */);

  DEFVAR_INT ("cons-cells-consed", &cons_cells_consed
    /* Number of cons cells that have been consed so far.  */);

  DEFVAR_INT ("floats-consed", &floats_consed
    /* Number of floats that have been consed so far.  */);

  DEFVAR_INT ("vector-cells-consed", &vector_cells_consed
    /* Number of vector cells that have been consed so far.  */);

  DEFVAR_INT ("symbols-consed", &symbols_consed
    /* Number of symbols that have been consed so far.  */);

  DEFVAR_INT ("string-chars-consed", &string_chars_consed
    /* Number of string characters that have been consed so far.  */);

  DEFVAR_INT ("misc-objects-consed", &misc_objects_consed
    /* Number of miscellaneous objects that have been consed so far.  */);

  DEFVAR_INT ("intervals-consed", &intervals_consed
    /* Number of intervals that have been consed so far.  */);

  DEFVAR_INT ("strings-consed", &strings_consed
    /* Number of strings that have been consed so far.  */);

  DEFVAR_LISP ("purify-flag", &Vpurify_flag
    /* Non-nil means loading Lisp code in order to dump an executable.
This means that certain objects should be allocated in shared (pure) space.  */);

  DEFVAR_INT ("undo-limit", &undo_limit
    /* Keep no more undo information once it exceeds this size.
This limit is applied when garbage collection happens.
The size is counted as the number of bytes occupied,
which includes both saved text and other data.  */);
  undo_limit = 20000;

  DEFVAR_INT ("undo-strong-limit", &undo_strong_limit
    /* Don't keep more than this much size of undo information.
A command which pushes past this size is itself forgotten.
This limit is applied when garbage collection happens.
The size is counted as the number of bytes occupied,
which includes both saved text and other data.  */);
  undo_strong_limit = 30000;

  DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages
    /* Non-nil means display messages at start and end of garbage collection.  */);
  garbage_collection_messages = 0;

  DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook
    /* Hook run after garbage collection has finished.  */);
  Vpost_gc_hook = Qnil;
  Qpost_gc_hook = intern ("post-gc-hook");
  staticpro (&Qpost_gc_hook);

  /* We build this in advance because if we wait until we need it, we might

39988:eac4e9ae201c

/* This file is part of the core Lisp implementation, and thus must
   deal with the real data structures.  If the Lisp implementation is
   replaced, this file likely will not be used.  */

#undef HIDE_LISP_IMPLEMENTATION
#include "lisp.h"
#include "process.h"
#include "intervals.h"
#include "puresize.h"
#include "buffer.h"

  current_sblock = tb;
}


DEFUN ("make-string", Fmake_string, Smake_string, 2, 2, 0,
  doc: /* Return a newly created string of length LENGTH, with each element being INIT.
Both LENGTH and INIT must be numbers.  */)
     (length, init)
     Lisp_Object length, init;
{
  register Lisp_Object val;
  register unsigned char *p, *end;
  int c, nbytes;

  return val;
}


DEFUN ("make-bool-vector", Fmake_bool_vector, Smake_bool_vector, 2, 2, 0,
  doc: /* Return a new bool-vector of length LENGTH, using INIT for as each element.
LENGTH must be a number.  INIT matters only in whether it is t or nil.  */)
     (length, init)
     Lisp_Object length, init;
{
  register Lisp_Object val;
  struct Lisp_Bool_Vector *p;
  int real_init, i;

  cons_free_list = ptr;
}


DEFUN ("cons", Fcons, Scons, 2, 2, 0,
  doc: /* Create a new cons, give it CAR and CDR as components, and return it.  */)
     (car, cdr)
     Lisp_Object car, cdr;
{
  register Lisp_Object val;

  if (cons_free_list)

						       Fcons (arg5, Qnil)))));
}


DEFUN ("list", Flist, Slist, 0, MANY, 0,
  doc: /* Return a newly created list with specified arguments as elements.
Any number of arguments, even zero arguments, are allowed.  */)
     (nargs, args)
     int nargs;
     register Lisp_Object *args;
{
  register Lisp_Object val;
  val = Qnil;

  return val;
}


DEFUN ("make-list", Fmake_list, Smake_list, 2, 2, 0,
  doc: /* Return a newly created list of length LENGTH, with each element being INIT.  */)
     (length, init)
     register Lisp_Object length, init;
{
  register Lisp_Object val;
  register int size;

  return v;
}


DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
  doc: /* Return a newly created vector of length LENGTH, with each element being INIT.
See also the function `vector'.  */)
     (length, init)
     register Lisp_Object length, init;
{
  Lisp_Object vector;
  register EMACS_INT sizei;
  register int index;

  return vector;
}


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, 1);

  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.  */)
     (nargs, args)
     register int nargs;
     Lisp_Object *args;
{
  register Lisp_Object len, val;
  register int index;

  return val;
}


DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
  doc: /* Create a byte-code object with specified arguments as elements.
The arguments should be the arglist, bytecode-string, constant vector,
stack size, (optional) doc string, and (optional) interactive spec.
The first four arguments are required; at most six have any
significance.  */)
     (nargs, args)
     register int nargs;
     Lisp_Object *args;
{
  register Lisp_Object len, val;
  register int index;

  n_symbol_blocks = 1;
}


DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
  doc: /* Return a newly allocated uninterned symbol whose name is NAME.
Its value and function definition are void, and its property list is nil.  */)
     (name)
     Lisp_Object name;
{
  register Lisp_Object val;
  register struct Lisp_Symbol *p;

  misc_objects_consed++;
  return val;
}

DEFUN ("make-marker", Fmake_marker, Smake_marker, 0, 0, 0,
  doc: /* Return a newly allocated marker which does not point at any place.  */)
     ()
{
  register Lisp_Object val;
  register struct Lisp_Marker *p;

  val = allocate_misc ();

/* Average number of live objects per GC.  */

static double avg_live;

DEFUN ("gc-status", Fgc_status, Sgc_status, 0, 0, "",
       doc: /* Show information about live and zombie objects.  */)
     ()
{
  Lisp_Object args[7];
  args[0] = build_string ("%d GCs, avg live/zombies = %.2f/%.2f (%f%%), max %d/%d");
  args[1] = make_number (ngcs);
  args[2] = make_float (avg_live);

  /* Mark Lisp data pointed to.  This is necessary because, in some
     situations, the C compiler optimizes Lisp objects away, so that
     only a pointer to them remains.  Example:

     DEFUN ("testme", Ftestme, Stestme, 0, 0, 0, "")
     ()
     {
       Lisp_Object obj = build_string ("test");
       struct Lisp_String *s = XSTRING (obj);
       Fgarbage_collect ();
       fprintf (stderr, "test `%s'\n", s->data);

  return new;
}


DEFUN ("purecopy", Fpurecopy, Spurecopy, 1, 1, 0,
       doc: /* Make a copy of OBJECT in pure storage.
Recursively copies contents of vectors and cons cells.
Does not copy symbols.  Copies strings without text properties.  */)
     (obj)
     register Lisp_Object obj;
{
  if (NILP (Vpurify_flag))
    return obj;

  return count;
}


DEFUN ("garbage-collect", Fgarbage_collect, Sgarbage_collect, 0, 0, "",
       doc: /* Reclaim storage for Lisp objects no longer needed.
Returns info on amount of space in use:
 ((USED-CONSES . FREE-CONSES) (USED-SYMS . FREE-SYMS)
  (USED-MARKERS . FREE-MARKERS) USED-STRING-CHARS USED-VECTOR-SLOTS
  (USED-FLOATS . FREE-FLOATS) (USED-INTERVALS . FREE-INTERVALS)
  (USED-STRINGS . FREE-STRINGS))
Garbage collection happens automatically if you cons more than
`gc-cons-threshold' bytes of Lisp data since previous garbage collection.  */)
     ()
{
  register struct gcpro *tail;
  register struct specbinding *bind;
  struct catchtag *catch;
  struct handler *handler;


/* Debugging aids.  */

DEFUN ("memory-limit", Fmemory_limit, Smemory_limit, 0, 0, 0,
  doc: /* Return the address of the last byte Emacs has allocated, divided by 1024.
This may be helpful in debugging Emacs's memory usage.
We divide the value by 1024 to make sure it fits in a Lisp integer.  */)
     ()
{
  Lisp_Object end;

  XSETINT (end, (EMACS_INT) sbrk (0) / 1024);

  return end;
}

DEFUN ("memory-use-counts", Fmemory_use_counts, Smemory_use_counts, 0, 0, 0,
  doc: /* Return a list of counters that measure how much consing there has been.
Each of these counters increments for a certain kind of object.
The counters wrap around from the largest positive integer to zero.
Garbage collection does not decrease them.
The elements of the value are as follows:
  (CONSES FLOATS VECTOR-CELLS SYMBOLS STRING-CHARS MISCS INTERVALS STRINGS)
All are in units of 1 = one object consed
except for VECTOR-CELLS and STRING-CHARS, which count the total length of
objects consed.
MISCS include overlays, markers, and some internal types.
Frames, windows, buffers, and subprocesses count as vectors
  (but the contents of a buffer's text do not count here).  */)
     ()
{
  Lisp_Object consed[8];

  consed[0] = make_number (min (MOST_POSITIVE_FIXNUM, cons_cells_consed));
  consed[1] = make_number (min (MOST_POSITIVE_FIXNUM, floats_consed));

}

void
syms_of_alloc ()
{
  DEFVAR_INT ("gc-cons-threshold", &gc_cons_threshold,
    doc: /* *Number of bytes of consing between garbage collections.
Garbage collection can happen automatically once this many bytes have been
allocated since the last garbage collection.  All data types count.

Garbage collection happens automatically only when `eval' is called.

By binding this temporarily to a large number, you can effectively
prevent garbage collection during a part of the program.  */);

  DEFVAR_INT ("pure-bytes-used", &pure_bytes_used,
    doc: /* Number of bytes of sharable Lisp data allocated so far.  */);

  DEFVAR_INT ("cons-cells-consed", &cons_cells_consed,
    doc: /* Number of cons cells that have been consed so far.  */);

  DEFVAR_INT ("floats-consed", &floats_consed,
    doc: /* Number of floats that have been consed so far.  */);

  DEFVAR_INT ("vector-cells-consed", &vector_cells_consed,
    doc: /* Number of vector cells that have been consed so far.  */);

  DEFVAR_INT ("symbols-consed", &symbols_consed,
    doc: /* Number of symbols that have been consed so far.  */);

  DEFVAR_INT ("string-chars-consed", &string_chars_consed,
    doc: /* Number of string characters that have been consed so far.  */);

  DEFVAR_INT ("misc-objects-consed", &misc_objects_consed,
    doc: /* Number of miscellaneous objects that have been consed so far.  */);

  DEFVAR_INT ("intervals-consed", &intervals_consed,
    doc: /* Number of intervals that have been consed so far.  */);

  DEFVAR_INT ("strings-consed", &strings_consed,
    doc: /* Number of strings that have been consed so far.  */);

  DEFVAR_LISP ("purify-flag", &Vpurify_flag,
    doc: /* Non-nil means loading Lisp code in order to dump an executable.
This means that certain objects should be allocated in shared (pure) space.  */);

  DEFVAR_INT ("undo-limit", &undo_limit,
    doc: /* Keep no more undo information once it exceeds this size.
This limit is applied when garbage collection happens.
The size is counted as the number of bytes occupied,
which includes both saved text and other data.  */);
  undo_limit = 20000;

  DEFVAR_INT ("undo-strong-limit", &undo_strong_limit,
    doc: /* Don't keep more than this much size of undo information.
A command which pushes past this size is itself forgotten.
This limit is applied when garbage collection happens.
The size is counted as the number of bytes occupied,
which includes both saved text and other data.  */);
  undo_strong_limit = 30000;

  DEFVAR_BOOL ("garbage-collection-messages", &garbage_collection_messages,
    doc: /* Non-nil means display messages at start and end of garbage collection.  */);
  garbage_collection_messages = 0;

  DEFVAR_LISP ("post-gc-hook", &Vpost_gc_hook,
    doc: /* Hook run after garbage collection has finished.  */);
  Vpost_gc_hook = Qnil;
  Qpost_gc_hook = intern ("post-gc-hook");
  staticpro (&Qpost_gc_hook);

  /* We build this in advance because if we wait until we need it, we might