0.9.17.15: silence %SAP-ALIEN compiler-note for MAKE-ALIEN in default…

… policy

 * Uses of MAKE-ALIEN are a common source of unavoidable notes about
   unoptimized %SAP-ALIEN, which only serve to mask the ones the user
   can do something about.

build-order.lisp-expr

@@ -305,6 +305,7 @@
  ("src/compiler/policy")
  ("src/compiler/policies")
  ("src/code/typedefs")
+ ("src/code/late-alieneval" :not-host) ; needs POLICY
 
  ;; ("src/code/defbangmacro" was here until sbcl-0.6.7.3.)
 

src/code/late-alieneval.lisp

@@ -0,0 +1,59 @@
+;;;; This file contains parts of the ALIEN implementation that
+;;;; are not part of the compiler, but depend on it.
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+
+(in-package "SB!ALIEN")
+
+(defmacro make-alien (type &optional size &environment env)
+  #!+sb-doc
+  "Allocate an alien of type TYPE and return an alien pointer to it. If SIZE
+is supplied, how it is interpreted depends on TYPE. If TYPE is an array type,
+SIZE is used as the first dimension for the allocated array. If TYPE is not an
+array, then SIZE is the number of elements to allocate. The memory is
+allocated using ``malloc'', so it can be passed to foreign functions which use
+``free''."
+  (let ((alien-type (if (alien-type-p type)
+                        type
+                        (parse-alien-type type env))))
+    (multiple-value-bind (size-expr element-type)
+        (if (alien-array-type-p alien-type)
+            (let ((dims (alien-array-type-dimensions alien-type)))
+              (cond
+                (size
+                 (unless dims
+                   (error
+                    "cannot override the size of zero-dimensional arrays"))
+                 (when (constantp size)
+                   (setf alien-type (copy-alien-array-type alien-type))
+                   (setf (alien-array-type-dimensions alien-type)
+                         (cons (constant-form-value size) (cdr dims)))))
+                (dims
+                 (setf size (car dims)))
+                (t
+                 (setf size 1)))
+              (values `(* ,size ,@(cdr dims))
+                      (alien-array-type-element-type alien-type)))
+            (values (or size 1) alien-type))
+      (let ((bits (alien-type-bits element-type))
+            (alignment (alien-type-alignment element-type)))
+        (unless bits
+          (error "The size of ~S is unknown."
+                 (unparse-alien-type element-type)))
+        (unless alignment
+          (error "The alignment of ~S is unknown."
+                 (unparse-alien-type element-type)))
+        (let ((alloc-form `(%sap-alien (%make-alien (* ,(align-offset bits alignment)
+                                                       ,size-expr))
+                                       ',(make-alien-pointer-type :to alien-type))))
+          (if (sb!c:policy env (> speed 1))
+              alloc-form
+              `(locally (declare (muffle-conditions compiler-note))
+                 ,alloc-form)))))))

src/code/target-alieneval.lisp

@@ -213,48 +213,6 @@
 
 ;;;; allocation/deallocation of heap aliens
 
-(defmacro make-alien (type &optional size &environment env)
-  #!+sb-doc
-  "Allocate an alien of type TYPE and return an alien pointer to it. If SIZE
-   is supplied, how it is interpreted depends on TYPE. If TYPE is an array
-   type, SIZE is used as the first dimension for the allocated array. If TYPE
-   is not an array, then SIZE is the number of elements to allocate. The
-   memory is allocated using ``malloc'', so it can be passed to foreign
-   functions which use ``free''."
-  (let ((alien-type (if (alien-type-p type)
-                        type
-                        (parse-alien-type type env))))
-    (multiple-value-bind (size-expr element-type)
-        (if (alien-array-type-p alien-type)
-            (let ((dims (alien-array-type-dimensions alien-type)))
-              (cond
-               (size
-                (unless dims
-                  (error
-                   "cannot override the size of zero-dimensional arrays"))
-                (when (constantp size)
-                  (setf alien-type (copy-alien-array-type alien-type))
-                  (setf (alien-array-type-dimensions alien-type)
-                        (cons (constant-form-value size) (cdr dims)))))
-               (dims
-                (setf size (car dims)))
-               (t
-                (setf size 1)))
-              (values `(* ,size ,@(cdr dims))
-                      (alien-array-type-element-type alien-type)))
-            (values (or size 1) alien-type))
-      (let ((bits (alien-type-bits element-type))
-            (alignment (alien-type-alignment element-type)))
-        (unless bits
-          (error "The size of ~S is unknown."
-                 (unparse-alien-type element-type)))
-        (unless alignment
-          (error "The alignment of ~S is unknown."
-                 (unparse-alien-type element-type)))
-        `(%sap-alien (%make-alien (* ,(align-offset bits alignment)
-                                     ,size-expr))
-                     ',(make-alien-pointer-type :to alien-type))))))
-
 ;;; Allocate a block of memory at least BITS bits long and return a
 ;;; system area pointer to it.
 #!-sb-fluid (declaim (inline %make-alien))

tests/alien.impure.lisp

@@ -163,4 +163,8 @@
                        (sb-alien:deref (sb-alien:slot a1 'u) 8)
                        (sb-alien:deref (sb-alien:slot a1 'u) 9)))))
 
+(handler-bind ((compiler-note (lambda (c)
+                                (error "bad note! ~A" c))))
+  (funcall (compile nil '(lambda () (sb-alien:make-alien sb-alien:int)))))
+
 ;;; success

version.lisp-expr

@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.17.14"
+"0.9.17.15"