Mercurial > hg > xemacs-beta

comparison src/opaque.c @ 5133:444a448b2f53

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Merge branch ben-lisp-object into default branch
author Ben Wing <ben@xemacs.org>
date Sun, 07 Mar 2010 06:47:37 -0600
parents a9c41067dd88
children 88bd4f3ef8e4
comparison
equal deleted inserted replaced
5113:b2dcf6a6d8ab 5133:444a448b2f53
1 /* Opaque Lisp objects. 1 /* Opaque Lisp objects.
2 Copyright (C) 1993, 1994, 1995 Sun Microsystems, Inc. 2 Copyright (C) 1993, 1994, 1995 Sun Microsystems, Inc.
3 Copyright (C) 1995, 1996, 2002 Ben Wing. 3 Copyright (C) 1995, 1996, 2002, 2010 Ben Wing.
4 4
5 This file is part of XEmacs. 5 This file is part of XEmacs.
6 6
7 XEmacs is free software; you can redistribute it and/or modify it 7 XEmacs is free software; you can redistribute it and/or modify it
8 under the terms of the GNU General Public License as published by the 8 under the terms of the GNU General Public License as published by the
60 { 60 {
61 return MAX_ALIGN_SIZE (offsetof (Lisp_Opaque, data) + opaque_size); 61 return MAX_ALIGN_SIZE (offsetof (Lisp_Opaque, data) + opaque_size);
62 } 62 }
63 63
64 static Bytecount 64 static Bytecount
65 sizeof_opaque (const void *header) 65 sizeof_opaque (Lisp_Object obj)
66 { 66 {
67 return aligned_sizeof_opaque (((const Lisp_Opaque *) header)->size); 67 return aligned_sizeof_opaque (XOPAQUE (obj)->size);
68 } 68 }
69 69
70 /* Return an opaque object of size SIZE. 70 /* Return an opaque object of size SIZE.
71 If DATA is OPAQUE_CLEAR, the object's data is memset to '\0' bytes. 71 If DATA is OPAQUE_CLEAR, the object's data is memset to '\0' bytes.
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
114 113
115 static const struct memory_description opaque_description[] = { 114 static const struct memory_description opaque_description[] = {
116 { XD_END } 115 { XD_END }
117 }; 116 };
118 117
119 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("opaque", opaque, 118 DEFINE_DUMPABLE_SIZABLE_LISP_OBJECT ("opaque", opaque,
120 1, /*dumpable-flag*/ 119 0, print_opaque, 0,
121 0, print_opaque, 0, 120 equal_opaque, hash_opaque,
122 equal_opaque, hash_opaque, 121 opaque_description,
123 opaque_description, 122 sizeof_opaque, Lisp_Opaque);
124 sizeof_opaque, Lisp_Opaque);
125 123
126 /* stuff to handle opaque pointers */ 124 /* stuff to handle opaque pointers */
127 125
128 /* Should never, ever be called. (except by an external debugger) */ 126 /* Should never, ever be called. (except by an external debugger) */
129 static void 127 static void
153 151
154 static const struct memory_description opaque_ptr_description[] = { 152 static const struct memory_description opaque_ptr_description[] = {
155 { XD_END } 153 { XD_END }
156 }; 154 };
157 155
158 DEFINE_LRECORD_IMPLEMENTATION ("opaque-ptr", opaque_ptr, 156 DEFINE_NODUMP_LISP_OBJECT ("opaque-ptr", opaque_ptr,
159 0, /*dumpable-flag*/ 157 0, print_opaque_ptr, 0,
160 0, print_opaque_ptr, 0, 158 equal_opaque_ptr, hash_opaque_ptr,
161 equal_opaque_ptr, hash_opaque_ptr, 159 opaque_ptr_description, Lisp_Opaque_Ptr);
162 opaque_ptr_description, Lisp_Opaque_Ptr);
163 160
164 Lisp_Object 161 Lisp_Object
165 make_opaque_ptr (void *val) 162 make_opaque_ptr (void *val)
166 { 163 {
167 #ifdef NEW_GC 164 #ifdef NEW_GC
168 Lisp_Object res = 165 Lisp_Object res = ALLOC_NORMAL_LISP_OBJECT (opaque_ptr);
169 wrap_pointer_1 (alloc_lrecord_type (Lisp_Opaque_Ptr,
170 &lrecord_opaque_ptr));
171 #else /* not NEW_GC */ 166 #else /* not NEW_GC */
172 Lisp_Object res = alloc_managed_lcrecord (Vopaque_ptr_free_list); 167 Lisp_Object res = alloc_managed_lcrecord (Vopaque_ptr_free_list);
173 #endif /* not NEW_GC */ 168 #endif /* not NEW_GC */
174 set_opaque_ptr (res, val); 169 set_opaque_ptr (res, val);
175 return res; 170 return res;
180 175
181 void 176 void
182 free_opaque_ptr (Lisp_Object ptr) 177 free_opaque_ptr (Lisp_Object ptr)
183 { 178 {
184 #ifdef NEW_GC 179 #ifdef NEW_GC
185 free_lrecord (ptr); 180 free_normal_lisp_object (ptr);
186 #else /* not NEW_GC */ 181 #else /* not NEW_GC */
187 free_managed_lcrecord (Vopaque_ptr_free_list, ptr); 182 free_managed_lcrecord (Vopaque_ptr_free_list, ptr);
188 #endif /* not NEW_GC */ 183 #endif /* not NEW_GC */
189 } 184 }
190 185
199 #endif /* not NEW_GC */ 194 #endif /* not NEW_GC */
200 195
201 void 196 void
202 init_opaque_once_early (void) 197 init_opaque_once_early (void)
203 { 198 {
204 INIT_LRECORD_IMPLEMENTATION (opaque); 199 INIT_LISP_OBJECT (opaque);
205 INIT_LRECORD_IMPLEMENTATION (opaque_ptr); 200 INIT_LISP_OBJECT (opaque_ptr);
206 201
207 #ifndef NEW_GC 202 #ifndef NEW_GC
208 reinit_opaque_early (); 203 reinit_opaque_early ();
209 #endif /* not NEW_GC */ 204 #endif /* not NEW_GC */
210 } 205 }