7248 - mu.subx: new primitive 'clear-object'
This commit is contained in:
parent
2715d377b6
commit
002f2609e9
144
apps/mu.subx
144
apps/mu.subx
|
@ -19977,6 +19977,10 @@ has-primitive-name?: # stmt: (addr stmt) -> result/eax: boolean
|
||||||
(string-equal? %esi "copy-object") # => eax
|
(string-equal? %esi "copy-object") # => eax
|
||||||
3d/compare-eax-and 0/imm32/false
|
3d/compare-eax-and 0/imm32/false
|
||||||
0f 85/jump-if-!= $has-primitive-name?:end/disp32
|
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
|
# if (name == "allocate") return true
|
||||||
(string-equal? %esi "allocate") # => eax
|
(string-equal? %esi "allocate") # => eax
|
||||||
3d/compare-eax-and 0/imm32/false
|
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))
|
(check-mu-copy-object-stmt *(ebp+8) *(ebp+0xc) *(ebp+0x10) *(ebp+0x14))
|
||||||
e9/jump $check-mu-primitive:end/disp32
|
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
|
# if (op == "allocate") check-mu-allocate-stmt
|
||||||
{
|
{
|
||||||
(string-equal? %ecx "allocate") # => eax
|
(string-equal? %ecx "allocate") # => eax
|
||||||
|
@ -23057,6 +23069,100 @@ $check-mu-copy-object-stmt:error-invalid-types:
|
||||||
(stop *(ebp+0x14) 1)
|
(stop *(ebp+0x14) 1)
|
||||||
# never gets here
|
# 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)
|
check-mu-allocate-stmt: # stmt: (addr stmt), fn: (addr function), err: (addr buffered-file), ed: (addr exit-descriptor)
|
||||||
# . prologue
|
# . prologue
|
||||||
55/push-ebp
|
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))
|
(translate-mu-copy-object-stmt *(ebp+8) *(ebp+0xc) *(ebp+0x14) *(ebp+0x18))
|
||||||
e9/jump $emit-subx-stmt:end/disp32
|
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
|
# allocate array
|
||||||
{
|
{
|
||||||
# if (!string-equal?(stmt->operation, "populate")) break
|
# 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]
|
# var first-inout/eax: (addr stmt-var) = stmt->inouts[0]
|
||||||
(lookup *(eax+0xc) *(eax+0x10)) # Stmt1-inouts Stmt1-inouts => eax
|
(lookup *(eax+0xc) *(eax+0x10)) # Stmt1-inouts Stmt1-inouts => eax
|
||||||
(emit-subx-call-operand *(ebp+8) %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
|
(lookup *(eax+8) *(eax+0xc)) # Stmt-var-next Stmt-var-next => eax
|
||||||
(emit-subx-call-operand *(ebp+8) %eax)
|
(emit-subx-call-operand *(ebp+8) %eax)
|
||||||
|
# emit size of inouts
|
||||||
(write-buffered *(ebp+8) Space)
|
(write-buffered *(ebp+8) Space)
|
||||||
(addr-payload-size %eax *(ebp+0x10) *(ebp+0x14)) # => eax
|
(addr-payload-size %eax *(ebp+0x10) *(ebp+0x14)) # => eax
|
||||||
(write-int32-hex-buffered *(ebp+8) %eax)
|
(write-int32-hex-buffered *(ebp+8) %eax)
|
||||||
|
@ -27141,6 +27258,33 @@ $translate-mu-copy-object-stmt:end:
|
||||||
5d/pop-to-ebp
|
5d/pop-to-ebp
|
||||||
c3/return
|
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)
|
translate-mu-allocate-stmt: # out: (addr buffered-file), stmt: (addr stmt), err: (addr buffered-file), ed: (addr exit-descriptor)
|
||||||
# . prologue
|
# . prologue
|
||||||
55/push-ebp
|
55/push-ebp
|
||||||
|
|
|
@ -522,8 +522,7 @@ $process-sandbox-rename:body: {
|
||||||
compare key, 0x1b # esc
|
compare key, 0x1b # esc
|
||||||
$process-sandbox-rename:cancel: {
|
$process-sandbox-rename:cancel: {
|
||||||
break-if-!=
|
break-if-!=
|
||||||
var empty: (handle word)
|
clear-object new-name-ah
|
||||||
copy-handle empty, new-name-ah
|
|
||||||
break $process-sandbox-rename:body
|
break $process-sandbox-rename:body
|
||||||
}
|
}
|
||||||
# if 'enter' pressed, perform rename
|
# if 'enter' pressed, perform rename
|
||||||
|
@ -586,9 +585,7 @@ $process-sandbox-rename:body: {
|
||||||
# sandbox->data = new-line
|
# sandbox->data = new-line
|
||||||
copy-handle new-line-h, sandbox-slot
|
copy-handle new-line-h, sandbox-slot
|
||||||
# clear partial-name-for-cursor-word
|
# clear partial-name-for-cursor-word
|
||||||
var empty: (handle word)
|
clear-object new-name-ah
|
||||||
copy-handle empty, new-name-ah
|
|
||||||
#? # XXX
|
|
||||||
#? var cursor-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path
|
#? 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 cursor/eax: (addr call-path-element) <- lookup *cursor-ah
|
||||||
#? var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word
|
#? var word-at-cursor-ah/eax: (addr handle word) <- get cursor, word
|
||||||
|
@ -643,8 +640,7 @@ $process-sandbox-define:body: {
|
||||||
compare key, 0x1b # esc
|
compare key, 0x1b # esc
|
||||||
$process-sandbox-define:cancel: {
|
$process-sandbox-define:cancel: {
|
||||||
break-if-!=
|
break-if-!=
|
||||||
var empty: (handle word)
|
clear-object new-name-ah
|
||||||
copy-handle empty, new-name-ah
|
|
||||||
break $process-sandbox-define:body
|
break $process-sandbox-define:body
|
||||||
}
|
}
|
||||||
# if 'enter' pressed, perform define
|
# if 'enter' pressed, perform define
|
||||||
|
|
|
@ -81,8 +81,7 @@ fn evaluate functions: (addr handle function), bindings: (addr table), scratch:
|
||||||
var type-addr/eax: (addr int) <- get target-val, type
|
var type-addr/eax: (addr int) <- get target-val, type
|
||||||
copy-to *type-addr, 0 # int
|
copy-to *type-addr, 0 # int
|
||||||
var target-string-ah/eax: (addr handle array byte) <- get target-val, text-data
|
var target-string-ah/eax: (addr handle array byte) <- get target-val, text-data
|
||||||
var empty: (handle array byte)
|
clear-object target-string-ah
|
||||||
copy-handle empty, target-string-ah
|
|
||||||
var target/eax: (addr int) <- get target-val, int-data
|
var target/eax: (addr int) <- get target-val, int-data
|
||||||
copy-to *target, result
|
copy-to *target, result
|
||||||
break $evaluate:process-word
|
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
|
var type-addr/eax: (addr int) <- get target-val, type
|
||||||
copy-to *type-addr, 0 # int
|
copy-to *type-addr, 0 # int
|
||||||
var target-array-ah/eax: (addr handle array value) <- get target-val, array-data
|
var target-array-ah/eax: (addr handle array value) <- get target-val, array-data
|
||||||
var empty: (handle array value)
|
clear-object target-array-ah
|
||||||
copy-handle empty, target-array-ah
|
|
||||||
var target/eax: (addr int) <- get target-val, int-data
|
var target/eax: (addr int) <- get target-val, int-data
|
||||||
copy-to *target, result
|
copy-to *target, result
|
||||||
break $evaluate:process-word
|
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 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
|
var filename-ah/ecx: (addr handle array byte) <- get target-val, filename
|
||||||
copy-object target-string-ah, filename-ah
|
copy-object target-string-ah, filename-ah
|
||||||
var empty: (handle array byte)
|
clear-object target-string-ah
|
||||||
copy-handle empty, target-string-ah
|
|
||||||
break $evaluate:process-word
|
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
|
var type-addr/eax: (addr int) <- get target-val, type
|
||||||
copy-to *type-addr, 1 # string
|
copy-to *type-addr, 1 # string
|
||||||
var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data
|
var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data
|
||||||
var empty: (handle buffered-file)
|
clear-object target-file-ah
|
||||||
copy-handle empty, target-file-ah
|
|
||||||
break $evaluate:process-word
|
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
|
var type-addr/eax: (addr int) <- get target-val, type
|
||||||
copy-to *type-addr, 1 # string
|
copy-to *type-addr, 1 # string
|
||||||
var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data
|
var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data
|
||||||
var empty: (handle buffered-file)
|
clear-object target-file-ah
|
||||||
copy-handle empty, target-file-ah
|
|
||||||
break $evaluate:process-word
|
break $evaluate:process-word
|
||||||
}
|
}
|
||||||
{
|
{
|
||||||
|
|
|
@ -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
|
# 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: (addr stream T), out: (addr T)
|
||||||
=> "(read-from-stream " s " " out " " size-of(T) ")"
|
=> "(read-from-stream " s " " out " " size-of(T) ")"
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue