about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorKartik K. Agaram <vc@akkartik.com>2014-07-17 09:02:43 -0700
committerKartik K. Agaram <vc@akkartik.com>2014-07-17 09:03:47 -0700
commit6215fec22513faaf31e01b6feee0aad59cb2560a (patch)
treeb73804a6452f311833feb2a479aed932726bc7fc
parent8ccc6ebf0f90a3b1e939d6ef845df7bfd4501f8a (diff)
downloadmu-6215fec22513faaf31e01b6feee0aad59cb2560a.tar.gz
27 - a simple assembler for turning else/break/continue into jumps
-rw-r--r--mu.arc67
-rw-r--r--mu.arc.t18
2 files changed, 85 insertions, 0 deletions
diff --git a/mu.arc b/mu.arc
index d4840706..0d0ea21b 100644
--- a/mu.arc
+++ b/mu.arc
@@ -114,6 +114,73 @@
 ;?     (prn "return " result)
     )))
 
+;? (mac assert (expr)
+;?   `(if (no ,expr)
+;?      (err "assertion failed: " ',expr)))
+
+(def convert-braces (instrs)
+  (let locs ()  ; list of information on each brace: (open/close pc)
+    (let pc 0
+      (loop (instrs instrs)
+        (each instr instrs
+          (if (~is 'begin instr.0)
+            (do
+;?               (prn pc " " instr)
+              (++ pc))
+            (do
+;?               (prn `(open ,pc))
+              (push `(open ,pc) locs)
+              (recur cdr.instr)
+;?               (prn `(close ,pc))
+              (push `(close ,pc) locs))))))
+    (zap rev locs)
+;?     (prn locs)
+    (with (pc  0
+           stack  ())  ; elems are pcs
+      (accum yield
+        (loop (instrs instrs)
+          (each instr instrs
+            (let delim (or (pos '<- instr) -1)
+              (with (oarg  (if (>= delim 0)
+                             (cut instr 0 delim))
+                     op  (instr (+ delim 1))
+                     arg  (cut instr (+ delim 2)))
+;?                 (prn op " " oarg)
+                (case op
+                  begin
+                    (do
+                      (push pc stack)
+                      (assert:is oarg nil)
+                      (recur arg)
+                      (pop stack))
+                  breakif
+                    (do
+;?                       (prn "breakif: " instr)
+                      (yield `(jif ,arg.0 (offset ,(close-offset pc locs)))))
+                  ;else
+                    (yield instr))))
+            (++ pc)))))))
+
+(def close-offset (pc locs)
+  (let close 0
+    (with (stacksize 0
+           done nil)
+      (each (state loc) locs
+;?         (prn "  :" close " " state " - " loc)
+        (if (< loc pc)
+              nil  ; do nothing
+            (no done)
+              (do
+                ; first time
+                (when (and (is 0 stacksize) (~is loc pc))
+                  (++ stacksize))
+                (if (is 'open state) (++ stacksize) (-- stacksize))
+                ; last time
+                (when (is 0 stacksize)
+                  (= close loc)
+                  (set done))))))
+    (- close pc 1)))
+
 (awhen cdr.argv
   (each file it
 ;?     (prn file)
diff --git a/mu.arc.t b/mu.arc.t
index 86442e3b..43d4dce6 100644
--- a/mu.arc.t
+++ b/mu.arc.t
@@ -365,3 +365,21 @@
                          ; temporaries for most recent call to add-fn
                          4 0  5 0  6 nil  7 3  8 4  9 7))
   (prn "F - different calls can exercise different clauses of the same function"))
+
+(if (~iso (convert-braces '(((integer 1) <- loadi 4)
+                            ((integer 2) <- loadi 2)
+                            ((integer 3) <- add (integer 2) (integer 2))
+                            { begin  ; 'begin' is just a hack because racket turns curlies into parens
+                            ((boolean 4) <- neq (integer 1) (integer 3))
+                            (breakif (boolean 4))
+                            ((integer 5) <- loadi 34)
+                            }
+                            (reply)))
+          '(((integer 1) <- loadi 4)
+            ((integer 2) <- loadi 2)
+            ((integer 3) <- add (integer 2) (integer 2))
+            ((boolean 4) <- neq (integer 1) (integer 3))
+            (jif (boolean 4) (offset 1))
+            ((integer 5) <- loadi 34)
+            (reply)))
+  (prn "F - convert braces"))