Mercurial > hg > xemacs-beta
diff src/symeval.h @ 5118:e0db3c197671 ben-lisp-object
merge up to latest default branch, doesn't compile yet
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Sat, 26 Dec 2009 21:18:49 -0600 |
parents | 8f1ee2d15784 |
children | d1247f3cc363 |
line wrap: on
line diff
--- a/src/symeval.h Sat Dec 26 00:20:27 2009 -0600 +++ b/src/symeval.h Sat Dec 26 21:18:49 2009 -0600 @@ -141,7 +141,7 @@ int (*magicfun) (Lisp_Object sym, Lisp_Object *val, Lisp_Object in_object, int flags); }; -DECLARE_LRECORD (symbol_value_forward, struct symbol_value_forward); +DECLARE_LISP_OBJECT (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.value)) @@ -228,7 +228,7 @@ Lisp_Object current_buffer; Lisp_Object current_alist_element; }; -DECLARE_LRECORD (symbol_value_buffer_local, struct symbol_value_buffer_local); +DECLARE_LISP_OBJECT (symbol_value_buffer_local, struct symbol_value_buffer_local); #define XSYMBOL_VALUE_BUFFER_LOCAL(x) \ XRECORD (x, symbol_value_buffer_local, struct symbol_value_buffer_local) #define SYMBOL_VALUE_BUFFER_LOCAL_P(x) RECORDP (x, symbol_value_buffer_local) @@ -253,7 +253,7 @@ Lisp_Object harg[MAGIC_HANDLER_MAX]; Lisp_Object shadowed; }; -DECLARE_LRECORD (symbol_value_lisp_magic, struct symbol_value_lisp_magic); +DECLARE_LISP_OBJECT (symbol_value_lisp_magic, struct symbol_value_lisp_magic); #define XSYMBOL_VALUE_LISP_MAGIC(x) \ XRECORD (x, symbol_value_lisp_magic, struct symbol_value_lisp_magic) #define SYMBOL_VALUE_LISP_MAGIC_P(x) RECORDP (x, symbol_value_lisp_magic) @@ -266,7 +266,7 @@ Lisp_Object aliasee; Lisp_Object shadowed; }; -DECLARE_LRECORD (symbol_value_varalias, struct symbol_value_varalias); +DECLARE_LISP_OBJECT (symbol_value_varalias, struct symbol_value_varalias); #define XSYMBOL_VALUE_VARALIAS(x) \ XRECORD (x, symbol_value_varalias, struct symbol_value_varalias) #define SYMBOL_VALUE_VARALIAS_P(x) RECORDP (x, symbol_value_varalias) @@ -277,7 +277,7 @@ DEFUN ("name, Fname, ...); // at top level in foo.c DEFSUBR (Fname); // in syms_of_foo(); */ -#ifdef MC_ALLOC +#ifdef NEW_GC MODULE_API void defsubr (Lisp_Subr *); #define DEFSUBR_MC_ALLOC(Fname) \ S##Fname= (struct Lisp_Subr *) mc_alloc (sizeof (struct Lisp_Subr)); \ @@ -309,7 +309,7 @@ defsubr_macro (S##Fname); \ } while (0) -#else /* not MC_ALLOC */ +#else /* not NEW_GC */ /* 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(); @@ -323,7 +323,7 @@ */ MODULE_API void defsubr_macro (Lisp_Subr *); #define DEFSUBR_MACRO(Fname) defsubr_macro (&S##Fname) -#endif /* not MC_ALLOC */ +#endif /* not NEW_GC */ MODULE_API void defsymbol_massage_name (Lisp_Object *location, const char *name); @@ -396,7 +396,7 @@ MODULE_API void defvar_magic (const char *symbol_name, const struct symbol_value_forward *magic); -#ifdef MC_ALLOC +#ifdef NEW_GC #define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magic_fun) \ do \ { \ @@ -413,7 +413,7 @@ \ defvar_magic ((lname), I_hate_C); \ } while (0) -#else /* not MC_ALLOC */ +#else /* not NEW_GC */ #define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magicfun) \ do \ { \ @@ -439,7 +439,7 @@ }; \ defvar_magic ((lname), &I_hate_C); \ } while (0) -#endif /* not MC_ALLOC */ +#endif /* not NEW_GC */ #define DEFVAR_SYMVAL_FWD_INT(lname, c_location, forward_type, magicfun) \ do \ { \ @@ -488,6 +488,83 @@ void flush_all_buffer_local_cache (void); +struct multiple_value { + struct LCRECORD_HEADER header; + Elemcount count; + Elemcount allocated_count; + Elemcount first_desired; + Lisp_Object contents[1]; +}; +typedef struct multiple_value multiple_value; + +DECLARE_LISP_OBJECT (multiple_value, multiple_value); +#define MULTIPLE_VALUEP(x) RECORDP (x, multiple_value) + +#define XMULTIPLE_VALUE(x) XRECORD (x, multiple_value, multiple_value) +#define wrap_multiple_value(p) wrap_record (p, multiple_value) + +#define CHECK_MULTIPLE_VALUE(x) CHECK_RECORD (x, multiple_value) +#define CONCHECK_MULTIPLE_VALUE(x) CONCHECK_RECORD (x, multiple_value) + +#define multiple_value_count(x) ((x)->count) +#define multiple_value_allocated_count(x) ((x)->allocated_count) +#define multiple_value_first_desired(x) ((x)->first_desired) +#define multiple_value_contents(x) ((x)->contents) + +#define XMULTIPLE_VALUE_COUNT(x) multiple_value_count (XMULTIPLE_VALUE (x)) +#define XMULTIPLE_VALUE_ALLOCATED_COUNT(x) \ + multiple_value_allocated_count (XMULTIPLE_VALUE (x)) +#define XMULTIPLE_VALUE_FIRST_DESIRED(x) \ + multiple_value_first_desired (XMULTIPLE_VALUE(x)) +#define XMULTIPLE_VALUE_CONTENTS(x) multiple_value_contents (XMULTIPLE_VALUE(x)) + +Lisp_Object multiple_value_call (int nargs, Lisp_Object *args); +Lisp_Object multiple_value_list_internal (int nargs, Lisp_Object *args); + +/* It's slightly ugly to expose this here, but it does cut down the amount + of work the bytecode interpreter has to do substantially. */ +extern int multiple_value_current_limit; + +/* Bind the multiple value limits that #'values and #'values-list pay + attention to. Used by bytecode and interpreted code. */ +int bind_multiple_value_limits (int first, int upper); + +Lisp_Object multiple_value_aref (Lisp_Object, Elemcount); +void multiple_value_aset (Lisp_Object, Elemcount, Lisp_Object); + +Lisp_Object values2 (Lisp_Object first, Lisp_Object second); + +DECLARE_INLINE_HEADER ( +Lisp_Object +ignore_multiple_values (Lisp_Object obj) +) +{ + return MULTIPLE_VALUEP (obj) ? multiple_value_aref (obj, 0) : obj; +} + +#ifdef ERROR_CHECK_MULTIPLE_VALUES + +DECLARE_INLINE_HEADER ( +Lisp_Object +ignore_multiple_values_1 (Lisp_Object obj) +) +{ + if (1 == multiple_value_current_limit) + { + assert (!MULTIPLE_VALUEP (obj)); + return obj; + } + + return ignore_multiple_values (obj); +} + +#define IGNORE_MULTIPLE_VALUES(X) ignore_multiple_values_1 (X) + +#else +#define IGNORE_MULTIPLE_VALUES(X) (multiple_value_current_limit == 1 ? (X) \ + : ignore_multiple_values (X)) +#endif + END_C_DECLS #endif /* INCLUDED_symeval_h_ */