commit 219684369f0251b169092d1d3ab47f5eee740e0d
Author: Alastair Bridgewater <nyef_sbcl@lisphacker.com>
Date:   Wed Mar 9 19:22:01 2011 -0500

    x86-64: Emit notes when compiling code that heap-allocates.
    
      * Add a new optimization policy for emitting heap allocation notes.
    
      * Export the symbol for the new policy from SB!C.
    
      * Hack up the ALLOCATION macro to emit a note when the POLICY for the
    NODE associated with the allocation calls for it.
    
      * Fix up VOP ALLOCATE-VECTOR-ON-HEAP to pass a suitable NODE for the
    new policy (the only such fixup required in the x86-64 backend proper).
    
      * The intent here is that (declare (optimize
    (sb-c:note-heap-allocation 1))) or higher will cause a note to be
    emitted for heap allocation...  But it will only work on x86-64.
    
      * The policy is conditional on x86-64, but possibly should be globally
    provided, just not implemented on other targets.
    
      * Any VOP that ends up calling an assembly-routine that does heap
    allocation (bignum overflow, for example) will not trigger the
    allocation note.
    
      * The actual note emitted is almost certainly less than ideal, and the
    choice of function for emitting the note may likewise be less than
    ideal.
    
      * This is more of an implementation sketch than actual tested code.
    In fact, I haven't even bothered compiling it.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index e99ff95..fba0ced 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -387,6 +387,8 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
                "WITH-SOURCE-LOCATION"
                "*SOURCE-LOCATION-THUNKS*"
 
+               #!+x86-64 "NOTE-HEAP-ALLOCATION"
+
                "BRANCH-IF"))
 
    #s(sb-cold:package-data
diff --git a/src/compiler/policies.lisp b/src/compiler/policies.lisp
index 55e5de3..2045c6a 100644
--- a/src/compiler/policies.lisp
+++ b/src/compiler/policies.lisp
@@ -136,3 +136,8 @@ debugger.")
 (define-optimization-quality store-coverage-data
     0
   ("no" "no" "yes" "yes"))
+
+#!+x86-64
+(define-optimization-quality note-heap-allocation
+    0
+  ("no" "yes" "yes" "yes"))
diff --git a/src/compiler/x86-64/alloc.lisp b/src/compiler/x86-64/alloc.lisp
index 9e44853..dcd4c8f 100644
--- a/src/compiler/x86-64/alloc.lisp
+++ b/src/compiler/x86-64/alloc.lisp
@@ -78,13 +78,14 @@
               positive-fixnum
               positive-fixnum)
   (:policy :fast-safe)
+  (:node-var node)
   (:generator 100
     (inst lea result (make-ea :byte :base words :disp
                               (+ (1- (ash 1 n-lowtag-bits))
                                  (* vector-data-offset n-word-bytes))))
     (inst and result (lognot lowtag-mask))
     (pseudo-atomic
-      (allocation result result)
+      (allocation result result node)
       (inst lea result (make-ea :byte :base result :disp other-pointer-lowtag))
       (storew type result 0 other-pointer-lowtag)
       (storew length result vector-length-slot other-pointer-lowtag))))
diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp
index b7b0aa9..03e69a9 100644
--- a/src/compiler/x86-64/macros.lisp
+++ b/src/compiler/x86-64/macros.lisp
@@ -158,11 +158,16 @@
     (inst lea alloc-tn (make-ea :byte :base alloc-tn :disp lowtag)))
   (values))
 
-(defun allocation (alloc-tn size &optional ignored dynamic-extent lowtag)
-  (declare (ignore ignored))
+(defun allocation (alloc-tn size &optional node dynamic-extent lowtag)
   (when dynamic-extent
     (allocation-dynamic-extent alloc-tn size lowtag)
     (return-from allocation (values)))
+  (when (and node
+             (policy node (> note-heap-allocation 0)))
+    ;; FIXME: M-C-N is an IR1-level construct, which we are well
+    ;; beyond at this point.  Additionally, it might be nice to come
+    ;; up with a more meaningful note.
+    (maybe-compiler-notify "Heap-allocating."))
   (let ((NOT-INLINE (gen-label))
         (DONE (gen-label))
         ;; Yuck.