+(defmacro make-alien (type &optional size &environment env)
+ #!+sb-doc
+ "Allocate an alien of type TYPE in foreign heap, and return an alien
+pointer to it. The allocated memory is not initialized, and may
+contain garbage. The memory is allocated using malloc(3), so it can be
+passed to foreign functions which use free(3), or released using
+FREE-ALIEN.
+
+For alien stack allocation, see macro WITH-ALIEN.
+
+The TYPE argument is not evaluated. If SIZE is supplied, how it is
+interpreted depends on TYPE:
+
+ * When TYPE is a foreign array type, an array of that type is
+ allocated, and a pointer to it is returned. Note that you
+ must use DEREF to first access the arrey through the pointer.
+
+ If supplied, SIZE is used as the first dimension for the array.
+
+ * When TYPE is any other foreign type, then an object for that
+ type is allocated, and a pointer to it is returned. So
+ (make-alien int) returns a (* int).
+
+ If SIZE is specified, then a block of that many objects is
+ allocated, with the result pointing to the first one.
+
+Examples:
+
+ (defvar *foo* (make-alien (array char 10)))
+ (type-of *foo*) ; => (alien (* (array (signed 8) 10)))
+ (setf (deref (deref foo) 0) 10) ; => 10
+
+ (make-alien char 12) ; => (alien (* (signed 8)))
+"
+ (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)))
+ ;; This is the one place where the %SAP-ALIEN note is quite
+ ;; undesirable, in most uses of MAKE-ALIEN the %SAP-ALIEN
+ ;; cannot be optimized away.
+ `(locally (declare (muffle-conditions compiler-note))
+ ;; 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)))
+