Chapter 5: Computing with Register Machines

My aim is to show that the heavenly machines is not a kind of divine, living being, but a kind of clockwork (and he who believes that a clock has soul attributes the maker’s glory to the work), insofar as nearly all the manifold motions are caused by a most simple and material force, just as all motions of the clock are caused by a single weight.
–Johannes Kepler (letter to Herwart von Honhenburg, 1605)

We began this book by studying processes and by describing processes in therms of procedures written in Lisp. To explain the meanings of these procedures, we used a succession of models of evaluation: the substitution model of Chapter 1, the environment model of Chapter 3, and the metacircular evaluator, in particular, dispelled much of the mystery of how Lisp-like languages are interpreted. But that evaluator fails to elucidate the mechanisms of control in a Lisp system because it inherits the control structure of the underlying Lisp system.
In this chapter we will describe process in terms of the step-by-step operation of a traditional computer. A typical register machine instruction applies a primitive operation to the contents of some registers and assigns that result to another register. We will approach our task from the perspective of a hardware architect rather than that of a machine-language computer programmer. We will providing an explicit model for the mechanisms of control in evaluator.

Contents

5.1 Designing Register Machines
5.2 A Register-Machine Simulator
5.3 Storage Allocation and Garbage Collection
5.4 The Explicit-Control Evaluator
5.5 Compilation

5.1 Designing Register Machines

To design a register machine, we must design its data paths (registers and operations) and the controller that sequences these operations.

Example:

(define (gcd a b)
  (if (= b 0)
    a
    (gcd b (remainder a b))))

(define (gcd a b)

(if (= b 0)

(gcd b (remainder a b))))

Each way to assign a value to a register is indicated by an arrow with an X behind the head, pointing from the source of data to the register. We can think of the X as a button that, when pushed, allows the value at the source to “flow” into the designated register.

In order for data paths to actually compute GCDs, the buttons must be pushed in the correct sequences. We will describe this sequence in terms of controller diagram.

5.1.1 A Language for Describing Register Machines

We will crated a language that presents, in textual form, all the information given by the data-path and controller diagrams.

(data-paths
 (registers
  ((name a)
   (buttons ((name a<-b) 
             (source (register b)))))
  ((name b)
   (buttons ((name b<-t)
             (source (register t)))))
  ((name t)
   (buttons ((name t<-r)
             (source (operation rem))))))
 (operations
  ((name rem)
   (inputs (register a) (register b)))
  ((name =)
   (inputs (register b) (constant 0)))))

(controller
 test-b                ; label
   (test =)            ; test
   (branch 
    (label gcd-done))  ; conditional branch
   (t<-r)              ; button push
   (a<-b)              ; button push
   (b<-t)              ; button push
   (goto 
    (label test-b))    ; unconditional branch
 gcd-done)             ; label

(data-paths

(registers

((name a)

(buttons ((name a<-b)

(source (register b)))))

((name b)

(buttons ((name b<-t)

(source (register t)))))

((name t)

(buttons ((name t<-r)

(source (operation rem))))))

(operations

((name rem)

(inputs (register a) (register b)))

((name =)

(inputs (register b) (constant 0)))))

(controller

test-b ; label

(test =) ; test

(branch

(label gcd-done)) ; conditional branch

(t<-r) ; button push

(a<-b) ; button push

(b<-t) ; button push

(goto

(label test-b)) ; unconditional branch

gcd-done) ; label

The above language is difficult to read because we must constantly refer back to the definitions of the button names and the operation names.
We will replace the arbitrary button and operation names by the definitions of their behavior, which means that we will omit the data-path description.

(controller
 test-b
   (test (op =) (reg b) (const 0))
   (branch (label gcd-done))
   (assign t (op rem) (reg a) (reg b))
   (assign a (reg b))
   (assign b (reg t))
   (goto (label test-b))
 gcd-done)

(controller

test-b

(test (op =) (reg b) (const 0))

(branch (label gcd-done))

(assign t (op rem) (reg a) (reg b))

(assign a (reg b))

(assign b (reg t))

(goto (label test-b))

gcd-done)

It is more verbose for large machines and obscures the actual data-path structure of the machine, however, we will use this register-machine language throughout this chapter, because we will be more concerned with understanding controllers that with understanding the elements and connections in data paths.

5.1.2 Abstraction in Machine Design

We will often define a machine to include “primitive” operations that are actually very complex.

5.1.3 Subroutines

gcd
 (test (op =) (reg b) (const 0))
 (branch (label gcd-done))
 (assign t (op rem) (reg a) (reg b))
 (assign a (reg b))
 (assign b (reg t))
 (goto (label gcd))
gcd-done
 (test (op =) (reg continue) (const 0))
 (branch (label after-gcd-1))
 (goto (label after-gcd-2))
  …
;; Before branching to gcd from
;; the first place where it is needed,
;; we place 0 in the continue register
 (assign continue (const 0))
 (goto (label gcd))
after-gcd-1
  …
;; Before the second use of gcd, 
;; we place 1 in the continue register
 (assign continue (const 1))
 (goto (label gcd))
after-gcd-2

gcd

(test (op =) (reg b) (const 0))

(branch (label gcd-done))

(assign t (op rem) (reg a) (reg b))

(assign a (reg b))

(assign b (reg t))

(goto (label gcd))

gcd-done

(test (op =) (reg continue) (const 0))

(branch (label after-gcd-1))

(goto (label after-gcd-2))

…

;; Before branching to gcd from

;; the first place where it is needed,

;; we place 0 in the continue register

(assign continue (const 0))

(goto (label gcd))

after-gcd-1

…

;; Before the second use of gcd,

;; we place 1 in the continue register

(assign continue (const 1))

(goto (label gcd))

after-gcd-2

We used the continue register to hold the label of the entry point in the controller sequence at which execution should continue when the subroutines is finished. (We can assign to a register a label in the controller sequence in such a way that this value can be fetched from the register and used to continue execution at the designated entry pointl)
However, if we call the subroutine again, the continue register will be overwritten.

5.1.4 Using a Stack to Implement Recursion

We will use a stack to handle the problem of nested subroutines calls in a way that save the contents of any registers that will be needed after the subproblem is solved so that these can be restored to continue the suspended computation.

Example:

(controller
  (assign continue (label fact-done))
fact-loop
  (test (op =) (reg n) (const 1))
  (branch (label base-case))
  (save continue)
(save n)
  (assign n (op -) (reg n) (const 1))
  (assign continue (label after-fact))
  (goto (label fact-loop))
after-fact
  (restore n)
  (restore continue)
  (assign val (op *) (reg n) (reg val)) ;val now contains n(n - 1)!
  (goto (reg continue))
base-case
  (assign val (const 1))
  (goto (reg continue))
fact-done)

(controller

(assign continue (label fact-done))

fact-loop

(test (op =) (reg n) (const 1))

(branch (label base-case))

(save continue)

(save n)

(assign n (op -) (reg n) (const 1))

(assign continue (label after-fact))

(goto (label fact-loop))

after-fact

(restore n)

(restore continue)

(assign val (op *) (reg n) (reg val)) ;val now contains n(n - 1)!

(goto (reg continue))

base-case

(assign val (const 1))

(goto (reg continue))

fact-done)

5.1.5 Instruction Summary

5.2 A Register-Machine Simulator

In this section we construct a simulator for machines described in register-machine language.
The simulator is a Scheme program with four interface procedures. the first uses a description of a register with four interface procedures to construct a model of the machine (a data structure whose parts correspond to the parts of the machine to be simulated), and the other three allow us to simulate the machine by manipulating the model:

(make-machine <register-names> <operations> <controller>) constructs and returns a model of machine with the give registers, operations, and controller.
(set-register-contents! <machine-model> <register-name> <value>) stores a value in a simulated register in the given machine.
(get-register-contents <machine-model> <register-name>) returns the contents of a simulated register in the given machine.
(start <machine-model>) simulates the execution of the given machine, starting from the beginning of the controller sequence and stopping when it reaches the end of the sequence.

5.2.1 The Machine Model

To build the model, make-machine begins with calling the procedure make-new-machine to constructs a container for some registers and a stack, together with an execution mechanism that process the controller instructions one by one.
make-machine then extends this basic model to include the registers, operations, and controller of the particular machine being defined.
First it allocates a register in the new machine for each of the supplied register names and installs the designated operations in the machine.
Then it uses an assembler to transform the controller list into instructions for the new machine and installs these as the machine’s instruction.
make-machine returns as its value the modified machine model.

(define (make-machine register-names 
                      ops 
                      controller-text)
  (let ((machine (make-new-machine)))
    (for-each (lambda (register-name)
                ((machine 'allocate-register) 
                 register-name))
              register-names)
    ((machine 'install-operations) ops)
    ((machine 'install-instruction-sequence)
     (assemble controller-text machine))
    machine))

(define (make-machine register-names

ops

controller-text)

(let ((machine (make-new-machine)))

(for-each (lambda (register-name)

((machine 'allocate-register)

((machine 'install-operations) ops)

((machine 'install-instruction-sequence)

(assemble controller-text machine))

machine))

Registers
We will represent a register as a procedure with local state.

(define (make-register name)
  (let ((contents '*unassigned*))
    (define (dispatch message)
      (cond ((eq? message 'get) contents)
            ((eq? message 'set)
             (lambda (value) 
               (set! contents value)))
            (else
             (error "Unknown request: 
                     REGISTER"
                    message))))
    dispatch))

(define (get-contents register)
  (register 'get))
(define (set-contents! register value)
  ((register 'set) value))

(define (make-register name)

(let ((contents '*unassigned*))

(define (dispatch message)

(cond ((eq? message 'get) contents)

((eq? message 'set)

(lambda (value)

(set! contents value)))

(else

(error "Unknown request:

message))))

dispatch))

(define (get-contents register)

(register 'get))

(define (set-contents! register value)

((register 'set) value))

The Stack
We can also represent a stack as a procedure with local state.

(define (make-stack)
  (let ((s '()))
    (define (push x)
      (set! s (cons x s)))
    (define (pop)
      (if (null? s)
          (error "Empty stack: POP")
          (let ((top (car s)))
            (set! s (cdr s))
            top)))
    (define (initialize)
      (set! s '())
      'done)
    (define (dispatch message)
      (cond ((eq? message 'push) push)
            ((eq? message 'pop) (pop))
            ((eq? message 'initialize) 
             (initialize))
            (else 
             (error "Unknown request: STACK"
                    message))))
    dispatch))

(define (pop stack) (stack 'pop))
(define (push stack value)
  ((stack 'push) value))

(define (make-stack)

(let ((s '()))

(define (push x)

(set! s (cons x s)))

(define (pop)

(if (null? s)

(error "Empty stack: POP")

(let ((top (car s)))

(set! s (cdr s))

top)))

(define (initialize)

(set! s '())

'done)

(define (dispatch message)

(cond ((eq? message 'push) push)

((eq? message 'pop) (pop))

((eq? message 'initialize)

(initialize))

(else

(error "Unknown request: STACK"

message))))

dispatch))

(define (pop stack) (stack 'pop))

(define (push stack value)

((stack 'push) value))

The basic machine
The make-new-machine procedure constructs an object whose local state consists of a stack, an initially empty instruction sequence, a list of operations that initially contains an operation to initialize the stack, and a register table that initially contains two registers, named flag and pc.
The flag register is used to control branching in the simulated machine.
The pc register determines the sequencing of instructions as the machine runs. Each machine instruction is a data structure that includes a procedure of no arguments, called the instruction execution procedure, such that calling this procedure simulates executing the instruction.

(define (make-new-machine)
  (let ((pc (make-register 'pc))
        (flag (make-register 'flag))
        (stack (make-stack))
        (the-instruction-sequence '()))
    (let ((the-ops
           (list 
            (list 'initialize-stack
                  (lambda () 
                    (stack 'initialize)))))
          (register-table
           (list (list 'pc pc) 
                 (list 'flag flag))))
      (define (allocate-register name)
        (if (assoc name register-table)
            (error 
             "Multiply defined register: " 
             name)
            (set! register-table
                  (cons 
                   (list name 
                         (make-register name))
                   register-table)))
        'register-allocated)
      (define (lookup-register name)
        (let ((val 
               (assoc name register-table)))
          (if val
              (cadr val)
              (error "Unknown register:" 
                     name))))
      (define (execute)
        (let ((insts (get-contents pc)))
          (if (null? insts)
              'done
              (begin
                ((instruction-execution-proc 
                  (car insts)))
                (execute)))))
      (define (dispatch message)
        (cond ((eq? message 'start)
               (set-contents! 
                pc
                the-instruction-sequence)
               (execute))
              ((eq? 
                message 
                'install-instruction-sequence)
               (lambda (seq) 
                 (set! 
                  the-instruction-sequence 
                  seq)))
              ((eq? message 
                    'allocate-register) 
               allocate-register)
              ((eq? message 'get-register) 
               lookup-register)
              ((eq? message 
                    'install-operations)
               (lambda (ops) 
                 (set! the-ops 
                       (append the-ops ops))))
              ((eq? message 'stack) stack)
              ((eq? message 'operations) 
               the-ops)
              (else (error "Unknown request: 
                            MACHINE"
                           message))))
      dispatch)))



(define (start machine)
  (machine 'start))
(define (get-register-contents 
         machine register-name)
  (get-contents 
   (get-register machine register-name)))
(define (set-register-contents! 
         machine register-name value)
  (set-contents! 
   (get-register machine register-name) 
   value)
  'done)
(define (get-register machine reg-name)
  ((machine 'get-register) reg-name))

(define (make-new-machine)

(let ((pc (make-register 'pc))

(flag (make-register 'flag))

(stack (make-stack))

(the-instruction-sequence '()))

(let ((the-ops

(list

(list 'initialize-stack

(lambda ()

(stack 'initialize)))))

(register-table

(list (list 'pc pc)

(list 'flag flag))))

(define (allocate-register name)

(if (assoc name register-table)

(error

"Multiply defined register: "

name)

(set! register-table

(cons

(list name

(make-register name))

'register-allocated)

(define (lookup-register name)

(let ((val

(assoc name register-table)))

(if val

(cadr val)

(error "Unknown register:"

name))))

(define (execute)

(let ((insts (get-contents pc)))

(if (null? insts)

'done

(begin

((instruction-execution-proc

(car insts)))

(execute)))))

(define (dispatch message)

(cond ((eq? message 'start)

(set-contents!

the-instruction-sequence)

(execute))

((eq?

message

'install-instruction-sequence)

(lambda (seq)

(set!

the-instruction-sequence

seq)))

((eq? message

'allocate-register)

allocate-register)

((eq? message 'get-register)

lookup-register)

((eq? message

'install-operations)

(lambda (ops)

(set! the-ops

(append the-ops ops))))

((eq? message 'stack) stack)

((eq? message 'operations)

the-ops)

(else (error "Unknown request:

MACHINE"

message))))

dispatch)))

(define (start machine)

(machine 'start))

(define (get-register-contents

machine register-name)

(get-contents

(get-register machine register-name)))

(define (set-register-contents!

machine register-name value)

(set-contents!

(get-register machine register-name)

value)

'done)

(define (get-register machine reg-name)

((machine 'get-register) reg-name))

5.2.2 The Assembler

Overall, the assembler is much like the evaluators which perform an appropriate action for each type of expression in the input language (in this case, the register-machine language).
The technique of producing an execution procedure for each instruction is just what we use in Section 4.1.7 to speed up the evaluator by separating analysis from runtime execution.
To begins, the assembler must know what all the labels refer to, so it begins by scanning the controller text to separate the labels from the instructions.
extract=labels takes as arguments a list text and a receive procedure.
receive will be called with two values:
(1) a list insts of instruction data structures
(2) a table labels, which associates each label from text with the position in the list insts that the label designates.

(define (assemble controller-text machine)
  (extract-labels controller-text
    (lambda (insts labels)
      (update-insts! insts labels machine)
      insts)))

(define (extract-labels text receive)
  (if (null? text)
      (receive '() '())
      (extract-labels 
       (cdr text)
       (lambda (insts labels)
         (let ((next-inst (car text)))
           (if (symbol? next-inst)
               (receive 
                   insts
                   (cons 
                    (make-label-entry 
                     next-inst
                     insts)
                    labels))
               (receive 
                   (cons (make-instruction 
                          next-inst)
                         insts)
                   labels)))))))

(define (assemble controller-text machine)

(extract-labels controller-text

(lambda (insts labels)

(update-insts! insts labels machine)

insts)))

(define (extract-labels text receive)

(if (null? text)

(receive '() '())

(extract-labels

(cdr text)

(lambda (insts labels)

(let ((next-inst (car text)))

(if (symbol? next-inst)

(receive

insts

(cons

(make-label-entry

next-inst

insts)

labels))

(receive

(cons (make-instruction

next-inst)

insts)

labels)))))))

update-insts! modifies the instruction list, which initially contains only the text of the instructions, to include the corresponding execution procedures.

(define (update-insts! insts labels machine)
  (let ((pc (get-register machine 'pc))
        (flag (get-register machine 'flag))
        (stack (machine 'stack))
        (ops (machine 'operations)))
    (for-each
     (lambda (inst)
       (set-instruction-execution-proc!
        inst
        (make-execution-procedure
         (instruction-text inst) 
         labels
         machine
         pc
         flag
         stack
         ops)))
     insts)))

(define (make-instruction text)
  (cons text '()))
(define (instruction-text inst) (car inst))
(define (instruction-execution-proc inst)
  (cdr inst))
(define (set-instruction-execution-proc!
         inst
         proc)
  (set-cdr! inst proc))

(define (update-insts! insts labels machine)

(let ((pc (get-register machine 'pc))

(flag (get-register machine 'flag))

(stack (machine 'stack))

(ops (machine 'operations)))

(for-each

(lambda (inst)

(set-instruction-execution-proc!

inst

(make-execution-procedure

(instruction-text inst)

labels

machine

flag

stack

ops)))

insts)))

(define (make-instruction text)

(cons text '()))

(define (instruction-text inst) (car inst))

(define (instruction-execution-proc inst)

(cdr inst))

(define (set-instruction-execution-proc!

inst

proc)

(set-cdr! inst proc))

Elements of the label table are pairs:

(define (make-label-entry label-name insts)
  (cons label-name insts))

(define (lookup-label labels label-name)
  (let ((val (assoc label-name labels)))
    (if val
        (cdr val)
        (error "Undefined label: ASSEMBLE" 
               label-name))))

(define (make-label-entry label-name insts)

(cons label-name insts))

(define (lookup-label labels label-name)

(let ((val (assoc label-name labels)))

(if val

(cdr val)

(error "Undefined label: ASSEMBLE"

label-name))))

5.2.3 Generating Execution Procedures for Instructions

Like the analyze procedure in the evaluator of Section 4.1.7, this dispatches on the type of instruction to generate the appropriate execution procedure.

(define (make-execution-procedure 
         inst labels machine pc flag stack ops)
  (cond ((eq? (car inst) 'assign)
         (make-assign 
          inst machine labels ops pc))
        ((eq? (car inst) 'test)
         (make-test 
          inst machine labels ops flag pc))
        ((eq? (car inst) 'branch)
         (make-branch 
          inst machine labels flag pc))
        ((eq? (car inst) 'goto)
         (make-goto inst machine labels pc))
        ((eq? (car inst) 'save)
         (make-save inst machine stack pc))
        ((eq? (car inst) 'restore)
         (make-restore inst machine stack pc))
        ((eq? (car inst) 'perform)
         (make-perform
          inst machine labels ops pc))
        (else (error "Unknown instruction 
                      type: ASSEMBLE"
                     inst))))

(define (make-execution-procedure

inst labels machine pc flag stack ops)

(cond ((eq? (car inst) 'assign)

(make-assign

inst machine labels ops pc))

((eq? (car inst) 'test)

(make-test

inst machine labels ops flag pc))

((eq? (car inst) 'branch)

(make-branch

inst machine labels flag pc))

((eq? (car inst) 'goto)

(make-goto inst machine labels pc))

((eq? (car inst) 'save)

(make-save inst machine stack pc))

((eq? (car inst) 'restore)

(make-restore inst machine stack pc))

((eq? (car inst) 'perform)

(make-perform

inst machine labels ops pc))

(else (error "Unknown instruction

type: ASSEMBLE"

inst))))

assign instructions

The make-assign procedure handles assign instructions:

(define (make-assign 
         inst machine labels operations pc)
  (let ((target 
         (get-register 
          machine 
          (assign-reg-name inst)))
        (value-exp (assign-value-exp inst)))
    (let ((value-proc
           (if (operation-exp? value-exp)
               (make-operation-exp
                value-exp 
                machine
                labels
                operations)
               (make-primitive-exp
                (car value-exp)
                machine
                labels))))
      (lambda ()   ; execution procedure
                   ; for assign
        (set-contents! target (value-proc))
        (advance-pc pc)))))

(define (make-assign

inst machine labels operations pc)

(let ((target

(get-register

machine

(assign-reg-name inst)))

(value-exp (assign-value-exp inst)))

(let ((value-proc

(if (operation-exp? value-exp)

(make-operation-exp

value-exp

machine

labels

operations)

(make-primitive-exp

(car value-exp)

machine

labels))))

(lambda () ; execution procedure

; for assign

(set-contents! target (value-proc))

(advance-pc pc)))))

The register name is looked up with get-register to produce the target register object.
The work of looking up and parsing is performed just once, at assembly time, not every time the instruction is simulated. This saving of work is the reason we use execution procedure, and corresponds directly the saving in work we obtained by separating program analysis from execution in the evaluator of Section 4.1.7.

advance-pc will advance the pc to the next instruction:

(define (advance-pc pc)
  (set-contents! pc (cdr (get-contents pc))))

1 2	(define (advance-pc pc) (set-contents! pc (cdr (get-contents pc))))

test, branch, and goto instructions

make-test handles test instructions in a similar way:

(define 
  (make-test 
   inst machine labels operations flag pc)
  (let ((condition (test-condition inst)))
    (if (operation-exp? condition)
        (let ((condition-proc
               (make-operation-exp
                condition 
                machine
                labels
                operations)))
          (lambda () 
            (set-contents! 
             flag (condition-proc))
            (advance-pc pc)))
        (error "Bad TEST instruction: 
                ASSEMBLE" inst))))

(define (test-condition test-instruction)
  (cdr test-instruction))

(define

(make-test

inst machine labels operations flag pc)

(let ((condition (test-condition inst)))

(if (operation-exp? condition)

(let ((condition-proc

(make-operation-exp

condition

machine

labels

operations)))

(lambda ()

(set-contents!

flag (condition-proc))

(advance-pc pc)))

(error "Bad TEST instruction:

ASSEMBLE" inst))))

(define (test-condition test-instruction)

(cdr test-instruction))

make-branch checks the contents of the flag register and either sets the contents of the pc to the branch destination (if the branch is taken) or else just advances the pc (if the branch is not taken).
The destination in a branch instruction must be a label which is looked up at assembly time.

(define 
  (make-branch 
   inst machine labels flag pc)
  (let ((dest (branch-dest inst)))
    (if (label-exp? dest)
        (let ((insts
               (lookup-label 
                labels 
                (label-exp-label dest))))
          (lambda ()
            (if (get-contents flag)
                (set-contents! pc insts)
                (advance-pc pc))))
        (error "Bad BRANCH instruction: 
                ASSEMBLE"
               inst))))

(define (branch-dest branch-instruction)
  (cadr branch-instruction))

(define

(make-branch

inst machine labels flag pc)

(let ((dest (branch-dest inst)))

(if (label-exp? dest)

(let ((insts

(lookup-label

labels

(label-exp-label dest))))

(lambda ()

(if (get-contents flag)

(set-contents! pc insts)

(advance-pc pc))))

(error "Bad BRANCH instruction:

ASSEMBLE"

inst))))

(define (branch-dest branch-instruction)

(cadr branch-instruction))

A goto instruction is similar to a branch, except that the destination may be specified either as a label or as a register, and the pc will is always set to the new destination.

(define (make-goto inst machine labels pc)
  (let ((dest (goto-dest inst)))
    (cond ((label-exp? dest)
           (let ((insts
                  (lookup-label 
                   labels
                   (label-exp-label dest))))
             (lambda () 
               (set-contents! pc insts))))
          ((register-exp? dest)
           (let ((reg
                  (get-register 
                   machine
                   (register-exp-reg dest))))
             (lambda ()
               (set-contents! 
                pc
                (get-contents reg)))))
          (else (error "Bad GOTO instruction: 
                        ASSEMBLE"
                       inst)))))

(define (goto-dest goto-instruction)
  (cadr goto-instruction))

(define (make-goto inst machine labels pc)

(let ((dest (goto-dest inst)))

(cond ((label-exp? dest)

(let ((insts

(lookup-label

labels

(label-exp-label dest))))

(lambda ()

(set-contents! pc insts))))

((register-exp? dest)

(let ((reg

(get-register

machine

(register-exp-reg dest))))

(lambda ()

(set-contents!

(get-contents reg)))))

(else (error "Bad GOTO instruction:

ASSEMBLE"

inst)))))

(define (goto-dest goto-instruction)

(cadr goto-instruction))

Other instructions
The stack instructions save and restore simply use the stack with the designated register and advance the pc:

(define (make-save inst machine stack pc)
  (let ((reg (get-register 
              machine
              (stack-inst-reg-name inst))))
    (lambda ()
      (push stack (get-contents reg))
      (advance-pc pc))))

(define (make-restore inst machine stack pc)
  (let ((reg (get-register
              machine
              (stack-inst-reg-name inst))))
    (lambda ()
      (set-contents! reg (pop stack))
      (advance-pc pc))))

(define (stack-inst-reg-name 
         stack-instruction)
  (cadr stack-instruction))

(define (make-save inst machine stack pc)

(let ((reg (get-register

machine

(stack-inst-reg-name inst))))

(lambda ()

(push stack (get-contents reg))

(advance-pc pc))))

(define (make-restore inst machine stack pc)

(let ((reg (get-register

machine

(stack-inst-reg-name inst))))

(lambda ()

(set-contents! reg (pop stack))

(advance-pc pc))))

(define (stack-inst-reg-name

stack-instruction)

(cadr stack-instruction))

make-perform generates an execution procedure for the action to be performed.

(define (make-perform 
         inst machine labels operations pc)
  (let ((action (perform-action inst)))
    (if (operation-exp? action)
        (let ((action-proc
               (make-operation-exp
                action
                machine
                labels
                operations)))
          (lambda ()
            (action-proc)
            (advance-pc pc)))
        (error "Bad PERFORM instruction: 
                ASSEMBLE"
               inst))))

(define (perform-action inst) (cdr inst))

(define (make-perform

inst machine labels operations pc)

(let ((action (perform-action inst)))

(if (operation-exp? action)

(let ((action-proc

(make-operation-exp

action

machine

labels

operations)))

(lambda ()

(action-proc)

(advance-pc pc)))

(error "Bad PERFORM instruction:

ASSEMBLE"

inst))))

(define (perform-action inst) (cdr inst))

Execution procedures for subexpression
The value of a reg, label, or const expression will produced by make-primitive-exp:

(define (make-primitive-exp exp machine labels)
  (cond ((constant-exp? exp)
         (let ((c (constant-exp-value exp)))
           (lambda () c)))
        ((label-exp? exp)
         (let ((insts
                (lookup-label 
                 labels
                 (label-exp-label exp))))
           (lambda () insts)))
        ((register-exp? exp)
         (let ((r (get-register
                   machine
                   (register-exp-reg exp))))
           (lambda () (get-contents r))))
        (else (error "Unknown expression type: 
                      ASSEMBLE"
                     exp))))

(define (register-exp? exp)
  (tagged-list? exp 'reg))
(define (register-exp-reg exp)
  (cadr exp))
(define (constant-exp? exp)
  (tagged-list? exp 'const))
(define (constant-exp-value exp)
  (cadr exp))
(define (label-exp? exp)
  (tagged-list? exp 'label))
(define (label-exp-label exp) 
  (cadr exp))

(define (make-primitive-exp exp machine labels)

(cond ((constant-exp? exp)

(let ((c (constant-exp-value exp)))

(lambda () c)))

((label-exp? exp)

(let ((insts

(lookup-label

labels

(label-exp-label exp))))

(lambda () insts)))

((register-exp? exp)

(let ((r (get-register

machine

(register-exp-reg exp))))

(lambda () (get-contents r))))

(else (error "Unknown expression type:

ASSEMBLE"

exp))))

(define (register-exp? exp)

(tagged-list? exp 'reg))

(define (register-exp-reg exp)

(cadr exp))

(define (constant-exp? exp)

(tagged-list? exp 'const))

(define (constant-exp-value exp)

(cadr exp))

(define (label-exp? exp)

(tagged-list? exp 'label))

(define (label-exp-label exp)

(cadr exp))

assign, perform, and test instructions may include the application of a machine operation (specified by an op expression) to some operands.

(define (make-operation-exp
         exp machine labels operations)
  (let ((op (lookup-prim 
             (operation-exp-op exp)
             operations))
        (aprocs
         (map (lambda (e)
                (make-primitive-exp 
                 e machine labels))
              (operation-exp-operands exp))))
    (lambda () (apply op (map (lambda (p) (p))
                              aprocs)))))

(define (operation-exp? exp)
  (and (pair? exp)
       (tagged-list? (car exp) 'op)))
(define (operation-exp-op operation-exp)
  (cadr (car operation-exp)))
(define (operation-exp-operands operation-exp)
  (cdr operation-exp))

(define (make-operation-exp

exp machine labels operations)

(let ((op (lookup-prim

(operation-exp-op exp)

operations))

(aprocs

(map (lambda (e)

(make-primitive-exp

e machine labels))

(operation-exp-operands exp))))

(lambda () (apply op (map (lambda (p) (p))

aprocs)))))

(define (operation-exp? exp)

(and (pair? exp)

(tagged-list? (car exp) 'op)))

(define (operation-exp-op operation-exp)

(cadr (car operation-exp)))

(define (operation-exp-operands operation-exp)

(cdr operation-exp))

The simulation procedure is found by looking up the operation name in the operation table for the machine:

(define (lookup-prim symbol operations)
  (let ((val (assoc symbol operations)))
    (if val
        (cadr val)
        (error "Unknown operation: ASSEMBLE"
               symbol))))

(define (lookup-prim symbol operations)

(let ((val (assoc symbol operations)))

(if val

(cadr val)

(error "Unknown operation: ASSEMBLE"

symbol))))

5.2.4 Monitoring Machine Performance

Exercise 5.19
Add a breakpoint feature in the simulator to help debugging.

5.3 Storage Allocation and Garbage Collection

5.4 The Explicit-Control Evaluator

S	M	T	W	T	F	S
« Jun
		1	2	3	4	5
6	7	8	9	10	11	12
13	14	15	16	17	18	19
20	21	22	23	24	25	26
27	28	29	30	31

诟屍

Chapter 5: Computing with Register Machines

5.1 Designing Register Machines

5.1.1 A Language for Describing Register Machines

5.1.2 Abstraction in Machine Design

5.1.3 Subroutines

5.1.4 Using a Stack to Implement Recursion

5.1.5 Instruction Summary

5.2 A Register-Machine Simulator

5.2.1 The Machine Model

5.2.2 The Assembler

5.2.3 Generating Execution Procedures for Instructions

5.2.4 Monitoring Machine Performance

5.3 Storage Allocation and Garbage Collection

5.4 The Explicit-Control Evaluator

5.5 Compilation

Leave a Reply Cancel reply