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

win64: racket3m

Browse Source
This commit is contained in:
Matthew Flatt 2010-12-03 22:35:38 -07:00
parent 52f0a8cf5e
commit 5065f39dec
11 changed files with 51 additions and 31 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/compiler/private/xform.rkt
View File

@ -423,11 +423,13 @@
(if (eq? (system-type) 'windows)
(lambda (s)
(let ([split (let loop ([s s])
(let ([m (regexp-match "([^ ]*) (.*)" s)])
(let ([m (regexp-match #rx"((?:\"[ ()]\"|[^ ])*) (.*)" s)])
(if m
(cons (cadr m) (loop (caddr m)))
(list s))))])
(apply (verbose process*) (find-executable-path (car split) #f)
(apply (verbose process*) (find-executable-path
(regexp-replace* #rx"\"([ ()])\"" (car split) "\\1")
#f)
(cdr split))))
(verbose process)))

4
src/foreign/foreign.c
View File

@ -431,7 +431,7 @@ static Scheme_Object *foreign_ffi_obj_name(int argc, Scheme_Object *argv[])
/* These will make sense in Racket when longs are longer than ints (needed
* for libffi's int32 types). There is no need to deal with bignums because
* mzscheme's fixnums are longs. */
inline int scheme_get_realint_val(Scheme_Object *o, int *v)
MZ_INLINE int scheme_get_realint_val(Scheme_Object *o, int *v)
{
if (SCHEME_INTP(o)) {
uintptr_t lv = SCHEME_INT_VAL(o);
@ -442,7 +442,7 @@ inline int scheme_get_realint_val(Scheme_Object *o, int *v)
return 1;
} else return 0;
}
inline int scheme_get_unsigned_realint_val(Scheme_Object *o, unsigned int *v)
MZ_INLINE int scheme_get_unsigned_realint_val(Scheme_Object *o, unsigned int *v)
{
if (SCHEME_INTP(o)) {
uintptr_t lv = SCHEME_INT_VAL(o);

4
src/foreign/foreign.rktc
View File

@ -345,7 +345,7 @@ THREAD_LOCAL_DECL(static Scheme_Hash_Table *opened_libs);
/* These will make sense in Racket when longs are longer than ints (needed
* for libffi's int32 types). There is no need to deal with bignums because
* mzscheme's fixnums are longs. */
inline int scheme_get_realint_val(Scheme_Object *o, int *v)
MZ_INLINE int scheme_get_realint_val(Scheme_Object *o, int *v)
{
if (SCHEME_INTP(o)) {
uintptr_t lv = SCHEME_INT_VAL(o);
@ -356,7 +356,7 @@ inline int scheme_get_realint_val(Scheme_Object *o, int *v)
return 1;
} else return 0;
}
inline int scheme_get_unsigned_realint_val(Scheme_Object *o, unsigned int *v)
MZ_INLINE int scheme_get_unsigned_realint_val(Scheme_Object *o, unsigned int *v)
{
if (SCHEME_INTP(o)) {
uintptr_t lv = SCHEME_INT_VAL(o);

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

@ -486,7 +486,7 @@ GC2_EXTERN void GC_adopt_message_allocator(void *msg_memory);
#endif
/* Macros (implementation-specific): */
#ifdef __x86_64__
#if defined(__x86_64__) || defined(_WIN64)
# define gcLOG_WORD_SIZE 3
#else
# define gcLOG_WORD_SIZE 2

4
src/racket/gc2/newgc.c
View File

@ -600,6 +600,10 @@ int GC_is_allocated(void *p)
/* Allocation */
/*****************************************************************************/
#ifdef _WIN64
# define GC_ALIGN_SIXTEEN
#endif
/* struct objhead is defined in gc2_obj.h */
/* Make sure alloction starts out double-word aligned.
The header on each allocated object is one word, so to make

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

@ -399,6 +399,7 @@ XFORM_GC_VARIABLE_STACK_THROUGH_FUNCTION;
# ifdef MZ_XFORM
START_XFORM_SKIP;
# endif
MZ_EXTERN Thread_Local_Variables *scheme_external_get_thread_local_variables();
static __inline Thread_Local_Variables *scheme_get_thread_local_variables() {
return scheme_external_get_thread_local_variables();
}

12
src/racket/src/error.c
View File

@ -1044,7 +1044,7 @@ static char *make_arity_expect_string(const char *name, int namelen,
if (arity_str) {
pos = scheme_sprintf(s, slen, "%t: expects %t, given %d",
name, namelen, arity_str, arity_len, xargc);
name, (intptr_t)namelen, arity_str, (intptr_t)arity_len, xargc);
} else if (minc < 0) {
const char *n;
int nlen;
@ -1061,20 +1061,20 @@ static char *make_arity_expect_string(const char *name, int namelen,
}
pos = scheme_sprintf(s, slen, "%t: no clause matching %d argument%s",
n, nlen,
n, (intptr_t)nlen,
xargc, xargc == 1 ? "" : "s");
} else if (!maxc)
pos = scheme_sprintf(s, slen, "%t: expects no arguments, given %d",
name, namelen, xargc);
name, (intptr_t)namelen, xargc);
else if (maxc < 0)
pos = scheme_sprintf(s, slen, "%t: expects at least %d argument%s, given %d",
name, namelen, xminc, (xminc == 1) ? "" : "s", xargc);
name, (intptr_t)namelen, xminc, (xminc == 1) ? "" : "s", xargc);
else if (minc == maxc)
pos = scheme_sprintf(s, slen, "%t: expects %d argument%s, given %d",
name, namelen, xminc, (xminc == 1) ? "" : "s", xargc);
name, (intptr_t)namelen, xminc, (xminc == 1) ? "" : "s", xargc);
else
pos = scheme_sprintf(s, slen, "%t: expects %d to %d arguments, given %d",
name, namelen, xminc, xmaxc, xargc);
name, (intptr_t)namelen, xminc, xmaxc, xargc);
if (xargc && argv) {
len /= xargc;

4
src/racket/src/fun.c
View File

@ -1881,10 +1881,10 @@ Scheme_Object *scheme_source_to_name(Scheme_Object *code)
}
if (cstx->srcloc->line >= 0) {
sprintf(buf, "%s%s%ld:%ld",
sprintf(buf, "%s%s%" PRINTF_INTPTR_SIZE_PREFIX "d:%" PRINTF_INTPTR_SIZE_PREFIX "d",
src, (src[0] ? ":" : ""), cstx->srcloc->line, cstx->srcloc->col - 1);
} else {
sprintf(buf, "%s%s%ld",
sprintf(buf, "%s%s%" PRINTF_INTPTR_SIZE_PREFIX "d",
src, (src[0] ? "::" : ""), cstx->srcloc->pos);
}

12
src/racket/src/read.c
View File

@ -1557,7 +1557,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
}
scheme_read_err(port, stxsrc, line, col, pos, fl, ch, indentation,
"read: bad input: `#%u'",
found, fl);
found, (intptr_t)fl);
return NULL;
}
break;
@ -1650,7 +1650,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
scheme_read_err(port, stxsrc, line, col, pos, SPAN(port, pos),
ch, indentation,
"read: bad syntax `#%c%u'",
orig_ch, a, cnt);
orig_ch, a, (intptr_t)cnt);
return NULL;
}
}
@ -1760,7 +1760,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
ch, indentation,
"read: bad syntax `#ha%5%u'",
str_part,
one_more, NOT_EOF_OR_SPECIAL(ch) ? 1 : 0);
one_more, (intptr_t)(NOT_EOF_OR_SPECIAL(ch) ? 1 : 0));
return NULL;
}
}
@ -3412,7 +3412,7 @@ read_here_string(Scheme_Object *port, Scheme_Object *stxsrc,
scheme_read_err(port, stxsrc, line, col, pos, MINSPAN(port, pos, init_span), EOF, indentation,
"read: found end-of-file before terminating %u%s",
tag,
(tlen > 50) ? 50 : tlen,
(intptr_t)((tlen > 50) ? 50 : tlen),
(tlen > 50) ? "..." : "");
return NULL;
}
@ -3950,7 +3950,7 @@ read_delimited_constant(int ch, const mzchar *str,
first_ch,
str_part,
one_more,
NOT_EOF_OR_SPECIAL(ch) ? 1 : 0);
(intptr_t)(NOT_EOF_OR_SPECIAL(ch) ? 1 : 0));
return NULL;
}
@ -4098,7 +4098,7 @@ read_character(Scheme_Object *port,
scheme_read_err(port, stxsrc, line, col, pos, count + 2, 0, indentation,
"read: bad character constant #\\%c%u",
(maxc == 4) ? 'u' : 'U',
nbuf, count);
nbuf, (intptr_t)count);
return NULL;
} else {
ch = n;

29
src/worksp/gc2/make.rkt
View File

@ -14,10 +14,15 @@
(define opt-flags "/O2 /Oy-")
(define re:only #f)
(unless (find-executable-path "cl.exe" #f)
(error (string-append
"Cannot find executable \"cl.exe\".\n"
"You may need to find and run \"vsvars32.bat\".")))
(define win64? (equal? "win32\\x86_64" (path->string (system-library-subpath #f))))
(define cl.exe
(let ([p (find-executable-path "cl.exe" #f)])
(unless p
(error (string-append
"Cannot find executable \"cl.exe\".\n"
"You may need to find and run \"vsvars32.bat\".")))
"cl.exe"))
(unless (directory-exists? "xsrc")
(make-directory "xsrc"))
@ -110,7 +115,8 @@
(list
"--depends"
"--cpp"
(format "cl.exe /MT /E ~a ~a ~a"
(format "~a /MT /E ~a ~a ~a"
cl.exe
common-cpp-defs
expand-extra-flags
includes)
@ -139,14 +145,14 @@
(check-timestamp t2 f)
(>= t t2)))
deps))))
(unless (system- (format "cl.exe ~a /MT /Zi ~a /c ~a /Fdxsrc/ /Fo~a" flags opt-flags c o))
(unless (system- (format "~a ~a /MT /Zi ~a /c ~a /Fdxsrc/ /Fo~a" cl.exe flags opt-flags c o))
(error "failed compile"))))
(define common-deps (list "../../racket/gc2/xform.rkt"
"../../racket/gc2/xform-mod.rkt"))
(define (find-obj f d) (format "../~a/release/~a.obj" d f))
(define (find-lib f d) (format "../~a/release/~a.lib" d f))
(define (find-obj f d) (format "../~a/~arelease/~a.obj" d (if win64? "x64/" "") f))
(define (find-lib f d) (format "../~a/~arelease/~a.lib" d (if win64? "x64/" "") f))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -247,8 +253,10 @@
(> (file-or-directory-modify-seconds f)
ms))
objs)
(unless (system- (format "cl.exe ~a /MT /Zi /Fe~a ~a ~a /link ~a~a~a"
(unless (system- (format "~a ~a ~a /MT /Zi /Fe~a ~a ~a /link ~a~a~a"
cl.exe
(if exe? "" "/LD /DLL")
(if win64? "/MACHINE:x64" "")
dll
(let loop ([objs (append objs sys-libs)])
(if (null? objs)
@ -338,7 +346,8 @@
"../../../GRacket.exe" " /subsystem:windows" #t))
(system- "mt.exe -manifest ../../../GRacket.exe.manifest -outputresource:../../../GRacket.exe;1")
(system- "cl.exe /MT /O2 /DMZ_PRECISE_GC /I../../racket/include /I.. /c ../../racket/dynsrc/mzdyn.c /Fomzdyn3m.obj")
(system- (format "~a /MT /O2 /DMZ_PRECISE_GC /I../../racket/include /I.. /c ../../racket/dynsrc/mzdyn.c /Fomzdyn3m.obj"
cl.exe))
(system- "lib.exe -def:../../racket/dynsrc/mzdyn.def -out:mzdyn3m.lib")
(define (copy-file/diff src dest)

4
src/worksp/mzconfig.h
View File

@ -25,6 +25,10 @@
/* The size of a `long long', as computed by sizeof. */
#undef SIZEOF_LONG_LONG
#ifdef _WIN64
# define SIZEOF_VOID_P 8
#endif
/* Direction of stack growth: 1 = up, -1 = down, 0 = unknown */
#define STACK_DIRECTION -1