From 1e9b2eeb4d8d07e6282dc6a747661134ccda8f4c Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Mon, 28 Nov 2011 14:15:31 +0200 Subject: [PATCH] MAKE-ALIEN improvements * Move more of the bytes-calculation to macroexpansion time. * Change %MAKE-ALIEN to take bytes instead of bits, so that --in theory at least-- chunks upto ARRAY-DIMENSION-LIMIT-1 bytes can be allocated. * Use ALIEN-FUNCALL-SAVES-FP-AND-PC 0. * Detect malloc() failure and signal a storage-condition for it. Fixes lp#891268. --- NEWS | 2 ++ src/code/target-alieneval.lisp | 26 ++++++++++++++++++-------- tests/alien.impure.lisp | 7 +++++++ 3 files changed, 27 insertions(+), 8 deletions(-) diff --git a/NEWS b/NEWS index 2f27a07..24ee1fa 100644 --- a/NEWS +++ b/NEWS @@ -7,6 +7,8 @@ changes relative to sbcl-1.0.54: ** --arch option can be used to specify the architecture to build for. (Mainly useful for building 32-bit SBCL's on x86-64 hosts, not full-blows cross-compilation.) + * enhancement: MAKE-ALIEN signals a storage-condition instead of returning a + null alien when malloc() fails. (lp#891268) * optimization: the compiler is smarter about representation selection for floating point constants used in full calls. * bug fix: deadlock detection could report the same deadlock twice, for diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp index e95abe3..aa7922f 100644 --- a/src/code/target-alieneval.lisp +++ b/src/code/target-alieneval.lisp @@ -295,18 +295,28 @@ Examples: ;; undesirable, in most uses of MAKE-ALIEN the %SAP-ALIEN ;; cannot be optimized away. `(locally (declare (muffle-conditions compiler-note)) - (%sap-alien (%make-alien (* ,(align-offset bits alignment) - ,size-expr)) + ;; FIXME: Do we really need the ASH/+7 here after ALIGN-OFFSET? + (%sap-alien (%make-alien (* ,(ash (+ 7 (align-offset bits alignment)) -3) + (the index ,size-expr))) ',(make-alien-pointer-type :to alien-type))))))) +(defun malloc-error (bytes errno) + (error 'simple-storage-condition + :format-control "~A: malloc() of ~S bytes failed." + :format-arguments (list (strerror errno) bytes))) + ;;; Allocate a block of memory at least BITS bits long and return a ;;; system area pointer to it. #!-sb-fluid (declaim (inline %make-alien)) -(defun %make-alien (bits) - (declare (type index bits)) - (alien-funcall (extern-alien "malloc" - (function system-area-pointer unsigned)) - (ash (the index (+ bits 7)) -3))) +(defun %make-alien (bytes) + (declare (type index bytes) + (optimize (sb!c:alien-funcall-saves-fp-and-pc 0))) + (let ((sap (alien-funcall (extern-alien "malloc" + (function system-area-pointer size-t)) + bytes))) + (if (and (not (eql 0 bytes)) (eql 0 (sap-int sap))) + (malloc-error bytes (get-errno)) + sap))) #!-sb-fluid (declaim (inline free-alien)) (defun free-alien (alien) @@ -329,7 +339,7 @@ allocated by MAKE-ALIEN, MAKE-ALIEN-STRING or malloc(3)." :external-format external-format :null-terminate null-terminate)) (count (length octets)) - (buf (%make-alien (* 8 count)))) + (buf (%make-alien count))) (sb!kernel:copy-ub8-to-system-area octets 0 buf 0 count) buf)) diff --git a/tests/alien.impure.lisp b/tests/alien.impure.lisp index c235b63..b490961 100644 --- a/tests/alien.impure.lisp +++ b/tests/alien.impure.lisp @@ -324,4 +324,11 @@ (assert (equal "This comes from lisp!" (cast alien c-string))) (free-alien alien))) +(with-test (:name :malloc-failure) + (assert (eq :enomem + (handler-case + (sb-alien:make-alien char (1- array-total-size-limit)) + (storage-condition () + :enomem))))) + ;;; success -- 1.7.10.4