From dd65639fb561a1cac59f5b0dc03482b8adb5441e Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Sun, 1 Mar 2009 20:34:50 +0000 Subject: [PATCH] 1.0.25.58: HPPA fixes from Larry Valkama --- src/compiler/hppa/call.lisp | 20 ++++++++++---------- src/compiler/hppa/insts.lisp | 23 ++++++++++------------- src/compiler/hppa/macros.lisp | 8 +++++++- version.lisp-expr | 2 +- 4 files changed, 28 insertions(+), 25 deletions(-) diff --git a/src/compiler/hppa/call.lisp b/src/compiler/hppa/call.lisp index 6ec58b6b3..1edc572ba 100644 --- a/src/compiler/hppa/call.lisp +++ b/src/compiler/hppa/call.lisp @@ -775,11 +775,11 @@ default-value-8 ;; 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 @@ default-value-8 (: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, diff --git a/src/compiler/hppa/insts.lisp b/src/compiler/hppa/insts.lisp index fc31a65fa..fac58b474 100644 --- a/src/compiler/hppa/insts.lisp +++ b/src/compiler/hppa/insts.lisp @@ -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) diff --git a/src/compiler/hppa/macros.lisp b/src/compiler/hppa/macros.lisp index 4489af86d..0a5e99140 100644 --- a/src/compiler/hppa/macros.lisp +++ b/src/compiler/hppa/macros.lisp @@ -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 diff --git a/version.lisp-expr b/version.lisp-expr index 5965b9228..ebeb71145 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.25.57" +"1.0.25.58"