January 2018 - cmucl-cvs - mailman3.common-lisp.net

[Git][cmucl/cmucl][sparc64-dev] 2 commits: Fix stack computations in COPY-MORE-ARGS
by Raymond Toy 07 Jan '18

07 Jan '18

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: a94d7f1f by Raymond Toy at 2018-01-06T18:32:24-08:00 Fix stack computations in COPY-MORE-ARGS Fixnums aren't 8-byte word offsets, so we need to shift fixnums left by 1 to get a word offset when computing new stack locations. - - - - - 11e8aafe by Raymond Toy at 2018-01-06T19:02:09-08:00 Fix stack computations in MORE-ARG-CONTEXT Fixnums aren't 8-byte word offsets, so we need to shift fixnums left by 1 to get a word offset when computing new stack locations. - - - - - 1 changed file: - src/compiler/sparc64/call.lisp Changes: ===================================== src/compiler/sparc64/call.lisp ===================================== --- a/src/compiler/sparc64/call.lisp +++ b/src/compiler/sparc64/call.lisp @@ -1141,12 +1141,17 @@ default-value-8 ;; Allocate the space on the stack. (cond ((zerop fixed) (inst cmp nargs-tn) + ;; Add nargs-tn to csp-tn twice to get the right address + ;; because fixnum values need to be multiplied by two to + ;; get the right word address/offset. + (inst add csp-tn csp-tn nargs-tn) (inst b :eq done) (inst add csp-tn csp-tn nargs-tn)) (t (inst subcc count nargs-tn (fixnumize fixed)) (inst b :le done) (inst nop) + (inst add csp-tn csp-tn count) (inst add csp-tn csp-tn count))) (when (< fixed register-arg-count) ;; We must stop when we run out of stack args, not when we run out of @@ -1158,6 +1163,7 @@ default-value-8 (move dst csp-tn) ;; Initialize src to be end of args. (inst add src cfp-tn nargs-tn) + (inst add src cfp-tn nargs-tn) (emit-label loop) ;; *--dst = *--src, --count @@ -1271,7 +1277,9 @@ default-value-8 (:generator 5 (emit-not-implemented) (inst sub count supplied (fixnumize fixed)) - (inst sub context csp-tn count))) + ;; Subtract count twice to get the correct word offset. + (inst sub context csp-tn count) + (inst sub context context count))) ;;; Signal wrong argument count error if Nargs isn't = to Count. View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/5fa489dfddcbaf53394a1b11… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/5fa489dfddcbaf53394a1b11… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][sparc64-dev] 3 commits: Fix some typos in format strings
by Raymond Toy 05 Jan '18

05 Jan '18

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: 587df5a1 by Raymond Toy at 2018-01-03T21:09:32-08:00 Fix some typos in format strings And make indentation consistent between uses. - - - - - bf42cefc by Raymond Toy at 2018-01-04T21:53:45-08:00 Add more not-implemented. - - - - - 5fa489df by Raymond Toy at 2018-01-04T21:55:08-08:00 Create trace-files for lispinit and globaldb Create the trace files so we can compare the actualassembly code with the compiler trace. Makes it easier to understand what each register contains because the trace file has more detail. - - - - - 3 changed files: - src/compiler/sparc64/arith.lisp - src/compiler/sparc64/insts.lisp - src/tools/worldcom.lisp Changes: ===================================== src/compiler/sparc64/arith.lisp ===================================== --- a/src/compiler/sparc64/arith.lisp +++ b/src/compiler/sparc64/arith.lisp @@ -130,6 +130,7 @@ ,@(when restore-fixnum-mask `((:temporary (:sc non-descriptor-reg) temp))) (:generator 2 + (emit-not-implemented) ,(if arg-swap `(inst ,op ,(if restore-fixnum-mask 'temp 'r) y x) `(inst ,op ,(if restore-fixnum-mask 'temp 'r) x y)) @@ -142,6 +143,7 @@ ,@(when restore-fixnum-mask `((:temporary (:sc non-descriptor-reg) temp))) (:generator 1 + (emit-not-implemented) (inst ,op ,(if restore-fixnum-mask 'temp 'r) x (fixnumize y)) ,@(when restore-fixnum-mask `((inst andn r temp fixnum-tag-mask))))))) @@ -149,6 +151,7 @@ fast-signed-binop) (:translate ,translate) (:generator ,(1+ untagged-penalty) + (emit-not-implemented) ,(if arg-swap `(inst ,op r y x) `(inst ,op r x y)))) @@ -157,11 +160,13 @@ fast-signed-binop-c) (:translate ,translate) (:generator ,untagged-penalty + (emit-not-implemented) (inst ,op r x y))))) (define-vop (,(symbolicate "FAST-" translate "/UNSIGNED=>UNSIGNED") fast-unsigned-binop) (:translate ,translate) (:generator ,(1+ untagged-penalty) + (emit-not-implemented) ,(if arg-swap `(inst ,op r y x) `(inst ,op r x y)))) @@ -170,6 +175,7 @@ fast-unsigned-binop-c) (:translate ,translate) (:generator ,untagged-penalty + (emit-not-implemented) (inst ,op r x y))))))) ); eval-when @@ -211,6 +217,7 @@ (:constant (or (and (unsigned-byte 12) (not (integer 0 0))) (integer #xfffff000 #xffffffff)))) (:generator 2 ; Needs to be low to give this vop a chance. + (emit-not-implemented) (cond ((= y #xffffffff) (move r x)) ((typep y '(unsigned-byte 13)) @@ -231,6 +238,7 @@ (:note _N"inline 32-bit abs") (:temporary (:scs (signed-reg)) y) (:generator 1 + (emit-not-implemented) ;; From Hacker's Delight ;; ;; abs(x) = (x ^ y) - y, where y = x >> 31 (signed shift) ===================================== src/compiler/sparc64/insts.lisp ===================================== --- a/src/compiler/sparc64/insts.lisp +++ b/src/compiler/sparc64/insts.lisp @@ -2346,12 +2346,16 @@ about function addresses and register values.") (emit-compute-inst segment vop dst src label temp #'(lambda (label posn delta-if-after) (when c::*compiler-trace-output* - (format c::*compiler-trace-output* "COMPUTE-CODE-FROM=LRA~%") - (format c::*compiler-trace-output* "label posn delta-if-after = ~A ~A ~A~%" + (format c::*compiler-trace-output* + "COMPUTE-CODE-FROM=FN~%") + (format c::*compiler-trace-output* + "label posn delta-if-after = ~A ~A ~A~%" label posn delta-if-after) - (format c::*compiler-trace-output* "label-position = ~A~%" + (format c::*compiler-trace-output* + "label-position = ~A~%" (label-position label posn delta-if-after)) - (format c::*compiler-trace-output* "header-len = ~A~%" + (format c::*compiler-trace-output* + "header-len = ~A~%" (component-header-length)) (format c::*compiler-trace-output* "Final offset = ~A~%" @@ -2413,12 +2417,16 @@ about function addresses and register values.") (emit-compute-inst segment vop dst src label temp #'(lambda (label posn delta-if-after) (when c::*compiler-trace-output* - (format c::*compiler-trace-output* "COMPUTE-LRA-FROM-CODE~%") - (format c::*compiler-trace-output* "label posn delta-if-after = ~A ~A ~A~%" + (format c::*compiler-trace-output* + "COMPUTE-LRA-FROM-CODE~%") + (format c::*compiler-trace-output* + "label posn delta-if-after = ~A ~A ~A~%" label posn delta-if-after) - (format c::*compiler-trace-output* "label-position = ~A~%" + (format c::*compiler-trace-output* + "label-position = ~A~%" (label-position label posn delta-if-after)) - (format c::*compiler-trace-output* "header-len = ~A~%" + (format c::*compiler-trace-output* + "header-len = ~A~%" (component-header-length)) (format c::*compiler-trace-output* "Final offset = ~A~%" ===================================== src/tools/worldcom.lisp ===================================== --- a/src/tools/worldcom.lisp +++ b/src/tools/worldcom.lisp @@ -119,7 +119,7 @@ (comf "target:code/globals") (comf "target:code/kernel") -(comf "target:code/lispinit") +(comf "target:code/lispinit" :trace-file t) (comf "target:pcl/walk") (comf "target:code/fwrappers") (comf "target:code/fdefinition") @@ -325,7 +325,7 @@ (let ((c:*compile-time-define-macros* nil)) (comf "target:code/defstruct") (comf "target:code/defmacro" :byte-compile *byte-compile*) - (comf "target:compiler/globaldb") + (comf "target:compiler/globaldb" :trace-file t) (comf "target:code/macros") #-no-runtime (comf "target:code/macros" :byte-compile t)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/caa31bdf92d9c27668e9cc55… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/caa31bdf92d9c27668e9cc55… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][sparc64-dev] 2 commits: Fix up the fast-ash-right vops
by Raymond Toy 04 Jan '18

04 Jan '18

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: d11ccfbf by Raymond Toy at 2018-01-03T20:55:23-08:00 Fix up the fast-ash-right vops Remove some nil'ed out code too. - - - - - caa31bdf by Raymond Toy at 2018-01-03T21:01:16-08:00 Mark allocate-vector and fix up length computation * Add NOT-IMPLEMENTED for this routine. * The number of words needs to be multiplied by 2 to get the actual number of bytes since fixnums are only shifted by 2, and words are now 8 bytes long. - - - - - 2 changed files: - src/assembly/sparc64/array.lisp - src/compiler/sparc64/arith.lisp Changes: ===================================== src/assembly/sparc64/array.lisp ===================================== --- a/src/assembly/sparc64/array.lisp +++ b/src/assembly/sparc64/array.lisp @@ -32,8 +32,12 @@ (:temp ndescr non-descriptor-reg nl0-offset) (:temp gc-temp non-descriptor-reg nl1-offset) (:temp vector descriptor-reg a3-offset)) + (not-implemented "ALLOCATE-VECTOR") (pseudo-atomic () - (inst add ndescr words (* (1+ vm:vector-data-offset) vm:word-bytes)) + ;; words is a fixnum. Multiply by 2 to get the actual number of + ;; bytes to allocate. + (inst sllx ndescr words 1) + (inst add ndescr ndescr (* (1+ vm:vector-data-offset) vm:word-bytes)) (inst andn ndescr vm:lowtag-mask) (allocation vector ndescr other-pointer-type :temp-tn gc-temp) #+gencgc @@ -42,7 +46,7 @@ ;; space. Fill the last word with a zero. (inst add ndescr vector) (storew zero-tn ndescr -1 vm:other-pointer-type)) - (inst srl ndescr type vm:word-shift) + (inst srl ndescr type vm:fixnum-tag-bits) (storew ndescr vector 0 vm:other-pointer-type) (storew length vector vm:vector-length-slot vm:other-pointer-type)) ;; This makes sure the zero byte at the end of a string is paged in so ===================================== src/compiler/sparc64/arith.lisp ===================================== --- a/src/compiler/sparc64/arith.lisp +++ b/src/compiler/sparc64/arith.lisp @@ -555,15 +555,9 @@ (let ((amt (tn-value amount))) (inst ,shift-inst result number amt)))))))) (frob ash-right-signed fast-ash-right/signed=>signed - signed-reg signed-num sra 3) + signed-reg signed-num sran 3) (frob ash-right-unsigned fast-ash-right/unsigned=>unsigned - unsigned-reg unsigned-num srl 3) - #+(and sparc-v9 sparc-v8plus) - (frob ash-right-signed fast-ash-right/signed64=>signed64 - signed64-reg signed64-num srax 3) - #+(and sparc-v9 sparc-v8plus) - (frob ash-right-unsigned fast-ash-right/unsigned64=>unsigned64 - unsigned64-reg unsigned64-num srlx 3) + unsigned-reg unsigned-num srln 3) ) ;; Constant right shift. @@ -585,32 +579,11 @@ (move result number) (inst ,shift-inst result number amount)))))) (frob ash-right-signed fast-ash-right-c/signed=>signed - signed-reg signed-num sra 1 31) + signed-reg signed-num sran 1 63) (frob ash-right-unsigned fast-ash-right-c/unsigned=>unsigned - unsigned-reg unsigned-num srl 1 31) - #+(and sparc-v9 sparc-v8plus) - (frob ash-right-signed fast-ash-right-c/signed64=>signed64 - signed64-reg signed64-num srax 1 63) - #+(and sparc-v9 sparc-v8plus) - (frob ash-right-unsigned fast-ash-right-c/unsigned64=>unsigned64 - unsigned64-reg unsigned64-num srlx 1 63) + unsigned-reg unsigned-num srln 1 63) ) -#+nil -(define-vop (fash-ash-right-c/signed=>signed fast-signed-binop-c) - (:args (x :target r :scs (signed-reg zero))) - (:arg-types signed-num - (:constant (integer 0 31))) - (:results (r :scs (signed-reg))) - (:result-types signed-num) - (:translate ash-right-signed) - (:note _N"inline (signed-byte 32) arithmetic") - (:generator 1 - (if (zerop y) - (move r x) - (inst srln r x y)))) - - (define-vop (fast-ash-right/fixnum=>fixnum) (:note _N"inline right ASH") (:translate ash-right-signed) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/34f8edd9936a038e22820e6e… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/34f8edd9936a038e22820e6e… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][sparc64-dev] 3 commits: Make target fixnum 61 bits long
by Raymond Toy 04 Jan '18

04 Jan '18

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: 93f40930 by Raymond Toy at 2018-01-03T16:13:54-08:00 Make target fixnum 61 bits long Let's try this and see how far we can get. If it proves to be too complicated, revert this and use 30-bit fixnums instead of 62-bit fixnums. - - - - - dc477f5b by Raymond Toy at 2018-01-03T16:15:48-08:00 Fix typo: sparc64 -> sparc-64. - - - - - 34f8edd9 by Raymond Toy at 2018-01-03T19:52:03-08:00 Bignum digits is still int for sparc64 For simplicity, we're keeping bignum digits in a 32-bit object because sparc-v9 doesn't have a 64x64->128 multiply. - - - - - 1 changed file: - src/compiler/generic/objdef.lisp Changes: ===================================== src/compiler/generic/objdef.lisp ===================================== --- a/src/compiler/generic/objdef.lisp +++ b/src/compiler/generic/objdef.lisp @@ -92,10 +92,12 @@ ); eval-when -(defparameter target-most-positive-fixnum (1- (ash 1 #-amd64 29 #+amd64 61)) +(defparameter target-most-positive-fixnum + (1- (ash 1 #-(or amd64 sparc-64) 29 #+(or amd64 sparc-64) 61)) "most-positive-fixnum in the target architecture.") -(defparameter target-most-negative-fixnum (ash -1 #-amd64 29 #+amd64 61) +(defparameter target-most-negative-fixnum + (ash -1 #-(or amd64 sparc-64) 29 #+(or amd64 sparc-64) 61) "most-negative-fixnum in the target architecture.") @@ -202,7 +204,11 @@ (define-primitive-object (bignum :lowtag other-pointer-type :header bignum-type :alloc-trans bignum::%allocate-bignum) - (digits :rest-p t :c-type #-alpha "long" #+alpha "u32")) + (digits :rest-p t + :c-type + #-(or alpha sparc-v9) "long" + #+alpha "u32" + #+sparc-v9 "int")) (define-primitive-object (ratio :type ratio :lowtag other-pointer-type View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/5e00e1dc01a4e19469e10d23… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/5e00e1dc01a4e19469e10d23… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][sparc64-dev] Replace li with v9 version
by Raymond Toy 03 Jan '18

03 Jan '18

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: 5e00e1dc by Raymond Toy at 2018-01-03T14:11:29-08:00 Replace li with v9 version Also Remove the old version that was 32-bit. - - - - - 1 changed file: - src/compiler/sparc64/insts.lisp Changes: ===================================== src/compiler/sparc64/insts.lisp ===================================== --- a/src/compiler/sparc64/insts.lisp +++ b/src/compiler/sparc64/insts.lisp @@ -2063,52 +2063,10 @@ about function addresses and register values.") ;;;; li, jali, ji, nop, cmp, not, neg, move, and more -#-sparc-v9 -(defun %li (reg value) - (etypecase value - ((signed-byte 13) - (inst add reg zero-tn value)) - ((or (signed-byte 32) (unsigned-byte 32)) - (let ((hi (ldb (byte 22 10) value)) - (lo (ldb (byte 10 0) value))) - (inst sethi reg hi) - (unless (zerop lo) - (inst add reg lo)))) - (fixup - (inst sethi reg value) - (inst add reg value)))) - -#+sparc-v9 -(defun %li (reg value) - (etypecase value - ((signed-byte 13) - (inst add reg zero-tn value)) - ((unsigned-byte 32) - (let ((hi (ldb (byte 22 10) value)) - (lo (ldb (byte 10 0) value))) - ;; Sethi sets the top 32-bits to zero. - (inst sethi reg hi) - (unless (zerop lo) - (inst add reg lo)))) - ((signed-byte 32) - (let ((hi (ldb (byte 22 10) value)) - (lo (ldb (byte 10 0) value))) - ;; Sethi sets the top 32-bits to zero. - (inst sethi reg hi) - (unless (zerop lo) - (inst add reg lo)) - ;; Sign-extend the result - (inst signx reg))) - (fixup - (inst sethi reg value) - (inst add reg value)))) - (define-instruction-macro li (reg value) `(%li ,reg ,value)) -#+sparc-v9 -(progn -(defun %li64 (reg value &optional temp) +(defun %li (reg value &optional temp) (etypecase value ((signed-byte 13) (inst add reg zero-tn value)) @@ -2168,10 +2126,6 @@ about function addresses and register values.") (inst sethi reg value) (inst add reg value)))) -(define-instruction-macro li64 (reg value &optional temp) - `(%li64 ,reg ,value ,temp)) - -) ;; Define LDN/STN synthetic instructions to do "natural" loads and ;; stores for 32-bit or 64-bit objects depending on whether this is a View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/5e00e1dc01a4e19469e10d230… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/5e00e1dc01a4e19469e10d230… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][sparc64-dev] 3 commits: Add not-implemented for xep-allocate-frame
by Raymond Toy 03 Jan '18

03 Jan '18

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: 54802798 by Raymond Toy at 2018-01-03T11:33:18-08:00 Add not-implemented for xep-allocate-frame It's done after compute-code-from-fn, but I think if we do it before, it messes up the computation of the code-tn. Anyway, this seems to work because I can see xep-allocate-frame running, and no apparent differences from before. - - - - - 4200eabe by Raymond Toy at 2018-01-03T12:10:33-08:00 Update fast-truncate for v9 Remove the "v8" from the vop names and update to use v9 instructions to allow operations with 64-bit values. - - - - - 49cfead9 by Raymond Toy at 2018-01-03T12:12:52-08:00 Remove stuff that was commented out. Also remove fast-v9-truncate/unsigned=>unsigned that is wrong for sparc64. - - - - - 2 changed files: - src/compiler/sparc64/arith.lisp - src/compiler/sparc64/call.lisp Changes: ===================================== src/compiler/sparc64/arith.lisp ===================================== --- a/src/compiler/sparc64/arith.lisp +++ b/src/compiler/sparc64/arith.lisp @@ -238,88 +238,9 @@ (inst xor r y x) (inst sub r y))) -;;; Special case fixnum + and - that trap on overflow. Useful when we -;;; don't know that the output type is a fixnum. - -;;; I (toy(a)rtp.ericsson.se) took these out. They don't seem to be -;;; used anywhere at all. -#+nil -(progn -(define-vop (+/fixnum fast-+/fixnum=>fixnum) - (:policy :safe) - (:results (r :scs (any-reg descriptor-reg))) - (:result-types tagged-num) - (:note _N"safe inline fixnum arithmetic") - (:generator 4 - (inst taddcctv r x y))) - -(define-vop (+-c/fixnum fast-+-c/fixnum=>fixnum) - (:policy :safe) - (:results (r :scs (any-reg descriptor-reg))) - (:result-types tagged-num) - (:note _N"safe inline fixnum arithmetic") - (:generator 3 - (inst taddcctv r x (fixnumize y)))) - -(define-vop (-/fixnum fast--/fixnum=>fixnum) - (:policy :safe) - (:results (r :scs (any-reg descriptor-reg))) - (:result-types tagged-num) - (:note _N"safe inline fixnum arithmetic") - (:generator 4 - (inst tsubcctv r x y))) - -(define-vop (--c/fixnum fast---c/fixnum=>fixnum) - (:policy :safe) - (:results (r :scs (any-reg descriptor-reg))) - (:result-types tagged-num) - (:note _N"safe inline fixnum arithmetic") - (:generator 3 - (inst tsubcctv r x (fixnumize y)))) - -) - ;;; Truncate -;; This doesn't work for some reason. -#+nil -(define-vop (fast-v8-truncate/fixnum=>fixnum fast-safe-arith-op) - (:translate truncate) - (:args (x :scs (any-reg)) - (y :scs (any-reg))) - (:arg-types tagged-num tagged-num) - (:results (quo :scs (any-reg)) - (rem :scs (any-reg))) - (:result-types tagged-num tagged-num) - (:note _N"inline fixnum arithmetic") - (:temporary (:scs (any-reg) :target quo) q) - (:temporary (:scs (any-reg)) r) - (:temporary (:scs (signed-reg)) y-int) - (:vop-var vop) - (:save-p :compute-only) - (:guard (or (backend-featurep :sparc-v8) - (and (backend-featurep :sparc-v9) - (not (backend-featurep :sparc-64))))) - (:generator 12 - (let ((zero (generate-error-code vop division-by-zero-error x y))) - (inst cmp y zero-tn) - (inst b :eq zero) - ;; Extend the sign of X into the Y register - (inst sra r x 31) - (inst wry r) - ;; Remove tag bits so Q and R will be tagged correctly. - (inst sra y-int y fixnum-tag-bits) - (inst nop) - (inst nop) - - (inst sdiv q x y-int) ; Q is tagged. - ;; We have the quotient so we need to compute the remainder - (inst smul r q y-int) ; R is tagged - (inst sub rem x r) - (unless (location= quo q) - (move quo q))))) - -(define-vop (fast-v8-truncate/signed=>signed fast-safe-arith-op) +(define-vop (fast-truncate/signed=>signed fast-safe-arith-op) (:translate truncate) (:args (x :scs (signed-reg)) (y :scs (signed-reg))) @@ -332,29 +253,21 @@ (:temporary (:scs (signed-reg)) r) (:vop-var vop) (:save-p :compute-only) - (:guard (or (backend-featurep :sparc-v8) - (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) - ;; Extend the sign of X into the Y register - (inst sra r x 31) - (inst wry r) - (inst nop) - (inst nop) + (inst b :eq zero :pn) (inst nop) - (inst sdiv q x y) + (inst sdivx q x y) ;; We have the quotient so we need to compue the remainder - (inst smul r q y) ; rem + (inst mulx r q y) ; rem (inst sub rem x r) (unless (location= quo q) (move quo q))))) -(define-vop (fast-v8-truncate/unsigned=>unsigned fast-safe-arith-op) +(define-vop (fast-truncate/unsigned=>unsigned fast-safe-arith-op) (:translate truncate) (:args (x :scs (unsigned-reg)) (y :scs (unsigned-reg))) @@ -367,105 +280,13 @@ (:temporary (:scs (unsigned-reg)) r) (:vop-var vop) (:save-p :compute-only) - (:guard (or (backend-featurep :sparc-v8) - (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) - (inst wry zero-tn) ; Clear out high part - (inst nop) - (inst nop) - (inst nop) - - (inst udiv q x y) - ;; Compute remainder - (inst umul r q y) - (inst sub rem x r) - (unless (location= quo q) - (inst move quo q))))) - -(define-vop (fast-v9-truncate/signed=>signed fast-safe-arith-op) - (:translate truncate) - (:args (x :scs (signed-reg)) - (y :scs (signed-reg))) - (:arg-types signed-num signed-num) - (:results (quo :scs (signed-reg)) - (rem :scs (signed-reg))) - (:result-types signed-num signed-num) - (:note _N"inline (signed-byte 32) arithmetic") - (:temporary (:scs (signed-reg) :target quo) q) - (:temporary (:scs (signed-reg)) r) - (:vop-var vop) - (: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) - ;; Sign extend the numbers, just in case. - (inst signx x) - (inst signx y) - (inst sdivx q x y) - ;; Compute remainder - (inst mulx r q y) - (inst sub rem x r) - (unless (location= quo q) - (inst move quo q))))) - -#+nil -(define-vop (fast-v9-truncate/signed64=>signed64 fast-safe-arith-op) - (:translate truncate) - (:args (x :scs (signed64-reg)) - (y :scs (signed64-reg))) - (:arg-types signed64-num signed64-num) - (:results (quo :scs (signed64-reg)) - (rem :scs (signed64-reg))) - (:result-types signed64-num signed64-num) - (:note _N"inline (signed-byte 32) arithmetic") - (:temporary (:scs (signed64-reg) :target quo) q) - (:temporary (:scs (signed64-reg)) r) - (:vop-var vop) - (:save-p :compute-only) - (:guard (backend-featurep :sparc-v9)) - (:generator 8 - (let ((zero (generate-error-code vop division-by-zero-error x y))) - (inst cmp y zero-tn) - (inst b :eq zero :pn :xcc) (inst nop) - - (inst sdivx q x y) - ;; Compute remainder - (inst mulx r q y) - (inst sub rem x r) - (unless (location= quo q) - (inst move quo q))))) - -(define-vop (fast-v9-truncate/unsigned=>unsigned fast-safe-arith-op) - (:translate truncate) - (:args (x :scs (unsigned-reg)) - (y :scs (unsigned-reg))) - (:arg-types unsigned-num unsigned-num) - (:results (quo :scs (unsigned-reg)) - (rem :scs (unsigned-reg))) - (:result-types unsigned-num unsigned-num) - (:note _N"inline (unsigned-byte 32) arithmetic") - (:temporary (:scs (unsigned-reg) :target quo) q) - (:temporary (:scs (unsigned-reg)) r) - (:vop-var vop) - (: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) - ;; Zap the higher 32 bits, just in case - (inst clruw x) - (inst clruw y) + (inst udivx q x y) ;; Compute remainder (inst mulx r q y) @@ -473,6 +294,7 @@ (unless (location= quo q) (inst move quo q))))) + ;;; Shifting (define-vop (fast-ash/signed=>signed) ===================================== src/compiler/sparc64/call.lisp ===================================== --- a/src/compiler/sparc64/call.lisp +++ b/src/compiler/sparc64/call.lisp @@ -180,8 +180,6 @@ (inst word 0) (inst word 0)) - ;;(emit-not-implemented) - ;; The start of the actual code. ;; Fix CODE, cause the function object was passed in. (inst compute-code-from-fn code-tn code-tn start-lab temp) @@ -209,6 +207,7 @@ (inst b :lt zero-out-mem) (inst add csp-tn vm:word-bytes)) ) + (emit-not-implemented) ;; Build our stack frames. (let ((size (* vm:word-bytes (sb-allocated-size 'control-stack)))) (cond ((typep size '(signed-byte 13)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/47d140f4b307a9b3f60822df… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/47d140f4b307a9b3f60822df… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][sparc64-dev] Adjust offset computation for lisp-return
by Raymond Toy 03 Jan '18

03 Jan '18

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: 47d140f4 by Raymond Toy at 2018-01-03T10:53:22-08:00 Adjust offset computation for lisp-return The offset is the number of instructions to skip over, so the multiplier should be 4 not word-bytes (8). And the LRA header word is 8 bytes long, so we need to skip over that to get to the correct instruction. I think. - - - - - 1 changed file: - src/compiler/sparc64/macros.lisp Changes: ===================================== src/compiler/sparc64/macros.lisp ===================================== --- a/src/compiler/sparc64/macros.lisp +++ b/src/compiler/sparc64/macros.lisp @@ -133,8 +133,10 @@ (defmacro lisp-return (return-pc &key (offset 0) (frob-code t)) "Return to RETURN-PC." `(progn + ;; 8 to skip over the lra object, and 4*offset to get to the + ;; right instruction since each instruction is 4 bytes long. (inst j ,return-pc - (- (* (1+ ,offset) word-bytes) other-pointer-type)) + (- (+ 8 (* ,offset 4)) other-pointer-type)) ,(if frob-code `(move code-tn ,return-pc) '(inst nop)))) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/47d140f4b307a9b3f60822df6… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/47d140f4b307a9b3f60822df6… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][sparc64-dev] Remove old signed64 stuff
by Raymond Toy 03 Jan '18

03 Jan '18

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: 850cec97 by Raymond Toy at 2018-01-03T09:40:15-08:00 Remove old signed64 stuff The old signed64 stuff (including the storage classes) aren't needed for sparc-64 since registers and such are 64-bit long. So remove them. - - - - - 2 changed files: - src/compiler/sparc64/move.lisp - src/compiler/sparc64/vm.lisp Changes: ===================================== src/compiler/sparc64/move.lisp ===================================== --- a/src/compiler/sparc64/move.lisp +++ b/src/compiler/sparc64/move.lisp @@ -406,298 +406,4 @@ ;;; (define-move-vop move-argument :move-argument (signed-reg unsigned-reg) (any-reg descriptor-reg)) - -;; 64-bit stuff -#+(and sparc-v9 sparc-v8plus) -(progn - -;; Move a signed-reg to a signed64-reg by sign-extending. (Is this -;; needed?) -(define-move-function (load-signed64-signed 1) (vop x y) - ((signed-reg) (signed64-reg unsigned64-reg)) - (inst signx y x)) - -;; Move a signed64-reg to signed-reg by setting the high 32 bits to be -;; the sign. (Is this needed and will this do the right thing when -;; that signed64-reg actually has more than 32 significant bits?) -#+nil -(define-move-function (load-signed-signed64 1) (vop x y) - ((signed64-reg) (signed-reg)) - (inst signx y x)) - -;; Load a 64-bit number from the stack -(define-move-function (load-number-stack-64 5) (vop x y) - ((signed64-stack) (signed64-reg) - (unsigned64-stack) (unsigned64-reg)) - (let ((nfp (current-nfp-tn vop))) - (load64 y nfp (tn-offset x)))) - -;; Save a 64-bit number to the stack -(define-move-function (store-number-stack-64 5) (vop x y) - ((signed64-reg) (signed64-stack) - (unsigned64-reg) (unsigned64-stack)) - (let ((nfp (current-nfp-tn vop))) - (store64 x nfp (tn-offset y)))) - -;; Move a tagged integer to a raw double-word representation. -(define-vop (move-to-64bit-word/fixnum) - (:args (x :scs (any-reg descriptor-reg))) - (:results (y :scs (signed64-reg unsigned64-reg))) - (:arg-types tagged-num) - (:note _N"fixnum untagging") - (:generator 0 - ;; Sign-extend the fixnum and then remove the tag. (Can't just - ;; remove the tag because we don't know for sure if X has been - ;; sign-extended to 64-bits. Let's be safe.) - (inst signx y x) - (inst srax y y fixnum-tag-bits))) - -(define-move-vop move-to-64bit-word/fixnum :move - (any-reg descriptor-reg) (signed64-reg unsigned64-reg)) - -;; Arg is a non-immediate constant, load it. -(define-vop (move-to-64bit-word-c) - (:args (x :scs (constant))) - (:results (y :scs (signed64-reg unsigned64-reg))) - (:note _N"constant load") - (:generator 1 - (inst li64 y (tn-value x)))) - -(define-move-vop move-to-64bit-word-c :move - (constant) (signed64-reg unsigned64-reg)) - -;; Arg is a fixnum or bignum. Figure out which and load if necessary -(define-vop (move-to-64bit-word/integer) - (:args (x :scs (descriptor-reg))) - (:results (y :scs (signed64-reg))) - (:note _N"integer to untagged word coercion") - (:temporary (:scs (signed64-reg)) temp) - (:generator 4 - (let ((done (gen-label))) - (inst andcc temp x fixnum-tag-mask) - (inst signx temp x) ; sign-extend X to TEMP - (inst b :eq done :pt :xcc) - (inst sran y temp fixnum-tag-bits) ; Zap the tag bits - - ;; We have a bignum. We need to check the length. If the - ;; length is 1, just get the one word. If it's 2, we need to - ;; get both words. - - (loadw temp x 0 other-pointer-type) - (inst srln temp 8) - (inst cmp temp 1) - (inst b :eq done) - ;; Get the low word and sign-extend it - (loadsw y x bignum-digits-offset other-pointer-type) - - - ;; Get the high word and then the low word. Merge them - ;; together. (If we knew that bignum digits started on an 8-byte - ;; boundary, we could do an 8-byte load and them manipulate the - ;; pieces to get the order we want. I think this would require - ;; adding a filler word to the bignum type in objdef.lisp. But - ;; then every bignum has a wasted word. Is that ok?) - (loadw temp x (1+ bignum-digits-offset) other-pointer-type) - (inst sllx temp temp 32) - (loadw y x bignum-digits-offset other-pointer-type) - (inst or y temp) - - (emit-label done) - - ))) - -(define-move-vop move-to-64bit-word/integer :move - (descriptor-reg) (signed64-reg)) - -;; Move a signed-byte 32 to a signed-byte 64. (Is this ever called? -;; I don't think so.) -(define-vop (move-to-64bit-word/signed) - (:args (x :scs (signed-reg))) - (:results (y :scs (signed64-reg))) - (:arg-types signed-num) - (:generator 0 - ;; Sign-extend the 32-bit number - (inst signx y x))) - -(define-move-vop move-to-64bit-word/signed :move - (signed-reg) (signed64-reg unsigned64-reg)) - -;; Move an unsigned-byte 32 to signed-byte 64. (I don't think this -;; ever gets called.) -(define-vop (move-to-64bit-word/unsigned) - (:args (x :scs (unsigned-reg))) - (:results (y :scs (signed64-reg))) - (:arg-types unsigned-num) - (:generator 1 - ;; Zero-extend the 32-bit number - (inst clruw y x))) - -(define-move-vop move-to-64bit-word/unsigned :move - (unsigned-reg) (signed64-reg unsigned64-reg)) - -;; Save a 64-bit int to a bignum. -(define-vop (move-from-signed64) - (:args (arg :scs (signed64-reg) :target x)) - (:results (y :scs (descriptor-reg))) - (:temporary (:scs (signed64-reg) :from (:argument 0)) x temp) - (:note _N"signed 64-bit word to integer coercion") - (:generator 20 - (move x arg) - (let ((fixnum (gen-label)) - (done (gen-label))) - ;; See if the result will fit in a fixnum. - (inst srax temp x positive-fixnum-bits) - (inst cmp temp) - ;; If result is all zeroes, we have a positive fixnum. - (inst b :eq fixnum :pt :xcc) - (inst orncc temp zero-tn temp) - ;; If result is all zeroes, we have a negative fixnum. - (inst b :eq done :pt :xcc) - (inst slln y x fixnum-tag-bits) - - ;; A 64-bit signed integer takes exactly 2 bignum digits - (with-fixed-allocation - (y temp bignum-type (+ 2 bignum-digits-offset)) - ;; Store the low word at the low address, the high word at the - ;; higher address. (Like move-to-64bit-word/integer, if we knew - ;; the first bignum digit was on a 8-byte boundary, we could - ;; just do a single 8-byte store instead of 2 stores here.) - (storew x y bignum-digits-offset other-pointer-type) - (inst srax x x 32) - (storew x y (1+ bignum-digits-offset) other-pointer-type)) - (inst b done) - (inst nop) - - (emit-label fixnum) - (inst slln y x fixnum-tag-bits) - (emit-label done)))) - -(define-move-vop move-from-signed64 :move - (signed64-reg) (descriptor-reg)) - -;; Save an unsigned 64-bit int to a bignum. -(define-vop (move-from-unsigned64) - (:args (arg :scs (unsigned64-reg) :target x)) - (:results (y :scs (descriptor-reg))) - (:temporary (:scs (unsigned64-reg) :from (:argument 0)) x temp) - (:note _N"unsigned 64-bit word to integer coercion") - (:generator 20 - (move x arg) - (let ((two-words (gen-label)) - (done (gen-label))) - ;; See if the result will fit in a fixnum. - (inst srax temp x positive-fixnum-bits) - (inst cmp temp) - ;; If result is all zeroes, we have a positive fixnum. - (inst b :eq done :pt :xcc) - (inst slln y x fixnum-tag-bits) - - ;; A unsigned 64-bit signed integer takes exactly 2 or 3 bignum - ;; digits. We always allocate 3. (The copying GC will take - ;; care of freeing the unused extra word, if any.) - (with-fixed-allocation - (y temp bignum-type (+ 3 bignum-digits-offset)) - (inst cmp x) - (inst b :ge two-words :pn :xcc) - (inst li temp (logior (ash 2 type-bits) bignum-type)) - (inst li temp (logior (ash 3 type-bits) bignum-type)) - (emit-label two-words) - ;; Set the header word with the correct bignum length. - (storew temp y 0 other-pointer-type) - ;; Store the low word at the low address, the high word at the - ;; higher address. (Like move-to-64bit-word/integer, if we knew - ;; the first bignum digit was on a 8-byte boundary, we could - ;; just do a single 8-byte store instead of 2 stores here.) - (storew x y bignum-digits-offset other-pointer-type) - (inst srax x x 32) - (storew x y (1+ bignum-digits-offset) other-pointer-type)) - (emit-label done)))) - -(define-move-vop move-from-unsigned64 :move - (unsigned64-reg) (descriptor-reg)) - -(define-vop (move-to-unsigned-64bit-word/integer) - (:args (x :scs (descriptor-reg))) - (:results (y :scs (unsigned64-reg))) - (:note _N"integer to untagged word coercion") - (:temporary (:scs (unsigned64-reg)) temp) - (:generator 4 - (let ((done (gen-label))) - (inst andcc temp x fixnum-tag-mask) - (inst signx temp x) ; sign-extend X to TEMP - (inst b :eq done :pt :xcc) - (inst sran y temp fixnum-tag-bits) ; Zap the tag bits - - ;; We have a bignum. We need to check the length. If the - ;; length is 1, just get the one word. If it's 2, we need to - ;; get both words. - - (loadw temp x 0 other-pointer-type) - (inst srln temp 8) - (inst cmp temp 1) - (inst b :eq done) - ;; Get the low word and zero-extend it and we're done. - (loadw y x bignum-digits-offset other-pointer-type) - - - ;; Get the high word and then the low word. Merge them - ;; together. (If we knew that bignum digits started on an 8-byte - ;; boundary, we could do an 8-byte load and them manipulate the - ;; pieces to get the order we want. I think this would require - ;; adding a filler word to the bignum type in objdef.lisp. But - ;; then every bignum has a wasted word. Is that ok?) - (loadw temp x (1+ bignum-digits-offset) other-pointer-type) - (inst sllx temp temp 32) - (loadw y x bignum-digits-offset other-pointer-type) - (inst or y temp) - - (emit-label done) - - ))) - -(define-move-vop move-to-unsigned-64bit-word/integer :move - (descriptor-reg) (unsigned64-reg)) - -(define-vop (64bit-word-move) - (:args (x :target y - :scs (signed64-reg unsigned64-reg) - :load-if (not (location= x y)))) - (:results (y :scs (signed64-reg unsigned64-reg) - :load-if (not (location= x y)))) - (:effects) - (:affected) - (:note _N"word integer move") - (:generator 0 - (move y x))) - -(define-move-vop 64bit-word-move :move - (signed64-reg unsigned64-reg) (signed64-reg unsigned64-reg)) - -;; Move untagged number arguments/return-values. -(define-vop (move-64bit-word-argument) - (:args (x :target y - :scs (signed-reg signed64-reg unsigned64-reg immediate)) - (fp :scs (any-reg) - :load-if (not (sc-is y sap-reg)))) - (:results (y)) - (:note _N"word integer argument move") - (:generator 0 - (sc-case y - ((signed64-reg unsigned64-reg) - (sc-case x - ((signed64-reg unsigned64-reg) - (move y x)) - (signed-reg - (inst signx y x)) - (immediate - (inst li64 y (tn-value x))))) - ((signed64-stack unsigned64-stack) - (store64 x fp (tn-offset y)))))) - -(define-move-vop move-64bit-word-argument :move-argument - (descriptor-reg signed64-reg unsigned64-reg) (signed64-reg unsigned64-reg)) - -(define-move-vop move-argument :move-argument - (signed64-reg unsigned64-reg) (descriptor-reg)) -) ===================================== src/compiler/sparc64/vm.lisp ===================================== --- a/src/compiler/sparc64/vm.lisp +++ b/src/compiler/sparc64/vm.lisp @@ -244,6 +244,7 @@ (non-descriptor-reg registers :locations #.non-descriptor-regs) +#|| ;; 64-bit signed and unsigned integers #+(and sparc-v9 sparc-v8plus) @@ -270,7 +271,7 @@ :constant-scs (zero immediate) :save-p t :alternate-scs (unsigned64-stack)) - +||# ;; Pointers to the interior of objects. Used only as an temporary. (interior-reg registers :locations (#.lip-offset)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/850cec97e6b7a65e0a5fd1358… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/850cec97e6b7a65e0a5fd1358… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][sparc64-dev] Split LOAD-IMMEDIATE into various parts
by Raymond Toy 03 Jan '18

03 Jan '18

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: bd60cf13 by Raymond Toy at 2018-01-03T09:34:27-08:00 Split LOAD-IMMEDIATE into various parts Use separate not-implemented for the various branchs of load-immediate to make it easier to tell what's being loaded. Also add a few more not-implemented calls in places we missed. - - - - - 1 changed file: - src/compiler/sparc64/move.lisp Changes: ===================================== src/compiler/sparc64/move.lisp ===================================== --- a/src/compiler/sparc64/move.lisp +++ b/src/compiler/sparc64/move.lisp @@ -25,15 +25,18 @@ ((null immediate zero) (any-reg descriptor-reg)) (let ((val (tn-value x))) - (not-implemented "LOAD-IMMEDIATE") (etypecase val (integer + (not-implemented "LOAD-IMMEDIATE/INTEGER") (inst li y (fixnumize val))) (null + (not-implemented "LOAD-IMMEDIATE/NULL") (move y null-tn)) (symbol + (not-implemented "LOAD-IMMEDIATE/SYMBOL") (load-symbol y val)) (character + (not-implemented "LOAD-IMMEDIATE/CHAR") (inst li y (logior (ash (char-code val) type-bits) base-char-type)))))) @@ -48,6 +51,7 @@ (define-move-function (load-number 1) (vop x y) ((immediate zero) (signed-reg unsigned-reg signed64-reg unsigned64-reg)) + (not-implemented "LOAD-NUMBER") (inst li64 y (tn-value x))) (define-move-function (load-base-char 1) (vop x y) @@ -223,6 +227,7 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:generator 4 (let ((done (gen-label))) + (emit-not-implemented) (inst andcc temp x fixnum-tag-mask) (inst signx temp x) ; sign-extend x to temp (inst b :eq done) @@ -333,6 +338,7 @@ (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) x temp) (:note _N"unsigned word to integer coercion") (:generator 20 + (emit-not-implemented) (move x arg) (let ((done (gen-label))) (inst sran temp x positive-fixnum-bits) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/bd60cf1358fdaba1d9ccee2ab… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/bd60cf1358fdaba1d9ccee2ab… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][sparc64-dev] 2 commits: Add more NOT-IMPLEMENTED
by Raymond Toy 03 Jan '18

03 Jan '18

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: 7c7966bd by Raymond Toy at 2018-01-03T08:44:07-08:00 Add more NOT-IMPLEMENTED - - - - - 5318926b by Raymond Toy at 2018-01-03T09:20:12-08:00 Align LRA on 16-byte boundaries - - - - - 3 changed files: - src/assembly/sparc64/arith.lisp - src/compiler/sparc64/macros.lisp - src/lisp/sparc64-assem.S Changes: ===================================== src/assembly/sparc64/arith.lisp ===================================== --- a/src/assembly/sparc64/arith.lisp +++ b/src/assembly/sparc64/arith.lisp @@ -36,6 +36,7 @@ (:temp lra descriptor-reg lra-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) + (not-implemented "GENERIC-+") (inst andcc zero-tn x fixnum-tag-mask) (inst b :ne DO-STATIC-FUN) (inst andcc zero-tn y fixnum-tag-mask) @@ -80,6 +81,7 @@ (:temp lra descriptor-reg lra-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) + (not-implemented "GENERIC--") (inst andcc zero-tn x fixnum-tag-mask) (inst b :ne DO-STATIC-FUN) (inst andcc zero-tn y fixnum-tag-mask) @@ -129,6 +131,7 @@ (:temp lra descriptor-reg lra-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) + (not-implemented "GENERIC-*") ;; If either arg is not a fixnum, call the static function. (inst andcc zero-tn x fixnum-tag-mask) (inst b :ne DO-STATIC-FUN) @@ -138,7 +141,7 @@ ;; Remove the tag from one arg so that the result will have the correct ;; fixnum tag. - (inst sra temp x fixnum-tag-bits) + (inst sran temp x fixnum-tag-bits) ;; Compute the produce temp * y and return the double-word product ;; in hi:lo. (cond ((backend-featurep :sparc-64) @@ -228,6 +231,7 @@ (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) + (not-implemented ,name) (inst andcc zero-tn x fixnum-tag-mask) (inst b :ne DO-STATIC-FN) (inst andcc zero-tn y fixnum-tag-mask) @@ -268,6 +272,7 @@ (:temp lra descriptor-reg lra-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) + (not-implemented "GENERIC-EQL") (inst cmp x y) (inst b :eq RETURN-T) (inst andcc zero-tn x fixnum-tag-mask) @@ -305,6 +310,7 @@ (:temp lra descriptor-reg lra-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) + (not-implemented "GENERIC-=") (inst andcc zero-tn x fixnum-tag-mask) (inst b :ne DO-STATIC-FN) (inst andcc zero-tn y fixnum-tag-mask) @@ -341,6 +347,7 @@ (:temp lra descriptor-reg lra-offset) (:temp nargs any-reg nargs-offset) (:temp ocfp any-reg ocfp-offset)) + (not-implemented "GENERIC-/=") (inst cmp x y) (inst b :eq RETURN-NIL) (inst andcc zero-tn x fixnum-tag-mask) ===================================== src/compiler/sparc64/macros.lisp ===================================== --- a/src/compiler/sparc64/macros.lisp +++ b/src/compiler/sparc64/macros.lisp @@ -142,7 +142,7 @@ (defmacro emit-return-pc (label) "Emit a return-pc header word. LABEL is the label to use for this return-pc." `(progn - (align lowtag-bits) + (align 4) (emit-label ,label) (inst word 0) (inst lra-header-word))) ===================================== src/lisp/sparc64-assem.S ===================================== --- a/src/lisp/sparc64-assem.S +++ b/src/lisp/sparc64-assem.S @@ -107,8 +107,9 @@ call_into_lisp: jmp reg_CODE+FUNCTION_CODE_OFFSET nop - .align 8 + .align 16 lra: + .word 0 .word type_ReturnPcHeader /* Blow off any extra values. */ View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/f52af3436f0f657dfb14d97f… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/f52af3436f0f657dfb14d97f… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][sparc64-dev] 2 commits: WORD-INDEX-{REF, SET} must shift index left.
by Raymond Toy 03 Jan '18

03 Jan '18

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/608fadde188e963541d6f44e… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/608fadde188e963541d6f44e… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][sparc64-dev] Fix error in printing NOT-IMPLEMENTED
by Raymond Toy 02 Jan '18

02 Jan '18

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: 608fadde by Raymond Toy at 2018-01-02T10:46:13-08:00 Fix error in printing NOT-IMPLEMENTED The computed max string length was off by 4 because instruction displacement is relative to the address of the branch instruction. Need to subtract 2, one for the instruction itself and one for the delay slot. - - - - - 1 changed file: - src/lisp/sparc-arch.c Changes: ===================================== src/lisp/sparc-arch.c ===================================== --- a/src/lisp/sparc-arch.c +++ b/src/lisp/sparc-arch.c @@ -531,10 +531,10 @@ sigill_handler(HANDLER_ARGS) string = (unsigned char *) &pc[3]; /* * The offset is in 32-bit words, so subtract one for - * the instruction in the branch delay slot and scale up - * the offet to be in bytes. + * the instruction itself and one for the branch delay + * slot and scale up the offet to be in bytes. */ - length = 4 * ((pc[1] & 0x7FFFF) - 1); + length = 4 * ((pc[1] & 0x7FFFF) - 2); while (string[length - 1] == '\0') { --length; View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/608fadde188e963541d6f44e4… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/608fadde188e963541d6f44e4… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][sparc64-dev] 2 commits: Enable random-xoroshiro for sparc64
by Raymond Toy 01 Jan '18

01 Jan '18

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: 0bb3de03 by Raymond Toy at 2018-01-01T09:03:08-08:00 Enable random-xoroshiro for sparc64 - - - - - dddfd33c by Raymond Toy at 2018-01-01T09:04:05-08:00 Add more not-implemented notes so we can watch what's happening. - - - - - 3 changed files: - src/compiler/sparc64/memory.lisp - src/compiler/sparc64/move.lisp - src/tools/cross-scripts/cross-x86-sparc64.lisp Changes: ===================================== src/compiler/sparc64/memory.lisp ===================================== --- a/src/compiler/sparc64/memory.lisp +++ b/src/compiler/sparc64/memory.lisp @@ -28,6 +28,7 @@ (:variant-vars offset lowtag) (:policy :fast-safe) (:generator 4 + (emit-not-implemented) (loadw value object offset lowtag))) ;;; (define-vop (cell-set) @@ -49,6 +50,7 @@ (:variant-vars base lowtag) (:info offset) (:generator 4 + (emit-not-implemented) (loadw value object (+ base offset) lowtag))) ;;; (define-vop (slot-set) @@ -57,6 +59,7 @@ (:variant-vars base lowtag) (:info offset) (:generator 4 + (emit-not-implemented) (storew value object (+ base offset) lowtag))) @@ -81,6 +84,7 @@ (:variant-vars offset lowtag) (:policy :fast-safe) (:generator 5 + (emit-not-implemented) (sc-case index ((immediate zero) (let ((offset (- (+ (if (sc-is index zero) ===================================== src/compiler/sparc64/move.lisp ===================================== --- a/src/compiler/sparc64/move.lisp +++ b/src/compiler/sparc64/move.lisp @@ -41,6 +41,7 @@ (define-move-function (load-number 1) (vop x y) ((immediate zero) (signed-reg unsigned-reg)) + (not-implemented "LOAD-NUMBER") (inst li y (tn-value x))) #+(and sparc-v9 sparc-v8plus) @@ -51,10 +52,12 @@ (define-move-function (load-base-char 1) (vop x y) ((immediate) (base-char-reg)) + (not-implemented "LOAD-BASE-CHAR") (inst li y (char-code (tn-value x)))) (define-move-function (load-system-area-pointer 1) (vop x y) ((immediate) (sap-reg)) + (not-implemented "LOAD-SYSTEM-AREA-POINTER") (inst li y (sap-int (tn-value x)))) (define-move-function (load-constant 5) (vop x y) @@ -64,6 +67,7 @@ (define-move-function (load-stack 5) (vop x y) ((control-stack) (any-reg descriptor-reg)) + (not-implemented "LOAD-STACK") (load-stack-tn y x)) (define-move-function (load-number-stack 5) (vop x y) @@ -72,6 +76,7 @@ (signed-stack) (signed-reg) (unsigned-stack) (unsigned-reg)) (let ((nfp (current-nfp-tn vop))) + (not-implemented "LOAD-NUMBER-STACK") (loadw y nfp (tn-offset x)))) (define-move-function (store-stack 5) (vop x y) @@ -85,6 +90,7 @@ (signed-reg) (signed-stack) (unsigned-reg) (unsigned-stack)) (let ((nfp (current-nfp-tn vop))) + (not-implemented "STORE-NUMBER-STACK") (storew x nfp (tn-offset y)))) @@ -169,6 +175,7 @@ (:arg-types tagged-num) (:note _N"fixnum untagging") (:generator 1 + (emit-not-implemented) (inst sran y x fixnum-tag-bits))) ;;; @@ -181,6 +188,7 @@ (:results (y :scs (signed-reg unsigned-reg))) (:note _N"constant load") (:generator 1 + (emit-not-implemented) (inst li y (tn-value x)))) ;;; @@ -196,6 +204,7 @@ (:temporary (:scs (non-descriptor-reg)) temp) (:generator 4 (let ((done (gen-label))) + (emit-not-implemented) (inst andcc temp x fixnum-tag-mask) (inst b :eq done) (inst sran y x fixnum-tag-bits) @@ -238,6 +247,7 @@ (:result-types tagged-num) (:note _N"fixnum tagging") (:generator 1 + (emit-not-implemented) (inst slln y x fixnum-tag-bits))) ;;; (define-move-vop move-from-word/fixnum :move @@ -253,6 +263,7 @@ (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) x temp) (:note _N"signed word to integer coercion") (:generator 20 + (emit-not-implemented) (move x arg) (let ((done (gen-label))) ;; Need to figure out if we have a fixnum or not, so look at the @@ -290,6 +301,7 @@ (:temporary (:scs (non-descriptor-reg) :from (:argument 0)) x temp) (:note _N"unsigned word to integer coercion") (:generator 20 + (emit-not-implemented) (move x arg) (let ((done (gen-label)) (one-word (gen-label))) ===================================== src/tools/cross-scripts/cross-x86-sparc64.lisp ===================================== --- a/src/tools/cross-scripts/cross-x86-sparc64.lisp +++ b/src/tools/cross-scripts/cross-x86-sparc64.lisp @@ -35,7 +35,7 @@ :relative-package-names ; Relative package names from Allegro :conservative-float-type :hash-new - :random-mt19937 ; MT-19937 generator + :random-xoroshiro ; xoroshiro128+ generator :cmu ; Announce this is CMUCL :cmu20 :cmu20b ; Current version identifier :modular-arith ; Modular arithmetic @@ -66,6 +66,7 @@ :pentium :long-float :new-random + :random-mt19937 ; MT-19937 generator :small :mp)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/a2c048858bf31dd0c5ec5f2b… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/compare/a2c048858bf31dd0c5ec5f2b… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[Git][cmucl/cmucl][sparc64-dev] Make declaration of solaris_register_addres match impl
by Raymond Toy 01 Jan '18

01 Jan '18

Raymond Toy pushed to branch sparc64-dev at cmucl / cmucl Commits: a2c04885 by Raymond Toy at 2017-12-31T15:38:11-08:00 Make declaration of solaris_register_addres match impl - - - - - 1 changed file: - src/lisp/sparc-lispregs.h Changes: ===================================== src/lisp/sparc-lispregs.h ===================================== --- a/src/lisp/sparc-lispregs.h +++ b/src/lisp/sparc-lispregs.h @@ -134,7 +134,7 @@ #include <ucontext.h> -extern int *solaris_register_address(struct ucontext *, int); +extern long *solaris_register_address(struct ucontext *, int); #define SC_REG(sc, reg) (*solaris_register_address(sc,reg)) View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/a2c048858bf31dd0c5ec5f2ba… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/a2c048858bf31dd0c5ec5f2ba… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0