diff --git a/pkgs/racket-test/tests/racket/contract/prof.rkt b/pkgs/racket-test/tests/racket/contract/prof.rkt
index a59db9f020..a3372908b1 100644
--- a/pkgs/racket-test/tests/racket/contract/prof.rkt
+++ b/pkgs/racket-test/tests/racket/contract/prof.rkt
@@ -645,4 +645,99 @@
       (eval '(let ([f f]) (f 1))))
    (void))
 
+  (test/spec-passed
+   'contract-marks68
+   '(let ()
+      (define woody%
+        (class object%
+          (define/public (draw who)
+            (format "reach for the sky, ~a" who))
+          (super-new)))
+      (define woody+c%
+        (contract
+         (class/c [draw (->m neg-blame? pos-blame?)])
+         woody% 'pos 'neg))
+      (send (new woody+c%) draw #f)))
+
+  (test/spec-passed
+   'contract-marks69
+   '(let ()
+      (define woody%
+        (class object%
+          (define/public (draw who)
+            (format "reach for the sky, ~a" who))
+          (super-new)))
+      (define woody/hat%
+        (class woody%
+          (field [hat-location 'uninitialized])
+          (define/public (lose-hat) (set! hat-location 'lost))
+          (define/public (find-hat) (set! hat-location 'on-head))
+          (super-new)))
+      (define woody/hat+c%
+        (contract (class/c [draw (->m neg-blame? pos-blame?)]
+                           [lose-hat (->m pos-blame?)]
+                           [find-hat (->m pos-blame?)]
+                           (field [hat-location pos-blame?]))
+                  woody/hat% 'pos 'neg))
+      (get-field hat-location (new woody/hat+c%))
+      (let ([woody (new woody/hat+c%)])
+        (set-field! hat-location woody 'under-the-dresser))))
+
+  (test/spec-passed
+   'contract-marks70
+   '(let ()
+      (define woody%
+        (class object%
+          (define/public (draw who)
+            (format "reach for the sky, ~a" who))
+          (super-new)))
+      (define woody/hat%
+        (class woody%
+          (field [hat-location 'uninitialized])
+          (define/public (lose-hat) (set! hat-location 'lost))
+          (define/public (find-hat) (set! hat-location 'on-head))
+          (super-new)))
+      (define woody/hat+c%
+        (contract (class/c [draw (->m neg-blame? pos-blame?)]
+                           [lose-hat (->m pos-blame?)]
+                           [find-hat (->m pos-blame?)]
+                           (field [hat-location pos-blame?]))
+                  woody/hat% 'pos 'neg))
+      (define woody/hat2%
+        (class woody/hat+c%
+          (inherit-field hat-location)
+          (define/public (eat-hat) (set! hat-location 'stomach))
+          (super-new)))
+      (send (new woody/hat2%) eat-hat)))
+
+  (test/spec-passed
+   'contract-marks71
+   '(let ()
+      (define woody%
+        (class object%
+          (define/public (draw who)
+            (format "reach for the sky, ~a" who))
+          (super-new)))
+      (define woody/init-hat%
+        (class woody%
+          (init init-hat-location)
+          (field [hat-location init-hat-location])
+          (define/public (lose-hat) (set! hat-location 'lost))
+          (define/public (find-hat) (set! hat-location 'on-head))
+          (super-new)))
+      (define woody/init-hat+c%
+        (contract
+         (class/c [draw (->m neg-blame? pos-blame?)]
+                  [lose-hat (->m pos-blame?)]
+                  [find-hat (->m pos-blame?)]
+                  (init [init-hat-location pos-blame?])
+                  (field [hat-location pos-blame?]))
+         woody/init-hat% 'pos 'neg))
+      (get-field hat-location
+                 (new woody/init-hat+c%
+                      [init-hat-location 'lost]))
+      (get-field hat-location
+                 (new woody/init-hat+c%
+                      [init-hat-location 'slinkys-mouth]))))
+
   )
diff --git a/racket/collects/racket/private/class-c-old.rkt b/racket/collects/racket/private/class-c-old.rkt
index 0618e0c02e..a340551950 100644
--- a/racket/collects/racket/private/class-c-old.rkt
+++ b/racket/collects/racket/private/class-c-old.rkt
@@ -164,21 +164,36 @@
     (define external-field-projections
       (for/list ([f (in-list (class/c-fields ctc))]
                  [c (in-list (class/c-field-contracts ctc))])
+        (define pos-blame (blame-add-field-context blame f #:swap? #f))
+        (define neg-blame (blame-add-field-context blame f #:swap? #t))
         (and c
              (let ([p-pos ((contract-late-neg-projection c)
-                           (blame-add-field-context blame f #:swap? #f))]
+                           pos-blame)]
                    [p-neg ((contract-late-neg-projection c)
-                           (blame-add-field-context blame f #:swap? #t))])
-               (cons p-pos p-neg)))))
+                           neg-blame)])
+               (cons (lambda (x pos-party)
+                       (define blame+pos-party (cons pos-blame pos-party))
+                       (with-contract-continuation-mark
+                        blame+pos-party
+                        (p-pos x pos-party)))
+                     (lambda (x neg-party)
+                       (define blame+neg-party (cons neg-blame neg-party))
+                       (with-contract-continuation-mark
+                        blame+neg-party
+                        (p-neg x neg-party))))))))
     
     ;; zip the inits and contracts together for ordered selection
     (define inits+contracts 
       (for/list ([init (in-list (class/c-inits ctc))]
                  [ctc (in-list (class/c-init-contracts ctc))])
-        (if ctc
-            (list init ((contract-late-neg-projection ctc) 
-                        (blame-add-init-context blame init)))
-            (list init #f))))
+        (cond [ctc
+               (define blame* (blame-add-init-context blame init))
+               (define neg-acceptor ((contract-late-neg-projection ctc) blame*))
+               (list init (lambda (x neg-party)
+                            (with-contract-continuation-mark
+                             (cons blame* neg-party)
+                             (neg-acceptor x neg-party))))]
+              [else (list init #f)])))
     
     (λ (cls neg-party)
       (class/c-check-first-order
@@ -411,7 +426,16 @@
              (let* ([blame-acceptor (contract-late-neg-projection c)]
                     [p-pos (blame-acceptor blame)]
                     [p-neg (blame-acceptor bswap)])
-               (cons p-pos p-neg)))))
+               (cons (lambda (x pos-party)
+                       (define blame+pos-party (cons blame pos-party))
+                       (with-contract-continuation-mark
+                        blame+pos-party
+                        (p-pos x pos-party)))
+                     (lambda (x neg-party)
+                       (define blame+neg-party (cons blame neg-party))
+                       (with-contract-continuation-mark
+                        blame+neg-party
+                        (p-neg x neg-party))))))))
     
     (define override-projections
       (for/list ([m (in-list (internal-class/c-overrides internal-ctc))]