Mercurial > hg > xemacs-beta
annotate src/opaque.c @ 5041:efaa6cd845e5
add regexp-debugging
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-15 Ben Wing <ben@xemacs.org>
* regex.c:
* regex.c (DEBUG_FAIL_PRINT1):
* regex.c (PUSH_FAILURE_POINT):
* regex.c (POP_FAILURE_POINT):
* regex.c (regex_compile):
* regex.c (re_match_2_internal):
* regex.h:
* search.c:
* search.c (search_buffer):
* search.c (debug_regexps_changed):
* search.c (vars_of_search):
Add an internal variable debug_regexps and a corresponding Lisp
variable `debug-regexps' that takes a list of areas in which to
display debugging info about regex compilation and matching
(currently three areas exist). Use existing debugging code
already in regex.c and modify it so that it recognizes the
debug_regexps variable and the flags in it.
Rename variable `debug-xemacs-searches' to just `debug-searches',
consistent with other debug vars.
tests/ChangeLog addition:
2010-02-15 Ben Wing <ben@xemacs.org>
* automated/search-tests.el (let):
* automated/search-tests.el (boundp):
debug-xemacs-searches renamed to debug-searches.
| author | Ben Wing <ben@xemacs.org> |
|---|---|
| date | Mon, 15 Feb 2010 21:51:22 -0600 |
| parents | 6ef8256a020a |
| children | b5df3737028a |
| rev | line source |
|---|---|
| 428 | 1 /* Opaque Lisp objects. |
| 2 Copyright (C) 1993, 1994, 1995 Sun Microsystems, Inc. | |
| 800 | 3 Copyright (C) 1995, 1996, 2002 Ben Wing. |
| 428 | 4 |
| 5 This file is part of XEmacs. | |
| 6 | |
| 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 | |
| 9 Free Software Foundation; either version 2, or (at your option) any | |
| 10 later version. | |
| 11 | |
| 12 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 13 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 14 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 15 for more details. | |
| 16 | |
| 17 You should have received a copy of the GNU General Public License | |
| 18 along with XEmacs; see the file COPYING. If not, write to | |
| 19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
| 20 Boston, MA 02111-1307, USA. */ | |
| 21 | |
| 22 /* Synched up with: Not in FSF. */ | |
| 23 | |
| 24 /* Written by Ben Wing, October 1993. */ | |
| 25 | |
| 26 /* "Opaque" is used internally to hold keep track of allocated memory | |
| 27 so it gets GC'd properly, and to store arbitrary data in places | |
| 28 where a Lisp_Object is required and which may get GC'd. (e.g. as | |
| 29 the argument to record_unwind_protect()). Once created in C, | |
| 30 opaque objects cannot be resized. | |
| 31 | |
| 32 OPAQUE OBJECTS SHOULD NEVER ESCAPE TO THE LISP LEVEL. Some code | |
| 33 depends on this. As such, opaque objects are a generalization | |
| 34 of the Qunbound marker. | |
| 35 */ | |
| 36 | |
| 37 #include <config.h> | |
| 38 #include "lisp.h" | |
| 39 #include "opaque.h" | |
| 40 | |
| 3263 | 41 #ifndef NEW_GC |
| 428 | 42 Lisp_Object Vopaque_ptr_free_list; |
| 3263 | 43 #endif /* not NEW_GC */ |
| 428 | 44 |
| 45 /* Should never, ever be called. (except by an external debugger) */ | |
| 46 static void | |
| 2286 | 47 print_opaque (Lisp_Object obj, Lisp_Object printcharfun, |
| 48 int UNUSED (escapeflag)) | |
| 428 | 49 { |
| 442 | 50 const Lisp_Opaque *p = XOPAQUE (obj); |
| 428 | 51 |
| 800 | 52 write_fmt_string |
| 53 (printcharfun, | |
| 54 "#<INTERNAL OBJECT (XEmacs bug?) (opaque, size=%lu) 0x%lx>", | |
| 55 (long)(p->size), (unsigned long) p); | |
| 428 | 56 } |
| 57 | |
| 665 | 58 inline static Bytecount |
| 59 aligned_sizeof_opaque (Bytecount opaque_size) | |
| 456 | 60 { |
| 826 | 61 return MAX_ALIGN_SIZE (offsetof (Lisp_Opaque, data) + opaque_size); |
| 456 | 62 } |
| 63 | |
| 665 | 64 static Bytecount |
| 442 | 65 sizeof_opaque (const void *header) |
| 428 | 66 { |
| 456 | 67 return aligned_sizeof_opaque (((const Lisp_Opaque *) header)->size); |
| 428 | 68 } |
| 69 | |
| 70 /* Return an opaque object of size SIZE. | |
| 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. | |
| 73 Else the object's data is initialized by copying from DATA. */ | |
| 74 Lisp_Object | |
| 665 | 75 make_opaque (const void *data, Bytecount size) |
| 428 | 76 { |
| 77 Lisp_Opaque *p = (Lisp_Opaque *) | |
| 3017 | 78 BASIC_ALLOC_LCRECORD (aligned_sizeof_opaque (size), &lrecord_opaque); |
| 428 | 79 p->size = size; |
| 80 | |
| 81 if (data == OPAQUE_CLEAR) | |
| 82 memset (p->data, '\0', size); | |
| 83 else if (data == OPAQUE_UNINIT) | |
| 84 DO_NOTHING; | |
| 85 else | |
| 86 memcpy (p->data, data, size); | |
| 87 | |
| 88 { | |
| 793 | 89 return wrap_opaque (p); |
| 428 | 90 } |
| 91 } | |
| 92 | |
| 93 /* This will not work correctly for opaques with subobjects! */ | |
| 94 | |
| 95 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
96 equal_opaque (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
97 int UNUSED (foldcase)) |
| 428 | 98 { |
| 665 | 99 Bytecount size; |
| 428 | 100 return ((size = XOPAQUE_SIZE (obj1)) == XOPAQUE_SIZE (obj2) && |
| 101 !memcmp (XOPAQUE_DATA (obj1), XOPAQUE_DATA (obj2), size)); | |
| 102 } | |
| 103 | |
| 104 /* This will not work correctly for opaques with subobjects! */ | |
| 105 | |
| 2515 | 106 static Hashcode |
| 2286 | 107 hash_opaque (Lisp_Object obj, int UNUSED (depth)) |
| 428 | 108 { |
| 109 if (XOPAQUE_SIZE (obj) == sizeof (unsigned long)) | |
| 2515 | 110 return *((Hashcode *) XOPAQUE_DATA (obj)); |
| 428 | 111 else |
| 112 return memory_hash (XOPAQUE_DATA (obj), XOPAQUE_SIZE (obj)); | |
| 113 } | |
| 114 | |
| 1204 | 115 static const struct memory_description opaque_description[] = { |
| 428 | 116 { XD_END } |
| 117 }; | |
| 118 | |
| 934 | 119 DEFINE_LRECORD_SEQUENCE_IMPLEMENTATION ("opaque", opaque, |
| 120 1, /*dumpable-flag*/ | |
| 121 0, print_opaque, 0, | |
| 122 equal_opaque, hash_opaque, | |
| 123 opaque_description, | |
| 124 sizeof_opaque, Lisp_Opaque); | |
| 428 | 125 |
| 126 /* stuff to handle opaque pointers */ | |
| 127 | |
| 128 /* Should never, ever be called. (except by an external debugger) */ | |
| 129 static void | |
| 2286 | 130 print_opaque_ptr (Lisp_Object obj, Lisp_Object printcharfun, |
| 131 int UNUSED (escapeflag)) | |
| 428 | 132 { |
| 442 | 133 const Lisp_Opaque_Ptr *p = XOPAQUE_PTR (obj); |
| 428 | 134 |
| 800 | 135 write_fmt_string |
| 136 (printcharfun, | |
| 137 "#<INTERNAL OBJECT (XEmacs bug?) (opaque-ptr, adr=0x%lx) 0x%lx>", | |
| 138 (long)(p->ptr), (unsigned long) p); | |
| 428 | 139 } |
| 140 | |
| 141 static int | |
|
4906
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
142 equal_opaque_ptr (Lisp_Object obj1, Lisp_Object obj2, int UNUSED (depth), |
|
6ef8256a020a
implement equalp in C, fix case-folding, add equal() method for keymaps
Ben Wing <ben@xemacs.org>
parents:
3263
diff
changeset
|
143 int UNUSED (foldcase)) |
| 428 | 144 { |
| 145 return (XOPAQUE_PTR (obj1)->ptr == XOPAQUE_PTR (obj2)->ptr); | |
| 146 } | |
| 147 | |
| 2515 | 148 static Hashcode |
| 2286 | 149 hash_opaque_ptr (Lisp_Object obj, int UNUSED (depth)) |
| 428 | 150 { |
| 2515 | 151 return (Hashcode) XOPAQUE_PTR (obj)->ptr; |
| 428 | 152 } |
| 153 | |
| 1575 | 154 static const struct memory_description opaque_ptr_description[] = { |
| 155 { XD_END } | |
| 156 }; | |
| 157 | |
| 934 | 158 DEFINE_LRECORD_IMPLEMENTATION ("opaque-ptr", opaque_ptr, |
| 159 0, /*dumpable-flag*/ | |
| 160 0, print_opaque_ptr, 0, | |
| 1204 | 161 equal_opaque_ptr, hash_opaque_ptr, |
| 1575 | 162 opaque_ptr_description, Lisp_Opaque_Ptr); |
| 428 | 163 |
| 164 Lisp_Object | |
| 165 make_opaque_ptr (void *val) | |
| 166 { | |
| 3263 | 167 #ifdef NEW_GC |
| 2720 | 168 Lisp_Object res = |
| 169 wrap_pointer_1 (alloc_lrecord_type (Lisp_Opaque_Ptr, | |
| 170 &lrecord_opaque_ptr)); | |
| 3263 | 171 #else /* not NEW_GC */ |
| 1204 | 172 Lisp_Object res = alloc_managed_lcrecord (Vopaque_ptr_free_list); |
| 3263 | 173 #endif /* not NEW_GC */ |
| 428 | 174 set_opaque_ptr (res, val); |
| 175 return res; | |
| 176 } | |
| 177 | |
| 178 /* Be very very careful with this. Same admonitions as with | |
| 179 free_cons() apply. */ | |
| 180 | |
| 181 void | |
| 182 free_opaque_ptr (Lisp_Object ptr) | |
| 183 { | |
| 3263 | 184 #ifdef NEW_GC |
| 2720 | 185 free_lrecord (ptr); |
| 3263 | 186 #else /* not NEW_GC */ |
| 428 | 187 free_managed_lcrecord (Vopaque_ptr_free_list, ptr); |
| 3263 | 188 #endif /* not NEW_GC */ |
| 428 | 189 } |
| 190 | |
| 3263 | 191 #ifndef NEW_GC |
| 428 | 192 void |
| 1204 | 193 reinit_opaque_early (void) |
| 428 | 194 { |
| 647 | 195 Vopaque_ptr_free_list = make_lcrecord_list (sizeof (Lisp_Opaque_Ptr), |
| 196 &lrecord_opaque_ptr); | |
| 428 | 197 staticpro_nodump (&Vopaque_ptr_free_list); |
| 198 } | |
| 3263 | 199 #endif /* not NEW_GC */ |
| 428 | 200 |
| 201 void | |
| 202 init_opaque_once_early (void) | |
| 203 { | |
| 442 | 204 INIT_LRECORD_IMPLEMENTATION (opaque); |
| 205 INIT_LRECORD_IMPLEMENTATION (opaque_ptr); | |
| 206 | |
| 3263 | 207 #ifndef NEW_GC |
| 1204 | 208 reinit_opaque_early (); |
| 3263 | 209 #endif /* not NEW_GC */ |
| 428 | 210 } |