Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Check the module search path to handle relocated shared libraries

Browse source 
when loading an image.  Fixes issue #345.
This commit is contained in:
Alex Shinn 2016-06-15 22:50:30 +09:00
parent 84edaf75a2
commit c953f2ed1d
3 changed files with 43 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
eval.c
View file

@ -2183,8 +2183,8 @@ sexp sexp_make_primitive_env_op (sexp ctx, sexp self, sexp_sint_t n, sexp versio
return e; return e;
} }
sexp sexp_find_module_file (sexp ctx, const char *file) { char* sexp_find_module_file_raw (sexp ctx, const char *file) {
sexp res=SEXP_FALSE, ls; sexp ls;
char *dir, *path; char *dir, *path;
sexp_uint_t slash, dirlen, filelen, len; sexp_uint_t slash, dirlen, filelen, len;
#ifdef PLAN9 #ifdef PLAN9
@ -2199,22 +2199,29 @@ sexp sexp_find_module_file (sexp ctx, const char *file) {
filelen = strlen(file); filelen = strlen(file);
ls = sexp_global(ctx, SEXP_G_MODULE_PATH); ls = sexp_global(ctx, SEXP_G_MODULE_PATH);
for ( ; sexp_pairp(ls) && sexp_not(res); ls=sexp_cdr(ls)) { for ( ; sexp_pairp(ls); ls=sexp_cdr(ls)) {
dir = sexp_string_data(sexp_car(ls)); dir = sexp_string_data(sexp_car(ls));
dirlen = sexp_string_size(sexp_car(ls)); dirlen = sexp_string_size(sexp_car(ls));
slash = dir[dirlen-1] == '/'; slash = dir[dirlen-1] == '/';
len = dirlen+filelen+2-slash; len = dirlen+filelen+2-slash;
path = (char*) sexp_malloc(len); path = (char*) sexp_malloc(len);
if (! path) return sexp_global(ctx, SEXP_G_OOM_ERROR); if (! path) return NULL;
memcpy(path, dir, dirlen); memcpy(path, dir, dirlen);
if (! slash) path[dirlen] = '/'; if (! slash) path[dirlen] = '/';
memcpy(path+len-filelen-1, file, filelen); memcpy(path+len-filelen-1, file, filelen);
path[len-1] = '\0'; path[len-1] = '\0';
if (sexp_find_static_library(path) || file_exists_p(path, buf)) if (sexp_find_static_library(path) || file_exists_p(path, buf))
res = sexp_c_string(ctx, path, len-1); return path;
free(path); free(path);
} }
return NULL;
}
sexp sexp_find_module_file (sexp ctx, const char *file) {
char* path = sexp_find_module_file_raw(ctx, file);
sexp res = sexp_c_string(ctx, path, -1);
if (path) free(path);
return res; return res;
} }

39
gc_heap.c
View file

@ -480,19 +480,40 @@ done:
return res; return res;
} }
static void* load_image_fn(sexp dl, sexp name) { static void* load_image_fn(sexp ctx, sexp dl, sexp name) {
sexp ls;
int len;
void *fn = NULL; void *fn = NULL;
char *file_name, *rel_name=NULL, *new_file_name;
char *handle_name = "<static>"; char *handle_name = "<static>";
char *symbol_name = sexp_string_data(name); char *symbol_name = sexp_string_data(name);
if (dl && sexp_dlp(dl)) { if (dl && sexp_dlp(dl)) {
if (!sexp_dl_handle(dl)) { if (!sexp_dl_handle(dl)) {
sexp_dl_handle(dl) = dlopen(sexp_string_data(sexp_dl_file(dl)), /* try exact file, then the search path */
RTLD_LAZY); file_name = sexp_string_data(sexp_dl_file(dl));
len = sexp_string_size(sexp_dl_file(dl));
sexp_dl_handle(dl) = dlopen(file_name, RTLD_LAZY);
if (!sexp_dl_handle(dl)) { if (!sexp_dl_handle(dl)) {
handle_name = sexp_string_data(sexp_dl_file(dl)); for (ls = sexp_global(ctx, SEXP_G_MODULE_PATH); sexp_pairp(ls); ls=sexp_cdr(ls)) {
snprintf(gc_heap_err_str, ERR_STR_SIZE, "dlopen failure: %s", if (strnstr(file_name, sexp_string_data(sexp_car(ls)), len+1)) {
handle_name); rel_name = file_name + sexp_string_size(sexp_car(ls));
return NULL; while (*rel_name == '/')
++rel_name;
new_file_name = sexp_find_module_file_raw(ctx, rel_name);
if (new_file_name) {
sexp_dl_handle(dl) = dlopen(new_file_name, RTLD_LAZY);
free(new_file_name);
if (sexp_dl_handle(dl))
break;
}
}
}
if (!sexp_dl_handle(dl)) {
handle_name = sexp_string_data(sexp_dl_file(dl));
snprintf(gc_heap_err_str, ERR_STR_SIZE, "dlopen failure: %s",
handle_name);
return NULL;
}
} }
} }
fn = dlsym(sexp_dl_handle(dl), symbol_name); fn = dlsym(sexp_dl_handle(dl), symbol_name);
@ -523,7 +544,7 @@ static sexp load_image_callback_p2 (sexp ctx, sexp dstp, void *user) {
return SEXP_FALSE; return SEXP_FALSE;
} }
fn = load_image_fn(sexp_opcode_dl(dstp), name); fn = load_image_fn(ctx, sexp_opcode_dl(dstp), name);
if (!fn) { if (!fn) {
return SEXP_FALSE; return SEXP_FALSE;
} }
@ -535,7 +556,7 @@ static sexp load_image_callback_p2 (sexp ctx, sexp dstp, void *user) {
snprintf(gc_heap_err_str, ERR_STR_SIZE, "type finalize field missing function name"); snprintf(gc_heap_err_str, ERR_STR_SIZE, "type finalize field missing function name");
return SEXP_FALSE; return SEXP_FALSE;
} }
fn = load_image_fn(sexp_type_dl(dstp), name); fn = load_image_fn(ctx, sexp_type_dl(dstp), name);
if (!fn) { if (!fn) {
return SEXP_FALSE; return SEXP_FALSE;
} }

1
include/chibi/eval.h
View file

@ -94,6 +94,7 @@ SEXP_API sexp sexp_make_standard_env_op (sexp context, sexp self, sexp_sint_t n,
SEXP_API void sexp_set_parameter (sexp ctx, sexp env, sexp name, sexp value); SEXP_API void sexp_set_parameter (sexp ctx, sexp env, sexp name, sexp value);
SEXP_API sexp sexp_load_standard_ports (sexp context, sexp env, FILE* in, FILE* out, FILE* err, int no_close); SEXP_API sexp sexp_load_standard_ports (sexp context, sexp env, FILE* in, FILE* out, FILE* err, int no_close);
SEXP_API sexp sexp_load_standard_env (sexp context, sexp env, sexp version); SEXP_API sexp sexp_load_standard_env (sexp context, sexp env, sexp version);
SEXP_API char* sexp_find_module_file_raw (sexp ctx, const char *file);
SEXP_API sexp sexp_find_module_file (sexp ctx, const char *file); SEXP_API sexp sexp_find_module_file (sexp ctx, const char *file);
SEXP_API sexp sexp_load_module_file (sexp ctx, const char *file, sexp env); SEXP_API sexp sexp_load_module_file (sexp ctx, const char *file, sexp env);
SEXP_API sexp sexp_current_module_path_op (sexp ctx, sexp self, sexp_sint_t n, sexp x); SEXP_API sexp sexp_current_module_path_op (sexp ctx, sexp self, sexp_sint_t n, sexp x);