sicp-ex-5.48



<< Previous exercise (5.47) | Index | Next exercise (5.49) >>


ypeels

; this code will get executed by primitive-apply in ch5-eceval-compiler.scm
; specifically, by (apply-primitive-procedure)
(define (compile-and-run expression)
    (let ((stack (eceval 'stack))
          (instructions
            (assemble
                (append
                    (statements (compile expression 'val 'next))
                    
                    ; print the result after executing statements
                    '((goto (reg printres))))
                eceval)))
            
        ; get rid of old value of continue
        ; this is optional, because (initialize-stack) will 
        ; clear the stack after print-result
        (stack 'pop) 
        
        ; the next 2 commands in primitive-apply are:
        ; (restore continue)
        ; (goto (reg continue))
        ; this forces eceval to jump to and execute instructions
        ((stack 'push) instructions)))
        
        
; --------------------------------------------------
        
(define (test-5.48)
    (load "ch5-compiler.scm")
    (load "load-eceval-compiler.scm")
    
    ; add and initialize new register printres to expose label print-result
    ; cf. compadd from 5.47
    (set! eceval (make-machine
        (cons 'printres eceval-compiler-register-list)
        eceval-operations   ; procedures accessible via (op) in asm code
        (cons 
            '(assign printres (label print-result)) 
            eceval-compiler-main-controller-text)))
    
    ; procedures accessible at the EC-Eval prompt
    (append! primitive-procedures 
        (list (list 'compile-and-run compile-and-run)))    
    
    (start-eceval)
)
(test-5.48)

; ;;; EC-Eval input:
; (compile-and-run '(define (f n) (if (= n 1) 1 (* (f (- n 1)) n))))
; ;;; EC-Eval value:
; ok
; ;;; EC-Eval input:
; (f 5)
; ;;; EC-Eval value:
; 120

Rptx

  
  
  
  
 (define (prim-compile-and-run expression) 
   (assemble (statements 
              (compile expression 'val 'return '())) 
             eceval)) 
  
 (define (compile-and-run? exp) 
   (tagged-list? exp 'compile-and-run)) 
  
 (define (compile-and-run-exp exp) 
   (cadadr exp)) 
  
 ; this is added to ev-dispatch 
        (test (op compile-and-run?) (reg exp)) 
        (branch (label ev-compile-and-run)) 
  
 ; here is ev-compile-and-run 
      ev-compile-and-run 
        (assign val (op compile-and-run-exp) (reg exp))  
        (assign val (op prim-compile-and-run) (reg val)) 
        (goto (label external-entry)) 
  
 ----------------------------------------------------------------- 
  
 ;;; EC-Eval input: 
 (compile-and-run 
  '(define (factorial n) 
     (if (= n 1) 
         1 
         (* (factorial (- n 1)) n)))) 
  
 (total-pushes = 0 max-depth = 0) 
 ;;; EC-Eval value: 
 ok 
  
 ;;; EC-Eval input: 
 (factorial 5) 
  
 (total-pushes = 11 max-depth = 8) 
 ;;; EC-Eval value: 
 120 
  
 ;; from the stack data we can see that it is in fact the compiled version 
 ;; of factorial.