There seem to be a spate of failures, in two groups:
(1) With the ghdl-0.31 package, apparently related to resolved signals,
also affecting the "DLX" example, on Mac OSX, FreeBSD and one on Arch
Linux (all 64 bit). I have so far failed to reproduce these.

(2) With trunk (ghdl-0.32dev), on Gna bug 18810, and several of the
Vests tests (Billowich/compliant/tc749.vhd) and also 
tc750, 751, 752, 755, 756.

For example,
-----------------------------------------------------------------
ghdl -a --std=93c vhdl-93/billowitch/compliant/tc749.vhd
ghdl --elab-run c01s01b01x01p05n02i00749ent  --assert-level=error
ghdl: exec error
and "dmesg" reports a segfault. 
-----------------------------------------------------------------

I now have a reduced testcase, and a patch for the runtime to get some
interesting information : 
$GHDL -a tc749.vhd
$GHDL -e c749ent
$GHDL -r c749ent
Allocated 000000000237D398
0: 2
Free 000000000237D398
Gnat Free 0x237d390
*** Error in `./c749ent': free(): invalid next size (fast):
0x000000000237d390 ***
======= Backtrace: =========
...


diff -r 254b267a3efa translate/grt/grt-cbinding.c
--- a/translate/grt/grt-cbinding.c	Mon Jan 20 14:01:47 2014 +0000
+++ b/translate/grt/grt-cbinding.c	Mon Jan 20 16:06:17 2014 +0000
@@ -75,6 +75,7 @@
 void
 __gnat_free (void *ptr)
 {
+  printf("Gnat Free %p\n",ptr);
   free (ptr);
 }
 
diff -r 254b267a3efa translate/grt/grt-disp_signals.adb
--- a/translate/grt/grt-disp_signals.adb	Mon Jan 20 14:01:47 2014 +0000
+++ b/translate/grt/grt-disp_signals.adb	Mon Jan 20 16:06:17 2014 +0000
@@ -153,6 +153,8 @@
    procedure Disp_Simple_Signal
      (Sig : Ghdl_Signal_Ptr; Sig_Type : Ghdl_Rti_Access; Sources : Boolean)
    is
+      function To_Address is new Ada.Unchecked_Conversion
+        (Source => Resolved_Signal_Acc, Target => Address);
    begin
       Put (' ');
       Put (stdout, Sig.all'Address);
@@ -204,6 +206,10 @@
             Put (" ports");
          end if;
          if Sig.S.Mode_Sig in Mode_Signal_User then
+            if Sig.S.Resolv /= null then
+               Put (stdout, " res func ");
+               Put (stdout, To_Address(Sig.S.Resolv));
+            end if;
             if Sig.S.Nbr_Drivers = 0 then
                Put ("; no driver");
             elsif Sig.S.Nbr_Drivers = 1 then
diff -r 254b267a3efa translate/grt/grt-lib.adb
--- a/translate/grt/grt-lib.adb	Mon Jan 20 14:01:47 2014 +0000
+++ b/translate/grt/grt-lib.adb	Mon Jan 20 16:06:17 2014 +0000
@@ -18,6 +18,12 @@
 with Grt.Errors; use Grt.Errors;
 with Grt.Options;
 
+-- debugging
+with Grt.Astdio;
+with Grt.Stdio;
+with Ada.Unchecked_Conversion;
+with System;
+
 package body Grt.Lib is
    --procedure Memcpy (Dst : Address; Src : Address; Size : Size_T);
    --pragma Import (C, Memcpy);
@@ -222,11 +228,15 @@
       return Res;
    end Ghdl_Malloc0;
 
-   procedure Ghdl_Deallocate (Ptr : Ghdl_Ptr)
-   is
+   procedure Ghdl_Deallocate (Ptr : Ghdl_Ptr) is
+      function To_Address is new Ada.Unchecked_Conversion
+        (Source => Ghdl_Ptr, Target => System.Address);
       procedure C_Free (Ptr : Ghdl_Ptr);
       pragma Import (C, C_Free, "free");
    begin
+      Grt.Astdio.Put(Grt.Stdio.stdout, "About to free ");
+      Grt.Astdio.Put(Grt.Stdio.stdout, To_Address(Ptr));
+      Grt.Astdio.New_Line(Grt.Stdio.stdout);
       C_Free (Ptr);
    end Ghdl_Deallocate;
 
diff -r 254b267a3efa translate/grt/grt-signals.adb
--- a/translate/grt/grt-signals.adb	Mon Jan 20 14:01:47 2014 +0000
+++ b/translate/grt/grt-signals.adb	Mon Jan 20 16:06:17 2014 +0000
@@ -86,9 +86,11 @@
       S : Ghdl_Signal_Data (Mode_Sig);
    begin
       Sig_Table.Increment_Last;
-
+      Info("Create_Signal");
       if Current_Resolv = null then
+         Info("Current_Resolv = null");
          if Resolv_Proc /= Null_Address then
+            Info("Resolv_Proc OK");
             Resolv := new Resolved_Signal_Type'
               (Resolv_Proc => Resolv_Proc,
                Resolv_Inst => Resolv_Inst,
@@ -96,9 +98,11 @@
                Sig_Range => (Sig_Table.Last, Sig_Table.Last),
                Disconnect_Time => Bad_Time);
          else
+            Info("Resolv_Proc = null");
             Resolv := null;
          end if;
       else
+         Info("Current_Resolv valid");
          if Resolv_Proc /= Null_Address then
             --  Only one resolution function is allowed!
             Internal_Error ("create_signal");
@@ -179,6 +183,8 @@
       --  Put the signal in the table.
       Sig_Table.Table (Sig_Table.Last) := Res;
 
+      Grt.Disp_Signals.Disp_A_Signal (Res);
+
       return Res;
    end Create_Signal;
 
@@ -211,6 +217,7 @@
       if Current_Resolv /= null then
          Internal_Error ("Ghdl_Signal_Create_Resolution");
       end if;
+      Info("Ghdl_Signal_Create_Resolution");
       Current_Resolv := new Resolved_Signal_Type'
         (Resolv_Proc => Proc,
          Resolv_Inst => Instance,
@@ -1758,6 +1765,8 @@
       Vec : Bool_Array_Type;
    begin
       --  Compute number of non-null drivers.
+      Info("compute_resolved_signal");
+      Grt.Disp_Signals.Disp_A_Signal (Sig);
       Length := 0;
       for I in 1 .. Sig.S.Nbr_Drivers loop
          case Sig.S.Drivers (I - 1).First_Trans.Kind is
@@ -2368,20 +2377,22 @@
          Last_Off : Signal_Net_Type;
          Num : Signal_Net_Type;
 
---          procedure Disp_Offs
---          is
---             use Grt.Astdio;
---             use Grt.Stdio;
---          begin
---             for I in Offs'Range loop
---                if Offs (I) /= 0 then
---                   Put_I32 (stdout, Ghdl_I32 (I));
---                   Put (": ");
---                   Put_I32 (stdout, Ghdl_I32 (Offs (I)));
---                   New_Line;
---                end if;
---             end loop;
---          end Disp_Offs;
+         procedure Disp_Offs
+         is
+            use Grt.Astdio;
+            use Grt.Stdio;
+         begin
+            for I in Offs'Range loop
+               Put_I32 (stdout, Ghdl_I32 (I));
+               if Offs (I) /= 0 then
+                  --Put_I32 (stdout, Ghdl_I32 (I));
+                  Put (": ");
+                  Put_I32 (stdout, Ghdl_I32 (Offs (I)));
+                  --New_Line;
+               end if;
+               New_Line;
+            end loop;
+         end Disp_Offs;
 
          type Propag_Array is array (Signal_Net_Type range <>)
            of Propagation_Type;
@@ -2393,6 +2404,11 @@
          procedure Deallocate is new Ada.Unchecked_Deallocation
            (Object => Forward_Build_Type, Name => Forward_Build_Acc);
 
+         function To_Address is new Ada.Unchecked_Conversion
+           (Source => Propag_Array_Acc, Target => System.Address);
+         use Grt.Astdio;
+         use Grt.Stdio;
+
          Net : Signal_Net_Type;
       begin
          --  1) Count number of propagation cell per net.
@@ -2417,6 +2433,11 @@
 
          --  3) Gather entries by net (copy)
          Propag := new Propag_Array (1 .. Last_Off);
+
+         Put(stdout, "Allocated ");
+         Put(stdout, To_Address(Propag));
+         New_Line(stdout);
+
          for I in Propagation.First .. Propagation.Last loop
             Net := Get_Propagation_Net (I);
             if Net /= No_Signal_Net then
@@ -2435,6 +2456,10 @@
                Propagation.Table (I) := Propag (I);
             end if;
          end loop;
+         Disp_Offs;
+         Put(stdout, "Free ");
+         Put(stdout, To_Address(Propag));
+         New_Line(stdout);
          Free (Propag);
          for I in 1 .. Last_Signal_Net loop
             --  Ignore holes.
ENTITY c749ent IS
  generic(
    zero : integer := 0;
    one  : integer := 1;
    three: integer := 3;
    seven: integer := 7;
    C1 : boolean    := true;
    C2 : bit       := '1';
    C3 : character    := 's';
    C4 : severity_level:= note;
    C5 : integer    := 3;
    C6 : real       := 3.0;
    C7 : time       := 3 ns;
    C8 : natural    := 1;
    C9 : positive    := 1;
    C10 : string    := "shishir";
    C11 : bit_vector    := B"0011"
    );
END c749ent;

ARCHITECTURE arch OF c749ent IS
   
  type record_std_package is record
                               a:boolean;
                               --b:bit;
                               --c:character;
                               --d:severity_level;
                               --e:integer;
                               f:real;
                               g:time;
                               --h:natural;
                               --i:positive;
                               j:string(one to seven);
                               k:bit_vector(zero to three);
                             end record;

  --constant C50 : record_std_package    := (C1,C2,C3,C4,C5,C6,C7,C8,C9,C10,C11);
  constant C50 : record_std_package    := (C1,C6,C7,C10,C11);

BEGIN

END arch;
_______________________________________________
Ghdl-discuss mailing list
[email protected]
https://mail.gna.org/listinfo/ghdl-discuss

Reply via email to