comparison 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
comparison
equal deleted inserted replaced
5117:3742ea8250b5 5118:e0db3c197671
139 through a call to `set', `setq', `set-default', or `setq-default', 139 through a call to `set', `setq', `set-default', or `setq-default',
140 or implicitly by the current buffer being changed. */ 140 or implicitly by the current buffer being changed. */
141 int (*magicfun) (Lisp_Object sym, Lisp_Object *val, Lisp_Object in_object, 141 int (*magicfun) (Lisp_Object sym, Lisp_Object *val, Lisp_Object in_object,
142 int flags); 142 int flags);
143 }; 143 };
144 DECLARE_LRECORD (symbol_value_forward, struct symbol_value_forward); 144 DECLARE_LISP_OBJECT (symbol_value_forward, struct symbol_value_forward);
145 #define XSYMBOL_VALUE_FORWARD(x) \ 145 #define XSYMBOL_VALUE_FORWARD(x) \
146 XRECORD (x, symbol_value_forward, struct symbol_value_forward) 146 XRECORD (x, symbol_value_forward, struct symbol_value_forward)
147 #define symbol_value_forward_forward(m) ((void *)((m)->magic.value)) 147 #define symbol_value_forward_forward(m) ((void *)((m)->magic.value))
148 #define symbol_value_forward_magicfun(m) ((m)->magicfun) 148 #define symbol_value_forward_magicfun(m) ((m)->magicfun)
149 149
226 Lisp_Object default_value; 226 Lisp_Object default_value;
227 Lisp_Object current_value; 227 Lisp_Object current_value;
228 Lisp_Object current_buffer; 228 Lisp_Object current_buffer;
229 Lisp_Object current_alist_element; 229 Lisp_Object current_alist_element;
230 }; 230 };
231 DECLARE_LRECORD (symbol_value_buffer_local, struct symbol_value_buffer_local); 231 DECLARE_LISP_OBJECT (symbol_value_buffer_local, struct symbol_value_buffer_local);
232 #define XSYMBOL_VALUE_BUFFER_LOCAL(x) \ 232 #define XSYMBOL_VALUE_BUFFER_LOCAL(x) \
233 XRECORD (x, symbol_value_buffer_local, struct symbol_value_buffer_local) 233 XRECORD (x, symbol_value_buffer_local, struct symbol_value_buffer_local)
234 #define SYMBOL_VALUE_BUFFER_LOCAL_P(x) RECORDP (x, symbol_value_buffer_local) 234 #define SYMBOL_VALUE_BUFFER_LOCAL_P(x) RECORDP (x, symbol_value_buffer_local)
235 235
236 /* 3. symbol-value-lisp-magic */ 236 /* 3. symbol-value-lisp-magic */
251 struct symbol_value_magic magic; 251 struct symbol_value_magic magic;
252 Lisp_Object handler[MAGIC_HANDLER_MAX]; 252 Lisp_Object handler[MAGIC_HANDLER_MAX];
253 Lisp_Object harg[MAGIC_HANDLER_MAX]; 253 Lisp_Object harg[MAGIC_HANDLER_MAX];
254 Lisp_Object shadowed; 254 Lisp_Object shadowed;
255 }; 255 };
256 DECLARE_LRECORD (symbol_value_lisp_magic, struct symbol_value_lisp_magic); 256 DECLARE_LISP_OBJECT (symbol_value_lisp_magic, struct symbol_value_lisp_magic);
257 #define XSYMBOL_VALUE_LISP_MAGIC(x) \ 257 #define XSYMBOL_VALUE_LISP_MAGIC(x) \
258 XRECORD (x, symbol_value_lisp_magic, struct symbol_value_lisp_magic) 258 XRECORD (x, symbol_value_lisp_magic, struct symbol_value_lisp_magic)
259 #define SYMBOL_VALUE_LISP_MAGIC_P(x) RECORDP (x, symbol_value_lisp_magic) 259 #define SYMBOL_VALUE_LISP_MAGIC_P(x) RECORDP (x, symbol_value_lisp_magic)
260 260
261 /* 4. symbol-value-varalias */ 261 /* 4. symbol-value-varalias */
264 { 264 {
265 struct symbol_value_magic magic; 265 struct symbol_value_magic magic;
266 Lisp_Object aliasee; 266 Lisp_Object aliasee;
267 Lisp_Object shadowed; 267 Lisp_Object shadowed;
268 }; 268 };
269 DECLARE_LRECORD (symbol_value_varalias, struct symbol_value_varalias); 269 DECLARE_LISP_OBJECT (symbol_value_varalias, struct symbol_value_varalias);
270 #define XSYMBOL_VALUE_VARALIAS(x) \ 270 #define XSYMBOL_VALUE_VARALIAS(x) \
271 XRECORD (x, symbol_value_varalias, struct symbol_value_varalias) 271 XRECORD (x, symbol_value_varalias, struct symbol_value_varalias)
272 #define SYMBOL_VALUE_VARALIAS_P(x) RECORDP (x, symbol_value_varalias) 272 #define SYMBOL_VALUE_VARALIAS_P(x) RECORDP (x, symbol_value_varalias)
273 #define symbol_value_varalias_aliasee(m) ((m)->aliasee) 273 #define symbol_value_varalias_aliasee(m) ((m)->aliasee)
274 #define symbol_value_varalias_shadowed(m) ((m)->shadowed) 274 #define symbol_value_varalias_shadowed(m) ((m)->shadowed)
275 275
276 /* To define a Lisp primitive function using a C function `Fname', do this: 276 /* To define a Lisp primitive function using a C function `Fname', do this:
277 DEFUN ("name, Fname, ...); // at top level in foo.c 277 DEFUN ("name, Fname, ...); // at top level in foo.c
278 DEFSUBR (Fname); // in syms_of_foo(); 278 DEFSUBR (Fname); // in syms_of_foo();
279 */ 279 */
280 #ifdef MC_ALLOC 280 #ifdef NEW_GC
281 MODULE_API void defsubr (Lisp_Subr *); 281 MODULE_API void defsubr (Lisp_Subr *);
282 #define DEFSUBR_MC_ALLOC(Fname) \ 282 #define DEFSUBR_MC_ALLOC(Fname) \
283 S##Fname= (struct Lisp_Subr *) mc_alloc (sizeof (struct Lisp_Subr)); \ 283 S##Fname= (struct Lisp_Subr *) mc_alloc (sizeof (struct Lisp_Subr)); \
284 set_lheader_implementation (&S##Fname->lheader, &lrecord_subr); \ 284 set_lheader_implementation (&S##Fname->lheader, &lrecord_subr); \
285 \ 285 \
307 do { \ 307 do { \
308 DEFSUBR_MC_ALLOC (Fname); \ 308 DEFSUBR_MC_ALLOC (Fname); \
309 defsubr_macro (S##Fname); \ 309 defsubr_macro (S##Fname); \
310 } while (0) 310 } while (0)
311 311
312 #else /* not MC_ALLOC */ 312 #else /* not NEW_GC */
313 /* To define a Lisp primitive function using a C function `Fname', do this: 313 /* To define a Lisp primitive function using a C function `Fname', do this:
314 DEFUN ("name, Fname, ...); // at top level in foo.c 314 DEFUN ("name, Fname, ...); // at top level in foo.c
315 DEFSUBR (Fname); // in syms_of_foo(); 315 DEFSUBR (Fname); // in syms_of_foo();
316 */ 316 */
317 MODULE_API void defsubr (Lisp_Subr *); 317 MODULE_API void defsubr (Lisp_Subr *);
321 DEFUN ("name, Fname, ...); // at top level in foo.c 321 DEFUN ("name, Fname, ...); // at top level in foo.c
322 DEFSUBR_MACRO (Fname); // in syms_of_foo(); 322 DEFSUBR_MACRO (Fname); // in syms_of_foo();
323 */ 323 */
324 MODULE_API void defsubr_macro (Lisp_Subr *); 324 MODULE_API void defsubr_macro (Lisp_Subr *);
325 #define DEFSUBR_MACRO(Fname) defsubr_macro (&S##Fname) 325 #define DEFSUBR_MACRO(Fname) defsubr_macro (&S##Fname)
326 #endif /* not MC_ALLOC */ 326 #endif /* not NEW_GC */
327 327
328 MODULE_API void defsymbol_massage_name (Lisp_Object *location, 328 MODULE_API void defsymbol_massage_name (Lisp_Object *location,
329 const char *name); 329 const char *name);
330 MODULE_API void defsymbol_massage_name_nodump (Lisp_Object *location, 330 MODULE_API void defsymbol_massage_name_nodump (Lisp_Object *location,
331 const char *name); 331 const char *name);
394 These are used in the syms_of_FILENAME functions. */ 394 These are used in the syms_of_FILENAME functions. */
395 395
396 MODULE_API void defvar_magic (const char *symbol_name, 396 MODULE_API void defvar_magic (const char *symbol_name,
397 const struct symbol_value_forward *magic); 397 const struct symbol_value_forward *magic);
398 398
399 #ifdef MC_ALLOC 399 #ifdef NEW_GC
400 #define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magic_fun) \ 400 #define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magic_fun) \
401 do \ 401 do \
402 { \ 402 { \
403 struct symbol_value_forward *I_hate_C = \ 403 struct symbol_value_forward *I_hate_C = \
404 alloc_lrecord_type (struct symbol_value_forward, \ 404 alloc_lrecord_type (struct symbol_value_forward, \
411 I_hate_C->magic.type = forward_type; \ 411 I_hate_C->magic.type = forward_type; \
412 I_hate_C->magicfun = magic_fun; \ 412 I_hate_C->magicfun = magic_fun; \
413 \ 413 \
414 defvar_magic ((lname), I_hate_C); \ 414 defvar_magic ((lname), I_hate_C); \
415 } while (0) 415 } while (0)
416 #else /* not MC_ALLOC */ 416 #else /* not NEW_GC */
417 #define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magicfun) \ 417 #define DEFVAR_SYMVAL_FWD(lname, c_location, forward_type, magicfun) \
418 do \ 418 do \
419 { \ 419 { \
420 static const struct symbol_value_forward I_hate_C = \ 420 static const struct symbol_value_forward I_hate_C = \
421 { /* struct symbol_value_forward */ \ 421 { /* struct symbol_value_forward */ \
437 }, \ 437 }, \
438 magicfun \ 438 magicfun \
439 }; \ 439 }; \
440 defvar_magic ((lname), &I_hate_C); \ 440 defvar_magic ((lname), &I_hate_C); \
441 } while (0) 441 } while (0)
442 #endif /* not MC_ALLOC */ 442 #endif /* not NEW_GC */
443 #define DEFVAR_SYMVAL_FWD_INT(lname, c_location, forward_type, magicfun) \ 443 #define DEFVAR_SYMVAL_FWD_INT(lname, c_location, forward_type, magicfun) \
444 do \ 444 do \
445 { \ 445 { \
446 DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun); \ 446 DEFVAR_SYMVAL_FWD (lname, c_location, forward_type, magicfun); \
447 dump_add_opaque_int (c_location); \ 447 dump_add_opaque_int (c_location); \
486 #define DEFVAR_BOOL_MAGIC(lname, c_location, magicfun) \ 486 #define DEFVAR_BOOL_MAGIC(lname, c_location, magicfun) \
487 DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_BOOLEAN_FORWARD, magicfun) 487 DEFVAR_SYMVAL_FWD_INT (lname, c_location, SYMVAL_BOOLEAN_FORWARD, magicfun)
488 488
489 void flush_all_buffer_local_cache (void); 489 void flush_all_buffer_local_cache (void);
490 490
491 struct multiple_value {
492 struct LCRECORD_HEADER header;
493 Elemcount count;
494 Elemcount allocated_count;
495 Elemcount first_desired;
496 Lisp_Object contents[1];
497 };
498 typedef struct multiple_value multiple_value;
499
500 DECLARE_LISP_OBJECT (multiple_value, multiple_value);
501 #define MULTIPLE_VALUEP(x) RECORDP (x, multiple_value)
502
503 #define XMULTIPLE_VALUE(x) XRECORD (x, multiple_value, multiple_value)
504 #define wrap_multiple_value(p) wrap_record (p, multiple_value)
505
506 #define CHECK_MULTIPLE_VALUE(x) CHECK_RECORD (x, multiple_value)
507 #define CONCHECK_MULTIPLE_VALUE(x) CONCHECK_RECORD (x, multiple_value)
508
509 #define multiple_value_count(x) ((x)->count)
510 #define multiple_value_allocated_count(x) ((x)->allocated_count)
511 #define multiple_value_first_desired(x) ((x)->first_desired)
512 #define multiple_value_contents(x) ((x)->contents)
513
514 #define XMULTIPLE_VALUE_COUNT(x) multiple_value_count (XMULTIPLE_VALUE (x))
515 #define XMULTIPLE_VALUE_ALLOCATED_COUNT(x) \
516 multiple_value_allocated_count (XMULTIPLE_VALUE (x))
517 #define XMULTIPLE_VALUE_FIRST_DESIRED(x) \
518 multiple_value_first_desired (XMULTIPLE_VALUE(x))
519 #define XMULTIPLE_VALUE_CONTENTS(x) multiple_value_contents (XMULTIPLE_VALUE(x))
520
521 Lisp_Object multiple_value_call (int nargs, Lisp_Object *args);
522 Lisp_Object multiple_value_list_internal (int nargs, Lisp_Object *args);
523
524 /* It's slightly ugly to expose this here, but it does cut down the amount
525 of work the bytecode interpreter has to do substantially. */
526 extern int multiple_value_current_limit;
527
528 /* Bind the multiple value limits that #'values and #'values-list pay
529 attention to. Used by bytecode and interpreted code. */
530 int bind_multiple_value_limits (int first, int upper);
531
532 Lisp_Object multiple_value_aref (Lisp_Object, Elemcount);
533 void multiple_value_aset (Lisp_Object, Elemcount, Lisp_Object);
534
535 Lisp_Object values2 (Lisp_Object first, Lisp_Object second);
536
537 DECLARE_INLINE_HEADER (
538 Lisp_Object
539 ignore_multiple_values (Lisp_Object obj)
540 )
541 {
542 return MULTIPLE_VALUEP (obj) ? multiple_value_aref (obj, 0) : obj;
543 }
544
545 #ifdef ERROR_CHECK_MULTIPLE_VALUES
546
547 DECLARE_INLINE_HEADER (
548 Lisp_Object
549 ignore_multiple_values_1 (Lisp_Object obj)
550 )
551 {
552 if (1 == multiple_value_current_limit)
553 {
554 assert (!MULTIPLE_VALUEP (obj));
555 return obj;
556 }
557
558 return ignore_multiple_values (obj);
559 }
560
561 #define IGNORE_MULTIPLE_VALUES(X) ignore_multiple_values_1 (X)
562
563 #else
564 #define IGNORE_MULTIPLE_VALUES(X) (multiple_value_current_limit == 1 ? (X) \
565 : ignore_multiple_values (X))
566 #endif
567
491 END_C_DECLS 568 END_C_DECLS
492 569
493 #endif /* INCLUDED_symeval_h_ */ 570 #endif /* INCLUDED_symeval_h_ */