[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 40/41: More efficient assembler instructions
From: |
Andy Wingo |
Subject: |
[Guile-commits] 40/41: More efficient assembler instructions |
Date: |
Wed, 02 Dec 2015 08:07:00 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit dbd9265cc0994c30429070136708b64a75ddf20a
Author: Andy Wingo <address@hidden>
Date: Tue Dec 1 17:04:36 2015 +0100
More efficient assembler instructions
* module/system/vm/assembler.scm (pack-u8-u24, pack-u8-s24):
(pack-u1-u7-u24, pack-u8-u12-u12, pack-u8-u8-u16): Tweak to expose
more possibilities for untagging u64 values.
---
module/system/vm/assembler.scm | 95 +++++++++++++++++++++++++---------------
1 files changed, 60 insertions(+), 35 deletions(-)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index f94d0f0..e5f464b 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -229,57 +229,82 @@
;;; These helpers create one 32-bit unit from multiple components.
(define-inline (pack-u8-u24 x y)
- (unless (<= 0 x 255)
- (error "out of range" x))
- (logior x (ash y 8)))
+ (let ((x* (logand x #xff))
+ (y* (logand y #xffffff)))
+ (unless (= x x*)
+ (error "out of range" x))
+ (unless (= y y*)
+ (error "out of range" y))
+ (logior x* (ash y* 8))))
(define-inline (pack-u8-s24 x y)
- (unless (<= 0 x 255)
- (error "out of range" x))
- (logior x (ash (cond
- ((< 0 (- y) #x800000)
- (+ y #x1000000))
- ((<= 0 y #xffffff)
- y)
- (else (error "out of range" y)))
- 8)))
+ (let ((x* (logand x #xff))
+ (y* (logand y #xffffff)))
+ (unless (= x x*)
+ (error "out of range" x))
+ (unless (if (< y* #x800000)
+ (= y y*)
+ (= (+ y #x1000000) y*))
+ (error "out of range" y))
+ (logior x* (ash y* 8))))
(define-inline (pack-u1-u7-u24 x y z)
- (unless (<= 0 x 1)
- (error "out of range" x))
- (unless (<= 0 y 127)
- (error "out of range" y))
- (logior x (ash y 1) (ash z 8)))
+ (let ((x* (logand x #x1))
+ (y* (logand y #x7f))
+ (z* (logand z #xffffff)))
+ (unless (= x x*)
+ (error "out of range" x))
+ (unless (= y y*)
+ (error "out of range" y))
+ (unless (= z z*)
+ (error "out of range" z))
+ (logior x* (ash y* 1) (ash z* 8))))
(define-inline (pack-u8-u12-u12 x y z)
- (unless (<= 0 x 255)
- (error "out of range" x))
- (unless (<= 0 y 4095)
- (error "out of range" y))
- (logior x (ash y 8) (ash z 20)))
+ (let ((x* (logand x #xff))
+ (y* (logand y #xfff))
+ (z* (logand z #xfff)))
+ (unless (= x x*)
+ (error "out of range" x))
+ (unless (= y y*)
+ (error "out of range" y))
+ (unless (= z z*)
+ (error "out of range" z))
+ (logior x* (ash y* 8) (ash z* 20))))
(define-inline (pack-u8-u8-u16 x y z)
- (unless (<= 0 x 255)
- (error "out of range" x))
- (unless (<= 0 y 255)
- (error "out of range" y))
- (logior x (ash y 8) (ash z 16)))
+ (let ((x* (logand x #xff))
+ (y* (logand y #xff))
+ (z* (logand z #xffff)))
+ (unless (= x x*)
+ (error "out of range" x))
+ (unless (= y y*)
+ (error "out of range" y))
+ (unless (= z z*)
+ (error "out of range" z))
+ (logior x* (ash y* 8) (ash z* 16))))
(define-inline (pack-u8-u8-u8-u8 x y z w)
- (unless (<= 0 x 255)
- (error "out of range" x))
- (unless (<= 0 y 255)
- (error "out of range" y))
- (unless (<= 0 z 255)
- (error "out of range" z))
- (logior x (ash y 8) (ash z 16) (ash w 24)))
+ (let ((x* (logand x #xff))
+ (y* (logand y #xff))
+ (z* (logand z #xff))
+ (w* (logand w #xff)))
+ (unless (= x x*)
+ (error "out of range" x))
+ (unless (= y y*)
+ (error "out of range" y))
+ (unless (= z z*)
+ (error "out of range" z))
+ (unless (= w w*)
+ (error "out of range" w))
+ (logior x* (ash y* 8) (ash z* 16) (ash w* 24))))
(eval-when (expand)
(define-syntax pack-flags
(syntax-rules ()
;; Add clauses as needed.
((pack-flags f1 f2) (logior (if f1 (ash 1 0) 0)
- (if f2 (ash 2 0) 0))))))
+ (if f2 (ash 1 1) 0))))))
;;; Helpers to read and write 32-bit units in a buffer.
- [Guile-commits] 28/41: Specialize u64 arithmetic, (continued)
- [Guile-commits] 28/41: Specialize u64 arithmetic, Andy Wingo, 2015/12/02
- [Guile-commits] 37/41: Disable warnings on bootstrap build, Andy Wingo, 2015/12/02
- [Guile-commits] 35/41: Add current-thread VM op, Andy Wingo, 2015/12/02
- [Guile-commits] 27/41: Better range inference for indexes of vector-ref, string-ref et al, Andy Wingo, 2015/12/02
- [Guile-commits] 29/41: Remove add1 and sub1, Andy Wingo, 2015/12/02
- [Guile-commits] 30/41: Add tagged and untagged arithmetic ops with immediate operands, Andy Wingo, 2015/12/02
- [Guile-commits] 32/41: Add support for unboxed s64 values, Andy Wingo, 2015/12/02
- [Guile-commits] 39/41: Specialize u64 bit operations, Andy Wingo, 2015/12/02
- [Guile-commits] 31/41: New instructions load-f64, load-u64, Andy Wingo, 2015/12/02
- [Guile-commits] 36/41: Add logsub op., Andy Wingo, 2015/12/02
- [Guile-commits] 40/41: More efficient assembler instructions,
Andy Wingo <=
- [Guile-commits] 33/41: Untag values and indexes for all bytevector instructions, Andy Wingo, 2015/12/02
- [Guile-commits] 41/41: Assembler has a single growable vector, Andy Wingo, 2015/12/02
- [Guile-commits] 38/41: Add untagged bitwise operations, Andy Wingo, 2015/12/02
- [Guile-commits] 34/41: Unbox indexes of vectors, strings, and structs, Andy Wingo, 2015/12/02