akkartik
/
mu
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

shell: separate 'def' from 'set' 

'def' creates new bindings (only in globals)
'set' only modifies existing bindings (either in env or globals)
This commit is contained in:
Kartik K. Agaram 2021-04-21 20:46:34 -07:00
parent bfc6fa1876
commit c54b7e9630
4 changed files with 274 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
309stream.subx
View File

@ -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

1
400.mu
View File

@ -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)

168
shell/evaluate.mu
View File

@ -145,8 +145,58 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
trace-higher trace
return
}
$evaluate:def: {
# trees starting with "def" define globals
var expr/esi: (addr cell) <- copy in-addr
# 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
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 def?/eax: boolean <- stream-data-equal? sym-data, "def"
compare def?, 0/false
break-if-=
#
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
{
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 def 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", "saving global 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
var tmp-string: (handle array byte)
var tmp-ah/edx: (addr handle array byte) <- address tmp-string
rewind-stream first-arg-data
stream-to-array first-arg-data, tmp-ah
var first-arg-data-string/eax: (addr array byte) <- lookup *tmp-ah
var out2/edi: (addr handle cell) <- copy out
append-global globals, first-arg-data-string, *out2
trace-higher trace
return
}
$evaluate:set: {
# trees starting with "set" define globals
# 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
@ -181,17 +231,11 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel
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", "saving global binding"
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
var tmp-string: (handle array byte)
var tmp-ah/edx: (addr handle array byte) <- address tmp-string
rewind-stream first-arg-data
stream-to-array first-arg-data, tmp-ah
var first-arg-data-string/eax: (addr array byte) <- lookup *tmp-ah
var out2/edi: (addr handle cell) <- copy out
append-global globals, first-arg-data-string, *out2
mutate-binding first-arg-data, out, env-h, globals, trace
trace-higher trace
return
}
@ -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

25
shell/global.mu
View File

@ -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