-- Netlist. -- Copyright (C) 2017 Tristan Gingold -- -- This file is part of GHDL. -- -- This program 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 Software Foundation; either version 2 of the License, or -- (at your option) any later version. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program; if not, write to the Free Software -- Foundation, Inc., 51 Franklin Street - Fifth Floor, Boston, -- MA 02110-1301, USA. with Std_Names; with Tables; with Netlists.Utils; use Netlists.Utils; with Netlists.Gates; package body Netlists is -- Names package Snames_Table is new Tables (Table_Component_Type => Sname_Record, Table_Index_Type => Sname, Table_Low_Bound => 0, Table_Initial => 1024); function New_Sname_User (Id : Name_Id) return Sname is begin Snames_Table.Append ((Kind => Sname_User, Prefix => No_Sname, Suffix => Uns32 (Id))); return Snames_Table.Last; end New_Sname_User; function New_Sname_Artificial (Id : Name_Id) return Sname is begin Snames_Table.Append ((Kind => Sname_Artificial, Prefix => No_Sname, Suffix => Uns32 (Id))); return Snames_Table.Last; end New_Sname_Artificial; function New_Sname (Prefix : Sname; Suffix : Name_Id) return Sname is begin Snames_Table.Append ((Kind => Sname_User, Prefix => Prefix, Suffix => Uns32 (Suffix))); return Snames_Table.Last; end New_Sname; function New_Sname_Version (Prefix : Sname; Ver : Uns32) return Sname is begin Snames_Table.Append ((Kind => Sname_Version, Prefix => Prefix, Suffix => Ver)); return Snames_Table.Last; end New_Sname_Version; function Is_Valid (Name : Sname) return Boolean is begin return Name > No_Sname and Name <= Snames_Table.Last; end Is_Valid; function Get_Sname_Kind (Name : Sname) return Sname_Kind is begin pragma Assert (Is_Valid (Name)); return Snames_Table.Table (Name).Kind; end Get_Sname_Kind; function Get_Sname_Prefix (Name : Sname) return Sname is begin pragma Assert (Is_Valid (Name)); return Snames_Table.Table (Name).Prefix; end Get_Sname_Prefix; procedure Set_Sname_Prefix (Name : Sname; Prefix : Sname) is begin pragma Assert (Is_Valid (Name)); Snames_Table.Table (Name).Prefix := Prefix; end Set_Sname_Prefix; function Get_Sname_Suffix (Name : Sname) return Name_Id is subtype Snames_Suffix is Sname_Kind range Sname_User .. Sname_Artificial; begin pragma Assert (Is_Valid (Name)); pragma Assert (Get_Sname_Kind (Name) in Snames_Suffix); return Name_Id (Snames_Table.Table (Name).Suffix); end Get_Sname_Suffix; function Get_Sname_Version (Name : Sname) return Uns32 is begin pragma Assert (Is_Valid (Name)); pragma Assert (Get_Sname_Kind (Name) = Sname_Version); return Snames_Table.Table (Name).Suffix; end Get_Sname_Version; function Get_Sname_Num (Name : Sname) return Uns32 is begin pragma Assert (Is_Valid (Name)); pragma Assert (Get_Sname_Kind (Name) = Sname_Artificial); return Snames_Table.Table (Name).Suffix; end Get_Sname_Num; -- Modules package Modules_Table is new Tables (Table_Component_Type => Module_Record, Table_Index_Type => Module, Table_Low_Bound => No_Module, Table_Initial => 1024); function New_Design (Name : Sname) return Module is Res : Module; Self : Instance; begin Modules_Table.Append ((Parent => No_Module, Name => Name, Id => Id_Design, First_Port_Desc => No_Port_Desc_Idx, Nbr_Inputs => 0, Nbr_Outputs => 0, First_Param_Desc => No_Param_Desc_Idx, Nbr_Params => 0, First_Sub_Module => No_Module, Last_Sub_Module => No_Module, Next_Sub_Module => No_Module, First_Instance => No_Instance, Last_Instance => No_Instance)); Res := Modules_Table.Last; Self := Create_Self_Instance (Res); pragma Unreferenced (Self); return Res; end New_Design; function Is_Valid (M : Module) return Boolean is begin return M > No_Module and then M <= Modules_Table.Last; end Is_Valid; function New_User_Module (Parent : Module; Name : Sname; Id : Module_Id; Nbr_Inputs : Port_Nbr; Nbr_Outputs : Port_Nbr; Nbr_Params : Param_Nbr := 0) return Module is pragma Assert (Is_Valid (Parent)); Parent_Rec : Module_Record renames Modules_Table.Table (Parent); Res : Module; begin Modules_Table.Append ((Parent => Parent, Name => Name, Id => Id, First_Port_Desc => No_Port_Desc_Idx, Nbr_Inputs => Nbr_Inputs, Nbr_Outputs => Nbr_Outputs, First_Param_Desc => No_Param_Desc_Idx, Nbr_Params => Nbr_Params, First_Sub_Module => No_Module, Last_Sub_Module => No_Module, Next_Sub_Module => No_Module, First_Instance => No_Instance, Last_Instance => No_Instance)); Res := Modules_Table.Last; -- Append if Parent_Rec.First_Sub_Module = No_Module then Parent_Rec.First_Sub_Module := Res; else Modules_Table.Table (Parent_Rec.Last_Sub_Module).Next_Sub_Module := Res; end if; Parent_Rec.Last_Sub_Module := Res; return Res; end New_User_Module; function Get_Module_Name (M : Module) return Sname is begin pragma Assert (Is_Valid (M)); return Modules_Table.Table (M).Name; end Get_Module_Name; function Get_Id (M : Module) return Module_Id is begin pragma Assert (Is_Valid (M)); return Modules_Table.Table (M).Id; end Get_Id; function Get_Nbr_Inputs (M : Module) return Port_Nbr is begin pragma Assert (Is_Valid (M)); return Modules_Table.Table (M).Nbr_Inputs; end Get_Nbr_Inputs; function Get_Nbr_Outputs (M : Module) return Port_Nbr is begin pragma Assert (Is_Valid (M)); return Modules_Table.Table (M).Nbr_Outputs; end Get_Nbr_Outputs; function Get_Nbr_Params (M : Module) return Param_Nbr is begin pragma Assert (Is_Valid (M)); return Modules_Table.Table (M).Nbr_Params; end Get_Nbr_Params; function Get_First_Port_Desc (M : Module) return Port_Desc_Idx is begin pragma Assert (Is_Valid (M)); return Modules_Table.Table (M).First_Port_Desc; end Get_First_Port_Desc; function Get_Input_First_Desc (M : Module) return Port_Desc_Idx is pragma Assert (Is_Valid (M)); begin return Modules_Table.Table (M).First_Port_Desc; end Get_Input_First_Desc; function Get_Output_First_Desc (M : Module) return Port_Desc_Idx is pragma Assert (Is_Valid (M)); begin return Modules_Table.Table (M).First_Port_Desc + Port_Desc_Idx (Modules_Table.Table (M).Nbr_Inputs); end Get_Output_First_Desc; function Get_Self_Instance (M : Module) return Instance is begin pragma Assert (Is_Valid (M)); return Modules_Table.Table (M).First_Instance; end Get_Self_Instance; function Get_First_Instance (M : Module) return Instance is First : constant Instance := Get_Self_Instance (M); begin if First = No_Instance then -- Empty module. return No_Instance; else return Get_Next_Instance (First); end if; end Get_First_Instance; function Get_First_Sub_Module (M : Module) return Module is begin pragma Assert (Is_Valid (M)); return Modules_Table.Table (M).First_Sub_Module; end Get_First_Sub_Module; function Get_Next_Sub_Module (M : Module) return Module is begin pragma Assert (Is_Valid (M)); return Modules_Table.Table (M).Next_Sub_Module; end Get_Next_Sub_Module; -- Instances package Instances_Table is new Tables (Table_Component_Type => Instance_Record, Table_Index_Type => Instance, Table_Low_Bound => No_Instance, Table_Initial => 1024); package Nets_Table is new Tables (Table_Component_Type => Net_Record, Table_Index_Type => Net, Table_Low_Bound => No_Net, Table_Initial => 1024); package Inputs_Table is new Tables (Table_Component_Type => Input_Record, Table_Index_Type => Input, Table_Low_Bound => No_Input, Table_Initial => 1024); package Params_Table is new Tables (Table_Component_Type => Uns32, Table_Index_Type => Param_Idx, Table_Low_Bound => No_Param_Idx, Table_Initial => 256); function Hash (Inst : Instance) return Hash_Value_Type is begin return Hash_Value_Type (Inst); end Hash; procedure Extract_All_Instances (M : Module; First_Instance : out Instance) is pragma Assert (Is_Valid (M)); M_Ent : Module_Record renames Modules_Table.Table (M); begin First_Instance := M_Ent.First_Instance; -- Clear the instance list. M_Ent.First_Instance := No_Instance; M_Ent.Last_Instance := No_Instance; end Extract_All_Instances; procedure Append_Instance (M : Module; Inst : Instance) is M_Ent : Module_Record renames Modules_Table.Table (M); begin if M_Ent.First_Instance = No_Instance then M_Ent.First_Instance := Inst; else Instances_Table.Table (M_Ent.Last_Instance).Next_Instance := Inst; end if; Instances_Table.Table (Inst).Prev_Instance := M_Ent.Last_Instance; M_Ent.Last_Instance := Inst; end Append_Instance; procedure Extract_Instance (Inst : Instance) is pragma Assert (Is_Valid (Inst)); Inst_Ent : Instance_Record renames Instances_Table.Table (Inst); M : constant Module := Inst_Ent.Parent; M_Ent : Module_Record renames Modules_Table.Table (M); begin if Inst_Ent.Prev_Instance /= No_Instance then Set_Next_Instance (Inst_Ent.Prev_Instance, Inst_Ent.Next_Instance); else pragma Assert (M_Ent.First_Instance = Inst); M_Ent.First_Instance := Inst_Ent.Next_Instance; end if; if Inst_Ent.Next_Instance /= No_Instance then Set_Prev_Instance (Inst_Ent.Next_Instance, Inst_Ent.Prev_Instance); else pragma Assert (M_Ent.Last_Instance = Inst); M_Ent.Last_Instance := Inst_Ent.Prev_Instance; end if; Inst_Ent.Prev_Instance := No_Instance; Inst_Ent.Next_Instance := No_Instance; end Extract_Instance; function Check_Connected (Inst : Instance) return Boolean is Nbr_Outputs : constant Port_Idx := Get_Nbr_Outputs (Inst); Nbr_Inputs : constant Port_Idx := Get_Nbr_Inputs (Inst); begin -- Check that all outputs are unused. if Nbr_Outputs > 1 then for K in 0 .. Nbr_Outputs - 1 loop if Is_Connected (Get_Output (Inst, K)) then return True; end if; end loop; end if; -- First disconnect inputs. if Nbr_Inputs > 0 then for K in 0 .. Nbr_Inputs - 1 loop if Get_Driver (Get_Input (Inst, K)) /= No_Net then return True; end if; end loop; end if; return False; end Check_Connected; procedure Remove_Instance (Inst : Instance) is begin pragma Assert (not Check_Connected (Inst)); Extract_Instance (Inst); end Remove_Instance; function New_Instance_Internal (Parent : Module; M : Module; Name : Sname; Nbr_Inputs : Port_Nbr; Nbr_Outputs : Port_Nbr; Nbr_Params : Param_Nbr) return Instance is pragma Assert (Is_Valid (Parent)); pragma Assert (Is_Valid (M)); Res : Instance; Inputs : constant Input := Inputs_Table.Allocate (Natural (Nbr_Inputs)); Outputs : constant Net := Nets_Table.Allocate (Natural (Nbr_Outputs)); Params : constant Param_Idx := Params_Table.Allocate (Natural (Nbr_Params)); begin Instances_Table.Append ((Parent => Parent, Next_Instance => No_Instance, Prev_Instance => No_Instance, Klass => M, Flag_Mark => False, Flag2 => False, Name => Name, First_Param => Params, First_Input => Inputs, First_Output => Outputs)); Res := Instances_Table.Last; -- Setup inputs. if Nbr_Inputs > 0 then for I in 0 .. Nbr_Inputs - 1 loop Inputs_Table.Table (Inputs + Input (I)) := (Parent => Res, Driver => No_Net, Next_Sink => No_Input); end loop; end if; -- Setup nets. if Nbr_Outputs > 0 then for I in 0 .. Nbr_Outputs - 1 loop Nets_Table.Table (Outputs + Net (I)) := (Parent => Res, First_Sink => No_Input, W => 0); end loop; end if; -- Init params (to 0). if Nbr_Params > 0 then for I in 0 .. Nbr_Params - 1 loop Params_Table.Table (Params + I) := 0; end loop; end if; return Res; end New_Instance_Internal; procedure Set_Outputs_Width_From_Desc (Inst : Instance; Nbr_Outputs : Port_Nbr; Outputs_Desc : Port_Desc_Idx) is begin if Nbr_Outputs > 0 then for I in 0 .. Nbr_Outputs - 1 loop Set_Width (Get_Output (Inst, I), Get_Port_Desc (Outputs_Desc + Port_Desc_Idx (I)).W); end loop; end if; end Set_Outputs_Width_From_Desc; function New_Instance (Parent : Module; M : Module; Name : Sname) return Instance is Nbr_Inputs : constant Port_Nbr := Get_Nbr_Inputs (M); Nbr_Outputs : constant Port_Nbr := Get_Nbr_Outputs (M); Nbr_Params : constant Param_Nbr := Get_Nbr_Params (M); Res : Instance; begin Res := New_Instance_Internal (Parent, M, Name, Nbr_Inputs, Nbr_Outputs, Nbr_Params); Set_Outputs_Width_From_Desc (Res, Nbr_Outputs, Get_Output_First_Desc (M)); -- Link instance Append_Instance (Parent, Res); return Res; end New_Instance; function New_Var_Instance (Parent : Module; M : Module; Name : Sname; Nbr_Inputs : Port_Nbr; Nbr_Outputs : Port_Nbr; Nbr_Params : Param_Nbr) return Instance is Res : Instance; begin Res := New_Instance_Internal (Parent, M, Name, Nbr_Inputs, Nbr_Outputs, Nbr_Params); -- Link instance Append_Instance (Parent, Res); return Res; end New_Var_Instance; function Create_Self_Instance (M : Module) return Instance is -- Can be done only once. pragma Assert (Get_Self_Instance (M) = No_Instance); Nbr_Inputs : constant Port_Nbr := Get_Nbr_Inputs (M); Nbr_Outputs : constant Port_Nbr := Get_Nbr_Outputs (M); Res : Instance; begin -- Swap inputs and outputs; no parameters. Res := New_Instance_Internal (M, M, Get_Module_Name (M), Nbr_Outputs, Nbr_Inputs, 0); Set_Outputs_Width_From_Desc (Res, Nbr_Inputs, Get_Input_First_Desc (M)); Append_Instance (M, Res); return Res; end Create_Self_Instance; function Is_Valid (I : Instance) return Boolean is begin return I > No_Instance and then I <= Instances_Table.Last; end Is_Valid; function Is_Self_Instance (I : Instance) return Boolean is Irec : Instance_Record renames Instances_Table.Table (I); begin return Irec.Parent = Irec.Klass; end Is_Self_Instance; procedure Free_Instance (Inst : Instance) is pragma Assert (Is_Valid (Inst)); begin Instances_Table.Table (Inst).Klass := Free_Module; end Free_Instance; function Get_Module (Inst : Instance) return Module is begin pragma Assert (Is_Valid (Inst)); return Instances_Table.Table (Inst).Klass; end Get_Module; function Get_Instance_Name (Inst : Instance) return Sname is begin pragma Assert (Is_Valid (Inst)); return Instances_Table.Table (Inst).Name; end Get_Instance_Name; function Get_Instance_Parent (Inst : Instance) return Module is begin pragma Assert (Is_Valid (Inst)); return Instances_Table.Table (Inst).Parent; end Get_Instance_Parent; function Get_Next_Instance (Inst : Instance) return Instance is begin pragma Assert (Is_Valid (Inst)); return Instances_Table.Table (Inst).Next_Instance; end Get_Next_Instance; procedure Set_Next_Instance (Inst : Instance; Next : Instance) is begin pragma Assert (Is_Valid (Inst)); Instances_Table.Table (Inst).Next_Instance := Next; end Set_Next_Instance; procedure Set_Prev_Instance (Inst : Instance; Prev : Instance) is begin pragma Assert (Is_Valid (Inst)); Instances_Table.Table (Inst).Prev_Instance := Prev; end Set_Prev_Instance; function Get_First_Output (Inst : Instance) return Net is begin pragma Assert (Is_Valid (Inst)); return Instances_Table.Table (Inst).First_Output; end Get_First_Output; function Get_Output (Inst : Instance; Idx : Port_Idx) return Net is begin pragma Assert (Is_Valid (Inst)); pragma Assert (Idx < Get_Nbr_Outputs (Inst)); return Instances_Table.Table (Inst).First_Output + Net (Idx); end Get_Output; function Get_Input (Inst : Instance; Idx : Port_Idx) return Input is begin pragma Assert (Is_Valid (Inst)); pragma Assert (Idx < Get_Nbr_Inputs (Inst)); return Instances_Table.Table (Inst).First_Input + Input (Idx); end Get_Input; -- Nets function Is_Valid (N : Net) return Boolean is begin return N > No_Net and then N <= Nets_Table.Last; end Is_Valid; function Get_Net_Parent (O : Net) return Instance is begin pragma Assert (Is_Valid (O)); return Nets_Table.Table (O).Parent; end Get_Net_Parent; function Get_Port_Idx (O : Net) return Port_Idx is pragma Assert (Is_Valid (O)); Parent : constant Instance := Get_Net_Parent (O); begin return Port_Idx (O - Instances_Table.Table (Parent).First_Output); end Get_Port_Idx; function Get_First_Sink (O : Net) return Input is begin pragma Assert (Is_Valid (O)); return Nets_Table.Table (O).First_Sink; end Get_First_Sink; function Get_Width (N : Net) return Width is pragma Assert (Is_Valid (N)); begin return Nets_Table.Table (N).W; end Get_Width; procedure Set_Width (N : Net; W : Width) is pragma Assert (Is_Valid (N)); begin if Nets_Table.Table (N).W /= No_Width then raise Internal_Error; end if; Nets_Table.Table (N).W := W; end Set_Width; -- Inputs function Is_Valid (N : Input) return Boolean is begin return N > No_Input and then N <= Inputs_Table.Last; end Is_Valid; function Get_Input_Parent (I : Input) return Instance is begin pragma Assert (Is_Valid (I)); return Inputs_Table.Table (I).Parent; end Get_Input_Parent; function Get_Port_Idx (I : Input) return Port_Idx is pragma Assert (Is_Valid (I)); Parent : constant Instance := Get_Input_Parent (I); begin return Port_Idx (I - Instances_Table.Table (Parent).First_Input); end Get_Port_Idx; function Get_Driver (I : Input) return Net is begin pragma Assert (Is_Valid (I)); return Inputs_Table.Table (I).Driver; end Get_Driver; function Get_Next_Sink (I : Input) return Input is begin pragma Assert (Is_Valid (I)); return Inputs_Table.Table (I).Next_Sink; end Get_Next_Sink; -- Port_Desc package Port_Desc_Table is new Tables (Table_Component_Type => Port_Desc, Table_Index_Type => Port_Desc_Idx, Table_Low_Bound => No_Port_Desc_Idx, Table_Initial => 1024); function Get_Port_Desc (Idx : Port_Desc_Idx) return Port_Desc is begin return Port_Desc_Table.Table (Idx); end Get_Port_Desc; function Get_Input_Desc (M : Module; I : Port_Idx) return Port_Desc is F : constant Port_Desc_Idx := Get_Input_First_Desc (M); pragma Assert (I < Get_Nbr_Inputs (M)); begin return Port_Desc_Table.Table (F + Port_Desc_Idx (I)); end Get_Input_Desc; function Get_Output_Desc (M : Module; O : Port_Idx) return Port_Desc is F : constant Port_Desc_Idx := Get_Output_First_Desc (M); pragma Assert (O < Get_Nbr_Outputs (M)); begin return Port_Desc_Table.Table (F + Port_Desc_Idx (O)); end Get_Output_Desc; procedure Set_Port_Desc (M : Module; Input_Descs : Port_Desc_Array; Output_Descs : Port_Desc_Array) is pragma Assert (Is_Valid (M)); pragma Assert (Input_Descs'Length = Get_Nbr_Inputs (M)); pragma Assert (Output_Descs'Length = Get_Nbr_Outputs (M)); begin pragma Assert (Modules_Table.Table (M).First_Port_Desc = No_Port_Desc_Idx); Modules_Table.Table (M).First_Port_Desc := Port_Desc_Table.Last + 1; for I of Input_Descs loop pragma Assert (I.Dir = Port_In); Port_Desc_Table.Append (I); end loop; for O of Output_Descs loop pragma Assert (O.Dir in Port_Outs); Port_Desc_Table.Append (O); end loop; end Set_Port_Desc; -- Param_Desc package Param_Desc_Table is new Tables (Table_Component_Type => Param_Desc, Table_Index_Type => Param_Desc_Idx, Table_Low_Bound => No_Param_Desc_Idx, Table_Initial => 256); procedure Set_Param_Desc (M : Module; Params : Param_Desc_Array) is pragma Assert (Is_Valid (M)); pragma Assert (Params'Length = Get_Nbr_Params (M)); begin pragma Assert (Modules_Table.Table (M).First_Param_Desc = No_Param_Desc_Idx); Modules_Table.Table (M).First_Param_Desc := Param_Desc_Table.Last + 1; for P of Params loop Param_Desc_Table.Append (P); end loop; end Set_Param_Desc; function Get_Param_Desc (M : Module; Param : Param_Idx) return Param_Desc is use Netlists.Gates; pragma Assert (Is_Valid (M)); begin case Get_Id (M) is when Id_Const_Bit | Id_Const_Log => return (No_Sname, Param_Uns32); when others => pragma Assert (Param < Get_Nbr_Params (M)); return Param_Desc_Table.Table (Modules_Table.Table (M).First_Param_Desc + Param_Desc_Idx (Param)); end case; end Get_Param_Desc; function Get_Mark_Flag (Inst : Instance) return Boolean is pragma Assert (Is_Valid (Inst)); begin return Instances_Table.Table (Inst).Flag_Mark; end Get_Mark_Flag; procedure Set_Mark_Flag (Inst : Instance; Flag : Boolean) is pragma Assert (Is_Valid (Inst)); begin Instances_Table.Table (Inst).Flag_Mark := Flag; end Set_Mark_Flag; function Get_Param_Idx (Inst : Instance; Param : Param_Idx) return Param_Idx is pragma Assert (Is_Valid (Inst)); pragma Assert (Param < Get_Nbr_Params (Inst)); begin return Instances_Table.Table (Inst).First_Param + Param; end Get_Param_Idx; function Get_Param_Uns32 (Inst : Instance; Param : Param_Idx) return Uns32 is pragma Assert (Is_Valid (Inst)); M : constant Module := Get_Module (Inst); pragma Assert (Param < Get_Nbr_Params (Inst)); pragma Assert (Get_Param_Desc (M, Param).Typ = Param_Uns32); begin return Params_Table.Table (Get_Param_Idx (Inst, Param)); end Get_Param_Uns32; procedure Set_Param_Uns32 (Inst : Instance; Param : Param_Idx; Val : Uns32) is pragma Assert (Is_Valid (Inst)); M : constant Module := Get_Module (Inst); pragma Assert (Param < Get_Nbr_Params (Inst)); pragma Assert (Get_Param_Desc (M, Param).Typ = Param_Uns32); begin Params_Table.Table (Get_Param_Idx (Inst, Param)) := Val; end Set_Param_Uns32; procedure Connect (I : Input; O : Net) is pragma Assert (Is_Valid (I)); pragma Assert (Is_Valid (O)); -- Check Width compatibility -- pragma assert (get_width (i) = get_width (o)); pragma Assert (Get_Driver (I) = No_Net); I_Ent : Input_Record renames Inputs_Table.Table (I); O_Ent : Net_Record renames Nets_Table.Table (O); begin I_Ent.Driver := O; I_Ent.Next_Sink := O_Ent.First_Sink; O_Ent.First_Sink := I; end Connect; procedure Disconnect (I : Input) is pragma Assert (Is_Valid (I)); Drv : constant Net := Get_Driver (I); pragma Assert (Drv /= No_Net); Next_Sink : constant Input := Get_Next_Sink (I); I_Ent : Input_Record renames Inputs_Table.Table (I); D_Ent : Net_Record renames Nets_Table.Table (Drv); S, N_S : Input; begin I_Ent.Next_Sink := No_Input; I_Ent.Driver := No_Net; if D_Ent.First_Sink = I then -- Was the first sink. D_Ent.First_Sink := Next_Sink; else -- Walk S := D_Ent.First_Sink; loop pragma Assert (Is_Valid (S)); N_S := Get_Next_Sink (S); if N_S = I then Inputs_Table.Table (S).Next_Sink := Next_Sink; exit; else S := N_S; end if; end loop; end if; end Disconnect; procedure Redirect_Inputs (Old : Net; N : Net) is First_I, I : Input; Prev_I : Input; begin First_I := Get_First_Sink (Old); if First_I = No_Input then return; end if; I := First_I; Prev_I := No_Input; while I /= No_Input loop declare I_Rec : Input_Record renames Inputs_Table.Table (I); begin pragma Assert (I_Rec.Driver = Old); I_Rec.Driver := N; if Prev_I /= No_Input then Inputs_Table.Table (Prev_I).Next_Sink := I; end if; Prev_I := I; I := I_Rec.Next_Sink; end; end loop; if Prev_I /= No_Input then Inputs_Table.Table (Prev_I).Next_Sink := Get_First_Sink (N); Nets_Table.Table (N).First_Sink := First_I; end if; end Redirect_Inputs; begin -- Initialize snames_table: create the first entry for No_Sname. Snames_Table.Append ((Kind => Sname_Artificial, Prefix => No_Sname, Suffix => 0)); pragma Assert (Snames_Table.Last = No_Sname); Modules_Table.Append ((Parent => No_Module, Name => No_Sname, Id => Id_None, First_Port_Desc => No_Port_Desc_Idx, Nbr_Inputs => 0, Nbr_Outputs => 0, First_Param_Desc => No_Param_Desc_Idx, Nbr_Params => 0, First_Sub_Module => No_Module, Last_Sub_Module => No_Module, Next_Sub_Module => No_Module, First_Instance => No_Instance, Last_Instance => No_Instance)); pragma Assert (Modules_Table.Last = No_Module); Modules_Table.Append ((Parent => No_Module, Name => New_Sname_Artificial (Std_Names.Name_None), Id => Id_Free, First_Port_Desc => No_Port_Desc_Idx, Nbr_Inputs => 0, Nbr_Outputs => 0, First_Param_Desc => No_Param_Desc_Idx, Nbr_Params => 0, First_Sub_Module => No_Module, Last_Sub_Module => No_Module, Next_Sub_Module => No_Module, First_Instance => No_Instance, Last_Instance => No_Instance)); pragma Assert (Modules_Table.Last = Free_Module); Instances_Table.Append ((Parent => No_Module, Next_Instance => No_Instance, Prev_Instance => No_Instance, Klass => No_Module, Flag_Mark => False, Flag2 => False, Name => No_Sname, First_Param => No_Param_Idx, First_Input => No_Input, First_Output => No_Net)); pragma Assert (Instances_Table.Last = No_Instance); Nets_Table.Append ((Parent => No_Instance, First_Sink => No_Input, W => 0)); pragma Assert (Nets_Table.Last = No_Net); Inputs_Table.Append ((Parent => No_Instance, Driver => No_Net, Next_Sink => No_Input)); pragma Assert (Inputs_Table.Last = No_Input); Port_Desc_Table.Append ((Name => No_Sname, W => 0, Dir => Port_In)); pragma Assert (Port_Desc_Table.Last = No_Port_Desc_Idx); Param_Desc_Table.Append ((Name => No_Sname, Typ => Param_Uns32)); pragma Assert (Param_Desc_Table.Last = No_Param_Desc_Idx); Params_Table.Append (0); pragma Assert (Params_Table.Last = No_Param_Idx); end Netlists;