* fluids.c (next_fluid_num): don't do

SCM_THREAD_CRITICAL_SECTION_START/END unless USE_THREADS is defined.

* ports.h: prototypes too.
* ports.c (scm_mode_bits, scm_port_mode): moved from fports.c.

* fports.h: prototype too.
* fports.c (scm_evict_ports): moved from ioext.c.

* ports.c (scm_close_port): return a boolean instead of unspecified.
throw an error if an error other than EBADF occurs.

* filesys.h: scm_close prototype.
* filesys.c (scm_close): new procedure, can close file descriptors
and ports (scsh compatible).

* ports.c (scm_flush_all_ports): SCM_PROC incorrectly allowed an
optional argument.

libguile/ChangeLog

@@ -1,5 +1,23 @@
+Sun Jul 20 03:55:49 1997  Gary Houston  <ghouston@actrix.gen.nz>
+
+	* fluids.c (next_fluid_num): don't do
+	SCM_THREAD_CRITICAL_SECTION_START/END unless USE_THREADS is defined.
+
+	* ports.h: prototypes too.
+	* ports.c (scm_mode_bits, scm_port_mode): moved from fports.c.
+
+	* fports.h: prototype too.
+	* fports.c (scm_evict_ports): moved from ioext.c.
+
 Sat Jul 19 04:56:52 1997  Gary Houston  <ghouston@actrix.gen.nz>
 
+	* ports.c (scm_close_port): return a boolean instead of unspecified.
+	throw an error if an error other than EBADF occurs.
+
+	* filesys.h: scm_close prototype.
+	* filesys.c (scm_close): new procedure, can close file descriptors
+	and ports (scsh compatible).
+
 	* ports.c (scm_flush_all_ports): SCM_PROC incorrectly allowed an
 	optional argument.
 

libguile/filesys.c

@@ -261,6 +261,28 @@ scm_open (path, flags, mode)
   return newpt;
 }
 
+SCM_PROC (s_close, "close", 1, 0, 0, scm_close);
+SCM
+scm_close (SCM fd_or_port)
+{
+  int rv;
+  int fd;
+
+  if (SCM_NIMP (fd_or_port) && SCM_PORTP (fd_or_port))
+    return scm_close_port (fd_or_port);
+  SCM_ASSERT (SCM_INUMP (fd_or_port), fd_or_port, SCM_ARG1, s_close);
+  fd = SCM_INUM (fd_or_port);
+  SCM_DEFER_INTS;
+  scm_evict_ports (fd);		/* see scsh manual.  */
+  SCM_SYSCALL (rv = close (SCM_INUM (fd)));
+  /* following scsh, closing an already closed file descriptor is
+     not an error.  */
+  if (rv < 0 && errno != EBADF)
+    scm_syserror (s_close);
+  SCM_ALLOW_INTS;
+  return (rv < 0) ? SCM_BOOL_F : SCM_BOOL_T;
+}
+
 
 /* {Files}
  */

libguile/filesys.h

@@ -58,6 +58,7 @@ extern SCM scm_chown SCM_P ((SCM path, SCM owner, SCM group));
 extern SCM scm_chmod SCM_P ((SCM port_or_path, SCM mode));
 extern SCM scm_umask SCM_P ((SCM mode));
 extern SCM scm_open SCM_P ((SCM path, SCM flags, SCM mode));
+extern SCM scm_close (SCM fd_or_port);
 extern SCM scm_stat SCM_P ((SCM fd_or_path));
 extern SCM scm_link SCM_P ((SCM oldpath, SCM newpath));
 extern SCM scm_rename SCM_P ((SCM oldname, SCM newname));

libguile/fluids.c

@@ -118,9 +118,13 @@ static
 int next_fluid_num ()
 {
   int n;
+#ifdef USE_THREADS
   SCM_THREAD_CRITICAL_SECTION_START;
+#endif
   n = n_fluids++;
+#ifdef USE_THREADS
   SCM_THREAD_CRITICAL_SECTION_END;
+#endif
   return n;
 }
 

libguile/fports.c

@@ -103,24 +103,27 @@ scm_setbuf0 (port)
   return SCM_UNSPECIFIED;
 }
 
-/* Return the flags that characterize a port based on the mode
+/* Move ports with the specified file descriptor to new descriptors,
- * string used to open a file for that port.
+ * reseting the revealed count to 0.
- *
+ * Should be called with SCM_DEFER_INTS active.
- * See PORT FLAGS in scm.h
  */
 
-long
+void
-scm_mode_bits (modes)
+scm_evict_ports (fd)
-     char *modes;
+     int fd;
 {
-  return (SCM_OPN
+  int i;
-	  | (strchr (modes, 'r') || strchr (modes, '+') ? SCM_RDNG : 0)
-	  | (   strchr (modes, 'w')
-	     || strchr (modes, 'a')
-	     || strchr (modes, '+') ? SCM_WRTNG : 0)
-	  | (strchr (modes, '0') ? SCM_BUF0 : 0));
-}
 
+  for (i = 0; i < scm_port_table_size; i++)
+    {
+      if (SCM_FPORTP (scm_port_table[i]->port)
+	  && fileno ((FILE *)SCM_STREAM (scm_port_table[i]->port)) == fd)
+	{
+	  scm_setfileno ((FILE *)SCM_STREAM (scm_port_table[i]->port), dup (fd));
+	  scm_set_port_revealed_x (scm_port_table[i]->port, SCM_MAKINUM (0));
+	}
+    }
+}
 
 /* scm_open_file
  * Return a new port open on a given file.
@@ -217,33 +220,6 @@ scm_stdio_to_port (file, mode, name)
 }
 
 
-/* Return the mode flags from an open port.
- * Some modes such as "append" are only used when opening
- * a file and are not returned here.  */
-
-SCM_PROC(s_port_mode, "port-mode", 1, 0, 0, scm_port_mode);
-
-SCM
-scm_port_mode (port)
-     SCM port;
-{
-  char modes[3];
-  modes[0] = '\0';
-  SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_port_mode);  
-  if (SCM_CAR (port) & SCM_RDNG) {
-    if (SCM_CAR (port) & SCM_WRTNG)
-      strcpy (modes, "r+");
-    else
-      strcpy (modes, "r");
-  }
-  else if (SCM_CAR (port) & SCM_WRTNG)
-    strcpy (modes, "w");
-  if (SCM_CAR (port) & SCM_BUF0)
-    strcat (modes, "0");
-  return scm_makfromstr (modes, strlen (modes), 0);
-}
-
-
 
 static int prinfport SCM_P ((SCM exp, SCM port, scm_print_state *pstate));
 

libguile/fports.h

@@ -56,10 +56,9 @@ extern scm_ptobfuns scm_pipob;
 
 
 extern SCM scm_setbuf0 SCM_P ((SCM port));
-extern long scm_mode_bits SCM_P ((char *modes));
+extern void scm_evict_ports SCM_P ((int fd));
 extern SCM scm_open_file SCM_P ((SCM filename, SCM modes));
 extern SCM scm_stdio_to_port SCM_P ((FILE *file, char *name, char *modes));
-extern SCM scm_port_mode SCM_P ((SCM port));
 extern void scm_init_fports SCM_P ((void));
 
 #endif  /* FPORTSH */

libguile/ioext.c

@@ -425,28 +425,6 @@ scm_setfileno (fs, fd)
 #endif
 }
 
-/* Move ports with the specified file descriptor to new descriptors,
- * reseting the revealed count to 0.
- * Should be called with SCM_DEFER_INTS active.
- */
-
-void
-scm_evict_ports (fd)
-     int fd;
-{
-  int i;
-
-  for (i = 0; i < scm_port_table_size; i++)
-    {
-      if (SCM_FPORTP (scm_port_table[i]->port)
-	  && fileno ((FILE *)SCM_STREAM (scm_port_table[i]->port)) == fd)
-	{
-	  scm_setfileno ((FILE *)SCM_STREAM (scm_port_table[i]->port), dup (fd));
-	  scm_set_port_revealed_x (scm_port_table[i]->port, SCM_MAKINUM (0));
-	}
-    }
-}
-
 /* Return a list of ports using a given file descriptor.  */
 SCM_PROC(s_fdes_to_ports, "fdes->ports", 1, 0, 0, scm_fdes_to_ports);
 

libguile/ioext.h

@@ -60,7 +60,6 @@ extern SCM scm_isatty_p SCM_P ((SCM port));
 extern SCM scm_fdopen SCM_P ((SCM fdes, SCM modes));
 extern SCM scm_primitive_move_to_fdes SCM_P ((SCM port, SCM fd));
 extern void scm_setfileno SCM_P ((FILE *fs, int fd));
-extern void scm_evict_ports SCM_P ((int fd));
 extern SCM scm_fdes_to_ports SCM_P ((SCM fd));
 extern void scm_init_ioext SCM_P ((void));
 

libguile/ports.c

@@ -351,8 +351,55 @@ scm_set_port_revealed_x (port, rcount)
   return SCM_UNSPECIFIED;
 }
 
+/* Return the flags that characterize a port based on the mode
+ * string used to open a file for that port.
+ *
+ * See PORT FLAGS in scm.h
+ */
+
+long
+scm_mode_bits (modes)
+     char *modes;
+{
+  return (SCM_OPN
+	  | (strchr (modes, 'r') || strchr (modes, '+') ? SCM_RDNG : 0)
+	  | (   strchr (modes, 'w')
+	     || strchr (modes, 'a')
+	     || strchr (modes, '+') ? SCM_WRTNG : 0)
+	  | (strchr (modes, '0') ? SCM_BUF0 : 0));
+}
+
+
+/* Return the mode flags from an open port.
+ * Some modes such as "append" are only used when opening
+ * a file and are not returned here.  */
+
+SCM_PROC(s_port_mode, "port-mode", 1, 0, 0, scm_port_mode);
+
+SCM
+scm_port_mode (port)
+     SCM port;
+{
+  char modes[3];
+  modes[0] = '\0';
+  SCM_ASSERT (SCM_NIMP (port) && SCM_OPPORTP (port), port, SCM_ARG1, s_port_mode);  
+  if (SCM_CAR (port) & SCM_RDNG) {
+    if (SCM_CAR (port) & SCM_WRTNG)
+      strcpy (modes, "r+");
+    else
+      strcpy (modes, "r");
+  }
+  else if (SCM_CAR (port) & SCM_WRTNG)
+    strcpy (modes, "w");
+  if (SCM_CAR (port) & SCM_BUF0)
+    strcat (modes, "0");
+  return scm_makfromstr (modes, strlen (modes), 0);
+}
+
+
 /* scm_close_port
  * Call the close operation on a port object. 
+ * see also scm_close.
  */
 SCM_PROC(s_close_port, "close-port", 1, 0, 0, scm_close_port);
 
@@ -361,17 +408,26 @@ scm_close_port (port)
      SCM port;
 {
   scm_sizet i;
+  int rv;
+
   SCM_ASSERT (SCM_NIMP (port) && SCM_PORTP (port), port, SCM_ARG1, s_close_port);
   if (SCM_CLOSEDP (port))
-    return SCM_UNSPECIFIED;
+    return SCM_BOOL_F;
   i = SCM_PTOBNUM (port);
   SCM_DEFER_INTS;
   if (scm_ptobs[i].fclose)
-    SCM_SYSCALL ((scm_ptobs[i].fclose) (SCM_STREAM (port)));
+    {
+      SCM_SYSCALL (rv = (scm_ptobs[i].fclose) (SCM_STREAM (port)));
+      /* ports with a closed file descriptor can be reclosed without error.  */
+      if (rv < 0 && errno != EBADF)
+	scm_syserror (s_close_port);
+    }
+  else
+    rv = 0;
   scm_remove_from_port_table (port);
   SCM_SETAND_CAR (port, ~SCM_OPN);
   SCM_ALLOW_INTS;
-  return SCM_UNSPECIFIED;
+  return (rv < 0) ? SCM_BOOL_F : SCM_BOOL_T;
 }
 
 SCM_PROC(s_close_all_ports_except, "close-all-ports-except", 0, 0, 1, scm_close_all_ports_except);

libguile/ports.h

@@ -177,6 +177,8 @@ extern SCM scm_pt_member SCM_P ((SCM member));
 extern int scm_revealed_count SCM_P ((SCM port));
 extern SCM scm_port_revealed SCM_P ((SCM port));
 extern SCM scm_set_port_revealed_x SCM_P ((SCM port, SCM rcount));
+extern long scm_mode_bits SCM_P ((char *modes));
+extern SCM scm_port_mode SCM_P ((SCM port));
 extern SCM scm_close_port SCM_P ((SCM port));
 extern SCM scm_close_all_ports_except SCM_P ((SCM ports));
 extern SCM scm_input_port_p SCM_P ((SCM x));