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

[Git][cmucl/cmucl][master] Regenerate
by Raymond Toy 13 Jan '18

13 Jan '18

Raymond Toy pushed to branch master at cmucl / cmucl Commits: f19dd877 by Raymond Toy at 2018-01-13T08:22:44-08:00 Regenerate - - - - - 2 changed files: - src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po - src/i18n/locale/ko/LC_MESSAGES/cmucl.po Changes: ===================================== src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po ===================================== --- a/src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po +++ b/src/i18n/locale/en(a)piglatin/LC_MESSAGES/cmucl.po @@ -34,7 +34,7 @@ msgstr "Ethay izesay ofway away eamstray inway-ufferbay." #: src/code/intl.lisp src/compiler/globaldb.lisp src/code/defstruct.lisp #: src/code/remote.lisp src/code/wire.lisp src/code/internet.lisp #: src/code/loop.lisp src/code/run-program.lisp src/code/parse-time.lisp -#: src/code/profile.lisp src/code/ntrace.lisp src/code/rand-mt19937.lisp +#: src/code/profile.lisp src/code/ntrace.lisp src/code/rand-xoroshiro.lisp #: src/code/debug.lisp src/code/debug-int.lisp src/code/debug-info.lisp #: src/code/eval.lisp src/code/filesys.lisp src/code/pathname.lisp #: src/code/fd-stream.lisp src/code/extfmts.lisp src/code/serve-event.lisp @@ -17335,17 +17335,18 @@ msgstr "" msgid "Type \"yes\" for yes or \"no\" for no. " msgstr "Ypetay \"esyay\" orfay esyay orway \"onay\" orfay onay. " -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp +#, fuzzy msgid "" "Generate an random state vector from the given SEED. The seed can be\n" -" either an integer or a vector of (unsigned-byte 32)" +" either an integer or a vector of (unsigned-byte 64)" msgstr "" "Enerategay anway andomray tatesay ectorvay omfray ethay ivengay SEED. Ethay " "eedsay ancay ebay\n" " eitherway anway integerway orway away ectorvay ofway (unsignedway-ytebay " "32)" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Make a random state object. If STATE is not supplied, return a copy\n" " of the default random state. If STATE is a random state, then return a\n" @@ -17360,11 +17361,12 @@ msgstr "" "tatesay eneratedgay omfray\n" " ethay universalway imetay orway /evday/urandomway ifway availableway." -#: src/code/rand-mt19937.lisp -msgid "Argument is not a RANDOM-STATE, T or NIL: ~S" +#: src/code/rand-xoroshiro.lisp +#, fuzzy +msgid "Argument is not a RANDOM-STATE, T, or NIL: ~S" msgstr "Argumentway isway otnay away RANDOM-STATE, T orway NIL: ~S" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Generate a uniformly distributed pseudo-random number between zero\n" " and Arg. State, if supplied, is the random state to use." @@ -17374,12 +17376,19 @@ msgstr "" " andway Argway. Tatesay, ifway uppliedsay, isway ethay andomray tatesay " "otay useway." -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "Argument is not a positive integer or a positive float: ~S" msgstr "" "Argumentway isway otnay away ositivepay integerway orway away ositivepay " "oatflay: ~S" +#: src/code/rand-xoroshiro.lisp +msgid "" +"Jump the RNG-STATE. This is equivalent to 2^64 calls to the\n" +" xoroshiro128+ generator. It can be used to generate 2^64\n" +" non-overlapping subsequences for parallel computations." +msgstr "" + #: src/code/ntrace.lisp msgid "" "This is bound to the returned values when evaluating :BREAK-AFTER and\n" @@ -27348,10 +27357,6 @@ msgid "use inline (unsigned-byte 32) operations" msgstr "useway inlineway (unsignedway-ytebay 32) operationsway" #: src/compiler/float-tran.lisp -msgid "Shouldn't happen" -msgstr "Ouldnshay't appenhay" - -#: src/compiler/float-tran.lisp msgid "Can't open-code float to rational comparison." msgstr "Ancay't openway-odecay oatflay otay ationalray omparisoncay." @@ -30979,6 +30984,9 @@ msgstr "" "eplacedray ybay ethay\n" "Unicodeway eplacementray aracterchay." +#~ msgid "Shouldn't happen" +#~ msgstr "Ouldnshay't appenhay" + #~ msgid "No such program: ~S" #~ msgstr "Onay uchsay ogrampray: ~S" ===================================== src/i18n/locale/ko/LC_MESSAGES/cmucl.po ===================================== --- a/src/i18n/locale/ko/LC_MESSAGES/cmucl.po +++ b/src/i18n/locale/ko/LC_MESSAGES/cmucl.po @@ -34,7 +34,7 @@ msgstr "스트림 인 버퍼의 크기." #: src/code/intl.lisp src/compiler/globaldb.lisp src/code/defstruct.lisp #: src/code/remote.lisp src/code/wire.lisp src/code/internet.lisp #: src/code/loop.lisp src/code/run-program.lisp src/code/parse-time.lisp -#: src/code/profile.lisp src/code/ntrace.lisp src/code/rand-mt19937.lisp +#: src/code/profile.lisp src/code/ntrace.lisp src/code/rand-xoroshiro.lisp #: src/code/debug.lisp src/code/debug-int.lisp src/code/debug-info.lisp #: src/code/eval.lisp src/code/filesys.lisp src/code/pathname.lisp #: src/code/fd-stream.lisp src/code/extfmts.lisp src/code/serve-event.lisp @@ -12130,13 +12130,13 @@ msgstr "" msgid "Type \"yes\" for yes or \"no\" for no. " msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Generate an random state vector from the given SEED. The seed can be\n" -" either an integer or a vector of (unsigned-byte 32)" +" either an integer or a vector of (unsigned-byte 64)" msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Make a random state object. If STATE is not supplied, return a copy\n" " of the default random state. If STATE is a random state, then return a\n" @@ -12144,20 +12144,27 @@ msgid "" " the universal time or /dev/urandom if available." msgstr "" -#: src/code/rand-mt19937.lisp -msgid "Argument is not a RANDOM-STATE, T or NIL: ~S" +#: src/code/rand-xoroshiro.lisp +msgid "Argument is not a RANDOM-STATE, T, or NIL: ~S" msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "" "Generate a uniformly distributed pseudo-random number between zero\n" " and Arg. State, if supplied, is the random state to use." msgstr "" -#: src/code/rand-mt19937.lisp +#: src/code/rand-xoroshiro.lisp msgid "Argument is not a positive integer or a positive float: ~S" msgstr "" +#: src/code/rand-xoroshiro.lisp +msgid "" +"Jump the RNG-STATE. This is equivalent to 2^64 calls to the\n" +" xoroshiro128+ generator. It can be used to generate 2^64\n" +" non-overlapping subsequences for parallel computations." +msgstr "" + #: src/code/ntrace.lisp msgid "" "This is bound to the returned values when evaluating :BREAK-AFTER and\n" @@ -18909,10 +18916,6 @@ msgid "use inline (unsigned-byte 32) operations" msgstr "" #: src/compiler/float-tran.lisp -msgid "Shouldn't happen" -msgstr "" - -#: src/compiler/float-tran.lisp msgid "Can't open-code float to rational comparison." msgstr "" View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/f19dd8773ef50989907e1e6c4… --- View it on GitLab: https://gitlab.common-lisp.net/cmucl/cmucl/commit/f19dd8773ef50989907e1e6c4… You're receiving this email because of your account on gitlab.common-lisp.net.

1 0

[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