Mercurial > hg > xemacs-beta

comparison src/opaque.c @ 396:6719134a07c2 r21-2-13

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-13
author cvs
date Mon, 13 Aug 2007 11:12:05 +0200
parents 8626e4521993
children 74fd4e045ea6
comparison
equal deleted inserted replaced
395:de2c2a7459d2 396:6719134a07c2
54 Lisp_Object Vopaque_ptr_free_list; 54 Lisp_Object Vopaque_ptr_free_list;
55 55
56 static Lisp_Object 56 static Lisp_Object
57 mark_opaque (Lisp_Object obj, void (*markobj) (Lisp_Object)) 57 mark_opaque (Lisp_Object obj, void (*markobj) (Lisp_Object))
58 { 58 {
59 Lisp_Opaque *p = XOPAQUE (obj); 59 Lisp_Opaque *p = XOPAQUE (obj);
60 Lisp_Object size_or_chain = p->size_or_chain; 60 /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */
61 Lisp_Object size_or_chain = p->size_or_chain;
61 #ifdef ERROR_CHECK_GC 62 #ifdef ERROR_CHECK_GC
62 if (!in_opaque_list_marking) 63 if (!in_opaque_list_marking)
63 /* size is non-int for objects on an opaque free list. We sure 64 /* size is non-int for objects on an opaque free list. We sure
64 as hell better not be marking any of these objects unless 65 as hell better not be marking any of these objects unless
65 we're marking an opaque list. */ 66 we're marking an opaque list. */
79 /* Should never, ever be called. (except by an external debugger) */ 80 /* Should never, ever be called. (except by an external debugger) */
80 static void 81 static void
81 print_opaque (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 82 print_opaque (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
82 { 83 {
83 CONST Lisp_Opaque *p = XOPAQUE (obj); 84 CONST Lisp_Opaque *p = XOPAQUE (obj);
85 /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */
86 Lisp_Object size_or_chain = p->size_or_chain;
84 char buf[200]; 87 char buf[200];
85 char size_buf[50]; 88 char size_buf[50];
86 89
87 if (INTP (p->size_or_chain)) 90 if (INTP (size_or_chain))
88 sprintf (size_buf, "size=%lu", (unsigned long) OPAQUE_SIZE (p)); 91 sprintf (size_buf, "size=%lu", (unsigned long) OPAQUE_SIZE (p));
89 else 92 else
90 sprintf (size_buf, "freed"); 93 sprintf (size_buf, "freed");
91 94
92 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (opaque, %s) 0x%lx>", 95 sprintf (buf, "#<INTERNAL OBJECT (XEmacs bug?) (opaque, %s) 0x%lx>",
96 99
97 static size_t 100 static size_t
98 sizeof_opaque (CONST void *header) 101 sizeof_opaque (CONST void *header)
99 { 102 {
100 CONST Lisp_Opaque *p = (CONST Lisp_Opaque *) header; 103 CONST Lisp_Opaque *p = (CONST Lisp_Opaque *) header;
104 /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */
105 Lisp_Object size_or_chain = p->size_or_chain;
101 return offsetof (Lisp_Opaque, data) 106 return offsetof (Lisp_Opaque, data)
102 + (GC_INTP (p->size_or_chain) ? XINT (p->size_or_chain) : 0); 107 + (GC_INTP (size_or_chain) ? XINT (size_or_chain) : 0);
103 } 108 }
104 109
105 /* Return an opaque object of size SIZE. 110 /* Return an opaque object of size SIZE.
106 If DATA is OPAQUE_CLEAR, the object's data is memset to '\0' bytes. 111 If DATA is OPAQUE_CLEAR, the object's data is memset to '\0' bytes.
107 If DATA is OPAQUE_UNINIT, the object's data is uninitialized. 112 If DATA is OPAQUE_UNINIT, the object's data is uninitialized.
131 /* This will not work correctly for opaques with subobjects! */ 136 /* This will not work correctly for opaques with subobjects! */
132 137
133 static int 138 static int
134 equal_opaque (Lisp_Object obj1, Lisp_Object obj2, int depth) 139 equal_opaque (Lisp_Object obj1, Lisp_Object obj2, int depth)
135 { 140 {
136 size_t size;
137 #ifdef DEBUG_XEMACS 141 #ifdef DEBUG_XEMACS
138 assert (!XOPAQUE_MARKFUN (obj1) && !XOPAQUE_MARKFUN (obj2)); 142 {
139 assert (INTP (XOPAQUE (obj1)->size_or_chain)); 143 /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */
140 assert (INTP (XOPAQUE (obj2)->size_or_chain)); 144 Lisp_Object size_or_chain_1 = XOPAQUE (obj1)->size_or_chain;
141 #endif 145 Lisp_Object size_or_chain_2 = XOPAQUE (obj2)->size_or_chain;
142 return ((size = XOPAQUE_SIZE (obj1)) == XOPAQUE_SIZE (obj2) && 146 assert (INTP (size_or_chain_1));
143 !memcmp (XOPAQUE_DATA (obj1), XOPAQUE_DATA (obj2), size)); 147 assert (INTP (size_or_chain_2));
148 assert (!XOPAQUE_MARKFUN (obj1) && !XOPAQUE_MARKFUN (obj2));
149 }
150 #endif
151 {
152 size_t size;
153 return ((size = XOPAQUE_SIZE (obj1)) == XOPAQUE_SIZE (obj2) &&
154 !memcmp (XOPAQUE_DATA (obj1), XOPAQUE_DATA (obj2), size));
155 }
144 } 156 }
145 157
146 /* This will not work correctly for opaques with subobjects! */ 158 /* This will not work correctly for opaques with subobjects! */
147 159
148 static unsigned long 160 static unsigned long
149 hash_opaque (Lisp_Object obj, int depth) 161 hash_opaque (Lisp_Object obj, int depth)
150 { 162 {
151 #ifdef DEBUG_XEMACS 163 #ifdef DEBUG_XEMACS
152 assert (!XOPAQUE_MARKFUN (obj)); 164 {
153 assert (INTP (XOPAQUE (obj)->size_or_chain)); 165 /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */
166 Lisp_Object size_or_chain = XOPAQUE (obj)->size_or_chain;
167 assert (INTP (size_or_chain));
168 assert (!XOPAQUE_MARKFUN (obj));
169 }
154 #endif 170 #endif
155 if (XOPAQUE_SIZE (obj) == sizeof (unsigned long)) 171 if (XOPAQUE_SIZE (obj) == sizeof (unsigned long))
156 return *((unsigned long *) XOPAQUE_DATA(obj)); 172 return *((unsigned long *) XOPAQUE_DATA (obj));
157 else 173 else
158 return memory_hash (XOPAQUE_DATA (obj), XOPAQUE_SIZE (obj)); 174 return memory_hash (XOPAQUE_DATA (obj), XOPAQUE_SIZE (obj));
159 } 175 }
160 176
161 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("opaque", opaque, 177 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("opaque", opaque,
221 free_managed_opaque (Lisp_Object opaque_list, Lisp_Object opaque) 237 free_managed_opaque (Lisp_Object opaque_list, Lisp_Object opaque)
222 { 238 {
223 Lisp_Opaque_List *li = XOPAQUE_LIST (opaque_list); 239 Lisp_Opaque_List *li = XOPAQUE_LIST (opaque_list);
224 240
225 #ifdef ERROR_CHECK_GC 241 #ifdef ERROR_CHECK_GC
226 assert (INTP (XOPAQUE (opaque)->size_or_chain)); 242 {
243 /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */
244 Lisp_Object size_or_chain = XOPAQUE (opaque)->size_or_chain;
245 assert (INTP (size_or_chain));
246 }
227 #endif 247 #endif
228 XOPAQUE (opaque)->size_or_chain = li->free; 248 XOPAQUE (opaque)->size_or_chain = li->free;
229 li->free = opaque; 249 li->free = opaque;
230 } 250 }
231 251