Fix eval primitives

1 files changed, 156 insertions, 154 deletions

diff --git a/eval.s b/eval.s
index 9f786ca..01f5a2e 100644
--- a/eval.s
+++ b/eval.s
@@ -23,95 +23,96 @@ not_atom:
 003016 011402 MOV @R4, R2           ; hd <- car(e)
 003020 032712 BIT #1, (R2)          ; test if hd is cons or atom
 003022 000001
-003024 000137 JMP head_is_atom      ; branch if atom(hd)
-003026 003300
+003024 001402 BEQ 4                 ; branch if cons
+003026 000137 JMP head_is_atom      ; jump if atom(hd)
+003030 003300
 ; otherwise (if cons):
-003030 011200 MOV @R2, R0           ; arg1 <- car(hd) = first
-003032 012701 MOV "LABEL", R1       ; arg2 <- at"LABEL"
-003034 005076
-003036 004737 JSR PC, #eq           ; test eq(first, at"LABEL")
-003040 003700
-000042 001020 BNE not_label         ; branch if not label
+003032 011200 MOV @R2, R0           ; arg1 <- car(hd) = first
+003034 012701 MOV "LABEL", R1       ; arg2 <- at"LABEL"
+003036 005100
+003040 004737 JSR PC, #eq           ; test eq(first, at"LABEL")
+003042 004600
+000044 001020 BNE not_label         ; branch if not label
 ; if is label
-003044 016202 MOV 2(R2), R2         ; rest <- cdr(hd)
-003046 000002
-003050 016203 MOV 2(R2), R3         ; rest' <- cdr(rest)
-003052 000002
+003046 016202 MOV 2(R2), R2         ; rest <- cdr(hd)
+003050 000002
+003052 016203 MOV 2(R2), R3         ; rest' <- cdr(rest)
+003054 000002
 ; R2 = rest
 ; R3 = rest'
 ; push entry l[second, hd] onto symbol table a
 ; a <- cons(l[second, hd], a)
-003054 011225 MOV @R2, (R5)+        ; push second (=car(rest)) onto symbol table column 0
-003056 011425 MOV @R4, (R5)+        ; push hd onto symbol table column 1
+003056 011225 MOV @R2, (R5)+        ; push second (=car(rest)) onto symbol table column 0
+003060 011425 MOV @R4, (R5)+        ; push hd onto symbol table column 1
 ; evaluate cons(third, tl) in extended environment
 ; R0 <- cons(third, tl)
-003060 011300 MOV @R3, R0           ; arg1 <- third (=car(rest'))
-003062 016401 MOV 2(R4), R1         ; arg2 <- tl = cdr(e)
-003064 000002
-003066 004737 JSR PC, #cons         ; result in R0
-003070 004400
-003072 004737 JSR PC, #eval         ; result <- eval(cons(third, tl))
-003074 003000
-003076 162705 SUB 4, R5             ; pop off symbol table entry
-003100 000004
-003102 000207 RTS PC                ; return result in R0
+003062 011300 MOV @R3, R0           ; arg1 <- third (=car(rest'))
+003064 016401 MOV 2(R4), R1         ; arg2 <- tl = cdr(e)
+003066 000002
+003070 004737 JSR PC, #cons         ; result in R0
+003072 004400
+003074 004737 JSR PC, #eval         ; result <- eval(cons(third, tl))
+003076 003000
+003100 162705 SUB 4, R5             ; pop off symbol table entry
+003102 000004
+003104 000207 RTS PC                ; return result in R0
 
 not_label:
 ; R2 = hd
-003104 011200 MOV @R2, R0           ; arg1 <- car(hd) = first
-003106 012701 MOV "LAMBDA", R1      ; arg2 <- at"LAMBDA"
-003110 005104 
-003112 004737 JSR PC, #eq           ; test eq(first, at"LAMBDA")
-003114 003700
-003116 001043 BNE error             ; branch if not lambda
+003106 011200 MOV @R2, R0           ; arg1 <- car(hd) = first
+003110 012701 MOV "LAMBDA", R1      ; arg2 <- at"LAMBDA"
+003112 005110
+003114 004737 JSR PC, #eq           ; test eq(first, at"LAMBDA")
+003116 004600
+003120 001043 BNE error             ; branch if not lambda
 ; if is lambda
 ; push onto a               ; a <- append(pair(second, evlis(tl)), a)
-003120 010546 MOV R5, -(SP)               ; push old symbol table pointer to stack
-003122 016201 MOV 2(R2), R1               ; rest <- cdr(hd)
-003124 000002
-003126 011102 MOV @R1, R2                 ; symbols <- car(rest) = second
-003130 016403 MOV 2(R4), R3               ; args <- tl = cdr(e)
-003132 000002
-003134 010146 MOV R1, -(SP)               ; save rest
+003122 010546 MOV R5, -(SP)               ; push old symbol table pointer to stack
+003124 016201 MOV 2(R2), R1               ; rest <- cdr(hd)
+003126 000002
+003130 011102 MOV @R1, R2                 ; symbols <- car(rest) = second
+003132 016403 MOV 2(R4), R3               ; args <- tl = cdr(e)
+003134 000002
+003136 010146 MOV R1, -(SP)               ; save rest
 ; R2 = symbols
 ; R3 = args
 evlis: (symbols, args)
-003134 032712 BIT #1, (R2)                ; test if symbols is cons or atom
-003136 000001
-003140 001021 BNE done                    ; if its atom jump to done
+003140 032712 BIT #1, (R2)                ; test if symbols is cons or atom
+003142 000001
+003144 001021 BNE done                    ; if its atom jump to done
 ; if its cons:
-003142 032713 BIT #1, (R3)                ; test if args is cons or atom
-003144 000001
-003146 001016 BNE done                    ; if its atom jump to done
+003146 032713 BIT #1, (R3)                ; test if args is cons or atom
+003150 000001
+003152 001016 BNE done                    ; if its atom jump to done
 ; if both are cons:
-003150 011300 MOV @R3, R0                 ; arg1 <- car(args)
-003152 010246 MOV R2, -(SP)               ; save symbos
-003154 010346 MOV R3, -(SP)               ; save args
-003156 004737 JSR PC, #eval               ; result <- eval (arg1)
-003160 003000
-003162 012603 MOV (SP)+, R3               ; restore args
-003164 012602 MOV (SP)+, R2               ; restore symbols
+003154 011300 MOV @R3, R0                 ; arg1 <- car(args)
+003156 010246 MOV R2, -(SP)               ; save symbos
+003160 010346 MOV R3, -(SP)               ; save args
+003162 004737 JSR PC, #eval               ; result <- eval (arg1)
+003164 003000
+003166 012603 MOV (SP)+, R3               ; restore args
+003170 012602 MOV (SP)+, R2               ; restore symbols
 ; push (symbol, eval(arg))
-003166 011225 MOV @R2, (R5)+              ; push symbol (=car(symbols)) to column 0
-003170 010025 MOV R0, (R5)+               ; push result to column 1
-003172 016202 MOV 2(R2), R2               ; args <- cdr(args)
-003174 000002
-003176 016303 MOV 2(R3), R3               ; symbols <- cdr(symbols)
+003172 011225 MOV @R2, (R5)+              ; push symbol (=car(symbols)) to column 0
+003174 010025 MOV R0, (R5)+               ; push result to column 1
+003176 016202 MOV 2(R2), R2               ; args <- cdr(args)
 003200 000002
-003202 000754 BR -40                      ; jump to evlis(symbols, args)
+003202 016303 MOV 2(R3), R3               ; symbols <- cdr(symbols)
+003204 000002
+003206 000754 BR -40                      ; jump to evlis(symbols, args)
 done:
-003204 012601 MOV (SP)+, R1               ; restore rest
+003210 012601 MOV (SP)+, R1               ; restore rest
 ; R1 = rest
-003206 016101 MOV 2(R1), R1               ; rest' <- cdr(rest)
-003210 000002
-003212 011100 MOV @R1, R0                 ; arg1 <- third = car(rest')
-003214 004737 JSR PC, #eval               ; result <- eval(third)
-003216 003000
+003212 016101 MOV 2(R1), R1               ; rest' <- cdr(rest)
+003214 000002
+003216 011100 MOV @R1, R0                 ; arg1 <- third = car(rest')
+003220 004737 JSR PC, #eval               ; result <- eval(third)
+003222 003000
 ; pop off argument entries
-003220 012605 MOV (SP)+, R5               ; restore symbol table pointer
-003222 000207 RTS PC
+003224 012605 MOV (SP)+, R5               ; restore symbol table pointer
+003226 000207 RTS PC
 error:
-003224 000777 BR -2                       ; infinite loop
+003230 000777 BR -2                       ; infinite loop
 
 head_is_atom:
 ; R2 = hd
@@ -123,7 +124,7 @@ head_is_atom:
 003306 012701 MOV "QUOTE", R1       ; arg2 <- at"QUOTE"
 003310 005016
 003312 004737 JSR PC, #eq           ; test eq(hd, at"QUOTE")
-003314 003700
+003314 004600
 003316 001002 BNE next              ; skip if not quote
 ; return car(tl)
 003320 011300 MOV @R3, R0
@@ -134,7 +135,7 @@ next:
 003326 012701 MOV "ATOM", R1        ; arg2 <- at"ATOM"
 003330 005026
 003332 004737 JSR PC, #eq           ; test eq(hd, at"ATOM")
-003334 003700
+003334 004600
 003336 001014 BNE next              ; skip if not atom
 ; return atom(eval(car(tl)))
 003340 011300 MOV @R3, R0           ; arg1 <- car(tl)
@@ -146,7 +147,7 @@ next:
 ; is atom
 003354 012700 MOV "T" R0
 003356 005006
-003160 000207 RTS PC
+003360 000207 RTS PC
 ; not_atom
 003362 012700 MOV "F" R0
 003364 005012
@@ -157,7 +158,7 @@ next:
 003372 012701 MOV "EQ", R1          ; arg2 <- at"EQ"
 003374 005036
 003376 004737 JSR PC, #eq           ; test eq(hd, at"EQ")
-003400 003700
+003400 004600
 003402 001026 BNE next              ; skip if not eq
 ; return eq(eval(car(tl)), eval(cadr(tl)))
 003404 011300 MOV @R3, R0           ; arg1 <- car(tl)
@@ -174,7 +175,7 @@ next:
 003432 010001 MOV R0, R1            ; arg2 <- result
 003134 012600 MOV (SP)+, R0         ; pop arg1
 003436 004737 JSR PC, #eq           ; test if equal
-003440 003700
+003440 004600
 003442 001003 BNE not_eq
 ; eq
 003444 012700 MOV "T" R0
@@ -190,10 +191,10 @@ next:
 003462 012701 MOV "COND", R1        ; arg2 <- at"COND"
 003464 005044
 003466 004737 JSR PC, #eq           ; test eq(hd, at"COND")
-003470 003700
-003472 001025 BNE next              ; skip if not cond
-; return evcon(car(tl))
-003474 011302 MOV @R3, R2           ; arg1 <- car(tl)
+003470 004600
+003472 001026 BNE next              ; skip if not cond
+; return evcon(tl)
+003474 010302 MOV R3, R2            ; c <- tl
 evcon:
 ; R1 = arg1 = at"T"
 ; R2 = c
@@ -204,115 +205,117 @@ evcon:
 003506 003000
 003510 012602 MOV (SP)+, R2         ; restore c
 003512 012701 MOV "T" R1            ; arg2 <- at"T"
-003514 004737 JSR PC, #eq           ; check if it's at"T"
-003516 003700
-003520 001403 BEQ is_true
+003514 005006
+003516 004737 JSR PC, #eq           ; check if it's at"T"
+003520 004600
+003522 001403 BEQ is_true
 ; if not true
-003522 016202 MOV 2(R2), R2         ; c <- cdr(c)
-003524 000002
-003526 000763 BR -26                ; evcon(c)
+003524 016202 MOV 2(R2), R2         ; c <- cdr(c)
+003526 000002
+003530 000762 BR evcon              ; evcon(c)
 ; if true
-003530 011200 MOV @R2, R0           ; car(c)
-003532 012700 MOV 2(R0), R0         ; cdar(c)
-003534 000002
-003536 011000 MOV @R0, R0           ; arg1 <- cadar(c)
-003540 004737 JSR PC, #eval         ; result <- eval(cadar(c))
-003542 003000
-003544 000207 RTS PC
+003532 011200 MOV @R2, R0           ; car(c)
+003534 016000 MOV 2(R0), R0         ; cdar(c)
+003536 000002
+003540 011000 MOV @R0, R0           ; arg1 <- cadar(c)
+003542 004737 JSR PC, #eval         ; result <- eval(cadar(c))
+003544 003000
+003546 000207 RTS PC
 
 next:
-003546 010200 MOV R2, R0            ; arg1 <- hd
-003550 012701 MOV "CAR", R1         ; arg2 <- at"CAR"
-003552 005052
-003554 004737 JSR PC, #eq           ; test eq(hd, at"CAR")
-003556 003700
-003560 001005 BNE next              ; skip if not car
+003550 010200 MOV R2, R0            ; arg1 <- hd
+003552 012701 MOV "CAR", R1         ; arg2 <- at"CAR"
+003554 005054
+003556 004737 JSR PC, #eq           ; test eq(hd, at"CAR")
+003560 004600
+003562 001005 BNE next              ; skip if not car
 ; return car(eval(car(tl)))
-003562 011300 MOV @R3, R0           ; arg1 <- car(tl)
-003564 004737 JSR PC, #eval         ; result <- eval(car(tl))
-003566 003000
-003570 011000 MOV @R0, R0           ; result <- car(result)
-003572 000207 RTS PC
+003564 011300 MOV @R3, R0           ; arg1 <- car(tl)
+003566 004737 JSR PC, #eval         ; result <- eval(car(tl))
+003570 003000
+003572 011000 MOV @R0, R0           ; result <- car(result)
+003574 000207 RTS PC
 
 next:
-003574 010200 MOV R2, R0            ; arg1 <- hd
-003576 012701 MOV "CDR", R1         ; arg2 <- at"CDR"
-003600 005062
-003602 004737 JSR PC, #eq           ; test eq(hd, at"CDR")
-003604 003700
-003606 001006 BNE next              ; skip if not cdr
+003576 010200 MOV R2, R0            ; arg1 <- hd
+003600 012701 MOV "CDR", R1         ; arg2 <- at"CDR"
+003602 005062
+003604 004737 JSR PC, #eq           ; test eq(hd, at"CDR")
+003606 004600
+003610 001006 BNE next              ; skip if not cdr
 ; return cdr(eval(car(tl)))
-003610 011300 MOV @R3, R0           ; arg1 <- car(tl)
-003612 004737 JSR PC, #eval         ; result <- eval(car(tl))
-003614 003000
-003616 016000 MOV 2(R0), R0         ; result <- cdr(result)
-003620 000002
-003622 000207 RTS PC
+003612 011300 MOV @R3, R0           ; arg1 <- car(tl)
+003614 004737 JSR PC, #eval         ; result <- eval(car(tl))
+003616 003000
+003620 016000 MOV 2(R0), R0         ; result <- cdr(result)
+003622 000002
+003624 000207 RTS PC
 
 next:
-003624 010200 MOV R2, R0            ; arg1 <- hd
-003626 012701 MOV "CONS", R1        ; arg2 <- at"CONS"
-003630 004737 JSR PC, #eq           ; test eq(hd, at"CONS")
-003632 003700
-003634 001020 BNE otherwise         ; skip if not cons
+003626 010200 MOV R2, R0            ; arg1 <- hd
+003630 012701 MOV "CONS", R1        ; arg2 <- at"CONS"
+003632 005070
+003634 004737 JSR PC, #eq           ; test eq(hd, at"CONS")
+003636 004600
+003640 001020 BNE otherwise         ; skip if not cons
 ; return cons(eval(car(tl)), eval(cadr(tl)))
-003636 011300 MOV @R3, R0           ; arg1 <- car(tl)
-003640 010346 MOV R3, -(SP)         ; save tl
-003642 004737 JSR PC, #eval         ; result <- eval(car(tl))
-003644 003000
-003646 012603 MOV (SP)+, R3         ; restore tl
-003650 010046 MOV R0, -(SP)         ; push cons arg1
-003652 016300 MOV 2(R3), R0         ; rest <- cdr(tl)
-003654 000002
-003656 011000 MOV @R0, R0           ; arg1 <- car(rest)
-003660 004737 JSR PC, #eval         ; result <- eval(cadr(tl))
-003662 003000
-003664 010001 MOV R0, R1            ; arg2 <- result
-003666 012600 MOV (SP)+, R0         ; pop arg1
-003670 004737 JSR PC, #cons
-003672 004400
-003674 000207 RTS PC
+003642 011300 MOV @R3, R0           ; arg1 <- car(tl)
+003644 010346 MOV R3, -(SP)         ; save tl
+003646 004737 JSR PC, #eval         ; result <- eval(car(tl))
+003650 003000
+003652 012603 MOV (SP)+, R3         ; restore tl
+003654 010046 MOV R0, -(SP)         ; push cons arg1
+003656 016300 MOV 2(R3), R0         ; rest <- cdr(tl)
+003660 000002
+003662 011000 MOV @R0, R0           ; arg1 <- car(rest)
+003664 004737 JSR PC, #eval         ; result <- eval(cadr(tl))
+003666 003000
+003670 010001 MOV R0, R1            ; arg2 <- result
+003672 012600 MOV (SP)+, R0         ; pop arg1
+003674 004737 JSR PC, #cons
+003676 004400
+003700 000207 RTS PC
 
 otherwise:
 ; return eval(cons(assoc(hd), tl)))
-003676 000207 RTS PC
+003702 000207 RTS PC
 
 ; This one touches R0, R1
 eq:
 ; R0 = arg1
 ; R1 = arg2
-003700 032710 BIT #1, (R0)            ; test if arg1 is cons or atom
-003700 000001
-003700 001420 BEQ bad                 ; if its cons jump to error
+004600 032710 BIT #1, (R0)            ; test if arg1 is cons or atom
+004602 000001
+004604 001420 BEQ bad                 ; if its cons jump to error
 ; otherwise its atom
-003700 032701 BIT #1, (R1)            ; test if arg2 is cons or atom
-003710 000001
-003712 001415 BEQ bad                 ; if its cons jump to error
+004606 032711 BIT #1, (R1)            ; test if arg2 is cons or atom
+004610 000001
+004612 001415 BEQ bad                 ; if its cons jump to error
 ; get the string pointers out of atoms arg1 and arg2
-003714 011000 MOV @(R0), R0
-003716 005300 DEC R0
-003720 011101 MOV @(R1), R1
-003722 005301 DEC R1
+004614 011000 MOV @(R0), R0
+004616 005300 DEC R0
+004620 011101 MOV @(R1), R1
+004622 005301 DEC R1
 loop:
-003724 121021 CMPB (R0), (R1)+        ; compare a byte from each string
+004624 121021 CMPB (R0), (R1)+        ; compare a byte from each string
                                       ; advance R1 pointer
-003726 001003 BNE not_equal
+004626 001003 BNE not_equal
 ; if they are equal:
-003730 105720 TSTB (R0)+              ; check if null byte
+004630 105720 TSTB (R0)+              ; check if null byte
                                       ; advance R0 pointer
-003732 001403 BEQ done                ; if null byte, strings are equal
+004632 001403 BEQ done                ; if null byte, strings are equal
 ; otherwise, not done yet:
-003734 000773 BR loop
+004634 000773 BR loop
 not_equal:
 ; the strings are not equal
-003736 000244 CLZ                     ; clear zero flag
-003740 000207 RTS PC
+004636 000244 CLZ                     ; clear zero flag
+004640 000207 RTS PC
 done:
 ; the strings are equal
-003742 000264 SEZ                     ; set zero flag
-003744 000207 RTS PC
+004642 000264 SEZ                     ; set zero flag
+004644 000207 RTS PC
 bad:
-003746 000777 BR -2                   ; infinite loop
+004646 000777 BR -2                   ; infinite loop
 
 ; THIS ONE TOUCHES R0, R2
 cons:
@@ -333,7 +336,6 @@ cons:
 004422 010000
 004424 000207 RTS PC
 
-
 ; This one touches R0, R1, R2, R4
 assoc:
 004500 010504 MOV R5, R4
@@ -350,7 +352,7 @@ loop:
 004514 014401 MOV -(R4), R1   ; key <- column 0
 004516 010200 MOV R2, R0      ; arg1 <- symbol
 004520 004737 JSR PC, #eq     ; check if symbol equals key
-004522 003700
+004522 004600
 004524 001367 BNE loop
 ; otherwise they are equal
 004526 016400 MOV 2(R4), R0   ; result <- value