[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] 02/04: Refactor range checking in assembler instruction
From: |
Andy Wingo |
Subject: |
[Guile-commits] 02/04: Refactor range checking in assembler instruction packers |
Date: |
Thu, 03 Dec 2015 08:07:02 +0000 |
wingo pushed a commit to branch master
in repository guile.
commit 7a43a3a1813ca5a1666b2049064132a6219ef6f3
Author: Andy Wingo <address@hidden>
Date: Wed Dec 2 22:12:30 2015 +0100
Refactor range checking in assembler instruction packers
* module/system/vm/assembler.scm (check-urange, check-srange): New
helpers.
(pack-u8-u24, pack-u8-s24, pack-u1-u7-u24, pack-u8-u12-u12):
(pack-u8-u8-u16, pack-u8-u8-u8-u8): Use the new helpers. Not only
makes the code nicer but also reduces register pressure.
---
module/system/vm/assembler.scm | 94 +++++++++++++++------------------------
1 files changed, 36 insertions(+), 58 deletions(-)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 012d6ee..a4d5efc 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -230,76 +230,54 @@
;;; Bytecode consists of 32-bit units, often subdivided in some way.
;;; These helpers create one 32-bit unit from multiple components.
-(define-inline (pack-u8-u24 x y)
- (let ((x* (logand x #xff))
- (y* (logand y #xffffff)))
+(define-inline (check-urange x mask)
+ (let ((x* (logand x mask)))
(unless (= x x*)
(error "out of range" x))
- (unless (= y y*)
- (error "out of range" y))
- (logior x* (ash y* 8))))
+ x*))
-(define-inline (pack-u8-s24 x y)
- (let ((x* (logand x #xff))
- (y* (logand y #xffffff)))
- (unless (= x x*)
+(define-inline (check-srange x mask)
+ (let ((x* (logand x mask)))
+ (unless (if (negative? x)
+ (= (+ x mask 1) x*)
+ (= 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))))
+ x*))
+
+(define-inline (pack-u8-u24 x y)
+ (let ((x (check-urange x #xff))
+ (y (check-urange y #xffffff)))
+ (logior x (ash y 8))))
+
+(define-inline (pack-u8-s24 x y)
+ (let ((x (check-urange x #xff))
+ (y (check-srange y #xffffff)))
+ (logior x (ash y 8))))
(define-inline (pack-u1-u7-u24 x y z)
- (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))))
+ (let ((x (check-urange x #x1))
+ (y (check-urange y #x7f))
+ (z (check-urange z #xffffff)))
+ (logior x (ash y 1) (ash z 8))))
(define-inline (pack-u8-u12-u12 x y z)
- (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))))
+ (let ((x (check-urange x #xff))
+ (y (check-urange y #xfff))
+ (z (check-urange z #xfff)))
+ (logior x (ash y 8) (ash z 20))))
(define-inline (pack-u8-u8-u16 x y z)
- (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))))
+ (let ((x (check-urange x #xff))
+ (y (check-urange y #xff))
+ (z (check-urange z #xffff)))
+ (logior x (ash y 8) (ash z 16))))
(define-inline (pack-u8-u8-u8-u8 x y z w)
- (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))))
+ (let ((x (check-urange x #xff))
+ (y (check-urange y #xff))
+ (z (check-urange z #xff))
+ (w (check-urange w #xff)))
+ (logior x (ash y 8) (ash z 16) (ash w 24))))
(eval-when (expand)
(define-syntax pack-flags