MIT 6.001 Class Notes May 1, 1997 Explicit Control Evaluator Code (excerpts) eval-dispatch ;; CONTRACT ;; Expects: ;; expression in EXP ;; environment in ENV ;; continuation in CONTINUE ;; Promises: ;; value will be in VAL ;; control will be at label in CONTINUE ;; stack will be unchanged (test (op self-evaluating?) (reg exp)) (branch (label ev-self-eval)) ... (test (op application?) (reg exp)) (branch (label ev-application)) (goto (label unknown-expression-type)) ev-self-eval (assign val (reg exp)) (goto (reg continue)) ev-variable (assign val (op lookup-variable-value) (reg exp) (reg env)) (goto (reg continue)) ev-application (save continue) (save env) (assign unev (op operands) (reg exp)) (save unev) (assign exp (op operator) (reg exp)) (assign continue (label ev-appl-did-operator)) (goto (label eval-dispatch)) ev-appl-did-operator (restore unev) (restore env) (assign argl (op empty-arglist)) (assign proc (reg val)) (test (op no-operands?) (reg unev)) (branch (label apply-dispatch)) (save proc) ev-appl-operand-loop (save argl) (assign exp (op first-operand) (reg unev)) (test (op last-operand?) (reg unev)) (branch (label ev-appl-last-arg)) (save env) (save unev) (assign continue (label ev-appl-accumulate-arg)) (goto (label eval-dispatch)) ev-appl-accumulate-arg (restore unev) (restore env) (restore argl) (assign argl (op adjoin-arg) (reg val) (reg argl)) (assign unev (op rest-operands) (reg unev)) (goto (label ev-appl-operand-loop)) ev-appl-last-arg (assign continue (label ev-appl-accum-last-arg)) (goto (label eval-dispatch)) ev-appl-accum-last-arg (restore argl) (assign argl (op adjoin-arg) (reg val) (reg argl)) (restore proc) (goto (label apply-dispatch)) apply-dispatch ;; CONTRACT ;; Expects: ;; procedure to call in PROC ;; arguments in ARGL ;; continuation on the top of stack ;; Promises: ;; value in VAL ;; control at label specified by continuation ;; stack will have the continuation removed (test (op primitive-procedure?) (reg proc)) (branch (label primitive-apply)) (test (op compound-procedure?) (reg proc)) (branch (label compound-apply)) ... compound-apply (assign unev (op procedure-parameters) (reg proc)) (assign env (op procedure-environment) (reg proc)) (assign env (op extend-environment) (reg unev) (reg argl) (reg env)) (assign unev (op procedure-body) (reg proc)) (goto (label ev-sequence)) ev-if (save exp) (save env) (save continue) (assign continue (label ev-if-decide)) (assign exp (op if-predicate) (reg exp)) (goto (label eval-dispatch)) ev-if-decide (restore continue) (restore env) (restore exp) (test (op true?) (reg val)) (branch (label ev-if-consequent)) ev-if-alternative (assign exp (op if-alternative) (reg exp)) (goto (label eval-dispatch)) ev-if-consequent (assign exp (op if-consequent) (reg exp)) (goto (label eval-dispatch)) ev-sequence ;; CONTRACT ;; Expects: ;; list of expressions in UNEV ;; environment in ENV ;; continuation on top of stack ;; Promises: ;; value of last expression in VAL ;; control at label specified by continuation ;; stack will have the continuation removed ... "Trivial Compilation" of (F A 1 2) Just knowing the contents of EXP and UNEV, plus remembering on what part of the code sequence we are working. ev-application<1> 1/1: (save continue) 2/2: (save env) ./3: ... (assign unev (op operands) (reg exp)) ; UNEV <- '(A 1 2) ./4: ... (save unev) ./5: ... (assign exp (op operator) (reg exp)) ; EXP <- 'F ./6: ... (assign continue (label ev-appl-did-operator)) ev-variable<2> 3/7: (assign val (op lookup-variable-value) (const F) (reg env)) ./8: ... (goto (reg continue)) ./9: ... (restore unev) ev-appl-did-operator<3> 4/10: (restore env) 5/11: (assign argl (op empty-arglist)) 6/12: (assign proc (reg val)) ./13: ... (test (op no-operands?) (reg unev)) ./14: ... (branch (label apply-dispatch)) 7/15: (save proc) ev-appl-operand-loop<4> 8/16: (save argl) ./17: ... (assign exp (op first-operand) (reg unev)) ; EXP <- 'A ./18: ... (test (op last-operand?) (reg unev)) ./19: ... (branch (label ev-appl-last-arg)) 9/20: (save env) ./21: ... (save unev) ./22: ... (assign continue (label ev-appl-accumulate-arg)) ./23: ... (goto (label eval-dispatch)) ev-variable<5> 10/24: (assign val (op lookup-variable-value) (const A) (reg env)) ../25 ... (goto (reg continue)) ev-appl-accumulate-arg<6> ../26: ... (restore unev) 11/27: (restore env) 12/28: (restore argl) 13/29: (assign argl (op adjoin-arg) (reg val) (reg argl)) 14/30: (assign unev (op rest-operands) (reg unev)) ; UNEV <- '(1 2) ../31: ... (goto (label ev-appl-operand-loop)) ev-appl-operand-loop<7> 15/32: (save argl) ../33: ... (assign exp (op first-operand) (reg unev)) ; EXP <- 1 ../34: ... (test (op last-operand?) (reg unev)) ../35: ... (branch (label ev-appl-last-arg)) 16/36: (save env) ../37: ... (save unev) ../38: ... (assign continue (label ev-appl-accumulate-arg)) ../39: ... (goto (label eval-dispatch)) ev-self-eval<8> 17/40: (assign val (const 1)) ../41: ... (goto (reg continue)) ev-appl-accumulate-arg<8> ../42: ... (restore unev) 18/43: (restore env) 19/44: (restore argl) 20/45: (assign argl (op adjoin-arg) (reg val) (reg argl)) ../46: ... (assign unev (op rest-operands) (reg unev)) ; UNEV <- '(2) ../47: ... (goto (label ev-appl-operand-loop)) ev-appl-operand-loop<9> 21/48: (save argl) ../49: ... (assign exp (op first-operand) (reg unev)) ; EXP <- 2 ../50: ... (test (op last-operand?) (reg unev)) ../51: ... (branch (label ev-appl-last-arg)) ev-appl-last-arg<10> ../52: ... (assign continue (label ev-appl-accum-last-arg)) ../53: ... (goto (label eval-dispatch)) ev-self-eval<11> 22/54: (assign val (const 2)) ../55: ... (goto (reg continue)) ev-appl-accum-last-arg<12> 23/56: (restore argl) 24/57: (assign argl (op adjoin-arg) (reg val) (reg argl)) 25/58: (restore proc) ../59: ... (goto (label apply-dispatch)) There are a total of 25 instructions out of 59 if we don't count the instructions in eval-dispatch (and we went there 4 times)! The compiler, as we saw, has to track where control goes after the current group of instructions is completed. There are three "linkage" possibilities: (a) NEXT: On to the next instruction in the sequence. This is what happens when we just tape sequences together. (b) RETURN: At run time, the CONTINUE register will say where to go. This is what happens when we come to the end of a procedure body. (c) A specific label: This is what happens when the compiler generates a sequence of instructions corresponding to ones where the interpreter places a value directly into the CONTINUE register and then goes off to EVAL-DISPATCH (like the argument loop, IF, etc.) (define (compile-linkage linkage) (cond ((eq? linkage 'return) (make-instruction-sequence '((goto (reg continue))))) ((eq? linkage 'next) (empty-instruction-sequence)) (else (make-instruction-sequence `((goto (label ,linkage))))))) In addition, there is the general idea of preserving a set of registers while a set of instructions is executed. For example, we preserve the ENV register while executing the instructions that compute the predicate of an IF, so the ENV register is unchanged when we decide whether to compute the consequent or alternative. This is done by putting in SAVEs before the instructions and corresponding RESTOREs after: [Warning: the code shown here isn't exactly what's in the compiler, as will be explained later.] (define (preserving regs seq1 seq2) (if (null? regs) (append-instruction-sequences seq1 seq2) (let ((first-reg (car regs))) (preserving (cdr regs) (make-instruction-sequence (append `((save ,first-reg)) (statements seq1) `((restore ,first-reg)))) seq2)))) (define (end-with-linkage linkage instruction-sequence) (preserving '(continue) instruction-sequence (compile-linkage linkage))) (define (compile-self-evaluating exp target linkage) (end-with-linkage linkage (make-instruction-sequence `((assign ,target (const ,exp)))))) (define (compile-application exp target linkage) (let ((proc-code (compile (operator exp) 'proc 'next)) (operand-codes (map (lambda (operand) (compile operand 'val 'next)) (operands exp)))) (preserving '(env continue) proc-code (preserving '(proc continue) (construct-arglist operand-codes) (compile-procedure-call target linkage))))) (define (construct-arglist operand-codes) (let ((operand-codes (reverse operand-codes))) (if (null? operand-codes) (make-instruction-sequence '((assign argl (const ())))) (let ((code-to-get-last-arg (append-instruction-sequences (car operand-codes) (make-instruction-sequence '((assign argl (op list) (reg val))))))) (if (null? (cdr operand-codes)) code-to-get-last-arg (preserving '(env) code-to-get-last-arg (code-to-get-rest-args (cdr operand-codes)))))))) (define (code-to-get-rest-args operand-codes) (let ((code-for-next-arg (preserving '(argl) (car operand-codes) (make-instruction-sequence '((assign argl (op cons) (reg val) (reg argl))))))) (if (null? (cdr operand-codes)) code-for-next-arg (preserving '(env) code-for-next-arg (code-to-get-rest-args (cdr operand-codes)))))) Our first compiler does one very small optimization: "targetting registers" rather than always putting the result into VAL. In particular, the operator of a combination is directly put into PROC rather into VAL and then moved to PROC as in our interpreter. Note: The compiler and the interpreter evaluate operands in opposite order! The compiler goes right-to-left, the interpreter goes left-to-right. The compiled code uses CONS to build up the list of argument values, while the interpreter uses ADJOIN-ARG. (save continue) (save env) (save continue) (assign proc (op lookup-variable-value) (const f) (reg env)) (restore continue) (restore env) (restore continue) (save continue) (save proc) (save env) (save continue) (assign val (const 2)) (restore continue) (assign argl (op list) (reg val)) (restore env) (save env) (save argl) (save continue) (assign val (const 1)) (restore continue) (restore argl) (assign argl (op cons) (reg val) (reg argl)) (restore env) (save argl) (save continue) (assign val (op lookup-variable-value) (const a) (reg env)) (restore continue) (restore argl) (assign argl (op cons) (reg val) (reg argl)) (restore proc) (restore continue) 31 instructions, which is 6 instructions (25%) worse than our trivial compiler! But we can improve things! Notice that we don't have to SAVE and RESTORE a register if either (a) it isn't changed by the instructions we're saving it around, or (b) it isn't needed by the instructions we're saving it for. This means that an "instruction sequence" must be more than just the statements to be executed: we need to know what registers it changes (to test condition (a)) and which registers it modifies (to test condition (b)). [This is why the earlier code wasn't quite correct: the calls to make-instruction-sequence, etc., need extra arguments specified these lists of registers.] (define (preserving regs seq1 seq2) (if (null? regs) (append-instruction-sequences seq1 seq2) (let ((first-reg (car regs))) (if (and (needs-register? seq2 first-reg) ; ** (modifies-register? seq1 first-reg)) ; ** (preserving (cdr regs) (make-instruction-sequence (list-union (list first-reg) ; ** needs (registers-needed seq1)) ; ** (list-difference (registers-modified seq1) ; ** modifies (list first-reg)) ; ** (append `((save ,first-reg)) (statements seq1) `((restore ,first-reg)))) seq2) (preserving (cdr regs) seq1 seq2))))) (compile-and-display '(f a 1 2)) (assign proc (op lookup-variable-value) (const f) (reg env)) (assign val (const 2)) (assign argl (op list) (reg val)) (assign val (const 1)) (assign argl (op cons) (reg val) (reg argl)) (assign val (op lookup-variable-value) (const a) (reg env)) (assign argl (op cons) (reg val) (reg argl)) 7 instructions instead of 25 (trivial compiler), 31 ("dumb" preserving) or >59 (interpreter).