Commit 1f0b3fd2 authored by Gerd Moellmann's avatar Gerd Moellmann
Browse files

(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.
parent 68c5d1db
2000-10-17 Gerd Moellmann <gerd@gnu.org>
* alloc.c (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.
* xdisp.c (try_cursor_movement): Use cursor_row_p also when
PT has moved backward.
......
......@@ -215,7 +215,7 @@ EMACS_INT pure_size;
/* Index in pure at which next pure object will be allocated.. */
int pureptr;
int pure_bytes_used;
/* If nonzero, this is a warning delivered by malloc and not yet
displayed. */
......@@ -318,6 +318,28 @@ static void check_gcpros P_ ((void));
#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
......@@ -3320,6 +3342,44 @@ mark_stack ()
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.
......@@ -3336,29 +3396,14 @@ make_pure_string (data, nchars, nbytes, 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 = (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;
}
......@@ -3372,11 +3417,10 @@ pure_cons (car, cdr)
Lisp_Object car, cdr;
{
register Lisp_Object new;
struct Lisp_Cons *p;
if (pureptr + sizeof (struct Lisp_Cons) > PURESIZE)
error ("Pure Lisp storage exhausted");
XSETCONS (new, PUREBEG + pureptr);
pureptr += sizeof (struct Lisp_Cons);
p = (struct Lisp_Cons *) pure_alloc (sizeof *p, Lisp_Cons);
XSETCONS (new, p);
XCAR (new) = Fpurecopy (car);
XCDR (new) = Fpurecopy (cdr);
return new;
......@@ -3390,34 +3434,11 @@ make_pure_float (num)
double num;
{
register Lisp_Object new;
struct Lisp_Float *p;
/* 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);
p = (struct Lisp_Float *) pure_alloc (sizeof *p, Lisp_Float);
XSETFLOAT (new, p);
XFLOAT_DATA (new) = num;
XSETFASTINT (XFLOAT (new)->type, 0); /* bug chasing -wsr */
return new;
}
......@@ -3429,15 +3450,12 @@ 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");
Lisp_Object new;
struct Lisp_Vector *p;
size_t size = sizeof *p + (len - 1) * sizeof (Lisp_Object);
XSETVECTOR (new, PUREBEG + pureptr);
pureptr += size;
p = (struct Lisp_Vector *) pure_alloc (size, Lisp_Vectorlike);
XSETVECTOR (new, p);
XVECTOR (new)->size = len;
return new;
}
......@@ -3453,8 +3471,7 @@ Does not copy symbols. Copies strings without text properties.")
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)
if (PURE_POINTER_P (XPNTR (obj)))
return obj;
if (CONSP (obj))
......@@ -3494,20 +3511,6 @@ Does not copy symbols. Copies strings without text properties.")
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. */
......@@ -3933,7 +3936,7 @@ mark_object (argptr)
loop2:
XUNMARK (obj);
if (PURE_POINTER_P ((PNTR_COMPARISON_TYPE) XPNTR (obj)))
if (PURE_POINTER_P (XPNTR (obj)))
return;
last_marked[last_marked_index++] = objptr;
......@@ -4903,7 +4906,7 @@ void
init_alloc_once ()
{
/* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
pureptr = 0;
pure_bytes_used = 0;
#if GC_MARK_STACK
mem_init ();
Vdead = make_pure_string ("DEAD", 4, 4, 0);
......@@ -4968,7 +4971,7 @@ 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,
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,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment