Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound;
Lisp_Object Qlocal_predicate, Qmake_local;
-Lisp_Object Qboundp, Qfboundp, Qglobally_boundp, Qmakunbound;
+Lisp_Object Qboundp, Qglobally_boundp, Qmakunbound;
Lisp_Object Qsymbol_value, Qset, Qdefault_boundp, Qdefault_value;
Lisp_Object Qset_default, Qsetq_default;
Lisp_Object Qmake_variable_buffer_local, Qmake_local_variable;
\f
static Lisp_Object
-mark_symbol (Lisp_Object obj, void (*markobj) (Lisp_Object))
+mark_symbol (Lisp_Object obj)
{
- struct Lisp_Symbol *sym = XSYMBOL (obj);
+ Lisp_Symbol *sym = XSYMBOL (obj);
Lisp_Object pname;
- markobj (sym->value);
- markobj (sym->function);
+ mark_object (sym->value);
+ mark_object (sym->function);
XSETSTRING (pname, sym->name);
- markobj (pname);
+ mark_object (pname);
if (!symbol_next (sym))
return sym->plist;
else
{
- markobj (sym->plist);
+ mark_object (sym->plist);
/* Mark the rest of the symbols in the obarray hash-chain */
sym = symbol_next (sym);
XSETSYMBOL (obj, sym);
}
}
+static const struct lrecord_description symbol_description[] = {
+ { XD_LISP_OBJECT, offsetof (Lisp_Symbol, next) },
+ { XD_LISP_OBJECT, offsetof (Lisp_Symbol, name) },
+ { XD_LISP_OBJECT, offsetof (Lisp_Symbol, value) },
+ { XD_LISP_OBJECT, offsetof (Lisp_Symbol, function) },
+ { XD_LISP_OBJECT, offsetof (Lisp_Symbol, plist) },
+ { XD_END }
+};
+
DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol,
mark_symbol, print_symbol, 0, 0, 0,
- struct Lisp_Symbol);
+ symbol_description, Lisp_Symbol);
\f
/**********************************************************************/
(string, obarray))
{
Lisp_Object object, *ptr;
- struct Lisp_Symbol *symbol;
+ Lisp_Symbol *symbol;
Bytecount len;
if (NILP (obarray)) obarray = Vobarray;
/* #### Bug! (intern-soft "nil") returns nil. Perhaps we should
add a DEFAULT-IF-NOT-FOUND arg, like in get. */
Lisp_Object tem;
- struct Lisp_String *string;
+ Lisp_String *string;
if (NILP (obarray)) obarray = Vobarray;
obarray = check_obarray (obarray);
(name, obarray))
{
Lisp_Object tem;
- struct Lisp_String *string;
+ Lisp_String *string;
int hash;
if (NILP (obarray)) obarray = Vobarray;
oblookup (Lisp_Object obarray, CONST Bufbyte *ptr, Bytecount size)
{
int hash, obsize;
- struct Lisp_Symbol *tail;
+ Lisp_Symbol *tail;
Lisp_Object bucket;
if (!VECTORP (obarray) ||
if (SYMBOLP (tail))
while (1)
{
- struct Lisp_Symbol *next;
+ Lisp_Symbol *next;
if ((*fn) (tail, arg))
return;
next = symbol_next (XSYMBOL (tail));
SYMVAL_CONST_SPECIFIER_FORWARD:
(declare with DEFVAR_SPECIFIER)
- Exactly like SYMVAL_CONST_OBJECT_FORWARD except that error message
- you get when attempting to set the value says to use
+ Exactly like SYMVAL_CONST_OBJECT_FORWARD except that the error
+ message you get when attempting to set the value says to use
`set-specifier' instead.
SYMVAL_CURRENT_BUFFER_FORWARD:
symbol to operate on. */
static Lisp_Object
-mark_symbol_value_buffer_local (Lisp_Object obj,
- void (*markobj) (Lisp_Object))
+mark_symbol_value_buffer_local (Lisp_Object obj)
{
struct symbol_value_buffer_local *bfwd;
#endif
bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
- markobj (bfwd->default_value);
- markobj (bfwd->current_value);
- markobj (bfwd->current_buffer);
+ mark_object (bfwd->default_value);
+ mark_object (bfwd->current_value);
+ mark_object (bfwd->current_buffer);
return bfwd->current_alist_element;
}
static Lisp_Object
-mark_symbol_value_lisp_magic (Lisp_Object obj,
- void (*markobj) (Lisp_Object))
+mark_symbol_value_lisp_magic (Lisp_Object obj)
{
struct symbol_value_lisp_magic *bfwd;
int i;
bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
for (i = 0; i < MAGIC_HANDLER_MAX; i++)
{
- markobj (bfwd->handler[i]);
- markobj (bfwd->harg[i]);
+ mark_object (bfwd->handler[i]);
+ mark_object (bfwd->harg[i]);
}
return bfwd->shadowed;
}
static Lisp_Object
-mark_symbol_value_varalias (Lisp_Object obj,
- void (*markobj) (Lisp_Object))
+mark_symbol_value_varalias (Lisp_Object obj)
{
struct symbol_value_varalias *bfwd;
assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
bfwd = XSYMBOL_VALUE_VARALIAS (obj);
- markobj (bfwd->shadowed);
+ mark_object (bfwd->shadowed);
return bfwd->aliasee;
}
write_c_string (buf, printcharfun);
}
+static const struct lrecord_description symbol_value_forward_description[] = {
+ { XD_END }
+};
+
+static const struct lrecord_description symbol_value_buffer_local_description[] = {
+ { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, default_value) },
+ { XD_LO_RESET_NIL, offsetof (struct symbol_value_buffer_local, current_value), 3 },
+ { XD_END }
+};
+
+static const struct lrecord_description symbol_value_lisp_magic_description[] = {
+ { XD_LISP_OBJECT_ARRAY, offsetof (struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 },
+ { XD_END }
+};
+
+static const struct lrecord_description symbol_value_varalias_description[] = {
+ { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, aliasee) },
+ { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, shadowed) },
+ { XD_END }
+};
+
DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
symbol_value_forward,
this_one_is_unmarkable,
print_symbol_value_magic, 0, 0, 0,
+ symbol_value_forward_description,
struct symbol_value_forward);
DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
symbol_value_buffer_local,
mark_symbol_value_buffer_local,
print_symbol_value_magic, 0, 0, 0,
+ symbol_value_buffer_local_description,
struct symbol_value_buffer_local);
DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
symbol_value_lisp_magic,
mark_symbol_value_lisp_magic,
print_symbol_value_magic, 0, 0, 0,
+ symbol_value_lisp_magic_description,
struct symbol_value_lisp_magic);
DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
symbol_value_varalias,
mark_symbol_value_varalias,
print_symbol_value_magic, 0, 0, 0,
+ symbol_value_varalias_description,
struct symbol_value_varalias);
\f
if (magicfun)
magicfun (sym, &newval, Qnil, 0);
*((int *) symbol_value_forward_forward (fwd))
- = ((NILP (newval)) ? 0 : 1);
+ = !NILP (newval);
return;
case SYMVAL_OBJECT_FORWARD:
/* This can also get called while we're preparing to shutdown.
#### What should really happen in that case? Should we
actually fix things so we can't get here in that case? */
+#ifndef PDUMP
assert (!initialized || preparing_for_armageddon);
+#endif
con = 0;
}
/* This can also get called while we're preparing to shutdown.
#### What should really happen in that case? Should we
actually fix things so we can't get here in that case? */
+#ifndef PDUMP
assert (!initialized || preparing_for_armageddon);
+#endif
con = 0;
}
(symbol, newval))
{
REGISTER Lisp_Object valcontents;
- struct Lisp_Symbol *sym;
+ Lisp_Symbol *sym;
/* remember, we're called by Fmakunbound() as well */
CHECK_SYMBOL (symbol);
reject_constant_symbols (symbol, newval, 0,
UNBOUNDP (newval) ? Qmakunbound : Qset);
- retry_2:
-
switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
{
case SYMVAL_LISP_MAGIC:
{
- Lisp_Object retval;
-
if (UNBOUNDP (newval))
- retval = maybe_call_magic_handler (symbol, Qmakunbound, 0);
+ {
+ maybe_call_magic_handler (symbol, Qmakunbound, 0);
+ return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = Qunbound;
+ }
else
- retval = maybe_call_magic_handler (symbol, Qset, 1, newval);
- if (!UNBOUNDP (retval))
- return newval;
- valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
- /* semi-change-o */
- goto retry_2;
+ {
+ maybe_call_magic_handler (symbol, Qset, 1, newval);
+ return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = newval;
+ }
}
case SYMVAL_VARALIAS:
Lisp_Object legerdemain;
struct symbol_value_lisp_magic *bfwd;
- assert (nargs >= 0 && nargs < 20);
+ assert (nargs >= 0 && nargs < countof (args));
legerdemain = XSYMBOL (sym)->value;
assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
void
init_symbols_once_early (void)
{
-#ifndef Qzero
- Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
-#endif
-
-#ifndef Qnull_pointer
- /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
- so the following is actually a no-op. */
- XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
-#endif
+ reinit_symbols_once_early ();
/* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
called the first time. */
defsymbol (&Qt, "t");
XSYMBOL (Qt)->value = Qt; /* Veritas aetera */
Vquit_flag = Qnil;
+
+ pdump_wire (&Qnil);
+ pdump_wire (&Qunbound);
+ pdump_wire (&Vquit_flag);
+}
+
+void
+reinit_symbols_once_early (void)
+{
+#ifndef Qzero
+ Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
+#endif
+
+#ifndef Qnull_pointer
+ /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
+ so the following is actually a no-op. */
+ XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
+#endif
+}
+
+void
+defsymbol_nodump (Lisp_Object *location, CONST char *name)
+{
+ *location = Fintern (make_string_nocopy ((CONST Bufbyte *) name,
+ strlen (name)),
+ Qnil);
+ staticpro_nodump (location);
}
void
* FIXME: Should newsubr be staticpro()'ed? I dont think so but I need
* a guru to check.
*/
-#define check_module_subr() \
-do { \
- if (initialized) { \
- struct Lisp_Subr *newsubr; \
- newsubr = (Lisp_Subr *)xmalloc(sizeof(struct Lisp_Subr)); \
- memcpy (newsubr, subr, sizeof(struct Lisp_Subr)); \
- subr->doc = (CONST char *)newsubr; \
- subr = newsubr; \
- } \
+#define check_module_subr() \
+do { \
+ if (initialized) { \
+ Lisp_Subr *newsubr = (Lisp_Subr *) xmalloc (sizeof (Lisp_Subr)); \
+ memcpy (newsubr, subr, sizeof (Lisp_Subr)); \
+ subr->doc = (CONST char *)newsubr; \
+ subr = newsubr; \
+ } \
} while (0)
#else /* ! HAVE_SHLIB */
#define check_module_subr()
assert (SYMBOLP (inherits_from));
conds = Fget (inherits_from, Qerror_conditions, Qnil);
- pure_put (*symbol, Qerror_conditions, Fcons (*symbol, conds));
+ Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds));
/* NOT build_translated_string (). This function is called at load time
and the string needs to get translated at run time. (This happens
in the function (display-error) in cmdloop.el.) */
- pure_put (*symbol, Qerror_message, build_string (messuhhj));
+ Fput (*symbol, Qerror_message, build_string (messuhhj));
}
void
defsymbol (&Qmake_local, "make-local");
defsymbol (&Qboundp, "boundp");
- defsymbol (&Qfboundp, "fboundp");
defsymbol (&Qglobally_boundp, "globally-boundp");
defsymbol (&Qmakunbound, "makunbound");
defsymbol (&Qsymbol_value, "symbol-value");
projects / chise / xemacs-chise.git- / blobdiff