game of life in lisp

Super slow; each frame is cleared as a sort of progress indicator while
it computes the next frame.

In the process I realize I need to adjust every single trace in the
shell sources to be more fault-tolerant to a filled-up trace stream.
This commit is contained in:
Kartik K. Agaram 2021-07-26 17:17:19 -07:00
parent 46441d7204
commit bfa0efb7d1
3 changed files with 109 additions and 47 deletions

View File

@ -17,18 +17,18 @@ fn state _grid: (addr array boolean), x: int, y: int -> _/eax: boolean {
break-if->= break-if->=
return 0/false return 0/false
} }
compare x, 0x100/width compare x, 0x80/width
{ {
break-if-< break-if-<
return 0/false return 0/false
} }
compare y, 0xc0/height compare y, 0x60/height
{ {
break-if-< break-if-<
return 0/false return 0/false
} }
var idx/eax: int <- copy y var idx/eax: int <- copy y
idx <- shift-left 8/log2width idx <- shift-left 7/log2width
idx <- add x idx <- add x
var grid/esi: (addr array boolean) <- copy _grid var grid/esi: (addr array boolean) <- copy _grid
var result/eax: (addr boolean) <- index grid, idx 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 { fn set-state _grid: (addr array boolean), x: int, y: int, val: boolean {
# don't bother checking bounds # don't bother checking bounds
var idx/eax: int <- copy y var idx/eax: int <- copy y
idx <- shift-left 8/log2width idx <- shift-left 7/log2width
idx <- add x idx <- add x
var grid/esi: (addr array boolean) <- copy _grid var grid/esi: (addr array boolean) <- copy _grid
var result/eax: (addr boolean) <- index grid, idx 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) { fn step old-grid: (addr array boolean), new-grid: (addr array boolean) {
var y/ecx: int <- copy 0 var y/ecx: int <- copy 0
{ {
compare y, 0xc0/height compare y, 0x60/height
break-if->= break-if->=
var x/edx: int <- copy 0 var x/edx: int <- copy 0
{ {
compare x, 0x100/width compare x, 0x80/width
break-if->= break-if->=
var n/eax: int <- num-live-neighbors old-grid, x, y var n/eax: int <- num-live-neighbors old-grid, x, y
# if neighbors < 2, die of loneliness # 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 # color a square of size 'side' starting at x*side, y*side
fn render-square _x: int, _y: int, color: int { fn render-square _x: int, _y: int, color: int {
var y/edx: int <- copy _y var y/edx: int <- copy _y
y <- shift-left 2/log2side y <- shift-left 3/log2side
var side/ebx: int <- copy 1 var side/ebx: int <- copy 1
side <- shift-left 2/log2side side <- shift-left 3/log2side
var ymax/ecx: int <- copy y var ymax/ecx: int <- copy y
ymax <- add side ymax <- add side
{ {
@ -167,7 +167,7 @@ fn render-square _x: int, _y: int, color: int {
break-if->= break-if->=
{ {
var x/eax: int <- copy _x var x/eax: int <- copy _x
x <- shift-left 2/log2side x <- shift-left 3/log2side
var xmax/ecx: int <- copy x var xmax/ecx: int <- copy x
xmax <- add side xmax <- add side
{ {
@ -196,12 +196,12 @@ fn render grid: (addr array boolean) {
compare state, 0/false compare state, 0/false
{ {
break-if-= break-if-=
render-square x, y, 3/cyan render-square x, y, 0/black
} }
compare state, 0/false compare state, 0/false
{ {
break-if-!= break-if-!=
render-square x, y, 0/black render-square x, y, 3/cyan
} }
x <- increment x <- increment
loop loop
@ -220,20 +220,20 @@ fn main screen: (addr screen), keyboard: (addr keyboard), data-disk: (addr disk)
# allocate on the heap # allocate on the heap
var grid1-storage: (handle array boolean) var grid1-storage: (handle array boolean)
var grid1-ah/eax: (addr handle array boolean) <- address grid1-storage 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/eax: (addr array boolean) <- lookup *grid1-ah
var grid1/esi: (addr array boolean) <- copy _grid1 var grid1/esi: (addr array boolean) <- copy _grid1
var grid2-storage: (handle array boolean) var grid2-storage: (handle array boolean)
var grid2-ah/eax: (addr handle array boolean) <- address grid2-storage 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/eax: (addr array boolean) <- lookup *grid2-ah
var grid2/edi: (addr array boolean) <- copy _grid2 var grid2/edi: (addr array boolean) <- copy _grid2
# initialize grid1 # initialize grid1
set-state grid1, 0x80, 0x5f, 1/live set-state grid1, 0x40, 0x2f, 1/live
set-state grid1, 0x81, 0x5f, 1/live set-state grid1, 0x41, 0x2f, 1/live
set-state grid1, 0x7f, 0x60, 1/live set-state grid1, 0x3f, 0x30, 1/live
set-state grid1, 0x80, 0x60, 1/live set-state grid1, 0x40, 0x30, 1/live
set-state grid1, 0x80, 0x61, 1/live set-state grid1, 0x40, 0x31, 1/live
# render grid1 # render grid1
render grid1 render grid1
{ {

View File

@ -165,28 +165,68 @@
for x 0 (x < w) ++x for x 0 (x < w) ++x
(pixel screen x y (palette Greys x*y))]) (pixel screen x y (palette Greys x*y))])
(main . [def (main screen keyboard) (main . [def (main screen keyboard)
(pat screen)]) (life screen keyboard)])
(lifreres . [define liferes 8]) (liferes . [define liferes 8])
(life . [def (life screen) (life . [def (life screen)
let g (grid (/ (width screen) liferes) with (w (/ (width screen) liferes)
(/ (height screen) liferes) h (/ (height screen) liferes))
0) with (g1 (grid w h 0)
isetgrid g 5 5 1 g2 (grid w h 0))
isetgrid g 6 5 1 isetgrid g1 w/2 h/2-1 1
isetgrid g 4 6 1 isetgrid g1 w/2+1 h/2-1 1
isetgrid g 5 6 1 isetgrid g1 w/2-1 h/2 1
isetgrid g 5 7 1 isetgrid g1 w/2 h/2 1
while 1 isetgrid g1 w/2 h/2+1 1
steplife g renderlife screen g1
renderlife screen g]) while 1
(steplife . [def (steplife g) 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) (renderlife . [def (renderlife screen g)
with (w (width screen) with (w (width screen)
h (height screen)) h (height screen))
for y 0 (< y h) ++y for y 0 (< y h) y+=liferes
for x 0 (< x w) ++x for x 0 (< x w) x+=liferes
(pixel screen x y (indexgrid g x/liferes y/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]) (sandbox . [life screen])
) )

View File

@ -799,15 +799,21 @@ fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), o
break-if-= break-if-=
var stream-storage: (stream byte 0x200) var stream-storage: (stream byte 0x200)
var stream/ecx: (addr stream byte) <- address stream-storage 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-storage: trace
var nested-trace/edi: (addr trace) <- address nested-trace-storage var nested-trace/edi: (addr trace) <- address nested-trace-storage
initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
print-cell params-ah, stream, nested-trace 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 clear-trace nested-trace
print-cell args-ah, stream, 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 var old-env-ah/eax: (addr handle cell) <- address old-env-h
clear-trace nested-trace clear-trace nested-trace
print-cell old-env-ah, stream, 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-= break-if-=
var stream-storage: (stream byte 0x800) # pessimistically sized just for the large alist loaded from disk in `main` 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 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 sym2/eax: (addr cell) <- copy sym
var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data var sym-data-ah/eax: (addr handle stream byte) <- get sym2, text-data
var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah var sym-data/eax: (addr stream byte) <- lookup *sym-data-ah
rewind-stream sym-data rewind-stream sym-data
write-stream 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 env-ah/eax: (addr handle cell) <- address env-h
var nested-trace-storage: trace var nested-trace-storage: trace
var nested-trace/edi: (addr trace) <- address nested-trace-storage 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-!= break-if-!=
var stream-storage: (stream byte 0x200) var stream-storage: (stream byte 0x200)
var stream/ecx: (addr stream byte) <- address stream-storage 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-storage: trace
var nested-trace/edi: (addr trace) <- address nested-trace-storage var nested-trace/edi: (addr trace) <- address nested-trace-storage
initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
print-cell out, stream, nested-trace 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 trace trace, "eval", stream
} }
# }}} # }}}
@ -983,12 +997,16 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell)
break-if-!= break-if-!=
var stream-storage: (stream byte 0x800) var stream-storage: (stream byte 0x800)
var stream/ecx: (addr stream byte) <- address stream-storage 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-storage: trace
var nested-trace/edi: (addr trace) <- address nested-trace-storage var nested-trace/edi: (addr trace) <- address nested-trace-storage
initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
print-cell out, stream, nested-trace 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 trace trace, "eval", stream
} }
# }}} # }}}
@ -1011,12 +1029,16 @@ fn lookup-symbol sym: (addr cell), out: (addr handle cell), env-h: (handle cell)
break-if-!= break-if-!=
var stream-storage: (stream byte 0x200) var stream-storage: (stream byte 0x200)
var stream/ecx: (addr stream byte) <- address stream-storage 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-storage: trace
var nested-trace/edi: (addr trace) <- address nested-trace-storage var nested-trace/edi: (addr trace) <- address nested-trace-storage
initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible initialize-trace nested-trace, 1/only-errors, 0x10/capacity, 0/visible
print-cell out, stream, nested-trace 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 trace trace, "eval", stream
} }
# }}} # }}}