sb-alien: some alien refactoring

[sbcl.git] / src / compiler / aliencomp.lisp

diff --git a/src/compiler/aliencomp.lisp b/src/compiler/aliencomp.lisp
index 36226af..56903ce 100644 (file)
--- a/src/compiler/aliencomp.lisp
+++ b/src/compiler/aliencomp.lisp
@@ -63,9 +63,9 @@
   (flushable movable))
 (defknown deport-alloc (alien alien-type) t
   (flushable movable))
-(defknown extract-alien-value (system-area-pointer unsigned-byte alien-type) t
+(defknown %alien-value (system-area-pointer unsigned-byte alien-type) t
   (flushable))
-(defknown deposit-alien-value (system-area-pointer unsigned-byte alien-type t) t
+(defknown (setf %alien-value) (t system-area-pointer unsigned-byte alien-type) t
   ())
 
 (defknown alien-funcall (alien-value &rest *) *
@@ -120,9 +120,9 @@
 (deftransform slot ((alien slot) * * :important t)
   (multiple-value-bind (slot-offset slot-type)
       (find-slot-offset-and-type alien slot)
-    `(extract-alien-value (alien-sap alien)
-                          ,slot-offset
-                          ',slot-type)))
+    `(%alien-value (alien-sap alien)
+                   ,slot-offset
+                   ',slot-type)))
 
 #+nil ;; ### But what about coercions?
 (defoptimizer (%set-slot derive-type) ((alien slot value))
@@ -139,10 +139,10 @@
 (deftransform %set-slot ((alien slot value) * * :important t)
   (multiple-value-bind (slot-offset slot-type)
       (find-slot-offset-and-type alien slot)
-    `(deposit-alien-value (alien-sap alien)
-                          ,slot-offset
-                          ',slot-type
-                          value)))
+    `(setf (%alien-value (alien-sap alien)
+                         ,slot-offset
+                         ',slot-type)
+           value)))
 
 (defoptimizer (%slot-addr derive-type) ((alien slot))
   (block nil
@@ -244,9 +244,9 @@
   (multiple-value-bind (indices-args offset-expr element-type)
       (compute-deref-guts alien indices)
     `(lambda (alien ,@indices-args)
-       (extract-alien-value (alien-sap alien)
-                            ,offset-expr
-                            ',element-type))))
+       (%alien-value (alien-sap alien)
+                     ,offset-expr
+                     ',element-type))))
 
 #+nil ;; ### Again, the value might be coerced.
 (defoptimizer (%set-deref derive-type) ((alien value &rest noise))
@@ -264,10 +264,10 @@
   (multiple-value-bind (indices-args offset-expr element-type)
       (compute-deref-guts alien indices)
     `(lambda (alien value ,@indices-args)
-       (deposit-alien-value (alien-sap alien)
-                            ,offset-expr
-                            ',element-type
-                            value))))
+       (setf (%alien-value (alien-sap alien)
+                           ,offset-expr
+                           ',element-type)
+             value))))
 
 (defoptimizer (%deref-addr derive-type) ((alien &rest noise))
   (declare (ignore noise))
@@ -304,9 +304,9 @@
         (return (make-alien-type-type type))))
     *wild-type*))
 
-(deftransform %heap-alien ((info) * * :important t)
+(deftransform %heap-alien ((info) ((constant-arg heap-alien-info)) * :important t)
   (multiple-value-bind (sap type) (heap-alien-sap-and-type info)
-    `(extract-alien-value ,sap 0 ',type)))
+    `(%alien-value ,sap 0 ',type)))
 
 #+nil ;; ### Again, deposit value might change the type.
 (defoptimizer (%set-heap-alien derive-type) ((info value))
@@ -321,7 +321,7 @@
 
 (deftransform %set-heap-alien ((info value) (heap-alien-info *) * :important t)
   (multiple-value-bind (sap type) (heap-alien-sap-and-type info)
-    `(deposit-alien-value ,sap 0 ',type value)))
+    `(setf (%alien-value ,sap 0 ',type) value)))
 
 (defoptimizer (%heap-alien-addr derive-type) ((info))
   (block nil
@@ -397,7 +397,7 @@
     (/noshow "in DEFTRANSFORM LOCAL-ALIEN" info alien-type)
     (/noshow (local-alien-info-force-to-memory-p info))
     (if (local-alien-info-force-to-memory-p info)
-        `(extract-alien-value var 0 ',alien-type)
+        `(%alien-value var 0 ',alien-type)
         `(naturalize var ',alien-type))))
 
 (deftransform %local-alien-forced-to-memory-p ((info) * * :important t)
@@ -410,7 +410,7 @@
   (let* ((info (lvar-value info))
          (alien-type (local-alien-info-type info)))
     (if (local-alien-info-force-to-memory-p info)
-        `(deposit-alien-value var 0 ',alien-type value)
+        `(setf (%alien-value var 0 ',alien-type) value)
         '(error "This should be eliminated as dead code."))))
 
 (defoptimizer (%local-alien-addr derive-type) ((info var))
@@ -508,9 +508,9 @@
     (%computed-lambda #'compute-deport-lambda type))
   (deftransform deport-alloc ((alien type) * * :important t)
     (%computed-lambda #'compute-deport-alloc-lambda type))
-  (deftransform extract-alien-value ((sap offset type) * * :important t)
+  (deftransform %alien-value ((sap offset type) * * :important t)
     (%computed-lambda #'compute-extract-lambda type))
-  (deftransform deposit-alien-value ((sap offset type value) * * :important t)
+  (deftransform (setf %alien-value) ((value sap offset type) * * :important t)
     (%computed-lambda #'compute-deposit-lambda type)))
 \f
 ;;;; a hack to clean up divisions