static void clear_marks (), gc_sweep ();
static void compact_strings ();
\f
+/* Versions of malloc and realloc that print warnings as memory gets full. */
+
Lisp_Object
malloc_warning_1 (str)
Lisp_Object str;
return val;
}
\f
+/* Interval allocation. */
+
#ifdef USE_TEXT_PROPERTIES
#define INTERVAL_BLOCK_SIZE \
((1020 - sizeof (struct interval_block *)) / sizeof (struct interval))
/* Mark the pointers of one interval. */
static void
-mark_interval (i)
+mark_interval (i, dummy)
register INTERVAL i;
+ Lisp_Object dummy;
{
if (XMARKBIT (i->plist))
abort ();
if (XMARKBIT (tree->plist))
return;
- traverse_intervals (tree, 1, 0, &mark_interval);
+ traverse_intervals (tree, 1, 0, mark_interval, Qnil);
}
#define MARK_INTERVAL_TREE(i) \
{ if (!NULL_INTERVAL_P (i)) mark_interval_tree (i); }
-#define UNMARK_BALANCE_INTERVALS(i) \
-{ \
- if (! NULL_INTERVAL_P (i)) \
- { \
- XUNMARK ((Lisp_Object) (i->parent)); \
- i = balance_intervals (i); \
- } \
+/* The oddity in the call to XUNMARK is necessary because XUNMARK
+ expands to an assigment to its argument, and most C compilers don't
+ support casts on the left operand of `='. */
+#define UNMARK_BALANCE_INTERVALS(i) \
+{ \
+ if (! NULL_INTERVAL_P (i)) \
+ { \
+ XUNMARK (* (Lisp_Object *) (&(i)->parent)); \
+ (i) = balance_intervals (i); \
+ } \
}
#else /* no interval use */
#endif /* no interval use */
\f
+/* Floating point allocation. */
+
#ifdef LISP_FLOAT_TYPE
/* Allocation of float cells, just like conses */
/* We store float cells inside of float_blocks, allocating a new
}
/* Return a newly created vector or string with specified arguments as
- elements. If all the arguments are characters, make a string;
- otherwise, make a vector. Any number of arguments, even zero
- arguments, are allowed. */
+ elements. If all the arguments are characters that can fit
+ in a string of events, make a string; otherwise, make a vector.
+
+ Any number of arguments, even zero arguments, are allowed. */
Lisp_Object
-make_array (nargs, args)
+make_event_array (nargs, args)
register int nargs;
Lisp_Object *args;
{
int i;
for (i = 0; i < nargs; i++)
+ /* The things that fit in a string
+ are characters that are in 0...127 after discarding the meta bit. */
if (XTYPE (args[i]) != Lisp_Int
- || (unsigned) XINT (args[i]) >= 0400)
+ || (XUINT (args[i]) & ~CHAR_META) >= 0200)
return Fvector (nargs, args);
/* Since the loop exited, we know that all the things in it are
Lisp_Object result = Fmake_string (nargs, make_number (0));
for (i = 0; i < nargs; i++)
- XSTRING (result)->data[i] = XINT (args[i]);
+ {
+ XSTRING (result)->data[i] = XINT (args[i]);
+ /* Move the meta bit to the right place for a string char. */
+ if (XINT (args[i]) & CHAR_META)
+ XSTRING (result)->data[i] |= 0x80;
+ }
return result;
}
}
\f
-/* Note: the user cannot manipulate ropes portably by referring
- to the chars of the string, because combining two chars to make a GLYPH
- depends on endianness. */
-
-DEFUN ("make-rope", Fmake_rope, Smake_rope, 0, MANY, 0,
- "Return a newly created rope containing the arguments of this function.\n\
-A rope is a string, except that its contents will be treated as an\n\
-array of glyphs, where a glyph is an integer type that may be larger\n\
-than a character. Emacs is normally configured to use 8-bit glyphs,\n\
-so ropes are normally no different from strings. But Emacs may be\n\
-configured to use 16-bit glyphs, to allow the use of larger fonts.\n\
-\n\
-Each argument (which must be an integer) specifies one glyph, whatever\n\
-size glyphs may be.\n\
-\n\
-See variable `buffer-display-table' for the uses of ropes.")
- (nargs, args)
- register int nargs;
- Lisp_Object *args;
-{
- register int i;
- register Lisp_Object val;
- register GLYPH *p;
+/* Pure storage management. */
- val = make_uninit_string (nargs * sizeof (GLYPH));
-
- p = (GLYPH *) XSTRING (val)->data;
- for (i = 0; i < nargs; i++)
- {
- CHECK_NUMBER (args[i], i);
- p[i] = XFASTINT (args[i]);
- }
- return val;
-}
-
-DEFUN ("rope-elt", Frope_elt, Srope_elt, 2, 2, 0,
- "Return an element of rope R at index N.\n\
-A rope is a string in which each pair of bytes is considered an element.\n\
-See variable `buffer-display-table' for the uses of ropes.")
- (r, n)
- Lisp_Object r, n;
-{
- CHECK_STRING (r, 0);
- CHECK_NUMBER (n, 1);
- if ((XSTRING (r)->size / sizeof (GLYPH)) <= XINT (n) || XINT (n) < 0)
- args_out_of_range (r, n);
- return ((GLYPH *) XSTRING (r)->data)[XFASTINT (n)];
-}
-\f
/* Must get an error if pure storage is full,
since if it cannot hold a large string
it may be able to hold conses that point to that string;
{
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. */
+ {
+ int 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");
XSET (new, Lisp_Float, PUREBEG + pureptr);
you lose
#endif
\f
+/* Garbage collection! */
+
int total_conses, total_markers, total_symbols, total_string_size, total_vector_size;
int total_free_conses, total_free_markers, total_free_symbols;
#ifdef LISP_FLOAT_TYPE
}
#endif
\f
-/* Mark reference to a Lisp_Object. If the object referred to
- has not been seen yet, recursively mark all the references contained in it.
+/* Mark reference to a Lisp_Object.
+ If the object referred to has not been seen yet, recursively mark
+ all the references contained in it.
If the object referenced is a short string, the referrencing slot
is threaded into a chain of such slots, pointed to from
{
register struct frame *ptr = XFRAME (obj);
register int size = ptr->size;
- register int i;
if (size & ARRAY_MARK_FLAG) break; /* Already marked */
ptr->size |= ARRAY_MARK_FLAG; /* Else mark it */
mark_object (&ptr->selected_window);
mark_object (&ptr->minibuffer_window);
mark_object (&ptr->param_alist);
- mark_object (&ptr->scrollbars);
- mark_object (&ptr->condemned_scrollbars);
+ mark_object (&ptr->scroll_bars);
+ mark_object (&ptr->condemned_scroll_bars);
+ mark_object (&ptr->menu_bar_items);
}
break;
-#endif /* not MULTI_FRAME */
+#endif /* MULTI_FRAME */
case Lisp_Symbol:
{
mark_buffer (buf)
Lisp_Object buf;
{
- Lisp_Object tem;
register struct buffer *buffer = XBUFFER (buf);
register Lisp_Object *ptr;
mark_object (ptr);
}
\f
-/* Find all structures not marked, and free them. */
+/* Sweep: find all structures not marked, and free them. */
static void
gc_sweep ()
}
}
\f
-/* Compactify strings, relocate references to them, and
- free any string blocks that become empty. */
+/* Compactify strings, relocate references, and free empty string blocks. */
static void
compact_strings ()
DEFUN ("memory-limit", Fmemory_limit, Smemory_limit, 0, 0, "",
"Return the address of the last byte Emacs has allocated, divided by 1024.\n\
This may be helpful in debugging Emacs's memory usage.\n\
-The value is divided by 1024 to make sure it will fit in a lisp integer.")
+We divide the value by 1024 to make sure it fits in a Lisp integer.")
()
{
Lisp_Object end;
defsubr (&Smake_list);
defsubr (&Smake_vector);
defsubr (&Smake_string);
- defsubr (&Smake_rope);
- defsubr (&Srope_elt);
defsubr (&Smake_symbol);
defsubr (&Smake_marker);
defsubr (&Spurecopy);
HCoop / bpt / emacs.git / blobdiff