From 584e494d5a426622a1fe82c3c1d24d43b287f123 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 29 Jan 2014 15:19:42 -0500
Subject: [PATCH] Instrument send dispatch for feature-specific profiling.

---
 .../racket/private/class-internal.rkt         |  6 ++--
 racket/collects/racket/private/classidmap.rkt | 36 ++++++++++---------
 2 files changed, 24 insertions(+), 18 deletions(-)

diff --git a/racket/collects/racket/private/class-internal.rkt b/racket/collects/racket/private/class-internal.rkt
index 0e1ab0b7a1..555d41af00 100644
--- a/racket/collects/racket/private/class-internal.rkt
+++ b/racket/collects/racket/private/class-internal.rkt
@@ -3591,7 +3591,8 @@ An example
         (set! arg-list (reverse arg-list))
         (set! let-bindings (reverse let-bindings))
         
-        (quasisyntax/loc stx
+        (syntax-property
+         (quasisyntax/loc stx
           (let*-values ([(sym) (quasiquote (unsyntax (localize name)))]
                         [(receiver) (unsyntax obj)]
                         [(method) (find-method/who '(unsyntax form) receiver sym)])
@@ -3603,7 +3604,8 @@ An example
                (make-method-call-to-possibly-wrapped-object
                 stx kw-args/var arg-list rest-arg?
                 #'sym #'method #'receiver
-                (quasisyntax/loc stx (find-method/who '(unsyntax form) receiver sym)))))))))
+                (quasisyntax/loc stx (find-method/who '(unsyntax form) receiver sym)))))))
+         'feature-profile:send-dispatch #t)))
     
     (define (core-send apply? kws?)
       (lambda (stx)
diff --git a/racket/collects/racket/private/classidmap.rkt b/racket/collects/racket/private/classidmap.rkt
index 1e07205170..f22020e69e 100644
--- a/racket/collects/racket/private/classidmap.rkt
+++ b/racket/collects/racket/private/classidmap.rkt
@@ -438,24 +438,28 @@
               ;; as the object to 'make-method-call' so that the
               ;; arguments end up in the right order.
               (unsyntax
-               (make-method-call
-                stx
-                #`(wrapped-object-neg-party receiver)
-                (syntax/loc stx method)
-                (syntax/loc stx sym)
-                #`((wrapped-object-object #,(syntax/loc stx receiver)) #,@arg-list)
-                rest-arg?
-                kw-args/var))
+               (syntax-property
+                (make-method-call
+                 stx
+                 #`(wrapped-object-neg-party receiver)
+                 (syntax/loc stx method)
+                 (syntax/loc stx sym)
+                 #`((wrapped-object-object #,(syntax/loc stx receiver)) #,@arg-list)
+                 rest-arg?
+                 kw-args/var)
+                'feature-profile:send-dispatch 'antimark))
               (let ([receiver (wrapped-object-object receiver)])
                 (unsyntax
-                 (make-method-call
-                  stx
-                  (syntax/loc stx receiver)
-                  (syntax/loc stx method-in-wrapper-fallback-case)
-                  (syntax/loc stx sym)
-                  arg-list
-                  rest-arg?
-                  kw-args/var))))
+                 (syntax-property
+                  (make-method-call
+                   stx
+                   (syntax/loc stx receiver)
+                   (syntax/loc stx method-in-wrapper-fallback-case)
+                   (syntax/loc stx sym)
+                   arg-list
+                   rest-arg?
+                   kw-args/var)
+                  'feature-profile:send-dispatch 'antimark))))
           (unsyntax
            (make-method-call
             stx