mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-05-20 14:19:18 +02:00
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:
parent
58a6724dea
commit
1cdd7edfa5
5 changed files with 72 additions and 26 deletions
11
Makefile
11
Makefile
|
@ -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
41
eval.c
|
@ -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;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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
28
main.c
|
@ -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) {
|
||||||
|
|
Loading…
Add table
Reference in a new issue