X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=src%2Fsymeval.h;h=141430b881165546e1ab5bfb2494193ec7efb868;hb=b2796f83b94d04d36cb97efe94dcda51af55ea75;hp=fc4a3ad079dea144ccc74b80840ceafd9dbf6fd6;hpb=6883ee56ec887c2c48abe5b06b5e66aa74031910;p=chise%2Fxemacs-chise.git diff --git a/src/symeval.h b/src/symeval.h index fc4a3ad..141430b 100644 --- a/src/symeval.h +++ b/src/symeval.h @@ -1,5 +1,6 @@ /* 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. @@ -23,14 +24,14 @@ Boston, MA 02111-1307, USA. */ /* 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 { /* The following tags use the 'symbol_value_forward' structure and are strictly for variables DEFVARed on the C level. */ - SYMVAL_FIXNUM_FORWARD, /* Forward C "int" */ + SYMVAL_FIXNUM_FORWARD, /* Forward C "Fixnum", really "EMACS_INT" */ SYMVAL_CONST_FIXNUM_FORWARD, /* Same, but can't be set */ SYMVAL_BOOLEAN_FORWARD, /* Forward C boolean ("int") */ SYMVAL_CONST_BOOLEAN_FORWARD, /* Same, but can't be set */ @@ -69,18 +70,21 @@ enum symbol_value_type #endif }; +/* Underlying C type used to implement DEFVAR_INT */ +typedef EMACS_INT Fixnum; + 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 ***********/ @@ -99,8 +103,9 @@ void print_symbol_value_magic (Lisp_Object, Lisp_Object, int); 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.); @@ -122,27 +127,22 @@ struct symbol_value_forward 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 */ @@ -271,68 +271,121 @@ DECLARE_LRECORD (symbol_value_varalias, struct symbol_value_varalias); #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 +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_HEADER(lname, c_location, forward_type) \ - DEFVAR_MAGIC_HEADER (lname, c_location, forward_type, 0) +#define DEFVAR_SYMVAL_FWD_INT(lname, c_location, forward_type, magicfun) do{ \ + DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun); \ + dump_add_opaque_int (c_location); \ +} 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_FIXNUM(lname, c_location, forward_type, magicfun) do{ \ + DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun); \ + dump_add_opaque_fixnum (c_location); \ } 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); \ + { \ + Lisp_Object *DSF_location = c_location; /* Type check */ \ + staticpro (DSF_location); \ + if (EQ (*DSF_location, Qnull_pointer)) *DSF_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_FIXNUM (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_FIXNUM (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_FIXNUM (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) + +void flush_all_buffer_local_cache (void); -#endif /* _XEMACS_SYMEVAL_H_ */ +#endif /* INCLUDED_symeval_h_ */