diff --git a/ex-5_31-xx.scm b/ex-5_31-xx.scm index 39d4191..29b7d5a 100644 --- a/ex-5_31-xx.scm +++ b/ex-5_31-xx.scm @@ -93,15 +93,12 @@ ev-appl-did-operator-no-restore (* (factorial (- n 1)) n))) 'val 'next "factorial.sicp-asm") -;(define label-counter 0) - (compile-to-file '(define (factorial-alt n) (if (= n 1) 1 (* n (factorial-alt (- n 1))))) 'val 'next "factorial-alt.sicp-asm") -;(define label-counter 0) ; $ diff factorial.sicp-asm factorial-alt.sicp-asm ; 33,36c33,34 @@ -133,6 +130,7 @@ ev-appl-did-operator-no-restore (display "[answered]\n") (display "\nex-5.34 - factorial-iter\n") + (compile-to-file '(define (factorial n) (define (iter product counter) @@ -143,6 +141,210 @@ ev-appl-did-operator-no-restore (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)) -(display "\nex-5.35\n") +; 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") + +(display "CONTINUE HERE!\n") + +(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) + (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))))) + +; Exercise 5.37. One way to understand the compiler's preserving mechanism for +; optimizing stack usage is to see what extra operations would be generated if +; we did not use this idea. Modify preserving so that it always generates the +; save and restore operations. Compile some simple expressions and identify the +; unnecessary stack operations that are generated. Compare the code to that +; generated with the preserving mechanism intact. + +(display "\nex-5.38\n")