From a306a646e6c1d3eb4aaf95474d998205c23040b0 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 13 Jul 2010 15:55:33 -0600 Subject: [PATCH] fix build for disabled FFI --- collects/openssl/sha1.rkt | 9 ++- src/configure | 4 +- src/foreign/Makefile.in | 4 + src/foreign/foreign.c | 145 ++++++++++++++++++++++++++++++++++++ src/foreign/foreign.rktc | 46 ++++++++++++ src/gracket/gc2/Makefile.in | 4 +- src/racket/Makefile.in | 9 ++- src/racket/configure.ac | 4 +- src/racket/gc2/Makefile.in | 8 +- src/racket/src/env.c | 19 +---- src/racket/src/schpriv.h | 2 +- src/racket/src/thread.c | 2 +- 12 files changed, 220 insertions(+), 36 deletions(-) diff --git a/collects/openssl/sha1.rkt b/collects/openssl/sha1.rkt index 4084bbaa51..b8f31a50a5 100644 --- a/collects/openssl/sha1.rkt +++ b/collects/openssl/sha1.rkt @@ -25,11 +25,14 @@ (define _SHA_CTX-pointer _pointer) (define SHA1_Init - (get-ffi-obj 'SHA1_Init libcrypto (_fun _SHA_CTX-pointer -> _int) (lambda () #f))) + (and libcrypto + (get-ffi-obj 'SHA1_Init libcrypto (_fun _SHA_CTX-pointer -> _int) (lambda () #f)))) (define SHA1_Update - (get-ffi-obj 'SHA1_Update libcrypto (_fun _SHA_CTX-pointer _pointer _long -> _int) (lambda () #f))) + (and libcrypto + (get-ffi-obj 'SHA1_Update libcrypto (_fun _SHA_CTX-pointer _pointer _long -> _int) (lambda () #f)))) (define SHA1_Final - (get-ffi-obj 'SHA1_Final libcrypto (_fun _pointer _SHA_CTX-pointer -> _int) (lambda () #f))) + (and libcrypto + (get-ffi-obj 'SHA1_Final libcrypto (_fun _pointer _SHA_CTX-pointer -> _int) (lambda () #f)))) (define (sha1-bytes in) (if SHA1_Init diff --git a/src/configure b/src/configure index ed1448ba61..eabe556377 100755 --- a/src/configure +++ b/src/configure @@ -12279,7 +12279,6 @@ ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. subdirs="$subdirs foreign/gcc/libffi" - makefiles="$makefiles foreign/Makefile" FOREIGNTARGET="foreign-stuff" FOREIGN_IF_USED="FOREIGN_USED" # --disable-multilib is needed to avoid problems when running libffi's @@ -12287,9 +12286,10 @@ ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. # other scripts do not use it anyway. ac_configure_args="$ac_configure_args --disable-multilib" else - FOREIGNTARGET="foreign-nothing" + FOREIGNTARGET="foreign-stub" MZOPTIONS="$MZOPTIONS -DDONT_USE_FOREIGN" fi +makefiles="$makefiles foreign/Makefile" ac_configure_args="$ac_configure_args$SUB_CONFIGURE_EXTRAS" if test "${enable_gracket}" = "yes" ; then diff --git a/src/foreign/Makefile.in b/src/foreign/Makefile.in index 6314911314..4cd99d43b9 100644 --- a/src/foreign/Makefile.in +++ b/src/foreign/Makefile.in @@ -14,6 +14,10 @@ all: $(MAKE) foreign.@LTO@ $(MAKE) gcc/libffi/libffi@FOREIGN_CONVENIENCE@.la +# just foreign.c, which will generate a stub module: +stub: + $(MAKE) foreign.@LTO@ + # Causes objects to be generated in gcc/libffi/src/ # in inconvenience mode: gcc/libffi/libffi@FOREIGN_CONVENIENCE@.la: diff --git a/src/foreign/foreign.c b/src/foreign/foreign.c index 617428a7a0..4aa17bec7b 100644 --- a/src/foreign/foreign.c +++ b/src/foreign/foreign.c @@ -7,6 +7,9 @@ ********************************************/ #include "schpriv.h" + +#ifndef DONT_USE_FOREIGN + #include #ifndef WINDOWS_DYNAMIC_LOAD @@ -3329,3 +3332,145 @@ void scheme_init_foreign(Scheme_Env *env) } /*****************************************************************************/ + +#else /* DONT_USE_FOREIGN */ + +static Scheme_Object *unimplemented(int argc, Scheme_Object **argv, Scheme_Object *who) +{ + scheme_signal_error("%s: foreign interface not supported for this platform", + ((Scheme_Primitive_Proc *)who)->name); + return NULL; +} + +static Scheme_Object *foreign_compiler_sizeof(int argc, Scheme_Object **argv) +{ + return scheme_make_integer(4); +} + +static Scheme_Object *foreign_make_ctype(int argc, Scheme_Object **argv) +{ + return scheme_false; +} + +void scheme_init_foreign(Scheme_Env *env) +{ + /* Create a dummy module. */ + Scheme_Env *menv; + menv = scheme_primitive_module(scheme_intern_symbol("#%foreign"), env); + scheme_add_global("ffi-lib?", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ffi-lib?", 1, 1), menv); + scheme_add_global("ffi-lib", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ffi-lib", 1, 2), menv); + scheme_add_global("ffi-lib-name", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ffi-lib-name", 1, 1), menv); + scheme_add_global("ffi-obj?", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ffi-obj?", 1, 1), menv); + scheme_add_global("ffi-obj", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ffi-obj", 2, 2), menv); + scheme_add_global("ffi-obj-lib", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ffi-obj-lib", 1, 1), menv); + scheme_add_global("ffi-obj-name", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ffi-obj-name", 1, 1), menv); + scheme_add_global("ctype?", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ctype?", 1, 1), menv); + scheme_add_global("ctype-basetype", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ctype-basetype", 1, 1), menv); + scheme_add_global("ctype-scheme->c", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ctype-scheme->c", 1, 1), menv); + scheme_add_global("ctype-c->scheme", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ctype-c->scheme", 1, 1), menv); + scheme_add_global("make-ctype", + scheme_make_prim_w_arity((Scheme_Prim *)foreign_make_ctype, "make-ctype", 3, 3), menv); + scheme_add_global("make-cstruct-type", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "make-cstruct-type", 1, 2), menv); + scheme_add_global("ffi-callback?", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ffi-callback?", 1, 1), menv); + scheme_add_global("cpointer?", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "cpointer?", 1, 1), menv); + scheme_add_global("cpointer-tag", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "cpointer-tag", 1, 1), menv); + scheme_add_global("set-cpointer-tag!", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "set-cpointer-tag!", 2, 2), menv); + scheme_add_global("ctype-sizeof", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ctype-sizeof", 1, 1), menv); + scheme_add_global("ctype-alignof", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ctype-alignof", 1, 1), menv); + scheme_add_global("compiler-sizeof", + scheme_make_prim_w_arity((Scheme_Prim *)foreign_compiler_sizeof, "compiler-sizeof", 1, 1), menv); + scheme_add_global("malloc", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "malloc", 1, 5), menv); + scheme_add_global("end-stubborn-change", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "end-stubborn-change", 1, 1), menv); + scheme_add_global("free", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "free", 1, 1), menv); + scheme_add_global("malloc-immobile-cell", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "malloc-immobile-cell", 1, 1), menv); + scheme_add_global("free-immobile-cell", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "free-immobile-cell", 1, 1), menv); + scheme_add_global("ptr-add", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ptr-add", 2, 3), menv); + scheme_add_global("ptr-add!", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ptr-add!", 2, 3), menv); + scheme_add_global("offset-ptr?", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "offset-ptr?", 1, 1), menv); + scheme_add_global("ptr-offset", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ptr-offset", 1, 1), menv); + scheme_add_global("set-ptr-offset!", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "set-ptr-offset!", 2, 3), menv); + scheme_add_global("vector->cpointer", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "vector->cpointer", 1, 1), menv); + scheme_add_global("flvector->cpointer", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "flvector->cpointer", 1, 1), menv); + scheme_add_global("memset", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "memset", 3, 5), menv); + scheme_add_global("memmove", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "memmove", 3, 6), menv); + scheme_add_global("memcpy", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "memcpy", 3, 6), menv); + scheme_add_global("ptr-ref", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ptr-ref", 2, 4), menv); + scheme_add_global("ptr-set!", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ptr-set!", 3, 5), menv); + scheme_add_global("ptr-equal?", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ptr-equal?", 2, 2), menv); + scheme_add_global("make-sized-byte-string", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "make-sized-byte-string", 2, 2), menv); + scheme_add_global("ffi-call", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ffi-call", 3, 5), menv); + scheme_add_global("ffi-callback", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "ffi-callback", 3, 6), menv); + scheme_add_global("saved-errno", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "saved-errno", 0, 0), menv); + scheme_add_global("lookup-errno", + scheme_make_prim_w_arity((Scheme_Prim *)unimplemented, "lookup-errno", 1, 1), menv); + scheme_add_global("_void", scheme_false, menv); + scheme_add_global("_int8", scheme_false, menv); + scheme_add_global("_uint8", scheme_false, menv); + scheme_add_global("_int16", scheme_false, menv); + scheme_add_global("_uint16", scheme_false, menv); + scheme_add_global("_int32", scheme_false, menv); + scheme_add_global("_uint32", scheme_false, menv); + scheme_add_global("_int64", scheme_false, menv); + scheme_add_global("_uint64", scheme_false, menv); + scheme_add_global("_fixint", scheme_false, menv); + scheme_add_global("_ufixint", scheme_false, menv); + scheme_add_global("_fixnum", scheme_false, menv); + scheme_add_global("_ufixnum", scheme_false, menv); + scheme_add_global("_float", scheme_false, menv); + scheme_add_global("_double", scheme_false, menv); + scheme_add_global("_double*", scheme_false, menv); + scheme_add_global("_bool", scheme_false, menv); + scheme_add_global("_string/ucs-4", scheme_false, menv); + scheme_add_global("_string/utf-16", scheme_false, menv); + scheme_add_global("_bytes", scheme_false, menv); + scheme_add_global("_path", scheme_false, menv); + scheme_add_global("_symbol", scheme_false, menv); + scheme_add_global("_pointer", scheme_false, menv); + scheme_add_global("_gcpointer", scheme_false, menv); + scheme_add_global("_scheme", scheme_false, menv); + scheme_add_global("_fpointer", scheme_false, menv); + scheme_finish_primitive_module(menv); + scheme_protect_primitive_provide(menv, NULL); +} + +#endif diff --git a/src/foreign/foreign.rktc b/src/foreign/foreign.rktc index 108ab16117..d898d62f54 100755 --- a/src/foreign/foreign.rktc +++ b/src/foreign/foreign.rktc @@ -10,6 +10,9 @@ exec racket "$0" > `echo "$0" | sed 's/rktc$/c/'` "$0" @header{foreign.rktc} #include "schpriv.h" + +#ifndef DONT_USE_FOREIGN + #include @@@IFNDEF{WINDOWS_DYNAMIC_LOAD}{ @@ -2412,3 +2415,46 @@ void scheme_init_foreign(Scheme_Env *env) } /*****************************************************************************/ + +#else /* DONT_USE_FOREIGN */ + +static Scheme_Object *unimplemented(int argc, Scheme_Object **argv, Scheme_Object *who) +{ + scheme_signal_error("%s: foreign interface not supported for this platform", + ((Scheme_Primitive_Proc *)who)->name); + return NULL; +} + +static Scheme_Object *foreign_compiler_sizeof(int argc, Scheme_Object **argv) +{ + return scheme_make_integer(4); +} + +static Scheme_Object *foreign_make_ctype(int argc, Scheme_Object **argv) +{ + return scheme_false; +} + +@(define (lookup name) + (if (member (cadr name) '("compiler_sizeof" "make_ctype")) + name + 'unimplemented)) + +void scheme_init_foreign(Scheme_Env *env) +{ + /* Create a dummy module. */ + Scheme_Env *menv; + menv = scheme_primitive_module(scheme_intern_symbol("#%foreign"), env); + @(maplines + (lambda (x) + (define-values (sname cfun min max) (apply values x)) + @list{scheme_add_global("@sname", + scheme_make_prim_w_arity((Scheme_Prim *)@(lookup cfun), "@sname", @min, @max), menv)}) + (reverse (cfunctions))) + @(map-types + @list{scheme_add_global("_@stype", scheme_false, menv)}) + scheme_finish_primitive_module(menv); + scheme_protect_primitive_provide(menv, NULL); +} + +#endif diff --git a/src/gracket/gc2/Makefile.in b/src/gracket/gc2/Makefile.in index 6af7ccd74b..d98d111001 100644 --- a/src/gracket/gc2/Makefile.in +++ b/src/gracket/gc2/Makefile.in @@ -1222,8 +1222,8 @@ FOREIGN_OBJSLIB = @FOREIGN_OBJSLIB@ FOREIGN_USED_LIB = $(FOREIGN_OBJ) $(FOREIGN_LIB) FOREIGN_USED_OBJSLIB = $(FOREIGN_OBJSLIB) -FOREIGN_NOT_USED_LIB = -FOREIGN_NOT_USED_OBJSLIB = +FOREIGN_NOT_USED_LIB = $(FOREIGN_OBJ) +FOREIGN_NOT_USED_OBJSLIB = $(FOREIGN_OBJSLIB) EXTRA_GMP := $(if @EXTRA_GMP_OBJ@,../../racket/src/@EXTRA_GMP_OBJ@,) diff --git a/src/racket/Makefile.in b/src/racket/Makefile.in index 8042ac48b0..1cc2e8e672 100644 --- a/src/racket/Makefile.in +++ b/src/racket/Makefile.in @@ -36,6 +36,7 @@ FOREIGN_DIR = ../foreign FOREIGN_OBJ = $(FOREIGN_DIR)/foreign.@LTO@ FOREIGN_OBJS = $(FOREIGN_OBJ) $(FOREIGN_DIR)/gcc/libffi/src/*.@LTO@ $(FOREIGN_DIR)/gcc/libffi/src/*/*.@LTO@ FOREIGN_LIB = $(FOREIGN_OBJ) ../foreign/gcc/libffi/libffi@FOREIGN_CONVENIENCE@.la +FOREIGN_STUB_LIB = $(FOREIGN_OBJ) FOREIGN_OBJSLIB = @FOREIGN_OBJSLIB@ # Dependency always uses FOREIGN_LIB, but linker uses FOREIGN_OBJSLIB. The # FOREIGN_OBJSLIB expansion has too many "*"s to be a valid make target, @@ -115,8 +116,8 @@ gc.@LIBSFX@: foreign-stuff: cd $(FOREIGN_DIR); $(MAKE) all -foreign-nothing: - echo no foreign +foreign-stub: + cd $(FOREIGN_DIR); $(MAKE) stub mzlibrary: cd src; $(MAKE) all @@ -124,8 +125,8 @@ mzlibrary: FOREIGN_USED_LIB = $(FOREIGN_OBJ) $(FOREIGN_LIB) FOREIGN_USED_OBJSLIB = $(FOREIGN_OBJSLIB) -FOREIGN_NOT_USED_LIB = -FOREIGN_NOT_USED_OBJSLIB = +FOREIGN_NOT_USED_LIB = $(FOREIGN_OBJ) +FOREIGN_NOT_USED_OBJSLIB = $(FOREIGN_OBJ) libracket.@LIBSFX@: src/*.@LTO@ $(@FOREIGN_IF_USED@_LIB) $(NICEAR) $(AR) $(ARFLAGS) libracket.@LIBSFX@ src/*.@LTO@ $(@FOREIGN_IF_USED@_OBJSLIB) @LIBRACKET_DEP@ diff --git a/src/racket/configure.ac b/src/racket/configure.ac index 4e96f6593b..ea8d997a79 100644 --- a/src/racket/configure.ac +++ b/src/racket/configure.ac @@ -1585,7 +1585,6 @@ FOREIGN_IF_USED="FOREIGN_NOT_USED" if test -d "${srcdir}/foreign" && test "${enable_foreign}" = "yes" ; then AC_CONFIG_AUX_DIR( foreign/gcc ) AC_CONFIG_SUBDIRS( foreign/gcc/libffi ) - makefiles="$makefiles foreign/Makefile" FOREIGNTARGET="foreign-stuff" FOREIGN_IF_USED="FOREIGN_USED" # --disable-multilib is needed to avoid problems when running libffi's @@ -1593,9 +1592,10 @@ if test -d "${srcdir}/foreign" && test "${enable_foreign}" = "yes" ; then # other scripts do not use it anyway. ac_configure_args="$ac_configure_args --disable-multilib" else - FOREIGNTARGET="foreign-nothing" + FOREIGNTARGET="foreign-stub" MZOPTIONS="$MZOPTIONS -DDONT_USE_FOREIGN" fi +makefiles="$makefiles foreign/Makefile" ac_configure_args="$ac_configure_args$SUB_CONFIGURE_EXTRAS" if test "${enable_gracket}" = "yes" ; then diff --git a/src/racket/gc2/Makefile.in b/src/racket/gc2/Makefile.in index 1d41d49c12..c3d12f5307 100644 --- a/src/racket/gc2/Makefile.in +++ b/src/racket/gc2/Makefile.in @@ -35,7 +35,7 @@ XFORM = env XFORM_USE_PRECOMP=$(XSRCDIR)/precomp.h $(XFORM_NOPRECOMP) SRCDIR = $(srcdir)/../src FOREIGN_USED_OBJ = foreign.@LTO@ -FOREIGN_NOT_USED_OBJ = +FOREIGN_NOT_USED_OBJ = $(FOREIGN_USED_OBJ) OBJS = salloc.@LTO@ \ bignum.@LTO@ \ @@ -80,7 +80,7 @@ OBJS = salloc.@LTO@ \ $(@FOREIGN_IF_USED@_OBJ) FOREIGN_USED_C = $(XSRCDIR)/foreign.c -FOREIGN_NOT_USED_C = +FOREIGN_NOT_USED_C = $(FOREIGN_USED_C) XSRCS = $(XSRCDIR)/salloc.c \ $(XSRCDIR)/bignum.c \ @@ -371,8 +371,8 @@ FOREIGN_OBJSLIB = @FOREIGN_OBJSLIB@ FOREIGN_USED_LIB = $(FOREIGN_OBJ) $(FOREIGN_LIB) FOREIGN_USED_OBJSLIB = $(FOREIGN_OBJSLIB) -FOREIGN_NOT_USED_LIB = -FOREIGN_NOT_USED_OBJSLIB = +FOREIGN_NOT_USED_LIB = $(FOREIGN_OBJ) +FOREIGN_NOT_USED_OBJSLIB = $(FOREIGN_OBJSLIB) EXTRA_GMP := $(if @EXTRA_GMP_OBJ@,../src/@EXTRA_GMP_OBJ@,) diff --git a/src/racket/src/env.c b/src/racket/src/env.c index b1c0a8d29b..fb92cfaff0 100644 --- a/src/racket/src/env.c +++ b/src/racket/src/env.c @@ -189,19 +189,6 @@ static void init_compile_data(Scheme_Comp_Env *env); /*========================================================================*/ -#ifdef DONT_USE_FOREIGN -static void init_dummy_foreign(Scheme_Env *env) -{ - /* Works just well enough that the `mzscheme' module can - import it (so that attaching `mzscheme' to a namespace - also attaches `#%foreign'). */ - Scheme_Env *menv; - menv = scheme_primitive_module(scheme_intern_symbol("#%foreign"), env); - scheme_finish_primitive_module(menv); - scheme_protect_primitive_provide(menv, NULL); -} -#endif - static void boot_module_resolver() { Scheme_Object *boot, *a[2]; @@ -501,7 +488,9 @@ static Scheme_Env *place_instance_init(void *stack_base, int initial_main_os_thr scheme_init_gmp_places(); scheme_alloc_global_fdset(); scheme_init_file_places(); +#ifndef DONT_USE_FOREIGN scheme_init_foreign_places(); +#endif env = scheme_make_empty_env(); scheme_set_param(scheme_current_config(), MZCONFIG_ENV, (Scheme_Object *)env); @@ -530,11 +519,7 @@ static Scheme_Env *place_instance_init(void *stack_base, int initial_main_os_thr #endif scheme_init_futures(env); -#ifndef DONT_USE_FOREIGN scheme_init_foreign(env); -#else - init_dummy_foreign(env); -#endif scheme_add_embedded_builtins(env); diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 104e65b2c4..f387eff2ad 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -241,8 +241,8 @@ void scheme_init_inspector(void); #ifndef DONT_USE_FOREIGN void scheme_init_foreign_globals(); -void scheme_init_foreign(Scheme_Env *env); #endif +void scheme_init_foreign(Scheme_Env *env); void scheme_init_place(Scheme_Env *env); void scheme_init_places_once(); void scheme_init_futures(Scheme_Env *env); diff --git a/src/racket/src/thread.c b/src/racket/src/thread.c index 7329d58ac3..3d2c4fb3bc 100644 --- a/src/racket/src/thread.c +++ b/src/racket/src/thread.c @@ -4159,7 +4159,7 @@ void scheme_thread_block(float sleep_time) #ifdef MZ_USE_FUTURES scheme_check_future_work(); #endif -#ifdef MZ_USE_MZRT +#if defined(MZ_USE_MZRT) && !defined(DONT_USE_FOREIGN) scheme_check_foreign_work(); #endif