grt-signals.adb

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

   begin
      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_E8, E8 => Val));
   end Ghdl_Signal_Associate_E8;

   procedure Ghdl_Signal_Simple_Assign_E8 (Sign : Ghdl_Signal_Ptr;
                                           Val : Ghdl_E8)
   is
      Trans : Transaction_Acc;
   begin
      if not Sign.Flags.Has_Active
        and then Sign.Net = Net_One_Driver
        and then Val = Sign.Value.E8
        and then Sign.S.Drivers (0).First_Trans.Next = null
      then
         return;
      end if;

      Trans := new Transaction'
        (Kind => Trans_Value,
         Time => 0,
         Next => null,
         Val => Value_Union'(Mode => Mode_E8, E8 => Val));

      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
   end Ghdl_Signal_Simple_Assign_E8;

   procedure Ghdl_Signal_Start_Assign_E8 (Sign : Ghdl_Signal_Ptr;
                                          Rej : Std_Time;
                                          Val : Ghdl_E8;
                                          After : Std_Time)
   is
      Trans : Transaction_Acc;
   begin
      Trans := new Transaction'
        (Kind => Trans_Value,
         Time => 0,
         Next => null,
         Val => Value_Union'(Mode => Mode_E8, E8 => Val));
      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
   end Ghdl_Signal_Start_Assign_E8;

   procedure Ghdl_Signal_Next_Assign_E8 (Sign : Ghdl_Signal_Ptr;
                                         Val : Ghdl_E8;
                                         After : Std_Time)
   is
   begin
      Ghdl_Signal_Next_Assign
        (Sign, Value_Union'(Mode => Mode_E8, E8 => Val), After);
   end Ghdl_Signal_Next_Assign_E8;

   function Ghdl_Create_Signal_I32
     (Init_Val : Ghdl_I32;
      Resolv_Func : System.Address;
      Resolv_Inst : System.Address)
     return Ghdl_Signal_Ptr
   is
   begin
      return Create_Signal
        (Mode_I32, Value_Union'(Mode => Mode_I32, I32 => Init_Val),
         Get_Current_Mode_Signal,
         Resolv_Func, Resolv_Inst);
   end Ghdl_Create_Signal_I32;

   procedure Ghdl_Signal_Init_I32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I32)
   is
   begin
      Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_I32, I32 => Init_Val));
   end Ghdl_Signal_Init_I32;

   procedure Ghdl_Signal_Associate_I32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I32)
   is
   begin
      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_I32, I32 => Val));
   end Ghdl_Signal_Associate_I32;

   procedure Ghdl_Signal_Simple_Assign_I32 (Sign : Ghdl_Signal_Ptr;
                                            Val : Ghdl_I32)
   is
      Trans : Transaction_Acc;
   begin
      if not Sign.Flags.Has_Active
        and then Sign.Net = Net_One_Driver
        and then Val = Sign.Value.I32
        and then Sign.S.Drivers (0).First_Trans.Next = null
      then
         return;
      end if;

      Trans := new Transaction'
        (Kind => Trans_Value,
         Time => 0,
         Next => null,
         Val => Value_Union'(Mode => Mode_I32, I32 => Val));

      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
   end Ghdl_Signal_Simple_Assign_I32;

   procedure Ghdl_Signal_Start_Assign_I32 (Sign : Ghdl_Signal_Ptr;
                                           Rej : Std_Time;
                                           Val : Ghdl_I32;
                                           After : Std_Time)
   is
      Trans : Transaction_Acc;
   begin
      Trans := new Transaction'
        (Kind => Trans_Value,
         Time => 0,
         Next => null,
         Val => Value_Union'(Mode => Mode_I32, I32 => Val));
      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
   end Ghdl_Signal_Start_Assign_I32;

   procedure Ghdl_Signal_Next_Assign_I32 (Sign : Ghdl_Signal_Ptr;
                                          Val : Ghdl_I32;
                                          After : Std_Time)
   is
   begin
      Ghdl_Signal_Next_Assign
        (Sign, Value_Union'(Mode => Mode_I32, I32 => Val), After);
   end Ghdl_Signal_Next_Assign_I32;

   function Ghdl_Create_Signal_I64
     (Init_Val : Ghdl_I64;
      Resolv_Func : System.Address;
      Resolv_Inst : System.Address)
     return Ghdl_Signal_Ptr
   is
   begin
      return Create_Signal
        (Mode_I64, Value_Union'(Mode => Mode_I64, I64 => Init_Val),
         Get_Current_Mode_Signal,
         Resolv_Func, Resolv_Inst);
   end Ghdl_Create_Signal_I64;

   procedure Ghdl_Signal_Init_I64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I64)
   is
   begin
      Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_I64, I64 => Init_Val));
   end Ghdl_Signal_Init_I64;

   procedure Ghdl_Signal_Associate_I64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I64)
   is
   begin
      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_I64, I64 => Val));
   end Ghdl_Signal_Associate_I64;

   procedure Ghdl_Signal_Simple_Assign_I64 (Sign : Ghdl_Signal_Ptr;
                                            Val : Ghdl_I64)
   is
      Trans : Transaction_Acc;
   begin
      if not Sign.Flags.Has_Active
        and then Sign.Net = Net_One_Driver
        and then Val = Sign.Value.I64
        and then Sign.S.Drivers (0).First_Trans.Next = null
      then
         return;
      end if;

      Trans := new Transaction'
        (Kind => Trans_Value,
         Time => 0,
         Next => null,
         Val => Value_Union'(Mode => Mode_I64, I64 => Val));

      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
   end Ghdl_Signal_Simple_Assign_I64;

   procedure Ghdl_Signal_Start_Assign_I64 (Sign : Ghdl_Signal_Ptr;
                                           Rej : Std_Time;
                                           Val : Ghdl_I64;
                                           After : Std_Time)
   is
      Trans : Transaction_Acc;
   begin
      Trans := new Transaction'
        (Kind => Trans_Value,
         Time => 0,
         Next => null,
         Val => Value_Union'(Mode => Mode_I64, I64 => Val));
      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
   end Ghdl_Signal_Start_Assign_I64;

   procedure Ghdl_Signal_Next_Assign_I64 (Sign : Ghdl_Signal_Ptr;
                                          Val : Ghdl_I64;
                                          After : Std_Time)
   is
   begin
      Ghdl_Signal_Next_Assign
        (Sign, Value_Union'(Mode => Mode_I64, I64 => Val), After);
   end Ghdl_Signal_Next_Assign_I64;

   function Ghdl_Create_Signal_F64
     (Init_Val : Ghdl_F64;
      Resolv_Func : System.Address;
      Resolv_Inst : System.Address)
     return Ghdl_Signal_Ptr
   is
   begin
      return Create_Signal
        (Mode_F64, Value_Union'(Mode => Mode_F64, F64 => Init_Val),
         Get_Current_Mode_Signal,
         Resolv_Func, Resolv_Inst);
   end Ghdl_Create_Signal_F64;

   procedure Ghdl_Signal_Init_F64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_F64)
   is
   begin
      Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_F64, F64 => Init_Val));
   end Ghdl_Signal_Init_F64;

   procedure Ghdl_Signal_Associate_F64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_F64)
   is
   begin
      Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_F64, F64 => Val));
   end Ghdl_Signal_Associate_F64;

   procedure Ghdl_Signal_Simple_Assign_F64 (Sign : Ghdl_Signal_Ptr;
                                            Val : Ghdl_F64)
   is
      Trans : Transaction_Acc;
   begin
      if not Sign.Flags.Has_Active
        and then Sign.Net = Net_One_Driver
        and then Val = Sign.Value.F64
        and then Sign.S.Drivers (0).First_Trans.Next = null
      then
         return;
      end if;

      Trans := new Transaction'
        (Kind => Trans_Value,
         Time => 0,
         Next => null,
         Val => Value_Union'(Mode => Mode_F64, F64 => Val));

      Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0);
   end Ghdl_Signal_Simple_Assign_F64;

   procedure Ghdl_Signal_Start_Assign_F64 (Sign : Ghdl_Signal_Ptr;
                                           Rej : Std_Time;
                                           Val : Ghdl_F64;
                                           After : Std_Time)
   is
      Trans : Transaction_Acc;
   begin
      Trans := new Transaction'
        (Kind => Trans_Value,
         Time => 0,
         Next => null,
         Val => Value_Union'(Mode => Mode_F64, F64 => Val));
      Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After);
   end Ghdl_Signal_Start_Assign_F64;

   procedure Ghdl_Signal_Next_Assign_F64 (Sign : Ghdl_Signal_Ptr;
                                          Val : Ghdl_F64;
                                          After : Std_Time)
   is
   begin
      Ghdl_Signal_Next_Assign
        (Sign, Value_Union'(Mode => Mode_F64, F64 => Val), After);
   end Ghdl_Signal_Next_Assign_F64;

   procedure Ghdl_Signal_Internal_Checks
   is
      Sig : Ghdl_Signal_Ptr;
   begin
      for I in Sig_Table.First .. Sig_Table.Last loop
         Sig := Sig_Table.Table (I);

         --  Check drivers.
         for J in 1 .. Sig.S.Nbr_Drivers loop
            declare
               Trans : Transaction_Acc;
            begin
               Trans := Sig.S.Drivers (J - 1).First_Trans;
               while Trans.Next /= null loop
                  if Trans.Next.Time < Trans.Time then
                     Internal_Error ("ghdl_signal_internal_checks: "
                                     & "bad transaction order");
                  end if;
                  Trans := Trans.Next;
               end loop;
               if Trans /= Sig.S.Drivers (J - 1).Last_Trans then
                  Internal_Error ("ghdl_signal_internal_checks: "
                                  & "last transaction mismatch");
               end if;
            end;
         end loop;
      end loop;
   end Ghdl_Signal_Internal_Checks;

   procedure Ghdl_Signal_Effective_Value (Targ : Ghdl_Signal_Ptr;
                                          Src : Ghdl_Signal_Ptr)
   is
   begin
      if Targ.S.Effective /= null then
         Error ("internal error: already effective value");
      end if;
      Targ.S.Effective := Src;
   end Ghdl_Signal_Effective_Value;

   Bit_Signal_Rti : aliased 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 => null);

   Boolean_Signal_Rti : aliased 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 => null);

   function Ghdl_Create_Signal_Attribute
     (Mode : Mode_Signal_Type; Time : Std_Time)
     return Ghdl_Signal_Ptr
   is
      Res : Ghdl_Signal_Ptr;
--      Sig_Type : Ghdl_Desc_Ptr;
   begin
      case Mode is
         when Mode_Transaction =>
            Sig_Rti := To_Ghdl_Rtin_Object_Acc
              (To_Ghdl_Rti_Access (Bit_Signal_Rti'Address));
         when Mode_Quiet
           | Mode_Stable =>
            Sig_Rti := To_Ghdl_Rtin_Object_Acc
              (To_Ghdl_Rti_Access (Boolean_Signal_Rti'Address));
         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),
         Mode, Null_Address, Null_Address);

      Last_Implicit_Signal := Res;

      if Mode /= Mode_Transaction then
         Res.S.Time := Time;
         Res.S.Attr_Trans := new Transaction'(Kind => Trans_Value,
                                              Time => 0,
                                              Next => null,
                                              Val => Res.Value);
      end if;

      if Time > 0 then
         Res.Flink := Future_List;
         Future_List := Res;
      end if;

      return Res;
   end Ghdl_Create_Signal_Attribute;

   function Ghdl_Create_Stable_Signal (Val : Std_Time) return Ghdl_Signal_Ptr
   is
   begin
      return Ghdl_Create_Signal_Attribute (Mode_Stable, Val);
   end Ghdl_Create_Stable_Signal;

   function Ghdl_Create_Quiet_Signal (Val : Std_Time) return Ghdl_Signal_Ptr