adjust DATA-VECTOR-FROM-INITS to avoid full calls to MAKE-ARRAY when possible

[sbcl.git] / src / code / host-alieneval.lisp

diff --git a/src/code/host-alieneval.lisp b/src/code/host-alieneval.lisp
index c29bdd5..eb883db 100644 (file)
--- a/src/code/host-alieneval.lisp
+++ b/src/code/host-alieneval.lisp
@@ -404,15 +404,27 @@
              (:make-load-form-fun sb!kernel:just-dump-it-normally))
   ;; The type of this alien.
   (type (missing-arg) :type alien-type)
-  ;; The form to evaluate to produce the SAP pointing to where in the heap
-  ;; it is.
-  (sap-form (missing-arg)))
+  ;; Its name.
+  (alien-name (missing-arg) :type simple-string)
+  ;; Data or code?
+  (datap (missing-arg) :type boolean))
 (def!method print-object ((info heap-alien-info) stream)
   (print-unreadable-object (info stream :type t)
-    (funcall (formatter "~S ~S")
+    (funcall (formatter "~S ~S~@[ (data)~]")
              stream
-             (heap-alien-info-sap-form info)
-             (unparse-alien-type (heap-alien-info-type info)))))
+             (heap-alien-info-alien-name info)
+             (unparse-alien-type (heap-alien-info-type info))
+             (heap-alien-info-datap info))))
+
+;;; The form to evaluate to produce the SAP pointing to where in the heap
+;;; it is.
+(defun heap-alien-info-sap-form (info)
+  `(foreign-symbol-sap ,(heap-alien-info-alien-name info)
+                       ,(heap-alien-info-datap info)))
+
+(defun heap-alien-info-sap (info)
+  (foreign-symbol-sap (heap-alien-info-alien-name info)
+                      (heap-alien-info-datap info)))
 \f
 ;;;; Interfaces to the different methods
 
@@ -484,7 +496,7 @@
 
 (defun compute-deposit-lambda (type)
   (declare (type alien-type type))
-  `(lambda (sap offset ignore value)
+  `(lambda (value sap offset ignore)
      (declare (type system-area-pointer sap)
               (type unsigned-byte offset)
               (ignore ignore))
@@ -991,7 +1003,7 @@
 
 ;;; FIXME: This is really pretty horrible: we avoid creating new
 ;;; ALIEN-RECORD-TYPE objects when a live one is flitting around the
-;;; system already. This way forwrd-references sans fields get get
+;;; system already. This way forward-references sans fields get
 ;;; "updated" for free to contain the field info. Maybe rename
 ;;; MAKE-ALIEN-RECORD-TYPE to %MAKE-ALIEN-RECORD-TYPE and use
 ;;; ENSURE-ALIEN-RECORD-TYPE instead. --NS 20040729
@@ -1040,7 +1052,8 @@
         (overall-alignment 1)
         (parsed-fields nil))
     (dolist (field fields)
-      (destructuring-bind (var type &key alignment) field
+      (destructuring-bind (var type &key alignment bits offset) field
+        (declare (ignore bits))
         (let* ((field-type (parse-alien-type type env))
                (bits (alien-type-bits field-type))
                (parsed-field
@@ -1056,7 +1069,7 @@
           (setf overall-alignment (max overall-alignment alignment))
           (ecase kind
             (:struct
-             (let ((offset (align-offset total-bits alignment)))
+             (let ((offset (or offset (align-offset total-bits alignment))))
                (setf (alien-record-field-offset parsed-field) offset)
                (setf total-bits (+ offset bits))))
             (:union
@@ -1083,7 +1096,9 @@
   `(,(alien-record-field-name field)
      ,(%unparse-alien-type (alien-record-field-type field))
      ,@(when (alien-record-field-bits field)
-             (list (alien-record-field-bits field)))))
+             (list :bits (alien-record-field-bits field)))
+     ,@(when (alien-record-field-offset field)
+             (list :offset (alien-record-field-offset field)))))
 
 ;;; Test the record fields. Keep a hashtable table of already compared
 ;;; types to detect cycles.