Commit b4634504 authored by Nikodemus Siivola's avatar Nikodemus Siivola
Browse files

1.0.24.30: fixed and tested some more cleanups on hppa-hpux 

 * Fix a stray #+ -> #!+.

 * Removed unneeded nops.

 * Explanation of magic numbers (but not yet substituted.)

   (Above changes in patch by Larry Valkama)

 * Fix a bunch of comments in the HPPA backend to use the right number
   of semicolons, and use FIXME-lav instead of FIX-lav to mark things
   (better grepping for the rest of us.)
parent 734d12cd

CREDITS

+6 −0
Original line number Diff line number Diff line
@@ -784,6 +784,10 @@ Raymond Toy: 
  floating point stuff. Various patches and fixes of his have been

  ported to SBCL, including his Sparc port of linkage-table.



Larry Valkama:

  He resurrected the HPUX port, and worked on the HPPA backend in

  general.



Peter Van Eynde:

  He wrestled the CLISP test suite into a mostly portable test suite

  (clocc ansi-test) which can be used on SBCL, provided a slew of
@@ -821,6 +825,7 @@ DFL David Lichteblau 
DTC  Douglas Crosher

JES  Juho Snellman

JRXR Joshua Ross

LAV  Larry Valkama

MG   Gabor Melis

MNA  Martin Atzmueller

NJF  Nathan Froyd
@@ -830,6 +835,7 @@ PRM Pierre Mai 
PVE  Peter Van Eynde

PW   Paul Werkowski

RAM  Robert MacLachlan

TCR  Tobias Rittweiler

THS  Thiemo Seufer

VJA  Vincent Arkesteijn

WHN  William ("Bill") Newman

src/compiler/hppa/arith.lisp

+8 −8
Original line number Diff line number Diff line
@@ -357,8 +357,8 @@ 
  (:temporary (:sc interior-reg :offset lip-offset) lip)

  (:ignore lip sign) ; fix-lav: why dont we ignore tmp ?

  (:generator 30

    ; looking at the register setup above, not sure if both can clash

    ; maybe it is ok that x and x-pass share register ? like it was

    ;; looking at the register setup above, not sure if both can clash

    ;; maybe it is ok that x and x-pass share register ? like it was

    (unless (location= y y-pass)

      (inst sra x 2 x-pass))

    (let ((fixup (make-fixup 'multiply :assembly-routine)))
@@ -469,11 +469,11 @@ 
      (inst bc := nil y zero-tn zero))

    (move x x-pass)

    (move y y-pass)

    ; really dirty trick to avoid the bug truncate/unsigned vop

    ; followed by move-from/word->fixnum where the result from

    ; the truncate is 0xe39516a7 and move-from-word will treat

    ; the unsigned high number as an negative number.

    ; instead we clear the high bit in the input to truncate.

    ;; really dirty trick to avoid the bug truncate/unsigned vop

    ;; followed by move-from/word->fixnum where the result from

    ;; the truncate is 0xe39516a7 and move-from-word will treat

    ;; the unsigned high number as an negative number.

    ;; instead we clear the high bit in the input to truncate.

    (inst li #x1fffffff q)

    (inst comb :<> q y skip :nullify t)

    (inst addi -1 zero-tn q)
@@ -481,7 +481,7 @@ 
    (inst and x-pass q x-pass)

    (inst and y-pass q y-pass)

    SKIP

    ; fix bug#2  (truncate #xe39516a7 #x3) => #0xf687078d,#x0

    ;; fix bug#2  (truncate #xe39516a7 #x3) => #0xf687078d,#x0

    (inst li #x7fffffff q)

    (inst and x-pass q x-pass)

    (let ((fixup (make-fixup 'truncate :assembly-routine)))

src/compiler/hppa/array.lisp

+1 −1
Original line number Diff line number Diff line
@@ -22,7 +22,7 @@ 
  (:temporary (:scs (non-descriptor-reg)) header)

  (:results (result :scs (descriptor-reg)))

  (:generator 13

    ; Note: Cant use addi, the immediate is too large

    ;; Note: Cant use addi, the immediate is too large

    (inst li (+ (* (1+ array-dimensions-offset) n-word-bytes)

                lowtag-mask) header)

    (inst add header rank bytes)

src/compiler/hppa/c-call.lisp

+13 −13
Original line number Diff line number Diff line
@@ -11,13 +11,13 @@ 


(in-package "SB!VM")



; beware that we deal alot here with register-offsets directly

; instead of their symbol-name in vm.lisp

; offset works differently depending on sc-type

;;; beware that we deal alot here with register-offsets directly

;;; instead of their symbol-name in vm.lisp

;;; offset works differently depending on sc-type

(defun my-make-wired-tn (prim-type-name sc-name offset state)

  (make-wired-tn (primitive-type-or-lose prim-type-name)

                 (sc-number-or-lose sc-name)

                 ; try to utilize vm.lisp definitions of registers:

                 ;; try to utilize vm.lisp definitions of registers:

                 (ecase sc-name

                   ((any-reg sap-reg signed-reg unsigned-reg)

                     (ecase offset ; FIX: port to other arch ???
@@ -36,9 +36,9 @@ 
                       (3 nl3-offset)))

                   ((single-reg double-reg) ; only for return

                     (+ 4 offset))

                   ; A tn of stack type tells us that we have data on

                   ; stack. This offset is current argument number so

                   ; -1 points to the correct place to write that data

                   ;; A tn of stack type tells us that we have data on

                   ;; stack. This offset is current argument number so

                   ;; -1 points to the correct place to write that data

                   ((sap-stack signed-stack unsigned-stack)

                     (- (arg-state-nargs state) offset 8 1)))))
@@ -260,8 +260,8 @@ 
  (:temporary (:sc any-reg :offset cfunc-offset

                   :from (:argument 0) :to (:result 0)) cfunc)

  (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)

  ; Not sure if using nargs is safe ( have we saved it ).

  ; but we cant use any non-descriptor-reg because c-args nl-4 is of that type

  ;; Not sure if using nargs is safe ( have we saved it ).

  ;; but we cant use any non-descriptor-reg because c-args nl-4 is of that type

  (:temporary (:sc non-descriptor-reg :offset nargs-offset) temp)

  (:vop-var vop)

  (:generator 0
@@ -281,12 +281,12 @@ 
  (:results (result :scs (sap-reg any-reg)))

  (:temporary (:scs (unsigned-reg) :to (:result 0)) temp)

  (:generator 0

    ; Because stack grows to higher addresses, we have the result

    ; pointing to an lowerer address than nsp

    ;; Because stack grows to higher addresses, we have the result

    ;; pointing to an lowerer address than nsp

    (move nsp-tn result)

    (unless (zerop amount)

      ; hp-ux stack grows towards larger addresses and stack must be

      ; allocated in blocks of 64 bytes

      ;; hp-ux stack grows towards larger addresses and stack must be

      ;; allocated in blocks of 64 bytes

      (let ((delta (+ 0 (logandc2 (+ amount 63) 63)))) ; was + 16

        (cond ((< delta (ash 1 10))

               (inst addi delta nsp-tn nsp-tn))

src/compiler/hppa/call.lisp

+8 −5
Original line number Diff line number Diff line
@@ -1025,10 +1025,13 @@ default-value-8 
      (lisp-return lra-arg :offset 2)

      ;; Nope, not the single case.

      (emit-label not-single)

      ;; most of these moves will not be emitted and therefor

      ;; isn't suitable to put in the delay slot below. But if

      ;; you do, dont forget to force-emit as in (move src dst t)

      (move ocfp-arg ocfp)

      (move lra-arg lra)

      (move vals-arg vals)

      (move nvals-arg nvals) ; FIX-lav: cant utilize branch-delay-slot, why?

      (move nvals-arg nvals)

      (let ((fixup (make-fixup 'return-multiple :assembly-routine)))

        (inst ldil fixup tmp)

        (inst be fixup lisp-heap-space tmp :nullify t)))
@@ -1061,7 +1064,7 @@ default-value-8 


;;; Copy a more arg from the argument area to the end of the current frame.

;;; Fixed is the number of non-more arguments.

;;; FIX-lav: old hppa code look smarter.

;;; FIXME-lav: old hppa code look smarter.

(define-vop (copy-more-arg)

  (:temporary (:sc any-reg :offset nl0-offset) result)

  (:temporary (:sc any-reg :offset nl1-offset) count)
@@ -1097,11 +1100,11 @@ default-value-8 
      (inst add nargs-tn cfp-tn src)



      (emit-label loop)

      ; decrease src, then load src into temp

      ;; decrease src, then load src into temp

      (inst ldwm (- n-word-bytes) src temp)

      ; increase, compare if count >= to zero, if true, jump

      ;; increase, compare if count >= to zero, if true, jump

      (inst addib :>= (fixnumize -1) count loop)

      ; decrease dst, then store temp at dst

      ;; decrease dst, then store temp at dst

      (inst stwm temp (- n-word-bytes) dst)



      (emit-label do-regs)