anchor.diff:    ((%initial :initarg :initial :accessor initial)
      (%final :initarg :final :accessor final)))
   
  -(defun compute-basic-blocks-for-code-object (code-object program)
  +(defun compute-basic-blocks-for-procedure (procedure program)
     (ensure-instruction-ownership program)
  -  (ensure-predecessors program)
     (with-accessors ((instructions instructions)
   		   (basic-blocks basic-blocks))
  -      code-object
  +      procedure
       (let ((remaining instructions))
         (flet ((one-block (instruction)
   	       (let ((initial instruction)
   		     (final instruction))
  -		 (loop for preds = (instruction-predecessors initial program)
  +		 (loop for preds = (predecessors initial)
   		       while (= (length preds) 1)
   		       for pred = (car preds)
  -		       while (eq (instruction-owner pred program) code-object)
  -		       for succs = (p2:successors pred)
  +		       while (eq (procedure pred) procedure)
  +		       for succs = (successors pred)
   		       while (= (length succs) 1)
   		       do (setf initial pred)
   			  (setf remaining (remove pred remaining :test #'eq)))
  -		 (loop for succs = (p2:successors final)
  +		 (loop for succs = (successors final)
   		       while (= (length succs) 1)
   		       for succ = (car succs)
  -		       while (eq (instruction-owner succ program) code-object)
  -		       for preds = (instruction-predecessors succ program)
  +		       while (eq (procedure succ) procedure)
  +		       for preds = (predecessors succ)
   		       while (= (length preds) 1)
   		       do (setf final succ)
   			  (setf remaining (remove succ remaining :test #'eq)))
  
positive.code: ;;; degenerate case, the basic block to which an instruction belongs
  ;;; contains only that single instruction.
  
  (defclass code-object ()
    ((%initial-instruction
      :initarg :initial-instruction :accessor initial-instruction)
     ;; Instructions that belong to this code object. 
     (%instructions :initform '() :accessor instructions)
     ;; Locations that  belong to this code object. 
     (%locations :initform '() :accessor locations)
     (%nesting-depth :initarg :nesting-depth :accessor nesting-depth)
     (%lexical-depth :initform nil :accessor lexical-depth)
     ;; The basic blocks that belong to this code object.
     (%basic-blocks :initform '() :accessor basic-blocks)))
  
  (defun make-code-object (initial-instruction nesting-depth)
    (make-instance 'code-object
      :initial-instruction initial-instruction
      :nesting-depth nesting-depth))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; A PROGRAM represents a top-level form together with derived
  ;;; knowledge of that form.  To begin with, a instance of a program
  ;;; contains only the initial instruction of the graph of instructions
  ;;; that represent nested code objects.
  
  (defclass program ()
    ((%initial-instruction
  
negative.code: 	(loop until (null remaining)
  	      do (push (one-block (pop remaining)) basic-blocks))))))
  
  (defun ensure-basic-block-for-procedure (procedure program)
    (when (null (basic-blocks procedure))
      (compute-basic-blocks-for-procedure procedure program)))
  
  (defun compute-basic-blocks (program)
    (ensure-instruction-ownership program)
    (loop for procedure in (procedures program)
  	do (compute-basic-blocks-for-procedure procedure program)))
    
  (defun ensure-basic-blocks (program)
    (ensure-instruction-ownership program)
    (loop for procedure in (procedures program)
  	do (ensure-basic-block-for-procedure procedure program)))