comparison src/alloc.c @ 32594:e0646c73bf81

(pure_bytes_used): Renamed from pureptr. (ALIGN): New macro. (pure_alloc): New function. (make_pure_string, pure_cons, make_pure_float, make_pure_vector): Use it. (Fpurecopy): Use PURE_POINTER_P.

32593:326836fbd4aa

      && ((PNTR_COMPARISON_TYPE) (P)				\
	  >= (PNTR_COMPARISON_TYPE) pure))

/* Index in pure at which next pure object will be allocated.. */

int pureptr;

/* If nonzero, this is a warning delivered by malloc and not yet
   displayed.  */

char *pending_malloc_warning;

#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
static void check_gcpros P_ ((void));
#endif

#endif /* GC_MARK_STACK != 0 */


/************************************************************************
				Malloc
 ************************************************************************/


/***********************************************************************
		       Pure Storage Management
 ***********************************************************************/

/* Return a string allocated in pure space.  DATA is a buffer holding
   NCHARS characters, and NBYTES bytes of string data.  MULTIBYTE
   non-zero means make the result string multibyte.

   Must get an error if pure storage is full, since if it cannot hold

     int nchars, nbytes;
     int multibyte;
{
  Lisp_Object string;
  struct Lisp_String *s;
  int string_size, data_size;

#define PAD(SZ) (((SZ) + sizeof (EMACS_INT) - 1) & ~(sizeof (EMACS_INT) - 1))

  string_size = PAD (sizeof (struct Lisp_String));
  data_size = PAD (nbytes + 1);

#undef PAD
  
  if (pureptr + string_size + data_size > PURESIZE)
    error ("Pure Lisp storage exhausted");

  s = (struct Lisp_String *) (PUREBEG + pureptr);
  pureptr += string_size;
  s->data = (unsigned char *) (PUREBEG + pureptr);
  pureptr += data_size;
  
  s->size = nchars;
  s->size_byte = multibyte ? nbytes : -1;
  bcopy (data, s->data, nbytes);
  s->data[nbytes] = '\0';
  s->intervals = NULL_INTERVAL;
  
  XSETSTRING (string, s);
  return string;
}

Lisp_Object
pure_cons (car, cdr)
     Lisp_Object car, cdr;
{
  register Lisp_Object new;

  if (pureptr + sizeof (struct Lisp_Cons) > PURESIZE)
    error ("Pure Lisp storage exhausted");
  XSETCONS (new, PUREBEG + pureptr);
  pureptr += sizeof (struct Lisp_Cons);
  XCAR (new) = Fpurecopy (car);
  XCDR (new) = Fpurecopy (cdr);
  return new;
}

Lisp_Object
make_pure_float (num)
     double num;
{
  register Lisp_Object new;

  /* Make sure that PUREBEG + pureptr is aligned on at least a sizeof
     (double) boundary.  Some architectures (like the sparc) require
     this, and I suspect that floats are rare enough that it's no
     tragedy for those that do.  */
  {
    size_t alignment;
    char *p = PUREBEG + pureptr;

#ifdef __GNUC__
#if __GNUC__ >= 2
    alignment = __alignof (struct Lisp_Float);
#else
    alignment = sizeof (struct Lisp_Float);
#endif
#else
    alignment = sizeof (struct Lisp_Float);
#endif  
    p = (char *) (((unsigned long) p + alignment - 1) & - alignment);
    pureptr = p - PUREBEG;
  }

  if (pureptr + sizeof (struct Lisp_Float) > PURESIZE)
    error ("Pure Lisp storage exhausted");
  XSETFLOAT (new, PUREBEG + pureptr);
  pureptr += sizeof (struct Lisp_Float);
  XFLOAT_DATA (new) = num;
  XSETFASTINT (XFLOAT (new)->type, 0);	/* bug chasing -wsr */
  return new;
}


/* Return a vector with room for LEN Lisp_Objects allocated from

Lisp_Object
make_pure_vector (len)
     EMACS_INT len;
{
  register Lisp_Object new;
  register EMACS_INT size = (sizeof (struct Lisp_Vector)
			     + (len - 1) * sizeof (Lisp_Object));

  if (pureptr + size > PURESIZE)
    error ("Pure Lisp storage exhausted");

  XSETVECTOR (new, PUREBEG + pureptr);
  pureptr += size;
  XVECTOR (new)->size = len;
  return new;
}

     register Lisp_Object obj;
{
  if (NILP (Vpurify_flag))
    return obj;

  if ((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE)
      && (PNTR_COMPARISON_TYPE) XPNTR (obj) >= (PNTR_COMPARISON_TYPE) pure)
    return obj;

  if (CONSP (obj))
    return pure_cons (XCAR (obj), XCDR (obj));
  else if (FLOATP (obj))


/***********************************************************************
			  Protection from GC
 ***********************************************************************/

/* Recording what needs to be marked for gc.  */

struct gcpro *gcprolist;

/* Addresses of staticpro'd variables.  */

#define NSTATICS 1024
Lisp_Object *staticvec[NSTATICS] = {0};

/* Index of next unused slot in staticvec.  */

int staticidx = 0;


/* Put an entry in staticvec, pointing at the variable with address
   VARADDRESS.  */

void

 loop:
  obj = *objptr;
 loop2:
  XUNMARK (obj);

  if (PURE_POINTER_P ((PNTR_COMPARISON_TYPE) XPNTR (obj)))
    return;

  last_marked[last_marked_index++] = objptr;
  if (last_marked_index == LAST_MARKED_SIZE)
    last_marked_index = 0;

void
init_alloc_once ()
{
  /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet!  */
  pureptr = 0;
#if GC_MARK_STACK
  mem_init ();
  Vdead = make_pure_string ("DEAD", 4, 4, 0);
#endif
#ifdef HAVE_SHM

allocated since the last garbage collection.  All data types count.\n\n\
Garbage collection happens automatically only when `eval' is called.\n\n\
By binding this temporarily to a large number, you can effectively\n\
prevent garbage collection during a part of the program.");

  DEFVAR_INT ("pure-bytes-used", &pureptr,
    "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.");

32594:e0646c73bf81

      && ((PNTR_COMPARISON_TYPE) (P)				\
	  >= (PNTR_COMPARISON_TYPE) pure))

/* Index in pure at which next pure object will be allocated.. */

int pure_bytes_used;

/* If nonzero, this is a warning delivered by malloc and not yet
   displayed.  */

char *pending_malloc_warning;

#if GC_MARK_STACK == GC_MARK_STACK_CHECK_GCPROS
static void check_gcpros P_ ((void));
#endif

#endif /* GC_MARK_STACK != 0 */

/* Recording what needs to be marked for gc.  */

struct gcpro *gcprolist;

/* Addresses of staticpro'd variables.  */

#define NSTATICS 1024
Lisp_Object *staticvec[NSTATICS] = {0};

/* Index of next unused slot in staticvec.  */

int staticidx = 0;

static POINTER_TYPE *pure_alloc P_ ((size_t, int));


/* Value is SZ rounded up to the next multiple of ALIGNMENT.
   ALIGNMENT must be a power of 2.  */

#define ALIGN(SZ, ALIGNMENT) \
  (((SZ) + (ALIGNMENT) - 1) & ~((ALIGNMENT) - 1))


/************************************************************************
				Malloc
 ************************************************************************/


/***********************************************************************
		       Pure Storage Management
 ***********************************************************************/

/* Allocate room for SIZE bytes from pure Lisp storage and return a
   pointer to it.  TYPE is the Lisp type for which the memory is
   allocated.  TYPE < 0 means it's not used for a Lisp object.

   If store_pure_type_info is set and TYPE is >= 0, the type of
   the allocated object is recorded in pure_types.  */

static POINTER_TYPE *
pure_alloc (size, type)
     size_t size;
     int type;
{
  size_t nbytes;
  POINTER_TYPE *result;
  char *beg = PUREBEG;

  /* Give Lisp_Floats an extra alignment.  */
  if (type == Lisp_Float)
    {
      size_t alignment;
#if defined __GNUC__ && __GNUC__ >= 2
      alignment = __alignof (struct Lisp_Float);
#else
      alignment = sizeof (struct Lisp_Float);
#endif
      pure_bytes_used = ALIGN (pure_bytes_used, alignment);
    }
    
  nbytes = ALIGN (size, sizeof (EMACS_INT));
  if (pure_bytes_used + nbytes > PURESIZE)
    error ("Pure Lisp storage exhausted");

  result = (POINTER_TYPE *) (beg + pure_bytes_used);
  pure_bytes_used += nbytes;
  return result;
}


/* Return a string allocated in pure space.  DATA is a buffer holding
   NCHARS characters, and NBYTES bytes of string data.  MULTIBYTE
   non-zero means make the result string multibyte.

   Must get an error if pure storage is full, since if it cannot hold

     int nchars, nbytes;
     int multibyte;
{
  Lisp_Object string;
  struct Lisp_String *s;

  s = (struct Lisp_String *) pure_alloc (sizeof *s, Lisp_String);
  s->data = (unsigned char *) pure_alloc (nbytes + 1, -1);
  s->size = nchars;
  s->size_byte = multibyte ? nbytes : -1;
  bcopy (data, s->data, nbytes);
  s->data[nbytes] = '\0';
  s->intervals = NULL_INTERVAL;
  XSETSTRING (string, s);
  return string;
}

Lisp_Object
pure_cons (car, cdr)
     Lisp_Object car, cdr;
{
  register Lisp_Object new;
  struct Lisp_Cons *p;

  p = (struct Lisp_Cons *) pure_alloc (sizeof *p, Lisp_Cons);
  XSETCONS (new, p);
  XCAR (new) = Fpurecopy (car);
  XCDR (new) = Fpurecopy (cdr);
  return new;
}

Lisp_Object
make_pure_float (num)
     double num;
{
  register Lisp_Object new;
  struct Lisp_Float *p;

  p = (struct Lisp_Float *) pure_alloc (sizeof *p, Lisp_Float);
  XSETFLOAT (new, p);
  XFLOAT_DATA (new) = num;
  return new;
}


/* Return a vector with room for LEN Lisp_Objects allocated from

Lisp_Object
make_pure_vector (len)
     EMACS_INT len;
{
  Lisp_Object new;
  struct Lisp_Vector *p;
  size_t size = sizeof *p + (len - 1) * sizeof (Lisp_Object);

  p = (struct Lisp_Vector *) pure_alloc (size, Lisp_Vectorlike);
  XSETVECTOR (new, p);
  XVECTOR (new)->size = len;
  return new;
}

     register Lisp_Object obj;
{
  if (NILP (Vpurify_flag))
    return obj;

  if (PURE_POINTER_P (XPNTR (obj)))
    return obj;

  if (CONSP (obj))
    return pure_cons (XCAR (obj), XCDR (obj));
  else if (FLOATP (obj))


/***********************************************************************
			  Protection from GC
 ***********************************************************************/

/* Put an entry in staticvec, pointing at the variable with address
   VARADDRESS.  */

void

 loop:
  obj = *objptr;
 loop2:
  XUNMARK (obj);

  if (PURE_POINTER_P (XPNTR (obj)))
    return;

  last_marked[last_marked_index++] = objptr;
  if (last_marked_index == LAST_MARKED_SIZE)
    last_marked_index = 0;

void
init_alloc_once ()
{
  /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet!  */
  pure_bytes_used = 0;
#if GC_MARK_STACK
  mem_init ();
  Vdead = make_pure_string ("DEAD", 4, 4, 0);
#endif
#ifdef HAVE_SHM

allocated since the last garbage collection.  All data types count.\n\n\
Garbage collection happens automatically only when `eval' is called.\n\n\
By binding this temporarily to a large number, you can effectively\n\
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.");