projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
fix "unable to read" compiler-error reporting during SBCL build
[sbcl.git]
/
src
/
compiler
/
ppc
/
insts.lisp
diff --git
a/src/compiler/ppc/insts.lisp
b/src/compiler/ppc/insts.lisp
index
9dceec4
..
8229af3
100644
(file)
--- a/
src/compiler/ppc/insts.lisp
+++ b/
src/compiler/ppc/insts.lisp
@@
-640,8
+640,7
@@
(#.fun-end-breakpoint-trap
(nt "Function end breakpoint trap"))
(#.object-not-instance-trap
(#.fun-end-breakpoint-trap
(nt "Function end breakpoint trap"))
(#.object-not-instance-trap
- (nt "Object not instance trap"))
- )))
+ (nt "Object not instance trap")))))
(eval-when (:compile-toplevel :execute)
(eval-when (:compile-toplevel :execute)
@@
-869,7
+868,7
@@
(when (typep si 'fixup)
(ecase ,fixup
((:ha :l) (note-fixup segment ,fixup si)))
(when (typep si 'fixup)
(ecase ,fixup
((:ha :l) (note-fixup segment ,fixup si)))
- (setq si 0))
+ (setq si (or (fixup-offset si) 0)))
(emit-d-form-inst segment ,op (reg-tn-encoding rt) (reg-tn-encoding ra) si)))))
(define-d-rs-ui-instruction (name op &key (cost 1) other-dependencies)
(emit-d-form-inst segment ,op (reg-tn-encoding rt) (reg-tn-encoding ra) si)))))
(define-d-rs-ui-instruction (name op &key (cost 1) other-dependencies)
@@
-1828,12
+1827,24
@@
(define-instruction-macro extlwi. (ra rs n b)
`(inst rlwinm. ,ra ,rs ,b 0 (1- ,n)))
(define-instruction-macro extlwi. (ra rs n b)
`(inst rlwinm. ,ra ,rs ,b 0 (1- ,n)))
+ (define-instruction-macro extrwi (ra rs n b)
+ `(inst rlwinm ,ra ,rs (mod (+ ,b ,n) 32) (- 32 ,n) 31))
+
+ (define-instruction-macro extrwi. (ra rs n b)
+ `(inst rlwinm. ,ra ,rs (mod (+ ,b ,n) 32) (- 32 ,n) 31))
+
(define-instruction-macro srwi (ra rs n)
`(inst rlwinm ,ra ,rs (- 32 ,n) ,n 31))
(define-instruction-macro srwi. (ra rs n)
`(inst rlwinm. ,ra ,rs (- 32 ,n) ,n 31))
(define-instruction-macro srwi (ra rs n)
`(inst rlwinm ,ra ,rs (- 32 ,n) ,n 31))
(define-instruction-macro srwi. (ra rs n)
`(inst rlwinm. ,ra ,rs (- 32 ,n) ,n 31))
+ (define-instruction-macro clrlwi (ra rs n)
+ `(inst rlwinm ,ra ,rs 0 ,n 31))
+
+ (define-instruction-macro clrlwi. (ra rs n)
+ `(inst rlwinm. ,ra ,rs 0 ,n 31))
+
(define-instruction-macro clrrwi (ra rs n)
`(inst rlwinm ,ra ,rs 0 0 (- 31 ,n)))
(define-instruction-macro clrrwi (ra rs n)
`(inst rlwinm ,ra ,rs 0 0 (- 31 ,n)))
@@
-2077,10
+2088,8
@@
(inst ori temp temp (ldb (byte 16 0) delta))
(inst add dst src temp))))))
(inst ori temp temp (ldb (byte 16 0) delta))
(inst add dst src temp))))))
-;; this function is misnamed. should be compute-code-from-lip,
-;; if the use in xep-allocate-frame is typical
-;; (someone says code = fn - header - label-offset + other-pointer-tag)
-(define-instruction compute-code-from-fn (segment dst src label temp)
+;; code = lip - header - label-offset + other-pointer-tag
+(define-instruction compute-code-from-lip (segment dst src label temp)
(:declare (type tn dst src temp) (type label label))
(:attributes variable-length)
(:dependencies (reads src) (writes dst) (writes temp))
(:declare (type tn dst src temp) (type label label))
(:attributes variable-length)
(:dependencies (reads src) (writes dst) (writes temp))
@@
-2095,6
+2104,7
@@
(component-header-length))))))
;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag
(component-header-length))))))
;; code = lra - other-pointer-tag - header - label-offset + other-pointer-tag
+;; = lra - (header + label-offset)
(define-instruction compute-code-from-lra (segment dst src label temp)
(:declare (type tn dst src temp) (type label label))
(:attributes variable-length)
(define-instruction compute-code-from-lra (segment dst src label temp)
(:declare (type tn dst src temp) (type label label))
(:attributes variable-length)
@@
-2108,6
+2118,7
@@
(component-header-length)))))))
;; lra = code + other-pointer-tag + header + label-offset - other-pointer-tag
(component-header-length)))))))
;; lra = code + other-pointer-tag + header + label-offset - other-pointer-tag
+;; = code + header + label-offset
(define-instruction compute-lra-from-code (segment dst src label temp)
(:declare (type tn dst src temp) (type label label))
(:attributes variable-length)
(define-instruction compute-lra-from-code (segment dst src label temp)
(:declare (type tn dst src temp) (type label label))
(:attributes variable-length)