X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-alieneval.lisp;h=e95abe384056faa773a79256cd39788d8b7a269d;hb=4255b37e50876702d2563f3418a44a3f5bf8a2e8;hp=21134891caf7afb780488161ff1bf6bcfc6116c4;hpb=511f4325a18532f48f8c6f99e0a63862b7b25aed;p=sbcl.git

diff --git a/src/code/target-alieneval.lisp b/src/code/target-alieneval.lisp
index 2113489..e95abe3 100644
--- a/src/code/target-alieneval.lisp
+++ b/src/code/target-alieneval.lisp
@@ -229,12 +229,38 @@
 
 (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''."
+  "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))))
@@ -285,11 +311,51 @@ allocated using ``malloc'', so it can be passed to foreign functions which use
 #!-sb-fluid (declaim (inline free-alien))
 (defun free-alien (alien)
   #!+sb-doc
-  "Dispose of the storage pointed to by ALIEN. ALIEN must have been allocated
-   by MAKE-ALIEN or malloc(3)."
+  "Dispose of the storage pointed to by ALIEN. The ALIEN must have been
+allocated by MAKE-ALIEN, MAKE-ALIEN-STRING or malloc(3)."
   (alien-funcall (extern-alien "free" (function (values) system-area-pointer))
                  (alien-sap alien))
   nil)
+
+(declaim (type (sfunction * system-area-pointer) %make-alien-string))
+(defun %make-alien-string (string &key (start 0) end
+                                       (external-format :default)
+                                       (null-terminate t))
+  ;; FIXME: This is slow. We want a function to get the length of the
+  ;; encoded string so we can allocate the foreign memory first and
+  ;; encode directly there.
+  (let* ((octets (string-to-octets string
+                                   :start start :end end
+                                   :external-format external-format
+                                   :null-terminate null-terminate))
+         (count (length octets))
+         (buf (%make-alien (* 8 count))))
+    (sb!kernel:copy-ub8-to-system-area octets 0 buf 0 count)
+    buf))
+
+(defun make-alien-string (string &rest rest
+                                 &key (start 0) end
+                                      (external-format :default)
+                                      (null-terminate t))
+  "Copy part of STRING delimited by START and END into freshly
+allocated foreign memory, freeable using free(3) or FREE-ALIEN.
+Returns the allocated string as a (* CHAR) alien, and the number of
+bytes allocated as secondary value.
+
+The string is encoded using EXTERNAL-FORMAT. If NULL-TERMINATE is
+true (the default), the alien string is terminated by an additional
+null byte.
+"
+  (declare (ignore start end external-format null-terminate))
+  (multiple-value-bind (sap bytes)
+      (apply #'%make-alien-string string rest)
+    (values (%sap-alien sap (parse-alien-type '(* char) nil))
+            bytes)))
+
+(define-compiler-macro make-alien-string (&rest args)
+  `(multiple-value-bind (sap bytes) (%make-alien-string ,@args)
+     (values (%sap-alien sap ',(parse-alien-type '(* char) nil))
+             bytes)))
 
 ;;;; the SLOT operator