X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/1d59fbe3acd419e1139ced2af433d50012942e31..8bc3ef5f21fd83216349fba54e3ba13ebd73828c:/src/alloc.c

diff --git a/src/alloc.c b/src/alloc.c
index be38f3edf7..7d7308b893 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -444,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);
 }
 
 
@@ -462,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)
@@ -487,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);
 
@@ -734,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;
 }
 
@@ -1165,30 +1158,6 @@ 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;
-}
-
-void
-initialize_symbol (Lisp_Object val, Lisp_Object name)
-{
-  struct Lisp_Symbol *p = xmalloc (sizeof *p);
-
-  scm_module_define (symbol_module, val, scm_from_pointer (p, NULL));
-  p = XSYMBOL (val);
-  p->self = val;
-  set_symbol_name (val, name);
-  set_symbol_plist (val, Qnil);
-  p->redirect = SYMBOL_PLAINVAL;
-  SET_SYMBOL_VAL (p, Qunbound);
-  scm_module_define (function_module, val, Qnil);
-  p->interned = SYMBOL_UNINTERNED;
-  p->constant = 0;
-  p->declared_special = false;
-}
-
 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.  */)
@@ -1200,7 +1169,6 @@ Its value is void, and its function definition and property list are nil.  */)
 
   val = scm_make_symbol (scm_from_utf8_stringn (SSDATA (name),
                                                 SBYTES (name)));
-  initialize_symbol (val, name);
   return val;
 }
 
@@ -1642,11 +1610,26 @@ die (const char *msg, const char *file, int line)
 
 /* 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;
+}
+
+scm_t_bits lisp_misc_tag;
+scm_t_bits lisp_string_tag;
+scm_t_bits lisp_vectorlike_tag;
+
 void
 init_alloc_once (void)
 {
   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!  */