[Git][cmucl/cmucl][sparc64-dev] 2 commits: WORD-INDEX-{REF, SET} must shift index left.
Raymond Toy
rtoy at common-lisp.net
Wed Jan 3 05:22:43 UTC 2018
Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl
Commits:
aae9e027 by Raymond Toy at 2018-01-02T21:22:18-08:00
WORD-INDEX-{REF,SET} must shift index left.
The sparc64 port still uses 3 bits for tags, so a fixnum index must be
left shifted by 1 to get the correct byte index when accessing words
(64-bit objects) to/from memory.
- - - - -
f52af343 by Raymond Toy at 2018-01-02T21:22:52-08:00
Add more calls to not-implemented.
Mostly so we can see more things happening.
- - - - -
6 changed files:
- src/compiler/sparc64/alloc.lisp
- src/compiler/sparc64/arith.lisp
- src/compiler/sparc64/array.lisp
- src/compiler/sparc64/c-call.lisp
- src/compiler/sparc64/call.lisp
- src/compiler/sparc64/memory.lisp
Changes:
=====================================
src/compiler/sparc64/alloc.lisp
=====================================
--- a/src/compiler/sparc64/alloc.lisp
+++ b/src/compiler/sparc64/alloc.lisp
@@ -61,6 +61,7 @@
(:variant-vars star)
(:policy :safe)
(:generator 0
+ (emit-not-implemented)
(cond ((zerop num)
(move result null-tn))
((and star (= num 1))
@@ -116,6 +117,7 @@
(:temporary (:scs (any-reg) :from (:argument 0)) boxed)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) unboxed)
(:generator 100
+ (emit-not-implemented)
(inst add boxed boxed-arg (fixnumize (1+ code-trace-table-offset-slot)))
(inst and boxed (lognot lowtag-mask))
(inst srln unboxed unboxed-arg word-shift)
@@ -139,6 +141,7 @@
(:policy :fast-safe)
(:translate make-fdefn)
(:generator 37
+ (emit-not-implemented)
(with-fixed-allocation (result temp fdefn-type fdefn-size)
;; For the linkage-table stuff, we need to look up the address
;; of undefined_tramp from the linkage table instead of using
@@ -156,6 +159,7 @@
(:temporary (:scs (non-descriptor-reg)) temp)
(:results (result :scs (descriptor-reg)))
(:generator 10
+ (emit-not-implemented)
(let ((size (+ length closure-info-offset)))
(with-fixed-allocation (result temp closure-header-type size
:lowtag function-pointer-type
@@ -169,6 +173,7 @@
(:temporary (:scs (non-descriptor-reg)) temp)
(:results (result :scs (descriptor-reg)))
(:generator 10
+ (emit-not-implemented)
(with-fixed-allocation
(result temp value-cell-header-type value-cell-size)
(storew value result value-cell-value-slot other-pointer-type))))
@@ -181,6 +186,7 @@
(:args)
(:results (result :scs (any-reg)))
(:generator 1
+ (emit-not-implemented)
(inst li result unbound-marker-type)))
(define-vop (fixed-alloc)
@@ -190,6 +196,7 @@
(:results (result :scs (descriptor-reg)))
(:temporary (:scs (non-descriptor-reg)) temp)
(:generator 4
+ (emit-not-implemented)
(with-fixed-allocation (result temp type words :lowtag lowtag :stack-p dynamic-extent)
)))
@@ -203,6 +210,7 @@
(:temporary (:scs (non-descriptor-reg)) header)
(:temporary (:scs (any-reg)) temp)
(:generator 6
+ (emit-not-implemented)
(inst add bytes extra (* (1+ words) word-bytes))
(inst slln header bytes (- type-bits vm:fixnum-tag-bits)) ; because bytes is already a fixnum
(inst add header header (+ (ash -2 type-bits) type))
=====================================
src/compiler/sparc64/arith.lisp
=====================================
--- a/src/compiler/sparc64/arith.lisp
+++ b/src/compiler/sparc64/arith.lisp
@@ -336,6 +336,7 @@
(and (backend-featurep :sparc-v9)
(not (backend-featurep :sparc-64)))))
(:generator 12
+ (emit-not-implemented)
(let ((zero (generate-error-code vop division-by-zero-error x y)))
(inst cmp y zero-tn)
(inst b :eq zero #+sparc-v9 :pn)
@@ -370,6 +371,7 @@
(and (backend-featurep :sparc-v9)
(not (backend-featurep :sparc-64)))))
(:generator 8
+ (emit-not-implemented)
(let ((zero (generate-error-code vop division-by-zero-error x y)))
(inst cmp y zero-tn)
(inst b :eq zero #+sparc-v9 :pn)
@@ -400,6 +402,7 @@
(:save-p :compute-only)
(:guard (backend-featurep :sparc-64))
(:generator 8
+ (emit-not-implemented)
(let ((zero (generate-error-code vop division-by-zero-error x y)))
(inst cmp y zero-tn)
(inst b :eq zero :pn)
@@ -456,6 +459,7 @@
(:save-p :compute-only)
(:guard (backend-featurep :sparc-64))
(:generator 8
+ (emit-not-implemented)
(let ((zero (generate-error-code vop division-by-zero-error x y)))
(inst cmp y zero-tn)
(inst b :eq zero :pn)
@@ -482,6 +486,7 @@
(:policy :fast-safe)
(:temporary (:sc non-descriptor-reg) ndesc)
(:generator 5
+ (emit-not-implemented)
(sc-case amount
(signed-reg
(cond ((backend-featurep :sparc-v9)
@@ -539,6 +544,7 @@
(:policy :fast-safe)
(:temporary (:sc non-descriptor-reg) ndesc)
(:generator 5
+ (emit-not-implemented)
(sc-case amount
(signed-reg
(cond ((backend-featurep :sparc-v9)
@@ -594,6 +600,7 @@
(:translate ash)
(:policy :fast-safe)
(:generator 4
+ (emit-not-implemented)
(cond
((< count -31) (move result zero-tn))
((< count 0) (inst srl result number (min (- count) 31)))
@@ -614,6 +621,7 @@
(:result-types ,type)
(:policy :fast-safe)
(:generator ,cost
+ (emit-not-implemented)
;; The result-type assures us that this shift will not
;; overflow. And for fixnum's, the zero bits that get
;; shifted in are just fine for the fixnum tag.
@@ -642,6 +650,7 @@
(:result-types ,type)
(:policy :fast-safe)
(:generator ,cost
+ (emit-not-implemented)
;; The result-type assures us that this shift will not
;; overflow. And for fixnum's, the zero bits that get
;; shifted in are just fine for the fixnum tag.
@@ -716,6 +725,7 @@
(:result-types ,type)
(:policy :fast-safe)
(:generator ,cost
+ (emit-not-implemented)
(sc-case amount
((signed-reg unsigned-reg)
(inst ,shift-inst result number amount))
@@ -748,6 +758,7 @@
(:result-types ,type)
(:policy :fast-safe)
(:generator ,cost
+ (emit-not-implemented)
(if (zerop amount)
(move result number)
(inst ,shift-inst result number amount))))))
@@ -789,6 +800,7 @@
(:temporary (:sc non-descriptor-reg :target result) temp)
(:policy :fast-safe)
(:generator 2
+ (emit-not-implemented)
;; Shift the fixnum right by the desired amount. Then zap out the
;; 2 LSBs to make it a fixnum again. (Those bits are junk.)
(sc-case amount
@@ -811,6 +823,7 @@
(:result-types positive-fixnum)
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) shift)
(:generator 30
+ (emit-not-implemented)
(let ((loop (gen-label))
(test (gen-label)))
(inst addcc shift zero-tn arg)
@@ -837,6 +850,7 @@
(:result-types positive-fixnum)
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) shift)
(:generator 30
+ (emit-not-implemented)
(let ((loop (gen-label))
(test (gen-label)))
(move shift arg)
@@ -862,6 +876,7 @@
(:result-types positive-fixnum)
(:temporary (:scs (non-descriptor-reg) :from (:argument 0)) mask temp)
(:generator 35
+ (emit-not-implemented)
(move res arg)
(dolist (stuff '((1 #x55555555) (2 #x33333333) (4 #x0f0f0f0f)
@@ -886,6 +901,7 @@
(and (backend-featurep :sparc-v9)
(not (backend-featurep :sparc-64)))))
(:generator 2
+ (emit-not-implemented)
;; The cost here should be less than the cost for
;; */signed=>signed. Why? A fixnum product using signed=>signed
;; has to convert both args to signed-nums. But using this, we
@@ -900,6 +916,7 @@
(and (backend-featurep :sparc-v9)
(not (backend-featurep :sparc-64)))))
(:generator 2
+ (emit-not-implemented)
(inst umul r x y)))
(define-vop (fast-v8-*-c/signed=>signed fast-signed-binop-c)
@@ -908,6 +925,7 @@
(and (backend-featurep :sparc-v9)
(not (backend-featurep :sparc-64)))))
(:generator 2
+ (emit-not-implemented)
(inst smul r x y)))
(define-vop (fast-v8-*-c/fixnum=>fixnum fast-safe-arith-op)
@@ -923,6 +941,7 @@
(and (backend-featurep :sparc-v9)
(not (backend-featurep :sparc-64)))))
(:generator 1
+ (emit-not-implemented)
(inst smul r x y)))
@@ -932,6 +951,7 @@
(and (backend-featurep :sparc-v9)
(not (backend-featurep :sparc-64)))))
(:generator 3
+ (emit-not-implemented)
(inst smul r x y)))
(define-vop (fast-v8-*/unsigned=>unsigned fast-unsigned-binop)
@@ -940,6 +960,7 @@
(and (backend-featurep :sparc-v9)
(not (backend-featurep :sparc-64)))))
(:generator 3
+ (emit-not-implemented)
(inst umul r x y)))
;; The smul and umul instructions are deprecated on the Sparc V9. Use
@@ -949,6 +970,7 @@
(:translate *)
(:guard (backend-featurep :sparc-64))
(:generator 4
+ (emit-not-implemented)
(inst sran temp y fixnum-tag-bits)
(inst mulx r x temp)))
@@ -956,12 +978,14 @@
(:translate *)
(:guard (backend-featurep :sparc-64))
(:generator 3
+ (emit-not-implemented)
(inst mulx r x y)))
(define-vop (fast-v9-*/unsigned=>unsigned fast-unsigned-binop)
(:translate *)
(:guard (backend-featurep :sparc-64))
(:generator 3
+ (emit-not-implemented)
(inst mulx r x y)))
@@ -1028,6 +1052,7 @@
suffix)))
(:translate ,tran)
(:generator ,cost
+ (emit-not-implemented)
(inst cmp x
,(if (eq suffix '-c/fixnum) '(fixnumize y) 'y))
(inst b (if not-p
@@ -1062,6 +1087,7 @@
(:note _N"inline fixnum comparison")
(:translate eql)
(:generator 4
+ (emit-not-implemented)
(inst cmp x y)
(inst b (if not-p :ne :eq) target)
(inst nop)))
@@ -1078,6 +1104,7 @@
(:info target not-p y)
(:translate eql)
(:generator 2
+ (emit-not-implemented)
(inst cmp x (fixnumize y))
(inst b (if not-p :ne :eq) target)
(inst nop)))
@@ -1103,6 +1130,7 @@
(:result-types unsigned-num)
(:policy :fast-safe)
(:generator 4
+ (emit-not-implemented)
(let ((done (gen-label)))
(inst cmp shift)
(inst b :eq done)
@@ -1127,11 +1155,13 @@
(:args (x :scs (unsigned-reg zero)))
(:arg-types unsigned-num)
(:generator 1
+ (emit-not-implemented)
(inst not r x)))
(define-vop (32bit-logical-and 32bit-logical)
(:translate 32bit-logical-and)
(:generator 1
+ (emit-not-implemented)
(inst and r x y)))
(deftransform 32bit-logical-nand ((x y) (* *))
@@ -1140,6 +1170,7 @@
(define-vop (32bit-logical-or 32bit-logical)
(:translate 32bit-logical-or)
(:generator 1
+ (emit-not-implemented)
(inst or r x y)))
(deftransform 32bit-logical-nor ((x y) (* *))
@@ -1148,6 +1179,7 @@
(define-vop (32bit-logical-xor 32bit-logical)
(:translate 32bit-logical-xor)
(:generator 1
+ (emit-not-implemented)
(inst xor r x y)))
(define-vop (32bit-logical-eqv 32bit-logical)
@@ -1158,6 +1190,7 @@
(define-vop (32bit-logical-orc2 32bit-logical)
(:translate 32bit-logical-orc2)
(:generator 1
+ (emit-not-implemented)
(inst orn r x y)))
(deftransform 32bit-logical-orc1 ((x y) (* *))
@@ -1166,6 +1199,7 @@
(define-vop (32bit-logical-andc2 32bit-logical)
(:translate 32bit-logical-andc2)
(:generator 1
+ (emit-not-implemented)
(inst andn r x y)))
(deftransform 32bit-logical-andc1 ((x y) (* *))
@@ -1184,12 +1218,14 @@
(:translate shift-towards-start)
(:note _N"shift-towards-start")
(:generator 1
+ (emit-not-implemented)
(inst slln r num amount)))
(define-vop (shift-towards-end shift-towards-someplace)
(:translate shift-towards-end)
(:note _N"shift-towards-end")
(:generator 1
+ (emit-not-implemented)
(inst srln r num amount)))
@@ -1229,6 +1265,7 @@
(:results (result :scs (descriptor-reg)))
(:guard (not (backend-featurep :sparc-v9)))
(:generator 3
+ (emit-not-implemented)
(let ((done (gen-label)))
(inst cmp digit)
(inst b :lt done)
@@ -1244,6 +1281,7 @@
(:results (result :scs (descriptor-reg)))
(:guard (backend-featurep :sparc-v9))
(:generator 3
+ (emit-not-implemented)
(inst cmp digit)
(load-symbol result t)
(inst cmove :lt result null-tn)))
@@ -1275,6 +1313,7 @@
(carry :scs (unsigned-reg)))
(:result-types unsigned-num positive-fixnum)
(:generator 3
+ (emit-not-implemented)
(inst addcc zero-tn c -1)
(inst addxcc result a b)
(inst addx carry zero-tn zero-tn)))
@@ -1290,6 +1329,7 @@
(borrow :scs (unsigned-reg)))
(:result-types unsigned-num positive-fixnum)
(:generator 4
+ (emit-not-implemented)
(inst subcc zero-tn c 1)
(inst subxcc result a b)
(inst addx borrow zero-tn zero-tn)
@@ -1357,6 +1397,7 @@
(lo :scs (unsigned-reg) :from (:eval 1)))
(:result-types unsigned-num unsigned-num)
(:generator 40
+ (emit-not-implemented)
(emit-multiply x y hi lo)
(inst addcc lo carry-in)
(inst addx hi zero-tn)))
@@ -1373,6 +1414,7 @@
(lo :scs (unsigned-reg) :from (:eval 1)))
(:result-types unsigned-num unsigned-num)
(:generator 40
+ (emit-not-implemented)
(emit-multiply x y hi lo)
(inst addcc lo carry-in)
(inst addx hi zero-tn)
@@ -1389,6 +1431,7 @@
(lo :scs (unsigned-reg)))
(:result-types unsigned-num unsigned-num)
(:generator 40
+ (emit-not-implemented)
(emit-multiply x y hi lo)))
(define-vop (bignum-lognot)
@@ -1399,6 +1442,7 @@
(:results (r :scs (unsigned-reg)))
(:result-types unsigned-num)
(:generator 1
+ (emit-not-implemented)
(inst not r x)))
(define-vop (fixnum-to-digit)
@@ -1409,6 +1453,7 @@
(:results (digit :scs (unsigned-reg)))
(:result-types unsigned-num)
(:generator 1
+ (emit-not-implemented)
(inst sran digit fixnum fixnum-tag-bits)))
(define-vop (bignum-floor)
@@ -1424,6 +1469,7 @@
(:guard (not (or (backend-featurep :sparc-v8)
(backend-featurep :sparc-v9))))
(:generator 300
+ (emit-not-implemented)
(move rem div-high)
(move quo div-low)
(dotimes (i 33)
@@ -1454,6 +1500,7 @@
(and (backend-featurep :sparc-v9)
(not (backend-featurep :sparc-64)))))
(:generator 15
+ (emit-not-implemented)
(inst wry div-high)
(inst nop)
(inst nop)
@@ -1480,6 +1527,7 @@
(:result-types unsigned-num unsigned-num)
(:guard (backend-featurep :sparc-64))
(:generator 5
+ (emit-not-implemented)
;; Set dividend to be div-high and div-low
(inst sllx dividend div-high 32)
(inst add dividend div-low)
@@ -1497,6 +1545,7 @@
(:results (res :scs (any-reg signed-reg)))
(:result-types signed-num)
(:generator 1
+ (emit-not-implemented)
(sc-case res
(any-reg
(inst slln res digit fixnum-tag-bits))
@@ -1513,6 +1562,7 @@
(:results (result :scs (unsigned-reg)))
(:result-types unsigned-num)
(:generator 1
+ (emit-not-implemented)
(sc-case count
((signed-reg unsigned-reg)
(inst sran result digit count))
@@ -1522,6 +1572,7 @@
(define-vop (digit-lshr digit-ashr)
(:translate bignum::%digit-logical-shift-right)
(:generator 1
+ (emit-not-implemented)
(sc-case count
((signed-reg unsigned-reg)
(inst srln result digit count))
@@ -1531,6 +1582,7 @@
(define-vop (digit-ashl digit-ashr)
(:translate bignum::%ashl)
(:generator 1
+ (emit-not-implemented)
(sc-case count
((signed-reg unsigned-reg)
(inst slln result digit count))
@@ -1758,7 +1810,7 @@
;; Unary operations
-#+(and sparc-v9 sparc-v8plus)
+#+(and nil sparc-v9 sparc-v8plus)
(progn
;;; The vops for the 64-bit operations are written this way because I
=====================================
src/compiler/sparc64/array.lisp
=====================================
--- a/src/compiler/sparc64/array.lisp
+++ b/src/compiler/sparc64/array.lisp
@@ -32,6 +32,7 @@
(:temporary (:scs (non-descriptor-reg)) gc-temp) ; gencgc
(:results (result :scs (descriptor-reg)))
(:generator 0
+ (emit-not-implemented)
(pseudo-atomic ()
(inst add ndescr rank (* (1+ array-dimensions-offset) vm:word-bytes))
(inst andn ndescr 4)
@@ -74,6 +75,7 @@
(:temporary (:scs (non-descriptor-reg)) temp)
(:results (res :scs (any-reg descriptor-reg)))
(:generator 6
+ (emit-not-implemented)
(loadw temp x 0 vm:other-pointer-type)
(inst sra temp vm:type-bits)
(inst sub temp (1- vm:array-dimensions-offset))
@@ -94,6 +96,7 @@
(:vop-var vop)
(:save-p :compute-only)
(:generator 5
+ (emit-not-implemented)
(let ((error (generate-error-code vop invalid-array-index-error
array bound index)))
(inst cmp index bound)
@@ -185,6 +188,7 @@
(:result-types positive-fixnum)
(:temporary (:scs (non-descriptor-reg) :to (:result 0)) temp result)
(:generator 20
+ (emit-not-implemented)
;; temp = floor(index bit-shift), to get address of word
;; containing our bits.
(inst srln temp index ,bit-shift)
@@ -352,6 +356,7 @@
(:temporary (:scs (non-descriptor-reg)) offset)
(:result-types single-float)
(:generator 5
+ (emit-not-implemented)
(inst add offset index (- (* vm:vector-data-offset vm:word-bytes)
vm:other-pointer-type))
(inst ldf value object offset)))
@@ -367,6 +372,7 @@
(:temporary (:scs (non-descriptor-reg)) temp)
(:result-types single-float)
(:generator 3
+ (emit-not-implemented)
(let ((offset (+ (fixnumize index)
(- (* vm:vector-data-offset vm:word-bytes)
vm:other-pointer-type))))
@@ -389,6 +395,7 @@
(:result-types single-float)
(:temporary (:scs (non-descriptor-reg)) offset)
(:generator 5
+ (emit-not-implemented)
(inst add offset index
(- (* vm:vector-data-offset vm:word-bytes)
vm:other-pointer-type))
@@ -410,6 +417,7 @@
(:result-types single-float)
(:temporary (:scs (non-descriptor-reg)) temp)
(:generator 2
+ (emit-not-implemented)
(let ((offset (+ (fixnumize index)
(- (* vm:vector-data-offset vm:word-bytes)
vm:other-pointer-type))))
@@ -432,6 +440,7 @@
(:result-types double-float)
(:temporary (:scs (non-descriptor-reg)) offset)
(:generator 7
+ (emit-not-implemented)
(inst slln offset index (- 3 fixnum-tag-bits))
(inst add offset (- (* vm:vector-data-offset vm:word-bytes)
vm:other-pointer-type))
@@ -448,6 +457,7 @@
(:result-types double-float)
(:temporary (:scs (non-descriptor-reg)) temp)
(:generator 3
+ (emit-not-implemented)
(let ((offset (+ (* index double-float-bytes)
(- (* vm:vector-data-offset vm:word-bytes)
vm:other-pointer-type))))
@@ -469,6 +479,7 @@
(:result-types double-float)
(:temporary (:scs (non-descriptor-reg)) offset)
(:generator 20
+ (emit-not-implemented)
(inst slln offset index (- 3 fixnum-tag-bits))
(inst add offset (- (* vm:vector-data-offset vm:word-bytes)
vm:other-pointer-type))
@@ -490,6 +501,7 @@
(:result-types double-float)
(:temporary (:scs (non-descriptor-reg)) temp)
(:generator 10
+ (emit-not-implemented)
(let ((offset (+ (* index double-float-bytes)
(- (* vm:vector-data-offset vm:word-bytes)
vm:other-pointer-type))))
@@ -609,6 +621,7 @@
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
(:result-types complex-single-float)
(:generator 5
+ (emit-not-implemented)
(let ((real-tn (complex-single-reg-real-tn value)))
(inst slln offset index (- 3 fixnum-tag-bits))
(inst add offset (- (* vm:vector-data-offset vm:word-bytes)
@@ -630,6 +643,7 @@
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp)
(:result-types complex-single-float)
(:generator 3
+ (emit-not-implemented)
(let ((offset (+ (* index (* 2 single-float-bytes))
(- (* vm:vector-data-offset vm:word-bytes)
vm:other-pointer-type)))
@@ -657,6 +671,7 @@
(:result-types complex-single-float)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
(:generator 5
+ (emit-not-implemented)
(let ((value-real (complex-single-reg-real-tn value))
(result-real (complex-single-reg-real-tn result)))
(inst slln offset index (- 3 fixnum-tag-bits))
@@ -686,6 +701,7 @@
(:result-types complex-single-float)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp)
(:generator 3
+ (emit-not-implemented)
(let ((offset (+ (* index (* 2 single-float-bytes))
(- (* vm:vector-data-offset vm:word-bytes)
vm:other-pointer-type)))
@@ -717,6 +733,7 @@
(:result-types complex-double-float)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
(:generator 7
+ (emit-not-implemented)
(let ((real-tn (complex-double-reg-real-tn value)))
(inst slln offset index (- 4 fixnum-tag-bits))
(inst add offset (- (* vm:vector-data-offset vm:word-bytes)
@@ -737,6 +754,7 @@
(:result-types complex-double-float)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp)
(:generator 5
+ (emit-not-implemented)
(let ((offset (+ (* index (* 2 double-float-bytes))
(- (* vm:vector-data-offset vm:word-bytes)
vm:other-pointer-type)))
@@ -764,6 +782,7 @@
(:result-types complex-double-float)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
(:generator 20
+ (emit-not-implemented)
(let ((value-real (complex-double-reg-real-tn value))
(result-real (complex-double-reg-real-tn result)))
(inst slln offset index (- 4 fixnum-tag-bits))
@@ -793,6 +812,7 @@
(:result-types complex-double-float)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp)
(:generator 15
+ (emit-not-implemented)
(let ((value-real (complex-double-reg-real-tn value))
(result-real (complex-double-reg-real-tn result))
(value-imag (complex-double-reg-imag-tn value))
@@ -1008,6 +1028,7 @@
(:result-types double-double-float)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
(:generator 7
+ (emit-not-implemented)
(let ((hi-tn (double-double-reg-hi-tn value)))
(inst slln offset index (- 4 fixnum-tag-bits))
(inst add offset (- (* vm:vector-data-offset vm:word-bytes)
@@ -1028,6 +1049,7 @@
(:result-types double-double-float)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp)
(:generator 5
+ (emit-not-implemented)
(let ((offset (+ (* index (* 2 double-float-bytes))
(- (* vm:vector-data-offset vm:word-bytes)
vm:other-pointer-type)))
@@ -1055,6 +1077,7 @@
(:result-types double-double-float)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
(:generator 20
+ (emit-not-implemented)
(let ((value-hi (double-double-reg-hi-tn value))
(result-hi (double-double-reg-hi-tn result)))
(inst slln offset index (- 4 fixnum-tag-bits))
@@ -1084,6 +1107,7 @@
(:result-types double-double-float)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp)
(:generator 15
+ (emit-not-implemented)
(let ((value-hi (double-double-reg-hi-tn value))
(result-hi (double-double-reg-hi-tn result))
(value-lo (double-double-reg-lo-tn value))
@@ -1119,6 +1143,7 @@
(:result-types complex-double-double-float)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
(:generator 7
+ (emit-not-implemented)
(let ((real-tn (complex-double-double-reg-real-hi-tn value)))
(inst slln offset index (- 5 fixnum-tag-bits))
(inst add offset (- (* vm:vector-data-offset vm:word-bytes)
@@ -1145,6 +1170,7 @@
(:result-types complex-double-double-float)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp)
(:generator 5
+ (emit-not-implemented)
(let ((offset (+ (* index (* 2 double-float-bytes))
(- (* vm:vector-data-offset vm:word-bytes)
vm:other-pointer-type)))
@@ -1180,6 +1206,7 @@
(:result-types complex-double-double-float)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) offset)
(:generator 20
+ (emit-not-implemented)
(let ((value-real (complex-double-double-reg-real-hi-tn value))
(result-real (complex-double-double-reg-real-hi-tn result)))
(inst slln offset index (- 5 fixnum-tag-bits))
@@ -1221,6 +1248,7 @@
(:result-types complex-double-double-float)
(:temporary (:scs (non-descriptor-reg) :from (:argument 1)) temp)
(:generator 15
+ (emit-not-implemented)
(let ((value-real (complex-double-double-reg-real-hi-tn value))
(result-real (complex-double-double-reg-real-hi-tn result))
(value-imag (complex-double-double-reg-imag-hi-tn value))
=====================================
src/compiler/sparc64/c-call.lisp
=====================================
--- a/src/compiler/sparc64/c-call.lisp
+++ b/src/compiler/sparc64/c-call.lisp
@@ -241,6 +241,7 @@
(:results (res :scs (sap-reg)))
(:result-types system-area-pointer)
(:generator 2
+ (emit-not-implemented)
(inst li res (make-fixup (extern-alien-name foreign-symbol)
:foreign))))
@@ -254,6 +255,7 @@
(:result-types system-area-pointer)
(:temporary (:scs (non-descriptor-reg)) addr)
(:generator 2
+ (emit-not-implemented)
(inst li addr (make-fixup (extern-alien-name foreign-symbol)
:foreign-data))
(loadw res addr)))
@@ -271,6 +273,7 @@
(:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
(:vop-var vop)
(:generator 0
+ (emit-not-implemented)
(let ((cur-nfp (current-nfp-tn vop)))
(when cur-nfp
(store-stack-tn nfp-save cur-nfp))
@@ -287,6 +290,7 @@
(:results (result :scs (sap-reg any-reg)))
(:temporary (:scs (unsigned-reg) :to (:result 0)) temp)
(:generator 0
+ (emit-not-implemented)
(unless (zerop amount)
(let ((delta (logandc2 (+ amount 7) 7)))
(cond ((< delta (ash 1 12))
@@ -305,6 +309,7 @@
(:policy :fast-safe)
(:temporary (:scs (unsigned-reg) :to (:result 0)) temp)
(:generator 0
+ (emit-not-implemented)
(unless (zerop amount)
(let ((delta (logandc2 (+ amount 7) 7)))
(cond ((< delta (ash 1 12))
=====================================
src/compiler/sparc64/call.lisp
=====================================
--- a/src/compiler/sparc64/call.lisp
+++ b/src/compiler/sparc64/call.lisp
@@ -244,6 +244,7 @@
(inst b :gt zero-out-loop)
(inst stn zero-tn csp-tn temp)
))
+ (emit-not-implemented)
(let ((size (* vm:word-bytes (sb-allocated-size 'control-stack))))
(cond ((typep size '(signed-byte 13))
(inst add csp-tn csp-tn size))
@@ -349,7 +350,7 @@ default-value-8
(inst nop))
(inst compute-code-from-lra code-tn code-tn lra-label temp))
(let ((regs-defaulted (gen-label))
- (defaulting-done (gen-label))
+ (defaulting-done (gen-label))
(default-stack-vals (gen-label)))
;; Branch off to the MV case.
(new-assem:without-scheduling ()
@@ -514,6 +515,7 @@ default-value-8
(:ignore arg-locs args ocfp)
(:generator 5
(trace-table-entry trace-table-call-site)
+ (emit-not-implemented)
(let ((label (gen-label))
(cur-nfp (current-nfp-tn vop)))
(when cur-nfp
@@ -554,6 +556,7 @@ default-value-8
(:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
(:generator 20
(trace-table-entry trace-table-call-site)
+ (emit-not-implemented)
(let ((label (gen-label))
(cur-nfp (current-nfp-tn vop)))
(when cur-nfp
@@ -598,6 +601,7 @@ default-value-8
(:temporary (:scs (non-descriptor-reg)) temp)
(:generator 5
(trace-table-entry trace-table-call-site)
+ (emit-not-implemented)
(let ((label (gen-label))
(cur-nfp (current-nfp-tn vop)))
(when cur-nfp
@@ -637,6 +641,7 @@ default-value-8
(:vop-var vop)
(:generator 6
(trace-table-entry trace-table-function-epilogue)
+ (emit-not-implemented)
(maybe-load-stack-tn old-fp-temp old-fp)
(maybe-load-stack-tn return-pc-temp return-pc)
(move csp-tn cfp-tn)
@@ -928,7 +933,7 @@ default-value-8
(:vop-var vop)
(:generator 75
-
+ (emit-not-implemented)
;; Move these into the passing locations if they are not already there.
(move args args-arg)
(move lexenv function-arg)
@@ -961,6 +966,7 @@ default-value-8
(:generator 6
(trace-table-entry trace-table-function-epilogue)
;; Clear the number stack.
+ (emit-not-implemented)
(let ((cur-nfp (current-nfp-tn vop)))
(when cur-nfp
(inst add nsp-tn cur-nfp
@@ -1005,6 +1011,7 @@ default-value-8
(:generator 6
(trace-table-entry trace-table-function-epilogue)
;; Clear the number stack.
+ (emit-not-implemented)
(let ((cur-nfp (current-nfp-tn vop)))
(when cur-nfp
(inst add nsp-tn cur-nfp
@@ -1056,6 +1063,7 @@ default-value-8
(:generator 13
(trace-table-entry trace-table-function-epilogue)
+ (emit-not-implemented)
(let ((not-single (gen-label)))
;; Clear the number stack.
(let ((cur-nfp (current-nfp-tn vop)))
@@ -1109,6 +1117,7 @@ default-value-8
(:ignore label)
(:generator 6
;; Get result.
+ (emit-not-implemented)
(move closure lexenv)))
;;; Copy a more arg from the argument area to the end of the current frame.
@@ -1122,6 +1131,7 @@ default-value-8
(:temporary (:sc descriptor-reg :offset cname-offset) temp)
(:info fixed)
(:generator 20
+ (emit-not-implemented)
(let ((loop (gen-label))
(do-regs (gen-label))
(done (gen-label)))
@@ -1196,6 +1206,7 @@ default-value-8
(:translate %listify-rest-args)
(:policy :safe)
(:generator 20
+ (emit-not-implemented)
(move context context-arg)
(move count count-arg)
;; Check to see if there are any arguments.
@@ -1259,6 +1270,7 @@ default-value-8
(:result-types t tagged-num)
(:note _N"more-arg-context")
(:generator 5
+ (emit-not-implemented)
(inst sub count supplied (fixnumize fixed))
(inst sub context csp-tn count)))
@@ -1295,6 +1307,7 @@ default-value-8
(:vop-var vop)
(:save-p :compute-only)
(:generator 1000
+ (emit-not-implemented)
(error-call vop ,error , at args)))))
(frob argument-count-error invalid-argument-count-error
c::%argument-count-error nargs)
=====================================
src/compiler/sparc64/memory.lisp
=====================================
--- a/src/compiler/sparc64/memory.lisp
+++ b/src/compiler/sparc64/memory.lisp
@@ -101,7 +101,9 @@
(inst ,op value object temp)))))
(t
,@(unless (zerop shift)
- `((inst srln temp index ,shift)))
+ (if (minusp shift)
+ `((inst slln temp index ,(- shift)))
+ `((inst srln temp index ,shift))))
(inst add temp ,(if (zerop shift) 'index 'temp)
(- (ash offset vm:word-shift) lowtag))
(inst ,op value object temp)))
@@ -112,8 +114,8 @@
(define-indexer signed-word-index-ref nil ldsw 0)
#+sparc-v9
(define-indexer signed-word-index-set nil st 0)
-(define-indexer word-index-ref nil ld 0)
-(define-indexer word-index-set t st 0)
+(define-indexer word-index-ref nil ldn -1)
+(define-indexer word-index-set t stn -1)
(define-indexer halfword-index-ref nil lduh 1)
(define-indexer signed-halfword-index-ref nil ldsh 1)
(define-indexer halfword-index-set t sth 1)
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/608fadde188e963541d6f44e42d17861f067a77f...f52af3436f0f657dfb14d97f1e882cad9f133e3b
---
View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/608fadde188e963541d6f44e42d17861f067a77f...f52af3436f0f657dfb14d97f1e882cad9f133e3b
You're receiving this email because of your account on gitlab.common-lisp.net.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cmucl-cvs/attachments/20180103/26e06365/attachment-0001.html>
More information about the cmucl-cvs
mailing list