Mercurial > hg > xemacs-beta
annotate src/sysdll.c @ 5560:58b38d5b32d0
Implement print-circle, allowing recursive and circular structures to be read.
src/ChangeLog addition:
2011-09-04 Aidan Kehoe <kehoea@parhasard.net>
* alloc.c:
* alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT_1):
* alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT):
* alloc.c (cons_print_preprocess):
* alloc.c (vector_print_preprocess):
* alloc.c (vector_nsubst_structures_descend):
* alloc.c (Fmake_symbol):
* alloc.c (UNMARK_symbol):
* alloc.c (sweep_symbols):
* alloc.c (reinit_alloc_objects_early):
* alloc.c (reinit_alloc_early):
* bytecode.c:
* bytecode.c (compiled_function_print_preprocess):
* bytecode.c (compiled_function_nsubst_structures_descend):
* bytecode.c (set_compiled_function_arglist):
* bytecode.c (set_compiled_function_interactive):
* bytecode.c (bytecode_objects_create):
* chartab.c:
* chartab.c (print_preprocess_mapper):
* chartab.c (nsubst_structures_mapper):
* chartab.c (char_table_nsubst_structures_descend):
* chartab.c (chartab_objects_create):
* elhash.c:
* elhash.c (nsubst_structures_map_hash_table):
* elhash.c (hash_table_nsubst_structures_descend):
* elhash.c (print_preprocess_mapper):
* elhash.c (hash_table_print_preprocess):
* elhash.c (inchash_eq):
* elhash.c (hash_table_objects_create):
* elhash.c (syms_of_elhash):
* elhash.h:
* emacs.c (main_1):
* fns.c:
* fns.c (check_eq_nokey):
* fns.c (Fnsubst):
* fns.c (syms_of_fns):
* lisp.h:
* lisp.h (struct Lisp_Symbol):
* lisp.h (IN_OBARRAY):
* lisp.h (struct):
* lisp.h (PRINT_PREPROCESS):
* lread.c (read1):
* lrecord.h:
* lrecord.h (struct lrecord_implementation):
* lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT):
* print.c:
* print.c (PRINT_CIRCLE_LIMIT):
* print.c (print_continuous_numbering_changed):
* print.c (print_prepare):
* print.c (print_finish):
* print.c (Fprin1_to_string):
* print.c (print_cons):
* print.c (print_preprocess_inchash_eq):
* print.c (print_preprocess):
* print.c (print_sort_get_numbers):
* print.c (print_sort_compare_ordinals):
* print.c (print_gensym_or_circle):
* print.c (nsubst_structures_descend):
* print.c (nsubst_structures):
* print.c (print_internal):
* print.c (print_symbol):
* print.c (vars_of_print):
* rangetab.c:
* rangetab.c (range_table_print_preprocess):
* rangetab.c (range_table_nsubst_structures_descend):
* rangetab.c (rangetab_objects_create):
* rangetab.c (syms_of_rangetab):
* symbols.c:
* symbols.c (symbol_print_preprocess):
* symbols.c (Fintern):
* symbols.c (Funintern):
* symbols.c (reinit_symbol_objects_early):
* symbols.c (init_symbols_once_early):
* symsinit.h:
Implement print-circle, printing circular structures in a readable
fashion, and treating them appropriately on read. This is by means
of two new object methods, print_preprocess (detecting
circularities), and nsubst_structures_descend (replacing
placeholders with the read objects).
Expose the substitution to Lisp via #'nsubst and its new
:descend-structures keyword.
Store information as to whether symbols are interned in obarray or
not in their header, making checking for keywords and uninterned
symbols (and thus printing) cheaper.
Default print_gensym to t, as Common Lisp does, and as a
more-than-decade old comment suggests.
lisp/ChangeLog addition:
2011-09-04 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el (byte-compile-output-file-form):
* bytecomp.el (byte-compile-output-docform):
Bind print-circle, print-continuous-numbering in these functions,
now those variables are available.
* lisp.el (forward-sexp):
* lisp.el (backward-sexp):
Recognise leading #N= as being part of an expression.
tests/ChangeLog addition:
2011-09-04 Aidan Kehoe <kehoea@parhasard.net>
* automated/lisp-reader-tests.el:
* automated/lisp-tests.el (literal-with-uninterned):
* automated/symbol-tests.el (foo):
Test print-circle, for printing (mutually-)recursive and circular
structures.
Bind print-continuous-numbering where appropriate.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sun, 04 Sep 2011 19:51:35 +0100 |
| parents | 4dee0387b9de |
| children | 5d5aeb79edb4 |
| rev | line source |
|---|---|
| 428 | 1 /* sysdll.c --- system dependent support for dynamic linked libraries |
| 2 Copyright (C) 1998 Free Software Foundation, Inc. | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
3 Copyright (C) 2010 Ben Wing. |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
4 |
| 428 | 5 Author: William Perry <wmperry@aventail.com> |
| 6 | |
| 7 This file is part of XEmacs. | |
| 8 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5183
diff
changeset
|
9 XEmacs is free software: you can redistribute it and/or modify it |
| 428 | 10 under the terms of the GNU General Public License as published by the |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5183
diff
changeset
|
11 Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5183
diff
changeset
|
12 option) any later version. |
| 428 | 13 |
| 14 XEmacs is distributed in the hope that it will be useful, but WITHOUT | |
| 15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
| 16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
| 17 for more details. | |
| 18 | |
| 19 You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5183
diff
changeset
|
20 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */ |
| 428 | 21 |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
22 /* This file has been Mule-ized, Ben Wing, 1-26-10. */ |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
23 |
| 428 | 24 #ifdef HAVE_CONFIG_H |
| 25 #include <config.h> | |
| 26 #endif | |
| 27 | |
| 430 | 28 #include <stdlib.h> |
| 1272 | 29 #include "lisp.h" |
| 428 | 30 #include "sysdll.h" |
| 31 | |
| 1383 | 32 #ifdef DLSYM_NEEDS_UNDERSCORE |
| 33 #define MAYBE_PREPEND_UNDERSCORE(n) do { \ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
34 Ibyte *buf = alloca_array (Ibyte, qxestrlen (n) + 2); \ |
| 1383 | 35 *buf = '_'; \ |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
36 qxestrcpy (buf + 1, n); \ |
| 1383 | 37 n = buf; \ |
| 38 } while (0) | |
| 39 #else | |
| 40 #define MAYBE_PREPEND_UNDERSCORE(n) | |
| 41 #endif | |
| 42 | |
| 428 | 43 /* This whole file is conditional upon HAVE_SHLIB */ |
| 44 #ifdef HAVE_SHLIB | |
| 45 | |
| 46 /* Thankfully, most systems follow the ELFish dlopen() method. | |
| 47 */ | |
| 452 | 48 #if defined(HAVE_DLOPEN) |
| 428 | 49 #include <dlfcn.h> |
| 50 | |
| 51 #ifndef RTLD_LAZY | |
| 1383 | 52 # ifdef DL_LAZY |
| 53 # define RTLD_LAZY DL_LAZY | |
| 54 # else | |
| 55 # define RTLD_LAZY 1 | |
| 56 # endif | |
| 428 | 57 #endif /* RTLD_LAZY isn't defined under FreeBSD - ick */ |
| 58 | |
| 863 | 59 #ifndef RTLD_NOW |
| 1383 | 60 # ifdef DL_NOW |
| 61 # define RTLD_NOW DL_NOW | |
| 62 # else | |
| 63 # define RTLD_NOW 2 | |
| 64 # endif | |
| 863 | 65 #endif |
| 66 | |
| 428 | 67 dll_handle |
| 1706 | 68 dll_open (Lisp_Object fname) |
| 428 | 69 { |
| 1706 | 70 Extbyte *soname; |
| 71 | |
| 72 if (NILP (fname)) | |
| 73 { | |
| 74 soname = NULL; | |
| 75 } | |
| 76 else | |
| 77 { | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
78 soname = LISP_STRING_TO_EXTERNAL (fname, Qdll_filename_encoding); |
| 1706 | 79 } |
| 80 return (dll_handle) dlopen (soname, RTLD_NOW); | |
| 428 | 81 } |
| 82 | |
| 83 int | |
| 84 dll_close (dll_handle h) | |
| 85 { | |
| 442 | 86 return dlclose ((void *) h); |
| 428 | 87 } |
| 88 | |
| 89 dll_func | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
90 dll_function (dll_handle h, const Ibyte *n) |
| 428 | 91 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
92 Extbyte *next; |
| 1383 | 93 MAYBE_PREPEND_UNDERSCORE (n); |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
94 next = ITEXT_TO_EXTERNAL (n, Qdll_function_name_encoding); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
95 return (dll_func) dlsym ((void *) h, next); |
| 428 | 96 } |
| 97 | |
| 98 dll_var | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
99 dll_variable (dll_handle h, const Ibyte *n) |
| 428 | 100 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
101 Extbyte *next; |
| 1383 | 102 MAYBE_PREPEND_UNDERSCORE (n); |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
103 next = ITEXT_TO_EXTERNAL (n, Qdll_variable_name_encoding); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
104 return (dll_var)dlsym ((void *)h, next); |
| 428 | 105 } |
| 106 | |
| 1706 | 107 Lisp_Object |
| 1811 | 108 dll_error () |
| 428 | 109 { |
| 1706 | 110 const Extbyte *msg; |
| 428 | 111 #if defined(HAVE_DLERROR) || defined(dlerror) |
| 1706 | 112 msg = (const Extbyte *) dlerror (); |
| 428 | 113 #elif defined(HAVE__DLERROR) |
| 1706 | 114 msg = (const Extbyte *) _dlerror(); |
| 428 | 115 #else |
| 1706 | 116 msg = (const Extbyte *) "Shared library error"; |
| 428 | 117 #endif |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
118 return build_extstring (msg, Qerror_message_encoding); |
| 428 | 119 } |
| 120 | |
| 121 #elif defined(HAVE_SHL_LOAD) | |
| 122 /* This is the HP/UX version */ | |
| 123 #include <dl.h> | |
| 124 dll_handle | |
| 1706 | 125 dll_open (Lisp_Object fname) |
| 428 | 126 { |
| 1706 | 127 Extbyte *soname; |
| 428 | 128 |
| 1706 | 129 if (NILP (fname)) |
| 130 { | |
| 131 soname = NULL; | |
| 132 } | |
| 133 else | |
| 134 { | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
135 soname = LISP_STRING_TO_EXTERNAL (fname, Qdll_filename_encoding); |
| 1706 | 136 } |
| 137 return (dll_handle) shl_load (soname, BIND_DEFERRED, 0L); | |
| 428 | 138 } |
| 139 | |
| 140 int | |
| 141 dll_close (dll_handle h) | |
| 142 { | |
| 442 | 143 return shl_unload ((shl_t) h); |
| 428 | 144 } |
| 145 | |
| 146 dll_func | |
| 1706 | 147 dll_function (dll_handle h, const CIbyte *n) |
| 428 | 148 { |
| 149 long handle = 0L; | |
| 150 | |
| 442 | 151 if (shl_findsym ((shl_t *) &h, n, TYPE_PROCEDURE, &handle)) |
| 428 | 152 return NULL; |
| 153 | |
| 442 | 154 return (dll_func) handle; |
| 428 | 155 } |
| 156 | |
| 157 dll_var | |
| 1706 | 158 dll_variable (dll_handle h, const CIbyte *n) |
| 428 | 159 { |
| 160 long handle = 0L; | |
| 161 | |
| 442 | 162 if (shl_findsym ((shl_t *) &h, n, TYPE_DATA, &handle)) |
| 428 | 163 return NULL; |
| 164 | |
| 442 | 165 return (dll_var) handle; |
| 428 | 166 } |
| 167 | |
| 1706 | 168 Lisp_Object |
| 1811 | 169 dll_error () |
| 428 | 170 { |
| 171 /* #### WTF?! Shouldn't this at least attempt to get strerror or | |
| 172 something? --hniksic */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
173 return build_ascstring ("Generic shared library error"); |
| 428 | 174 } |
| 175 | |
| 1632 | 176 #elif defined (WIN32_NATIVE) || defined (CYGWIN) |
| 442 | 177 |
| 1632 | 178 #include "syswindows.h" |
| 179 #include "sysfile.h" | |
| 442 | 180 |
| 428 | 181 dll_handle |
| 1706 | 182 dll_open (Lisp_Object fname) |
| 428 | 183 { |
| 1706 | 184 Extbyte *soname; |
| 185 | |
| 186 if (NILP (fname)) | |
| 187 { | |
| 188 soname = NULL; | |
| 189 } | |
| 190 else | |
| 191 { | |
|
4834
b3ea9c582280
Use new cygwin_conv_path API with Cygwin 1.7 for converting names between Win32 and POSIX, UTF-8-aware, with attendant changes elsewhere
Ben Wing <ben@xemacs.org>
parents:
3841
diff
changeset
|
192 LISP_LOCAL_FILE_FORMAT_TO_TSTR (fname, soname); |
| 1706 | 193 } |
| 194 return (dll_handle) qxeLoadLibrary (soname); | |
| 428 | 195 } |
| 196 | |
| 197 int | |
| 198 dll_close (dll_handle h) | |
| 199 { | |
| 1706 | 200 return FreeLibrary ((HMODULE) h); |
| 428 | 201 } |
| 202 | |
| 203 dll_func | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
204 dll_function (dll_handle h, const Ibyte *n) |
| 428 | 205 { |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
206 Extbyte *next = ITEXT_TO_EXTERNAL (n, Qmswindows_multibyte); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
207 return (dll_func) GetProcAddress ((HINSTANCE) h, next); |
| 428 | 208 } |
| 209 | |
| 210 dll_func | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
211 dll_variable (dll_handle h, const Ibyte *n) |
| 428 | 212 { |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
213 Extbyte *next = ITEXT_TO_EXTERNAL (n, Qmswindows_multibyte); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
214 return (dll_func) GetProcAddress ((HINSTANCE) h, next); |
| 428 | 215 } |
| 216 | |
| 1706 | 217 Lisp_Object |
| 1811 | 218 dll_error () |
| 428 | 219 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
220 Ascbyte err[32]; |
| 1706 | 221 snprintf (err, 32, "Windows DLL Error %lu", GetLastError ()); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
222 return build_ascstring (err); |
| 428 | 223 } |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
224 #elif defined (HAVE_DYLD) |
| 1383 | 225 /* This section supports MacOSX dynamic libraries. Dynamically |
| 226 loadable libraries must be compiled as bundles, not dynamiclibs. | |
| 227 */ | |
| 228 | |
| 229 #include <mach-o/dyld.h> | |
| 230 | |
| 231 dll_handle | |
| 1706 | 232 dll_open (Lisp_Object fname) |
| 1383 | 233 { |
| 1706 | 234 Extbyte *soname; |
| 1383 | 235 NSObjectFileImage file; |
| 1418 | 236 NSModule out; |
| 1706 | 237 NSObjectFileImageReturnCode ret; |
| 238 | |
| 2855 | 239 /* |
| 240 * MacOS X dll support is for bundles, not the current executable, so return | |
| 241 * NULL is this case. However, dll_function() uses a special hack where a | |
| 242 * NULL handle can be used to find executable symbols. This satisfies the | |
| 243 * needs of ui-gtk.c but is not a general solution. | |
| 244 */ | |
| 1706 | 245 if (NILP (fname)) |
| 246 { | |
| 2855 | 247 return NULL; |
| 1706 | 248 } |
| 249 else | |
| 250 { | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
251 soname = LISP_STRING_TO_EXTERNAL (fname, Qdll_filename_encoding); |
| 1706 | 252 } |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
253 ret = NSCreateObjectFileImageFromFile (soname, &file); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
254 if (ret != NSObjectFileImageSuccess) |
| 1383 | 255 return NULL; |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
256 out = NSLinkModule (file, soname, |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
257 NSLINKMODULE_OPTION_BINDNOW | |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
258 NSLINKMODULE_OPTION_PRIVATE | |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
259 NSLINKMODULE_OPTION_RETURN_ON_ERROR); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
260 return (dll_handle) out; |
| 1383 | 261 } |
| 262 | |
| 263 int | |
| 264 dll_close (dll_handle h) | |
| 265 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
266 return NSUnLinkModule ((NSModule) h, NSUNLINKMODULE_OPTION_NONE); |
| 1383 | 267 } |
| 268 | |
| 1851 | 269 /* Given an address, return the mach_header for the image containing it |
| 270 * or zero if the given address is not contained in any loaded images. | |
| 271 * | |
| 272 * Note: image_for_address(), my_find_image() and search_linked_libs() are | |
| 273 * based on code from the dlcompat library | |
| 274 * (http://www.opendarwin.org/projects/dlcompat). | |
| 275 */ | |
| 276 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
277 static const struct mach_header * |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
278 image_for_address (void *address) |
| 1851 | 279 { |
| 280 unsigned long i; | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
281 unsigned long count = _dyld_image_count (); |
| 3841 | 282 const struct mach_header *mh = 0; |
| 1851 | 283 |
| 284 for (i = 0; i < count; i++) | |
| 285 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
286 unsigned long addr = (unsigned long) address - |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
287 _dyld_get_image_vmaddr_slide (i); |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
288 mh = _dyld_get_image_header (i); |
| 1851 | 289 |
| 290 if (mh) | |
| 291 { | |
| 292 struct load_command *lc = | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
293 (struct load_command *) ((Rawbyte *) mh + |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
294 sizeof(struct mach_header)); |
| 1851 | 295 unsigned long j; |
| 296 | |
| 297 for (j = 0; j < mh->ncmds; | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
298 j++, lc = (struct load_command *) ((Rawbyte *)lc + lc->cmdsize)) |
| 1851 | 299 { |
| 300 if (LC_SEGMENT == lc->cmd && | |
| 301 addr >= ((struct segment_command *)lc)->vmaddr && | |
| 302 addr < | |
| 303 ((struct segment_command *)lc)->vmaddr + | |
| 304 ((struct segment_command *)lc)->vmsize) | |
| 305 { | |
| 306 goto image_found; | |
| 307 } | |
| 308 } | |
| 309 } | |
| 310 | |
| 311 mh = 0; | |
| 312 } | |
| 313 | |
| 314 image_found: | |
| 315 return mh; | |
| 316 } | |
| 317 | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
318 static const struct mach_header * |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
319 my_find_image (const char *name) |
| 1851 | 320 { |
| 321 const struct mach_header *mh = (struct mach_header *) | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
322 NSAddImage (name, NSADDIMAGE_OPTION_RETURN_ONLY_IF_LOADED | |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
323 NSADDIMAGE_OPTION_RETURN_ON_ERROR); |
| 1851 | 324 |
| 325 if (!mh) | |
| 326 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
327 int count = _dyld_image_count (); |
| 1851 | 328 int j; |
| 329 | |
| 330 for (j = 0; j < count; j++) | |
| 331 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
332 const char *id = _dyld_get_image_name (j); |
| 1851 | 333 |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
334 if (!strcmp (id, name)) |
| 1851 | 335 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
336 mh = _dyld_get_image_header (j); |
| 1851 | 337 break; |
| 338 } | |
| 339 } | |
| 340 } | |
| 341 | |
| 342 return mh; | |
| 343 } | |
| 344 | |
| 345 /* | |
|
5384
3889ef128488
Fix misspelled words, and some grammar, across the entire source tree.
Jerry James <james@xemacs.org>
parents:
5183
diff
changeset
|
346 * dyld adds libraries by first adding the directly dependent libraries in |
| 1851 | 347 * link order, and then adding the dependencies for those libraries, so we |
| 348 * should do the same... but we don't bother adding the extra dependencies, if | |
| 349 * the symbols are neither in the loaded image nor any of it's direct | |
| 350 * dependencies, then it probably isn't there. | |
| 351 */ | |
| 352 static NSSymbol | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
353 search_linked_libs (const struct mach_header * mh, const Ibyte *symbol) |
| 1851 | 354 { |
| 2054 | 355 unsigned long n; |
| 1851 | 356 NSSymbol nssym = 0; |
| 357 | |
| 358 struct load_command *lc = | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
359 (struct load_command *) ((Rawbyte *) mh + sizeof (struct mach_header)); |
| 1851 | 360 |
| 361 for (n = 0; n < mh->ncmds; | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
362 n++, lc = (struct load_command *) ((Rawbyte *) lc + lc->cmdsize)) |
| 1851 | 363 { |
| 364 if ((LC_LOAD_DYLIB == lc->cmd) || (LC_LOAD_WEAK_DYLIB == lc->cmd)) | |
| 365 { | |
| 366 struct mach_header *wh; | |
| 367 | |
| 368 if ((wh = (struct mach_header *) | |
|
5183
f283b08ff0c9
Avoid build failure, Apple's g++-4.0.1, Mac OS 10.4.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4981
diff
changeset
|
369 my_find_image((const Chbyte *) |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
370 (((struct dylib_command *) lc)-> |
|
5183
f283b08ff0c9
Avoid build failure, Apple's g++-4.0.1, Mac OS 10.4.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4981
diff
changeset
|
371 dylib.name.offset + (const Chbyte *) lc)))) |
| 1851 | 372 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
373 Extbyte *symext = |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
374 ITEXT_TO_EXTERNAL (symbol, Qdll_symbol_encoding); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
375 if (NSIsSymbolNameDefinedInImage (wh, symext)) |
| 1851 | 376 { |
| 377 nssym = | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
378 NSLookupSymbolInImage |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
379 (wh, |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
380 symext, |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
381 NSLOOKUPSYMBOLINIMAGE_OPTION_BIND | |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
382 NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR); |
| 1851 | 383 break; |
| 384 } | |
| 385 } | |
| 386 } | |
| 387 } | |
| 388 | |
| 389 return nssym; | |
| 390 } | |
| 391 | |
| 1383 | 392 dll_func |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
393 dll_function (dll_handle h, const Ibyte *n) |
| 1383 | 394 { |
| 1851 | 395 NSSymbol sym = 0; |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
396 Extbyte *next; |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
397 |
| 1383 | 398 MAYBE_PREPEND_UNDERSCORE (n); |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
399 next = ITEXT_TO_EXTERNAL (n, Qdll_function_name_encoding); |
| 1851 | 400 |
| 401 /* NULL means the program image and shared libraries, not bundles. */ | |
| 402 | |
| 403 if (h == NULL) | |
| 404 { | |
| 405 /* NOTE: This assumes that this function is included in the main program | |
| 406 and not in a shared library. */ | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
407 const struct mach_header* my_mh = |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
408 image_for_address ((void*) &dll_function); |
| 1851 | 409 |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
410 if (NSIsSymbolNameDefinedInImage (my_mh, next)) |
| 1851 | 411 { |
| 412 sym = | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
413 NSLookupSymbolInImage |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
414 (my_mh, |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
415 next, |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
416 NSLOOKUPSYMBOLINIMAGE_OPTION_BIND | |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
417 NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR); |
| 1851 | 418 } |
| 419 | |
| 420 if (!sym) | |
| 421 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
422 sym = search_linked_libs (my_mh, n); |
| 1851 | 423 } |
| 424 } | |
| 425 else | |
| 426 { | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
427 sym = NSLookupSymbolInModule ((NSModule)h, next); |
| 1851 | 428 } |
| 429 | |
| 430 if (sym == 0) return 0; | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
431 return (dll_func) NSAddressOfSymbol (sym); |
| 1851 | 432 } |
| 1383 | 433 |
| 434 dll_var | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
435 dll_variable (dll_handle h, const Ibyte *n) |
| 1383 | 436 { |
| 437 NSSymbol sym; | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
438 Extbyte *next; |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
439 |
| 1383 | 440 MAYBE_PREPEND_UNDERSCORE (n); |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
441 next = ITEXT_TO_EXTERNAL (n, Qdll_variable_name_encoding); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
442 |
|
5183
f283b08ff0c9
Avoid build failure, Apple's g++-4.0.1, Mac OS 10.4.
Aidan Kehoe <kehoea@parhasard.net>
parents:
4981
diff
changeset
|
443 sym = NSLookupSymbolInModule ((NSModule) h, (const Chbyte *)n); |
| 1383 | 444 if (sym == 0) return 0; |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
445 return (dll_var) NSAddressOfSymbol (sym); |
| 1383 | 446 } |
| 447 | |
| 1706 | 448 Lisp_Object |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
449 dll_error (void) |
| 1383 | 450 { |
| 451 NSLinkEditErrors c; | |
| 452 int errorNumber; | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
453 const Extbyte *fileNameWithError, *errorString; |
|
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
454 NSLinkEditError (&c, &errorNumber, &fileNameWithError, &errorString); |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
455 return build_extstring (errorString, Qerror_message_encoding); |
| 1383 | 456 } |
| 2078 | 457 #elif HAVE_LTDL |
| 458 /* Libtool's libltdl */ | |
| 459 #include <ltdl.h> | |
| 460 | |
| 461 dll_handle | |
| 462 dll_open (Lisp_Object fname) | |
| 463 { | |
| 464 Extbyte *soname; | |
| 465 | |
| 466 if (NILP (fname)) | |
| 467 { | |
| 468 soname = NULL; | |
| 469 } | |
| 470 else | |
| 471 { | |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
472 soname = LISP_STRING_TO_EXTERNAL (fname, Qdll_filename_encoding); |
| 2078 | 473 } |
| 474 return (dll_handle) lt_dlopen (soname); | |
| 475 } | |
| 476 | |
| 477 int | |
| 478 dll_close (dll_handle h) | |
| 479 { | |
| 480 return lt_dlclose ((lt_dlhandle) h); | |
| 481 } | |
| 482 | |
| 483 dll_func | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
484 dll_function (dll_handle h, const Ibyte *n) |
| 2078 | 485 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
486 Extbyte *next; |
| 2078 | 487 MAYBE_PREPEND_UNDERSCORE (n); |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
488 next = ITEXT_TO_EXTERNAL (n, Qdll_function_name_encoding); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
489 return (dll_func) lt_dlsym ((lt_dlhandle) h, next); |
| 2078 | 490 } |
| 491 | |
| 492 dll_var | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
493 dll_variable (dll_handle h, const Ibyte *n) |
| 2078 | 494 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
495 Extbyte *next; |
| 2078 | 496 MAYBE_PREPEND_UNDERSCORE (n); |
|
4981
4aebb0131297
Cleanups/renaming of EXTERNAL_TO_C_STRING and friends
Ben Wing <ben@xemacs.org>
parents:
4953
diff
changeset
|
497 next = ITEXT_TO_EXTERNAL (n, Qdll_variable_name_encoding); |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
498 return (dll_var) lt_dlsym ((lt_dlhandle) h, next); |
| 2078 | 499 } |
| 500 | |
| 501 Lisp_Object | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
502 dll_error (void) |
| 2078 | 503 { |
|
4953
304aebb79cd3
function renamings to track names of char typedefs
Ben Wing <ben@xemacs.org>
parents:
4952
diff
changeset
|
504 return build_extstring (lt_dlerror (), Qerror_message_encoding); |
| 2078 | 505 } |
| 428 | 506 #else |
| 1706 | 507 /* Catchall if we don't know about this system's method of dynamic loading */ |
| 428 | 508 dll_handle |
| 1706 | 509 dll_open (Lisp_Object fname) |
| 428 | 510 { |
| 511 return NULL; | |
| 512 } | |
| 513 | |
| 514 int | |
| 515 dll_close (dll_handle h) | |
| 516 { | |
| 517 return 0; | |
| 518 } | |
| 519 | |
| 520 dll_func | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
521 dll_function (dll_handle h, const Ibyte *n) |
| 428 | 522 { |
| 523 return NULL; | |
| 524 } | |
| 525 | |
| 526 dll_func | |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
527 dll_variable (dll_handle h, const Ibyte *n) |
| 428 | 528 { |
| 529 return NULL; | |
| 530 } | |
| 531 | |
| 1706 | 532 Lisp_Object |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
533 dll_error (void) |
| 428 | 534 { |
|
4952
19a72041c5ed
Mule-izing, various fixes related to char * arguments
Ben Wing <ben@xemacs.org>
parents:
4834
diff
changeset
|
535 return build_ascstring ("Shared libraries not implemented on this system"); |
| 428 | 536 } |
| 537 #endif /* System conditionals */ | |
| 538 | |
| 539 #endif /* HAVE_SHLIB */ |