guile-elisp bootstrap (C)

* src/alloc.c (initialize_symbol): Remove. All callers changed.

* src/data.c (Ffboundp, Fmakunbound, Ffmakunbound, Fsymbol_function)
  (Ffset): Call the corresponding Guile-Elisp functions.
  (Fbind_symbol): New function.

* src/emacs.c (string_from_scheme): New function.
  (main2): Resolve modules instead of defining them.
  Set `make-lisp-string'. Call `emacs!'.

* src/eval.c (For, Fand, Fcond, Fprog1, Fprog2, Fbind_symbol): Remove.

* src/lisp.h (XSYMBOL): Use `symbol-desc' from Guile-Elisp.
  (SYMBOL_NAME, SYMBOL_INTERNED_P, SYMBOL_FUNCTION):
  (WRAP1, WRAP2): New macros.
  (set_symbol_function, symbol_plist, set_symbol_plist): Call the
  corresponding Guile-Elisp function.

* lread.c (init_obarray): Use Guile-Elisp's unbound symbol object.
  (Ffind_symbol): Return the symbol if it is present in the obarray.

6 files changed, 72 insertions, 262 deletions

diff --git a/src/alloc.c b/src/alloc.c
index a300396514..63ba7b9a30 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -1165,22 +1165,6 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
 			   Symbol Allocation
  ***********************************************************************/
 
-void
-initialize_symbol (Lisp_Object val, Lisp_Object name)
-{
-  sym_t p;
-
-  scm_module_define (symbol_module, val, scm_c_make_vector (5, SCM_BOOL_F));
-  p = XSYMBOL (val);
-  SET_SYMBOL_SELF (p, val);
-  scm_module_define (plist_module, val, Qnil);
-  SET_SYMBOL_REDIRECT (p, SYMBOL_PLAINVAL);
-  SET_SYMBOL_VAL (p, Qunbound);
-  scm_module_define (function_module, val, Qnil);
-  SET_SYMBOL_CONSTANT (p, 0);
-  SET_SYMBOL_DECLARED_SPECIAL (p, 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.  */)
@@ -1192,7 +1176,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;
 }
 
diff --git a/src/data.c b/src/data.c
index 79e605b731..bd79e3cab3 100644
--- a/src/data.c
+++ b/src/data.c
@@ -653,46 +653,10 @@ global value outside of any lexical scope.  */)
   return (EQ (valcontents, Qunbound) ? Qnil : Qt);
 }
 
-/* FIXME: Make it an alias for function-symbol!  */
-DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0,
-       doc: /* Return t if SYMBOL's function definition is not void.  */)
-  (register Lisp_Object symbol)
-{
-  CHECK_SYMBOL (symbol);
-  return NILP (SYMBOL_FUNCTION (symbol)) ? Qnil : Qt;
-}
-
-DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0,
-       doc: /* Make SYMBOL's value be void.
-Return SYMBOL.  */)
-  (register Lisp_Object symbol)
-{
-  CHECK_SYMBOL (symbol);
-  if (SYMBOL_CONSTANT_P (symbol))
-    xsignal1 (Qsetting_constant, symbol);
-  Fset (symbol, Qunbound);
-  return symbol;
-}
-
-DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0,
-       doc: /* Make SYMBOL's function definition be nil.
-Return SYMBOL.  */)
-  (register Lisp_Object symbol)
-{
-  CHECK_SYMBOL (symbol);
-  if (NILP (symbol) || EQ (symbol, Qt))
-    xsignal1 (Qsetting_constant, symbol);
-  set_symbol_function (symbol, Qnil);
-  return symbol;
-}
-
-DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
-       doc: /* Return SYMBOL's function definition, or nil if that is void.  */)
-  (register Lisp_Object symbol)
-{
-  CHECK_SYMBOL (symbol);
-  return SYMBOL_FUNCTION (symbol);
-}
+WRAP1 (Ffboundp, "fboundp")
+WRAP1 (Fmakunbound, "makunbound")
+WRAP1 (Ffmakunbound, "fmakunbound")
+WRAP1 (Fsymbol_function, "symbol-function")
 
 DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0,
        doc: /* Return SYMBOL's property list.  */)
@@ -713,30 +677,7 @@ DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0,
   return name;
 }
 
-DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
-       doc: /* Set SYMBOL's function definition to DEFINITION, and return DEFINITION.  */)
-  (register Lisp_Object symbol, Lisp_Object definition)
-{
-  register Lisp_Object function;
-  CHECK_SYMBOL (symbol);
-
-  function = SYMBOL_FUNCTION (symbol);
-
-  if (!NILP (Vautoload_queue) && !NILP (function))
-    Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
-
-  if (AUTOLOADP (function))
-    Fput (symbol, Qautoload, XCDR (function));
-
-  /* Convert to eassert or remove after GC bug is found.  In the
-     meantime, check unconditionally, at a slight perf hit.  */
-  if (valid_lisp_object_p (definition) < 1)
-    emacs_abort ();
-
-  set_symbol_function (symbol, definition);
-
-  return definition;
-}
+WRAP2 (Ffset, "fset")
 
 DEFUN ("defalias", Fdefalias, Sdefalias, 2, 3, 0,
        doc: /* Set SYMBOL's function definition to DEFINITION.
@@ -3396,6 +3337,18 @@ A is a bool vector, B is t or nil, and I is an index into A.  */)
 }
 
 
+DEFUN ("bind-symbol", Fbind_symbol, Sbind_symbol, 3, 3, 0,
+       doc: /* Bind symbol.  */)
+  (Lisp_Object symbol, Lisp_Object value, Lisp_Object thunk)
+{
+  Lisp_Object val;
+  dynwind_begin ();
+  specbind (symbol, value);
+  val = call0 (thunk);
+  dynwind_end ();
+  return val;
+}
+
 void
 syms_of_data (void)
 {
diff --git a/src/emacs.c b/src/emacs.c
index ec3227262c..9e12a7c4f8 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -700,6 +700,16 @@ close_output_streams (void)
      _exit (EXIT_FAILURE);
 }
 
+static Lisp_Object
+string_from_scheme (Lisp_Object scheme_string)
+{
+  size_t nbytes;
+  char *c_string = scm_to_utf8_stringn (scheme_string, &nbytes);
+  return make_string_from_bytes (c_string,
+                                 scm_c_string_length (scheme_string),
+                                 nbytes);
+}
+
 static int main2 (void *, int, char **);
 
 int
@@ -1168,23 +1178,21 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
 
   if (!initialized)
     {
-      symbol_module = scm_call (scm_c_public_ref ("guile", "define-module*"),
-                                scm_list_1 (scm_from_utf8_symbol ("elisp-symbols")),
-                                scm_from_locale_keyword ("pure"),
-                                SCM_BOOL_T,
-                                SCM_UNDEFINED);
-      function_module = scm_call (scm_c_public_ref ("guile", "define-module*"),
-                                  scm_list_1 (scm_from_utf8_symbol ("elisp-functions")),
-                                  scm_from_locale_keyword ("pure"),
-                                  SCM_BOOL_T,
-                                  SCM_UNDEFINED);
-      plist_module = scm_call (scm_c_public_ref ("guile", "define-module*"),
-                                  scm_list_1 (scm_from_utf8_symbol ("elisp-plists")),
-                                  scm_from_locale_keyword ("pure"),
-                                  SCM_BOOL_T,
-                                  SCM_UNDEFINED);
+      /* scm_c_module_define (scm_c_resolve_module ("language elisp lexer"), */
+      /*                      "make-lisp-string", */
+      /*                      scm_c_make_gsubr ("make-lisp-string", 1, 0, 0, */
+      /*                                        string_from_scheme)); */
+      (void *) scm_c_resolve_module ("language elisp spec");
+      symbol_module = scm_c_resolve_module ("elisp-symbols");
+      function_module = scm_c_resolve_module ("elisp-functions");
+      plist_module = scm_c_resolve_module ("elisp-plists");
+      scm_set_current_module (scm_c_resolve_module ("guile-user"));
 
       init_alloc_once ();
+      scm_c_module_define (scm_c_resolve_module ("language elisp lexer"),
+                           "make-lisp-string",
+                           scm_c_make_gsubr ("make-lisp-string", 1, 0, 0,
+                                             string_from_scheme));
       init_guile ();
       init_fns_once ();
       init_obarray ();
@@ -1203,6 +1211,15 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem
          functions because it sets up symbols used by defsubr.  */
       syms_of_data ();
 
+      scm_call_7 (scm_c_public_ref ("language elisp runtime", "emacs!"),
+                  SYMBOL_FUNCTION (intern ("symbol-value")),
+                  SYMBOL_FUNCTION (intern ("set")),
+                  SYMBOL_FUNCTION (intern ("boundp")),
+                  SYMBOL_FUNCTION (intern ("default-value")),
+                  SYMBOL_FUNCTION (intern ("set-default")),
+                  SYMBOL_FUNCTION (intern ("default-boundp")),
+                  SYMBOL_FUNCTION (intern ("bind-symbol")));
+
       /* Call syms_of_xfaces before init_window_once because that
 	 function creates Vterminal_frame.  Termcap frames now use
 	 faces, and the face implementation uses some symbols as
diff --git a/src/eval.c b/src/eval.c
index 436953e911..cf086a8a3c 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -351,58 +351,6 @@ do_debug_on_call (Lisp_Object code)
   call_debugger (list1 (code));
 }
 
-/* NOTE!!! Every function that can call EVAL must protect its args
-   and temporaries from garbage collection while it needs them.
-   The definition of `For' shows what you have to do.  */
-
-DEFUN ("or", For, Sor, 0, UNEVALLED, 0,
-       doc: /* Eval args until one of them yields non-nil, then return that value.
-The remaining args are not evalled at all.
-If all args return nil, return nil.
-usage: (or CONDITIONS...)  */)
-  (Lisp_Object args)
-{
-  register Lisp_Object val = Qnil;
-  struct gcpro gcpro1;
-
-  GCPRO1 (args);
-
-  while (CONSP (args))
-    {
-      val = eval_sub (XCAR (args));
-      if (!NILP (val))
-	break;
-      args = XCDR (args);
-    }
-
-  UNGCPRO;
-  return val;
-}
-
-DEFUN ("and", Fand, Sand, 0, UNEVALLED, 0,
-       doc: /* Eval args until one of them yields nil, then return nil.
-The remaining args are not evalled at all.
-If no arg yields nil, return the last arg's value.
-usage: (and CONDITIONS...)  */)
-  (Lisp_Object args)
-{
-  register Lisp_Object val = Qt;
-  struct gcpro gcpro1;
-
-  GCPRO1 (args);
-
-  while (CONSP (args))
-    {
-      val = eval_sub (XCAR (args));
-      if (NILP (val))
-	break;
-      args = XCDR (args);
-    }
-
-  UNGCPRO;
-  return val;
-}
-
 DEFUN ("if", Fif, Sif, 2, UNEVALLED, 0,
        doc: /* If COND yields non-nil, do THEN, else do ELSE...
 Returns the value of THEN or the value of the last of the ELSE's.
@@ -423,39 +371,6 @@ usage: (if COND THEN ELSE...)  */)
   return Fprogn (XCDR (XCDR (args)));
 }
 
-DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0,
-       doc: /* Try each clause until one succeeds.
-Each clause looks like (CONDITION BODY...).  CONDITION is evaluated
-and, if the value is non-nil, this clause succeeds:
-then the expressions in BODY are evaluated and the last one's
-value is the value of the cond-form.
-If a clause has one element, as in (CONDITION), then the cond-form
-returns CONDITION's value, if that is non-nil.
-If no clause succeeds, cond returns nil.
-usage: (cond CLAUSES...)  */)
-  (Lisp_Object args)
-{
-  Lisp_Object val = args;
-  struct gcpro gcpro1;
-
-  GCPRO1 (args);
-  while (CONSP (args))
-    {
-      Lisp_Object clause = XCAR (args);
-      val = eval_sub (Fcar (clause));
-      if (!NILP (val))
-	{
-	  if (!NILP (XCDR (clause)))
-	    val = Fprogn (XCDR (clause));
-	  break;
-	}
-      args = XCDR (args);
-    }
-  UNGCPRO;
-
-  return val;
-}
-
 DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
        doc: /* Eval BODY forms sequentially and return value of last one.
 usage: (progn BODY...)  */)
@@ -485,44 +400,6 @@ unwind_body (Lisp_Object body)
   Fprogn (body);
 }
 
-DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0,
-       doc: /* Eval FIRST and BODY sequentially; return value from FIRST.
-The value of FIRST is saved during the evaluation of the remaining args,
-whose values are discarded.
-usage: (prog1 FIRST BODY...)  */)
-  (Lisp_Object args)
-{
-  Lisp_Object val;
-  Lisp_Object args_left;
-  struct gcpro gcpro1, gcpro2;
-
-  args_left = args;
-  val = args;
-  GCPRO2 (args, val);
-
-  val = eval_sub (XCAR (args_left));
-  while (CONSP (args_left = XCDR (args_left)))
-    eval_sub (XCAR (args_left));
-
-  UNGCPRO;
-  return val;
-}
-
-DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0,
-       doc: /* Eval FORM1, FORM2 and BODY sequentially; return value from FORM2.
-The value of FORM2 is saved during the evaluation of the
-remaining args, whose values are discarded.
-usage: (prog2 FORM1 FORM2 BODY...)  */)
-  (Lisp_Object args)
-{
-  struct gcpro gcpro1;
-
-  GCPRO1 (args);
-  eval_sub (XCAR (args));
-  UNGCPRO;
-  return Fprog1 (XCDR (args));
-}
-
 DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0,
        doc: /* Set each SYM to the value of its VAL.
 The symbols SYM are variables; they are literal (not evaluated).
@@ -2262,18 +2139,6 @@ DEFUN ("values", Fvalues, Svalues, 0, MANY, 0,
   return scm_c_values (args, nargs);
 }
 
-DEFUN ("bind-symbol", Fbind_symbol, Sbind_symbol, 3, 3, 0,
-       doc: /* Bind symbol.  */)
-  (Lisp_Object symbol, Lisp_Object value, Lisp_Object thunk)
-{
-  Lisp_Object val;
-  dynwind_begin ();
-  specbind (symbol, value);
-  val = call0 (thunk);
-  dynwind_end ();
-  return val;
-}
-
 DEFUN ("apply", Fapply, Sapply, 1, MANY, 0,
        doc: /* Call FUNCTION with our remaining args, using our last arg as list of args.
 Then return the value FUNCTION returns.
diff --git a/src/lisp.h b/src/lisp.h
index cd120c7889..c92431d04a 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -654,16 +654,7 @@ extern Lisp_Object Qt, Qnil, Qt_, Qnil_;
 
 typedef Lisp_Object sym_t;
 
-INLINE sym_t
-XSYMBOL (Lisp_Object a)
-{
-  Lisp_Object tem;
-  if (EQ (a, Qt)) a = Qt_;
-  if (EQ (a, Qnil)) a = Qnil_;
-  eassert (SYMBOLP (a));
-  tem = scm_variable_ref (scm_module_lookup (symbol_module, a));
-  return tem;
-}
+INLINE sym_t XSYMBOL (Lisp_Object a);
 
 /* Pseudovector types.  */
 
@@ -1350,9 +1341,7 @@ SET_SYMBOL_FWD (sym_t sym, union Lisp_Fwd *v)
 INLINE Lisp_Object
 SYMBOL_NAME (Lisp_Object sym)
 {
-  if (EQ (sym, Qnil)) sym = Qnil_;
-  if (EQ (sym, Qt)) sym = Qt_;
-  return build_string (scm_to_locale_string (scm_symbol_to_string (sym)));
+  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.  */
@@ -1360,17 +1349,15 @@ SYMBOL_NAME (Lisp_Object sym)
 INLINE bool
 SYMBOL_INTERNED_P (Lisp_Object sym)
 {
-  if (EQ (sym, Qnil)) sym = Qnil_;
-  if (EQ (sym, Qt)) sym = Qt_;
+  if (EQ (sym, Qnil)) return true;
+  if (EQ (sym, Qt)) return true;
   return scm_is_true (scm_symbol_interned_p (sym));
 }
 
 INLINE Lisp_Object
 SYMBOL_FUNCTION (Lisp_Object sym)
 {
-  if (EQ (sym, Qnil)) sym = Qnil_;
-  if (EQ (sym, Qt)) sym = Qt_;
-  return scm_variable_ref (scm_module_lookup (function_module, sym));
+  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
@@ -2403,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)
@@ -2755,25 +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)
 {
-  if (EQ (sym, Qnil)) sym = Qnil_;
-  if (EQ (sym, Qt)) sym = Qt_;
-  scm_variable_set_x (scm_module_lookup (function_module, sym), function);
+  scm_call_2 (scm_c_public_ref ("language elisp runtime", "set-symbol-function!"),
+              sym, function);
 }
 
 INLINE Lisp_Object
 symbol_plist (Lisp_Object sym)
 {
-  if (EQ (sym, Qnil)) sym = Qnil_;
-  if (EQ (sym, Qt)) sym = Qt_;
-  return scm_variable_ref (scm_module_lookup (plist_module, sym));
+  return scm_call_1 (scm_c_public_ref ("language elisp runtime", "symbol-plist"),
+                     sym);
 }
 
 INLINE void
 set_symbol_plist (Lisp_Object sym, Lisp_Object plist)
 {
-  if (EQ (sym, Qnil)) sym = Qnil_;
-  if (EQ (sym, Qt)) sym = Qt_;
-  scm_variable_set_x (scm_module_lookup (plist_module, sym), plist);
+  scm_call_2 (scm_c_public_ref ("language elisp runtime", "set-symbol-plist!"),
+              sym, plist);
 }
 
 /* Buffer-local (also frame-local) variable access functions.  */
@@ -4018,5 +4005,12 @@ functionp (Lisp_Object object)
     }
 }
 
+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 */
diff --git a/src/lread.c b/src/lread.c
index 39b49ab9f1..b2ed3bb232 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3806,8 +3806,7 @@ DEFUN ("find-symbol", Ffind_symbol, Sfind_symbol, 1, 2, 0,
 
   sstring = scm_from_utf8_stringn (SSDATA (string), SBYTES (string));
   tem = scm_find_symbol (sstring, obhash (obarray));
-  if (scm_is_true (tem)
-      && scm_is_true (scm_module_variable (symbol_module, tem)))
+  if (scm_is_true (tem))
     {
       if (EQ (tem, Qnil_))
         tem = Qnil;
@@ -3840,7 +3839,6 @@ it defaults to the value of `obarray'.  */)
   sym = scm_intern (scm_from_utf8_stringn (SSDATA (string),
                                            SBYTES (string)),
                     obhash (obarray));
-  initialize_symbol (sym, string);
 
   if ((SREF (string, 0) == ':')
       && EQ (obarray, initial_obarray))
@@ -3972,7 +3970,7 @@ init_obarray (void)
   SET_SYMBOL_CONSTANT (XSYMBOL (Qt_), 1);
   SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (Qt_), 1);
 
-  Qunbound = Fmake_symbol (build_pure_c_string ("unbound"));
+  Qunbound = scm_c_public_ref ("language elisp runtime", "unbound");
   SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound);
 
   /* Qt is correct even if CANNOT_DUMP.  loadup.el will set to nil at end.  */