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 ,@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/608fadde188e963541d6f44e4...

--- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/608fadde188e963541d6f44e4... You're receiving this email because of your account on gitlab.common-lisp.net.