diff --git a/collects/deinprogramm/deinprogramm-langs.rkt b/collects/deinprogramm/deinprogramm-langs.rkt
index ccdf1b64b7..8759c82758 100644
--- a/collects/deinprogramm/deinprogramm-langs.rkt
+++ b/collects/deinprogramm/deinprogramm-langs.rkt
@@ -1246,10 +1246,12 @@
       ;;  test coverage
       ;;
       
+      ;; WARNING: much code copied from "collects/lang/htdp-langs.rkt"
+      
       (define test-coverage-enabled (make-parameter #t))
       (define current-test-coverage-info (make-thread-cell #f))
       
-      (define (initialize-test-coverage-point key expr)
+      (define (initialize-test-coverage-point expr)
         (unless (thread-cell-ref current-test-coverage-info)
           (let ([ht (make-hasheq)])
             (thread-cell-set! current-test-coverage-info ht)
@@ -1272,15 +1274,19 @@
                        (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)))))
+            (hash-set! ht expr #;(box #f) (mcons #f #f)))))
       
-      (define (test-covered key)
-        (let ([ht (thread-cell-ref current-test-coverage-info)])
-          (and ht
-               (let ([v (hash-ref ht key)])
-                 (and v
-                      (with-syntax ([v v])
-                        #'(set-mcar! v #t)))))))
+      (define (test-covered expr)
+        (let* ([ht (or (thread-cell-ref current-test-coverage-info)
+                       (error 'deinprogramm-langs
+                              "internal-error: no test-coverage table"))]
+               [v (hash-ref ht expr
+                    (lambda ()
+                      (error 'deinprogramm-langs
+                             "internal-error: expression not found: ~.s"
+                             expr)))])
+          #; (lambda () (set-box! v #t))
+          (with-syntax ([v v]) #'(#%plain-app set-mcar! v #t))))
       
       (define-values/invoke-unit et:stacktrace@
         (import et:stacktrace-imports^) (export (prefix et: et:stacktrace^)))
diff --git a/collects/drracket/private/debug.rkt b/collects/drracket/private/debug.rkt
index c38d787b9c..d06a46621a 100644
--- a/collects/drracket/private/debug.rkt
+++ b/collects/drracket/private/debug.rkt
@@ -925,7 +925,7 @@ profile todo:
   
   (define current-test-coverage-info (make-thread-cell #f))
   
-  (define (initialize-test-coverage-point key expr)
+  (define (initialize-test-coverage-point expr)
     (unless (hash? (thread-cell-ref current-test-coverage-info))
       (let ([rep (drracket:rep:current-rep)])
         (when rep
@@ -938,14 +938,14 @@ profile todo:
       (when (hash? ht)
         ;; if rep isn't around, we don't do test coverage...
         ;; this can happen when check syntax expands, for example
-        (hash-set! ht key (mcons #f expr)))))
+        (hash-set! ht expr #;(box #f) (mcons #f #f)))))
   
-  (define (test-covered key)
+  (define (test-covered expr)
     (let ([ht (thread-cell-ref current-test-coverage-info)])
       (and (hash? ht) ;; as in the `when' test in `initialize-test-coverage-point'
-           (let ([v (hash-ref ht key #f)])
-             (and v
-                  (λ () (set-mcar! v #t)))))))
+           (let ([v (hash-ref ht expr #f)])
+             ;; (and v (λ () (set-box! v #t)))
+             (and v (with-syntax ([v v]) #'(#%plain-app set-mcar! v #t)))))))
   
   (define test-coverage-interactions-text<%>
     (interface ()
@@ -1075,7 +1075,6 @@ profile todo:
                [locked-ht (make-hasheq)]
                [already-frozen-ht (make-hasheq)]
                [actions-ht (make-hash)]
-               [on/syntaxes (hash-map ht (λ (_ pr) pr))]
                
                ;; can-annotate : (listof (list boolean srcloc))
                ;; boolean is #t => code was run
@@ -1083,17 +1082,17 @@ profile todo:
                ;; remove those that cannot be annotated
                [can-annotate
                 (filter values
-                        (map (λ (pr)
-                               (let ([stx (mcdr pr)])
-                                 (and (syntax? stx)
-                                      (let ([src (syntax-source stx)]
-                                            [pos (syntax-position stx)]
-                                            [span (syntax-span stx)])
-                                        (and pos
-                                             span
-                                             (send (get-defs) port-name-matches? src)
-                                             (list (mcar pr) (make-srcloc (get-defs) #f #f pos span)))))))
-                             on/syntaxes))]
+                        (hash-map ht
+                          (λ (stx covered?)
+                            (and (syntax? stx)
+                                 (let ([src (syntax-source stx)]
+                                       [pos (syntax-position stx)]
+                                       [span (syntax-span stx)])
+                                   (and pos
+                                        span
+                                        (send (get-defs) port-name-matches? src)
+                                        (list (mcar covered?)
+                                              (make-srcloc (get-defs) #f #f pos span))))))))]
                
                ;; filtered : (listof (list boolean srcloc))
                ;; remove redundant expressions
diff --git a/collects/errortrace/errortrace-lib.rkt b/collects/errortrace/errortrace-lib.rkt
index 43fd6a364e..d7a11da398 100644
--- a/collects/errortrace/errortrace-lib.rkt
+++ b/collects/errortrace/errortrace-lib.rkt
@@ -66,7 +66,7 @@
 ;; expressions with test suite coverage information.  Returning the
 ;; first argument means no tests coverage information is collected.
 
-;; test-coverage-point : syntax syntax -> (values syntax info)
+;; test-coverage-point : syntax syntax integer -> (values syntax info)
 ;; sets a test coverage point for a single expression
 (define (test-coverage-point body expr phase)
   (if (and (test-coverage-enabled) (zero? phase))
@@ -240,10 +240,8 @@
         (with-syntax ([key (datum->syntax #f key (quote-syntax here))]
                       [expr expr]
                       [register-executed-once register-executed-once]);<- 3D!
-          (syntax
-           (begin
-             (register-executed-once 'key)
-             expr))))
+          #'(begin (register-executed-once 'key)
+                   expr)))
       expr))
 
 (define (get-execute-counts)
diff --git a/collects/errortrace/scribblings/errortrace.scrbl b/collects/errortrace/scribblings/errortrace.scrbl
index b7ee22db0e..9567e8d832 100644
--- a/collects/errortrace/scribblings/errortrace.scrbl
+++ b/collects/errortrace/scribblings/errortrace.scrbl
@@ -418,27 +418,31 @@ be wrapped.}
 Determines if the test coverage annotation is inserted into the code.
 This parameter controls how compilation happens---it does not affect the
 dynamic behavior of the already compiled code. If the parameter is set,
-calls to @schemein[test-covered] are inserted into the code (and
+code generated by @schemein[test-covered] are inserted into the code (and
 @schemein[initialize-test-coverage-point] is called during compilation).
-If not, no calls to test-covered are inserted.}
+If not, no calls to @scheme[test-covered] code are inserted.}
 
-@defproc[(test-covered (key any/c)) (or/c (-> void?) syntax? #f)]{
-This is called during compilation of the program with a key value once
- for each point with the key for that program point that was passed to
+@defproc[(test-covered (stx any/c)) (or/c syntax? (-> void?) #f)]{
+This is called during compilation of the program with an expression for
+each point in the program that was passed to
 @schemein[initialize-test-coverage-point].
 
-If the result is @scheme[#f], this program point is not
-instrumented. If the result is syntax, it is inserted into the code,
-and if it is a thunk, the thunk is inserted into the code in an
-application. In either case, the syntax or the thunk should register
-that the relevant point was covered.}
+If the result is @scheme[#f], this program point is not instrumented. If
+the result is syntax, it is inserted into the code, and if it is a
+thunk, the thunk is inserted into the code in an application (using the
+thunk directly, as a 3D value). In either case, the syntax or the thunk
+should register that the relevant point was covered.
 
-@defproc[(initialize-test-coverage-point (key any/c) (stx any/c)) void?]{
+Note: using a thunk tends to be slow.  Current uses in the Racket code
+will create a mutable pair in @scheme[initialize-test-coverage-point],
+and @scheme[test-covered] returns syntax that will set its mcar.  (This
+makes the resulting overhead about 3 times smaller.)}
+
+@defproc[(initialize-test-coverage-point (stx any/c)) void?]{
 
 During compilation of the program, this function is called with each
-sub-expression of the program. The first argument is a special key
-used to identify this program point. The second argument is the
-syntax of this program point.}
+sub-expression of the program. The argument is the syntax of this program
+point, which is usually used as a key to identify this program point.}
 
 @defthing[profile-key any/c]{
 
diff --git a/collects/errortrace/stacktrace.rkt b/collects/errortrace/stacktrace.rkt
index 2807ba70c4..8739af3e3e 100644
--- a/collects/errortrace/stacktrace.rkt
+++ b/collects/errortrace/stacktrace.rkt
@@ -85,20 +85,17 @@
          (if (and (test-coverage-enabled)
                   (zero? phase)
                   (syntax-position expr))
-             (let* ([key (gensym 'test-coverage-point)])
-               (initialize-test-coverage-point key expr)
-               (let ([thunk (test-covered key)])
-                 (cond
-                   [(procedure? thunk)
-                    (with-syntax ([body body]
-                                  [thunk thunk])
-                      #'(begin (#%plain-app thunk) body))]
-                   [(syntax? thunk)
-                    (with-syntax ([body body]
-                                  [thunk thunk])
-                      #'(begin thunk body))]
-                   [else
-                    body])))
+             (begin (initialize-test-coverage-point expr)
+                    (let ([thunk (test-covered expr)])
+                      (cond [(procedure? thunk)
+                             (with-syntax ([body body]
+                                           [thunk thunk])
+                               #'(begin (#%plain-app thunk) body))]
+                            [(syntax? thunk)
+                             (with-syntax ([body body]
+                                           [thunk thunk])
+                               #'(begin thunk body))]
+                            [else body])))
              body))
 
 
diff --git a/collects/lang/htdp-langs.rkt b/collects/lang/htdp-langs.rkt
index 6c11906e74..a5ba78d5ae 100644
--- a/collects/lang/htdp-langs.rkt
+++ b/collects/lang/htdp-langs.rkt
@@ -1076,7 +1076,7 @@
       (define test-coverage-enabled (make-parameter #t))
       (define current-test-coverage-info (make-thread-cell #f))
       
-      (define (initialize-test-coverage-point key expr)
+      (define (initialize-test-coverage-point expr)
         (unless (thread-cell-ref current-test-coverage-info)
           (let ([ht (make-hasheq)])
             (thread-cell-set! current-test-coverage-info ht)
@@ -1144,16 +1144,19 @@
                        (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)))))
+            (hash-set! ht expr #;(box #f) (mcons #f #f)))))
       
-      (define (test-covered key)
-        (let* ([ht (thread-cell-ref current-test-coverage-info)]
-               [v (and ht (hash-ref ht key #f))])
-          (with-syntax ([v v])
-            #'(set-mcar! v #t))
-          #;
-          (and v
-               (λ () (set-mcar! v #t)))))
+      (define (test-covered expr)
+        (let* ([ht (or (thread-cell-ref current-test-coverage-info)
+                       (error 'htdp-langs
+                              "internal-error: no test-coverage table"))]
+               [v (hash-ref ht expr
+                    (lambda ()
+                      (error 'htdp-langs
+                             "internal-error: expression not found: ~.s"
+                             expr)))])
+          #; (lambda () (set-box! v #t))
+          (with-syntax ([v v]) #'(#%plain-app set-mcar! v #t))))
       
       (define-values/invoke-unit et:stacktrace@
         (import et:stacktrace-imports^) (export (prefix et: et:stacktrace^)))
diff --git a/collects/racket/private/sandbox-coverage.rkt b/collects/racket/private/sandbox-coverage.rkt
index 6b3e891ae4..9c121ecd25 100644
--- a/collects/racket/private/sandbox-coverage.rkt
+++ b/collects/racket/private/sandbox-coverage.rkt
@@ -1,70 +1,73 @@
 ;; This file is is used in the context of sandboxed code, it uses the
 ;; stacktrace interface from errortrace to find uncovered expressions.
-(module sandbox-coverage mzscheme
-  (require errortrace/stacktrace mzlib/unit mzlib/list)
+#lang racket/base
+(require errortrace/stacktrace racket/unit (for-template racket/base))
 
-  ;; Test coverage run-time support
-  (define test-coverage-enabled (make-parameter #t))
-  (define test-coverage-info (make-hash-table))
-  (define (initialize-test-coverage-point key expr)
-    (hash-table-put! test-coverage-info key (mcons expr #f)))
-  (define (test-covered key)
-    (let ([mpair (hash-table-get test-coverage-info key)])
-      (λ () (set-mcdr! mpair #t))))
+;; Test coverage run-time support
+(define test-coverage-enabled (make-parameter #t))
+(define test-coverage-info (make-hasheq))
+(define (initialize-test-coverage-point expr)
+  (hash-set! test-coverage-info expr (mcons #f #f)))
+(define (test-covered expr)
+  (let ([v (hash-ref test-coverage-info expr
+                     (lambda ()
+                       (error 'sandbox-coverage
+                              "internal error: no info for ~.s" expr)))])
+    (and v (with-syntax ([v v]) #'(#%plain-app set-mcar! v #t)))))
 
-  (define (get-uncovered-expressions)
-    (let* ([xs (hash-table-map test-coverage-info (lambda (k v) 
-                                                    (cons (mcar v) (mcdr v))))]
-           [xs (filter (lambda (x) (syntax-position (car x))) xs)]
-           [xs (sort xs (lambda (x1 x2)
-                          (let ([p1 (syntax-position (car x1))]
-                                [p2 (syntax-position (car x2))])
-                            (or (< p1 p2) ; earlier first
-                                (and (= p1 p2)
-                                     (> (syntax-span (car x1)) ; wider first
-                                        (syntax-span (car x2))))))))]
-           [xs (reverse xs)])
-      (if (null? xs)
-        xs
-        (let loop ([xs (cdr xs)] [r (list (car xs))])
-          (if (null? xs)
-            (map car (filter (lambda (x) (not (cdr x))) r))
-            (loop (cdr xs)
-                  (cond [(not (and (= (syntax-position (caar xs))
-                                      (syntax-position (caar r)))
-                                   (= (syntax-span (caar xs))
-                                      (syntax-span (caar r)))))
-                         (cons (car xs) r)]
-                        [(cdar r) r]
-                        [else (cons (car xs) (cdr r))])))))))
+(define (get-uncovered-expressions)
+  (let* ([xs (hash-map test-coverage-info
+                       (lambda (k v) (cons k (mcar v))))]
+         [xs (filter (lambda (x) (syntax-position (car x))) xs)]
+         [xs (sort xs (lambda (x1 x2)
+                        (let ([p1 (syntax-position (car x1))]
+                              [p2 (syntax-position (car x2))])
+                          (or (< p1 p2) ; earlier first
+                              (and (= p1 p2)
+                                   (> (syntax-span (car x1)) ; wider first
+                                      (syntax-span (car x2))))))))]
+         [xs (reverse xs)])
+    (if (null? xs)
+      xs
+      (let loop ([xs (cdr xs)] [r (list (car xs))])
+        (if (null? xs)
+          (map car (filter (lambda (x) (not (cdr x))) r))
+          (loop (cdr xs)
+                (cond [(not (and (= (syntax-position (caar xs))
+                                    (syntax-position (caar r)))
+                                 (= (syntax-span (caar xs))
+                                    (syntax-span (caar r)))))
+                       (cons (car xs) r)]
+                      [(cdar r) r]
+                      [else (cons (car xs) (cdr r))])))))))
 
-  (provide get-uncovered-expressions)
+(provide get-uncovered-expressions)
 
-  ;; no profiling
-  (define profile-key #f)
-  (define profiling-enabled (lambda () #f))
-  (define initialize-profile-point void)
-  (define register-profile-start void)
-  (define register-profile-done void)
-  ;; no marks
-  (define (with-mark mark expr) expr)
+;; no profiling
+(define profile-key #f)
+(define profiling-enabled (lambda () #f))
+(define initialize-profile-point void)
+(define register-profile-start void)
+(define register-profile-done void)
+;; no marks
+(define (with-mark mark expr) expr)
 
-  (define-values/invoke-unit/infer stacktrace@)
+(define-values/invoke-unit/infer stacktrace@)
 
-  (define errortrace-compile-handler
-    (let ([orig (current-compile)]
-          [ns (current-namespace)])
-      (lambda (e immediate-eval?)
-        (orig (if (and (eq? ns (current-namespace))
-                       (not (compiled-expression?
-                             (if (syntax? e) (syntax-e e) e))))
-                (annotate-top
-                 (expand-syntax (if (syntax? e)
-                                  e
-                                  (namespace-syntax-introduce
-                                   (datum->syntax-object #f e))))
-                 (namespace-base-phase))
-                e)
-              immediate-eval?))))
+(define errortrace-compile-handler
+  (let ([orig (current-compile)]
+        [ns (current-namespace)])
+    (lambda (e immediate-eval?)
+      (orig (if (and (eq? ns (current-namespace))
+                     (not (compiled-expression?
+                           (if (syntax? e) (syntax-e e) e))))
+              (annotate-top
+               (expand-syntax (if (syntax? e)
+                                e
+                                (namespace-syntax-introduce
+                                 (datum->syntax #f e))))
+               (namespace-base-phase))
+              e)
+            immediate-eval?))))
 
-  (current-compile errortrace-compile-handler))
+(current-compile errortrace-compile-handler)