From ee0993a71dbf89dbd7322863b8e4750b1b701392 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Tue, 17 Apr 2018 20:03:16 -0700
Subject: vm/asm: reconfiguration of display dimensions.

Increasing the maximum frame width from 256 to 1024 words;
and reducing the max display depth from 256 to 64 frames.
Small operands use a 4:6 split: the first 64 words
of the first 16 levels can be accessed with a 10
bit operand.

* share/txr/stdlib/asm.tl (parse-operand): Adjust to
wider syntax for registers due to more digits.
The v registers are 5 hex digits now: 2 digit level,
and a 3 digit offset.
(with-lev-idx): New macro.
(operand-to-sym): Use with-lev-idx and rename variables
to lv and ix.
(small-op-p, enc-op-p, small-op-to-sym): Rewrite for 4:6 small
operand.

* share/txr/stdlib/vm-param.tl (%lev-size%, %lev-bits%,
%max-lev%): Adjust values.
(%sm-lev-size%, %max-sm-lev-idx%, sm-lev-bits%): New symbol
macros.

* vm.c (VM_LEV_BITS, VM_LEV_MASK, VM_SM_LEV_BITS,
VM_SM_LEV_MASK): Values adjusted.
---
 share/txr/stdlib/asm.tl      | 49 ++++++++++++++++++++++++++++----------------
 share/txr/stdlib/vm-param.tl |  9 +++++---
 2 files changed, 37 insertions(+), 21 deletions(-)

(limited to 'share')

diff --git a/share/txr/stdlib/asm.tl b/share/txr/stdlib/asm.tl
index 25dd009f..eafc322d 100644
--- a/share/txr/stdlib/asm.tl
+++ b/share/txr/stdlib/asm.tl
@@ -43,9 +43,6 @@
   (:method backpatch (me asm at offs)
     (asm-error `@{me.symbol} doesn't backpatch`)))
 
-(defmacro small-op-p (val)
-  ^(< ,val ,1024))
-
 (compile-only
   (defstruct assembler nil
     buf
@@ -263,24 +260,30 @@
 
 (defun parse-operand (str)
   (cond
-    ((r^$ #/t[0-9A-Fa-f][0-9A-Fa-f]?/ str)
+    ((r^$ #/t[0-9A-Fa-f][0-9A-Fa-f]?[0-9A-Fa-f]?/ str)
      (int-str [str 1..:] 16))
-    ((r^$ #/d[0-9A-Fa-f][0-9A-Fa-f]?/ str)
+    ((r^$ #/d[0-9A-Fa-f][0-9A-Fa-f]?[0-9A-Fa-f]?/ str)
      (+ %lev-size% (int-str [str 1..:] 16)))
-    ((r^$ #/v[0-9A-Fa-f]?[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]/ str)
-       (let ((xn (int-str [`0@{str[1..:]}` -4..-2] 16))
-             (yn (int-str [str -2..:] 16)))
-         (+ (* %lev-size% (ssucc xn)) yn)))))
+    ((r^$ #/v[0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f][0-9A-Fa-f]/ str)
+       (let ((lv (int-str [`0@{str[1..:]}` -5..-3] 16))
+             (ix (int-str [str -3..:] 16)))
+         (+ (* %lev-size% (ssucc lv)) ix)))))
+
+(defmacro with-lev-idx ((lev-var idx-var) val-expr . body)
+  (with-gensyms (val-var)
+    ^(let* ((,val-var ,val-expr)
+            (,lev-var (ash ,val-var (macro-time (- %lev-bits%))))
+            (,idx-var (logtrunc ,val-var %lev-bits%)))
+       ,*body)))
 
 (defun operand-to-sym (val)
-  (let ((xn (ash val (- %lev-bits%)))
-        (yn (logtrunc val %lev-bits%)))
-    (caseql xn
-      (0 (if (eql yn 0)
+  (with-lev-idx (lv ix) val
+    (caseql lv
+      (0 (if (zerop ix)
            nil
-           (intern (fmt "t~,02X" yn))))
-      (1 (intern (fmt "d~,02X" yn)))
-      (t (intern (fmt "v~,02X~,02X" (ssucc xn) yn))))))
+           (intern (fmt "t~,02X" ix))))
+      (1 (intern (fmt "d~,02X" ix)))
+      (t (intern (fmt "v~,02X~,03X" (ssucc lv) ix))))))
 
 (defun bits-to-obj (bits width)
   (let ((tag (logtrunc bits 2))
@@ -290,9 +293,19 @@
       (2 (chr-int val))
       (t (error "~s: bad immediate operand: ~s" 'assembler bits)))))
 
-(defmacro enc-small-op (val) val)
+(defun small-op-p (val)
+  (with-lev-idx (lv ix) val
+    (and (< -1 ix %sm-lev-size%)
+         (<= 0 lv %max-sm-lev-idx%))))
+
+(defun enc-small-op (val)
+  (with-lev-idx (lv ix) val
+    (logior (ash lv %sm-lev-bits%) ix)))
 
-(defmacro small-op-to-sym (val) ^(operand-to-sym ,val))
+(defun small-op-to-sym (sval)
+  (let ((lv (ash sval (- %sm-lev-bits%)))
+        (ix (logtrunc sval %sm-lev-bits%)))
+    (operand-to-sym (+ (* lv %lev-size%) ix))))
 
 (defstruct backpatch-low16 nil
   (:method backpatch (me asm at offs)
diff --git a/share/txr/stdlib/vm-param.tl b/share/txr/stdlib/vm-param.tl
index 40ab68f6..bac6287e 100644
--- a/share/txr/stdlib/vm-param.tl
+++ b/share/txr/stdlib/vm-param.tl
@@ -24,9 +24,12 @@
 ;; OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
-(defsymacro %lev-size% 256)
+(defsymacro %lev-size% 1024)
 (defsymacro %max-lev-idx% (macro-time (ppred %lev-size%)))
-(defsymacro %lev-bits% 8)
-(defsymacro %max-lev% 255)
+(defsymacro %lev-bits% 10)
+(defsymacro %max-lev% 63)
 (defsymacro %max-v-lev% (macro-time (ppred %max-lev%)))
 (defsymacro %imm-width% 32)
+(defsymacro %sm-lev-size% 64)
+(defsymacro %max-sm-lev-idx% 15)
+(defsymacro %sm-lev-bits% 6)
-- 
cgit v1.2.3