view patches/guile-2.0.0-mingw-compile-binary.patch @ 6506:6c1f7f6fb878

mingw:guile: another go-path fix in boot-9.scm. Fixes compile of (user).
author Jan Nieuwenhuizen <janneke@gnu.org>
date Sat, 19 Mar 2011 10:01:26 +0100
parents ba506e08a7ce
children
line wrap: on
line source

--- guile-1.9.15/module/system/base/compile.scm~	2011-02-15 10:54:38.483090146 +0100
+++ guile-1.9.15/module/system/base/compile.scm	2011-03-03 09:15:24.742333809 +0100
@@ -51,7 +51,7 @@
 ;; (put 'call-with-output-file/atomic 'scheme-indent-function 1)
 (define* (call-with-output-file/atomic filename proc #:optional reference)
   (let* ((template (string-append filename ".XXXXXX"))
-         (tmp (mkstemp! template)))
+         (tmp (mkstemp! template "w+b")))
     (call-once
      (lambda ()
        (with-throw-handler #t
--- guile-1.9.15/libguile/posix.h~	2010-12-14 19:15:17.000000000 +0100
+++ guile-1.9.15/libguile/posix.h	2011-03-03 09:21:46.058955734 +0100
@@ -67,7 +67,7 @@
 SCM_API SCM scm_uname (void);
 SCM_API SCM scm_environ (SCM env);
 SCM_API SCM scm_tmpnam (void);
-SCM_API SCM scm_mkstemp (SCM tmpl);
+SCM_API SCM scm_mkstemp (SCM tmpl, SCM mode);
 SCM_API SCM scm_tmpfile (void);
 SCM_API SCM scm_open_pipe (SCM pipestr, SCM modes);
 SCM_API SCM scm_close_pipe (SCM port);
--- guile-1.9.15/libguile/posix.c~	2011-01-29 21:36:58.000000000 +0100
+++ guile-1.9.15/libguile/posix.c	2011-03-03 09:14:46.745199721 +0100
@@ -1329,8 +1329,8 @@
 extern int mkstemp (char *);
 #endif
 
-SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 0, 0,
-	    (SCM tmpl),
+SCM_DEFINE (scm_mkstemp, "mkstemp!", 1, 1, 0,
+	    (SCM tmpl, SCM mode),
 	    "Create a new unique file in the file system and return a new\n"
 	    "buffered port open for reading and writing to the file.\n"
 	    "\n"
@@ -1338,6 +1338,8 @@
 	    "created: it must end with @samp{XXXXXX} and those @samp{X}s\n"
 	    "will be changed in the string to return the name of the file.\n"
 	    "(@code{port-filename} on the port also gives the name.)\n"
+	    "The optional @var{mode}, if given, is a string specifying the\n"
+	    "open mode of the file, e.g. w+b\n"
 	    "\n"
 	    "POSIX doesn't specify the permissions mode of the file, on GNU\n"
 	    "and most systems it's @code{#o600}.  An application can use\n"
@@ -1354,7 +1356,12 @@
 {
   char *c_tmpl;
   int rv;
-  
+  SCM port;
+  char *c_mode = "w+";
+
+  if (!SCM_UNBNDP (mode))
+    c_mode = scm_to_locale_string (mode);
+
   scm_dynwind_begin (0);
 
   c_tmpl = scm_to_locale_string (tmpl);
@@ -1369,7 +1376,10 @@
 			tmpl, SCM_INUM0);
 
   scm_dynwind_end ();
-  return scm_fdes_to_port (rv, "w+", tmpl);
+  port = scm_fdes_to_port (rv, c_mode, tmpl);
+  if (!SCM_UNBNDP (mode))
+    free (c_mode);
+  return port;
 }
 #undef FUNC_NAME
 
--- guile-2.0.0.1/libguile/ports.h~	2011-03-13 23:21:07.000000000 +0100
+++ guile-2.0.0.1/libguile/ports.h	2011-03-18 21:23:27.834575752 +0100
@@ -137,6 +137,7 @@ SCM_INTERNAL SCM scm_i_port_weak_hash;
 #define SCM_RDNG	(2L<<16) /* Is it a readable port? */
 #define SCM_WRTNG	(4L<<16) /* Is it writable? */
 #define SCM_BUF0	(8L<<16) /* Is it unbuffered? */
+#define SCM_BINARY	(16L<<16) /* Is it binary? */
 #define SCM_BUFLINE     (64L<<16) /* Is it line-buffered? */
 
 #define SCM_PORTP(x) (!SCM_IMP (x) && (SCM_TYP7 (x) == scm_tc7_port))
--- guile-2.0.0.1/libguile/ports.c~	2011-03-13 23:21:07.000000000 +0100
+++ guile-2.0.0.1/libguile/ports.c	2011-03-18 21:27:07.755942569 +0100
@@ -767,6 +767,7 @@ scm_i_mode_bits_n (SCM modes)
 	     || scm_i_string_contains_char (modes, 'a')
 	     || scm_i_string_contains_char (modes, '+') ? SCM_WRTNG : 0)
 	  | (scm_i_string_contains_char (modes, '0') ? SCM_BUF0 : 0)
+	  | (scm_i_string_contains_char (modes, 'b') ? SCM_BINARY : 0)
 	  | (scm_i_string_contains_char (modes, 'l') ? SCM_BUFLINE : 0));
 }
 
@@ -816,6 +817,8 @@ SCM_DEFINE (scm_port_mode, "port-mode",
     strcpy (modes, "w");
   if (SCM_CELL_WORD_0 (port) & SCM_BUF0)
     strcat (modes, "0");
+  if (SCM_CELL_WORD_0 (port) & SCM_BINARY)
+    strcat (modes, "b");
   return scm_from_locale_string (modes);
 }
 #undef FUNC_NAME
--- guile-2.0.0.1/libguile/mkstemp.c~	2011-03-13 23:21:07.000000000 +0100
+++ guile-2.0.0.1/libguile/mkstemp.c	2011-03-18 22:06:10.889140473 +0100
@@ -51,6 +51,7 @@
    conflicts with a declaration in a system header file, we'll find
    out, because we should include that header file here.  */
 int mkstemp (char *);
+int mkostemp (char *, int flags);
 
 /* Generate a unique temporary file name from TEMPLATE.
 
@@ -61,10 +62,11 @@ int mkstemp (char *);
    The last six characters of TEMPLATE must be "XXXXXX"; they are
    replaced with a string that makes the filename unique.
 
-   Returns a file descriptor open on the file for reading and writing.  */
+   Returns a file descriptor on the file, open with FLAGS .  */
 int
-mkstemp (template)
+mkostemp (template, flags)
      char *template;
+     int flags;
 {
   static const char letters[]
     = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
@@ -112,7 +114,7 @@ mkstemp (template)
       v /= 62;
       XXXXXX[5] = letters[v % 62];
 
-      fd = open (template, O_RDWR|O_CREAT|O_EXCL, 0600);
+      fd = open (template, flags, 0600);
       if (fd >= 0)
 	/* The file does not exist.  */
 	return fd;
@@ -127,3 +129,24 @@ mkstemp (template)
   template[0] = '\0';
   return -1;
 }
+
+/* Generate a unique temporary file name from TEMPLATE.
+
+   TEMPLATE has the form:
+
+   <path>/ccXXXXXX
+
+   The last six characters of TEMPLATE must be "XXXXXX"; they are
+   replaced with a string that makes the filename unique.
+
+   Returns a file descriptor on the file for reading and writing */
+int
+mkstemp (template)
+     char *template;
+{
+  return mkostemp (template, O_RDWR|O_CREAT|O_EXCL
+#ifdef O_BINARY
+		   |O_BINARY
+#endif
+		   );
+}
--- guile-2.0.0.1/libguile/fports.c~	2011-03-18 22:09:54.270594577 +0100
+++ guile-2.0.0.1/libguile/fports.c	2011-03-18 22:09:45.086370334 +0100
@@ -568,6 +571,8 @@ scm_i_fdes_to_port (int fdes, long mode_
     else
       scm_fport_buffer_add (port, -1, -1);
   }
+  if (mode_bits & SCM_BINARY)
+    scm_i_set_port_encoding_x (port, 0);
   SCM_SET_FILENAME (port, name);
   scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
   return port;
--- guile-2.0.0.1/libguile/load.c~	2011-03-17 20:58:49.923054099 +0100
+++ guile-2.0.0.1/libguile/load.c	2011-03-18 23:02:16.870989978 +0100
@@ -887,9 +887,15 @@ SCM_DEFINE (scm_primitive_load_path, "pr
       && scm_is_string (scm_car (*scm_loc_load_compiled_extensions)))
     {
       SCM fallback = scm_string_append
-        (scm_list_3 (*scm_loc_compile_fallback_path,
-                     full_filename,
-                     scm_car (*scm_loc_load_compiled_extensions)));
+	(scm_list_3 (*scm_loc_compile_fallback_path,
+		     scm_equal_p (scm_i_substring (full_filename, 1, 2),
+				  scm_from_locale_string (":"))
+		     /* on MinGW remove drive-letter separator `:' to
+			obtain valid file name */
+		     ? scm_i_substring (full_filename, 2,
+					scm_i_string_length (full_filename))
+		     : full_filename,
+		     scm_car (*scm_loc_load_compiled_extensions)));
       if (scm_is_true (scm_stat (fallback, SCM_BOOL_F)))
         {
           compiled_filename = fallback;
--- guile-2.0.0.1/module/ice-9/boot-9.scm~	2011-03-18 23:39:22.092737409 +0100
+++ guile-2.0.0.1/module/ice-9/boot-9.scm	2011-03-19 09:23:48.673392189 +0100
@@ -3277,7 +3277,11 @@ module '(ice-9 q) '(make-q q-length))}."
          (string-append
           %compile-fallback-path
           ;; no need for '/' separator here, canon-path is absolute
-          canon-path
+          (if (eq? (string-ref canon-path 1) #\:)
+              ;; on Mingw remove drive-letter separator `:' to
+              ;; obtain valid file name
+              (substring canon-path 2)
+              canon-path)
           (cond ((or (null? %load-compiled-extensions)
                      (string-null? (car %load-compiled-extensions)))
                  (warn "invalid %load-compiled-extensions"