diff --git a/srfi/srfi-39.scm b/srfi/srfi-39.scm
index b8bb1d364..6808e90b7 100644
--- a/srfi/srfi-39.scm
+++ b/srfi/srfi-39.scm
@@ -1,6 +1,6 @@
 ;;; srfi-39.scm --- Parameter objects
 
-;; 	Copyright (C) 2004 Free Software Foundation, Inc.
+;; 	Copyright (C) 2004, 2005 Free Software Foundation, Inc.
 ;;
 ;; This program is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU General Public License as
@@ -67,7 +67,8 @@
   #:export-syntax (parameterize)
 
   ;; helper procedure not in srfi-39.
-  #:export (with-parameters*))
+  #:export (with-parameters*)
+  #:replace (current-input-port current-output-port current-error-port))
 
 ;; Make 'srfi-39 available as a feature identifiere to `cond-expand'.
 ;;
@@ -101,7 +102,61 @@
                        (list ?value ...)
                        (lambda () ?body ...)))))
 
+(define (current-input-port . new-value)
+  (if (null? new-value)
+      ((@ (guile) current-input-port))
+      (apply set-current-input-port new-value)))
+
+(define (current-output-port . new-value)
+  (if (null? new-value)
+      ((@ (guile) current-output-port))
+      (apply set-current-output-port new-value)))
+
+(define (current-error-port . new-value)
+  (if (null? new-value)
+      ((@ (guile) current-error-port))
+      (apply set-current-error-port new-value)))
+
+(define port-list
+  (list current-input-port current-output-port current-error-port))
+
+;; There are no fluids behind current-input-port etc, so those parameter
+;; objects are picked out of the list and handled separately with a
+;; dynamic-wind to swap their values to and from a location (the "value"
+;; variable in the swapper procedure "let").
+;;
+;; current-input-port etc are already per-dynamic-root, so this arrangement
+;; works the same as a fluid.  Perhaps they could become fluids for ease of
+;; implementation here.
+;;
+;; Notice the use of a param local variable for the swapper procedure.  It
+;; ensures any application changes to the PARAMS list won't affect the
+;; winding.
+;;
 (define (with-parameters* params values thunk)
-  (with-fluids* (map (lambda (p) (p get-fluid-tag)) params)
-                (map (lambda (p v) ((p get-conv-tag) v)) params values)
-                thunk))
+  (let more ((params params)
+	     (values values)
+	     (fluids '())     ;; fluids from each of PARAMS
+	     (convs  '())     ;; VALUES with conversion proc applied
+	     (swapper noop))  ;; wind/unwind procedure for ports handling
+    (if (null? params)
+	(if (eq? noop swapper)
+	    (with-fluids* fluids convs thunk)
+	    (dynamic-wind
+		swapper
+		(lambda ()
+		  (with-fluids* fluids convs thunk))
+		swapper))
+	(if (memq (car params) port-list)
+	    (more (cdr params) (cdr values)
+		  fluids convs
+		  (let ((param (car params))
+			(value (car values))
+			(prev-swapper swapper))
+		    (lambda ()
+		      (set! value (param value))
+		      (prev-swapper))))
+	    (more (cdr params) (cdr values)
+		  (cons ((car params) get-fluid-tag) fluids)
+		  (cons (((car params) get-conv-tag) (car values)) convs)
+		  swapper)))))