다음 명령열이 아직 필요로 하는 레지스터만 저장한다.

(begin
  (define (contains? item items)
    (cond ((null? items) #f)
          ((eq? item (car items)) #t)
          (else (contains? item (cdr items)))))
  (define (adjoin item items)
    (if (contains? item items) items (append items (list item))))
  (define (union left right)
    (if (null? right) left
        (union (adjoin (car right) left) (cdr right))))
  (define (difference left right)
    (cond ((null? left) '())
          ((contains? (car left) right)
           (difference (cdr left) right))
          (else
           (cons (car left) (difference (cdr left) right)))))
  (define (make-sequence needs modifies statements)
    (list needs modifies statements))
  (define (needs sequence) (car sequence))
  (define (modifies sequence) (cadr sequence))
  (define (statements sequence) (caddr sequence))
  (define (append-sequences first second)
    (make-sequence
      (union (needs first)
             (difference (needs second) (modifies first)))
      (union (modifies first) (modifies second))
      (append (statements first) (statements second))))
  (define (preserving register first second)
    (if (and (contains? register (needs second))
             (contains? register (modifies first)))
        (append-sequences
          (make-sequence
            (adjoin register (needs first))
            (difference (modifies first) (list register))
            (append (list (list 'save register))
                    (append (statements first)
                            (list (list 'restore register)))))
          second)
        (append-sequences first second)))
  (preserving
    'env
    (make-sequence '(env) '(env val)
                   '((assign env extended) (assign val operand)))
    (make-sequence '(env val) '(val)
                   '((perform apply)))))