diff options
| -rw-r--r-- | 317abort.subx | 6 | ||||
| -rw-r--r-- | shell/cell.mu | 25 | ||||
| -rw-r--r-- | shell/primitives.mu | 209 | ||||
| -rwxr-xr-x | translate_subx | 2 | ||||
| -rwxr-xr-x | translate_subx_emulated | 2 |
5 files changed, 239 insertions, 5 deletions
diff --git a/317abort.subx b/317abort.subx index 643d1ef5..5ee3b37f 100644 --- a/317abort.subx +++ b/317abort.subx @@ -27,10 +27,10 @@ dump-call-stack: 51/push-ecx 52/push-edx 53/push-ebx - # var labels/edx: (addr stream {start-address, label-slice} 0x4000) + # var labels/edx: (addr stream {start-address, label-slice} 0x5000) # start addresses are in ascending order - 81 5/subop/subtract %esp 0x30000/imm32 # 0x4000 labels * 12 bytes per label - 68/push 0x30000/imm32 + 81 5/subop/subtract %esp 0x3c000/imm32 # 0x5000 labels * 12 bytes per label + 68/push 0x3c000/imm32 68/push 0/imm32/read 68/push 0/imm32/write 89/<- %edx 4/r32/esp diff --git a/shell/cell.mu b/shell/cell.mu index 79a9fb17..ada86a29 100644 --- a/shell/cell.mu +++ b/shell/cell.mu @@ -16,6 +16,8 @@ type cell { keyboard-data: (handle gap-buffer) # type 7: array array-data: (handle array handle cell) + # type 8: image + image-data: (handle image) # TODO: (associative) table # if you add types here, don't forget to update cell-isomorphic? } @@ -295,3 +297,26 @@ fn array? _x: (addr cell) -> _/eax: boolean { } return 1/true } + +fn new-image _out-ah: (addr handle cell), in: (addr stream byte) { + var out-ah/eax: (addr handle cell) <- copy _out-ah + allocate out-ah + var out/eax: (addr cell) <- lookup *out-ah + var type/ecx: (addr int) <- get out, type + copy-to *type, 8/image + var dest-ah/eax: (addr handle image) <- get out, image-data + allocate dest-ah + var dest/eax: (addr image) <- lookup *dest-ah + initialize-image dest, in +} + +fn image? _x: (addr cell) -> _/eax: boolean { + var x/esi: (addr cell) <- copy _x + var type/eax: (addr int) <- get x, type + compare *type, 8/image + { + break-if-= + return 0/false + } + return 1/true +} diff --git a/shell/primitives.mu b/shell/primitives.mu index b511cc01..d38eedbc 100644 --- a/shell/primitives.mu +++ b/shell/primitives.mu @@ -60,6 +60,8 @@ fn initialize-primitives _self: (addr global-table) { append-primitive self, "populate" append-primitive self, "index" append-primitive self, "iset" + # for images + append-primitive self, "img" # misc append-primitive self, "abort" # keep sync'd with render-primitives @@ -113,6 +115,13 @@ fn render-primitives screen: (addr screen), xmin: int, xmax: int, ymax: int { var tmpx/eax: int <- copy right-min tmpx <- draw-text-rightward screen, " populate", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg tmpx <- draw-text-rightward screen, ": int _ -> array", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg + y <- increment + set-cursor-position screen, right-min, y + draw-text-wrapping-right-then-down-from-cursor screen, "images", right-min, y, xmax, ymax, 7/fg=grey, 0xdc/bg=green-bg + y <- increment + var tmpx/eax: int <- copy right-min + tmpx <- draw-text-rightward screen, " img", tmpx, xmax, y, 0x2a/fg=orange, 0xdc/bg=green-bg + tmpx <- draw-text-rightward screen, ": screen stream x y w h", tmpx, xmax, y, 7/fg=grey, 0xdc/bg=green-bg #? { #? compare screen, 0 #? break-if-!= @@ -587,6 +596,13 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand return } { + var render-image?/eax: boolean <- string-equal? f-name, "img" + compare render-image?, 0/false + break-if-= + apply-render-image args-ah, out, trace + return + } + { var abort?/eax: boolean <- string-equal? f-name, "abort" compare abort?, 0/false break-if-= @@ -3756,6 +3772,199 @@ fn apply-iset _args-ah: (addr handle cell), out: (addr handle cell), trace: (add # return nothing } +fn apply-render-image _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { + trace-text trace, "eval", "apply 'img'" + var args-ah/eax: (addr handle cell) <- copy _args-ah + var _args/eax: (addr cell) <- lookup *args-ah + var args/esi: (addr cell) <- copy _args + { + var args-type/eax: (addr int) <- get args, type + compare *args-type, 0/pair + break-if-= + error trace, "args to 'img' are not a list" + return + } + var empty-args?/eax: boolean <- nil? args + compare empty-args?, 0/false + { + break-if-= + error trace, "'img' needs 6 args but got 0" + return + } + # screen = args->left + var first-ah/eax: (addr handle cell) <- get args, left + var first/eax: (addr cell) <- lookup *first-ah + { + var first-type/eax: (addr int) <- get first, type + compare *first-type, 5/screen + break-if-= + error trace, "first arg for 'img' is not a screen" + return + } + var screen-ah/eax: (addr handle screen) <- get first, screen-data + var _screen/eax: (addr screen) <- lookup *screen-ah + var screen/edi: (addr screen) <- copy _screen + # x1 = args->right->left->value + var rest-ah/eax: (addr handle cell) <- get args, right + var _rest/eax: (addr cell) <- lookup *rest-ah + var rest/esi: (addr cell) <- copy _rest + { + var rest-type/eax: (addr int) <- get rest, type + compare *rest-type, 0/pair + break-if-= + error trace, "'img' encountered non-pair" + return + } + { + var rest-nil?/eax: boolean <- nil? rest + compare rest-nil?, 0/false + break-if-= + error trace, "'img' needs 6 args but got 1" + return + } + var second-ah/eax: (addr handle cell) <- get rest, left + var second/eax: (addr cell) <- lookup *second-ah + { + var second-type/eax: (addr int) <- get second, type + compare *second-type, 3/stream + break-if-= + error trace, "second arg for 'img' is not a stream (image data in ascii netpbm)" + return + } + var img-data-ah/eax: (addr handle stream byte) <- get second, text-data + var img-data/eax: (addr stream byte) <- lookup *img-data-ah + var img-h: (handle cell) + var img-ah/ecx: (addr handle cell) <- address img-h + new-image img-ah, img-data + # x = rest->right->left->value + var rest-ah/eax: (addr handle cell) <- get rest, right + var _rest/eax: (addr cell) <- lookup *rest-ah + rest <- copy _rest + { + var rest-type/eax: (addr int) <- get rest, type + compare *rest-type, 0/pair + break-if-= + error trace, "'img' encountered non-pair" + return + } + { + var rest-nil?/eax: boolean <- nil? rest + compare rest-nil?, 0/false + break-if-= + error trace, "'img' needs 6 args but got 2" + return + } + var third-ah/eax: (addr handle cell) <- get rest, left + var third/eax: (addr cell) <- lookup *third-ah + { + var third-type/eax: (addr int) <- get third, type + compare *third-type, 1/number + break-if-= + error trace, "third arg for 'img' is not a number (screen x coordinate of top left)" + return + } + var third-value/eax: (addr float) <- get third, number-data + var x/ebx: int <- convert *third-value + # y = rest->right->left->value + var rest-ah/eax: (addr handle cell) <- get rest, right + var _rest/eax: (addr cell) <- lookup *rest-ah + var rest/esi: (addr cell) <- copy _rest + { + var rest-type/eax: (addr int) <- get rest, type + compare *rest-type, 0/pair + break-if-= + error trace, "'img' encountered non-pair" + return + } + { + var rest-nil?/eax: boolean <- nil? rest + compare rest-nil?, 0/false + break-if-= + error trace, "'img' needs 6 args but got 3" + return + } + var fourth-ah/eax: (addr handle cell) <- get rest, left + var fourth/eax: (addr cell) <- lookup *fourth-ah + { + var fourth-type/eax: (addr int) <- get fourth, type + compare *fourth-type, 1/number + break-if-= + error trace, "fourth arg for 'img' is not a number (screen x coordinate of end point)" + return + } + var fourth-value/eax: (addr float) <- get fourth, number-data + var y/ecx: int <- convert *fourth-value + # w = rest->right->left->value + var rest-ah/eax: (addr handle cell) <- get rest, right + var _rest/eax: (addr cell) <- lookup *rest-ah + rest <- copy _rest + { + var rest-type/eax: (addr int) <- get rest, type + compare *rest-type, 0/pair + break-if-= + error trace, "'img' encountered non-pair" + return + } + { + var rest-nil?/eax: boolean <- nil? rest + compare rest-nil?, 0/false + break-if-= + error trace, "'img' needs 6 args but got 4" + return + } + var fifth-ah/eax: (addr handle cell) <- get rest, left + var fifth/eax: (addr cell) <- lookup *fifth-ah + { + var fifth-type/eax: (addr int) <- get fifth, type + compare *fifth-type, 1/number + break-if-= + error trace, "fifth arg for 'img' is not a number (screen y coordinate of end point)" + return + } + var fifth-value/eax: (addr float) <- get fifth, number-data + var tmp/eax: int <- convert *fifth-value + var w: int + copy-to w, tmp + # h = rest->right->left->value + var rest-ah/eax: (addr handle cell) <- get rest, right + var _rest/eax: (addr cell) <- lookup *rest-ah + rest <- copy _rest + { + var rest-type/eax: (addr int) <- get rest, type + compare *rest-type, 0/pair + break-if-= + error trace, "'img' encountered non-pair" + return + } + { + var rest-nil?/eax: boolean <- nil? rest + compare rest-nil?, 0/false + break-if-= + error trace, "'img' needs 6 args but got 5" + return + } + var sixth-ah/eax: (addr handle cell) <- get rest, left + var sixth/eax: (addr cell) <- lookup *sixth-ah + { + var sixth-type/eax: (addr int) <- get sixth, type + compare *sixth-type, 1/number + break-if-= + error trace, "sixth arg for 'img' is not an int (height)" + return + } + var sixth-value/eax: (addr float) <- get sixth, number-data + var tmp/eax: int <- convert *sixth-value + var h: int + copy-to h, tmp + # + var img-cell-ah/eax: (addr handle cell) <- address img-h + var img-cell/eax: (addr cell) <- lookup *img-cell-ah + var img-ah/eax: (addr handle image) <- get img-cell, image-data + var img/eax: (addr image) <- lookup *img-ah + render-image screen, img, x y, w h + # return nothing +} + fn apply-abort _args-ah: (addr handle cell), out: (addr handle cell), trace: (addr trace) { abort "aa" } diff --git a/translate_subx b/translate_subx index 2fc62671..391a9b43 100755 --- a/translate_subx +++ b/translate_subx @@ -55,7 +55,7 @@ then exit 1 fi -if [ `wc -l < labels` -gt 16384 ] # 0x4000 stream capacity in abort.subx +if [ `wc -l < labels` -gt 20480 ] # 0x5000 stream capacity in abort.subx then echo "abort will go into infinite regress" exit 1 diff --git a/translate_subx_emulated b/translate_subx_emulated index d6fc009b..6a025e9c 100755 --- a/translate_subx_emulated +++ b/translate_subx_emulated @@ -59,7 +59,7 @@ then exit 1 fi -if [ `wc -l < labels` -gt 16384 ] # 0x4000 stream capacity in abort.subx +if [ `wc -l < labels` -gt 20480 ] # 0x5000 stream capacity in abort.subx then echo "abort will go into infinite regress" exit 1 |