diff options
Diffstat (limited to 'eval.s')
| -rw-r--r-- | eval.s | 172 |
1 files changed, 127 insertions, 45 deletions
@@ -4,80 +4,109 @@ a (the environment / symbol table) at a known location ; e to be evaluated in R0 ; result of evaluation in R0 eval: (e) = - BIT #1, R0 ; test if e is cons or atom + BIT #1, (R0) ; test if e is cons or atom BEQ not_atom ; branch if not atom(e) JSR PC, #assoc ; return assoc(e) ; TODO assumes assoc puts result in R0 RTS PC not_atom: - MOV @R0, R2 ; hd <- car(e) ; R2 - MOV 2(R0), R3 ; tl <- cdr(e) ; R3 - BIT #1, R1 ; test if hd is cons or atom + ; R7 = PC + ; R6 = SP + ; R5 = a (symbol table) + ; R4 = e (original sexp) + ; R3 = args = tl = cdr(e) + ; R2 = hd, symbols = second = car(cdr(hd)) + ; R1 = arg2 + ; R0 = arg1, result + MOV R0, R4 ; save e + MOV @R4, R2 ; hd <- car(e) + BIT #1, (R2) ; test if hd is cons or atom BNE head_is_atom ; branch if atom(hd) - ;otherwise: - MOV @R2, R0 ; arg1 <- car(hd) ; R0 (first) - MOV 2(R2), R4 ; rest <- cdr(hd) ; R4 - MOV 2(R4), R5 ; rest' <- cdr(rest) ; R5 - MOV @(R4), R4 ; second <- car(rest) ; R4 - MOV @(R5), R5 ; third <- car(rest') ; R5 - + ;otherwise (if cons): + MOV @R2, R0 ; arg1 <- car(hd) = first MOV "LABEL", R1 ; arg2 <- at"LABEL" JSR PC, #eq ; test eq(first, at"LABEL") - ; result is in R1 - BEQ not_label ; branch if not label - ;if is label + BNE not_label ; branch if not label + + ; if is label + MOV 2(R2), R2 ; rest <- cdr(hd) + MOV 2(R2), R3 ; rest' <- cdr(rest) + + ; R2 = rest + ; R3 = rest' + ; push entry l[second, hd] onto symbol table a ; a <- cons(l[second, hd], a) - MOV R2, (#symbol_table); push hd onto symbol table column 1 - MOV R4, (#symbol_table); push second onto symbol table column 0 - - ; r0 <- cons(third, tl) - MOV R5, R0 ; arg1 <- third - MOV R3, R1 ; arg2 <- tl - JSR PC, #cons ; result in R0 - JSR PC, #eval ; result <- eval(cons(third, tl)) - pop off of a ; a <- cdr a - RTS PC ; return result in R0 + MOV @R2, (R5)+ ; push second (=car(rest)) onto symbol table column 0 + MOV @R4, (R5)+ ; push hd onto symbol table column 1 + ; evaluate cons(third, tl) in extended environment + ; R0 <- cons(third, tl) + MOV @R3, R0 ; arg1 <- third (=car(rest')) + MOV 2(R4), R1 ; arg2 <- tl = cdr(e) + JSR PC, #cons ; result in R0 + JSR PC, #eval ; result <- eval(cons(third, tl)) + SUB 4, R5 ; pop off symbol table entry + RTS PC ; return result in R0 not_label: + ; R2 = hd ; first still in R0 MOV "LAMBDA", R1 ; arg2 <- at"LAMBDA" JSR PC, #eq ; test eq(first, at"LAMBDA") - ; result is in R1 - BEQ error ; branch if not lambda + BNE error ; branch if not lambda ;if is lambda - save old a - ; push onto a ; a <- append(pair(second, evlis(tl)), a) + ; push onto a ; a <- append(pair(second, evlis(tl)), a) + + MOV R5, -(SP) ; push old symbol table pointer to stack + + MOV 2(R2), R1 ; rest <- cdr(hd) + MOV @R1, R2 ; symbols <- car(rest) = second + MOV 2(R4), R3 ; args <- tl = cdr(e) + + ; R1 = rest + + ; R2 = symbols + ; R3 = args evlis: (symbols, args) - BIT #1, R0 ; test if args is cons or atom - if its atom jump to done + + BIT #1, (R2) ; test if symbols is cons or atom + BNE done ; if its atom jump to done + ; if its cons: - BIT #1, R1 ; test if symbols is cons or atom - if its atom jump to done + BIT #1, (R3) ; test if args is cons or atom + BNE done ; if its atom jump to done + ; if both are cons: - symbol <- car(symbols) - symbols <- cdr(symbols) - arg1 <- car(args) - args <- cdr(args) - JSR PC, #eval ; eval (arg1) ; result in R0 + MOV @R3, R0 ; arg1 <- car(args) + JSR PC, #eval ; result <- eval (arg1) + ; push (symbol, eval(arg)) - MOV R0, (#symbol_table) ; push R0 to column 1 - MOV , (#symbol_table) ; push symbol to column 0 - jump to evlis(symbols, args) + MOV @R2, (R5)+ ; push symbol (=car(symbols)) to column 0 + MOV R0, (R5)+ ; push result to column 1 + + MOV 2(R2), R2 ; args <- cdr(args) + MOV 2(R3), R3 ; symbols <- cdr(symbols) + + BR -??? ; jump to evlis(symbols, args) done: - MOV R5, R0 ; arg1 <- third + MOV 2(R1), R1 ; rest' <- cdr(rest) + MOV @R1, R0 ; arg1 <- third = car(rest') JSR PC, #eval ; result <- eval(third) - pop off of a ; a <- old a + ; pop off argument entries + MOV (SP)+, R5 ; restore symbol table pointer - return result + RTS PC error: - this should never happen. ill-formed s-exp - return bad ; maybe just return the original s-exp + MOV R4, R0 + BR -2 ; infinite loop + ; this should never happen. ill-formed s-exp + ; return bad ; maybe just return the original s-exp + RTS PC head_is_atom: (hd, tl) return cases [ (eq(hd, at"QUOTE"), car(tl)) @@ -89,6 +118,59 @@ head_is_atom: (hd, tl) , (eq(hd, at"CONS"), cons(eval(car(tl)), eval(cadr(tl)))) , (at"T", eval(cons(assoc(hd), tl))) ] + MOV R2, R0 ; arg1 <- hd + MOV "QUOTE", R1 ; arg2 <- at"QUOTE" + JSR PC, #eq ; test eq(hd, at"QUOTE") + BNE next ; skip if not quote + ... + RTS PC + + next: + MOV "ATOM", R1 ; arg2 <- at"ATOM" + JSR PC, #eq ; test eq(hd, at"ATOM") + BNE next ; skip if not atom + ... + RTS PC + + next: + MOV "EQ", R1 ; arg2 <- at"EQ" + JSR PC, #eq ; test eq(hd, at"EQ") + BNE next ; skip if not eq + ... + RTS PC + + next: + MOV "COND", R1 ; arg2 <- at"COND" + JSR PC, #eq ; test eq(hd, at"COND") + BNE next ; skip if not cond + ... + RTS PC + + next: + MOV "CAR", R1 ; arg2 <- at"CAR" + JSR PC, #eq ; test eq(hd, at"CAR") + BNE next ; skip if not car + ... + RTS PC + + next: + MOV "CDR", R1 ; arg2 <- at"CDR" + JSR PC, #eq ; test eq(hd, at"CDR") + BNE next ; skip if not cdr + ... + RTS PC + + next: + MOV "CONS", R1 ; arg2 <- at"CONS" + JSR PC, #eq ; test eq(hd, at"CONS") + BNE next ; skip if not cons + ... + RTS PC + + otherwise: + ... + RTS PC + evcon(c) = cases |