Update of /cvsroot/sbcl/sbcl/src/compiler/alpha
In directory sc8-pr-cvs1:/tmp/cvs-serv21522/src/compiler/alpha
Modified Files:
Tag: alpha64_branch
array.lisp call.lisp debug.lisp float.lisp insts.lisp
macros.lisp static-fn.lisp system.lisp values.lisp
Log Message:
0.8alpha.0.28.alpha64.4
STILL BROKEN. THANKS FOR ASKING.
More 64 bit fixes:
Semi-mechanical {ld,st}l -> {ld,st}q substitution throughout
alpha backend
Mostly mechanical: replace alpha conditionals all through objdef
with alpha32
emit-header-data (xep-allocate-frame): get the padding right
Index: array.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/alpha/array.lisp,v
retrieving revision 1.8
retrieving revision 1.8.24.1
diff -u -d -r1.8 -r1.8.24.1
--- array.lisp 18 Mar 2002 19:08:01 -0000 1.8
+++ array.lisp 17 May 2003 01:49:52 -0000 1.8.24.1
@@ -197,7 +197,7 @@
(inst srl index ,bit-shift temp)
(inst sll temp 2 temp)
(inst addq object temp lip)
- (inst ldl old
+ (inst ldq old
(- (* vector-data-offset n-word-bytes)
other-pointer-lowtag)
lip)
Index: call.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/alpha/call.lisp,v
retrieving revision 1.19.20.1
retrieving revision 1.19.20.2
diff -u -d -r1.19.20.1 -r1.19.20.2
--- call.lisp 14 May 2003 19:00:14 -0000 1.19.20.1
+++ call.lisp 17 May 2003 01:49:53 -0000 1.19.20.2
@@ -136,8 +136,8 @@
(emit-label start-lab)
;; Allocate function header.
(inst simple-fun-header-word)
- (dotimes (i (1- simple-fun-code-offset))
- (inst lword 0))
+ (dotimes (i (* n-word-bytes (1- simple-fun-code-offset)))
+ (inst byte 0))
;; The start of the actual code.
;; Compute CODE from the address of this entry point.
(let ((entry-point (gen-label)))
@@ -307,7 +307,7 @@
(defaults (cons default-lab tn))
(inst blt temp default-lab)
- (inst ldl move-temp (* i n-word-bytes) ocfp-tn)
+ (inst ldq move-temp (* i n-word-bytes) ocfp-tn)
(inst subq temp (fixnumize 1) temp)
(store-stack-tn tn move-temp)))
@@ -710,7 +710,7 @@
`((inst subq csp-tn new-fp nargs-pass)
,@(let ((index -1))
(mapcar (lambda (name)
- `(inst ldl ,name
+ `(inst ldq ,name
,(ash (incf index)
word-shift)
new-fp))
@@ -722,7 +722,7 @@
(any-reg
(inst move ocfp ocfp-pass))
(control-stack
- (inst ldl ocfp-pass
+ (inst ldq ocfp-pass
(ash (tn-offset ocfp)
word-shift)
cfp-tn))))
@@ -731,7 +731,7 @@
(#!-gengc descriptor-reg #!+gengc any-reg
(inst move return-pc return-pc-pass))
(control-stack
- (inst ldl return-pc-pass
+ (inst ldq return-pc-pass
(ash (tn-offset return-pc)
word-shift)
cfp-tn))))
@@ -760,31 +760,31 @@
`((sc-case name
(descriptor-reg (move name name-pass))
(control-stack
- (inst ldl name-pass
+ (inst ldq name-pass
(ash (tn-offset name) word-shift) cfp-tn)
(do-next-filler))
(constant
- (inst ldl name-pass
+ (inst ldq name-pass
(- (ash (tn-offset name) word-shift)
other-pointer-lowtag) code-tn)
(do-next-filler)))
- (inst ldl entry-point
+ (inst ldq entry-point
(- (ash fdefn-raw-addr-slot word-shift)
other-pointer-lowtag) name-pass)
(do-next-filler))
`((sc-case arg-fun
(descriptor-reg (move arg-fun lexenv))
(control-stack
- (inst ldl lexenv
+ (inst ldq lexenv
(ash (tn-offset arg-fun) word-shift) cfp-tn)
(do-next-filler))
(constant
- (inst ldl lexenv
+ (inst ldq lexenv
(- (ash (tn-offset arg-fun) word-shift)
other-pointer-lowtag) code-tn)
(do-next-filler)))
#!-gengc
- (inst ldl function
+ (inst ldq function
(- (ash closure-fun-slot word-shift)
fun-pointer-lowtag) lexenv)
#!-gengc
@@ -794,7 +794,7 @@
(- (ash simple-fun-code-offset word-shift)
fun-pointer-lowtag) entry-point)
#!+gengc
- (inst ldl entry-point
+ (inst ldq entry-point
(- (ash closure-entry-point-slot word-shift)
fun-pointer-lowtag) lexenv)
#!+gengc
@@ -994,7 +994,7 @@
;; Check for the single case.
(inst li (fixnumize 1) a0)
(inst cmpeq nvals-arg a0 temp)
- (inst ldl a0 0 vals-arg)
+ (inst ldq a0 0 vals-arg)
(inst beq temp not-single)
;; Return with one value.
Index: debug.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/alpha/debug.lisp,v
retrieving revision 1.6
retrieving revision 1.6.28.1
diff -u -d -r1.6 -r1.6.28.1
--- debug.lisp 11 Oct 2001 14:05:26 -0000 1.6
+++ debug.lisp 17 May 2003 01:49:53 -0000 1.6.28.1
@@ -38,7 +38,7 @@
(:result-types *)
(:generator 5
(inst addq object offset sap)
- (inst ldl result 0 sap)))
+ (inst ldq result 0 sap)))
(define-vop (read-control-stack-c)
(:translate stack-ref)
@@ -49,7 +49,7 @@
(:results (result :scs (descriptor-reg)))
(:result-types *)
(:generator 4
- (inst ldl result (* offset n-word-bytes) object)))
+ (inst ldq result (* offset n-word-bytes) object)))
(define-vop (write-control-stack)
(:translate %set-stack-ref)
@@ -63,7 +63,7 @@
(:temporary (:scs (sap-reg) :from (:argument 1)) sap)
(:generator 2
(inst addq object offset sap)
- (inst stl value 0 sap)
+ (inst stq value 0 sap)
(move value result)))
(define-vop (write-control-stack-c)
@@ -76,7 +76,7 @@
(:results (result :scs (descriptor-reg)))
(:result-types *)
(:generator 1
- (inst stl value (* offset n-word-bytes) sap)
+ (inst stq value (* offset n-word-bytes) sap)
(move value result)))
Index: float.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/alpha/float.lisp,v
retrieving revision 1.8
retrieving revision 1.8.24.1
diff -u -d -r1.8 -r1.8.24.1
--- float.lisp 16 Mar 2002 21:16:09 -0000 1.8
+++ float.lisp 17 May 2003 01:49:53 -0000 1.8.24.1
@@ -498,7 +498,7 @@
(let ((stack-tn
(sc-case x
(signed-reg
- (inst stl x
+ (inst stq x
(* (tn-offset temp)
n-word-bytes)
(current-nfp-tn vop))
@@ -613,7 +613,7 @@
(current-nfp-tn vop)))
(single-stack
(unless (location= bits res)
- (inst ldl temp
+ (inst ldq temp
(* (tn-offset bits) n-word-bytes)
(current-nfp-tn vop))
(inst stl temp
@@ -666,11 +666,11 @@
(inst sts float
(* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop))
- (inst ldl bits
+ (inst ldq bits
(* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop)))
(single-stack
- (inst ldl bits
+ (inst ldq bits
(* (tn-offset float) n-word-bytes)
(current-nfp-tn vop)))
(descriptor-reg
@@ -699,11 +699,11 @@
(inst stt float
(* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop))
- (inst ldl hi-bits
+ (inst ldq hi-bits
(* (1+ (tn-offset stack-temp)) n-word-bytes)
(current-nfp-tn vop)))
(double-stack
- (inst ldl hi-bits
+ (inst ldq hi-bits
(* (1+ (tn-offset float)) n-word-bytes)
(current-nfp-tn vop)))
(descriptor-reg
@@ -726,11 +726,11 @@
(inst stt float
(* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop))
- (inst ldl lo-bits
+ (inst ldq lo-bits
(* (tn-offset stack-temp) n-word-bytes)
(current-nfp-tn vop)))
(double-stack
- (inst ldl lo-bits
+ (inst ldq lo-bits
(* (tn-offset float) n-word-bytes)
(current-nfp-tn vop)))
(descriptor-reg
Index: insts.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/alpha/insts.lisp,v
retrieving revision 1.12
retrieving revision 1.12.24.1
diff -u -d -r1.12 -r1.12.24.1
--- insts.lisp 19 May 2002 13:55:32 -0000 1.12
+++ insts.lisp 17 May 2003 01:49:53 -0000 1.12.24.1
@@ -539,10 +539,13 @@
(emit-byte segment byte)))
(defun emit-header-data (segment type)
+ ;; this version hardcoded for 8 byte words: change emit-qword to
+ ;; something else for other lengths
+ (aver (= n-word-bytes 8))
(emit-back-patch
- segment 4
+ segment n-word-bytes
(lambda (segment posn)
- (emit-lword segment
+ (emit-qword segment
(logior type
(ash (+ posn (component-header-length))
(- n-widetag-bits word-shift)))))))
Index: macros.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/alpha/macros.lisp,v
retrieving revision 1.15
retrieving revision 1.15.2.1
diff -u -d -r1.15 -r1.15.2.1
--- macros.lisp 3 May 2003 18:27:12 -0000 1.15
+++ macros.lisp 17 May 2003 01:49:53 -0000 1.15.2.1
@@ -37,7 +37,8 @@
`(unless (location= ,n-src ,n-dst)
(inst move ,n-src ,n-dst))))
-(defmacro loadw (result base &optional (offset 0) (lowtag 0))
+;;; this was called loadw, when we had 32 bit words
+(defmacro loadl (result base &optional (offset 0) (lowtag 0))
(once-only ((result result) (base base))
`(inst ldl ,result (- (ash ,offset word-shift) ,lowtag) ,base)))
@@ -45,27 +46,31 @@
(once-only ((result result) (base base))
`(inst ldq ,result (- (ash ,offset word-shift) ,lowtag) ,base)))
-(defmacro storew (value base &optional (offset 0) (lowtag 0))
+(defmacro loadw (&rest stuff) `(loadq ,@stuff))
+
+;;; was storew when we had 32 bit words
+(defmacro storel (value base &optional (offset 0) (lowtag 0))
(once-only ((value value) (base base) (offset offset) (lowtag lowtag))
`(inst stl ,value (- (ash ,offset word-shift) ,lowtag) ,base)))
(defmacro storeq (value base &optional (offset 0) (lowtag 0))
(once-only ((value value) (base base) (offset offset) (lowtag lowtag))
`(inst stq ,value (- (ash ,offset word-shift) ,lowtag) ,base)))
+(defmacro storew (&rest stuff) `(storeq ,@stuff))
(defmacro load-symbol (reg symbol)
(once-only ((reg reg) (symbol symbol))
`(inst lda ,reg (static-symbol-offset ,symbol) null-tn)))
(defmacro load-symbol-value (reg symbol)
- `(inst ldl ,reg
+ `(inst ldq ,reg
(+ (static-symbol-offset ',symbol)
(ash symbol-value-slot word-shift)
(- other-pointer-lowtag))
null-tn))
(defmacro store-symbol-value (reg symbol)
- `(inst stl ,reg
+ `(inst stq ,reg
(+ (static-symbol-offset ',symbol)
(ash symbol-value-slot word-shift)
(- other-pointer-lowtag))
@@ -78,7 +83,7 @@
(n-source source)
(n-offset offset))
`(progn
- (inst ldl ,n-target ,n-offset ,n-source)
+ (inst ldq ,n-target ,n-offset ,n-source)
(inst and ,n-target #xff ,n-target))))
;;; macros to handle the fact that we cannot use the machine native
@@ -259,9 +264,9 @@
(:result-types ,el-type)
(:generator 5
(inst addq object index lip)
- (inst ldl value (- (* ,offset n-word-bytes) ,lowtag) lip)
+ (inst ldq value (- (* ,offset n-word-bytes) ,lowtag) lip)
,@(when (equal scs '(unsigned-reg))
- '((inst mskll value 4 value)))))
+ '((inst mskll value 4 value))))) ; 64bit ?
(define-vop (,(symbolicate name "-C"))
,@(when translate
`((:translate ,translate)))
@@ -274,7 +279,7 @@
(:results (value :scs ,scs))
(:result-types ,el-type)
(:generator 4
- (inst ldl value (- (* (+ ,offset index) n-word-bytes) ,lowtag)
+ (inst ldq value (- (* (+ ,offset index) n-word-bytes) ,lowtag)
object)
,@(when (equal scs '(unsigned-reg))
'((inst mskll value 4 value)))))))
Index: static-fn.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/alpha/static-fn.lisp,v
retrieving revision 1.4
retrieving revision 1.4.24.1
diff -u -d -r1.4 -r1.4.24.1
--- static-fn.lisp 12 Dec 2001 18:33:42 -0000 1.4
+++ static-fn.lisp 17 May 2003 01:49:53 -0000 1.4.24.1
@@ -77,7 +77,7 @@
(cur-nfp (current-nfp-tn vop)))
,@(moves (arg-names) (temp-names))
(inst li (fixnumize ,num-args) nargs)
- (inst ldl entry-point (static-fun-offset symbol) null-tn)
+ (inst ldq entry-point (static-fun-offset symbol) null-tn)
(when cur-nfp
(store-stack-tn nfp-save cur-nfp))
(inst move cfp-tn ocfp)
Index: system.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/alpha/system.lisp,v
retrieving revision 1.10.24.1
retrieving revision 1.10.24.2
diff -u -d -r1.10.24.1 -r1.10.24.2
--- system.lisp 14 May 2003 12:12:03 -0000 1.10.24.1
+++ system.lisp 17 May 2003 01:49:53 -0000 1.10.24.2
@@ -76,10 +76,10 @@
(:results (result :scs (unsigned-reg)))
(:result-types positive-fixnum)
(:generator 6
- (inst ldl temp (- fun-pointer-lowtag) function)
+ (inst ldq temp (- fun-pointer-lowtag) function)
(inst and temp #xff temp)
(inst bis type temp temp)
- (inst stl temp (- fun-pointer-lowtag) function)
+ (inst stq temp (- fun-pointer-lowtag) function)
(move type result)))
@@ -246,6 +246,6 @@
(let ((offset
(- (* (+ index vector-data-offset) n-word-bytes)
other-pointer-lowtag)))
- (inst ldl count offset count-vector)
+ (inst ldq count offset count-vector)
(inst addq count 1 count)
- (inst stl count offset count-vector))))
+ (inst stq count offset count-vector))))
Index: values.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/compiler/alpha/values.lisp,v
retrieving revision 1.5
retrieving revision 1.5.24.1
diff -u -d -r1.5 -r1.5.24.1
--- values.lisp 16 Jan 2002 02:10:42 -0000 1.5
+++ values.lisp 17 May 2003 01:49:53 -0000 1.5.24.1
@@ -112,7 +112,7 @@
(inst move csp-tn dst)
(inst addq csp-tn count csp-tn)
LOOP
- (inst ldl temp 0 src)
+ (inst ldq temp 0 src)
(inst addq src 4 src)
(inst addq dst 4 dst)
(inst stl temp -4 dst)
|