sicp-ex-5.48

  
 ; 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 

  
  
  
  
 (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.  

To avoid having the compiler or evaluator direclty access the machine/eceval, I added a (dynamic) assemble instruction to the Register Machine's assembler.

  
Compiler
========

  (define (statements-with-return exp)
    (statements
      (compile exp empty-ctenv 'val 'return)))


Register Machine - Assembler
============================

To keep it simple the assemble instruction doesn't take any parameters, it
reads the statetments from the val register, and then writes the assembled
instructions back to val:

  (define (make-assemble-val inst machine labels operations pc)
    (lambda ()
      (let* ((statements (get-register-contents machine 'val))
             (instructions
              (assemble statements machine)))
        (set-register-contents! machine 'val instructions)
        (advance-pc pc))))

This is called from make-execution-procedure:

  (define (make-execution-procedure ...)
    (cond ((eq? (car inst) 'assign)
           (make-assign inst machine labels ops pc))
          ...
          ((eq? (car inst) 'assemble-val)                     ;*
           (make-assemble-val inst machine labels ops pc))    ;*
          (else (error \"Unknown instruction type -- ASSEMBLE\" inst))))


EC-Evaluator
============

The ec-evaluator compiles the expression to val, uses assemble-val to
replace the statements with the assembled instructions and then goes to
those instructions:

  compile-and-run
    (assign exp (op compile-and-run-exp) (reg exp))
    (assign val (op statements-with-return) (reg exp))
    (assemble-val)
    (goto (reg val))

This is called from eval-dispatch:

  eval-dispatch
    (test (op self-evaluating?) (reg exp))
    (branch (label ev-self-eval))
    ...
    (test (op compile-and-run?) (reg exp))                    ;*
    (branch (label compile-and-run))                          ;*
    (test (op application?) (reg exp))
    (branch (label ev-application))
    (goto (label unknown-expression-type))

These use the following additional primitive operations:

  (list 'compile-and-run?
       (lambda (exp) (tagged-list? exp 'compile-and-run)))
  (list 'statements-with-return statements-with-return)
  (list 'compile-and-run-exp cadr)

I wrote a detailed walkthrough on my blog: https://nguyenhuythanh.com/posts/sicp-5.48