* 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.
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. */)
val = scm_make_symbol (scm_from_utf8_stringn (SSDATA (name),
SBYTES (name)));
- initialize_symbol (val, name);
return val;
}
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. */)
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.
}
\f
+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;
+}
+\f
void
syms_of_data (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
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 ();
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
call_debugger (list1 (code));
}
\f
-/* 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.
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...) */)
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).
return scm_c_values (args, nargs);
}
\f
-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;
-}
-\f
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.
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. */
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. */
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
#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)
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. */
}
}
+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 */
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;
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))
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. */
HCoop / bpt / emacs.git / commitdiff