[prev in list] [next in list] [prev in thread] [next in thread]
List: sbcl-commits
Subject: [Sbcl-commits] master: More compact error code for overflow-ash
From: stassats via Sbcl-commits <sbcl-commits () lists ! sourceforge ! net>
Date: 2023-09-29 18:12:24
Message-ID: 1696011145.164796.6174 () sfp-scm-5 ! v30 ! lw ! sourceforge ! com
[Download RAW message or body]
The branch "master" has been updated in SBCL:
via f88b4de36a9aa96c31e17f04d0fc3c9816a82dc4 (commit)
from 31926f15f83f7febd25e9763c1a15b74dfdccf37 (commit)
- Log -----------------------------------------------------------------
commit f88b4de36a9aa96c31e17f04d0fc3c9816a82dc4
Author: Stas Boukarev <stassats@gmail.com>
Date: Fri Sep 29 19:39:38 2023 +0300
More compact error code for overflow-ash
Encode immediate shifts without moving them into a register.
---
src/compiler/arm64/arith.lisp | 46 +++++++++++++++++++++++++-----------------
src/compiler/x86-64/arith.lisp | 46 +++++++++++++++++++++++++-----------------
2 files changed, 56 insertions(+), 36 deletions(-)
diff --git a/src/compiler/arm64/arith.lisp b/src/compiler/arm64/arith.lisp
index 39f28310e..c32de38ce 100644
--- a/src/compiler/arm64/arith.lisp
+++ b/src/compiler/arm64/arith.lisp
@@ -2328,15 +2328,20 @@
(amount-error amount)
(error (generate-error-code+
(when (sc-is amount immediate)
- (setf amount (tn-value amount)
- amount-error
- (make-random-tn :kind :normal
- :sc (sc-or-lose (if (typep amount 'word)
- 'unsigned-reg
- 'signed-reg))
- :offset (tn-offset tmp-tn)))
- (lambda ()
- (load-immediate-word amount-error amount)))
+ (setf amount (tn-value amount))
+ (cond ((typep amount 'sc-offset)
+ (setf amount-error (make-sc+offset immediate-sc-number amount))
+ nil)
+ (t
+ (setf amount-error
+ (make-random-tn :kind :normal
+ :sc (sc-or-lose (if (typep amount 'word)
+ 'unsigned-reg
+ 'signed-reg))
+ :offset (tn-offset tmp-tn)))
+
+ (lambda ()
+ (load-immediate-word amount-error amount)))))
vop 'sb-kernel::ash-overflow2-error number amount-error))
(fits (csubtypep (tn-ref-type amount-ref)
(specifier-type `(integer -63 63)))))
@@ -2407,15 +2412,20 @@
(amount-error amount)
(error (generate-error-code+
(when (sc-is amount immediate)
- (setf amount (tn-value amount)
- amount-error
- (make-random-tn :kind :normal
- :sc (sc-or-lose (if (typep amount 'word)
- 'unsigned-reg
- 'signed-reg))
- :offset (tn-offset tmp-tn)))
- (lambda ()
- (load-immediate-word amount-error amount)))
+ (setf amount (tn-value amount))
+ (cond ((typep amount 'sc-offset)
+ (setf amount-error (make-sc+offset immediate-sc-number amount))
+ nil)
+ (t
+ (setf amount-error
+ (make-random-tn :kind :normal
+ :sc (sc-or-lose (if (typep amount 'word)
+ 'unsigned-reg
+ 'signed-reg))
+ :offset (tn-offset tmp-tn)))
+
+ (lambda ()
+ (load-immediate-word amount-error amount)))))
vop 'sb-kernel::ash-overflow2-error number amount-error))
(fits (csubtypep (tn-ref-type amount-ref)
(specifier-type `(integer -63 63)))))
diff --git a/src/compiler/x86-64/arith.lisp b/src/compiler/x86-64/arith.lisp
index e06051ccb..64ad6eefe 100644
--- a/src/compiler/x86-64/arith.lisp
+++ b/src/compiler/x86-64/arith.lisp
@@ -1281,15 +1281,20 @@
(amount-error amount)
(error (generate-error-code+
(when (sc-is amount immediate)
- (setf amount (tn-value amount)
- amount-error
- (make-random-tn :kind :normal
- :sc (sc-or-lose (if (typep amount 'word)
- 'unsigned-reg
- 'signed-reg))
- :offset (tn-offset temp)))
- (lambda ()
- (inst mov temp amount)))
+ (setf amount (tn-value amount))
+ (cond ((typep amount 'sc-offset)
+ (setf amount-error (make-sc+offset immediate-sc-number amount))
+ nil)
+ (t
+ (setf amount-error
+ (make-random-tn :kind :normal
+ :sc (sc-or-lose (if (typep amount 'word)
+ 'unsigned-reg
+ 'signed-reg))
+ :offset (tn-offset temp)))
+
+ (lambda ()
+ (inst mov temp amount)))))
vop 'sb-kernel::ash-overflow2-error number amount-error))
(amount-width (if (csubtypep (tn-ref-type amount-ref)
(specifier-type `(signed-byte 32)))
@@ -1378,15 +1383,20 @@
(amount-error amount)
(error (generate-error-code+
(when (sc-is amount immediate)
- (setf amount (tn-value amount)
- amount-error
- (make-random-tn :kind :normal
- :sc (sc-or-lose (if (typep amount 'word)
- 'unsigned-reg
- 'signed-reg))
- :offset (tn-offset temp)))
- (lambda ()
- (inst mov temp amount)))
+ (setf amount (tn-value amount))
+ (cond ((typep amount 'sc-offset)
+ (setf amount-error (make-sc+offset immediate-sc-number amount))
+ nil)
+ (t
+ (setf amount-error
+ (make-random-tn :kind :normal
+ :sc (sc-or-lose (if (typep amount 'word)
+ 'unsigned-reg
+ 'signed-reg))
+ :offset (tn-offset temp)))
+
+ (lambda ()
+ (inst mov temp amount)))))
vop 'sb-kernel::ash-overflow2-error number amount-error))
(amount-width (if (csubtypep (tn-ref-type amount-ref)
(specifier-type `(signed-byte 32)))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic