guile-commits
[Top][All Lists]
Advanced

[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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]