grt-vcd.adb

vhdl集成电路设计软件.需要用gcc-4.0.2版本编译.

               Info.Kind := Vcd_Bad;
         end case;
      else
         Info.Val := Vcd_Effective;
      end if;
   end Get_Verilog_Wire;

   procedure Add_Signal (Sig : VhpiHandleT)
   is
      N : Vcd_Index_Type;
      Vcd_El : Verilog_Wire_Info;
   begin
      Get_Verilog_Wire (Sig, Vcd_El);

      if Vcd_El.Kind = Vcd_Bad then
         Vcd_Put ("$comment ");
         Vcd_Put_Name (Sig);
         Vcd_Put (" is not handled");
         --Vcd_Put (Ghdl_Type_Kind'Image (Desc.Kind));
         Vcd_Putc (' ');
         Vcd_Put_End;
         return;
      else
         Vcd_Table.Increment_Last;
         N := Vcd_Table.Last;

         Vcd_Table.Table (N) := Vcd_El;
         Vcd_Put ("$var ");
         case Vcd_El.Kind is
            when Vcd_Integer32 =>
               Vcd_Put ("integer 32");
            when Vcd_Bool
              | Vcd_Bit
              | Vcd_Stdlogic =>
               Vcd_Put ("reg 1");
            when Vcd_Bitvector
              | Vcd_Stdlogic_Vector =>
               Vcd_Put ("reg ");
               Vcd_Put_I32 (Ghdl_I32 (Vcd_El.Irange.I32.Len));
            when Vcd_Bad =>
               null;
         end case;
         Vcd_Putc (' ');
         Vcd_Put_Idcode (N);
         Vcd_Putc (' ');
         Vcd_Put_Name (Sig);
         if Vcd_El.Irange /= null then
            Vcd_Putc ('[');
            Vcd_Put_I32 (Vcd_El.Irange.I32.Left);
            Vcd_Putc (':');
            Vcd_Put_I32 (Vcd_El.Irange.I32.Right);
            Vcd_Putc (']');
         end if;
         Vcd_Putc (' ');
         Vcd_Put_End;
         if Boolean'(False) then
            Vcd_Put ("$comment ");
            Vcd_Put_Name (Sig);
            Vcd_Put (" is ");
            case Vcd_El.Val is
               when Vcd_Effective =>
                  Vcd_Put ("effective ");
               when Vcd_Driving =>
                  Vcd_Put ("driving ");
            end case;
            Vcd_Put_End;
         end if;
      end if;
   end Add_Signal;

   procedure Vcd_Put_Hierarchy (Inst : VhpiHandleT)
   is
      Decl_It : VhpiHandleT;
      Decl : VhpiHandleT;
      Error : AvhpiErrorT;
   begin
      Vhpi_Iterator (VhpiDecls, Inst, Decl_It, Error);
      if Error /= AvhpiErrorOk then
         Avhpi_Error (Error);
         return;
      end if;

      --  Extract signals.
      loop
         Vhpi_Scan (Decl_It, Decl, Error);
         exit when Error = AvhpiErrorIteratorEnd;
         if Error /= AvhpiErrorOk then
            Avhpi_Error (Error);
            return;
         end if;

         case Vhpi_Get_Kind (Decl) is
            when VhpiPortDeclK
              | VhpiSigDeclK =>
               Add_Signal (Decl);
            when others =>
               null;
         end case;
      end loop;

      --  Extract sub-scopes.
      Vhpi_Iterator (VhpiInternalRegions, Inst, Decl_It, Error);
      if Error /= AvhpiErrorOk then
         Avhpi_Error (Error);
         return;
      end if;

      loop
         Vhpi_Scan (Decl_It, Decl, Error);
         exit when Error = AvhpiErrorIteratorEnd;
         if Error /= AvhpiErrorOk then
            Avhpi_Error (Error);
            return;
         end if;

         case Vhpi_Get_Kind (Decl) is
            when VhpiIfGenerateK
              | VhpiForGenerateK
              | VhpiBlockStmtK
              | VhpiCompInstStmtK =>
               Vcd_Put ("$scope module ");
               Vcd_Put_Name (Decl);
               Vcd_Putc (' ');
               Vcd_Put_End;
               Vcd_Put_Hierarchy (Decl);
               Vcd_Put ("$upscope ");
               Vcd_Put_End;
            when others =>
               null;
         end case;
      end loop;

   end Vcd_Put_Hierarchy;

   procedure Vcd_Put_Bit (V : Ghdl_B2)
   is
      C : Character;
   begin
      if V then
         C := '1';
      else
         C := '0';
      end if;
      Vcd_Putc (C);
   end Vcd_Put_Bit;

   procedure Vcd_Put_Stdlogic (V : Ghdl_E8)
   is
      type Map_Type is array (Ghdl_E8 range 0 .. 8) of Character;
      --                             "UX01ZWLH-"
   -- Map_Vlg : constant Map_Type := "xx01zz01x";
      Map_Std : constant Map_Type := "UX01ZWLH-";
   begin
      if V not in Map_Type'Range then
         Vcd_Putc ('?');
      else
         Vcd_Putc (Map_Std (V));
      end if;
   end Vcd_Put_Stdlogic;

   procedure Vcd_Put_Integer32 (V : Ghdl_U32)
   is
      Val : Ghdl_U32;
      N : Natural;
   begin
      Val := V;
      N := 32;
      while N > 1 loop
         exit when (Val and 16#8000_0000#) /= 0;
         Val := Val * 2;
         N := N - 1;
      end loop;

      while N > 0 loop
         if (Val and 16#8000_0000#) /= 0 then
            Vcd_Putc ('1');
         else
            Vcd_Putc ('0');
         end if;
         Val := Val * 2;
         N := N - 1;
      end loop;
   end Vcd_Put_Integer32;

   procedure Vcd_Put_Var (I : Vcd_Index_Type)
   is
      Addr : Address;
      V : Verilog_Wire_Info renames Vcd_Table.Table (I);
      Len : Ghdl_Index_Type;
   begin
      Addr := V.Addr;
      if V.Irange = null then
         Len := 1;
      else
         Len := V.Irange.I32.Len;
      end if;
      case V.Val is
         when Vcd_Effective =>
            case V.Kind is
               when Vcd_Bit
                 | Vcd_Bool =>
                  Vcd_Put_Bit (To_Signal_Arr_Ptr (Addr)(0).Value.B2);
               when Vcd_Stdlogic =>
                  Vcd_Put_Stdlogic (To_Signal_Arr_Ptr (Addr)(0).Value.E8);
               when Vcd_Integer32 =>
                  Vcd_Putc ('b');
                  Vcd_Put_Integer32 (To_Signal_Arr_Ptr (Addr)(0).Value.E32);
               when Vcd_Bitvector =>
                  Vcd_Putc ('b');
                  for J in 0 .. Len - 1 loop
                     Vcd_Put_Bit (To_Signal_Arr_Ptr (Addr)(J).Value.B2);
                  end loop;
                  Vcd_Putc (' ');
               when Vcd_Stdlogic_Vector =>
                  Vcd_Putc ('b');
                  for J in 0 .. Len - 1 loop
                     Vcd_Put_Stdlogic (To_Signal_Arr_Ptr (Addr)(J).Value.E8);
                  end loop;
                  Vcd_Putc (' ');
               when Vcd_Bad =>
                  null;
            end case;
         when Vcd_Driving =>
            case V.Kind is
               when Vcd_Bit
                 | Vcd_Bool =>
                  Vcd_Put_Bit
                    (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.B2);
               when Vcd_Stdlogic =>
                  Vcd_Put_Stdlogic
                    (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.E8);
               when Vcd_Integer32 =>
                  Vcd_Putc ('b');
                  Vcd_Put_Integer32
                    (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.E32);
               when Vcd_Bitvector =>
                  Vcd_Putc ('b');
                  for J in 0 .. Len - 1 loop
                     Vcd_Put_Bit
                       (To_Signal_Arr_Ptr (Addr)(J).Driving_Value.B2);
                  end loop;
                  Vcd_Putc (' ');
               when Vcd_Stdlogic_Vector =>
                  Vcd_Putc ('b');
                  for J in 0 .. Len - 1 loop
                     Vcd_Put_Stdlogic
                       (To_Signal_Arr_Ptr (Addr)(J).Driving_Value.E8);
                  end loop;
                  Vcd_Putc (' ');
               when Vcd_Bad =>
                  null;
            end case;
      end case;
      Vcd_Put_Idcode (I);
      Vcd_Newline;
   end Vcd_Put_Var;

   function Verilog_Wire_Changed (Info : Verilog_Wire_Info;
                                  Last : Std_Time)
                                 return Boolean
   is
      Len : Ghdl_Index_Type;
   begin
      if Info.Irange = null then
         Len := 1;
      else
         Len := Info.Irange.I32.Len;
      end if;

      case Info.Val is
         when Vcd_Effective =>
            case Info.Kind is
               when Vcd_Bit
                 | Vcd_Bool
                 | Vcd_Stdlogic
                 | Vcd_Bitvector
                 | Vcd_Stdlogic_Vector
                 | Vcd_Integer32 =>
                  for J in 0 .. Len - 1 loop
                     if To_Signal_Arr_Ptr (Info.Addr)(J).Last_Event = Last then
                        return True;
                     end if;
                  end loop;
               when Vcd_Bad =>
                  null;
            end case;
         when Vcd_Driving =>
            case Info.Kind is
               when Vcd_Bit
                 | Vcd_Bool
                 | Vcd_Stdlogic
                 | Vcd_Bitvector
                 | Vcd_Stdlogic_Vector
                 | Vcd_Integer32 =>
                  for J in 0 .. Len - 1 loop
                     if To_Signal_Arr_Ptr (Info.Addr)(J).Last_Active = Last
                     then
                        return True;
                     end if;
                  end loop;
               when Vcd_Bad =>
                  null;
            end case;
      end case;
      return False;
   end Verilog_Wire_Changed;

   procedure Vcd_Put_Time
   is
      Str : String (1 .. 21);
      First : Natural;
   begin
      Vcd_Putc ('#');
      Vstrings.To_String (Str, First, Ghdl_I64 (Cycle_Time));
      Vcd_Put (Str (First .. Str'Last));
      Vcd_Newline;
   end Vcd_Put_Time;

   procedure Vcd_Cycle;

   --  Called after elaboration.
   procedure Vcd_Start
   is
      Root : VhpiHandleT;
   begin
      --  Do nothing if there is no VCD file to generate.
      if H = null then
         return;
      end if;

      --  Be sure the RTI of std_ulogic is set.
      Search_Types_RTI;

      --  Put hierarchy.
      Get_Root_Inst (Root);
      Vcd_Put_Hierarchy (Root);

      --  End of header.
      Vcd_Put ("$enddefinitions ");
      Vcd_Put_End;

      Register_Cycle_Hook (Vcd_Cycle'Access);
   end Vcd_Start;

   --  Called before each non delta cycle.
   procedure Vcd_Cycle is
   begin
      --  Disp values.
      Vcd_Put_Time;
      if Cycle_Time = 0 then
         --  Disp all values.
         for I in Vcd_Table.First .. Vcd_Table.Last loop
            Vcd_Put_Var (I);
         end loop;
      else
         --  Disp only values changed.
         for I in Vcd_Table.First .. Vcd_Table.Last loop
            if Verilog_Wire_Changed (Vcd_Table.Table (I), Cycle_Time) then
               Vcd_Put_Var (I);
            end if;
         end loop;
      end if;
   end Vcd_Cycle;

   --  Called at the end of the simulation.
   procedure Vcd_End is
   begin
      if H /= null then
         Vcd_Close (H);
      end if;
   end Vcd_End;

   Vcd_Hooks : aliased constant Hooks_Type :=
     (Option => Vcd_Option'Access,
      Help => Vcd_Help'Access,
      Init => Vcd_Init'Access,
      Start => Vcd_Start'Access,
      Finish => Vcd_End'Access);

   procedure Register is
   begin
      Register_Hooks (Vcd_Hooks'Access);
   end Register;
end Grt.Vcd;