diff --git a/README b/README
index 2dfce40c3d0d6499349372aa2b9022f28e42cc1a..60f9b714b490060b38c0fef08eb3ea4603c9b062 100644
--- a/README
+++ b/README
@@ -1,4 +1,4 @@
-$Id: README,v 1.29 2003/02/08 15:31:15 dan_b Exp $         -*- Text -*-
+$Id: README,v 1.30 2003/03/16 15:18:25 dan_b Exp $         -*- Text -*-
 
 
 asdf: another system definition facility          
@@ -706,4 +706,12 @@ recompile only one system.  So it would be more useful to have
 make-sub-operation refuse to propagate ":force t" to other systems, and
 propagate only something like ":force :recursively". ''
 
+Ideally what we actually want is some kind of criterion that says
+to which systems (and which operations) a :force switch will propagate.
+
+(defgeneric operation-propagates-force-p (operation component))
+
+make-sub-operation would call this
+
+
 
diff --git a/asdf.lisp b/asdf.lisp
index ba12d018ae3e59f29e00c480a4fb42a82b540401..f497345c911614fc89111e2b5bef9c337fee8fb4 100644
--- a/asdf.lisp
+++ b/asdf.lisp
@@ -1,4 +1,4 @@
-;;; This is asdf: Another System Definition Facility.  $Revision: 1.62 $
+;;; This is asdf: Another System Definition Facility.  $Revision: 1.63 $
 ;;;
 ;;; Feedback, bug reports, and patches are all welcome: please mail to
 ;;; <cclan-list@lists.sf.net>.  But note first that the canonical
@@ -87,7 +87,7 @@
 
 (in-package #:asdf)
 
-(defvar *asdf-revision* (let* ((v "$Revision: 1.62 $")
+(defvar *asdf-revision* (let* ((v "$Revision: 1.63 $")
 			       (colon (position #\: v))
 			       (dot (position #\. v)))
 			  (and v colon dot 
@@ -308,10 +308,21 @@ and NIL NAME and TYPE components"
      (t (sysdef-error (formatter "~@<invalid component designator ~A~@:>")
 		      name))))
 
+;;; for the sake of keeping things reasonably neat, we adopt a
+;;; convention that functions in this list are prefixed SYSDEF-
+
+(defvar *system-definition-search-functions*
+  '(sysdef-central-registry-search))
+
 (defun system-definition-pathname (system)
   (some (lambda (x) (funcall x system))
 	*system-definition-search-functions*))
 	
+(defvar *central-registry*
+  '(*default-pathname-defaults*
+    #+nil "/home/dan/src/sourceforge/cclan/asdf/systems/"
+    #+nil "telent:asdf;systems;"))
+
 (defun sysdef-central-registry-search (system)
   (let ((name (coerce-name system)))
     (block nil
@@ -325,17 +336,6 @@ and NIL NAME and TYPE components"
 	      (return file)))))))
 
 
-(defvar *central-registry*
-  '(*default-pathname-defaults*
-    #+nil "/home/dan/src/sourceforge/cclan/asdf/systems/"
-    #+nil "telent:asdf;systems;"))
-
-;;; for the sake of keeping things reasonably neat, we adopt a
-;;; convention that functions in this list are prefixed SYSDEF-
-
-(defvar *system-definition-search-functions*
-  '(sysdef-central-registry-search))
-
 (defun find-system (name &optional (error-p t))
   (let* ((name (coerce-name name))
 	 (in-memory (gethash name *defined-systems*))
@@ -405,13 +405,17 @@ system."))
 (defmethod source-file-type ((c static-file) (s module)) nil)
 
 (defmethod component-relative-pathname ((component source-file))
-  (let ((*default-pathname-defaults* (component-parent-pathname component)))
-    (or (slot-value component 'relative-pathname)
-	(make-pathname :name (component-name component)
-		       :type
-		       (source-file-type component
-					 (component-system component))))))
-
+  (let* ((*default-pathname-defaults* (component-parent-pathname component))
+	 (name-type
+	  (make-pathname
+	   :name (component-name component)
+	   :type (source-file-type component
+				   (component-system component)))))
+    (if (slot-value component 'relative-pathname)
+	(merge-pathnames
+	 (slot-value component 'relative-pathname)
+	 name-type)
+	name-type)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; operations
@@ -419,13 +423,18 @@ system."))
 ;;; one of these is instantiated whenever (operate ) is called
 
 (defclass operation ()
-  ((forced-p :initform nil :initarg :force :accessor operation-forced-p )
+  ((forced :initform nil :initarg :force :accessor operation-forced)
    (original-initargs :initform nil :initarg :original-initargs
 		      :accessor operation-original-initargs)
    (visited-nodes :initform nil :accessor operation-visited-nodes)
    (visiting-nodes :initform nil :accessor operation-visiting-nodes)
    (parent :initform nil :initarg :parent :accessor operation-parent)))
 
+(defmethod print-object ((o operation) stream)
+  (print-unreadable-object (o stream :type t :identity t)
+    (ignore-errors
+      (prin1 (operation-original-initargs o) stream))))
+
 (defmethod shared-initialize :after ((operation operation) slot-names
 				     &key force 
 				     &allow-other-keys)
@@ -450,9 +459,29 @@ system."))
        (operation-ancestor it)
        operation))
 
-(defun make-sub-operation (o type)
-  (let ((args (operation-original-initargs o)))
-    (apply #'make-instance type :parent o :original-initargs args args)))
+
+(defun make-sub-operation (c o dep-c dep-o)
+  (let* ((args (copy-list (operation-original-initargs o)))
+	 (force-p (getf args :force)))
+    ;; note explicit comparison with T: any other non-NIL force value
+    ;; (e.g. :recursive) will pass through
+    (cond ((and (null (component-parent c))
+		(null (component-parent dep-c))
+		(not (eql c dep-c)))
+	   (when (eql force-p t)
+	     (setf (getf args :force) nil))
+	   ;; note we lose the parent slot, because we don't want
+	   ;; forced to propagate backwards either (changes in depended-on
+	   ;; systems shouldn't force recompilation of the depending system)
+	   (apply #'make-instance dep-o
+		  ;:parent o
+		  :original-initargs args args))
+	  ((subtypep (type-of o) dep-o)
+	   o)
+	  (t 
+	   (apply #'make-instance dep-o
+		  :parent o :original-initargs args args)))))
+
 
 (defgeneric visit-component (operation component data))
 
@@ -550,18 +579,16 @@ system."))
 (defmethod traverse ((operation operation) (c component))
   (let ((forced nil))
     (labels ((do-one-dep (required-op required-c required-v)
-	       (let ((op (if (subtypep (type-of operation) required-op)
-			     operation
-			     (make-sub-operation operation required-op)))
-		     (dep-c (or (find-component
-				 (component-parent c)
-				 ;; XXX tacky.  really we should build the
-				 ;; in-order-to slot with canonicalized
-				 ;; names instead of coercing this late
-				 (coerce-name required-c) required-v)
-				(error 'missing-dependency :required-by c
-				       :version required-v
-				       :requires required-c))))
+	       (let* ((dep-c (or (find-component
+				  (component-parent c)
+				  ;; XXX tacky.  really we should build the
+				  ;; in-order-to slot with canonicalized
+				  ;; names instead of coercing this late
+				  (coerce-name required-c) required-v)
+				 (error 'missing-dependency :required-by c
+					:version required-v
+					:requires required-c)))
+		      (op (make-sub-operation c operation dep-c required-op)))
 		 (traverse op dep-c)))	   	   
 	     (do-dep (op dep)
 	       (cond ((eq op 'feature)
@@ -609,8 +636,13 @@ system."))
 		 forced))))
 	;; now the thing itself
 	(when (or forced module-ops
-		  (operation-forced-p (operation-ancestor operation))
-		  (not (operation-done-p operation c)))
+		  (not (operation-done-p operation c))
+		  (let ((f (operation-forced (operation-ancestor operation))))
+		    (and f (or (not (consp f))
+			       (member (component-name
+					(operation-ancestor operation))
+				       (mapcar #'coerce-name f)
+				       :test #'string=)))))
 	  (let ((do-first (cdr (assoc (class-name (class-of operation))
 				      (slot-value c 'do-first)))))
 	    (loop for (required-op . deps) in do-first