diff --git a/mu-init.subx b/mu-init.subx index 08a8856e..b60249ba 100644 --- a/mu-init.subx +++ b/mu-init.subx @@ -12,6 +12,7 @@ Entry: # initialize stack bd/copy-to-ebp 0/imm32 +#? (main 0 0 Primary-bus-secondary-drive) # always first run tests (run-tests) (num-test-failures) # => eax diff --git a/shell/cell.mu b/shell/cell.mu index 8c4db86f..1aed590d 100644 --- a/shell/cell.mu +++ b/shell/cell.mu @@ -90,6 +90,10 @@ fn new-pair out: (addr handle cell), left: (handle cell), right: (handle cell) { initialize-pair out, left, right } +fn nil out: (addr handle cell) { + allocate-pair out +} + fn allocate-primitive-function _out: (addr handle cell) { var out/eax: (addr handle cell) <- copy _out allocate out diff --git a/shell/evaluate.mu b/shell/evaluate.mu index 00a75b9a..19fe9fdc 100644 --- a/shell/evaluate.mu +++ b/shell/evaluate.mu @@ -10,7 +10,7 @@ fn evaluate _in: (addr handle cell), out: (addr handle cell), env-h: (handle cel #? } # trace "evaluate " in " in environment " env {{{ { - var stream-storage: (stream byte 0x40) + var stream-storage: (stream byte 0x100) var stream/ecx: (addr stream byte) <- address stream-storage write stream, "evaluate " print-cell in, stream, 0/no-trace @@ -232,7 +232,7 @@ fn apply _f-ah: (addr handle cell), args-ah: (addr handle cell), out: (addr hand # if it's not a primitive function it must be an anonymous function # trace "apply anonymous function " f " in environment " env {{{ { - var stream-storage: (stream byte 0x40) + var stream-storage: (stream byte 0x100) var stream/ecx: (addr stream byte) <- address stream-storage write stream, "apply anonymous function " print-cell _f-ah, stream, 0/no-trace @@ -318,7 +318,7 @@ fn push-bindings _params-ah: (addr handle cell), _args-ah: (addr handle cell), o # Params can only be symbols or pairs. Args can be anything. # trace "pushing bindings from " params " to " args {{{ { - var stream-storage: (stream byte 0x40) + var stream-storage: (stream byte 0x100) var stream/ecx: (addr stream byte) <- address stream-storage write stream, "pushing bindings from " print-cell params-ah, stream, 0/no-trace diff --git a/shell/global.mu b/shell/global.mu index 107d85e7..5d34298b 100644 --- a/shell/global.mu +++ b/shell/global.mu @@ -20,6 +20,7 @@ fn initialize-globals _self: (addr global-table) { append-primitive self, "car" append-primitive self, "cdr" append-primitive self, "cons" + append-primitive self, "=" } fn render-globals screen: (addr screen), _self: (addr global-table), xmin: int, ymin: int, xmax: int, ymax: int { @@ -237,6 +238,13 @@ fn apply-primitive _f: (addr cell), args-ah: (addr handle cell), out: (addr hand apply-cons args-ah, out, env-h, trace return } + { + var is-compare?/eax: boolean <- string-equal? f-name, "=" + compare is-compare?, 0/false + break-if-= + apply-compare args-ah, out, env-h, trace + return + } abort "unknown primitive function" } @@ -542,3 +550,39 @@ fn apply-cons _args-ah: (addr handle cell), out: (addr handle cell), env-h: (han # cons new-pair out, *first-ah, *second-ah } + +fn apply-compare _args-ah: (addr handle cell), out: (addr handle cell), env-h: (handle cell), trace: (addr trace) { + trace-text trace, "eval", "apply =" + var args-ah/eax: (addr handle cell) <- copy _args-ah + var _args/eax: (addr cell) <- lookup *args-ah + var args/esi: (addr cell) <- copy _args + var _env/eax: (addr cell) <- lookup env-h + var env/edi: (addr cell) <- copy _env + # TODO: check that args is a pair + var empty-args?/eax: boolean <- nil? args + compare empty-args?, 0/false + { + break-if-= + error trace, "cons needs 2 args but got 0" + return + } + # args->left + var first-ah/ecx: (addr handle cell) <- get args, left + # args->right->left + var right-ah/eax: (addr handle cell) <- get args, right + var right/eax: (addr cell) <- lookup *right-ah + # TODO: check that right is a pair + var second-ah/edx: (addr handle cell) <- get right, left + # compare + var _first/eax: (addr cell) <- lookup *first-ah + var first/ecx: (addr cell) <- copy _first + var second/eax: (addr cell) <- lookup *second-ah + var match?/eax: boolean <- cell-isomorphic? first, second, trace + compare match?, 0/false + { + break-if-!= + nil out + return + } + new-integer out, 1/true +}