Mercurial > hg > xemacs-beta

comparison src/opaque.c @ 337:fbbf69b4e8a7 r21-0-66

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-0-66
author cvs
date Mon, 13 Aug 2007 10:51:02 +0200
parents c5d627a313b1
children cc15677e0335
comparison
equal deleted inserted replaced
336:fe0a93612022 337:fbbf69b4e8a7
53 Lisp_Object Vopaque_ptr_free_list; 53 Lisp_Object Vopaque_ptr_free_list;
54 54
55 static Lisp_Object 55 static Lisp_Object
56 mark_opaque (Lisp_Object obj, void (*markobj) (Lisp_Object)) 56 mark_opaque (Lisp_Object obj, void (*markobj) (Lisp_Object))
57 { 57 {
58 struct Lisp_Opaque *p = XOPAQUE (obj);
59 /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */
60 Lisp_Object size_or_chain = p->size_or_chain;
58 #ifdef ERROR_CHECK_GC 61 #ifdef ERROR_CHECK_GC
59 if (!in_opaque_list_marking) 62 if (!in_opaque_list_marking)
60 /* size is non-int for objects on an opaque free list. We sure 63 /* size is non-int for objects on an opaque free list. We sure
61 as hell better not be marking any of these objects unless 64 as hell better not be marking any of these objects unless
62 we're marking an opaque list. */ 65 we're marking an opaque list. */
63 assert (INTP (XOPAQUE (obj)->size_or_chain)); 66 assert (GC_INTP (size_or_chain));
64 else 67 else
65 /* marking an opaque on the free list doesn't do any recursive 68 /* marking an opaque on the free list doesn't do any recursive
66 markings, so we better not have non-freed opaques on a free 69 markings, so we better not have non-freed opaques on a free
67 list. */ 70 list. */
68 assert (!INTP (XOPAQUE (obj)->size_or_chain)); 71 assert (!GC_INTP (size_or_chain));
69 #endif 72 #endif
70 if (INTP (XOPAQUE (obj)->size_or_chain) && XOPAQUE_MARKFUN (obj)) 73 if (GC_INTP (size_or_chain) && OPAQUE_MARKFUN (p))
71 return XOPAQUE_MARKFUN (obj) (obj, markobj); 74 return OPAQUE_MARKFUN (p) (obj, markobj);
72 else 75 else
73 return XOPAQUE (obj)->size_or_chain; 76 return size_or_chain;
74 } 77 }
75 78
76 /* Should never, ever be called. (except by an external debugger) */ 79 /* Should never, ever be called. (except by an external debugger) */
77 static void 80 static void
78 print_opaque (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) 81 print_opaque (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
79 { 82 {
83 CONST struct Lisp_Opaque *p = XOPAQUE (obj);
84 /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */
85 Lisp_Object size_or_chain = p->size_or_chain;
80 char buf[200]; 86 char buf[200];
81 if (INTP (XOPAQUE (obj)->size_or_chain)) 87 if (GC_INTP (size_or_chain))
82 sprintf (buf, "#<INTERNAL EMACS BUG (opaque, size=%ld) 0x%lx>", 88 sprintf (buf, "#<INTERNAL EMACS BUG (opaque, size=%ld) 0x%lx>",
83 (long) XOPAQUE_SIZE (obj), (unsigned long) XPNTR (obj)); 89 (long) OPAQUE_SIZE (p), (unsigned long) XPNTR (obj));
84 else 90 else
85 sprintf (buf, "#<INTERNAL EMACS BUG (opaque, freed) 0x%lx>", 91 sprintf (buf, "#<INTERNAL EMACS BUG (opaque, freed) 0x%lx>",
86 (unsigned long) XPNTR (obj)); 92 (unsigned long) XPNTR (obj));
87 write_c_string (buf, printcharfun); 93 write_c_string (buf, printcharfun);
88 } 94 }
89 95
90 static size_t 96 static size_t
91 sizeof_opaque (CONST void *header) 97 sizeof_opaque (CONST void *header)
92 { 98 {
93 CONST struct Lisp_Opaque *p = (CONST struct Lisp_Opaque *) header; 99 CONST struct Lisp_Opaque *p = (CONST struct Lisp_Opaque *) header;
94 if (!INTP (p->size_or_chain)) 100 /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */
101 Lisp_Object size_or_chain = p->size_or_chain;
102 if (!GC_INTP (size_or_chain))
95 return sizeof (*p); 103 return sizeof (*p);
96 return sizeof (*p) + XINT (p->size_or_chain) - sizeof (int); 104 return sizeof (*p) + XINT (size_or_chain) - sizeof (int);
97 } 105 }
98 106
99 Lisp_Object 107 Lisp_Object
100 make_opaque (int size, CONST void *data) 108 make_opaque (int size, CONST void *data)
101 { 109 {
117 125
118 static int 126 static int
119 equal_opaque (Lisp_Object obj1, Lisp_Object obj2, int depth) 127 equal_opaque (Lisp_Object obj1, Lisp_Object obj2, int depth)
120 { 128 {
121 #ifdef DEBUG_XEMACS 129 #ifdef DEBUG_XEMACS
122 assert (!XOPAQUE_MARKFUN (obj1) && !XOPAQUE_MARKFUN (obj2)); 130 {
123 assert (INTP (XOPAQUE(obj1)->size_or_chain)); 131 /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */
124 assert (INTP (XOPAQUE(obj2)->size_or_chain)); 132 Lisp_Object size_or_chain_1 = XOPAQUE (obj1)->size_or_chain;
125 #endif 133 Lisp_Object size_or_chain_2 = XOPAQUE (obj2)->size_or_chain;
126 if (XOPAQUE_SIZE(obj1) != XOPAQUE_SIZE(obj2)) 134 assert (INTP (size_or_chain_1));
127 return 0; 135 assert (INTP (size_or_chain_2));
128 return (XOPAQUE_SIZE(obj1) == sizeof(*XOPAQUE_DATA(obj1)) 136 assert (!XOPAQUE_MARKFUN (obj1) && !XOPAQUE_MARKFUN (obj2));
129 ? *XOPAQUE_DATA(obj1) == *XOPAQUE_DATA(obj2) 137 }
130 : memcmp (XOPAQUE_DATA(obj1), XOPAQUE_DATA(obj2), 138 #endif
131 XOPAQUE_SIZE(obj1)) == 0); 139 {
140 size_t size;
141 return ((size = XOPAQUE_SIZE (obj1)) == XOPAQUE_SIZE (obj2) &&
142 !memcmp (XOPAQUE_DATA (obj1), XOPAQUE_DATA (obj2), size));
143 }
132 } 144 }
133 145
134 /* This will not work correctly for opaques with subobjects! */ 146 /* This will not work correctly for opaques with subobjects! */
135 147
136 static unsigned long 148 static unsigned long
137 hash_opaque (Lisp_Object obj, int depth) 149 hash_opaque (Lisp_Object obj, int depth)
138 { 150 {
139 #ifdef DEBUG_XEMACS 151 #ifdef DEBUG_XEMACS
140 assert (!XOPAQUE_MARKFUN (obj)); 152 {
141 assert (INTP (XOPAQUE(obj)->size_or_chain)); 153 /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */
142 #endif 154 Lisp_Object size_or_chain = XOPAQUE (obj)->size_or_chain;
143 if (XOPAQUE_SIZE(obj) == sizeof (unsigned long)) 155 assert (INTP (size_or_chain));
144 return (unsigned int) *XOPAQUE_DATA(obj); 156 assert (!XOPAQUE_MARKFUN (obj));
145 else 157 }
146 return memory_hash (XOPAQUE_DATA(obj), XOPAQUE_SIZE(obj)); 158 #endif
159 if (XOPAQUE_SIZE (obj) == sizeof (unsigned long))
160 return *((unsigned long *) XOPAQUE_DATA (obj));
161 else
162 return memory_hash (XOPAQUE_DATA (obj), XOPAQUE_SIZE (obj));
147 } 163 }
148 164
149 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("opaque", opaque, 165 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("opaque", opaque,
150 mark_opaque, print_opaque, 0, 166 mark_opaque, print_opaque, 0,
151 equal_opaque, hash_opaque, 167 equal_opaque, hash_opaque,
209 free_managed_opaque (Lisp_Object opaque_list, Lisp_Object opaque) 225 free_managed_opaque (Lisp_Object opaque_list, Lisp_Object opaque)
210 { 226 {
211 struct Lisp_Opaque_List *li = XOPAQUE_LIST (opaque_list); 227 struct Lisp_Opaque_List *li = XOPAQUE_LIST (opaque_list);
212 228
213 #ifdef ERROR_CHECK_GC 229 #ifdef ERROR_CHECK_GC
214 assert (INTP (XOPAQUE (opaque)->size_or_chain)); 230 {
231 /* Egcs 1.1.1 sometimes crashes on INTP (p->size_or_chain) */
232 Lisp_Object size_or_chain = XOPAQUE (opaque)->size_or_chain;
233 assert (INTP (size_or_chain));
234 }
215 #endif 235 #endif
216 XOPAQUE (opaque)->size_or_chain = li->free; 236 XOPAQUE (opaque)->size_or_chain = li->free;
217 li->free = opaque; 237 li->free = opaque;
218 } 238 }
219 239