From ce094a5d827b82c48eb76b1b4c04cf899219c33b Mon Sep 17 00:00:00 2001
From: Kartik Agaram <vc@akkartik.com>
Date: Tue, 6 Oct 2020 00:36:28 -0700
Subject: 6968

Snapshot that requires a check in the Mu compiler.

Currently I don't spill a register if it could possibly be over-written
by a function output within. However, find-in-call-path is a good example
of where this constraint is too lenient and results in unsafe code. The
variable `curr` gets clobbered during loop update by the variable `match?`.

What's the answer? Perhaps we should ban all conditional updates to function
outputs? That'd be dashed inconvenient.
---
 apps/tile/data.mu        | 146 ++++++++++++++++++++++++++++++++++++++++-------
 apps/tile/environment.mu |  35 +++++++-----
 apps/tile/main.mu        |  18 ++++++
 3 files changed, 162 insertions(+), 37 deletions(-)

diff --git a/apps/tile/data.mu b/apps/tile/data.mu
index 5c54f6f5..beceb7c7 100644
--- a/apps/tile/data.mu
+++ b/apps/tile/data.mu
@@ -3,7 +3,7 @@ type sandbox {
   data: (handle line)
   # display data
   cursor-word: (handle word)
-  cursor-word-index: int
+  cursor-call-path: (handle call-path-element)
   expanded-words: (handle call-path)
   #
   next: (handle sandbox)
@@ -55,10 +55,18 @@ type bind {
 # A call-path is a data structure that can unambiguously refer to any specific
 # call arbitrarily deep inside the call hierarchy of a program.
 type call-path {
-  data: int
+  data: (handle call-path-element)
   next: (handle call-path)
 }
 
+# A call-path is a list of elements, each of which corresponds to some call.
+# Calls are denoted by their position in the caller's body. They also include
+# the function being called.
+type call-path-element {
+  index-in-body: int
+  next: (handle call-path-element)
+}
+
 type result {
   data: value-stack
   error: (handle array byte)  # single error message for now
@@ -66,6 +74,8 @@ type result {
 
 fn initialize-sandbox _sandbox: (addr sandbox) {
   var sandbox/esi: (addr sandbox) <- copy _sandbox
+  var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
+  allocate cursor-call-path-ah
   var line-ah/eax: (addr handle line) <- get sandbox, data
   allocate line-ah
   var line/eax: (addr line) <- lookup *line-ah
@@ -195,20 +205,22 @@ fn populate-text-with _out: (addr handle array byte), _in: (addr array byte) {
   }
 }
 
-fn find-in-call-path in: (addr handle call-path), _needle: int -> result/eax: boolean {
+fn find-in-call-path in: (addr handle call-path), needle: (addr handle call-path-element) -> result/eax: boolean {
 $find-in-call-path:body: {
   var curr-ah/esi: (addr handle call-path) <- copy in
-  var needle/ebx: int <- copy _needle
   {
     var curr/eax: (addr call-path) <- lookup *curr-ah
     compare curr, 0
     break-if-=
-    var curr-n/ecx: (addr int) <- get curr, data
-    compare needle, *curr-n
     {
-      break-if-!=
-      result <- copy 1  # true
-      break $find-in-call-path:body
+      var curr-data/eax: (addr handle call-path-element) <- get curr, data
+      var match?/eax: boolean <- call-path-element-match? curr-data, needle
+      compare match?, 0  # false
+      {
+        break-if-=
+        result <- copy 1  # true
+        break $find-in-call-path:body
+      }
     }
     curr-ah <- get curr, next
     loop
@@ -217,38 +229,128 @@ $find-in-call-path:body: {
 }
 }
 
+fn call-path-element-match? _x: (addr handle call-path-element), _y: (addr handle call-path-element) -> result/eax: boolean {
+$call-path-element-match?:body: {
+  var x-ah/eax: (addr handle call-path-element) <- copy _x
+  var x-a/eax: (addr call-path-element) <- lookup *x-ah
+  var x/esi: (addr call-path-element) <- copy x-a
+  var y-ah/eax: (addr handle call-path-element) <- copy _y
+  var y-a/eax: (addr call-path-element) <- lookup *y-ah
+  var y/edi: (addr call-path-element) <- copy y-a
+  compare x, y
+  {
+    break-if-!=
+    result <- copy 1  # true
+    break $call-path-element-match?:body
+  }
+  compare x, 0
+  {
+    break-if-!=
+    result <- copy 0  # false
+    break $call-path-element-match?:body
+  }
+  compare y, 0
+  {
+    break-if-!=
+    result <- copy 0  # false
+    break $call-path-element-match?:body
+  }
+  var x-data-a/ecx: (addr int) <- get x, index-in-body
+  var x-data/ecx: int <- copy *x-data-a
+  var y-data-a/eax: (addr int) <- get y, index-in-body
+  var y-data/eax: int <- copy *y-data-a
+  compare x-data, y-data
+  {
+    break-if-=
+    result <- copy 0  # false
+    break $call-path-element-match?:body
+  }
+  var x-next/ecx: (addr handle call-path-element) <- get x, next
+  var y-next/eax: (addr handle call-path-element) <- get y, next
+  result <- call-path-element-match? x-next, y-next
+}
+}
+
 # order is irrelevant
-fn insert-in-call-path list: (addr handle call-path), _n: int {
+fn insert-in-call-path list: (addr handle call-path), new: (addr handle call-path-element) {
   var new-path-storage: (handle call-path)
   var new-path-ah/edi: (addr handle call-path) <- address new-path-storage
   allocate new-path-ah
   var new-path/eax: (addr call-path) <- lookup *new-path-ah
   var next/ecx: (addr handle call-path) <- get new-path, next
   copy-object list, next
-  var data/ecx: (addr int) <- get new-path, data
-  var n/edx: int <- copy _n
-  copy-to *data, n
+  var dest/ecx: (addr handle call-path-element) <- get new-path, data
+  deep-copy-call-path-element new, dest
   copy-object new-path-ah, list
 }
 
-fn delete-in-call-path list: (addr handle call-path), _n: int {
+# assumes dest is initially clear
+fn deep-copy-call-path-element _src: (addr handle call-path-element), _dest: (addr handle call-path-element) {
+  var src/esi: (addr handle call-path-element) <- copy _src
+  # if src is null, return
+  var _src-addr/eax: (addr call-path-element) <- lookup *src
+  compare _src-addr, 0
+  break-if-=
+  # allocate
+  var src-addr/esi: (addr call-path-element) <- copy _src-addr
+  var dest/eax: (addr handle call-path-element) <- copy _dest
+  allocate dest
+  # copy data
+  var dest-addr/eax: (addr call-path-element) <- lookup *dest
+  {
+    var dest-data-addr/ecx: (addr int) <- get dest-addr, index-in-body
+    var tmp/eax: (addr int) <- get src-addr, index-in-body
+    var tmp2/eax: int <- copy *tmp
+    copy-to *dest-data-addr, tmp2
+  }
+  # recurse
+  var src-next/esi: (addr handle call-path-element) <- get src-addr, next
+  var dest-next/eax: (addr handle call-path-element) <- get dest-addr, next
+  deep-copy-call-path-element src-next, dest-next
+}
+
+fn delete-in-call-path list: (addr handle call-path), needle: (addr handle call-path-element) {
 $delete-in-call-path:body: {
   var curr-ah/esi: (addr handle call-path) <- copy list
-  var n/ebx: int <- copy _n
   $delete-in-call-path:loop: {
-    var curr/eax: (addr call-path) <- lookup *curr-ah
+    var _curr/eax: (addr call-path) <- lookup *curr-ah
+    var curr/ecx: (addr call-path) <- copy _curr
     compare curr, 0
     break-if-=
-    var curr-n/ecx: (addr int) <- get curr, data
-    compare n, *curr-n
     {
-      break-if-!=
-      var next-ah/ecx: (addr handle call-path) <- get curr, next
-      copy-object next-ah, curr-ah
-      loop $delete-in-call-path:loop
+      var curr-data/eax: (addr handle call-path-element) <- get curr, data
+      var match?/eax: boolean <- call-path-element-match? curr-data, needle
+      compare match?, 0  # false
+      {
+        break-if-=
+        var next-ah/ecx: (addr handle call-path) <- get curr, next
+        copy-object next-ah, curr-ah
+        loop $delete-in-call-path:loop
+      }
     }
     curr-ah <- get curr, next
     loop
   }
 }
 }
+
+fn increment-final-element list: (addr handle call-path-element) {
+  var final-ah/eax: (addr handle call-path-element) <- copy list
+  var final/eax: (addr call-path-element) <- lookup *final-ah
+  var val/eax: (addr int) <- get final, index-in-body
+  increment *val
+}
+
+fn decrement-final-element list: (addr handle call-path-element) {
+  var final-ah/eax: (addr handle call-path-element) <- copy list
+  var final/eax: (addr call-path-element) <- lookup *final-ah
+  var val/eax: (addr int) <- get final, index-in-body
+  decrement *val
+}
+
+fn final-element-value list: (addr handle call-path-element) -> result/eax: int {
+  var final-ah/eax: (addr handle call-path-element) <- copy list
+  var final/eax: (addr call-path-element) <- lookup *final-ah
+  var val/eax: (addr int) <- get final, index-in-body
+  result <- copy *val
+}
diff --git a/apps/tile/environment.mu b/apps/tile/environment.mu
index deb66a0d..78462817 100644
--- a/apps/tile/environment.mu
+++ b/apps/tile/environment.mu
@@ -83,8 +83,8 @@ $process:body: {
         break-if-=
         copy-object prev-word-ah, cursor-word-ah
         cursor-to-end prev-word
-        var cursor-word-index/eax: (addr int) <- get sandbox, cursor-word-index
-        decrement *cursor-word-index
+        var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
+        decrement-final-element cursor-call-path
       }
       break $process:body
     }
@@ -107,8 +107,8 @@ $process:body: {
         break-if-=
         copy-object next-word-ah, cursor-word-ah
         cursor-to-start next-word
-        var cursor-word-index/eax: (addr int) <- get sandbox, cursor-word-index
-        increment *cursor-word-index
+        var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
+        increment-final-element cursor-call-path
       }
       break $process:body
     }
@@ -132,8 +132,8 @@ $process:body: {
         copy-object prev-word-ah, cursor-word-ah
         cursor-to-end prev-word
         delete-next prev-word
-        var cursor-word-index/eax: (addr int) <- get sandbox, cursor-word-index
-        decrement *cursor-word-index
+        var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
+        decrement-final-element cursor-call-path
       }
       break $process:body
     }
@@ -144,8 +144,8 @@ $process:body: {
       append-word cursor-word-ah
       var next-word-ah/ecx: (addr handle word) <- get cursor-word, next
       copy-object next-word-ah, cursor-word-ah
-      var cursor-word-index/eax: (addr int) <- get sandbox, cursor-word-index
-      increment *cursor-word-index
+      var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
+      increment-final-element cursor-call-path
       break $process:body
     }
     compare key, 0xa  # enter
@@ -172,19 +172,19 @@ fn toggle-cursor-word _sandbox: (addr sandbox) {
 $toggle-cursor-word:body: {
   var sandbox/esi: (addr sandbox) <- copy _sandbox
   var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words
-  var cursor-word-index/ecx: (addr int) <- get sandbox, cursor-word-index
-  var already-expanded?/eax: boolean <- find-in-call-path expanded-words, *cursor-word-index
+  var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path
+  var already-expanded?/eax: boolean <- find-in-call-path expanded-words, cursor-call-path
   compare already-expanded?, 0  # false
   {
     break-if-!=
     # if not already-expanded, insert
-    insert-in-call-path expanded-words *cursor-word-index
+    insert-in-call-path expanded-words cursor-call-path
     break $toggle-cursor-word:body
   }
   {
     break-if-=
     # otherwise delete
-    delete-in-call-path expanded-words *cursor-word-index
+    delete-in-call-path expanded-words cursor-call-path
   }
 }
 }
@@ -247,7 +247,9 @@ fn render-line screen: (addr screen), functions: (addr handle function), binding
   var first-word-ah/eax: (addr handle word) <- get line, data
   var curr-word/eax: (addr word) <- lookup *first-word-ah
   #
-  var word-index/ebx: int <- copy 0
+  var word-index-storage: (handle call-path-element)
+  var word-index/ebx: (addr handle call-path-element) <- address word-index-storage
+  allocate word-index  # leak
   # loop-carried dependency
   var curr-col/ecx: int <- copy left-col
   #
@@ -319,14 +321,17 @@ fn render-line screen: (addr screen), functions: (addr handle function), binding
     subtract-from top-row, 1
       move-cursor screen, top-row, curr-col
       start-color screen, 8, 7
-        print-int32-hex-bits screen, word-index, 4
+        {
+          var word-index-val/eax: int <- final-element-value word-index
+          print-int32-hex-bits screen, word-index-val, 4
+        }
       reset-formatting screen
     add-to top-row, 1
     # now render main column
     curr-col <- render-column screen, functions, bindings, line, curr-word, top-row, curr-col, cursor-word, cursor-col-a
     var next-word-ah/edx: (addr handle word) <- get curr-word, next
     curr-word <- lookup *next-word-ah
-    word-index <- increment
+    increment-final-element word-index
     loop
   }
   right-col <- copy curr-col
diff --git a/apps/tile/main.mu b/apps/tile/main.mu
index c4a5f6c0..642d1621 100644
--- a/apps/tile/main.mu
+++ b/apps/tile/main.mu
@@ -44,12 +44,30 @@ fn main args-on-stack: (addr array addr array byte) -> exit-status/ebx: int {
 }
 
 fn interactive {
+#?   var elem: (handle call-path-element)
+#?   var elem-addr/ebx: (addr handle call-path-element) <- address elem
+#?   allocate elem-addr  # leak
+#?   var path: (handle call-path)
+#?   var path-addr/eax: (addr handle call-path) <- address path
+#?   allocate path-addr
+#?   var dummy/eax: boolean <- find-in-call-path path-addr, elem-addr
   enable-screen-grid-mode
   enable-keyboard-immediate-mode
   var env-storage: environment
   var env/esi: (addr environment) <- address env-storage
   initialize-environment env
   draw-screen env
+#?   var key/eax: grapheme <- copy 0x31  # '1'
+#?   process env, key
+#?   key <- copy 0x20  # space
+#?   process env, key
+#?   key <- copy 0x32  # '2'
+#?   process env, key
+#?   key <- copy 0x2a  # '*'
+#?   process env, key
+#?   key <- copy 0xa  # newline
+#?   process env, key
+#?   render env
   {
     var key/eax: grapheme <- read-key-from-real-keyboard
     compare key, 0x71  # 'q'
-- 
cgit 1.4.1-2-gfad0