7248 - mu.subx: new primitive 'clear-object'

5 files changed, 155 insertions, 17 deletions

diff --git a/apps/mu b/apps/mu
index 619faa48..28668bdf 100755
--- a/apps/mu
+++ b/apps/mu
Binary files differdiff --git a/apps/mu.subx b/apps/mu.subx
index 76765bcc..ddd3a794 100644
--- a/apps/mu.subx
+++ b/apps/mu.subx
@@ -19977,6 +19977,10 @@ has-primitive-name?:  # stmt: (addr stmt) -> result/eax: boolean
     (string-equal? %esi "copy-object")  # => eax
     3d/compare-eax-and 0/imm32/false
     0f 85/jump-if-!= $has-primitive-name?:end/disp32
+    # if (name == "clear-object") return true
+    (string-equal? %esi "clear-object")  # => eax
+    3d/compare-eax-and 0/imm32/false
+    0f 85/jump-if-!= $has-primitive-name?:end/disp32
     # if (name == "allocate") return true
     (string-equal? %esi "allocate")  # => eax
     3d/compare-eax-and 0/imm32/false
@@ -20121,6 +20125,14 @@ check-mu-primitive:  # stmt: (addr stmt), fn: (addr function), err: (addr buffer
       (check-mu-copy-object-stmt *(ebp+8) *(ebp+0xc) *(ebp+0x10) *(ebp+0x14))
       e9/jump $check-mu-primitive:end/disp32
     }
+    # if (op == "clear-object") check-mu-clear-object-stmt
+    {
+      (string-equal? %ecx "clear-object")  # => eax
+      3d/compare-eax-and 0/imm32/false
+      74/jump-if-= break/disp8
+      (check-mu-clear-object-stmt *(ebp+8) *(ebp+0xc) *(ebp+0x10) *(ebp+0x14))
+      e9/jump $check-mu-primitive:end/disp32
+    }
     # if (op == "allocate") check-mu-allocate-stmt
     {
       (string-equal? %ecx "allocate")  # => eax
@@ -23057,6 +23069,100 @@ $check-mu-copy-object-stmt:error-invalid-types:
     (stop *(ebp+0x14) 1)
     # never gets here
 
+check-mu-clear-object-stmt:  # stmt: (addr stmt), fn: (addr function), err: (addr buffered-file), ed: (addr exit-descriptor)
+    # . prologue
+    55/push-ebp
+    89/<- %ebp 4/r32/esp
+    # . save registers
+    50/push-eax
+    51/push-ecx
+    53/push-ebx
+    56/push-esi
+    57/push-edi
+    # esi = stmt
+    8b/-> *(ebp+8) 6/r32/esi
+$check-mu-clear-object-stmt:check-for-output:
+    # if stmt->outputs abort
+    (lookup *(esi+0x14) *(esi+0x18))  # Stmt1-outputs Stmt1-outputs => eax
+    3d/compare-eax-and 0/imm32
+    0f 85/jump-if-!= $check-mu-clear-object-stmt:error-too-many-outputs/disp32
+$check-mu-clear-object-stmt:get-left:
+    # var dest/edi: (addr stmt-var) = stmt->inouts
+    (lookup *(esi+0xc) *(esi+0x10))  # Stmt1-inouts Stmt1-inouts => eax
+    89/<- %edi 0/r32/eax
+    # zero inouts
+    3d/compare-eax-and 0/imm32
+    0f 84/jump-if-= $check-mu-clear-object-stmt:error-incorrect-inouts/disp32
+$check-mu-clear-object-stmt:get-src:
+    # > 1 inout
+    (lookup *(edi+8) *(edi+0xc))  # Stmt-var-next Stmt-var-next => eax
+    3d/compare-eax-and 0/imm32
+    0f 85/jump-if-!= $check-mu-clear-object-stmt:error-incorrect-inouts/disp32
+$check-mu-clear-object-stmt:types:
+    # var src-type/ecx: (addr type-tree) = src->value->type
+    (lookup *edi *(edi+4))  # Stmt-var-value Stmt-var-value => eax
+    (lookup *(eax+8) *(eax+0xc))  # Var-type Var-type => eax
+    89/<- %ecx 0/r32/eax
+    # if (src->is-deref?) src-type = src-type->payload
+    8b/-> *(edi+0x10) 0/r32/eax  # Stmt-var-is-deref
+    3d/compare-eax-and 0/imm32/false
+    {
+      74/jump-if-= break/disp8
+      (lookup *(ecx+0xc) *(ecx+0x10))  # Type-tree-right Type-tree-right => eax
+      # if src-type->right is null, src-type = src-type->left
+      81 7/subop/compare *(eax+0xc) 0/imm32  # Type-tree-right
+      {
+        75/jump-if-!= break/disp8
+        (lookup *(eax+4) *(eax+8))  # Type-tree-left Type-tree-left => eax
+      }
+      89/<- %ecx 0/r32/eax
+    }
+    # if src-type is not addr, abort
+    (is-mu-addr-type? %ecx)  # => eax
+    3d/compare-eax-and 0/imm32/false
+    0f 84/jump-if-= $check-mu-clear-object-stmt:error-invalid-type/disp32
+$check-mu-clear-object-stmt:end:
+    # . restore registers
+    5f/pop-to-edi
+    5e/pop-to-esi
+    5b/pop-to-ebx
+    59/pop-to-ecx
+    58/pop-to-eax
+    # . epilogue
+    89/<- %esp 5/r32/ebp
+    5d/pop-to-ebp
+    c3/return
+
+$check-mu-clear-object-stmt:error-incorrect-inouts:
+    (write-buffered *(ebp+0x10) "fn ")
+    8b/-> *(ebp+0xc) 0/r32/eax
+    (lookup *eax *(eax+4))  # Function-name Function-name => eax
+    (write-buffered *(ebp+0x10) %eax)
+    (write-buffered *(ebp+0x10) ": stmt 'clear-object' must have a single inout\n")
+    (flush *(ebp+0x10))
+    (stop *(ebp+0x14) 1)
+    # never gets here
+
+$check-mu-clear-object-stmt:error-too-many-outputs:
+    (write-buffered *(ebp+0x10) "fn ")
+    8b/-> *(ebp+0xc) 0/r32/eax
+    (lookup *eax *(eax+4))  # Function-name Function-name => eax
+    (write-buffered *(ebp+0x10) %eax)
+    (write-buffered *(ebp+0x10) ": stmt 'clear-object' must not have any outputs\n")
+    (flush *(ebp+0x10))
+    (stop *(ebp+0x14) 1)
+    # never gets here
+
+$check-mu-clear-object-stmt:error-invalid-type:
+    (write-buffered *(ebp+0x10) "fn ")
+    8b/-> *(ebp+0xc) 0/r32/eax
+    (lookup *eax *(eax+4))  # Function-name Function-name => eax
+    (write-buffered *(ebp+0x10) %eax)
+    (write-buffered *(ebp+0x10) ": stmt clear-object: inout must have an addr type\n")
+    (flush *(ebp+0x10))
+    (stop *(ebp+0x14) 1)
+    # never gets here
+
 check-mu-allocate-stmt:  # stmt: (addr stmt), fn: (addr function), err: (addr buffered-file), ed: (addr exit-descriptor)
     # . prologue
     55/push-ebp
@@ -26334,6 +26440,15 @@ emit-subx-stmt:  # out: (addr buffered-file), stmt: (addr stmt), primitives: (ad
       (translate-mu-copy-object-stmt *(ebp+8) *(ebp+0xc) *(ebp+0x14) *(ebp+0x18))
       e9/jump $emit-subx-stmt:end/disp32
     }
+    # clear-object
+    {
+      # if (!string-equal?(stmt->operation, "clear-object")) break
+      (string-equal? %ecx "clear-object")  # => eax
+      3d/compare-eax-and 0/imm32
+      0f 84/jump-if-= break/disp32
+      (translate-mu-clear-object-stmt *(ebp+8) *(ebp+0xc) *(ebp+0x14) *(ebp+0x18))
+      e9/jump $emit-subx-stmt:end/disp32
+    }
     # allocate array
     {
       # if (!string-equal?(stmt->operation, "populate")) break
@@ -27127,8 +27242,10 @@ translate-mu-copy-object-stmt:  # out: (addr buffered-file), stmt: (addr stmt),
     # var first-inout/eax: (addr stmt-var) = stmt->inouts[0]
     (lookup *(eax+0xc) *(eax+0x10))  # Stmt1-inouts Stmt1-inouts => eax
     (emit-subx-call-operand *(ebp+8) %eax)
+    # var second-inout/eax: (addr stmt-var) = stmt->inouts[1]
     (lookup *(eax+8) *(eax+0xc))  # Stmt-var-next Stmt-var-next => eax
     (emit-subx-call-operand *(ebp+8) %eax)
+    # emit size of inouts
     (write-buffered *(ebp+8) Space)
     (addr-payload-size %eax *(ebp+0x10) *(ebp+0x14))  # => eax
     (write-int32-hex-buffered *(ebp+8) %eax)
@@ -27141,6 +27258,33 @@ $translate-mu-copy-object-stmt:end:
     5d/pop-to-ebp
     c3/return
 
+translate-mu-clear-object-stmt:  # out: (addr buffered-file), stmt: (addr stmt), err: (addr buffered-file), ed: (addr exit-descriptor)
+    # . prologue
+    55/push-ebp
+    89/<- %ebp 4/r32/esp
+    # . save registers
+    50/push-eax
+    #
+    (emit-indent *(ebp+8) *Curr-block-depth)
+    (write-buffered *(ebp+8) "(zero-out")
+    # eax = stmt
+    8b/-> *(ebp+0xc) 0/r32/eax
+    # var dest/eax: (addr stmt-var) = stmt->inouts[0]
+    (lookup *(eax+0xc) *(eax+0x10))  # Stmt1-inouts Stmt1-inouts => eax
+    #
+    (emit-subx-call-operand *(ebp+8) %eax)
+    (write-buffered *(ebp+8) Space)
+    (addr-payload-size %eax *(ebp+0x10) *(ebp+0x14))  # => eax
+    (write-int32-hex-buffered *(ebp+8) %eax)
+    (write-buffered *(ebp+8) ")\n")
+$translate-mu-clear-object-stmt:end:
+    # . restore registers
+    58/pop-to-eax
+    # . epilogue
+    89/<- %esp 5/r32/ebp
+    5d/pop-to-ebp
+    c3/return
+
 translate-mu-allocate-stmt:  # out: (addr buffered-file), stmt: (addr stmt), err: (addr buffered-file), ed: (addr exit-descriptor)
     # . prologue
     55/push-ebp
diff --git a/apps/tile/environment.mu b/apps/tile/environment.mu
index b774356d..c70efd7c 100644
--- a/apps/tile/environment.mu
+++ b/apps/tile/environment.mu
@@ -522,8 +522,7 @@ $process-sandbox-rename:body: {
   compare key, 0x1b  # esc
   $process-sandbox-rename:cancel: {
     break-if-!=
-    var empty: (handle word)
-    copy-handle empty, new-name-ah
+    clear-object new-name-ah
     break $process-sandbox-rename:body
   }
   # if 'enter' pressed, perform rename
@@ -586,9 +585,7 @@ $process-sandbox-rename:body: {
     # sandbox->data = new-line
     copy-handle new-line-h, sandbox-slot
     # clear partial-name-for-cursor-word
-    var empty: (handle word)
-    copy-handle empty, new-name-ah
-#?     # XXX
+    clear-object new-name-ah
 #?     var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
 #?     var cursor/eax: (addr call-path-element) <- lookup *cursor-ah
 #?     var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word
@@ -643,8 +640,7 @@ $process-sandbox-define:body: {
   compare key, 0x1b  # esc
   $process-sandbox-define:cancel: {
     break-if-!=
-    var empty: (handle word)
-    copy-handle empty, new-name-ah
+    clear-object new-name-ah
     break $process-sandbox-define:body
   }
   # if 'enter' pressed, perform define
diff --git a/apps/tile/rpn.mu b/apps/tile/rpn.mu
index 22aa9c19..1b288fa5 100644
--- a/apps/tile/rpn.mu
+++ b/apps/tile/rpn.mu
@@ -81,8 +81,7 @@ fn evaluate functions: (addr handle function), bindings: (addr table), scratch:
           var type-addr/eax: (addr int) <- get target-val, type
           copy-to *type-addr, 0  # int
           var target-string-ah/eax: (addr handle array byte) <- get target-val, text-data
-          var empty: (handle array byte)
-          copy-handle empty, target-string-ah
+          clear-object target-string-ah
           var target/eax: (addr int) <- get target-val, int-data
           copy-to *target, result
           break $evaluate:process-word
@@ -98,8 +97,7 @@ fn evaluate functions: (addr handle function), bindings: (addr table), scratch:
           var type-addr/eax: (addr int) <- get target-val, type
           copy-to *type-addr, 0  # int
           var target-array-ah/eax: (addr handle array value) <- get target-val, array-data
-          var empty: (handle array value)
-          copy-handle empty, target-array-ah
+          clear-object target-array-ah
           var target/eax: (addr int) <- get target-val, int-data
           copy-to *target, result
           break $evaluate:process-word
@@ -136,8 +134,7 @@ fn evaluate functions: (addr handle function), bindings: (addr table), scratch:
         var target-string-ah/eax: (addr handle array byte) <- get target-val, text-data
         var filename-ah/ecx: (addr handle array byte) <- get target-val, filename
         copy-object target-string-ah, filename-ah
-        var empty: (handle array byte)
-        copy-handle empty, target-string-ah
+        clear-object target-string-ah
         break $evaluate:process-word
       }
       {
@@ -172,8 +169,7 @@ fn evaluate functions: (addr handle function), bindings: (addr table), scratch:
         var type-addr/eax: (addr int) <- get target-val, type
         copy-to *type-addr, 1  # string
         var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data
-        var empty: (handle buffered-file)
-        copy-handle empty, target-file-ah
+        clear-object target-file-ah
         break $evaluate:process-word
       }
       {
@@ -208,8 +204,7 @@ fn evaluate functions: (addr handle function), bindings: (addr table), scratch:
         var type-addr/eax: (addr int) <- get target-val, type
         copy-to *type-addr, 1  # string
         var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data
-        var empty: (handle buffered-file)
-        copy-handle empty, target-file-ah
+        clear-object target-file-ah
         break $evaluate:process-word
       }
       {
diff --git a/mu_instructions b/mu_instructions
index 629ba3d1..f487d29a 100644
--- a/mu_instructions
+++ b/mu_instructions
@@ -384,6 +384,9 @@ populate-stream in: (addr handle stream T), num  # can be literal or variable on
 
 # Some miscellaneous helpers to avoid error-prone size computations
 
+clear x: (addr T)
+  => "(zero-out " s " " size-of(T) ")"
+
 read-from-stream s: (addr stream T), out: (addr T)
   => "(read-from-stream " s " " out " " size-of(T) ")"