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

MinGW-w64 support

Browse Source 
For now, SGC must be used, but `configure' does not select it
automatically.

Also, support Cygwin (in addition to MSYS) as a build environment
when using MinGW compilers. Since I build in a Cygwin environment
(which seemed to be the easiest way to get MinGW-w64 gcc), I use

  ../configure --host=x86_64-w64-mingw32 --enable-sgc
This commit is contained in:
Matthew Flatt 2012-12-27 15:57:26 -06:00
parent 7b9879c0e6
commit 03259ef539
28 changed files with 259 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
src/Makefile.in
View File

@ -62,7 +62,7 @@ both:
# Install (common) ----------------------------------------
SETUP_ARGS = -X "$(DESTDIR)$(collectsdir)" -N "raco setup" -l- setup $(PLT_SETUP_OPTIONS) $(PLT_ISO) @INSTALL_SETUP_FLAGS@
SETUP_ARGS = -X @DIRCVTPRE@"$(DESTDIR)$(collectsdir)"@DIRCVTPOST@ -N "raco setup" -l- setup $(PLT_SETUP_OPTIONS) $(PLT_ISO) @INSTALL_SETUP_FLAGS@
# Pass compile and link flags to `make install' for use by any
# collection-setup actions that compile and link C code:
@ -81,10 +81,10 @@ plain-install:
install-common-first:
mkdir -p $(ALLDIRINFO)
@RUN_RACKET_CGC@ -c "$(srcdir)/get-libs.rkt" core "$(DESTDIR)$(libpltdir)"
@RUN_RACKET_CGC@ -c "$(srcdir)/get-libs.rkt" math "$(DESTDIR)$(libpltdir)"
@RUN_RACKET_CGC@ -c "$(srcdir)/get-libs.rkt" db "$(DESTDIR)$(libpltdir)"
@RUN_RACKET_CGC@ -c "$(srcdir)/get-libs.rkt" com "$(DESTDIR)$(libpltdir)"
@RUN_RACKET_CGC@ -c "$(srcdir)/get-libs.rkt" core @DIRCVTPRE@"$(DESTDIR)$(libpltdir)"@DIRCVTPOST@
@RUN_RACKET_CGC@ -c "$(srcdir)/get-libs.rkt" math @DIRCVTPRE@"$(DESTDIR)$(libpltdir)"@DIRCVTPOST@
@RUN_RACKET_CGC@ -c "$(srcdir)/get-libs.rkt" db @DIRCVTPRE@"$(DESTDIR)$(libpltdir)"@DIRCVTPOST@
@RUN_RACKET_CGC@ -c "$(srcdir)/get-libs.rkt" com @DIRCVTPRE@"$(DESTDIR)$(libpltdir)"@DIRCVTPOST@
install-common-middle:
$(MAKE) @MAKE_COPYTREE@-run

4
src/README
View File

@ -29,7 +29,9 @@ To compile with MinGW tools, follow the Unix instructions below; do not
use `--enable-shared', because DLLs will be generated automatically.
The result is a Windows-style build, but without MzCOM. If you are using
a variant of MinGW without "libdelayimp.a", get the implementation of
"delayimp.c" from MinGW-w64 and compile it to "libdelayimp.a".
"delayimp.c" from MinGW-w64 and compile it to "libdelayimp.a". When
compiling with MinGW-w64 for 64-bit mode, the `--enable-sgc' flag
to `configure' is currently required.
To compile with Cygwin tools, follow the Unix instructions below, and be
sure to configure with `--enable-shared'. The result is a Unix-style

46
src/configure vendored
View File

@ -730,6 +730,11 @@ WXPRECOMP
USE_WXPRECOMP
INCLUDEDEP
WX_MMD_FLAG
PWD
DIRCVTPRE
DIRCVTPOST
WINDRES
DLLTOOL
OSKHOME
EXTRA_OSK_LIBS
FOREIGN_IF_USED
@ -2183,7 +2188,7 @@ if test "${enable_shared}" = "yes" ; then
exit 1
fi
;;
mingw*)
*mingw*)
echo "ERROR: don't use --enable-shared or --enable-dynlib with mingw"
exit 1
;;
@ -2388,6 +2393,12 @@ MROPTIONS=
INCLUDEDEP="#"
WX_MMD_FLAG=
DIRCVTPRE=
DIRCVTPOST=
PWD=pwd
WINDRES=windres
DLLTOOL=dlltool
PREFLAGS="$CPPFLAGS"
OWN_LIBFFI="ON"
@ -4022,7 +4033,7 @@ case "$host_os" in
fi
LIBS="$LIBS -Wl,-E"
;;
mingw*)
*mingw*)
enable_parallel_by_default=yes
use_flag_pthread=no
MZOPTIONS="$MZOPTIONS -fno-omit-frame-pointer" # to make JIT backtraces work
@ -4038,6 +4049,19 @@ cat >>confdefs.h <<\_ACEOF
#define HAVE_STDINT_H 1
_ACEOF
if `which ${host}-windres > /dev/null` ; then
WINDRES="${host}-windres"
fi
if `which ${host}-dlltool > /dev/null` ; then
DLLTOOL="${host}-dlltool"
fi
case "$build_os" in
*cygwin*)
PWD="cygpath -m \\\`pwd\\\`"
DIRCVTPRE="\`cygpath -m "
DIRCVTPOST="\`"
;;
esac
;;
cygwin*)
enable_cgcdefault="yes"
@ -4355,6 +4379,11 @@ fi
if test "$using_gnu_cpp" = "yes" ; then
XFORMFLAGS="$XFORMFLAGS --keep-lines"
case "$build_os" in
*cygwin*)
XFORMFLAGS="$XFORMFLAGS --D-via-include"
;;
esac
fi
{ echo "$as_me:$LINENO: result: $using_gnu_cpp" >&5
echo "${ECHO_T}$using_gnu_cpp" >&6; }
@ -8992,6 +9021,12 @@ LIBS="$LIBS $EXTRALIBS"
@ -9844,6 +9879,11 @@ WXPRECOMP!$WXPRECOMP$ac_delim
USE_WXPRECOMP!$USE_WXPRECOMP$ac_delim
INCLUDEDEP!$INCLUDEDEP$ac_delim
WX_MMD_FLAG!$WX_MMD_FLAG$ac_delim
PWD!$PWD$ac_delim
DIRCVTPRE!$DIRCVTPRE$ac_delim
DIRCVTPOST!$DIRCVTPOST$ac_delim
WINDRES!$WINDRES$ac_delim
DLLTOOL!$DLLTOOL$ac_delim
OSKHOME!$OSKHOME$ac_delim
EXTRA_OSK_LIBS!$EXTRA_OSK_LIBS$ac_delim
FOREIGN_IF_USED!$FOREIGN_IF_USED$ac_delim
@ -9875,7 +9915,7 @@ LIBOBJS!$LIBOBJS$ac_delim
LTLIBOBJS!$LTLIBOBJS$ac_delim
_ACEOF
if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 48; then
if test `sed -n "s/.*$ac_delim\$/X/p" conf$$subs.sed | grep -c X` = 53; then
break
elif $ac_last_try; then
{ { echo "$as_me:$LINENO: error: could not make $CONFIG_STATUS" >&5

18
src/foreign/libffi/src/x86/win64.S
View File

@ -11,6 +11,12 @@
#define RVALUE 64
#define FN 72
#ifdef _MSC_VER
# define M_MSC_IZE(x) _ ## x
#else
# define M_MSC_IZE(x) x
#endif
/* ffi_call_win64 (void (*prep_args_fn)(char *, extended_cif *),
extended_cif *ecif, unsigned bytes, unsigned flags,
unsigned *rvalue, void (*fn)());
@ -235,7 +241,7 @@ END
#else
.text
.extern _ffi_closure_win64_inner
.extern M_MSC_IZE(ffi_closure_win64_inner)
# ffi_closure_win64 will be called with these registers set:
# rax points to 'closure'
@ -246,8 +252,8 @@ END
# call ffi_closure_win64_inner for the actual work, then return the result.
#
.balign 16
.globl _ffi_closure_win64
_ffi_closure_win64:
.globl M_MSC_IZE(ffi_closure_win64)
M_MSC_IZE(ffi_closure_win64):
# copy register arguments onto stack
test $1,%r11
jne .Lfirst_is_float
@ -287,7 +293,7 @@ _ffi_closure_win64:
mov %rax, %rcx # context is first parameter
mov %rsp, %rdx # stack is second parameter
add $48, %rdx # point to start of arguments
mov $_ffi_closure_win64_inner, %rax
mov $M_MSC_IZE(ffi_closure_win64_inner), %rax
callq *%rax # call the real closure function
add $40, %rsp
movq %rax, %xmm0 # If the closure returned a float,
@ -296,8 +302,8 @@ _ffi_closure_win64:
.ffi_closure_win64_end:
.balign 16
.globl _ffi_call_win64
_ffi_call_win64:
.globl M_MSC_IZE(ffi_call_win64)
M_MSC_IZE(ffi_call_win64):
# copy registers onto stack
mov %r9,32(%rsp)
mov %r8,24(%rsp)

10
src/gracket/Makefile.in
View File

@ -98,7 +98,7 @@ gracket@CGC@ : $(RACKETDEPS) grmain.@LTO@ $(GRACKETOBJECTS) $(MRSTATIC_STUB) $(G
$(GRACKETLINKER) $(GRACKETLDFLAGS) $(MRSTATIC) -o gracket@CGC@ $(GRACKETOBJECTS) $(GRACKETRES) $(GRACKETLDLIBS) $(MRSTATIC_STUB)
gres.o : $(srcdir)/../worksp/gracket/gracket.rc
windres -i $(srcdir)/../worksp/gracket/gracket.rc -o gres.o
@WINDRES@ -i $(srcdir)/../worksp/gracket/gracket.rc -o gres.o
resources@NOT_MINGW@ :
$(NOOP)
@ -128,7 +128,7 @@ solaris-static:
linux-static:
$(MAKE) gracket MRSTATIC=--static LDNONSTATICLIBS='-ldl'
DEF_COLLECTS_DIR = -DINITIAL_COLLECTS_DIRECTORY='"'"`cd $(srcdir)/../../collects; pwd`"'"'
DEF_COLLECTS_DIR = -DINITIAL_COLLECTS_DIRECTORY='"'"`cd $(srcdir)/../../collects; @PWD@`"'"'
grmain.@LTO@ : $(srcdir)/grmain.c $(srcdir)/../racket/main.c \
$(srcdir)/../racket/cmdline.inc $(srcdir)/../racket/src/stypes.h \
@ -174,7 +174,7 @@ install-post-collects:
$(MAKE) install-@WXVARIANT@-post-collects
install-common:
@RUN_RACKET_CGC@ -c "$(srcdir)/../get-libs.rkt" gui "$(DESTDIR)$(libpltdir)"
@RUN_RACKET_CGC@ -c "$(srcdir)/../get-libs.rkt" gui @DIRCVTPRE@"$(DESTDIR)$(libpltdir)"@DIRCVTPOST@
# X11 ----------------------------------------
@ -196,7 +196,7 @@ install-lib-cgc-wx_xt:
install-wx_xt-cgc:
$(MAKE) @MRLIBINSTALL@-cgc-wx_xt
cd ..; $(ICP) gracket/gracket@CGC@ "$(DESTDIR)@MZINSTALLBINDIR@/gracket@CGC_INSTALLED@"
@RUN_RACKET_CGC@ -cu "$(srcdir)/../racket/collects-path.rkt" "$(DESTDIR)@MZINSTALLBINDIR@/gracket@CGC_INSTALLED@@EXE_SUFFIX@" @COLLECTS_PATH@
@RUN_RACKET_CGC@ -cu "$(srcdir)/../racket/collects-path.rkt" @DIRCVTPRE@"$(DESTDIR)@MZINSTALLBINDIR@/gracket@CGC_INSTALLED@@EXE_SUFFIX@"@DIRCVTPOST@ @COLLECTS_PATH@
install-wx_xt-cgc-final:
$(NOOP)
@ -210,7 +210,7 @@ install-lib-3m-wx_xt:
install-wx_xt-3m:
$(MAKE) @MRLIBINSTALL@-3m-wx_xt
cd ..; $(ICP) gracket/gracket@MMM@ "$(DESTDIR)@MZINSTALLBINDIR@/gracket@MMM_INSTALLED@"
@RUN_RACKET_MMM@ -cu "$(srcdir)/../racket/collects-path.rkt" "$(DESTDIR)@MZINSTALLBINDIR@/gracket@MMM_INSTALLED@@EXE_SUFFIX@" @COLLECTS_PATH@
@RUN_RACKET_MMM@ -cu "$(srcdir)/../racket/collects-path.rkt" @DIRCVTPRE@"$(DESTDIR)@MZINSTALLBINDIR@/gracket@MMM_INSTALLED@@EXE_SUFFIX@"@DIRCVTPOST@ @COLLECTS_PATH@
install-wx_xt-3m-final:
$(NOOP)

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

@ -58,7 +58,7 @@ XFORMDEP = $(srcdir)/../../racket/gc2/xform.rkt $(srcdir)/../../racket/gc2/xform
GRACKETLDFLAGS = $(LDFLAGS) -L../../racket
DEF_COLLECTS_DIR = +D INITIAL_COLLECTS_DIRECTORY='"'"`cd $(srcdir)/../../../collects; pwd`"'"'
DEF_COLLECTS_DIR = +D INITIAL_COLLECTS_DIRECTORY='"'"`cd $(srcdir)/../../../collects; @PWD@`"'"'
XFORMWP = $(XFORM)

15
src/gracket/grmain.c
View File

@ -493,7 +493,7 @@ static BOOL CALLBACK CheckWindow(HWND wnd, LPARAM param)
DWORD w;
char **argv, *v;
COPYDATASTRUCT cd;
DWORD result;
DWORD_PTR result;
LRESULT ok;
ok = SendMessageTimeout(wnd, wm_is_gracket,
@ -507,7 +507,7 @@ static BOOL CALLBACK CheckWindow(HWND wnd, LPARAM param)
if (ok == 0)
return TRUE; /* ignore and continue */
if (result == 79) {
if ((intptr_t)result == 79) {
/* found it */
} else
return TRUE; /* continue search */
@ -609,16 +609,7 @@ int APIENTRY WinMain(HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR ignored
int j, argc;
char **argv, *normalized_path;
/* Order matters: load dependencies first */
# ifndef MZ_PRECISE_GC
load_delayed_dll(NULL, "libmzgcxxxxxxx.dll");
# endif
load_delayed_dll(NULL, "libracket" DLL_3M_SUFFIX "xxxxxxx.dll");
record_dll_path();
# ifdef __MINGW32__
scheme_set_atexit(atexit);
# endif
load_delayed();
{
HANDLE h;

14
src/racket/Makefile.in
View File

@ -191,13 +191,13 @@ lib/libracketxxxxxxx.dll: lib/libmzgcxxxxxxx.dll libracket.@LIBSFX@ mzsj86g.o
@MZLINKER@ -shared -o lib/libracketxxxxxxx.dll mzsj86g.o -Wl,--output-def -Wl,libracket.def -Wl,--whole-archive libracket.@LIBSFX@ -Wl,--no-whole-archive -lshell32 -luser32 -lws2_32 lib/libmzgcxxxxxxx.dll
libracket.dll.a: lib/libracketxxxxxxx.dll
dlltool --def libracket.def -D libracketxxxxxxx.dll --output-delaylib libracket.dll.a
@DLLTOOL@ --def libracket.def -D libracketxxxxxxx.dll --output-delaylib libracket.dll.a
libmzgc.dll.a: lib/libmzgcxxxxxxx.dll
dlltool --def libmzgc.def -D libmzgcxxxxxxx.dll --output-delaylib libmzgc.dll.a
@DLLTOOL@ --def libmzgc.def -D libmzgcxxxxxxx.dll --output-delaylib libmzgc.dll.a
rres.o : $(srcdir)/../worksp/racket/racket.rc
windres -i $(srcdir)/../worksp/racket/racket.rc -o rres.o
@WINDRES@ -i $(srcdir)/../worksp/racket/racket.rc -o rres.o
racket@CGC@@MINGW@: libracket.dll.a libmzgc.dll.a main.@LTO@ $(SPECIALIZINGOBJECTS) rres.o
@MZLINKER@ -o racket@CGC@ main.@LTO@ rres.o $(SPECIALIZINGOBJECTS) libracket.dll.a libmzgc.dll.a @LDFLAGS@ @LIBS@ -ldelayimp
@ -216,7 +216,7 @@ racket.multiboot : libracket.@LIBSFX@ libmzgc.@LIBSFX@ main.@LTO@
# ----------------------------------------
DEF_COLLECTS_DIR = -DINITIAL_COLLECTS_DIRECTORY='"'"`cd $(srcdir)/../../collects; pwd`"'"'
DEF_COLLECTS_DIR = -DINITIAL_COLLECTS_DIRECTORY='"'"`cd $(srcdir)/../../collects; @PWD@`"'"'
main.@LTO@: $(srcdir)/main.c $(srcdir)/include/scheme.h $(srcdir)/sconfig.h $(srcdir)/src/stypes.h $(srcdir)/cmdline.inc $(srcdir)/parse_cmdl.inc $(srcdir)/oskglue.inc
$(CC) -I$(builddir) -I$(srcdir)/include @CFLAGS@ @COMPFLAGS@ @PREFLAGS@ @PROFFLAGS@ @OPTIONS@ @MZOPTIONS@ $(DEF_COLLECTS_DIR) -c $(srcdir)/main.c -o main.@LTO@
@ -258,7 +258,7 @@ total_startup:
$(MAKE) cgc
headers:
@RUN_RACKET_CGC@ -cqu $(srcdir)/mkincludes.rkt "$(DESTDIR)$(includepltdir)" "$(srcdir)" .
@RUN_RACKET_CGC@ -cqu $(srcdir)/mkincludes.rkt @DIRCVTPRE@"$(DESTDIR)$(includepltdir)"@DIRCVTPOST@ "$(srcdir)" .
$(srcdir)/src/schexn.h: $(srcdir)/src/makeexn
$(RACKET) -um $(srcdir)/src/makeexn > $(srcdir)/src/schexn.h
@ -368,7 +368,7 @@ mingw-install-cgc:
cd ..; $(ICP) racket/lib/libmzgcxxxxxxx.dll "$(DESTDIR)$(libdir)/libmzgcxxxxxxx.dll"
cd ..; $(ICP) racket/lib/libracketxxxxxxx.dll "$(DESTDIR)$(libdir)/libracketxxxxxxx.dll"
cd ..; $(ICP) racket/racket@CGC@ "$(DESTDIR)@MZINSTALLBINDIR@/Racket@CGC_INSTALLED@"
@RUN_RACKET_CGC@ -cu "$(srcdir)/collects-path.rkt" "$(DESTDIR)@MZINSTALLBINDIR@/Racket@CGC_INSTALLED@@EXE_SUFFIX@" @COLLECTS_PATH@
@RUN_RACKET_CGC@ -cu "$(srcdir)/collects-path.rkt" @DIRCVTPRE@"$(DESTDIR)@MZINSTALLBINDIR@/Racket@CGC_INSTALLED@@EXE_SUFFIX@"@DIRCVTPOST@ @COLLECTS_PATH@
mingw-install-cgc-final:
$(NOOP)
@ -376,7 +376,7 @@ mingw-install-cgc-final:
mingw-install-3m:
cd ..; $(ICP) racket/racket@MMM@ "$(DESTDIR)@MZINSTALLBINDIR@/Racket@MMM_INSTALLED@"
cd ..; $(ICP) racket/lib/libracket3mxxxxxxx.dll "$(DESTDIR)$(libdir)/libracket3mxxxxxxx.dll"
@RUN_RACKET_MMM@ -cu "$(srcdir)/collects-path.rkt" "$(DESTDIR)@MZINSTALLBINDIR@/Racket@MMM_INSTALLED@@EXE_SUFFIX@" @COLLECTS_PATH@
@RUN_RACKET_MMM@ -cu "$(srcdir)/collects-path.rkt" @DIRCVTPRE@"$(DESTDIR)@MZINSTALLBINDIR@/Racket@MMM_INSTALLED@@EXE_SUFFIX@"@DIRCVTPOST@ @COLLECTS_PATH@
mingw-install-3m-final:
$(NOOP)

34
src/racket/configure.ac
View File

@ -113,7 +113,7 @@ if test "${enable_shared}" = "yes" ; then
exit 1
fi
;;
mingw*)
*mingw*)
echo "ERROR: don't use --enable-shared or --enable-dynlib with mingw"
exit 1
;;
@ -318,6 +318,12 @@ MROPTIONS=
INCLUDEDEP="#"
WX_MMD_FLAG=
DIRCVTPRE=
DIRCVTPOST=
PWD=pwd
WINDRES=windres
DLLTOOL=dlltool
PREFLAGS="$CPPFLAGS"
OWN_LIBFFI="ON"
@ -557,7 +563,7 @@ case "$host_os" in
fi
LIBS="$LIBS -Wl,-E"
;;
mingw*)
*mingw*)
enable_parallel_by_default=yes
use_flag_pthread=no
MZOPTIONS="$MZOPTIONS -fno-omit-frame-pointer" # to make JIT backtraces work
@ -569,6 +575,19 @@ case "$host_os" in
COLLECTS_PATH="collects"
skip_iconv_check=yes
AC_DEFINE(HAVE_STDINT_H,1,[Have stdint.h])
if `which ${host}-windres > /dev/null` ; then
WINDRES="${host}-windres"
fi
if `which ${host}-dlltool > /dev/null` ; then
DLLTOOL="${host}-dlltool"
fi
case "$build_os" in
*cygwin*)
PWD="cygpath -m \\\`pwd\\\`"
DIRCVTPRE="\`cygpath -m "
DIRCVTPOST="\`"
;;
esac
;;
cygwin*)
enable_cgcdefault="yes"
@ -747,6 +766,11 @@ AC_TRY_RUN(
}, using_gnu_cpp=yes, using_gnu_cpp=no, using_gnu_cpp=no)
if test "$using_gnu_cpp" = "yes" ; then
XFORMFLAGS="$XFORMFLAGS --keep-lines"
case "$build_os" in
*cygwin*)
XFORMFLAGS="$XFORMFLAGS --D-via-include"
;;
esac
fi
AC_MSG_RESULT($using_gnu_cpp)
@ -1321,6 +1345,12 @@ AC_SUBST(USE_WXPRECOMP)
AC_SUBST(INCLUDEDEP)
AC_SUBST(WX_MMD_FLAG)
AC_SUBST(PWD)
AC_SUBST(DIRCVTPRE)
AC_SUBST(DIRCVTPOST)
AC_SUBST(WINDRES)
AC_SUBST(DLLTOOL)
AC_SUBST(OSKHOME)
AC_SUBST(EXTRA_OSK_LIBS)

2
src/racket/dynsrc/Makefile.in
View File

@ -55,7 +55,7 @@ dynexmpl.o: $(srcdir)/dynexmpl.c $(HEADERS)
$(PLAIN_CC) $(CFLAGS) -mwindows -DMRSTART -o ../mrstarter $(srcdir)/start.c sres.o
sres.o:
windres -i $(srcdir)/../../worksp/starters/start.rc -o sres.o
@WINDRES@ -i $(srcdir)/../../worksp/starters/start.rc -o sres.o
# Cygwin ########################################

2
src/racket/gc/include/private/gcconfig.h
View File

@ -433,7 +433,7 @@
# define CYGWIN32
# define mach_type_known
# endif
# if defined(__MINGW32__)
# if defined(__MINGW32__) && !defined(_WIN64) /* PLTSCHEME: no _WIN64 */
# define I386
# define MSWIN32
# define mach_type_known

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

@ -29,7 +29,7 @@ LIBFFI_INCLUDE_OFF =
ARLIBFLAGS = @LDFLAGS@ $(LIBS)
DEF_COLLECTS_DIR = +D INITIAL_COLLECTS_DIRECTORY='"'"`cd $(srcdir)/../../../collects; pwd`"'"'
DEF_COLLECTS_DIR = +D INITIAL_COLLECTS_DIRECTORY='"'"`cd $(srcdir)/../../../collects; @PWD@`"'"'
# See ../../Makefile about RUN_RACKET_CGC, which
# typically redirects to RUN_THIS_RACKET_CGC:
@ -283,7 +283,7 @@ $(XSRCDIR)/setjmpup.c: ../src/setjmpup.@LTO@ $(XFORMDEP)
$(XSRCDIR)/sfs.c: ../src/sfs.@LTO@ $(XFORMDEP)
$(XFORM) $(XSRCDIR)/sfs.c $(SRCDIR)/sfs.c
$(XSRCDIR)/string.c: ../src/string.@LTO@ $(XFORMDEP)
$(XFORM_SETUP) --cpp "$(CPP) -I../src $(CPPFLAGS)" -o $(XSRCDIR)/string.c $(SRCDIR)/string.c
$(XFORM_SETUP) --cpp "$(CPP) -I../src $(CPPFLAGS)" @XFORMFLAGS@ -o $(XSRCDIR)/string.c $(SRCDIR)/string.c
$(XSRCDIR)/struct.c: ../src/struct.@LTO@ $(XFORMDEP)
$(XFORM) $(XSRCDIR)/struct.c $(SRCDIR)/struct.c
$(XSRCDIR)/symbol.c: ../src/symbol.@LTO@ $(XFORMDEP) $(SRCDIR)/mzrt.h
@ -299,7 +299,7 @@ $(XSRCDIR)/validate.c: ../src/validate.@LTO@ $(XFORMDEP)
$(XSRCDIR)/vector.c: ../src/vector.@LTO@ $(XFORMDEP)
$(XFORM) $(XSRCDIR)/vector.c $(SRCDIR)/vector.c
$(XSRCDIR)/foreign.c: ../../foreign/foreign.@LTO@ $(XFORMDEP)
$(XFORM_SETUP) --cpp "$(CPP) $(CPPFLAGS) $(LIBFFI_INCLUDE_@OWN_LIBFFI@) -I${SRCDIR}/../../racket/src" -o $(XSRCDIR)/foreign.c $(SRCDIR)/../../foreign/foreign.c
$(XFORM_SETUP) --cpp "$(CPP) $(CPPFLAGS) $(LIBFFI_INCLUDE_@OWN_LIBFFI@) -I${SRCDIR}/../../racket/src" @XFORMFLAGS@ -o $(XSRCDIR)/foreign.c $(SRCDIR)/../../foreign/foreign.c
$(XSRCDIR)/main.c: ../main.@LTO@ $(XFORMDEP)
$(XFORM_NOPRECOMP) $(XSRCDIR)/main.c $(DEF_COLLECTS_DIR) $(srcdir)/../main.c
@ -509,7 +509,7 @@ $(MZFWMMM): ../libracket3m.@LIBSFX@
@MZLINKER@ -shared -o ../lib/libracket3mxxxxxxx.dll ../mzsj86g.o -Wl,--output-def -Wl,libracket3m.def -Wl,--whole-archive ../libracket3m.@LIBSFX@ -Wl,--no-whole-archive -lshell32 -luser32 -lws2_32
libracket3m.dll.a: ../lib/libracket3mxxxxxxx.dll
dlltool --def libracket3m.def -D libracket3mxxxxxxx.dll --output-delaylib libracket3m.dll.a
@DLLTOOL@ --def libracket3m.def -D libracket3mxxxxxxx.dll --output-delaylib libracket3m.dll.a
../racket@MMM@@MINGW@: libracket3m.dll.a main.@LTO@ ../rres.o $(SPECIALIZINGOBJECTS)
cd ..; @MZLINKER@ -o racket@MMM@ gc2/main.@LTO@ rres.o $(SPECIALIZINGOBJECTS) gc2/libracket3m.dll.a @LDFLAGS@ @LIBS@ -ldelayimp

27
src/racket/gc2/xform-mod.rkt
View File

@ -9,6 +9,9 @@
(define output-depends-info? #f)
(define gc-variable-stack-through-funcs? #f)
(define def-via-include? #f)
(define include-counter 1)
(define palm? #f)
(define pgc? #t)
(define pgc-really? #t)
@ -48,11 +51,27 @@
(set! file-out dest-file)]
[("--indirect") "access GC_variable_stack through functions"
(set! gc-variable-stack-through-funcs? #t)]
[("--D-via-include") "implement +D via -include"
(set! def-via-include? #t)]
[("+D") def "add CPP -D flag"
(set! cpp (string-append cpp " -D"
(if (eq? (system-type) 'windows)
def
(regexp-replace* "[ \"]" def "'\\0'"))))]]
(cond
[def-via-include?
;; This mode is useful when command-line argument parsing
;; breaks down in corner cases, such as when using a Cygwin
;; build of gcc.
(define fn (format "def~a.inc" include-counter))
(set! include-counter (add1 include-counter))
(define m (regexp-match #rx"^([^=]+)=(.*)$" def))
(call-with-output-file fn
(lambda (out)
(fprintf out "#define ~a ~a\n" (cadr m) (caddr m)))
'truncate/replace)
(set! cpp (string-append cpp (format " -include ~a" fn)))]
[else
(set! cpp (string-append cpp " -D"
(if (eq? (system-type) 'windows)
def
(regexp-replace* "[ \"]" def "'\\0'"))))])]]
[args (file)
(set! file-in file)])

1
src/racket/gc2/xform.rkt
View File

@ -84,6 +84,7 @@
(printf " (If this isn't a parallel make, then delete it.)\n")
(printf " Waiting until the lock file disappears...\n")
(let loop ()
(flush-output)
(sleep 0.1)
(if (file-exists? lock-file)
(loop)

4
src/racket/include/scheme.h
View File

@ -244,8 +244,8 @@ typedef _int64 mzlonglong;
typedef unsigned _int64 umzlonglong;
#else
# if defined(NO_LONG_LONG_TYPE) || defined(SIXTY_FOUR_BIT_INTEGERS)
typedef long mzlonglong;
typedef unsigned long umzlonglong;
typedef intptr_t mzlonglong;
typedef uintptr_t umzlonglong;
# else
typedef long long mzlonglong;
typedef unsigned long long umzlonglong;

14
src/racket/include/schthread.h
View File

@ -28,7 +28,7 @@ extern "C" {
#if defined(MZ_USE_PLACES) || defined(MZ_USE_FUTURES)
# define USE_THREAD_LOCAL
# ifdef _WIN32
# ifdef _WIN64
# if defined(_WIN64) && !defined(__MINGW32__)
# define THREAD_LOCAL __declspec(thread)
# define MZ_THREAD_EXTERN extern
# define IMPLEMENT_THREAD_LOCAL_EXTERNALLY_VIA_PROC
@ -420,6 +420,17 @@ MZ_EXTERN int scheme_tls_index;
static __inline Thread_Local_Variables **scheme_get_thread_local_variables_ptr(void) {
# ifdef __MINGW32__
Thread_Local_Variables **x;
# ifdef _WIN64
asm (
"mov %%gs:(0x58), %%rax;"
"mov (%%rax), %%rax;"
"add %1, %%rax;"
"mov %%rax, %0;"
:"=r"(x) /* output */
:"r"(scheme_tls_delta)
:"%rax" /* clobbered register */
);
# else
asm (
"mov %%fs:(0x2C), %%eax;"
"mov (%%eax), %%eax;"
@ -429,6 +440,7 @@ static __inline Thread_Local_Variables **scheme_get_thread_local_variables_ptr(v
:"r"(scheme_tls_delta)
:"%eax" /* clobbered register */
);
# endif
return x;
# else
__asm { mov eax, FS:[0x2C]

4
src/racket/main.c
View File

@ -312,7 +312,11 @@ void load_delayed()
through the OS-supplied mechanism. Just assume that the first
thread-local variable is ours. */
void **base;
# ifdef _WIN64
asm("mov %%gs:(0x58), %0;" :"=r"(base));
# else
asm("mov %%fs:(0x2C), %0;" :"=r"(base));
# endif
scheme_register_tls_space(*base, _tls_index);
}
# else

20
src/racket/sgc/collect.inc
View File

@ -49,12 +49,12 @@ static void COLLECT(OFFSET_ARG)
#ifndef SIXTY_FOUR_BIT_INTEGERS
SectorPage **local_sector_pagetables;
#endif
unsigned long local_low_plausible;
unsigned long local_high_plausible;
uintptr_t local_low_plausible;
uintptr_t local_high_plausible;
int local_collect_stack_size;
int local_collect_stack_count;
unsigned long *local_collect_stack;
long local_mem_use;
uintptr_t *local_collect_stack;
intptr_t local_mem_use;
/* Download globals into locals so they can be put in registers: */
#ifndef SIXTY_FOUR_BIT_INTEGERS
@ -68,9 +68,9 @@ static void COLLECT(OFFSET_ARG)
local_mem_use = mem_use;
IF_OR_WHILE (local_collect_stack_count) {
unsigned long s, end;
uintptr_t s, end;
#if KEEP_DETAIL_PATH
unsigned long source;
uintptr_t source;
#endif
#if CHECK_SKIP_MARK_AT_FIRST
@ -127,7 +127,7 @@ static void COLLECT(OFFSET_ARG)
while (s < end) {
void *d = *(void **)INT_TO_PTR(s);
unsigned long p = ADD_LOCAL_OFFSET(PTR_TO_INT(d));
uintptr_t p = ADD_LOCAL_OFFSET(PTR_TO_INT(d));
MARK_STATISTIC(num_checks_stat++);
#ifdef FOLLOW_INTERIOR
@ -150,21 +150,21 @@ static void COLLECT(OFFSET_ARG)
if (pagetable) {
SectorPage *page = pagetable + SECTOR_LOOKUP_PAGEPOS(p);
long kind = page->kind;
int kind = page->kind;
MARK_STATISTIC(num_pages_stat++);
if (kind == sector_kind_block) {
/* Found common block: */
BlockOfMemory *block = (BlockOfMemory *)INT_TO_PTR(page->start);
unsigned long bstart = block->start;
uintptr_t bstart = block->start;
MARK_STATISTIC(num_blocks_stat++);
if ((p >= bstart) && (p < block->top)) {
int size = block->size;
int pos = block->positions[(p - bstart) >> LOG_PTR_SIZE];
unsigned long start = bstart + pos * size;
uintptr_t start = bstart + pos * size;
MARK_STATISTIC(num_blockallocs_stat++);

46
src/racket/sgc/sgc.c
View File

@ -37,7 +37,9 @@
#ifdef _WIN64
# define SIZEOF_LONG 8
# define inline _inline
# ifdef _MSC_VER
# define inline _inline
# endif
#endif
#ifdef SIZEOF_LONG
@ -298,7 +300,13 @@
# define LOG_PTR_SIZE 2
# define LOW_32_BITS(x) x
#endif
# define PTR_SIZE (1 << LOG_PTR_SIZE)
#define PTR_SIZE (1 << LOG_PTR_SIZE)
#ifdef _WIN64
# define ALLOC_ALIGNMENT 16
#else
# define ALLOC_ALIGNMENT PTR_SIZE
#endif
#define DOUBLE_SIZE sizeof(double)
@ -1492,6 +1500,14 @@ static void free_managed(void *s)
/*************************************************************/
static intptr_t size_align(intptr_t s) {
if (s & (ALLOC_ALIGNMENT-1))
return s + (ALLOC_ALIGNMENT - (s & (ALLOC_ALIGNMENT-1)));
else
return s;
}
static void init_size_map()
{
int i, j, find_half;
@ -1505,7 +1521,7 @@ static void init_size_map()
size_index_map[i] = i;
}
for (i = 0; i < 8; i++) {
size_map[i] = (i + 1) * PTR_SIZE;
size_map[i] = size_align((i + 1) * PTR_SIZE);
}
/* i's final value is used below... */
@ -1516,7 +1532,7 @@ static void init_size_map()
while (j < (MAX_COMMON_SIZE >> 2)) {
size_index_map[j] = i;
if ((j + 1) == next) {
size_map[i] = next * PTR_SIZE;
size_map[i] = size_align(next * PTR_SIZE);
i++;
if (find_half) {
next = 2 * k;
@ -1529,7 +1545,7 @@ static void init_size_map()
j++;
}
if (i < NUM_COMMON_SIZE)
size_map[i] = next * PTR_SIZE;
size_map[i] = size_align(next * PTR_SIZE);
#if 0
FPRINTF(STDERR, "max: %d num: %d\n", MAX_COMMON_SIZE, NUM_COMMON_SIZE);
@ -2336,20 +2352,20 @@ static void *do_malloc(SET_NO_BACKINFO
void *a;
MemoryChunk *c;
/* Round up to ptr-aligned size: */
if (size & (PTR_SIZE-1))
size += PTR_SIZE - (size & (PTR_SIZE-1));
/* Round up to aligned size: */
if (size & (ALLOC_ALIGNMENT-1))
size += ALLOC_ALIGNMENT - (size & (ALLOC_ALIGNMENT-1));
ALLOC_STATISTIC(num_chunk_allocs_stat++);
cpos = 0;
a = malloc_sector(size + sizeof(MemoryChunk), sector_kind_chunk, 1);
a = malloc_sector(size + size_align(sizeof(MemoryChunk)), sector_kind_chunk, 1);
if (!a) {
if (mem_use >= mem_limit)
GC_gcollect();
a = malloc_sector(size + sizeof(MemoryChunk), sector_kind_chunk, 0);
a = malloc_sector(size + size_align(sizeof(MemoryChunk)), sector_kind_chunk, 0);
}
c = (MemoryChunk *)a;
@ -2376,7 +2392,7 @@ static void *do_malloc(SET_NO_BACKINFO
c->next->prev_ptr = &c->next;
#endif
c->start = PTR_TO_INT(&c->data);
c->start = size_align(PTR_TO_INT(&c->data));
c->end = c->start + size;
c->atomic = flags & do_malloc_ATOMIC;
@ -2431,10 +2447,10 @@ static void *do_malloc(SET_NO_BACKINFO
#endif
/* upper bound: */
elem_per_block = (SECTOR_SEGMENT_SIZE - sizeof(BlockOfMemory)) / sizeElemBit;
elem_per_block = (SECTOR_SEGMENT_SIZE - size_align(sizeof(BlockOfMemory))) / sizeElemBit;
/* ^- mem area size ^- block record */
/* use this one: */
elem_per_block = ((SECTOR_SEGMENT_SIZE - sizeof(BlockOfMemory) - elem_per_block
elem_per_block = ((SECTOR_SEGMENT_SIZE - size_align(sizeof(BlockOfMemory)) - elem_per_block
/* ^- mem area size ^- block record ^- elems */
- (extra_alignment + PTR_SIZE - 2)) / sizeElemBit);
/* ^- possible elem padding, -2 since BlockOfMemory has free[1] */
@ -2444,7 +2460,7 @@ static void *do_malloc(SET_NO_BACKINFO
} else {
elem_per_block = 1;
/* Add (PTR_SIZE - 1) to ensure enough room after alignment: */
c = sizeof(BlockOfMemory) + (PTR_SIZE - 1) + sizeElemBit;
c = size_align(sizeof(BlockOfMemory)) + (PTR_SIZE - 1) + sizeElemBit;
}
block = (BlockOfMemory *)malloc_sector(c, sector_kind_block, 1);
@ -2470,7 +2486,7 @@ static void *do_malloc(SET_NO_BACKINFO
#endif
/* offset for data (ptr aligned): */
c = sizeof(BlockOfMemory) + (elem_per_block - 1);
c = size_align(sizeof(BlockOfMemory) + (elem_per_block - 1));
if (c & (PTR_SIZE - 1))
c += (PTR_SIZE - (c & (PTR_SIZE - 1)));
#if !PAD_BOUNDARY_BYTES

38
src/racket/src/eval.c
View File

@ -4486,10 +4486,10 @@ static void *expand_k(void)
return obj;
}
static Scheme_Object *_expand(Scheme_Object *obj, Scheme_Comp_Env *env,
int depth, int rename, int just_to_top,
Scheme_Object *catch_lifts_key, int eb,
int as_local)
static Scheme_Object *r_expand(Scheme_Object *obj, Scheme_Comp_Env *env,
int depth, int rename, int just_to_top,
Scheme_Object *catch_lifts_key, int eb,
int as_local)
/* as_local < 0 => catch lifts to let */
{
Scheme_Thread *p = scheme_current_thread;
@ -4507,8 +4507,8 @@ static Scheme_Object *_expand(Scheme_Object *obj, Scheme_Comp_Env *env,
Scheme_Object *scheme_expand(Scheme_Object *obj, Scheme_Env *env)
{
return _expand(obj, scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
-1, 1, 0, scheme_true, -1, 0);
return r_expand(obj, scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
-1, 1, 0, scheme_true, -1, 0);
}
Scheme_Object *scheme_tail_eval_expr(Scheme_Object *obj)
@ -4681,8 +4681,8 @@ static Scheme_Object *expand(int argc, Scheme_Object **argv)
env = scheme_get_env(NULL);
return _expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
-1, 1, 0, scheme_false, 0, 0);
return r_expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
-1, 1, 0, scheme_false, 0, 0);
}
static Scheme_Object *expand_stx(int argc, Scheme_Object **argv)
@ -4694,8 +4694,8 @@ static Scheme_Object *expand_stx(int argc, Scheme_Object **argv)
env = scheme_get_env(NULL);
return _expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
-1, -1, 0, scheme_false, 0, 0);
return r_expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
-1, -1, 0, scheme_false, 0, 0);
}
Scheme_Object *scheme_generate_lifts_key(void)
@ -5026,7 +5026,7 @@ do_local_expand(const char *name, int for_stx, int catch_lifts, int for_expr, in
} else {
/* Expand the expression. depth = -2 means expand all the way, but
preserve letrec-syntax. */
l = _expand(l, env, -2, 0, 0, catch_lifts_key, 0, catch_lifts ? catch_lifts : 1);
l = r_expand(l, env, -2, 0, 0, catch_lifts_key, 0, catch_lifts ? catch_lifts : 1);
}
SCHEME_EXPAND_OBSERVE_LOCAL_POST(observer, l);
@ -5112,8 +5112,8 @@ expand_once(int argc, Scheme_Object **argv)
env = scheme_get_env(NULL);
return _expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
1, 1, 0, scheme_false, 0, 0);
return r_expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
1, 1, 0, scheme_false, 0, 0);
}
static Scheme_Object *
@ -5126,8 +5126,8 @@ expand_stx_once(int argc, Scheme_Object **argv)
env = scheme_get_env(NULL);
return _expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
1, -1, 0, scheme_false, 0, 0);
return r_expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
1, -1, 0, scheme_false, 0, 0);
}
static Scheme_Object *
@ -5137,8 +5137,8 @@ expand_to_top_form(int argc, Scheme_Object **argv)
env = scheme_get_env(NULL);
return _expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
1, 1, 1, scheme_false, 0, 0);
return r_expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
1, 1, 1, scheme_false, 0, 0);
}
static Scheme_Object *
@ -5151,8 +5151,8 @@ expand_stx_to_top_form(int argc, Scheme_Object **argv)
env = scheme_get_env(NULL);
return _expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
1, -1, 1, scheme_false, 0, 0);
return r_expand(argv[0], scheme_new_expand_env(env, NULL, SCHEME_TOPLEVEL_FRAME),
1, -1, 1, scheme_false, 0, 0);
}
static Scheme_Object *do_eval_string_all(Scheme_Object *port, const char *str, Scheme_Env *env,

5
src/racket/src/jitstack.c
View File

@ -125,7 +125,8 @@ uintptr_t scheme_approx_sp()
return p;
}
#ifdef _WIN64
#if defined( _WIN64) && !defined(__MINGW32__)
# define USE_WIN64_UNWIND
# ifndef UNWIND_HISTORY_TABLE_SIZE
extern PRUNTIME_FUNCTION WINAPI RtlLookupFunctionEntry(ULONG64, ULONG64*, void*);
extern PVOID WINAPI RtlVirtualUnwind(DWORD, DWORD64, DWORD64, PRUNTIME_FUNCTION,
@ -216,7 +217,7 @@ Scheme_Object *scheme_native_stack_trace(void)
#endif
}
#ifdef _WIN64
#ifdef USE_WIN64_UNWIND
{
CONTEXT ctx;
PRUNTIME_FUNCTION rf;

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

@ -596,7 +596,7 @@ typedef struct mzrt_rwlock {
HANDLE readEvent;
HANDLE writeMutex;
LONG readers;
} mzrt_rwlock;
};
int mzrt_rwlock_create(mzrt_rwlock **lock) {
*lock = malloc(sizeof(mzrt_rwlock));

3
src/racket/src/mzsj86g.S
View File

@ -1,3 +1,5 @@
#ifndef _WIN64
.globl _scheme_mz_setjmp
_scheme_mz_setjmp:
push %EBP
@ -38,3 +40,4 @@ _scheme_mz_longjmp:
.section .drectve,"r"
.ascii " -export:scheme_mz_longjmp"
#endif

38
src/racket/src/port.c
View File

@ -456,8 +456,8 @@ THREAD_LOCAL_DECL(void *scheme_break_semaphore;)
#endif
#ifdef MZ_FDS
static Scheme_Object *make_fd_input_port(int fd, Scheme_Object *name, int regfile, int textmode, int *refcount, int internal);
static Scheme_Object *make_fd_output_port(int fd, Scheme_Object *name, int regfile, int textmode, int read_too, int flush_mode,
static Scheme_Object *make_fd_input_port(intptr_t fd, Scheme_Object *name, int regfile, int textmode, int *refcount, int internal);
static Scheme_Object *make_fd_output_port(intptr_t fd, Scheme_Object *name, int regfile, int textmode, int read_too, int flush_mode,
int *refcount);
#endif
#ifdef USE_OSKIT_CONSOLE
@ -660,7 +660,7 @@ void scheme_init_port_places(void)
#else
# ifdef MZ_FDS
# ifdef WINDOWS_FILE_HANDLES
: make_fd_input_port((int)GetStdHandle(STD_INPUT_HANDLE), scheme_intern_symbol("stdin"), 0, 0,
: make_fd_input_port((intptr_t)GetStdHandle(STD_INPUT_HANDLE), scheme_intern_symbol("stdin"), 0, 0,
stdin_refcount, 0)
# else
: make_fd_input_port(0, scheme_intern_symbol("stdin"), 0, 0, stdin_refcount, 0)
@ -675,7 +675,7 @@ void scheme_init_port_places(void)
? scheme_make_stdout()
#ifdef MZ_FDS
# ifdef WINDOWS_FILE_HANDLES
: make_fd_output_port((int)GetStdHandle(STD_OUTPUT_HANDLE),
: make_fd_output_port((intptr_t)GetStdHandle(STD_OUTPUT_HANDLE),
scheme_intern_symbol("stdout"), 0, 0, 0,
-1, stdout_refcount)
# else
@ -691,7 +691,7 @@ void scheme_init_port_places(void)
? scheme_make_stderr()
#ifdef MZ_FDS
# ifdef WINDOWS_FILE_HANDLES
: make_fd_output_port((int)GetStdHandle(STD_ERROR_HANDLE),
: make_fd_output_port((intptr_t)GetStdHandle(STD_ERROR_HANDLE),
scheme_intern_symbol("stderr"), 0, 0, 0,
MZ_FLUSH_ALWAYS, stderr_refcount)
# else
@ -4423,7 +4423,7 @@ Scheme_Object *scheme_file_identity(int argc, Scheme_Object *argv[])
return scheme_get_fd_identity(p, fd, NULL);
}
static int is_fd_terminal(int fd)
static int is_fd_terminal(intptr_t fd)
{
#if defined(WIN32_FD_HANDLES)
if (GetFileType((HANDLE)fd) == FILE_TYPE_CHAR) {
@ -4654,7 +4654,7 @@ scheme_do_open_input_file(char *name, int offset, int argc, Scheme_Object *argv[
return NULL;
}
result = make_fd_input_port((int)fd, scheme_make_path(filename), regfile, mode[1] == 't', NULL, internal);
result = make_fd_input_port((intptr_t)fd, scheme_make_path(filename), regfile, mode[1] == 't', NULL, internal);
# else
if (scheme_directory_exists(filename)) {
if (err) {
@ -4985,7 +4985,7 @@ scheme_do_open_output_file(char *name, int offset, int argc, Scheme_Object *argv
SetEndOfFile(fd);
}
return make_fd_output_port((int)fd, scheme_make_path(filename), regfile, mode[1] == 't', and_read,
return make_fd_output_port((intptr_t)fd, scheme_make_path(filename), regfile, mode[1] == 't', and_read,
-1, NULL);
# else
if (scheme_directory_exists(filename)) {
@ -5111,7 +5111,7 @@ Scheme_Object *scheme_open_output_file_with_mode(const char *name, const char *w
}
#ifdef WINDOWS_FILE_HANDLES
static int win_seekable(int fd)
static int win_seekable(intptr_t fd)
{
/* SetFilePointer() requires " a file stored on a seeking device".
I'm not sure how to test that, so we approximate as "regular
@ -5519,7 +5519,7 @@ scheme_file_buffer(int argc, Scheme_Object *argv[])
}
}
static int try_lock(int fd, int writer, int *_errid)
static int try_lock(intptr_t fd, int writer, int *_errid)
{
#ifdef UNIX_FILE_SYSTEM
# ifdef USE_FLOCK_FOR_FILE_LOCKS
@ -6526,7 +6526,7 @@ static int fd_input_buffer_mode(Scheme_Port *p, int mode)
}
static Scheme_Object *
make_fd_input_port(int fd, Scheme_Object *name, int regfile, int win_textmode, int *refcount, int internal)
make_fd_input_port(intptr_t fd, Scheme_Object *name, int regfile, int win_textmode, int *refcount, int internal)
{
Scheme_Input_Port *ip;
Scheme_FD *fip;
@ -7793,7 +7793,7 @@ static int fd_output_buffer_mode(Scheme_Port *p, int mode)
}
static Scheme_Object *
make_fd_output_port(int fd, Scheme_Object *name, int regfile, int win_textmode, int and_read,
make_fd_output_port(intptr_t fd, Scheme_Object *name, int regfile, int win_textmode, int and_read,
int flush_mode, int *refcount)
{
Scheme_FD *fop;
@ -8023,8 +8023,8 @@ static int MyPipe(intptr_t *ph, int near_index) {
}
}
ph[0] = (long)a[0];
ph[1] = (long)a[1];
ph[0] = (intptr_t)a[0];
ph[1] = (intptr_t)a[1];
return 0;
} else
@ -8971,9 +8971,9 @@ static intptr_t mz_spawnv(char *command, const char * const *argv,
/* If none of the stdio handles are consoles, specifically
create the subprocess without a console: */
if (!is_fd_terminal((int)startup.hStdInput)
&& !is_fd_terminal((int)startup.hStdOutput)
&& !is_fd_terminal((int)startup.hStdError))
if (!is_fd_terminal((intptr_t)startup.hStdInput)
&& !is_fd_terminal((intptr_t)startup.hStdOutput)
&& !is_fd_terminal((intptr_t)startup.hStdError))
cr_flag = CREATE_NO_WINDOW;
else
cr_flag = 0;
@ -9010,7 +9010,7 @@ static void CopyFileHandleForSubprocess(intptr_t *hs, int pos)
0,
TRUE,
DUPLICATE_SAME_ACCESS)) {
hs[pos] = (int)h2;
hs[pos] = (intptr_t)h2;
hs[alt_pos] = 1;
} else {
hs[alt_pos] = 0;
@ -9067,7 +9067,7 @@ static Scheme_Object *subprocess(int c, Scheme_Object *args[])
int exact_cmdline = 0;
#endif
#if defined(WINDOWS_PROCESSES)
int spawn_status;
intptr_t spawn_status;
#endif
/*--------------------------------------------*/

5
src/racket/src/salloc.c
View File

@ -282,8 +282,13 @@ void scheme_setup_thread_local_key_if_needed() XFORM_SKIP_PROC
void **base;
# ifdef __MINGW32__
# ifdef _WIN64
asm("mov %%gs:(0x58), %0;"
:"=r"(base)); /* output */
# else
asm("mov %%fs:(0x2C), %0;"
:"=r"(base)); /* output */
# endif
# else
__asm { mov ecx, FS:[0x2C]
mov base, ecx }

8
src/racket/utils/splay.c
View File

@ -56,14 +56,14 @@
typedef struct tree_node Tree;
struct tree_node {
Tree * left, * right;
unsigned long item;
uintptr_t item;
void *data;
};
# define Splay_Item(t) t->item
# define Set_Splay_Item(t, v) t->item = v
#endif
static Tree * splay (unsigned long i, Tree * t) {
static Tree * splay (uintptr_t i, Tree * t) {
/* Simple top down splay, not requiring i to be in the tree t. */
/* What it does is described above. */
Tree N, *l, *r, *y;
@ -107,7 +107,7 @@ static Tree * splay (unsigned long i, Tree * t) {
return t;
}
static Tree * splay_insert(unsigned long i, Tree * new, Tree * t) {
static Tree * splay_insert(uintptr_t i, Tree * new, Tree * t) {
/* Insert i into the tree t, unless it's already there. */
/* Return a pointer to the resulting tree. */
Set_Splay_Item(new, i);
@ -134,7 +134,7 @@ static Tree * splay_insert(unsigned long i, Tree * new, Tree * t) {
#ifndef OMIT_SPLAY_DELETE
static Tree * splay_delete(unsigned long i, Tree * t) {
static Tree * splay_delete(uintptr_t i, Tree * t) {
/* Deletes i from the tree if it's there. */
/* Return a pointer to the resulting tree. */
Tree * x;

4
src/worksp/gracket/gracket.manifest
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity version="5.3.1.11"
processorArchitecture="X86"
processorArchitecture="*"
name="Org.Racket-Lang.GRacket"
type="win32" />
<description>GRacket: Graphical Racket.</description>
@ -20,7 +20,7 @@
<assemblyIdentity type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
processorArchitecture="X86"
processorArchitecture="*"
publicKeyToken="6595b64144ccf1df"
language="*" />
</dependentAssembly>

4
src/worksp/racket/racket.manifest
View File

@ -1,7 +1,7 @@
<?xml version="1.0" encoding="UTF-8" standalone="no"?>
<assembly xmlns="urn:schemas-microsoft-com:asm.v1" manifestVersion="1.0">
<assemblyIdentity version="5.3.1.11"
processorArchitecture="X86"
processorArchitecture="*"
name="Org.Racket-Lang.Racket"
type="win32" />
<description>Racket.</description>
@ -20,7 +20,7 @@
<assemblyIdentity type="win32"
name="Microsoft.Windows.Common-Controls"
version="6.0.0.0"
processorArchitecture="X86"
processorArchitecture="*"
publicKeyToken="6595b64144ccf1df"
language="*" />
</dependentAssembly>