comparison src/lisp.h @ 3263:d674024a8674

[xemacs-hg @ 2006-02-27 16:29:00 by crestani] - Introduce a fancy asynchronous finalization strategy on C level. - Merge the code conditioned on MC_ALLOC into the code conditioned on NEW_GC. - Remove the possibility to free objects manually outside garbage collections when the new collector is enabled.
author crestani
date Mon, 27 Feb 2006 16:29:29 +0000
parents 2b8bb4938bb4
children 168191f9515f
comparison
equal deleted inserted replaced
3262:79d41cfd8e6b 3263:d674024a8674
2036 #define wrap_cons(p) wrap_record (p, cons) 2036 #define wrap_cons(p) wrap_record (p, cons)
2037 #define CONSP(x) RECORDP (x, cons) 2037 #define CONSP(x) RECORDP (x, cons)
2038 #define CHECK_CONS(x) CHECK_RECORD (x, cons) 2038 #define CHECK_CONS(x) CHECK_RECORD (x, cons)
2039 #define CONCHECK_CONS(x) CONCHECK_RECORD (x, cons) 2039 #define CONCHECK_CONS(x) CONCHECK_RECORD (x, cons)
2040 2040
2041 #ifdef MC_ALLOC 2041 #ifdef NEW_GC
2042 #define CONS_MARKED_P(c) MARKED_P (&((c)->lheader)) 2042 #define CONS_MARKED_P(c) MARKED_P (&((c)->lheader))
2043 #define MARK_CONS(c) MARK (&((c)->lheader)) 2043 #define MARK_CONS(c) MARK (&((c)->lheader))
2044 #else /* not MC_ALLOC */ 2044 #else /* not NEW_GC */
2045 #define CONS_MARKED_P(c) MARKED_RECORD_HEADER_P(&((c)->lheader)) 2045 #define CONS_MARKED_P(c) MARKED_RECORD_HEADER_P(&((c)->lheader))
2046 #define MARK_CONS(c) MARK_RECORD_HEADER (&((c)->lheader)) 2046 #define MARK_CONS(c) MARK_RECORD_HEADER (&((c)->lheader))
2047 #endif /* not MC_ALLOC */ 2047 #endif /* not NEW_GC */
2048 2048
2049 extern MODULE_API Lisp_Object Qnil; 2049 extern MODULE_API Lisp_Object Qnil;
2050 2050
2051 #define NILP(x) EQ (x, Qnil) 2051 #define NILP(x) EQ (x, Qnil)
2052 #define cons_car(a) ((a)->car_) 2052 #define cons_car(a) ((a)->car_)
2635 struct 2635 struct
2636 { 2636 {
2637 /* WARNING: Everything before ascii_begin must agree exactly with 2637 /* WARNING: Everything before ascii_begin must agree exactly with
2638 struct lrecord_header */ 2638 struct lrecord_header */
2639 unsigned int type :8; 2639 unsigned int type :8;
2640 #ifdef MC_ALLOC 2640 #ifdef NEW_GC
2641 unsigned int lisp_readonly :1; 2641 unsigned int lisp_readonly :1;
2642 unsigned int free :1; 2642 unsigned int free :1;
2643 /* Number of chars at beginning of string that are one byte in length 2643 /* Number of chars at beginning of string that are one byte in length
2644 (byte_ascii_p) */ 2644 (byte_ascii_p) */
2645 unsigned int ascii_begin :22; 2645 unsigned int ascii_begin :22;
2646 #else /* not MC_ALLOC */ 2646 #else /* not NEW_GC */
2647 unsigned int mark :1; 2647 unsigned int mark :1;
2648 unsigned int c_readonly :1; 2648 unsigned int c_readonly :1;
2649 unsigned int lisp_readonly :1; 2649 unsigned int lisp_readonly :1;
2650 /* Number of chars at beginning of string that are one byte in length 2650 /* Number of chars at beginning of string that are one byte in length
2651 (byte_ascii_p) */ 2651 (byte_ascii_p) */
2652 unsigned int ascii_begin :21; 2652 unsigned int ascii_begin :21;
2653 #endif /* not MC_ALLOC */ 2653 #endif /* not NEW_GC */
2654 } v; 2654 } v;
2655 } u; 2655 } u;
2656 #ifdef NEW_GC 2656 #ifdef NEW_GC
2657 int indirect; 2657 int indirect;
2658 Lisp_Object data_object; 2658 Lisp_Object data_object;
2662 #endif /* not NEW_GC */ 2662 #endif /* not NEW_GC */
2663 Lisp_Object plist; 2663 Lisp_Object plist;
2664 }; 2664 };
2665 typedef struct Lisp_String Lisp_String; 2665 typedef struct Lisp_String Lisp_String;
2666 2666
2667 #ifdef MC_ALLOC 2667 #ifdef NEW_GC
2668 #define MAX_STRING_ASCII_BEGIN ((1 << 22) - 1) 2668 #define MAX_STRING_ASCII_BEGIN ((1 << 22) - 1)
2669 #else 2669 #else /* not NEW_GC */
2670 #define MAX_STRING_ASCII_BEGIN ((1 << 21) - 1) 2670 #define MAX_STRING_ASCII_BEGIN ((1 << 21) - 1)
2671 #endif 2671 #endif /* not NEW_GC */
2672 2672
2673 DECLARE_MODULE_API_LRECORD (string, Lisp_String); 2673 DECLARE_MODULE_API_LRECORD (string, Lisp_String);
2674 #define XSTRING(x) XRECORD (x, string, Lisp_String) 2674 #define XSTRING(x) XRECORD (x, string, Lisp_String)
2675 #define wrap_string(p) wrap_record (p, string) 2675 #define wrap_string(p) wrap_record (p, string)
2676 #define STRINGP(x) RECORDP (x, string) 2676 #define STRINGP(x) RECORDP (x, string)
3183 3183
3184 # define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x)) 3184 # define INT_OR_FLOATP(x) (INTP (x) || FLOATP (x))
3185 3185
3186 /*--------------------------- readonly objects -------------------------*/ 3186 /*--------------------------- readonly objects -------------------------*/
3187 3187
3188 #ifndef MC_ALLOC 3188 #ifndef NEW_GC
3189 #define CHECK_C_WRITEABLE(obj) \ 3189 #define CHECK_C_WRITEABLE(obj) \
3190 do { if (c_readonly (obj)) c_write_error (obj); } while (0) 3190 do { if (c_readonly (obj)) c_write_error (obj); } while (0)
3191 3191
3192 #define C_READONLY(obj) (C_READONLY_RECORD_HEADER_P(XRECORD_LHEADER (obj))) 3192 #define C_READONLY(obj) (C_READONLY_RECORD_HEADER_P(XRECORD_LHEADER (obj)))
3193 #endif /* not MC_ALLOC */ 3193 #endif /* not NEW_GC */
3194 3194
3195 #define CHECK_LISP_WRITEABLE(obj) \ 3195 #define CHECK_LISP_WRITEABLE(obj) \
3196 do { if (lisp_readonly (obj)) lisp_write_error (obj); } while (0) 3196 do { if (lisp_readonly (obj)) lisp_write_error (obj); } while (0)
3197 3197
3198 #define LISP_READONLY(obj) (LISP_READONLY_RECORD_HEADER_P(XRECORD_LHEADER (obj))) 3198 #define LISP_READONLY(obj) (LISP_READONLY_RECORD_HEADER_P(XRECORD_LHEADER (obj)))
3430 #define UNEVALLED -1 3430 #define UNEVALLED -1
3431 3431
3432 /* Can't be const, because then subr->doc is read-only and 3432 /* Can't be const, because then subr->doc is read-only and
3433 Snarf_documentation chokes */ 3433 Snarf_documentation chokes */
3434 3434
3435 #ifdef MC_ALLOC 3435 #ifdef NEW_GC
3436 #define DEFUN(lname, Fname, min_args, max_args, prompt, arglist) \ 3436 #define DEFUN(lname, Fname, min_args, max_args, prompt, arglist) \
3437 Lisp_Object Fname (EXFUN_##max_args); \ 3437 Lisp_Object Fname (EXFUN_##max_args); \
3438 static struct Lisp_Subr MC_ALLOC_S##Fname = \ 3438 static struct Lisp_Subr MC_ALLOC_S##Fname = \
3439 { \ 3439 { \
3440 { /* struct lrecord_header */ \ 3440 { /* struct lrecord_header */ \
3472 }; \ 3472 }; \
3473 static struct Lisp_Subr *S##Fname; \ 3473 static struct Lisp_Subr *S##Fname; \
3474 DOESNT_RETURN_TYPE (Lisp_Object) Fname (DEFUN_##max_args arglist) 3474 DOESNT_RETURN_TYPE (Lisp_Object) Fname (DEFUN_##max_args arglist)
3475 #define GET_DEFUN_LISP_OBJECT(Fname) \ 3475 #define GET_DEFUN_LISP_OBJECT(Fname) \
3476 wrap_subr (S##Fname); 3476 wrap_subr (S##Fname);
3477 #else /* not MC_ALLOC */ 3477 #else /* not NEW_GC */
3478 #define DEFUN(lname, Fname, min_args, max_args, prompt, arglist) \ 3478 #define DEFUN(lname, Fname, min_args, max_args, prompt, arglist) \
3479 Lisp_Object Fname (EXFUN_##max_args); \ 3479 Lisp_Object Fname (EXFUN_##max_args); \
3480 static struct Lisp_Subr S##Fname = \ 3480 static struct Lisp_Subr S##Fname = \
3481 { \ 3481 { \
3482 { /* struct lrecord_header */ \ 3482 { /* struct lrecord_header */ \
3514 (lisp_fn_t) Fname \ 3514 (lisp_fn_t) Fname \
3515 }; \ 3515 }; \
3516 DOESNT_RETURN_TYPE (Lisp_Object) Fname (DEFUN_##max_args arglist) 3516 DOESNT_RETURN_TYPE (Lisp_Object) Fname (DEFUN_##max_args arglist)
3517 #define GET_DEFUN_LISP_OBJECT(Fname) \ 3517 #define GET_DEFUN_LISP_OBJECT(Fname) \
3518 wrap_subr (&S##Fname); 3518 wrap_subr (&S##Fname);
3519 #endif /* not MC_ALLOC */ 3519 #endif /* not NEW_GC */
3520 3520
3521 /* Heavy ANSI C preprocessor hackery to get DEFUN to declare a 3521 /* Heavy ANSI C preprocessor hackery to get DEFUN to declare a
3522 prototype that matches max_args, and add the obligatory 3522 prototype that matches max_args, and add the obligatory
3523 `Lisp_Object' type declaration to the formal C arguments. */ 3523 `Lisp_Object' type declaration to the formal C arguments. */
3524 3524
4019 MODULE_API void unstaticpro_nodump (Lisp_Object *); 4019 MODULE_API void unstaticpro_nodump (Lisp_Object *);
4020 #endif 4020 #endif
4021 4021
4022 #endif 4022 #endif
4023 4023
4024 #ifdef MC_ALLOC 4024 #ifdef NEW_GC
4025 extern Lisp_Object_dynarr *mcpros; 4025 extern Lisp_Object_dynarr *mcpros;
4026 #ifdef DEBUG_XEMACS 4026 #ifdef DEBUG_XEMACS
4027 /* Help debug crashes gc-marking a mcpro'ed object. */ 4027 /* Help debug crashes gc-marking a mcpro'ed object. */
4028 MODULE_API void mcpro_1 (Lisp_Object, char *); 4028 MODULE_API void mcpro_1 (Lisp_Object, char *);
4029 #define mcpro(ptr) mcpro_1 (ptr, #ptr) 4029 #define mcpro(ptr) mcpro_1 (ptr, #ptr)
4030 #else /* not DEBUG_XEMACS */ 4030 #else /* not DEBUG_XEMACS */
4031 /* Call mcpro (&var) to protect mc variable `var'. */ 4031 /* Call mcpro (&var) to protect mc variable `var'. */
4032 MODULE_API void mcpro (Lisp_Object); 4032 MODULE_API void mcpro (Lisp_Object);
4033 #endif /* not DEBUG_XEMACS */ 4033 #endif /* not DEBUG_XEMACS */
4034 #endif /* MC_ALLOC */ 4034 #endif /* NEW_GC */
4035 4035
4036 void register_post_gc_action (void (*fun) (void *), void *arg); 4036 void register_post_gc_action (void (*fun) (void *), void *arg);
4037 int begin_gc_forbidden (void); 4037 int begin_gc_forbidden (void);
4038 void end_gc_forbidden (int count); 4038 void end_gc_forbidden (int count);
4039 extern int gc_currently_forbidden; 4039 extern int gc_currently_forbidden;
4087 MODULE_API EXFUN (Fmake_string, 2); 4087 MODULE_API EXFUN (Fmake_string, 2);
4088 MODULE_API EXFUN (Fmake_symbol, 1); 4088 MODULE_API EXFUN (Fmake_symbol, 1);
4089 MODULE_API EXFUN (Fmake_vector, 2); 4089 MODULE_API EXFUN (Fmake_vector, 2);
4090 MODULE_API EXFUN (Fvector, MANY); 4090 MODULE_API EXFUN (Fvector, MANY);
4091 4091
4092 #ifndef MC_ALLOC 4092 #ifndef NEW_GC
4093 void release_breathing_space (void); 4093 void release_breathing_space (void);
4094 #endif /* not MC_ALLOC */ 4094 #endif /* not NEW_GC */
4095 Lisp_Object noseeum_cons (Lisp_Object, Lisp_Object); 4095 Lisp_Object noseeum_cons (Lisp_Object, Lisp_Object);
4096 MODULE_API Lisp_Object make_vector (Elemcount, Lisp_Object); 4096 MODULE_API Lisp_Object make_vector (Elemcount, Lisp_Object);
4097 MODULE_API Lisp_Object vector1 (Lisp_Object); 4097 MODULE_API Lisp_Object vector1 (Lisp_Object);
4098 MODULE_API Lisp_Object vector2 (Lisp_Object, Lisp_Object); 4098 MODULE_API Lisp_Object vector2 (Lisp_Object, Lisp_Object);
4099 MODULE_API Lisp_Object vector3 (Lisp_Object, Lisp_Object, Lisp_Object); 4099 MODULE_API Lisp_Object vector3 (Lisp_Object, Lisp_Object, Lisp_Object);