Implement 5.47
parent
867e456de1
commit
90bd09efc1
112
ex-5_45-xx.scm
112
ex-5_45-xx.scm
|
@ -60,36 +60,102 @@
|
||||||
|
|
||||||
(display "[done]\n")
|
(display "[done]\n")
|
||||||
|
|
||||||
(display "\nex-5.47\n")
|
(display "\nex-5.47 - call-interpreted-from-compiled\n")
|
||||||
|
|
||||||
; Exercise 5.47. This section described how to modify the explicit-control
|
(define (compile-procedure-call target linkage)
|
||||||
; evaluator so that interpreted code can call compiled procedures. Show how to
|
(let* ((primitive-branch (make-label 'primitive-branch))
|
||||||
; modify the compiler so that compiled procedures can call not only primitive
|
(compiled-branch (make-label 'compiled-branch))
|
||||||
; procedures and compiled procedures, but interpreted procedures as well. This
|
(interpreted-branch (make-label 'interpreted-branch))
|
||||||
; requires modifying compile-procedure-call to handle the case of compound
|
(after-call (make-label 'after-call))
|
||||||
; (interpreted) procedures. Be sure to handle all the same target and linkage
|
(compiled-linkage (if (eq? linkage 'next) after-call linkage))
|
||||||
; combinations as in compile-proc-appl. To do the actual procedure application,
|
(compiled-test-primitive
|
||||||
; the code needs to jump to the evaluator's compound-apply entry point. This
|
(make-instruction-sequence
|
||||||
; label cannot be directly referenced in object code (since the assembler
|
'(proc) '()
|
||||||
; requires that all labels referenced by the code it is assembling be defined
|
`((test (op primitive-procedure?) (reg proc))
|
||||||
; there), so we will add a register called compapp to the evaluator machine to
|
(branch (label ,primitive-branch)))))
|
||||||
; hold this entry point, and add an instruction to initialize it:
|
(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)))
|
||||||
|
|
||||||
; (assign compapp (label compound-apply))
|
(define (compile-intp-appl target linkage)
|
||||||
; (branch (label external-entry)) ; branches if flag is set
|
(cond ((and (eq? target 'val) (not (eq? linkage 'return)))
|
||||||
;read-eval-print-loop
|
(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)))))
|
||||||
|
|
||||||
; To test your code, start by defining a procedure f that calls a procedure g.
|
(define expression
|
||||||
; Use compile-and-go to compile the definition of f and start the evaluator.
|
'(begin
|
||||||
; Now, typing at the evaluator, define g and try to call f.
|
(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
|
; (compile-and-go expression)
|
||||||
'(define (f n)
|
;; To test this exercise uncomment the previous line, then:
|
||||||
(g n)))
|
;; $ 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.48\n")
|
||||||
|
|
||||||
; (display "\nex-5.49\n")
|
; (display "\nex-5.49\n")
|
||||||
|
; (display "\nex-5.50\n")
|
||||||
|
; (display "\nex-5.51\n")
|
||||||
|
; (display "\nex-5.52\n")
|
||||||
|
|
||||||
|
|
|
@ -56,7 +56,7 @@
|
||||||
(set-register-contents! eceval 'val instructions)
|
(set-register-contents! eceval 'val instructions)
|
||||||
(set-register-contents! eceval 'flag true)
|
(set-register-contents! eceval 'flag true)
|
||||||
(start eceval)))
|
(start eceval)))
|
||||||
|
|
||||||
;;**NB. To [not] monitor stack operations, comment in/[out] the line after
|
;;**NB. To [not] monitor stack operations, comment in/[out] the line after
|
||||||
;; print-result in the machine controller below
|
;; print-result in the machine controller below
|
||||||
;;**Also choose the desired make-stack version in regsim.scm
|
;;**Also choose the desired make-stack version in regsim.scm
|
||||||
|
|
Loading…
Reference in New Issue