Import Upstream version 5d6upstream/5d6

1 files changed, 90 insertions, 14 deletions

diff --git a/ioext.c b/ioext.c
index 1d7f68b..62ec8b2 100644
--- a/ioext.c
+++ b/ioext.c
@@ -15,26 +15,26 @@
  * the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA.
  *
  * As a special exception, the Free Software Foundation gives permission
- * for additional uses of the text contained in its release of GUILE.
+ * for additional uses of the text contained in its release of SCM.
  *
- * The exception is that, if you link the GUILE library with other files
+ * The exception is that, if you link the SCM library with other files
  * to produce an executable, this does not by itself cause the
  * resulting executable to be covered by the GNU General Public License.
  * Your use of that executable is in no way restricted on account of
- * linking the GUILE library code into it.
+ * linking the SCM library code into it.
  *
  * This exception does not however invalidate any other reasons why
  * the executable file might be covered by the GNU General Public License.
  *
  * This exception applies only to the code released by the
- * Free Software Foundation under the name GUILE.  If you copy
+ * Free Software Foundation under the name SCM.  If you copy
  * code from other Free Software Foundation releases into a copy of
- * GUILE, as the General Public License permits, the exception does
+ * SCM, as the General Public License permits, the exception does
  * not apply to the code that you add in this way.  To avoid misleading
  * anyone as to the status of such modified files, you must delete
  * this exception notice from them.
  *
- * If you write modifications of your own for GUILE, it is your choice
+ * If you write modifications of your own for SCM, it is your choice
  * whether to permit this exception to apply to your modifications.
  * If you do not wish that, delete this exception notice.
  */
@@ -70,8 +70,11 @@ SCM	stat2scm P((struct stat *stat_temp));
 #ifdef __FreeBSD__
 # include <unistd.h>
 #endif
+#ifdef __OpenBSD__
+# include <unistd.h>
+#endif
 /* added by Denys Duchier */
-#ifdef __svr4__
+#ifdef __SVR4
 # include <sys/types.h>
 # include <unistd.h>
 #endif
@@ -81,6 +84,12 @@ SCM	stat2scm P((struct stat *stat_temp));
 #ifdef GO32
 # include <unistd.h>
 #endif
+#ifdef __osf__
+# include <unistd.h>
+#endif
+#ifdef __MACH__
+# include <unistd.h>
+#endif
 
 #ifndef STDC_HEADERS
 	int chdir P((const char *path));
@@ -198,6 +207,20 @@ SCM file_set_position(port, pos)
 {
 	SCM ans;
 	ASSERT(NIMP(port) && OPFPORTP(port), port, ARG1, s_file_set_pos);
+#ifndef RECKLESS
+	if (TRACKED & SCM_PORTFLAGS(port)) {
+	  if (INUM0==pos) {
+	    int i = SCM_PORTNUM(port);
+	    scm_port_table[i].line = 1L;
+	    scm_port_table[i].col = 1;
+	  }
+	  else {
+	    if (2 <= verbose)
+	      scm_warn("Setting file position for tracked port: ", "", port);
+	    SCM_PORTFLAGS(port) &= (~TRACKED);
+	  }
+	}
+#endif
 	CLRDY(port);		/* Clear ungetted char */
 	SYSCALL(ans = (fseek(STREAM(port), INUM(pos), 0)) ? BOOL_F : BOOL_T;);
 #ifdef HAVE_PIPE
@@ -217,8 +240,9 @@ SCM reopen_file(filename, modes, port)
   char cmodes[4];
   long flags;
   ASSERT(NIMP(filename) && STRINGP(filename), filename, ARG1, s_reopen_file);
-  ASSERT(NIMP(modes) && STRINGP(modes), modes, ARG2, s_reopen_file);
+  ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_reopen_file);
   flags =  mode_bits(CHARS(modes), cmodes);
+  ASSERT(flags, modes, ARG2, s_reopen_file);
   DEFER_INTS;
   ASSERT(NIMP(port) && FPORTP(port) && OPENP(port), port, ARG3, s_reopen_file);
   SCM_OPENCALL(f = freopen(CHARS(filename), cmodes, STREAM(port)));
@@ -227,14 +251,13 @@ SCM reopen_file(filename, modes, port)
     return BOOL_F;
   }
   else {
-    SETSTREAM(port, f);
     SCM_PORTFLAGS(port) = flags;
-    CAR(port) = scm_port_entry(tc16_fport, flags);
+    SCM_SETFLAGS(port, flags);
     if (BUF0 & flags)
       i_setbuf0(port);
+    SCM_PORTDATA(port) = filename;
   }
   ALLOW_INTS;
-  SCM_PORTDATA(port) = filename;
   return port;
 }
 
@@ -250,19 +273,25 @@ SCM l_dup(oldpt, modes)
   FILE *f;
   SCM newpt;
   ASSERT(NIMP(oldpt) && OPFPORTP(oldpt), oldpt, ARG1, s_dup);
-  ASSERT(NIMP(modes) && STRINGP(modes), modes, ARG2, s_dup);
+  ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_dup);
   flags = mode_bits(CHARS(modes), cmodes);
+  ASSERT(flags, modes, ARG2, s_dup);
   NEWCELL(newpt);
   DEFER_INTS;
   SCM_OPENCALL(tfd = dup(fileno(STREAM(oldpt))));
   if (-1==tfd) {ALLOW_INTS;return BOOL_F;};
   SYSCALL(f = fdopen(tfd, cmodes););
   if (!f) {
+    int lerrno = errno;
     close(tfd);
+    errno = lerrno;
+#  ifdef EINVAL
+    if (lerrno==EINVAL) wta(modes, (char *)ARG2, s_dup);
+#  endif
     wta(MAKINUM(tfd), (char *)NALLOC, s_port_type);
   }
-  SETSTREAM(newpt, f);
-  CAR(newpt) = scm_port_entry(tc16_fport, flags);
+  newpt = scm_port_entry(f, tc16_fport, flags);
+  SCM_PORTDATA(newpt) = SCM_PORTDATA(oldpt);
   if (BUF0 & flags)
     i_setbuf0(newpt);
   ALLOW_INTS;
@@ -690,6 +719,49 @@ static iproc subr2s[] = {
 #endif
 	{0, 0}};
 
+#include <fcntl.h>		/* for O_RDONLY, O_RDWR, O_EXCL */
+#ifdef O_EXCL
+SCM scm_try_create_file(fname, modes, perms)
+     SCM fname, modes, perms;
+{
+  SCM port;
+  FILE *f;
+  char cmodes[4];
+  long flags;
+  int fd, fdflags = O_CREAT | O_EXCL;
+# ifdef S_IROTH
+  mode_t cperms = S_IRUSR | S_IWUSR | S_IRGRP | S_IWGRP | S_IROTH | S_IWOTH;
+# else
+  int cperms = 0666;
+# endif
+  ASSERT(NIMP(fname) && STRINGP(fname), fname, ARG1, s_try_create_file);
+  ASSERT(NIMP(modes) && (STRINGP(modes) || SYMBOLP(modes)), modes, ARG2, s_try_create_file);
+  if (NNULLP(perms)) {
+    perms = CAR(perms);
+    ASSERT(INUMP(perms), perms, ARG3, s_try_create_file);
+# ifdef S_IROTH
+    cperms = (mode_t)INUM(perms);
+# else
+    cperms = INUM(perms);
+# endif
+  }
+  flags = mode_bits(CHARS(modes), cmodes);
+  ASSERT(flags, modes, ARG2, s_try_create_file);
+  fdflags |= (RDNG & flags) ? O_RDWR : O_WRONLY;
+  DEFER_INTS;
+  SCM_OPENCALL(fd = open(CHARS(fname), fdflags, cperms));
+  if (fd >= 0 && (f = fdopen(fd, cmodes))) {
+    port = scm_port_entry(f, tc16_fport, flags);
+    if (BUF0 & flags) i_setbuf0(port);
+    SCM_PORTDATA(port) = fname;
+  }
+  else
+    port = BOOL_F;
+  ALLOW_INTS;
+  return port;
+}
+#endif
+
 static iproc subr2os[] = {
 	{s_file_set_pos, file_set_position},
 	{s_read_line1, read_line1},
@@ -702,6 +774,9 @@ void init_ioext()
 	init_iprocs(subr1s, tc7_subr_1);
 	init_iprocs(subr2os, tc7_subr_2o);
 	init_iprocs(subr2s, tc7_subr_2);
+#ifdef O_EXCL
+	make_subr(s_try_create_file, tc7_lsubr_2, scm_try_create_file);
+#endif
 	make_subr(s_reopen_file, tc7_subr_3, reopen_file);
 #ifndef THINK_C
 # ifndef MCH_AMIGA
@@ -733,6 +808,7 @@ void init_ioext()
 	add_feature("i/o-extensions");
 	add_feature("line-i/o");
 	scm_ldstr("\n\
+(define (file-exists? path) (access path \"r\"))\n\
 (define (directory-for-each proc dirname . args)\n\
   (define dir (opendir (if (symbol? dirname)\n\
 			   (symbol->string dirname)\n\