shell: separate 'def' from 'set'

'def' creates new bindings (only in globals)
'set' only modifies existing bindings (either in env or globals)

4 files changed, 272 insertions, 7 deletions

diff --git a/309stream.subx b/309stream.subx
index 56b19272..43cb1b01 100644
--- a/309stream.subx
+++ b/309stream.subx
@@ -212,3 +212,92 @@ $stream-final:end:
     89/<- %esp 5/r32/ebp
     5d/pop-to-ebp
     c3/return
+
+# compare all the data in two streams (ignoring the read pointer)
+streams-data-equal?:  # f: (addr stream byte), s: (addr array byte) -> result/eax: boolean
+    # pseudocode:
+    #   awrite = a->write
+    #   if (awrite != b->write) return false
+    #   i = 0
+    #   curra = a->data
+    #   currb = b->data
+    #   while i < awrite
+    #     i1 = *curra
+    #     i2 = *currb
+    #     if (c1 != c2) return false
+    #     i+=4, curra+=4, currb+=4
+    #   return true
+    #
+    # registers:
+    #   i: ecx
+    #   awrite: edx
+    #   curra: esi
+    #   currb: edi
+    #   i1: eax
+    #   i2: ebx
+    #
+    # . prologue
+    55/push-ebp
+    89/<- %ebp 4/r32/esp
+    # . save registers
+    51/push-ecx
+    52/push-edx
+    53/push-ebx
+    56/push-esi
+    57/push-edi
+    # esi = a
+    8b/-> *(ebp+8) 6/r32/esi
+    # edi = b
+    8b/-> *(ebp+0xc) 7/r32/edi
+    # var awrite/edx: int = a->write
+    8b/-> *esi 2/r32/edx
+$streams-data-equal?:sizes:
+    # if (awrite != b->write) return false
+    39/compare *edi 2/r32/edx
+    75/jump-if-!= $streams-data-equal?:false/disp8
+    # var curra/esi: (addr byte) = a->data
+    81 0/subop/add %esi 0xc/imm32
+    # var currb/edi: (addr byte) = b->data
+    81 0/subop/add %edi 0xc/imm32
+    # var i/ecx: int = 0
+    31/xor-with %ecx 1/r32/ecx
+    # var vala/eax: int
+    31/xor-with %eax 0/r32/eax
+    # var valb/ebx: int
+    31/xor-with %ebx 3/r32/ebx
+$streams-data-equal?:loop:
+    {
+      # if (i >= awrite) return true
+      39/compare %ecx 2/r32/edx
+      7d/jump-if->= $streams-data-equal?:true/disp8
+      # var vala/eax: int = *curra
+      8a/byte-> *esi 0/r32/eax
+      # var valb/ebx: int = *currb
+      8a/byte-> *edi 3/r32/ebx
+      # if (vala != valb) return false
+      39/compare %eax 3/r32/ebx
+      75/jump-if-!= $streams-data-equal?:false/disp8
+      # i++
+      41/increment-ecx
+      # curra++
+      46/increment-esi
+      # currb++
+      47/increment-edi
+      eb/jump loop/disp8
+    }
+$streams-data-equal?:true:
+    b8/copy-to-eax 1/imm32
+    eb/jump $streams-data-equal?:end/disp8
+$streams-data-equal?:false:
+    b8/copy-to-eax 0/imm32
+$streams-data-equal?:end:
+    # . restore registers
+    5f/pop-to-edi
+    5e/pop-to-esi
+    5b/pop-to-ebx
+    5a/pop-to-edx
+    59/pop-to-ecx
+    # . epilogue
+    89/<- %esp 5/r32/ebp
+    5d/pop-to-ebp
+    c3/return
diff --git a/400.mu b/400.mu
index e7f4c599..4d71bd11 100644
--- a/400.mu
+++ b/400.mu
@@ -32,6 +32,7 @@ sig debug-print x: (addr array byte), fg: int, bg: int
 sig clear-stream f: (addr stream _)
 sig rewind-stream f: (addr stream _)
 sig stream-data-equal? f: (addr stream byte), s: (addr array byte) -> _/eax: boolean
+sig streams-data-equal? f: (addr stream byte), s: (addr stream byte) -> _/eax: boolean
 sig check-stream-equal f: (addr stream byte), s: (addr array byte), msg: (addr array byte)
 sig next-stream-line-equal? f: (addr stream byte), s: (addr array byte) -> _/eax: boolean
 sig check-next-stream-line-equal f: (addr stream byte), s: (addr array byte), msg: (addr array byte)
diff --git a/shell/evaluate.mu b/shell/evaluate.mu
index b8fe1797..3e9cb6b6 100644
--- a/shell/evaluate.mu
+++ b/shell/evaluate.mu
@@ -145,10 +145,10 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
     trace-higher trace
     return
   }
-  $evaluate:set: {
-    # trees starting with "set" define globals
+  $evaluate:def: {
+    # trees starting with "def" define globals
     var expr/esi: (addr cell) <- copy in-addr
-    # if its first elem is not "set", break
+    # if its first elem is not "def", break
     var first-ah/ecx: (addr handle cell) <- get in-addr, left
     var rest-ah/edx: (addr handle cell) <- get in-addr, right
     var first/eax: (addr cell) <- lookup *first-ah
@@ -157,11 +157,11 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
     break-if-!=
     var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data
     var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
-    var set?/eax: boolean <- stream-data-equal? sym-data, "set"
-    compare set?, 0/false
+    var def?/eax: boolean <- stream-data-equal? sym-data, "def"
+    compare def?, 0/false
     break-if-=
     #
-    trace-text trace, "eval", "set"
+    trace-text trace, "eval", "def"
     trace-text trace, "eval", "evaluating second arg"
     var rest/eax: (addr cell) <- lookup *rest-ah
     var first-arg-ah/ecx: (addr handle cell) <- get rest, left
@@ -170,7 +170,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
       var first-arg-type/eax: (addr int) <- get first-arg, type
       compare *first-arg-type, 2/symbol
       break-if-=
-      error trace, "first arg to set must be a symbol"
+      error trace, "first arg to def must be a symbol"
       trace-higher trace
       return
     }
@@ -195,6 +195,50 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
     trace-higher trace
     return
   }
+  $evaluate:set: {
+    # trees starting with "set" mutate bindings
+    var expr/esi: (addr cell) <- copy in-addr
+    # if its first elem is not "set", break
+    var first-ah/ecx: (addr handle cell) <- get in-addr, left
+    var rest-ah/edx: (addr handle cell) <- get in-addr, right
+    var first/eax: (addr cell) <- lookup *first-ah
+    var first-type/ecx: (addr int) <- get first, type
+    compare *first-type, 2/symbol
+    break-if-!=
+    var sym-data-ah/eax: (addr handle stream byte) <- get first, text-data
+    var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
+    var set?/eax: boolean <- stream-data-equal? sym-data, "set"
+    compare set?, 0/false
+    break-if-=
+    #
+    trace-text trace, "eval", "set"
+    trace-text trace, "eval", "evaluating second arg"
+    var rest/eax: (addr cell) <- lookup *rest-ah
+    var first-arg-ah/ecx: (addr handle cell) <- get rest, left
+    {
+      var first-arg/eax: (addr cell) <- lookup *first-arg-ah
+      var first-arg-type/eax: (addr int) <- get first-arg, type
+      compare *first-arg-type, 2/symbol
+      break-if-=
+      error trace, "first arg to set must be a symbol"
+      trace-higher trace
+      return
+    }
+    rest-ah <- get rest, right
+    rest <- lookup *rest-ah
+    var second-arg-ah/edx: (addr handle cell) <- get rest, left
+    debug-print "P", 4/fg, 0/bg
+    increment call-number
+    evaluate second-arg-ah, out, env-h, globals, trace, screen-cell, keyboard-cell, call-number
+    debug-print "Q", 4/fg, 0/bg
+    trace-text trace, "eval", "mutating binding"
+    var first-arg/eax: (addr cell) <- lookup *first-arg-ah
+    var first-arg-data-ah/eax: (addr handle stream byte) <- get first-arg, text-data
+    var first-arg-data/eax: (addr stream byte) <- lookup *first-arg-data-ah
+    mutate-binding first-arg-data, out, env-h, globals, trace
+    trace-higher trace
+    return
+  }
   $evaluate:if: {
     # trees starting with "if" are conditionals
     var expr/esi: (addr cell) <- copy in-addr
@@ -644,6 +688,112 @@ fn test-lookup-symbol-in-globals {
   check-ints-equal *result-value, 2/add, "F - test-lookup-symbol-in-globals/1"
 }
 
+fn mutate-binding name: (addr stream byte), val: (addr handle cell), env-h: (handle cell), globals: (addr global-table), trace: (addr trace) {
+  # trace name
+  {
+    compare trace, 0
+    break-if-=
+    var stream-storage: (stream byte 0x800)  # pessimistically sized just for the large alist loaded from disk in `main`
+    var stream/ecx: (addr stream byte) <- address stream-storage
+    write stream, "bind "
+    rewind-stream name
+    write-stream stream, name
+    write stream, " to "
+    print-cell val, stream, 0/no-trace
+    write stream, " in "
+    var env-ah/eax: (addr handle cell) <- address env-h
+    print-cell env-ah, stream, 0/no-trace
+    trace trace, "eval", stream
+  }
+  trace-lower trace
+  var _env/eax: (addr cell) <- lookup env-h
+  var env/ebx: (addr cell) <- copy _env
+  # if env is not a list, abort
+  {
+    var env-type/ecx: (addr int) <- get env, type
+    compare *env-type, 0/pair
+    break-if-=
+    error trace, "eval found a non-list environment"
+    trace-higher trace
+    return
+  }
+  # if env is nil, look in globals
+  {
+    var env-nil?/eax: boolean <- nil? env
+    compare env-nil?, 0/false
+    break-if-=
+    debug-print "b", 3/fg, 0/bg
+    mutate-binding-in-globals name, val, globals, trace
+    debug-print "x", 3/fg, 0/bg
+    trace-higher trace
+    # trace "=> " val " (global)" {{{
+    {
+      compare trace, 0
+      break-if-=
+      var error?/eax: boolean <- has-errors? trace
+      compare error?, 0/false
+      break-if-!=
+      var stream-storage: (stream byte 0x200)
+      var stream/ecx: (addr stream byte) <- address stream-storage
+      write stream, "=> "
+      print-cell val, stream, 0/no-trace
+      write stream, " (global)"
+      trace trace, "eval", stream
+    }
+    # }}}
+    debug-print "y", 3/fg, 0/bg
+    return
+  }
+  # check car
+  var env-head-storage: (handle cell)
+  var env-head-ah/eax: (addr handle cell) <- address env-head-storage
+  car env, env-head-ah, 0/no-trace
+  var _env-head/eax: (addr cell) <- lookup *env-head-ah
+  var env-head/ecx: (addr cell) <- copy _env-head
+  # if car is not a list, abort
+  {
+    var env-head-type/eax: (addr int) <- get env-head, type
+    compare *env-head-type, 0/pair
+    break-if-=
+    error trace, "environment is not a list of (key . value) pairs"
+    trace-higher trace
+    return
+  }
+  # check key
+  var curr-key-storage: (handle cell)
+  var curr-key-ah/eax: (addr handle cell) <- address curr-key-storage
+  car env-head, curr-key-ah, trace
+  var curr-key/eax: (addr cell) <- lookup *curr-key-ah
+  # if key is not a symbol, abort
+  {
+    var curr-key-type/eax: (addr int) <- get curr-key, type
+    compare *curr-key-type, 2/symbol
+    break-if-=
+    error trace, "environment contains a binding for a non-symbol"
+    trace-higher trace
+    return
+  }
+  # if key matches name, return val
+  var curr-key-data-ah/eax: (addr handle stream byte) <- get curr-key, text-data
+  var curr-key-data/eax: (addr stream byte) <- lookup *curr-key-data-ah
+  var match?/eax: boolean <- streams-data-equal? curr-key-data, name
+  compare match?, 0/false
+  {
+    break-if-=
+    var dest/eax: (addr handle cell) <- get env-head, right
+    copy-object val, dest
+    trace-text trace, "eval", "=> done"
+    trace-higher trace
+    return
+  }
+  # otherwise recurse
+  var env-tail-storage: (handle cell)
+  var env-tail-ah/eax: (addr handle cell) <- address env-tail-storage
+  cdr env, env-tail-ah, trace
+  mutate-binding name, val, *env-tail-ah, globals, trace
+  trace-higher trace
+}
+
 fn car _in: (addr cell), out: (addr handle cell), trace: (addr trace) {
   trace-text trace, "eval", "car"
   trace-lower trace
diff --git a/shell/global.mu b/shell/global.mu
index 9bc2aff4..6af04237 100644
--- a/shell/global.mu
+++ b/shell/global.mu
@@ -368,6 +368,31 @@ fn find-symbol-in-globals _globals: (addr global-table), sym-name: (addr stream
   return -1/not-found
 }
 
+fn mutate-binding-in-globals name: (addr stream byte), val: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
+  var globals/esi: (addr global-table) <- copy _globals
+  {
+    compare globals, 0
+    break-if-=
+    var curr-index/ecx: int <- find-symbol-in-globals globals, name
+    compare curr-index, -1/not-found
+    break-if-=
+    var global-data-ah/eax: (addr handle array global) <- get globals, data
+    var global-data/eax: (addr array global) <- lookup *global-data-ah
+    var curr-offset/ebx: (offset global) <- compute-offset global-data, curr-index
+    var curr/ebx: (addr global) <- index global-data, curr-offset
+    var dest/eax: (addr handle cell) <- get curr, value
+    copy-object val, dest
+    return
+  }
+  # otherwise error "unbound symbol: ", sym
+  var stream-storage: (stream byte 0x40)
+  var stream/ecx: (addr stream byte) <- address stream-storage
+  write stream, "unbound symbol: "
+  rewind-stream name
+  write-stream stream, name
+  trace trace, "error", stream
+}
+
 # a little strange; goes from value to name and selects primitive based on name
 fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr handle cell), _globals: (addr global-table), trace: (addr trace) {
   var f/esi: (addr cell) <- copy _f