/* Definitions of symbol-value forwarding for XEmacs Lisp interpreter.
Copyright (C) 1985, 1986, 1987, 1992, 1993 Free Software Foundation, Inc.
+ Copyright (C) 2000 Ben Wing.
This file is part of XEmacs.
/* Fsymbol_value checks whether XSYMBOL (sym)->value is one of these,
* and does weird magic stuff if so */
-#ifndef _XEMACS_SYMEVAL_H_
-#define _XEMACS_SYMEVAL_H_
+#ifndef INCLUDED_symeval_h_
+#define INCLUDED_symeval_h_
enum symbol_value_type
{
struct symbol_value_magic
{
struct lcrecord_header lcheader;
+ void *value;
enum symbol_value_type type;
};
-#define SYMBOL_VALUE_MAGIC_P(x) \
- (LRECORDP (x) \
- && (XRECORD_LHEADER_IMPLEMENTATION (x)->printer \
- == print_symbol_value_magic))
+#define SYMBOL_VALUE_MAGIC_P(x) \
+(LRECORDP (x) && \
+ XRECORD_LHEADER (x)->type <= lrecord_type_max_symbol_value_magic)
#define XSYMBOL_VALUE_MAGIC_TYPE(v) \
(((struct symbol_value_magic *) XPNTR (v))->type)
-#define XSETSYMBOL_VALUE_MAGIC(s, p) XSETOBJ (s, Lisp_Type_Record, p)
+#define XSETSYMBOL_VALUE_MAGIC(s, p) XSETOBJ (s, p)
void print_symbol_value_magic (Lisp_Object, Lisp_Object, int);
/********** The various different symbol-value-magic types ***********/
struct symbol_value_forward
{
struct symbol_value_magic magic;
- /* void *forward; -- use magic.lcheader.next instead */
- /* Function controlling magic behavior of this forward variable.
+
+ /* `magicfun' is a function controlling the magic behavior of this
+ forward variable.
SYM is the symbol being operated on (read, set, etc.);
that the only console-local variables currently existing
are built-in ones, because others can't be created.)
- FLAGS gives more information about the operation being
- performed.
+ FLAGS gives more information about the operation being performed.
- The return value indicates what the magic function actually
- did.
+ The return value indicates what the magic function actually did.
Currently FLAGS and the return value are not used. This
function is only called when the value of a forward variable
is about to be changed. Note that this can occur explicitly
through a call to `set', `setq', `set-default', or `setq-default',
- or implicitly by the current buffer being changed.
-
- */
-
+ or implicitly by the current buffer being changed. */
int (*magicfun) (Lisp_Object sym, Lisp_Object *val, Lisp_Object in_object,
int flags);
};
DECLARE_LRECORD (symbol_value_forward, struct symbol_value_forward);
#define XSYMBOL_VALUE_FORWARD(x) \
XRECORD (x, symbol_value_forward, struct symbol_value_forward)
-#define symbol_value_forward_forward(m) ((void *)((m)->magic.lcheader.next))
+#define symbol_value_forward_forward(m) ((void *)((m)->magic.value))
#define symbol_value_forward_magicfun(m) ((m)->magicfun)
/* 2. symbol-value-buffer-local */
#define symbol_value_varalias_aliasee(m) ((m)->aliasee)
#define symbol_value_varalias_shadowed(m) ((m)->shadowed)
-/* DEFSUBR (Fname);
- is how we define the symbol for function `Fname' at start-up time. */
+/* To define a Lisp primitive function using a C function `Fname', do this:
+ DEFUN ("name, Fname, ...); // at top level in foo.c
+ DEFSUBR (Fname); // in syms_of_foo();
+*/
+void defsubr (Lisp_Subr *);
#define DEFSUBR(Fname) defsubr (&S##Fname)
-void defsubr (struct Lisp_Subr *);
-void defsymbol (Lisp_Object *location, CONST char *name);
-
-void defkeyword (Lisp_Object *location, CONST char *name);
-
-void deferror (Lisp_Object *symbol, CONST char *name,
- CONST char *message, Lisp_Object inherits_from);
+/* To define a Lisp primitive macro using a C function `Fname', do this:
+ DEFUN ("name, Fname, ...); // at top level in foo.c
+ DEFSUBR_MACRO (Fname); // in syms_of_foo();
+*/
+void defsubr_macro (Lisp_Subr *);
+#define DEFSUBR_MACRO(Fname) defsubr_macro (&S##Fname)
+
+void defsymbol_massage_name (Lisp_Object *location, const char *name);
+void defsymbol_massage_name_nodump (Lisp_Object *location, const char *name);
+void defsymbol_massage_multiword_predicate (Lisp_Object *location,
+ const char *name);
+void defsymbol_massage_multiword_predicate_nodump (Lisp_Object *location,
+ const char *name);
+void defsymbol (Lisp_Object *location, const char *name);
+void defsymbol_nodump (Lisp_Object *location, const char *name);
+
+#define DEFSYMBOL(name) defsymbol_massage_name (&name, #name)
+#define DEFSYMBOL_NO_DUMP(name) defsymbol_massage_name_nodump (&name, #name)
+#define DEFSYMBOL_MULTIWORD_PREDICATE(name) \
+ defsymbol_massage_multiword_predicate (&name, #name)
+#define DEFSYMBOL_MULTIWORD_PREDICATE_NO_DUMP(name) \
+ defsymbol_massage_multiword_predicate_nodump (&name, #name)
+
+void defkeyword (Lisp_Object *location, const char *name);
+void defkeyword_massage_name (Lisp_Object *location, const char *name);
+#define DEFKEYWORD(name) defkeyword_massage_name (&name, #name)
+
+void deferror (Lisp_Object *symbol, const char *name,
+ const char *message, Lisp_Object inherits_from);
+void deferror_massage_name (Lisp_Object *symbol, const char *name,
+ const char *message, Lisp_Object inherits_from);
+void deferror_massage_name_and_message (Lisp_Object *symbol, const char *name,
+ Lisp_Object inherits_from);
+#define DEFERROR(name, message, inherits_from) \
+ deferror_massage_name (&name, #name, message, inherits_from)
+/* In this case, the error message is the same as the name, modulo some
+ prettifying */
+#define DEFERROR_STANDARD(name, inherits_from) \
+ deferror_massage_name_and_message (&name, #name, inherits_from)
/* Macros we use to define forwarded Lisp variables.
These are used in the syms_of_FILENAME functions. */
-void defvar_mumble (CONST char *names, CONST void *magic, size_t sizeof_magic);
-
-#ifdef USE_INDEXED_LRECORD_IMPLEMENTATION
-# define symbol_value_forward_lheader_initializer { 1, 0, 0 }
-#else
-# define symbol_value_forward_lheader_initializer \
- { lrecord_symbol_value_forward }
-#endif
-
-#define DEFVAR_HEADER(lname, c_location, forward_type) \
- DEFVAR_MAGIC_HEADER (lname, c_location, forward_type, 0)
+void defvar_magic (const char *symbol_name, const struct symbol_value_forward *magic);
+
+#define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magicfun) do { \
+ static const struct symbol_value_forward I_hate_C = \
+ { /* struct symbol_value_forward */ \
+ { /* struct symbol_value_magic */ \
+ { /* struct lcrecord_header */ \
+ { /* struct lrecord_header */ \
+ lrecord_type_symbol_value_forward, /* lrecord_type_index */ \
+ 1, /* mark bit */ \
+ 1, /* c_readonly bit */ \
+ 1 /* lisp_readonly bit */ \
+ }, \
+ 0, /* next */ \
+ 0, /* uid */ \
+ 0 /* free */ \
+ }, \
+ c_location, \
+ forward_type \
+ }, \
+ magicfun \
+ }; \
+ defvar_magic ((lname), &I_hate_C); \
+} while (0)
-#define DEFVAR_MAGIC_HEADER(lname, c_location, forward_type, magicfun) do { \
- static CONST struct symbol_value_forward I_hate_C \
- = { { { symbol_value_forward_lheader_initializer, \
- (struct lcrecord_header *) (c_location), 69 }, \
- forward_type }, magicfun }; \
- defvar_mumble ((lname), &I_hate_C, sizeof (I_hate_C)); \
+#define DEFVAR_SYMVAL_FWD_INT(lname, c_location, forward_type, magicfun) do{ \
+ DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun); \
+ dumpopaque (c_location, sizeof(int)); \
} while (0)
-#define DEFVAR_HEADER_GCPRO(lname, c_location, symbol_value_type) do { \
- DEFVAR_HEADER (lname, c_location, symbol_value_type); \
- staticpro (c_location); \
+#define DEFVAR_SYMVAL_FWD_OBJECT(lname, c_location, forward_type, magicfun) do{ \
+ DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun); \
+ staticpro (c_location); \
+ if (EQ (*c_location, Qnull_pointer)) *c_location = Qnil; \
} while (0)
-#define DEFVAR_LISP(lname, c_location) \
- DEFVAR_HEADER_GCPRO (lname, c_location, SYMVAL_OBJECT_FORWARD)
+#define DEFVAR_LISP(lname, c_location) \
+ DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_OBJECT_FORWARD, 0)
#define DEFVAR_CONST_LISP(lname, c_location) \
- DEFVAR_HEADER_GCPRO (lname, c_location, SYMVAL_CONST_OBJECT_FORWARD)
+ DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_CONST_OBJECT_FORWARD, 0)
#define DEFVAR_SPECIFIER(lname, c_location) \
- DEFVAR_HEADER_GCPRO (lname, c_location, SYMVAL_CONST_SPECIFIER_FORWARD)
+ DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_CONST_SPECIFIER_FORWARD, 0)
#define DEFVAR_INT(lname, c_location) \
- DEFVAR_HEADER (lname, c_location, SYMVAL_FIXNUM_FORWARD)
+ DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_FIXNUM_FORWARD, 0)
#define DEFVAR_CONST_INT(lname, c_location) \
- DEFVAR_HEADER (lname, c_location, SYMVAL_CONST_FIXNUM_FORWARD)
+ DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_CONST_FIXNUM_FORWARD, 0)
#define DEFVAR_BOOL(lname, c_location) \
- DEFVAR_HEADER (lname, c_location, SYMVAL_BOOLEAN_FORWARD)
+ DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_BOOLEAN_FORWARD, 0)
#define DEFVAR_CONST_BOOL(lname, c_location) \
- DEFVAR_HEADER (lname, c_location, SYMVAL_CONST_BOOLEAN_FORWARD)
-
-#define DEFVAR_LISP_MAGIC(lname, c_location, magicfun) do { \
- DEFVAR_MAGIC_HEADER (lname, c_location, SYMVAL_OBJECT_FORWARD, magicfun); \
- staticpro (c_location); \
-} while (0)
+ DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_CONST_BOOLEAN_FORWARD, 0)
+#define DEFVAR_LISP_MAGIC(lname, c_location, magicfun) \
+ DEFVAR_SYMVAL_FWD_OBJECT (lname, c_location, SYMVAL_OBJECT_FORWARD, magicfun)
#define DEFVAR_INT_MAGIC(lname, c_location, magicfun) \
- DEFVAR_MAGIC_HEADER (lname, c_location, SYMVAL_FIXNUM_FORWARD, magicfun);
+ DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_FIXNUM_FORWARD, magicfun)
#define DEFVAR_BOOL_MAGIC(lname, c_location, magicfun) \
- DEFVAR_MAGIC_HEADER (lname, c_location, SYMVAL_BOOLEAN_FORWARD, magicfun);
+ DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_BOOLEAN_FORWARD, magicfun)
-#endif /* _XEMACS_SYMEVAL_H_ */
+#endif /* INCLUDED_symeval_h_ */
projects / chise / xemacs-chise.git.1 / blobdiff