sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Split out the library loading functions into a separate C file.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-10-30 11:35:22 +02:00
parent 7bb3a31182
commit 1b8c9534be
5 changed files with 462 additions and 424 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

0
msvc/c/ffi/placeholder Normal file
View file

1
src/c/Makefile.in
View file

@ -48,6 +48,7 @@ OBJS = main.o symbol.o package.o list.o\
printer/write_object.o printer/write_symbol.o \
printer/write_array.o printer/write_list.o printer/write_code.o \
printer/write_sse.o printer/print_unreadable.o \
ffi/libraries.o \
typespec.o assignment.o \
predicate.o number.o\
num_pred.o num_comp.o num_arith.o num_sfun.o num_co.o\

443
src/c/ffi/libraries.d Normal file
View file

@ -0,0 +1,443 @@
/* -*- mode: c; c-basic-offset: 8 -*- */
/*
load.d -- Shared library and bundle opening / copying / closing
*/
/*
Copyright (c) 1990, Giuseppe Attardi and William F. Schelter.
Copyright (c) 2001, Juan Jose Garcia Ripoll.
ECL is free software; you can redistribute it and/or
modify it under the terms of the GNU Library General Public
License as published by the Free Software Foundation; either
version 2 of the License, or (at your option) any later version.
See file '../Copyright' for full details.
*/
#include <ecl/ecl.h>
/*
* Choosing the interface for loading binary files. Currently we recognize
* three different methods:
* - Windows API, provided by ECL_MS_WINDOWS_HOST
* - dlopen, provided HAVE_DLFCN_H is defined
* - NSLinkModule, provided HAVE_MACH_O_DYLD_H is defined
* They are chosen in this precise order. In order to make the code for these
* methods mutually exclusive, when one method is present, the other macros
* get undefined. Handling of dynamically loaded libraries is constrained to
* this file and thus the changes can be limited to this file.
*/
#ifdef ECL_MS_WINDOWS_HOST
# ifdef HAVE_DLFCN_H
# undef HAVE_DLFCN_H
# endif
# ifdef HAVE_MACH_O_DYLD_H
# undef HAVE_MACH_O_DYLD_H
# endif
#endif
#ifdef HAVE_DLFCN_H
# ifdef HAVE_MACH_O_DYLD_H
# undef HAVE_MACH_O_DYLD_H
# endif
#endif
#ifdef ENABLE_DLOPEN
# ifdef cygwin
# include <w32api/windows.h>
# endif
# ifdef HAVE_DLFCN_H
# include <dlfcn.h>
# define INIT_PREFIX "init_fas_"
# ifdef bool
# undef bool
# endif
# endif
# ifdef HAVE_MACH_O_DYLD_H
# include <mach-o/dyld.h>
# define INIT_PREFIX "_init_fas_"
# endif
# ifdef HAVE_LINK_H
# include <link.h>
# endif
# if defined(ECL_MS_WINDOWS_HOST)
# include <windows.h>
# include <windef.h>
# include <winbase.h>
# include <tlhelp32.h>
# define INIT_PREFIX "init_fas_"
# else
# include <unistd.h>
# endif
#endif /* ENABLE_DLOPEN */
#include <ecl/ecl-inl.h>
#include <ecl/internal.h>
static cl_object
copy_object_file(cl_object original)
{
int err;
cl_object copy = make_constant_base_string("TMP:ECL");
copy = si_coerce_to_filename(si_mkstemp(copy));
/*
* We either have to make a full copy to convince the loader to load this object
* file again, or we want to retain the possibility of overwriting the object
* file we load later on (case of Windows, which locks files that are loaded).
* The symlinks do not seem to work in latest versions of Linux.
*/
#if defined(ECL_MS_WINDOWS_HOST)
ecl_disable_interrupts();
err = !CopyFile(original->base_string.self, copy->base_string.self, 0);
ecl_enable_interrupts();
if (err) {
FEwin32_error("Error when copying file from~&~3T~A~&to~&~3T~A",
2, original, copy);
}
#else
err = Null(si_copy_file(original, copy));
if (err) {
FEerror("Error when copying file from~&~3T~A~&to~&~3T~A",
2, original, copy);
}
#endif
#ifdef cygwin
{
cl_object new_copy = make_constant_base_string(".dll");
new_copy = si_base_string_concatenate(2, copy, new_copy);
cl_rename_file(2, copy, new_copy);
copy = new_copy;
}
ecl_disable_interrupts();
err = chmod(copy->base_string.self, S_IRWXU) < 0;
ecl_enable_interrupts();
if (err) {
FElibc_error("Unable to give executable permissions to ~A",
1, copy);
}
#endif
return copy;
}
#ifdef ENABLE_DLOPEN
static void
dlopen_wrapper(cl_object filename, cl_object block)
{
char *filename_string = (char*)filename->base_string.self;
#ifdef HAVE_DLFCN_H
block->cblock.handle = dlopen(filename_string, RTLD_NOW|RTLD_GLOBAL);
#endif
#ifdef HAVE_MACH_O_DYLD_H
{
NSObjectFileImage file;
static NSObjectFileImageReturnCode code;
code = NSCreateObjectFileImageFromFile(filename_string, &file);
if (code != NSObjectFileImageSuccess) {
block->cblock.handle = NULL;
} else {
NSModule out = NSLinkModule(file, filename_string,
NSLINKMODULE_OPTION_PRIVATE|
NSLINKMODULE_OPTION_BINDNOW|
NSLINKMODULE_OPTION_RETURN_ON_ERROR);
block->cblock.handle = out;
}}
#endif
#if defined(ECL_MS_WINDOWS_HOST)
block->cblock.handle = LoadLibrary(filename_string);
#endif
}
static void
dlclose_wrapper(cl_object block)
{
if (block->cblock.handle != NULL) {
#ifdef HAVE_DLFCN_H
dlclose(block->cblock.handle);
#endif
#ifdef HAVE_MACH_O_DYLD_H
NSUnLinkModule(block->cblock.handle, NSUNLINKMODULE_OPTION_NONE);
#endif
#if defined(ECL_MS_WINDOWS_HOST)
FreeLibrary(block->cblock.handle);
#endif
block->cblock.handle = NULL;
}
}
static cl_object
ecl_library_find_by_name(cl_object filename)
{
cl_object l;
for (l = cl_core.libraries; l != Cnil; l = ECL_CONS_CDR(l)) {
cl_object other = ECL_CONS_CAR(l);
cl_object name = other->cblock.name;
if (!Null(name) && ecl_string_eq(name, filename)) {
return other;
}
}
return Cnil;
}
static cl_object
ecl_library_find_by_handle(void *handle)
{
cl_object l;
for (l = cl_core.libraries; l != Cnil; l = ECL_CONS_CDR(l)) {
cl_object other = ECL_CONS_CAR(l);
if (handle == other->cblock.handle) {
return other;
}
}
return Cnil;
}
static cl_object
ecl_library_open_inner(cl_object filename, bool self_destruct)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object other, block = ecl_alloc_object(t_codeblock);
block->cblock.self_destruct = self_destruct;
block->cblock.locked = 0;
block->cblock.handle = NULL;
block->cblock.entry = NULL;
block->cblock.data = NULL;
block->cblock.data_size = 0;
block->cblock.temp_data = NULL;
block->cblock.temp_data_size = 0;
block->cblock.data_text = NULL;
block->cblock.data_text_size = 0;
block->cblock.name = filename;
block->cblock.next = Cnil;
block->cblock.links = Cnil;
block->cblock.cfuns_size = 0;
block->cblock.cfuns = NULL;
block->cblock.source = Cnil;
block->cblock.refs = MAKE_FIXNUM(1);
ECL_WITH_GLOBAL_LOCK_BEGIN(the_env) {
ecl_disable_interrupts();
dlopen_wrapper(filename, block);
if (block->cblock.handle != NULL) {
/* Have we already loaded this library? If so, then unload this
* copy and increase the reference counter so that we can keep
* track (in lisp) of how many copies we use.
*/
cl_object other = ecl_library_find_by_handle(block->cblock.handle);
if (other != Cnil) {
dlclose_wrapper(block);
block = other;
block->cblock.refs = ecl_one_plus(block->cblock.refs);
} else {
si_set_finalizer(block, Ct);
cl_core.libraries = CONS(block, cl_core.libraries);
}
}
ecl_enable_interrupts();
} ECL_WITH_GLOBAL_LOCK_END;
return block;
}
cl_object
ecl_library_open(cl_object filename, bool force_reload) {
cl_object block;
bool self_destruct = 0;
char *filename_string;
/* Coerces to a file name but does not merge with cwd */
filename = coerce_to_physical_pathname(filename);
filename = ecl_namestring(filename,
ECL_NAMESTRING_TRUNCATE_IF_ERROR |
ECL_NAMESTRING_FORCE_BASE_STRING);
if (!force_reload) {
/* When loading a foreign library, such as a dll or a
* so, it cannot contain any executable top level
* code. In that case force_reload=0 and there is no
* need to reload it if it has already been loaded. */
block = ecl_library_find_by_name(filename);
if (!Null(block)) {
return block;
}
} else {
/* We are using shared libraries as modules and
* force_reload=1. Here we have to face the problem
* that many operating systems do not allow to load a
* shared library twice, even if it has changed. Hence
* we have to make a unique copy to be able to load
* the same FASL twice. In Windows this copy is
* _always_ made because otherwise it cannot be
* overwritten. In Unix we need only do that when the
* file has been previously loaded. */
#if defined(ECL_MS_WINDOWS_HOST) || defined(cygwin)
filename = copy_object_file(filename);
self_destruct = 1;
#else
block = ecl_library_find_by_name(filename);
if (!Null(block)) {
filename = copy_object_file(filename);
self_destruct = 1;
}
#endif
}
DO_LOAD:
block = ecl_library_open_inner(filename, self_destruct);
/*
* A second pass to ensure that the dlopen routine has not
* returned a library that we had already loaded. If this is
* the case, we close the new copy to ensure we do refcounting
* right.
*/
if (block->cblock.refs != MAKE_FIXNUM(1)) {
if (force_reload) {
ecl_library_close(block);
filename = copy_object_file(filename);
self_destruct = 1;
goto DO_LOAD;
}
}
return block;
}
void *
ecl_library_symbol(cl_object block, const char *symbol, bool lock) {
void *p;
if (block == @':default') {
cl_object l;
for (l = cl_core.libraries; l != Cnil; l = ECL_CONS_CDR(l)) {
cl_object block = ECL_CONS_CAR(l);
p = ecl_library_symbol(block, symbol, lock);
if (p) return p;
}
ecl_disable_interrupts();
#if defined(ECL_MS_WINDOWS_HOST)
{
HANDLE hndSnap = NULL;
HANDLE hnd = NULL;
hndSnap = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, GetCurrentProcessId());
if (hndSnap != INVALID_HANDLE_VALUE)
{
MODULEENTRY32 me32;
me32.dwSize = sizeof(MODULEENTRY32);
if (Module32First(hndSnap, &me32))
{
do
hnd = GetProcAddress(me32.hModule, symbol);
while (hnd == NULL && Module32Next(hndSnap, &me32));
}
CloseHandle(hndSnap);
}
p = (void*)hnd;
}
#endif
#ifdef HAVE_DLFCN_H
p = dlsym(0, symbol);
#endif
#if !defined(ECL_MS_WINDOWS_HOST) && !defined(HAVE_DLFCN_H)
p = 0;
#endif
ecl_enable_interrupts();
} else {
ecl_disable_interrupts();
#ifdef HAVE_DLFCN_H
p = dlsym(block->cblock.handle, symbol);
#endif
#if defined(ECL_MS_WINDOWS_HOST)
{
HMODULE h = (HMODULE)(block->cblock.handle);
p = GetProcAddress(h, symbol);
}
#endif
#ifdef HAVE_MACH_O_DYLD_H
NSSymbol sym;
sym = NSLookupSymbolInModule((NSModule)(block->cblock.handle),
symbol);
if (sym == 0) {
p = 0;
} else {
p = NSAddressOfSymbol(sym);
}
#endif
ecl_enable_interrupts();
/* Libraries whose symbols are being referenced by the FFI should not
* get garbage collected. Until we find a better solution we simply lock
* them for the rest of the runtime */
if (p) {
block->cblock.locked |= lock;
}
}
return p;
}
cl_object
ecl_library_error(cl_object block) {
cl_object output;
ecl_disable_interrupts();
#ifdef HAVE_DLFCN_H
output = make_base_string_copy(dlerror());
#endif
#ifdef HAVE_MACH_O_DYLD_H
{
NSLinkEditErrors c;
int number;
const char *filename;
NSLinkEditError(&c, &number, &filename, &message);
output = make_base_string_copy(message);
}
#endif
#if defined(ECL_MS_WINDOWS_HOST)
{
const char *message;
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
FORMAT_MESSAGE_ALLOCATE_BUFFER,
0, GetLastError(), 0, (void*)&message, 0, NULL);
output = make_base_string_copy(message);
LocalFree(message);
}
#endif
ecl_enable_interrupts();
return output;
}
void
ecl_library_close(cl_object block) {
const cl_env_ptr the_env = ecl_process_env();
ECL_WITH_GLOBAL_LOCK_BEGIN(the_env) {
ecl_disable_interrupts();
if (block->cblock.refs != MAKE_FIXNUM(1)) {
block->cblock.refs = ecl_one_minus(block->cblock.refs);
block = Cnil;
} else if (block->cblock.handle != NULL) {
dlclose_wrapper(block);
cl_core.libraries = ecl_remove_eq(block, cl_core.libraries);
}
ecl_enable_interrupts();
} ECL_WITH_GLOBAL_LOCK_END;
if (block != Cnil && block->cblock.self_destruct) {
const char *filename;
if (!Null(block->cblock.name)) {
unlink((char*)block->cblock.name->base_string.self);
}
}
}
void
ecl_library_close_all(void)
{
while (cl_core.libraries != Cnil) {
ecl_library_close(ECL_CONS_CAR(cl_core.libraries));
}
}
ecl_def_ct_base_string(init_prefix, INIT_PREFIX, sizeof(INIT_PREFIX)-1, static, const);
cl_object
_ecl_library_init_prefix(void)
{
return init_prefix;
}
ecl_def_ct_base_string(default_entry, INIT_PREFIX "CODE", sizeof(INIT_PREFIX "CODE")-1,
static, const);
cl_object
_ecl_library_default_entry(void)
{
return default_entry;
}
#endif /* ENABLE_DLOPEN */

437
src/c/load.d
View file

@ -14,433 +14,18 @@
See file '../Copyright' for full details.
*/
#include <string.h>
#include <stdio.h>
#include <ecl/ecl.h>
/*
* Choosing the interface for loading binary files. Currently we recognize
* three different methods:
* - Windows API, provided by ECL_MS_WINDOWS_HOST
* - dlopen, provided HAVE_DLFCN_H is defined
* - NSLinkModule, provided HAVE_MACH_O_DYLD_H is defined
* They are chosen in this precise order. In order to make the code for these
* methods mutually exclusive, when one method is present, the other macros
* get undefined. Handling of dynamically loaded libraries is constrained to
* this file and thus the changes can be limited to this file.
*/
#ifdef ECL_MS_WINDOWS_HOST
# ifdef HAVE_DLFCN_H
# undef HAVE_DLFCN_H
# endif
# ifdef HAVE_MACH_O_DYLD_H
# undef HAVE_MACH_O_DYLD_H
# endif
#endif
#ifdef HAVE_DLFCN_H
# ifdef HAVE_MACH_O_DYLD_H
# undef HAVE_MACH_O_DYLD_H
# endif
#endif
#ifdef ENABLE_DLOPEN
# ifdef cygwin
# include <w32api/windows.h>
# endif
# ifdef HAVE_DLFCN_H
# include <dlfcn.h>
# define INIT_PREFIX "init_fas_"
# ifdef bool
# undef bool
# endif
# endif
# ifdef HAVE_MACH_O_DYLD_H
# include <mach-o/dyld.h>
# define INIT_PREFIX "_init_fas_"
# endif
# ifdef HAVE_LINK_H
# include <link.h>
# endif
# if defined(ECL_MS_WINDOWS_HOST)
# include <windows.h>
# include <windef.h>
# include <winbase.h>
# include <tlhelp32.h>
# define INIT_PREFIX "init_fas_"
# else
# include <unistd.h>
# endif
#endif /* ENABLE_DLOPEN */
#include <ecl/ecl-inl.h>
#include <ecl/internal.h>
#include <sys/stat.h>
#ifndef HAVE_LSTAT
static void
symlink(const char *orig, const char *dest)
{
}
#endif
static cl_object
copy_object_file(cl_object original)
{
int err;
cl_object copy = make_constant_base_string("TMP:ECL");
copy = si_coerce_to_filename(si_mkstemp(copy));
/*
* We either have to make a full copy to convince the loader to load this object
* file again, or we want to retain the possibility of overwriting the object
* file we load later on (case of Windows, which locks files that are loaded).
* The symlinks do not seem to work in latest versions of Linux.
*/
#if defined(ECL_MS_WINDOWS_HOST)
ecl_disable_interrupts();
err = !CopyFile(original->base_string.self, copy->base_string.self, 0);
ecl_enable_interrupts();
if (err) {
FEwin32_error("Error when copying file from~&~3T~A~&to~&~3T~A",
2, original, copy);
}
#else
err = Null(si_copy_file(original, copy));
if (err) {
FEerror("Error when copying file from~&~3T~A~&to~&~3T~A",
2, original, copy);
}
#endif
#ifdef cygwin
{
cl_object new_copy = make_constant_base_string(".dll");
new_copy = si_base_string_concatenate(2, copy, new_copy);
cl_rename_file(2, copy, new_copy);
copy = new_copy;
}
ecl_disable_interrupts();
err = chmod(copy->base_string.self, S_IRWXU) < 0;
ecl_enable_interrupts();
if (err) {
FElibc_error("Unable to give executable permissions to ~A",
1, copy);
}
#endif
return copy;
}
#ifdef ENABLE_DLOPEN
static void
dlopen_wrapper(cl_object filename, cl_object block)
{
char *filename_string = (char*)filename->base_string.self;
#ifdef HAVE_DLFCN_H
block->cblock.handle = dlopen(filename_string, RTLD_NOW|RTLD_GLOBAL);
#endif
#ifdef HAVE_MACH_O_DYLD_H
{
NSObjectFileImage file;
static NSObjectFileImageReturnCode code;
code = NSCreateObjectFileImageFromFile(filename_string, &file);
if (code != NSObjectFileImageSuccess) {
block->cblock.handle = NULL;
} else {
NSModule out = NSLinkModule(file, filename_string,
NSLINKMODULE_OPTION_PRIVATE|
NSLINKMODULE_OPTION_BINDNOW|
NSLINKMODULE_OPTION_RETURN_ON_ERROR);
block->cblock.handle = out;
}}
#endif
#if defined(ECL_MS_WINDOWS_HOST)
block->cblock.handle = LoadLibrary(filename_string);
#endif
}
static void
dlclose_wrapper(cl_object block)
{
if (block->cblock.handle != NULL) {
#ifdef HAVE_DLFCN_H
dlclose(block->cblock.handle);
#endif
#ifdef HAVE_MACH_O_DYLD_H
NSUnLinkModule(block->cblock.handle, NSUNLINKMODULE_OPTION_NONE);
#endif
#if defined(ECL_MS_WINDOWS_HOST)
FreeLibrary(block->cblock.handle);
#endif
block->cblock.handle = NULL;
}
}
static cl_object
ecl_library_find_by_name(cl_object filename)
{
cl_object l;
for (l = cl_core.libraries; l != Cnil; l = ECL_CONS_CDR(l)) {
cl_object other = ECL_CONS_CAR(l);
cl_object name = other->cblock.name;
if (!Null(name) && ecl_string_eq(name, filename)) {
return other;
}
}
return Cnil;
}
static cl_object
ecl_library_find_by_handle(void *handle)
{
cl_object l;
for (l = cl_core.libraries; l != Cnil; l = ECL_CONS_CDR(l)) {
cl_object other = ECL_CONS_CAR(l);
if (handle == other->cblock.handle) {
return other;
}
}
return Cnil;
}
static cl_object
ecl_library_open_inner(cl_object filename, bool self_destruct)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object other, block = ecl_alloc_object(t_codeblock);
block->cblock.self_destruct = self_destruct;
block->cblock.locked = 0;
block->cblock.handle = NULL;
block->cblock.entry = NULL;
block->cblock.data = NULL;
block->cblock.data_size = 0;
block->cblock.temp_data = NULL;
block->cblock.temp_data_size = 0;
block->cblock.data_text = NULL;
block->cblock.data_text_size = 0;
block->cblock.name = filename;
block->cblock.next = Cnil;
block->cblock.links = Cnil;
block->cblock.cfuns_size = 0;
block->cblock.cfuns = NULL;
block->cblock.source = Cnil;
block->cblock.refs = MAKE_FIXNUM(1);
ECL_WITH_GLOBAL_LOCK_BEGIN(the_env) {
ecl_disable_interrupts();
dlopen_wrapper(filename, block);
if (block->cblock.handle != NULL) {
/* Have we already loaded this library? If so, then unload this
* copy and increase the reference counter so that we can keep
* track (in lisp) of how many copies we use.
*/
cl_object other = ecl_library_find_by_handle(block->cblock.handle);
if (other != Cnil) {
dlclose_wrapper(block);
block = other;
block->cblock.refs = ecl_one_plus(block->cblock.refs);
} else {
si_set_finalizer(block, Ct);
cl_core.libraries = CONS(block, cl_core.libraries);
}
}
ecl_enable_interrupts();
} ECL_WITH_GLOBAL_LOCK_END;
return block;
}
cl_object
ecl_library_open(cl_object filename, bool force_reload) {
cl_object block;
bool self_destruct = 0;
char *filename_string;
/* Coerces to a file name but does not merge with cwd */
filename = coerce_to_physical_pathname(filename);
filename = ecl_namestring(filename,
ECL_NAMESTRING_TRUNCATE_IF_ERROR |
ECL_NAMESTRING_FORCE_BASE_STRING);
if (!force_reload) {
/* When loading a foreign library, such as a dll or a
* so, it cannot contain any executable top level
* code. In that case force_reload=0 and there is no
* need to reload it if it has already been loaded. */
block = ecl_library_find_by_name(filename);
if (!Null(block)) {
return block;
}
} else {
/* We are using shared libraries as modules and
* force_reload=1. Here we have to face the problem
* that many operating systems do not allow to load a
* shared library twice, even if it has changed. Hence
* we have to make a unique copy to be able to load
* the same FASL twice. In Windows this copy is
* _always_ made because otherwise it cannot be
* overwritten. In Unix we need only do that when the
* file has been previously loaded. */
#if defined(ECL_MS_WINDOWS_HOST) || defined(cygwin)
filename = copy_object_file(filename);
self_destruct = 1;
#else
block = ecl_library_find_by_name(filename);
if (!Null(block)) {
filename = copy_object_file(filename);
self_destruct = 1;
}
#endif
}
DO_LOAD:
block = ecl_library_open_inner(filename, self_destruct);
/*
* A second pass to ensure that the dlopen routine has not
* returned a library that we had already loaded. If this is
* the case, we close the new copy to ensure we do refcounting
* right.
*/
if (block->cblock.refs != MAKE_FIXNUM(1)) {
if (force_reload) {
ecl_library_close(block);
filename = copy_object_file(filename);
self_destruct = 1;
goto DO_LOAD;
}
}
return block;
}
void *
ecl_library_symbol(cl_object block, const char *symbol, bool lock) {
void *p;
if (block == @':default') {
cl_object l;
for (l = cl_core.libraries; l != Cnil; l = ECL_CONS_CDR(l)) {
cl_object block = ECL_CONS_CAR(l);
p = ecl_library_symbol(block, symbol, lock);
if (p) return p;
}
ecl_disable_interrupts();
#if defined(ECL_MS_WINDOWS_HOST)
{
HANDLE hndSnap = NULL;
HANDLE hnd = NULL;
hndSnap = CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, GetCurrentProcessId());
if (hndSnap != INVALID_HANDLE_VALUE)
{
MODULEENTRY32 me32;
me32.dwSize = sizeof(MODULEENTRY32);
if (Module32First(hndSnap, &me32))
{
do
hnd = GetProcAddress(me32.hModule, symbol);
while (hnd == NULL && Module32Next(hndSnap, &me32));
}
CloseHandle(hndSnap);
}
p = (void*)hnd;
}
#endif
#ifdef HAVE_DLFCN_H
p = dlsym(0, symbol);
#endif
#if !defined(ECL_MS_WINDOWS_HOST) && !defined(HAVE_DLFCN_H)
p = 0;
#endif
ecl_enable_interrupts();
} else {
ecl_disable_interrupts();
#ifdef HAVE_DLFCN_H
p = dlsym(block->cblock.handle, symbol);
#endif
#if defined(ECL_MS_WINDOWS_HOST)
{
HMODULE h = (HMODULE)(block->cblock.handle);
p = GetProcAddress(h, symbol);
}
#endif
#ifdef HAVE_MACH_O_DYLD_H
NSSymbol sym;
sym = NSLookupSymbolInModule((NSModule)(block->cblock.handle),
symbol);
if (sym == 0) {
p = 0;
} else {
p = NSAddressOfSymbol(sym);
}
#endif
ecl_enable_interrupts();
/* Libraries whose symbols are being referenced by the FFI should not
* get garbage collected. Until we find a better solution we simply lock
* them for the rest of the runtime */
if (p) {
block->cblock.locked |= lock;
}
}
return p;
}
cl_object
ecl_library_error(cl_object block) {
cl_object output;
ecl_disable_interrupts();
#ifdef HAVE_DLFCN_H
output = make_base_string_copy(dlerror());
#endif
#ifdef HAVE_MACH_O_DYLD_H
{
NSLinkEditErrors c;
int number;
const char *filename;
NSLinkEditError(&c, &number, &filename, &message);
output = make_base_string_copy(message);
}
#endif
#if defined(ECL_MS_WINDOWS_HOST)
{
const char *message;
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
FORMAT_MESSAGE_ALLOCATE_BUFFER,
0, GetLastError(), 0, (void*)&message, 0, NULL);
output = make_base_string_copy(message);
LocalFree(message);
}
#endif
ecl_enable_interrupts();
return output;
}
void
ecl_library_close(cl_object block) {
const cl_env_ptr the_env = ecl_process_env();
ECL_WITH_GLOBAL_LOCK_BEGIN(the_env) {
ecl_disable_interrupts();
if (block->cblock.refs != MAKE_FIXNUM(1)) {
block->cblock.refs = ecl_one_minus(block->cblock.refs);
block = Cnil;
} else if (block->cblock.handle != NULL) {
dlclose_wrapper(block);
cl_core.libraries = ecl_remove_eq(block, cl_core.libraries);
}
ecl_enable_interrupts();
} ECL_WITH_GLOBAL_LOCK_END;
if (block != Cnil && block->cblock.self_destruct) {
const char *filename;
if (!Null(block->cblock.name)) {
unlink((char*)block->cblock.name->base_string.self);
}
}
}
void
ecl_library_close_all(void)
{
while (cl_core.libraries != Cnil) {
ecl_library_close(ECL_CONS_CAR(cl_core.libraries));
}
}
cl_object
si_load_binary(cl_object filename, cl_object verbose, cl_object print, cl_object external_format)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object block;
cl_object basename;
cl_object prefix;
cl_object init_prefix, prefix;
cl_object output;
/* We need the full pathname */
@ -454,19 +39,23 @@ si_load_binary(cl_object filename, cl_object verbose, cl_object print, cl_object
}
/* Fist try to call "init_CODE()" */
block->cblock.entry = ecl_library_symbol(block, INIT_PREFIX "CODE", 0);
init_prefix = _ecl_library_default_entry();
block->cblock.entry =
ecl_library_symbol(block, init_prefix->base_string.self, 0);
if (block->cblock.entry != NULL)
goto GO_ON;
/* Next try to call "init_FILE()" where FILE is the file name */
prefix = ecl_symbol_value(@'si::*init-function-prefix*');
if (Null(prefix))
prefix = make_constant_base_string(INIT_PREFIX);
else
prefix = @si::base-string-concatenate(3,
make_constant_base_string(INIT_PREFIX),
prefix,
make_constant_base_string("_"));
init_prefix = _ecl_library_init_prefix();
if (Null(prefix)) {
prefix = init_prefix;
} else {
prefix = @si::base-string-concatenate(3,
init_prefix,
prefix,
make_constant_base_string("_"));
}
basename = cl_pathname_name(1,filename);
basename = @si::base-string-concatenate(2, prefix, @string-upcase(1, funcall(4, @'nsubstitute', CODE_CHAR('_'), CODE_CHAR('-'), basename)));
block->cblock.entry = ecl_library_symbol(block, (char*)basename->base_string.self, 0);

5
src/h/internal.h
View file

@ -288,6 +288,11 @@ extern cl_object ecl_extend_hashtable(cl_object hashtable);
extern cl_object FEnot_funcallable_vararg(cl_narg narg, ...);
/* load.d */
extern cl_object _ecl_library_init_prefix(void);
extern cl_object _ecl_library_default_entry(void);
/* print.d */
extern cl_object _ecl_stream_or_default_output(cl_object stream);