Mercurial > hg > xemacs-beta
view src/sysdll.c @ 5013:ae48681c47fa
changes to VOID_TO_LISP et al.
-------------------- ChangeLog entries follow: --------------------
src/ChangeLog addition:
2010-02-08 Ben Wing <ben@xemacs.org>
* casetab.c (compute_canon_mapper):
* casetab.c (initialize_identity_mapper):
* casetab.c (compute_up_or_eqv_mapper):
* casetab.c (recompute_case_table):
* casetab.c (set_case_table):
* chartab.c (copy_mapper):
* chartab.c (copy_char_table_range):
* chartab.c (get_range_char_table_1):
* console.c (find_nonminibuffer_frame_not_on_console_predicate):
* console.c (find_nonminibuffer_frame_not_on_console):
* console.c (nuke_all_console_slots):
* device.c:
* device.c (find_nonminibuffer_frame_not_on_device_predicate):
* device.c (find_nonminibuffer_frame_not_on_device):
* dialog-msw.c (dialog_proc):
* dialog-msw.c (handle_question_dialog_box):
* dialog-x.c (maybe_run_dbox_text_callback):
* eval.c:
* eval.c (safe_run_hook_trapping_problems_1):
* eval.c (safe_run_hook_trapping_problems):
* event-msw.c:
* event-msw.c (mswindows_wnd_proc):
* event-msw.c (mswindows_find_frame):
* faces.c (update_face_inheritance_mapper):
* frame-msw.c (mswindows_init_frame_1):
* frame-msw.c (mswindows_get_mouse_position):
* frame-msw.c (mswindows_get_frame_parent):
* glade.c (connector):
* glade.c (Fglade_xml_signal_connect):
* glade.c (Fglade_xml_signal_autoconnect):
* glade.c (Fglade_xml_textdomain):
* glyphs-msw.c (mswindows_subwindow_instantiate):
* glyphs-msw.c (mswindows_widget_instantiate):
* glyphs.c (check_instance_cache_mapper):
* glyphs.c (check_window_subwindow_cache):
* glyphs.c (check_image_instance_structure):
* gui-x.c (snarf_widget_value_mapper):
* gui-x.c (popup_selection_callback):
* gui-x.c (button_item_to_widget_value):
* keymap.c (map_keymap_mapper):
* keymap.c (Fmap_keymap):
* menubar-gtk.c (__torn_off_sir):
* menubar-gtk.c (__activate_menu):
* menubar-gtk.c (menu_convert):
* menubar-gtk.c (__generic_button_callback):
* menubar-gtk.c (menu_descriptor_to_widget_1):
* menubar-msw.c:
* menubar-msw.c (EMPTY_ITEM_ID):
* menubar-x.c (menu_item_descriptor_to_widget_value_1):
* menubar-x.c (pre_activate_callback):
* menubar-x.c (command_builder_operate_menu_accelerator):
* menubar-x.c (command_builder_find_menu_accelerator):
* print.c (print_internal):
* process-unix.c (close_process_descs_mapfun):
* process.c (get_process_from_usid):
* process.c (init_process_io_handles):
* profile.c (sigprof_handler):
* profile.c (get_profiling_info_timing_maphash):
* profile.c (Fget_profiling_info):
* profile.c (set_profiling_info_timing_maphash):
* profile.c (mark_profiling_info_maphash):
* scrollbar-msw.c (mswindows_create_scrollbar_instance):
* scrollbar-msw.c (mswindows_free_scrollbar_instance):
* scrollbar-msw.c (mswindows_handle_scrollbar_event):
* specifier.c (recompute_cached_specifier_everywhere_mapfun):
* specifier.c (recompute_cached_specifier_everywhere):
* syntax.c (copy_to_mirrortab):
* syntax.c (copy_if_not_already_present):
* syntax.c (update_just_this_syntax_table):
* text.c (new_dfc_convert_now_damn_it):
* text.h (LISP_STRING_TO_EXTERNAL):
* tooltalk.c:
* tooltalk.c (tooltalk_message_callback):
* tooltalk.c (tooltalk_pattern_callback):
* tooltalk.c (Fcreate_tooltalk_message):
* tooltalk.c (Fcreate_tooltalk_pattern):
* ui-byhand.c (__generic_toolbar_callback):
* ui-byhand.c (generic_toolbar_insert_item):
* ui-byhand.c (__emacs_gtk_ctree_recurse_internal):
* ui-byhand.c (Fgtk_ctree_recurse):
* ui-gtk.c (__internal_callback_destroy):
* ui-gtk.c (__internal_callback_marshal):
* ui-gtk.c (Fgtk_signal_connect):
* ui-gtk.c (gtk_type_to_lisp):
* ui-gtk.c (lisp_to_gtk_type):
* ui-gtk.c (lisp_to_gtk_ret_type):
* lisp-disunion.h:
* lisp-disunion.h (NON_LVALUE):
* lisp-union.h:
* lisp.h (LISP_HASH):
Rename:
LISP_TO_VOID -> STORE_LISP_IN_VOID
VOID_TO_LISP -> GET_LISP_FROM_VOID
These new names are meant to clearly identify that the Lisp object
is the source and void the sink, and that they can't be used the
other way around -- they aren't exact opposites despite the old
names. The names are also important given the new functions
created just below. Also, clarify comments in lisp-union.h and
lisp-disunion.h about the use of the functions.
* lisp.h:
New functions STORE_VOID_IN_LISP and GET_VOID_FROM_LISP. These
are different from the above in that the source is a void *
(previously, you had to use make_opaque_ptr()).
* eval.c (restore_lisp_object):
* eval.c (record_unwind_protect_restoring_lisp_object):
* eval.c (struct restore_int):
* eval.c (restore_int):
* eval.c (record_unwind_protect_restoring_int):
* eval.c (free_pointer):
* eval.c (record_unwind_protect_freeing):
* eval.c (free_dynarr):
* eval.c (record_unwind_protect_freeing_dynarr):
* eval.c (unbind_to_1):
Use STORE_VOID_IN_LISP and GET_VOID_FROM_LISP to eliminate the
use of make_opaque_ptr() and mostly eliminate Lisp consing
entirely in the use of these various record_unwind_protect_*
functions as well as internal_bind_* (e.g. internal_bind_int).
* tests.c:
* tests.c (Ftest_store_void_in_lisp):
* tests.c (syms_of_tests):
* tests.c (vars_of_tests):
Add an C-assert-style test to test STORE_VOID_IN_LISP and
GET_VOID_FROM_LISP to make sure the same value comes back that
was put in.
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Mon, 08 Feb 2010 06:42:16 -0600 |
parents | 4aebb0131297 |
children | f283b08ff0c9 |
line wrap: on
line source
/* sysdll.c --- system dependent support for dynamic linked libraries Copyright (C) 1998 Free Software Foundation, Inc. Copyright (C) 2010 Ben Wing. Author: William Perry <wmperry@aventail.com> This file is part of XEmacs. XEmacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. XEmacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with XEmacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */ /* This file has been Mule-ized, Ben Wing, 1-26-10. */ #ifdef HAVE_CONFIG_H #include <config.h> #endif #include <stdlib.h> #include "lisp.h" #include "sysdll.h" #ifdef DLSYM_NEEDS_UNDERSCORE #define MAYBE_PREPEND_UNDERSCORE(n) do { \ Ibyte *buf = alloca_array (Ibyte, qxestrlen (n) + 2); \ *buf = '_'; \ qxestrcpy (buf + 1, n); \ n = buf; \ } while (0) #else #define MAYBE_PREPEND_UNDERSCORE(n) #endif /* This whole file is conditional upon HAVE_SHLIB */ #ifdef HAVE_SHLIB /* Thankfully, most systems follow the ELFish dlopen() method. */ #if defined(HAVE_DLOPEN) #include <dlfcn.h> #ifndef RTLD_LAZY # ifdef DL_LAZY # define RTLD_LAZY DL_LAZY # else # define RTLD_LAZY 1 # endif #endif /* RTLD_LAZY isn't defined under FreeBSD - ick */ #ifndef RTLD_NOW # ifdef DL_NOW # define RTLD_NOW DL_NOW # else # define RTLD_NOW 2 # endif #endif dll_handle dll_open (Lisp_Object fname) { Extbyte *soname; if (NILP (fname)) { soname = NULL; } else { soname = LISP_STRING_TO_EXTERNAL (fname, Qdll_filename_encoding); } return (dll_handle) dlopen (soname, RTLD_NOW); } int dll_close (dll_handle h) { return dlclose ((void *) h); } dll_func dll_function (dll_handle h, const Ibyte *n) { Extbyte *next; MAYBE_PREPEND_UNDERSCORE (n); next = ITEXT_TO_EXTERNAL (n, Qdll_function_name_encoding); return (dll_func) dlsym ((void *) h, next); } dll_var dll_variable (dll_handle h, const Ibyte *n) { Extbyte *next; MAYBE_PREPEND_UNDERSCORE (n); next = ITEXT_TO_EXTERNAL (n, Qdll_variable_name_encoding); return (dll_var)dlsym ((void *)h, next); } Lisp_Object dll_error () { const Extbyte *msg; #if defined(HAVE_DLERROR) || defined(dlerror) msg = (const Extbyte *) dlerror (); #elif defined(HAVE__DLERROR) msg = (const Extbyte *) _dlerror(); #else msg = (const Extbyte *) "Shared library error"; #endif return build_extstring (msg, Qerror_message_encoding); } #elif defined(HAVE_SHL_LOAD) /* This is the HP/UX version */ #include <dl.h> dll_handle dll_open (Lisp_Object fname) { Extbyte *soname; if (NILP (fname)) { soname = NULL; } else { soname = LISP_STRING_TO_EXTERNAL (fname, Qdll_filename_encoding); } return (dll_handle) shl_load (soname, BIND_DEFERRED, 0L); } int dll_close (dll_handle h) { return shl_unload ((shl_t) h); } dll_func dll_function (dll_handle h, const CIbyte *n) { long handle = 0L; if (shl_findsym ((shl_t *) &h, n, TYPE_PROCEDURE, &handle)) return NULL; return (dll_func) handle; } dll_var dll_variable (dll_handle h, const CIbyte *n) { long handle = 0L; if (shl_findsym ((shl_t *) &h, n, TYPE_DATA, &handle)) return NULL; return (dll_var) handle; } Lisp_Object dll_error () { /* #### WTF?! Shouldn't this at least attempt to get strerror or something? --hniksic */ return build_ascstring ("Generic shared library error"); } #elif defined (WIN32_NATIVE) || defined (CYGWIN) #include "syswindows.h" #include "sysfile.h" dll_handle dll_open (Lisp_Object fname) { Extbyte *soname; if (NILP (fname)) { soname = NULL; } else { LISP_LOCAL_FILE_FORMAT_TO_TSTR (fname, soname); } return (dll_handle) qxeLoadLibrary (soname); } int dll_close (dll_handle h) { return FreeLibrary ((HMODULE) h); } dll_func dll_function (dll_handle h, const Ibyte *n) { Extbyte *next = ITEXT_TO_EXTERNAL (n, Qmswindows_multibyte); return (dll_func) GetProcAddress ((HINSTANCE) h, next); } dll_func dll_variable (dll_handle h, const Ibyte *n) { Extbyte *next = ITEXT_TO_EXTERNAL (n, Qmswindows_multibyte); return (dll_func) GetProcAddress ((HINSTANCE) h, next); } Lisp_Object dll_error () { Ascbyte err[32]; snprintf (err, 32, "Windows DLL Error %lu", GetLastError ()); return build_ascstring (err); } #elif defined (HAVE_DYLD) /* This section supports MacOSX dynamic libraries. Dynamically loadable libraries must be compiled as bundles, not dynamiclibs. */ #include <mach-o/dyld.h> dll_handle dll_open (Lisp_Object fname) { Extbyte *soname; NSObjectFileImage file; NSModule out; NSObjectFileImageReturnCode ret; /* * MacOS X dll support is for bundles, not the current executable, so return * NULL is this case. However, dll_function() uses a special hack where a * NULL handle can be used to find executable symbols. This satisfies the * needs of ui-gtk.c but is not a general solution. */ if (NILP (fname)) { return NULL; } else { soname = LISP_STRING_TO_EXTERNAL (fname, Qdll_filename_encoding); } ret = NSCreateObjectFileImageFromFile (soname, &file); if (ret != NSObjectFileImageSuccess) return NULL; out = NSLinkModule (file, soname, NSLINKMODULE_OPTION_BINDNOW | NSLINKMODULE_OPTION_PRIVATE | NSLINKMODULE_OPTION_RETURN_ON_ERROR); return (dll_handle) out; } int dll_close (dll_handle h) { return NSUnLinkModule ((NSModule) h, NSUNLINKMODULE_OPTION_NONE); } /* Given an address, return the mach_header for the image containing it * or zero if the given address is not contained in any loaded images. * * Note: image_for_address(), my_find_image() and search_linked_libs() are * based on code from the dlcompat library * (http://www.opendarwin.org/projects/dlcompat). */ static const struct mach_header * image_for_address (void *address) { unsigned long i; unsigned long count = _dyld_image_count (); const struct mach_header *mh = 0; for (i = 0; i < count; i++) { unsigned long addr = (unsigned long) address - _dyld_get_image_vmaddr_slide (i); mh = _dyld_get_image_header (i); if (mh) { struct load_command *lc = (struct load_command *) ((Rawbyte *) mh + sizeof(struct mach_header)); unsigned long j; for (j = 0; j < mh->ncmds; j++, lc = (struct load_command *) ((Rawbyte *)lc + lc->cmdsize)) { if (LC_SEGMENT == lc->cmd && addr >= ((struct segment_command *)lc)->vmaddr && addr < ((struct segment_command *)lc)->vmaddr + ((struct segment_command *)lc)->vmsize) { goto image_found; } } } mh = 0; } image_found: return mh; } static const struct mach_header * my_find_image (const char *name) { const struct mach_header *mh = (struct mach_header *) NSAddImage (name, NSADDIMAGE_OPTION_RETURN_ONLY_IF_LOADED | NSADDIMAGE_OPTION_RETURN_ON_ERROR); if (!mh) { int count = _dyld_image_count (); int j; for (j = 0; j < count; j++) { const char *id = _dyld_get_image_name (j); if (!strcmp (id, name)) { mh = _dyld_get_image_header (j); break; } } } return mh; } /* * dyld adds libraries by first adding the directly dependant libraries in * link order, and then adding the dependencies for those libraries, so we * should do the same... but we don't bother adding the extra dependencies, if * the symbols are neither in the loaded image nor any of it's direct * dependencies, then it probably isn't there. */ static NSSymbol search_linked_libs (const struct mach_header * mh, const Ibyte *symbol) { unsigned long n; NSSymbol nssym = 0; struct load_command *lc = (struct load_command *) ((Rawbyte *) mh + sizeof (struct mach_header)); for (n = 0; n < mh->ncmds; n++, lc = (struct load_command *) ((Rawbyte *) lc + lc->cmdsize)) { if ((LC_LOAD_DYLIB == lc->cmd) || (LC_LOAD_WEAK_DYLIB == lc->cmd)) { struct mach_header *wh; if ((wh = (struct mach_header *) my_find_image((Rawbyte *) (((struct dylib_command *) lc)-> dylib.name.offset + (Rawbyte *) lc)))) { Extbyte *symext = ITEXT_TO_EXTERNAL (symbol, Qdll_symbol_encoding); if (NSIsSymbolNameDefinedInImage (wh, symext)) { nssym = NSLookupSymbolInImage (wh, symext, NSLOOKUPSYMBOLINIMAGE_OPTION_BIND | NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR); break; } } } } return nssym; } dll_func dll_function (dll_handle h, const Ibyte *n) { NSSymbol sym = 0; Extbyte *next; MAYBE_PREPEND_UNDERSCORE (n); next = ITEXT_TO_EXTERNAL (n, Qdll_function_name_encoding); /* NULL means the program image and shared libraries, not bundles. */ if (h == NULL) { /* NOTE: This assumes that this function is included in the main program and not in a shared library. */ const struct mach_header* my_mh = image_for_address ((void*) &dll_function); if (NSIsSymbolNameDefinedInImage (my_mh, next)) { sym = NSLookupSymbolInImage (my_mh, next, NSLOOKUPSYMBOLINIMAGE_OPTION_BIND | NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR); } if (!sym) { sym = search_linked_libs (my_mh, n); } } else { sym = NSLookupSymbolInModule ((NSModule)h, next); } if (sym == 0) return 0; return (dll_func) NSAddressOfSymbol (sym); } dll_var dll_variable (dll_handle h, const Ibyte *n) { NSSymbol sym; Extbyte *next; MAYBE_PREPEND_UNDERSCORE (n); next = ITEXT_TO_EXTERNAL (n, Qdll_variable_name_encoding); sym = NSLookupSymbolInModule ((NSModule) h, n); if (sym == 0) return 0; return (dll_var) NSAddressOfSymbol (sym); } Lisp_Object dll_error (void) { NSLinkEditErrors c; int errorNumber; const Extbyte *fileNameWithError, *errorString; NSLinkEditError (&c, &errorNumber, &fileNameWithError, &errorString); return build_extstring (errorString, Qerror_message_encoding); } #elif HAVE_LTDL /* Libtool's libltdl */ #include <ltdl.h> dll_handle dll_open (Lisp_Object fname) { Extbyte *soname; if (NILP (fname)) { soname = NULL; } else { soname = LISP_STRING_TO_EXTERNAL (fname, Qdll_filename_encoding); } return (dll_handle) lt_dlopen (soname); } int dll_close (dll_handle h) { return lt_dlclose ((lt_dlhandle) h); } dll_func dll_function (dll_handle h, const Ibyte *n) { Extbyte *next; MAYBE_PREPEND_UNDERSCORE (n); next = ITEXT_TO_EXTERNAL (n, Qdll_function_name_encoding); return (dll_func) lt_dlsym ((lt_dlhandle) h, next); } dll_var dll_variable (dll_handle h, const Ibyte *n) { Extbyte *next; MAYBE_PREPEND_UNDERSCORE (n); next = ITEXT_TO_EXTERNAL (n, Qdll_variable_name_encoding); return (dll_var) lt_dlsym ((lt_dlhandle) h, next); } Lisp_Object dll_error (void) { return build_extstring (lt_dlerror (), Qerror_message_encoding); } #else /* Catchall if we don't know about this system's method of dynamic loading */ dll_handle dll_open (Lisp_Object fname) { return NULL; } int dll_close (dll_handle h) { return 0; } dll_func dll_function (dll_handle h, const Ibyte *n) { return NULL; } dll_func dll_variable (dll_handle h, const Ibyte *n) { return NULL; } Lisp_Object dll_error (void) { return build_ascstring ("Shared libraries not implemented on this system"); } #endif /* System conditionals */ #endif /* HAVE_SHLIB */