dynwind fixes

[bpt/emacs.git] / src / alloc.c

diff --git a/src/alloc.c b/src/alloc.c
index 648e3f7..e64bc37 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -414,16 +414,6 @@ xputenv (char const *string)
   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
@@ -454,14 +444,10 @@ init_strings (void)
 
 /* 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);
 }
 
 
@@ -472,9 +458,10 @@ allocate_string (void)
    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)
@@ -497,11 +484,9 @@ static Lisp_Object
 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);
 
@@ -744,17 +729,15 @@ Lisp_Object
 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;
 }
 
@@ -795,15 +778,7 @@ DEFUN ("cons", Fcons, Scons, 2, 2, 0,
        doc: /* Create a new cons, give it CAR and CDR as components, and return it.  */)
   (Lisp_Object car, Lisp_Object cdr)
 {
-  register Lisp_Object val;
-  struct Lisp_Cons *p;
-
-  p = xmalloc (sizeof *p);
-  SCM_NEWSMOB (p->self, lisp_cons_tag, p);
-  XSETCONS (val, p);
-  XSETCAR (val, car);
-  XSETCDR (val, cdr);
-  return val;
+  return scm_cons (car, cdr);
 }
 
 /* Make a list of 1, 2, 3, 4 or 5 specified objects.  */
@@ -1183,36 +1158,17 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
                           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;
 }
 
@@ -1654,14 +1610,23 @@ die (const char *msg, const char *file, int line)
 \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);
-  lisp_cons_tag = scm_make_smob_type ("elisp-cons", 0);
 
   /* Used to do Vpurify_flag = Qt here, but Qt isn't set up yet!  */
 
@@ -1687,6 +1652,8 @@ init_alloc (void)
 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
@@ -1743,20 +1710,6 @@ do hash-consing of the objects allocated to pure space.  */);
 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