guile-elisp bootstrap (C)
[bpt/emacs.git] / src / lisp.h
index 2f7c2f7..c92431d 100644 (file)
@@ -291,58 +291,26 @@ 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) (SMOB_TYPEP (x, lisp_float_tag))
+#define lisp_h_FLOATP(x) (x && SCM_INEXACTP (x))
 #define lisp_h_INTEGERP(x) (SCM_I_INUMP (x))
 #define lisp_h_MARKERP(x) (MISCP (x) && XMISCTYPE (x) == Lisp_Misc_Marker)
 #define lisp_h_MISCP(x) (SMOB_TYPEP (x, lisp_misc_tag))
-#define lisp_h_NILP(x) EQ (x, Qnil)
+#define lisp_h_NILP(x) (scm_is_lisp_false (x))
 #define lisp_h_SET_SYMBOL_VAL(sym, v) \
-   (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value = (v))
-#define lisp_h_SYMBOL_CONSTANT_P(sym) (XSYMBOL (sym)->constant)
+   (eassert (SYMBOL_REDIRECT (sym) == SYMBOL_PLAINVAL), \
+      scm_c_vector_set_x (sym, 4, v))
+#define lisp_h_SYMBOL_CONSTANT_P(sym) (SYMBOL_CONSTANT (XSYMBOL (sym)))
 #define lisp_h_SYMBOL_VAL(sym) \
-   (eassert ((sym)->redirect == SYMBOL_PLAINVAL), (sym)->val.value)
-#define lisp_h_SYMBOLP(x) (SMOB_TYPEP (x, lisp_symbol_tag))
+   (eassert (SYMBOL_REDIRECT (sym) == SYMBOL_PLAINVAL), \
+    scm_c_vector_ref (sym, 4))
+#define lisp_h_SYMBOLP(x) \
+  (x && (scm_is_symbol (x) || EQ (x, Qnil) || EQ (x, Qt)))
 #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))
-
-/* When compiling via gcc -O0, define the key operations as macros, as
-   Emacs is too slow otherwise.  To disable this optimization, compile
-   with -DINLINING=false.  */
-#if 0
-#if (defined __NO_INLINE__ \
-     && ! defined __OPTIMIZE__ && ! defined __OPTIMIZE_SIZE__ \
-     && ! (defined INLINING && ! INLINING))
-# define XLI(o) lisp_h_XLI (o)
-# define XIL(i) lisp_h_XIL (i)
-# define CHECK_LIST_CONS(x, y) lisp_h_CHECK_LIST_CONS (x, y)
-# define CHECK_NUMBER(x) lisp_h_CHECK_NUMBER (x)
-# define CHECK_SYMBOL(x) lisp_h_CHECK_SYMBOL (x)
-# define CHECK_TYPE(ok, predicate, x) lisp_h_CHECK_TYPE (ok, predicate, x)
-# define CONSP(x) lisp_h_CONSP (x)
-# define EQ(x, y) lisp_h_EQ (x, y)
-# define FLOATP(x) lisp_h_FLOATP (x)
-# define INTEGERP(x) lisp_h_INTEGERP (x)
-# define MARKERP(x) lisp_h_MARKERP (x)
-# define MISCP(x) lisp_h_MISCP (x)
-# define NILP(x) lisp_h_NILP (x)
-# define SET_SYMBOL_VAL(sym, v) lisp_h_SET_SYMBOL_VAL (sym, v)
-# define SYMBOL_CONSTANT_P(sym) lisp_h_SYMBOL_CONSTANT_P (sym)
-# define SYMBOL_VAL(sym) lisp_h_SYMBOL_VAL (sym)
-# define SYMBOLP(x) lisp_h_SYMBOLP (x)
-# 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
-#endif
 
 /* Define NAME as a lisp.h inline function that returns TYPE and has
    arguments declared as ARGDECLS and passed as ARGS.  ARGDECLS and
@@ -375,15 +343,14 @@ DEFINE_GDB_SYMBOL_END (USE_LSB_TAG)
 #define ENUM_BF(TYPE) enum TYPE
 #endif
 
-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;
-scm_t_bits lisp_float_tag;
 
 enum Lisp_Type
   {
+    Lisp_Other,
+
     /* Integer.  XINT (obj) is the integer value.  */
     Lisp_Int,
 
@@ -475,7 +442,6 @@ enum pvec_type
   PVEC_HASH_TABLE,
   PVEC_TERMINAL,
   PVEC_WINDOW_CONFIGURATION,
-  PVEC_SUBR,
   PVEC_OTHER,
   /* These should be last, check internal_equal to see why.  */
   PVEC_COMPILED,
@@ -601,7 +567,6 @@ INLINE void set_sub_char_table_contents (Lisp_Object, ptrdiff_t,
                                              Lisp_Object);
 INLINE bool STRINGP (Lisp_Object);
 INLINE bool SUB_CHAR_TABLE_P (Lisp_Object);
-INLINE bool SUBRP (Lisp_Object);
 INLINE bool (SYMBOLP) (Lisp_Object);
 INLINE bool (VECTORLIKEP) (Lisp_Object);
 INLINE bool WINDOWP (Lisp_Object);
@@ -661,18 +626,11 @@ XTYPE (Lisp_Object o)
   else if (FLOATP (o))
     return Lisp_Float;
   else
-    abort ();
+    return Lisp_Other;
 }
 
 /* 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)
 {
@@ -687,14 +645,16 @@ XSTRING (Lisp_Object a)
   return SMOB_PTR (a);
 }
 
-LISP_MACRO_DEFUN (XSYMBOL, struct Lisp_Symbol *, (Lisp_Object a), (a))
+extern void initialize_symbol (Lisp_Object, Lisp_Object);
+INLINE Lisp_Object build_string (const char *);
+extern Lisp_Object symbol_module;
+extern Lisp_Object function_module;
+extern Lisp_Object plist_module;
+extern Lisp_Object Qt, Qnil, Qt_, Qnil_;
 
-INLINE struct Lisp_Float *
-XFLOAT (Lisp_Object a)
-{
-  eassert (FLOATP (a));
-  return SMOB_PTR (a);
-}
+typedef Lisp_Object sym_t;
+
+INLINE sym_t XSYMBOL (Lisp_Object a);
 
 /* Pseudovector types.  */
 
@@ -718,13 +678,6 @@ XTERMINAL (Lisp_Object a)
   return SMOB_PTR (a);
 }
 
-INLINE struct Lisp_Subr *
-XSUBR (Lisp_Object a)
-{
-  eassert (SUBRP (a));
-  return SMOB_PTR (a);
-}
-
 INLINE struct buffer *
 XBUFFER (Lisp_Object a)
 {
@@ -761,11 +714,9 @@ 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)
-#define XSETFLOAT(a, b) ((a) = (b)->self)
+#define XSETSYMBOL(a, b) ((a) = scm_c_vector_ref (b, 0))
 #define XSETMISC(a, b) (a) = ((union Lisp_Misc *) (b))->u_any.self
 
 /* Pseudovector types.  */
@@ -816,36 +767,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))
 
@@ -856,12 +777,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.  */
@@ -1305,32 +1226,6 @@ CHAR_TABLE_SET (Lisp_Object ct, int idx, Lisp_Object val)
     char_table_set (ct, idx, val);
 }
 
-/* This structure describes a built-in function.
-   It is generated by the DEFUN macro only.
-   defsubr makes it into a Lisp object.  */
-
-struct Lisp_Subr
-  {
-    struct vectorlike_header header;
-    union {
-      Lisp_Object (*a0) (void);
-      Lisp_Object (*a1) (Lisp_Object);
-      Lisp_Object (*a2) (Lisp_Object, Lisp_Object);
-      Lisp_Object (*a3) (Lisp_Object, Lisp_Object, Lisp_Object);
-      Lisp_Object (*a4) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
-      Lisp_Object (*a5) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
-      Lisp_Object (*a6) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
-      Lisp_Object (*a7) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
-      Lisp_Object (*a8) (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object);
-      Lisp_Object (*aUNEVALLED) (Lisp_Object args);
-      Lisp_Object (*aMANY) (ptrdiff_t, Lisp_Object *);
-    } function;
-    short min_args, max_args;
-    const char *symbol_name;
-    const char *intspec;
-    const char *doc;
-  };
-
 /* This is the number of slots that every char table must have.  This
    counts the ordinary slots and the top, defalt, parent, and purpose
    slots.  */
@@ -1353,15 +1248,6 @@ CHAR_TABLE_EXTRA_SLOTS (struct Lisp_Char_Table *ct)
                               Symbols
  ***********************************************************************/
 
-/* Interned state of a symbol.  */
-
-enum symbol_interned
-{
-  SYMBOL_UNINTERNED = 0,
-  SYMBOL_INTERNED = 1,
-  SYMBOL_INTERNED_IN_INITIAL_OBARRAY = 2
-};
-
 enum symbol_redirect
 {
   SYMBOL_PLAINVAL  = 4,
@@ -1372,102 +1258,90 @@ enum symbol_redirect
 
 struct Lisp_Symbol
 {
-  Lisp_Object self;
+  Lisp_Object self_;
 
   /* Indicates where the value can be found:
      0 : it's a plain var, the value is in the `value' field.
      1 : it's a varalias, the value is really in the `alias' symbol.
      2 : it's a localized var, the value is in the `blv' object.
      3 : it's a forwarding variable, the value is in `forward'.  */
-  ENUM_BF (symbol_redirect) redirect : 3;
+  ENUM_BF (symbol_redirect) redirect_ : 3;
 
   /* Non-zero means symbol is constant, i.e. changing its value
      should signal an error.  If the value is 3, then the var
      can be changed, but only by `defconst'.  */
-  unsigned constant : 2;
-
-  /* Interned state of the symbol.  This is an enumerator from
-     enum symbol_interned.  */
-  unsigned interned : 2;
+  unsigned constant_ : 2;
 
   /* True means that this variable has been explicitly declared
      special (with `defvar' etc), and shouldn't be lexically bound.  */
-  bool_bf declared_special : 1;
-
-  /* True if pointed to from purespace and hence can't be GC'd.  */
-  bool_bf pinned : 1;
-
-  /* The symbol's name, as a Lisp string.  */
-  Lisp_Object name;
+  bool_bf declared_special_ : 1;
 
   /* Value of the symbol or Qunbound if unbound.  Which alternative of the
      union is used depends on the `redirect' field above.  */
   union {
-    Lisp_Object value;
-    struct Lisp_Symbol *alias;
-    struct Lisp_Buffer_Local_Value *blv;
-    union Lisp_Fwd *fwd;
-  } val;
-
-  /* Function value of the symbol or Qnil if not fboundp.  */
-  Lisp_Object function;
-
-  /* The symbol's property list.  */
-  Lisp_Object plist;
-
-  /* Next symbol in obarray bucket, if the symbol is interned.  */
-  struct Lisp_Symbol *next;
+    Lisp_Object value_;
+    sym_t alias_;
+    struct Lisp_Buffer_Local_Value *blv_;
+    union Lisp_Fwd *fwd_;
+  };
 };
 
-/* Value is name of symbol.  */
+#define SYMBOL_SELF(sym) (scm_c_vector_ref (sym, 0))
+#define SET_SYMBOL_SELF(sym, v) (scm_c_vector_set_x (sym, 0, v))
+#define SYMBOL_REDIRECT(sym) (XINT (scm_c_vector_ref (sym, 1)))
+#define SET_SYMBOL_REDIRECT(sym, v) (scm_c_vector_set_x (sym, 1, make_number (v)))
+#define SYMBOL_CONSTANT(sym) (XINT (scm_c_vector_ref (sym, 2)))
+#define SET_SYMBOL_CONSTANT(sym, v) (scm_c_vector_set_x (sym, 2, make_number (v)))
+#define SYMBOL_DECLARED_SPECIAL(sym) (XINT (scm_c_vector_ref (sym, 3)))
+#define SET_SYMBOL_DECLARED_SPECIAL(sym, v) (scm_c_vector_set_x (sym, 3, make_number (v)))
 
-LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (struct Lisp_Symbol *sym), (sym))
+/* Value is name of symbol.  */
 
-INLINE struct Lisp_Symbol *
-SYMBOL_ALIAS (struct Lisp_Symbol *sym)
+INLINE sym_t 
+SYMBOL_ALIAS (sym_t sym)
 {
-  eassert (sym->redirect == SYMBOL_VARALIAS);
-  return sym->val.alias;
+  eassert (SYMBOL_REDIRECT (sym) == SYMBOL_VARALIAS);
+  return scm_c_vector_ref (sym, 4);
 }
 INLINE struct Lisp_Buffer_Local_Value *
-SYMBOL_BLV (struct Lisp_Symbol *sym)
+SYMBOL_BLV (sym_t sym)
 {
-  eassert (sym->redirect == SYMBOL_LOCALIZED);
-  return sym->val.blv;
+  eassert (SYMBOL_REDIRECT (sym) == SYMBOL_LOCALIZED);
+  return scm_to_pointer (scm_c_vector_ref (sym, 4));
 }
 INLINE union Lisp_Fwd *
-SYMBOL_FWD (struct Lisp_Symbol *sym)
+SYMBOL_FWD (sym_t sym)
 {
-  eassert (sym->redirect == SYMBOL_FORWARDED);
-  return sym->val.fwd;
+  eassert (SYMBOL_REDIRECT (sym) == SYMBOL_FORWARDED);
+  return scm_to_pointer (scm_c_vector_ref (sym, 4));
 }
 
 LISP_MACRO_DEFUN_VOID (SET_SYMBOL_VAL,
-                      (struct Lisp_Symbol *sym, Lisp_Object v), (sym, v))
+                      (sym_t sym, Lisp_Object v), (sym, v))
 
 INLINE void
-SET_SYMBOL_ALIAS (struct Lisp_Symbol *sym, struct Lisp_Symbol *v)
+SET_SYMBOL_ALIAS (sym_t sym, sym_t v)
 {
-  eassert (sym->redirect == SYMBOL_VARALIAS);
-  sym->val.alias = v;
+  eassert (SYMBOL_REDIRECT (sym) == SYMBOL_VARALIAS);
+  scm_c_vector_set_x (sym, 4, v);
 }
 INLINE void
-SET_SYMBOL_BLV (struct Lisp_Symbol *sym, struct Lisp_Buffer_Local_Value *v)
+SET_SYMBOL_BLV (sym_t sym, struct Lisp_Buffer_Local_Value *v)
 {
-  eassert (sym->redirect == SYMBOL_LOCALIZED);
-  sym->val.blv = v;
+  eassert (SYMBOL_REDIRECT (sym) == SYMBOL_LOCALIZED);
+  scm_c_vector_set_x (sym, 4, scm_from_pointer (v, NULL));
 }
 INLINE void
-SET_SYMBOL_FWD (struct Lisp_Symbol *sym, union Lisp_Fwd *v)
+SET_SYMBOL_FWD (sym_t sym, union Lisp_Fwd *v)
 {
-  eassert (sym->redirect == SYMBOL_FORWARDED);
-  sym->val.fwd = v;
+  eassert (SYMBOL_REDIRECT (sym) == SYMBOL_FORWARDED);
+  scm_c_vector_set_x (sym, 4, scm_from_pointer (v, NULL));
 }
 
 INLINE Lisp_Object
 SYMBOL_NAME (Lisp_Object sym)
 {
-  return XSYMBOL (sym)->name;
+  return build_string (scm_to_locale_string (scm_call_1 (scm_c_public_ref ("language elisp runtime", "symbol-name"), sym)));
 }
 
 /* Value is true if SYM is an interned symbol.  */
@@ -1475,15 +1349,15 @@ SYMBOL_NAME (Lisp_Object sym)
 INLINE bool
 SYMBOL_INTERNED_P (Lisp_Object sym)
 {
-  return XSYMBOL (sym)->interned != SYMBOL_UNINTERNED;
+  if (EQ (sym, Qnil)) return true;
+  if (EQ (sym, Qt)) return true;
+  return scm_is_true (scm_symbol_interned_p (sym));
 }
 
-/* Value is true if SYM is interned in initial_obarray.  */
-
-INLINE bool
-SYMBOL_INTERNED_IN_INITIAL_OBARRAY_P (Lisp_Object sym)
+INLINE Lisp_Object
+SYMBOL_FUNCTION (Lisp_Object sym)
 {
-  return XSYMBOL (sym)->interned == SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
+  return scm_call_1 (scm_c_public_ref ("elisp-functions", "symbol-function"), sym);
 }
 
 /* Value is non-zero if symbol is considered a constant, i.e. its
@@ -1495,6 +1369,8 @@ LISP_MACRO_DEFUN (SYMBOL_CONSTANT_P, int, (Lisp_Object sym), (sym))
 #define DEFSYM(sym, name)                                              \
   do { (sym) = intern_c_string ((name)); staticpro (&(sym)); } while (false)
 
+LISP_MACRO_DEFUN (SYMBOL_VAL, Lisp_Object, (sym_t sym), (sym))
+
 \f
 /***********************************************************************
                             Hash Tables
@@ -2050,18 +1926,7 @@ XBUFFER_OBJFWD (union Lisp_Fwd *a)
   return &a->u_buffer_objfwd;
 }
 \f
-/* Lisp floating point type.  */
-struct Lisp_Float
-  {
-    Lisp_Object self;
-    double data;
-  };
-
-INLINE double
-XFLOAT_DATA (Lisp_Object f)
-{
-  return XFLOAT (f)->data;
-}
+#define XFLOAT_DATA(f)  (scm_to_double (f))
 
 /* Most hosts nowadays use IEEE floating point, so they use IEC 60559
    representations, have infinities and NaNs, and do not trap on
@@ -2231,12 +2096,6 @@ TERMINALP (Lisp_Object a)
   return PSEUDOVECTORP (a, PVEC_TERMINAL);
 }
 
-INLINE bool
-SUBRP (Lisp_Object a)
-{
-  return PSEUDOVECTORP (a, PVEC_SUBR);
-}
-
 INLINE bool
 COMPILEDP (Lisp_Object a)
 {
@@ -2447,25 +2306,71 @@ CHECK_NUMBER_CDR (Lisp_Object x)
 
 /* This version of DEFUN declares a function prototype with the right
    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 (lname, gsubr_ ## fnname, minargs, maxargs, intspec)) \
    Lisp_Object fnname DEFUN_ARGS_ ## maxargs ;                         \
-   static struct Lisp_Subr alignas (GCALIGNMENT) sname =               \
-   { { NULL,                                                            \
-       (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS)                            \
-       | (sizeof (struct Lisp_Subr) / sizeof (EMACS_INT)) },           \
-     { (Lisp_Object (__cdecl *)(void))fnname },                         \
-     minargs, maxargs, lname, intspec, 0};                             \
-   Lisp_Object fnname
-#else  /* not _MSC_VER */
-#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc)    \
-   static struct Lisp_Subr alignas (GCALIGNMENT) sname =               \
-   { { .self = NULL,                                                    \
-       .size = PVEC_SUBR << PSEUDOVECTOR_AREA_BITS },                   \
-     { .a ## maxargs = fnname },                                        \
-     minargs, maxargs, lname, intspec, 0};                             \
+   DEFUN_GSUBR_ ## maxargs (lname, fnname, minargs, maxargs)            \
    Lisp_Object fnname
-#endif
+
+#define GSUBR_ARGS_1(f) f (arg1)
+#define GSUBR_ARGS_2(f) GSUBR_ARGS_1 (f), f (arg2)
+#define GSUBR_ARGS_3(f) GSUBR_ARGS_2 (f), f (arg3)
+#define GSUBR_ARGS_4(f) GSUBR_ARGS_3 (f), f (arg4)
+#define GSUBR_ARGS_5(f) GSUBR_ARGS_4 (f), f (arg5)
+#define GSUBR_ARGS_6(f) GSUBR_ARGS_5 (f), f (arg6)
+#define GSUBR_ARGS_7(f) GSUBR_ARGS_6 (f), f (arg7)
+#define GSUBR_ARGS_8(f) GSUBR_ARGS_7 (f), f (arg8)
+
+#define GSUBR_ARGS(n) GSUBR_ARGS_PASTE (GSUBR_ARGS_, n)
+#define GSUBR_ARGS_PASTE(a, b) a ## b
+
+#define DEFUN_GSUBR_N(fn, maxargs)                              \
+  Lisp_Object                                                   \
+  gsubr_ ## fn                                                  \
+  (GSUBR_ARGS (maxargs) (Lisp_Object))                          \
+  {                                                             \
+    return fn (GSUBR_ARGS (maxargs) (GSUBR_ARG));               \
+  }
+#define GSUBR_ARG(x) (SCM_UNBNDP (x) ? Qnil : x)
+
+#define DEFUN_GSUBR_0(lname, fn, minargs, maxargs)       \
+  Lisp_Object gsubr_ ## fn (void) { return fn (); }
+#define DEFUN_GSUBR_1(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+#define DEFUN_GSUBR_2(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+#define DEFUN_GSUBR_3(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+#define DEFUN_GSUBR_4(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+#define DEFUN_GSUBR_5(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+#define DEFUN_GSUBR_6(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+#define DEFUN_GSUBR_7(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+#define DEFUN_GSUBR_8(lname, fn, min, max) DEFUN_GSUBR_N(fn, max)
+
+#define DEFUN_GSUBR_UNEVALLED(lname, fn, minargs, maxargs)  \
+  Lisp_Object                                               \
+  gsubr_ ## fn (Lisp_Object rest)                           \
+  {                                                         \
+    Lisp_Object len = Flength (rest);                       \
+    if (XINT (len) < minargs)                               \
+      xsignal2 (Qwrong_number_of_arguments,                 \
+                intern (lname), len);                       \
+    return fn (rest);                                       \
+  }
+#define DEFUN_GSUBR_MANY(lname, fn, minargs, maxargs)        \
+  Lisp_Object                                               \
+  gsubr_ ## fn (Lisp_Object rest)                           \
+  {                                                         \
+    int len = scm_to_int (scm_length (rest));               \
+    Lisp_Object *args;                                      \
+    SAFE_ALLOCA_LISP (args, len);                           \
+    int i;                                                  \
+    for (i = 0;                                             \
+         i < len && scm_is_pair (rest);                     \
+         i++, rest = SCM_CDR (rest))                        \
+      args[i] = SCM_CAR (rest);                             \
+    if (i < minargs)                                        \
+      xsignal2 (Qwrong_number_of_arguments,                 \
+                intern (lname), make_number (i));           \
+    return fn (i, args);                                    \
+  }
 
 /* Note that the weird token-substitution semantics of ANSI C makes
    this work for MANY and UNEVALLED.  */
@@ -2485,6 +2390,9 @@ CHECK_NUMBER_CDR (Lisp_Object x)
 #define DEFUN_ARGS_8   (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, \
                         Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)
 
+#define WRAP1(cfn, lfn) Lisp_Object cfn (Lisp_Object a) { return call1 (intern (lfn), a); }
+#define WRAP2(cfn, lfn) Lisp_Object cfn (Lisp_Object a, Lisp_Object b) { return call2 (intern (lfn), a, b); }
+
 /* True if OBJ is a Lisp function.  */
 INLINE bool
 FUNCTIONP (Lisp_Object obj)
@@ -2494,7 +2402,7 @@ FUNCTIONP (Lisp_Object obj)
 
 /* defsubr (Sname);
    is how we define the symbol for function `name' at start-up time.  */
-extern void defsubr (struct Lisp_Subr *);
+extern void defsubr (const char *, scm_t_subr, short, short, const char *);
 
 enum maxargs
   {
@@ -2600,10 +2508,6 @@ typedef jmp_buf sys_jmp_buf;
    union specbinding.  But only eval.c should access it.  */
 
 enum specbind_tag {
-  SPECPDL_UNWIND,              /* An unwind_protect function on Lisp_Object.  */
-  SPECPDL_UNWIND_PTR,          /* Likewise, on void *.  */
-  SPECPDL_UNWIND_INT,          /* Likewise, on int.  */
-  SPECPDL_UNWIND_VOID,         /* Likewise, with no arg.  */
   SPECPDL_BACKTRACE,           /* An element of the backtrace.  */
   SPECPDL_LET,                 /* A plain and simple dynamic let-binding.  */
   /* Tags greater than SPECPDL_LET must be "subkinds" of LET.  */
@@ -2616,21 +2520,28 @@ union specbinding
     ENUM_BF (specbind_tag) kind : CHAR_BIT;
     struct {
       ENUM_BF (specbind_tag) kind : CHAR_BIT;
+    } frame;
+    struct {
+      ENUM_BF (specbind_tag) kind : CHAR_BIT;
+      bool wind_explicitly;
       void (*func) (Lisp_Object);
       Lisp_Object arg;
     } unwind;
     struct {
       ENUM_BF (specbind_tag) kind : CHAR_BIT;
+      bool wind_explicitly;
       void (*func) (void *);
       void *arg;
     } unwind_ptr;
     struct {
       ENUM_BF (specbind_tag) kind : CHAR_BIT;
+      bool wind_explicitly;
       void (*func) (int);
       int arg;
     } unwind_int;
     struct {
       ENUM_BF (specbind_tag) kind : CHAR_BIT;
+      bool wind_explicitly;
       void (*func) (void);
     } unwind_void;
     struct {
@@ -2682,53 +2593,16 @@ enum handlertype { CATCHER, CONDITION_CASE };
 struct handler
 {
   enum handlertype type;
+  Lisp_Object ptag;
   Lisp_Object tag_or_ch;
   Lisp_Object val;
+  Lisp_Object var;
+  Lisp_Object body;
   struct handler *next;
-  struct handler *nextfree;
-
-  /* The bytecode interpreter can have several handlers active at the same
-     time, so when we longjmp to one of them, it needs to know which handler
-     this was and what was the corresponding internal state.  This is stored
-     here, and when we longjmp we make sure that handlerlist points to the
-     proper handler.  */
-  Lisp_Object *bytecode_top;
-  int bytecode_dest;
-
-  /* Most global vars are reset to their value via the specpdl mechanism,
-     but a few others are handled by storing their value here.  */
-#if true /* GC_MARK_STACK == GC_MAKE_GCPROS_NOOPS, but defined later.  */
-  struct gcpro *gcpro;
-#endif
-  sys_jmp_buf jmp;
   EMACS_INT lisp_eval_depth;
-  ptrdiff_t pdlcount;
-  int poll_suppress_count;
   int interrupt_input_blocked;
 };
 
-/* Fill in the components of c, and put it on the list.  */
-#define PUSH_HANDLER(c, tag_ch_val, handlertype)       \
-  if (handlerlist->nextfree)                           \
-    (c) = handlerlist->nextfree;                       \
-  else                                                 \
-    {                                                  \
-      (c) = xmalloc (sizeof (struct handler));         \
-      (c)->nextfree = NULL;                            \
-      handlerlist->nextfree = (c);                     \
-    }                                                  \
-  (c)->type = (handlertype);                           \
-  (c)->tag_or_ch = (tag_ch_val);                       \
-  (c)->val = Qnil;                                     \
-  (c)->next = handlerlist;                             \
-  (c)->lisp_eval_depth = lisp_eval_depth;              \
-  (c)->pdlcount = SPECPDL_INDEX ();                    \
-  (c)->poll_suppress_count = poll_suppress_count;      \
-  (c)->interrupt_input_blocked = interrupt_input_blocked;\
-  (c)->gcpro = gcprolist;                              \
-  handlerlist = (c);
-
-
 extern Lisp_Object memory_signal_data;
 
 /* Check quit-flag and quit if it is non-nil.
@@ -2871,19 +2745,22 @@ set_hash_value_slot (struct Lisp_Hash_Table *h, ptrdiff_t idx, Lisp_Object val)
 INLINE void
 set_symbol_function (Lisp_Object sym, Lisp_Object function)
 {
-  XSYMBOL (sym)->function = function;
+  scm_call_2 (scm_c_public_ref ("language elisp runtime", "set-symbol-function!"),
+              sym, function);
 }
 
-INLINE void
-set_symbol_plist (Lisp_Object sym, Lisp_Object plist)
+INLINE Lisp_Object
+symbol_plist (Lisp_Object sym)
 {
-  XSYMBOL (sym)->plist = plist;
+  return scm_call_1 (scm_c_public_ref ("language elisp runtime", "symbol-plist"),
+                     sym);
 }
 
 INLINE void
-set_symbol_next (Lisp_Object sym, struct Lisp_Symbol *next)
+set_symbol_plist (Lisp_Object sym, Lisp_Object plist)
 {
-  XSYMBOL (sym)->next = next;
+  scm_call_2 (scm_c_public_ref ("language elisp runtime", "set-symbol-plist!"),
+              sym, plist);
 }
 
 /* Buffer-local (also frame-local) variable access functions.  */
@@ -2956,6 +2833,7 @@ set_sub_char_table_contents (Lisp_Object table, ptrdiff_t idx, Lisp_Object val)
 }
 
 /* Defined in data.c.  */
+extern Lisp_Object Qnil_, Qt_;
 extern Lisp_Object Qquote, Qunbound;
 extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
 extern Lisp_Object Qerror, Qquit, Qargs_out_of_range;
@@ -2970,6 +2848,7 @@ extern Lisp_Object Qcircular_list;
 extern Lisp_Object Qsequencep;
 extern Lisp_Object Qchar_or_string_p, Qinteger_or_marker_p;
 extern Lisp_Object Qfboundp;
+extern Lisp_Object Qspecial_operator;
 
 extern Lisp_Object Qcdr;
 
@@ -3021,14 +2900,14 @@ extern Lisp_Object arithcompare (Lisp_Object num1, Lisp_Object num2,
 extern intmax_t cons_to_signed (Lisp_Object, intmax_t, intmax_t);
 extern uintmax_t cons_to_unsigned (Lisp_Object, uintmax_t);
 
-extern struct Lisp_Symbol *indirect_variable (struct Lisp_Symbol *);
+extern sym_t indirect_variable (sym_t );
 extern _Noreturn void args_out_of_range (Lisp_Object, Lisp_Object);
 extern _Noreturn void args_out_of_range_3 (Lisp_Object, Lisp_Object,
                                           Lisp_Object);
 extern Lisp_Object do_symval_forwarding (union Lisp_Fwd *);
 extern void set_internal (Lisp_Object, Lisp_Object, Lisp_Object, bool);
 extern void syms_of_data (void);
-extern void swap_in_global_binding (struct Lisp_Symbol *);
+extern void swap_in_global_binding (sym_t );
 
 /* Defined in cmds.c */
 extern void syms_of_cmds (void);
@@ -3091,6 +2970,7 @@ extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t);
 extern ptrdiff_t string_byte_to_char (Lisp_Object, ptrdiff_t);
 extern Lisp_Object string_to_multibyte (Lisp_Object);
 extern Lisp_Object string_make_unibyte (Lisp_Object);
+extern void init_fns_once (void);
 extern void syms_of_fns (void);
 
 /* Defined in floatfns.c.  */
@@ -3418,7 +3298,7 @@ extern Lisp_Object Qlexical_binding;
 extern Lisp_Object check_obarray (Lisp_Object);
 extern Lisp_Object intern_1 (const char *, ptrdiff_t);
 extern Lisp_Object intern_c_string_1 (const char *, ptrdiff_t);
-extern Lisp_Object oblookup (Lisp_Object, const char *, ptrdiff_t, ptrdiff_t);
+extern Lisp_Object obhash (Lisp_Object);
 INLINE void
 LOADHIST_ATTACH (Lisp_Object x)
 {
@@ -3476,6 +3356,7 @@ extern _Noreturn void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object,
                                Lisp_Object);
 extern _Noreturn void signal_error (const char *, Lisp_Object);
 extern Lisp_Object eval_sub (Lisp_Object form);
+extern Lisp_Object Ffuncall (ptrdiff_t nargs, Lisp_Object *args);
 extern Lisp_Object apply1 (Lisp_Object, Lisp_Object);
 extern Lisp_Object call0 (Lisp_Object);
 extern Lisp_Object call1 (Lisp_Object, Lisp_Object);
@@ -3494,15 +3375,16 @@ extern Lisp_Object internal_condition_case_n
     (Lisp_Object (*) (ptrdiff_t, Lisp_Object *), ptrdiff_t, Lisp_Object *,
      Lisp_Object, Lisp_Object (*) (Lisp_Object, ptrdiff_t, Lisp_Object *));
 extern void specbind (Lisp_Object, Lisp_Object);
+extern void record_unwind_protect_1 (void (*) (Lisp_Object), Lisp_Object, bool);
 extern void record_unwind_protect (void (*) (Lisp_Object), Lisp_Object);
+extern void record_unwind_protect_ptr_1 (void (*) (void *), void *, bool);
 extern void record_unwind_protect_ptr (void (*) (void *), void *);
+extern void record_unwind_protect_int_1 (void (*) (int), int, bool);
 extern void record_unwind_protect_int (void (*) (int), int);
+extern void record_unwind_protect_void_1 (void (*) (void), bool);
 extern void record_unwind_protect_void (void (*) (void));
-extern void record_unwind_protect_nothing (void);
-extern void clear_unwind_protect (ptrdiff_t);
-extern void set_unwind_protect (ptrdiff_t, void (*) (Lisp_Object), Lisp_Object);
-extern void set_unwind_protect_ptr (ptrdiff_t, void (*) (void *), void *);
-extern Lisp_Object unbind_to (ptrdiff_t, Lisp_Object);
+extern void dynwind_begin (void);
+extern void dynwind_end (void);
 extern _Noreturn void error (const char *, ...) ATTRIBUTE_FORMAT_PRINTF (1, 2);
 extern _Noreturn void verror (const char *, va_list)
   ATTRIBUTE_FORMAT_PRINTF (1, 0);
@@ -3520,8 +3402,11 @@ extern void record_in_backtrace (Lisp_Object function,
 extern void mark_specpdl (void);
 extern void get_backtrace (Lisp_Object array);
 Lisp_Object backtrace_top_function (void);
-extern bool let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol);
+extern bool let_shadows_buffer_binding_p (sym_t symbol);
 extern bool let_shadows_global_binding_p (Lisp_Object symbol);
+extern _Noreturn SCM abort_to_prompt (SCM, SCM);
+extern SCM call_with_prompt (SCM, SCM, SCM);
+extern SCM make_prompt_tag (void);
 
 
 /* Defined in editfns.c.  */
@@ -3584,7 +3469,9 @@ extern Lisp_Object write_region (Lisp_Object, Lisp_Object, Lisp_Object,
                                 Lisp_Object, Lisp_Object, Lisp_Object,
                                 Lisp_Object, int);
 extern void close_file_unwind (int);
+extern void close_file_ptr_unwind (void *);
 extern void fclose_unwind (void *);
+extern void fclose_ptr_unwind (void *);
 extern void restore_point_unwind (Lisp_Object);
 extern _Noreturn void report_file_errno (const char *, Lisp_Object, int);
 extern _Noreturn void report_file_error (const char *, Lisp_Object);
@@ -4022,16 +3909,13 @@ extern void init_system_name (void);
 
 enum MAX_ALLOCA { MAX_ALLOCA = 16 * 1024 };
 
-extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
-
-#define USE_SAFE_ALLOCA                        \
-  ptrdiff_t sa_count = SPECPDL_INDEX (); bool sa_must_free = false
+#define USE_SAFE_ALLOCA ((void) 0)
 
 /* SAFE_ALLOCA allocates a simple buffer.  */
 
 #define SAFE_ALLOCA(size) ((size) < MAX_ALLOCA \
                           ? alloca (size)      \
-                          : (sa_must_free = true, record_xmalloc (size)))
+                          : xmalloc (size))
 
 /* SAFE_NALLOCA sets BUF to a newly allocated array of MULTIPLIER *
    NITEMS items, each of the same type as *BUF.  MULTIPLIER must
@@ -4042,23 +3926,12 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
     if ((nitems) <= MAX_ALLOCA / sizeof *(buf) / (multiplier))  \
       (buf) = alloca (sizeof *(buf) * (multiplier) * (nitems));         \
     else                                                        \
-      {                                                                 \
-       (buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier)); \
-       sa_must_free = true;                                     \
-       record_unwind_protect_ptr (xfree, buf);                  \
-      }                                                                 \
-  } while (false)
+      (buf) = xnmalloc (nitems, sizeof *(buf) * (multiplier));   \
+  } while (0)
 
 /* SAFE_FREE frees xmalloced memory and enables GC as needed.  */
 
-#define SAFE_FREE()                    \
-  do {                                 \
-    if (sa_must_free) {                        \
-      sa_must_free = false;            \
-      unbind_to (sa_count, Qnil);      \
-    }                                  \
-  } while (false)
-
+#define SAFE_FREE() ((void) 0)
 
 /* SAFE_ALLOCA_LISP allocates an array of Lisp_Objects.  */
 
@@ -4067,13 +3940,7 @@ extern void *record_xmalloc (size_t) ATTRIBUTE_ALLOC_SIZE ((1));
     if ((nelt) < MAX_ALLOCA / word_size)                      \
       (buf) = alloca ((nelt) * word_size);                    \
     else if ((nelt) < min (PTRDIFF_MAX, SIZE_MAX) / word_size) \
-      {                                                               \
-       Lisp_Object arg_;                                      \
-       (buf) = xmalloc ((nelt) * word_size);                  \
-       arg_ = make_save_memory (buf, nelt);                   \
-       sa_must_free = true;                                   \
-       record_unwind_protect (free_save_value, arg_);         \
-      }                                                               \
+      buf = xmalloc ((nelt) * word_size);                     \
     else                                                      \
       memory_full (SIZE_MAX);                                 \
   } while (false)
@@ -4127,8 +3994,8 @@ functionp (Lisp_Object object)
        }
     }
 
-  if (SUBRP (object))
-    return XSUBR (object)->max_args != UNEVALLED;
+  if (scm_is_true (scm_procedure_p (object)))
+    return 1;
   else if (COMPILEDP (object))
     return true;
   else if (CONSP (object))
@@ -4136,10 +4003,14 @@ functionp (Lisp_Object object)
       Lisp_Object car = XCAR (object);
       return EQ (car, Qlambda) || EQ (car, Qclosure);
     }
-  else
-    return false;
 }
 
-INLINE_HEADER_END
+INLINE sym_t
+XSYMBOL (Lisp_Object a)
+{
+  return scm_call_1 (scm_c_public_ref ("language elisp runtime", "symbol-desc"),
+                     a);
+}
 
+INLINE_HEADER_END
 #endif /* EMACS_LISP_H */