SICP 問題 5.37
preservingを修正して常にsaveとrestoreをさせ,修正前と後を比較する.
修正前
(define (preserving regs seq1 seq2) (if (null? regs) (append-instruction-sequences seq1 seq2) (let ((first-reg (car regs))) ;first-regが (if (and (needs-register? seq2 first-reg) ;seq2に必要なレジスタで (modifies-register? seq1 first-reg)) ;seq1が変更するレジスタなら (preserving (cdr regs) (make-instruction-sequence ;; needs ここでsaveするのでfirst-regが必要になるのでlist-union (list-union (list first-reg) (registers-needed seq1)) ;; modify saveしてのseq2の前にrestoreするのでseq2から見ればfirst-reg変更無し (list-difference (registers-modified seq1) (list first-reg)) ;; statements 条件を満たすfirst-regの場合はseq1をsaveとrestoreで挟む (append `((save ,first-reg)) (statements seq1) `((restore ,first-reg)))) seq2) (preserving (cdr regs) seq1 seq2)))))
必要ないsaveやrestoreは一切されない,賢いpreserving.
gosh> (compile '(define (f a b) (+ a b)) 'val 'next) ((env) (val) ((assign val (op make-compiled-procedure) (label entry34) (reg env)) (goto (label after-lambda35)) entry34 (assign env (op compiled-procedure-env) (reg proc)) (assign env (op extend-environment) (const (a b)) (reg argl) (reg env)) (assign proc (op lookup-variable-value) (const +) (reg env)) (assign val (op lookup-variable-value) (const a) (reg env)) (assign argl (op list) (reg val)) (assign val (op lookup-variable-value) (const b) (reg env)) (assign val (op list) (reg val)) (assign argl (op append) (reg argl) (reg val)) (test (op primitive-procedure?) (reg proc)) (branch (label primitive-branch36)) compiled-branch37 (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) primitive-branch36 (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) (goto (reg continue)) after-call38 after-lambda35 (perform (op define-variable!) (const f) (reg val) (reg env)) (assign val (const ok)) ))
修正後
(define (preserving regs seq1 seq2) (if (null? regs) (append-instruction-sequences seq1 seq2) (let ((first-reg (car regs))) (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))))
gosh> (compile '(define (f a b) (+ a b)) 'val 'next) ((continue env) ;まずcontinueを必要とするようになっている. (val) ((save continue) ;ここでsave continueするから (save env) (save continue) ;ここでさらにsave continueしている. (assign val (op make-compiled-procedure) (label entry41) (reg env)) (restore continue) ;ここで復帰. (goto (label after-lambda42)) ;ここまでで無駄なsave 3. 無駄なrestore 1 entry41 (assign env (op compiled-procedure-env) (reg proc)) (assign env (op extend-environment) (const (a b)) (reg argl) (reg env)) (save continue) ;ここでまたsave continue (save env) ;env (save continue) ;continue (assign proc (op lookup-variable-value) (const +) (reg env)) (restore continue) ;restore c (restore env) ;restore e (restore continue) ;restore c (save continue) ;save c (save proc) ;save p (save env) ;save e (save continue) ;save c (assign val (op lookup-variable-value) (const a) (reg env)) (restore continue) ;restore c (assign argl (op list) (reg val)) (restore env) ;restore e (save argl) ;save a (save continue) ;save c (assign val (op lookup-variable-value) (const b) (reg env)) (restore continue) ;restore c (restore argl) ;restore a (assign val (op list) (reg val)) (assign argl (op append) (reg argl) (reg val)) (restore proc) ;restore p (restore continue) ;restore c (test (op primitive-procedure?) (reg proc)) (branch (label primitive-branch43)) compiled-branch44 (assign val (op compiled-procedure-entry) (reg proc)) (goto (reg val)) primitive-branch43 (save continue) ;save c (assign val (op apply-primitive-procedure) (reg proc) (reg argl)) (restore continue) ;restore c (goto (reg continue)) after-call45 after-lambda42 (restore env) ;restore e 最初のenv (perform (op define-variable!) (const f) (reg val) (reg env)) (assign val (const ok)) (restore continue) ;最初のcontinue ))