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:
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->=
|
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
|
||||||
{
|
{
|
||||||
|
|
|
@ -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])
|
||||||
)
|
)
|
||||||
|
|
|
@ -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
|
||||||
}
|
}
|
||||||
# }}}
|
# }}}
|
||||||
|
|
Loading…
Reference in New Issue