1 /* Opaque Lisp objects.
2 Copyright (C) 1993, 1994, 1995 Sun Microsystems, Inc.
3 Copyright (C) 1995, 1996 Ben Wing.
5 This file is part of SXEmacs
7 SXEmacs is free software: you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation, either version 3 of the License, or
10 (at your option) any later version.
12 SXEmacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program. If not, see <http://www.gnu.org/licenses/>. */
21 /* Synched up with: Not in FSF. */
23 /* Written by Ben Wing, October 1993. */
25 /* "Opaque" is used internally to hold keep track of allocated memory
26 so it gets GC'd properly, and to store arbitrary data in places
27 where a Lisp_Object is required and which may get GC'd. (e.g. as
28 the argument to record_unwind_protect()). Once created in C,
29 opaque objects cannot be resized.
31 OPAQUE OBJECTS SHOULD NEVER ESCAPE TO THE LISP LEVEL. Some code
32 depends on this. As such, opaque objects are a generalization
33 of the Qunbound marker.
40 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
41 Lisp_Object Vopaque_ptr_free_list;
44 /* Should never, ever be called. (except by an external debugger) */
46 print_opaque(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
48 const Lisp_Opaque *p = XOPAQUE(obj);
52 "#<INTERNAL OBJECT (SXEmacs bug?) (opaque, size=%lu) 0x%lx>",
53 (long)(p->size), (unsigned long)p);
54 write_c_string(buf, printcharfun);
58 aligned_sizeof_opaque(size_t opaque_size)
59 __attribute__((always_inline));
61 aligned_sizeof_opaque(size_t opaque_size)
63 return ALIGN_SIZE(offsetof(Lisp_Opaque, data) + opaque_size,
64 ALIGNOF(max_align_t));
67 static size_t sizeof_opaque(const void *header)
69 return aligned_sizeof_opaque(((const Lisp_Opaque *)header)->size);
72 /* Return an opaque object of size SIZE.
73 If DATA is OPAQUE_CLEAR, the object's data is memset to '\0' bytes.
74 If DATA is OPAQUE_UNINIT, the object's data is uninitialized.
75 Else the object's data is initialized by copying from DATA. */
77 make_opaque(const void *data, size_t size)
79 Lisp_Opaque *p = (Lisp_Opaque *)
80 alloc_lcrecord(aligned_sizeof_opaque(size), &lrecord_opaque);
83 if (data == OPAQUE_CLEAR)
84 memset(p->data, '\0', size);
85 else if (data == OPAQUE_UNINIT)
88 memcpy(p->data, data, size);
97 /* This will not work correctly for opaques with subobjects! */
99 static int equal_opaque(Lisp_Object obj1, Lisp_Object obj2, int depth)
102 return ((size = XOPAQUE_SIZE(obj1)) == XOPAQUE_SIZE(obj2) &&
103 !memcmp(XOPAQUE_DATA(obj1), XOPAQUE_DATA(obj2), size));
106 /* This will not work correctly for opaques with subobjects! */
108 static unsigned long hash_opaque(Lisp_Object obj, int depth)
110 if (XOPAQUE_SIZE(obj) == sizeof(unsigned long))
111 return *((unsigned long *)XOPAQUE_DATA(obj));
113 return memory_hash(XOPAQUE_DATA(obj), XOPAQUE_SIZE(obj));
116 static const struct lrecord_description opaque_description[] = {
120 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION("opaque", opaque,
122 equal_opaque, hash_opaque,
124 sizeof_opaque, Lisp_Opaque);
126 /* stuff to handle opaque pointers */
128 /* Should never, ever be called. (except by an external debugger) */
130 print_opaque_ptr(Lisp_Object obj, Lisp_Object printcharfun, int escapeflag)
132 const Lisp_Opaque_Ptr *p = XOPAQUE_PTR(obj);
136 "#<INTERNAL OBJECT (SXEmacs bug?) "
137 "(opaque-ptr, adr=%p) %p>", p->ptr, p);
138 write_c_string(buf, printcharfun);
141 static int equal_opaque_ptr(Lisp_Object obj1, Lisp_Object obj2, int depth)
143 return (XOPAQUE_PTR(obj1)->ptr == XOPAQUE_PTR(obj2)->ptr);
146 static unsigned long hash_opaque_ptr(Lisp_Object obj, int depth)
148 return (unsigned long)XOPAQUE_PTR(obj)->ptr;
151 DEFINE_LRECORD_IMPLEMENTATION("opaque-ptr", opaque_ptr,
152 0, print_opaque_ptr, 0,
153 equal_opaque_ptr, hash_opaque_ptr, 0,
156 Lisp_Object make_opaque_ptr(void *val)
158 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
159 Lisp_Object res = wrap_object(
160 alloc_lcrecord(sizeof(Lisp_Opaque_Ptr), &lrecord_opaque_ptr));
162 Lisp_Object res = allocate_managed_lcrecord(Vopaque_ptr_free_list);
165 set_opaque_ptr(res, val);
169 /* Be very very careful with this. Same admonitions as with
170 free_cons() apply. */
172 void free_opaque_ptr(Lisp_Object ptr)
174 #if defined HAVE_BDWGC && defined EF_USE_BDWGC
177 free_managed_lcrecord(Vopaque_ptr_free_list, ptr);
183 reinit_opaque_once_early(void)
185 #if !defined HAVE_BDWGC || !defined EF_USE_BDWGC
186 Vopaque_ptr_free_list =
187 make_lcrecord_list(sizeof(Lisp_Opaque_Ptr),
188 &lrecord_opaque_ptr);
189 staticpro_nodump(&Vopaque_ptr_free_list);
194 void init_opaque_once_early(void)
196 INIT_LRECORD_IMPLEMENTATION(opaque);
197 INIT_LRECORD_IMPLEMENTATION(opaque_ptr);
199 reinit_opaque_once_early();