use guile conses

* src/alloc.c (Fcons): Use `scm_cons'.

* src/lisp.h (lisp_cons_tag, XCONS, XSETCONS, struct Lisp_Cons)
  (XCAR_AS_LVALUE, XCDR_AS_LVALUE): Remove.

  (XCAR): Use `scm_car'.
  (XCDR): Use` scm_cdr'.
  (XSETCAR): Use `scm_set_car_x'.
  (XSETCDR): Use `scm_set_cdr_x'.
  (CONSP): Use `scm_is_pair'.

* src/undo.c (truncate_undo_list): Use `sizeof (scm_t_cell)' as the size
  of a cons cell for estimating memory usage.

diff --git a/src/alloc.c b/src/alloc.c
index 648e3f7..7976669 100644 (file)
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -795,15 +795,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.  */
@@ -1661,7 +1653,6 @@ 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_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!  */
 

diff --git a/src/lisp.h b/src/lisp.h
index 4888c27..d830cf4 100644 (file)
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -291,7 +291,7 @@ DEFINE_GDB_SYMBOL_END (USE_LSB_TAG)
 #define lisp_h_CHECK_SYMBOL(x) CHECK_TYPE (SYMBOLP (x), Qsymbolp, x)
 #define lisp_h_CHECK_TYPE(ok, predicate, x) \
    ((ok) ? (void) 0 : (void) wrong_type_argument (predicate, x))
-#define lisp_h_CONSP(x) (SMOB_TYPEP (x, lisp_cons_tag))
+#define lisp_h_CONSP(x) (x && scm_is_pair (x))
 #define lisp_h_EQ(x, y) (scm_is_eq (x, y))
 #define lisp_h_FLOATP(x) (x && SCM_INEXACTP (x))
 #define lisp_h_INTEGERP(x) (SCM_I_INUMP (x))
@@ -305,8 +305,8 @@ DEFINE_GDB_SYMBOL_END (USE_LSB_TAG)
    (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
 #define lisp_h_SYMBOLP(x) (SMOB_TYPEP (x, lisp_symbol_tag))
 #define lisp_h_VECTORLIKEP(x) (SMOB_TYPEP (x, lisp_vectorlike_tag))
-#define lisp_h_XCAR(c) XCONS (c)->car
-#define lisp_h_XCDR(c) XCONS (c)->cdr
+#define lisp_h_XCAR(c) (scm_car (c))
+#define lisp_h_XCDR(c) (scm_cdr (c))
 #define lisp_h_XHASH(a) (SCM_UNPACK (a))
 #define lisp_h_XSYMBOL(a) \
    (eassert (SYMBOLP (a)), (struct Lisp_Symbol *) SMOB_PTR (a))
@@ -338,7 +338,6 @@ DEFINE_GDB_SYMBOL_END (USE_LSB_TAG)
 # define VECTORLIKEP(x) lisp_h_VECTORLIKEP (x)
 # define XCAR(c) lisp_h_XCAR (c)
 # define XCDR(c) lisp_h_XCDR (c)
-# define XCONS(a) lisp_h_XCONS (a)
 # define XHASH(a) lisp_h_XHASH (a)
 # define XSYMBOL(a) lisp_h_XSYMBOL (a)
 #endif
@@ -379,7 +378,6 @@ scm_t_bits lisp_symbol_tag;
 scm_t_bits lisp_misc_tag;
 scm_t_bits lisp_string_tag;
 scm_t_bits lisp_vectorlike_tag;
-scm_t_bits lisp_cons_tag;
 
 enum Lisp_Type
   {
@@ -665,13 +663,6 @@ XTYPE (Lisp_Object o)
 
 /* Extract a value or address from a Lisp_Object.  */
 
-INLINE struct Lisp_Cons *
-XCONS (Lisp_Object a)
-{
-  eassert (CONSP (a));
-  return SMOB_PTR (a);
-}
-
 INLINE struct Lisp_Vector *
 XVECTOR (Lisp_Object a)
 {
@@ -753,7 +744,6 @@ make_lisp_proc (struct Lisp_Process *p)
 
 #define XSETINT(a, b) ((a) = make_number (b))
 #define XSETFASTINT(a, b) ((a) = make_natnum (b))
-#define XSETCONS(a, b) ((a) = (b)->self)
 #define XSETVECTOR(a, b) ((a) = (b)->header.self)
 #define XSETSTRING(a, b) ((a) = (b)->self)
 #define XSETSYMBOL(a, b) ((a) = (b)->self)
@@ -807,36 +797,6 @@ LISP_MACRO_DEFUN_VOID (CHECK_TYPE,
 
 typedef struct interval *INTERVAL;
 
-struct Lisp_Cons
-  {
-    Lisp_Object self;
-
-    /* Car of this cons cell.  */
-    Lisp_Object car;
-
-    /* Cdr of this cons cell.  */
-    Lisp_Object cdr;
-  };
-
-/* Take the car or cdr of something known to be a cons cell.  */
-/* The _addr functions shouldn't be used outside of the minimal set
-   of code that has to know what a cons cell looks like.  Other code not
-   part of the basic lisp implementation should assume that the car and cdr
-   fields are not accessible.  (What if we want to switch to
-   a copying collector someday?  Cached cons cell field addresses may be
-   invalidated at arbitrary points.)  */
-INLINE Lisp_Object *
-xcar_addr (Lisp_Object c)
-{
-  return &XCONS (c)->car;
-}
-INLINE Lisp_Object *
-xcdr_addr (Lisp_Object c)
-{
-  return &XCONS (c)->cdr;
-}
-
-/* Use these from normal code.  */
 LISP_MACRO_DEFUN (XCAR, Lisp_Object, (Lisp_Object c), (c))
 LISP_MACRO_DEFUN (XCDR, Lisp_Object, (Lisp_Object c), (c))
 
@@ -847,12 +807,12 @@ LISP_MACRO_DEFUN (XCDR, Lisp_Object, (Lisp_Object c), (c))
 INLINE void
 XSETCAR (Lisp_Object c, Lisp_Object n)
 {
-  *xcar_addr (c) = n;
+  scm_set_car_x (c, n);
 }
 INLINE void
 XSETCDR (Lisp_Object c, Lisp_Object n)
 {
-  *xcdr_addr (c) = n;
+  scm_set_cdr_x (c, n);
 }
 
 /* Take the car or cdr of something whose type is not known.  */
@@ -2429,6 +2389,7 @@ CHECK_NUMBER_CDR (Lisp_Object x)
    arguments, so we can catch errors with maxargs at compile-time.  */
 #ifdef _MSC_VER
 #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc)    \
+   SCM_SNARF_INIT (defsubr (&sname);)                                   \
    Lisp_Object fnname DEFUN_ARGS_ ## maxargs ;                         \
    static struct Lisp_Subr alignas (GCALIGNMENT) sname =               \
    { { NULL,                                                            \
@@ -2439,6 +2400,7 @@ CHECK_NUMBER_CDR (Lisp_Object x)
    Lisp_Object fnname
 #else  /* not _MSC_VER */
 #define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc)    \
+   SCM_SNARF_INIT (defsubr (&sname);)                                   \
    static struct Lisp_Subr alignas (GCALIGNMENT) sname =               \
    { { .self = NULL,                                                    \
        .size = PVEC_SUBR << PSEUDOVECTOR_AREA_BITS },                   \

diff --git a/src/undo.c b/src/undo.c
index d498974..b81f1ae 100644 (file)
--- a/src/undo.c
+++ b/src/undo.c
@@ -329,6 +329,7 @@ truncate_undo_list (struct buffer *b)
   Lisp_Object prev, next, last_boundary;
   EMACS_INT size_so_far = 0;
   ptrdiff_t count = SPECPDL_INDEX ();
+  static const size_t sizeof_cons = sizeof (scm_t_cell);
 
   /* Make the buffer current to get its local values of variables such
      as undo_limit.  Also so that Vundo_outer_limit_function can
@@ -346,7 +347,7 @@ truncate_undo_list (struct buffer *b)
   if (CONSP (next) && NILP (XCAR (next)))
     {
       /* Add in the space occupied by this element and its chain link.  */
-      size_so_far += sizeof (struct Lisp_Cons);
+      size_so_far += sizeof_cons;
 
       /* Advance to next element.  */
       prev = next;
@@ -365,10 +366,10 @@ truncate_undo_list (struct buffer *b)
       elt = XCAR (next);
 
       /* Add in the space occupied by this element and its chain link.  */
-      size_so_far += sizeof (struct Lisp_Cons);
+      size_so_far += sizeof_cons;
       if (CONSP (elt))
        {
-         size_so_far += sizeof (struct Lisp_Cons);
+         size_so_far += sizeof_cons;
          if (STRINGP (XCAR (elt)))
            size_so_far += (sizeof (struct Lisp_String) - 1
                            + SCHARS (XCAR (elt)));
@@ -426,10 +427,10 @@ truncate_undo_list (struct buffer *b)
        }
 
       /* Add in the space occupied by this element and its chain link.  */
-      size_so_far += sizeof (struct Lisp_Cons);
+      size_so_far += sizeof_cons;
       if (CONSP (elt))
        {
-         size_so_far += sizeof (struct Lisp_Cons);
+         size_so_far += sizeof_cons;
          if (STRINGP (XCAR (elt)))
            size_so_far += (sizeof (struct Lisp_String) - 1
                            + SCHARS (XCAR (elt)));