anchor.diff:  (in-package #:sicl-program)
  -
  -;;;; A SIMPLE INSTRUCTION CHAIN is a sequence of instructions, all
  -;;;; belonging to the same procedure, such that every instruction in
  -;;;; the sequence except the first is the unique successor in the
  -;;;; instruction graph of its predecessor in the sequence, and every
  -;;;; instruction in the sequence except the last is the unique
  -;;;; predecessor in the instruction graph of its successor in the
  -;;;; sequence.
  -;;;;
  -;;;; A BASIC BLOCK is a MAXIMAL SIMPLE INSTRUCTION CHAIN.  It is
  -;;;; maximal in that if any predecessor in the instruction graph of the
  -;;;; first instruction in the chain were to be included in the
  -;;;; sequence, then the sequence is no longer a simple instruction
  -;;;; chain, and if any successor in the instruction graph of the last
  -;;;; instruction in the chain were to be included in the sequence, then
  -;;;; the sequence is no longer a simple instruction chain. 
  -;;;;
  -;;;; Every instruction belongs to exactly one basic block.  In the
  -;;;; degenerate case, the basic block to which an instruction belongs
  -;;;; contains only that single instruction.
  -;;;;
  -;;;; We follow the terminology of Steven S Muchnick, in that a FLOW
  -;;;; GRAPH is a graph of BASIC BLOCKS. 
   
   ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;;
  
positive.code: 
  (add-dependencies 'lexical-depth
  		  '(location-ownership))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  ;;; Basic blocks.
  
  (defclass basic-block ()
    ((;; The first instruction in the basic block.
      %initial :initarg :initial :accessor initial)
     ;; The last instruction in the basic block.
     (%final :initarg :final :accessor final)
     ;; The basic blocks that dominate this block (not necessarily
     ;; immediately, and not strictly).
     (%dominators :initform '() :accessor dominators)))
  
  (defun compute-basic-blocks-for-procedure (procedure)
    (with-accessors ((instructions instructions)
  		   (basic-blocks basic-blocks))
        procedure
      (setf basic-blocks '())
      (let ((remaining instructions))
        (flet ((one-block (instruction)
  	       (let ((initial instruction)
  		     (final instruction))
  		 (loop for preds = (predecessors initial)
  		       while (= (length preds) 1)
  		       for pred = (car preds)
  		       while (eq (owner pred) procedure)
  		       for succs = (successors pred)
  		       while (= (length succs) 1)
  		       do (setf initial pred)
  			  (setf remaining (remove pred remaining :test #'eq)))
  		 (loop for succs = (successors final)
  		       while (= (length succs) 1)
  		       for succ = (car succs)
  		       while (eq (owner succ) procedure)
  		       for preds = (predecessors succ)
  		       while (= (length preds) 1)
  		       do (setf final succ)
  			  (setf remaining (remove succ remaining :test #'eq)))
  		 (let ((b (make-instance 'basic-block
  			    :initial initial
  			    :final final)))
  		   (loop for ins = initial then (car (successors ins))
  			 do (setf (basic-block ins) b)
  			 until (eq ins final))
  		   b))))
  	(loop until (null remaining)
  	      do (push (one-block (pop remaining)) basic-blocks))))))
  
  (defun compute-basic-blocks (program)
    (let ((*program* program))
      (loop for procedure in (procedures program)
  	  do (compute-basic-blocks-for-procedure procedure))))
  
  (set-processor 'basic-blocks 'compute-basic-blocks)
  
  (add-dependencies 'basic-blocks
  		  '(instruction-ownership))
  
  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  ;;;
  
negative.code: ;;; counting nested loops and by taking branches into account.
  
  (defun compute-spill-costs (program)
    (let* ((loops (remove 1 (sicl-compiler-loops:kosaraju
  			   (initial-instruction program) #'successors)
  			:test #'length))
  	 (loop-instructions (reduce #'append loops :from-end t))
  	 (conflicts (compute-conflicts program)))
  