162 lines
5.0 KiB
Scheme
162 lines
5.0 KiB
Scheme
(load "shared/util")
|
|
(load "shared/sicp-load-eceval-compiler")
|
|
(load "shared/sicp-compiler")
|
|
|
|
(display "\nex-5.45 - factorial-stack-usage-comparison\n")
|
|
|
|
;(compile-and-go
|
|
; '(begin
|
|
; (define (factorial n)
|
|
; (if (= n 1)
|
|
; 1
|
|
; (* (factorial (- n 1)) n)))
|
|
; (factorial 10)))
|
|
|
|
; a.
|
|
|
|
; | (factorial 10) | pushes | depth |
|
|
; | -------------- | ------ | ------ |
|
|
; | machine | 18 | 18 |
|
|
; | compiled | 56 | 29 |
|
|
; | evaluator | 310 | 35 |
|
|
|
|
; | (factorial 20) | pushes | depth |
|
|
; | -------------- | ------ | ------ |
|
|
; | machine | 38 | 38 |
|
|
; | compiled | 116 | 59 |
|
|
; | evaluator | 630 | 65 |
|
|
|
|
; pushes(compiled/machine) = 3
|
|
; depth(compiled/machine) = 1.5
|
|
|
|
; pushes(evaluator/compiled) = 5.5
|
|
; depth(evaluator/compiled) = 1.2
|
|
|
|
; b. Use special handling for primitive procedures from exercise 5.38.
|
|
|
|
(display "[done]\n")
|
|
|
|
(display "\nex-5.46 - fibo-stack-usage-comparison\n")
|
|
|
|
;(compile-and-go
|
|
; '(begin
|
|
; (define (fib n)
|
|
; (if (< n 2)
|
|
; n
|
|
; (+ (fib (- n 1)) (fib (- n 2)))))
|
|
; (fib 10)))
|
|
|
|
; | (fib 10) | pushes | depth |
|
|
; | -------------- | ------ | ------ |
|
|
; | machine | 264 | 18 |
|
|
; | compiled | 882 | 29 |
|
|
; | evaluator | 4950 | 53 |
|
|
|
|
; | (fib 20) | pushes | depth |
|
|
; | -------------- | ------ | ------ |
|
|
; | machine | 32835 | 38 |
|
|
; | compiled | 109452 | 59 |
|
|
; | evaluator | 612942 | 103 |
|
|
|
|
(display "[done]\n")
|
|
|
|
(display "\nex-5.47 - call-interpreted-from-compiled\n")
|
|
|
|
(define (compile-procedure-call target linkage)
|
|
(let* ((primitive-branch (make-label 'primitive-branch))
|
|
(compiled-branch (make-label 'compiled-branch))
|
|
(interpreted-branch (make-label 'interpreted-branch))
|
|
(after-call (make-label 'after-call))
|
|
(compiled-linkage (if (eq? linkage 'next) after-call linkage))
|
|
(compiled-test-primitive
|
|
(make-instruction-sequence
|
|
'(proc) '()
|
|
`((test (op primitive-procedure?) (reg proc))
|
|
(branch (label ,primitive-branch)))))
|
|
(compiled-test-procedure
|
|
(make-instruction-sequence
|
|
'(proc) '()
|
|
`((test (op compiled-procedure?) (reg proc))
|
|
(branch (label ,compiled-branch)))))
|
|
(compiled-interpreted-branch
|
|
(append-instruction-sequences
|
|
interpreted-branch
|
|
(compile-intp-appl target compiled-linkage)))
|
|
(compiled-compiled-branch
|
|
(append-instruction-sequences
|
|
compiled-branch
|
|
(compile-proc-appl target compiled-linkage)))
|
|
(compiled-primitive-branch
|
|
(append-instruction-sequences
|
|
primitive-branch
|
|
(end-with-linkage
|
|
linkage
|
|
(make-instruction-sequence
|
|
'(proc argl) (list target)
|
|
`((assign ,target (op apply-primitive-procedure) (reg proc) (reg argl))))))))
|
|
(append-instruction-sequences
|
|
compiled-test-primitive
|
|
(append-instruction-sequences
|
|
compiled-test-procedure
|
|
(parallel-instruction-sequences
|
|
compiled-interpreted-branch
|
|
(parallel-instruction-sequences
|
|
compiled-compiled-branch
|
|
compiled-primitive-branch)))
|
|
after-call)))
|
|
|
|
(define (compile-intp-appl target linkage)
|
|
(cond ((and (eq? target 'val) (not (eq? linkage 'return)))
|
|
(make-instruction-sequence
|
|
'(proc) all-regs
|
|
`((save continue)
|
|
(assign continue (label ,linkage))
|
|
(save continue)
|
|
(goto (reg compapp)))))
|
|
((and (not (eq? target 'val)) (not (eq? linkage 'return)))
|
|
(let ((proc-return (make-label 'proc-return)))
|
|
(make-instruction-sequence '(proc) all-regs
|
|
`((save continue)
|
|
(assign continue (label ,proc-return))
|
|
(save continue)
|
|
(goto (reg compapp))
|
|
,proc-return
|
|
(assign ,target (reg val))
|
|
(goto (label ,linkage))))))
|
|
((and (eq? target 'val) (eq? linkage 'return))
|
|
(make-instruction-sequence
|
|
'(proc) all-regs
|
|
`((save continue)
|
|
(goto (reg compapp)))))
|
|
(else (error "unsupported target linkage -- COMPILE-INTP-APPL"
|
|
(list target linkage)))))
|
|
|
|
(define expression
|
|
'(begin
|
|
(define (f n)
|
|
(g n))
|
|
(define (factorial n)
|
|
(if (= n 1)
|
|
1
|
|
(* (factorial (- n 1)) n)))))
|
|
|
|
; (compile-to-file expression 'val 'return "f-call-interpreted.scm")
|
|
;; Requires compile-to-file from ex-5_3_31-38.scm
|
|
|
|
; (compile-and-go expression)
|
|
;; To test this exercise uncomment the previous line, then:
|
|
;; $ mit-scheme
|
|
;; 1 ]=> (load "ex-5_45-xx")
|
|
;; 2 ]=> (define (g n) (* n n n))
|
|
;; 3 ]=> (f 3) ; calls interpreted 'g'
|
|
|
|
(display "[done]\n")
|
|
|
|
(display "\nex-5.48\n")
|
|
|
|
; (display "\nex-5.49\n")
|
|
; (display "\nex-5.50\n")
|
|
; (display "\nex-5.51\n")
|
|
; (display "\nex-5.52\n")
|
|
|