Mercurial > hg > xemacs-beta

comparison src/lrecord.h @ 5117:3742ea8250b5 ben-lisp-object ben-lisp-object-final-ws-year-2005

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Checking in final CVS version of workspace 'ben-lisp-object'
author Ben Wing <ben@xemacs.org>
date Sat, 26 Dec 2009 00:20:27 -0600
parents d30cd499e445
children e0db3c197671
comparison
equal deleted inserted replaced
5116:e56f73345619 5117:3742ea8250b5
80 the opaque type. --ben 80 the opaque type. --ben
81 */ 81 */
82 #endif /* not MC_ALLOC */ 82 #endif /* not MC_ALLOC */
83 83
84 #ifdef MC_ALLOC 84 #ifdef MC_ALLOC
85 #define ALLOC_LISP_OBJECT(type) alloc_lrecord (&lrecord_##type)
86 #define ALLOC_SIZED_LISP_OBJECT(size, type) \
87 alloc_sized_lrecord (size, &lrecord_##type)
85 #define ALLOC_LCRECORD_TYPE alloc_lrecord_type 88 #define ALLOC_LCRECORD_TYPE alloc_lrecord_type
86 #define COPY_SIZED_LCRECORD copy_sized_lrecord 89 #define COPY_SIZED_LCRECORD copy_sized_lrecord
87 #define COPY_LCRECORD copy_lrecord 90 #define COPY_LCRECORD copy_lrecord
88 #define LISPOBJ_STORAGE_SIZE(ptr, size, stats) \ 91 #define LISPOBJ_STORAGE_SIZE(ptr, size, stats) \
89 mc_alloced_storage_size (size, stats) 92 mc_alloced_storage_size (size, stats)
90 #define ZERO_LCRECORD zero_lrecord 93 #define ZERO_LCRECORD zero_lrecord
91 #define LCRECORD_HEADER lrecord_header 94 #define LCRECORD_HEADER lrecord_header
92 #define BASIC_ALLOC_LCRECORD alloc_lrecord
93 #define FREE_LCRECORD free_lrecord 95 #define FREE_LCRECORD free_lrecord
94 #else 96 #else
97 #define ALLOC_LISP_OBJECT(type) alloc_lcrecord (&lrecord_##type)
98 #define ALLOC_SIZED_LISP_OBJECT(size, type) \
99 old_alloc_sized_lcrecord (size, &lrecord_##type)
95 #define ALLOC_LCRECORD_TYPE old_alloc_lcrecord_type 100 #define ALLOC_LCRECORD_TYPE old_alloc_lcrecord_type
96 #define COPY_SIZED_LCRECORD old_copy_sized_lcrecord 101 #define COPY_SIZED_LCRECORD old_copy_sized_lcrecord
97 #define COPY_LCRECORD old_copy_lcrecord 102 #define COPY_LCRECORD old_copy_lcrecord
98 #define LISPOBJ_STORAGE_SIZE malloced_storage_size 103 #define LISPOBJ_STORAGE_SIZE malloced_storage_size
99 #define ZERO_LCRECORD old_zero_lcrecord 104 #define ZERO_LCRECORD old_zero_lcrecord
100 #define LCRECORD_HEADER old_lcrecord_header 105 #define LCRECORD_HEADER old_lcrecord_header
101 #define BASIC_ALLOC_LCRECORD old_basic_alloc_lcrecord
102 #define FREE_LCRECORD old_free_lcrecord 106 #define FREE_LCRECORD old_free_lcrecord
103 #endif 107 #endif
104 108
105 BEGIN_C_DECLS 109 BEGIN_C_DECLS
106 110
176 { 180 {
177 struct lrecord_header lheader; 181 struct lrecord_header lheader;
178 182
179 /* The `next' field is normally used to chain all lcrecords together 183 /* The `next' field is normally used to chain all lcrecords together
180 so that the GC can find (and free) all of them. 184 so that the GC can find (and free) all of them.
181 `old_basic_alloc_lcrecord' threads lcrecords together. 185 `old_alloc_sized_lcrecord' threads lcrecords together.
182 186
183 The `next' field may be used for other purposes as long as some 187 The `next' field may be used for other purposes as long as some
184 other mechanism is provided for letting the GC do its work. 188 other mechanism is provided for letting the GC do its work.
185 189
186 For example, the event and marker object types allocate members 190 For example, the event and marker object types allocate members
328 Yes, this currently means there is logic duplication. Eventually the 332 Yes, this currently means there is logic duplication. Eventually the
329 mark methods will be removed. */ 333 mark methods will be removed. */
330 Lisp_Object (*marker) (Lisp_Object); 334 Lisp_Object (*marker) (Lisp_Object);
331 335
332 /* `printer' converts the object to a printed representation. 336 /* `printer' converts the object to a printed representation.
333 This can be NULL; in this case default_object_printer() will be 337 This can be NULL; in this case internal_object_printer() will be
334 used instead. */ 338 used instead. */
335 void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag); 339 void (*printer) (Lisp_Object, Lisp_Object printcharfun, int escapeflag);
336 340
337 /* `finalizer' is called at GC time when the object is about to 341 /* `finalizer' is called at GC time when the object is about to
338 be freed, and at dump time (FOR_DISKSAVE will be non-zero in this 342 be freed, and at dump time (FOR_DISKSAVE will be non-zero in this
365 Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop); 369 Lisp_Object (*getprop) (Lisp_Object obj, Lisp_Object prop);
366 int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val); 370 int (*putprop) (Lisp_Object obj, Lisp_Object prop, Lisp_Object val);
367 int (*remprop) (Lisp_Object obj, Lisp_Object prop); 371 int (*remprop) (Lisp_Object obj, Lisp_Object prop);
368 Lisp_Object (*plist) (Lisp_Object obj); 372 Lisp_Object (*plist) (Lisp_Object obj);
369 373
370 #ifdef MC_ALLOC 374 /* Only one of `static_size' and `size_in_bytes_method' is non-0. If
371 /* Only one of `static_size' and `size_in_bytes_method' is non-0. */ 375 `static_size' is 0, this type is not instantiable by
372 #else /* not MC_ALLOC */ 376 ALLOC_LISP_OBJECT(). If both are 0 (this should never happen), this
373 /* Only one of `static_size' and `size_in_bytes_method' is non-0. 377 object cannot be instantiated; you will get an abort() if you try.*/
374 If both are 0, this type is not instantiable by
375 old_basic_alloc_lcrecord(). */
376 #endif /* not MC_ALLOC */
377 Bytecount static_size; 378 Bytecount static_size;
378 Bytecount (*size_in_bytes_method) (const void *header); 379 Bytecount (*size_in_bytes_method) (const void *header);
379 380
380 /* The (constant) index into lrecord_implementations_table */ 381 /* The (constant) index into lrecord_implementations_table */
381 enum lrecord_type lrecord_type_index; 382 enum lrecord_type lrecord_type_index;
1086 #define XD_DYNARR_DESC(base_type, sub_desc) \ 1087 #define XD_DYNARR_DESC(base_type, sub_desc) \
1087 { XD_BLOCK_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), {sub_desc} },\ 1088 { XD_BLOCK_PTR, offsetof (base_type, base), XD_INDIRECT(1, 0), {sub_desc} },\
1088 { XD_INT, offsetof (base_type, cur) }, \ 1089 { XD_INT, offsetof (base_type, cur) }, \
1089 { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) } \ 1090 { XD_INT_RESET, offsetof (base_type, max), XD_INDIRECT(1, 0) } \
1090 1091
1091 /* DEFINE_LRECORD_IMPLEMENTATION is for objects with constant size. 1092 /* DEFINE_LISP_OBJECT is for objects with constant size.
1092 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION is for objects whose size varies. 1093
1094 DEFINE_SIZABLE_LISP_OBJECT is for objects whose size varies.
1095
1096 DEFINE_FROB_BLOCK_LISP_OBJECT is for objects that are allocated in
1097 large blocks ("frob blocks"), which are parceled up individually. Such
1098 objects need special handling in alloc.c. This does not apply to
1099 MC_ALLOC, because it does this automatically.
1100
1101 DEFINE_*_WITH_PROPS is for objects which support the unified property
1102 interface using `get', `put', `remprop' and `object-plist'.
1103
1104 DEFINE_EXTERNAL_* is for objects defined in an external module.
1105
1106 MAKE_LISP_OBJECT is what underlies all of these; it defines
1107
1093 */ 1108 */
1094 1109
1095 #if defined (ERROR_CHECK_TYPES) 1110 #if defined (ERROR_CHECK_TYPES)
1096 # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype) 1111 # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype)
1097 #else 1112 #else
1098 # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype) 1113 # define DECLARE_ERROR_CHECK_TYPES(c_name, structtype)
1099 #endif 1114 #endif
1100 1115
1101 1116 #error MUST STILL SUPPORT THIS:::
1102 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \
1103 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
1104
1105 #define DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
1106 MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype)
1107 1117
1108 #define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ 1118 #define DEFINE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \
1109 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) 1119 DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
1110 1120
1111 #define DEFINE_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ 1121 #error and variations
1112 MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype) 1122
1113 1123 #define DEFINE_INTERNAL_LISP_OBJECT(name,c_name,dumpable,structtype,desc,marker) ...
1114 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ 1124
1115 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) 1125 #define DEFINE_FROB_BLOCK_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \
1116 1126 DEFINE_FROB_BLOCK_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
1117 #define DEFINE_BASIC_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ 1127
1118 MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,0,sizer,1,structtype) 1128 #define DEFINE_FROB_BLOCK_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
1119 1129 MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof(structtype),0,1,structtype)
1120 #define DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \ 1130
1121 MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) 1131 #define DEFINE_INTERNAL_LISP_OBJECT(name,c_name,structtype,desc,dumpable,marker) \
1132 DEFINE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,)
1133
1134 #define DEFINE_LISP_OBJECT(name,c_name,structtype,desc,dumpable,marker,printer,equal,hash,nuker) \
1135 DEFINE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,)
1136
1137 #define DEFINE_LISP_OBJECT_WITH_PROPS(name,c_name,structtype,dumpable,desc,marker,printer,equal,hash,nuker,getprop,putprop,remprop,plist) \
1138 MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype)
1139
1140 #define DEFINE_SIZABLE_LISP_OBJECT(name,c_name,structtype,sizer,desc,dumpable,marker,printer,equal,hash,nuker) \
1141 DEFINE_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype)
1142
1143 #define DEFINE_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,structtype,sizer,desc,dumpable,marker,printer,equal,hash,nuker,getprop,putprop,remprop,plist) \
1144 MAKE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype)
1122 1145
1123 #ifdef MC_ALLOC 1146 #ifdef MC_ALLOC
1124 #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ 1147 #define MAKE_LISP_OBJECT(name,c_name,structtype,sizer,desc,dumpable,marker,printer,equal,hash,nuker,getprop,putprop,remprop,plist,frob_block) \
1125 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1148 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1126 const struct lrecord_implementation lrecord_##c_name = \ 1149 const struct lrecord_implementation lrecord_##c_name = \
1127 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1150 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1128 getprop, putprop, remprop, plist, size, sizer, \ 1151 getprop, putprop, remprop, plist, size, sizer, \
1129 lrecord_type_##c_name } 1152 lrecord_type_##c_name }
1130 #else /* not MC_ALLOC */ 1153 #else /* not MC_ALLOC */
1131 #define MAKE_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ 1154 #define MAKE_LISP_OBJECT(name,c_name,structtype,sizer,desc,dumpable,marker,printer,equal,hash,nuker,getprop,putprop,remprop,plist,frob_block) \
1132 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1155 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1133 const struct lrecord_implementation lrecord_##c_name = \ 1156 const struct lrecord_implementation lrecord_##c_name = \
1134 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1157 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1135 getprop, putprop, remprop, plist, size, sizer, \ 1158 getprop, putprop, remprop, plist, size, sizer, \
1136 lrecord_type_##c_name, basic_p } 1159 lrecord_type_##c_name, frob_block }
1137 #endif /* not MC_ALLOC */ 1160 #endif /* not MC_ALLOC */
1138 1161
1139 #define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \ 1162 #define DEFINE_EXTERNAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,structtype) \
1140 DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype) 1163 DEFINE_EXTERNAL_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,structtype)
1141 1164
1142 #define DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \ 1165 #define DEFINE_EXTERNAL_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,structtype) \
1143 MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype) 1166 MAKE_EXTERNAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizeof (structtype),0,0,structtype)
1144 1167
1145 #define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \ 1168 #define DEFINE_EXTERNAL_SIZABLE_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,sizer,structtype) \
1146 DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype) 1169 DEFINE_EXTERNAL_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,0,0,0,0,sizer,structtype)
1147 1170
1148 #define DEFINE_EXTERNAL_LRECORD_SEQUENCE_IMPLEMENTATION_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \ 1171 #define DEFINE_EXTERNAL_SIZABLE_LISP_OBJECT_WITH_PROPS(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,sizer,structtype) \
1149 MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype) 1172 MAKE_EXTERNAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,0,sizer,0,structtype)
1150 1173
1151 #ifdef MC_ALLOC 1174 #ifdef MC_ALLOC
1152 #define MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ 1175 #define MAKE_EXTERNAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \
1153 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1176 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1154 int lrecord_type_##c_name; \ 1177 int lrecord_type_##c_name; \
1155 struct lrecord_implementation lrecord_##c_name = \ 1178 struct lrecord_implementation lrecord_##c_name = \
1156 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1179 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1157 getprop, putprop, remprop, plist, size, sizer, \ 1180 getprop, putprop, remprop, plist, size, sizer, \
1158 lrecord_type_last_built_in_type } 1181 lrecord_type_last_built_in_type }
1159 #else /* not MC_ALLOC */ 1182 #else /* not MC_ALLOC */
1160 #define MAKE_EXTERNAL_LRECORD_IMPLEMENTATION(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \ 1183 #define MAKE_EXTERNAL_LISP_OBJECT(name,c_name,dumpable,marker,printer,nuker,equal,hash,desc,getprop,putprop,remprop,plist,size,sizer,basic_p,structtype) \
1161 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \ 1184 DECLARE_ERROR_CHECK_TYPES(c_name, structtype) \
1162 int lrecord_type_##c_name; \ 1185 int lrecord_type_##c_name; \
1163 struct lrecord_implementation lrecord_##c_name = \ 1186 struct lrecord_implementation lrecord_##c_name = \
1164 { name, dumpable, marker, printer, nuker, equal, hash, desc, \ 1187 { name, dumpable, marker, printer, nuker, equal, hash, desc, \
1165 getprop, putprop, remprop, plist, size, sizer, \ 1188 getprop, putprop, remprop, plist, size, sizer, \
1167 #endif /* not MC_ALLOC */ 1190 #endif /* not MC_ALLOC */
1168 1191
1169 #ifdef USE_KKCC 1192 #ifdef USE_KKCC
1170 extern MODULE_API const struct memory_description *lrecord_memory_descriptions[]; 1193 extern MODULE_API const struct memory_description *lrecord_memory_descriptions[];
1171 1194
1172 #define INIT_LRECORD_IMPLEMENTATION(type) do { \ 1195 #define INIT_LISP_OBJECT(type) do { \
1173 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \ 1196 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \
1174 lrecord_memory_descriptions[lrecord_type_##type] = \ 1197 lrecord_memory_descriptions[lrecord_type_##type] = \
1175 lrecord_implementations_table[lrecord_type_##type]->description; \ 1198 lrecord_implementations_table[lrecord_type_##type]->description; \
1176 } while (0) 1199 } while (0)
1177 #else /* not USE_KKCC */ 1200 #else /* not USE_KKCC */
1178 extern MODULE_API Lisp_Object (*lrecord_markers[]) (Lisp_Object); 1201 extern MODULE_API Lisp_Object (*lrecord_markers[]) (Lisp_Object);
1179 1202
1180 #define INIT_LRECORD_IMPLEMENTATION(type) do { \ 1203 #define INIT_LISP_OBJECT(type) do { \
1181 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \ 1204 lrecord_implementations_table[lrecord_type_##type] = &lrecord_##type; \
1182 lrecord_markers[lrecord_type_##type] = \ 1205 lrecord_markers[lrecord_type_##type] = \
1183 lrecord_implementations_table[lrecord_type_##type]->marker; \ 1206 lrecord_implementations_table[lrecord_type_##type]->marker; \
1184 } while (0) 1207 } while (0)
1185 #endif /* not USE_KKCC */ 1208 #endif /* not USE_KKCC */
1186 1209
1187 #define INIT_EXTERNAL_LRECORD_IMPLEMENTATION(type) do { \ 1210 #define INIT_EXTERNAL_LISP_OBJECT(type) do { \
1188 lrecord_type_##type = lrecord_type_count++; \ 1211 lrecord_type_##type = lrecord_type_count++; \
1189 lrecord_##type.lrecord_type_index = lrecord_type_##type; \ 1212 lrecord_##type.lrecord_type_index = lrecord_type_##type; \
1190 INIT_LRECORD_IMPLEMENTATION(type); \ 1213 INIT_LISP_OBJECT(type); \
1191 } while (0) 1214 } while (0)
1192 1215
1193 #ifdef HAVE_SHLIB 1216 #ifdef HAVE_SHLIB
1194 /* Allow undefining types in order to support module unloading. */ 1217 /* Allow undefining types in order to support module unloading. */
1195 1218
1196 #ifdef USE_KKCC 1219 #ifdef USE_KKCC
1197 #define UNDEF_LRECORD_IMPLEMENTATION(type) do { \ 1220 #define UNDEF_LISP_OBJECT(type) do { \
1198 lrecord_implementations_table[lrecord_type_##type] = NULL; \ 1221 lrecord_implementations_table[lrecord_type_##type] = NULL; \
1199 lrecord_memory_descriptions[lrecord_type_##type] = NULL; \ 1222 lrecord_memory_descriptions[lrecord_type_##type] = NULL; \
1200 } while (0) 1223 } while (0)
1201 #else /* not USE_KKCC */ 1224 #else /* not USE_KKCC */
1202 #define UNDEF_LRECORD_IMPLEMENTATION(type) do { \ 1225 #define UNDEF_LISP_OBJECT(type) do { \
1203 lrecord_implementations_table[lrecord_type_##type] = NULL; \ 1226 lrecord_implementations_table[lrecord_type_##type] = NULL; \
1204 lrecord_markers[lrecord_type_##type] = NULL; \ 1227 lrecord_markers[lrecord_type_##type] = NULL; \
1205 } while (0) 1228 } while (0)
1206 #endif /* not USE_KKCC */ 1229 #endif /* not USE_KKCC */
1207 1230
1208 #define UNDEF_EXTERNAL_LRECORD_IMPLEMENTATION(type) do { \ 1231 #define UNDEF_EXTERNAL_LISP_OBJECT(type) do { \
1209 if (lrecord_##type.lrecord_type_index == lrecord_type_count - 1) { \ 1232 if (lrecord_##type.lrecord_type_index == lrecord_type_count - 1) { \
1210 /* This is the most recently defined type. Clean up nicely. */ \ 1233 /* This is the most recently defined type. Clean up nicely. */ \
1211 lrecord_type_##type = lrecord_type_count--; \ 1234 lrecord_type_##type = lrecord_type_count--; \
1212 } /* Else we can't help leaving a hole with this implementation. */ \ 1235 } /* Else we can't help leaving a hole with this implementation. */ \
1213 UNDEF_LRECORD_IMPLEMENTATION(type); \ 1236 UNDEF_LISP_OBJECT(type); \
1214 } while (0) 1237 } while (0)
1215 1238
1216 #endif /* HAVE_SHLIB */ 1239 #endif /* HAVE_SHLIB */
1217 1240
1218 #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record) 1241 #define LRECORDP(a) (XTYPE (a) == Lisp_Type_Record)
1239 4. Create the data layout description for your object. See 1262 4. Create the data layout description for your object. See
1240 toolbar_button_description below; the comment above in `struct lrecord', 1263 toolbar_button_description below; the comment above in `struct lrecord',
1241 describing the purpose of the descriptions; and comments elsewhere in 1264 describing the purpose of the descriptions; and comments elsewhere in
1242 this file describing the exact syntax of the description structures. 1265 this file describing the exact syntax of the description structures.
1243 1266
1244 6. Define your object with DEFINE_LRECORD_IMPLEMENTATION() or some 1267 6. Define your object with DEFINE_LISP_OBJECT() or some
1245 variant. 1268 variant.
1246 1269
1247 7. Include the header file in the .c file where you defined the object. 1270 7. Include the header file in the .c file where you defined the object.
1248 1271
1249 8. Put a call to INIT_LRECORD_IMPLEMENTATION() for the object in the 1272 8. Put a call to INIT_LISP_OBJECT() for the object in the
1250 .c file's syms_of_foo() function. 1273 .c file's syms_of_foo() function.
1251 1274
1252 9. Add a type enum for the object to enum lrecord_type, earlier in this 1275 9. Add a type enum for the object to enum lrecord_type, earlier in this
1253 file. 1276 file.
1254 1277
1334 mark_object (data->callback); 1357 mark_object (data->callback);
1335 mark_object (data->enabled_p); 1358 mark_object (data->enabled_p);
1336 return data->help_string; 1359 return data->help_string;
1337 } 1360 }
1338 1361
1339 [[ If your object should never escape to Lisp, declare its print method 1362 DEFINE_NONDUMPABLE_LISP_OBJECT ("toolbar-button", toolbar_button,
1340 as internal_object_printer instead of 0. ]] 1363 mark_toolbar_button,
1341 1364 external_object_printer, 0, 0, 0,
1342 DEFINE_LRECORD_IMPLEMENTATION ("toolbar-button", toolbar_button, 1365 toolbar_button_description,
1343 0, mark_toolbar_button, 0, 0, 0, 0, 1366 struct toolbar_button);
1344 toolbar_button_description,
1345 struct toolbar_button);
1346 1367
1347 ... 1368 ...
1348 1369
1349 void 1370 void
1350 syms_of_toolbar (void) 1371 syms_of_toolbar (void)
1351 { 1372 {
1352 INIT_LRECORD_IMPLEMENTATION (toolbar_button); 1373 INIT_LISP_OBJECT (toolbar_button);
1353 1374
1354 ...; 1375 ...;
1355 } 1376 }
1356 1377
1357 ------------------------------ in inline.c ----------------------------- 1378 ------------------------------ in inline.c -----------------------------
1376 1397
1377 /* 1398 /*
1378 1399
1379 Note: Object types defined in external dynamically-loaded modules (not 1400 Note: Object types defined in external dynamically-loaded modules (not
1380 part of the XEmacs main source code) should use DECLARE_EXTERNAL_LRECORD 1401 part of the XEmacs main source code) should use DECLARE_EXTERNAL_LRECORD
1381 and DEFINE_EXTERNAL_LRECORD_IMPLEMENTATION rather than DECLARE_LRECORD 1402 and DEFINE_EXTERNAL_LISP_OBJECT rather than DECLARE_LRECORD
1382 and DEFINE_LRECORD_IMPLEMENTATION. The EXTERNAL versions declare and 1403 and DEFINE_LISP_OBJECT. The EXTERNAL versions declare and
1383 allocate an enumerator for the type being defined. 1404 allocate an enumerator for the type being defined.
1384 1405
1385 */ 1406 */
1386 1407
1387 1408
1518 #define CHECK_NONRECORD(x, lisp_enum, predicate) do { \ 1539 #define CHECK_NONRECORD(x, lisp_enum, predicate) do { \
1519 if (XTYPE (x) != lisp_enum) \ 1540 if (XTYPE (x) != lisp_enum) \
1520 dead_wrong_type_argument (predicate, x); \ 1541 dead_wrong_type_argument (predicate, x); \
1521 } while (0) 1542 } while (0)
1522 1543
1544 /* How to allocate a Lisp object:
1545
1546 - For most objects, simply call ALLOC_LISP_OBJECT (type), where TYPE is
1547 the name of the type (e.g. toolbar_button). Such objects can be freed
1548 manually using FREE_LCRECORD.
1549
1550 - For objects whose size can vary (and hence which have a
1551 size_in_bytes_method rather than a static_size), call
1552 ALLOC_SIZED_LISP_OBJECT (size, type), where TYPE is the
1553 name of the type. NOTE: You cannot call FREE_LCRECORD() on such
1554 on object! (At least when not MC_ALLOC)
1555
1556 - Basic lrecords (of which there are a limited number, which exist only
1557 when not MC_ALLOC, and which have special handling in alloc.c) need
1558 special handling; if you don't understand this, just ignore it.
1559
1560 - Some lrecords, which are used totally internally, use the
1561 noseeum-* functions for the reason of debugging.
1562 */
1563
1523 #ifndef MC_ALLOC 1564 #ifndef MC_ALLOC
1524 /*-------------------------- lcrecord-list -----------------------------*/ 1565 /*-------------------------- lcrecord-list -----------------------------*/
1525 1566
1526 struct lcrecord_list 1567 struct lcrecord_list
1527 { 1568 {
1558 they only handle blocks of a particular, fixed size. Thus, objects that 1599 they only handle blocks of a particular, fixed size. Thus, objects that
1559 can be of varying sizes need to do various tricks. These considerations 1600 can be of varying sizes need to do various tricks. These considerations
1560 in particular dictate the various types of management: 1601 in particular dictate the various types of management:
1561 1602
1562 -- "Auto-managed" means that you just go ahead and allocate the lcrecord 1603 -- "Auto-managed" means that you just go ahead and allocate the lcrecord
1563 whenever you want, using old_alloc_lcrecord_type(), and the appropriate 1604 whenever you want, using ALLOC_LISP_OBJECT(), and the appropriate
1564 lcrecord-list manager is automatically created. To free, you just call 1605 lcrecord-list manager is automatically created. To free, you just call
1565 "FREE_LCRECORD()" and the appropriate lcrecord-list manager is 1606 "FREE_LCRECORD()" and the appropriate lcrecord-list manager is
1566 automatically located and called. The limitation here of course is that 1607 automatically located and called. The limitation here of course is that
1567 all your objects are of the same size. (#### Eventually we should have a 1608 all your objects are of the same size. (#### Eventually we should have a
1568 more sophisticated system that tracks the sizes seen and creates one 1609 more sophisticated system that tracks the sizes seen and creates one
1581 lcrecord-lists, no way to free them. This may be suitable when the 1622 lcrecord-lists, no way to free them. This may be suitable when the
1582 lcrecords are variable-sized and (a) you're too lazy to write the code 1623 lcrecords are variable-sized and (a) you're too lazy to write the code
1583 to hand-manage them, or (b) the objects you create are always or almost 1624 to hand-manage them, or (b) the objects you create are always or almost
1584 always Lisp-visible, and thus there's no point in freeing them (and it 1625 always Lisp-visible, and thus there's no point in freeing them (and it
1585 wouldn't be safe to do so). You just create them with 1626 wouldn't be safe to do so). You just create them with
1586 BASIC_ALLOC_LCRECORD(), and that's it. 1627 ALLOC_SIZED_LISP_OBJECT(), and that's it.
1587 1628
1588 --ben 1629 --ben
1589 1630
1590 Here is an in-depth look at the steps required to create a allocate an 1631 Here is an in-depth look at the steps required to create a allocate an
1591 lcrecord using the hand-managed style. Since this is the most 1632 lcrecord using the hand-managed style. Since this is the most
1594 lcrecord really entails, and what are the precautions: 1635 lcrecord really entails, and what are the precautions:
1595 1636
1596 1) Create an lcrecord-list object using make_lcrecord_list(). This is 1637 1) Create an lcrecord-list object using make_lcrecord_list(). This is
1597 often done at initialization. Remember to staticpro_nodump() this 1638 often done at initialization. Remember to staticpro_nodump() this
1598 object! The arguments to make_lcrecord_list() are the same as would be 1639 object! The arguments to make_lcrecord_list() are the same as would be
1599 passed to BASIC_ALLOC_LCRECORD(). 1640 passed to ALLOC_SIZED_LISP_OBJECT().
1600 1641
1601 2) Instead of calling BASIC_ALLOC_LCRECORD(), call alloc_managed_lcrecord() 1642 2) Instead of calling ALLOC_SIZED_LISP_OBJECT(), call
1602 and pass the lcrecord-list earlier created. 1643 alloc_managed_lcrecord() and pass the lcrecord-list earlier created.
1603 1644
1604 3) When done with the lcrecord, call free_managed_lcrecord(). The 1645 3) When done with the lcrecord, call free_managed_lcrecord(). The
1605 standard freeing caveats apply: ** make sure there are no pointers to 1646 standard freeing caveats apply: ** make sure there are no pointers to
1606 the object anywhere! ** 1647 the object anywhere! **
1607 1648
1608 4) Calling free_managed_lcrecord() is just like kissing the 1649 4) Calling free_managed_lcrecord() is just like kissing the
1609 lcrecord goodbye as if it were garbage-collected. This means: 1650 lcrecord goodbye as if it were garbage-collected. This means:
1610 -- the contents of the freed lcrecord are undefined, and the 1651 -- the contents of the freed lcrecord are undefined, and the
1611 contents of something produced by alloc_managed_lcrecord() 1652 contents of something produced by alloc_managed_lcrecord()
1612 are undefined, just like for BASIC_ALLOC_LCRECORD(). 1653 are undefined, just like for ALLOC_SIZED_LISP_OBJECT().
1613 -- the mark method for the lcrecord's type will *NEVER* be called 1654 -- the mark method for the lcrecord's type will *NEVER* be called
1614 on freed lcrecords. 1655 on freed lcrecords.
1615 -- the finalize method for the lcrecord's type will be called 1656 -- the finalize method for the lcrecord's type will be called
1616 at the time that free_managed_lcrecord() is called. 1657 at the time that free_managed_lcrecord() is called.
1617 */ 1658 */
1618 1659
1619 /* UNMANAGED MODEL: */ 1660 /* UNMANAGED MODEL: */
1620 void *old_basic_alloc_lcrecord (Bytecount size, 1661 Lisp_Object old_alloc_lcrecord (const struct lrecord_implementation *);
1621 const struct lrecord_implementation *); 1662 Lisp_Object old_alloc_sized_lcrecord (Bytecount size,
1663 const struct lrecord_implementation *);
1622 1664
1623 /* HAND-MANAGED MODEL: */ 1665 /* HAND-MANAGED MODEL: */
1624 Lisp_Object make_lcrecord_list (Elemcount size, 1666 Lisp_Object make_lcrecord_list (Elemcount size,
1625 const struct lrecord_implementation 1667 const struct lrecord_implementation
1626 *implementation); 1668 *implementation);
1627 Lisp_Object alloc_managed_lcrecord (Lisp_Object lcrecord_list); 1669 Lisp_Object alloc_managed_lcrecord (Lisp_Object lcrecord_list);
1628 void free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord); 1670 void free_managed_lcrecord (Lisp_Object lcrecord_list, Lisp_Object lcrecord);
1629 1671
1630 /* AUTO-MANAGED MODEL: */ 1672 /* AUTO-MANAGED MODEL: */
1631 MODULE_API void * 1673 MODULE_API Lisp_Object
1632 alloc_automanaged_lcrecord (Bytecount size, 1674 alloc_automanaged_lcrecord (Bytecount size,
1633 const struct lrecord_implementation *); 1675 const struct lrecord_implementation *);
1634 1676
1635 #define old_alloc_lcrecord_type(type, lrecord_implementation) \ 1677 #define old_alloc_lcrecord_type(type, imp) \
1636 ((type *) alloc_automanaged_lcrecord (sizeof (type), lrecord_implementation)) 1678 ((type *) XPNTR (alloc_automanaged_lcrecord (sizeof (type), imp)))
1637 1679
1638 void old_free_lcrecord (Lisp_Object rec); 1680 void old_free_lcrecord (Lisp_Object rec);
1639 1681
1640 1682
1641 /* Copy the data from one lcrecord structure into another, but don't 1683 /* Copy the data from one lcrecord structure into another, but don't
1655 1697
1656 #define old_zero_lcrecord(lcr) old_zero_sized_lcrecord (lcr, sizeof (*(lcr))) 1698 #define old_zero_lcrecord(lcr) old_zero_sized_lcrecord (lcr, sizeof (*(lcr)))
1657 1699
1658 #else /* MC_ALLOC */ 1700 #else /* MC_ALLOC */
1659 1701
1660 /* How to allocate a lrecord: 1702 Lisp_Object alloc_sized_lrecord (Bytecount size,
1661 1703 const struct lrecord_implementation *imp);
1662 - If the size of the lrecord is fix, say it equals its size of its 1704 Lisp_Object noseeum_alloc_sized_lrecord (Bytecount size,
1663 struct, then use alloc_lrecord_type. 1705 const struct lrecord_implementation *);
1664 1706 Lisp_Object alloc_lrecord (const struct lrecord_implementation *imp);
1665 - If the size varies, i.e. it is not equal to the size of its 1707
1666 struct, use alloc_lrecord and specify the amount of storage you 1708 #define alloc_lrecord_type(type, imp) \
1667 need for the object. 1709 ((type *) XPNTR (alloc_sized_lrecord (sizeof (type), imp)))
1668
1669 - Some lrecords, which are used totally internally, use the
1670 noseeum-* functions for the reason of debugging.
1671
1672 - To free a Lisp_Object manually, use free_lrecord. */
1673
1674 void *alloc_lrecord (Bytecount size,
1675 const struct lrecord_implementation *);
1676
1677 #define alloc_lrecord_type(type, lrecord_implementation) \
1678 ((type *) alloc_lrecord (sizeof (type), lrecord_implementation))
1679 1710
1680 void *noseeum_alloc_lrecord (Bytecount size, 1711 void *noseeum_alloc_lrecord (Bytecount size,
1681 const struct lrecord_implementation *); 1712 const struct lrecord_implementation *);
1682 1713
1683 #define noseeum_alloc_lrecord_type(type, lrecord_implementation) \ 1714 #define noseeum_alloc_lrecord_type(type, imp) \
1684 ((type *) noseeum_alloc_lrecord (sizeof (type), lrecord_implementation)) 1715 ((type *) XPNTR (noseeum_alloc_sized_lrecord (sizeof (type), imp)))
1685 1716
1686 void free_lrecord (Lisp_Object rec); 1717 void free_lrecord (Lisp_Object rec);
1687 1718
1688 1719
1689 /* Copy the data from one lrecord structure into another, but don't 1720 /* Copy the data from one lrecord structure into another, but don't