2016/02/08
SICP 問題 5.38c
元のcompileによる出力と5.38abでcompile-open-codeを追加したコンパイラの出力を比べる.
命令列が約半分になっている.
compile-open-codeを追加したコンパイラの出力
((env)
(val)
((assign val (op make-compiled-procedure) (label entry1) (reg env))
(goto (label after-lambda2))
entry1
(assign env (op compiled-procedure-env) (reg proc))
(assign env (op extend-environment) (const (n)) (reg argl) (reg env))
(assign arg1 (op lookup-variable-value) (const n) (reg env))
(assign arg2 (const 1))
(assign val (op =) (reg arg1) (reg arg2))
(test (op false?) (reg val))
(branch (label false-branch4))
true-branch3
(assign val (const 1))
(goto (reg continue))
false-branch4
(save continue)
(assign proc (op lookup-variable-value) (const factorial) (reg env))
(assign arg1 (op lookup-variable-value) (const n) (reg env))
(assign arg2 (const 1))
(assign val (op -) (reg arg1) (reg arg2))
(assign argl (op list) (reg val))
(test (op primitive-procedure?) (reg proc))
(branch (label primitive-branch6))
compiled-branch7
(assign continue (label proc-return9))
(assign val (op compiled-procedure-entry) (reg proc))
(goto (reg val))
proc-return9
(assign arg1 (reg val))
(goto (label after-call8))
primitive-branch6
(assign arg1 (op apply-primitive-procedure) (reg proc) (reg argl))
after-call8
(assign arg2 (op lookup-variable-value) (const n) (reg env))
(assign val (op *) (reg arg1) (reg arg2))
(restore continue)
(goto (reg continue))
after-if5
after-lambda2
(perform (op define-variable!) (const factorial) (reg val) (reg env))
(assign val (const ok))))
元のcompileによる出力
((env)
(val)
((assign val (op make-compiled-procedure) (label entry1) (reg env))
(goto (label after-lambda2))
entry1
(assign env (op compiled-procedure-env) (reg proc))
(assign env (op extend-environment) (const (n)) (reg argl) (reg env))
(save continue)
(save env)
(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 n) (reg env))
(assign argl (op cons) (reg val) (reg argl))
(test (op primitive-procedure?) (reg proc))
(branch (label primitive-branch6))
compiled-branch7
(assign continue (label after-call8))
(assign val (op compiled-procedure-entry) (reg proc))
(goto (reg val))
primitive-branch6
(assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call8
(restore env)
(restore continue)
(test (op false?) (reg val))
(branch (label false-branch4))
true-branch3
(assign val (const 1))
(goto (reg continue))
false-branch4
(assign proc (op lookup-variable-value) (const *) (reg env))
(save continue)
(save proc)
(assign val (op lookup-variable-value) (const n) (reg env))
(assign argl (op list) (reg val))
(save argl)
(assign proc (op lookup-variable-value) (const factorial) (reg env))
(save proc)
(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 n) (reg env))
(assign argl (op cons) (reg val) (reg argl))
(test (op primitive-procedure?) (reg proc))
(branch (label primitive-branch9))
compiled-branch10
(assign continue (label after-call11))
(assign val (op compiled-procedure-entry) (reg proc))
(goto (reg val))
primitive-branch9
(assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call11
(assign argl (op list) (reg val))
(restore proc)
(test (op primitive-procedure?) (reg proc))
(branch (label primitive-branch12))
compiled-branch13
(assign continue (label after-call14))
(assign val (op compiled-procedure-entry) (reg proc))
(goto (reg val))
primitive-branch12
(assign val (op apply-primitive-procedure) (reg proc) (reg argl))
after-call14
(restore argl)
(assign argl (op cons) (reg val) (reg argl))
(restore proc)
(restore continue)
(test (op primitive-procedure?) (reg proc))
(branch (label primitive-branch15))
compiled-branch16
(assign val (op compiled-procedure-entry) (reg proc))
(goto (reg val))
primitive-branch15
(assign val (op apply-primitive-procedure) (reg proc) (reg argl))
(goto (reg continue))
after-call17
after-if5
after-lambda2
(perform (op define-variable!) (const factorial) (reg val) (reg env))
(assign val (const ok))
))