X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fsap.lisp;h=7de8ab9420b79adde6270c16d6708e49b5f5127b;hb=079ef9dad558ca07cb8178ef428bf738112174fa;hp=daf9be8d0fc1ee7f3063dd3335b5224935483b5a;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/compiler/x86/sap.lisp b/src/compiler/x86/sap.lisp
index daf9be8..7de8ab9 100644
--- a/src/compiler/x86/sap.lisp
+++ b/src/compiler/x86/sap.lisp
@@ -10,9 +10,6 @@
 ;;;; files for more information.
 
 (in-package "SB!VM")
-
-(file-comment
- "$Header$")
 
 ;;;; moves and coercions
 
@@ -22,7 +19,7 @@
   (:results (y :scs (sap-reg)))
   (:note "pointer to SAP coercion")
   (:generator 1
-    (loadw y x sap-pointer-slot other-pointer-type)))
+    (loadw y x sap-pointer-slot other-pointer-lowtag)))
 (define-move-vop move-to-sap :move
   (descriptor-reg) (sap-reg))
 
@@ -33,8 +30,8 @@
   (:note "SAP to pointer coercion")
   (:node-var node)
   (:generator 20
-    (with-fixed-allocation (res sap-type sap-size node)
-      (storew sap res sap-pointer-slot other-pointer-type))))
+    (with-fixed-allocation (res sap-widetag sap-size node)
+      (storew sap res sap-pointer-slot other-pointer-lowtag))))
 (define-move-vop move-from-sap :move
   (sap-reg) (descriptor-reg))
 
@@ -54,7 +51,7 @@
   (sap-reg) (sap-reg))
 
 ;;; Move untagged sap arguments/return-values.
-(define-vop (move-sap-argument)
+(define-vop (move-sap-arg)
   (:args (x :target y
 	    :scs (sap-reg))
 	 (fp :scs (any-reg)
@@ -69,16 +66,22 @@
        (if (= (tn-offset fp) esp-offset)
 	   (storew x fp (tn-offset y))	; c-call
 	   (storew x fp (- (1+ (tn-offset y)))))))))
-(define-move-vop move-sap-argument :move-argument
+(define-move-vop move-sap-arg :move-arg
   (descriptor-reg sap-reg) (sap-reg))
 
-;;; Use standard MOVE-ARGUMENT + coercion to move an untagged sap to a
+;;; Use standard MOVE-ARG + coercion to move an untagged sap to a
 ;;; descriptor passing location.
-(define-move-vop move-argument :move-argument
+(define-move-vop move-arg :move-arg
   (sap-reg) (descriptor-reg))
 
 ;;;; SAP-INT and INT-SAP
 
+;;; The function SAP-INT is used to generate an integer corresponding
+;;; to the system area pointer, suitable for passing to the kernel
+;;; interfaces (which want all addresses specified as integers). The
+;;; function INT-SAP is used to do the opposite conversion. The
+;;; integer representation of a SAP is the byte offset of the SAP from
+;;; the start of the address space.
 (define-vop (sap-int)
   (:args (sap :scs (sap-reg) :target int))
   (:arg-types system-area-pointer)
@@ -88,7 +91,6 @@
   (:policy :fast-safe)
   (:generator 1
     (move int sap)))
-
 (define-vop (int-sap)
   (:args (int :scs (unsigned-reg) :target sap))
   (:arg-types unsigned-num)
@@ -494,4 +496,26 @@
   (:result-types system-area-pointer)
   (:generator 2
     (move sap vector)
-    (inst add sap (- (* vector-data-offset word-bytes) other-pointer-type))))
+    (inst add
+	  sap
+	  (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))))
+
+;;; Transforms for 64-bit SAP accessors.
+
+(deftransform sap-ref-64 ((sap offset) (* *))
+  '(logior (sap-ref-32 sap offset)
+           (ash (sap-ref-32 sap (+ offset 4)) 32)))
+
+(deftransform signed-sap-ref-64 ((sap offset) (* *))
+  '(logior (sap-ref-32 sap offset)
+           (ash (signed-sap-ref-32 sap (+ offset 4)) 32)))
+
+(deftransform %set-sap-ref-64 ((sap offset value) (* * *))
+  '(progn
+     (%set-sap-ref-32 sap offset (logand value #xffffffff))
+     (%set-sap-ref-32 sap (+ offset 4) (ash value -32))))
+
+(deftransform %set-signed-sap-ref-64 ((sap offset value) (* * *))
+  '(progn
+     (%set-sap-ref-32 sap offset (logand value #xffffffff))
+     (%set-signed-sap-ref-32 sap (+ offset 4) (ash value -32))))