Re: guile 2.0.9 build on mingw

[Eli Zaretskii <eliz@gnu.org>]

> Date: Tue, 11 Jun 2013 19:53:21 +0300
> From: Eli Zaretskii <eliz@gnu.org>
> Cc: ludo@gnu.org, guile-user@gnu.org
> 
> Btw, --disable-posix disables too much, for no good reason.  E.g., it
> removes such innocent and important functionalities as "chdir",
> "open", and "close".  This is unnecessary, especially since most of
> the functions disabled by --disable-posix already have HAVE_foo guards
> around them, so systems that don't have them will not have the
> corresponding Guile feature.  I will try to lift as much of the
> disabled functionality as MinGW can bear.

Please find the changes to do this below.  I removed most of the
HAVE_POSIX ifdef's, as they are no longer needed.

The bug report at http://bugs.gnu.org/14171 says that when Guile is
compiled with enable-posix, it "can't start the REPL".  Can someone
please show me a simple way of trying that?  I'd like to see if my
build, which didn't use --disable-posix, has any problems in that
area, and if so try to debug them.


--- libguile/filesys.c~0	2013-04-09 09:52:31.000000000 +0300
+++ libguile/filesys.c	2013-06-12 13:41:31.244477700 +0300
@@ -112,7 +112,12 @@
 
 /* Some more definitions for the native Windows port. */
 #ifdef __MINGW32__
-# define fsync(fd) _commit (fd)
+# define fsync(fd)    _commit (fd)
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+/* FIXME: Should use 'link' module from gnulib.  */
+# define link(f1,f2)  CreateHardLink(f2, f1, NULL)
+# define HAVE_LINK 1
 #endif /* __MINGW32__ */
 
 
@@ -143,8 +148,6 @@
 
 \f
 
-#ifdef HAVE_POSIX
-
 /* {Permissions}
  */
 
@@ -320,8 +323,6 @@ SCM_DEFINE (scm_close_fdes, "close-fdes"
 }
 #undef FUNC_NAME
 
-#endif /* HAVE_POSIX */
-
 \f
 /* {Files}
  */
@@ -587,7 +588,6 @@ SCM_DEFINE (scm_lstat, "lstat", 1, 0, 0,
 #endif /* HAVE_LSTAT */
 
 \f
-#ifdef HAVE_POSIX
 
 /* {Modifying Directories}
  */
@@ -1219,8 +1219,6 @@ SCM_DEFINE (scm_sendfile, "sendfile", 3,
 }
 #undef FUNC_NAME
 
-#endif /* HAVE_POSIX */
-
 \f
 /* Essential procedures used in (system base compile).  */
 
@@ -1845,7 +1843,6 @@ SCM_DEFINE (scm_closedir, "closedir", 1,
 #undef FUNC_NAME
 
 
-#ifdef HAVE_POSIX
 static int
 scm_dir_print (SCM exp, SCM port, scm_print_state *pstate SCM_UNUSED)
 {
@@ -1866,14 +1863,12 @@ scm_dir_free (SCM p)
     closedir ((DIR *) SCM_SMOB_DATA_1 (p));
   return 0;
 }
-#endif
 
 \f
 
 void
 scm_init_filesys ()
 {
-#ifdef HAVE_POSIX
   scm_tc16_dir = scm_make_smob_type ("directory", 0);
   scm_set_smob_free (scm_tc16_dir, scm_dir_free);
   scm_set_smob_print (scm_tc16_dir, scm_dir_print);
@@ -1942,7 +1937,6 @@ scm_init_filesys ()
 #ifdef FD_CLOEXEC  
   scm_c_define ("FD_CLOEXEC", scm_from_int (FD_CLOEXEC));
 #endif
-#endif /* HAVE_POSIX */
 
   /* `access' symbols.  */
   scm_c_define ("R_OK", scm_from_int (R_OK));
--- libguile/posix.c~0	2013-03-29 21:20:01.000000000 +0300
+++ libguile/posix.c	2013-06-12 13:03:12.379677700 +0300
@@ -85,6 +85,27 @@
 #if HAVE_SYS_WAIT_H
 # include <sys/wait.h>
 #endif
+#ifdef __MINGW32__
+# define WEXITSTATUS(stat_val) ((stat_val) & 255)
+/* Windows reports exit status from fatal exceptions as 0xC0000nnn
+   codes, see winbase.h.  We usurp codes above 0xC0000200 for SIGxxx
+   signals.  */
+# define WIFEXITED(stat_val)   (((stat_val) & 0xC0000000) == 0)
+# define WIFSIGNALED(stat_val) (((stat_val) & 0xC0000000) != 0)
+# define WTERMSIG(stat_val)    ((stat_val > 0xC0000200) ? stat_val - 0xC0000200 : stat_val)
+# define WIFSTOPPED(stat_val)  (0)
+# define WSTOPSIG(stat_var)    (0)
+# include <process.h>
+# define waitpid(p,s,o)        _cwait(s, p, WAIT_CHILD)
+# define HAVE_WAITPID 1
+# define getuid()              (500) /* Local Administrator */
+# define getgid()              (513) /* None */
+# define setuid(u)             (0)
+# define setgid(g)             (0)
+# define pipe(f)               _pipe(f, 0, O_NOINHERIT)
+# define WIN32_LEAN_AND_MEAN
+# include <windows.h>
+#endif
 #ifndef WEXITSTATUS
 # define WEXITSTATUS(stat_val) ((unsigned)(stat_val) >> 8)
 #endif
@@ -674,6 +695,25 @@ SCM_DEFINE (scm_kill, "kill", 2, 0, 0,
           goto err;
         }
     }
+#ifdef __MINGW32__
+  else
+    {
+      HANDLE ph = OpenProcess (PROCESS_TERMINATE, 0, scm_to_int (pid));
+      int s = scm_to_int (sig);
+
+      if (!ph)
+	{
+	  errno = EPERM;
+	  goto err;
+	}
+      if (!TerminateProcess (ph, 0xC0000200 + s))
+	{
+	  errno = EINVAL;
+	  goto err;
+	}
+      CloseHandle (ph);
+    }
+#endif	/* __MINGW32__ */
 #endif
   return SCM_UNSPECIFIED;
 }
@@ -720,6 +760,7 @@ SCM_DEFINE (scm_waitpid, "waitpid", 1, 1
 {
   int i;
   int status;
+#ifndef __MINGW32__
   int ioptions;
   if (SCM_UNBNDP (options))
     ioptions = 0;
@@ -728,6 +769,7 @@ SCM_DEFINE (scm_waitpid, "waitpid", 1, 1
       /* Flags are interned in scm_init_posix.  */
       ioptions = scm_to_int (options);
     }
+#endif
   SCM_SYSCALL (i = waitpid (scm_to_int (pid), &status, ioptions));
   if (i == -1)
     SCM_SYSERROR;
@@ -736,7 +778,6 @@ SCM_DEFINE (scm_waitpid, "waitpid", 1, 1
 #undef FUNC_NAME
 #endif /* HAVE_WAITPID */
 
-#ifndef __MINGW32__
 SCM_DEFINE (scm_status_exit_val, "status:exit-val", 1, 0, 0, 
             (SCM status),
 	    "Return the exit status value, as would be set if a process\n"
@@ -787,7 +828,6 @@ SCM_DEFINE (scm_status_stop_sig, "status
     return SCM_BOOL_F;
 }
 #undef FUNC_NAME
-#endif /* __MINGW32__ */
 
 #ifdef HAVE_GETPPID
 SCM_DEFINE (scm_getppid, "getppid", 0, 0, 0,
@@ -802,7 +842,6 @@ SCM_DEFINE (scm_getppid, "getppid", 0, 0
 #endif /* HAVE_GETPPID */
 
 
-#ifndef __MINGW32__
 SCM_DEFINE (scm_getuid, "getuid", 0, 0, 0,
             (),
 	    "Return an integer representing the current real user ID.")
@@ -906,10 +945,8 @@ SCM_DEFINE (scm_seteuid, "seteuid", 1, 0
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
-#endif /* __MINGW32__ */
 
 
-#ifdef HAVE_SETEGID
 SCM_DEFINE (scm_setegid, "setegid", 1, 0, 0, 
             (SCM id),
 	    "Sets the effective group ID to the integer @var{id}, provided the process\n"
@@ -921,7 +958,7 @@ SCM_DEFINE (scm_setegid, "setegid", 1, 0
 {
   int rv;
 
-#ifdef HAVE_SETEUID
+#ifdef HAVE_SETEGID
   rv = setegid (scm_to_int (id));
 #else
   rv = setgid (scm_to_int (id));
@@ -932,7 +969,6 @@ SCM_DEFINE (scm_setegid, "setegid", 1, 0
     
 }
 #undef FUNC_NAME
-#endif
 
 
 #ifdef HAVE_GETPGRP
@@ -1247,6 +1283,7 @@ SCM_DEFINE (scm_fork, "primitive-fork", 
   return scm_from_int (pid);
 }
 #undef FUNC_NAME
+#endif /* HAVE_FORK */
 
 /* Since Guile uses threads, we have to be very careful to avoid calling
    functions that are not async-signal-safe in the child.  That's why
@@ -1320,7 +1357,130 @@ scm_open_process (SCM mode, SCM prog, SC
   }
 #endif
 
+#ifdef HAVE_FORK
   pid = fork ();
+#elif defined(__MINGW32__)
+  {
+    int save_stdin = -1, save_stdout = -1;
+    int errno_save;
+
+    if (reading)
+      {
+	save_stdout = dup (1);
+	errno_save = errno;
+	if (save_stdout == -1)
+	  {
+	    close (c2p[0]);
+	    close (c2p[1]);
+	    free (exec_file);
+	    errno = errno_save;
+	    SCM_SYSERROR;
+	  }
+      }
+
+    if (writing)
+      {
+	save_stdin = dup (0);
+	errno_save = errno;
+	if (save_stdin == -1)
+	  {
+	    if (reading)
+	      close (save_stdout);
+	    close (p2c[0]);
+	    close (p2c[1]);
+	    free (exec_file);
+	    errno = errno_save;
+	    SCM_SYSERROR;
+	  }
+      }
+
+    if (reading)
+      {
+	close (1);
+	if (dup (c2p[1]) != 1)
+	  {
+	    errno_save = errno;
+	    close (save_stdout);
+	    close (c2p[0]);
+	    close (c2p[1]);
+	    if (writing)
+	      {
+		close (save_stdin);
+		close (p2c[0]);
+		close (p2c[1]);
+	      }
+	    errno = errno_save;
+	    SCM_SYSERROR;
+	  }
+	close (c2p[1]);
+      }
+    if (writing)
+      {
+	close (0);
+	if (dup (p2c[0]) != 0)
+	  {
+	    errno_save = errno;
+	    close (save_stdin);
+	    close (p2c[0]);
+	    close (p2c[1]);
+	    if (reading)
+	      {
+		close (save_stdout);
+		close (c2p[0]);
+		close (c2p[1]);
+	      }
+	    errno = errno_save;
+	    SCM_SYSERROR;
+	  }
+	close (p2c[0]);
+      }
+
+    pid = spawnvp (P_NOWAIT, exec_file, exec_argv);
+    errno_save = errno;
+
+    if (reading)
+      {
+	close (1);
+	if (dup (save_stdout) != 1)
+	  {
+	    if (writing)
+	      close (save_stdin);
+	    close (save_stdout);
+	    close (p2c[1]);
+	    close (c2p[0]);
+	    errno = errno_save;
+	    SCM_SYSERROR;
+	  }
+	close (save_stdout);
+      }
+    if (writing)
+      {
+	close (0);
+	if (dup (save_stdin) != 0)
+	  {
+	    if (reading)
+	      close (save_stdout);
+	    close (save_stdin);
+	    close (p2c[1]);
+	    close (c2p[0]);
+	    errno = errno_save;
+	    SCM_SYSERROR;
+	  }
+	close (save_stdin);
+      }
+
+    if (pid < 0)
+      errno = errno_save;
+  }
+#else
+  close (c2p[0]);
+  close (c2p[1]);
+  close (p2c[0]);
+  close (p2c[1]);
+  free (exec_file);
+  errno = ENOSYS;
+  SCM_SYSERROR;
+#endif	/* HAVE_FORK */
 
   if (pid == -1)
     {
@@ -1329,14 +1489,28 @@ scm_open_process (SCM mode, SCM prog, SC
       if (reading)
         {
           close (c2p[0]);
+#ifdef HAVE_FORK
           close (c2p[1]);
+#endif
         }
       if (writing)
         {
+#ifdef HAVE_FORK
           close (p2c[0]);
+#endif
           close (p2c[1]);
         }
       errno = errno_save;
+
+#ifndef HAVE_FORK
+      /* The exec failed!  There is nothing sensible to do.  */
+      if (err > 0)
+	{
+	  char *msg = strerror (errno);
+	  fprintf (fdopen (err, "a"), "In spawnvp of %s: %s\n",
+		   exec_file, msg);
+	}
+#endif
       SCM_SYSERROR;
     }
 
@@ -1362,7 +1536,8 @@ scm_open_process (SCM mode, SCM prog, SC
       return scm_values
         (scm_list_3 (read_port, write_port, scm_from_int (pid)));
     }
-  
+
+#ifdef HAVE_FORK
   /* The child.  */
   if (reading)
     close (c2p[0]);
@@ -1411,16 +1586,16 @@ scm_open_process (SCM mode, SCM prog, SC
   if (err > 0)
     {
       char *msg = strerror (errno);
-      fprintf (fdopen (err, "a"), "In execlp of %s: %s\n",
+      fprintf (fdopen (err, "a"), "In execvp of %s: %s\n",
                exec_file, msg);
     }
 
   _exit (EXIT_FAILURE);
   /* Not reached.  */
   return SCM_BOOL_F;
+#endif	/* HAVE_FORK */
 }
 #undef FUNC_NAME
-#endif /* HAVE_FORK */
 
 #ifdef __MINGW32__
 # include "win32-uname.h"
@@ -2238,13 +2413,11 @@ SCM_DEFINE (scm_gethostname, "gethostnam
 #endif /* HAVE_GETHOSTNAME */
 
 \f
-#ifdef HAVE_FORK
 static void
 scm_init_popen (void)
 {
   scm_c_define_gsubr ("open-process", 2, 0, 1, scm_open_process);
 }
-#endif
 
 void
 scm_init_posix ()
@@ -2337,11 +2510,11 @@ scm_init_posix ()
 
 #ifdef HAVE_FORK
   scm_add_feature ("fork");
+#endif	/* HAVE_FORK */
   scm_c_register_extension ("libguile-" SCM_EFFECTIVE_VERSION,
                             "scm_init_popen",
 			    (scm_t_extension_init_func) scm_init_popen,
 			    NULL);
-#endif	/* HAVE_FORK */
 }
 
 /*