X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsaptran.lisp;h=cf84c28133cfe4c9f56ddcbd28b589ef28133aef;hb=942e45e3bb73fd55786e4a0ab4590324063c0c89;hp=f709ceabb939765169e5ff9c69c32dd7d09bdeb8;hpb=78fa16bf55be44cc16845be84d98023e83fb14bc;p=sbcl.git diff --git a/src/compiler/saptran.lisp b/src/compiler/saptran.lisp index f709cea..cf84c28 100644 --- a/src/compiler/saptran.lisp +++ b/src/compiler/saptran.lisp @@ -14,36 +14,35 @@ ;;;; 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) - (simple-string &optional boolean)) +(deftransform foreign-symbol-sap ((symbol &optional datap) + (simple-string &optional boolean)) #!-linkage-table (if (null datap) - (give-up-ir1-transform) - `(foreign-symbol-address symbol)) + (give-up-ir1-transform) + `(foreign-symbol-sap symbol)) #!+linkage-table (if (and (constant-lvar-p symbol) (constant-lvar-p datap)) - (let ((name (lvar-value symbol)) - (datap (lvar-value datap))) - (if (or #+sb-xc-host t ; only static symbols on host + (let ((name (lvar-value symbol)) + (datap (lvar-value datap))) + (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 - (give-up-ir1-transform))) + (find-foreign-symbol-in-table name *static-foreign-symbols*)) + `(foreign-symbol-sap ,name) ; VOP + `(foreign-symbol-dataref-sap ,name))) ; VOP + (give-up-ir1-transform))) (defknown (sap< sap<= sap= sap>= sap>) - (system-area-pointer system-area-pointer) boolean + (system-area-pointer system-area-pointer) boolean (movable flushable)) (defknown sap+ (system-area-pointer integer) system-area-pointer (movable flushable)) -(defknown sap- (system-area-pointer system-area-pointer) +(defknown sap- (system-area-pointer system-area-pointer) (signed-byte #.sb!vm::n-word-bits) (movable flushable)) @@ -135,14 +134,14 @@ (flushable)) (defknown %set-sap-ref-single - (system-area-pointer fixnum single-float) single-float + (system-area-pointer fixnum single-float) single-float ()) (defknown %set-sap-ref-double - (system-area-pointer fixnum double-float) double-float + (system-area-pointer fixnum double-float) double-float ()) #!+long-float (defknown %set-sap-ref-long - (system-area-pointer fixnum long-float) long-float + (system-area-pointer fixnum long-float) long-float ()) ;;;; transforms for converting sap relation operators @@ -160,12 +159,12 @@ (deftransform sap+ ((sap offset)) (cond ((and (constant-lvar-p offset) - (eql (lvar-value offset) 0)) - 'sap) - (t - (extract-fun-args sap 'sap+ 2) - '(lambda (sap offset1 offset2) - (sap+ sap (+ offset1 offset2)))))) + (eql (lvar-value offset) 0)) + 'sap) + (t + (extract-fun-args sap 'sap+ 2) + '(lambda (sap offset1 offset2) + (sap+ sap (+ offset1 offset2)))))) (macrolet ((def (fun) `(deftransform ,fun ((sap offset) * *) @@ -202,10 +201,10 @@ #!+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)))))) + `(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)