suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix build for disabled FFI

Browse Source
This commit is contained in:
Matthew Flatt 2010-07-13 15:55:33 -06:00
parent 94799247ee
commit a306a646e6
12 changed files with 220 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
collects/openssl/sha1.rkt
View File

@ -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

4
src/configure vendored
View File

@ -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

4
src/foreign/Makefile.in
View File

@ -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:

145
src/foreign/foreign.c
View File

@ -7,6 +7,9 @@
********************************************/
#include "schpriv.h"
#ifndef DONT_USE_FOREIGN
#include <errno.h>
#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

46
src/foreign/foreign.rktc
View File

@ -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 <errno.h>
@@@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

4
src/gracket/gc2/Makefile.in
View File

@ -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@,)

9
src/racket/Makefile.in
View File

@ -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@

4
src/racket/configure.ac
View File

@ -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

8
src/racket/gc2/Makefile.in
View File

@ -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@,)

19
src/racket/src/env.c
View File

@ -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);

2
src/racket/src/schpriv.h
View File

@ -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);

2
src/racket/src/thread.c
View File

@ -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