free_float (ptr)
struct Lisp_Float *ptr;
{
- XSETFASTINT (ptr->type, (EMACS_INT) float_free_list);
+ *(struct Lisp_Float **)&ptr->type = float_free_list;
float_free_list = ptr;
}
if (float_free_list)
{
XSETFLOAT (val, float_free_list);
- float_free_list = (struct Lisp_Float *) XFASTINT (float_free_list->type);
+ float_free_list = *(struct Lisp_Float **)&float_free_list->type;
}
else
{
free_cons (ptr)
struct Lisp_Cons *ptr;
{
- XSETFASTINT (ptr->car, (EMACS_INT) cons_free_list);
+ *(struct Lisp_Cons **)&ptr->car = cons_free_list;
cons_free_list = ptr;
}
if (cons_free_list)
{
XSETCONS (val, cons_free_list);
- cons_free_list = (struct Lisp_Cons *) XFASTINT (cons_free_list->car);
+ cons_free_list = *(struct Lisp_Cons **)&cons_free_list->car;
}
else
{
register Lisp_Object val;
register int size;
- if (!INTEGERP (length) || XINT (length) < 0)
- length = wrong_type_argument (Qnatnump, length);
- size = XINT (length);
+ CHECK_NATNUM (length, 0);
+ size = XFASTINT (length);
val = Qnil;
while (size-- > 0)
struct Lisp_Vector *all_vectors;
+struct Lisp_Vector *
+allocate_vectorlike (len)
+ EMACS_INT len;
+{
+ struct Lisp_Vector *p;
+
+ p = (struct Lisp_Vector *)xmalloc (sizeof (struct Lisp_Vector)
+ + (len - 1) * sizeof (Lisp_Object));
+ VALIDATE_LISP_STORAGE (p, 0);
+ consing_since_gc += (sizeof (struct Lisp_Vector)
+ + (len - 1) * sizeof (Lisp_Object));
+
+ p->next = all_vectors;
+ all_vectors = p;
+ return p;
+}
+
DEFUN ("make-vector", Fmake_vector, Smake_vector, 2, 2, 0,
"Return a newly created vector of length LENGTH, with each element being INIT.\n\
See also the function `vector'.")
(length, init)
register Lisp_Object length, init;
{
- register int sizei, index;
- register Lisp_Object vector;
+ Lisp_Object vector;
+ register EMACS_INT sizei;
+ register int index;
register struct Lisp_Vector *p;
- if (!INTEGERP (length) || XINT (length) < 0)
- length = wrong_type_argument (Qnatnump, length);
- sizei = XINT (length);
-
- p = (struct Lisp_Vector *) xmalloc (sizeof (struct Lisp_Vector) + (sizei - 1) * sizeof (Lisp_Object));
- VALIDATE_LISP_STORAGE (p, 0);
-
- XSETVECTOR (vector, p);
- consing_since_gc += sizeof (struct Lisp_Vector) + (sizei - 1) * sizeof (Lisp_Object);
+ CHECK_NATNUM (length, 0);
+ sizei = XFASTINT (length);
+ p = allocate_vectorlike (sizei);
p->size = sizei;
- p->next = all_vectors;
- all_vectors = p;
-
for (index = 0; index < sizei; index++)
p->contents[index] = init;
+ XSETVECTOR (vector, p);
return vector;
}
args[index] = Fpurecopy (args[index]);
p->contents[index] = args[index];
}
- XSETTYPE (val, Lisp_Compiled);
+ XSETCOMPILED (val, val);
return val;
}
\f
if (symbol_free_list)
{
XSETSYMBOL (val, symbol_free_list);
- symbol_free_list
- = (struct Lisp_Symbol *) XFASTINT (symbol_free_list->value);
+ symbol_free_list = *(struct Lisp_Symbol **)&symbol_free_list->value;
}
else
{
register Lisp_Object val;
register unsigned char *p, *end, c;
- if (!INTEGERP (length) || XINT (length) < 0)
- length = wrong_type_argument (Qnatnump, length);
+ CHECK_NATNUM (length, 0);
CHECK_NUMBER (init, 1);
- val = make_uninit_string (XINT (length));
+ val = make_uninit_string (XFASTINT (length));
c = XINT (init);
p = XSTRING (val)->data;
end = p + XSTRING (val)->size;
(obj)
register Lisp_Object obj;
{
- register Lisp_Object new, tem;
- register int i;
-
if (NILP (Vpurify_flag))
return obj;
&& (PNTR_COMPARISON_TYPE) XPNTR (obj) >= (PNTR_COMPARISON_TYPE) pure)
return obj;
-#ifdef SWITCH_ENUM_BUG
- switch ((int) XTYPE (obj))
-#else
- switch (XTYPE (obj))
-#endif
- {
- case Lisp_Misc:
- switch (XMISC (obj)->type)
- {
- case Lisp_Misc_Marker:
- error ("Attempt to copy a marker to pure storage");
-
- default:
- abort ();
- }
-
- case Lisp_Cons:
- return pure_cons (XCONS (obj)->car, XCONS (obj)->cdr);
-
+ if (CONSP (obj))
+ return pure_cons (XCONS (obj)->car, XCONS (obj)->cdr);
#ifdef LISP_FLOAT_TYPE
- case Lisp_Float:
- return make_pure_float (XFLOAT (obj)->data);
+ else if (FLOATP (obj))
+ return make_pure_float (XFLOAT (obj)->data);
#endif /* LISP_FLOAT_TYPE */
-
- case Lisp_String:
- return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size);
-
- case Lisp_Compiled:
- case Lisp_Vector:
- new = make_pure_vector (XVECTOR (obj)->size);
- for (i = 0; i < XVECTOR (obj)->size; i++)
- {
- tem = XVECTOR (obj)->contents[i];
- XVECTOR (new)->contents[i] = Fpurecopy (tem);
- }
- XSETTYPE (new, XTYPE (obj));
- return new;
-
- default:
+ else if (STRINGP (obj))
+ return make_pure_string (XSTRING (obj)->data, XSTRING (obj)->size);
+ else if (COMPILEDP (obj) || VECTORP (obj))
+ {
+ register struct Lisp_Vector *vec;
+ register int i, size;
+
+ size = XVECTOR (obj)->size;
+ vec = XVECTOR (make_pure_vector (size));
+ for (i = 0; i < size; i++)
+ vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
+ if (COMPILEDP (obj))
+ XSETCOMPILED (obj, vec);
+ else
+ XSETVECTOR (obj, vec);
return obj;
}
+ else if (MARKERP (obj))
+ error ("Attempt to copy a marker to pure storage");
+ else
+ return obj;
}
\f
/* Recording what needs to be marked for gc. */
}
break;
- case Lisp_Vector:
- case Lisp_Window:
- case Lisp_Process:
- case Lisp_Window_Configuration:
- {
- register struct Lisp_Vector *ptr = XVECTOR (obj);
- register EMACS_INT size = ptr->size;
- /* The reason we use ptr1 is to avoid an apparent hardware bug
- that happens occasionally on the FSF's HP 300s.
- The bug is that a2 gets clobbered by recursive calls to mark_object.
- The clobberage seems to happen during function entry,
- perhaps in the moveml instruction.
- Yes, this is a crock, but we have to do it. */
- struct Lisp_Vector *volatile ptr1 = ptr;
- register int i;
-
- if (size & ARRAY_MARK_FLAG) break; /* Already marked */
- ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
- for (i = 0; i < size; i++) /* and then mark its elements */
- mark_object (&ptr1->contents[i]);
- }
- break;
-
- case Lisp_Compiled:
- /* We could treat this just like a vector, but it is better
- to save the COMPILED_CONSTANTS element for last and avoid recursion
- there. */
- {
- register struct Lisp_Vector *ptr = XVECTOR (obj);
- register EMACS_INT size = ptr->size;
- /* See comment above under Lisp_Vector. */
- struct Lisp_Vector *volatile ptr1 = ptr;
- register int i;
-
- if (size & ARRAY_MARK_FLAG) break; /* Already marked */
- ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
- for (i = 0; i < size; i++) /* and then mark its elements */
- {
- if (i != COMPILED_CONSTANTS)
- mark_object (&ptr1->contents[i]);
- }
- /* This cast should be unnecessary, but some Mips compiler complains
- (MIPS-ABI + SysVR4, DC/OSx, etc). */
- objptr = (Lisp_Object *) &ptr1->contents[COMPILED_CONSTANTS];
- goto loop;
- }
-
+ case Lisp_Vectorlike:
+ if (GC_SUBRP (obj))
+ break;
+ else if (GC_COMPILEDP (obj))
+ /* We could treat this just like a vector, but it is better
+ to save the COMPILED_CONSTANTS element for last and avoid recursion
+ there. */
+ {
+ register struct Lisp_Vector *ptr = XVECTOR (obj);
+ register EMACS_INT size = ptr->size;
+ /* See comment above under Lisp_Vector. */
+ struct Lisp_Vector *volatile ptr1 = ptr;
+ register int i;
+
+ if (size & ARRAY_MARK_FLAG)
+ break; /* Already marked */
+ ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
+ size &= PSEUDOVECTOR_SIZE_MASK;
+ for (i = 0; i < size; i++) /* and then mark its elements */
+ {
+ if (i != COMPILED_CONSTANTS)
+ mark_object (&ptr1->contents[i]);
+ }
+ /* This cast should be unnecessary, but some Mips compiler complains
+ (MIPS-ABI + SysVR4, DC/OSx, etc). */
+ objptr = (Lisp_Object *) &ptr1->contents[COMPILED_CONSTANTS];
+ goto loop;
+ }
#ifdef MULTI_FRAME
- case Lisp_Frame:
- {
- /* See comment above under Lisp_Vector for why this is volatile. */
- register struct frame *volatile ptr = XFRAME (obj);
- register EMACS_INT size = ptr->size;
-
- if (size & ARRAY_MARK_FLAG) break; /* Already marked */
- ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
-
- mark_object (&ptr->name);
- mark_object (&ptr->focus_frame);
- mark_object (&ptr->width);
- mark_object (&ptr->height);
- mark_object (&ptr->selected_window);
- mark_object (&ptr->minibuffer_window);
- mark_object (&ptr->param_alist);
- mark_object (&ptr->scroll_bars);
- mark_object (&ptr->condemned_scroll_bars);
- mark_object (&ptr->menu_bar_items);
- mark_object (&ptr->menu_bar_vector);
- mark_object (&ptr->face_alist);
- }
- break;
+ else if (GC_FRAMEP (obj))
+ {
+ /* See comment above under Lisp_Vector for why this is volatile. */
+ register struct frame *volatile ptr = XFRAME (obj);
+ register EMACS_INT size = ptr->size;
+
+ if (size & ARRAY_MARK_FLAG) break; /* Already marked */
+ ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
+
+ mark_object (&ptr->name);
+ mark_object (&ptr->focus_frame);
+ mark_object (&ptr->selected_window);
+ mark_object (&ptr->minibuffer_window);
+ mark_object (&ptr->param_alist);
+ mark_object (&ptr->scroll_bars);
+ mark_object (&ptr->condemned_scroll_bars);
+ mark_object (&ptr->menu_bar_items);
+ mark_object (&ptr->face_alist);
+ mark_object (&ptr->menu_bar_vector);
+ mark_object (&ptr->buffer_predicate);
+ }
+ else
#endif /* MULTI_FRAME */
+ {
+ register struct Lisp_Vector *ptr = XVECTOR (obj);
+ register EMACS_INT size = ptr->size;
+ /* The reason we use ptr1 is to avoid an apparent hardware bug
+ that happens occasionally on the FSF's HP 300s.
+ The bug is that a2 gets clobbered by recursive calls to mark_object.
+ The clobberage seems to happen during function entry,
+ perhaps in the moveml instruction.
+ Yes, this is a crock, but we have to do it. */
+ struct Lisp_Vector *volatile ptr1 = ptr;
+ register int i;
+
+ if (size & ARRAY_MARK_FLAG) break; /* Already marked */
+ ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
+ if (size & PSEUDOVECTOR_FLAG)
+ size &= PSEUDOVECTOR_SIZE_MASK;
+ for (i = 0; i < size; i++) /* and then mark its elements */
+ mark_object (&ptr1->contents[i]);
+ }
+ break;
case Lisp_Symbol:
{
are protected with staticpro. */
break;
+ case Lisp_Misc_Overlay:
+ {
+ struct Lisp_Overlay *ptr = XOVERLAY (obj);
+ if (!XMARKBIT (ptr->plist))
+ {
+ XMARK (ptr->plist);
+ mark_object (&ptr->start);
+ mark_object (&ptr->end);
+ objptr = &ptr->plist;
+ goto loop;
+ }
+ }
+ break;
+
default:
abort ();
}
break;
case Lisp_Cons:
- case Lisp_Overlay:
{
register struct Lisp_Cons *ptr = XCONS (obj);
if (XMARKBIT (ptr->car)) break;
break;
case Lisp_Int:
- case Lisp_Subr:
break;
default:
for (i = 0; i < lim; i++)
if (!XMARKBIT (cblk->conses[i].car))
{
- XSETFASTINT (cblk->conses[i].car, (EMACS_INT) cons_free_list);
num_free++;
+ *(struct Lisp_Cons **)&cblk->conses[i].car = cons_free_list;
cons_free_list = &cblk->conses[i];
}
else
for (i = 0; i < lim; i++)
if (!XMARKBIT (fblk->floats[i].type))
{
- XSETFASTINT (fblk->floats[i].type, (EMACS_INT) float_free_list);
num_free++;
+ *(struct Lisp_Float **)&fblk->floats[i].type = float_free_list;
float_free_list = &fblk->floats[i];
}
else
for (i = 0; i < lim; i++)
if (!XMARKBIT (sblk->symbols[i].plist))
{
- XSETFASTINT (sblk->symbols[i].value, (EMACS_INT) symbol_free_list);
+ *(struct Lisp_Symbol **)&sblk->symbols[i].value = symbol_free_list;
symbol_free_list = &sblk->symbols[i];
num_free++;
}
case Lisp_Misc_Some_Buffer_Local_Value:
markword = &mblk->markers[i].u_buffer_local_value.car;
break;
+ case Lisp_Misc_Overlay:
+ markword = &mblk->markers[i].u_overlay.plist;
+ break;
default:
markword = 0;
+ break;
}
if (markword && !XMARKBIT (*markword))
{