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 "\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
|
||||
; evaluator so that interpreted code can call compiled procedures. Show how to
|
||||
; modify the compiler so that compiled procedures can call not only primitive
|
||||
; procedures and compiled procedures, but interpreted procedures as well. This
|
||||
; requires modifying compile-procedure-call to handle the case of compound
|
||||
; (interpreted) procedures. Be sure to handle all the same target and linkage
|
||||
; combinations as in compile-proc-appl. To do the actual procedure application,
|
||||
; the code needs to jump to the evaluator's compound-apply entry point. This
|
||||
; label cannot be directly referenced in object code (since the assembler
|
||||
; requires that all labels referenced by the code it is assembling be defined
|
||||
; there), so we will add a register called compapp to the evaluator machine to
|
||||
; hold this entry point, and add an instruction to initialize it:
|
||||
(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)))
|
||||
|
||||
; (assign compapp (label compound-apply))
|
||||
; (branch (label external-entry)) ; branches if flag is set
|
||||
;read-eval-print-loop
|
||||
; ...
|
||||
(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)))))
|
||||
|
||||
; To test your code, start by defining a procedure f that calls a procedure g.
|
||||
; Use compile-and-go to compile the definition of f and start the evaluator.
|
||||
; Now, typing at the evaluator, define g and try to call f.
|
||||
(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
|
||||
'(define (f n)
|
||||
(g n)))
|
||||
; (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")
|
||||
|
||||
|
|
|
@ -56,7 +56,7 @@
|
|||
(set-register-contents! eceval 'val instructions)
|
||||
(set-register-contents! eceval 'flag true)
|
||||
(start eceval)))
|
||||
|
||||
|
||||
;;**NB. To [not] monitor stack operations, comment in/[out] the line after
|
||||
;; print-result in the machine controller below
|
||||
;;**Also choose the desired make-stack version in regsim.scm
|
||||
|
|
Loading…
Reference in New Issue