From dcb73f3edef1e31078fbe585e2fafbd26743efd7 Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Wed, 18 Oct 2006 13:59:21 +0000 Subject: [PATCH] 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 | 1 + src/code/late-alieneval.lisp | 59 ++++++++++++++++++++++++++++++++++++++++ src/code/target-alieneval.lisp | 42 ---------------------------- tests/alien.impure.lisp | 4 +++ version.lisp-expr | 2 +- 5 files changed, 65 insertions(+), 43 deletions(-) create mode 100644 src/code/late-alieneval.lisp diff --git a/build-order.lisp-expr b/build-order.lisp-expr index 6109208..20aa67c 100644 --- a/build-order.lisp-expr +++ b/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.) diff --git a/src/code/late-alieneval.lisp b/src/code/late-alieneval.lisp new file mode 100644 index 0000000..b9d9aab --- /dev/null +++ b/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))))))) diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp index 6784be3..e664b37 100644 --- a/src/code/target-alieneval.lisp +++ b/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)) diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp index 6c6b002..4619da3 100644 --- a/tests/alien.impure.lisp +++ b/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 diff --git a/version.lisp-expr b/version.lisp-expr index 17cc52d..157053f 100644 --- a/version.lisp-expr +++ b/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" -- 1.7.10.4