Tentatively fix win32 support.

6 files changed, 39 insertions, 141 deletions

diff --git a/Makefile.in b/Makefile.in
index 9f9ea7e13..93bf89299 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -323,7 +323,7 @@ distclean: clean
 	$(RM) -f Makefile config.status ghdl.gpr
 
 clean-c: force
-	$(RM) -f memsegs_c.o chkstk.o linux.o times.o grt-cbinding.o grt-cvpi.o
+	$(RM) -f memsegs_c.o chkstk.o jumps.o times.o grt-cbinding.o grt-cvpi.o
 	$(RM) -f fstapi.o fastlz.o lz4.o
 
 force:
diff --git a/configure b/configure
index a5be5d6bb..48da0c6af 100755
--- a/configure
+++ b/configure
@@ -75,7 +75,7 @@ fi
 
 # Sanity checks
 # Check that gnatmake exists
-if ! $GNATMAKE 2> /dev/null; then
+if ! $GNATMAKE --version 2> /dev/null; then
     echo "Sorry, you need GNAT to build GHDL.  See the README"
     echo "(gnatmake executable is: $GNATMAKE)"
     exit 1
@@ -149,7 +149,7 @@ for v in $subst_vars; do
     eval vval=\$$v
     echo $v=\"$vval\"
 done
-sed_opts=`echo $subst_vars | sed -e "s/\\([a-zA-Z_]*\\)/-e \"s%@\1@%\$\1%g\"/g"`
+sed_opts=`echo $subst_vars | sed -e "s/\\([a-zA-Z_]*\\)/ -e \"s%@\1@%\$\1%g\"/g"`
 echo 'echo "Creating ghdl.gpr"'
 echo sed $sed_opts '< $srcdir/ghdl.gpr.in > ghdl.gpr'
 echo 'echo "Creating Makefile"'
diff --git a/src/grt/config/jumps.c b/src/grt/config/jumps.c
index 360ea8089..775225e64 100644
--- a/src/grt/config/jumps.c
+++ b/src/grt/config/jumps.c
@@ -67,28 +67,24 @@ static int run_env_en;
 static JMP_BUF run_env;
 
 extern void grt_overflow_error (void);
+extern void grt_null_access_error (void);
 
 #ifdef __APPLE__
 #define NEED_SIGFPE_HANDLER
 #endif
-#if defined (__linux__) && defined (__i386__)
-#define NEED_SIGSEGV_HANDLER
-#endif
 
-#ifdef NEED_SIGFPE_HANDLER
 static struct sigaction prev_sigfpe_act;
 
-/* Handler for SIGFPE signal, raised in case of overflow (i386).  */
+/* Handler for SIGFPE signal.
+   It is also raised in case of overflow (i386 linux).  */
 static void grt_overflow_handler (int signo, siginfo_t *info, void *ptr)
 {
   grt_overflow_error ();
 }
-#endif
 
-#ifdef NEED_SIGSEGV_HANDLER
 static struct sigaction prev_sigsegv_act;
 
-/* Linux handler for overflow.  This is used only by mcode.  */
+/* Posix handler for overflow.  This is used only by mcode.  */
 static void grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
 {
 #if defined (__linux__) && defined (__i386__)
@@ -100,12 +96,11 @@ static void grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
 #endif
 
   /* We loose.  */
+  grt_null_access_error ();
 }
-#endif /* __linux__ && __i386__ */
 
 static void grt_signal_setup (void)
 {
-#ifdef NEED_SIGSEGV_HANDLER
   {
     struct sigaction sigsegv_act;
 
@@ -122,7 +117,6 @@ static void grt_signal_setup (void)
        If the handler is not installed, then some feature are lost.  */
     sigaction (SIGSEGV, &sigsegv_act, &prev_sigsegv_act);
   }
-#endif
 
 #ifdef NEED_SIGFPE_HANDLER
   {
@@ -139,9 +133,7 @@ static void grt_signal_setup (void)
 
 static void grt_signal_restore (void)
 {
-#ifdef NEED_SIGSEGV_HANDLER
   sigaction (SIGSEGV, &prev_sigsegv_act, NULL);
-#endif
 
 #ifdef NEED_SIGFPE_HANDLER
   sigaction (SIGFPE, &prev_sigfpe_act, NULL);
diff --git a/src/grt/config/win32.c b/src/grt/config/win32.c
index 35322ba9f..f9d669ef0 100644
--- a/src/grt/config/win32.c
+++ b/src/grt/config/win32.c
@@ -30,6 +30,12 @@
 #include <assert.h>
 #include <excpt.h>
 
+static int run_env_en;
+static jmp_buf run_env;
+
+extern void grt_overflow_error (void);
+extern void grt_null_access_error (void);
+
 static EXCEPTION_DISPOSITION
 ghdl_SEH_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
 		  void *EstablisherFrame,
@@ -42,119 +48,6 @@ struct exception_registration
   void *handler;
 };
 
-struct stack_type
-{
-  LPVOID fiber; //  Win fiber.
-  void (*func)(void *);  // Function
-  void *arg; //  Function argument.
-};
-
-static struct stack_type main_stack_context;
-static struct stack_type *current;
-extern void grt_set_main_stack (struct stack_type *stack);
-
-void grt_stack_init(void)
-{
-  main_stack_context.fiber = ConvertThreadToFiber (NULL);
-  if (main_stack_context.fiber == NULL)
-    {
-      fprintf (stderr, "convertThreadToFiber failed (err=%lu)\n",
-	       GetLastError ());
-      abort ();
-    }
-  grt_set_main_stack (&main_stack_context);
-  current = &main_stack_context;
-}
-
-static VOID __stdcall
-grt_stack_loop (void *v_stack)
-{
-  struct stack_type *stack = (struct stack_type *)v_stack;
-  struct exception_registration er;
-  struct exception_registration *prev;
-
-  /* Get current handler.  */
-  asm ("mov %%fs:(0),%0" : "=r" (prev));
-
-  /* Build regisration.  */
-  er.prev = prev;
-  er.handler = ghdl_SEH_handler;
-
-  /* Register.  */
-  asm ("mov %0,%%fs:(0)" : : "r" (&er));
-
-  while (1)
-    {
-      (*stack->func)(stack->arg);
-    }
-}
-
-struct stack_type *
-grt_stack_create (void (*func)(void *), void *arg) 
-{
-  struct stack_type *res;
-
-  res = malloc (sizeof (struct stack_type));
-  if (res == NULL)
-    return NULL;
-  res->func = func;
-  res->arg = arg;
-  res->fiber = CreateFiber (0, &grt_stack_loop, res);
-  if (res->fiber == NULL)
-    {
-      free (res);
-      return NULL;
-    }
-  return res;
-}
-
-static int run_env_en;
-static jmp_buf run_env;
-static int need_longjmp;
-
-void
-grt_stack_switch (struct stack_type *to, struct stack_type *from)
-{
-  assert (current == from);
-  current = to;
-  SwitchToFiber (to->fiber);
-  if (from == &main_stack_context && need_longjmp)
-    {
-      /* We returned to do the longjump.  */
-      current = &main_stack_context;
-      longjmp (run_env, need_longjmp);
-    }
-}
-
-void
-grt_stack_delete (struct stack_type *stack)
-{
-  DeleteFiber (stack->fiber);
-  stack->fiber = NULL;
-}
-
-void
-__ghdl_maybe_return_via_longjump (int val)
-{
-  if (!run_env_en)
-    return;
-
-  if (current != &main_stack_context)
-    {
-      /* We are allowed to jump only in the same stack.
-	 First switch back to the main thread.  */
-      need_longjmp = val;
-      SwitchToFiber (main_stack_context.fiber);
-    }
-  else
-    longjmp (run_env, val);
-}
-
-extern void grt_stack_error_grow_failed (void);
-extern void grt_stack_error_null_access (void);
-extern void grt_stack_error_memory_access (void);
-extern void grt_overflow_error (void);
-
 static EXCEPTION_DISPOSITION
 ghdl_SEH_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
 		  void *EstablisherFrame,
@@ -166,12 +59,9 @@ ghdl_SEH_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
   switch (ExceptionRecord->ExceptionCode)
     {
     case EXCEPTION_ACCESS_VIOLATION:
-      if (ExceptionRecord->ExceptionInformation[1] == 0)
-	grt_stack_error_null_access ();
-      else
-	grt_stack_error_memory_access ();
+      grt_null_access_error ();
       break;
-          
+
     case EXCEPTION_FLT_DENORMAL_OPERAND:
     case EXCEPTION_FLT_DIVIDE_BY_ZERO:
     case EXCEPTION_FLT_INVALID_OPERATION:
@@ -180,19 +70,19 @@ ghdl_SEH_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
     case EXCEPTION_FLT_UNDERFLOW:
       msg = "floating point error";
       break;
-     
+
     case EXCEPTION_INT_DIVIDE_BY_ZERO:
       msg = "division by 0";
       break;
-     
+
     case EXCEPTION_INT_OVERFLOW:
       grt_overflow_error ();
       break;
-           
+
     case EXCEPTION_STACK_OVERFLOW:
       msg = "stack overflow";
       break;
-     
+
     default:
       msg = "unknown reason";
       break;
@@ -205,6 +95,13 @@ ghdl_SEH_handler (struct _EXCEPTION_RECORD* ExceptionRecord,
   return 0; /* This is never reached, avoid compiler warning  */
 }
 
+void
+__ghdl_maybe_return_via_longjump (int val)
+{
+  if (run_env_en)
+    longjmp (run_env, val);
+}
+
 int
 __ghdl_run_through_longjump (int (*func)(void))
 {
diff --git a/src/grt/grt-errors.adb b/src/grt/grt-errors.adb
index 29da11206..66dfbf1dd 100644
--- a/src/grt/grt-errors.adb
+++ b/src/grt/grt-errors.adb
@@ -259,4 +259,9 @@ package body Grt.Errors is
    begin
       Error ("overflow detected");
    end Grt_Overflow_Error;
+
+   procedure Grt_Null_Access_Error is
+   begin
+      Error ("NULL access dereferenced");
+   end Grt_Null_Access_Error;
 end Grt.Errors;
diff --git a/src/grt/grt-errors.ads b/src/grt/grt-errors.ads
index 8dcf55b4d..833cded1b 100644
--- a/src/grt/grt-errors.ads
+++ b/src/grt/grt-errors.ads
@@ -36,7 +36,6 @@ package Grt.Errors is
    procedure Error_C_Std (Str : Std_String_Uncons);
    --procedure Error_C (Inst : Ghdl_Instance_Name_Acc);
    procedure Error_E (Str : String := "");
-   -- procedure Error_E_Std (Str : Std_String_Uncons);
    pragma No_Return (Error_E);
 
    --  Multi-call report procedure.  Do not exit at end.
@@ -50,6 +49,7 @@ package Grt.Errors is
 
    --  Complete error message.
    procedure Error (Str : String);
+   pragma No_Return (Error);
 
    --  Warning message.
    procedure Warning (Str : String);
@@ -64,6 +64,11 @@ package Grt.Errors is
 
    --  Display an error message for an overflow.
    procedure Grt_Overflow_Error;
+   pragma No_Return (Grt_Overflow_Error);
+
+   --  Display an error message for a NULL access dereference.
+   procedure Grt_Null_Access_Error;
+   pragma No_Return (Grt_Null_Access_Error);
 
    --  Called at end of error message.  Central point for failures.
    procedure Fatal_Error;
@@ -82,7 +87,6 @@ package Grt.Errors is
 
 private
    pragma Export (C, Grt_Overflow_Error, "grt_overflow_error");
-
-   pragma No_Return (Error);
+   pragma Export (C, Grt_Null_Access_Error, "grt_null_access_error");
 end Grt.Errors;