From 879f4fa041cfdefee655eb877f1a91f86a9c62b7 Mon Sep 17 00:00:00 2001
From: Bryan Newbold <bnewbold@robocracy.org>
Date: Fri, 3 Mar 2017 00:56:40 -0800
Subject: New upstream version 5f2

---
 ioext.c | 64 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 61 insertions(+), 3 deletions(-)
 mode change 100644 => 100755 ioext.c

(limited to 'ioext.c')

diff --git a/ioext.c b/ioext.c
old mode 100644
new mode 100755
index 2cc4dc0..abc0fd2
--- a/ioext.c
+++ b/ioext.c
@@ -569,6 +569,54 @@ SCM ren_fil(oldname, newname)
   return ans;
 #endif
 }
+static char s_copy_file[] = "copy-file";
+SCM scm_copy_file(oldname, newname)
+     SCM oldname, newname;
+{
+  ASRTER(NIMP(oldname) && STRINGP(oldname), oldname, ARG1, s_copy_file);
+  ASRTER(NIMP(newname) && STRINGP(newname), newname, ARG2, s_copy_file);
+  {
+    FILE* fin = fopen(CHARS(oldname), "rb");
+    FILE* fout;
+    unsigned char buff[1024];
+    int cnt, retval = BOOL_T;
+    if (!fin) return BOOL_F;
+    fout = fopen(CHARS(newname), "wb");
+    if (!fout) {fclose(fin); return BOOL_F;}
+    {
+#ifndef THINK_C
+# ifndef MCH_AMIGA
+#  ifndef vms
+      int i;
+      struct stat stat_temp;
+      struct utimbuf utm_tmp;
+      SYSCALL(i = fstat(fileno(fin), &stat_temp););
+#  endif
+# endif
+#endif
+      while ((cnt = fread(buff, 1, 1024, fin))) {
+	if ((cnt > 0) && (cnt != fwrite(buff, 1, cnt, fout))) retval = BOOL_F;
+      }
+      if (!feof(fin)) retval = BOOL_F;
+      fclose(fin);
+      fclose(fout);
+#ifndef THINK_C
+# ifndef MCH_AMIGA
+#  ifndef vms
+      if (!i) {
+	utm_tmp.actime = stat_temp.st_atime;
+	utm_tmp.modtime = stat_temp.st_mtime;
+	SYSCALL(i = utime(CHARS(newname), &utm_tmp););
+      }
+      if (i) return BOOL_F;
+#  endif
+# endif
+#endif
+      return retval;
+    }
+  }
+}
+
 static char s_fileno[] = "fileno";
 SCM l_fileno(port)
      SCM port;
@@ -754,6 +802,7 @@ static iproc subr1os[] = {
 
 static iproc subr2s[] = {
 	{s_ren_fil, ren_fil},
+	{s_copy_file, scm_copy_file},
 #ifndef macintosh
 	{s_access, l_access},
 #endif
@@ -859,9 +908,10 @@ void init_ioext()
 	scm_ldstr("\n\
 (define (file-exists? path) (access path \"r\"))\n\
 (define (make-directory path)\n\
-  (define umsk (umask 18))\n\
-  (umask umsk)\n\
-  (mkdir path (logxor #o777 umsk)))\n\
+  (define umsk (umask #o022))\n\
+  (let ((success? (mkdir path (logxor #o777 umsk))))\n\
+    (umask umsk)\n\
+    success?))\n\
 (define current-directory getcwd)\n\
 (define (directory-for-each proc dirname . args)\n\
   (define dir (opendir (if (symbol? dirname)\n\
@@ -884,6 +934,14 @@ void init_ioext()
 	(do ((filename (readdir dir) (readdir dir)))\n\
 	    ((not filename) (closedir dir))\n\
 	  (and (selector filename) (proc filename))))))\n\
+(define (directory*-for-each proc path-glob)\n\
+  (define dir (pathname->vicinity path-glob))\n\
+  (let ((glob (substring path-glob\n\
+			 (string-length dir)\n\
+			 (string-length path-glob))))\n\
+    (directory-for-each proc\n\
+			(if (equal? \"\" dir) \".\" dir)\n\
+			glob)))\n\
 (define (system->line command . tmp)\n\
   (require 'filename)\n\
   (cond ((null? tmp)\n\
-- 
cgit v1.2.3