Update of /cvsroot/sbcl/sbcl/src/compiler/hppa
In directory fdv4jf1.ch3.sourceforge.com:/tmp/cvs-serv11156/src/compiler/hppa
Modified Files:
call.lisp insts.lisp macros.lisp
Log Message:
1.0.25.58: HPPA fixes from Larry Valkama
Index: call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/hppa/call.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- call.lisp 10 Jan 2009 11:19:22 -0000 1.11
+++ call.lisp 1 Mar 2009 20:34:50 -0000 1.12
@@ -775,11 +775,11 @@
;; Conditionally insert a conditional trap:
(when step-instrumenting
;; Get the symbol-value of SB!IMPL::*STEPPING*
- (inst ldw (- (+ symbol-value-slot
- (truncate (static-symbol-offset 'sb!impl::*stepping*)
- n-word-bytes))
- other-pointer-lowtag)
- null-tn stepping)
+ (loadw stepping null-tn
+ (+ symbol-value-slot
+ (truncate (static-symbol-offset 'sb!impl::*stepping*)
+ n-word-bytes))
+ other-pointer-lowtag)
;; If it's not NIL, trap.
;(inst comb := stepping null-tn step-done-label)
(inst comb := null-tn null-tn step-done-label :nullify t)
@@ -1256,11 +1256,11 @@
(:vop-var vop)
(:generator 3
;; Get the symbol-value of SB!IMPL::*STEPPING*
- (inst ldw (- (+ symbol-value-slot
- (truncate (static-symbol-offset 'sb!impl::*stepping*)
- n-word-bytes))
- other-pointer-lowtag)
- null-tn stepping)
+ (loadw stepping null-tn
+ (+ symbol-value-slot
+ (truncate (static-symbol-offset 'sb!impl::*stepping*)
+ n-word-bytes))
+ other-pointer-lowtag)
;; If it's not NIL, trap.
(inst comb := stepping null-tn DONE :nullify t)
;; CONTEXT-PC will be pointing here when the interrupt is handled,
Index: insts.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/hppa/insts.lisp,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- insts.lisp 12 Jan 2009 11:47:57 -0000 1.11
+++ insts.lisp 1 Mar 2009 20:34:51 -0000 1.12
@@ -783,7 +783,7 @@
(emit-back-patch segment 4
(lambda (segment posn)
(let ((disp (label-relative-displacement target posn)))
- (aver (<= (- (ash 1 16)) disp (1- (ash 1 16))))
+ (aver (typep disp '(signed-byte 17)))
(multiple-value-bind
(w1 w2 w)
(decompose-branch-disp segment disp)
@@ -863,15 +863,12 @@
(emit-back-patch segment 4
(lambda (segment posn)
(let ((disp (label-relative-displacement target posn)))
- (when (not (<= (- (ash 1 11)) disp (1- (ash 1 11))))
- (format t "AVER fail: disp = ~s~%" disp)
- (format t "target = ~s~%" target)
- (format t "posn = ~s~%" posn)
- )
- (aver (<= (- (ash 1 11)) disp (1- (ash 1 11))))
+ ; emit-conditional-branch is used by instruction emitters: MOVB, COMB, ADDB and BB
+ ; which assembles an immediate of total 12 bits (including sign bit).
+ (aver (typep disp '(signed-byte 12)))
(let ((w1 (logior (ash (ldb (byte 10 0) disp) 1)
(ldb (byte 1 10) disp)))
- (w (ldb (byte 1 11) disp)))
+ (w (ldb (byte 1 11) disp))) ; take out the sign bit
(emit-branch segment opcode r2 r1 cond w1 (if nullify 1 0) w))))))
(defun im5-encoding (value)
@@ -1531,7 +1528,7 @@
(lambda (segment posn)
(let ((disp (label-relative-displacement target posn)))
(assemble (segment vop)
- (cond ((<= (- (ash 1 11)) disp (1- (ash 1 11)))
+ (cond ((typep disp '(signed-byte 12))
(inst comb (maybe-negate-cond cond not-p) r1 r2 target)
(inst nop)) ; FIXME-lav, cant nullify when backward branch
(t
@@ -1553,7 +1550,7 @@
(lambda (segment posn delta-if-after)
(let ((disp (label-relative-displacement target posn delta-if-after)))
(when (and (<= 0 disp (1- (ash 1 11)))
- (<= (- (ash 1 4)) imm (1- (ash 1 4))))
+ (typep imm '(signed-byte 5)))
(assemble (segment vop)
(inst comib (maybe-negate-cond cond not-p) imm reg target
:nullify t))
@@ -1561,8 +1558,8 @@
(lambda (segment posn)
(let ((disp (label-relative-displacement target posn)))
(assemble (segment vop)
- (cond ((and (<= (- (ash 1 11)) disp (1- (ash 1 11)))
- (<= (- (ash 1 4)) imm (1- (ash 1 4))))
+ (cond ((and (typep disp '(signed-byte 12))
+ (typep imm '(signed-byte 5)))
(inst comib (maybe-negate-cond cond not-p) imm reg target)
(inst nop))
(t
@@ -1605,7 +1602,7 @@
(lambda (segment posn delta-if-after)
(let ((delta (funcall calc label posn delta-if-after)))
;; WHEN, Why not AVER ?
- (when (<= (- (ash 1 10)) delta (1- (ash 1 10)))
+ (when (typep delta '(signed-byte 11))
(emit-back-patch segment 4
(lambda (segment posn)
(assemble (segment vop)
Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/hppa/macros.lisp,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- macros.lisp 10 Jan 2009 11:19:22 -0000 1.13
+++ macros.lisp 1 Mar 2009 20:34:51 -0000 1.14
@@ -41,7 +41,13 @@
(defmacro load-symbol (reg symbol)
(once-only ((reg reg) (symbol symbol))
- `(inst addi (static-symbol-offset ,symbol) null-tn ,reg)))
+ `(let ((offset (static-symbol-offset ,symbol)))
+ (cond
+ ((typep offset '(signed-byte 11))
+ (inst addi offset null-tn ,reg))
+ (t
+ (inst ldil offset ,reg)
+ (inst ldo offset null-tn ,reg :unsigned t))))))
(defmacro load-symbol-value (reg symbol)
`(inst ldw
|