bugs fix for ghw writer

8 files changed, 125 insertions, 151 deletions

diff --git a/doc/ghdl.texi b/doc/ghdl.texi
index c868a8c23..c945cc28f 100644
--- a/doc/ghdl.texi
+++ b/doc/ghdl.texi
@@ -4,10 +4,14 @@
 @settitle GHDL guide
 @c %**end of header
 
+@direntry
+* ghdl: (ghdl).         VHDL compiler.
+@end direntry
+
 @titlepage
 @title GHDL guide
 @subtitle GHDL, a VHDL compiler
-@subtitle For GHDL version 0.21 (Sokcho edition)
+@subtitle For GHDL version 0.22 (Sokcho edition)
 @author Tristan Gingold
 @c The following two commands start the copyright page.
 @page
diff --git a/ortho/oread/Makefile b/ortho/oread/Makefile
index bf6a00424..2d5053abb 100644
--- a/ortho/oread/Makefile
+++ b/ortho/oread/Makefile
@@ -32,7 +32,7 @@ $(ortho_exec): force
 
 clean:
 	$(MAKE) -f $(BACK_END)/Makefile clean
-	$(RM) -f oread *.o *~
+	$(RM) -f oread-gcc oread-mcode *.o *~
 
 distclean: clean
 	$(MAKE) -f $(BACK_END)/Makefile distclean
diff --git a/translate/grt/config/win32.c b/translate/grt/config/win32.c
index 80ea2703a..583b885ba 100644
--- a/translate/grt/config/win32.c
+++ b/translate/grt/config/win32.c
@@ -1,5 +1,5 @@
-/*  GRT stack implementation for Win32
-    Copyright (C) 2004, 2005 Felix Bertram.
+/*  GRT stack implementation for Win32 using fibers.
+    Copyright (C) 2005 Tristan Gingold.
 
     GHDL is free software; you can redistribute it and/or modify it under
     the terms of the GNU General Public License as published by the Free
@@ -16,139 +16,74 @@
     Software Foundation, 59 Temple Place - Suite 330, Boston, MA
     02111-1307, USA.
 */
-//-----------------------------------------------------------------------------
-// Project:     GHDL - VHDL Simulator
-// Description: Win32 port of stacks package
-// Note:        Tristan's original i386/Linux used assembly-code 
-//              to manually switch stacks for performance reasons.
-// History:     2004feb09, FB, created.
-//-----------------------------------------------------------------------------
 
 #include <windows.h>
-//#include <pthread.h>
-//#include <stdlib.h>
-//#include <stdio.h>
+#include <stdio.h>
 
+struct stack_type
+{
+  LPVOID fiber; //  Win fiber.
+  void (*func)(void *);  // Function
+  void *arg; //  Function argument.
+};
 
-//#define INFO printf
-#define INFO (void)
-
-// GHDL names an endless loop calling FUNC with ARG a 'stack'
-// at a given time, only one stack may be 'executed'
-typedef struct 
-{	HANDLE              thread;         // stack's thread
-	HANDLE              mutex;          // mutex to suspend/resume thread
-	void                (*Func)(void*); // stack's FUNC
-	void*               Arg;            // ARG passed to FUNC
-} Stack_Type_t, *Stack_Type;
-
-Stack_Type_t      main_stack_context;
-extern Stack_Type grt_stack_main_stack;
+static struct stack_type  main_stack_context;
+extern void grt_set_main_stack (struct stack_type *stack);
 
-//------------------------------------------------------------------------------
 void grt_stack_init(void)
-// Initialize the stacks package.
-// This may adjust stack sizes.
-// Must be called after grt.options.decode.
-// => procedure Stack_Init;
-{	INFO("grt_stack_init\n");
-	INFO("  main_stack_context=0x%08x\n", &main_stack_context);
-
-	// create event. reset event, as we are currently running
-	main_stack_context.mutex = CreateEvent(NULL,  // lpsa
-	                                       FALSE, // fManualReset
-	                                       FALSE, // fInitialState
-	                                       NULL); // lpszEventName
-
-	grt_stack_main_stack= &main_stack_context;
+{
+  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);
 }
 
-//------------------------------------------------------------------------------
-static unsigned long __stdcall grt_stack_loop(void* pv_myStack)
+static VOID __stdcall
+grt_stack_loop (void *v_stack)
 {
-	Stack_Type myStack= (Stack_Type)pv_myStack;
-
-	INFO("grt_stack_loop\n");
-	
-	INFO("  myStack=0x%08x\n", myStack);
-
-	// block until event becomes set again.
-	// this happens when this stack is enabled for the first time
-	WaitForSingleObject(myStack->mutex, INFINITE);
-	
-	// run stack's function in endless loop
-	while(1)
-	{	INFO("  call 0x%08x with 0x%08x\n", myStack->Func, myStack->Arg);
-		myStack->Func(myStack->Arg);
-	}
-	
-	// we never get here...
-	return 0;
+  struct stack_type *stack = (struct stack_type *)v_stack;
+  while (1)
+    {
+      (*stack->func)(stack->arg);
+    }
 }
 
-//------------------------------------------------------------------------------
-Stack_Type grt_stack_create(void* Func, void* Arg) 
-// Create a new stack, which on first execution will call FUNC with
-// an argument ARG.
-// => function Stack_Create (Func : Address; Arg : Address) return Stack_Type;
-{  	Stack_Type newStack;
-	DWORD      m_IDThread; // Thread's ID (dummy)
-
-	INFO("grt_stack_create\n");
-	INFO("  call 0x%08x with 0x%08x\n", Func, Arg);
-			
-	newStack= malloc(sizeof(Stack_Type_t));
-	
-	// init function and argument
-	newStack->Func= Func;
-	newStack->Arg=  Arg;
-	
-	// create event. reset event, so that thread will blocked in grt_stack_loop
-	newStack->mutex= CreateEvent(NULL,  // lpsa
-	                             FALSE, // fManualReset
-	                             FALSE, // fInitialState
-	                             NULL); // lpszEventName
-	
-	INFO("  newStack=0x%08x\n", newStack);
-	
-	// create thread, which executes grt_stack_loop
-	newStack->thread= CreateThread(NULL,           // lpsa
-	                               0,              // cbStack
-	                               grt_stack_loop, // lpStartAddr
-	                               newStack,       // lpvThreadParm
-	                               0,              // fdwCreate
-	                               &m_IDThread);   // lpIDThread
-	
-	return newStack;
+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;
 }
 
-//------------------------------------------------------------------------------
-void grt_stack_switch(Stack_Type To, Stack_Type From)
-// Resume stack TO and save the current context to the stack pointed by
-// CUR.
-// => procedure Stack_Switch (To : Stack_Type; From : Stack_Type);
-{	INFO("grt_stack_switch\n");
-	INFO("  from 0x%08x to 0x%08x\n", From, To);
-	
-	// set 'To' event. this will make the other thread either
-	// - start for first time in grt_stack_loop
-	// - resume at WaitForSingleObject below
-	SetEvent(To->mutex);
-		
-	// block until 'From' event becomes set again
-	// as we are running, our event is reset and we block here
-	// when stacks are switched, with above SetEvent, we may proceed
-	WaitForSingleObject(From->mutex, INFINITE);
+void
+grt_stack_switch (struct stack_type *to, struct stack_type *from)
+{
+  SwitchToFiber (to->fiber);
 }
 
-//------------------------------------------------------------------------------
-void grt_stack_delete(Stack_Type Stack)
-// Delete stack STACK, which must not be currently executed.
-// => procedure Stack_Delete (Stack : Stack_Type);
-{	INFO("grt_stack_delete\n");
+void
+grt_stack_delete (struct stack_type *stack)
+{
+  DeleteFiber (stack->fiber);
+  stack->fiber = NULL;
 }
 
-//----------------------------------------------------------------------------
 #ifndef WITH_GNAT_RUN_TIME
 void __gnat_raise_storage_error(void)
 {
@@ -161,6 +96,3 @@ void __gnat_raise_program_error(void)
 }
 #endif
 
-//----------------------------------------------------------------------------
-// end of file
-
diff --git a/translate/grt/ghwlib.c b/translate/grt/ghwlib.c
index b230acf38..45856889c 100644
--- a/translate/grt/ghwlib.c
+++ b/translate/grt/ghwlib.c
@@ -1214,16 +1214,31 @@ ghw_read_cycle_end (struct ghw_handler *h)
   return 0;
 }
 
+static const char *
+ghw_get_lit (union ghw_type *type, int e)
+{
+  if (e >= type->en.nbr || e < 0)
+    return "??";
+  else
+    return type->en.lits[e];
+}
+
+static void
+ghw_disp_lit (union ghw_type *type, int e)
+{
+  printf ("%s (%d)", ghw_get_lit (type, e), e);
+}
+
 void
 ghw_disp_value (union ghw_val *val, union ghw_type *type)
 {
   switch (ghw_get_base_type (type)->kind)
     {
     case ghdl_rtik_type_b2:
-      printf ("%s (%d)", type->en.lits[val->b2], val->b2);
+      ghw_disp_lit (type, val->b2);
       break;
     case ghdl_rtik_type_e8:
-      printf ("%s (%d)", type->en.lits[val->e8], val->e8);
+      ghw_disp_lit (type, val->e8);
       break;
     case ghdl_rtik_type_i32:
       printf ("%d", val->i32);
@@ -1582,10 +1597,14 @@ ghw_get_dir (int is_downto)
 }
 
 void
-ghw_disp_range (union ghw_range *rng)
+ghw_disp_range (union ghw_type *type, union ghw_range *rng)
 {
   switch (rng->kind)
     {
+    case ghdl_rtik_type_e8:
+      printf ("%s %s %s", ghw_get_lit (type, rng->e8.left),
+	      ghw_get_dir (rng->e8.dir), ghw_get_lit (type, rng->e8.right));
+      break;
     case ghdl_rtik_type_i32:
     case ghdl_rtik_type_p32:
       printf ("%d %s %d",
@@ -1657,7 +1676,7 @@ ghw_disp_type (struct ghw_handler *h, union ghw_type *t)
 	printf ("subtype %s is ", s->name);
 	ghw_disp_typename (h, s->base);
 	printf (" range ");
-	ghw_disp_range (s->rng);
+	ghw_disp_range (s->base, s->rng);
 	printf (";\n");
       }
       break;
@@ -1692,7 +1711,7 @@ ghw_disp_type (struct ghw_handler *h, union ghw_type *t)
 	  {
 	    if (i != 0)
 	      printf (", ");
-	    ghw_disp_range (a->rngs[i]);
+	    ghw_disp_range ((union ghw_type *)a->base, a->rngs[i]);
 	  }
 	printf (");\n");
       }
diff --git a/translate/grt/ghwlib.h b/translate/grt/ghwlib.h
index 7441d1ee5..dbf20fe80 100644
--- a/translate/grt/ghwlib.h
+++ b/translate/grt/ghwlib.h
@@ -390,7 +390,8 @@ void ghw_close (struct ghw_handler *h);
 
 const char *ghw_get_dir (int is_downto);
 
-void ghw_disp_range (union ghw_range *rng);
+/* Note: TYPE must be a base type (used only to display literals).  */
+void ghw_disp_range (union ghw_type *type, union ghw_range *rng);
 
 void ghw_disp_type (struct ghw_handler *h, union ghw_type *t);
 
diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb
index 520fbe46f..5b3a12f94 100644
--- a/translate/grt/grt-signals.adb
+++ b/translate/grt/grt-signals.adb
@@ -1095,15 +1095,6 @@ package body Grt.Signals is
          when others =>
             Internal_Error ("ghdl_create_signal_attribute");
       end case;
---       Sig_Instance_Name := new Ghdl_Instance_Name_Type'
---         (Kind => Ghdl_Name_Signal,
---          Name => null,
---          Parent => null,
---          Brother => null,
---          Sig_Mode => Mode,
---          Sig_Kind => Kind_Signal_No,
---        Sig_Indexes => (First => Sig_Table.Last + 1, Last => Sig_Table.Last),
---          Sig_Type_Desc => Sig_Type);
       --  Note: bit and boolean are both mode_b2.
       Res := Create_Signal
         (Mode_B2, Value_Union'(Mode => Mode_B2, B2 => True),
diff --git a/translate/grt/grt-waves.adb b/translate/grt/grt-waves.adb
index 8a189e69d..bfe4cec82 100644
--- a/translate/grt/grt-waves.adb
+++ b/translate/grt/grt-waves.adb
@@ -785,6 +785,15 @@ package body Grt.Waves is
    Nbr_Scope_Signals : Natural := 0;
    Nbr_Dumped_Signals : Natural := 0;
 
+   --  This is only valid during write_hierarchy.
+   function Get_Signal_Number (Sig : Ghdl_Signal_Ptr) return Natural
+   is
+      function To_Integer_Address is new Ada.Unchecked_Conversion
+        (Ghdl_Signal_Ptr, Integer_Address);
+   begin
+      return Natural (To_Integer_Address (Sig.Alink));
+   end Get_Signal_Number;
+
    procedure Write_Signal_Number (Val_Addr : Address;
                                   Val_Name : Vstring;
                                   Val_Type : Ghdl_Rti_Access)
@@ -792,20 +801,28 @@ package body Grt.Waves is
       pragma Unreferenced (Val_Name);
       pragma Unreferenced (Val_Type);
 
-      function To_Integer_Address is new Ada.Unchecked_Conversion
-        (Ghdl_Signal_Ptr, Integer_Address);
+      Num : Natural;
+
       function To_Ghdl_Signal_Ptr is new Ada.Unchecked_Conversion
         (Source => Integer_Address, Target => Ghdl_Signal_Ptr);
       Sig : Ghdl_Signal_Ptr;
    begin
+      --  Convert to signal.
       Sig := To_Ghdl_Signal_Ptr (To_Addr_Acc (Val_Addr).all);
-      if not Sig.Flags.Is_Dumped then
-         Sig.Flags.Is_Dumped := True;
+
+      --  Get signal number.
+      Num := Get_Signal_Number (Sig);
+
+      --  If the signal number is 0, then assign a valid signal number.
+      if Num = 0 then
          Nbr_Dumped_Signals := Nbr_Dumped_Signals + 1;
-         Sig.Flink := To_Ghdl_Signal_Ptr
+         Sig.Alink := To_Ghdl_Signal_Ptr
            (Integer_Address (Nbr_Dumped_Signals));
+         Num := Nbr_Dumped_Signals;
       end if;
-      Wave_Put_ULEB128 (Ghdl_E32 (To_Integer_Address (Sig.Flink)));
+
+      --  Do the real job: write the signal number.
+      Wave_Put_ULEB128 (Ghdl_E32 (Num));
    end Write_Signal_Number;
 
    procedure Foreach_Scalar_Signal_Number is new
@@ -1370,13 +1387,18 @@ package body Grt.Waves is
       Table_Initial => 32,
       Table_Increment => 100);
 
+   function Get_Dump_Entry (N : Natural) return Ghdl_Signal_Ptr is
+   begin
+      return Dump_Table.Table (N);
+   end Get_Dump_Entry;
+
    procedure Write_Hierarchy (Root : VhpiHandleT)
    is
       N : Natural;
    begin
-      --  Check Flink is 0.
+      --  Check Alink is 0.
       for I in Sig_Table.First .. Sig_Table.Last loop
-         if Sig_Table.Table (I).Flink /= null then
+         if Sig_Table.Table (I).Alink /= null then
             Internal_Error ("wave.write_hierarchy");
          end if;
       end loop;
@@ -1393,15 +1415,20 @@ package body Grt.Waves is
       Wave_Put_Byte (0);
 
       Dump_Table.Set_Last (Nbr_Dumped_Signals);
+      for I in Dump_Table.First .. Dump_Table.Last loop
+         Dump_Table.Table (I) := null;
+      end loop;
 
       --  Save and clear.
-      N := 0;
       for I in Sig_Table.First .. Sig_Table.Last loop
-         if Sig_Table.Table (I).Flags.Is_Dumped then
-            N := N + 1;
+         N := Get_Signal_Number (Sig_Table.Table (I));
+         if N /= 0 then
+            if Dump_Table.Table (N) /= null then
+               Internal_Error ("wave.write_hierarchy(2)");
+            end if;
             Dump_Table.Table (N) := Sig_Table.Table (I);
+            Sig_Table.Table (I).Alink := null;
          end if;
-         Sig_Table.Table (I).Flink := null;
       end loop;
    end Write_Hierarchy;
 
diff --git a/version.ads b/version.ads
index 852bffec7..4118496e8 100644
--- a/version.ads
+++ b/version.ads
@@ -1,4 +1,4 @@
 package Version is
    Ghdl_Version : constant String :=
-      "GHDL 0.21 (20051218) [Sokcho edition]";
+      "GHDL 0.22dev (20051220) [Sokcho edition]";
 end Version;