diff --git a/libguile/ChangeLog b/libguile/ChangeLog index f03029aa2..e08e98456 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,5 +1,23 @@ +Sun Jul 20 03:55:49 1997 Gary Houston + + * 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 + * 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. diff --git a/libguile/filesys.c b/libguile/filesys.c index 30234a87f..f9d4c4070 100644 --- a/libguile/filesys.c +++ b/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} */ diff --git a/libguile/filesys.h b/libguile/filesys.h index e8e3fe773..3c251919b 100644 --- a/libguile/filesys.h +++ b/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)); diff --git a/libguile/fluids.c b/libguile/fluids.c index fdb107863..e71cb5bbf 100644 --- a/libguile/fluids.c +++ b/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; } diff --git a/libguile/fports.c b/libguile/fports.c index ff232f428..9354c5ad0 100644 --- a/libguile/fports.c +++ b/libguile/fports.c @@ -103,24 +103,27 @@ scm_setbuf0 (port) 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 +/* Move ports with the specified file descriptor to new descriptors, + * reseting the revealed count to 0. + * Should be called with SCM_DEFER_INTS active. */ -long -scm_mode_bits (modes) - char *modes; +void +scm_evict_ports (fd) + int fd; { - 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)); -} + 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)); + } + } +} /* 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)); diff --git a/libguile/fports.h b/libguile/fports.h index b8834462f..1323759b5 100644 --- a/libguile/fports.h +++ b/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 */ diff --git a/libguile/ioext.c b/libguile/ioext.c index cc7430afa..0f094f349 100644 --- a/libguile/ioext.c +++ b/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); diff --git a/libguile/ioext.h b/libguile/ioext.h index d3d2a37a7..194c74a23 100644 --- a/libguile/ioext.h +++ b/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)); diff --git a/libguile/ports.c b/libguile/ports.c index 1937419f2..b545ad3a1 100644 --- a/libguile/ports.c +++ b/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); diff --git a/libguile/ports.h b/libguile/ports.h index eb81d684e..120c443e6 100644 --- a/libguile/ports.h +++ b/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));