if (putenv ((char *) string) != 0)
memory_full (0);
}
-
-/* Return a newly allocated memory block of SIZE bytes, remembering
- to free it when unwinding. */
-void *
-record_xmalloc (size_t size)
-{
- void *p = xmalloc (size);
- record_unwind_protect_ptr (xfree, p);
- return p;
-}
\f
/***********************************************************************
Interval Allocation
/* Return a new Lisp_String. */
-static struct Lisp_String *
+static Lisp_Object
allocate_string (void)
{
- struct Lisp_String *p;
-
- p = xmalloc (sizeof *p);
- SCM_NEWSMOB (p->self, lisp_string_tag, p);
- return p;
+ return scm_make_smob (lisp_string_tag);
}
S->data if it was initially non-null. */
void
-allocate_string_data (struct Lisp_String *s,
+allocate_string_data (Lisp_Object string,
EMACS_INT nchars, EMACS_INT nbytes)
{
+ struct Lisp_String *s = (void *) SCM_SMOB_DATA (string);
unsigned char *data;
if (STRING_BYTES_BOUND < nbytes)
make_empty_string (int multibyte)
{
Lisp_Object string;
- struct Lisp_String *s;
- s = allocate_string ();
- allocate_string_data (s, 0, 0);
- XSETSTRING (string, s);
+ string = allocate_string ();
+ allocate_string_data (string, 0, 0);
if (! multibyte)
STRING_SET_UNIBYTE (string);
make_uninit_multibyte_string (EMACS_INT nchars, EMACS_INT nbytes)
{
Lisp_Object string;
- struct Lisp_String *s;
if (nchars < 0)
emacs_abort ();
if (!nbytes)
return empty_multibyte_string;
- s = allocate_string ();
- s->intervals = NULL;
- allocate_string_data (s, nchars, nbytes);
- XSETSTRING (string, s);
+ string = allocate_string ();
+ ((struct Lisp_String *) SCM_SMOB_DATA (string))->intervals = NULL;
+ allocate_string_data (string, nchars, nbytes);
return string;
}
Symbol Allocation
***********************************************************************/
-static void
-set_symbol_name (Lisp_Object sym, Lisp_Object name)
-{
- XSYMBOL (sym)->name = name;
-}
-
DEFUN ("make-symbol", Fmake_symbol, Smake_symbol, 1, 1, 0,
doc: /* Return a newly allocated uninterned symbol whose name is NAME.
Its value is void, and its function definition and property list are nil. */)
(Lisp_Object name)
{
register Lisp_Object val;
- register struct Lisp_Symbol *p;
CHECK_STRING (name);
- p = xmalloc (sizeof *p);
- SCM_NEWSMOB (p->self, lisp_symbol_tag, p);
- XSETSYMBOL (val, p);
- p = XSYMBOL (val);
- set_symbol_name (val, name);
- set_symbol_plist (val, Qnil);
- p->redirect = SYMBOL_PLAINVAL;
- SET_SYMBOL_VAL (p, Qunbound);
- set_symbol_function (val, Qnil);
- set_symbol_next (val, NULL);
- p->interned = SYMBOL_UNINTERNED;
- p->constant = 0;
- p->declared_special = false;
- p->pinned = false;
+ val = scm_make_symbol (scm_from_utf8_stringn (SSDATA (name),
+ SBYTES (name)));
return val;
}
\f
/* Initialization. */
+static int
+print_lisp_string (SCM obj, SCM port, scm_print_state *pstate)
+{
+ scm_c_write (port, "#<elisp-string \"", 16);
+ scm_c_write (port, XSTRING (obj)->data, STRING_BYTES (XSTRING (obj)));
+ scm_c_write (port, "\">", 2);
+ return 0;
+}
+
void
init_alloc_once (void)
{
- lisp_symbol_tag = scm_make_smob_type ("elisp-symbol", 0);
lisp_misc_tag = scm_make_smob_type ("elisp-misc", 0);
- lisp_string_tag = scm_make_smob_type ("elisp-string", 0);
+ lisp_string_tag = scm_make_smob_type ("elisp-string",
+ sizeof (struct Lisp_String));
+ scm_set_smob_print (lisp_string_tag, print_lisp_string);
lisp_vectorlike_tag = scm_make_smob_type ("elisp-vectorlike", 0);
/* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet! */
void
syms_of_alloc (void)
{
+#include "alloc.x"
+
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
The time is in seconds as a floating point value. */);
DEFVAR_INT ("gcs-done", gcs_done,
doc: /* Accumulated number of garbage collections done. */);
-
- defsubr (&Scons);
- defsubr (&Slist);
- defsubr (&Svector);
- defsubr (&Sbool_vector);
- defsubr (&Smake_byte_code);
- defsubr (&Smake_list);
- defsubr (&Smake_vector);
- defsubr (&Smake_string);
- defsubr (&Smake_bool_vector);
- defsubr (&Smake_symbol);
- defsubr (&Smake_marker);
- defsubr (&Spurecopy);
- defsubr (&Sgarbage_collect);
}
/* When compiled with GCC, GDB might say "No enum type named