From 55b54f920d52e0d6b41105bdf98c7064516dd4c3 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Fri, 11 Dec 2009 08:50:42 +0000 Subject: [PATCH 1/6] Welcome to a new PLT day. svn: r17266 --- collects/repos-time-stamp/stamp.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss index 801889843f..4993a345d1 100644 --- a/collects/repos-time-stamp/stamp.ss +++ b/collects/repos-time-stamp/stamp.ss @@ -1 +1 @@ -#lang scheme/base (provide stamp) (define stamp "10dec2009") +#lang scheme/base (provide stamp) (define stamp "11dec2009") From fb67e2610b1307c1d0e8cc5a76aa58f022c94cb9 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 11 Dec 2009 12:49:46 +0000 Subject: [PATCH 2/6] adjust large-file-support flag handling svn: r17267 --- src/configure | 2 +- src/mzscheme/configure.ac | 2 +- src/mzscheme/src/jit.c | 7 +++---- 3 files changed, 5 insertions(+), 6 deletions(-) diff --git a/src/configure b/src/configure index 408c45f899..b0acdacae6 100755 --- a/src/configure +++ b/src/configure @@ -7100,7 +7100,7 @@ fi LFS_CFLAGS=`getconf LFS_CFLAGS 2> /dev/null` if test "${LFS_CFLAGS}" != "" ; then echo "Large-file support: ${LFS_CFLAGS}" - PREFLAGS="${PREFLAGS} ${LFS_CFLAGS}" + MZOPTIONS="${MZOPTIONS} ${LFS_CFLAGS}" fi ###### Get data sizes, stack direction, and endianness ####### diff --git a/src/mzscheme/configure.ac b/src/mzscheme/configure.ac index ded0b82323..266010fb79 100644 --- a/src/mzscheme/configure.ac +++ b/src/mzscheme/configure.ac @@ -914,7 +914,7 @@ fi LFS_CFLAGS=`getconf LFS_CFLAGS 2> /dev/null` if test "${LFS_CFLAGS}" != "" ; then echo "Large-file support: ${LFS_CFLAGS}" - PREFLAGS="${PREFLAGS} ${LFS_CFLAGS}" + MZOPTIONS="${MZOPTIONS} ${LFS_CFLAGS}" fi ###### Get data sizes, stack direction, and endianness ####### diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c index dbe1c4d715..45ad3125c6 100644 --- a/src/mzscheme/src/jit.c +++ b/src/mzscheme/src/jit.c @@ -2251,9 +2251,9 @@ static void ts_on_demand(void) XFORM_SKIP_PROC #ifdef MZ_PRECISE_GC static void *ts_prepare_retry_alloc(void *p, void *p2) XFORM_SKIP_PROC { - unsigned long ret; - if (scheme_use_rtcall) { + unsigned long ret; + jit_future_storage[0] = p; jit_future_storage[1] = p2; ret = scheme_rtcall_alloc("[acquire_gc_page]", FSRC_OTHER); @@ -2265,8 +2265,7 @@ static void *ts_prepare_retry_alloc(void *p, void *p2) XFORM_SKIP_PROC return p; } - ret = prepare_retry_alloc(p, p2); - return ret; + return prepare_retry_alloc(p, p2); } #endif From 0c03246daa30d6814ede401b0cba4be2ceb89a15 Mon Sep 17 00:00:00 2001 From: Mike Sperber Date: Fri, 11 Dec 2009 16:50:58 +0000 Subject: [PATCH 3/6] Fix xref. svn: r17268 --- collects/scribblings/reference/exns.scrbl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/collects/scribblings/reference/exns.scrbl b/collects/scribblings/reference/exns.scrbl index 9fc843868b..3fa43ac68f 100644 --- a/collects/scribblings/reference/exns.scrbl +++ b/collects/scribblings/reference/exns.scrbl @@ -57,7 +57,7 @@ exception handler obtains control, and the handler itself is @defproc*[([(error [sym symbol?]) any] [(error [msg string?][v any/c] ...) any] - [(error [src symbol?][format string?][v any/c] ...) any])]{ + [(error [src symbol?][frmat string?][v any/c] ...) any])]{ Raises the exception @scheme[exn:fail], which contains an error string. The different forms produce the error string in different @@ -74,11 +74,11 @@ ways: @scheme[error-value->string-handler]). A space is inserted before each @scheme[v].} - @item{@scheme[(error src format v ...)] creates a + @item{@scheme[(error src frmat v ...)] creates a message string equivalent to the string created by @schemeblock[ - (format (string-append "~s: " format) src v ...) + (format (string-append "~s: " frmat) src v ...) ]} ] From 4f140eed0363df64ccc3a119168661e91ac45d9c Mon Sep 17 00:00:00 2001 From: Casey Klein Date: Fri, 11 Dec 2009 20:54:32 +0000 Subject: [PATCH 4/6] Metafunctions now respect caching-enabled? and set-cache-size!. svn: r17271 --- collects/redex/private/matcher.ss | 1 + collects/redex/private/reduction-semantics.ss | 14 ++++++-- collects/redex/redex.scrbl | 33 +++++++------------ 3 files changed, 24 insertions(+), 24 deletions(-) diff --git a/collects/redex/private/matcher.ss b/collects/redex/private/matcher.ss index 6e9a2beff3..c3f00cca55 100644 --- a/collects/redex/private/matcher.ss +++ b/collects/redex/private/matcher.ss @@ -1592,6 +1592,7 @@ before the pattern compiler is invoked. compiled-pattern?)) (set-cache-size! (-> (and/c integer? positive?) void?)) + (cache-size (and/c integer? positive?)) (make-bindings ((listof bind?) . -> . bindings?)) (bindings-table (bindings? . -> . (listof bind?))) diff --git a/collects/redex/private/reduction-semantics.ss b/collects/redex/private/reduction-semantics.ss index c082c6546d..4fdca8fbfd 100644 --- a/collects/redex/private/reduction-semantics.ss +++ b/collects/redex/private/reduction-semantics.ss @@ -1425,7 +1425,15 @@ (values (wrap (letrec ([cache (make-hash)] + [cache-entries 0] [not-in-cache (gensym)] + [cache-result (λ (arg res case) + (when (caching-enabled?) + (when (>= cache-entries cache-size) + (set! cache (make-hash)) + (set! cache-entries 0)) + (hash-set! cache arg (cons res case)) + (set! cache-entries (add1 cache-entries))))] [log-coverage (λ (id) (when id (for-each @@ -1452,7 +1460,7 @@ [(null? cases) (if relation? (begin - (hash-set! cache exp (cons #f #f)) + (cache-result exp #f #f) #f) (redex-error name "no clauses matched for ~s" `(,name . ,exp)))] [else @@ -1470,7 +1478,7 @@ (redex-error name "codomain test failed for ~s, call was ~s" ans `(,name ,@exp))) (cond [ans - (hash-set! cache exp (cons #t id)) + (cache-result exp #t id) (log-coverage id) #t] [else @@ -1499,7 +1507,7 @@ "codomain test failed for ~s, call was ~s" ans `(,name ,@exp))) - (hash-set! cache exp (cons ans id)) + (cache-result exp ans id) (log-coverage id) ans)]))])))]))] [else diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl index f53615be1c..7d99f20667 100644 --- a/collects/redex/redex.scrbl +++ b/collects/redex/redex.scrbl @@ -369,28 +369,19 @@ clause is followed by an ellipsis. Nested ellipses produce nested lists. } -@defproc[(set-cache-size! [size positive-integer?]) void?]{ - -Changes the cache size; the default size is @scheme[350]. - -The cache is per-pattern (ie, each pattern has a cache of size at most -350 (by default)) and is a simple table that maps expressions to how -they matched the pattern (ie, the bindings for the pattern -variables). When the cache gets full, it is thrown away and a new -cache is started. +@defparam[caching-enabled? on? boolean?]{ + When this parameter is @scheme[#t] (the default), Redex caches the results of + pattern matching and metafunction evaluation. There is a separate cache for + each pattern and metafunction; when one fills (see @scheme[set-cache-size!]), + Redex evicts all of the entries in that cache. + + Caching should be disabled when matching a pattern that depends on values + other than the in-scope pattern variables or evaluating a metafunction + that reads or writes mutable external state. } -@defparam[caching-enabled? on? boolean?]{ - This is a parameter that controls whether or not a cache - is consulted (and updated) while matching and while evaluating - metafunctions. - - If it is @scheme[#t], then side-conditions and the right-hand sides - of metafunctions are assumed to only depend on the values of the - pattern variables in scope (and thus not on any other external - state). - - Defaults to @scheme[#t]. +@defproc[(set-cache-size! [size positive-integer?]) void?]{ +Changes the size of the per-pattern and per-metafunction caches. The default size is @scheme[350]. } @section{Terms} @@ -921,7 +912,7 @@ or if the contract is violated. Note that metafunctions are assumed to always return the same results for the same inputs, and their results are cached, unless -@scheme[caching-enable?] is set to @scheme[#f]. Accordingly, if a +@scheme[caching-enabled?] is set to @scheme[#f]. Accordingly, if a metafunction is called with the same inputs twice, then its body is only evaluated a single time. From ea1929841bc2be93f9a3b9115ef62684f0786629 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 12 Dec 2009 03:18:24 +0000 Subject: [PATCH 5/6] fix and adjust inlining metric svn: r17274 --- src/mzscheme/src/env.c | 2 +- src/mzscheme/src/eval.c | 14 +++++++++----- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index 1eb4d678ce..c5425e5b0e 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -3166,7 +3166,7 @@ Optimize_Info *scheme_optimize_info_create() #ifdef MZTAG_REQUIRED info->type = scheme_rt_optimize_info; #endif - info->inline_fuel = 16; + info->inline_fuel = 32; return info; } diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 08725e0da4..a38d1db5aa 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -2552,14 +2552,14 @@ static Scheme_Object *optimize_application(Scheme_Object *o, Optimize_Info *info all_vals = 0; } + info->size += 1; + if (all_vals) { le = try_optimize_fold(app->args[0], (Scheme_Object *)app, info); if (le) return le; } - info->size += 1; - info->preserves_marks = !!(rator_flags & CLOS_PRESERVES_MARKS); info->single_result = !!(rator_flags & CLOS_SINGLE_RESULT); if (rator_flags & CLOS_RESULT_TENTATIVE) { @@ -2723,14 +2723,14 @@ static Scheme_Object *optimize_application3(Scheme_Object *o, Optimize_Info *inf /* Fold or continue */ + info->size += 1; + if (all_vals) { le = try_optimize_fold(app->rator, (Scheme_Object *)app, info); if (le) return le; } - info->size += 1; - /* Check for (call-with-values (lambda () M) N): */ if (SAME_OBJ(app->rator, scheme_call_with_values_proc)) { if (SAME_TYPE(SCHEME_TYPE(app->rand1), scheme_compiled_unclosed_procedure_type)) { @@ -3154,8 +3154,10 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info) val = scheme_optimize_info_lookup(info, pos, NULL, NULL); if (val) { - if (SAME_TYPE(SCHEME_TYPE(val), scheme_compiled_toplevel_type)) + if (SAME_TYPE(SCHEME_TYPE(val), scheme_compiled_toplevel_type)) { + info->size -= 1; return scheme_optimize_expr(val, info); + } return val; } @@ -3189,6 +3191,7 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info) case scheme_compiled_let_void_type: return scheme_optimize_lets(expr, info, 0); case scheme_compiled_toplevel_type: + info->size += 1; if (info->top_level_consts) { int pos; Scheme_Object *c; @@ -3226,6 +3229,7 @@ Scheme_Object *scheme_optimize_expr(Scheme_Object *expr, Optimize_Info *info) scheme_optimize_info_used_top(info); return expr; case scheme_compiled_quote_syntax_type: + info->size += 1; scheme_optimize_info_used_top(info); return expr; case scheme_variable_type: From 002cfcc2d81c6008afe0644987521431a3702b87 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sat, 12 Dec 2009 08:50:36 +0000 Subject: [PATCH 6/6] Welcome to a new PLT day. svn: r17275 --- collects/repos-time-stamp/stamp.ss | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss index 4993a345d1..a5a0911d84 100644 --- a/collects/repos-time-stamp/stamp.ss +++ b/collects/repos-time-stamp/stamp.ss @@ -1 +1 @@ -#lang scheme/base (provide stamp) (define stamp "11dec2009") +#lang scheme/base (provide stamp) (define stamp "12dec2009")