Load port bindings in separate (ice-9 ports) module

* module/ice-9/ports.scm: New file.
* am/bootstrap.am (SOURCES): Add ice-9/ports.scm.
* libguile/fports.c (scm_init_ice_9_fports): New function.
  (scm_init_fports): Arrange for scm_init_ice_9_fports to be called via
  load-extension, and load snarfed things there.  Move open-file
  definition early, to allow ports to bootstrap.
* libguile/ioext.c (scm_init_ice_9_ioext): New function.
  (scm_init_ioext): Similarly, register scm_init_ice_9_ioext as an
  extension.
* libguile/ports.c (scm_set_current_input_port)
  (scm_set_current_output_port, scm_set_current_error_port): Don't
  define Scheme bindings; do that in Scheme.
* libguile/ports.c (scm_i_set_default_port_encoding):
  (scm_i_default_port_encoding, scm_i_default_port_conversion_handler):
  (scm_i_set_default_port_conversion_handler): Since we now init
  encoding early, remove the "init" flags on these encoding/strategy
  vars.
  (scm_init_ice_9_ports): New function.
  (scm_init_ports): Register scm_init_ice_9_ports extension, and define
  some bindings needed by the bootstrap.
* module/Makefile.am (SOURCES): Add ice-9/ports.scm.
* module/ice-9/boot-9.scm: Remove code that's not on the boot path,
  moving it to ice-9/ports.scm.  At the end, load (ice-9 ports).
* module/ice-9/psyntax.scm (include): Use close-port instead of
  close-input-port.
* module/ice-9/psyntax-pp.scm (include): Regenerate.

9 files changed, 602 insertions, 397 deletions

diff --git a/am/bootstrap.am b/am/bootstrap.am
index d613d7f02..0eaa87b06 100644
--- a/am/bootstrap.am
+++ b/am/bootstrap.am
@@ -123,6 +123,7 @@ SOURCES =					\
   system/base/ck.scm				\
 						\
   ice-9/boot-9.scm				\
+  ice-9/ports.scm				\
   ice-9/r5rs.scm				\
   ice-9/deprecated.scm				\
   ice-9/binary-ports.scm			\
diff --git a/libguile/fports.c b/libguile/fports.c
index 11aa1707b..efbcf73a0 100644
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -121,8 +121,8 @@ SCM_DEFINE (scm_file_port_p, "file-port?", 1, 0, 0,
 
 
 static SCM sys_file_port_name_canonicalization;
-SCM_SYMBOL (sym_relative, "relative");
-SCM_SYMBOL (sym_absolute, "absolute");
+static SCM sym_relative;
+static SCM sym_absolute;
 
 static SCM
 fport_canonicalize_filename (SCM filename)
@@ -677,16 +677,34 @@ scm_init_fports_keywords ()
   k_encoding       = scm_from_latin1_keyword ("encoding");
 }
 
+static void
+scm_init_ice_9_fports (void)
+{
+#include "libguile/fports.x"
+}
+
 void
 scm_init_fports ()
 {
   scm_tc16_fport = scm_make_fptob ();
 
+  scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
+                            "scm_init_ice_9_fports",
+			    (scm_t_extension_init_func) scm_init_ice_9_fports,
+			    NULL);
+
+  /* The following bindings are used early in boot-9.scm.  */
+
+  /* Used by `include' and also by `file-exists?' if `stat' is
+     unavailable.  */
+  scm_c_define_gsubr (s_scm_i_open_file, 2, 0, 1, (scm_t_subr) scm_i_open_file);
+
+  /* Used by `open-file.', also via C.  */
+  sym_relative = scm_from_latin1_symbol ("relative");
+  sym_absolute = scm_from_latin1_symbol ("absolute");
   sys_file_port_name_canonicalization = scm_make_fluid ();
   scm_c_define ("%file-port-name-canonicalization",
                 sys_file_port_name_canonicalization);
-                                    
-#include "libguile/fports.x"
 }
 
 /*
diff --git a/libguile/ioext.c b/libguile/ioext.c
index 607eec636..3f0a53f5d 100644
--- a/libguile/ioext.c
+++ b/libguile/ioext.c
@@ -302,12 +302,21 @@ SCM_DEFINE (scm_fdes_to_ports, "fdes->ports", 1, 0, 0,
 #undef FUNC_NAME    
 
 
+static void
+scm_init_ice_9_ioext (void)
+{
+#include "libguile/ioext.x"
+}
+
 void 
 scm_init_ioext ()
 {
   scm_add_feature ("i/o-extensions");
 
-#include "libguile/ioext.x"
+  scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
+                            "scm_init_ice_9_ioext",
+			    (scm_t_extension_init_func) scm_init_ice_9_ioext,
+			    NULL);
 }
 
 
diff --git a/libguile/ports.c b/libguile/ports.c
index 8fe8dbe0d..d1bb231f0 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -425,14 +425,9 @@ SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_set_current_input_port, "set-current-input-port", 1, 0, 0,
-           (SCM port),
-	    "@deffnx {Scheme Procedure} set-current-output-port port\n"
-	    "@deffnx {Scheme Procedure} set-current-error-port port\n"
-	    "Change the ports returned by @code{current-input-port},\n"
-	    "@code{current-output-port} and @code{current-error-port}, respectively,\n"
-	    "so that they use the supplied @var{port} for input or output.")
-#define FUNC_NAME s_scm_set_current_input_port
+SCM
+scm_set_current_input_port (SCM port)
+#define FUNC_NAME "set-current-input-port"
 {
   SCM oinp = scm_fluid_ref (cur_inport_fluid);
   SCM_VALIDATE_OPINPORT (1, port);
@@ -441,11 +436,9 @@ SCM_DEFINE (scm_set_current_input_port, "set-current-input-port", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-
-SCM_DEFINE (scm_set_current_output_port, "set-current-output-port", 1, 0, 0,
-	    (SCM port),
-	    "Set the current default output port to @var{port}.")
-#define FUNC_NAME s_scm_set_current_output_port
+SCM
+scm_set_current_output_port (SCM port)
+#define FUNC_NAME "scm-set-current-output-port"
 {
   SCM ooutp = scm_fluid_ref (cur_outport_fluid);
   port = SCM_COERCE_OUTPORT (port);
@@ -455,11 +448,9 @@ SCM_DEFINE (scm_set_current_output_port, "set-current-output-port", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-
-SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0,
-	    (SCM port),
-	    "Set the current default error port to @var{port}.")
-#define FUNC_NAME s_scm_set_current_error_port
+SCM
+scm_set_current_error_port (SCM port)
+#define FUNC_NAME "set-current-error-port"
 {
   SCM oerrp = scm_fluid_ref (cur_errport_fluid);
   port = SCM_COERCE_OUTPORT (port);
@@ -469,7 +460,6 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-
 SCM
 scm_set_current_warning_port (SCM port)
 #define FUNC_NAME "set-current-warning-port"
@@ -482,7 +472,6 @@ scm_set_current_warning_port (SCM port)
 }
 #undef FUNC_NAME
 
-
 void
 scm_dynwind_current_input_port (SCM port)
 #define FUNC_NAME NULL
@@ -916,19 +905,12 @@ SCM_DEFINE (scm_close_output_port, "close-output-port", 1, 0, 0,
 /* A fluid specifying the default encoding for newly created ports.  If it is
    a string, that is the encoding.  If it is #f, it is in the "native"
    (Latin-1) encoding.  */
-SCM_VARIABLE (default_port_encoding_var, "%default-port-encoding");
-
-static int scm_port_encoding_init = 0;
+static SCM default_port_encoding_var;
 
 /* Use ENCODING as the default encoding for future ports.  */
 void
 scm_i_set_default_port_encoding (const char *encoding)
 {
-  if (!scm_port_encoding_init
-      || !scm_is_fluid (SCM_VARIABLE_REF (default_port_encoding_var)))
-    scm_misc_error (NULL, "tried to set port encoding fluid before it is initialized",
-		    SCM_EOL);
-
   if (encoding_matches (encoding, "ISO-8859-1"))
     scm_fluid_set_x (SCM_VARIABLE_REF (default_port_encoding_var), SCM_BOOL_F);
   else
@@ -940,63 +922,41 @@ scm_i_set_default_port_encoding (const char *encoding)
 const char *
 scm_i_default_port_encoding (void)
 {
-  if (!scm_port_encoding_init)
-    return "ISO-8859-1";
-  else if (!scm_is_fluid (SCM_VARIABLE_REF (default_port_encoding_var)))
+  SCM encoding;
+
+  encoding = scm_fluid_ref (SCM_VARIABLE_REF (default_port_encoding_var));
+  if (!scm_is_string (encoding))
     return "ISO-8859-1";
   else
-    {
-      SCM encoding;
-
-      encoding = scm_fluid_ref (SCM_VARIABLE_REF (default_port_encoding_var));
-      if (!scm_is_string (encoding))
-	return "ISO-8859-1";
-      else
-	return scm_i_string_chars (encoding);
-    }
+    return scm_i_string_chars (encoding);
 }
 
 /* A fluid specifying the default conversion handler for newly created
    ports.  Its value should be one of the symbols below.  */
-SCM_VARIABLE (default_conversion_strategy_var,
-	      "%default-port-conversion-strategy");
-
-/* Whether the above fluid is initialized.  */
-static int scm_conversion_strategy_init = 0;
+static SCM default_conversion_strategy_var;
 
 /* The possible conversion strategies.  */
-SCM_SYMBOL (sym_error, "error");
-SCM_SYMBOL (sym_substitute, "substitute");
-SCM_SYMBOL (sym_escape, "escape");
+static SCM sym_error;
+static SCM sym_substitute;
+static SCM sym_escape;
 
 /* Return the default failed encoding conversion policy for new created
    ports.  */
 scm_t_string_failed_conversion_handler
 scm_i_default_port_conversion_handler (void)
 {
-  scm_t_string_failed_conversion_handler handler;
-
-  if (!scm_conversion_strategy_init
-      || !scm_is_fluid (SCM_VARIABLE_REF (default_conversion_strategy_var)))
-    handler = SCM_FAILED_CONVERSION_QUESTION_MARK;
-  else
-    {
-      SCM fluid, value;
+  SCM value;
 
-      fluid = SCM_VARIABLE_REF (default_conversion_strategy_var);
-      value = scm_fluid_ref (fluid);
+  value = scm_fluid_ref (SCM_VARIABLE_REF (default_conversion_strategy_var));
 
-      if (scm_is_eq (sym_substitute, value))
-	handler = SCM_FAILED_CONVERSION_QUESTION_MARK;
-      else if (scm_is_eq (sym_escape, value))
-	handler = SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE;
-      else
-	/* Default to 'error also when the fluid's value is not one of
-	   the valid symbols.  */
-	handler = SCM_FAILED_CONVERSION_ERROR;
-    }
-
-  return handler;
+  if (scm_is_eq (sym_substitute, value))
+    return SCM_FAILED_CONVERSION_QUESTION_MARK;
+  else if (scm_is_eq (sym_escape, value))
+    return SCM_FAILED_CONVERSION_ESCAPE_SEQUENCE;
+  else
+    /* Default to 'error also when the fluid's value is not one of
+       the valid symbols.  */
+    return SCM_FAILED_CONVERSION_ERROR;
 }
 
 /* Use HANDLER as the default conversion strategy for future ports.  */
@@ -1006,11 +966,6 @@ scm_i_set_default_port_conversion_handler (scm_t_string_failed_conversion_handle
 {
   SCM strategy;
 
-  if (!scm_conversion_strategy_init
-      || !scm_is_fluid (SCM_VARIABLE_REF (default_conversion_strategy_var)))
-    scm_misc_error (NULL, "tried to set conversion strategy fluid before it is initialized",
-		    SCM_EOL);
-
   switch (handler)
     {
     case SCM_FAILED_CONVERSION_ERROR:
@@ -3286,42 +3241,77 @@ SCM_DEFINE (scm_sys_make_void_port, "%make-void-port", 1, 0, 0,
 
 /* Initialization.  */
 
-void
-scm_init_ports ()
+static void
+scm_init_ice_9_ports (void)
 {
+#include "libguile/ports.x"
+
   /* lseek() symbols.  */
   scm_c_define ("SEEK_SET", scm_from_int (SEEK_SET));
   scm_c_define ("SEEK_CUR", scm_from_int (SEEK_CUR));
   scm_c_define ("SEEK_END", scm_from_int (SEEK_END));
 
+  /* These bindings are used when boot-9 turns `current-input-port' et
+     al into parameters.  They are then removed from the guile module.  */
+  scm_c_define ("%current-input-port-fluid", cur_inport_fluid);
+  scm_c_define ("%current-output-port-fluid", cur_outport_fluid);
+  scm_c_define ("%current-error-port-fluid", cur_errport_fluid);
+  scm_c_define ("%current-warning-port-fluid", cur_warnport_fluid);
+}
+
+void
+scm_init_ports (void)
+{
   scm_tc16_void_port = scm_make_port_type ("void", void_port_read,
 					   void_port_write);
 
+  scm_i_port_weak_set = scm_c_make_weak_set (31);
+
   cur_inport_fluid = scm_make_fluid ();
   cur_outport_fluid = scm_make_fluid ();
   cur_errport_fluid = scm_make_fluid ();
   cur_warnport_fluid = scm_make_fluid ();
   cur_loadport_fluid = scm_make_fluid ();
 
-  scm_i_port_weak_set = scm_c_make_weak_set (31);
-
-#include "libguile/ports.x"
+  sym_substitute = scm_from_latin1_symbol ("substitute");
+  sym_escape = scm_from_latin1_symbol ("escape");
+  sym_error = scm_from_latin1_symbol ("error");
 
   /* Use Latin-1 as the default port encoding.  */
-  SCM_VARIABLE_SET (default_port_encoding_var,
-                    scm_make_fluid_with_default (SCM_BOOL_F));
-  scm_port_encoding_init = 1;
-
-  SCM_VARIABLE_SET (default_conversion_strategy_var,
-                    scm_make_fluid_with_default (sym_substitute));
-  scm_conversion_strategy_init = 1;
-
-  /* These bindings are used when boot-9 turns `current-input-port' et
-     al into parameters.  They are then removed from the guile module.  */
-  scm_c_define ("%current-input-port-fluid", cur_inport_fluid);
-  scm_c_define ("%current-output-port-fluid", cur_outport_fluid);
-  scm_c_define ("%current-error-port-fluid", cur_errport_fluid);
-  scm_c_define ("%current-warning-port-fluid", cur_warnport_fluid);
+  default_port_encoding_var =
+    scm_c_define ("%default-port-encoding",
+                  scm_make_fluid_with_default (SCM_BOOL_F));
+  default_conversion_strategy_var =
+    scm_c_define ("%default-port-conversion-strategy",
+                  scm_make_fluid_with_default (sym_substitute));
+
+  scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
+                            "scm_init_ice_9_ports",
+			    (scm_t_extension_init_func) scm_init_ice_9_ports,
+			    NULL);
+
+  /* The following bindings are used early in boot-9.scm.  */
+
+  /* Used by `include'.  */
+  scm_c_define_gsubr (s_scm_set_port_encoding_x, 2, 0, 0,
+                      (scm_t_subr) scm_set_port_encoding_x);
+  scm_c_define_gsubr (s_scm_eof_object_p, 1, 0, 0,
+                      (scm_t_subr) scm_eof_object_p);
+
+  /* Used by a number of error/warning-printing routines.  */
+  scm_c_define_gsubr (s_scm_force_output, 0, 1, 0,
+                      (scm_t_subr) scm_force_output);
+
+  /* Used by `file-exists?' and related functions if `stat' is
+     unavailable.  */
+  scm_c_define_gsubr (s_scm_close_port, 1, 0, 0,
+                      (scm_t_subr) scm_close_port);
+
+  /* Used by error routines.  */
+  scm_c_define_gsubr (s_scm_current_error_port, 0, 0, 0,
+                      (scm_t_subr) scm_current_error_port);
+  scm_c_define_gsubr (s_scm_current_warning_port, 0, 0, 0,
+                      (scm_t_subr) scm_current_warning_port);
 }
 
 /*
diff --git a/module/Makefile.am b/module/Makefile.am
index 6cb160314..71b265ae4 100644
--- a/module/Makefile.am
+++ b/module/Makefile.am
@@ -88,6 +88,7 @@ SOURCES =					\
   ice-9/poe.scm					\
   ice-9/poll.scm				\
   ice-9/popen.scm				\
+  ice-9/ports.scm				\
   ice-9/posix.scm				\
   ice-9/pretty-print.scm			\
   ice-9/psyntax-pp.scm				\
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index 9e9efe65b..ee3648027 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -151,38 +151,6 @@ a-cont
 
 
 
-;;; {Low-Level Port Code}
-;;;
-
-;; These are used to request the proper mode to open files in.
-;;
-(define OPEN_READ "r")
-(define OPEN_WRITE "w")
-(define OPEN_BOTH "r+")
-
-(define *null-device* "/dev/null")
-
-;; NOTE: Later in this file, this is redefined to support keywords
-(define (open-input-file str)
-  "Takes a string naming an existing file and returns an input port
-capable of delivering characters from the file.  If the file
-cannot be opened, an error is signalled."
-  (open-file str OPEN_READ))
-
-;; NOTE: Later in this file, this is redefined to support keywords
-(define (open-output-file str)
-  "Takes a string naming an output file to be created and returns an
-output port capable of writing characters to a new file by that
-name.  If the file cannot be opened, an error is signalled.  If a
-file with the given name already exists, the effect is unspecified."
-  (open-file str OPEN_WRITE))
-
-(define (open-io-file str) 
-  "Open file with name STR for both input and output."
-  (open-file str OPEN_BOTH))
-
-
-
 ;;; {Simple Debugging Tools}
 ;;;
 
@@ -315,11 +283,10 @@ file with the given name already exists, the effect is unspecified."
              (for-eachn (cdr l1) (map cdr rest))))))))
 
 
-;; Temporary definition used in the include-from-path expansion;
-;; replaced later.
+;; Temporary definitions used by `include'; replaced later.
 
-(define (absolute-file-name? file-name)
-  #t)
+(define (absolute-file-name? file-name) #t)
+(define (open-input-file str) (open-file str "r"))
 
 ;;; {and-map and or-map}
 ;;;
@@ -1195,11 +1162,6 @@ VALUE."
 ;;
 ;; It should print OBJECT to PORT.
 
-(define (inherit-print-state old-port new-port)
-  (if (get-print-state old-port)
-      (port-with-print-state new-port (get-print-state old-port))
-      new-port))
-
 ;; 0: type-name, 1: fields, 2: constructor
 (define record-type-vtable
   (let ((s (make-vtable (string-append standard-vtable-fields "prprpw")
@@ -1446,29 +1408,6 @@ CONV is not applied to the initial value."
 
 
 
-;;; Current ports as parameters.
-;;;
-
-(let ()
-  (define-syntax-rule (port-parameterize! binding fluid predicate msg)
-    (begin
-      (set! binding (fluid->parameter (module-ref (current-module) 'fluid)
-                                      (lambda (x)
-                                        (if (predicate x) x
-                                            (error msg x)))))
-      (hashq-remove! (%get-pre-modules-obarray) 'fluid)))
-  
-  (port-parameterize! current-input-port %current-input-port-fluid
-                      input-port? "expected an input port")
-  (port-parameterize! current-output-port %current-output-port-fluid
-                      output-port? "expected an output port")
-  (port-parameterize! current-error-port %current-error-port-fluid
-                      output-port? "expected an output port")
-  (port-parameterize! current-warning-port %current-warning-port-fluid
-                      output-port? "expected an output port"))
-
-
-
 ;;; {Languages}
 ;;;
 
@@ -1483,140 +1422,6 @@ CONV is not applied to the initial value."
 ;;; {High-Level Port Routines}
 ;;;
 
-(define* (open-input-file
-          file #:key (binary #f) (encoding #f) (guess-encoding #f))
-  "Takes a string naming an existing file and returns an input port
-capable of delivering characters from the file.  If the file
-cannot be opened, an error is signalled."
-  (open-file file (if binary "rb" "r")
-             #:encoding encoding
-             #:guess-encoding guess-encoding))
-
-(define* (open-output-file file #:key (binary #f) (encoding #f))
-  "Takes a string naming an output file to be created and returns an
-output port capable of writing characters to a new file by that
-name.  If the file cannot be opened, an error is signalled.  If a
-file with the given name already exists, the effect is unspecified."
-  (open-file file (if binary "wb" "w")
-             #:encoding encoding))
-
-(define* (call-with-input-file
-          file proc #:key (binary #f) (encoding #f) (guess-encoding #f))
-  "PROC should be a procedure of one argument, and FILE should be a
-string naming a file.  The file must
-already exist. These procedures call PROC
-with one argument: the port obtained by opening the named file for
-input or output.  If the file cannot be opened, an error is
-signalled.  If the procedure returns, then the port is closed
-automatically and the values yielded by the procedure are returned.
-If the procedure does not return, then the port will not be closed
-automatically unless it is possible to prove that the port will
-never again be used for a read or write operation."
-  (let ((p (open-input-file file
-                            #:binary binary
-                            #:encoding encoding
-                            #:guess-encoding guess-encoding)))
-    (call-with-values
-      (lambda () (proc p))
-      (lambda vals
-        (close-input-port p)
-        (apply values vals)))))
-
-(define* (call-with-output-file file proc #:key (binary #f) (encoding #f))
-  "PROC should be a procedure of one argument, and FILE should be a
-string naming a file.  The behaviour is unspecified if the file
-already exists. These procedures call PROC
-with one argument: the port obtained by opening the named file for
-input or output.  If the file cannot be opened, an error is
-signalled.  If the procedure returns, then the port is closed
-automatically and the values yielded by the procedure are returned.
-If the procedure does not return, then the port will not be closed
-automatically unless it is possible to prove that the port will
-never again be used for a read or write operation."
-  (let ((p (open-output-file file #:binary binary #:encoding encoding)))
-    (call-with-values
-      (lambda () (proc p))
-      (lambda vals
-        (close-output-port p)
-        (apply values vals)))))
-
-(define (with-input-from-port port thunk)
-  (parameterize ((current-input-port port))
-    (thunk)))
-
-(define (with-output-to-port port thunk)
-  (parameterize ((current-output-port port))
-    (thunk)))
-
-(define (with-error-to-port port thunk)
-  (parameterize ((current-error-port port))
-    (thunk)))
-
-(define* (with-input-from-file
-          file thunk #:key (binary #f) (encoding #f) (guess-encoding #f))
-  "THUNK must be a procedure of no arguments, and FILE must be a
-string naming a file.  The file must already exist. The file is opened for
-input, an input port connected to it is made
-the default value returned by `current-input-port',
-and the THUNK is called with no arguments.
-When the THUNK returns, the port is closed and the previous
-default is restored.  Returns the values yielded by THUNK.  If an
-escape procedure is used to escape from the continuation of these
-procedures, their behavior is implementation dependent."
-  (call-with-input-file file
-   (lambda (p) (with-input-from-port p thunk))
-   #:binary binary
-   #:encoding encoding
-   #:guess-encoding guess-encoding))
-
-(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f))
-  "THUNK must be a procedure of no arguments, and FILE must be a
-string naming a file.  The effect is unspecified if the file already exists.
-The file is opened for output, an output port connected to it is made
-the default value returned by `current-output-port',
-and the THUNK is called with no arguments.
-When the THUNK returns, the port is closed and the previous
-default is restored.  Returns the values yielded by THUNK.  If an
-escape procedure is used to escape from the continuation of these
-procedures, their behavior is implementation dependent."
-  (call-with-output-file file
-   (lambda (p) (with-output-to-port p thunk))
-   #:binary binary
-   #:encoding encoding))
-
-(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f))
-  "THUNK must be a procedure of no arguments, and FILE must be a
-string naming a file.  The effect is unspecified if the file already exists.
-The file is opened for output, an output port connected to it is made
-the default value returned by `current-error-port',
-and the THUNK is called with no arguments.
-When the THUNK returns, the port is closed and the previous
-default is restored.  Returns the values yielded by THUNK.  If an
-escape procedure is used to escape from the continuation of these
-procedures, their behavior is implementation dependent."
-  (call-with-output-file file
-   (lambda (p) (with-error-to-port p thunk))
-   #:binary binary
-   #:encoding encoding))
-
-(define (call-with-input-string string proc)
-  "Calls the one-argument procedure @var{proc} with a newly created
-input port from which @var{string}'s contents may be read.  The value
-yielded by the @var{proc} is returned."
-  (proc (open-input-string string)))
-
-(define (with-input-from-string string thunk)
-  "THUNK must be a procedure of no arguments.
-The test of STRING  is opened for
-input, an input port connected to it is made, 
-and the THUNK is called with no arguments.
-When the THUNK returns, the port is closed.
-Returns the values yielded by THUNK.  If an
-escape procedure is used to escape from the continuation of these
-procedures, their behavior is implementation dependent."
-  (call-with-input-string string
-   (lambda (p) (with-input-from-port p thunk))))
-
 (define (call-with-output-string proc)
   "Calls the one-argument procedure @var{proc} with a newly created output
 port.  When the function returns, the string composed of the characters
@@ -1625,18 +1430,6 @@ written into the port is returned."
     (proc port)
     (get-output-string port)))
 
-(define (with-output-to-string thunk)
-  "Calls THUNK and returns its output as a string."
-  (call-with-output-string
-   (lambda (p) (with-output-to-port p thunk))))
-
-(define (with-error-to-string thunk)
-  "Calls THUNK and returns its error output as a string."
-  (call-with-output-string
-   (lambda (p) (with-error-to-port p thunk))))
-
-(define the-eof-object (call-with-input-string "" (lambda (p) (read-char p))))
-
 
 
 ;;; {Booleans}
@@ -1758,95 +1551,9 @@ written into the port is returned."
 
 
 
-;;; {File Descriptors and Ports}
+;;; {C Environment}
 ;;;
 
-(define file-position ftell)
-(define* (file-set-position port offset #:optional (whence SEEK_SET))
-  (seek port offset whence))
-
-(define (move->fdes fd/port fd)
-  (cond ((integer? fd/port)
-         (dup->fdes fd/port fd)
-         (close fd/port)
-         fd)
-        (else
-         (primitive-move->fdes fd/port fd)
-         (set-port-revealed! fd/port 1)
-         fd/port)))
-
-(define (release-port-handle port)
-  (let ((revealed (port-revealed port)))
-    (if (> revealed 0)
-        (set-port-revealed! port (- revealed 1)))))
-
-(define dup->port
-  (case-lambda
-    ((port/fd mode)
-     (fdopen (dup->fdes port/fd) mode))
-    ((port/fd mode new-fd)
-     (let ((port (fdopen (dup->fdes port/fd new-fd) mode)))
-       (set-port-revealed! port 1)
-       port))))
-
-(define dup->inport
-  (case-lambda
-    ((port/fd)
-     (dup->port port/fd "r"))
-    ((port/fd new-fd)
-     (dup->port port/fd "r" new-fd))))
-
-(define dup->outport
-  (case-lambda
-    ((port/fd)
-     (dup->port port/fd "w"))
-    ((port/fd new-fd)
-     (dup->port port/fd "w" new-fd))))
-
-(define dup
-  (case-lambda
-    ((port/fd)
-     (if (integer? port/fd)
-         (dup->fdes port/fd)
-         (dup->port port/fd (port-mode port/fd))))
-    ((port/fd new-fd)
-     (if (integer? port/fd)
-         (dup->fdes port/fd new-fd)
-         (dup->port port/fd (port-mode port/fd) new-fd)))))
-
-(define (duplicate-port port modes)
-  (dup->port port modes))
-
-(define (fdes->inport fdes)
-  (let loop ((rest-ports (fdes->ports fdes)))
-    (cond ((null? rest-ports)
-           (let ((result (fdopen fdes "r")))
-             (set-port-revealed! result 1)
-             result))
-          ((input-port? (car rest-ports))
-           (set-port-revealed! (car rest-ports)
-                               (+ (port-revealed (car rest-ports)) 1))
-           (car rest-ports))
-          (else
-           (loop (cdr rest-ports))))))
-
-(define (fdes->outport fdes)
-  (let loop ((rest-ports (fdes->ports fdes)))
-    (cond ((null? rest-ports)
-           (let ((result (fdopen fdes "w")))
-             (set-port-revealed! result 1)
-             result))
-          ((output-port? (car rest-ports))
-           (set-port-revealed! (car rest-ports)
-                               (+ (port-revealed (car rest-ports)) 1))
-           (car rest-ports))
-          (else
-           (loop (cdr rest-ports))))))
-
-(define (port->fdes port)
-  (set-port-revealed! port (+ (port-revealed port) 1))
-  (fileno port))
-
 (define (setenv name value)
   (if value
       (putenv (string-append name "=" value))
@@ -4322,6 +4029,16 @@ when none is available, reading FILE-NAME with READER."
 
 
 
+;;; {Ports}
+;;;
+
+;; Allow code in (guile) to use port bindings.
+(module-use! the-root-module (resolve-interface '(ice-9 ports)))
+;; Allow users of (guile) to see port bindings.
+(module-use! the-scm-module (resolve-interface '(ice-9 ports)))
+
+
+
 ;;; SRFI-4 in the default environment.  FIXME: we should figure out how
 ;;; to deprecate this.
 ;;;
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
new file mode 100644
index 000000000..0dd1df718
--- /dev/null
+++ b/module/ice-9/ports.scm
@@ -0,0 +1,469 @@
+;;; Ports
+;;; Copyright (C) 2016 Free Software Foundation, Inc.
+;;;
+;;; This library is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU Lesser General Public License as
+;;; published by the Free Software Foundation, either version 3 of the
+;;; License, or (at your option) any later version.
+;;;
+;;; This library is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; Lesser General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU Lesser General Public
+;;; License along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;;
+;;; Implementation of input/output routines over ports.
+;;;
+;;; Note that loading this module overrides some core bindings; see the
+;;; `replace-bootstrap-bindings' invocation below for details.
+;;;
+;;; Code:
+
+
+(define-module (ice-9 ports)
+  #:export (;; Definitions from ports.c.
+            %port-property
+            %set-port-property!
+            current-input-port current-output-port
+            current-error-port current-warning-port
+            set-current-input-port set-current-output-port
+            set-current-error-port
+            port-mode
+            port?
+            input-port?
+            output-port?
+            port-closed?
+            eof-object?
+            close-port
+            close-input-port
+            close-output-port
+            ;; These two are currently defined by scm_init_ports; fix?
+            ;; %default-port-encoding
+            ;; %default-port-conversion-strategy
+            port-encoding
+            set-port-encoding!
+            port-conversion-strategy
+            set-port-conversion-strategy!
+            read-char
+            peek-char
+            unread-char
+            unread-string
+            setvbuf
+            drain-input
+            force-output
+            char-ready?
+            seek SEEK_SET SEEK_CUR SEEK_END
+            truncate-file
+            port-line
+            set-port-line!
+            port-column
+            set-port-column!
+            port-filename
+            set-port-filename!
+            port-for-each
+            flush-all-ports
+            %make-void-port
+
+            ;; Definitions from fports.c.
+            open-file
+            file-port?
+            port-revealed
+            set-port-revealed!
+            adjust-port-revealed!
+            ;; note: %file-port-name-canonicalization is used in boot-9
+
+            ;; Definitions from ioext.c.
+            ftell
+            redirect-port
+            dup->fdes
+            dup2
+            fileno
+            isatty?
+            fdopen
+            primitive-move->fdes
+            fdes->ports
+
+            ;; Definitions in Scheme
+            file-position
+            file-set-position
+            move->fdes
+            release-port-handle
+            dup->port
+            dup->inport
+            dup->outport
+            dup
+            duplicate-port
+            fdes->inport
+            fdes->outport
+            port->fdes
+            OPEN_READ OPEN_WRITE OPEN_BOTH
+            *null-device*
+            open-input-file
+            open-output-file
+            open-io-file
+            call-with-input-file
+            call-with-output-file
+            with-input-from-port
+            with-output-to-port
+            with-error-to-port
+            with-input-from-file
+            with-output-to-file
+            with-error-to-file
+            call-with-input-string
+            with-input-from-string
+            call-with-output-string
+            with-output-to-string
+            with-error-to-string
+            the-eof-object
+            inherit-print-state))
+
+(define (replace-bootstrap-bindings syms)
+  (for-each
+   (lambda (sym)
+     (let* ((var (module-variable the-scm-module sym))
+            (mod (current-module))
+            (iface (module-public-interface mod)))
+       (unless var (error "unbound in root module" sym))
+       (module-add! mod sym var)
+       (when (module-local-variable iface sym)
+         (module-add! iface sym var))))
+   syms))
+
+(replace-bootstrap-bindings '(open-file
+                              open-input-file
+                              set-port-encoding!
+                              eof-object?
+                              force-output
+                              call-with-output-string
+                              close-port
+                              current-error-port
+                              current-warning-port))
+
+(load-extension (string-append "libguile-" (effective-version))
+                "scm_init_ice_9_ports")
+(load-extension (string-append "libguile-" (effective-version))
+                "scm_init_ice_9_fports")
+(load-extension (string-append "libguile-" (effective-version))
+                "scm_init_ice_9_ioext")
+
+
+
+;;; Current ports as parameters.
+;;;
+
+(define current-input-port
+  (fluid->parameter %current-input-port-fluid
+                    (lambda (x)
+                      (unless (input-port? x)
+                        (error "expected an input port" x))
+                      x)))
+
+(define current-output-port
+  (fluid->parameter %current-output-port-fluid
+                    (lambda (x)
+                      (unless (output-port? x)
+                        (error "expected an output port" x))
+                      x)))
+
+(define current-error-port
+  (fluid->parameter %current-error-port-fluid
+                    (lambda (x)
+                      (unless (output-port? x)
+                        (error "expected an output port" x))
+                      x)))
+
+(define current-warning-port
+  (fluid->parameter %current-warning-port-fluid
+                    (lambda (x)
+                      (unless (output-port? x)
+                        (error "expected an output port" x))
+                      x)))
+
+
+
+
+;;; {File Descriptors and Ports}
+;;;
+
+(define file-position ftell)
+(define* (file-set-position port offset #:optional (whence SEEK_SET))
+  (seek port offset whence))
+
+(define (move->fdes fd/port fd)
+  (cond ((integer? fd/port)
+         (dup->fdes fd/port fd)
+         (close fd/port)
+         fd)
+        (else
+         (primitive-move->fdes fd/port fd)
+         (set-port-revealed! fd/port 1)
+         fd/port)))
+
+(define (release-port-handle port)
+  (let ((revealed (port-revealed port)))
+    (if (> revealed 0)
+        (set-port-revealed! port (- revealed 1)))))
+
+(define dup->port
+  (case-lambda
+    ((port/fd mode)
+     (fdopen (dup->fdes port/fd) mode))
+    ((port/fd mode new-fd)
+     (let ((port (fdopen (dup->fdes port/fd new-fd) mode)))
+       (set-port-revealed! port 1)
+       port))))
+
+(define dup->inport
+  (case-lambda
+    ((port/fd)
+     (dup->port port/fd "r"))
+    ((port/fd new-fd)
+     (dup->port port/fd "r" new-fd))))
+
+(define dup->outport
+  (case-lambda
+    ((port/fd)
+     (dup->port port/fd "w"))
+    ((port/fd new-fd)
+     (dup->port port/fd "w" new-fd))))
+
+(define dup
+  (case-lambda
+    ((port/fd)
+     (if (integer? port/fd)
+         (dup->fdes port/fd)
+         (dup->port port/fd (port-mode port/fd))))
+    ((port/fd new-fd)
+     (if (integer? port/fd)
+         (dup->fdes port/fd new-fd)
+         (dup->port port/fd (port-mode port/fd) new-fd)))))
+
+(define (duplicate-port port modes)
+  (dup->port port modes))
+
+(define (fdes->inport fdes)
+  (let loop ((rest-ports (fdes->ports fdes)))
+    (cond ((null? rest-ports)
+           (let ((result (fdopen fdes "r")))
+             (set-port-revealed! result 1)
+             result))
+          ((input-port? (car rest-ports))
+           (set-port-revealed! (car rest-ports)
+                               (+ (port-revealed (car rest-ports)) 1))
+           (car rest-ports))
+          (else
+           (loop (cdr rest-ports))))))
+
+(define (fdes->outport fdes)
+  (let loop ((rest-ports (fdes->ports fdes)))
+    (cond ((null? rest-ports)
+           (let ((result (fdopen fdes "w")))
+             (set-port-revealed! result 1)
+             result))
+          ((output-port? (car rest-ports))
+           (set-port-revealed! (car rest-ports)
+                               (+ (port-revealed (car rest-ports)) 1))
+           (car rest-ports))
+          (else
+           (loop (cdr rest-ports))))))
+
+(define (port->fdes port)
+  (set-port-revealed! port (+ (port-revealed port) 1))
+  (fileno port))
+
+;; Legacy interfaces.
+
+(define (set-current-input-port port)
+  "Set the current default input port to @var{port}."
+  (current-input-port port))
+
+(define (set-current-output-port port)
+  "Set the current default output port to @var{port}."
+  (current-output-port port))
+
+(define (set-current-error-port port)
+  "Set the current default error port to @var{port}."
+  (current-error-port port))
+
+
+;;;; high level routines
+
+
+;;; {High-Level Port Routines}
+;;;
+
+;; These are used to request the proper mode to open files in.
+;;
+(define OPEN_READ "r")
+(define OPEN_WRITE "w")
+(define OPEN_BOTH "r+")
+
+(define *null-device* "/dev/null")
+
+(define* (open-input-file
+          file #:key (binary #f) (encoding #f) (guess-encoding #f))
+  "Takes a string naming an existing file and returns an input port
+capable of delivering characters from the file.  If the file
+cannot be opened, an error is signalled."
+  (open-file file (if binary "rb" "r")
+             #:encoding encoding
+             #:guess-encoding guess-encoding))
+
+(define* (open-output-file file #:key (binary #f) (encoding #f))
+  "Takes a string naming an output file to be created and returns an
+output port capable of writing characters to a new file by that
+name.  If the file cannot be opened, an error is signalled.  If a
+file with the given name already exists, the effect is unspecified."
+  (open-file file (if binary "wb" "w")
+             #:encoding encoding))
+
+(define (open-io-file str) 
+  "Open file with name STR for both input and output."
+  (open-file str OPEN_BOTH))
+
+(define* (call-with-input-file
+          file proc #:key (binary #f) (encoding #f) (guess-encoding #f))
+  "PROC should be a procedure of one argument, and FILE should be a
+string naming a file.  The file must
+already exist. These procedures call PROC
+with one argument: the port obtained by opening the named file for
+input or output.  If the file cannot be opened, an error is
+signalled.  If the procedure returns, then the port is closed
+automatically and the values yielded by the procedure are returned.
+If the procedure does not return, then the port will not be closed
+automatically unless it is possible to prove that the port will
+never again be used for a read or write operation."
+  (let ((p (open-input-file file
+                            #:binary binary
+                            #:encoding encoding
+                            #:guess-encoding guess-encoding)))
+    (call-with-values
+      (lambda () (proc p))
+      (lambda vals
+        (close-input-port p)
+        (apply values vals)))))
+
+(define* (call-with-output-file file proc #:key (binary #f) (encoding #f))
+  "PROC should be a procedure of one argument, and FILE should be a
+string naming a file.  The behaviour is unspecified if the file
+already exists. These procedures call PROC
+with one argument: the port obtained by opening the named file for
+input or output.  If the file cannot be opened, an error is
+signalled.  If the procedure returns, then the port is closed
+automatically and the values yielded by the procedure are returned.
+If the procedure does not return, then the port will not be closed
+automatically unless it is possible to prove that the port will
+never again be used for a read or write operation."
+  (let ((p (open-output-file file #:binary binary #:encoding encoding)))
+    (call-with-values
+      (lambda () (proc p))
+      (lambda vals
+        (close-output-port p)
+        (apply values vals)))))
+
+(define (with-input-from-port port thunk)
+  (parameterize ((current-input-port port))
+    (thunk)))
+
+(define (with-output-to-port port thunk)
+  (parameterize ((current-output-port port))
+    (thunk)))
+
+(define (with-error-to-port port thunk)
+  (parameterize ((current-error-port port))
+    (thunk)))
+
+(define* (with-input-from-file
+          file thunk #:key (binary #f) (encoding #f) (guess-encoding #f))
+  "THUNK must be a procedure of no arguments, and FILE must be a
+string naming a file.  The file must already exist. The file is opened for
+input, an input port connected to it is made
+the default value returned by `current-input-port',
+and the THUNK is called with no arguments.
+When the THUNK returns, the port is closed and the previous
+default is restored.  Returns the values yielded by THUNK.  If an
+escape procedure is used to escape from the continuation of these
+procedures, their behavior is implementation dependent."
+  (call-with-input-file file
+   (lambda (p) (with-input-from-port p thunk))
+   #:binary binary
+   #:encoding encoding
+   #:guess-encoding guess-encoding))
+
+(define* (with-output-to-file file thunk #:key (binary #f) (encoding #f))
+  "THUNK must be a procedure of no arguments, and FILE must be a
+string naming a file.  The effect is unspecified if the file already exists.
+The file is opened for output, an output port connected to it is made
+the default value returned by `current-output-port',
+and the THUNK is called with no arguments.
+When the THUNK returns, the port is closed and the previous
+default is restored.  Returns the values yielded by THUNK.  If an
+escape procedure is used to escape from the continuation of these
+procedures, their behavior is implementation dependent."
+  (call-with-output-file file
+   (lambda (p) (with-output-to-port p thunk))
+   #:binary binary
+   #:encoding encoding))
+
+(define* (with-error-to-file file thunk #:key (binary #f) (encoding #f))
+  "THUNK must be a procedure of no arguments, and FILE must be a
+string naming a file.  The effect is unspecified if the file already exists.
+The file is opened for output, an output port connected to it is made
+the default value returned by `current-error-port',
+and the THUNK is called with no arguments.
+When the THUNK returns, the port is closed and the previous
+default is restored.  Returns the values yielded by THUNK.  If an
+escape procedure is used to escape from the continuation of these
+procedures, their behavior is implementation dependent."
+  (call-with-output-file file
+   (lambda (p) (with-error-to-port p thunk))
+   #:binary binary
+   #:encoding encoding))
+
+(define (call-with-input-string string proc)
+  "Calls the one-argument procedure @var{proc} with a newly created
+input port from which @var{string}'s contents may be read.  The value
+yielded by the @var{proc} is returned."
+  (proc (open-input-string string)))
+
+(define (with-input-from-string string thunk)
+  "THUNK must be a procedure of no arguments.
+The test of STRING  is opened for
+input, an input port connected to it is made, 
+and the THUNK is called with no arguments.
+When the THUNK returns, the port is closed.
+Returns the values yielded by THUNK.  If an
+escape procedure is used to escape from the continuation of these
+procedures, their behavior is implementation dependent."
+  (call-with-input-string string
+   (lambda (p) (with-input-from-port p thunk))))
+
+(define (call-with-output-string proc)
+  "Calls the one-argument procedure @var{proc} with a newly created output
+port.  When the function returns, the string composed of the characters
+written into the port is returned."
+  (let ((port (open-output-string)))
+    (proc port)
+    (get-output-string port)))
+
+(define (with-output-to-string thunk)
+  "Calls THUNK and returns its output as a string."
+  (call-with-output-string
+   (lambda (p) (with-output-to-port p thunk))))
+
+(define (with-error-to-string thunk)
+  "Calls THUNK and returns its error output as a string."
+  (call-with-output-string
+   (lambda (p) (with-error-to-port p thunk))))
+
+(define the-eof-object (call-with-input-string "" (lambda (p) (read-char p))))
+
+(define (inherit-print-state old-port new-port)
+  (if (get-print-state old-port)
+      (port-with-print-state new-port (get-print-state old-port))
+      new-port))
diff --git a/module/ice-9/psyntax-pp.scm b/module/ice-9/psyntax-pp.scm
index 6029f0565..0d30b7c3f 100644
--- a/module/ice-9/psyntax-pp.scm
+++ b/module/ice-9/psyntax-pp.scm
@@ -3246,7 +3246,7 @@
                  (set-port-encoding! p (let ((t enc)) (if t t "UTF-8")))
                  (let f ((x (read p)) (result '()))
                    (if (eof-object? x)
-                     (begin (close-input-port p) (reverse result))
+                     (begin (close-port p) (reverse result))
                      (f (read p) (cons (datum->syntax k x) result)))))))))
         (let ((src (syntax-source x)))
           (let ((file (if src (assq-ref src 'filename) #f)))
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index c9c309ae1..0bc602431 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -3183,7 +3183,7 @@
                   (result '()))
             (if (eof-object? x)
                 (begin
-                  (close-input-port p)
+                  (close-port p)
                   (reverse result))
                 (f (read p)
                    (cons (datum->syntax k x) result)))))))