Answer till 5.36
This commit is contained in:
210
ex-5_31-xx.scm
210
ex-5_31-xx.scm
@@ -93,15 +93,12 @@ ev-appl-did-operator-no-restore
|
|||||||
(* (factorial (- n 1)) n)))
|
(* (factorial (- n 1)) n)))
|
||||||
'val 'next "factorial.sicp-asm")
|
'val 'next "factorial.sicp-asm")
|
||||||
|
|
||||||
;(define label-counter 0)
|
|
||||||
|
|
||||||
(compile-to-file
|
(compile-to-file
|
||||||
'(define (factorial-alt n)
|
'(define (factorial-alt n)
|
||||||
(if (= n 1)
|
(if (= n 1)
|
||||||
1
|
1
|
||||||
(* n (factorial-alt (- n 1)))))
|
(* n (factorial-alt (- n 1)))))
|
||||||
'val 'next "factorial-alt.sicp-asm")
|
'val 'next "factorial-alt.sicp-asm")
|
||||||
;(define label-counter 0)
|
|
||||||
|
|
||||||
; $ diff factorial.sicp-asm factorial-alt.sicp-asm
|
; $ diff factorial.sicp-asm factorial-alt.sicp-asm
|
||||||
; 33,36c33,34
|
; 33,36c33,34
|
||||||
@@ -133,6 +130,7 @@ ev-appl-did-operator-no-restore
|
|||||||
(display "[answered]\n")
|
(display "[answered]\n")
|
||||||
|
|
||||||
(display "\nex-5.34 - factorial-iter\n")
|
(display "\nex-5.34 - factorial-iter\n")
|
||||||
|
|
||||||
(compile-to-file
|
(compile-to-file
|
||||||
'(define (factorial n)
|
'(define (factorial n)
|
||||||
(define (iter product counter)
|
(define (iter product counter)
|
||||||
@@ -143,6 +141,210 @@ ev-appl-did-operator-no-restore
|
|||||||
(iter 1 1))
|
(iter 1 1))
|
||||||
'val 'next "factorial-iter.sicp-asm")
|
'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")
|
||||||
|
|||||||
Reference in New Issue
Block a user