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
parent
46441d7204
commit
bfa0efb7d1
36
apps/life.mu
36
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
|
||||
{
|
||||
|
|
|
|||
|
|
@ -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])
|
||||
)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
# }}}
|
||||
|
|
|
|||
Loading…
Reference in New Issue