anchor.diff:  
   (sys.int::pci-register-driver *hda-pci-ids* 'probe)
   (setf c (first *cards*))
  +
  +(defun write-bdl (hda entry base length)
  +  (let ((array (hda-corb/rirb/dmap hda))
  +        (offset (+ (/ +bdl-offset+ 4) (* entry 4))))
  +    (setf (aref array (+ offset 0)) (ldb (byte 32 0) base)
  +          (aref array (+ offset 1)) (ldb (byte 32 32) base)
  +          (aref array (+ offset 2)) length
  +          (aref array (+ offset 3)) 0)))
  +
  +(defun read-bdl (hda entry)
  +  (let ((array (hda-corb/rirb/dmap hda))
  +        (offset (+ (/ +bdl-offset+ 4) (* entry 4))))
  +    (values (logior (aref array (+ offset 0))
  +                    (ash (aref array (+ offset 0)) 32))
  +            (aref array (+ offset 2))
  +            (aref array (+ offset 3)))))
  +
  +(defun prep-stream (hda stream-id bdl-base bdl-length)
  +  (let ((r (hda-register-set hda))
  +        (r-base (+ #x80 (* stream-id #x20))))
  +    (setf (reg/32 r (+ r-base +sdnbdpl+)) (+ (hda-corb/rirb/dmap-physical c) +bdl-offset+ (* bdl-base 16))
  +          (reg/16 r (+ r-base +sdnfmt+)) #x4011
  +          (reg/16 r (+ r-base +sdnlvi+)) bdl-length
  +          (reg/32 r (+ r-base +sdncbl+)) #x100000)))
  +
  +(defun stream-reset (hda stream-id)
  +  ;; Clear the run bit before doing anything.
  +  (setf (reg/32 (hda-register-set hda)
  +                (+ #x80 (* stream-id #x20) +sdnctlsts+))
  +        (logand (reg/32 (hda-register-set hda)
  +                        (+ #x80 (* stream-id #x20) +sdnctlsts+))
  +                (lognot 2)))
  +  (setf (reg/32 (hda-register-set hda)
  +                (+ #x80 (* stream-id #x20) +sdnctlsts+))
  +        1)
  +  (setf (reg/32 (hda-register-set hda)
  +                (+ #x80 (* stream-id #x20) +sdnctlsts+))
  +        0))
  +
  +(defun stream-go (hda stream-id)
  +  (setf (reg/32 (hda-register-set hda)
  +                (+ #x80 (* stream-id #x20) +sdnctlsts+))
  +        #x00100002))
  +
  +(defun test (codec dac pin &optional mixer)
  +  (stream-reset c 4)
  +  (write-bdl c 0 #x200000 #x80000)
  +  (write-bdl c 1 #x400000 #x80000)
  +  (prep-stream c 4 0 1)
  +  (when mixer
  +    (command c codec mixer #x3F07F)) ; unmute L/R out/in
  +  (command c codec dac #x70610) ; stream=1
  +  (command c codec dac #x24011) ; format
  +  (command c codec dac #x3b07f) ; unmute L/R out
  +  (command c codec pin #x3b07f) ; unmute L/R out
  +  (command c codec pin #x70740) ; enable output
  +  (stream-go c 4))
  
positive.code:    (function-groups :initarg :function-groups :reader function-groups)))
  
  (defclass function-group (node)
    (widgets :initarg :widgets :reader widgets))
  
  (defclass audio-function-group (function-group)
    ())
  
  (defclass widget (node)
    (function-group :initarg :function-group :reader function-group))
  
  (defclass widget-connections-mixin ()
    (connections :initarg :connections :reader connections))
  
  (defclass output-amp-mixin () ())
  (defclass input-amp-mixin () ())
  
  (defclass audio-widget (widget) ())
  
  (defclass audio-output-converter (audio-widget output-amp-mixin)
    ())
  
negative.code:                                         (ldb (byte 8 8) x)
                                          (ldb (byte 8 16) x)
                                          (ldb (byte 8 24) x)))))))
      (subseq entries 0 n-entries)))
  
  (defgeneric enumerate-function-group (function-group))
  
  (defmethod enumerate-function-group ((function-group function-group))
    (let ((subs (parameter function-group +parameter-subordinates+)))
      (setf (slot-value function-group 'widgets)
            (loop for widget-nid from (parameter-subordinates-starting-node subs)
               below (+ (parameter-subordinates-starting-node subs)
                        (parameter-subordinates-total subs))
               collect (make-instance (widget-class function-group widget-nid)
                                      :nid widget-nid
                                      :cad (cad function-group)
                                      :hda (hda function-group)
                                      :function-group function-group))))
    (dolist (widget (widgets function-group))
      (enumerate-widget widget))
    function-group)
  
  (defmethod enumerate-function-group :after ((function-group audio-function-group))
    ;; Discover interesting pins.
    ;; "Interesting" is entirely arbitrary and consists of headphones,
    ;; line-in, line-out and mic pins.
    (dolist (widget (widgets function-group))
      (when (typep widget 'audio-pin-complex)
        (case (pin-default-device widget)
          ((:line-out :headphones-out)
           (push widget (slot-value function-group 'outputs)))
          ((:line-in :mic-in)
           (push widget (slot-value function-group 'inputs)))))))
  
  (defun enumerate-codec (hda cad)
    (let* ((root (make-instance 'root-node :nid +root-nid+ :cad cad :hda hda))
           (root-subs (parameter root +parameter-subordinates+)))
      (setf (slot-value root 'function-groups)
            (loop for function-nid from (parameter-subordinates-starting-node root-subs)
               below (+ (parameter-subordinates-starting-node root-subs)
                        (parameter-subordinates-total root-subs))
               collect (let* ((type (command hda cad function-nid (make-parameter +parameter-function-group+))))
                         (make-instance (function-group-class (parameter-function-group-node-type type))
                                        :nid function-nid
                                        :cad cad
                                        :hda hda
                                        :root root))))
      (dolist (fgroup (function-groups root))
        (enumerate-function-group fgroup))
      root))
  
  (defgeneric graph-widget (widget))
  
  (defmethod graph-widget ((widget widget))
    (format t "~D [label=\"~:(~A~) (~D)\"];~%"
            (nid widget) (type-of widget) (nid widget)))
  
  (defmethod graph-widget :after ((widget widget-connections-mixin))
    (dolist (connection (connections widget))
      (ecase (widget-connection-direction widget)
        (:bidirectional
         (format t "~D -> ~D;~%" (nid connection) (nid widget))
         (format t "~D -> ~D;~%" (nid widget) (nid connection)))
        (:sink (format t "~D -> ~D;~%" (nid connection) (nid widget)))
        (:source (format t "~D -> ~D;~%" (nid widget) (nid connection)))
        (:undirected (format t "~D -> ~D [dir=\"none\"];~%" (nid widget) (nid connection))))))
  
  (defmethod graph-widget ((widget audio-pin-complex))
    (format t "~D [label=\"~:(~A~) (~D)\\n~A\\n~:(~A)\\n~A\\n~A\"];~%"
            (nid widget) (type-of widget) (nid widget)
            (pin-location widget)
            (pin-default-device widget)
            (pin-connection-type widget)
            (pin-colour widget)))
  
  (defun graph-connections (root-node)
    (format t "digraph G {~%")
    (dolist (function-group (function-groups root-node))
      (dolist (widget (widgets function-group))
        (graph-widget widget)))
    (format t "}~%"))
  
  (defvar *cards* '())
  (setf *cards* '())
  