\f
;;;; DEFKNOWNs
-(defknown foreign-symbol-address (simple-string) system-area-pointer
- (movable flushable))
+#!+linkage-table
+(deftransform foreign-symbol-address ((symbol &optional datap) (simple-string boolean))
+ (if (and (constant-lvar-p symbol) (constant-lvar-p datap))
+ `(sap-int (foreign-symbol-sap symbol datap))
+ (give-up-ir1-transform)))
+
+(deftransform foreign-symbol-sap ((symbol &optional datap)
+ (simple-string &optional boolean))
+ #!-linkage-table
+ (if (null datap)
+ (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
+ (not datap)
+ (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) (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)
(unsigned-byte 32)
())
-#!+alpha
+;; FIXME These are supported natively on alpha and using deftransforms
+;; in compiler/x86/sap.lisp, which in OAO$n$ style need copying to
+;; other 32 bit systems
(defknown sap-ref-64 (system-area-pointer fixnum) (unsigned-byte 64)
(flushable))
-#!+alpha
(defknown %set-sap-ref-64 (system-area-pointer fixnum (unsigned-byte 64))
(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))
(signed-byte 32)
())
-#!+alpha
(defknown signed-sap-ref-64 (system-area-pointer fixnum) (signed-byte 64)
(flushable))
-#!+alpha
(defknown %set-signed-sap-ref-64 (system-area-pointer fixnum (signed-byte 64))
(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)
(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
())
\f
;;;; transforms for converting sap relation operators
-(macrolet ((def-frob (sap-fun int-fun)
+(macrolet ((def (sap-fun int-fun)
`(deftransform ,sap-fun ((x y) * *)
`(,',int-fun (sap-int x) (sap-int y)))))
- (def-frob sap< <)
- (def-frob sap<= <=)
- (def-frob sap= =)
- (def-frob sap>= >=)
- (def-frob sap> >))
+ (def sap< <)
+ (def sap<= <=)
+ (def sap= =)
+ (def sap>= >=)
+ (def sap> >))
\f
;;;; transforms for optimizing SAP+
(deftransform sap+ ((sap offset))
- (cond ((and (constant-continuation-p offset)
- (eql (continuation-value offset) 0))
- 'sap)
- (t
- (extract-function-args sap 'sap+ 2)
- '(lambda (sap offset1 offset2)
- (sap+ sap (+ offset1 offset2))))))
-
-(macrolet ((def-frob (fun)
+ (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))))))
+
+(macrolet ((def (fun)
`(deftransform ,fun ((sap offset) * *)
- (extract-function-args sap 'sap+ 2)
+ (extract-fun-args sap 'sap+ 2)
`(lambda (sap offset1 offset2)
(,',fun sap (+ offset1 offset2))))))
- (def-frob sap-ref-8)
- (def-frob %set-sap-ref-8)
- (def-frob signed-sap-ref-8)
- (def-frob %set-signed-sap-ref-8)
- (def-frob sap-ref-16)
- (def-frob %set-sap-ref-16)
- (def-frob signed-sap-ref-16)
- (def-frob %set-signed-sap-ref-16)
- (def-frob sap-ref-32)
- (def-frob %set-sap-ref-32)
- (def-frob signed-sap-ref-32)
- (def-frob %set-signed-sap-ref-32)
- (def-frob sap-ref-sap)
- (def-frob %set-sap-ref-sap)
- (def-frob sap-ref-single)
- (def-frob %set-sap-ref-single)
- (def-frob sap-ref-double)
- (def-frob %set-sap-ref-double)
+ (def sap-ref-8)
+ (def %set-sap-ref-8)
+ (def signed-sap-ref-8)
+ (def %set-signed-sap-ref-8)
+ (def sap-ref-16)
+ (def %set-sap-ref-16)
+ (def signed-sap-ref-16)
+ (def %set-signed-sap-ref-16)
+ (def sap-ref-32)
+ (def %set-sap-ref-32)
+ (def signed-sap-ref-32)
+ (def %set-signed-sap-ref-32)
+ (def sap-ref-64)
+ (def %set-sap-ref-64)
+ (def signed-sap-ref-64)
+ (def %set-signed-sap-ref-64)
+ (def sap-ref-sap)
+ (def %set-sap-ref-sap)
+ (def sap-ref-single)
+ (def %set-sap-ref-single)
+ (def sap-ref-double)
+ (def %set-sap-ref-double)
;; The original CMUCL code had #!+(and x86 long-float) for this first one,
;; but only #!+long-float for the second. This was redundant, since the
;; LONG-FLOAT target feature only exists on X86. So we removed the
;; redundancy. --njf 2002-01-08
- #!+long-float (def-frob sap-ref-long)
- #!+long-float (def-frob %set-sap-ref-long))
+ #!+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))
projects / sbcl.git / blobdiff