X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fcompiler%2Fsaptran.lisp;h=178e61e5d550d11bfece0226f33bff4c6bd30bd8;hb=1af3faa2b79125b774c2182cab841ed7ee555bed;hp=64f067b166557a4280bc3fbba8a3da30cd453b59;hpb=75b52379bdc2269961af6a1308eca63610f38ac3;p=sbcl.git diff --git a/src/compiler/saptran.lisp b/src/compiler/saptran.lisp index 64f067b..178e61e 100644 --- a/src/compiler/saptran.lisp +++ b/src/compiler/saptran.lisp @@ -14,18 +14,17 @@ ;;;; DEFKNOWNs #!+linkage-table -(deftransform foreign-symbol-address-as-integer ((symbol &optional datap) - (simple-string boolean)) +(deftransform foreign-symbol-address ((symbol &optional datap) (simple-string boolean)) (if (and (constant-lvar-p symbol) (constant-lvar-p datap)) - `(sap-int (foreign-symbol-address symbol datap)) + `(sap-int (foreign-symbol-sap symbol datap)) (give-up-ir1-transform))) -(deftransform foreign-symbol-address ((symbol &optional datap) +(deftransform foreign-symbol-sap ((symbol &optional datap) (simple-string &optional boolean)) #!-linkage-table (if (null datap) (give-up-ir1-transform) - `(foreign-symbol-address symbol)) + `(foreign-symbol-sap symbol)) #!+linkage-table (if (and (constant-lvar-p symbol) (constant-lvar-p datap)) (let ((name (lvar-value symbol)) @@ -33,8 +32,8 @@ (if (or #+sb-xc-host t ; only static symbols on host (not datap) (find-foreign-symbol-in-table name *static-foreign-symbols*)) - `(foreign-symbol-address ,name) ; VOP - `(foreign-symbol-dataref-address ,name))) ; VOP + `(foreign-symbol-sap ,name) ; VOP + `(foreign-symbol-dataref-sap ,name))) ; VOP (give-up-ir1-transform))) (defknown (sap< sap<= sap= sap>= sap>) @@ -43,12 +42,14 @@ (defknown sap+ (system-area-pointer integer) system-area-pointer (movable flushable)) -(defknown sap- (system-area-pointer system-area-pointer) (signed-byte 32) +(defknown sap- (system-area-pointer system-area-pointer) + (signed-byte #.sb!vm::n-word-bits) (movable flushable)) -(defknown sap-int (system-area-pointer) (unsigned-byte #!-alpha 32 #!+alpha 64) +(defknown sap-int (system-area-pointer) + (unsigned-byte #.sb!vm::n-machine-word-bits) (movable flushable)) -(defknown int-sap ((unsigned-byte #!-alpha 32 #!+alpha 64)) +(defknown int-sap ((unsigned-byte #.sb!vm::n-machine-word-bits)) system-area-pointer (movable)) (defknown sap-ref-8 (system-area-pointer fixnum) (unsigned-byte 8) @@ -78,6 +79,14 @@ (unsigned-byte 64) ()) +(defknown sap-ref-word (system-area-pointer fixnum) + (unsigned-byte #.sb!vm::n-machine-word-bits) + (flushable)) +(defknown %set-sap-ref-word + (system-area-pointer fixnum (unsigned-byte #.sb!vm::n-machine-word-bits)) + (unsigned-byte #.sb!vm::n-machine-word-bits) + ()) + (defknown signed-sap-ref-8 (system-area-pointer fixnum) (signed-byte 8) (flushable)) (defknown %set-signed-sap-ref-8 (system-area-pointer fixnum (signed-byte 8)) @@ -102,6 +111,14 @@ (signed-byte 64) ()) +(defknown signed-sap-ref-word (system-area-pointer fixnum) + (signed-byte #.sb!vm::n-machine-word-bits) + (flushable)) +(defknown %set-signed-sap-ref-word + (system-area-pointer fixnum (signed-byte #.sb!vm::n-machine-word-bits)) + (signed-byte #.sb!vm::n-machine-word-bits) + ()) + (defknown sap-ref-sap (system-area-pointer fixnum) system-area-pointer (flushable)) (defknown %set-sap-ref-sap (system-area-pointer fixnum system-area-pointer) @@ -182,3 +199,15 @@ ;; redundancy. --njf 2002-01-08 #!+long-float (def sap-ref-long) #!+long-float (def %set-sap-ref-long)) + +(macrolet ((def (fun args 32-bit 64-bit) + `(deftransform ,fun (,args) + (ecase sb!vm::n-word-bits + (32 '(,32-bit ,@args)) + (64 '(,64-bit ,@args)))))) + (def sap-ref-word (sap offset) sap-ref-32 sap-ref-64) + (def signed-sap-ref-word (sap offset) signed-sap-ref-32 signed-sap-ref-64) + (def %set-sap-ref-word (sap offset value) + %set-sap-ref-32 %set-sap-ref-64) + (def %set-signed-sap-ref-word (sap offset value) + %set-signed-sap-ref-32 %set-signed-sap-ref-64))