grt-signals.adb

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

   is
   begin
      return Ghdl_Create_Signal_Attribute (Mode_Quiet, Val);
   end Ghdl_Create_Quiet_Signal;

   function Ghdl_Create_Transaction_Signal return Ghdl_Signal_Ptr
   is
   begin
      return Ghdl_Create_Signal_Attribute (Mode_Transaction, 0);
   end Ghdl_Create_Transaction_Signal;

   procedure Ghdl_Signal_Attribute_Register_Prefix (Sig : Ghdl_Signal_Ptr)
   is
   begin
      Add_Port (Last_Implicit_Signal, Sig);
   end Ghdl_Signal_Attribute_Register_Prefix;

   --Guard_String : constant String := "guard";
   --Guard_Name : constant Ghdl_Str_Len_Address_Type :=
   --  (Len => 5, Str => Guard_String'Address);
   --function To_Ghdl_Str_Len_Ptr is new Ada.Unchecked_Conversion
   --  (Source => System.Address, Target => Ghdl_Str_Len_Ptr);

   Guard_Rti : aliased constant Ghdl_Rtin_Object :=
     (Common => (Kind => Ghdl_Rtik_Signal,
                 Depth => 0,
                 Mode => Ghdl_Rti_Signal_Mode_None,
                 Max_Depth => 0),
      Name => null,
      Loc => (Rel => True, Off => 0),
      Obj_Type => Std_Standard_Boolean_RTI_Ptr);

   function Ghdl_Signal_Create_Guard (This : System.Address;
                                      Proc : Guard_Func_Acc)
     return Ghdl_Signal_Ptr
   is
      Res : Ghdl_Signal_Ptr;
   begin
      Sig_Rti := To_Ghdl_Rtin_Object_Acc
        (To_Ghdl_Rti_Access (Guard_Rti'Address));
      Res := Create_Signal
        (Mode_B2, Value_Union'(Mode => Mode_B2, B2 => Proc.all (This)),
         Mode_Guard, Null_Address, Null_Address);
      Res.S.Guard_Func := Proc;
      Res.S.Guard_Instance := This;
      Last_Implicit_Signal := Res;
      return Res;
   end Ghdl_Signal_Create_Guard;

   procedure Ghdl_Signal_Guard_Dependence (Sig : Ghdl_Signal_Ptr)
   is
   begin
      Add_Port (Last_Implicit_Signal, Sig);
   end Ghdl_Signal_Guard_Dependence;

   function Ghdl_Create_Delayed_Signal (Sig : Ghdl_Signal_Ptr; Val : Std_Time)
                                       return Ghdl_Signal_Ptr
   is
      Res : Ghdl_Signal_Ptr;
   begin
      Res := Create_Signal (Sig.Mode, Sig.Value,
                            Mode_Delayed, Null_Address, Null_Address);
      Res.S.Time := Val;
      if Val > 0 then
         Res.Flink := Future_List;
         Future_List := Res;
      end if;
      Res.S.Attr_Trans := new Transaction'(Kind => Trans_Value,
                                           Time => 0,
                                           Next => null,
                                           Val => Res.Value);
      Append_Port (Res, Sig);
      return Res;
   end Ghdl_Create_Delayed_Signal;

   function Signal_Ptr_To_Index (Ptr : Ghdl_Signal_Ptr) return Sig_Table_Index
   is
   begin
      --  Note: we may start from ptr.instance_name.sig_index, but
      --  instance_name is *not* set for conversion signals.
      for I in reverse Sig_Table.First .. Sig_Table.Last loop
         if Sig_Table.Table (I) = Ptr then
            return I;
         end if;
      end loop;
      return -1;
   end Signal_Ptr_To_Index;

   function Ghdl_Signal_Get_Nbr_Ports (Sig : Ghdl_Signal_Ptr)
                                      return Ghdl_Index_Type is
   begin
      return Sig.Nbr_Ports;
   end Ghdl_Signal_Get_Nbr_Ports;

   function Ghdl_Signal_Get_Nbr_Drivers (Sig : Ghdl_Signal_Ptr)
                                        return Ghdl_Index_Type is
   begin
      return Sig.S.Nbr_Drivers;
   end Ghdl_Signal_Get_Nbr_Drivers;

   function Ghdl_Signal_Read_Port
     (Sig : Ghdl_Signal_Ptr; Index : Ghdl_Index_Type)
     return Ghdl_Value_Ptr
   is
   begin
      if Index >= Sig.Nbr_Ports then
         Internal_Error ("ghdl_signal_read_port: bad index");
      end if;
      return To_Ghdl_Value_Ptr (Sig.Ports (Index).Driving_Value'Address);
   end Ghdl_Signal_Read_Port;

   function Ghdl_Signal_Read_Driver
     (Sig : Ghdl_Signal_Ptr; Index : Ghdl_Index_Type)
     return Ghdl_Value_Ptr
   is
      Trans : Transaction_Acc;
   begin
      if Index >= Sig.S.Nbr_Drivers then
         Internal_Error ("ghdl_signal_read_driver: bad index");
      end if;
      Trans := Sig.S.Drivers (Index).First_Trans;
      case Trans.Kind is
         when Trans_Value =>
            return To_Ghdl_Value_Ptr (Trans.Val'Address);
         when Trans_Null =>
            return null;
         when Trans_Error =>
            Error ("range check error on signal");
      end case;
   end Ghdl_Signal_Read_Driver;

   procedure Ghdl_Signal_Conversion (Func : System.Address;
                                     Instance : System.Address;
                                     Src : Ghdl_Signal_Ptr;
                                     Src_Len : Ghdl_Index_Type;
                                     Dst : Ghdl_Signal_Ptr;
                                     Dst_Len : Ghdl_Index_Type;
                                     Mode : Mode_Signal_Type)
   is
      Data : Sig_Conversion_Acc;
      Sig : Ghdl_Signal_Ptr;
   begin
      Data := new Sig_Conversion_Type'(Func => Func,
                                       Instance => Instance,
                                       Src => (-1, -1),
                                       Dest => (-1, -1));
      Data.Src.First := Signal_Ptr_To_Index (Src);
      Data.Src.Last := Data.Src.First + Sig_Table_Index (Src_Len) - 1;

      Data.Dest.First := Signal_Ptr_To_Index (Dst);
      Data.Dest.Last := Data.Dest.First + Sig_Table_Index (Dst_Len) - 1;

      --  Convert DEST to new mode.
      for I in Data.Dest.First .. Data.Dest.Last loop
         Sig := Sig_Table.Table (I);
         case Mode is
            when Mode_Conv_In =>
               Sig.S := (Mode_Sig => Mode_Conv_In,
                         Conv => Data);
            when Mode_Conv_Out =>
               Sig.S := (Mode_Sig => Mode_Conv_Out,
                         Conv => Data);
            when others =>
               Internal_Error ("ghdl_signal_conversion");
         end case;
      end loop;
   end Ghdl_Signal_Conversion;

   procedure Ghdl_Signal_In_Conversion (Func : System.Address;
                                        Instance : System.Address;
                                        Src : Ghdl_Signal_Ptr;
                                        Src_Len : Ghdl_Index_Type;
                                        Dst : Ghdl_Signal_Ptr;
                                        Dst_Len : Ghdl_Index_Type)
   is
   begin
      Ghdl_Signal_Conversion
        (Func, Instance, Src, Src_Len, Dst, Dst_Len, Mode_Conv_In);
   end Ghdl_Signal_In_Conversion;

   procedure Ghdl_Signal_Out_Conversion (Func : System.Address;
                                         Instance : System.Address;
                                         Src : Ghdl_Signal_Ptr;
                                         Src_Len : Ghdl_Index_Type;
                                         Dst : Ghdl_Signal_Ptr;
                                         Dst_Len : Ghdl_Index_Type)
   is
   begin
      Ghdl_Signal_Conversion
        (Func, Instance, Src, Src_Len, Dst, Dst_Len, Mode_Conv_Out);
   end Ghdl_Signal_Out_Conversion;

   function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B2
   is
      Drv : Driver_Acc;
   begin
      Drv := Get_Driver (Sig);
      if Drv = null then
         --  FIXME: disp signal and process.
         Error ("'driving error: no driver in process for signal");
      end if;
      if Drv.First_Trans.Kind /= Trans_Null then
         return True;
      else
         return False;
      end if;
   end Ghdl_Signal_Driving;

   function Ghdl_Signal_Driving_Value_B2 (Sig : Ghdl_Signal_Ptr) return Ghdl_B2
   is
      Drv : Driver_Acc;
   begin
      Drv := Get_Driver (Sig);
      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
         Error ("'driving_value: no active driver in process for signal");
      else
         return Drv.First_Trans.Val.B2;
      end if;
   end Ghdl_Signal_Driving_Value_B2;

   function Ghdl_Signal_Driving_Value_E8 (Sig : Ghdl_Signal_Ptr)
                                         return Ghdl_E8
   is
      Drv : Driver_Acc;
   begin
      Drv := Get_Driver (Sig);
      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
         Error ("'driving_value: no active driver in process for signal");
      else
         return Drv.First_Trans.Val.E8;
      end if;
   end Ghdl_Signal_Driving_Value_E8;

   function Ghdl_Signal_Driving_Value_I32 (Sig : Ghdl_Signal_Ptr)
                                          return Ghdl_I32
   is
      Drv : Driver_Acc;
   begin
      Drv := Get_Driver (Sig);
      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
         Error ("'driving_value: no active driver in process for signal");
      else
         return Drv.First_Trans.Val.I32;
      end if;
   end Ghdl_Signal_Driving_Value_I32;

   function Ghdl_Signal_Driving_Value_I64 (Sig : Ghdl_Signal_Ptr)
                                          return Ghdl_I64
   is
      Drv : Driver_Acc;
   begin
      Drv := Get_Driver (Sig);
      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
         Error ("'driving_value: no active driver in process for signal");
      else
         return Drv.First_Trans.Val.I64;
      end if;
   end Ghdl_Signal_Driving_Value_I64;

   function Ghdl_Signal_Driving_Value_F64 (Sig : Ghdl_Signal_Ptr)
                                          return Ghdl_F64
   is
      Drv : Driver_Acc;
   begin
      Drv := Get_Driver (Sig);
      if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then
         Error ("'driving_value: no active driver in process for signal");
      else
         return Drv.First_Trans.Val.F64;
      end if;
   end Ghdl_Signal_Driving_Value_F64;

   procedure Flush_Active_List
   is
      Sig : Ghdl_Signal_Ptr;
      Next_Sig : Ghdl_Signal_Ptr;
   begin
      --  Free active_list.
      Sig := Active_List;
      loop
         Next_Sig := Sig.Link;
         exit when Next_Sig = null;
         Sig.Link := null;
         Sig := Next_Sig;
      end loop;
      Active_List := Sig;
   end Flush_Active_List;

   --  Add SIG in active_list.
   procedure Add_Active_List (Sig : Ghdl_Signal_Ptr);
   pragma Inline (Add_Active_List);

   procedure Add_Active_List (Sig : Ghdl_Signal_Ptr)
   is
   begin
      if Sig.Link = null then
         Sig.Link := Active_List;
         Active_List := Sig;
      end if;
   end Add_Active_List;

   function Find_Next_Time return Std_Time
   is
      Res : Std_Time;
      Sig : Ghdl_Signal_Ptr;

      procedure Check_Transaction (Trans : Transaction_Acc)
      is
      begin
         if Trans /= null then
            if Trans.Time = Res and Sig.Link = null then
               Sig.Link := Active_List;
               Active_List := Sig;
            elsif Trans.Time < Res then
               Flush_Active_List;

               --  Put sig on the list.
               Sig.Link := Active_List;
               Active_List := Sig;

               Res := Trans.Time;
            end if;
            if Res = Current_Time then
               --  Must have been in the active list.
               Internal_Error ("find_next_time(2)");
            end if;
         end if;
      end Check_Transaction;
   begin
      --  If there is signals in the active list, then next cycle is a delta
      --  cycle, so next time is current_time.
      if Active_List.Link /= null then
         return Current_Time;
      end if;

      Res := Std_Time'Last;

      Sig := Future_List;
      while Sig.Flink /= null loop
         case Sig.S.Mode_Sig is
            when Mode_Signal_User =>
               for J in 1 .. Sig.S.Nbr_Drivers loop
                  Check_Transaction (Sig.S.Drivers (J - 1).First_Trans.Next);
               end loop;
            when Mode_Delayed
              | Mode_Stable
              | Mode_Quiet =>
               Check_Transaction (Sig.S.Attr_Trans.Next);
            when others =>
               Internal_Error ("find_next_time(3)");
         end case;
         Sig := Sig.Flink;
      end loop;
      return Res;
   end Find_Next_Time;

--    function Get_Nbr_Non_Null_Source (Sig : Ghdl_Signal_Ptr)
--                                     return Natural
--    is
--       Length : Natural;
--    begin
--       Length := Sig.Nbr_Ports;
--       for I in 0 .. Sig.Nbr_Drivers - 1 loop
--          case Sig.Drivers (I).First_Trans.Kind is
--             when Trans_Value =>
--                Length := Length + 1;
--             when Trans_Null =>
--                null;
--             when Trans_Error =>
--                Error ("range check error");
--          end case;
--       end loop;
--       return Length;
--    end Get_Nbr_Non_Null_Source;

   Clear_List : Ghdl_Signal_Ptr := null;