diff options
| -rw-r--r-- | apps/life.mu | 36 | ||||
| -rw-r--r-- | shell/data.limg | 76 | ||||
| -rw-r--r-- | shell/evaluate.mu | 44 |
3 files changed, 109 insertions, 47 deletions
diff --git a/apps/life.mu b/apps/life.mu index a65347bf..10914c41 100644 --- a/apps/life.mu +++ b/apps/life.mu @@ -17,18 +17,18 @@ fn state _grid: (addr array boolean), x: int, y: int -> _/eax: boolean { break-if->= return 0/false } - compare x, 0x100/width + compare x, 0x80/width { break-if-< return 0/false } - compare y, 0xc0/height + compare y, 0x60/height { break-if-< return 0/false } var idx/eax: int <- copy y - idx <- shift-left 8/log2width + idx <- shift-left 7/log2width idx <- add x var grid/esi: (addr array boolean) <- copy _grid var result/eax: (addr boolean) <- index grid, idx @@ -38,7 +38,7 @@ fn state _grid: (addr array boolean), x: int, y: int -> _/eax: boolean { fn set-state _grid: (addr array boolean), x: int, y: int, val: boolean { # don't bother checking bounds var idx/eax: int <- copy y - idx <- shift-left 8/log2width + idx <- shift-left 7/log2width idx <- add x var grid/esi: (addr array boolean) <- copy _grid var result/eax: (addr boolean) <- index grid, idx @@ -114,11 +114,11 @@ fn num-live-neighbors grid: (addr array boolean), x: int, y: int -> _/eax: int { fn step old-grid: (addr array boolean), new-grid: (addr array boolean) { var y/ecx: int <- copy 0 { - compare y, 0xc0/height + compare y, 0x60/height break-if->= var x/edx: int <- copy 0 { - compare x, 0x100/width + compare x, 0x80/width break-if->= var n/eax: int <- num-live-neighbors old-grid, x, y # if neighbors < 2, die of loneliness @@ -157,9 +157,9 @@ fn step old-grid: (addr array boolean), new-grid: (addr array boolean) { # color a square of size 'side' starting at x*side, y*side fn render-square _x: int, _y: int, color: int { var y/edx: int <- copy _y - y <- shift-left 2/log2side + y <- shift-left 3/log2side var side/ebx: int <- copy 1 - side <- shift-left 2/log2side + side <- shift-left 3/log2side var ymax/ecx: int <- copy y ymax <- add side { @@ -167,7 +167,7 @@ fn render-square _x: int, _y: int, color: int { break-if->= { var x/eax: int <- copy _x - x <- shift-left 2/log2side + x <- shift-left 3/log2side var xmax/ecx: int <- copy x xmax <- add side { @@ -196,12 +196,12 @@ fn render grid: (addr array boolean) { compare state, 0/false { break-if-= - render-square x, y, 3/cyan + render-square x, y, 0/black } compare state, 0/false { break-if-!= - render-square x, y, 0/black + render-square x, y, 3/cyan } x <- increment loop @@ -220,20 +220,20 @@ fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk) # allocate on the heap var grid1-storage: (handle array boolean) var grid1-ah/eax: (addr handle array boolean) <- address grid1-storage - populate grid1-ah, 0xc000 # width * height + populate grid1-ah, 0x3000 # width * height var _grid1/eax: (addr array boolean) <- lookup *grid1-ah var grid1/esi: (addr array boolean) <- copy _grid1 var grid2-storage: (handle array boolean) var grid2-ah/eax: (addr handle array boolean) <- address grid2-storage - populate grid2-ah, 0xc000 # width * height + populate grid2-ah, 0x3000 # width * height var _grid2/eax: (addr array boolean) <- lookup *grid2-ah var grid2/edi: (addr array boolean) <- copy _grid2 # initialize grid1 - set-state grid1, 0x80, 0x5f, 1/live - set-state grid1, 0x81, 0x5f, 1/live - set-state grid1, 0x7f, 0x60, 1/live - set-state grid1, 0x80, 0x60, 1/live - set-state grid1, 0x80, 0x61, 1/live + set-state grid1, 0x40, 0x2f, 1/live + set-state grid1, 0x41, 0x2f, 1/live + set-state grid1, 0x3f, 0x30, 1/live + set-state grid1, 0x40, 0x30, 1/live + set-state grid1, 0x40, 0x31, 1/live # render grid1 render grid1 { diff --git a/shell/data.limg b/shell/data.limg index 88e81da6..b11e50c8 100644 --- a/shell/data.limg +++ b/shell/data.limg @@ -165,28 +165,68 @@ for x 0 (x < w) ++x (pixel screen x y (palette Greys x*y))]) (main . [def (main screen keyboard) - (pat screen)]) - (lifreres . [define liferes 8]) + (life screen keyboard)]) + (liferes . [define liferes 8]) (life . [def (life screen) - let g (grid (/ (width screen) liferes) - (/ (height screen) liferes) - 0) - isetgrid g 5 5 1 - isetgrid g 6 5 1 - isetgrid g 4 6 1 - isetgrid g 5 6 1 - isetgrid g 5 7 1 - while 1 - steplife g - renderlife screen g]) - (steplife . [def (steplife g) - ]) + with (w (/ (width screen) liferes) + h (/ (height screen) liferes)) + with (g1 (grid w h 0) + g2 (grid w h 0)) + isetgrid g1 w/2 h/2-1 1 + isetgrid g1 w/2+1 h/2-1 1 + isetgrid g1 w/2-1 h/2 1 + isetgrid g1 w/2 h/2 1 + isetgrid g1 w/2 h/2+1 1 + renderlife screen g1 + while 1 + steplife g1 g2 screen + renderlife screen g2 + steplife g2 g1 screen + renderlife screen g1]) + (steplife . [def (steplife old new screen) + ++lifetime + with (h (len old) + w (len (index old 0))) + for x 0 (< x w) ++x + for y 0 (< y h) ++y + fill_rect screen x*liferes y*liferes x+1*liferes y+1*liferes 0 + with (curr (indexgrid old x y) + n (neighbors old x y w h) + ) + isetgrid new x y (if (= n 2) + curr + (if (= n 3) + 1 + 0))]) (renderlife . [def (renderlife screen g) with (w (width screen) h (height screen)) - for y 0 (< y h) ++y - for x 0 (< x w) ++x - (pixel screen x y (indexgrid g x/liferes y/liferes))]) + for y 0 (< y h) y+=liferes + for x 0 (< x w) x+=liferes + (fill_rect screen x y x+liferes y+liferes + (if (0 = (indexgrid g x/liferes y/liferes)) + 3 +# (1 + lifetime%15) + 0))]) + (neighbors . [def (neighbors g x y w h) + ret result 0 + when (y > 0) + when (x > 0) + result += (indexgrid g x-1 y-1) + result += (indexgrid g x y-1) + when (x < w-1) + result += (indexgrid g x+1 y-1) + when (x > 0) + result += (indexgrid g x-1 y) + when (x < w-1) + result += (indexgrid g x+1 y) + when (y < h-1) + when (x > 0) + result += (indexgrid g x-1 y+1) + result += (indexgrid g x y+1) + when (x < w-1) + result += (indexgrid g x+1 y+1)]) + (lifetime . [define lifetime 0]) )) (sandbox . [life screen]) ) diff --git a/shell/evaluate.mu b/shell/evaluate.mu index cb2c84ef..932a0fa5 100644 --- a/shell/evaluate.mu +++ b/shell/evaluate.mu @@ -799,15 +799,21 @@ fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), o break-if-= var stream-storage: (stream byte 0x200) var stream/ecx: (addr stream byte) <- address stream-storage - write stream, "pushing bindings from " + var overflow?/eax: boolean <- try-write stream, "pushing bindings from " + compare overflow?, 0/false + break-if-!= var nested-trace-storage: trace var nested-trace/edi: (addr trace) <- address nested-trace-storage initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible print-cell params-ah, stream, nested-trace - write stream, " to " + var overflow?/eax: boolean <- try-write stream, " to " + compare overflow?, 0/false + break-if-!= clear-trace nested-trace print-cell args-ah, stream, nested-trace - write stream, " onto " + var overflow?/eax: boolean <- try-write stream, " onto " + compare overflow?, 0/false + break-if-!= var old-env-ah/eax: (addr handle cell) <- address old-env-h clear-trace nested-trace print-cell old-env-ah, stream, nested-trace @@ -881,13 +887,17 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell) break-if-= var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` var stream/ecx: (addr stream byte) <- address stream-storage - write stream, "look up " + var overflow?/eax: boolean <- try-write stream, "look up " + compare overflow?, 0/false + break-if-!= var sym2/eax: (addr cell) <- copy sym var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah rewind-stream sym-data write-stream stream, sym-data - write stream, " in " + var overflow?/eax: boolean <- try-write stream, " in " + compare overflow?, 0/false + break-if-!= var env-ah/eax: (addr handle cell) <- address env-h var nested-trace-storage: trace var nested-trace/edi: (addr trace) <- address nested-trace-storage @@ -926,12 +936,16 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell) break-if-!= var stream-storage: (stream byte 0x200) var stream/ecx: (addr stream byte) <- address stream-storage - write stream, "=> " + var overflow?/eax: boolean <- try-write stream, "=> " + compare overflow?, 0/false + break-if-!= var nested-trace-storage: trace var nested-trace/edi: (addr trace) <- address nested-trace-storage initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible print-cell out, stream, nested-trace - write stream, " (global)" + var overflow?/eax: boolean <- try-write stream, " (global)" + compare overflow?, 0/false + break-if-!= trace trace, "eval", stream } # }}} @@ -983,12 +997,16 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell) break-if-!= var stream-storage: (stream byte 0x800) var stream/ecx: (addr stream byte) <- address stream-storage - write stream, "=> " + var overflow?/eax: boolean <- try-write stream, "=> " + compare overflow?, 0/false + break-if-!= var nested-trace-storage: trace var nested-trace/edi: (addr trace) <- address nested-trace-storage initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible print-cell out, stream, nested-trace - write stream, " (match)" + var overflow?/eax: boolean <- try-write stream, " (match)" + compare overflow?, 0/false + break-if-!= trace trace, "eval", stream } # }}} @@ -1011,12 +1029,16 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell) break-if-!= var stream-storage: (stream byte 0x200) var stream/ecx: (addr stream byte) <- address stream-storage - write stream, "=> " + var overflow?/eax: boolean <- try-write stream, "=> " + compare overflow?, 0/false + break-if-!= var nested-trace-storage: trace var nested-trace/edi: (addr trace) <- address nested-trace-storage initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible print-cell out, stream, nested-trace - write stream, " (recurse)" + var overflow?/eax: boolean <- try-write stream, " (recurse)" + compare overflow?, 0/false + break-if-!= trace trace, "eval", stream } # }}} |