diff options
Diffstat (limited to 'apps/tile')
| -rw-r--r-- | apps/tile/README.md | 33 | ||||
| -rw-r--r-- | apps/tile/box.mu | 109 | ||||
| -rw-r--r-- | apps/tile/data.mu | 641 | ||||
| -rw-r--r-- | apps/tile/environment.mu | 2181 | ||||
| -rw-r--r-- | apps/tile/float-stack.mu | 64 | ||||
| -rw-r--r-- | apps/tile/gap-buffer.mu | 343 | ||||
| -rw-r--r-- | apps/tile/grapheme-stack.mu | 191 | ||||
| -rw-r--r-- | apps/tile/main.mu | 133 | ||||
| -rw-r--r-- | apps/tile/rpn.mu | 911 | ||||
| -rw-r--r-- | apps/tile/surface.mu | 412 | ||||
| -rw-r--r-- | apps/tile/table.mu | 165 | ||||
| -rw-r--r-- | apps/tile/value-stack.mu | 149 | ||||
| -rw-r--r-- | apps/tile/value.mu | 424 | ||||
| -rw-r--r-- | apps/tile/vimrc.vim | 2 | ||||
| -rw-r--r-- | apps/tile/word.mu | 573 |
15 files changed, 0 insertions, 6331 deletions
diff --git a/apps/tile/README.md b/apps/tile/README.md deleted file mode 100644 index a13f7662..00000000 --- a/apps/tile/README.md +++ /dev/null @@ -1,33 +0,0 @@ -A programming environment that tries to [“stop drawing dead fish”](http://worrydream.com/#!/StopDrawingDeadFish). - -<img alt='screenshot' src='../../html/rpn5.png' width='500px'> - -To run: - -``` -./translate_mu apps/tile/*.mu -./a.elf screen -``` - -To run tests: - -``` -./a.elf test -``` - -To run a conventional REPL (for debugging): - -``` -./a.elf type -``` - -## hacking - -Unlike the top-level directory, this is just a prototype so far. There are no -tests. - -To add a new primitive you'll need to hard-code it into the `evaluate` -function (apps/tile/rpn.mu). - -There's also a second place you'll want to teach about predefined primitives: -`bound-function?` (apps/tile/environment.mu) diff --git a/apps/tile/box.mu b/apps/tile/box.mu deleted file mode 100644 index 859d0b8e..00000000 --- a/apps/tile/box.mu +++ /dev/null @@ -1,109 +0,0 @@ -fn draw-box screen: (addr screen), row1: int, col1: int, row2: int, col2: int { - draw-horizontal-line screen, row1, col1, col2 - draw-vertical-line screen, row1, row2, col1 - draw-horizontal-line screen, row2, col1, col2 - draw-vertical-line screen, row1, row2, col2 - draw-top-left-corner screen, row1, col1 - draw-top-right-corner screen, row1, col2 - draw-bottom-left-corner screen, row2, col1 - draw-bottom-right-corner screen, row2, col2 -} - -fn draw-hatching screen: (addr screen), row1: int, col1: int, row2: int, col2: int { - var c/eax: int <- copy col1 - var r1/ecx: int <- copy row1 - r1 <- increment - c <- add 2 - { - compare c, col2 - break-if->= - draw-vertical-line screen, r1, row2, c - c <- add 2 - loop - } -} - -fn draw-horizontal-line screen: (addr screen), row: int, col1: int, col2: int { - var col/eax: int <- copy col1 - move-cursor screen, row, col - { - compare col, col2 - break-if->= - print-code-point screen, 0x2500 - col <- increment - loop - } -} - -fn draw-vertical-line screen: (addr screen), row1: int, row2: int, col: int { - var row/eax: int <- copy row1 - { - compare row, row2 - break-if->= - move-cursor screen, row, col - print-code-point screen, 0x2502 - row <- increment - loop - } -} - -fn draw-top-left-corner screen: (addr screen), row: int, col: int { - move-cursor screen, row, col - print-code-point screen, 0x250c -} - -fn draw-top-right-corner screen: (addr screen), row: int, col: int { - move-cursor screen, row, col - print-code-point screen, 0x2510 -} - -fn draw-bottom-left-corner screen: (addr screen), row: int, col: int { - move-cursor screen, row, col - print-code-point screen, 0x2514 -} - -fn draw-bottom-right-corner screen: (addr screen), row: int, col: int { - move-cursor screen, row, col - print-code-point screen, 0x2518 -} - -# erase parts of screen the slow way -fn clear-rect screen: (addr screen), row1: int, col1: int, row2: int, col2: int { - var i/eax: int <- copy row1 - { - compare i, row2 - break-if-> - var j/ecx: int <- copy col1 - move-cursor screen, i, j - { - compare j, col2 - break-if-> - print-grapheme screen 0x20/space - j <- increment - loop - } - i <- increment - loop - } -} - -fn clear-rect2 screen: (addr screen), row1: int, col1: int, w: int, h: int { - var i/eax: int <- copy 0 - var curr-row/esi: int <- copy row1 - { - compare i, w - break-if->= - move-cursor screen, curr-row, col1 - var j/ecx: int <- copy 0 - { - compare j, h - break-if->= - print-grapheme screen 0x20/space - j <- increment - loop - } - i <- increment - curr-row <- increment - loop - } -} diff --git a/apps/tile/data.mu b/apps/tile/data.mu deleted file mode 100644 index d711e7d7..00000000 --- a/apps/tile/data.mu +++ /dev/null @@ -1,641 +0,0 @@ -# widgets in the environment share the following pattern of updates: -# process-* functions read keys and update which object the cursor is at -# render-* functions print to screen and update which row/col each object's cursor is at - -type sandbox { - setup: (handle line) - data: (handle line) - # bookkeeping for process-* - cursor-call-path: (handle call-path-element) - expanded-words: (handle call-path) - partial-name-for-cursor-word: (handle word) # only when renaming word - partial-name-for-function: (handle word) # only when defining function - # bookkeeping for render-* - cursor-row: int - cursor-col: int - # - next: (handle sandbox) - prev: (handle sandbox) -} - -type function { - name: (handle array byte) - args: (handle word) # in reverse order - body: (handle line) - # bookkeeping for process-* - cursor-word: (handle word) - # bookkeeping for render-* - cursor-row: int - cursor-col: int - # todo: some sort of indication of spatial location - next: (handle function) -} - -type line { - name: (handle array byte) - data: (handle word) - result: (handle result) # might be cached - next: (handle line) - prev: (handle line) -} - -type word { - scalar-data: (handle gap-buffer) - next: (handle word) - prev: (handle word) -} - -# todo: turn this into a sum type -type value { - type: int - number-data: float # if type = 0 - text-data: (handle array byte) # if type = 1 - array-data: (handle array value) # if type = 2 - file-data: (handle buffered-file) # if type = 3 - filename: (handle array byte) # if type = 3 - screen-data: (handle screen) # if type = 4 -} - -type table { - data: (handle array bind) - next: (handle table) -} - -type bind { - key: (handle array byte) - value: (handle value) # I'd inline this but we sometimes want to return a specific value from a table -} - -# 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: (handle call-path-element) - next: (handle call-path) -} - -# A call-path element is a list of elements, each of which corresponds to some call. -type call-path-element { - word: (handle word) - next: (handle call-path-element) -} - -type result { - data: value-stack - error: (handle array byte) # single error message for now -} - -fn initialize-sandbox _sandbox: (addr sandbox) { - var sandbox/esi: (addr sandbox) <- copy _sandbox - var line-ah/eax: (addr handle line) <- get sandbox, data - allocate line-ah - var line/eax: (addr line) <- lookup *line-ah - initialize-line line - var word-ah/ecx: (addr handle word) <- get line, data - var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - allocate cursor-call-path-ah - var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - var dest/eax: (addr handle word) <- get cursor-call-path, word - copy-object word-ah, dest -} - -# initialize line with a single empty word -fn initialize-line _line: (addr line) { - var line/esi: (addr line) <- copy _line - var word-ah/eax: (addr handle word) <- get line, data - allocate word-ah - var word/eax: (addr word) <- lookup *word-ah - initialize-word word -} - -fn create-primitive-functions _self: (addr handle function) { - # x 2* = x 2 * - var self/esi: (addr handle function) <- copy _self - allocate self - var _f/eax: (addr function) <- lookup *self - var f/esi: (addr function) <- copy _f - var name-ah/eax: (addr handle array byte) <- get f, name - populate-text-with name-ah, "2*" - var args-ah/eax: (addr handle word) <- get f, args - allocate args-ah - var args/eax: (addr word) <- lookup *args-ah - initialize-word-with args, "x" - var body-ah/eax: (addr handle line) <- get f, body - allocate body-ah - var body/eax: (addr line) <- lookup *body-ah - initialize-line body - var curr-word-ah/ecx: (addr handle word) <- get body, data - parse-words "x 2 *", curr-word-ah - var cursor-word-ah/edx: (addr handle word) <- get f, cursor-word - copy-object curr-word-ah, cursor-word-ah - # x 1+ = x 1 + - var next/esi: (addr handle function) <- get f, next - allocate next - var _f/eax: (addr function) <- lookup *next - var f/esi: (addr function) <- copy _f - var name-ah/eax: (addr handle array byte) <- get f, name - populate-text-with name-ah, "1+" - var args-ah/eax: (addr handle word) <- get f, args - allocate args-ah - var args/eax: (addr word) <- lookup *args-ah - initialize-word-with args, "x" - var body-ah/eax: (addr handle line) <- get f, body - allocate body-ah - var body/eax: (addr line) <- lookup *body-ah - initialize-line body - curr-word-ah <- get body, data - parse-words "x 1 +", curr-word-ah - var cursor-word-ah/edx: (addr handle word) <- get f, cursor-word - copy-object curr-word-ah, cursor-word-ah - # x 2+ = x 1+ 1+ - var next/esi: (addr handle function) <- get f, next - allocate next - var _f/eax: (addr function) <- lookup *next - var f/esi: (addr function) <- copy _f - var name-ah/eax: (addr handle array byte) <- get f, name - populate-text-with name-ah, "2+" - var args-ah/eax: (addr handle word) <- get f, args - allocate args-ah - var args/eax: (addr word) <- lookup *args-ah - initialize-word-with args, "x" - var body-ah/eax: (addr handle line) <- get f, body - allocate body-ah - var body/eax: (addr line) <- lookup *body-ah - initialize-line body - curr-word-ah <- get body, data - parse-words "x 1+ 1+", curr-word-ah - var cursor-word-ah/edx: (addr handle word) <- get f, cursor-word - copy-object curr-word-ah, cursor-word-ah - # x square = x x * - var next/esi: (addr handle function) <- get f, next - allocate next - var _f/eax: (addr function) <- lookup *next - var f/esi: (addr function) <- copy _f - var name-ah/eax: (addr handle array byte) <- get f, name - populate-text-with name-ah, "square" - var args-ah/eax: (addr handle word) <- get f, args - allocate args-ah - var args/eax: (addr word) <- lookup *args-ah - initialize-word-with args, "x" - var body-ah/eax: (addr handle line) <- get f, body - allocate body-ah - var body/eax: (addr line) <- lookup *body-ah - initialize-line body - curr-word-ah <- get body, data - parse-words "x x *", curr-word-ah - var cursor-word-ah/edx: (addr handle word) <- get f, cursor-word - copy-object curr-word-ah, cursor-word-ah - # x 1- = x 1 - - var next/esi: (addr handle function) <- get f, next - allocate next - var _f/eax: (addr function) <- lookup *next - var f/esi: (addr function) <- copy _f - var name-ah/eax: (addr handle array byte) <- get f, name - populate-text-with name-ah, "1-" - var args-ah/eax: (addr handle word) <- get f, args - allocate args-ah - var args/eax: (addr word) <- lookup *args-ah - initialize-word-with args, "x" - var body-ah/eax: (addr handle line) <- get f, body - allocate body-ah - var body/eax: (addr line) <- lookup *body-ah - initialize-line body - curr-word-ah <- get body, data - parse-words "x 1 -", curr-word-ah - var cursor-word-ah/edx: (addr handle word) <- get f, cursor-word - copy-object curr-word-ah, cursor-word-ah - # x y sub = x y - - var next/esi: (addr handle function) <- get f, next - allocate next - var _f/eax: (addr function) <- lookup *next - var f/esi: (addr function) <- copy _f - var name-ah/eax: (addr handle array byte) <- get f, name - populate-text-with name-ah, "sub" - # critical lesson: args are stored in reverse order - var args-ah/eax: (addr handle word) <- get f, args - allocate args-ah - var args/eax: (addr word) <- lookup *args-ah - initialize-word-with args, "y" - var next-arg-ah/eax: (addr handle word) <- get args, next - allocate next-arg-ah - var next-arg/eax: (addr word) <- lookup *next-arg-ah - initialize-word-with next-arg, "x" - var body-ah/eax: (addr handle line) <- get f, body - allocate body-ah - var body/eax: (addr line) <- lookup *body-ah - initialize-line body - curr-word-ah <- get body, data - parse-words "x y -", curr-word-ah - var cursor-word-ah/edx: (addr handle word) <- get f, cursor-word - copy-object curr-word-ah, cursor-word-ah -} - -fn function-body functions: (addr handle function), _word: (addr handle word), out: (addr handle line) { - var function-name-storage: (handle array byte) - var function-name-ah/ecx: (addr handle array byte) <- address function-name-storage - var word-ah/esi: (addr handle word) <- copy _word - var word/eax: (addr word) <- lookup *word-ah - var gap-ah/eax: (addr handle gap-buffer) <- get word, scalar-data - var gap/eax: (addr gap-buffer) <- lookup *gap-ah - gap-buffer-to-string gap, function-name-ah - var _function-name/eax: (addr array byte) <- lookup *function-name-ah - var function-name/esi: (addr array byte) <- copy _function-name - var curr-ah/ecx: (addr handle function) <- copy functions - $function-body:loop: { - var _curr/eax: (addr function) <- lookup *curr-ah - var curr/edx: (addr function) <- copy _curr - compare curr, 0 - break-if-= - var curr-name-ah/eax: (addr handle array byte) <- get curr, name - var curr-name/eax: (addr array byte) <- lookup *curr-name-ah - var found?/eax: boolean <- string-equal? curr-name, function-name - compare found?, 0/false - { - break-if-= - var src/eax: (addr handle line) <- get curr, body - copy-object src, out - break $function-body:loop - } - curr-ah <- get curr, next - loop - } -} - -fn body-length functions: (addr handle function), function-name: (addr handle word) -> _/eax: int { - var body-storage: (handle line) - var body-ah/edi: (addr handle line) <- address body-storage - function-body functions, function-name, body-ah - var body/eax: (addr line) <- lookup *body-ah - var result/eax: int <- num-words-in-line body - return result -} - -fn num-words-in-line _in: (addr line) -> _/eax: int { - var in/esi: (addr line) <- copy _in - var curr-ah/ecx: (addr handle word) <- get in, data - var result/edi: int <- copy 0 - { - var curr/eax: (addr word) <- lookup *curr-ah - compare curr, 0 - break-if-= - curr-ah <- get curr, next - result <- increment - loop - } - return result -} - -fn populate-text-with _out: (addr handle array byte), _in: (addr array byte) { - var in/esi: (addr array byte) <- copy _in - var n/ecx: int <- length in - var out/edx: (addr handle array byte) <- copy _out - populate out, n - var _out-addr/eax: (addr array byte) <- lookup *out - var out-addr/edx: (addr array byte) <- copy _out-addr - var i/eax: int <- copy 0 - { - compare i, n - break-if->= - var src/esi: (addr byte) <- index in, i - var val/ecx: byte <- copy-byte *src - var dest/edi: (addr byte) <- index out-addr, i - copy-byte-to *dest, val - i <- increment - loop - } -} - -fn initialize-path-from-sandbox _in: (addr sandbox), _out: (addr handle call-path-element) { - var sandbox/esi: (addr sandbox) <- copy _in - var line-ah/eax: (addr handle line) <- get sandbox, data - var line/eax: (addr line) <- lookup *line-ah - var src/esi: (addr handle word) <- get line, data - var out-ah/edi: (addr handle call-path-element) <- copy _out - var out/eax: (addr call-path-element) <- lookup *out-ah - var dest/edi: (addr handle word) <- get out, word - copy-object src, dest -} - -fn initialize-path-from-line _line: (addr line), _out: (addr handle call-path-element) { - var line/eax: (addr line) <- copy _line - var src/esi: (addr handle word) <- get line, data - var out-ah/edi: (addr handle call-path-element) <- copy _out - var out/eax: (addr call-path-element) <- lookup *out-ah - var dest/edi: (addr handle word) <- get out, word - copy-object src, dest -} - -fn find-in-call-paths call-paths: (addr handle call-path), needle: (addr handle call-path-element) -> _/eax: boolean { - var curr-ah/esi: (addr handle call-path) <- copy call-paths - $find-in-call-path:loop: { - var curr/eax: (addr call-path) <- lookup *curr-ah - compare curr, 0 - break-if-= - { - 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-= - return 1/true - } - } - curr-ah <- get curr, next - loop - } - return 0/false -} - -fn call-path-element-match? _x: (addr handle call-path-element), _y: (addr handle call-path-element) -> _/eax: boolean { - 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-!= - return 1/true - } - compare x, 0 - { - break-if-!= - return 0/false - } - compare y, 0 - { - break-if-!= - return 0/false - } - # compare word addresses, not contents - var x-data-ah/ecx: (addr handle word) <- get x, word - var x-data-a/eax: (addr word) <- lookup *x-data-ah - var x-data/ecx: int <- copy x-data-a - var y-data-ah/eax: (addr handle word) <- get y, word - var y-data-a/eax: (addr word) <- lookup *y-data-ah - var y-data/eax: int <- copy y-data-a -#? print-string 0, "match? " -#? print-int32-hex 0, x-data -#? print-string 0, " vs " -#? print-int32-hex 0, y-data -#? print-string 0, "\n" - compare x-data, y-data - { - break-if-= - return 0/false - } - var x-next/ecx: (addr handle call-path-element) <- get x, next - var y-next/eax: (addr handle call-path-element) <- get y, next - var result/eax: boolean <- call-path-element-match? x-next, y-next - return result -} - -# order is irrelevant -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 dest/ecx: (addr handle call-path-element) <- get new-path, data - deep-copy-call-path-element new, dest - copy-object new-path-ah, list -} - -# 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 handle word) <- get dest-addr, word - var src-data-addr/eax: (addr handle word) <- get src-addr, word - copy-object src-data-addr, dest-data-addr - } - # 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) { - var curr-ah/esi: (addr handle call-path) <- copy list - $delete-in-call-path:loop: { - var _curr/eax: (addr call-path) <- lookup *curr-ah - var curr/ecx: (addr call-path) <- copy _curr - compare curr, 0 - break-if-= - { - 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-ah/ecx: (addr handle word) <- get final, word - var val/eax: (addr word) <- lookup *val-ah - var new-ah/edx: (addr handle word) <- get val, next - var target/eax: (addr word) <- lookup *new-ah - compare target, 0 - break-if-= - copy-object new-ah, val-ah -} - -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-ah/ecx: (addr handle word) <- get final, word - var val/eax: (addr word) <- lookup *val-ah -#? print-string 0, "replacing " -#? { -#? var foo/eax: int <- copy val -#? print-int32-hex 0, foo -#? } - var new-ah/edx: (addr handle word) <- get val, prev - var target/eax: (addr word) <- lookup *new-ah - compare target, 0 - break-if-= - # val = val->prev -#? print-string 0, " with " -#? { -#? var foo/eax: int <- copy target -#? print-int32-hex 0, foo -#? } -#? print-string 0, "\n" - copy-object new-ah, val-ah -} - -fn move-final-element-to-start-of-line 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-ah/ecx: (addr handle word) <- get final, word - var val/eax: (addr word) <- lookup *val-ah - var new-ah/edx: (addr handle word) <- get val, prev - var target/eax: (addr word) <- lookup *new-ah - compare target, 0 - break-if-= - copy-object new-ah, val-ah - move-final-element-to-start-of-line list -} - -fn move-final-element-to-end-of-line 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-ah/ecx: (addr handle word) <- get final, word - var val/eax: (addr word) <- lookup *val-ah - var new-ah/edx: (addr handle word) <- get val, next - var target/eax: (addr word) <- lookup *new-ah - compare target, 0 - break-if-= - copy-object new-ah, val-ah - move-final-element-to-end-of-line list -} - -fn push-to-call-path-element list: (addr handle call-path-element), new: (addr handle word) { - var new-element-storage: (handle call-path-element) - var new-element-ah/edi: (addr handle call-path-element) <- address new-element-storage - allocate new-element-ah - var new-element/eax: (addr call-path-element) <- lookup *new-element-ah - # save word - var dest/ecx: (addr handle word) <- get new-element, word - copy-object new, dest - # save next - var dest2/ecx: (addr handle call-path-element) <- get new-element, next - copy-object list, dest2 - # return - copy-object new-element-ah, list -} - -fn drop-from-call-path-element _list: (addr handle call-path-element) { - var list-ah/esi: (addr handle call-path-element) <- copy _list - var list/eax: (addr call-path-element) <- lookup *list-ah - var next/eax: (addr handle call-path-element) <- get list, next - copy-object next, _list -} - -fn drop-nested-calls _list: (addr handle call-path-element) { - var list-ah/esi: (addr handle call-path-element) <- copy _list - var list/eax: (addr call-path-element) <- lookup *list-ah - var next-ah/edi: (addr handle call-path-element) <- get list, next - var next/eax: (addr call-path-element) <- lookup *next-ah - compare next, 0 - break-if-= - copy-object next-ah, _list - drop-nested-calls _list -} - -fn dump-call-path-element screen: (addr screen), _x-ah: (addr handle call-path-element) { - var x-ah/ecx: (addr handle call-path-element) <- copy _x-ah - var _x/eax: (addr call-path-element) <- lookup *x-ah - var x/esi: (addr call-path-element) <- copy _x - var word-ah/eax: (addr handle word) <- get x, word - var word/eax: (addr word) <- lookup *word-ah - print-word screen, word - var next-ah/ecx: (addr handle call-path-element) <- get x, next - var next/eax: (addr call-path-element) <- lookup *next-ah - compare next, 0 - { - break-if-= - print-string screen, " " - dump-call-path-element screen, next-ah - return - } - print-string screen, "\n" -} - -fn dump-call-paths screen: (addr screen), _x-ah: (addr handle call-path) { - var x-ah/ecx: (addr handle call-path) <- copy _x-ah - var x/eax: (addr call-path) <- lookup *x-ah - compare x, 0 - break-if-= - var src/ecx: (addr handle call-path-element) <- get x, data - dump-call-path-element screen, src - var next-ah/ecx: (addr handle call-path) <- get x, next - var next/eax: (addr call-path) <- lookup *next-ah - compare next, 0 - { - break-if-= - dump-call-paths screen, next-ah - } -} - -fn function-width _self: (addr function) -> _/eax: int { - var self/esi: (addr function) <- copy _self - var args/ecx: (addr handle word) <- get self, args - var arg-width/eax: int <- word-list-length args - var result/edi: int <- copy arg-width - result <- add 4 # function-header-indent + body-indent - var body-ah/eax: (addr handle line) <- get self, body - var body-width/eax: int <- body-width body-ah - body-width <- add 1 # right margin - body-width <- add 2 # body-indent for "≡ " - compare result, body-width - { - break-if->= - result <- copy body-width - } - return result -} - -fn body-width lines: (addr handle line) -> _/eax: int { - var curr-ah/esi: (addr handle line) <- copy lines - var result/edi: int <- copy 0 - { - var curr/eax: (addr line) <- lookup *curr-ah - compare curr, 0 - break-if-= - { - var words/ecx: (addr handle word) <- get curr, data - var curr-len/eax: int <- word-list-length words - compare curr-len, result - break-if-<= - result <- copy curr-len - } - curr-ah <- get curr, next - loop - } - return result -} - -fn function-height _self: (addr function) -> _/eax: int { - var self/esi: (addr function) <- copy _self - var body-ah/eax: (addr handle line) <- get self, body - var result/eax: int <- line-list-length body-ah - result <- increment # for function header - return result -} - -fn line-list-length lines: (addr handle line) -> _/eax: int { - var curr-ah/esi: (addr handle line) <- copy lines - var result/edi: int <- copy 0 - { - var curr/eax: (addr line) <- lookup *curr-ah - compare curr, 0 - break-if-= - curr-ah <- get curr, next - result <- increment - loop - } - return result -} diff --git a/apps/tile/environment.mu b/apps/tile/environment.mu deleted file mode 100644 index de771dee..00000000 --- a/apps/tile/environment.mu +++ /dev/null @@ -1,2181 +0,0 @@ -# The architecture that seems to be crystallizing: the environment has two -# areas: functions and sandbox. -# -# Rendering the environment requires rendering all areas. -# Displaying the cursor requires displaying cursor for the area controlling the cursor. -# Processing events for the environment requires processing events for the area controlling the cursor. -# -# Areas can have dialogs. -# There can also be global dialogs (currently just one: goto function). -# Areas are responsible for rendering their dialogs. -# In practice this results in dialogs encapsulating the state they need to -# decide whether to render. -# -# This will be useful if we add more areas in the future. - -type environment { - screen: (handle screen) - functions: (handle function) - sandboxes: (handle sandbox) - partial-function-name: (handle word) - # at most one of these will be set - cursor-function: (handle function) - cursor-sandbox: (handle sandbox) - # - nrows: int - ncols: int - code-separator-col: int -} - -fn initialize-environment _env: (addr environment) { - var env/esi: (addr environment) <- copy _env - # initialize some predefined function definitions - var functions/eax: (addr handle function) <- get env, functions - create-primitive-functions functions - # initialize first sandbox - var sandbox-ah/ecx: (addr handle sandbox) <- get env, sandboxes - allocate sandbox-ah - var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah - initialize-sandbox sandbox - # initialize cursor sandbox - var cursor-sandbox-ah/eax: (addr handle sandbox) <- get env, cursor-sandbox - copy-object sandbox-ah, cursor-sandbox-ah - # initialize screen - var screen-ah/eax: (addr handle screen) <- get env, screen - var _screen/eax: (addr screen) <- lookup *screen-ah - var screen/edi: (addr screen) <- copy _screen - var nrows/eax: int <- copy 0 - var ncols/ecx: int <- copy 0 - nrows, ncols <- screen-size screen - var dest/edx: (addr int) <- get env, nrows - copy-to *dest, nrows - dest <- get env, ncols - copy-to *dest, ncols - var repl-col/ecx: int <- copy ncols - repl-col <- shift-right 1 - dest <- get env, code-separator-col - copy-to *dest, repl-col -} - -fn initialize-environment-with-fake-screen _self: (addr environment), nrows: int, ncols: int { - var self/esi: (addr environment) <- copy _self - var screen-ah/eax: (addr handle screen) <- get self, screen - allocate screen-ah - var screen-addr/eax: (addr screen) <- lookup *screen-ah - initialize-screen screen-addr, nrows, ncols - initialize-environment self -} - -############# -# Iterate -############# - -fn process _self: (addr environment), key: grapheme { - var self/esi: (addr environment) <- copy _self - var fn-name-ah/eax: (addr handle word) <- get self, partial-function-name - var fn-name/eax: (addr word) <- lookup *fn-name-ah - compare fn-name, 0 - { - break-if-= -#? print-string 0, "processing goto fn\n" - process-goto-dialog self, key - return - } - var function-ah/eax: (addr handle function) <- get self, cursor-function - var function/eax: (addr function) <- lookup *function-ah - compare function, 0 - { - break-if-= -#? print-string 0, "processing function\n" - process-function self, function, key - return - } - var sandbox-ah/eax: (addr handle sandbox) <- get self, cursor-sandbox - var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah - compare sandbox, 0 - { - break-if-= -#? print-string 0, "processing sandbox\n" - process-sandbox self, sandbox, key - return - } -} - -# collect new name in partial-function-name, and move the cursor to function with that name -fn process-goto-dialog _self: (addr environment), key: grapheme { - var self/esi: (addr environment) <- copy _self - var fn-name-ah/edi: (addr handle word) <- get self, partial-function-name - # if 'esc' pressed, cancel goto - compare key, 0x1b/esc - $process-goto-dialog:cancel: { - break-if-!= - clear-object fn-name-ah - return - } - # if 'enter' pressed, location function and set cursor to it - compare key, 0xa/enter - $process-goto-dialog:commit: { - break-if-!= -#? print-string 0, "jump\n" - var fn-name/eax: (addr word) <- lookup *fn-name-ah - var functions/ecx: (addr handle function) <- get self, functions - var dest/edx: (addr handle function) <- get self, cursor-function - callee functions, fn-name, dest - # we won't clear cursor-sandbox until we start supporting multiple sandboxes - clear-object fn-name-ah - # there shouldn't be any need to clear state for other dialogs in the sandbox - return - } - # - compare key, 0x7f/del # backspace on Macs - $process-goto-dialog:backspace: { - break-if-!= - # if not at start, delete grapheme before cursor - var fn-name/eax: (addr word) <- lookup *fn-name-ah - var at-start?/eax: boolean <- cursor-at-start? fn-name - compare at-start?, 0/false - { - break-if-!= - var fn-name/eax: (addr word) <- lookup *fn-name-ah - delete-before-cursor fn-name - } - return - } - # otherwise insert key within current word - var print?/eax: boolean <- real-grapheme? key - $process-goto-dialog:real-grapheme: { - compare print?, 0/false - break-if-= - var fn-name/eax: (addr word) <- lookup *fn-name-ah - add-grapheme-to-word fn-name, key - return - } - # silently ignore other hotkeys -} - -fn process-function _self: (addr environment), _function: (addr function), key: grapheme { - var self/esi: (addr environment) <- copy _self - var function/edi: (addr function) <- copy _function - process-function-edit self, function, key -} - -fn process-function-edit _self: (addr environment), _function: (addr function), key: grapheme { - var self/esi: (addr environment) <- copy _self - var function/edi: (addr function) <- copy _function - var cursor-word-ah/ebx: (addr handle word) <- get function, cursor-word - var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah - var cursor-word/ecx: (addr word) <- copy _cursor-word - compare key, 0x445b1b/left-arrow - $process-function-edit:key-left-arrow: { - break-if-!= -#? print-string 0, "left-arrow\n" - # if not at start, move left within current word - var at-start?/eax: boolean <- cursor-at-start? cursor-word - compare at-start?, 0/false - { - break-if-!= -#? print-string 0, "cursor left within word\n" - cursor-left cursor-word - return - } - # otherwise move to end of previous word - var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev - var prev-word/eax: (addr word) <- lookup *prev-word-ah - { - compare prev-word, 0 - break-if-= -#? print-string 0, "move to previous word\n" - cursor-to-end prev-word - copy-object prev-word-ah, cursor-word-ah - } - return - } - compare key, 0x435b1b/right-arrow - $process-function-edit:key-right-arrow: { - break-if-!= - # if not at end, move right within current word - var at-end?/eax: boolean <- cursor-at-end? cursor-word - compare at-end?, 0/false - { - break-if-!= - cursor-right cursor-word - return - } - # otherwise, move to the next word - var next-word-ah/edx: (addr handle word) <- get cursor-word, next - var next-word/eax: (addr word) <- lookup *next-word-ah - { - compare next-word, 0 - break-if-= - cursor-to-start next-word - copy-object next-word-ah, cursor-word-ah - } - return - } - # word-based motions - compare key, 2/ctrl-b - $process-function-edit:prev-word: { - break-if-!= - # jump to previous word if possible - var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev - var prev-word/eax: (addr word) <- lookup *prev-word-ah - { - compare prev-word, 0 - break-if-= - cursor-to-end prev-word - copy-object prev-word-ah, cursor-word-ah - } - return - } - compare key, 6/ctrl-f - $process-function-edit:next-word: { - break-if-!= - # jump to previous word if possible - var next-word-ah/edx: (addr handle word) <- get cursor-word, next - var next-word/eax: (addr word) <- lookup *next-word-ah - { - compare next-word, 0 - break-if-= - cursor-to-end next-word - copy-object next-word-ah, cursor-word-ah - } - return - } - # line-based motions - compare key, 1/ctrl-a - $process-function-edit:start-of-line: { - break-if-!= - # move cursor to start of first word - var body-ah/eax: (addr handle line) <- get function, body - var body/eax: (addr line) <- lookup *body-ah - var body-contents-ah/ecx: (addr handle word) <- get body, data - copy-object body-contents-ah, cursor-word-ah - var body-contents/eax: (addr word) <- lookup *body-contents-ah - cursor-to-start body-contents - return - } - compare key, 5/ctrl-e - $process-function-edit:end-of-line: { - break-if-!= - # move cursor to end of final word - var body-ah/eax: (addr handle line) <- get function, body - var body/eax: (addr line) <- lookup *body-ah - var body-contents-ah/ecx: (addr handle word) <- get body, data - copy-object body-contents-ah, cursor-word-ah - final-word cursor-word-ah, cursor-word-ah - var cursor-word/eax: (addr word) <- lookup *cursor-word-ah - cursor-to-end cursor-word - return - } - # bounce to another function - compare key, 7/ctrl-g - $process-function-edit:goto-function: { - break-if-!= - # initialize dialog to name function to jump to - var partial-function-name-ah/eax: (addr handle word) <- get self, partial-function-name - allocate partial-function-name-ah - var partial-function-name/eax: (addr word) <- lookup *partial-function-name-ah - initialize-word partial-function-name - return - } - # bounce to sandbox - compare key, 9/tab - $process-function-edit:goto-sandbox: { - break-if-!= - var function-ah/eax: (addr handle function) <- get self, cursor-function - clear-object function-ah - return - } - # editing the current function - compare key, 0x7f/del # backspace on Macs - $process-function-edit:backspace: { - break-if-!= - # if not at start of some word, delete grapheme before cursor within current word - var at-start?/eax: boolean <- cursor-at-start? cursor-word - compare at-start?, 0/false - { - break-if-!= - delete-before-cursor cursor-word - return - } - # otherwise delete current word and move to end of prev word - var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev - var prev-word/eax: (addr word) <- lookup *prev-word-ah - { - compare prev-word, 0 - break-if-= - cursor-to-end prev-word - delete-next prev-word - copy-object prev-word-ah, cursor-word-ah - } - return - } - compare key, 0x20/space - $process-function-edit:space: { - break-if-!= -#? print-string 0, "space\n" - # if cursor is at start of word, insert word before - { - var at-start?/eax: boolean <- cursor-at-start? cursor-word - compare at-start?, 0/false - break-if-= - var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev - append-word prev-word-ah - var new-prev-word-ah/eax: (addr handle word) <- get cursor-word, prev - copy-object new-prev-word-ah, cursor-word-ah - return - } - # if start of word is quote and grapheme before cursor is not, just insert it as usual - # TODO: support string escaping - { - var first-grapheme/eax: grapheme <- first-grapheme cursor-word - compare first-grapheme, 0x22/double-quote - break-if-!= - var final-grapheme/eax: grapheme <- grapheme-before-cursor cursor-word - compare final-grapheme, 0x22/double-quote - break-if-= - break $process-function-edit:space - } - # if start of word is '[' and grapheme before cursor is not ']', just insert it as usual - # TODO: support nested arrays - { - var first-grapheme/eax: grapheme <- first-grapheme cursor-word - compare first-grapheme, 0x5b/[ - break-if-!= - var final-grapheme/eax: grapheme <- grapheme-before-cursor cursor-word - compare final-grapheme, 0x5d/] - break-if-= - break $process-function-edit:space - } - # otherwise insert word after and move cursor to it for the next key - # (but we'll continue to track the current cursor-word for the rest of this function) - append-word cursor-word-ah - var next-word-ah/eax: (addr handle word) <- get cursor-word, next - copy-object next-word-ah, cursor-word-ah - # if cursor is at end of word, that's all - var at-end?/eax: boolean <- cursor-at-end? cursor-word - compare at-end?, 0/false - { - break-if-= - return - } - # otherwise we're in the middle of a word - # move everything after cursor to the (just created) next word - var next-word-ah/eax: (addr handle word) <- get cursor-word, next - var _next-word/eax: (addr word) <- lookup *next-word-ah - var next-word/ebx: (addr word) <- copy _next-word - { - var at-end?/eax: boolean <- cursor-at-end? cursor-word - compare at-end?, 0/false - break-if-!= - var g/eax: grapheme <- pop-after-cursor cursor-word - add-grapheme-to-word next-word, g - loop - } - cursor-to-start next-word - return - } - # otherwise insert key within current word - var g/edx: grapheme <- copy key - var print?/eax: boolean <- real-grapheme? key - $process-function-edit:real-grapheme: { - compare print?, 0/false - break-if-= - add-grapheme-to-word cursor-word, g - return - } - # silently ignore other hotkeys -} - -fn process-sandbox _self: (addr environment), _sandbox: (addr sandbox), key: grapheme { - var self/esi: (addr environment) <- copy _self - var sandbox/edi: (addr sandbox) <- copy _sandbox - var rename-word-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-cursor-word - var rename-word-mode?/eax: (addr word) <- lookup *rename-word-mode-ah? - compare rename-word-mode?, 0 - { - break-if-= -#? print-string 0, "processing sandbox rename\n" - process-sandbox-rename sandbox, key - return - } - var define-function-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-function - var define-function-mode?/eax: (addr word) <- lookup *define-function-mode-ah? - compare define-function-mode?, 0 - { - break-if-= -#? print-string 0, "processing function definition\n" - var functions/ecx: (addr handle function) <- get self, functions - process-sandbox-define sandbox, functions, key - return - } -#? print-string 0, "processing sandbox edit\n" - process-sandbox-edit self, sandbox, key -} - -fn process-sandbox-edit _self: (addr environment), _sandbox: (addr sandbox), key: grapheme { - var self/esi: (addr environment) <- copy _self - var sandbox/edi: (addr sandbox) <- copy _sandbox - var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - var cursor-word-ah/ebx: (addr handle word) <- get cursor-call-path, word - var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah - var cursor-word/ecx: (addr word) <- copy _cursor-word - compare key, 0x445b1b/left-arrow - $process-sandbox-edit:key-left-arrow: { - break-if-!= -#? print-string 0, "left-arrow\n" - # if not at start, move left within current word - var at-start?/eax: boolean <- cursor-at-start? cursor-word - compare at-start?, 0/false - { - break-if-!= -#? print-string 0, "cursor left within word\n" - cursor-left cursor-word - return - } - # if current word is expanded, move to the rightmost word in its body - { - var cursor-call-path/esi: (addr handle call-path-element) <- get sandbox, cursor-call-path - var expanded-words/edx: (addr handle call-path) <- get sandbox, expanded-words - var curr-word-is-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path - compare curr-word-is-expanded?, 0/false - break-if-= - # update cursor-call-path -#? print-string 0, "curr word is expanded\n" - var self/ecx: (addr environment) <- copy _self - var functions/ecx: (addr handle function) <- get self, functions - var body: (handle line) - var body-ah/eax: (addr handle line) <- address body - function-body functions, cursor-word-ah, body-ah - var body-addr/eax: (addr line) <- lookup *body-ah - var first-word-ah/edx: (addr handle word) <- get body-addr, data - var final-word-h: (handle word) - var final-word-ah/eax: (addr handle word) <- address final-word-h - final-word first-word-ah, final-word-ah - push-to-call-path-element cursor-call-path, final-word-ah - # move cursor to end of word - var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word - var cursor-word/eax: (addr word) <- lookup *cursor-word-ah - cursor-to-end cursor-word - return - } - # if at first word, look for a caller to jump to - $process-sandbox-edit:key-left-arrow-first-word: { - var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev - var prev-word/eax: (addr word) <- lookup *prev-word-ah - compare prev-word, 0 - break-if-!= - $process-sandbox-edit:key-left-arrow-first-word-and-caller: { -#? print-string 0, "return\n" - { - var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path - var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - var next-cursor-element-ah/edx: (addr handle call-path-element) <- get cursor-call-path, next - var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah - compare next-cursor-element, 0 - break-if-= $process-sandbox-edit:key-left-arrow-first-word-and-caller - copy-object next-cursor-element-ah, cursor-call-path-ah - } - var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word - var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah - cursor-word <- copy _cursor-word - } - } - # then move to end of previous word - var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev - var prev-word/eax: (addr word) <- lookup *prev-word-ah - { - compare prev-word, 0 - break-if-= -#? print-string 0, "move to previous word\n" - cursor-to-end prev-word -#? { -#? var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path -#? var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah -#? var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word -#? var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah -#? var cursor-word/ebx: (addr word) <- copy _cursor-word -#? print-string 0, "word at cursor before: " -#? print-word 0, cursor-word -#? print-string 0, "\n" -#? } - var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - decrement-final-element cursor-call-path -#? { -#? var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path -#? var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah -#? var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word -#? var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah -#? var cursor-word/ebx: (addr word) <- copy _cursor-word -#? print-string 0, "word at cursor after: " -#? print-word 0, cursor-word -#? print-string 0, "\n" -#? } - } - return - } - compare key, 0x435b1b/right-arrow - $process-sandbox-edit:key-right-arrow: { - break-if-!= - # if not at end, move right within current word - var at-end?/eax: boolean <- cursor-at-end? cursor-word - compare at-end?, 0/false - { - break-if-!= -#? print-string 0, "a\n" - cursor-right cursor-word - return - } - # if at final word, look for a caller to jump to - { - var next-word-ah/edx: (addr handle word) <- get cursor-word, next - var next-word/eax: (addr word) <- lookup *next-word-ah - compare next-word, 0 - break-if-!= - var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path - var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - var next-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next - var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah - compare next-cursor-element, 0 - break-if-= - copy-object next-cursor-element-ah, cursor-call-path-ah - return - } - # otherwise, move to the next word - var next-word-ah/edx: (addr handle word) <- get cursor-word, next - var next-word/eax: (addr word) <- lookup *next-word-ah - { - compare next-word, 0 - break-if-= -#? print-string 0, "b\n" - cursor-to-start next-word - # . . cursor-word now out of date - var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path - increment-final-element cursor-call-path - # Is the new cursor word expanded? If so, it's a function call. Add a - # new level to the cursor-call-path for the call's body. - $process-sandbox-edit:key-right-arrow-next-word-is-call-expanded: { -#? print-string 0, "c\n" - { - var expanded-words/eax: (addr handle call-path) <- get sandbox, expanded-words - var curr-word-is-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path - compare curr-word-is-expanded?, 0/false - break-if-= $process-sandbox-edit:key-right-arrow-next-word-is-call-expanded - } - var callee-h: (handle function) - var callee-ah/edx: (addr handle function) <- address callee-h - var functions/ebx: (addr handle function) <- get self, functions - callee functions, next-word, callee-ah - var callee/eax: (addr function) <- lookup *callee-ah - var callee-body-ah/eax: (addr handle line) <- get callee, body - var callee-body/eax: (addr line) <- lookup *callee-body-ah - var callee-body-first-word/edx: (addr handle word) <- get callee-body, data - push-to-call-path-element cursor-call-path, callee-body-first-word - # position cursor at left - var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word - var cursor-word/eax: (addr word) <- lookup *cursor-word-ah - cursor-to-start cursor-word -#? print-string 0, "d\n" - return - } - } - return - } - compare key, 0xa/enter - { - break-if-!= - # toggle display of subsidiary stack - toggle-cursor-word sandbox - return - } - compare key, 0xc/ctrl-l - $process-sandbox-edit:new-line: { - break-if-!= - # new line in sandbox - append-line sandbox - return - } - # word-based motions - compare key, 2/ctrl-b - $process-sandbox-edit:prev-word: { - break-if-!= - # jump to previous word at same level - var prev-word-ah/edx: (addr handle word) <- get cursor-word, prev - var prev-word/eax: (addr word) <- lookup *prev-word-ah - { - compare prev-word, 0 - break-if-= - cursor-to-end prev-word - var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - decrement-final-element cursor-call-path - return - } - # if previous word doesn't exist, try to bump up one level - { - var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path - var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - var caller-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next - var caller-cursor-element/eax: (addr call-path-element) <- lookup *caller-cursor-element-ah - compare caller-cursor-element, 0 - break-if-= - # check if previous word exists in caller - var caller-word-ah/eax: (addr handle word) <- get caller-cursor-element, word - var caller-word/eax: (addr word) <- lookup *caller-word-ah - var word-before-caller-ah/eax: (addr handle word) <- get caller-word, prev - var word-before-caller/eax: (addr word) <- lookup *word-before-caller-ah - compare word-before-caller, 0 - break-if-= - # if so jump to it - drop-from-call-path-element cursor-call-path-ah - decrement-final-element cursor-call-path-ah - return - } - } - compare key, 6/ctrl-f - $process-sandbox-edit:next-word: { - break-if-!= -#? print-string 0, "AA\n" - # jump to previous word at same level - var next-word-ah/edx: (addr handle word) <- get cursor-word, next - var next-word/eax: (addr word) <- lookup *next-word-ah - { - compare next-word, 0 - break-if-= -#? print-string 0, "BB\n" - cursor-to-end next-word - var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - increment-final-element cursor-call-path - return - } - # if next word doesn't exist, try to bump up one level -#? print-string 0, "CC\n" - var cursor-call-path-ah/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path - var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - var caller-cursor-element-ah/ecx: (addr handle call-path-element) <- get cursor-call-path, next - var caller-cursor-element/eax: (addr call-path-element) <- lookup *caller-cursor-element-ah - compare caller-cursor-element, 0 - break-if-= -#? print-string 0, "DD\n" - copy-object caller-cursor-element-ah, cursor-call-path-ah - return - } - compare key, 7/ctrl-g - $process-sandbox-edit:goto-function: { - break-if-!= - # initialize dialog to name function to jump to - var partial-function-name-ah/eax: (addr handle word) <- get self, partial-function-name - allocate partial-function-name-ah - var partial-function-name/eax: (addr word) <- lookup *partial-function-name-ah - initialize-word partial-function-name - return - } - # line-based motions - compare key, 1/ctrl-a - $process-sandbox-edit:start-of-line: { - break-if-!= - # move cursor up past all calls and to start of line - var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - drop-nested-calls cursor-call-path-ah - move-final-element-to-start-of-line cursor-call-path-ah - # move cursor to start of word - var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word - var cursor-word/eax: (addr word) <- lookup *cursor-word-ah - cursor-to-start cursor-word - # this works as long as the first word isn't expanded - # but we don't expect to see zero-arg functions first-up - return - } - compare key, 5/ctrl-e - $process-sandbox-edit:end-of-line: { - break-if-!= - # move cursor up past all calls and to start of line - var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - drop-nested-calls cursor-call-path-ah - move-final-element-to-end-of-line cursor-call-path-ah - # move cursor to end of word - var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word - var cursor-word/eax: (addr word) <- lookup *cursor-word-ah - cursor-to-end cursor-word - # this works because expanded words lie to the right of their bodies - # so the final word is always guaranteed to be at the top-level - return - } - compare key, 0x15/ctrl-u - $process-sandbox-edit:clear-line: { - break-if-!= - # clear line in sandbox - initialize-sandbox sandbox - return - } - # if cursor is within a call, disable editing hotkeys below - var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - var next-cursor-element-ah/eax: (addr handle call-path-element) <- get cursor-call-path, next - var next-cursor-element/eax: (addr call-path-element) <- lookup *next-cursor-element-ah - compare next-cursor-element, 0 - { - break-if-= - return - } - # - remaining keys only work at the top row outside any function calls - compare key, 0x7f/del # backspace on Macs - $process-sandbox-edit:backspace: { - break-if-!= - # if not at start of some word, delete grapheme before cursor within current word - var at-start?/eax: boolean <- cursor-at-start? cursor-word - compare at-start?, 0/false - { - break-if-!= - delete-before-cursor cursor-word - return - } - # otherwise delete current word and move to end of prev word - var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev - var prev-word/eax: (addr word) <- lookup *prev-word-ah - { - compare prev-word, 0 - break-if-= - cursor-to-end prev-word - delete-next prev-word - var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - decrement-final-element cursor-call-path - } - return - } - compare key, 0x20/space - $process-sandbox-edit:space: { - break-if-!= -#? print-string 0, "space\n" - # if cursor is at start of word, insert word before - { - var at-start?/eax: boolean <- cursor-at-start? cursor-word - compare at-start?, 0/false - break-if-= - var prev-word-ah/eax: (addr handle word) <- get cursor-word, prev - append-word prev-word-ah - var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - decrement-final-element cursor-call-path - return - } - # if start of word is quote and grapheme before cursor is not, just insert it as usual - # TODO: support string escaping - { - var first-grapheme/eax: grapheme <- first-grapheme cursor-word - compare first-grapheme, 0x22/double-quote - break-if-!= - var final-grapheme/eax: grapheme <- grapheme-before-cursor cursor-word - compare final-grapheme, 0x22/double-quote - break-if-= - break $process-sandbox-edit:space - } - # if start of word is '[' and grapheme before cursor is not ']', just insert it as usual - # TODO: support nested arrays - { - var first-grapheme/eax: grapheme <- first-grapheme cursor-word - compare first-grapheme, 0x5b/[ - break-if-!= - var final-grapheme/eax: grapheme <- grapheme-before-cursor cursor-word - compare final-grapheme, 0x5d/] - break-if-= - break $process-sandbox-edit:space - } - # otherwise insert word after and move cursor to it for the next key - # (but we'll continue to track the current cursor-word for the rest of this function) - append-word cursor-word-ah - var cursor-call-path/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - increment-final-element cursor-call-path - # if cursor is at end of word, that's all - var at-end?/eax: boolean <- cursor-at-end? cursor-word - compare at-end?, 0/false - { - break-if-= - return - } - # otherwise we're in the middle of a word - # move everything after cursor to the (just created) next word - var next-word-ah/eax: (addr handle word) <- get cursor-word, next - var _next-word/eax: (addr word) <- lookup *next-word-ah - var next-word/ebx: (addr word) <- copy _next-word - { - var at-end?/eax: boolean <- cursor-at-end? cursor-word - compare at-end?, 0/false - break-if-!= - var g/eax: grapheme <- pop-after-cursor cursor-word - add-grapheme-to-word next-word, g - loop - } - cursor-to-start next-word - return - } - compare key, 0xe/ctrl-n - $process:rename-word: { - break-if-!= - # TODO: ensure current word is not a function - # rename word at cursor - var new-name-ah/eax: (addr handle word) <- get sandbox, partial-name-for-cursor-word - allocate new-name-ah - var new-name/eax: (addr word) <- lookup *new-name-ah - initialize-word new-name - return - } - compare key, 4/ctrl-d - $process:define-function: { - break-if-!= - # define function out of line at cursor - var new-name-ah/eax: (addr handle word) <- get sandbox, partial-name-for-function - allocate new-name-ah - var new-name/eax: (addr word) <- lookup *new-name-ah - initialize-word new-name - return - } - # otherwise insert key within current word - var g/edx: grapheme <- copy key - var print?/eax: boolean <- real-grapheme? key - $process-sandbox-edit:real-grapheme: { - compare print?, 0/false - break-if-= - add-grapheme-to-word cursor-word, g - return - } - # silently ignore other hotkeys -} - -# collect new name in partial-name-for-cursor-word, and then rename the word -# at cursor to it -# Precondition: cursor-call-path is a singleton (not within a call) -fn process-sandbox-rename _sandbox: (addr sandbox), key: grapheme { - var sandbox/esi: (addr sandbox) <- copy _sandbox - var new-name-ah/edi: (addr handle word) <- get sandbox, partial-name-for-cursor-word - # if 'esc' pressed, cancel rename - compare key, 0x1b/esc - $process-sandbox-rename:cancel: { - break-if-!= - clear-object new-name-ah - return - } - # if 'enter' pressed, perform rename - compare key, 0xa/enter - $process-sandbox-rename:commit: { - break-if-!= -#? print-string 0, "rename\n" - # new line - var new-line-h: (handle line) - var new-line-ah/eax: (addr handle line) <- address new-line-h - allocate new-line-ah - var new-line/eax: (addr line) <- lookup *new-line-ah - initialize-line new-line - var new-line-word-ah/ecx: (addr handle word) <- get new-line, data - { - # move word at cursor to new line - 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 -#? print-string 0, "cursor before at word " -#? { -#? var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah -#? print-word 0, cursor-word -#? print-string 0, "\n" -#? } - move-word-contents word-at-cursor-ah, new-line-word-ah - # copy name to word at cursor - copy-word-contents-before-cursor new-name-ah, word-at-cursor-ah -#? print-string 0, "cursor after at word " -#? { -#? var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah -#? print-word 0, cursor-word -#? print-string 0, "\n" -#? var foo/eax: int <- copy cursor-word -#? print-int32-hex 0, foo -#? print-string 0, "\n" -#? } -#? print-string 0, "new name word " -#? { -#? var new-name/eax: (addr word) <- lookup *new-name-ah -#? print-word 0, new-name -#? print-string 0, "\n" -#? var foo/eax: int <- copy new-name -#? print-int32-hex 0, foo -#? print-string 0, "\n" -#? } - } - # prepend '=' to name - { - var new-name/eax: (addr word) <- lookup *new-name-ah - cursor-to-start new-name - add-grapheme-to-word new-name, 0x3d/= - } - # append name to new line - chain-words new-line-word-ah, new-name-ah - # new-line->next = sandbox->data - var new-line-next/ecx: (addr handle line) <- get new-line, next - var sandbox-slot/edx: (addr handle line) <- get sandbox, data - copy-object sandbox-slot, new-line-next - # sandbox->data = new-line - copy-handle new-line-h, sandbox-slot - # clear partial-name-for-cursor-word - 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 -#? print-string 0, "cursor after rename: " -#? { -#? var cursor-word/eax: (addr word) <- lookup *word-at-cursor-ah -#? print-word 0, cursor-word -#? print-string 0, " -- " -#? var foo/eax: int <- copy cursor-word -#? print-int32-hex 0, foo -#? print-string 0, "\n" -#? } - return - } - # - compare key, 0x7f/del # backspace on Macs - $process-sandbox-rename:backspace: { - break-if-!= - # if not at start, delete grapheme before cursor - var new-name/eax: (addr word) <- lookup *new-name-ah - var at-start?/eax: boolean <- cursor-at-start? new-name - compare at-start?, 0/false - { - break-if-!= - var new-name/eax: (addr word) <- lookup *new-name-ah - delete-before-cursor new-name - } - return - } - # otherwise insert key within current word - var print?/eax: boolean <- real-grapheme? key - $process-sandbox-rename:real-grapheme: { - compare print?, 0/false - break-if-= - var new-name/eax: (addr word) <- lookup *new-name-ah - add-grapheme-to-word new-name, key - return - } - # silently ignore other hotkeys -} - -# collect new name in partial-name-for-function, and then define the last line -# of the sandbox to be a new function with that name. Replace the last line -# with a call to the appropriate function. -# Precondition: cursor-call-path is a singleton (not within a call) -fn process-sandbox-define _sandbox: (addr sandbox), functions: (addr handle function), key: grapheme { - var sandbox/esi: (addr sandbox) <- copy _sandbox - var new-name-ah/edi: (addr handle word) <- get sandbox, partial-name-for-function - # if 'esc' pressed, cancel define - compare key, 0x1b/esc - $process-sandbox-define:cancel: { - break-if-!= - clear-object new-name-ah - return - } - # if 'enter' pressed, perform define - compare key, 0xa/enter - $process-sandbox-define:commit: { - break-if-!= -#? print-string 0, "define\n" - # create new function - var new-function: (handle function) - var new-function-ah/ecx: (addr handle function) <- address new-function - allocate new-function-ah - var _new-function/eax: (addr function) <- lookup *new-function-ah - var new-function/ebx: (addr function) <- copy _new-function - var dest/edx: (addr handle function) <- get new-function, next - copy-object functions, dest - copy-object new-function-ah, functions - # set function name to new-name - var new-name/eax: (addr word) <- lookup *new-name-ah - var dest/edx: (addr handle array byte) <- get new-function, name - word-to-string new-name, dest - # move final line to body - var body-ah/eax: (addr handle line) <- get new-function, body - allocate body-ah - var body/eax: (addr line) <- lookup *body-ah - var body-contents/ecx: (addr handle word) <- get body, data - var final-line-storage: (handle line) - var final-line-ah/eax: (addr handle line) <- address final-line-storage - final-line sandbox, final-line-ah - var final-line/eax: (addr line) <- lookup *final-line-ah - var final-line-contents/eax: (addr handle word) <- get final-line, data - copy-object final-line-contents, body-contents - var cursor-word-ah/ecx: (addr handle word) <- get new-function, cursor-word - copy-object final-line-contents, cursor-word-ah - { - var cursor-word/eax: (addr word) <- lookup *cursor-word-ah - cursor-to-start cursor-word - } - # - copy-unbound-words-to-args functions - # - var empty-word: (handle word) - copy-handle empty-word, final-line-contents - construct-call functions, final-line-contents - # clear partial-name-for-function - var empty-word: (handle word) - copy-handle empty-word, new-name-ah - # update cursor - var final-line/eax: (addr line) <- lookup final-line-storage - var cursor-call-path-ah/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path - allocate cursor-call-path-ah # leak - initialize-path-from-line final-line, cursor-call-path-ah - return - } - # - compare key, 0x7f/del # backspace on Macs - $process-sandbox-define:backspace: { - break-if-!= - # if not at start, delete grapheme before cursor - var new-name/eax: (addr word) <- lookup *new-name-ah - var at-start?/eax: boolean <- cursor-at-start? new-name - compare at-start?, 0/false - { - break-if-!= - var new-name/eax: (addr word) <- lookup *new-name-ah - delete-before-cursor new-name - } - return - } - # otherwise insert key within current word - var print?/eax: boolean <- real-grapheme? key - $process-sandbox-define:real-grapheme: { - compare print?, 0/false - break-if-= - var new-name/eax: (addr word) <- lookup *new-name-ah - add-grapheme-to-word new-name, key - return - } - # silently ignore other hotkeys -} - -# extract from the body of the first function in 'functions' all words that -# aren't defined in the rest of 'functions'. Prepend them in reverse order. -# Assumes function body is a single line for now. -fn copy-unbound-words-to-args _functions: (addr handle function) { - # target - var target-ah/eax: (addr handle function) <- copy _functions - var _target/eax: (addr function) <- lookup *target-ah - var target/esi: (addr function) <- copy _target - var dest-ah/edi: (addr handle word) <- get target, args - # next - var functions-ah/edx: (addr handle function) <- get target, next - # src - var line-ah/eax: (addr handle line) <- get target, body - var line/eax: (addr line) <- lookup *line-ah - var curr-ah/eax: (addr handle word) <- get line, data - var curr/eax: (addr word) <- lookup *curr-ah - { - compare curr, 0 - break-if-= - $copy-unbound-words-to-args:loop-iter: { - # is it a number? - { - var is-int?/eax: boolean <- word-is-decimal-integer? curr - compare is-int?, 0/false - break-if-!= $copy-unbound-words-to-args:loop-iter - } - # is it a pre-existing function? - var bound?/ebx: boolean <- bound-function? curr, functions-ah - compare bound?, 0/false - break-if-!= - # is it already bound as an arg? - var dup?/ebx: boolean <- arg-exists? _functions, curr # _functions = target-ah - compare dup?, 0/false - break-if-!= $copy-unbound-words-to-args:loop-iter - # push copy of curr before dest-ah - var rest-h: (handle word) - var rest-ah/ecx: (addr handle word) <- address rest-h - copy-object dest-ah, rest-ah - copy-word curr, dest-ah - chain-words dest-ah, rest-ah - } - var next-ah/ecx: (addr handle word) <- get curr, next - curr <- lookup *next-ah - loop - } -} - -fn bound-function? w: (addr word), functions-ah: (addr handle function) -> _/ebx: boolean { - var result/ebx: boolean <- copy 1/true - { - ## numbers - # if w == "+" return true - var subresult/eax: boolean <- word-equal? w, "+" - compare subresult, 0/false - break-if-!= - # if w == "-" return true - subresult <- word-equal? w, "-" - compare subresult, 0/false - break-if-!= - # if w == "*" return true - subresult <- word-equal? w, "*" - compare subresult, 0/false - break-if-!= - # if w == "/" return true - subresult <- word-equal? w, "/" - compare subresult, 0/false - break-if-!= - # if w == "sqrt" return true - subresult <- word-equal? w, "sqrt" - compare subresult, 0/false - break-if-!= - ## strings/arrays - # if w == "len" return true - subresult <- word-equal? w, "len" - compare subresult, 0/false - break-if-!= - ## files - # if w == "open" return true - subresult <- word-equal? w, "open" - compare subresult, 0/false - break-if-!= - # if w == "read" return true - subresult <- word-equal? w, "read" - compare subresult, 0/false - break-if-!= - # if w == "slurp" return true - subresult <- word-equal? w, "slurp" - compare subresult, 0/false - break-if-!= - # if w == "lines" return true - subresult <- word-equal? w, "lines" - compare subresult, 0/false - break-if-!= - ## screens - # if w == "fake-screen" return true - subresult <- word-equal? w, "fake-screen" - compare subresult, 0/false - break-if-!= - # if w == "print" return true - subresult <- word-equal? w, "print" - compare subresult, 0/false - break-if-!= - # if w == "move" return true - subresult <- word-equal? w, "move" - compare subresult, 0/false - break-if-!= - # if w == "up" return true - subresult <- word-equal? w, "up" - compare subresult, 0/false - break-if-!= - # if w == "down" return true - subresult <- word-equal? w, "down" - compare subresult, 0/false - break-if-!= - # if w == "left" return true - subresult <- word-equal? w, "left" - compare subresult, 0/false - break-if-!= - # if w == "right" return true - subresult <- word-equal? w, "right" - compare subresult, 0/false - break-if-!= - ## hacks - # if w == "dup" return true - subresult <- word-equal? w, "dup" - compare subresult, 0/false - break-if-!= - # if w == "swap" return true - subresult <- word-equal? w, "swap" - compare subresult, 0/false - break-if-!= - # return w in functions - var out-h: (handle function) - var out/eax: (addr handle function) <- address out-h - callee functions-ah, w, out - var found?/eax: (addr function) <- lookup *out - result <- copy found? - } - return result -} - -fn arg-exists? _f-ah: (addr handle function), arg: (addr word) -> _/ebx: boolean { - var f-ah/eax: (addr handle function) <- copy _f-ah - var f/eax: (addr function) <- lookup *f-ah - var args-ah/eax: (addr handle word) <- get f, args - var result/ebx: boolean <- word-exists? args-ah, arg - return result -} - -# construct a call to `f` with copies of exactly its args -fn construct-call _f-ah: (addr handle function), _dest-ah: (addr handle word) { - var f-ah/eax: (addr handle function) <- copy _f-ah - var _f/eax: (addr function) <- lookup *f-ah - var f/esi: (addr function) <- copy _f - # append args in reverse - var args-ah/eax: (addr handle word) <- get f, args - var dest-ah/edi: (addr handle word) <- copy _dest-ah - copy-words-in-reverse args-ah, dest-ah - # append name - var name-ah/eax: (addr handle array byte) <- get f, name - var name/eax: (addr array byte) <- lookup *name-ah - append-word-at-end-with dest-ah, name -} - -fn word-index _words: (addr handle word), _n: int, out: (addr handle word) { - var n/ecx: int <- copy _n - { - compare n, 0 - break-if-!= - copy-object _words, out - return - } - var words-ah/eax: (addr handle word) <- copy _words - var words/eax: (addr word) <- lookup *words-ah - var next/eax: (addr handle word) <- get words, next - n <- decrement - word-index next, n, out -} - -fn toggle-cursor-word _sandbox: (addr sandbox) { - var sandbox/esi: (addr sandbox) <- copy _sandbox - var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words - var cursor-call-path/ecx: (addr handle call-path-element) <- get sandbox, cursor-call-path -#? print-string 0, "cursor call path: " -#? dump-call-path-element 0, cursor-call-path -#? print-string 0, "expanded words:\n" -#? dump-call-paths 0, expanded-words - var already-expanded?/eax: boolean <- find-in-call-paths expanded-words, cursor-call-path - compare already-expanded?, 0/false - { - break-if-!= -#? print-string 0, "expand\n" - # if not already-expanded, insert - insert-in-call-path expanded-words cursor-call-path -#? print-string 0, "expanded words now:\n" -#? dump-call-paths 0, expanded-words - return - } - { - break-if-= - # otherwise delete - delete-in-call-path expanded-words cursor-call-path - } -} - -fn append-line _sandbox: (addr sandbox) { - var sandbox/esi: (addr sandbox) <- copy _sandbox - var line-ah/ecx: (addr handle line) <- get sandbox, data - { - var line/eax: (addr line) <- lookup *line-ah - var next-line-ah/edx: (addr handle line) <- get line, next - var next-line/eax: (addr line) <- lookup *next-line-ah - compare next-line, 0 - break-if-= - line-ah <- copy next-line-ah - loop - } - var line/eax: (addr line) <- lookup *line-ah - var final-line-ah/edx: (addr handle line) <- get line, next - allocate final-line-ah - var final-line/eax: (addr line) <- lookup *final-line-ah - initialize-line final-line - var final-prev/eax: (addr handle line) <- get final-line, prev - copy-object line-ah, final-prev - # clear cursor - var final-line/eax: (addr line) <- lookup *final-line-ah - var word-ah/ecx: (addr handle word) <- get final-line, data - var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - var dest/eax: (addr handle word) <- get cursor-call-path, word - copy-object word-ah, dest -} - -############# -# Visualize -############# - -fn evaluate-environment _env: (addr environment), stack: (addr value-stack) { - var env/esi: (addr environment) <- copy _env - # functions - var functions/edx: (addr handle function) <- get env, functions - # line - var sandbox-ah/esi: (addr handle sandbox) <- get env, sandboxes - var sandbox/eax: (addr sandbox) <- lookup *sandbox-ah - var line-ah/eax: (addr handle line) <- get sandbox, data - var _line/eax: (addr line) <- lookup *line-ah - var line/esi: (addr line) <- copy _line - evaluate functions, 0, line, 0, stack -} - -fn render _env: (addr environment) { -#? print-string 0, "== render\n" - var env/esi: (addr environment) <- copy _env - clear-canvas env - # menu - render-menu env - # screen - var screen-ah/eax: (addr handle screen) <- get env, screen - var _screen/eax: (addr screen) <- lookup *screen-ah - var screen/edi: (addr screen) <- copy _screen - # functions - var sep-col/eax: (addr int) <- get env, code-separator-col - var functions/edx: (addr handle function) <- get env, functions - render-functions screen, *sep-col, env - # sandbox - var repl-col/ecx: int <- copy *sep-col - repl-col <- add 2/repl-margin-left - var cursor-sandbox-ah/eax: (addr handle sandbox) <- get env, cursor-sandbox - var cursor-sandbox/eax: (addr sandbox) <- lookup *cursor-sandbox-ah - # bindings - var bindings-storage: table - var bindings/ebx: (addr table) <- address bindings-storage - initialize-table bindings, 0x10 -#? print-string 0, "render-sandbox {\n" - render-sandbox screen, functions, bindings, cursor-sandbox, 3, repl-col -#? print-string 0, "render-sandbox }\n" - # dialogs - render-goto-dialog screen, env - # - position-cursor screen, env -} - -# draw a wordstar-style cheatsheet of shortcuts on the bottom line of the screen -fn render-menu _env: (addr environment) { - var env/esi: (addr environment) <- copy _env - var cursor-function-ah/eax: (addr handle function) <- get env, cursor-function - var cursor-function/eax: (addr function) <- lookup *cursor-function-ah - { - compare cursor-function, 0 - break-if-= - render-function-menu env - return - } - var cursor-sandbox-ah/eax: (addr handle sandbox) <- get env, cursor-sandbox - var cursor-sandbox/eax: (addr sandbox) <- lookup *cursor-sandbox-ah - { - compare cursor-sandbox, 0 - break-if-= - render-sandbox-menu env - return - } -} - -# HACK: areas currently responsible for positioning their dialogs' cursors. So -# we just do nothing here if a dialog is up. -fn position-cursor screen: (addr screen), _env: (addr environment) { - var env/esi: (addr environment) <- copy _env - var goto-function-ah/eax: (addr handle word) <- get env, partial-function-name - var goto-function/eax: (addr word) <- lookup *goto-function-ah - { - compare goto-function, 0 - break-if-= - return - } - var cursor-function-ah/eax: (addr handle function) <- get env, cursor-function - var cursor-function/eax: (addr function) <- lookup *cursor-function-ah - { - compare cursor-function, 0 - break-if-= - var cursor-row/ecx: (addr int) <- get cursor-function, cursor-row - var cursor-col/eax: (addr int) <- get cursor-function, cursor-col - move-cursor screen, *cursor-row, *cursor-col - return - } - var cursor-sandbox-ah/eax: (addr handle sandbox) <- get env, cursor-sandbox - var cursor-sandbox/eax: (addr sandbox) <- lookup *cursor-sandbox-ah - { - compare cursor-sandbox, 0 - break-if-= - # if in a dialog, return - { - var partial-word-rename-ah/eax: (addr handle word) <- get cursor-sandbox, partial-name-for-cursor-word - var partial-word-rename/eax: (addr word) <- lookup *partial-word-rename-ah - compare partial-word-rename, 0 - break-if-= - return - } - { - var partial-function-name-ah/eax: (addr handle word) <- get cursor-sandbox, partial-name-for-function - var partial-function-name/eax: (addr word) <- lookup *partial-function-name-ah - compare partial-function-name, 0 - break-if-= - return - } - var cursor-row/ecx: (addr int) <- get cursor-sandbox, cursor-row - var cursor-col/eax: (addr int) <- get cursor-sandbox, cursor-col - move-cursor screen, *cursor-row, *cursor-col - } -} - -fn render-goto-dialog screen: (addr screen), _env: (addr environment) { - var env/esi: (addr environment) <- copy _env - var goto-function-mode-ah?/eax: (addr handle word) <- get env, partial-function-name - var goto-function-mode?/eax: (addr word) <- lookup *goto-function-mode-ah? - compare goto-function-mode?, 0/false - break-if-= - # clear a space for the dialog - var top-row/ebx: int <- copy 3 - var bottom-row/edx: int <- copy 9 - var sep-col/eax: (addr int) <- get env, code-separator-col - var left-col/ecx: int <- copy *sep-col - left-col <- subtract 0x10 - var right-col/eax: int <- copy *sep-col - right-col <- add 0x10 - clear-rect screen, top-row, left-col, bottom-row, right-col - draw-box screen, top-row, left-col, bottom-row, right-col - # render a little menu for the dialog - var menu-row/eax: int <- copy bottom-row - menu-row <- decrement - var menu-col/edx: int <- copy left-col - menu-col <- add 2 - move-cursor screen, menu-row, menu-col - start-reverse-video screen - print-string screen, " esc " - reset-formatting screen - print-string screen, " cancel " - start-reverse-video screen - print-string screen, " enter " - reset-formatting screen - print-string screen, " jump " - # draw the word, positioned appropriately around the cursor - var start-col/ecx: int <- copy left-col - start-col <- increment - move-cursor screen, 6, start-col # cursor-row - var word-ah?/edx: (addr handle word) <- get env, partial-function-name - var word/eax: (addr word) <- lookup *word-ah? - print-word screen, word -} - -fn render-sandbox screen: (addr screen), functions: (addr handle function), bindings: (addr table), _sandbox: (addr sandbox), top-row: int, left-col: int { - var sandbox/esi: (addr sandbox) <- copy _sandbox - # line - var curr-line-ah/eax: (addr handle line) <- get sandbox, data - var _curr-line/eax: (addr line) <- lookup *curr-line-ah - var curr-line/ecx: (addr line) <- copy _curr-line - # - var curr-row/edx: int <- copy top-row - # cursor row, col - var cursor-row-addr: (addr int) - var tmp/eax: (addr int) <- get sandbox, cursor-row - copy-to cursor-row-addr, tmp - var cursor-col-addr: (addr int) - tmp <- get sandbox, cursor-col - copy-to cursor-col-addr, tmp - # render all but final line without stack -#? print-string 0, "render all but final line\n" - { - var next-line-ah/eax: (addr handle line) <- get curr-line, next - var next-line/eax: (addr line) <- lookup *next-line-ah - compare next-line, 0 - break-if-= - { - var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word - var cursor-word/eax: (addr word) <- lookup *cursor-word-ah - # it's enough to pass in the first word of the path, because if the path isn't a singleton the word is guaranteed to be unique - render-line-without-stack screen, curr-line, curr-row, left-col, cursor-word, cursor-row-addr, cursor-col-addr - } - curr-line <- copy next-line - curr-row <- add 2 - loop - } - # - render-final-line-with-stack screen, functions, bindings, sandbox, curr-row, left-col, cursor-row-addr, cursor-col-addr - # at most one of the following dialogs will be rendered - render-rename-dialog screen, sandbox - render-define-dialog screen, sandbox -} - -fn render-final-line-with-stack screen: (addr screen), functions: (addr handle function), bindings: (addr table), _sandbox: (addr sandbox), top-row: int, left-col: int, cursor-row-addr: (addr int), cursor-col-addr: (addr int) { - var sandbox/esi: (addr sandbox) <- copy _sandbox - # expanded-words - var expanded-words/edi: (addr handle call-path) <- get sandbox, expanded-words - # cursor-word - var cursor-call-path-ah/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - var cursor-call-path/eax: (addr call-path-element) <- lookup *cursor-call-path-ah - var cursor-word-ah/eax: (addr handle word) <- get cursor-call-path, word - var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah - var cursor-word/ebx: (addr word) <- copy _cursor-word -#? print-string 0, "word at cursor: " -#? print-word 0, cursor-word -#? print-string 0, "\n" - # cursor-call-path - var cursor-call-path: (addr handle call-path-element) - { - var src/eax: (addr handle call-path-element) <- get sandbox, cursor-call-path - copy-to cursor-call-path, src - } - # first line - var first-line-ah/eax: (addr handle line) <- get sandbox, data - var _first-line/eax: (addr line) <- lookup *first-line-ah - var first-line/edx: (addr line) <- copy _first-line - # final line - var final-line-storage: (handle line) - var final-line-ah/eax: (addr handle line) <- address final-line-storage - final-line sandbox, final-line-ah - var final-line/eax: (addr line) <- lookup *final-line-ah - # curr-path - var curr-path-storage: (handle call-path-element) - var curr-path/ecx: (addr handle call-path-element) <- address curr-path-storage - allocate curr-path # leak - initialize-path-from-line final-line, curr-path - # - var dummy/ecx: int <- render-line screen, functions, bindings, first-line, final-line, expanded-words, top-row, left-col, curr-path, cursor-word, cursor-call-path, cursor-row-addr, cursor-col-addr -} - -fn final-line _sandbox: (addr sandbox), out: (addr handle line) { - var sandbox/esi: (addr sandbox) <- copy _sandbox - var curr-line-ah/ecx: (addr handle line) <- get sandbox, data - { - var curr-line/eax: (addr line) <- lookup *curr-line-ah - var next-line-ah/edx: (addr handle line) <- get curr-line, next - var next-line/eax: (addr line) <- lookup *next-line-ah - compare next-line, 0 - break-if-= - curr-line-ah <- copy next-line-ah - loop - } - copy-object curr-line-ah, out -} - -fn render-rename-dialog screen: (addr screen), _sandbox: (addr sandbox) { - var sandbox/edi: (addr sandbox) <- copy _sandbox - var rename-word-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-cursor-word - var rename-word-mode?/eax: (addr word) <- lookup *rename-word-mode-ah? - compare rename-word-mode?, 0/false - break-if-= - # clear a space for the dialog - var cursor-row/ebx: (addr int) <- get sandbox, cursor-row - var top-row/eax: int <- copy *cursor-row - top-row <- subtract 3 - var bottom-row/ecx: int <- copy *cursor-row - bottom-row <- add 3 - var cursor-col/ebx: (addr int) <- get sandbox, cursor-col - var left-col/edx: int <- copy *cursor-col - left-col <- subtract 0x10 - var right-col/ebx: int <- copy *cursor-col - right-col <- add 0x10 - clear-rect screen, top-row, left-col, bottom-row, right-col - draw-box screen, top-row, left-col, bottom-row, right-col - # render a little menu for the dialog - var menu-row/ecx: int <- copy bottom-row - menu-row <- decrement - var menu-col/edx: int <- copy left-col - menu-col <- add 2 - move-cursor screen, menu-row, menu-col - start-reverse-video screen - print-string screen, " esc " - reset-formatting screen - print-string screen, " cancel " - start-reverse-video screen - print-string screen, " enter " - reset-formatting screen - print-string screen, " rename " - # draw the word, positioned appropriately around the cursor - var cursor-col/ebx: (addr int) <- get sandbox, cursor-col - var start-col/ecx: int <- copy *cursor-col - var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-cursor-word - var word/eax: (addr word) <- lookup *word-ah? - var cursor-index/eax: int <- cursor-index word - start-col <- subtract cursor-index - var cursor-row/ebx: (addr int) <- get sandbox, cursor-row - move-cursor screen, *cursor-row, start-col - var word/eax: (addr word) <- lookup *word-ah? - print-word screen, word -} - -fn render-define-dialog screen: (addr screen), _sandbox: (addr sandbox) { - var sandbox/edi: (addr sandbox) <- copy _sandbox - var define-function-mode-ah?/ecx: (addr handle word) <- get sandbox, partial-name-for-function - var define-function-mode?/eax: (addr word) <- lookup *define-function-mode-ah? - compare define-function-mode?, 0/false - break-if-= - # clear a space for the dialog - var cursor-row/ebx: (addr int) <- get sandbox, cursor-row - var top-row/eax: int <- copy *cursor-row - top-row <- subtract 3 - var bottom-row/ecx: int <- copy *cursor-row - bottom-row <- add 3 - var cursor-col/ebx: (addr int) <- get sandbox, cursor-col - var left-col/edx: int <- copy *cursor-col - left-col <- subtract 0x10 - var right-col/ebx: int <- copy *cursor-col - right-col <- add 0x10 - clear-rect screen, top-row, left-col, bottom-row, right-col - draw-box screen, top-row, left-col, bottom-row, right-col - # render a little menu for the dialog - var menu-row/ecx: int <- copy bottom-row - menu-row <- decrement - var menu-col/edx: int <- copy left-col - menu-col <- add 2 - move-cursor screen, menu-row, menu-col - start-reverse-video screen - print-string screen, " esc " - reset-formatting screen - print-string screen, " cancel " - start-reverse-video screen - print-string screen, " enter " - reset-formatting screen - print-string screen, " define " - # draw the word, positioned appropriately around the cursor - var cursor-col/ebx: (addr int) <- get sandbox, cursor-col - var start-col/ecx: int <- copy *cursor-col - var word-ah?/edx: (addr handle word) <- get sandbox, partial-name-for-function - var word/eax: (addr word) <- lookup *word-ah? - var cursor-index/eax: int <- cursor-index word - start-col <- subtract cursor-index - var cursor-row/ebx: (addr int) <- get sandbox, cursor-row - move-cursor screen, *cursor-row, start-col - var word/eax: (addr word) <- lookup *word-ah? - print-word screen, word -} - -# Render just the words in 'line'. -fn render-line-without-stack screen: (addr screen), _line: (addr line), curr-row: int, left-col: int, cursor-word: (addr word), cursor-row-addr: (addr int), cursor-col-addr: (addr int) { - # curr-word - var line/eax: (addr line) <- copy _line - var first-word-ah/eax: (addr handle word) <- get line, data - var _curr-word/eax: (addr word) <- lookup *first-word-ah - var curr-word/esi: (addr word) <- copy _curr-word - # - # loop-carried dependency - var curr-col/ecx: int <- copy left-col - # - { - compare curr-word, 0 - break-if-= -#? print-string 0, "-- word in penultimate lines: " -#? { -#? var foo/eax: int <- copy curr-word -#? print-int32-hex 0, foo -#? } -#? print-string 0, "\n" - var old-col/edx: int <- copy curr-col - move-cursor screen, curr-row, curr-col - print-word screen, curr-word - { - var max-width/eax: int <- word-length curr-word - curr-col <- add max-width - curr-col <- add 1/margin-right - } - # cache cursor column if necessary - { - compare curr-word, cursor-word - break-if-!= -#? print-string 0, "Cursor at " -#? print-int32-decimal 0, curr-row -#? print-string 0, ", " -#? print-int32-decimal 0, old-col -#? print-string 0, "\n" -#? print-string 0, "contents: " -#? print-word 0, cursor-word -#? print-string 0, "\n" -#? { -#? var foo/eax: int <- copy cursor-word -#? print-int32-hex 0, foo -#? print-string 0, "\n" -#? } - var dest/ecx: (addr int) <- copy cursor-row-addr - var src/eax: int <- copy curr-row - copy-to *dest, src - dest <- copy cursor-col-addr - copy-to *dest, old-col - var cursor-index-in-word/eax: int <- cursor-index curr-word - add-to *dest, cursor-index-in-word - } - # loop update - var next-word-ah/edx: (addr handle word) <- get curr-word, next - var _curr-word/eax: (addr word) <- lookup *next-word-ah - curr-word <- copy _curr-word - loop - } -} - -fn call-depth-at-cursor _sandbox: (addr sandbox) -> _/eax: int { - var sandbox/esi: (addr sandbox) <- copy _sandbox - var cursor-call-path/edi: (addr handle call-path-element) <- get sandbox, cursor-call-path - var result/eax: int <- call-path-element-length cursor-call-path - result <- add 2 # input-row - 1 - return result -} - -fn call-path-element-length _x: (addr handle call-path-element) -> _/eax: int { - var curr-ah/ecx: (addr handle call-path-element) <- copy _x - var result/edi: int <- copy 0 - { - var curr/eax: (addr call-path-element) <- lookup *curr-ah - compare curr, 0 - break-if-= - curr-ah <- get curr, next - result <- increment - loop - } - return result -} - -# Render the line of words in line, along with the state of the stack under each word. -# Also render any expanded function calls using recursive calls. -# -# Along the way, compute the column the cursor should be positioned at (cursor-col-addr). -fn render-line screen: (addr screen), functions: (addr handle function), bindings: (addr table), first-line: (addr line), _line: (addr line), expanded-words: (addr handle call-path), top-row: int, left-col: int, curr-path: (addr handle call-path-element), cursor-word: (addr word), cursor-call-path: (addr handle call-path-element), cursor-row-addr: (addr int), cursor-col-addr: (addr int) -> _/ecx: int { -#? print-string 0, "render-line\n" -#? dump-table bindings - # curr-word - var line/esi: (addr line) <- copy _line - var first-word-ah/eax: (addr handle word) <- get line, data - var curr-word/eax: (addr word) <- lookup *first-word-ah - # - # loop-carried dependency - var curr-col/ecx: int <- copy left-col - # - { - compare curr-word, 0 - break-if-= -#? print-string 0, "-- word " -#? print-word 0, curr-word -#? print-string 0, "\n" - # if necessary, first render columns for subsidiary stack - $render-line:subsidiary: { - { -#? print-string 0, "check sub\n" - var display-subsidiary-stack?/eax: boolean <- find-in-call-paths expanded-words, curr-path - compare display-subsidiary-stack?, 0/false - break-if-= $render-line:subsidiary - } -#? print-string 0, "render subsidiary stack\n" - # does function exist? - var callee/edi: (addr function) <- copy 0 - { - var callee-h: (handle function) - var callee-ah/ecx: (addr handle function) <- address callee-h - callee functions, curr-word, callee-ah - var _callee/eax: (addr function) <- lookup *callee-ah - callee <- copy _callee - compare callee, 0 - break-if-= $render-line:subsidiary - } - move-cursor screen, top-row, curr-col - start-color screen, 8, 7 - print-word screen, curr-word - { - var word-len/eax: int <- word-length curr-word - curr-col <- add word-len - curr-col <- add 2 - increment top-row - } - # obtain stack at call site - var stack-storage: value-stack - var stack/edx: (addr value-stack) <- address stack-storage - initialize-value-stack stack, 0x10 - { - var prev-word-ah/eax: (addr handle word) <- get curr-word, prev - var prev-word/eax: (addr word) <- lookup *prev-word-ah - compare prev-word, 0 - break-if-= - var bindings2-storage: table - var bindings2/ebx: (addr table) <- address bindings2-storage - deep-copy-table bindings, bindings2 - evaluate functions, bindings2, first-line, prev-word, stack - } - # construct new bindings - var callee-bindings-storage: table - var callee-bindings/esi: (addr table) <- address callee-bindings-storage - initialize-table callee-bindings, 0x10 - bind-args callee, stack, callee-bindings - # obtain body - var callee-body-ah/eax: (addr handle line) <- get callee, body - var callee-body/eax: (addr line) <- lookup *callee-body-ah - var callee-body-first-word/edx: (addr handle word) <- get callee-body, data - # - render subsidiary stack - push-to-call-path-element curr-path, callee-body-first-word # leak -#? print-string 0, "subsidiary {\n" -#? dump-table callee-bindings -#? syscall_exit - curr-col <- render-line screen, functions, callee-bindings, callee-body, callee-body, expanded-words, top-row, curr-col, curr-path, cursor-word, cursor-call-path, cursor-row-addr, cursor-col-addr -#? print-string 0, "}\n" - drop-from-call-path-element curr-path - # - move-cursor screen, top-row, curr-col - print-code-point screen, 0x21d7/⇗ - # - curr-col <- add 2 - decrement top-row - } - # render main column - var old-col/edx: int <- copy curr-col - var bindings2-storage: table - var bindings2/ebx: (addr table) <- address bindings2-storage -#? print-string 0, "deep-copy {\n" - deep-copy-table bindings, bindings2 -#? print-string 0, "}\n" -#? print-string 0, "render column {\n" - curr-col <- render-column screen, functions, bindings2, first-line, line, curr-word, top-row, curr-col -#? print-string 0, "}\n" - # cache cursor column if necessary - $render-line:cache-cursor-column: { - { - var found?/eax: boolean <- call-path-element-match? curr-path, cursor-call-path - compare found?, 0/false - break-if-= $render-line:cache-cursor-column - } - var dest/edi: (addr int) <- copy cursor-row-addr - { - var src/eax: int <- copy top-row - copy-to *dest, src - } - dest <- copy cursor-col-addr - copy-to *dest, old-col - var cursor-index-in-word/eax: int <- cursor-index curr-word - add-to *dest, cursor-index-in-word - } - # loop update -#? print-string 0, "next word\n" - var next-word-ah/edx: (addr handle word) <- get curr-word, next - curr-word <- lookup *next-word-ah -#? { -#? var foo/eax: int <- copy curr-word -#? print-int32-hex 0, foo -#? print-string 0, "\n" -#? } - increment-final-element curr-path - loop - } - return curr-col -} - -fn callee functions: (addr handle function), word: (addr word), out: (addr handle function) { - var stream-storage: (stream byte 0x10) - var stream/esi: (addr stream byte) <- address stream-storage - emit-word word, stream - find-function functions, stream, out -} - -# Render: -# - starting at top-row, left-col: final-word -# - starting somewhere below at left-col: the stack result from interpreting first-world to final-word (inclusive) -# -# Return the farthest column written. -fn render-column screen: (addr screen), functions: (addr handle function), bindings: (addr table), first-line: (addr line), line: (addr line), final-word: (addr word), top-row: int, left-col: int -> _/ecx: int { -#? print-string 0, "render-column\n" -#? dump-table bindings - var max-width/esi: int <- copy 0 - { - # compute stack - var stack: value-stack - var stack-addr/edi: (addr value-stack) <- address stack - initialize-value-stack stack-addr, 0x10/max-words - # copy bindings - var bindings2-storage: table - var bindings2/ebx: (addr table) <- address bindings2-storage -#? print-string 0, "deep copy table {\n" - deep-copy-table bindings, bindings2 -#? print-string 0, "}\n" - evaluate functions, bindings2, first-line, final-word, stack-addr - # indent stack - var indented-col/ebx: int <- copy left-col - indented-col <- add 1/margin-right - # render stack - var curr-row/edx: int <- copy top-row - curr-row <- add 2/stack-margin-top - { - var top-addr/ecx: (addr int) <- get stack-addr, top - compare *top-addr, 0 - break-if-<= - decrement *top-addr - var data-ah/eax: (addr handle array value) <- get stack-addr, data - var data/eax: (addr array value) <- lookup *data-ah - var top/ecx: int <- copy *top-addr - var dest-offset/ecx: (offset value) <- compute-offset data, top - var val/eax: (addr value) <- index data, dest-offset - render-value-at screen, curr-row, indented-col, val, 1/top-level=true - { - var width/eax: int <- value-width val, 1 - compare width, max-width - break-if-<= - max-width <- copy width - } - var height/eax: int <- value-height val - curr-row <- add height - loop - } - } - - max-width <- add 2 # spaces on either side of items on the stack - - # render word, initialize result - reset-formatting screen - move-cursor screen, top-row, left-col - print-word screen, final-word - { - var width/eax: int <- word-length final-word - compare width, max-width - break-if-<= - max-width <- copy width - } - - # post-process right-col - var right-col/ecx: int <- copy left-col - right-col <- add max-width - right-col <- add 1/margin-right -#? print-int32-decimal 0, left-col -#? print-string 0, " => " -#? print-int32-decimal 0, right-col -#? print-string 0, "\n" - return right-col -} - -fn render-function-menu _env: (addr environment) { - var env/esi: (addr environment) <- copy _env - var screen-ah/edi: (addr handle screen) <- get env, screen - var _screen/eax: (addr screen) <- lookup *screen-ah - var screen/edi: (addr screen) <- copy _screen - var nrows/eax: (addr int) <- get env, nrows - move-cursor screen, *nrows, 0 - start-reverse-video screen - print-string screen, " ctrl-q " - reset-formatting screen - print-string screen, " quit " - start-reverse-video screen - print-string screen, " ctrl-a " - reset-formatting screen - print-string screen, " ⏮ " - start-reverse-video screen - print-string screen, " ctrl-b " - reset-formatting screen - print-string screen, " ◀ word " - start-reverse-video screen - print-string screen, " ctrl-f " - reset-formatting screen - print-string screen, " word ▶ " - start-reverse-video screen - print-string screen, " ctrl-e " - reset-formatting screen - print-string screen, " ⏭ " - start-reverse-video screen - print-string screen, " ctrl-g " - reset-formatting screen - print-string screen, " go to function " - start-reverse-video screen - print-string screen, " tab " - reset-formatting screen - print-string screen, " go to sandbox" -} - -fn render-sandbox-menu _env: (addr environment) { - var env/esi: (addr environment) <- copy _env - var screen-ah/edi: (addr handle screen) <- get env, screen - var _screen/eax: (addr screen) <- lookup *screen-ah - var screen/edi: (addr screen) <- copy _screen - var nrows/eax: (addr int) <- get env, nrows - move-cursor screen, *nrows, 0 - start-reverse-video screen - print-string screen, " ctrl-q " - reset-formatting screen - print-string screen, " quit " - start-reverse-video screen - print-string screen, " ctrl-a " - reset-formatting screen - print-string screen, " ⏮ " - start-reverse-video screen - print-string screen, " ctrl-b " - reset-formatting screen - print-string screen, " ◀ word " - start-reverse-video screen - print-string screen, " ctrl-f " - reset-formatting screen - print-string screen, " word ▶ " - start-reverse-video screen - print-string screen, " ctrl-e " - reset-formatting screen - print-string screen, " ⏭ " - start-reverse-video screen - print-string screen, " ctrl-g " - reset-formatting screen - print-string screen, " go to function " - start-reverse-video screen - print-string screen, " ctrl-l " - reset-formatting screen - print-string screen, " new line " - start-reverse-video screen - print-string screen, " ctrl-u " - reset-formatting screen - print-string screen, " clear " - start-reverse-video screen - print-string screen, " ctrl-n " - reset-formatting screen - print-string screen, " name word " - start-reverse-video screen - print-string screen, " ctrl-d " - reset-formatting screen - print-string screen, " define function" -} - -fn clear-canvas _env: (addr environment) { - var env/esi: (addr environment) <- copy _env - var screen-ah/edi: (addr handle screen) <- get env, screen - var _screen/eax: (addr screen) <- lookup *screen-ah - var screen/edi: (addr screen) <- copy _screen - clear-screen screen - var nrows/eax: (addr int) <- get env, nrows - var sep-col/ecx: (addr int) <- get env, code-separator-col - # divider - draw-vertical-line screen, 1, *nrows, *sep-col - # primitives - var dummy/eax: int <- render-primitives screen, *nrows, *sep-col -} - -# return value: top-most row written to -fn render-primitives screen: (addr screen), bottom-margin-row: int, right-col: int -> _/eax: int { - # render primitives from the bottom of the screen upward - var row/ecx: int <- copy bottom-margin-row - row <- subtract 1 - var col/edx: int <- copy 1 - move-cursor screen, row, col - row, col <- render-primitive-group screen, row, col, right-col, "numbers: ", "+ - * / sqrt " - row, col <- render-primitive-group screen, row, col, right-col, "arrays: ", "len " - row, col <- render-primitive-group screen, row, col, right-col, "files: ", "open read slurp lines " - row, col <- render-primitive-group screen, row, col, right-col, "misc: ", "dup swap " # hack: keep these at the right of the bottom row - row, col <- render-primitive-group screen, row, col, right-col, "screens: ", "fake-screen print move up down left right " - # finally print heading up top - row <- decrement - move-cursor screen, row, 1 - start-bold screen - print-string screen, "primitives:" - reset-formatting screen - return row -} - -# start at row, col and print the given strings -# move up one row if there isn't enough room before right-col -# return row, col printed until -fn render-primitive-group screen: (addr screen), _row: int, _col: int, right-col: int, _heading: (addr array byte), _contents: (addr array byte) -> _/ecx: int, _/edx: int { - var row/ecx: int <- copy _row - var col/edx: int <- copy _col - # decrement row if necessary - var new-col/ebx: int <- copy col - var heading/esi: (addr array byte) <- copy _heading - var len1/eax: int <- length heading - new-col <- add len1 - var contents/edi: (addr array byte) <- copy _contents - var len2/eax: int <- length contents - new-col <- add len2 - var bound/eax: int <- copy right-col - bound <- decrement - { - compare new-col, bound - break-if-<= - row <- decrement - col <- copy 1 - } - move-cursor screen, row, col - start-color screen, 0xf6, 7 - print-string screen, heading - reset-formatting screen - print-string screen, contents - return row, new-col -} - -fn render-functions screen: (addr screen), right-col: int, _env: (addr environment) { - var row/ecx: int <- copy 1 - var dummy-col/edx: int <- copy right-col - var env/esi: (addr environment) <- copy _env - var functions/esi: (addr handle function) <- get env, functions - { - var curr/eax: (addr function) <- lookup *functions - compare curr, 0 - break-if-= - row, dummy-col <- render-function-right-aligned screen, row, right-col, curr - functions <- get curr, next - row <- add 1/inter-function-margin - loop - } -} - -# print function starting at row, right-aligned before right-col -# return row, col printed until -fn render-function-right-aligned screen: (addr screen), row: int, right-col: int, f: (addr function) -> _/ecx: int, _/edx: int { - var col/edx: int <- copy right-col - col <- subtract 1/function-right-margin - var col2/ebx: int <- copy col - var width/eax: int <- function-width f - col <- subtract width - var new-row/ecx: int <- copy row - var height/eax: int <- function-height f - new-row <- add height - new-row <- decrement - col <- subtract 1/function-left-padding - start-color screen, 0, 0xf7 - clear-rect screen, row, col, new-row, col2 - col <- add 1 -#? var dummy/eax: grapheme <- read-key-from-real-keyboard - render-function screen, row, col, f - new-row <- add 1/function-bottom-margin - col <- subtract 1/function-left-padding - col <- subtract 1/function-left-margin - reset-formatting screen - return new-row, col -} - -# render function starting at row, col -# only single-line functions supported for now -fn render-function screen: (addr screen), row: int, col: int, _f: (addr function) { - var f/esi: (addr function) <- copy _f - var args/ecx: (addr handle word) <- get f, args - move-cursor screen, row, col - print-words-in-reverse screen, args - var name-ah/eax: (addr handle array byte) <- get f, name - var name/eax: (addr array byte) <- lookup *name-ah - start-bold screen - print-string screen, name - reset-formatting screen - start-color screen, 0, 0xf7 - increment row - add-to col, 2 - move-cursor screen, row, col - print-string screen, "≡ " - add-to col, 2 - var cursor-row/ecx: (addr int) <- get f, cursor-row - var cursor-col/edx: (addr int) <- get f, cursor-col - var cursor-word-ah/eax: (addr handle word) <- get f, cursor-word - var _cursor-word/eax: (addr word) <- lookup *cursor-word-ah - var cursor-word/ebx: (addr word) <- copy _cursor-word - var body-ah/eax: (addr handle line) <- get f, body - var body/eax: (addr line) <- lookup *body-ah - render-line-without-stack screen, body, row, col, cursor-word, cursor-row, cursor-col -} - -fn real-grapheme? g: grapheme -> _/eax: boolean { - # if g == newline return true - compare g, 0xa - { - break-if-!= - return 1/true - } - # if g == tab return true - compare g, 9 - { - break-if-!= - return 1/true - } - # if g < 32 return false - compare g, 0x20 - { - break-if->= - return 0/false - } - # if g <= 255 return true - compare g, 0xff - { - break-if-> - return 1/true - } - # if (g&0xff == Esc) it's an escape sequence - and-with g, 0xff - compare g, 0x1b/esc - { - break-if-!= - return 0/false - } - # otherwise return true - return 1/true -} diff --git a/apps/tile/float-stack.mu b/apps/tile/float-stack.mu deleted file mode 100644 index 146995e7..00000000 --- a/apps/tile/float-stack.mu +++ /dev/null @@ -1,64 +0,0 @@ -type float-stack { - data: (handle array float) - top: int -} - -fn initialize-float-stack _self: (addr float-stack), n: int { - var self/esi: (addr float-stack) <- copy _self - var d/edi: (addr handle array float) <- get self, data - populate d, n - var top/eax: (addr int) <- get self, top - copy-to *top, 0 -} - -fn clear-float-stack _self: (addr float-stack) { - var self/esi: (addr float-stack) <- copy _self - var top/eax: (addr int) <- get self, top - copy-to *top, 0 -} - -fn push-float-stack _self: (addr float-stack), _val: float { - var self/esi: (addr float-stack) <- copy _self - var top-addr/ecx: (addr int) <- get self, top - var data-ah/edx: (addr handle array float) <- get self, data - var data/eax: (addr array float) <- lookup *data-ah - var top/edx: int <- copy *top-addr - var dest-addr/edx: (addr float) <- index data, top - var val/xmm0: float <- copy _val - copy-to *dest-addr, val - add-to *top-addr, 1 -} - -fn pop-float-stack _self: (addr float-stack) -> _/xmm0: float { - var self/esi: (addr float-stack) <- copy _self - var top-addr/ecx: (addr int) <- get self, top - { - compare *top-addr, 0 - break-if-> - var zero: float - return zero - } - subtract-from *top-addr, 1 - var data-ah/edx: (addr handle array float) <- get self, data - var data/eax: (addr array float) <- lookup *data-ah - var top/edx: int <- copy *top-addr - var result-addr/eax: (addr float) <- index data, top - return *result-addr -} - -fn float-stack-empty? _self: (addr float-stack) -> _/eax: boolean { - var self/esi: (addr float-stack) <- copy _self - var top-addr/eax: (addr int) <- get self, top - compare *top-addr, 0 - { - break-if-!= - return 1/true - } - return 0/false -} - -fn float-stack-length _self: (addr float-stack) -> _/eax: int { - var self/esi: (addr float-stack) <- copy _self - var top-addr/eax: (addr int) <- get self, top - return *top-addr -} diff --git a/apps/tile/gap-buffer.mu b/apps/tile/gap-buffer.mu deleted file mode 100644 index 0132daf0..00000000 --- a/apps/tile/gap-buffer.mu +++ /dev/null @@ -1,343 +0,0 @@ -type gap-buffer { - left: grapheme-stack - right: grapheme-stack -} - -fn initialize-gap-buffer _self: (addr gap-buffer) { - var self/esi: (addr gap-buffer) <- copy _self - var left/eax: (addr grapheme-stack) <- get self, left - initialize-grapheme-stack left, 0x10/max-word-size - var right/eax: (addr grapheme-stack) <- get self, right - initialize-grapheme-stack right, 0x10/max-word-size -} - -# just for tests -fn initialize-gap-buffer-with self: (addr gap-buffer), s: (addr array byte) { - initialize-gap-buffer self - var stream-storage: (stream byte 0x10/max-word-size) - var stream/ecx: (addr stream byte) <- address stream-storage - write stream, s - { - var done?/eax: boolean <- stream-empty? stream - compare done?, 0/false - break-if-!= - var g/eax: grapheme <- read-grapheme stream - add-grapheme-at-gap self, g - loop - } -} - -fn gap-buffer-to-string self: (addr gap-buffer), out: (addr handle array byte) { - var s-storage: (stream byte 0x100) - var s/ecx: (addr stream byte) <- address s-storage - emit-gap-buffer self, s - stream-to-array s, out -} - -fn emit-gap-buffer _self: (addr gap-buffer), out: (addr stream byte) { - var self/esi: (addr gap-buffer) <- copy _self - clear-stream out - var left/eax: (addr grapheme-stack) <- get self, left - emit-stack-from-bottom left, out - var right/eax: (addr grapheme-stack) <- get self, right - emit-stack-from-top right, out -} - -# dump stack from bottom to top -fn emit-stack-from-bottom _self: (addr grapheme-stack), out: (addr stream byte) { - var self/esi: (addr grapheme-stack) <- copy _self - var data-ah/edi: (addr handle array grapheme) <- get self, data - var _data/eax: (addr array grapheme) <- lookup *data-ah - var data/edi: (addr array grapheme) <- copy _data - var top-addr/ecx: (addr int) <- get self, top - var i/eax: int <- copy 0 - { - compare i, *top-addr - break-if->= - var g/edx: (addr grapheme) <- index data, i - write-grapheme out, *g - i <- increment - loop - } -} - -# dump stack from top to bottom -fn emit-stack-from-top _self: (addr grapheme-stack), out: (addr stream byte) { - var self/esi: (addr grapheme-stack) <- copy _self - var data-ah/edi: (addr handle array grapheme) <- get self, data - var _data/eax: (addr array grapheme) <- lookup *data-ah - var data/edi: (addr array grapheme) <- copy _data - var top-addr/ecx: (addr int) <- get self, top - var i/eax: int <- copy *top-addr - i <- decrement - { - compare i, 0 - break-if-< - var g/edx: (addr grapheme) <- index data, i - write-grapheme out, *g - i <- decrement - loop - } -} - -fn render-gap-buffer screen: (addr screen), _gap: (addr gap-buffer) { - var gap/esi: (addr gap-buffer) <- copy _gap - var left/eax: (addr grapheme-stack) <- get gap, left - render-stack-from-bottom left, screen - var right/eax: (addr grapheme-stack) <- get gap, right - render-stack-from-top right, screen -} - -fn gap-buffer-length _gap: (addr gap-buffer) -> _/eax: int { - var gap/esi: (addr gap-buffer) <- copy _gap - var left/eax: (addr grapheme-stack) <- get gap, left - var tmp/eax: (addr int) <- get left, top - var left-length/ecx: int <- copy *tmp - var right/esi: (addr grapheme-stack) <- get gap, right - tmp <- get right, top - var result/eax: int <- copy *tmp - result <- add left-length - return result -} - -fn add-grapheme-at-gap _self: (addr gap-buffer), g: grapheme { - var self/esi: (addr gap-buffer) <- copy _self - var left/eax: (addr grapheme-stack) <- get self, left - push-grapheme-stack left, g -} - -fn gap-to-start self: (addr gap-buffer) { - { - var curr/eax: grapheme <- gap-left self - compare curr, -1 - loop-if-!= - } -} - -fn gap-to-end self: (addr gap-buffer) { - { - var curr/eax: grapheme <- gap-right self - compare curr, -1 - loop-if-!= - } -} - -fn gap-at-start? _self: (addr gap-buffer) -> _/eax: boolean { - var self/esi: (addr gap-buffer) <- copy _self - var left/eax: (addr grapheme-stack) <- get self, left - var result/eax: boolean <- grapheme-stack-empty? left - return result -} - -fn gap-at-end? _self: (addr gap-buffer) -> _/eax: boolean { - var self/esi: (addr gap-buffer) <- copy _self - var right/eax: (addr grapheme-stack) <- get self, right - var result/eax: boolean <- grapheme-stack-empty? right - return result -} - -fn gap-right _self: (addr gap-buffer) -> _/eax: grapheme { - var self/esi: (addr gap-buffer) <- copy _self - var g/eax: grapheme <- copy 0 - var right/ecx: (addr grapheme-stack) <- get self, right - g <- pop-grapheme-stack right - compare g, -1 - { - break-if-= - var left/ecx: (addr grapheme-stack) <- get self, left - push-grapheme-stack left, g - } - return g -} - -fn gap-left _self: (addr gap-buffer) -> _/eax: grapheme { - var self/esi: (addr gap-buffer) <- copy _self - var g/eax: grapheme <- copy 0 - { - var left/ecx: (addr grapheme-stack) <- get self, left - g <- pop-grapheme-stack left - } - compare g, -1 - { - break-if-= - var right/ecx: (addr grapheme-stack) <- get self, right - push-grapheme-stack right, g - } - return g -} - -fn gap-index _self: (addr gap-buffer) -> _/eax: int { - var self/eax: (addr gap-buffer) <- copy _self - var left/eax: (addr grapheme-stack) <- get self, left - var top-addr/eax: (addr int) <- get left, top - var result/eax: int <- copy *top-addr - return result -} - -fn first-grapheme-in-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { - var self/esi: (addr gap-buffer) <- copy _self - # try to read from left - var left/eax: (addr grapheme-stack) <- get self, left - var top-addr/ecx: (addr int) <- get left, top - compare *top-addr, 0 - { - break-if-<= - var data-ah/eax: (addr handle array grapheme) <- get left, data - var data/eax: (addr array grapheme) <- lookup *data-ah - var result-addr/eax: (addr grapheme) <- index data, 0 - return *result-addr - } - # try to read from right - var right/eax: (addr grapheme-stack) <- get self, right - top-addr <- get right, top - compare *top-addr, 0 - { - break-if-<= - var data-ah/eax: (addr handle array grapheme) <- get right, data - var data/eax: (addr array grapheme) <- lookup *data-ah - var top/ecx: int <- copy *top-addr - top <- decrement - var result-addr/eax: (addr grapheme) <- index data, top - return *result-addr - } - # give up - return -1 -} - -fn grapheme-before-cursor-in-gap-buffer _self: (addr gap-buffer) -> _/eax: grapheme { - var self/esi: (addr gap-buffer) <- copy _self - # try to read from left - var left/ecx: (addr grapheme-stack) <- get self, left - var top-addr/edx: (addr int) <- get left, top - compare *top-addr, 0 - { - break-if-<= - var result/eax: grapheme <- pop-grapheme-stack left - push-grapheme-stack left, result - return result - } - # give up - return -1 -} - -fn delete-before-gap _self: (addr gap-buffer) { - var self/eax: (addr gap-buffer) <- copy _self - var left/eax: (addr grapheme-stack) <- get self, left - var dummy/eax: grapheme <- pop-grapheme-stack left -} - -fn pop-after-gap _self: (addr gap-buffer) -> _/eax: grapheme { - var self/eax: (addr gap-buffer) <- copy _self - var right/eax: (addr grapheme-stack) <- get self, right - var result/eax: grapheme <- pop-grapheme-stack right - return result -} - -fn gap-buffer-equal? _self: (addr gap-buffer), s: (addr array byte) -> _/eax: boolean { - var self/esi: (addr gap-buffer) <- copy _self - # complication: graphemes may be multiple bytes - # so don't rely on length - # instead turn the expected result into a stream and arrange to read from it in order - var stream-storage: (stream byte 0x10/max-word-size) - var expected-stream/ecx: (addr stream byte) <- address stream-storage - write expected-stream, s - # compare left - var left/edx: (addr grapheme-stack) <- get self, left - var result/eax: boolean <- prefix-match? left, expected-stream - compare result, 0/false - { - break-if-!= - return result - } - # compare right - var right/edx: (addr grapheme-stack) <- get self, right - result <- suffix-match? right, expected-stream - compare result, 0/false - { - break-if-!= - return result - } - # ensure there's nothing left over - result <- stream-empty? expected-stream - return result -} - -fn test-gap-buffer-equal-from-end? { - var _g: gap-buffer - var g/esi: (addr gap-buffer) <- address _g - initialize-gap-buffer g - # - var c/eax: grapheme <- copy 0x61/a - add-grapheme-at-gap g, c - add-grapheme-at-gap g, c - add-grapheme-at-gap g, c - # gap is at end (right is empty) - var _result/eax: boolean <- gap-buffer-equal? g, "aaa" - var result/eax: int <- copy _result - check-ints-equal result, 1, "F - test-gap-buffer-equal-from-end?" -} - -fn test-gap-buffer-equal-from-middle? { - var _g: gap-buffer - var g/esi: (addr gap-buffer) <- address _g - initialize-gap-buffer g - # - var c/eax: grapheme <- copy 0x61/a - add-grapheme-at-gap g, c - add-grapheme-at-gap g, c - add-grapheme-at-gap g, c - var dummy/eax: grapheme <- gap-left g - # gap is in the middle - var _result/eax: boolean <- gap-buffer-equal? g, "aaa" - var result/eax: int <- copy _result - check-ints-equal result, 1, "F - test-gap-buffer-equal-from-middle?" -} - -fn test-gap-buffer-equal-from-start? { - var _g: gap-buffer - var g/esi: (addr gap-buffer) <- address _g - initialize-gap-buffer g - # - var c/eax: grapheme <- copy 0x61/a - add-grapheme-at-gap g, c - add-grapheme-at-gap g, c - add-grapheme-at-gap g, c - var dummy/eax: grapheme <- gap-left g - dummy <- gap-left g - dummy <- gap-left g - # gap is at the start - var _result/eax: boolean <- gap-buffer-equal? g, "aaa" - var result/eax: int <- copy _result - check-ints-equal result, 1, "F - test-gap-buffer-equal-from-start?" -} - -fn copy-gap-buffer _src-ah: (addr handle gap-buffer), _dest-ah: (addr handle gap-buffer) { - # obtain src-a, dest-a - var src-ah/eax: (addr handle gap-buffer) <- copy _src-ah - var _src-a/eax: (addr gap-buffer) <- lookup *src-ah - var src-a/esi: (addr gap-buffer) <- copy _src-a - var dest-ah/eax: (addr handle gap-buffer) <- copy _dest-ah - var _dest-a/eax: (addr gap-buffer) <- lookup *dest-ah - var dest-a/edi: (addr gap-buffer) <- copy _dest-a - # copy left grapheme-stack - var src/ecx: (addr grapheme-stack) <- get src-a, left - var dest/edx: (addr grapheme-stack) <- get dest-a, left - copy-grapheme-stack src, dest - # copy right grapheme-stack - src <- get src-a, right - dest <- get dest-a, right - copy-grapheme-stack src, dest -} - -fn gap-buffer-is-decimal-integer? _self: (addr gap-buffer) -> _/eax: boolean { - var self/esi: (addr gap-buffer) <- copy _self - var curr/ecx: (addr grapheme-stack) <- get self, left - var result/eax: boolean <- grapheme-stack-is-decimal-integer? curr - { - compare result, 0/false - break-if-= - curr <- get self, right - result <- grapheme-stack-is-decimal-integer? curr - } - return result -} diff --git a/apps/tile/grapheme-stack.mu b/apps/tile/grapheme-stack.mu deleted file mode 100644 index e0d40ecc..00000000 --- a/apps/tile/grapheme-stack.mu +++ /dev/null @@ -1,191 +0,0 @@ -type grapheme-stack { - data: (handle array grapheme) - top: int -} - -fn initialize-grapheme-stack _self: (addr grapheme-stack), n: int { - var self/esi: (addr grapheme-stack) <- copy _self - var d/edi: (addr handle array grapheme) <- get self, data - populate d, n - var top/eax: (addr int) <- get self, top - copy-to *top, 0 -} - -fn clear-grapheme-stack _self: (addr grapheme-stack) { - var self/esi: (addr grapheme-stack) <- copy _self - var top/eax: (addr int) <- get self, top - copy-to *top, 0 -} - -fn grapheme-stack-empty? _self: (addr grapheme-stack) -> _/eax: boolean { - var self/esi: (addr grapheme-stack) <- copy _self - var top/eax: (addr int) <- get self, top - compare *top, 0 - { - break-if-!= - return 1/true - } - return 0/false -} - -fn push-grapheme-stack _self: (addr grapheme-stack), _val: grapheme { - var self/esi: (addr grapheme-stack) <- copy _self - var top-addr/ecx: (addr int) <- get self, top - var data-ah/edx: (addr handle array grapheme) <- get self, data - var data/eax: (addr array grapheme) <- lookup *data-ah - var top/edx: int <- copy *top-addr - var dest-addr/edx: (addr grapheme) <- index data, top - var val/eax: grapheme <- copy _val - copy-to *dest-addr, val - add-to *top-addr, 1 -} - -fn pop-grapheme-stack _self: (addr grapheme-stack) -> _/eax: grapheme { - var self/esi: (addr grapheme-stack) <- copy _self - var top-addr/ecx: (addr int) <- get self, top - { - compare *top-addr, 0 - break-if-> - return -1 - } - subtract-from *top-addr, 1 - var data-ah/edx: (addr handle array grapheme) <- get self, data - var data/eax: (addr array grapheme) <- lookup *data-ah - var top/edx: int <- copy *top-addr - var result-addr/eax: (addr grapheme) <- index data, top - return *result-addr -} - -fn copy-grapheme-stack _src: (addr grapheme-stack), dest: (addr grapheme-stack) { - var src/esi: (addr grapheme-stack) <- copy _src - var data-ah/edi: (addr handle array grapheme) <- get src, data - var _data/eax: (addr array grapheme) <- lookup *data-ah - var data/edi: (addr array grapheme) <- copy _data - var top-addr/ecx: (addr int) <- get src, top - var i/eax: int <- copy 0 - { - compare i, *top-addr - break-if->= - var g/edx: (addr grapheme) <- index data, i - push-grapheme-stack dest, *g - i <- increment - loop - } -} - -# dump stack to screen from bottom to top -# don't move the cursor or anything -fn render-stack-from-bottom _self: (addr grapheme-stack), screen: (addr screen) { - var self/esi: (addr grapheme-stack) <- copy _self - var data-ah/edi: (addr handle array grapheme) <- get self, data - var _data/eax: (addr array grapheme) <- lookup *data-ah - var data/edi: (addr array grapheme) <- copy _data - var top-addr/ecx: (addr int) <- get self, top - var i/eax: int <- copy 0 - { - compare i, *top-addr - break-if->= - var g/edx: (addr grapheme) <- index data, i - print-grapheme screen, *g - i <- increment - loop - } -} - -# dump stack to screen from top to bottom -# don't move the cursor or anything -fn render-stack-from-top _self: (addr grapheme-stack), screen: (addr screen) { - var self/esi: (addr grapheme-stack) <- copy _self - var data-ah/edi: (addr handle array grapheme) <- get self, data - var _data/eax: (addr array grapheme) <- lookup *data-ah - var data/edi: (addr array grapheme) <- copy _data - var top-addr/ecx: (addr int) <- get self, top - var i/eax: int <- copy *top-addr - i <- decrement - { - compare i, 0 - break-if-< - var g/edx: (addr grapheme) <- index data, i - print-grapheme screen, *g - i <- decrement - loop - } -} - -# compare from bottom -# beware: modifies 'stream', which must be disposed of after a false result -fn prefix-match? _self: (addr grapheme-stack), s: (addr stream byte) -> _/eax: boolean { - var self/esi: (addr grapheme-stack) <- copy _self - var data-ah/edi: (addr handle array grapheme) <- get self, data - var _data/eax: (addr array grapheme) <- lookup *data-ah - var data/edi: (addr array grapheme) <- copy _data - var top-addr/ecx: (addr int) <- get self, top - var i/ebx: int <- copy 0 - { - compare i, *top-addr - break-if->= - # if curr != expected, return false - { - var curr-a/edx: (addr grapheme) <- index data, i - var expected/eax: grapheme <- read-grapheme s - { - compare expected, *curr-a - break-if-= - return 0/false - } - } - i <- increment - loop - } - return 1 # true -} - -# compare from bottom -# beware: modifies 'stream', which must be disposed of after a false result -fn suffix-match? _self: (addr grapheme-stack), s: (addr stream byte) -> _/eax: boolean { - var self/esi: (addr grapheme-stack) <- copy _self - var data-ah/edi: (addr handle array grapheme) <- get self, data - var _data/eax: (addr array grapheme) <- lookup *data-ah - var data/edi: (addr array grapheme) <- copy _data - var top-addr/eax: (addr int) <- get self, top - var i/ebx: int <- copy *top-addr - i <- decrement - { - compare i, 0 - break-if-< - { - var curr-a/edx: (addr grapheme) <- index data, i - var expected/eax: grapheme <- read-grapheme s - # if curr != expected, return false - { - compare expected, *curr-a - break-if-= - return 0/false - } - } - i <- decrement - loop - } - return 1 # true -} - -fn grapheme-stack-is-decimal-integer? _self: (addr grapheme-stack) -> _/eax: boolean { - var self/esi: (addr grapheme-stack) <- copy _self - var data-ah/eax: (addr handle array grapheme) <- get self, data - var _data/eax: (addr array grapheme) <- lookup *data-ah - var data/edx: (addr array grapheme) <- copy _data - var top-addr/ecx: (addr int) <- get self, top - var i/ebx: int <- copy 0 - var result/eax: boolean <- copy 1/true - $grapheme-stack-is-integer?:loop: { - compare i, *top-addr - break-if->= - var g/edx: (addr grapheme) <- index data, i - result <- is-decimal-digit? *g - compare result, 0/false - break-if-= - i <- increment - loop - } - return result -} diff --git a/apps/tile/main.mu b/apps/tile/main.mu deleted file mode 100644 index e0daaf1b..00000000 --- a/apps/tile/main.mu +++ /dev/null @@ -1,133 +0,0 @@ -fn main args-on-stack: (addr array addr array byte) -> _/ebx: int { - var args/eax: (addr array addr array byte) <- copy args-on-stack - var len/ecx: int <- length args - compare len, 2 - { - break-if-!= - # if single arg is 'test', run tests - var tmp/ecx: (addr addr array byte) <- index args, 1 - var tmp2/eax: boolean <- string-equal? *tmp, "test" - compare tmp2, 0/false - { - break-if-= - run-tests - return 0 # TODO: get at Num-test-failures somehow - } - # if single arg is 'screen', run in full-screen mode - tmp2 <- string-equal? *tmp, "screen" - compare tmp2, 0/false - { - break-if-= - interactive - return 0 - } - # if single arg is 'type', run in typewriter mode - tmp2 <- string-equal? *tmp, "type" - compare tmp2, 0/false - { - break-if-= - repl - return 0 - } - # if single arg is 'test' ... - tmp2 <- string-equal? *tmp, "test2" - compare tmp2, 0/false - { - break-if-= - test - return 0 - } - } - # otherwise error message - print-string-to-real-screen "usage:\n" - print-string-to-real-screen " to run tests: tile test\n" - print-string-to-real-screen " full-screen mode: tile screen\n" - print-string-to-real-screen " regular REPL: tile type\n" - return 1 -} - -fn interactive { - enable-screen-grid-mode - enable-keyboard-immediate-mode - var env-storage: environment - var env/esi: (addr environment) <- address env-storage - initialize-environment env - { - render env - var key/eax: grapheme <- read-key-from-real-keyboard - compare key, 0x11/ctrl-q - break-if-= - process env, key - loop - } - enable-keyboard-type-mode - enable-screen-type-mode -} - -fn test { - var env-storage: environment - var env/esi: (addr environment) <- address env-storage - initialize-environment-with-fake-screen env, 0x20, 0xa0 - render env -} - -fn process-all env: (addr environment), cmds: (addr array byte) { - var cmds-stream: (stream byte 0x100) - var cmds-stream-a/esi: (addr stream byte) <- address cmds-stream - write cmds-stream-a, cmds - { - var done?/eax: boolean <- stream-empty? cmds-stream-a - compare done?, 0/false - break-if-!= - var g/eax: grapheme <- read-grapheme cmds-stream-a - process env, g - loop - } -} - -fn repl { - { - # prompt - print-string-to-real-screen "> " - # read - var line-storage: (stream byte 0x100) - var line/ecx: (addr stream byte) <- address line-storage - clear-stream line - read-line-from-real-keyboard line - var done?/eax: boolean <- stream-empty? line - compare done?, 0/false - break-if-!= - # parse - var env-storage: environment - var env/esi: (addr environment) <- address env-storage - initialize-environment env - { - var done?/eax: boolean <- stream-empty? line - compare done?, 0/false - break-if-!= - var g/eax: grapheme <- read-grapheme line - process env, g - loop - } - # eval - var stack-storage: value-stack - var stack/edi: (addr value-stack) <- address stack-storage - initialize-value-stack stack, 0x10 - evaluate-environment env, stack - # print - var empty?/eax: boolean <- value-stack-empty? stack - { - compare empty?, 0/false - break-if-!= - var result/xmm0: float <- pop-number-from-value-stack stack - print-float-decimal-approximate 0, result, 3 - print-string 0, "\n" - print-string 0, "width: " - var width/eax: int <- float-size result, 3 - print-int32-decimal 0, width - print-string 0, "\n" - } - # - loop - } -} diff --git a/apps/tile/rpn.mu b/apps/tile/rpn.mu deleted file mode 100644 index bf81308b..00000000 --- a/apps/tile/rpn.mu +++ /dev/null @@ -1,911 +0,0 @@ -fn evaluate functions: (addr handle function), bindings: (addr table), scratch: (addr line), end: (addr word), out: (addr value-stack) { - var line/eax: (addr line) <- copy scratch - var word-ah/eax: (addr handle word) <- get line, data - var curr/eax: (addr word) <- lookup *word-ah - var curr-stream-storage: (stream byte 0x10) - var curr-stream/edi: (addr stream byte) <- address curr-stream-storage - clear-value-stack out - $evaluate:loop: { - # precondition (should never hit) - compare curr, 0 - break-if-= - # update curr-stream - emit-word curr, curr-stream -#? print-string-to-real-screen "eval: " -#? print-stream-to-real-screen curr-stream -#? print-string-to-real-screen "\n" - $evaluate:process-word: { - ### if curr-stream is an operator, perform it - ## numbers - { - var is-add?/eax: boolean <- stream-data-equal? curr-stream, "+" - compare is-add?, 0 - break-if-= - var _b/xmm0: float <- pop-number-from-value-stack out - var b/xmm1: float <- copy _b - var a/xmm0: float <- pop-number-from-value-stack out - a <- add b - push-number-to-value-stack out, a - break $evaluate:process-word - } - { - var is-sub?/eax: boolean <- stream-data-equal? curr-stream, "-" - compare is-sub?, 0 - break-if-= - var _b/xmm0: float <- pop-number-from-value-stack out - var b/xmm1: float <- copy _b - var a/xmm0: float <- pop-number-from-value-stack out - a <- subtract b - push-number-to-value-stack out, a - break $evaluate:process-word - } - { - var is-mul?/eax: boolean <- stream-data-equal? curr-stream, "*" - compare is-mul?, 0 - break-if-= - var _b/xmm0: float <- pop-number-from-value-stack out - var b/xmm1: float <- copy _b - var a/xmm0: float <- pop-number-from-value-stack out - a <- multiply b - push-number-to-value-stack out, a - break $evaluate:process-word - } - { - var is-div?/eax: boolean <- stream-data-equal? curr-stream, "/" - compare is-div?, 0 - break-if-= - var _b/xmm0: float <- pop-number-from-value-stack out - var b/xmm1: float <- copy _b - var a/xmm0: float <- pop-number-from-value-stack out - a <- divide b - push-number-to-value-stack out, a - break $evaluate:process-word - } - { - var is-sqrt?/eax: boolean <- stream-data-equal? curr-stream, "sqrt" - compare is-sqrt?, 0 - break-if-= - var a/xmm0: float <- pop-number-from-value-stack out - a <- square-root a - push-number-to-value-stack out, a - break $evaluate:process-word - } - ## strings/arrays - { - var is-len?/eax: boolean <- stream-data-equal? curr-stream, "len" - compare is-len?, 0 - break-if-= -#? print-string 0, "is len\n" - # pop target-val from out - var out2/esi: (addr value-stack) <- copy out - var top-addr/ecx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= -#? print-string 0, "stack has stuff\n" - var data-ah/eax: (addr handle array value) <- get out2, data - var data/eax: (addr array value) <- lookup *data-ah - var top/edx: int <- copy *top-addr - top <- decrement - var dest-offset/edx: (offset value) <- compute-offset data, top - var target-val/edx: (addr value) <- index data, dest-offset - # check target-val is a string or array - var target-type-addr/eax: (addr int) <- get target-val, type - compare *target-type-addr, 1/string - { - break-if-!= - # compute length - var src-ah/eax: (addr handle array byte) <- get target-val, text-data - var src/eax: (addr array byte) <- lookup *src-ah - var result/ebx: int <- length src - var result-f/xmm0: float <- convert result - # save result into target-val - 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 - clear-object target-string-ah - var target/eax: (addr float) <- get target-val, number-data - copy-to *target, result-f - break $evaluate:process-word - } - compare *target-type-addr, 2/array - { - break-if-!= - # compute length - var src-ah/eax: (addr handle array value) <- get target-val, array-data - var src/eax: (addr array value) <- lookup *src-ah - var result/ebx: int <- length src - var result-f/xmm0: float <- convert result - # save result into target-val - 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 - clear-object target-array-ah - var target/eax: (addr float) <- get target-val, number-data - copy-to *target, result-f - break $evaluate:process-word - } - } - ## files - { - var is-open?/eax: boolean <- stream-data-equal? curr-stream, "open" - compare is-open?, 0 - break-if-= - # pop target-val from out - var out2/esi: (addr value-stack) <- copy out - var top-addr/ecx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= - var data-ah/eax: (addr handle array value) <- get out2, data - var data/eax: (addr array value) <- lookup *data-ah - var top/edx: int <- copy *top-addr - top <- decrement - var dest-offset/edx: (offset value) <- compute-offset data, top - var target-val/edx: (addr value) <- index data, dest-offset - # check target-val is a string - var target-type-addr/eax: (addr int) <- get target-val, type - compare *target-type-addr, 1/string - break-if-!= - # open target-val as a filename and save the handle in target-val - var src-ah/eax: (addr handle array byte) <- get target-val, text-data - var src/eax: (addr array byte) <- lookup *src-ah - var result-ah/ecx: (addr handle buffered-file) <- get target-val, file-data - open src, 0, result-ah # write? = false - # save result into target-val - var type-addr/eax: (addr int) <- get target-val, type - copy-to *type-addr, 3/file - 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 - clear-object target-string-ah - break $evaluate:process-word - } - { - var is-read?/eax: boolean <- stream-data-equal? curr-stream, "read" - compare is-read?, 0 - break-if-= - # pop target-val from out - var out2/esi: (addr value-stack) <- copy out - var top-addr/ecx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= - var data-ah/eax: (addr handle array value) <- get out2, data - var data/eax: (addr array value) <- lookup *data-ah - var top/edx: int <- copy *top-addr - top <- decrement - var dest-offset/edx: (offset value) <- compute-offset data, top - var target-val/edx: (addr value) <- index data, dest-offset - # check target-val is a file - var target-type-addr/eax: (addr int) <- get target-val, type - compare *target-type-addr, 3/file - break-if-!= - # read a line from the file and save in target-val - # read target-val as a filename and save the handle in target-val - var file-ah/eax: (addr handle buffered-file) <- get target-val, file-data - var file/eax: (addr buffered-file) <- lookup *file-ah - var s: (stream byte 0x100) - var s-addr/ecx: (addr stream byte) <- address s - read-line-buffered file, s-addr - var target/eax: (addr handle array byte) <- get target-val, text-data - stream-to-array s-addr, target - # save result into target-val - 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 - clear-object target-file-ah - break $evaluate:process-word - } - { - var is-slurp?/eax: boolean <- stream-data-equal? curr-stream, "slurp" - compare is-slurp?, 0 - break-if-= - # pop target-val from out - var out2/esi: (addr value-stack) <- copy out - var top-addr/ecx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= - var data-ah/eax: (addr handle array value) <- get out2, data - var data/eax: (addr array value) <- lookup *data-ah - var top/edx: int <- copy *top-addr - top <- decrement - var dest-offset/edx: (offset value) <- compute-offset data, top - var target-val/edx: (addr value) <- index data, dest-offset - # check target-val is a file - var target-type-addr/eax: (addr int) <- get target-val, type - compare *target-type-addr, 3/file - break-if-!= - # slurp all contents from file and save in target-val - # read target-val as a filename and save the handle in target-val - var file-ah/eax: (addr handle buffered-file) <- get target-val, file-data - var file/eax: (addr buffered-file) <- lookup *file-ah - var s: (stream byte 0x100) - var s-addr/ecx: (addr stream byte) <- address s - slurp file, s-addr - var target/eax: (addr handle array byte) <- get target-val, text-data - stream-to-array s-addr, target - # save result into target-val - 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 - clear-object target-file-ah - break $evaluate:process-word - } - { - var is-lines?/eax: boolean <- stream-data-equal? curr-stream, "lines" - compare is-lines?, 0 - break-if-= - # pop target-val from out - var out2/esi: (addr value-stack) <- copy out - var top-addr/ecx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= - var data-ah/eax: (addr handle array value) <- get out2, data - var data/eax: (addr array value) <- lookup *data-ah - var top/edx: int <- copy *top-addr - top <- decrement - var dest-offset/edx: (offset value) <- compute-offset data, top - var target-val/edx: (addr value) <- index data, dest-offset - # check target-val is a file - var target-type-addr/eax: (addr int) <- get target-val, type - compare *target-type-addr, 3/file - break-if-!= - # read all lines from file and save as an array of strings in target-val - # read target-val as a filename and save the handle in target-val - var file-ah/eax: (addr handle buffered-file) <- get target-val, file-data - var file/eax: (addr buffered-file) <- lookup *file-ah - var s: (stream byte 0x100) - var s-addr/ecx: (addr stream byte) <- address s - slurp file, s-addr - var tmp-ah/eax: (addr handle array byte) <- get target-val, text-data - stream-to-array s-addr, tmp-ah - var tmp/eax: (addr array byte) <- lookup *tmp-ah -#? enable-screen-type-mode -#? print-string 0, tmp - var h: (handle array (handle array byte)) - { - var ah/edx: (addr handle array (handle array byte)) <- address h - split-string tmp, 0xa, ah - } - var target/eax: (addr handle array value) <- get target-val, array-data - save-lines h, target - # save result into target-val - var type-addr/eax: (addr int) <- get target-val, type - copy-to *type-addr, 2/array - var target-file-ah/eax: (addr handle buffered-file) <- get target-val, file-data - var empty-file: (handle buffered-file) - copy-handle empty-file, target-file-ah - var target-text-ah/eax: (addr handle array byte) <- get target-val, text-data - var empty-text: (handle array byte) - copy-handle empty-text, target-text-ah - break $evaluate:process-word - } - ## screens - { - var is-fake-screen?/eax: boolean <- stream-data-equal? curr-stream, "fake-screen" - compare is-fake-screen?, 0 - break-if-= - var out2/esi: (addr value-stack) <- copy out - var top-addr/ecx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= - # pop width and height from out - var nrows-f/xmm0: float <- pop-number-from-value-stack out2 - var nrows/edx: int <- convert nrows-f - var ncols-f/xmm0: float <- pop-number-from-value-stack out2 - var ncols/ebx: int <- convert ncols-f - # define a new screen with those dimensions - var screen-h: (handle screen) - var screen-ah/eax: (addr handle screen) <- address screen-h - allocate screen-ah - var screen/eax: (addr screen) <- lookup screen-h - initialize-screen screen, nrows, ncols - # push screen to stack - var data-ah/eax: (addr handle array value) <- get out2, data - var data/eax: (addr array value) <- lookup *data-ah - var top/edx: int <- copy *top-addr - increment *top-addr - var dest-offset/edx: (offset value) <- compute-offset data, top - var target-val/edx: (addr value) <- index data, dest-offset - var type/eax: (addr int) <- get target-val, type - copy-to *type, 4/screen - var dest/eax: (addr handle screen) <- get target-val, screen-data - copy-handle screen-h, dest - break $evaluate:process-word - } - { - var is-print?/eax: boolean <- stream-data-equal? curr-stream, "print" - compare is-print?, 0 - break-if-= - var out2/esi: (addr value-stack) <- copy out - var top-addr/ecx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= - # pop string from out - var top-addr/ecx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= - decrement *top-addr - var data-ah/eax: (addr handle array value) <- get out2, data - var _data/eax: (addr array value) <- lookup *data-ah - var data/edi: (addr array value) <- copy _data - var top/eax: int <- copy *top-addr - var dest-offset/edx: (offset value) <- compute-offset data, top - var s/esi: (addr value) <- index data, dest-offset - # select target screen from top of out (but don't pop it) - compare *top-addr, 0 - break-if-<= - var top/eax: int <- copy *top-addr - top <- decrement - var dest-offset/edx: (offset value) <- compute-offset data, top - var target-val/edx: (addr value) <- index data, dest-offset - var type/eax: (addr int) <- get target-val, type - compare *type, 4/screen - break-if-!= - # print string to target screen - var dest-ah/eax: (addr handle screen) <- get target-val, screen-data - var dest/eax: (addr screen) <- lookup *dest-ah - var r/ecx: (addr int) <- get dest, cursor-row - var c/edx: (addr int) <- get dest, cursor-col - render-value-at dest, *r, *c, s, 0 - break $evaluate:process-word - } - { - var is-move?/eax: boolean <- stream-data-equal? curr-stream, "move" - compare is-move?, 0 - break-if-= - var out2/esi: (addr value-stack) <- copy out - # pop args - var r-f/xmm0: float <- pop-number-from-value-stack out2 - var r/ecx: int <- convert r-f - var c-f/xmm0: float <- pop-number-from-value-stack out2 - var c/edx: int <- convert c-f - # select screen from top of out (but don't pop it) - var top-addr/ebx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= - var data-ah/eax: (addr handle array value) <- get out2, data - var _data/eax: (addr array value) <- lookup *data-ah - var data/edi: (addr array value) <- copy _data - var top/eax: int <- copy *top-addr - top <- decrement - var target-offset/eax: (offset value) <- compute-offset data, top - var target-val/ebx: (addr value) <- index data, target-offset - var type/eax: (addr int) <- get target-val, type - compare *type, 4/screen - break-if-!= - var target-ah/eax: (addr handle screen) <- get target-val, screen-data - var target/eax: (addr screen) <- lookup *target-ah - move-cursor target, r, c - break $evaluate:process-word - } - { - var is-up?/eax: boolean <- stream-data-equal? curr-stream, "up" - compare is-up?, 0 - break-if-= - var out2/esi: (addr value-stack) <- copy out - var top-addr/ebx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= - # pop args - var d-f/xmm0: float <- pop-number-from-value-stack out2 - var d/ecx: int <- convert d-f - # select screen from top of out (but don't pop it) - compare *top-addr, 0 - break-if-<= - var data-ah/eax: (addr handle array value) <- get out2, data - var _data/eax: (addr array value) <- lookup *data-ah - var data/edi: (addr array value) <- copy _data - var top/eax: int <- copy *top-addr - top <- decrement - var target-offset/eax: (offset value) <- compute-offset data, top - var target-val/ebx: (addr value) <- index data, target-offset - var type/eax: (addr int) <- get target-val, type - compare *type, 4/screen - break-if-!= - var target-ah/eax: (addr handle screen) <- get target-val, screen-data - var _target/eax: (addr screen) <- lookup *target-ah - var target/edi: (addr screen) <- copy _target - var r/edx: (addr int) <- get target, cursor-row - var c/eax: (addr int) <- get target, cursor-col - var col/eax: int <- copy *c - { - compare d, 0 - break-if-<= - compare *r, 1 - break-if-<= - print-string target "│" - decrement *r - move-cursor target, *r, col - d <- decrement - loop - } - break $evaluate:process-word - } - { - var is-down?/eax: boolean <- stream-data-equal? curr-stream, "down" - compare is-down?, 0 - break-if-= - var out2/esi: (addr value-stack) <- copy out - var top-addr/ebx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= - # pop args - var d-f/xmm0: float <- pop-number-from-value-stack out2 - var d/ecx: int <- convert d-f - # select screen from top of out (but don't pop it) - compare *top-addr, 0 - break-if-<= - var data-ah/eax: (addr handle array value) <- get out2, data - var _data/eax: (addr array value) <- lookup *data-ah - var data/edi: (addr array value) <- copy _data - var top/eax: int <- copy *top-addr - top <- decrement - var target-offset/eax: (offset value) <- compute-offset data, top - var target-val/ebx: (addr value) <- index data, target-offset - var type/eax: (addr int) <- get target-val, type - compare *type, 4/screen - break-if-!= - var target-ah/eax: (addr handle screen) <- get target-val, screen-data - var _target/eax: (addr screen) <- lookup *target-ah - var target/edi: (addr screen) <- copy _target - var bound-a/ebx: (addr int) <- get target, num-rows - var bound/ebx: int <- copy *bound-a - var r/edx: (addr int) <- get target, cursor-row - var c/eax: (addr int) <- get target, cursor-col - var col/eax: int <- copy *c - { - compare d, 0 - break-if-<= - compare *r, bound - break-if->= - print-string target "│" - increment *r - move-cursor target, *r, col - d <- decrement - loop - } - break $evaluate:process-word - } - { - var is-left?/eax: boolean <- stream-data-equal? curr-stream, "left" - compare is-left?, 0 - break-if-= - var out2/esi: (addr value-stack) <- copy out - var top-addr/ebx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= - # pop args - var d-f/xmm0: float <- pop-number-from-value-stack out2 - var d/ecx: int <- convert d-f - # select screen from top of out (but don't pop it) - compare *top-addr, 0 - break-if-<= - var data-ah/eax: (addr handle array value) <- get out2, data - var _data/eax: (addr array value) <- lookup *data-ah - var data/edi: (addr array value) <- copy _data - var top/eax: int <- copy *top-addr - top <- decrement - var target-offset/eax: (offset value) <- compute-offset data, top - var target-val/ebx: (addr value) <- index data, target-offset - var type/eax: (addr int) <- get target-val, type - compare *type, 4/screen - break-if-!= - var target-ah/eax: (addr handle screen) <- get target-val, screen-data - var _target/eax: (addr screen) <- lookup *target-ah - var target/edi: (addr screen) <- copy _target - var c/edx: (addr int) <- get target, cursor-col - var r/eax: (addr int) <- get target, cursor-row - var row/eax: int <- copy *r - { - compare d, 0 - break-if-<= - compare *c, 1 - break-if-<= - print-string target "─" - decrement *c - decrement *c # second one to undo the print above - move-cursor target, row, *c - d <- decrement - loop - } - break $evaluate:process-word - } - { - var is-right?/eax: boolean <- stream-data-equal? curr-stream, "right" - compare is-right?, 0 - break-if-= - var out2/esi: (addr value-stack) <- copy out - var top-addr/ebx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= - # pop args - var _d/xmm0: float <- pop-number-from-value-stack out2 - var d/ecx: int <- convert _d - # select screen from top of out (but don't pop it) - compare *top-addr, 0 - break-if-<= - var data-ah/eax: (addr handle array value) <- get out2, data - var _data/eax: (addr array value) <- lookup *data-ah - var data/edi: (addr array value) <- copy _data - var top/eax: int <- copy *top-addr - top <- decrement - var target-offset/eax: (offset value) <- compute-offset data, top - var target-val/ebx: (addr value) <- index data, target-offset - var type/eax: (addr int) <- get target-val, type - compare *type, 4/screen - break-if-!= - var target-ah/eax: (addr handle screen) <- get target-val, screen-data - var _target/eax: (addr screen) <- lookup *target-ah - var target/edi: (addr screen) <- copy _target - var bound-a/ebx: (addr int) <- get target, num-rows - var bound/ebx: int <- copy *bound-a - var c/edx: (addr int) <- get target, cursor-col - var r/eax: (addr int) <- get target, cursor-row - var row/eax: int <- copy *r - { - compare d, 0 - break-if-<= - compare *c, bound - break-if->= - print-string target "─" - # no increment; the print took care of it - move-cursor target, row, *c - d <- decrement - loop - } - break $evaluate:process-word - } - ## HACKS: we're trying to avoid turning this into Forth - { - var is-dup?/eax: boolean <- stream-data-equal? curr-stream, "dup" - compare is-dup?, 0 - break-if-= - # read src-val from out - var out2/esi: (addr value-stack) <- copy out - var top-addr/ecx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= - var data-ah/eax: (addr handle array value) <- get out2, data - var data/eax: (addr array value) <- lookup *data-ah - var top/ecx: int <- copy *top-addr - top <- decrement - var offset/edx: (offset value) <- compute-offset data, top - var src-val/edx: (addr value) <- index data, offset - # push a copy of it - top <- increment - var offset/ebx: (offset value) <- compute-offset data, top - var target-val/ebx: (addr value) <- index data, offset - copy-object src-val, target-val - # commit - var top-addr/ecx: (addr int) <- get out2, top - increment *top-addr - break $evaluate:process-word - } - { - var is-swap?/eax: boolean <- stream-data-equal? curr-stream, "swap" - compare is-swap?, 0 - break-if-= - # read top-val from out - var out2/esi: (addr value-stack) <- copy out - var top-addr/ecx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= - var data-ah/eax: (addr handle array value) <- get out2, data - var data/eax: (addr array value) <- lookup *data-ah - var top/ecx: int <- copy *top-addr - top <- decrement - var offset/edx: (offset value) <- compute-offset data, top - var top-val/edx: (addr value) <- index data, offset - # read next val from out - top <- decrement - var offset/ebx: (offset value) <- compute-offset data, top - var pen-top-val/ebx: (addr value) <- index data, offset - # swap - var tmp: value - var tmp-a/eax: (addr value) <- address tmp - copy-object top-val, tmp-a - copy-object pen-top-val, top-val - copy-object tmp-a, pen-top-val - break $evaluate:process-word - } - ### if curr-stream defines a binding, save top of stack to bindings - { - var done?/eax: boolean <- stream-empty? curr-stream - compare done?, 0/false - break-if-!= - var new-byte/eax: byte <- read-byte curr-stream - compare new-byte, 0x3d/= - break-if-!= - # pop target-val from out - var out2/esi: (addr value-stack) <- copy out - var top-addr/ecx: (addr int) <- get out2, top - compare *top-addr, 0 - break-if-<= - var data-ah/eax: (addr handle array value) <- get out2, data - var data/eax: (addr array value) <- lookup *data-ah - var top/edx: int <- copy *top-addr - top <- decrement - var dest-offset/edx: (offset value) <- compute-offset data, top - var target-val/edx: (addr value) <- index data, dest-offset - # create binding from curr-stream to target-val - var key-h: (handle array byte) - var key/ecx: (addr handle array byte) <- address key-h - stream-to-array curr-stream, key - bind-in-table bindings, key, target-val - break $evaluate:process-word - } - rewind-stream curr-stream - ### if curr-stream is a known function name, call it appropriately - { - var callee-h: (handle function) - var callee-ah/eax: (addr handle function) <- address callee-h - find-function functions, curr-stream, callee-ah - var callee/eax: (addr function) <- lookup *callee-ah - compare callee, 0 - break-if-= - perform-call callee, out, functions - break $evaluate:process-word - } - ### if it's a name, push its value - { - compare bindings, 0 - break-if-= - var tmp: (handle array byte) - var curr-string-ah/edx: (addr handle array byte) <- address tmp - stream-to-array curr-stream, curr-string-ah # unfortunate leak - var curr-string/eax: (addr array byte) <- lookup *curr-string-ah - var val-storage: (handle value) - var val-ah/edi: (addr handle value) <- address val-storage - lookup-binding bindings, curr-string, val-ah - var val/eax: (addr value) <- lookup *val-ah - compare val, 0 - break-if-= - push-value-stack out, val - break $evaluate:process-word - } - ### if the word starts with a quote and ends with a quote, turn it into a string - { - var start/eax: byte <- stream-first curr-stream - compare start, 0x22/double-quote - break-if-!= - var end/eax: byte <- stream-final curr-stream - compare end, 0x22/double-quote - break-if-!= - var h: (handle array byte) - var s/eax: (addr handle array byte) <- address h - unquote-stream-to-array curr-stream, s # leak - push-string-to-value-stack out, *s - break $evaluate:process-word - } - ### if the word starts with a '[' and ends with a ']', turn it into an array - { - var start/eax: byte <- stream-first curr-stream - compare start, 0x5b/[ - break-if-!= - var end/eax: byte <- stream-final curr-stream - compare end, 0x5d/] - break-if-!= - # wastefully create a new input string to strip quotes - var h: (handle array value) - var input-ah/eax: (addr handle array byte) <- address h - unquote-stream-to-array curr-stream, input-ah # leak - # wastefully parse input into int-array - # TODO: support parsing arrays of other types - var input/eax: (addr array byte) <- lookup *input-ah - var h2: (handle array int) - var int-array-ah/esi: (addr handle array int) <- address h2 - parse-array-of-decimal-ints input, int-array-ah # leak - var _int-array/eax: (addr array int) <- lookup *int-array-ah - var int-array/esi: (addr array int) <- copy _int-array - var len/ebx: int <- length int-array - # push value-array of same size as int-array - var h3: (handle array value) - var value-array-ah/eax: (addr handle array value) <- address h3 - populate value-array-ah, len - push-array-to-value-stack out, *value-array-ah - # copy int-array into value-array - var _value-array/eax: (addr array value) <- lookup *value-array-ah - var value-array/edi: (addr array value) <- copy _value-array - var i/eax: int <- copy 0 - { - compare i, len - break-if->= - var src-addr/ecx: (addr int) <- index int-array, i - var src/ecx: int <- copy *src-addr - var src-f/xmm0: float <- convert src - var dest-offset/edx: (offset value) <- compute-offset value-array, i - var dest-val/edx: (addr value) <- index value-array, dest-offset - var dest/edx: (addr float) <- get dest-val, number-data - copy-to *dest, src-f - i <- increment - loop - } - break $evaluate:process-word - } - ### otherwise assume it's a literal number and push it - { - var n/eax: int <- parse-decimal-int-from-stream curr-stream - var n-f/xmm0: float <- convert n - push-number-to-value-stack out, n-f - } - } - # termination check - compare curr, end - break-if-= - # update - var next-word-ah/edx: (addr handle word) <- get curr, next - curr <- lookup *next-word-ah - # - loop - } - # process next line if necessary - var line/eax: (addr line) <- copy scratch - var next-line-ah/eax: (addr handle line) <- get line, next - var next-line/eax: (addr line) <- lookup *next-line-ah - compare next-line, 0 - break-if-= - evaluate functions, bindings, next-line, end, out -} - -fn test-evaluate { - var line-storage: line - var line/esi: (addr line) <- address line-storage - var first-word-ah/eax: (addr handle word) <- get line-storage, data - allocate-word-with first-word-ah, "3" - append-word-with *first-word-ah, "=a" - var next-line-ah/eax: (addr handle line) <- get line-storage, next - allocate next-line-ah - var next-line/eax: (addr line) <- lookup *next-line-ah - var first-word-ah/eax: (addr handle word) <- get next-line, data - allocate-word-with first-word-ah, "a" - var functions-storage: (handle function) - var functions/ecx: (addr handle function) <- address functions-storage - var table-storage: table - var table/ebx: (addr table) <- address table-storage - initialize-table table, 0x10 - var stack-storage: value-stack - var stack/edi: (addr value-stack) <- address stack-storage - initialize-value-stack stack, 0x10 - evaluate functions, table, line, 0, stack - var x-f/xmm0: float <- pop-number-from-value-stack stack - var x/eax: int <- convert x-f - check-ints-equal x, 3, "F - test-evaluate" -} - -fn find-function first: (addr handle function), name: (addr stream byte), out: (addr handle function) { - var curr/esi: (addr handle function) <- copy first - $find-function:loop: { - var _f/eax: (addr function) <- lookup *curr - var f/ecx: (addr function) <- copy _f - compare f, 0 - break-if-= - var curr-name-ah/eax: (addr handle array byte) <- get f, name - var curr-name/eax: (addr array byte) <- lookup *curr-name-ah - var done?/eax: boolean <- stream-data-equal? name, curr-name - compare done?, 0/false - { - break-if-= - copy-handle *curr, out - break $find-function:loop - } - curr <- get f, next - loop - } -} - -fn perform-call _callee: (addr function), caller-stack: (addr value-stack), functions: (addr handle function) { - var callee/ecx: (addr function) <- copy _callee - # create bindings for args - var table-storage: table - var table/esi: (addr table) <- address table-storage - initialize-table table, 0x10 - bind-args callee, caller-stack, table - # obtain body - var body-ah/eax: (addr handle line) <- get callee, body - var body/eax: (addr line) <- lookup *body-ah - # perform call - var stack-storage: value-stack - var stack/edi: (addr value-stack) <- address stack-storage - initialize-value-stack stack, 0x10 -#? print-string-to-real-screen "about to enter recursive eval\n" - evaluate functions, table, body, 0, stack -#? print-string-to-real-screen "exited recursive eval\n" - # pop target-val from out - var top-addr/ecx: (addr int) <- get stack, top - compare *top-addr, 0 - break-if-<= - var data-ah/eax: (addr handle array value) <- get stack, data - var data/eax: (addr array value) <- lookup *data-ah - var top/edx: int <- copy *top-addr - top <- decrement - var dest-offset/edx: (offset value) <- compute-offset data, top - var target-val/edx: (addr value) <- index data, dest-offset - # stitch target-val into caller-stack - push-value-stack caller-stack, target-val -} - -# pop args from the caller-stack and bind them to successive args -# implies: function args are stored in reverse order -fn bind-args _callee: (addr function), _caller-stack: (addr value-stack), table: (addr table) { - var callee/ecx: (addr function) <- copy _callee - var curr-arg-ah/eax: (addr handle word) <- get callee, args - var curr-arg/eax: (addr word) <- lookup *curr-arg-ah - # - var curr-key-storage: (handle array byte) - var curr-key/edx: (addr handle array byte) <- address curr-key-storage - { - compare curr-arg, 0 - break-if-= - # create binding - word-to-string curr-arg, curr-key - { - # pop target-val from caller-stack - var caller-stack/esi: (addr value-stack) <- copy _caller-stack - var top-addr/ecx: (addr int) <- get caller-stack, top - compare *top-addr, 0 - break-if-<= - decrement *top-addr - var data-ah/eax: (addr handle array value) <- get caller-stack, data - var data/eax: (addr array value) <- lookup *data-ah - var top/ebx: int <- copy *top-addr - var dest-offset/ebx: (offset value) <- compute-offset data, top - var target-val/ebx: (addr value) <- index data, dest-offset - # create binding from curr-key to target-val - bind-in-table table, curr-key, target-val - } - # - var next-arg-ah/edx: (addr handle word) <- get curr-arg, next - curr-arg <- lookup *next-arg-ah - loop - } -} - -# Copy of 'simplify' that just tracks the maximum stack depth needed -# Doesn't actually need to simulate the stack, since every word has a predictable effect. -fn max-stack-depth first-word: (addr word), final-word: (addr word) -> _/edi: int { - var curr-word/eax: (addr word) <- copy first-word - var curr-depth/ecx: int <- copy 0 - var result/edi: int <- copy 0 - $max-stack-depth:loop: { - $max-stack-depth:process-word: { - # handle operators - { - var is-add?/eax: boolean <- word-equal? curr-word, "+" - compare is-add?, 0 - break-if-= - curr-depth <- decrement - break $max-stack-depth:process-word - } - { - var is-sub?/eax: boolean <- word-equal? curr-word, "-" - compare is-sub?, 0 - break-if-= - curr-depth <- decrement - break $max-stack-depth:process-word - } - { - var is-mul?/eax: boolean <- word-equal? curr-word, "*" - compare is-mul?, 0 - break-if-= - curr-depth <- decrement - break $max-stack-depth:process-word - } - # otherwise it's an int (do we need error-checking?) - curr-depth <- increment - # update max depth if necessary - { - compare curr-depth, result - break-if-<= - result <- copy curr-depth - } - } - # if curr-word == final-word break - compare curr-word, final-word - break-if-= - # curr-word = curr-word->next - var next-word-ah/edx: (addr handle word) <- get curr-word, next - curr-word <- lookup *next-word-ah - # - loop - } - return result -} diff --git a/apps/tile/surface.mu b/apps/tile/surface.mu deleted file mode 100644 index 2e353022..00000000 --- a/apps/tile/surface.mu +++ /dev/null @@ -1,412 +0,0 @@ -# A surface is a large 2-D grid that you can only see a subset of through the -# screen. -# Imagine a pin going through both surface and screen. As we update the -# surface contents, the pinned point stays fixed, providing a sense of -# stability. - -type surface { - screen: (handle screen) - data: (handle array screen-cell) - nrows: int - ncols: int - screen-nrows: int - screen-ncols: int - pin-row: int # 1-indexed - pin-col: int # 1-indexed - pin-screen-row: int # 1-indexed - pin-screen-col: int # 1-indexed -} - -# intended mostly for tests; could be slow -fn initialize-surface-with _self: (addr surface), in: (addr array byte) { - var self/esi: (addr surface) <- copy _self - # fill in nrows, ncols - var nrows/ecx: int <- num-lines in - var dest/eax: (addr int) <- get self, nrows - copy-to *dest, nrows - var ncols/edx: int <- first-line-length in # assume all lines are the same length - dest <- get self, ncols - copy-to *dest, ncols - # fill in data - var len/ecx: int <- copy nrows - len <- multiply ncols - var out/edi: (addr surface) <- copy _self - var data/eax: (addr handle array screen-cell) <- get out, data - populate data, len - var data-addr/eax: (addr array screen-cell) <- lookup *data - fill-in data-addr, in - # fill in screen-nrows, screen-ncols - { - var screen-ah/eax: (addr handle screen) <- get self, screen - var _screen-addr/eax: (addr screen) <- lookup *screen-ah - var screen-addr/edi: (addr screen) <- copy _screen-addr - var nrows/eax: int <- copy 0 - var ncols/ecx: int <- copy 0 - nrows, ncols <- screen-size screen-addr - var dest/edi: (addr int) <- get self, screen-nrows - copy-to *dest, nrows - dest <- get self, screen-ncols - copy-to *dest, ncols - } -} - -fn pin-surface-at _self: (addr surface), r: int, c: int { - var self/esi: (addr surface) <- copy _self - var dest/ecx: (addr int) <- get self, pin-row - var tmp/eax: int <- copy r - copy-to *dest, tmp - dest <- get self, pin-col - tmp <- copy c - copy-to *dest, tmp -} - -fn pin-surface-to _self: (addr surface), sr: int, sc: int { - var self/esi: (addr surface) <- copy _self - var dest/ecx: (addr int) <- get self, pin-screen-row - var tmp/eax: int <- copy sr - copy-to *dest, tmp - dest <- get self, pin-screen-col - tmp <- copy sc - copy-to *dest, tmp -} - -fn render-surface _self: (addr surface) { -#? print-string-to-real-screen "render-surface\n" - var self/esi: (addr surface) <- copy _self - # clear screen - var screen-ah/eax: (addr handle screen) <- get self, screen - var screen/eax: (addr screen) <- lookup *screen-ah - clear-screen screen - # - var nrows/edx: (addr int) <- get self, screen-nrows - var ncols/ebx: (addr int) <- get self, screen-ncols - var screen-row/ecx: int <- copy 1 - { - compare screen-row, *nrows - break-if-> - var screen-col/eax: int <- copy 1 - { - compare screen-col, *ncols - break-if-> -#? print-string-to-real-screen "X" - print-surface-cell-at self, screen-row, screen-col - screen-col <- increment - loop - } -#? print-string-to-real-screen "\n" - screen-row <- increment - loop - } -} - -fn print-surface-cell-at _self: (addr surface), screen-row: int, screen-col: int { - var self/esi: (addr surface) <- copy _self - var row/ecx: int <- screen-row-to-surface self, screen-row - var col/edx: int <- screen-col-to-surface self, screen-col - var data-ah/edi: (addr handle array screen-cell) <- get self, data - var _data-addr/eax: (addr array screen-cell) <- lookup *data-ah - var data-addr/edi: (addr array screen-cell) <- copy _data-addr - var idx/eax: int <- surface-screen-cell-index self, row, col - # if out of bounds, print ' ' - compare idx, 0 - { - break-if->= - var space/ecx: grapheme <- copy 0x20 - var screen-ah/edi: (addr handle screen) <- get self, screen - var screen/eax: (addr screen) <- lookup *screen-ah - print-grapheme screen, space - return - } - # otherwise print the appropriate screen-cell - var offset/ecx: (offset screen-cell) <- compute-offset data-addr, idx - var src/ecx: (addr screen-cell) <- index data-addr, offset - var screen-ah/edi: (addr handle screen) <- get self, screen - var screen/eax: (addr screen) <- lookup *screen-ah - print-screen-cell screen, src -} - -# print a cell with all its formatting at the cursor location -fn print-screen-cell screen: (addr screen), _cell: (addr screen-cell) { - var cell/esi: (addr screen-cell) <- copy _cell - reset-formatting screen - var fg/eax: (addr int) <- get cell, color - var bg/ecx: (addr int) <- get cell, background-color - start-color screen, *fg, *bg - var tmp/eax: (addr boolean) <- get cell, bold? - { - compare *tmp, 0 - break-if-= - start-bold screen - } - { - tmp <- get cell, underline? - compare *tmp, 0 - break-if-= - start-underline screen - } - { - tmp <- get cell, reverse? - compare *tmp, 0 - break-if-= - start-reverse-video screen - } - { - tmp <- get cell, blink? - compare *tmp, 0 - break-if-= - start-blinking screen - } - var g/eax: (addr grapheme) <- get cell, data - print-grapheme screen, *g -#? var g2/eax: grapheme <- copy *g -#? var g3/eax: int <- copy g2 -#? print-int32-hex-to-real-screen g3 -#? print-string-to-real-screen "\n" -} - -fn surface-screen-cell-index _self: (addr surface), row: int, col: int -> _/eax: int { - var self/esi: (addr surface) <- copy _self -#? print-int32-hex-to-real-screen row -#? print-string-to-real-screen ", " -#? print-int32-hex-to-real-screen col -#? print-string-to-real-screen "\n" - var result/eax: int <- copy -1 - { - compare row, 1 - break-if-< - compare col, 1 - break-if-< - var nrows-addr/ecx: (addr int) <- get self, nrows - var nrows/ecx: int <- copy *nrows-addr - compare row, nrows - break-if-> - var ncols-addr/ecx: (addr int) <- get self, ncols - var ncols/ecx: int <- copy *ncols-addr - compare col, ncols - break-if-> - #? print-string-to-real-screen "!\n" - result <- copy row - result <- subtract 1 - result <- multiply ncols - result <- add col - result <- subtract 1 - } - return result -} - -fn screen-row-to-surface _self: (addr surface), screen-row: int -> _/ecx: int { - var self/esi: (addr surface) <- copy _self - var result/ecx: int <- copy screen-row - var tmp/eax: (addr int) <- get self, pin-row - result <- add *tmp - tmp <- get self, pin-screen-row - result <- subtract *tmp - return result -} - -fn max _a: int, b: int -> _/eax: int { - var a/eax: int <- copy _a - compare a, b - { - break-if-> - return b - } - return a -} - -fn min _a: int, b: int -> _/eax: int { - var a/eax: int <- copy _a - compare a, b - { - break-if-> - return a - } - return b -} - -fn screen-col-to-surface _self: (addr surface), screen-col: int -> _/edx: int { - var self/esi: (addr surface) <- copy _self - var result/edx: int <- copy screen-col - var tmp/eax: (addr int) <- get self, pin-col - result <- add *tmp - tmp <- get self, pin-screen-col - result <- subtract *tmp - return result -} - -fn surface-row-to-screen _self: (addr surface), row: int -> _/ecx: int { - var self/esi: (addr surface) <- copy _self - var result/ecx: int <- copy row - var tmp/eax: (addr int) <- get self, pin-screen-row - result <- add *tmp - tmp <- get self, pin-row - result <- subtract *tmp - return result -} - -fn surface-col-to-screen _self: (addr surface), col: int -> _/edx: int { - var self/esi: (addr surface) <- copy _self - var result/edx: int <- copy col - var tmp/eax: (addr int) <- get self, pin-screen-col - result <- add *tmp - tmp <- get self, pin-col - result <- subtract *tmp - return result -} - -# assumes last line doesn't end in '\n' -fn num-lines in: (addr array byte) -> _/ecx: int { - var s: (stream byte 0x100) - var s-addr/esi: (addr stream byte) <- address s - write s-addr, in - var result/ecx: int <- copy 1 - { - var done?/eax: boolean <- stream-empty? s-addr - compare done?, 0/false - break-if-!= - var g/eax: grapheme <- read-grapheme s-addr - compare g, 0xa/newline - loop-if-!= - result <- increment - loop - } - return result -} - -fn first-line-length in: (addr array byte) -> _/edx: int { - var s: (stream byte 0x100) - var s-addr/esi: (addr stream byte) <- address s - write s-addr, in - var result/edx: int <- copy 0 - { - var done?/eax: boolean <- stream-empty? s-addr - compare done?, 0/false - break-if-!= - var g/eax: grapheme <- read-grapheme s-addr - compare g, 0xa/newline - break-if-= - result <- increment - loop - } - return result -} - -fn fill-in _out: (addr array screen-cell), in: (addr array byte) { - var s: (stream byte 0x100) - var out/edi: (addr array screen-cell) <- copy _out - var s-addr/esi: (addr stream byte) <- address s - write s-addr, in - var idx/ecx: int <- copy 0 - { - var done?/eax: boolean <- stream-empty? s-addr - compare done?, 0/false - break-if-!= - var g/eax: grapheme <- read-grapheme s-addr - compare g, 0xa/newline - loop-if-= - var offset/edx: (offset screen-cell) <- compute-offset out, idx - var dest/edx: (addr screen-cell) <- index out, offset - var dest2/edx: (addr grapheme) <- get dest, data - copy-to *dest2, g - idx <- increment - loop - } -} - -# pin (1, 1) to (1, 1) on screen -fn test-surface-pin-at-origin { - var s: surface - var s-addr/esi: (addr surface) <- address s - # surface contents are a fixed grid with 8 rows and 6 columns - # (strip vowels second time around to break vertical alignment of letters) - initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz" - pin-surface-at s-addr, 1, 1 # surface row and column - pin-surface-to s-addr, 1, 1 # screen row and column - render-surface s-addr - var screen-ah/eax: (addr handle screen) <- get s-addr, screen - var screen-addr/eax: (addr screen) <- lookup *screen-ah - check-screen-row screen-addr, 1, "abcd", "F - test-surface-pin-at-origin" - check-screen-row screen-addr, 2, "ghij", "F - test-surface-pin-at-origin" - check-screen-row screen-addr, 3, "mnop", "F - test-surface-pin-at-origin" -} - -# pin (1, 1) to (2, 1) on screen; screen goes past edge of the universe -fn test-surface-pin-2 { - var s: surface - var s-addr/esi: (addr surface) <- address s - # surface contents are a fixed grid with 8 rows and 6 columns - # (strip vowels second time around to break vertical alignment of letters) - initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz" - pin-surface-at s-addr, 1, 1 # surface row and column - pin-surface-to s-addr, 2, 1 # screen row and column - render-surface s-addr - var screen-ah/eax: (addr handle screen) <- get s-addr, screen - var screen-addr/eax: (addr screen) <- lookup *screen-ah - # surface edge reached (should seldom happen in the app) - check-screen-row screen-addr, 1, " ", "F - test-surface-pin-2" - check-screen-row screen-addr, 2, "abcd", "F - test-surface-pin-2" - check-screen-row screen-addr, 3, "ghij", "F - test-surface-pin-2" -} - -# pin (2, 1) to (1, 1) on screen -fn test-surface-pin-3 { - var s: surface - var s-addr/esi: (addr surface) <- address s - # surface contents are a fixed grid with 8 rows and 6 columns - # (strip vowels second time around to break vertical alignment of letters) - initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz" - pin-surface-at s-addr, 2, 1 # surface row and column - pin-surface-to s-addr, 1, 1 # screen row and column - render-surface s-addr - var screen-ah/eax: (addr handle screen) <- get s-addr, screen - var screen-addr/eax: (addr screen) <- lookup *screen-ah - check-screen-row screen-addr, 1, "ghij", "F - test-surface-pin-3" - check-screen-row screen-addr, 2, "mnop", "F - test-surface-pin-3" - check-screen-row screen-addr, 3, "stuv", "F - test-surface-pin-3" -} - -# pin (1, 1) to (1, 2) on screen; screen goes past edge of the universe -fn test-surface-pin-4 { - var s: surface - var s-addr/esi: (addr surface) <- address s - # surface contents are a fixed grid with 8 rows and 6 columns - # (strip vowels second time around to break vertical alignment of letters) - initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz" - pin-surface-at s-addr, 1, 1 # surface row and column - pin-surface-to s-addr, 1, 2 # screen row and column - render-surface s-addr - var screen-ah/eax: (addr handle screen) <- get s-addr, screen - var screen-addr/eax: (addr screen) <- lookup *screen-ah - # surface edge reached (should seldom happen in the app) - check-screen-row screen-addr, 1, " abc", "F - test-surface-pin-4" - check-screen-row screen-addr, 2, " ghi", "F - test-surface-pin-4" - check-screen-row screen-addr, 3, " mno", "F - test-surface-pin-4" -} - -# pin (1, 2) to (1, 1) on screen -fn test-surface-pin-5 { - var s: surface - var s-addr/esi: (addr surface) <- address s - # surface contents are a fixed grid with 8 rows and 6 columns - # (strip vowels second time around to break vertical alignment of letters) - initialize-surface-with-fake-screen s-addr, 3, 4, "abcdef\nghijkl\nmnopqr\nstuvwx\nyzabcd\nfghjkl\nmnpqrs\ntvwxyz" - pin-surface-at s-addr, 1, 2 # surface row and column - pin-surface-to s-addr, 1, 1 # screen row and column - render-surface s-addr - var screen-ah/eax: (addr handle screen) <- get s-addr, screen - var screen-addr/eax: (addr screen) <- lookup *screen-ah - check-screen-row screen-addr, 1, "bcde", "F - test-surface-pin-5" - check-screen-row screen-addr, 2, "hijk", "F - test-surface-pin-5" - check-screen-row screen-addr, 3, "nopq", "F - test-surface-pin-5" -} - -fn initialize-surface-with-fake-screen _self: (addr surface), nrows: int, ncols: int, in: (addr array byte) { - var self/esi: (addr surface) <- copy _self - # fill in screen - var screen-ah/eax: (addr handle screen) <- get self, screen - allocate screen-ah - var screen-addr/eax: (addr screen) <- lookup *screen-ah - initialize-screen screen-addr, nrows, ncols - # fill in everything else - initialize-surface-with self, in -} diff --git a/apps/tile/table.mu b/apps/tile/table.mu deleted file mode 100644 index 9c03117b..00000000 --- a/apps/tile/table.mu +++ /dev/null @@ -1,165 +0,0 @@ -fn initialize-table _self: (addr table), n: int { - var self/esi: (addr table) <- copy _self - var data-ah/eax: (addr handle array bind) <- get self, data - populate data-ah, n -} - -fn deep-copy-table _src: (addr table), _dest: (addr table) { -#? print-string 0, "deep-copy-table\n" - var src/eax: (addr table) <- copy _src - var src-data-ah/eax: (addr handle array bind) <- get src, data - var _src-data/eax: (addr array bind) <- lookup *src-data-ah - var src-data/esi: (addr array bind) <- copy _src-data - var n/ecx: int <- length src-data - var dest/eax: (addr table) <- copy _dest - initialize-table dest, n - var dest-data-ah/eax: (addr handle array bind) <- get dest, data - var _dest-data/eax: (addr array bind) <- lookup *dest-data-ah - var dest-data/edi: (addr array bind) <- copy _dest-data - var i/eax: int <- copy 0 - { - compare i, n - break-if->= -#? print-string 0, "iter\n" - $deep-copy:element: { - var offset/edx: (offset bind) <- compute-offset src-data, i - var src-bind/ecx: (addr bind) <- index src-data, offset - var dest-bind/edx: (addr bind) <- index dest-data, offset - var src-key-ah/ebx: (addr handle array byte) <- get src-bind, key - var src-key/eax: (addr array byte) <- lookup *src-key-ah - compare src-key, 0 - break-if-= - # copy key - var dest-key-ah/eax: (addr handle array byte) <- get dest-bind, key - copy-object src-key-ah, dest-key-ah - # deep copy value - var src-val-ah/eax: (addr handle value) <- get src-bind, value - var _src-val/eax: (addr value) <- lookup *src-val-ah - var src-val/ecx: (addr value) <- copy _src-val - var dest-val-ah/eax: (addr handle value) <- get dest-bind, value - allocate dest-val-ah - var dest-val/eax: (addr value) <- lookup *dest-val-ah -#? print-string 0, "deep copy value {\n" - deep-copy-value src-val, dest-val -#? print-string 0, "}\n" - } - i <- increment - loop - } -#? print-string 0, "end deep-copy-table\n" -} - -fn bind-in-table _self: (addr table), key: (addr handle array byte), val: (addr value) { - var self/esi: (addr table) <- copy _self - var data-ah/esi: (addr handle array bind) <- get self, data - var _data/eax: (addr array bind) <- lookup *data-ah - var data/esi: (addr array bind) <- copy _data - var next-empty-slot-index/eax: (offset bind) <- next-empty-slot data, key - var dest/eax: (addr bind) <- index data, next-empty-slot-index - make-binding dest, key, val -} - -# manual test: full array of binds -fn next-empty-slot _data: (addr array bind), key: (addr handle array byte) -> _/eax: (offset bind) { - var data/esi: (addr array bind) <- copy _data - var len/ecx: int <- length data - var i/edx: int <- copy 0 - var result/eax: (offset bind) <- copy 0 - $next-empty-slot:loop: { - result <- compute-offset data, i - compare i, len - break-if->= - { - var target/esi: (addr bind) <- index data, result - var target2/esi: (addr handle array byte) <- get target, key - var target3/eax: (addr array byte) <- lookup *target2 - compare target3, 0 - break-if-= $next-empty-slot:loop - # TODO: how to indicate that key already exists? we don't want to permit rebinding - } - i <- increment - loop - } - return result -} - -fn make-number-binding _self: (addr bind), key: (addr handle array byte), _val: float { - var self/esi: (addr bind) <- copy _self - var dest/eax: (addr handle array byte) <- get self, key - copy-object key, dest - var dest2/eax: (addr handle value) <- get self, value - allocate dest2 - var dest3/eax: (addr value) <- lookup *dest2 - var dest4/eax: (addr float) <- get dest3, number-data - var val/xmm0: float <- copy _val - copy-to *dest4, val -} - -fn make-binding _self: (addr bind), key: (addr handle array byte), val: (addr value) { - var self/esi: (addr bind) <- copy _self - var dest/eax: (addr handle array byte) <- get self, key - copy-object key, dest - var dest2/eax: (addr handle value) <- get self, value - allocate dest2 - var dest3/eax: (addr value) <- lookup *dest2 - copy-object val, dest3 -} - -fn lookup-binding _self: (addr table), key: (addr array byte), out: (addr handle value) { - var self/esi: (addr table) <- copy _self - var data-ah/esi: (addr handle array bind) <- get self, data - var _data/eax: (addr array bind) <- lookup *data-ah - var data/esi: (addr array bind) <- copy _data - var len/edx: int <- length data - var i/ebx: int <- copy 0 - $lookup-binding:loop: { - compare i, len - break-if->= - { - var offset/edx: (offset bind) <- compute-offset data, i - var target-bind/esi: (addr bind) <- index data, offset - var target2/edx: (addr handle array byte) <- get target-bind, key - var target3/eax: (addr array byte) <- lookup *target2 - compare target3, 0 - break-if-= $lookup-binding:loop - var is-match?/eax: boolean <- string-equal? target3, key - compare is-match?, 0/false - break-if-= - # found - var target/eax: (addr handle value) <- get target-bind, value - copy-object target, out - break $lookup-binding:loop - } - i <- increment - loop - } -} - -fn dump-table _self: (addr table) { - var self/esi: (addr table) <- copy _self - var data-ah/esi: (addr handle array bind) <- get self, data - var _data/eax: (addr array bind) <- lookup *data-ah - var data/esi: (addr array bind) <- copy _data - var len/edx: int <- length data - var i/ebx: int <- copy 0 - { - compare i, len - break-if->= - var offset/edx: (offset bind) <- compute-offset data, i - var target-bind/esi: (addr bind) <- index data, offset - var key-ah/edx: (addr handle array byte) <- get target-bind, key - var key/eax: (addr array byte) <- lookup *key-ah - compare key, 0 - break-if-= - print-string 0, key - print-string 0, ": " - var val-ah/eax: (addr handle value) <- get target-bind, value - var val/eax: (addr value) <- lookup *val-ah - var type/eax: (addr int) <- get val, type - print-int32-hex 0, *type - print-string 0, "\n" - i <- increment - loop - } - print-string 0, "\n" -} diff --git a/apps/tile/value-stack.mu b/apps/tile/value-stack.mu deleted file mode 100644 index 886b4037..00000000 --- a/apps/tile/value-stack.mu +++ /dev/null @@ -1,149 +0,0 @@ -# support for non-int values is untested - -type value-stack { - data: (handle array value) - top: int -} - -fn initialize-value-stack _self: (addr value-stack), n: int { - var self/esi: (addr value-stack) <- copy _self - var d/edi: (addr handle array value) <- get self, data - populate d, n - var top/eax: (addr int) <- get self, top - copy-to *top, 0 -} - -fn clear-value-stack _self: (addr value-stack) { - var self/esi: (addr value-stack) <- copy _self - var top/eax: (addr int) <- get self, top - copy-to *top, 0 -} - -fn push-number-to-value-stack _self: (addr value-stack), _val: float { - var self/esi: (addr value-stack) <- copy _self - var top-addr/ecx: (addr int) <- get self, top - var data-ah/edx: (addr handle array value) <- get self, data - var data/eax: (addr array value) <- lookup *data-ah - var top/edx: int <- copy *top-addr - var dest-offset/edx: (offset value) <- compute-offset data, top - var dest-addr/edx: (addr value) <- index data, dest-offset - var dest-addr2/eax: (addr float) <- get dest-addr, number-data - var val/xmm0: float <- copy _val -#? print-float-decimal-approximate 0, val, 3 - copy-to *dest-addr2, val - increment *top-addr - var type-addr/eax: (addr int) <- get dest-addr, type - copy-to *type-addr, 0/number -} - -fn push-string-to-value-stack _self: (addr value-stack), val: (handle array byte) { - var self/esi: (addr value-stack) <- copy _self - var top-addr/ecx: (addr int) <- get self, top - var data-ah/edx: (addr handle array value) <- get self, data - var data/eax: (addr array value) <- lookup *data-ah - var top/edx: int <- copy *top-addr - var dest-offset/edx: (offset value) <- compute-offset data, top - var dest-addr/edx: (addr value) <- index data, dest-offset - var dest-addr2/eax: (addr handle array byte) <- get dest-addr, text-data - copy-handle val, dest-addr2 - var dest-addr3/eax: (addr int) <- get dest-addr, type -#? print-string 0, "setting type to 1: " -#? { -#? var foo/eax: int <- copy dest-addr3 -#? print-int32-hex 0, foo -#? } -#? print-string 0, "\n" - copy-to *dest-addr3, 1/string - increment *top-addr -} - -fn push-array-to-value-stack _self: (addr value-stack), val: (handle array value) { - var self/esi: (addr value-stack) <- copy _self - var top-addr/ecx: (addr int) <- get self, top - var data-ah/edx: (addr handle array value) <- get self, data - var data/eax: (addr array value) <- lookup *data-ah - var top/edx: int <- copy *top-addr - var dest-offset/edx: (offset value) <- compute-offset data, top - var dest-addr/edx: (addr value) <- index data, dest-offset - var dest-addr2/eax: (addr handle array value) <- get dest-addr, array-data - copy-handle val, dest-addr2 - # update type - var dest-addr3/eax: (addr int) <- get dest-addr, type - copy-to *dest-addr3, 2/array - increment *top-addr -} - -fn push-value-stack _self: (addr value-stack), val: (addr value) { - var self/esi: (addr value-stack) <- copy _self - var top-addr/ecx: (addr int) <- get self, top - var data-ah/edx: (addr handle array value) <- get self, data - var data/eax: (addr array value) <- lookup *data-ah - var top/edx: int <- copy *top-addr - var dest-offset/edx: (offset value) <- compute-offset data, top - var dest-addr/edx: (addr value) <- index data, dest-offset - copy-object val, dest-addr - increment *top-addr -} - -fn pop-number-from-value-stack _self: (addr value-stack) -> _/xmm0: float { - var self/esi: (addr value-stack) <- copy _self - var top-addr/ecx: (addr int) <- get self, top - { - compare *top-addr, 0 - break-if-> - var minus-one/eax: int <- copy -1 - var minus-one-f/xmm0: float <- convert minus-one - return minus-one-f - } - decrement *top-addr - var data-ah/edx: (addr handle array value) <- get self, data - var data/eax: (addr array value) <- lookup *data-ah - var top/edx: int <- copy *top-addr - var dest-offset/edx: (offset value) <- compute-offset data, top - var result-addr/eax: (addr value) <- index data, dest-offset - var result-addr2/eax: (addr float) <- get result-addr, number-data - return *result-addr2 -} - -fn value-stack-empty? _self: (addr value-stack) -> _/eax: boolean { - var self/esi: (addr value-stack) <- copy _self - var top/eax: (addr int) <- get self, top - compare *top, 0 - { - break-if-!= - return 1/true - } - return 0/false -} - -fn value-stack-length _self: (addr value-stack) -> _/eax: int { - var self/esi: (addr value-stack) <- copy _self - var top-addr/eax: (addr int) <- get self, top - return *top-addr -} - -fn save-lines in-h: (handle array (handle array byte)), _out-ah: (addr handle array value) { - var _in/eax: (addr array (handle array byte)) <- lookup in-h - var in/esi: (addr array (handle array byte)) <- copy _in - var len/ecx: int <- length in - var out-ah/edi: (addr handle array value) <- copy _out-ah - populate out-ah, len - var out/eax: (addr array value) <- lookup *out-ah - # copy in into out - var i/ebx: int <- copy 0 - { - compare i, len - break-if->= -#? print-int32-hex 0, i -#? print-string 0, "\n" - var src/ecx: (addr handle array byte) <- index in, i - var dest-offset/edx: (offset value) <- compute-offset out, i - var dest-val/edx: (addr value) <- index out, dest-offset - var dest/eax: (addr handle array byte) <- get dest-val, text-data - copy-object src, dest - var type/edx: (addr int) <- get dest-val, type - copy-to *type, 1/string - i <- increment - loop - } -} diff --git a/apps/tile/value.mu b/apps/tile/value.mu deleted file mode 100644 index 8bd01676..00000000 --- a/apps/tile/value.mu +++ /dev/null @@ -1,424 +0,0 @@ -fn render-value-at screen: (addr screen), row: int, col: int, _val: (addr value), top-level?: boolean { - move-cursor screen, row, col - var val/esi: (addr value) <- copy _val - var val-type/ecx: (addr int) <- get val, type - # per-type rendering logic goes here - compare *val-type, 1/string - { - break-if-!= - var val-ah/eax: (addr handle array byte) <- get val, text-data - var val-string/eax: (addr array byte) <- lookup *val-ah - compare val-string, 0 - break-if-= - var orig-len/ecx: int <- length val-string - var truncated: (handle array byte) - var truncated-ah/esi: (addr handle array byte) <- address truncated - substring val-string, 0, 0xc, truncated-ah - var truncated-string/eax: (addr array byte) <- lookup *truncated-ah - var len/edx: int <- length truncated-string - start-color screen, 0xf2, 7 - print-code-point screen, 0x275d/open-quote - print-string screen, truncated-string - compare len, orig-len - { - break-if-= - print-code-point screen, 0x2026/ellipses - } - print-code-point screen, 0x275e/close-quote - reset-formatting screen - return - } - compare *val-type, 2/array - { - break-if-!= - var val-ah/eax: (addr handle array value) <- get val, array-data - var val-array/eax: (addr array value) <- lookup *val-ah - render-array-at screen, row, col, val-array - return - } - compare *val-type, 3/file - { - break-if-!= - var val-ah/eax: (addr handle buffered-file) <- get val, file-data - var val-file/eax: (addr buffered-file) <- lookup *val-ah - start-color screen, 0, 7 - # TODO - print-string screen, " FILE " - return - } - compare *val-type, 4/screen - { - break-if-!= -#? print-string 0, "render-screen" - var val-ah/eax: (addr handle screen) <- get val, screen-data - var val-screen/eax: (addr screen) <- lookup *val-ah - render-screen screen, row, col, val-screen -#? print-string 0, "}\n" - return - } - # render ints by default for now - var val-num/eax: (addr float) <- get val, number-data - render-number screen, *val-num, top-level? -} - -# synaesthesia -# TODO: right-justify -fn render-number screen: (addr screen), val: float, top-level?: boolean { - # if we're inside an array, don't color - compare top-level?, 0 - { - break-if-!= - print-float-decimal-approximate screen, val, 3 - return - } - var val-int/eax: int <- convert val - var bg/eax: int <- hash-color val-int - var fg/ecx: int <- copy 7 - { - compare bg, 2 - break-if-!= - fg <- copy 0 - } - { - compare bg, 3 - break-if-!= - fg <- copy 0 - } - { - compare bg, 6 - break-if-!= - fg <- copy 0 - } - start-color screen, fg, bg - print-grapheme screen, 0x20/space - print-float-decimal-approximate screen, val, 3 - print-grapheme screen, 0x20/space -} - -fn render-array-at screen: (addr screen), row: int, col: int, _a: (addr array value) { - start-color screen, 0xf2, 7 - # don't surround in spaces - print-grapheme screen, 0x5b/[ - increment col - var a/esi: (addr array value) <- copy _a - var max/ecx: int <- length a - var i/eax: int <- copy 0 - { - compare i, max - break-if->= - { - compare i, 0 - break-if-= - print-string screen, " " - } - var off/ecx: (offset value) <- compute-offset a, i - var x/ecx: (addr value) <- index a, off - render-value-at screen, row, col, x, 0 - { - var w/eax: int <- value-width x, 0 - add-to col, w - increment col - } - i <- increment - loop - } - print-grapheme screen, 0x5d/] -} - -fn render-screen screen: (addr screen), row: int, col: int, _target-screen: (addr screen) { - reset-formatting screen - move-cursor screen, row, col - var target-screen/esi: (addr screen) <- copy _target-screen - var ncols-a/ecx: (addr int) <- get target-screen, num-cols - print-upper-border screen, *ncols-a - var r/edx: int <- copy 1 - var nrows-a/ebx: (addr int) <- get target-screen, num-rows - { - compare r, *nrows-a - break-if-> - increment row # mutate arg - move-cursor screen, row, col - print-string screen, " " - var c/edi: int <- copy 1 - { - compare c, *ncols-a - break-if-> - print-screen-cell-of-fake-screen screen, target-screen, r, c - c <- increment - loop - } - print-string screen, " " - r <- increment - loop - } - increment row # mutate arg - move-cursor screen, row, col - print-lower-border screen, *ncols-a -} - -fn hash-color val: int -> _/eax: int { - var quotient/eax: int <- copy 0 - var remainder/edx: int <- copy 0 - quotient, remainder <- integer-divide val, 7 # assumes that 7 is always the background color - return remainder -} - -fn print-screen-cell-of-fake-screen screen: (addr screen), _target: (addr screen), _row: int, _col: int { - start-color screen, 0, 0xf6 - var target/esi: (addr screen) <- copy _target - var row/ecx: int <- copy _row - var col/edx: int <- copy _col - # if cursor is at screen-cell, add some fancy - { - var cursor-row/eax: (addr int) <- get target, cursor-row - compare *cursor-row, row - break-if-!= - var cursor-col/eax: (addr int) <- get target, cursor-col - compare *cursor-col, col - break-if-!= - start-blinking screen - start-color screen, 0, 1 - } - var g/eax: grapheme <- screen-grapheme-at target, row, col - { - compare g, 0 - break-if-!= - g <- copy 0x20/space - } - print-grapheme screen, g - reset-formatting screen -} - -fn print-upper-border screen: (addr screen), width: int { - print-code-point screen, 0x250c/top-left-corner - var i/eax: int <- copy 0 - { - compare i, width - break-if->= - print-code-point screen, 0x2500/horizontal-line - i <- increment - loop - } - print-code-point screen, 0x2510/top-right-corner -} - -fn print-lower-border screen: (addr screen), width: int { - print-code-point screen, 0x2514/bottom-left-corner - var i/eax: int <- copy 0 - { - compare i, width - break-if->= - print-code-point screen, 0x2500/horizontal-line - i <- increment - loop - } - print-code-point screen, 0x2518/bottom-right-corner -} - -fn value-width _v: (addr value), top-level: boolean -> _/eax: int { - var v/esi: (addr value) <- copy _v - var type/eax: (addr int) <- get v, type - { - compare *type, 0/int - break-if-!= - var v-num/edx: (addr float) <- get v, number-data - var result/eax: int <- float-size *v-num, 3 - return result - } - { - compare *type, 1/string - break-if-!= - var s-ah/eax: (addr handle array byte) <- get v, text-data - var s/eax: (addr array byte) <- lookup *s-ah - compare s, 0 - break-if-= - var result/eax: int <- length s - compare result, 0xd/max-string-size - { - break-if-<= - result <- copy 0xd - } - # if it's a nested string, include space for quotes - # we don't do this for the top-level, where the quotes will overflow - # into surrounding padding. - compare top-level, 0/false - { - break-if-!= - result <- add 2 - } - return result - } - { - compare *type, 2/array - break-if-!= - var a-ah/eax: (addr handle array value) <- get v, array-data - var a/eax: (addr array value) <- lookup *a-ah - compare a, 0 - break-if-= - var result/eax: int <- array-width a - return result - } - { - compare *type, 3/file - break-if-!= - var f-ah/eax: (addr handle buffered-file) <- get v, file-data - var f/eax: (addr buffered-file) <- lookup *f-ah - compare f, 0 - break-if-= - # TODO: visualizing file handles - return 4 - } - { - compare *type, 4/screen - break-if-!= - var screen-ah/eax: (addr handle screen) <- get v, screen-data - var screen/eax: (addr screen) <- lookup *screen-ah - compare screen, 0 - break-if-= - var ncols/ecx: (addr int) <- get screen, num-cols - var result/eax: int <- copy *ncols - result <- add 2 # left/right margins - return *ncols - } - return 0 -} - -# keep sync'd with render-array-at -fn array-width _a: (addr array value) -> _/eax: int { - var a/esi: (addr array value) <- copy _a - var max/ecx: int <- length a - var i/eax: int <- copy 0 - var result/edi: int <- copy 0 - { - compare i, max - break-if->= - { - compare i, 0 - break-if-= - result <- increment # for space - } - var off/ecx: (offset value) <- compute-offset a, i - var x/ecx: (addr value) <- index a, off - { - var w/eax: int <- value-width x, 0 - result <- add w - } - i <- increment - loop - } - # we won't add 2 for surrounding brackets since we don't surround arrays in - # spaces like other value types - return result -} - -fn value-height _v: (addr value) -> _/eax: int { - var v/esi: (addr value) <- copy _v - var type/eax: (addr int) <- get v, type - { - compare *type, 3/file - break-if-!= - # TODO: visualizing file handles - return 1 - } - { - compare *type, 4/screen - break-if-!= - var screen-ah/eax: (addr handle screen) <- get v, screen-data - var screen/eax: (addr screen) <- lookup *screen-ah - compare screen, 0 - break-if-= - var nrows/ecx: (addr int) <- get screen, num-rows - var result/eax: int <- copy *nrows - result <- add 2 # top and bottom border - return result - } - return 1 -} - -fn deep-copy-value _src: (addr value), _dest: (addr value) { -#? print-string 0, "deep-copy-value\n" - var src/esi: (addr value) <- copy _src - var dest/edi: (addr value) <- copy _dest - var type/ebx: (addr int) <- get src, type - var y/ecx: (addr int) <- get dest, type - copy-object type, y - compare *type, 0 # int - { - break-if-!= -#? print-string 0, "int value\n" - var src-n/eax: (addr float) <- get src, number-data - var dest-n/ecx: (addr float) <- get dest, number-data - copy-object src-n, dest-n - return - } - compare *type, 1/string - { - break-if-!= -#? print-string 0, "string value\n" - var src-ah/eax: (addr handle array byte) <- get src, text-data - var src/eax: (addr array byte) <- lookup *src-ah - var dest-ah/edx: (addr handle array byte) <- get dest, text-data - copy-array-object src, dest-ah - return - } - compare *type, 2/array - { - break-if-!= -#? print-string 0, "array value\n" - var src-ah/eax: (addr handle array value) <- get src, array-data - var _src/eax: (addr array value) <- lookup *src-ah - var src/esi: (addr array value) <- copy _src - var n/ecx: int <- length src - var dest-ah/edx: (addr handle array value) <- get dest, array-data - populate dest-ah, n - var _dest/eax: (addr array value) <- lookup *dest-ah - var dest/edi: (addr array value) <- copy _dest - var i/eax: int <- copy 0 - { - compare i, n - break-if->= - { - var offset/edx: (offset value) <- compute-offset src, i - var src-element/eax: (addr value) <- index src, offset - var dest-element/ecx: (addr value) <- index dest, offset - deep-copy-value src-element, dest-element - } - i <- increment - loop - } - copy-array-object src, dest-ah - return - } - compare *type, 3/file - { - break-if-!= -#? print-string 0, "file value\n" - var src-filename-ah/eax: (addr handle array byte) <- get src, filename - var _src-filename/eax: (addr array byte) <- lookup *src-filename-ah - var src-filename/ecx: (addr array byte) <- copy _src-filename - var dest-filename-ah/ebx: (addr handle array byte) <- get dest, filename - copy-array-object src-filename, dest-filename-ah - var src-file-ah/eax: (addr handle buffered-file) <- get src, file-data - var src-file/eax: (addr buffered-file) <- lookup *src-file-ah - var dest-file-ah/edx: (addr handle buffered-file) <- get dest, file-data - copy-file src-file, dest-file-ah, src-filename - return - } - compare *type, 4/screen - { - break-if-!= -#? print-string 0, "screen value\n" - var src-screen-ah/eax: (addr handle screen) <- get src, screen-data - var _src-screen/eax: (addr screen) <- lookup *src-screen-ah - var src-screen/ecx: (addr screen) <- copy _src-screen - var dest-screen-ah/eax: (addr handle screen) <- get dest, screen-data - allocate dest-screen-ah - var dest-screen/eax: (addr screen) <- lookup *dest-screen-ah - copy-object src-screen, dest-screen - var dest-screen-data-ah/ebx: (addr handle array screen-cell) <- get dest-screen, data - var src-screen-data-ah/eax: (addr handle array screen-cell) <- get src-screen, data - var src-screen-data/eax: (addr array screen-cell) <- lookup *src-screen-data-ah - copy-array-object src-screen-data, dest-screen-data-ah - return - } -} diff --git a/apps/tile/vimrc.vim b/apps/tile/vimrc.vim deleted file mode 100644 index 348fe364..00000000 --- a/apps/tile/vimrc.vim +++ /dev/null @@ -1,2 +0,0 @@ -" when opening files in this directory, load vimrc from cwd (top-level) -source vimrc.vim diff --git a/apps/tile/word.mu b/apps/tile/word.mu deleted file mode 100644 index b4f5000b..00000000 --- a/apps/tile/word.mu +++ /dev/null @@ -1,573 +0,0 @@ -fn initialize-word _self: (addr word) { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - allocate data-ah - var data/eax: (addr gap-buffer) <- lookup *data-ah - initialize-gap-buffer data -} - -## some helpers for creating words. mostly for tests - -fn initialize-word-with _self: (addr word), s: (addr array byte) { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - allocate data-ah - var data/eax: (addr gap-buffer) <- lookup *data-ah - initialize-gap-buffer-with data, s -} - -fn allocate-word-with _out: (addr handle word), s: (addr array byte) { - var out/eax: (addr handle word) <- copy _out - allocate out - var out-addr/eax: (addr word) <- lookup *out - initialize-word-with out-addr, s -} - -# just for tests for now -# TODO: handle existing next -# one implication of handles: append must take a handle -fn append-word-with self-h: (handle word), s: (addr array byte) { - var self/eax: (addr word) <- lookup self-h - var next-ah/eax: (addr handle word) <- get self, next - allocate-word-with next-ah, s - var next/eax: (addr word) <- lookup *next-ah - var prev-ah/eax: (addr handle word) <- get next, prev - copy-handle self-h, prev-ah -} - -# just for tests for now -# TODO: handle existing prev -fn prepend-word-with self-h: (handle word), s: (addr array byte) { - var self/eax: (addr word) <- lookup self-h - var prev-ah/eax: (addr handle word) <- get self, prev - allocate-word-with prev-ah, s - var prev/eax: (addr word) <- lookup *prev-ah - var next-ah/eax: (addr handle word) <- get prev, next - copy-handle self-h, next-ah -} - -## real primitives - -fn move-word-contents _src-ah: (addr handle word), _dest-ah: (addr handle word) { - var dest-ah/eax: (addr handle word) <- copy _dest-ah - var _dest/eax: (addr word) <- lookup *dest-ah - var dest/edi: (addr word) <- copy _dest - var src-ah/eax: (addr handle word) <- copy _src-ah - var _src/eax: (addr word) <- lookup *src-ah - var src/esi: (addr word) <- copy _src - cursor-to-start src - var src-data-ah/eax: (addr handle gap-buffer) <- get src, scalar-data - var src-data/eax: (addr gap-buffer) <- lookup *src-data-ah - var src-stack/ecx: (addr grapheme-stack) <- get src-data, right - { - var done?/eax: boolean <- grapheme-stack-empty? src-stack - compare done?, 0/false - break-if-!= - var g/eax: grapheme <- pop-grapheme-stack src-stack -#? print-grapheme 0, g -#? print-string 0, "\n" - add-grapheme-to-word dest, g - loop - } -} - -fn copy-word-contents-before-cursor _src-ah: (addr handle word), _dest-ah: (addr handle word) { - var dest-ah/eax: (addr handle word) <- copy _dest-ah - var _dest/eax: (addr word) <- lookup *dest-ah - var dest/edi: (addr word) <- copy _dest - var src-ah/eax: (addr handle word) <- copy _src-ah - var src/eax: (addr word) <- lookup *src-ah - var src-data-ah/eax: (addr handle gap-buffer) <- get src, scalar-data - var src-data/eax: (addr gap-buffer) <- lookup *src-data-ah - var src-stack/ecx: (addr grapheme-stack) <- get src-data, left - var src-stack-data-ah/eax: (addr handle array grapheme) <- get src-stack, data - var _src-stack-data/eax: (addr array grapheme) <- lookup *src-stack-data-ah - var src-stack-data/edx: (addr array grapheme) <- copy _src-stack-data - var top-addr/ecx: (addr int) <- get src-stack, top - var i/eax: int <- copy 0 - { - compare i, *top-addr - break-if->= - var g/edx: (addr grapheme) <- index src-stack-data, i - add-grapheme-to-word dest, *g - i <- increment - loop - } -} - -fn word-equal? _self: (addr word), s: (addr array byte) -> _/eax: boolean { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - var result/eax: boolean <- gap-buffer-equal? data, s - return result -} - -fn word-length _self: (addr word) -> _/eax: int { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - var result/eax: int <- gap-buffer-length data - return result -} - -fn final-word _in: (addr handle word), out: (addr handle word) { - var curr-h: (handle word) - var curr-ah/esi: (addr handle word) <- address curr-h - copy-object _in, curr-ah - var curr/eax: (addr word) <- copy 0 - var next/edi: (addr handle word) <- copy 0 - { - curr <- lookup *curr-ah - next <- get curr, next - curr <- lookup *next - compare curr, 0 - break-if-= - copy-object next, curr-ah - loop - } - copy-object curr-ah, out # modify 'out' right at the end, just in case it's same as 'in' -} - -fn first-grapheme _self: (addr word) -> _/eax: grapheme { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - var result/eax: grapheme <- first-grapheme-in-gap-buffer data - return result -} - -fn grapheme-before-cursor _self: (addr word) -> _/eax: grapheme { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - var result/eax: grapheme <- grapheme-before-cursor-in-gap-buffer data - return result -} - -fn add-grapheme-to-word _self: (addr word), c: grapheme { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - add-grapheme-at-gap data, c -} - -fn cursor-at-start? _self: (addr word) -> _/eax: boolean { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - var result/eax: boolean <- gap-at-start? data - return result -} - -fn cursor-at-end? _self: (addr word) -> _/eax: boolean { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - var result/eax: boolean <- gap-at-end? data - return result -} - -fn cursor-left _self: (addr word) { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - var dummy/eax: grapheme <- gap-left data -} - -fn cursor-right _self: (addr word) { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - var dummy/eax: grapheme <- gap-right data -} - -fn cursor-to-start _self: (addr word) { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - gap-to-start data -} - -fn cursor-to-end _self: (addr word) { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - gap-to-end data -} - -fn cursor-index _self: (addr word) -> _/eax: int { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - var result/eax: int <- gap-index data - return result -} - -fn delete-before-cursor _self: (addr word) { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - delete-before-gap data -} - -fn pop-after-cursor _self: (addr word) -> _/eax: grapheme { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - var result/eax: grapheme <- pop-after-gap data - return result -} - -fn delete-next _self: (addr word) { - var self/esi: (addr word) <- copy _self - var next-ah/edi: (addr handle word) <- get self, next - var next/eax: (addr word) <- lookup *next-ah - compare next, 0 - break-if-= - var next-next-ah/ecx: (addr handle word) <- get next, next - var self-ah/esi: (addr handle word) <- get next, prev - copy-object next-next-ah, next-ah - var new-next/eax: (addr word) <- lookup *next-next-ah - compare new-next, 0 - break-if-= - var dest/eax: (addr handle word) <- get new-next, prev - copy-object self-ah, dest -} - -fn print-word screen: (addr screen), _self: (addr word) { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - render-gap-buffer screen, data -} - -fn print-words-in-reverse screen: (addr screen), _words-ah: (addr handle word) { - var words-ah/eax: (addr handle word) <- copy _words-ah - var words-a/eax: (addr word) <- lookup *words-ah - compare words-a, 0 - break-if-= - # recurse - var next-ah/ecx: (addr handle word) <- get words-a, next - print-words-in-reverse screen, next-ah - # print - print-word screen, words-a - print-string screen, " " -} - -# Gotcha with some word operations: ensure dest-ah isn't in the middle of some -# existing chain of words. There are two pointers to patch, and you'll forget -# to do the other one. -fn copy-words _src-ah: (addr handle word), _dest-ah: (addr handle word) { - var src-ah/eax: (addr handle word) <- copy _src-ah - var src-a/eax: (addr word) <- lookup *src-ah - compare src-a, 0 - break-if-= - # copy - var dest-ah/edi: (addr handle word) <- copy _dest-ah - copy-word src-a, dest-ah - # recurse - var rest: (handle word) - var rest-ah/ecx: (addr handle word) <- address rest - var next-src-ah/esi: (addr handle word) <- get src-a, next - copy-words next-src-ah, rest-ah - chain-words dest-ah, rest-ah -} - -fn copy-words-in-reverse _src-ah: (addr handle word), _dest-ah: (addr handle word) { - var src-ah/eax: (addr handle word) <- copy _src-ah - var _src-a/eax: (addr word) <- lookup *src-ah - var src-a/esi: (addr word) <- copy _src-a - compare src-a, 0 - break-if-= - # recurse - var next-src-ah/ecx: (addr handle word) <- get src-a, next - var dest-ah/edi: (addr handle word) <- copy _dest-ah - copy-words-in-reverse next-src-ah, dest-ah - # - copy-word-at-end src-a, dest-ah -} - -fn copy-word-at-end src: (addr word), _dest-ah: (addr handle word) { - var dest-ah/edi: (addr handle word) <- copy _dest-ah - # if dest is null, copy and return - var dest-a/eax: (addr word) <- lookup *dest-ah - compare dest-a, 0 - { - break-if-!= - copy-word src, dest-ah - return - } - # copy current word - var new: (handle word) - var new-ah/ecx: (addr handle word) <- address new - copy-word src, new-ah - # append it at the end - var curr-ah/edi: (addr handle word) <- copy dest-ah - { - var curr-a/eax: (addr word) <- lookup *curr-ah # curr-a guaranteed not to be null - var next-ah/ecx: (addr handle word) <- get curr-a, next - var next-a/eax: (addr word) <- lookup *next-ah - compare next-a, 0 - break-if-= - curr-ah <- copy next-ah - loop - } - chain-words curr-ah, new-ah -} - -fn append-word-at-end-with _dest-ah: (addr handle word), s: (addr array byte) { - var dest-ah/edi: (addr handle word) <- copy _dest-ah - # if dest is null, copy and return - var dest-a/eax: (addr word) <- lookup *dest-ah - compare dest-a, 0 - { - break-if-!= - allocate-word-with dest-ah, s - return - } - # otherwise append at end - var curr-ah/edi: (addr handle word) <- copy dest-ah - { - var curr-a/eax: (addr word) <- lookup *curr-ah # curr-a guaranteed not to be null - var next-ah/ecx: (addr handle word) <- get curr-a, next - var next-a/eax: (addr word) <- lookup *next-ah - compare next-a, 0 - break-if-= - curr-ah <- copy next-ah - loop - } - append-word-with *curr-ah, s -} - -fn copy-word _src-a: (addr word), _dest-ah: (addr handle word) { - var dest-ah/eax: (addr handle word) <- copy _dest-ah - allocate dest-ah - var _dest-a/eax: (addr word) <- lookup *dest-ah - var dest-a/eax: (addr word) <- copy _dest-a - initialize-word dest-a - var dest/edi: (addr handle gap-buffer) <- get dest-a, scalar-data - var src-a/eax: (addr word) <- copy _src-a - var src/eax: (addr handle gap-buffer) <- get src-a, scalar-data - copy-gap-buffer src, dest -} - -# one implication of handles: append must take a handle -fn append-word _self-ah: (addr handle word) { - var saved-self-storage: (handle word) - var saved-self/eax: (addr handle word) <- address saved-self-storage - copy-object _self-ah, saved-self -#? { -#? print-string 0, "self-ah is " -#? var foo/eax: int <- copy _self-ah -#? print-int32-hex 0, foo -#? print-string 0, "\n" -#? } - var self-ah/esi: (addr handle word) <- copy _self-ah - var _self/eax: (addr word) <- lookup *self-ah - var self/ebx: (addr word) <- copy _self -#? { -#? print-string 0, "0: self is " -#? var self-ah/eax: (addr handle word) <- copy _self-ah -#? var self/eax: (addr word) <- lookup *self-ah -#? var foo/eax: int <- copy self -#? print-int32-hex 0, foo -#? print-string 0, "\n" -#? } - # allocate new handle - var new: (handle word) - var new-ah/ecx: (addr handle word) <- address new - allocate new-ah - var new-addr/eax: (addr word) <- lookup new - initialize-word new-addr -#? { -#? print-string 0, "new is " -#? var foo/eax: int <- copy new-addr -#? print-int32-hex 0, foo -#? print-string 0, "\n" -#? } - # new->next = self->next - var src/esi: (addr handle word) <- get self, next -#? { -#? print-string 0, "src is " -#? var foo/eax: int <- copy src -#? print-int32-hex 0, foo -#? print-string 0, "\n" -#? } - var dest/edi: (addr handle word) <- get new-addr, next - copy-object src, dest - # new->next->prev = new - { - var next-addr/eax: (addr word) <- lookup *src - compare next-addr, 0 - break-if-= -#? { -#? print-string 0, "next-addr is " -#? var foo/eax: int <- copy next-addr -#? print-int32-hex 0, foo -#? print-string 0, "\n" -#? } - dest <- get next-addr, prev -#? #? { -#? #? print-string 0, "self-ah is " -#? #? var foo/eax: int <- copy _self-ah -#? #? print-int32-hex 0, foo -#? #? print-string 0, "\n" -#? #? print-string 0, "2: self is " -#? #? var self-ah/eax: (addr handle word) <- copy _self-ah -#? #? var self/eax: (addr word) <- lookup *self-ah -#? #? var foo/eax: int <- copy self -#? #? print-int32-hex 0, foo -#? #? print-string 0, "\n" -#? #? } -#? { -#? print-string 0, "copying new to " -#? var foo/eax: int <- copy dest -#? print-int32-hex 0, foo -#? print-string 0, "\n" -#? } - copy-object new-ah, dest -#? { -#? print-string 0, "4: self is " -#? var self-ah/eax: (addr handle word) <- copy _self-ah -#? var self/eax: (addr word) <- lookup *self-ah -#? var foo/eax: int <- copy self -#? print-int32-hex 0, foo -#? print-string 0, "\n" -#? } - } - # new->prev = saved-self - dest <- get new-addr, prev -#? { -#? print-string 0, "copying " -#? var self-ah/esi: (addr handle word) <- copy _self-ah -#? var self/eax: (addr word) <- lookup *self-ah -#? var foo/eax: int <- copy self -#? print-int32-hex 0, foo -#? print-string 0, " to " -#? foo <- copy dest -#? print-int32-hex 0, foo -#? print-string 0, "\n" -#? } - var saved-self-ah/eax: (addr handle word) <- address saved-self-storage - copy-object saved-self-ah, dest - # self->next = new - dest <- get self, next - copy-object new-ah, dest -} - -fn chain-words _self-ah: (addr handle word), _next: (addr handle word) { - var self-ah/esi: (addr handle word) <- copy _self-ah - var _self/eax: (addr word) <- lookup *self-ah - var self/ecx: (addr word) <- copy _self - var dest/edx: (addr handle word) <- get self, next - var next-ah/edi: (addr handle word) <- copy _next - copy-object next-ah, dest - var next/eax: (addr word) <- lookup *next-ah - compare next, 0 - break-if-= - dest <- get next, prev - copy-object self-ah, dest -} - -fn emit-word _self: (addr word), out: (addr stream byte) { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - emit-gap-buffer data, out -} - -fn word-to-string _self: (addr word), out: (addr handle array byte) { - var self/esi: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - gap-buffer-to-string data, out -} - -fn word-is-decimal-integer? _self: (addr word) -> _/eax: boolean { - var self/eax: (addr word) <- copy _self - var data-ah/eax: (addr handle gap-buffer) <- get self, scalar-data - var data/eax: (addr gap-buffer) <- lookup *data-ah - var result/eax: boolean <- gap-buffer-is-decimal-integer? data - return result -} - -# ABSOLUTELY GHASTLY -fn word-exists? _haystack-ah: (addr handle word), _needle: (addr word) -> _/ebx: boolean { - var needle-name-storage: (handle array byte) - var needle-name-ah/eax: (addr handle array byte) <- address needle-name-storage - word-to-string _needle, needle-name-ah # profligate leak - var _needle-name/eax: (addr array byte) <- lookup *needle-name-ah - var needle-name/edi: (addr array byte) <- copy _needle-name - # base case - var haystack-ah/esi: (addr handle word) <- copy _haystack-ah - var curr/eax: (addr word) <- lookup *haystack-ah - compare curr, 0 - { - break-if-!= - return 0/false - } - # check curr - var curr-name-storage: (handle array byte) - var curr-name-ah/ecx: (addr handle array byte) <- address curr-name-storage - word-to-string curr, curr-name-ah # profligate leak - var curr-name/eax: (addr array byte) <- lookup *curr-name-ah - var found?/eax: boolean <- string-equal? needle-name, curr-name - compare found?, 0 - { - break-if-= - return 1/true - } - # recurse - var curr/eax: (addr word) <- lookup *haystack-ah - var next-haystack-ah/eax: (addr handle word) <- get curr, next - var result/ebx: boolean <- word-exists? next-haystack-ah, _needle - return result -} - -fn word-list-length words: (addr handle word) -> _/eax: int { - var curr-ah/esi: (addr handle word) <- copy words - var result/edi: int <- copy 0 - { - var curr/eax: (addr word) <- lookup *curr-ah - compare curr, 0 - break-if-= - { - var word-len/eax: int <- word-length curr - result <- add word-len - result <- add 1/inter-word-margin - } - curr-ah <- get curr, next - loop - } - return result -} - -# out-ah already has a word allocated and initialized -fn parse-words in: (addr array byte), out-ah: (addr handle word) { - var in-stream: (stream byte 0x100) - var in-stream-a/esi: (addr stream byte) <- address in-stream - write in-stream-a, in - var cursor-word-ah/ebx: (addr handle word) <- copy out-ah - $parse-words:loop: { - var done?/eax: boolean <- stream-empty? in-stream-a - compare done?, 0/false - break-if-!= - var _g/eax: grapheme <- read-grapheme in-stream-a - var g/ecx: grapheme <- copy _g - # if not space, insert - compare g, 0x20/space - { - break-if-= - var cursor-word/eax: (addr word) <- lookup *cursor-word-ah - add-grapheme-to-word cursor-word, g - loop $parse-words:loop - } - # otherwise insert word after and move cursor to it - append-word cursor-word-ah - var cursor-word/eax: (addr word) <- lookup *cursor-word-ah - cursor-to-start cursor-word # reset cursor in each function - cursor-word-ah <- get cursor-word, next - loop - } -} |