mu/shell/cell.mu

324 lines
8.8 KiB
Forth

type cell {
type: int
# type 0: pair; the unit of lists, trees, DAGS or graphs
left: (handle cell)
right: (handle cell)
# type 1: number
number-data: float
# type 2: symbol
# type 3: stream
text-data: (handle stream byte)
# type 4: primitive function
index-data: int
# type 5: screen
screen-data: (handle screen)
# type 6: keyboard
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?
}
fn allocate-symbol _out: (addr handle cell) {
var out/eax: (addr handle cell) <- copy _out
allocate out
var out-addr/eax: (addr cell) <- lookup *out
var type/ecx: (addr int) <- get out-addr, type
copy-to *type, 2/symbol
var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data
populate-stream dest-ah, 0x40/max-symbol-size
}
fn initialize-symbol _out: (addr handle cell), val: (addr array byte) {
var out/eax: (addr handle cell) <- copy _out
var out-addr/eax: (addr cell) <- lookup *out
var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data
var dest/eax: (addr stream byte) <- lookup *dest-ah
write dest, val
}
fn new-symbol out: (addr handle cell), val: (addr array byte) {
allocate-symbol out
initialize-symbol out, val
}
fn symbol? _x: (addr cell) -> _/eax: boolean {
var x/esi: (addr cell) <- copy _x
var type/eax: (addr int) <- get x, type
compare *type, 2/symbol
{
break-if-=
return 0/false
}
return 1/true
}
fn symbol-equal? _in: (addr cell), name: (addr array byte) -> _/eax: boolean {
var in/esi: (addr cell) <- copy _in
var in-type/eax: (addr int) <- get in, type
compare *in-type, 2/symbol
{
break-if-=
return 0/false
}
var in-data-ah/eax: (addr handle stream byte) <- get in, text-data
var in-data/eax: (addr stream byte) <- lookup *in-data-ah
var result/eax: boolean <- stream-data-equal? in-data, name
return result
}
fn allocate-stream _out: (addr handle cell) {
var out/eax: (addr handle cell) <- copy _out
allocate out
var out-addr/eax: (addr cell) <- lookup *out
var type/ecx: (addr int) <- get out-addr, type
copy-to *type, 3/stream
var dest-ah/eax: (addr handle stream byte) <- get out-addr, text-data
populate-stream dest-ah, 0x40/max-stream-size
}
fn allocate-number _out: (addr handle cell) {
var out/eax: (addr handle cell) <- copy _out
allocate out
var out-addr/eax: (addr cell) <- lookup *out
var type/ecx: (addr int) <- get out-addr, type
copy-to *type, 1/number
}
fn initialize-integer _out: (addr handle cell), n: int {
var out/eax: (addr handle cell) <- copy _out
var out-addr/eax: (addr cell) <- lookup *out
var dest-addr/eax: (addr float) <- get out-addr, number-data
var src/xmm0: float <- convert n
copy-to *dest-addr, src
}
fn new-integer out: (addr handle cell), n: int {
allocate-number out
initialize-integer out, n
}
fn initialize-float _out: (addr handle cell), n: float {
var out/eax: (addr handle cell) <- copy _out
var out-addr/eax: (addr cell) <- lookup *out
var dest-ah/eax: (addr float) <- get out-addr, number-data
var src/xmm0: float <- copy n
copy-to *dest-ah, src
}
fn new-float out: (addr handle cell), n: float {
allocate-number out
initialize-float out, n
}
fn number? _x: (addr cell) -> _/eax: boolean {
var x/esi: (addr cell) <- copy _x
var type/eax: (addr int) <- get x, type
compare *type, 1/number
{
break-if-=
return 0/false
}
return 1/true
}
fn allocate-pair out: (addr handle cell) {
allocate out
# new cells have type pair by default
}
fn initialize-pair _out: (addr handle cell), left: (handle cell), right: (handle cell) {
var out/eax: (addr handle cell) <- copy _out
var out-addr/eax: (addr cell) <- lookup *out
var dest-ah/ecx: (addr handle cell) <- get out-addr, left
copy-handle left, dest-ah
dest-ah <- get out-addr, right
copy-handle right, dest-ah
}
fn new-pair out: (addr handle cell), left: (handle cell), right: (handle cell) {
allocate-pair out
initialize-pair out, left, right
}
fn nil out: (addr handle cell) {
allocate-pair out
}
fn pair? _x: (addr cell) -> _/eax: boolean {
var x/esi: (addr cell) <- copy _x
var type/eax: (addr int) <- get x, type
compare *type, 0/pair
{
break-if-=
return 0/false
}
return 1/true
}
fn allocate-primitive-function _out: (addr handle cell) {
var out/eax: (addr handle cell) <- copy _out
allocate out
var out-addr/eax: (addr cell) <- lookup *out
var type/ecx: (addr int) <- get out-addr, type
copy-to *type, 4/primitive-function
}
fn initialize-primitive-function _out: (addr handle cell), n: int {
var out/eax: (addr handle cell) <- copy _out
var out-addr/eax: (addr cell) <- lookup *out
var type/ecx: (addr int) <- get out-addr, type
copy-to *type, 4/primitive
var dest-addr/eax: (addr int) <- get out-addr, index-data
var src/ecx: int <- copy n
copy-to *dest-addr, src
}
fn new-primitive-function out: (addr handle cell), n: int {
allocate-primitive-function out
initialize-primitive-function out, n
}
fn primitive? _x: (addr cell) -> _/eax: boolean {
var x/esi: (addr cell) <- copy _x
var type/eax: (addr int) <- get x, type
compare *type, 4/primitive
{
break-if-=
return 0/false
}
return 1/true
}
fn allocate-screen _out: (addr handle cell) {
var out/eax: (addr handle cell) <- copy _out
allocate out
var out-addr/eax: (addr cell) <- lookup *out
var type/ecx: (addr int) <- get out-addr, type
copy-to *type, 5/screen
}
fn new-fake-screen _out: (addr handle cell), width: int, height: int, pixel-graphics?: boolean {
var out/eax: (addr handle cell) <- copy _out
allocate-screen out
var out-addr/eax: (addr cell) <- lookup *out
var dest-ah/eax: (addr handle screen) <- get out-addr, screen-data
allocate dest-ah
var dest-addr/eax: (addr screen) <- lookup *dest-ah
initialize-screen dest-addr, width, height, pixel-graphics?
}
fn screen? _x: (addr cell) -> _/eax: boolean {
var x/esi: (addr cell) <- copy _x
var type/eax: (addr int) <- get x, type
compare *type, 5/screen
{
break-if-=
return 0/false
}
return 1/true
}
fn clear-screen-var _self-ah: (addr handle cell) {
var self-ah/eax: (addr handle cell) <- copy _self-ah
var self/eax: (addr cell) <- lookup *self-ah
compare self, 0
{
break-if-!=
return
}
var screen-ah/eax: (addr handle screen) <- get self, screen-data
var screen/eax: (addr screen) <- lookup *screen-ah
clear-screen screen
}
fn allocate-keyboard _out: (addr handle cell) {
var out/eax: (addr handle cell) <- copy _out
allocate out
var out-addr/eax: (addr cell) <- lookup *out
var type/ecx: (addr int) <- get out-addr, type
copy-to *type, 6/keyboard
}
fn new-fake-keyboard _out: (addr handle cell), capacity: int {
var out/eax: (addr handle cell) <- copy _out
allocate-keyboard out
var out-addr/eax: (addr cell) <- lookup *out
var dest-ah/eax: (addr handle gap-buffer) <- get out-addr, keyboard-data
allocate dest-ah
var dest-addr/eax: (addr gap-buffer) <- lookup *dest-ah
initialize-gap-buffer dest-addr, capacity
}
fn keyboard? _x: (addr cell) -> _/eax: boolean {
var x/esi: (addr cell) <- copy _x
var type/eax: (addr int) <- get x, type
compare *type, 6/keyboard
{
break-if-=
return 0/false
}
return 1/true
}
fn rewind-keyboard-var _self-ah: (addr handle cell) {
var self-ah/eax: (addr handle cell) <- copy _self-ah
var self/eax: (addr cell) <- lookup *self-ah
compare self, 0
{
break-if-!=
return
}
var keyboard-ah/eax: (addr handle gap-buffer) <- get self, keyboard-data
var keyboard/eax: (addr gap-buffer) <- lookup *keyboard-ah
rewind-gap-buffer keyboard
}
fn new-array _out: (addr handle cell), capacity: int {
var out/eax: (addr handle cell) <- copy _out
allocate out
var out-addr/eax: (addr cell) <- lookup *out
var type/ecx: (addr int) <- get out-addr, type
copy-to *type, 7/array
var dest-ah/eax: (addr handle array handle cell) <- get out-addr, array-data
populate dest-ah, capacity
}
fn array? _x: (addr cell) -> _/eax: boolean {
var x/esi: (addr cell) <- copy _x
var type/eax: (addr int) <- get x, type
compare *type, 7/array
{
break-if-=
return 0/false
}
return 1/true
}
fn new-image _out-ah: (addr handle cell), in: (addr stream byte) {
rewind-stream in
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
}