447 lines
14 KiB
Scheme
447 lines
14 KiB
Scheme
(load "util.scm")
|
|
(load "misc/ch5-compiler.scm")
|
|
|
|
(display "\nex-5.31 - save-and-restore-for-apply\n")
|
|
|
|
; 1. save and restore env around operator
|
|
; 2. save and restore env around each operand (except last)
|
|
; 3. save and restore argl around each operand
|
|
; 4. save and restore proc around operand sequence
|
|
|
|
; (f 'x 'y)
|
|
; 1-4 are superfluous
|
|
|
|
; ((f) 'x 'y)
|
|
; 1-4 are superfluous
|
|
; no need to save env because compound-apply without args does
|
|
; not change env
|
|
|
|
; (f (g 'x) y)
|
|
; 1 is superfluous
|
|
; we need 2 because (g 'x) changes the env for y
|
|
; we need 3 because (g 'x) changes argl
|
|
; we need 4 because (g 'x) changes proc
|
|
|
|
; (f (g 'x) 'y) ; 1 is superfluous
|
|
; 1-2 are superfluous
|
|
; (g 'x) changes the env but we don't need it later (better save it anyway)
|
|
; 3-4 are still needed
|
|
|
|
(display "[answered]\n")
|
|
|
|
(display "\nex-5.32 - optimize-eceval-application\n")
|
|
|
|
'(
|
|
ev-application
|
|
(save continue)
|
|
(assign unev (op operands) (reg exp))
|
|
(assign exp (op operator) (reg exp))
|
|
(assign continue (label ev-appl-did-operator-no-restore))
|
|
(test (op variable?) (reg exp))
|
|
(branch (label ev-variable))
|
|
(save env)
|
|
(save unev)
|
|
(assign continue (label ev-appl-did-operator))
|
|
(goto (label eval-dispatch))
|
|
ev-appl-did-operator
|
|
(restore unev)
|
|
(restore env)
|
|
ev-appl-did-operator-no-restore
|
|
(assign argl (op empty-arglist))
|
|
(assign proc (reg val))
|
|
(test (op no-operands?) (reg unev))
|
|
(branch (label apply-dispatch))
|
|
(save proc)
|
|
)
|
|
|
|
(display "[ok]\n")
|
|
|
|
; b. Applying all the optimizations make sense, but the compiled code will
|
|
; still run faster because the interpreter has to analyze the code every time
|
|
; it executes and the analysis itself adds overhead that the compiler can do
|
|
; before runtime
|
|
(display "[answered]\n")
|
|
|
|
|
|
(display "\nex-5.33 - compare-factorial-definitions\n")
|
|
|
|
(define (compile-to-file code target linkage file-name)
|
|
(set! label-counter 0)
|
|
(define (write-list-to-port xs port)
|
|
(if (null? xs)
|
|
'()
|
|
(begin
|
|
(display (car xs) port)
|
|
(display "\n" port)
|
|
(write-list-to-port (cdr xs) port))))
|
|
(if #f ; #t means write to file; #f means don't write to file
|
|
(let* ((compile-result (compile code target linkage))
|
|
(assembly-insts (statements compile-result))
|
|
(port (open-output-file file-name)))
|
|
(write-list-to-port assembly-insts port)
|
|
(display "[")
|
|
(display file-name)
|
|
(display "]\n")
|
|
(close-output-port port))
|
|
(begin
|
|
(display "[")
|
|
(display file-name)
|
|
(display "]\n"))))
|
|
|
|
; Uncomment the following lines to write the assembly code for the to methods
|
|
; into files.
|
|
|
|
(compile-to-file
|
|
'(define (factorial n)
|
|
(if (= n 1)
|
|
1
|
|
(* (factorial (- n 1)) n)))
|
|
'val 'next "factorial.sicp-asm")
|
|
|
|
(compile-to-file
|
|
'(define (factorial-alt n)
|
|
(if (= n 1)
|
|
1
|
|
(* n (factorial-alt (- n 1)))))
|
|
'val 'next "factorial-alt.sicp-asm")
|
|
|
|
; $ diff factorial.sicp-asm factorial-alt.sicp-asm
|
|
; 33,36c33,34
|
|
; < (assign val (op lookup-variable-value) (const n) (reg env))
|
|
; < (assign argl (op list) (reg val))
|
|
; < (save argl)
|
|
; ---
|
|
; > (save env)
|
|
; > (assign proc (op lookup-variable-value) (const factorial-alt) (reg env))
|
|
; 63c61,63
|
|
; < (restore argl)
|
|
; ---
|
|
; > (assign argl (op list) (reg val))
|
|
; > (restore env)
|
|
; > (assign val (op lookup-variable-value) (const n) (reg env))
|
|
|
|
; The regular factorial needs an additional save-and-restore for argl before
|
|
; the recursive call. Argl must be saved because it contains the value of n
|
|
; before the recursive call.
|
|
|
|
; The alternative factorial needs an additional save-and-restore for env before
|
|
; the recursive call. Env must be saved for other the evaluation of the
|
|
; remaining arguments. In this case, the look-up of n which comes second for
|
|
; the alternative implementation.
|
|
|
|
; Neither version executes more efficiently and they have the same number of
|
|
; instructions.
|
|
|
|
(display "[answered]\n")
|
|
|
|
(display "\nex-5.34 - factorial-iter\n")
|
|
|
|
(compile-to-file
|
|
'(define (factorial n)
|
|
(define (iter product counter)
|
|
(if (> counter n)
|
|
product
|
|
(iter (* counter product)
|
|
(+ counter 1))))
|
|
(iter 1 1))
|
|
'val 'next "factorial-iter.sicp-asm")
|
|
|
|
; ;; construct code for factorial
|
|
; (assign val (op make-compiled-procedure) (label entry2) (reg env))
|
|
; (goto (label after-lambda1))
|
|
;
|
|
; ;; entry to factorial
|
|
; entry2
|
|
; (assign env (op compiled-procedure-env) (reg proc))
|
|
; (assign env (op extend-environment) (const (n)) (reg argl) (reg env))
|
|
;
|
|
; ;; construct the iter procedure within factorial
|
|
; (assign val (op make-compiled-procedure) (label entry7) (reg env))
|
|
; (goto (label after-lambda6))
|
|
;
|
|
; ;; entry to iter
|
|
; entry7
|
|
; (assign env (op compiled-procedure-env) (reg proc))
|
|
; (assign env (op extend-environment) (const (product counter)) (reg argl) (reg env))
|
|
; (save continue)
|
|
; (save env)
|
|
; (assign proc (op lookup-variable-value) (const >) (reg env))
|
|
; (assign val (op lookup-variable-value) (const n) (reg env))
|
|
; (assign argl (op list) (reg val))
|
|
; (assign val (op lookup-variable-value) (const counter) (reg env))
|
|
; (assign argl (op cons) (reg val) (reg argl))
|
|
; (test (op primitive-procedure?) (reg proc))
|
|
; (branch (label primitive-branch22))
|
|
;
|
|
; ;; dead code
|
|
; compiled-branch21
|
|
; (assign continue (label after-call20))
|
|
; (assign val (op compiled-procedure-entry) (reg proc))
|
|
; (goto (reg val))
|
|
; ;; dead code end
|
|
;
|
|
; primitive-branch22
|
|
; (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
|
|
; after-call20
|
|
; (restore env)
|
|
; (restore continue)
|
|
; (test (op false?) (reg val))
|
|
; (branch (label false-branch9))
|
|
;
|
|
; true-branch10
|
|
; ;; load end result into val and return
|
|
; (assign val (op lookup-variable-value) (const product) (reg env))
|
|
; (goto (reg continue))
|
|
;
|
|
; false-branch9
|
|
; ;; setup for next iteration
|
|
; (assign proc (op lookup-variable-value) (const iter) (reg env))
|
|
; (save continue)
|
|
; (save proc)
|
|
; (save env)
|
|
;
|
|
; ;; compute first argument for iter call
|
|
; (assign proc (op lookup-variable-value) (const +) (reg env))
|
|
; (assign val (const 1))
|
|
; (assign argl (op list) (reg val))
|
|
; (assign val (op lookup-variable-value) (const counter) (reg env))
|
|
; (assign argl (op cons) (reg val) (reg argl))
|
|
; (test (op primitive-procedure?) (reg proc))
|
|
; (branch (label primitive-branch16))
|
|
; compiled-branch15
|
|
; (assign continue (label after-call14))
|
|
; (assign val (op compiled-procedure-entry) (reg proc))
|
|
; (goto (reg val))
|
|
; primitive-branch16
|
|
; (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
|
|
; after-call14
|
|
; (assign argl (op list) (reg val))
|
|
;
|
|
; ;; compute second argument for iter call
|
|
; (restore env)
|
|
; (save argl)
|
|
; (assign proc (op lookup-variable-value) (const *) (reg env))
|
|
; (assign val (op lookup-variable-value) (const product) (reg env))
|
|
; (assign argl (op list) (reg val))
|
|
; (assign val (op lookup-variable-value) (const counter) (reg env))
|
|
; (assign argl (op cons) (reg val) (reg argl))
|
|
; (test (op primitive-procedure?) (reg proc))
|
|
; (branch (label primitive-branch13))
|
|
; compiled-branch12
|
|
; (assign continue (label after-call11))
|
|
; (assign val (op compiled-procedure-entry) (reg proc))
|
|
; (goto (reg val))
|
|
; primitive-branch13
|
|
; (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
|
|
;
|
|
; after-call11
|
|
; (restore argl)
|
|
; (assign argl (op cons) (reg val) (reg argl))
|
|
;
|
|
; ;; prepare for tail-recursive call to iter
|
|
; (restore proc)
|
|
; ;; restore the original continue label
|
|
; (restore continue)
|
|
; (test (op primitive-procedure?) (reg proc))
|
|
; (branch (label primitive-branch19))
|
|
; compiled-branch18
|
|
; (assign val (op compiled-procedure-entry) (reg proc))
|
|
; ;; jump to entry of iter
|
|
; (goto (reg val))
|
|
; primitive-branch19
|
|
; (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
|
|
; (goto (reg continue))
|
|
; after-call17
|
|
; after-if8
|
|
; after-lambda6
|
|
; ;; after definition of iter
|
|
; (perform (op define-variable!) (const iter) (reg val) (reg env))
|
|
; (assign val (const ok))
|
|
;
|
|
; ;; call iter with the initial arguments
|
|
; (assign proc (op lookup-variable-value) (const iter) (reg env))
|
|
; (assign val (const 1))
|
|
; (assign argl (op list) (reg val))
|
|
; (assign val (const 1))
|
|
; (assign argl (op cons) (reg val) (reg argl))
|
|
; (test (op primitive-procedure?) (reg proc))
|
|
; (branch (label primitive-branch5))
|
|
; compiled-branch4
|
|
; (assign val (op compiled-procedure-entry) (reg proc))
|
|
; (goto (reg val)) ;; jump to entry of iter
|
|
; ;; primitive branch not taken
|
|
; primitive-branch5
|
|
; (assign val (op apply-primitive-procedure) (reg proc) (reg argl))
|
|
; (goto (reg continue))
|
|
; after-call3
|
|
; after-lambda1
|
|
; ;; after definition of factorial
|
|
; (perform (op define-variable!) (const factorial) (reg val) (reg env))
|
|
; (assign val (const ok))
|
|
|
|
; The iterative procedure restores the continue register before the next
|
|
; recursive call to iter. This allows the based case to return directly to the
|
|
; original caller of factorial. The recursive implementation requires each call
|
|
; to return to the original to the previous caller which builds up the stack.
|
|
|
|
(display "[answered]\n")
|
|
|
|
|
|
(display "\nex-5.35 - reverse-engineer-compiled-procedure\n")
|
|
|
|
(compile-to-file
|
|
'(define (f x)
|
|
(+ x (g (+ x 2))))
|
|
'val 'next "f-reversed.sicp-asm")
|
|
(display "[ok]\n")
|
|
|
|
|
|
(display "\nex-5.36 - order-of-evaluation\n")
|
|
|
|
; The compiler produces code the evaluates in right-to-left order.
|
|
|
|
; To change the order to left-to-right we can remove the reverse from
|
|
; construct-arglist. We then have to construct the arglist with append instead
|
|
; of cons. That means we have to put the current arg val into a list and then
|
|
; call the append procedure. Consequently, the performance is worse because of
|
|
; the additional list instruction and because append is more expensive than
|
|
; cons.
|
|
|
|
; (define (code-to-get-rest-args operand-codes)
|
|
; (let ((code-for-next-arg
|
|
; (preserving '(argl)
|
|
; (car operand-codes)
|
|
; (make-instruction-sequence '(val argl) '(argl)
|
|
; '((assign val (op list) (reg val)) ;; ** left-to-right evaluation
|
|
; (assign argl (op append) (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))))))
|
|
|
|
(display "[answered]\n")
|
|
|
|
|
|
(display "\nex-5.37 - preserving-mechanism-evaluation\n")
|
|
|
|
; Uncomment the following code to compile a version with optimized and
|
|
; unoptimzed stack usage for a simple program.
|
|
|
|
(compile-to-file
|
|
'(+ 1 1)
|
|
'val 'next "f-add.scm")
|
|
|
|
;(define (preserving regs seq1 seq2)
|
|
; (if (null? regs)
|
|
; (append-instruction-sequences seq1 seq2)
|
|
; (let ((first-reg (car regs)))
|
|
; (if #t ; preserve all registers no matter what
|
|
; ; (and (needs-register? seq2 first-reg) (modifies-register? seq1 first-reg))
|
|
; (preserving (cdr regs)
|
|
; (make-instruction-sequence
|
|
; (list-union (list first-reg)
|
|
; (registers-needed seq1))
|
|
; (list-difference (registers-modified seq1)
|
|
; (list first-reg))
|
|
; (append `((save ,first-reg))
|
|
; (statements seq1)
|
|
; `((restore ,first-reg))))
|
|
; seq2)
|
|
; (preserving (cdr regs) seq1 seq2)))))
|
|
|
|
(compile-to-file
|
|
'(+ 1 1)
|
|
'val 'next "f-add-unoptimized-stack-usage.scm")
|
|
|
|
; $ diff f-add.scm f-add-unoptimized-stack-usage.scm
|
|
; 0a1,3
|
|
; > (save continue)
|
|
; > (save env)
|
|
; > (save continue)
|
|
; 1a5,11
|
|
; > (restore continue)
|
|
; > (restore env)
|
|
; > (restore continue)
|
|
; > (save continue)
|
|
; > (save proc)
|
|
; > (save env)
|
|
; > (save continue)
|
|
; 2a13
|
|
; > (restore continue)
|
|
; 3a15,17
|
|
; > (restore env)
|
|
; > (save argl)
|
|
; > (save continue)
|
|
; 4a19,20
|
|
; > (restore continue)
|
|
; > (restore argl)
|
|
; 5a22,23
|
|
; > (restore proc)
|
|
; > (restore continue)
|
|
; 12a31
|
|
; > (save continue)
|
|
; 13a33
|
|
; > (restore continue)
|
|
|
|
; Even for the simple program (+ 1 1) the stack-preserving-mechanism saves 20
|
|
; stack operations. Pretty impressive.
|
|
|
|
(display "[answered]\n")
|
|
|
|
(display "\nex-5.38 - optimize-procedure-application\n")
|
|
|
|
; a. The open-coded primitives, unlike the special forms, all need their
|
|
; operands evaluated. Write a code generator spread-arguments for use by all
|
|
; the open-coding code generators. Spread-arguments should take an operand list
|
|
; and compile the given operands targeted to successive argument registers.
|
|
; Note that an operand may contain a call to an open-coded primitive, so
|
|
; argument registers will have to be preserved during operand evaluation.
|
|
|
|
(define (spread-arguments operand-list)
|
|
(define (compile-operands operand-list operand-number)
|
|
(cond
|
|
((null? operand-list) (empty-instruction-sequence))
|
|
((and (= operand-number 1))
|
|
(preserving
|
|
'(arg1)
|
|
(compile (car operand-list) 'arg1 'next)
|
|
(compile-operands (cdr operand-list) (+ operand-number 1))))
|
|
((and (= operand-number 2))
|
|
(preserving
|
|
'(arg1 arg2)
|
|
(compile (car operand-list) 'arg2 'next)
|
|
(compile-operands (cdr operand-list) (+ operand-number 1))))
|
|
(else
|
|
(error "Only two arg registers supported -- SPREAD-ARGUMENTS"))))
|
|
|
|
(let ((operand-codes (compile-operands operand-list 1)))
|
|
operand-codes))
|
|
|
|
(define (display-lines xs)
|
|
(define (display-line x)
|
|
(display x) (newline))
|
|
(map display-line xs))
|
|
|
|
(display-lines (third (spread-arguments '(1 1))))
|
|
(newline)
|
|
|
|
(display "b. CONTINUE HERE\n")
|
|
|
|
; b. For each of the primitive procedures =, *, -, and +, write a code
|
|
; generator that takes a combination with that operator, together with a target
|
|
; and a linkage descriptor, and produces code to spread the arguments into the
|
|
; registers and then perform the operation targeted to the given target with
|
|
; the given linkage. You need only handle expressions with two operands. Make
|
|
; compile dispatch to these code generators.
|
|
|
|
; c. Try your new compiler on the factorial example. Compare the resulting
|
|
; code with the result produced without open coding.
|
|
|
|
; d. Extend your code generators for + and * so that they can handle
|
|
; expressions with arbitrary numbers of operands. An expression with more than
|
|
; two operands will have to be compiled into a sequence of operations, each
|
|
; with only two inputs.
|
|
|
|
(display "\nex-5.39\n")
|