diff --git a/collects/compiler/decompile.ss b/collects/compiler/decompile.ss
index aa851a4052..5f1248b43e 100644
--- a/collects/compiler/decompile.ss
+++ b/collects/compiler/decompile.ss
@@ -75,7 +75,9 @@
                 (if (null? stx-ids) null '(#%stx-array))
                 lift-ids)
                (map (lambda (stx id)
-                      `(define ,id (#%decode-syntax ,(stx-encoded stx))))
+                      `(define ,id ,(if stx
+                                        `(#%decode-syntax ,(stx-encoded stx))
+                                        #f)))
                     stxs stx-ids)))]
     [else (error 'decompile-prefix "huh?: ~e" a-prefix)]))
 
@@ -304,7 +306,8 @@
                                       + - * / min max bitwise-and bitwise-ior
                                       arithmetic-shift vector-ref string-ref bytes-ref
                                       set-mcar! set-mcdr! cons mcons))]
-             [(4) (memq (car a) '(vector-set! string-set! bytes-set!))]))
+             [(4) (memq (car a) '(vector-set! string-set! bytes-set!))]
+             [else #f]))
       (cons '#%in a)
       a))
 
diff --git a/collects/compiler/zo-parse.ss b/collects/compiler/zo-parse.ss
index f73b98d2ce..29b7b76f5b 100644
--- a/collects/compiler/zo-parse.ss
+++ b/collects/compiler/zo-parse.ss
@@ -306,7 +306,7 @@
   ;; not sure if it's really unsigned
   (integer-bytes->integer (read-bytes 4 p) #f #f))
 
-(define-struct cport ([pos #:mutable] orig-port size bytes symtab shared-offsets decoded rns))
+(define-struct cport ([pos #:mutable] orig-port size bytes symtab shared-offsets decoded rns mpis))
 
 (define (cp-getc cp)
   (begin-with-definitions
@@ -430,6 +430,11 @@
 ;; Synatx unmarshaling
 
 (define-form-struct wrapped (datum wraps certs))
+(define-form-struct lexical-rename (alist))
+(define-form-struct phase-shift (amt src dest))
+(define-form-struct module-rename (phase kind set-id unmarshals renames mark-renames plus-kern?))
+(define-form-struct all-from-module (path phase src-phase exceptions prefix))
+(define-form-struct module-binding (path mod-phase import-phase id nominal-path nominal-phase nominal-id))
 
 (define (decode-stx cp v)
   (if (integer? v)
@@ -515,15 +520,107 @@
                  ;; a mark
                  (string->symbol (format "mark~a" (car a)))]
                 [(vector? a)
-                 `(#%decode-lexical-rename ,a)]
+                 (make-lexical-rename
+                  (let ([top (+ (/ (- (vector-length a) 2) 2) 2)])
+                    (let loop ([i 2])
+                      (if (= i top)
+                          null
+                          (cons (cons (vector-ref a i)
+                                      (vector-ref a (+ (- top 2) i)))
+                                (loop (+ i 1)))))))]
                 [(pair? a)
-                 `(#%decode-module-rename ,a)]
+                 (let-values ([(plus-kern? a) (if (eq? (car a) #t)
+                                                  (values #t (cdr a))
+                                                  (values #f a))])
+                   (match a
+                     [`(,phase ,kind ,set-id ,maybe-unmarshals . ,renames)
+                      (let-values ([(unmarshals renames mark-renames)
+                                    (if (vector? maybe-unmarshals)
+                                        (values null maybe-unmarshals renames)
+                                        (values maybe-unmarshals
+                                                (car renames)
+                                                (cdr renames)))])
+                        (make-module-rename phase 
+                                            (if kind 'marked 'normal)
+                                            set-id
+                                            (map (lambda (u)
+                                                   (let ([just-phase? (number? (cddr u))])
+                                                     (let-values ([(exns prefix)
+                                                                   (if just-phase?
+                                                                       (values null #f)
+                                                                       (let loop ([u (if just-phase? null (cdddr u))]
+                                                                                  [a null])
+                                                                         (if (pair? u)
+                                                                             (loop (cdr u) (cons (car u) a))
+                                                                             (values (reverse a) u))))])
+                                                       (make-all-from-module
+                                                        (parse-module-path-index cp (car u))
+                                                        (cadr u)
+                                                        (if just-phase?
+                                                            (cddr u)
+                                                            (caddr u))
+                                                        exns
+                                                        prefix))))
+                                                 unmarshals)
+                                            (let loop ([i 0])
+                                              (if (= i (vector-length renames))
+                                                  null
+                                                  (cons
+                                                   (let ([key (vector-ref renames i)]
+                                                         [make-mapping
+                                                          (lambda (path mod-phase import-phase id nominal-path nominal-phase nominal-id)
+                                                            (make-module-binding
+                                                             (parse-module-path-index cp path)
+                                                             mod-phase
+                                                             import-phase 
+                                                             id 
+                                                             (parse-module-path-index cp nominal-path)
+                                                             nominal-phase 
+                                                             (if (eq? id nominal-id) #t nominal-id)))])
+                                                     (cons key
+                                                           (let ([m (vector-ref renames (add1 i))]
+                                                                 [parse-nominal-modidx-plus-phase
+                                                                  (lambda (modidx mod-phase exportname nominal-modidx-plus-phase nom-exportname)
+                                                                    (match nominal-modidx-plus-phase
+                                                                      [`(,nominal-modidx ,import-phase-plus-nominal-phase)
+                                                                       (match import-phase-plus-nominal-phase
+                                                                         [`(,import-phase ,nom-phase)
+                                                                          (make-mapping modidx mod-phase import-phase exportname
+                                                                                        nominal-modidx nom-phase nom-exportname)]
+                                                                         [import-phase
+                                                                          (make-mapping modidx mod-phase import-phase exportname
+                                                                                        modidx mod-phase nom-exportname)])]
+                                                                      [nominal-modidx
+                                                                       (make-mapping modidx mod-phase '* exportname
+                                                                                     nominal-modidx mod-phase nom-exportname)]))])
+                                                             (match m
+                                                               [`(,modidx ,mod-phase ,exportname ,nominal-modidx-plus-phase . ,nominal-exportname)
+                                                                (parse-nominal-modidx-plus-phase modidx mod-phase exportname 
+                                                                                                 nominal-modidx-plus-phase nominal-exportname)]
+                                                               [`(,modidx ,exportname ,nominal-modidx-plus-phase . ,nominal-exportname)
+                                                                (parse-nominal-modidx-plus-phase modidx '* exportname 
+                                                                                                 nominal-modidx-plus-phase nominal-exportname)]
+                                                               [`(,modidx ,nominal-modidx)
+                                                                (make-mapping modidx '* '* key nominal-modidx '* key)]
+                                                               [`(,modidx ,exportname)
+                                                                (make-mapping modidx '* '* exportname modidx '* exportname)]
+                                                               [modidx
+                                                                (make-mapping modidx '* '* key modidx '* key)]))))
+                                                   (loop (+ i 2)))))
+                                            mark-renames
+                                            (and plus-kern? 'plus-kern)))]
+                     [else (error "bad module rename: ~e" a)]))]
                 [(boolean? a)
                  `(#%top-level-rename ,a)]
                 [(symbol? a)
                  '(#%mark-barrier)]
                 [(box? a)
-                 `(#%phase-shift ,(unbox a))]
+                 (match (unbox a)
+                   [`#(,amt ,src ,dest #f)
+                    (make-phase-shift amt 
+                                      (parse-module-path-index cp src)
+                                      (parse-module-path-index cp dest))]
+                   [else (error 'parse "bad phase shift: ~e" a)])]
                 [else (error 'decode-wraps "bad wrap element: ~e" a)])))
            w)))
 
@@ -544,6 +641,20 @@
   (vector-set! (cport-symtab cp) pos v)
   (vector-set! (cport-decoded cp) pos #t))
 
+(define (parse-module-path-index cp s)
+  (cond
+   [(not s) #f]
+   [(module-path-index? s)
+    (hash-ref (cport-mpis cp) s
+              (lambda ()
+                (let-values ([(name base) (module-path-index-split s)])
+                  (let ([v `(module-path-index-join
+                             (quote ,name)
+                             ,(parse-module-path-index cp base))])
+                    (hash-set! (cport-mpis cp) s v)
+                    v))))]
+   [else `(quote ,s)]))
+
 ;; ----------------------------------------
 ;; Main parsing loop
 
@@ -784,7 +895,7 @@
 
    (define symtab (make-vector symtabsize (make-not-ready)))
 
-   (define cp (make-cport 0 port size* rst symtab so* (make-vector symtabsize #f) (make-hash)))
+   (define cp (make-cport 0 port size* rst symtab so* (make-vector symtabsize #f) (make-hash) (make-hash)))
    (for/list ([i (in-range 1 symtabsize)])
      (when (not-ready? (vector-ref symtab i))
        (set-cport-pos! cp (vector-ref so* (sub1 i)))
diff --git a/collects/drscheme/private/language.ss b/collects/drscheme/private/language.ss
index 9e5228a149..1e282e30e5 100644
--- a/collects/drscheme/private/language.ss
+++ b/collects/drscheme/private/language.ss
@@ -1086,7 +1086,9 @@
      (λ ()
        (with-handlers ([(λ (x) #t)
                         (λ (x)
-                          (display (exn-message x))
+                          (display (if (exn? x) 
+                                       (exn-message x) 
+                                       (format "~s" x)))
                           (newline))])
          (when module-spec
            (if use-copy?
diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss
index cabd4c33a1..c49bb2fda4 100644
--- a/collects/drscheme/private/rep.ss
+++ b/collects/drscheme/private/rep.ss
@@ -323,6 +323,26 @@ TODO
   
   (define setup-scheme-interaction-mode-keymap
     (λ (keymap)
+      (define (beginning-of-line text select?)
+        (let* ([para (send text position-line (send text get-start-position))]
+               [para-start (send text line-start-position para)]
+               [prompt (send text get-prompt)]
+               [para-start-text (send text get-text para-start (+ para-start (string-length prompt)))]
+               [new-start 
+                (cond
+                  [(equal? prompt para-start-text)
+                   (+ para-start (string-length prompt))]
+                  [else
+                   para-start])])
+          (if select?
+              (send text set-position new-start (send text get-end-position))
+              (send text set-position new-start new-start))))
+      
+      (send keymap add-function "beginning-of-line/prompt"
+            (λ (text event) (beginning-of-line text #f)))
+      (send keymap add-function "select-to-beginning-of-line/prompt"
+            (λ (text event) (beginning-of-line text #t)))
+      
       (send keymap add-function "put-previous-sexp"
             (λ (text event) 
               (send text copy-prev-previous-expr)))
@@ -330,6 +350,11 @@ TODO
             (λ (text event) 
               (send text copy-next-previous-expr)))
       
+      (send keymap map-function "c:a" "beginning-of-line/prompt")
+      (send keymap map-function "s:c:a" "select-to-beginning-of-line/prompt")
+      (send keymap map-function "home" "beginning-of-line/prompt")
+      (send keymap map-function "s:home" "select-to-beginning-of-line/prompt")
+      
       (keymap:send-map-function-meta keymap "p" "put-previous-sexp")
       (keymap:send-map-function-meta keymap "n" "put-next-sexp")
       (send keymap map-function "c:up" "put-previous-sexp")
diff --git a/collects/lang/htdp-langs.ss b/collects/lang/htdp-langs.ss
index 82004b4038..0dc74efd39 100644
--- a/collects/lang/htdp-langs.ss
+++ b/collects/lang/htdp-langs.ss
@@ -167,8 +167,7 @@
                  (namespace-require scheme-test-module-name)
                  (scheme-test-data (list (drscheme:rep:current-rep) drs-eventspace test-display%))
                  (test-execute (get-preference 'tests:enable? (lambda () #t)))
-                 (test-format (make-formatter (lambda (v o) (render-value/format v settings o 40))))
-                 )))
+                 (test-format (make-formatter (lambda (v o) (render-value/format v settings o 40)))))))
             (super on-execute settings run-in-user-thread))
           
           (define/private (teaching-languages-error-value->string settings v len)
@@ -1034,22 +1033,19 @@
             (thread-cell-set! current-test-coverage-info ht)
             (let ([rep (drscheme:rep:current-rep)])
               (when rep
-                (let ([s (make-semaphore 0)])
-                  (parameterize ([current-eventspace drs-eventspace])
-                    (queue-callback
-                     (λ ()
-                       (let ([on-sd (make-object style-delta%)]
-                             [off-sd (make-object style-delta%)])
-                         (cond
-                           [(preferences:get 'framework:white-on-black?)
-                            (send on-sd set-delta-foreground "white")
-                            (send off-sd set-delta-foreground "indianred")]
-                           [else
-                            (send on-sd set-delta-foreground "black")
-                            (send off-sd set-delta-foreground "firebrick")])
-                         (send rep set-test-coverage-info ht on-sd off-sd #f))
-                       (semaphore-post s))))
-                  (semaphore-wait s))))))
+                (parameterize ([current-eventspace drs-eventspace])
+                  (queue-callback
+                   (λ ()
+                     (let ([on-sd (make-object style-delta%)]
+                           [off-sd (make-object style-delta%)])
+                       (cond
+                         [(preferences:get 'framework:white-on-black?)
+                          (send on-sd set-delta-foreground "white")
+                          (send off-sd set-delta-foreground "indianred")]
+                         [else
+                          (send on-sd set-delta-foreground "black")
+                          (send off-sd set-delta-foreground "firebrick")])
+                       (send rep set-test-coverage-info ht on-sd off-sd #f)))))))))
         (let ([ht (thread-cell-ref current-test-coverage-info)])
           (when ht
             (hash-set! ht key (mcons #f expr)))))
@@ -1124,7 +1120,7 @@
                (lambda (exp)
                  (let* ([is-compiled? (compiled-expression? (if (syntax? exp) (syntax-e exp) exp))]
                         [annotated
-                         (if is-compiled?
+                         (if is-compiled? 
                              exp
                              (let* ([et-annotated (et:annotate-top (expand exp) 
                                                                    (namespace-base-phase))]
diff --git a/collects/lang/private/beginner-funs.ss b/collects/lang/private/beginner-funs.ss
index 9c44f36b8d..e00dd65ea9 100644
--- a/collects/lang/private/beginner-funs.ss
+++ b/collects/lang/private/beginner-funs.ss
@@ -304,32 +304,32 @@
     ("Characters"
       (char? (any -> boolean)
 	"to determine whether a value is a character")
-      (char=? (char char ... -> boolean)
+      (char=? (char char char ... -> boolean)
 	"to determine whether two characters are equal")
-      (char<? (char char ... -> boolean)
+      (char<? (char char char ... -> boolean)
 	"to determine whether a character precedes another")
-      (char>? (char char ... -> boolean)
+      (char>? (char char char ... -> boolean)
 	"to determine whether a character succeeds another")
-      (char<=? (char char ... -> boolean)
+      (char<=? (char char char ... -> boolean)
 	"to determine whether a character precedes another"
 	" (or is equal to it)")
-      (char>=? (char char ... -> boolean)
+      (char>=? (char char char ... -> boolean)
 	"to determine whether a character succeeds another"
 	" (or is equal to it)")
     
-      (char-ci=? (char char ... -> boolean)
+      (char-ci=? (char char char ... -> boolean)
 	"to determine whether two characters are equal"
 	" in a case-insensitive manner")
-      (char-ci<? (char char ... -> boolean)
+      (char-ci<? (char char char ... -> boolean)
 	"to determine whether a character precedes another"
 	" in a case-insensitive manner")
-      (char-ci>? (char char ... -> boolean)
+      (char-ci>? (char char char ... -> boolean)
 	"to determine whether a character succeeds another"
 	" in a case-insensitive manner")
-      (char-ci<=? (char char ... -> boolean)
+      (char-ci<=? (char char char ... -> boolean)
 	"to determine whether a character precedes another"
 	" (or is equal to it) in a case-insensitive manner")
-      (char-ci>=? (char char ... -> boolean)
+      (char-ci>=? (char char char ... -> boolean)
 	"to determine whether a character succeeds another"
 	" (or is equal to it) in a case-insensitive manner")
     
diff --git a/collects/lang/private/contracts/contracts-module-begin.ss b/collects/lang/private/contracts/contracts-module-begin.ss
index ac2c2764a5..637a1834a2 100644
--- a/collects/lang/private/contracts/contracts-module-begin.ss
+++ b/collects/lang/private/contracts/contracts-module-begin.ss
@@ -144,7 +144,7 @@
               [_ (raise-syntax-error 'contract "internal error.5")])))
 	
 	(define local-expand-stop-list 
-          (list 'contract 'define-values 'define-syntaxes '#%require
+          (list 'contract 'define-values 'define-syntaxes 'define-values-for-syntax '#%require
                 '#%provide 'define-data '#%app '#%datum 'define-struct 'begin 'begin0))
 	
 	;; parse-contract-expressions 
diff --git a/collects/mzlib/pretty.ss b/collects/mzlib/pretty.ss
index c860882047..ca90839973 100644
--- a/collects/mzlib/pretty.ss
+++ b/collects/mzlib/pretty.ss
@@ -1088,11 +1088,13 @@
 
        (define max-call-head-width 5)
 
-       (define (no-sharing? expr count acdr)
-         (if (and found (hash-table-get found (acdr expr) #f))
+       (define (no-sharing? expr count apair? acdr)
+         (if (and found 
+                  (apair? expr)
+                  (hash-table-get found (acdr expr) #f))
              #f
              (or (zero? count)
-                 (no-sharing? (acdr expr) (sub1 count) acdr))))
+                 (no-sharing? (acdr expr) (sub1 count) apair? acdr))))
 
        (define (style head expr apair? acar acdr)
          (case (look-in-style-table head)
@@ -1100,22 +1102,22 @@
 		    syntax-rules
 		    shared
 		    unless when)
-            (and (no-sharing? expr 1 acdr)
+            (and (no-sharing? expr 1 apair? acdr)
                  pp-lambda))
 	   ((if set! set!-values)
-            (and (no-sharing? expr 1 acdr)
+            (and (no-sharing? expr 1 apair? acdr)
                  pp-if))
 	   ((cond case-lambda)
-            (and (no-sharing? expr 0 acdr)
+            (and (no-sharing? expr 0 apair? acdr)
                  pp-cond))
 	   ((case class) 
-            (and (no-sharing? expr 1 acdr)
+            (and (no-sharing? expr 1 apair? acdr)
                  pp-case))
 	   ((and or import export 
 		 require require-for-syntax require-for-template 
 		 provide link
 		 public private override rename inherit field init)
-            (and (no-sharing? expr 0 acdr)
+            (and (no-sharing? expr 0 apair? acdr)
                  pp-and))
 	   ((let letrec let*
 	      let-values letrec-values let*-values
@@ -1126,20 +1128,21 @@
                                        (symbol? (acar (acdr expr))))
                                   2
                                   1)
+                              apair?
                               acdr)
                  pp-let))
 	   ((begin begin0)
-            (and (no-sharing? expr 0 acdr)
+            (and (no-sharing? expr 0 apair? acdr)
                  pp-begin))
 	   ((do letrec-syntaxes+values)
-            (and (no-sharing? expr 2 acdr)
+            (and (no-sharing? expr 2 apair? acdr)
                  pp-do))
 
 	   ((send syntax-case instantiate module)
-            (and (no-sharing? expr 2 acdr)
+            (and (no-sharing? expr 2 apair? acdr)
                  pp-syntax-case))
 	   ((make-object)
-            (and (no-sharing? expr 1 acdr)
+            (and (no-sharing? expr 1 apair? acdr)
                  pp-make-object))
 
 	   (else #f)))
diff --git a/collects/redex/examples/omega.ss b/collects/redex/examples/omega.ss
index 30789b4705..7d947b55bc 100644
--- a/collects/redex/examples/omega.ss
+++ b/collects/redex/examples/omega.ss
@@ -20,15 +20,15 @@
 (define reductions
   (reduction-relation
    lang
-   (--> (in-hole c_1 (call/cc v_arg))
-        ,(term-let ([v (variable-not-in (term c_1) 'x)])
-           (term (in-hole c_1 (v_arg (lambda (v) (abort (in-hole c_1 v)))))))
-        call/cc)
-   (--> (in-hole c (abort e_1)) 
-        e_1
+   (--> (in-hole c (call/cc v))
+        (in-hole c (v (lambda (x) (abort (in-hole c x)))))
+        call/cc
+        (fresh x))
+   (--> (in-hole c (abort e)) 
+        e
         abort)
-   (--> (in-hole c_1 ((lambda (variable_x) e_body) v_arg))
-        (in-hole c_1 (subst (variable_x v_arg e_body)))
+   (--> (in-hole c ((lambda (x) e) v))
+        (in-hole c (subst (x v e)))
         βv)))
 
 (traces reductions '((lambda (x) (x x)) (lambda (x) (x x))))
diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss
index 9dc8c1106a..1b822b13f6 100644
--- a/collects/repos-time-stamp/stamp.ss
+++ b/collects/repos-time-stamp/stamp.ss
@@ -1 +1 @@
-#lang scheme/base (provide stamp) (define stamp "17oct2008")
+#lang scheme/base (provide stamp) (define stamp "21oct2008")
diff --git a/collects/scheme/private/contract.ss b/collects/scheme/private/contract.ss
index acff2e0640..8f94fde362 100644
--- a/collects/scheme/private/contract.ss
+++ b/collects/scheme/private/contract.ss
@@ -1646,6 +1646,7 @@ improve method arity mismatch contract violation error messages?
    (λ (x)
      (and (number? x)
           (integer? x)
+          (exact? x)
           (x . >= . 0)))))
 
 (define (integer-in start end)
diff --git a/collects/scribblings/guide/contracts-gotchas.scrbl b/collects/scribblings/guide/contracts-gotchas.scrbl
index 99d4203628..5064870eb0 100644
--- a/collects/scribblings/guide/contracts-gotchas.scrbl
+++ b/collects/scribblings/guide/contracts-gotchas.scrbl
@@ -1,12 +1,95 @@
 #lang scribble/doc
-@(require scribble/manual
+@(require scribble/manual 
           scribble/eval
+	  scheme/sandbox
           "guide-utils.ss"
           "contracts-utils.ss"
           (for-label scheme/contract))
 
 @title[#:tag "contracts-gotchas"]{Gotchas}
 
+@ctc-section{Contracts and @scheme[eq?]}
+
+As a general rule, adding a contract to a program should
+either leave the behavior of the program unchanged, or
+should signal a contract violation. And this is almost true
+for PLT Scheme contracts, with one exception: @scheme[eq?].
+
+The @scheme[eq?] procedure is designed to be fast and does
+not provide much in the way of guarantees, except that if it
+returns true, it means that the two values behave
+identically in all respects. Internally, this is implemented
+as pointer equality at a low-level so it exposes information
+about how PLT Scheme is implemented (and how contracts are
+implemented). 
+
+Contracts interact poorly with @scheme[eq?] because function
+contract checking is implemented internally as wrapper
+functions. For example, consider this module:
+@schememod[
+scheme
+
+(define (make-adder x)
+  (if (= 1 x)
+      add1
+      (lambda (y) (+ x 1))))
+(provide/contract [make-adder (-> number? (-> number? number?))])
+]
+
+It exports the @scheme[make-adder] function that is the usual curried
+addition function, except that it returns Scheme's @scheme[add1] when
+its input is @scheme[1].
+
+You might expect that
+@schemeblock[
+(eq? (make-adder 1)
+     (make-adder 1))
+]
+
+would return @scheme[#t], but it does not. If the contract were
+changed to @scheme[any/c] (or even @scheme[(-> number? any/c)]), then
+the @scheme[eq?] call would return @scheme[#t].
+
+Moral: do not use @scheme[eq?] on values that have contracts.
+
+@ctc-section{Defining recursive contracts}
+
+When defining a self-referential contract, it is natural to use
+@scheme[define]. For example, one might try to write a contract on
+streams like this:
+
+@(define e (make-base-eval))
+@(interaction-eval #:eval e (require scheme/contract))
+@interaction[
+  #:eval e
+(define stream/c
+ (promise/c
+  (or/c
+   null?
+   (cons/c number? stream/c))))
+]
+ 
+Unfortunately, this does not work because the value of
+@scheme[stream/c] is needed before it is defined. Put another way, all
+of the combinators evaluate their arguments eagerly, even thought the
+values that they accept do not.
+
+Instead, use 
+@schemeblock[
+(define stream/c
+ (promise/c
+  (or/c
+   null?
+   (cons/c 1
+           (recursive-contract stream/c)))))
+]
+
+The use of @scheme[recursive-contract] delays the evaluation of the
+identifier @scheme[stream/c] until after the contract is first
+checked, long enough to ensure that @scheme[stream/c] is defined.
+
+See also @ctc-link["lazy-contracts"].
+
 @ctc-section{Using @scheme[set!] to Assign to Variables Provided via @scheme[provide/contract]}
 
 The contract library assumes that variables exported via
@@ -50,34 +133,5 @@ scheme
                   [get-x (-> integer?)])
 ]
 
-This is a bug we hope to address in a future release.
-@;{
-@question{Contracts and @scheme[eq?]}
+Moral: This is a bug we hope to address in a future release.
 
-As a general rule, adding a contract to a program should
-either leave the behavior of the program unchanged, or
-should signal a contract violation. And this is almost true
-for PLT Scheme contracts, with one exception: @scheme[eq?].
-
-The @scheme[eq?] procedure is designed to be fast and does
-not provide much in the way of guarantees, except that if it
-returns true, it means that the two values behave
-identically in all respects. Internally, this is implemented
-as pointer equality at a low-level so it exposes information
-about how PLT Scheme is implemented (and how contracts are
-implemented). 
-
-Contracts interact poorly with @scheme[eq?] because function
-contract checking is implemented internally as wrapper
-functions. For example, consider this module:
-@schememod[
-scheme
-
-(define (make-adder ))
-(provide make-adder)
-
-(provide/contract [make-adder (-> number? (-> number? number?))])
-]
-
-
-}
diff --git a/collects/scribblings/guide/contracts-intro.scrbl b/collects/scribblings/guide/contracts-intro.scrbl
index 4fc42f0ce5..bcef700631 100644
--- a/collects/scribblings/guide/contracts-intro.scrbl
+++ b/collects/scribblings/guide/contracts-intro.scrbl
@@ -193,3 +193,40 @@ services, it also demands the client to deliver
 something. This kind of thing happens when a module exports
 a function, an object, a class or other values that enable
 values to flow in both directions.
+
+@ctc-section{Experimenting with examples}
+
+All of the contracts and module in this chapter (excluding those just
+following) are written using the standard @tt{#lang} syntax for
+describing modules. Thus, if you extract examples from this chapter in
+order to experiment with the behavior of the contract system, you
+would have to make multiple files. 
+
+To rectify this, PLT Scheme provides a special language, called
+@schememodname[scheme/load]. The contents of such a module is other modules (and
+@scheme[require] statements), using the parenthesized syntax for a
+module. For example, to try the example earlier in this section, you
+would write:
+@schememod[
+scheme/load
+
+(module m scheme
+  (define amount 150)
+  (provide/contract [amount (and/c number? positive?)]))
+
+(module n scheme
+  (require 'm)
+  (+ amount 10))
+
+(require 'n)]
+
+Each of the modules and their contracts are wrapped in parentheses
+with the @scheme[module] keyword at the front. The first argument to
+@scheme[module] should be the name of the module, so it can be used in
+a subsequent @scheme[require] statement (note that in the
+@scheme[require], the name of the module must be prefixed with a
+quote). The second argument to @scheme[module] is the language (what
+would have come after @tt{#lang} in the usual notation), and the
+remaining arguments are the body of the module. After all of the
+modules, there must a @scheme[require] to kick things off.
+
diff --git a/collects/scribblings/reference/regexps.scrbl b/collects/scribblings/reference/regexps.scrbl
index 92885b8d0d..eea79141e9 100644
--- a/collects/scribblings/reference/regexps.scrbl
+++ b/collects/scribblings/reference/regexps.scrbl
@@ -206,8 +206,8 @@ case-sensitively.
                        [start-pos exact-nonnegative-integer? 0]
                        [end-pos (or/c exact-nonnegative-integer? #f) #f]
                        [output-port (or/c output-port? #f) #f])
-         (or/c (listof (or/c (or/c string? bytes?)
-                             #f))
+         (or/c (listof (or/c string? #f))
+               (listof (or/c bytes? #f))
                #f)]{
 
 Attempts to match @scheme[pattern] (a string, byte string, regexp
@@ -304,7 +304,7 @@ bytes. To avoid such interleaving, use @scheme[regexp-match-peek]
                         [input (or/c string? bytes? input-port?)]
                         [start-pos exact-nonnegative-integer? 0]
                         [end-pos (or/c exact-nonnegative-integer? #f) #f])
-         (listof (or/c string? bytes?))]{
+         (or/c (listof string?) (listof bytes?))]{
 
 Like @scheme[regexp-match], but the result is a list of strings or
 byte strings corresponding to a sequence of matches of
@@ -336,8 +336,8 @@ port).
                        [start-pos exact-nonnegative-integer? 0]
                        [end-pos (or/c exact-nonnegative-integer? #f) #f]
                        [output-port (or/c output-port? #f) #f])
-         (or/c (listof (or/c (or/c string? bytes?)
-                             #f))
+         (or/c (listof (or/c string? #f))
+               (listof (or/c bytes? #f))
                #f)]{
 
 Like @scheme[regexp-match] on input ports, except that if the match
diff --git a/collects/scribblings/reference/sandbox.scrbl b/collects/scribblings/reference/sandbox.scrbl
index 73942e8708..87f3780709 100644
--- a/collects/scribblings/reference/sandbox.scrbl
+++ b/collects/scribblings/reference/sandbox.scrbl
@@ -539,8 +539,8 @@ byte string into the pipe.  It can also be used with @scheme[eof],
 which closes the pipe.}
 
 
-@defproc*[([(get-output [evaluator (any/c . -> . any)]) (or/c input-port? bytes? string?)]
-           [(get-error-output [evaluator (any/c . -> . any)]) (or/c input-port? bytes? string?)])]{
+@defproc*[([(get-output [evaluator (any/c . -> . any)]) (or/c #f input-port? bytes? string?)]
+           [(get-error-output [evaluator (any/c . -> . any)]) (or/c #f input-port? bytes? string?)])]{
 
 Returns the output or error-output of the @scheme[evaluator],
 in a way that depends on the setting of @scheme[(sandbox-output)] or
diff --git a/collects/scribblings/reference/syntax.scrbl b/collects/scribblings/reference/syntax.scrbl
index 64b6e2cb6d..c98d287524 100644
--- a/collects/scribblings/reference/syntax.scrbl
+++ b/collects/scribblings/reference/syntax.scrbl
@@ -753,7 +753,7 @@ instead of
                       #rx"-" (string-titlecase name) "")))
               scheme/base))]
   will get the @scheme[scheme/base] bindings that match the regexp,
-  and renamed to use ``caml case''.}
+  and renamed to use ``camel case''.}
 
 @; --------------------
 
@@ -783,7 +783,7 @@ instead of
                       #rx"-" (string-titlecase name) "")))
               (all-defined-out)))]
   will provide all defined bindings that match the regexp, and renamed
-  to use ``caml case''.}
+  to use ``camel case''.}
 
 @;------------------------------------------------------------------------
 @section[#:tag "quote"]{Literals: @scheme[quote] and @scheme[#%datum]}
diff --git a/collects/stepper/internal-docs.txt b/collects/stepper/internal-docs.txt
index f47d9be621..fefbd85372 100644
--- a/collects/stepper/internal-docs.txt
+++ b/collects/stepper/internal-docs.txt
@@ -202,6 +202,16 @@ Where it's used: the stepper-skipto label is used by the 2nd-pass
 macro-labeler and the annotator.  Both are in annotate.ss.  In addition
 to skipping inward, a stepper hint
 
+stepper-skipto/discard :
+
+ This is like stepper-skipto, except that it makes the stepper
+ replace the expression the property is attached to by the
+ subexpression indicated by its value.
+
+ (This is used in the contracts implementation for "Die Macht der
+ Abstraktion", where procedures are wrapped in a contract-checking
+ context that has no impact on the reduction semantics.)
+
 stepper-else :
  [ #t ] : Initially applied to the 'true' that the cond macro
   replaces a beginner's 'else' with, it is later transferred
diff --git a/collects/stepper/private/annotate.ss b/collects/stepper/private/annotate.ss
index 5a2a69a785..8107300a0e 100644
--- a/collects/stepper/private/annotate.ss
+++ b/collects/stepper/private/annotate.ss
@@ -387,21 +387,25 @@
                . -> . (vector/p syntax? binding-set?))
     (lambda (exp tail-bound pre-break? procedure-name-info)
       
-      (cond [(stepper-syntax-property exp 'stepper-skipto)
-             (let* ([free-vars-captured #f] ; this will be set!'ed
-                    ;[dont-care (printf "expr: ~a\nskipto: ~a\n" expr (stepper-syntax-property expr 'stepper-skipto))]
-                    ; WARNING! I depend on the order of evaluation in application arguments here:
-                    [annotated (skipto/auto
-                                exp
-                                'rebuild
-                                (lambda (subterm)
-                                  (let*-2vals ([(stx free-vars) (annotate/inner subterm tail-bound pre-break? procedure-name-info)])
-                                              (set! free-vars-captured free-vars)
-                                              stx)))])
-               (2vals (wcm-wrap
-                       skipto-mark
-                       annotated)
-                      free-vars-captured))]
+      (cond [(cond
+	      ((stepper-syntax-property exp 'stepper-skipto) 'rebuild)
+	      ((stepper-syntax-property exp 'stepper-skipto/discard) 'discard)
+	      (else #f))
+	     => (lambda (traversal)
+		  (let* ([free-vars-captured #f] ; this will be set!'ed
+			 ;;[dont-care (printf "expr: ~a\nskipto: ~a\n" expr (stepper-syntax-property expr 'stepper-skipto))]
+			 ;; WARNING! I depend on the order of evaluation in application arguments here:
+			 [annotated (skipto/auto
+				     exp
+				     traversal
+				     (lambda (subterm)
+				       (let*-2vals ([(stx free-vars) (annotate/inner subterm tail-bound pre-break? procedure-name-info)])
+						   (set! free-vars-captured free-vars)
+						   stx)))])
+		    (2vals (wcm-wrap
+			    skipto-mark
+			    annotated)
+			   free-vars-captured)))]
             
             [(stepper-syntax-property exp 'stepper-skip-completely)
              (2vals (wcm-wrap 13 exp) null)]
diff --git a/collects/stepper/private/shared.ss b/collects/stepper/private/shared.ss
index 59b55eeb08..208f50393e 100644
--- a/collects/stepper/private/shared.ss
+++ b/collects/stepper/private/shared.ss
@@ -481,7 +481,8 @@
   ;; traversal argument is 'discard, the result of the transformation is the
   ;; result of this function
   (define (skipto/auto stx traversal transformer)
-    (cond [(stepper-syntax-property stx 'stepper-skipto)
+    (cond [(or (stepper-syntax-property stx 'stepper-skipto)
+	       (stepper-syntax-property stx 'stepper-skipto/discard))
            =>
            (cut update <> stx (cut skipto/auto <> traversal transformer) traversal)]
           [else (transformer stx)]))
diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss
index 00588747f3..4eed97fc69 100644
--- a/collects/tests/mzscheme/contract-test.ss
+++ b/collects/tests/mzscheme/contract-test.ss
@@ -4778,6 +4778,7 @@ so that propagation occurs.
   (test-flat-contract '(real-in 1 10) 3/2 20)
   (test-flat-contract '(string-len/c 3) "ab" "abc")
   (test-flat-contract 'natural-number/c 5 -1)
+  (test-flat-contract 'natural-number/c #e3 #i3.0)
   (test-flat-contract 'false/c #f #t)
   
   (test-flat-contract #t #t "x")
diff --git a/collects/tests/run-automated-tests.ss b/collects/tests/run-automated-tests.ss
index f5b8a1e95e..bacba4089a 100755
--- a/collects/tests/run-automated-tests.ss
+++ b/collects/tests/run-automated-tests.ss
@@ -32,7 +32,7 @@
 ;;   ignored, and should only be used by the mzscheme tests.)
 (define tests
   '([no-handler load "mzscheme/quiet.ss" (lib "scheme/init")]
-    [require "typed-scheme/run.ss"]
+    ;; [require "typed-scheme/run.ss"]
     [require "match/plt-match-tests.ss"]
     ;; [require "stepper/automatic-tests.ss" (lib "scheme/base")]
     [require "lazy/main.ss"]
diff --git a/collects/tests/typed-scheme/fail/unbound-type.ss b/collects/tests/typed-scheme/fail/unbound-type.ss
new file mode 100644
index 0000000000..3ae769ab65
--- /dev/null
+++ b/collects/tests/typed-scheme/fail/unbound-type.ss
@@ -0,0 +1,9 @@
+#;
+(exn-pred 1)
+#lang typed-scheme
+
+
+(: f (Foo -> String))
+(define (f x) (string-append x))
+
+(f 1)
\ No newline at end of file
diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss
index df537b8951..f1452e1303 100644
--- a/collects/typed-scheme/private/base-env.ss
+++ b/collects/typed-scheme/private/base-env.ss
@@ -4,6 +4,7 @@
  scheme/list
  (only-in rnrs/lists-6 fold-left)
  '#%paramz
+ (only-in '#%kernel [apply kernel:apply])
  scheme/promise
  (only-in scheme/match/runtime match:error))
 
@@ -236,11 +237,13 @@
 [list-tail (-poly (a) ((-lst a) -Integer . -> . (-lst a)))]
 [positive? (-> N B)]
 [negative? (-> N B)]
-[odd? (-> N B)]
-[even? (-> N B)]
+[odd? (-> -Integer B)]
+[even? (-> -Integer B)]
 
-[apply      (-poly (a b) (((list) a . ->* . b) (-lst a) . -> . b))]
-[time-apply (-poly (a b) (((list) a . ->* . b) (-lst a) . -> . b))]
+[apply        (-poly (a b) (((list) a . ->* . b) (-lst a) . -> . b))]
+[kernel:apply (-poly (a b) (((list) a . ->* . b) (-lst a) . -> . b))]
+[time-apply (-poly (a b) (((list) a . ->* . b) (-lst a)
+                          . -> . (-values (list b N N N))))]
 
 [call/cc (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (*Un a b)))]
 [call/ec (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (*Un a b)))]
@@ -264,20 +267,24 @@
 
 ;; regexp stuff
 [regexp-match
- (cl->
-  [((*Un -String -Regexp) -String) (-opt (-lst (-opt -String)))]
-  [(-Pattern -String) (-opt (-lst (-opt (*Un -Bytes -String))))]
-  [(-Pattern -String N) (-opt (-lst (-opt (*Un -Bytes -String))))]
-  [(-Pattern -String N (-opt N)) (-opt (-lst (-opt (*Un -Bytes -String))))]
-  [(-Pattern -String N (-opt N) (-opt -Output-Port)) (-lst (-opt (*Un -Bytes -String)))]
-  [(-Pattern -String (-opt N) (-opt -Output-Port)) (-lst (-opt (*Un -Bytes -String)))]
-  [(-Pattern -String (-opt -Output-Port)) (-lst (-opt (*Un -Bytes -String)))]
-  [(-Pattern (*Un -Input-Port -Bytes)) (-opt (-lst (-opt -Bytes)))]
-  [(-Pattern (*Un -Input-Port -Bytes) N) (-opt (-lst (-opt -Bytes)))]
-  [(-Pattern (*Un -Input-Port -Bytes) N (-opt N)) (-opt (-lst (-opt -Bytes)))]
-  [(-Pattern (*Un -Input-Port -Bytes) (-opt N)) (-opt (-lst (-opt -Bytes)))]
-  [(-Pattern (*Un -Input-Port -Bytes) N (-opt N) (-opt -Output-Port)) (-lst (-opt -Bytes))])]
-
+ (let ([?outp   (-opt -Output-Port)]
+       [?N      (-opt N)]
+       [optlist (lambda (t) (-opt (-lst (-opt t))))]
+       [-StrRx  (*Un -String -Regexp -PRegexp)]
+       [-BtsRx  (*Un -Bytes  -Byte-Regexp -Byte-PRegexp)]
+       [-InpBts (*Un -Input-Port -Bytes)])
+   (cl-> [(-StrRx   -String           ) (optlist -String)]
+         [(-StrRx   -String N         ) (optlist -String)]
+         [(-StrRx   -String N ?N      ) (optlist -String)]
+         [(-StrRx   -String N ?N ?outp) (optlist -String)]
+         [(-BtsRx   -String           ) (optlist -Bytes)]
+         [(-BtsRx   -String N         ) (optlist -Bytes)]
+         [(-BtsRx   -String N ?N      ) (optlist -Bytes)]
+         [(-BtsRx   -String N ?N ?outp) (optlist -Bytes)]
+         [(-Pattern -InpBts           ) (optlist -Bytes)]
+         [(-Pattern -InpBts N         ) (optlist -Bytes)]
+         [(-Pattern -InpBts N ?N      ) (optlist -Bytes)]
+         [(-Pattern -InpBts N ?N ?outp) (optlist -Bytes)]))]
 
 [number->string (N . -> . -String)]
 
diff --git a/collects/typed-scheme/private/parse-type.ss b/collects/typed-scheme/private/parse-type.ss
index c04f26dc1e..58560d2d50 100644
--- a/collects/typed-scheme/private/parse-type.ss
+++ b/collects/typed-scheme/private/parse-type.ss
@@ -213,10 +213,10 @@
           (make-Name #'id)]
          [(eq? '-> (syntax-e #'id))
           (tc-error/delayed "Incorrect use of -> type constructor")
-          Univ]
+          Err]
          [else
           (tc-error/delayed "Unbound type name ~a" (syntax-e #'id))
-          Univ])]
+          Err])]
 
       [(All . rest) (eq? (syntax-e #'All) 'All) (tc-error "All: bad syntax")]
       [(Opaque . rest) (eq? (syntax-e #'Opaque) 'Opqaue) (tc-error "Opaque: bad syntax")]
@@ -239,8 +239,9 @@
               (tc-error "Wrong number of arguments to type ~a, expected ~a but got ~a" rator (length ns) (length args)))
             (instantiate-poly rator args)]
            [(Mu: _ _) (loop (unfold rator) args)]
+           [(Error:) Err]
            [_ (tc-error/delayed "Type ~a cannot be applied, arguments were: ~a" rator args)
-              Univ]))
+              Err]))
        #;
        (let ([ty (parse-type #'id)])
          #;(printf "ty is ~a" ty)
diff --git a/collects/typed-scheme/private/prims.ss b/collects/typed-scheme/private/prims.ss
index d6eb0a8365..a7bbcbedbe 100644
--- a/collects/typed-scheme/private/prims.ss
+++ b/collects/typed-scheme/private/prims.ss
@@ -52,14 +52,13 @@ This file defines two sorts of primitives. All of them are provided into any mod
 
 
 
-(define-syntax (require/typed stx)
-  
+(define-syntax (require/typed stx)  
   (syntax-case* stx (rename) (lambda (x y) (eq? (syntax-e x) (syntax-e y)))
     [(_ lib [nm ty] ...)
      #'(begin (require/typed nm ty lib) ...)]
     [(_ nm ty lib)
      (identifier? #'nm)
-     (with-syntax ([(cnt*) (syntax->datum #'(nm))])
+     (with-syntax ([(cnt*) (generate-temporaries #'(nm))])
        (quasisyntax/loc stx (begin 
                               #,(syntax-property (syntax-property #'(define cnt* #f)
                                                                   'typechecker:contract-def #'ty)
diff --git a/collects/typed-scheme/private/subtype.ss b/collects/typed-scheme/private/subtype.ss
index 1db8c33be8..4438704580 100644
--- a/collects/typed-scheme/private/subtype.ss
+++ b/collects/typed-scheme/private/subtype.ss
@@ -168,6 +168,9 @@
               [(list t t) A0]              
               ;; univ is top
               [(list _ (Univ:)) A0]
+              ;; error is top and bot
+              [(list _ (Error:)) A0]
+              [(list (Error:) _) A0]
               ;; (Un) is bot
               [(list _ (Union: (list))) (fail! s t)]
               [(list (Union: (list)) _) A0]
diff --git a/collects/typed-scheme/private/type-effect-convenience.ss b/collects/typed-scheme/private/type-effect-convenience.ss
index 28db30a89a..22510c5768 100644
--- a/collects/typed-scheme/private/type-effect-convenience.ss
+++ b/collects/typed-scheme/private/type-effect-convenience.ss
@@ -139,6 +139,7 @@
 (define -Promise make-promise-ty)
 
 (define Univ (make-Univ))
+(define Err (make-Error))
 
 (define-syntax -v 
   (syntax-rules ()
diff --git a/collects/typed-scheme/rep/type-rep.ss b/collects/typed-scheme/rep/type-rep.ss
index 5536a84417..4b6effb7a4 100644
--- a/collects/typed-scheme/rep/type-rep.ss
+++ b/collects/typed-scheme/rep/type-rep.ss
@@ -15,6 +15,9 @@
 ;; t must be a Type
 (dt Scope (t))
 
+;; this is ONLY used when a type error ocurrs
+(dt Error () [#:frees #f] [#:fold-rhs #:base])
+
 ;; i is an nat
 (dt B (i)
     [#:frees empty-hash-table (make-immutable-hasheq (list (cons i Covariant)))]
diff --git a/collects/typed-scheme/typecheck/provide-handling.ss b/collects/typed-scheme/typecheck/provide-handling.ss
index 4ca36a3460..d3fb28c9d2 100644
--- a/collects/typed-scheme/typecheck/provide-handling.ss
+++ b/collects/typed-scheme/typecheck/provide-handling.ss
@@ -2,7 +2,7 @@
 
 (require (except-in "../utils/utils.ss" extend))
 (require (only-in srfi/1/list s:member)
-         syntax/kerncase 
+         syntax/kerncase syntax/boundmap
          mzlib/trace
          (private type-contract)
          (rep type-rep)
@@ -23,68 +23,77 @@
 (define (remove-provides forms)
   (filter (lambda (e) (not (provide? e))) (syntax->list forms)))
 
-(define ((generate-prov stx-defs val-defs) form)
-  (define (mem? i vd)
-    (cond [(s:member i vd (lambda (i j) (free-identifier=? i (binding-name j)))) => car]
-          [else #f]))
-  (define (lookup-id i vd)
-    (def-binding-ty (mem? i vd)))
-  (define (mk internal-id external-id)
-    (cond
-      [(mem? internal-id val-defs)
-       =>
-       (lambda (b)
-         (with-syntax ([id internal-id]
-                       [out-id external-id])
-           (cond [(type->contract (def-binding-ty b) (lambda () #f)) 
-                  =>
-                  (lambda (cnt)                                    
-                    (with-syntax ([(export-id cnt-id) (generate-temporaries #'(id id))])
-                      #`(begin 
-                          (define/contract cnt-id #,cnt id)
+(define (generate-prov stx-defs val-defs)
+  (define mapping (make-free-identifier-mapping))
+  (lambda (form)
+    (define (mem? i vd)
+      (cond [(s:member i vd (lambda (i j) (free-identifier=? i (binding-name j)))) => car]
+            [else #f]))
+    (define (lookup-id i vd)
+      (def-binding-ty (mem? i vd)))
+    (define (mk internal-id external-id)
+      (cond
+        ;; if it's already done, do nothing
+        [(free-identifier-mapping-get mapping internal-id
+                                      ;; if it wasn't there, put it in, and skip this case
+                                      (lambda ()
+                                        (free-identifier-mapping-put! mapping internal-id #t)
+                                        #f))
+         #'(begin)]
+        [(mem? internal-id val-defs)
+         =>
+         (lambda (b)
+           (with-syntax ([id internal-id]
+                         [out-id external-id])
+             (cond [(type->contract (def-binding-ty b) (lambda () #f)) 
+                    =>
+                    (lambda (cnt)                                    
+                      (with-syntax ([(export-id cnt-id) (generate-temporaries #'(id id))])
+                        #`(begin 
+                            (define/contract cnt-id #,cnt id)
+                            (define-syntax export-id
+                              (if (unbox typed-context?)
+                                  (make-rename-transformer #'id)
+                                  (make-rename-transformer #'cnt-id)))
+                            (#%provide (rename export-id out-id)))))]
+                   [else 
+                    (with-syntax ([(export-id) (generate-temporaries #'(id))])
+                      #`(begin                             
                           (define-syntax export-id
                             (if (unbox typed-context?)
                                 (make-rename-transformer #'id)
-                                (make-rename-transformer #'cnt-id)))
-                          (#%provide (rename export-id out-id)))))]
-                 [else 
-                  (with-syntax ([(export-id) (generate-temporaries #'(id))])
-                    #`(begin                             
-                        (define-syntax export-id
-                          (if (unbox typed-context?)
-                              (make-rename-transformer #'id)
-                              (lambda (stx) (tc-error/stx stx "The type of ~a cannot be converted to a contract" (syntax-e #'id)))))
-                        (provide (rename-out [export-id out-id]))))])))]
-      [(mem? internal-id stx-defs) 
-       =>
-       (lambda (b)
-         (with-syntax ([id internal-id]
-                       [out-id external-id])
-           (with-syntax ([(export-id cnt-id) (generate-temporaries #'(id id))])
-             #`(begin                    
-                 (define-syntax export-id
-                   (if (unbox typed-context?)
-                       (make-rename-transformer #'id)
-                       (lambda (stx)
-                         (tc-error/stx stx "Macro ~a from typed module used in untyped code" (syntax-e #'out-id)))))
-                 (provide (rename-out [export-id out-id]))))))]
-      [(eq? (syntax-e internal-id) (syntax-e external-id))
-       #`(provide #,internal-id)]
-      [else #`(provide (rename-out [#,internal-id #,external-id]))]))
-  (kernel-syntax-case form #f
-    [(#%provide form ...)
-     (map 
-      (lambda (f)
-        (parameterize ([current-orig-stx f])
-          (syntax-case* f (struct rename all-defined protect all-defined-except all-from all-from-except) 
-            (lambda (a b) (eq? (syntax-e a) (syntax-e b)))
-            [id 
-             (identifier? #'id)
-             (mk #'id #'id)]
-            [(rename in out)
-             (mk #'in #'out)]
-            [(protect . _)
-             (tc-error "provide: protect not supported by Typed Scheme")]
-            [_ (int-err "unknown provide form")])))
-      (syntax->list #'(form ...)))]
-    [_ (int-err "non-provide form! ~a" (syntax->datum form))]))
+                                (lambda (stx) (tc-error/stx stx "The type of ~a cannot be converted to a contract" (syntax-e #'id)))))
+                          (provide (rename-out [export-id out-id]))))])))]
+        [(mem? internal-id stx-defs) 
+         =>
+         (lambda (b)
+           (with-syntax ([id internal-id]
+                         [out-id external-id])
+             (with-syntax ([(export-id cnt-id) (generate-temporaries #'(id id))])
+               #`(begin                    
+                   (define-syntax export-id
+                     (if (unbox typed-context?)
+                         (make-rename-transformer #'id)
+                         (lambda (stx)
+                           (tc-error/stx stx "Macro ~a from typed module used in untyped code" (syntax-e #'out-id)))))
+                   (provide (rename-out [export-id out-id]))))))]
+        [(eq? (syntax-e internal-id) (syntax-e external-id))
+         #`(provide #,internal-id)]
+        [else #`(provide (rename-out [#,internal-id #,external-id]))]))
+    (kernel-syntax-case form #f
+      [(#%provide form ...)
+       (map 
+        (lambda (f)
+          (parameterize ([current-orig-stx f])
+            (syntax-case* f (struct rename all-defined protect all-defined-except all-from all-from-except) 
+              (lambda (a b) (eq? (syntax-e a) (syntax-e b)))
+              [id 
+               (identifier? #'id)
+               (mk #'id #'id)]
+              [(rename in out)
+               (mk #'in #'out)]
+              [(protect . _)
+               (tc-error "provide: protect not supported by Typed Scheme")]
+              [_ (int-err "unknown provide form")])))
+        (syntax->list #'(form ...)))]
+      [_ (int-err "non-provide form! ~a" (syntax->datum form))])))
diff --git a/collects/typed-scheme/typecheck/tc-app-unit.ss b/collects/typed-scheme/typecheck/tc-app-unit.ss
index 6114a73981..d0ada2721c 100644
--- a/collects/typed-scheme/typecheck/tc-app-unit.ss
+++ b/collects/typed-scheme/typecheck/tc-app-unit.ss
@@ -484,6 +484,8 @@
          (match-let ([(list (tc-result: ts) ...) (map (lambda (f) (outer-loop 
                                                                    (ret f e1 e2) argtypes arg-thn-effs arg-els-effs args)) fs)])
            (ret (apply Un ts)))]
+        ;; error type is a perfectly good fcn type
+        [(tc-result: (Error:)) (ret (make-Error))]
         [(tc-result: f-ty _ _) (tc-error/expr #:return (ret (Un))
                                               "Cannot apply expression of type ~a, since it is not a function type" f-ty)]))))
 
diff --git a/collects/typed-scheme/typecheck/tc-toplevel.ss b/collects/typed-scheme/typecheck/tc-toplevel.ss
index 5f2d36f25b..2c3aa72e28 100644
--- a/collects/typed-scheme/typecheck/tc-toplevel.ss
+++ b/collects/typed-scheme/typecheck/tc-toplevel.ss
@@ -40,7 +40,9 @@
       
       ;; require/typed
       [(define-values () (begin (quote-syntax (require/typed-internal nm ty)) (#%plain-app values)))
-       (register-type #'nm (parse-type #'ty))]
+       (let ([t (parse-type #'ty)])
+         (register-type #'nm t)
+         (list (make-def-binding #'nm t)))]
       
       ;; define-typed-struct
       [(define-values () (begin (quote-syntax (define-typed-struct-internal nm ([fld : ty] ...))) (#%plain-app values)))
diff --git a/collects/typed-scheme/typed-scheme.scrbl b/collects/typed-scheme/typed-scheme.scrbl
index 4c7a66e389..e9ad7336e3 100644
--- a/collects/typed-scheme/typed-scheme.scrbl
+++ b/collects/typed-scheme/typed-scheme.scrbl
@@ -460,8 +460,8 @@ The following base types are parameteric in their type arguments.
 @defform[(values t ...)]{is the type of a sequence of multiple values, with
 types @scheme[t ...].  This can only appear as the return type of a
 function.}
-@defform/none[v]{where @scheme[v] is a number, boolean or string, is the singleton type containing
-only that value}
+@defform/none[v]{where @scheme[v] is a number, boolean or string, is the singleton type containing only that value}
+@defform/none['sym]{where @scheme[sym] is a symbol, is the singleton type containing only that symbol}
 @defform/none[i]{where @scheme[i] is an identifier can be a reference to a type
 name or a type variable}
 @defform[(Rec n t)]{is a recursive type where @scheme[n] is bound to the
diff --git a/src/mred/wxme/wx_mline.cxx b/src/mred/wxme/wx_mline.cxx
index 2fbd1ea0ad..3101c56b80 100644
--- a/src/mred/wxme/wx_mline.cxx
+++ b/src/mred/wxme/wx_mline.cxx
@@ -747,6 +747,8 @@ long wxMediaLine::FindExtraScroll(double y)
 {
   if (y >= h)
     return numscrolls;
+  if (y <= 0)
+    return 0;
   
   if (!scrollSnip)
     return 0;
diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c
index e49d9bb5f4..0bb16801d1 100644
--- a/src/mzscheme/src/env.c
+++ b/src/mzscheme/src/env.c
@@ -1743,7 +1743,8 @@ Scheme_Object *scheme_hash_module_variable(Scheme_Env *env, Scheme_Object *modid
   return val;
 }
 
-Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Object *bdg, int is_def, Scheme_Object *phase)
+Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Object *bdg, int is_def, 
+                                Scheme_Object *phase, int *_skipped)
 /* The `env' argument can actually be a hash table. */
 {
   Scheme_Object *marks = NULL, *sym, *map, *l, *a, *amarks, *m, *best_match, *cm, *abdg;
@@ -1752,6 +1753,9 @@ Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Objec
 
   sym = SCHEME_STX_SYM(id);
 
+  if (_skipped)
+    *_skipped = 0;
+
   if (SCHEME_HASHTP((Scheme_Object *)env))
     marked_names = (Scheme_Hash_Table *)env;
   else {
@@ -1951,6 +1955,9 @@ Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Objec
         scheme_hash_set(rev_ht, best_match, scheme_true);
       }
     }
+  } else {
+    if (_skipped)
+      *_skipped = best_match_skipped;
   }
 
   return best_match;
@@ -2515,7 +2522,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
   if (SAME_OBJ(modidx, scheme_undefined)) {
     if (!env->genv->module && SCHEME_STXP(find_id)) {
       /* Looks like lexically bound, but double-check that it's not bound via a tl_id: */
-      find_global_id = scheme_tl_id_sym(env->genv, find_id, NULL, 0, NULL);
+      find_global_id = scheme_tl_id_sym(env->genv, find_id, NULL, 0, NULL, NULL);
       if (!SAME_OBJ(find_global_id, SCHEME_STX_VAL(find_id)))
         modidx = NULL; /* yes, it is bound */
     }
@@ -2582,7 +2589,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags,
     *_menv = genv;
   
   if (!modname && SCHEME_STXP(find_id))
-    find_global_id = scheme_tl_id_sym(env->genv, find_id, NULL, 0, NULL);
+    find_global_id = scheme_tl_id_sym(env->genv, find_id, NULL, 0, NULL, NULL);
   else
     find_global_id = find_id;
 
diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c
index 1f6e7c342f..5886b1ba8b 100644
--- a/src/mzscheme/src/eval.c
+++ b/src/mzscheme/src/eval.c
@@ -3518,6 +3518,9 @@ static void sfs_note_app(SFS_Info *info, Scheme_Object *rator)
 {
   if (!info->pass) {
     if (!info->tail_pos) {
+      if (SAME_OBJ(scheme_values_func, rator))
+        /* no need to clear for app of `values' */
+        return;
       if (SCHEME_PRIMP(rator)) {
         int opt;
         opt = ((Scheme_Prim_Proc_Header *)rator)->flags & SCHEME_PRIM_OPT_MASK;
@@ -5435,7 +5438,7 @@ scheme_compile_expand_expr(Scheme_Object *form, Scheme_Comp_Env *env,
     /* If form is a marked name, then force #%top binding.
        This is so temporaries can be used as defined ids. */
     Scheme_Object *nm;
-    nm = scheme_tl_id_sym(env->genv, form, NULL, 0, NULL);
+    nm = scheme_tl_id_sym(env->genv, form, NULL, 0, NULL, NULL);
     if (!SAME_OBJ(nm, SCHEME_STX_VAL(form))) {
       stx = scheme_datum_to_syntax(top_symbol, scheme_false, scheme_sys_wraps(env), 0, 0);
 
@@ -5870,7 +5873,7 @@ static Scheme_Object *check_top(const char *when, Scheme_Object *form, Scheme_Co
     Scheme_Object *modidx, *symbol = c, *tl_id;
     int bad;
 
-    tl_id = scheme_tl_id_sym(env->genv, symbol, NULL, 0, NULL);
+    tl_id = scheme_tl_id_sym(env->genv, symbol, NULL, 0, NULL, NULL);
     if (NOT_SAME_OBJ(tl_id, SCHEME_STX_SYM(symbol))) {
       /* Since the module has a rename for this id, it's certainly defined. */
     } else {
@@ -5917,7 +5920,7 @@ top_syntax(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Compile_Info *rec,
 
   c = check_top(scheme_compile_stx_string, form, env, rec, drec);
 
-  c = scheme_tl_id_sym(env->genv, c, NULL, 0, NULL);
+  c = scheme_tl_id_sym(env->genv, c, NULL, 0, NULL, NULL);
 
   if (env->genv->module && !rec[drec].resolve_module_ids) {
     /* Self-reference in a module; need to remember the modidx.  Don't
@@ -8954,7 +8957,7 @@ scheme_make_lifted_defn(Scheme_Object *sys_wraps, Scheme_Object **_id, Scheme_Ob
   Scheme_Object *l;
 
   /* Registers marked id: */
-  scheme_tl_id_sym(env->genv, *_id, scheme_false, 2, NULL);
+  scheme_tl_id_sym(env->genv, *_id, scheme_false, 2, NULL, NULL);
 
   l = icons(scheme_datum_to_syntax(define_values_symbol, scheme_false, sys_wraps, 0, 0), 
 	    icons(scheme_make_pair(*_id, scheme_null),
diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c
index a22bbff3f0..72ba911c39 100644
--- a/src/mzscheme/src/module.c
+++ b/src/mzscheme/src/module.c
@@ -3210,7 +3210,7 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object
 	supplied (not both). For unprotected access, both prot_insp
 	and stx+certs should be supplied. */
 {
-  symbol = scheme_tl_id_sym(env, symbol, NULL, 0, NULL);
+  symbol = scheme_tl_id_sym(env, symbol, NULL, 0, NULL, NULL);
 
   if (scheme_is_kernel_env(env)
       || ((env->module->primitive && !env->module->provide_protects))
@@ -3389,7 +3389,7 @@ Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Sch
     if (!menv->et_ran)
       scheme_run_module_exptime(menv, 1);
 
-    name = scheme_tl_id_sym(menv, name, NULL, 0, NULL);
+    name = scheme_tl_id_sym(menv, name, NULL, 0, NULL, NULL);
 
     val = scheme_lookup_in_table(menv->syntax, (char *)name);
 
@@ -5505,7 +5505,7 @@ static int check_already_required(Scheme_Hash_Table *required, Scheme_Object *na
 
 static Scheme_Object *stx_sym(Scheme_Object *name, Scheme_Object *_genv)
 {
-  return scheme_tl_id_sym((Scheme_Env *)_genv, name, NULL, 2, NULL);
+  return scheme_tl_id_sym((Scheme_Env *)_genv, name, NULL, 2, NULL, NULL);
 }
 
 static Scheme_Object *add_a_rename(Scheme_Object *fm, Scheme_Object *post_ex_rn)
@@ -5546,7 +5546,7 @@ static Scheme_Object *add_lifted_defn(Scheme_Object *data, Scheme_Object **_id,
   self_modidx = SCHEME_VEC_ELS(data)[1];
   rn = SCHEME_VEC_ELS(data)[2];
   
-  name = scheme_tl_id_sym(env->genv, *_id, scheme_false, 2, NULL);
+  name = scheme_tl_id_sym(env->genv, *_id, scheme_false, 2, NULL, NULL);
 
   /* Create the bucket, indicating that the name will be defined: */
   scheme_add_global_symbol(name, scheme_undefined, env->genv);
@@ -5848,7 +5848,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
 	    /* Remember the original: */
 	    all_defs = scheme_make_pair(name, all_defs);
 	    
-	    name = scheme_tl_id_sym(env->genv, name, NULL, 2, NULL);
+	    name = scheme_tl_id_sym(env->genv, name, NULL, 2, NULL, NULL);
 
 	    /* Check that it's not yet defined: */
 	    if (scheme_lookup_in_table(env->genv->toplevel, (const char *)name)) {
@@ -5925,7 +5925,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
             else
               all_et_defs = scheme_make_pair(name, all_et_defs);
 	    
-	    name = scheme_tl_id_sym(oenv->genv, name, NULL, 2, NULL);
+	    name = scheme_tl_id_sym(oenv->genv, name, NULL, 2, NULL, NULL);
 	    
 	    if (scheme_lookup_in_table(oenv->genv->syntax, (const char *)name)) {
 	      scheme_wrong_syntax("module", orig_name, e, 
@@ -6278,7 +6278,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env,
 	  /* may be a single shadowed exclusion, now bound to exclude_hint... */
 	  n = SCHEME_CAR(n);
 	  if (SCHEME_STXP(n))
-	    n = scheme_tl_id_sym(env->genv, n, NULL, 0, NULL);
+	    n = scheme_tl_id_sym(env->genv, n, NULL, 0, NULL, NULL);
 	  n = scheme_hash_get(required, n);
 	  if (n && !SAME_OBJ(SCHEME_VEC_ELS(n)[1], kernel_modidx)) {
 	    /* there is a single shadowed exclusion. */
@@ -6814,7 +6814,7 @@ int compute_reprovides(Scheme_Hash_Table *all_provided,
         /* Make sure each excluded name was defined: */
         for (exns = exl; !SCHEME_STX_NULLP(exns); exns = SCHEME_STX_CDR(exns)) {
           a = SCHEME_STX_CAR(exns);
-          name = scheme_tl_id_sym(genv, a, NULL, 0, NULL);
+          name = scheme_tl_id_sym(genv, a, NULL, 0, NULL, NULL);
           if (!scheme_lookup_in_table(genv->toplevel, (const char *)name)
               && !scheme_lookup_in_table(genv->syntax, (const char *)name)) {
             scheme_wrong_syntax("module", a, ree_kw, "excluded identifier was not defined");
@@ -6824,12 +6824,12 @@ int compute_reprovides(Scheme_Hash_Table *all_provided,
         for (adl = all_defs; SCHEME_PAIRP(adl); adl = SCHEME_CDR(adl)) {
           name = SCHEME_CAR(adl);
           exname = SCHEME_STX_SYM(name);
-          name = scheme_tl_id_sym(genv, name, NULL, 0, NULL);
+          name = scheme_tl_id_sym(genv, name, NULL, 0, NULL, NULL);
 	
           /* Was this one excluded? */
           for (exns = exl; !SCHEME_STX_NULLP(exns); exns = SCHEME_STX_CDR(exns)) {
             a = SCHEME_STX_CAR(exns);
-            a = scheme_tl_id_sym(genv, a, NULL, 0, NULL);
+            a = scheme_tl_id_sym(genv, a, NULL, 0, NULL, NULL);
             if (SAME_OBJ(a, name))
               break;
           }
@@ -6845,7 +6845,7 @@ int compute_reprovides(Scheme_Hash_Table *all_provided,
                  as if it had ree_kw's context, then comparing that result
                  to the actual tl_id. */
               a = scheme_datum_to_syntax(exname, scheme_false, ree_kw, 0, 0);
-              a = scheme_tl_id_sym(genv, a, NULL, 0, NULL);
+              a = scheme_tl_id_sym(genv, a, NULL, 0, NULL, NULL);
 	    
               if (SAME_OBJ(a, name)) {
                 /* Add prefix, if any */
@@ -7033,7 +7033,7 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table
           prnt_name = name;
           if (SCHEME_STXP(name)) {
             if (genv)
-              name = scheme_tl_id_sym(genv, name, NULL, 0, phase);
+              name = scheme_tl_id_sym(genv, name, NULL, 0, phase, NULL);
             else
               name = SCHEME_STX_VAL(name); /* shouldn't get here; no `define-for-label' */
           }
@@ -7106,7 +7106,7 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table
             if (genv
                 && (SAME_OBJ(phase, scheme_make_integer(0))
                     || SAME_OBJ(phase, scheme_make_integer(1))))
-              name = scheme_tl_id_sym(genv, name, NULL, 0, phase);
+              name = scheme_tl_id_sym(genv, name, NULL, 0, phase, NULL);
             else {
               name = SCHEME_STX_VAL(name); /* shouldn't get here; no `define-for-label' */
             }
@@ -8040,7 +8040,7 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */
             /* The `require' expression has a set of marks in its
                context, which means that we need to generate a name. */
             iname = scheme_datum_to_syntax(iname, scheme_false, mark_src, 0, 0);
-            iname = scheme_tl_id_sym(orig_env, iname, scheme_false, 2, to_phase);
+            iname = scheme_tl_id_sym(orig_env, iname, scheme_false, 2, to_phase, NULL);
             if (all_simple)
               *all_simple = 0;
           }
diff --git a/src/mzscheme/src/port.c b/src/mzscheme/src/port.c
index f49a88ed02..6eaba89dff 100644
--- a/src/mzscheme/src/port.c
+++ b/src/mzscheme/src/port.c
@@ -122,11 +122,15 @@ typedef struct Win_FD_Input_Thread {
   /* This is malloced for use in a Win32 thread */
   HANDLE fd;
   volatile int avail, err, checking;
+  int *refcount;
   HANDLE eof;
   unsigned char *buffer;
   HANDLE checking_sema, ready_sema, you_clean_up_sema;
+  HANDLE thread;
 } Win_FD_Input_Thread;
 
+static HANDLE refcount_sema;
+
 typedef struct Win_FD_Output_Thread {
   /* This is malloced for use in a Win32 thread */
   HANDLE fd;
@@ -144,6 +148,7 @@ typedef struct Win_FD_Output_Thread {
   volatile int done, err_no;
   volatile unsigned int buflen, bufstart, bufend; /* used for blocking, only */
   unsigned char *buffer; /* used for blocking, only */
+  int *refcount;
   HANDLE lock_sema, work_sema, ready_sema, you_clean_up_sema;
   /* lock_sema protects the fields, work_sema starts the flush or
      flush-checking thread to work, ready_sema indicates that a flush
@@ -187,6 +192,59 @@ typedef struct Scheme_Subprocess {
 # define MZ_FDS
 #endif
 
+/******************** refcounts ********************/
+
+#ifdef WINDOWS_FILE_HANDLES
+
+static int *malloc_refcount()
+{
+  if (!refcount_sema)
+    refcount_sema = CreateSemaphore(NULL, 1, 1, NULL);
+
+  return (int *)malloc(sizeof(int));
+}
+
+#ifdef MZ_XFORM
+START_XFORM_SKIP;
+#endif
+
+static int dec_refcount(int *refcount)
+{
+  int rc;
+
+  if (!refcount)
+    return 0;
+
+  WaitForSingleObject(refcount_sema, INFINITE);
+  *refcount -= 1;
+  rc = *refcount;
+  ReleaseSemaphore(refcount_sema, 1, NULL);
+
+  if (!rc) free(refcount);
+
+  return rc;
+}
+
+#ifdef MZ_XFORM
+END_XFORM_SKIP;
+#endif
+
+#else
+
+static int *malloc_refcount()
+{
+  return (int *)scheme_malloc_atomic(sizeof(int));
+}
+
+static int dec_refcount(int *refcount)
+{
+  if (!refcount)
+    return 0;
+  *refcount -= 1;
+  return *refcount;
+}
+
+#endif
 
 /******************** file-descriptor I/O ********************/
 
@@ -4532,6 +4590,26 @@ scheme_make_file_input_port(FILE *fp)
 # ifdef WINDOWS_FILE_HANDLES
 static long WindowsFDReader(Win_FD_Input_Thread *th);
 static void WindowsFDICleanup(Win_FD_Input_Thread *th);
+typedef BOOL (WINAPI* CSI_proc)(HANDLE);
+
+static CSI_proc get_csi(void)
+{
+  static int tried_csi = 0;
+  static CSI_proc csi;
+  
+  START_XFORM_SKIP;      
+  if (!tried_csi) {
+    HMODULE hm;
+    hm = LoadLibrary("kernel32.dll");
+    if (hm)
+      csi = (CSI_proc)GetProcAddress(hm, "CancelSynchronousIo");
+    else
+      csi = NULL;
+    tried_csi = 1;
+  }
+  END_XFORM_SKIP;
+  return csi;
+}
 # endif
 
 /* forward decl: */
@@ -4914,11 +4992,10 @@ fd_close_input(Scheme_Input_Port *port)
 
   fip = (Scheme_FD *)port->port_data;
 
-  if (fip->refcount)
-    *fip->refcount -= 1;
-
 #ifdef WINDOWS_FILE_HANDLES
   if (fip->th) {
+    CSI_proc csi;
+
     /* -1 for checking means "shut down" */
     fip->th->checking = -1;
     ReleaseSemaphore(fip->th->checking_sema, 1, NULL);
@@ -4928,25 +5005,40 @@ fd_close_input(Scheme_Input_Port *port)
       fip->th->eof = NULL;
     }
 
+    csi = get_csi();
+    if (csi) {
+      /* Helps thread wake up. Otherwise, it's possible for the
+         thread to stay stuck trying to read, in which case the
+         file handle (probably a pipe) doesn't get closed. */
+      csi(fip->th->thread);
+    }
+
     /* Try to get out of cleaning up the records (since they can't be
        cleaned until the thread is also done: */
     if (WaitForSingleObject(fip->th->you_clean_up_sema, 0) != WAIT_OBJECT_0) {
       /* The other thread exited and left us with clean-up: */
       WindowsFDICleanup(fip->th);
     } /* otherwise, thread is responsible for clean-up */
-  }
-  if (!fip->refcount || !*fip->refcount) {
-    CloseHandle((HANDLE)fip->fd);
-    --scheme_file_open_count;
+  } else {
+    int rc;
+    rc = dec_refcount(fip->refcount);
+    if (!rc) {
+      CloseHandle((HANDLE)fip->fd);
+      --scheme_file_open_count;
+    }
   }
 #else
-  if (!fip->refcount || !*fip->refcount) {
-    int cr;
-    do {
-      cr = close(fip->fd);
-    } while ((cr == -1) && (errno == EINTR));
-    --scheme_file_open_count;
-  }
+ {
+   int rc;
+   rc = dec_refcount(fip->refcount);
+   if (!rc) {
+     int cr;
+     do {
+       cr = close(fip->fd);
+     } while ((cr == -1) && (errno == EINTR));
+     --scheme_file_open_count;
+   }
+ }
 #endif
 }
 
@@ -5088,9 +5180,12 @@ make_fd_input_port(int fd, Scheme_Object *name, int regfile, int win_textmode, i
     th->ready_sema = sm;
     sm = CreateSemaphore(NULL, 1, 1, NULL);
     th->you_clean_up_sema = sm;
+    th->refcount = refcount;
 
     h = CreateThread(NULL, 4096, (LPTHREAD_START_ROUTINE)WindowsFDReader, th, 0, &id);
 
+    th->thread = h;
+
     scheme_remember_thread(h, 1);
   }
 #endif
@@ -5161,9 +5256,15 @@ static long WindowsFDReader(Win_FD_Input_Thread *th)
 
 static void WindowsFDICleanup(Win_FD_Input_Thread *th)
 {
+  int rc;
+
   CloseHandle(th->checking_sema);
   CloseHandle(th->ready_sema);
   CloseHandle(th->you_clean_up_sema);
+
+  rc = dec_refcount(th->refcount);
+  if (!rc) CloseHandle(th->fd);
+
   free(th->buffer);
   free(th);
 }
@@ -5906,7 +6007,8 @@ static long flush_fd(Scheme_Output_Port *op,
 	    oth->ready_sema = sm;
 	    sm = CreateSemaphore(NULL, 1, 1, NULL);
 	    oth->you_clean_up_sema = sm;
-
+	    oth->refcount = fop->refcount;
+            
 	    h = CreateThread(NULL, 4096, (LPTHREAD_START_ROUTINE)WindowsFDWriter, oth, 0, &id);
 
 	    scheme_remember_thread(h, 1);
@@ -6134,10 +6236,6 @@ fd_write_string(Scheme_Output_Port *port,
   return len;
 }
 
-#ifdef WINDOWS_FILE_HANDLES
-typedef BOOL (WINAPI* CSI_proc)(HANDLE);
-#endif
-
 static void
 fd_close_output(Scheme_Output_Port *port)
 {
@@ -6163,32 +6261,15 @@ fd_close_output(Scheme_Output_Port *port)
   if (port->closed)
     return;
 
-  if (fop->refcount)
-    *fop->refcount -= 1;
-
 #ifdef WINDOWS_FILE_HANDLES
   if (fop->oth) {
-    static int tried_csi = 0;
-    static CSI_proc csi;
+    CSI_proc csi;
 
-    START_XFORM_SKIP;      
-    if (!tried_csi) {
-      HMODULE hm;
-      hm = LoadLibrary("kernel32.dll");
-      if (hm)
-	csi = (BOOL (WINAPI*)(HANDLE))GetProcAddress(hm, "CancelSynchronousIo");
-      else
-	csi = NULL;
-      tried_csi = 1;
-    }
-    END_XFORM_SKIP;
+    csi = get_csi();
 
     if (csi) {
+      /* See also call to csi in fd_close_input */
       csi(fop->oth->thread);
-      /* We're hoping that if CancelSyncrhonousIo isn't available, that
-	 CloseHandle() will work, or that WriteFile() didn't block after
-	 all (which seems to be the case with pre-Vista FILE_TYPE_CHAR
-	 handles). */
     }
     CloseHandle(fop->oth->thread);
     fop->oth->done = 1;
@@ -6200,19 +6281,27 @@ fd_close_output(Scheme_Output_Port *port)
       WindowsFDOCleanup(fop->oth);
     } /* otherwise, thread is responsible for clean-up */
     fop->oth = NULL;
-  }
-  if (!fop->refcount || !*fop->refcount) {
-    CloseHandle((HANDLE)fop->fd);
-    --scheme_file_open_count;
+  } else {
+    int rc;
+    rc = dec_refcount(fop->refcount);
+    if (!rc) {
+      CloseHandle((HANDLE)fop->fd);
+      --scheme_file_open_count;
+    }
   }
 #else
-  if (!fop->refcount || !*fop->refcount) {
-    int cr;
-    do {
-      cr = close(fop->fd);
-    } while ((cr == -1) && (errno == EINTR));
-    --scheme_file_open_count;
-  }
+ {
+   int rc;
+   rc = dec_refcount(fop->refcount);
+
+   if (!rc) {
+     int cr;
+     do {
+       cr = close(fop->fd);
+     } while ((cr == -1) && (errno == EINTR));
+     --scheme_file_open_count;
+   }
+ }
 #endif
 }
 
@@ -6290,7 +6379,7 @@ make_fd_output_port(int fd, Scheme_Object *name, int regfile, int win_textmode,
   if (and_read) {
     int *rc;
     Scheme_Object *a[2];
-    rc = (int *)scheme_malloc_atomic(sizeof(int));
+    rc = malloc_refcount();
     *rc = 2;
     fop->refcount = rc;
     a[1] = the_port;
@@ -6382,9 +6471,15 @@ static long WindowsFDWriter(Win_FD_Output_Thread *oth)
 
 static void WindowsFDOCleanup(Win_FD_Output_Thread *oth)
 {
+  int rc;
+
   CloseHandle(oth->lock_sema);
   CloseHandle(oth->work_sema);
   CloseHandle(oth->you_clean_up_sema);
+  
+  rc = dec_refcount(oth->refcount);
+  if (!rc) CloseHandle(oth->fd);
+
   if (oth->buffer)
     free(oth->buffer);
   free(oth);
diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h
index 8a6b5b270e..0ab5091ff3 100644
--- a/src/mzscheme/src/schpriv.h
+++ b/src/mzscheme/src/schpriv.h
@@ -2634,7 +2634,8 @@ void scheme_add_global_constant_symbol(Scheme_Object *name, Scheme_Object *v, Sc
 
 
 
-Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Object *bdg, int is_def, Scheme_Object *phase);
+Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Object *bdg, int is_def, 
+                                Scheme_Object *phase, int *_skipped);
 int scheme_tl_id_is_sym_used(Scheme_Hash_Table *marked_names, Scheme_Object *sym);
 
 Scheme_Object *scheme_sys_wraps(Scheme_Comp_Env *env);
diff --git a/src/mzscheme/src/stxobj.c b/src/mzscheme/src/stxobj.c
index 31ec03d690..b619c3de83 100644
--- a/src/mzscheme/src/stxobj.c
+++ b/src/mzscheme/src/stxobj.c
@@ -3300,7 +3300,7 @@ static int explain_resolves = 0;
 static Scheme_Object *resolve_env(WRAP_POS *_wraps,
                                   Scheme_Object *a, Scheme_Object *orig_phase, 
                                   int w_mod, Scheme_Object **get_names,
-                                  Scheme_Object *skip_ribs)
+                                  Scheme_Object *skip_ribs, int *_binding_marks_skipped)
 /* Module binding ignored if w_mod is 0.
    If module bound, result is module idx, and get_names[0] is set to source name,
      get_names[1] is set to the nominal source module, get_names[2] is set to
@@ -3321,6 +3321,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps,
   Scheme_Object *phase = orig_phase;
   Scheme_Object *bdg = NULL, *floating = NULL;
   Scheme_Hash_Table *export_registry = NULL;
+  int mresult_skipped = 0;
 
   EXPLAIN(printf("Resolving %s [skips: %s]:\n", SCHEME_SYM_VAL(SCHEME_STX_VAL(a)),
                  scheme_write_to_string(skip_ribs ? skip_ribs : scheme_false, NULL)));
@@ -3370,10 +3371,12 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps,
         }
 	stack_pos -= 2;
       }
-      if (!did_lexical)
+      if (!did_lexical) {
 	result = mresult;
-      else if (get_names)
-	get_names[0] = scheme_undefined;
+        if (_binding_marks_skipped)
+          *_binding_marks_skipped = mresult_skipped;
+      } else if (get_names)
+        get_names[0] = scheme_undefined;
 
       EXPLAIN(printf("Result: %s\n", scheme_write_to_string(result, 0)));
 
@@ -3383,6 +3386,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps,
                && w_mod) {
       /* Module rename: */
       Module_Renames *mrn;
+      int skipped;
 
       EXPLAIN(printf("Rename/set\n"));
 	
@@ -3415,7 +3419,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps,
 	  if (mrn->marked_names) {
 	    /* Resolve based on rest of wraps: */
 	    if (!bdg) {
-	      bdg = resolve_env(&wraps, a, orig_phase, 0, NULL, skip_ribs);
+	      bdg = resolve_env(&wraps, a, orig_phase, 0, NULL, skip_ribs, NULL);
               if (SCHEME_FALSEP(bdg)) {
                 if (!floating_checked) {
                   floating = check_floating_id(a);
@@ -3425,7 +3429,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps,
               }
             }
 	    /* Remap id based on marks and rest-of-wraps resolution: */
-	    glob_id = scheme_tl_id_sym((Scheme_Env *)mrn->marked_names, a, bdg, 0, NULL);
+	    glob_id = scheme_tl_id_sym((Scheme_Env *)mrn->marked_names, a, bdg, 0, NULL, &skipped);
 	    if (SCHEME_TRUEP(bdg)
 		&& !SAME_OBJ(glob_id, SCHEME_STX_VAL(a))) {
 	      /* Even if this module doesn't match, the lex-renamed id
@@ -3437,8 +3441,10 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps,
 	      stack_pos = 0;
 	      o_rename_stack = scheme_null;
 	    }
-	  } else
+	  } else {
+            skipped = 0;
 	    glob_id = SCHEME_STX_VAL(a);
+          }
 
           EXPLAIN(printf(" search %s\n", scheme_write_to_string(glob_id, 0)));
 
@@ -3478,6 +3484,8 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps,
 					    modidx_shift_from,
 					    modidx_shift_to);
 
+            mresult_skipped = skipped;
+
 	    if (get_names) {
               int no_shift = 0;
 
@@ -3551,6 +3559,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps,
             }
 	  } else {
 	    mresult = scheme_false;
+            mresult_skipped = 0;
 	    if (get_names)
 	      get_names[0] = NULL;
 	  }
@@ -3647,7 +3656,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps,
 	    	      
 	      if (SCHEME_VOIDP(other_env)) {
 		SCHEME_USE_FUEL(1);
-		other_env = resolve_env(NULL, renamed, 0, 0, NULL, recur_skip_ribs);
+		other_env = resolve_env(NULL, renamed, 0, 0, NULL, recur_skip_ribs, NULL);
 		if (!is_rib)
 		  SCHEME_VEC_ELS(rename)[2+c+ri] = other_env;
 		SCHEME_USE_FUEL(1);
@@ -3806,13 +3815,13 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_
 	  if (mrn->needs_unmarshal) {
 	    /* Use resolve_env to trigger unmarshal, so that we
 	       don't have to implement top/from shifts here: */
-	    resolve_env(NULL, a, orig_phase, 1, NULL, NULL);
+	    resolve_env(NULL, a, orig_phase, 1, NULL, NULL, NULL);
 	  }
 
 	  if (mrn->marked_names) {
 	    /* Resolve based on rest of wraps: */
 	    if (!bdg)
-	      bdg = resolve_env(&wraps, a, orig_phase, 0, NULL, NULL);
+	      bdg = resolve_env(&wraps, a, orig_phase, 0, NULL, NULL, NULL);
             if (SCHEME_FALSEP(bdg))  {
               if (!floating_checked) {
                 floating = check_floating_id(a);
@@ -3821,7 +3830,7 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_
               bdg = floating;
             }
 	    /* Remap id based on marks and rest-of-wraps resolution: */
-	    glob_id = scheme_tl_id_sym((Scheme_Env *)mrn->marked_names, a, bdg, 0, NULL);
+	    glob_id = scheme_tl_id_sym((Scheme_Env *)mrn->marked_names, a, bdg, 0, NULL, NULL);
 	  } else
 	    glob_id = SCHEME_STX_VAL(a);
 
@@ -3892,8 +3901,8 @@ int scheme_stx_module_eq2(Scheme_Object *a, Scheme_Object *b, Scheme_Object *pha
   if ((a == asym) || (b == bsym))
     return 1;
   
-  a = resolve_env(NULL, a, phase, 1, NULL, NULL);
-  b = resolve_env(NULL, b, phase, 1, NULL, NULL);
+  a = resolve_env(NULL, a, phase, 1, NULL, NULL, NULL);
+  b = resolve_env(NULL, b, phase, 1, NULL, NULL, NULL);
 
   if (SAME_TYPE(SCHEME_TYPE(a), scheme_module_index_type))
     a = scheme_module_resolve(a, 0);
@@ -3935,7 +3944,7 @@ Scheme_Object *scheme_stx_module_name(Scheme_Object **a, Scheme_Object *phase,
     names[4] = NULL;
     names[5] = NULL;
 
-    modname = resolve_env(NULL, *a, phase, 1, names, NULL);
+    modname = resolve_env(NULL, *a, phase, 1, names, NULL, NULL);
     
     if (names[0]) {
       if (SAME_OBJ(names[0], scheme_undefined)) {
@@ -3966,7 +3975,7 @@ Scheme_Object *scheme_stx_moduleless_env(Scheme_Object *a)
   if (SCHEME_STXP(a)) {
     Scheme_Object *r;
 
-    r = resolve_env(NULL, a, scheme_make_integer(0), 0, NULL, NULL);
+    r = resolve_env(NULL, a, scheme_make_integer(0), 0, NULL, NULL, NULL);
 
     if (SCHEME_FALSEP(r))
       r = check_floating_id(a);
@@ -3998,13 +4007,13 @@ int scheme_stx_env_bound_eq(Scheme_Object *a, Scheme_Object *b, Scheme_Object *u
   if (!SAME_OBJ(asym, bsym))
     return 0;
 
-  ae = resolve_env(NULL, a, phase, 0, NULL, NULL);
+  ae = resolve_env(NULL, a, phase, 0, NULL, NULL, NULL);
   /* No need to module_resolve ae, because we ignored module renamings. */
 
   if (uid)
     be = uid;
   else {
-    be = resolve_env(NULL, b, phase, 0, NULL, NULL);
+    be = resolve_env(NULL, b, phase, 0, NULL, NULL, NULL);
     /* No need to module_resolve be, because we ignored module renamings. */
   }
 
@@ -4034,7 +4043,7 @@ int scheme_stx_bound_eq(Scheme_Object *a, Scheme_Object *b, Scheme_Object *phase
 Scheme_Object *scheme_explain_resolve_env(Scheme_Object *a)
 {
   explain_resolves++;
-  a = resolve_env(NULL, a, 0, 0, NULL, NULL);
+  a = resolve_env(NULL, a, 0, 0, NULL, NULL, NULL);
   --explain_resolves;
   return a;
 }
@@ -4567,7 +4576,7 @@ static void simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Table *lex_ca
 
 	      other_env = SCHEME_VEC_ELS(v)[2+vvsize+ii];
 	      if (SCHEME_VOIDP(other_env)) {
-		other_env = resolve_env(NULL, stx, 0, 0, NULL, skip_ribs);
+		other_env = resolve_env(NULL, stx, 0, 0, NULL, skip_ribs, NULL);
 		SCHEME_VEC_ELS(v)[2+vvsize+ii] = other_env;
 	      }
 
@@ -5509,7 +5518,7 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w,
       scheme_unmarshal_wrap_set(ut, local_key, a);
     } else if (SCHEME_PAIRP(a)) {
       /* A rename table:
-           - ([#t] <index-num> <phase-num> <bool> [unmarshal] #(<table-elem> ...) 
+           - ([#t] <phase-num> <kind-num> <set-identity> [unmarshal] #(<table-elem> ...)
 	       . ((<sym> (<marked-list-or-mark> . <target-gensym>) ...) ...)) ; <- marked_names
 	where a <table-elem> is actually two values, one of:
            - <exname> <modname>
@@ -6788,7 +6797,7 @@ static Scheme_Object *delta_introducer(int argc, struct Scheme_Object *argv[], S
 
 static Scheme_Object *syntax_transfer_intro(int argc, Scheme_Object **argv)
 {
-  Scheme_Object *m1, *m2, *delta, *a[1];
+  Scheme_Object *orig_m1, *m1, *m2, *delta, *a[1];
   int l1, l2;
 
   if (!SCHEME_STXP(argv[0]))
@@ -6797,6 +6806,7 @@ static Scheme_Object *syntax_transfer_intro(int argc, Scheme_Object **argv)
     scheme_wrong_type("make-syntax-delta-introducer", "syntax", 1, argc, argv);
 
   m1 = scheme_stx_extract_marks(argv[0]);
+  orig_m1 = m1;
   m2 = scheme_stx_extract_marks(argv[1]);
 
   l1 = scheme_list_length(m1);
@@ -6810,11 +6820,32 @@ static Scheme_Object *syntax_transfer_intro(int argc, Scheme_Object **argv)
   }
 
   if (!scheme_equal(m1, m2)) {
-    /* tails don't match, so keep all marks */
-    while (l1) {
-      delta = CONS(SCHEME_CAR(m1), delta);
-      m1 = SCHEME_CDR(m1);
-      l1--;
+    /* tails don't match, so keep all marks --- except those that determine a module binding */
+    int skipped = 0;
+    Scheme_Object *phase;
+    Scheme_Thread *p = scheme_current_thread;
+
+    phase = scheme_make_integer(p->current_local_env
+                                ? p->current_local_env->genv->phase
+                                : 0);
+    resolve_env(NULL, argv[0], phase, 1, NULL, NULL, &skipped);
+
+    if (skipped) {
+      /* Just keep the first `skipped' marks. */
+      delta = scheme_null;
+      m1 = orig_m1;
+      while (skipped) {
+        delta = CONS(SCHEME_CAR(m1), delta);
+        m1 = SCHEME_CDR(m1);
+        skipped--;
+      }
+    } else {
+      /* Keep them all */
+      while (l1) {
+        delta = CONS(SCHEME_CAR(m1), delta);
+        m1 = SCHEME_CDR(m1);
+        l1--;
+      }
     }
   }
 
diff --git a/src/mzscheme/src/syntax.c b/src/mzscheme/src/syntax.c
index e095659f65..b3534c2053 100644
--- a/src/mzscheme/src/syntax.c
+++ b/src/mzscheme/src/syntax.c
@@ -1102,7 +1102,7 @@ defn_targets_syntax (Scheme_Object *var, Scheme_Comp_Env *env, Scheme_Compile_In
     Scheme_Object *name, *pr, *bucket;
 
     name = SCHEME_STX_CAR(var);
-    name = scheme_tl_id_sym(env->genv, name, NULL, 2, NULL);
+    name = scheme_tl_id_sym(env->genv, name, NULL, 2, NULL, NULL);
 
     if (rec[drec].resolve_module_ids || !env->genv->module) {
       bucket = (Scheme_Object *)scheme_global_bucket(name, env->genv);
@@ -5373,7 +5373,7 @@ static Scheme_Object *stx_val(Scheme_Object *name, Scheme_Object *_env)
 {
   Scheme_Env *env = (Scheme_Env *)_env;
 
-  return scheme_tl_id_sym(env, name, NULL, 2, NULL);
+  return scheme_tl_id_sym(env, name, NULL, 2, NULL, NULL);
 }
 
 static Scheme_Object *