adding support for dynamic loading shared libraries

load now recognizes ".so" files and loads them with dlopen,
then calls sexp_init_library(ctx, env) from that library.
This commit is contained in:
Alex Shinn 2009-11-05 20:41:01 +09:00
parent 58a6724dea
commit 1cdd7edfa5
5 changed files with 72 additions and 26 deletions

View file

@ -9,6 +9,7 @@ LIBDIR ?= $(PREFIX)/lib
SOLIBDIR ?= $(PREFIX)/lib SOLIBDIR ?= $(PREFIX)/lib
INCDIR ?= $(PREFIX)/include/chibi INCDIR ?= $(PREFIX)/include/chibi
MODDIR ?= $(PREFIX)/share/chibi MODDIR ?= $(PREFIX)/share/chibi
LIBDIR ?= $(PREFIX)/lib/chibi
DESTDIR ?= DESTDIR ?=
@ -49,7 +50,7 @@ endif
all: chibi-scheme$(EXE) all: chibi-scheme$(EXE)
ifdef USE_BOEHM ifeq ($(USE_BOEHM),1)
GCLDFLAGS := -lgc GCLDFLAGS := -lgc
XCPPFLAGS := $(CPPFLAGS) -Iinclude -DUSE_BOEHM=1 XCPPFLAGS := $(CPPFLAGS) -Iinclude -DUSE_BOEHM=1
else else
@ -57,13 +58,19 @@ GCLDFLAGS :=
XCPPFLAGS := $(CPPFLAGS) -Iinclude XCPPFLAGS := $(CPPFLAGS) -Iinclude
endif endif
ifeq ($(USE_DL),0)
XLDFLAGS := $(LDFLAGS) $(GCLDFLAGS) -lm XLDFLAGS := $(LDFLAGS) $(GCLDFLAGS) -lm
XCFLAGS := -Wall -DUSE_DL=0 -g3 $(CFLAGS)
else
XLDFLAGS := $(LDFLAGS) $(GCLDFLAGS) -ldl -lm
XCFLAGS := -Wall -g3 $(CFLAGS) XCFLAGS := -Wall -g3 $(CFLAGS)
endif
INCLUDES = include/chibi/sexp.h include/chibi/config.h include/chibi/install.h INCLUDES = include/chibi/sexp.h include/chibi/config.h include/chibi/install.h
include/chibi/install.h: Makefile include/chibi/install.h: Makefile
echo '#define sexp_module_dir "'$(MODDIR)'"' > $@ echo '#define sexp_so_extension "'$(SO)'"' > $@
echo '#define sexp_module_dir "'$(MODDIR)'"' >> $@
sexp.o: sexp.c gc.c opt/bignum.c $(INCLUDES) Makefile sexp.o: sexp.c gc.c opt/bignum.c $(INCLUDES) Makefile
$(CC) -c $(XCPPFLAGS) $(XCFLAGS) $(CLIBFLAGS) -o $@ $< $(CC) -c $(XCPPFLAGS) $(XCFLAGS) $(CLIBFLAGS) -o $@ $<

41
eval.c
View file

@ -1999,9 +1999,31 @@ void sexp_warn_undefs (sexp ctx, sexp from, sexp to, sexp out) {
} }
} }
#if USE_DL
sexp sexp_load_dl (sexp ctx, sexp file, sexp env) {
sexp_proc2 init;
void *handle = dlopen(sexp_string_data(file), RTLD_LAZY);
if (! handle)
return sexp_compile_error(ctx, "couldn't load dynamic library", file);
init = dlsym(handle, "sexp_init_library");
if (! init) {
dlclose(handle);
return sexp_compile_error(ctx, "dynamic library has no sexp_init_library", file);
}
return init(ctx, env);
}
#endif
sexp sexp_load (sexp ctx, sexp source, sexp env) { sexp sexp_load (sexp ctx, sexp source, sexp env) {
sexp tmp, out; sexp tmp, out;
sexp_gc_var4(ctx2, x, in, res); sexp_gc_var4(ctx2, x, in, res);
#if USE_DL
char *suffix = sexp_string_data(source)
+ sexp_string_length(source) - strlen(sexp_so_extension);
if (strcmp(suffix, sexp_so_extension) == 0) {
res = sexp_load_dl(ctx, source, env);
} else {
#endif
sexp_gc_preserve4(ctx, ctx2, x, in, res); sexp_gc_preserve4(ctx, ctx2, x, in, res);
res = SEXP_VOID; res = SEXP_VOID;
in = sexp_open_input_file(ctx, source); in = sexp_open_input_file(ctx, source);
@ -2027,12 +2049,15 @@ sexp sexp_load (sexp ctx, sexp source, sexp env) {
if (x == SEXP_EOF) if (x == SEXP_EOF)
res = SEXP_VOID; res = SEXP_VOID;
sexp_close_port(ctx, in); sexp_close_port(ctx, in);
#if USE_WARN_UNDEFS
if (sexp_oportp(out))
sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp, out);
#endif
} }
sexp_gc_release4(ctx); sexp_gc_release4(ctx);
#if USE_DL
}
#endif
#if USE_WARN_UNDEFS
if (sexp_oportp(out) && ! sexp_exceptionp(res))
sexp_warn_undefs(ctx, sexp_env_bindings(env), tmp, out);
#endif
return res; return res;
} }
@ -2272,17 +2297,17 @@ sexp sexp_apply (sexp ctx, sexp proc, sexp args) {
stack[--offset] = sexp_car(ls); stack[--offset] = sexp_car(ls);
stack[top] = sexp_make_fixnum(len); stack[top] = sexp_make_fixnum(len);
top++; top++;
sexp_context_top(ctx) = top + 3;
stack[top++] = sexp_make_fixnum(0); stack[top++] = sexp_make_fixnum(0);
stack[top++] = final_resumer; stack[top++] = final_resumer;
stack[top++] = sexp_make_fixnum(0); stack[top++] = sexp_make_fixnum(0);
sexp_context_top(ctx) = top;
res = sexp_vm(ctx, proc); res = sexp_vm(ctx, proc);
return res; return res;
} }
sexp sexp_compile (sexp ctx, sexp x) { sexp sexp_compile (sexp ctx, sexp x) {
sexp_gc_var4(ast, ctx2, vec, res); sexp_gc_var3(ast, vec, res);
sexp_gc_preserve4(ctx, ast, ctx2, vec, res); sexp_gc_preserve3(ctx, ast, vec, res);
ast = analyze(ctx, x); ast = analyze(ctx, x);
if (sexp_exceptionp(ast)) { if (sexp_exceptionp(ast)) {
res = ast; res = ast;
@ -2294,7 +2319,7 @@ sexp sexp_compile (sexp ctx, sexp x) {
res = sexp_make_procedure(ctx, sexp_make_fixnum(0), sexp_make_fixnum(0), res = sexp_make_procedure(ctx, sexp_make_fixnum(0), sexp_make_fixnum(0),
res, vec); res, vec);
} }
sexp_gc_release4(ctx); sexp_gc_release3(ctx);
return res; return res;
} }

View file

@ -5,6 +5,9 @@
/* uncomment this to disable the module system */ /* uncomment this to disable the module system */
/* #define USE_MODULES 0 */ /* #define USE_MODULES 0 */
/* uncomment this to disable dynamic loading */
/* #define USE_DL 0 */
/* uncomment this to use the Boehm conservative GC */ /* uncomment this to use the Boehm conservative GC */
/* #define USE_BOEHM 1 */ /* #define USE_BOEHM 1 */
@ -67,6 +70,14 @@
#define USE_MODULES 1 #define USE_MODULES 1
#endif #endif
#ifndef USE_DL
#ifdef PLAN9
#define USE_DL 0
#else
#define USE_DL 1
#endif
#endif
#ifndef USE_BOEHM #ifndef USE_BOEHM
#define USE_BOEHM 0 #define USE_BOEHM 0
#endif #endif

View file

@ -11,6 +11,10 @@
#include <ctype.h> #include <ctype.h>
#include <stdio.h> #include <stdio.h>
#if USE_DL
#include <dlfcn.h>
#endif
#ifdef PLAN9 #ifdef PLAN9
#include <u.h> #include <u.h>
#include <libc.h> #include <libc.h>
@ -555,6 +559,9 @@ SEXP_API sexp sexp_make_integer(sexp ctx, sexp_sint_t x);
#define sexp_bignum_length(x) ((x)->value.bignum.length) #define sexp_bignum_length(x) ((x)->value.bignum.length)
#define sexp_bignum_data(x) ((x)->value.bignum.data) #define sexp_bignum_data(x) ((x)->value.bignum.data)
#define sexp_dllib_file(x) ((x)->value.dllib.file)
#define sexp_dllib_handle(x) ((x)->value.dllib.handle)
/****************************** arithmetic ****************************/ /****************************** arithmetic ****************************/
#define sexp_fx_add(a, b) ((sexp)(((sexp_sint_t)a)+((sexp_sint_t)b)-SEXP_FIXNUM_TAG)) #define sexp_fx_add(a, b) ((sexp)(((sexp_sint_t)a)+((sexp_sint_t)b)-SEXP_FIXNUM_TAG))

28
main.c
View file

@ -50,10 +50,8 @@ sexp find_module_file (sexp ctx, char *file) {
sexp sexp_load_module_file (sexp ctx, char *file, sexp env) { sexp sexp_load_module_file (sexp ctx, char *file, sexp env) {
sexp res = SEXP_VOID; sexp res = SEXP_VOID;
sexp_gc_var(ctx, path, s_path); sexp_gc_var2(path, irr);
sexp_gc_var(ctx, irr, s_irr); sexp_gc_preserve2(ctx, path, irr);
sexp_gc_preserve(ctx, path, s_path);
sexp_gc_preserve(ctx, irr, s_irr);
path = find_module_file(ctx, file); path = find_module_file(ctx, file);
if (! sexp_stringp(path)) { if (! sexp_stringp(path)) {
path = sexp_c_string(ctx, chibi_module_dir, -1); path = sexp_c_string(ctx, chibi_module_dir, -1);
@ -67,32 +65,32 @@ sexp sexp_load_module_file (sexp ctx, char *file, sexp env) {
} else { } else {
res = sexp_load(ctx, path, env); res = sexp_load(ctx, path, env);
} }
sexp_gc_release(ctx, path, s_path); sexp_gc_release2(ctx);
return res; return res;
} }
sexp sexp_init_environments (sexp ctx) { sexp sexp_init_environments (sexp ctx) {
sexp res, env; sexp res, env;
sexp_gc_var(ctx, confenv, s_confenv); sexp_gc_var1(confenv);
env = sexp_context_env(ctx); env = sexp_context_env(ctx);
res = sexp_load_module_file(ctx, sexp_init_file, env); res = sexp_load_module_file(ctx, sexp_init_file, env);
if (! sexp_exceptionp(res)) { if (! sexp_exceptionp(res)) {
res = SEXP_UNDEF; res = SEXP_UNDEF;
sexp_gc_preserve(ctx, confenv, s_confenv); sexp_gc_preserve1(ctx, confenv);
confenv = sexp_make_env(ctx); confenv = sexp_make_env(ctx);
sexp_env_copy(ctx, confenv, env, SEXP_FALSE); sexp_env_copy(ctx, confenv, env, SEXP_FALSE);
sexp_load_module_file(ctx, sexp_config_file, confenv); sexp_load_module_file(ctx, sexp_config_file, confenv);
env_define(ctx, env, sexp_intern(ctx, "*config-env*"), confenv); env_define(ctx, env, sexp_intern(ctx, "*config-env*"), confenv);
env_define(ctx, confenv, sexp_intern(ctx, "*config-env*"), confenv); env_define(ctx, confenv, sexp_intern(ctx, "*config-env*"), confenv);
sexp_gc_release(ctx, confenv, s_confenv); sexp_gc_release1(ctx);
} }
return res; return res;
} }
void repl (sexp ctx) { void repl (sexp ctx) {
sexp tmp, res, env, in, out, err; sexp tmp, res, env, in, out, err;
sexp_gc_var(ctx, obj, s_obj); sexp_gc_var1(obj);
sexp_gc_preserve(ctx, obj, s_obj); sexp_gc_preserve1(ctx, obj);
env = sexp_context_env(ctx); env = sexp_context_env(ctx);
sexp_context_tracep(ctx) = 1; sexp_context_tracep(ctx) = 1;
in = sexp_eval_string(ctx, "(current-input-port)", env); in = sexp_eval_string(ctx, "(current-input-port)", env);
@ -120,18 +118,16 @@ void repl (sexp ctx) {
} }
} }
} }
sexp_gc_release(ctx, obj, s_obj); sexp_gc_release1(ctx);
} }
void run_main (int argc, char **argv) { void run_main (int argc, char **argv) {
sexp env, out=NULL, res=SEXP_VOID, ctx; sexp env, out=NULL, res=SEXP_VOID, ctx;
sexp_uint_t i, quit=0, init_loaded=0; sexp_uint_t i, quit=0, init_loaded=0;
sexp_gc_var(ctx, str, s_str); sexp_gc_var1(str);
sexp_gc_var(ctx, confenv, s_confenv);
ctx = sexp_make_context(NULL, NULL, NULL); ctx = sexp_make_context(NULL, NULL, NULL);
sexp_gc_preserve(ctx, str, s_str); sexp_gc_preserve1(ctx, str);
sexp_gc_preserve(ctx, confenv, s_confenv);
env = sexp_context_env(ctx); env = sexp_context_env(ctx);
out = sexp_eval_string(ctx, "(current-output-port)", env); out = sexp_eval_string(ctx, "(current-output-port)", env);
@ -185,7 +181,7 @@ void run_main (int argc, char **argv) {
repl(ctx); repl(ctx);
} }
sexp_gc_release(ctx, str, s_str); sexp_gc_release1(ctx);
} }
int main (int argc, char **argv) { int main (int argc, char **argv) {