diff --git a/compiler/new-assem.lisp b/compiler/new-assem.lisp
index f06d6a5431ef5d83bfd5eb631ee8a4bf1e027d66..21c7fad4978ac2ac46669aaeceac440ae92beea7 100644
--- a/compiler/new-assem.lisp
+++ b/compiler/new-assem.lisp
@@ -7,7 +7,7 @@
 ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;;
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/new-assem.lisp,v 1.13 1992/07/29 20:39:52 wlott Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/new-assem.lisp,v 1.14 1992/07/30 04:47:34 wlott Exp $")
 ;;;
 ;;; **********************************************************************
 ;;;
@@ -264,7 +264,14 @@
 		     (incf *next-inst-id*)))
 	   stream)
     (format stream #+debug " emitter=~S" #-debug "emitter=~S"
-	    (inst-emitter inst))
+	    (let ((emitter (inst-emitter inst)))
+	      (if emitter
+		  (multiple-value-bind
+		      (lambda lexenv-p name)
+		      (function-lambda-expression emitter)
+		    (declare (ignore lambda lexenv-p))
+		    name)
+		  '<flushed>)))
     (when (inst-depth inst)
       (format stream ", depth=~D" (inst-depth inst)))))
 
@@ -314,13 +321,15 @@
 ;;; see if the basic block is terminated.
 ;;; 
 (defun queue-inst (segment inst reads writes)
-  #+debug (format *trace-output* "Queuing ~S~%" inst)
+  #+debug (format *trace-output* "~&Queuing ~S~%" inst)
   (assert (segment-run-scheduler segment))
   (let* ((writers (segment-writers segment))
 	 (readers (segment-readers segment))
 	 (read-dependencies nil)
 	 (write-dependencies nil)
 	 (emittable-insts (segment-emittable-insts segment)))
+    ;; For everything we read, find out who wrote it and note that we
+    ;; depend on them.
     (dolist (read reads)
       (let ((writer (assoc read writers :test #'eq)))
 	(when writer
@@ -328,41 +337,38 @@
 	    (pushnew prev-inst read-dependencies)
 	    (pushnew inst (inst-read-dependents prev-inst))
 	    (setf emittable-insts
-		  (delete prev-inst emittable-insts :test #'eq)))))
-      (push (cons read inst) readers))
+		  (delete prev-inst emittable-insts :test #'eq))))))
+    ;; For everything we write, find out who has read the old value and
+    ;; note that we depend on them also.  Also, change the writers record
+    ;; to indicate that we wrote that location last.
     (dolist (write writes)
-      (let ((writer (assoc write writers :test #'eq)))
-	(when writer
-	  (let ((prev-inst (cdr writer)))
+      (let ((reader (assoc write readers :test #'eq)))
+	(when reader
+	  (dolist (prev-inst (cdr reader))
 	    (pushnew prev-inst write-dependencies)
 	    (pushnew inst (inst-write-dependents prev-inst))
 	    (setf emittable-insts
 		  (delete prev-inst emittable-insts :test #'eq)))
-	  (setf writers (delete writer writers :test #'eq))))
-      (let ((reader (assoc write readers :test #'eq)))
-	(when reader
-	  (let ((prev-inst (cdr reader)))
-	    (unless (eq prev-inst inst)
-	      (pushnew prev-inst write-dependencies)
-	      (pushnew inst (inst-write-dependents prev-inst))
-	      (setf emittable-insts
-		    (delete prev-inst emittable-insts :test #'eq)))
-	    (setf readers (delete reader readers :test #'eq))))))
+	  (setf readers (delete reader readers :test #'eq))))
+      (setf writers
+	    (acons write inst
+		   (delete write writers :test #'eq :key #'car))))
     #+debug
     (when read-dependencies
       (format *trace-output* " Reads values produced by ~:S.~%"
 	      read-dependencies))
+    (setf (inst-read-dependencies inst) read-dependencies)
     #+debug
     (when write-dependencies
-      (format *trace-output* " Writes values used by ~:S.~%"
+      (format *trace-output* " Writes values needed by ~:S.~%"
 	      write-dependencies))
-    (setf (inst-read-dependencies inst) read-dependencies)
     (setf (inst-write-dependencies inst) write-dependencies)
     (dolist (read reads)
-      (push (cons read inst) readers))
+      (let ((reader (assoc read readers :test #'eq)))
+	(if reader
+	    (pushnew inst (cdr reader))
+	    (push (list read inst) readers))))
     (setf (segment-readers segment) readers)
-    (dolist (write writes)
-      (push (cons write inst) writers))
     (setf (segment-writers segment) writers)
     (let ((countdown (segment-branch-countdown segment)))
       (cond ((instruction-attributep (inst-attributes inst) branch)
@@ -454,19 +460,29 @@
     ;; Schedule all the branches in their exact locations.
     (let ((insts-from-end 0))
       (dolist (branch (segment-queued-branches segment))
-	(dotimes (i (- (car branch) insts-from-end))
-	  #+debug
-	  (format *trace-output* "Filling branch delay slot...~%")
-	  (let ((inst (or (schedule-one-inst segment) :nop)))
-	    (push inst results))
-	  (advance-one-inst segment)
-	  (incf insts-from-end))
 	(let ((inst (cdr branch)))
+	  (dotimes (i (- (car branch) insts-from-end))
+	    #+debug
+	    (format *trace-output* "Filling branch delay slot...~%")
+	    (flet ((maybe-schedule-dependent (dependents)
+		     (when dependents
+		       (let ((inst (car dependents)))
+			 (note-resolved-dependencies segment inst)
+			 (setf (segment-emittable-insts segment)
+			       (delete inst (segment-emittable-insts segment)))
+			 inst))))
+	      (push (or (maybe-schedule-dependent (inst-read-dependents inst))
+			(maybe-schedule-dependent (inst-write-dependents inst))
+			(schedule-one-inst segment)
+			:nop)
+		    results))
+	    (advance-one-inst segment)
+	    (incf insts-from-end))
 	  (note-resolved-dependencies segment inst)
-	  (push inst results))
-	#+debug
-	(format *trace-output* "Emitting ~S~%" (cdr branch))
-	(advance-one-inst segment)))
+	  (push inst results)
+	  #+debug
+	  (format *trace-output* "Emitting ~S~%" inst)
+	  (advance-one-inst segment))))
     ;;
     ;; Keep scheduling stuff until we run out.
     (loop
@@ -518,8 +534,6 @@
   (let ((inst (pop (segment-emittable-insts segment))))
     (cond (inst
 	   ;; We've got us a live one here.  Go for it.
-	   (assert (null (inst-write-dependents inst)))
-	   (assert (null (inst-read-dependents inst)))
 	   #+debug
 	   (format *Trace-output* "Emitting ~S~%" inst)
 	   (note-resolved-dependencies segment inst)
@@ -547,6 +561,8 @@
 ;;; dependency can be emitted now.
 ;;;
 (defun note-resolved-dependencies (segment inst)
+  (assert (null (inst-read-dependents inst)))
+  (assert (null (inst-write-dependents inst)))
   (dolist (dep (inst-write-dependencies inst))
     ;; These are the instructions who have to be completed before our
     ;; write fires.  Doesn't matter how far before, just before.
@@ -597,19 +613,21 @@
 ;;;
 ;;; Note that inst is emittable by sticking it in the SEGMENT-EMITTABLE-INSTS
 ;;; list.  We keep the emittable-insts sorted with the largest ``depths''
-;;; first.
+;;; first.  Except that if INST is a branch, don't bother.  It will be handled
+;;; correctly by the branch emitting code in SCHEDULE-PENDING-INSTRUCTIONS.
 ;;;
 (defun insert-emittable-inst (segment inst)
-  #+debug
-  (format *Trace-output* "Now emittable: ~S~%" inst)
-  (do ((my-depth (inst-depth inst))
-       (remaining (segment-emittable-insts segment) (cdr remaining))
-       (prev nil remaining))
-      ((or (null remaining) (> my-depth (inst-depth (car remaining))))
-       (if prev
-	   (setf (cdr prev) (cons inst remaining))
-	   (setf (segment-emittable-insts segment) (cons inst remaining)))
-       (ext:undefined-value))))
+  (unless (instruction-attributep (inst-attributes inst) branch)
+    #+debug
+    (format *Trace-output* "Now emittable: ~S~%" inst)
+    (do ((my-depth (inst-depth inst))
+	 (remaining (segment-emittable-insts segment) (cdr remaining))
+	 (prev nil remaining))
+	((or (null remaining) (> my-depth (inst-depth (car remaining))))
+	 (if prev
+	     (setf (cdr prev) (cons inst remaining))
+	     (setf (segment-emittable-insts segment) (cons inst remaining))))))
+  (ext:undefined-value))
 
 
 ;;;; Structure used during output emission.