Mercurial > hg > xemacs-beta

comparison src/opaque.c @ 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 1e7cc382eb16
children e0db3c197671
comparison
equal deleted inserted replaced
5116:e56f73345619 5117:3742ea8250b5
72 If DATA is OPAQUE_UNINIT, the object's data is uninitialized. 72 If DATA is OPAQUE_UNINIT, the object's data is uninitialized.
73 Else the object's data is initialized by copying from DATA. */ 73 Else the object's data is initialized by copying from DATA. */
74 Lisp_Object 74 Lisp_Object
75 make_opaque (const void *data, Bytecount size) 75 make_opaque (const void *data, Bytecount size)
76 { 76 {
77 Lisp_Opaque *p = (Lisp_Opaque *) 77 Lisp_Object obj =
78 BASIC_ALLOC_LCRECORD (aligned_sizeof_opaque (size), &lrecord_opaque); 78 ALLOC_SIZED_LISP_OBJECT (aligned_sizeof_opaque (size), opaque);
79 Lisp_Opaque *p = XOPAQUE (obj);
79 p->size = size; 80 p->size = size;
80 81
81 if (data == OPAQUE_CLEAR) 82 if (data == OPAQUE_CLEAR)
82 memset (p->data, '\0', size); 83 memset (p->data, '\0', size);
83 else if (data == OPAQUE_UNINIT) 84 else if (data == OPAQUE_UNINIT)
84 DO_NOTHING; 85 DO_NOTHING;
85 else 86 else
86 memcpy (p->data, data, size); 87 memcpy (p->data, data, size);
87 88
88 { 89 return obj;
89 return wrap_opaque (p);
90 }
91 } 90 }
92 91
93 /* This will not work correctly for opaques with subobjects! */ 92 /* This will not work correctly for opaques with subobjects! */
94 93
95 static int 94 static int
113 112
114 static const struct memory_description opaque_description[] = { 113 static const struct memory_description opaque_description[] = {
115 { XD_END } 114 { XD_END }
116 }; 115 };
117 116
118 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("opaque", opaque, 117 DEFINE_SIZABLE_LISP_OBJECT ("opaque", opaque,
119 1, /*dumpable-flag*/ 118 0, print_opaque, 0,
120 0, print_opaque, 0, 119 equal_opaque, hash_opaque,
121 equal_opaque, hash_opaque, 120 opaque_description,
122 opaque_description, 121 sizeof_opaque, Lisp_Opaque);
123 sizeof_opaque, Lisp_Opaque);
124 122
125 /* stuff to handle opaque pointers */ 123 /* stuff to handle opaque pointers */
126 124
127 /* Should never, ever be called. (except by an external debugger) */ 125 /* Should never, ever be called. (except by an external debugger) */
128 static void 126 static void
151 149
152 static const struct memory_description opaque_ptr_description[] = { 150 static const struct memory_description opaque_ptr_description[] = {
153 { XD_END } 151 { XD_END }
154 }; 152 };
155 153
156 DEFINE_LRECORD_IMPLEMENTATION ("opaque-ptr", opaque_ptr, 154 DEFINE_NONDUMPABLE_LISP_OBJECT ("opaque-ptr", opaque_ptr,
157 0, /*dumpable-flag*/ 155 0, print_opaque_ptr, 0,
158 0, print_opaque_ptr, 0, 156 equal_opaque_ptr, hash_opaque_ptr,
159 equal_opaque_ptr, hash_opaque_ptr, 157 opaque_ptr_description, Lisp_Opaque_Ptr);
160 opaque_ptr_description, Lisp_Opaque_Ptr);
161 158
162 Lisp_Object 159 Lisp_Object
163 make_opaque_ptr (void *val) 160 make_opaque_ptr (void *val)
164 { 161 {
165 #ifdef MC_ALLOC 162 #ifdef MC_ALLOC
166 Lisp_Object res = 163 Lisp_Object res = ALLOC_LISP_OBJECT (opaque_ptr);
167 wrap_pointer_1 (alloc_lrecord_type (Lisp_Opaque_Ptr,
168 &lrecord_opaque_ptr));
169 #else /* not MC_ALLOC */ 164 #else /* not MC_ALLOC */
170 Lisp_Object res = alloc_managed_lcrecord (Vopaque_ptr_free_list); 165 Lisp_Object res = alloc_managed_lcrecord (Vopaque_ptr_free_list);
171 #endif /* not MC_ALLOC */ 166 #endif /* not MC_ALLOC */
172 set_opaque_ptr (res, val); 167 set_opaque_ptr (res, val);
173 return res; 168 return res;
197 #endif /* not MC_ALLOC */ 192 #endif /* not MC_ALLOC */
198 193
199 void 194 void
200 init_opaque_once_early (void) 195 init_opaque_once_early (void)
201 { 196 {
202 INIT_LRECORD_IMPLEMENTATION (opaque); 197 INIT_LISP_OBJECT (opaque);
203 INIT_LRECORD_IMPLEMENTATION (opaque_ptr); 198 INIT_LISP_OBJECT (opaque_ptr);
204 199
205 #ifndef MC_ALLOC 200 #ifndef MC_ALLOC
206 reinit_opaque_early (); 201 reinit_opaque_early ();
207 #endif /* not MC_ALLOC */ 202 #endif /* not MC_ALLOC */
208 } 203 }