From d1c3da7b87087d7da58128aaf84afaeaeae971eb Mon Sep 17 00:00:00 2001 From: BT Templeton Date: Mon, 23 Sep 2013 03:40:05 -0400 Subject: [PATCH] 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. --- src/alloc.c | 17 ------- src/data.c | 81 +++++++------------------------ src/emacs.c | 47 ++++++++++++------ src/eval.c | 135 ---------------------------------------------------- src/lisp.h | 48 ++++++++----------- src/lread.c | 6 +-- 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. */ -- 2.20.1