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.
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.
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.
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.
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.