From 7791faea231292a261acfaf8e5a6c4f256744df3 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Wed, 15 May 2019 18:39:50 +0200 Subject: Add edif parser. --- src/edif/Makefile | 39 ++ src/edif/dump_edif.adb | 182 +++++++ src/edif/edif-disp_edif.adb | 292 +++++++++++ src/edif/edif-disp_edif.ads | 5 + src/edif/edif-nodes.adb | 1012 ++++++++++++++++++++++++++++++++++++ src/edif/edif-nodes.adb.in | 321 ++++++++++++ src/edif/edif-nodes.ads | 418 +++++++++++++++ src/edif/edif-nodes_meta.adb | 1062 ++++++++++++++++++++++++++++++++++++++ src/edif/edif-nodes_meta.adb.in | 76 +++ src/edif/edif-nodes_meta.ads | 191 +++++++ src/edif/edif-nodes_meta.ads.in | 70 +++ src/edif/edif-nutils.adb | 21 + src/edif/edif-nutils.ads | 15 + src/edif/edif-parse.adb | 1088 +++++++++++++++++++++++++++++++++++++++ src/edif/edif-parse.ads | 12 + src/edif/edif-scans.adb | 306 +++++++++++ src/edif/edif-scans.ads | 19 + src/edif/edif-tokens.ads | 15 + src/edif/edif.ads | 3 + 19 files changed, 5147 insertions(+) create mode 100644 src/edif/Makefile create mode 100644 src/edif/dump_edif.adb create mode 100644 src/edif/edif-disp_edif.adb create mode 100644 src/edif/edif-disp_edif.ads create mode 100644 src/edif/edif-nodes.adb create mode 100644 src/edif/edif-nodes.adb.in create mode 100644 src/edif/edif-nodes.ads create mode 100644 src/edif/edif-nodes_meta.adb create mode 100644 src/edif/edif-nodes_meta.adb.in create mode 100644 src/edif/edif-nodes_meta.ads create mode 100644 src/edif/edif-nodes_meta.ads.in create mode 100644 src/edif/edif-nutils.adb create mode 100644 src/edif/edif-nutils.ads create mode 100644 src/edif/edif-parse.adb create mode 100644 src/edif/edif-parse.ads create mode 100644 src/edif/edif-scans.adb create mode 100644 src/edif/edif-scans.ads create mode 100644 src/edif/edif-tokens.ads create mode 100644 src/edif/edif.ads diff --git a/src/edif/Makefile b/src/edif/Makefile new file mode 100644 index 000000000..7d2fa6980 --- /dev/null +++ b/src/edif/Makefile @@ -0,0 +1,39 @@ +GNATMAKE=gnatmake -j0 +CFLAGS=-g +GNAT_FLAGS=-aI.. -aI../vhdl -aI../psl -aI../grt -gnat05 -gnaty3befhkmr -gnata -gnatf -gnatwae $(CFLAGS) +BE=debug +ortho_srcdir=../ortho +GEN_SRCS=edif-nodes.adb edif-nodes_meta.ads edif-nodes_meta.adb +CC=gcc + +PNODES=../xtools/pnodes.py +PNODES_ARGS=--field-file=edif-nodes.adb.in --kind-file=edif-nodes.ads --node-file=edif-nodes.ads --template-file=edif-nodes.adb.in --meta-basename=edif-nodes_meta --kind-type=Nkind --kind-range-prefix=Nkinds_ --kind-prefix=N_ --node-type=Node + +all: dump_edif + + +dump_edif$(EXEEXT): $(GEN_SRCS) force + $(GNATMAKE) $(GNAT_FLAGS) dump_edif + +edif-nodes.adb: edif-nodes.adb.in edif-nodes.ads $(PNODES) + $(RM) -f $@ + $(PNODES) $(PNODES_ARGS) body > $@ + chmod a-w $@ + +edif-nodes_meta.ads: edif-nodes_meta.ads.in edif-nodes.ads $(PNODES) + $(RM) -f $@ + $(PNODES) $(PNODES_ARGS) meta_specs > $@ + chmod a-w $@ + +edif-nodes_meta.adb: edif-nodes_meta.adb.in edif-nodes.ads $(PNODES) + $(RM) -f $@ + $(PNODES) $(PNODES_ARGS) --keep-order meta_body > $@ + chmod a-w $@ + +clean: force + $(RM) -f *.o *.ali dump_edif *.cf b~*.ad? + +maintainer-clean: clean + $(RM) -f $(GEN_SRCS) + +force: diff --git a/src/edif/dump_edif.adb b/src/edif/dump_edif.adb new file mode 100644 index 000000000..129787364 --- /dev/null +++ b/src/edif/dump_edif.adb @@ -0,0 +1,182 @@ +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Command_Line; use Ada.Command_Line; +with Types; use Types; +with Name_Table; +with Std_Names; +with Files_Map; +with Str_Table; +with Errorout; +with Errorout.Console; +with Edif.Tokens; use Edif.Tokens; +with Edif.Scans; use Edif.Scans; +with Edif.Nodes; use Edif.Nodes; +with Edif.Parse; use Edif.Parse; +with Edif.Disp_Edif; + +procedure Dump_Edif is + procedure Usage is + begin + Put_Line ("usage: " & Command_Name & " [--scan|--raw] FILE"); + end Usage; + + procedure Error_Msg_Option (Msg : String) is + begin + Put_Line (Standard_Error, Msg); + raise Fatal_Error; + end Error_Msg_Option; + + N : Natural; + + type Cmd_Type is (Cmd_None, Cmd_Scan, Cmd_Raw); + Cmd : Cmd_Type; + + Id : Name_Id; + Dir_Id : Name_Id; + Sfe : Source_File_Entry; +begin + Set_Exit_Status (Failure); + + Errorout.Console.Install_Handler; + Errorout.Console.Set_Program_Name (Command_Name); + Std_Names.Std_Names_Initialize; + Files_Map.Initialize; + + -- Decode options. + Cmd := Cmd_None; + N := 1; + while N <= Argument_Count loop + declare + Opt : constant String := Argument (N); + begin + exit when Opt (1) /= '-' and Opt (1) /= '+'; + + if Opt = "--scan" then + Cmd := Cmd_Scan; + elsif Opt = "--raw" then + Cmd := Cmd_Raw; + else + Usage; + return; + end if; + end; + N := N + 1; + end loop; + + -- Stop now if no arguments. + if N > Argument_Count then + Usage; + return; + end if; + + -- Parse files on the command line. + while N <= Argument_Count loop + -- Load the file. + Id := Name_Table.Get_Identifier (Argument (N)); + Dir_Id := Null_Identifier; + Files_Map.Normalize_Pathname (Dir_Id, Id); + Sfe := Files_Map.Read_Source_File (Dir_Id, Id); + if Sfe = No_Source_File_Entry then + Error_Msg_Option ("cannot open " & Argument (N)); + end if; + + -- Parse file. + Set_File (Sfe); + + case Cmd is + when Cmd_Scan => + declare + Indent : Natural; + Need_Nl : Boolean; + Need_Sp : Boolean; + + procedure Maybe_Nl is + begin + if Need_Nl then + New_Line; + Put ((1 .. 2 * Indent => ' ')); + Need_Nl := False; + Need_Sp := False; + elsif Need_Sp then + Put (' '); + Need_Sp := False; + end if; + end Maybe_Nl; + begin + Indent := 0; + Need_Nl := False; + Need_Sp := False; + loop + Scan; + + case Current_Token is + when Tok_Keyword => + New_Line; + Put ((1 .. 2 * Indent => ' ')); + Need_Nl := False; + Put ('('); + Put (Name_Table.Image (Current_Identifier)); + Need_Sp := True; + Indent := Indent + 1; + when Tok_Right_Paren => + Put (')'); + Need_Nl := True; + Indent := Indent - 1; + when Tok_Symbol => + Maybe_Nl; + Put (Name_Table.Image (Current_Identifier)); + Need_Sp := True; + when Tok_String => + Maybe_Nl; + Put ('"'); + Put (Str_Table.String_String8 + (Current_String, Nat32 (Current_String_Len))); + Put ('"'); + Need_Sp := True; + when Tok_Number => + Maybe_Nl; + declare + S : constant String := Int32'Image (Current_Number); + F : Natural; + begin + if S (1) = ' ' then + F := 2; + else + F := 1; + end if; + Put (S (F .. S'Last)); + end; + Need_Sp := True; + when Tok_Eof => + exit; + end case; + end loop; + end; + when Cmd_Raw => + declare + T : Node; + begin + T := Parse_File_Simple; + if Errorout.Nbr_Errors > 0 then + raise Fatal_Error; + end if; + Edif.Disp_Edif.Disp_Node (T); + end; + when Cmd_None => + declare + T : Node; + begin + T := Parse_Edif200; + if Errorout.Nbr_Errors > 0 then + raise Fatal_Error; + end if; + Edif.Disp_Edif.Disp_Node (T); + end; + end case; + + N := N + 1; + end loop; + Set_Exit_Status (Success); +exception + when Fatal_Error => + null; +end Dump_Edif; diff --git a/src/edif/edif-disp_edif.adb b/src/edif/edif-disp_edif.adb new file mode 100644 index 000000000..ab3256916 --- /dev/null +++ b/src/edif/edif-disp_edif.adb @@ -0,0 +1,292 @@ +with Ada.Text_IO; use Ada.Text_IO; +with Types; use Types; +with Str_Table; +with Name_Table; + +package body Edif.Disp_Edif is + procedure Disp (N : Node; Indent : Natural); + + procedure Disp_Int32 (V : Int32) + is + S : constant String := Int32'Image (V); + begin + if S (1) = ' ' then + Put (S (2 .. S'Last)); + else + Put (S); + end if; + end Disp_Int32; + + procedure Disp_Symbol (S : Name_Id) + is + Img : constant String := Name_Table.Image (S); + begin + if Img (Img'First) not in 'a' .. 'z' then + Put ('&'); + end if; + Put (Img); + end Disp_Symbol; + + procedure Disp_Indent (Indent : Natural) is + begin + Put ((1 .. 2 * Indent => ' ')); + end Disp_Indent; + + procedure Disp_Chain (Chain : Node; Indent : Natural) + is + N : Node; + begin + N := Chain; + while N /= Null_Node loop + Disp (N, Indent); + N := Get_Chain (N); + end loop; + end Disp_Chain; + + procedure Disp_Keyword_Head (Name : String; Indent : Natural) is + begin + Disp_Indent (Indent); + Put ('('); + Put (Name); + Put (' '); + end Disp_Keyword_Head; + + procedure Disp_Keyword_Tail is + begin + Put (')'); + New_Line; + end Disp_Keyword_Tail; + + procedure Disp_Keyword (Name : String; Arg : Int32; Indent : Natural) is + begin + Disp_Keyword_Head (Name, Indent); + Disp_Int32 (Arg); + Disp_Keyword_Tail; + end Disp_Keyword; + + procedure Disp_Keyword (Name : String; Arg : Node; Indent : Natural) is + begin + Disp_Keyword_Head (Name, Indent); + Disp (Arg, Indent + 1); + Disp_Keyword_Tail; + end Disp_Keyword; + + procedure Disp_Keyword (Name : String; Arg : Name_Id; Indent : Natural) is + begin + Disp_Keyword_Head (Name, Indent); + Disp_Symbol (Arg); + Disp_Keyword_Tail; + end Disp_Keyword; + + procedure Disp_Decl_Head (Name : String; N : Node; Indent : Natural) is + begin + Disp_Keyword_Head (Name, Indent); + Disp (Get_Name (N), Indent); + New_Line; + end Disp_Decl_Head; + + procedure Disp_Decl_Tail (Indent : Natural) is + begin + Disp_Indent (Indent); + Disp_Keyword_Tail; + end Disp_Decl_Tail; + + procedure Disp_Opt (N : Node; Indent : Natural) is + begin + if N /= Null_Node then + Disp (N, Indent); + end if; + end Disp_Opt; + + procedure Disp (N : Node; Indent : Natural) is + begin + if N = Null_Node then + Put ("()"); + return; + end if; + + case Get_Kind (N) is + when N_Keyword => + declare + El : Node; + begin + New_Line; + Disp_Indent (Indent); + Put ('('); + Put (Name_Table.Image (Get_Keyword (N))); + El := Get_CDR (N); + while El /= Null_Node loop + Put (' '); + Disp (Get_CAR (El), Indent + 1); + El := Get_CDR (El); + end loop; + Put (')'); + end; + + when N_Symbol => + Disp_Symbol (Get_Symbol (N)); + + when N_Number => + Disp_Int32 (Get_Number (N)); + + when N_String => + Put ('"'); + Put (Str_Table.String_String8 + (Get_String_Id (N), Nat32 (Get_String_Len (N)))); + Put ('"'); + + when N_Edif => + Disp_Decl_Head ("edif", N, Indent); + Disp_Keyword ("edifversion", Get_Edif_Version (N), Indent + 1); + Disp_Keyword ("ediflevel", Get_Edif_Level (N), Indent + 1); + Disp_Keyword ("keywordmap", Get_Keyword_Map (N), Indent + 1); + Disp_Keyword ("status", Get_Status (N), Indent + 1); + Disp_Chain (Get_External_Chain (N), Indent + 1); + Disp_Chain (Get_Library_Chain (N), Indent + 1); + Disp (Get_Design (N), Indent + 1); + Disp_Decl_Tail (Indent); + + when N_Library => + Disp_Decl_Head ("library", N, Indent); + Disp_Keyword ("ediflevel", Get_Edif_Level (N), Indent + 1); + Disp_Keyword ("technology", Get_Technology (N), Indent + 1); + Disp_Chain (Get_Cells_Chain (N), Indent + 1); + Disp_Decl_Tail (Indent); + + when N_External => + Disp_Decl_Head ("external", N, Indent); + Disp_Keyword ("ediflevel", Get_Edif_Level (N), Indent + 1); + Disp_Keyword ("technology", Get_Technology (N), Indent + 1); + Disp_Chain (Get_Cells_Chain (N), Indent + 1); + Disp_Decl_Tail (Indent); + + when N_Cell => + Disp_Decl_Head ("cell", N, Indent); + Disp_Keyword ("celltype", Get_Cell_Type (N), Indent + 1); + Disp (Get_View (N), Indent + 1); + Disp_Decl_Tail (Indent); + + when N_View => + Disp_Decl_Head ("view", N, Indent); + Disp_Keyword ("viewtype", Get_View_Type (N), Indent + 1); + Disp (Get_Interface (N), Indent + 1); + declare + Contents : constant Node := Get_Contents_Chain (N); + begin + if Contents /= Null_Node then + Disp_Keyword_Head ("contents", Indent + 1); + New_Line; + Disp_Chain (Contents, Indent + 2); + Disp_Indent (Indent + 1); + Disp_Keyword_Tail; + end if; + end; + Disp_Decl_Tail (Indent); + + when N_Interface => + Disp_Keyword_Head ("interface", Indent); + New_Line; + Disp_Chain (Get_Ports_Chain (N), Indent + 1); + Disp_Chain (Get_Properties_Chain (N), Indent + 1); + Disp_Indent (Indent); + Disp_Keyword_Tail; + + when N_Port => + Disp_Decl_Head ("port", N, Indent); + Disp_Keyword_Head ("direction", Indent + 1); + case Get_Direction (N) is + when Dir_Input => + Put ("input"); + when Dir_Output => + Put ("output"); + when Dir_Inout => + Put ("inout"); + end case; + Disp_Keyword_Tail; + Disp_Decl_Tail (Indent); + + when N_Rename => + Put ("(rename "); + Disp (Get_Name (N), Indent); + Put (' '); + Disp (Get_String (N), Indent); + Put (')'); + + when N_Member => + Put ("(member "); + Disp (Get_Name (N), Indent); + Put (' '); + Disp_Int32 (Get_Index (N)); + Put (')'); + + when N_Array => + Put ("(array "); + Disp (Get_Name (N), Indent); + Put (' '); + Disp_Int32 (Get_Array_Length (N)); + Put (')'); + + when N_Instance => + Disp_Decl_Head ("instance", N, Indent); + Disp (Get_Instance_Ref (N), Indent + 1); + Disp_Chain (Get_Port_Instances_Chain (N), Indent + 1); + Disp_Chain (Get_Properties_Chain (N), Indent + 1); + Disp_Decl_Tail (Indent); + + when N_Net => + Disp_Decl_Head ("net", N, Indent); + Disp_Chain (Get_Joined_Chain (N), Indent + 1); + Disp_Decl_Tail (Indent); + + when N_View_Ref => + Disp_Decl_Head ("viewref", N, Indent); + Disp (Get_Cell_Ref (N), Indent + 1); + Disp_Decl_Tail (Indent); + + when N_Cell_Ref => + Disp_Keyword_Head ("cellref", Indent); + Disp (Get_Name (N), Indent); + Disp_Opt (Get_Library_Ref (N), Indent + 1); + Disp_Keyword_Tail; + + when N_Port_Ref => + Disp_Keyword_Head ("portref", Indent); + Disp (Get_Port (N), Indent); + Disp_Opt (Get_Instance_Ref (N), Indent + 1); + Disp_Keyword_Tail; + + when N_Property => + Disp_Keyword_Head ("property", Indent); + Disp (Get_Name (N), Indent); + Put (' '); + Disp (Get_Value (N), Indent); + Disp_Keyword_Tail; + + when N_Port_Instance => + Disp_Decl_Head ("portinstance", N, Indent); + Disp_Chain (Get_Properties_Chain (N), Indent + 1); + Disp_Decl_Tail (Indent); + + when N_Design => + Disp_Decl_Head ("design", N, Indent); + Disp (Get_Cell_Ref (N), Indent + 1); + Disp_Chain (Get_Properties_Chain (N), Indent + 1); + Disp_Decl_Tail (Indent); + + when N_Boolean => + if Get_Boolean (N) then + Put ("(true)"); + else + Put ("(false)"); + end if; + + when others => + Put ("??? " & Nkind'Image (Get_Kind (N))); + end case; + end Disp; + + procedure Disp_Node (N : Node) is + begin + Disp (N, 0); + end Disp_Node; +end Edif.Disp_Edif; diff --git a/src/edif/edif-disp_edif.ads b/src/edif/edif-disp_edif.ads new file mode 100644 index 000000000..519438852 --- /dev/null +++ b/src/edif/edif-disp_edif.ads @@ -0,0 +1,5 @@ +with Edif.Nodes; use Edif.Nodes; + +package Edif.Disp_Edif is + procedure Disp_Node (N : Node); +end Edif.Disp_Edif; diff --git a/src/edif/edif-nodes.adb b/src/edif/edif-nodes.adb new file mode 100644 index 000000000..62d0bc43f --- /dev/null +++ b/src/edif/edif-nodes.adb @@ -0,0 +1,1012 @@ +-- This is in fact -*- Ada -*- +with Ada.Unchecked_Conversion; +with Tables; +with Edif.Nodes_Meta; use Edif.Nodes_Meta; + +package body Edif.Nodes is + type Format_Type is + ( + Format_X1, + Format_X2, + Format_X4 + ); + + -- Common fields are: + -- Nkind : Kind_Type + -- State1 : Bit2_Type + -- Flag1 : Boolean + -- Flag2 : Boolean + -- Flag3 : Boolean + -- Flag4 : Boolean + -- Flag5 : Boolean + -- Flag6 : Boolean + -- Flag7 : Boolean + -- Flag8 : Boolean + -- Flag9 : Boolean + -- Flag10 : Boolean + -- Flag11 : Boolean + -- Flag12 : Boolean + -- Flag13 : Boolean + -- Flag14 : Boolean + -- Field0 : Node + -- Field1 : Node + -- Field2 : Node + + -- Fields of Format_X1: + + -- Fields of Format_X2: + -- Field3 : Node + -- Field4 : Node + -- Field5 : Node + + -- Fields of Format_X4: + -- Field3 : Node + -- Field4 : Node + -- Field5 : Node + -- Field6 : Node + -- Field7 : Node + -- Field8 : Node + -- Field9 : Node + -- Field10 : Node + -- Field11 : Node + + type Bit2_Type is range 0 .. 2 ** 2 - 1; + + type Node_Record is record + Kind : Nkind; -- 8 bits + State1 : Bit2_Type; + Flag1 : Boolean; + Flag2 : Boolean; + Flag3 : Boolean; + Flag4 : Boolean; + Flag5 : Boolean; + Flag6 : Boolean; + Flag7 : Boolean; + Flag8 : Boolean; + Flag9 : Boolean; + Flag10 : Boolean; + Flag11 : Boolean; + Flag12 : Boolean; + Flag13 : Boolean; + Flag14 : Boolean; + Flag15 : Boolean; + Flag16 : Boolean; + Flag17 : Boolean; + Flag18 : Boolean; + Flag19 : Boolean; + Flag20 : Boolean; + Flag21 : Boolean; + Flag22 : Boolean; + + Field0 : Node; + Field1 : Node; + Field2 : Node; + end record; + pragma Pack (Node_Record); + for Node_Record'Size use 4 * 32; + + package Nodet is new Tables + (Table_Component_Type => Node_Record, + Table_Index_Type => Node, + Table_Low_Bound => 2, + Table_Initial => 1024); + + Init_Node : constant Node_Record := + (Kind => N_Error, + Flag1 | Flag2 | Flag3 | Flag4 | Flag5 | Flag6 | Flag7 | Flag8 => False, + Flag9 | Flag10 | Flag11 | Flag12 | Flag13 | Flag14 | Flag15 => False, + Flag16 | Flag17 | Flag18 | Flag19 | Flag20 | Flag21 | Flag22 => False, + State1 => 0, + Field0 | Field1 | Field2 => 0); + + Free_Nodes : Node := Null_Node; + + + function Get_Last_Node return Node is + begin + return Nodet.Last; + end Get_Last_Node; + + function Node_To_Uns32 is new Ada.Unchecked_Conversion + (Source => Node, Target => Uns32); + function Uns32_To_Node is new Ada.Unchecked_Conversion + (Source => Uns32, Target => Node); + + function Node_To_Int32 is new Ada.Unchecked_Conversion + (Source => Node, Target => Int32); + function Int32_To_Node is new Ada.Unchecked_Conversion + (Source => Int32, Target => Node); + + function Bit2_Type_To_Direction_Type is new Ada.Unchecked_Conversion + (Bit2_Type, Direction_Type); + function Direction_Type_To_Bit2_Type is new Ada.Unchecked_Conversion + (Direction_Type, Bit2_Type); + + + function Node_To_Location_Type (N : Node) return Location_Type is + begin + return Location_Type (N); + end Node_To_Location_Type; + + function Location_Type_To_Node (L : Location_Type) return Node is + begin + return Node (L); + end Location_Type_To_Node; + + + procedure Set_Kind (N : Node; K : Nkind) is + begin + Nodet.Table (N).Kind := K; + end Set_Kind; + + function Get_Kind (N : Node) return Nkind is + begin + pragma Assert (N /= Null_Node, "get_kind: null node"); + return Nodet.Table (N).Kind; + end Get_Kind; + + procedure Set_State1 (N : Node; State : Bit2_Type) is + begin + Nodet.Table (N).State1 := State; + end Set_State1; + + function Get_State1 (N : Node) return Bit2_Type is + begin + return Nodet.Table (N).State1; + end Get_State1; + + + procedure Set_Flag1 (N : Node; Flag : Boolean) is + begin + Nodet.Table (N).Flag1 := Flag; + end Set_Flag1; + + function Get_Flag1 (N : Node) return Boolean is + begin + return Nodet.Table (N).Flag1; + end Get_Flag1; + + + procedure Set_Field0 (N : Node; V : Node) is + begin + Nodet.Table (N).Field0 := V; + end Set_Field0; + + function Get_Field0 (N : Node) return Node is + begin + return Nodet.Table (N).Field0; + end Get_Field0; + + + procedure Set_Field1 (N : Node; V : Node) is + begin + Nodet.Table (N).Field1 := V; + end Set_Field1; + + function Get_Field1 (N : Node) return Node is + begin + return Nodet.Table (N).Field1; + end Get_Field1; + + + procedure Set_Field2 (N : Node; V : Node) is + begin + Nodet.Table (N).Field2 := V; + end Set_Field2; + + function Get_Field2 (N : Node) return Node is + begin + return Nodet.Table (N).Field2; + end Get_Field2; + + + procedure Set_Field3 (N : Node; V : Node) is + begin + Nodet.Table (N + 1).Field0 := V; + end Set_Field3; + + function Get_Field3 (N : Node) return Node is + begin + return Nodet.Table (N + 1).Field0; + end Get_Field3; + + + procedure Set_Field4 (N : Node; V : Node) is + begin + Nodet.Table (N + 1).Field1 := V; + end Set_Field4; + + function Get_Field4 (N : Node) return Node is + begin + return Nodet.Table (N + 1).Field1; + end Get_Field4; + + + procedure Set_Field5 (N : Node; V : Node) is + begin + Nodet.Table (N + 1).Field2 := V; + end Set_Field5; + + function Get_Field5 (N : Node) return Node is + begin + return Nodet.Table (N + 1).Field2; + end Get_Field5; + + + procedure Set_Field6 (N : Node; V : Node) is + begin + Nodet.Table (N + 2).Field0 := V; + end Set_Field6; + + function Get_Field6 (N : Node) return Node is + begin + return Nodet.Table (N + 2).Field0; + end Get_Field6; + + + procedure Set_Field7 (N : Node; V : Node) is + begin + Nodet.Table (N + 2).Field1 := V; + end Set_Field7; + + function Get_Field7 (N : Node) return Node is + begin + return Nodet.Table (N + 2).Field1; + end Get_Field7; + + + procedure Set_Field8 (N : Node; V : Node) is + begin + Nodet.Table (N + 2).Field2 := V; + end Set_Field8; + + function Get_Field8 (N : Node) return Node is + begin + return Nodet.Table (N + 2).Field2; + end Get_Field8; + + + function Get_Format (Kind : Nkind) return Format_Type; + + function Create_Node (Kind : Nkind) return Node + is + Res : Node; + begin + case Get_Format (Kind) is + when Format_X1 => + if Free_Nodes /= Null_Node then + Res := Free_Nodes; + Free_Nodes := Get_Field1 (Res); + else + Nodet.Increment_Last; + Res := Nodet.Last; + end if; + when Format_X2 => + Res := Nodet.Allocate (2); + Nodet.Table (Res + 1) := Init_Node; + when Format_X4 => + Res := Nodet.Allocate (4); + Nodet.Table (Res + 1) := Init_Node; + Nodet.Table (Res + 2) := Init_Node; + Nodet.Table (Res + 3) := Init_Node; + end case; + Nodet.Table (Res) := Init_Node; + Set_Kind (Res, Kind); + return Res; + end Create_Node; + + procedure Free_Node (N : Node) + is + begin + -- FIXME: handle extended nodes. + Set_Kind (N, N_Error); + Set_Field1 (N, Free_Nodes); + Free_Nodes := N; + end Free_Node; + + function Get_Location (N : Node) return Location_Type is + begin + return Node_To_Location_Type (Get_Field0 (N)); + end Get_Location; + + procedure Set_Location (N : Node; Loc : Location_Type) is + begin + Set_Field0 (N, Location_Type_To_Node (Loc)); + end Set_Location; + + pragma Unreferenced (Get_Last_Node); + + -- Subprograms + function Get_Format (Kind : Nkind) return Format_Type is + begin + case Kind is + when N_Error + | N_Keyword + | N_Symbol + | N_Number + | N_String + | N_Chain + | N_Cell_Ref + | N_View_Ref + | N_Member + | N_Array + | N_Rename + | N_Boolean => + return Format_X1; + when N_External + | N_Cell + | N_Port + | N_Library + | N_Interface + | N_Instance + | N_Net + | N_Design + | N_Port_Ref + | N_Property + | N_Userdata + | N_Port_Instance => + return Format_X2; + when N_Edif + | N_View => + return Format_X4; + end case; + end Get_Format; + + function Get_CAR (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_CAR (Get_Kind (N)), + "no field CAR"); + return Get_Field1 (N); + end Get_CAR; + + procedure Set_CAR (N : Node; V : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_CAR (Get_Kind (N)), + "no field CAR"); + Set_Field1 (N, V); + end Set_CAR; + + function Get_CDR (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_CDR (Get_Kind (N)), + "no field CDR"); + return Get_Field2 (N); + end Get_CDR; + + procedure Set_CDR (N : Node; V : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_CDR (Get_Kind (N)), + "no field CDR"); + Set_Field2 (N, V); + end Set_CDR; + + function Get_Symbol (N : Node) return Name_Id is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Symbol (Get_Kind (N)), + "no field Symbol"); + return Name_Id'Val (Get_Field1 (N)); + end Get_Symbol; + + procedure Set_Symbol (N : Node; Id : Name_Id) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Symbol (Get_Kind (N)), + "no field Symbol"); + Set_Field1 (N, Name_Id'Pos (Id)); + end Set_Symbol; + + function Get_Keyword (N : Node) return Name_Id is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Keyword (Get_Kind (N)), + "no field Keyword"); + return Name_Id'Val (Get_Field1 (N)); + end Get_Keyword; + + procedure Set_Keyword (N : Node; Id : Name_Id) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Keyword (Get_Kind (N)), + "no field Keyword"); + Set_Field1 (N, Name_Id'Pos (Id)); + end Set_Keyword; + + function Get_Number (N : Node) return Int32 is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Number (Get_Kind (N)), + "no field Number"); + return Node_To_Int32 (Get_Field1 (N)); + end Get_Number; + + procedure Set_Number (N : Node; Val : Int32) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Number (Get_Kind (N)), + "no field Number"); + Set_Field1 (N, Int32_To_Node (Val)); + end Set_Number; + + function Get_String_Id (N : Node) return String8_Id is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_String_Id (Get_Kind (N)), + "no field String_Id"); + return String8_Id'Val (Get_Field1 (N)); + end Get_String_Id; + + procedure Set_String_Id (N : Node; Id : String8_Id) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_String_Id (Get_Kind (N)), + "no field String_Id"); + Set_Field1 (N, String8_Id'Pos (Id)); + end Set_String_Id; + + function Get_String_Len (N : Node) return Uns32 is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_String_Len (Get_Kind (N)), + "no field String_Len"); + return Node_To_Uns32 (Get_Field2 (N)); + end Get_String_Len; + + procedure Set_String_Len (N : Node; Bn : Uns32) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_String_Len (Get_Kind (N)), + "no field String_Len"); + Set_Field2 (N, Uns32_To_Node (Bn)); + end Set_String_Len; + + function Get_Name (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Name (Get_Kind (N)), + "no field Name"); + return Get_Field1 (N); + end Get_Name; + + procedure Set_Name (N : Node; Name : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Name (Get_Kind (N)), + "no field Name"); + Set_Field1 (N, Name); + end Set_Name; + + function Get_Edif_Level (N : Node) return Int32 is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Edif_Level (Get_Kind (N)), + "no field Edif_Level"); + return Node_To_Int32 (Get_Field2 (N)); + end Get_Edif_Level; + + procedure Set_Edif_Level (N : Node; Level : Int32) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Edif_Level (Get_Kind (N)), + "no field Edif_Level"); + Set_Field2 (N, Int32_To_Node (Level)); + end Set_Edif_Level; + + function Get_Edif_Version (N : Node) return Int32 is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Edif_Version (Get_Kind (N)), + "no field Edif_Version"); + return Node_To_Int32 (Get_Field3 (N)); + end Get_Edif_Version; + + procedure Set_Edif_Version (N : Node; Version : Int32) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Edif_Version (Get_Kind (N)), + "no field Edif_Version"); + Set_Field3 (N, Int32_To_Node (Version)); + end Set_Edif_Version; + + function Get_Keyword_Map (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Keyword_Map (Get_Kind (N)), + "no field Keyword_Map"); + return Get_Field4 (N); + end Get_Keyword_Map; + + procedure Set_Keyword_Map (N : Node; Map : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Keyword_Map (Get_Kind (N)), + "no field Keyword_Map"); + Set_Field4 (N, Map); + end Set_Keyword_Map; + + function Get_Status (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Status (Get_Kind (N)), + "no field Status"); + return Get_Field5 (N); + end Get_Status; + + procedure Set_Status (N : Node; Status : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Status (Get_Kind (N)), + "no field Status"); + Set_Field5 (N, Status); + end Set_Status; + + function Get_Chain (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Chain (Get_Kind (N)), + "no field Chain"); + return Get_Field5 (N); + end Get_Chain; + + procedure Set_Chain (N : Node; Chain : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Chain (Get_Kind (N)), + "no field Chain"); + Set_Field5 (N, Chain); + end Set_Chain; + + function Get_External_Chain (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_External_Chain (Get_Kind (N)), + "no field External_Chain"); + return Get_Field6 (N); + end Get_External_Chain; + + procedure Set_External_Chain (N : Node; Chain : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_External_Chain (Get_Kind (N)), + "no field External_Chain"); + Set_Field6 (N, Chain); + end Set_External_Chain; + + function Get_Library_Chain (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Library_Chain (Get_Kind (N)), + "no field Library_Chain"); + return Get_Field7 (N); + end Get_Library_Chain; + + procedure Set_Library_Chain (N : Node; Chain : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Library_Chain (Get_Kind (N)), + "no field Library_Chain"); + Set_Field7 (N, Chain); + end Set_Library_Chain; + + function Get_Cells_Chain (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Cells_Chain (Get_Kind (N)), + "no field Cells_Chain"); + return Get_Field4 (N); + end Get_Cells_Chain; + + procedure Set_Cells_Chain (N : Node; Chain : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Cells_Chain (Get_Kind (N)), + "no field Cells_Chain"); + Set_Field4 (N, Chain); + end Set_Cells_Chain; + + function Get_Ports_Chain (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Ports_Chain (Get_Kind (N)), + "no field Ports_Chain"); + return Get_Field2 (N); + end Get_Ports_Chain; + + procedure Set_Ports_Chain (N : Node; Chain : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Ports_Chain (Get_Kind (N)), + "no field Ports_Chain"); + Set_Field2 (N, Chain); + end Set_Ports_Chain; + + function Get_Contents_Chain (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Contents_Chain (Get_Kind (N)), + "no field Contents_Chain"); + return Get_Field4 (N); + end Get_Contents_Chain; + + procedure Set_Contents_Chain (N : Node; Chain : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Contents_Chain (Get_Kind (N)), + "no field Contents_Chain"); + Set_Field4 (N, Chain); + end Set_Contents_Chain; + + function Get_Properties_Chain (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Properties_Chain (Get_Kind (N)), + "no field Properties_Chain"); + return Get_Field3 (N); + end Get_Properties_Chain; + + procedure Set_Properties_Chain (N : Node; Chain : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Properties_Chain (Get_Kind (N)), + "no field Properties_Chain"); + Set_Field3 (N, Chain); + end Set_Properties_Chain; + + function Get_Port_Instances_Chain (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Port_Instances_Chain (Get_Kind (N)), + "no field Port_Instances_Chain"); + return Get_Field4 (N); + end Get_Port_Instances_Chain; + + procedure Set_Port_Instances_Chain (N : Node; Chain : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Port_Instances_Chain (Get_Kind (N)), + "no field Port_Instances_Chain"); + Set_Field4 (N, Chain); + end Set_Port_Instances_Chain; + + function Get_Joined_Chain (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Joined_Chain (Get_Kind (N)), + "no field Joined_Chain"); + return Get_Field2 (N); + end Get_Joined_Chain; + + procedure Set_Joined_Chain (N : Node; Chain : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Joined_Chain (Get_Kind (N)), + "no field Joined_Chain"); + Set_Field2 (N, Chain); + end Set_Joined_Chain; + + function Get_Design (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Design (Get_Kind (N)), + "no field Design"); + return Get_Field8 (N); + end Get_Design; + + procedure Set_Design (N : Node; Design : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Design (Get_Kind (N)), + "no field Design"); + Set_Field8 (N, Design); + end Set_Design; + + function Get_Designator (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Designator (Get_Kind (N)), + "no field Designator"); + return Get_Field4 (N); + end Get_Designator; + + procedure Set_Designator (N : Node; Id : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Designator (Get_Kind (N)), + "no field Designator"); + Set_Field4 (N, Id); + end Set_Designator; + + function Get_Technology (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Technology (Get_Kind (N)), + "no field Technology"); + return Get_Field3 (N); + end Get_Technology; + + procedure Set_Technology (N : Node; Design : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Technology (Get_Kind (N)), + "no field Technology"); + Set_Field3 (N, Design); + end Set_Technology; + + function Get_Cell_Type (N : Node) return Name_Id is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Cell_Type (Get_Kind (N)), + "no field Cell_Type"); + return Name_Id'Val (Get_Field2 (N)); + end Get_Cell_Type; + + procedure Set_Cell_Type (N : Node; Ctype : Name_Id) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Cell_Type (Get_Kind (N)), + "no field Cell_Type"); + Set_Field2 (N, Name_Id'Pos (Ctype)); + end Set_Cell_Type; + + function Get_View_Type (N : Node) return Name_Id is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_View_Type (Get_Kind (N)), + "no field View_Type"); + return Name_Id'Val (Get_Field2 (N)); + end Get_View_Type; + + procedure Set_View_Type (N : Node; Vtype : Name_Id) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_View_Type (Get_Kind (N)), + "no field View_Type"); + Set_Field2 (N, Name_Id'Pos (Vtype)); + end Set_View_Type; + + function Get_Interface (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Interface (Get_Kind (N)), + "no field Interface"); + return Get_Field6 (N); + end Get_Interface; + + procedure Set_Interface (N : Node; Inter : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Interface (Get_Kind (N)), + "no field Interface"); + Set_Field6 (N, Inter); + end Set_Interface; + + function Get_View_Ref (N : Node) return Name_Id is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_View_Ref (Get_Kind (N)), + "no field View_Ref"); + return Name_Id'Val (Get_Field1 (N)); + end Get_View_Ref; + + procedure Set_View_Ref (N : Node; Ref : Name_Id) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_View_Ref (Get_Kind (N)), + "no field View_Ref"); + Set_Field1 (N, Name_Id'Pos (Ref)); + end Set_View_Ref; + + function Get_Cell_Ref (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Cell_Ref (Get_Kind (N)), + "no field Cell_Ref"); + return Get_Field2 (N); + end Get_Cell_Ref; + + procedure Set_Cell_Ref (N : Node; Ref : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Cell_Ref (Get_Kind (N)), + "no field Cell_Ref"); + Set_Field2 (N, Ref); + end Set_Cell_Ref; + + function Get_Library_Ref (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Library_Ref (Get_Kind (N)), + "no field Library_Ref"); + return Get_Field2 (N); + end Get_Library_Ref; + + procedure Set_Library_Ref (N : Node; Ref : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Library_Ref (Get_Kind (N)), + "no field Library_Ref"); + Set_Field2 (N, Ref); + end Set_Library_Ref; + + function Get_View (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_View (Get_Kind (N)), + "no field View"); + return Get_Field4 (N); + end Get_View; + + procedure Set_View (N : Node; View : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_View (Get_Kind (N)), + "no field View"); + Set_Field4 (N, View); + end Set_View; + + function Get_Direction (N : Node) return Direction_Type is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Direction (Get_Kind (N)), + "no field Direction"); + return Bit2_Type_To_Direction_Type (Get_State1 (N)); + end Get_Direction; + + procedure Set_Direction (N : Node; Dir : Direction_Type) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Direction (Get_Kind (N)), + "no field Direction"); + Set_State1 (N, Direction_Type_To_Bit2_Type (Dir)); + end Set_Direction; + + function Get_Boolean (N : Node) return Boolean is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Boolean (Get_Kind (N)), + "no field Boolean"); + return Get_Flag1 (N); + end Get_Boolean; + + procedure Set_Boolean (N : Node; Val : Boolean) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Boolean (Get_Kind (N)), + "no field Boolean"); + Set_Flag1 (N, Val); + end Set_Boolean; + + function Get_Value (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Value (Get_Kind (N)), + "no field Value"); + return Get_Field2 (N); + end Get_Value; + + procedure Set_Value (N : Node; Val : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Value (Get_Kind (N)), + "no field Value"); + Set_Field2 (N, Val); + end Set_Value; + + function Get_Owner (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Owner (Get_Kind (N)), + "no field Owner"); + return Get_Field3 (N); + end Get_Owner; + + procedure Set_Owner (N : Node; Owner : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Owner (Get_Kind (N)), + "no field Owner"); + Set_Field3 (N, Owner); + end Set_Owner; + + function Get_Instance_Ref (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Instance_Ref (Get_Kind (N)), + "no field Instance_Ref"); + return Get_Field2 (N); + end Get_Instance_Ref; + + procedure Set_Instance_Ref (N : Node; Ref : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Instance_Ref (Get_Kind (N)), + "no field Instance_Ref"); + Set_Field2 (N, Ref); + end Set_Instance_Ref; + + function Get_Port (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Port (Get_Kind (N)), + "no field Port"); + return Get_Field1 (N); + end Get_Port; + + procedure Set_Port (N : Node; Port : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Port (Get_Kind (N)), + "no field Port"); + Set_Field1 (N, Port); + end Set_Port; + + function Get_Index (N : Node) return Int32 is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Index (Get_Kind (N)), + "no field Index"); + return Node_To_Int32 (Get_Field2 (N)); + end Get_Index; + + procedure Set_Index (N : Node; Idx : Int32) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Index (Get_Kind (N)), + "no field Index"); + Set_Field2 (N, Int32_To_Node (Idx)); + end Set_Index; + + function Get_Array_Length (N : Node) return Int32 is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Array_Length (Get_Kind (N)), + "no field Array_Length"); + return Node_To_Int32 (Get_Field2 (N)); + end Get_Array_Length; + + procedure Set_Array_Length (N : Node; Len : Int32) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Array_Length (Get_Kind (N)), + "no field Array_Length"); + Set_Field2 (N, Int32_To_Node (Len)); + end Set_Array_Length; + + function Get_Unit (N : Node) return Name_Id is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Unit (Get_Kind (N)), + "no field Unit"); + return Name_Id'Val (Get_Field4 (N)); + end Get_Unit; + + procedure Set_Unit (N : Node; Unit : Name_Id) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_Unit (Get_Kind (N)), + "no field Unit"); + Set_Field4 (N, Name_Id'Pos (Unit)); + end Set_Unit; + + function Get_String (N : Node) return Node is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_String (Get_Kind (N)), + "no field String"); + return Get_Field2 (N); + end Get_String; + + procedure Set_String (N : Node; Str : Node) is + begin + pragma Assert (N /= Null_Node); + pragma Assert (Has_String (Get_Kind (N)), + "no field String"); + Set_Field2 (N, Str); + end Set_String; + + +end Edif.Nodes; diff --git a/src/edif/edif-nodes.adb.in b/src/edif/edif-nodes.adb.in new file mode 100644 index 000000000..7c371888e --- /dev/null +++ b/src/edif/edif-nodes.adb.in @@ -0,0 +1,321 @@ +-- This is in fact -*- Ada -*- +with Ada.Unchecked_Conversion; +with Tables; +with Edif.Nodes_Meta; use Edif.Nodes_Meta; + +package body Edif.Nodes is + type Format_Type is + ( + Format_X1, + Format_X2, + Format_X4 + ); + + -- Common fields are: + -- Nkind : Kind_Type + -- State1 : Bit2_Type + -- Flag1 : Boolean + -- Flag2 : Boolean + -- Flag3 : Boolean + -- Flag4 : Boolean + -- Flag5 : Boolean + -- Flag6 : Boolean + -- Flag7 : Boolean + -- Flag8 : Boolean + -- Flag9 : Boolean + -- Flag10 : Boolean + -- Flag11 : Boolean + -- Flag12 : Boolean + -- Flag13 : Boolean + -- Flag14 : Boolean + -- Field0 : Node + -- Field1 : Node + -- Field2 : Node + + -- Fields of Format_X1: + + -- Fields of Format_X2: + -- Field3 : Node + -- Field4 : Node + -- Field5 : Node + + -- Fields of Format_X4: + -- Field3 : Node + -- Field4 : Node + -- Field5 : Node + -- Field6 : Node + -- Field7 : Node + -- Field8 : Node + -- Field9 : Node + -- Field10 : Node + -- Field11 : Node + + type Bit2_Type is range 0 .. 2 ** 2 - 1; + + type Node_Record is record + Kind : Nkind; -- 8 bits + State1 : Bit2_Type; + Flag1 : Boolean; + Flag2 : Boolean; + Flag3 : Boolean; + Flag4 : Boolean; + Flag5 : Boolean; + Flag6 : Boolean; + Flag7 : Boolean; + Flag8 : Boolean; + Flag9 : Boolean; + Flag10 : Boolean; + Flag11 : Boolean; + Flag12 : Boolean; + Flag13 : Boolean; + Flag14 : Boolean; + Flag15 : Boolean; + Flag16 : Boolean; + Flag17 : Boolean; + Flag18 : Boolean; + Flag19 : Boolean; + Flag20 : Boolean; + Flag21 : Boolean; + Flag22 : Boolean; + + Field0 : Node; + Field1 : Node; + Field2 : Node; + end record; + pragma Pack (Node_Record); + for Node_Record'Size use 4 * 32; + + package Nodet is new Tables + (Table_Component_Type => Node_Record, + Table_Index_Type => Node, + Table_Low_Bound => 2, + Table_Initial => 1024); + + Init_Node : constant Node_Record := + (Kind => N_Error, + Flag1 | Flag2 | Flag3 | Flag4 | Flag5 | Flag6 | Flag7 | Flag8 => False, + Flag9 | Flag10 | Flag11 | Flag12 | Flag13 | Flag14 | Flag15 => False, + Flag16 | Flag17 | Flag18 | Flag19 | Flag20 | Flag21 | Flag22 => False, + State1 => 0, + Field0 | Field1 | Field2 => 0); + + Free_Nodes : Node := Null_Node; + + + function Get_Last_Node return Node is + begin + return Nodet.Last; + end Get_Last_Node; + + function Node_To_Uns32 is new Ada.Unchecked_Conversion + (Source => Node, Target => Uns32); + function Uns32_To_Node is new Ada.Unchecked_Conversion + (Source => Uns32, Target => Node); + + function Node_To_Int32 is new Ada.Unchecked_Conversion + (Source => Node, Target => Int32); + function Int32_To_Node is new Ada.Unchecked_Conversion + (Source => Int32, Target => Node); + + function Bit2_Type_To_Direction_Type is new Ada.Unchecked_Conversion + (Bit2_Type, Direction_Type); + function Direction_Type_To_Bit2_Type is new Ada.Unchecked_Conversion + (Direction_Type, Bit2_Type); + + + function Node_To_Location_Type (N : Node) return Location_Type is + begin + return Location_Type (N); + end Node_To_Location_Type; + + function Location_Type_To_Node (L : Location_Type) return Node is + begin + return Node (L); + end Location_Type_To_Node; + + + procedure Set_Kind (N : Node; K : Nkind) is + begin + Nodet.Table (N).Kind := K; + end Set_Kind; + + function Get_Kind (N : Node) return Nkind is + begin + pragma Assert (N /= Null_Node, "get_kind: null node"); + return Nodet.Table (N).Kind; + end Get_Kind; + + procedure Set_State1 (N : Node; State : Bit2_Type) is + begin + Nodet.Table (N).State1 := State; + end Set_State1; + + function Get_State1 (N : Node) return Bit2_Type is + begin + return Nodet.Table (N).State1; + end Get_State1; + + + procedure Set_Flag1 (N : Node; Flag : Boolean) is + begin + Nodet.Table (N).Flag1 := Flag; + end Set_Flag1; + + function Get_Flag1 (N : Node) return Boolean is + begin + return Nodet.Table (N).Flag1; + end Get_Flag1; + + + procedure Set_Field0 (N : Node; V : Node) is + begin + Nodet.Table (N).Field0 := V; + end Set_Field0; + + function Get_Field0 (N : Node) return Node is + begin + return Nodet.Table (N).Field0; + end Get_Field0; + + + procedure Set_Field1 (N : Node; V : Node) is + begin + Nodet.Table (N).Field1 := V; + end Set_Field1; + + function Get_Field1 (N : Node) return Node is + begin + return Nodet.Table (N).Field1; + end Get_Field1; + + + procedure Set_Field2 (N : Node; V : Node) is + begin + Nodet.Table (N).Field2 := V; + end Set_Field2; + + function Get_Field2 (N : Node) return Node is + begin + return Nodet.Table (N).Field2; + end Get_Field2; + + + procedure Set_Field3 (N : Node; V : Node) is + begin + Nodet.Table (N + 1).Field0 := V; + end Set_Field3; + + function Get_Field3 (N : Node) return Node is + begin + return Nodet.Table (N + 1).Field0; + end Get_Field3; + + + procedure Set_Field4 (N : Node; V : Node) is + begin + Nodet.Table (N + 1).Field1 := V; + end Set_Field4; + + function Get_Field4 (N : Node) return Node is + begin + return Nodet.Table (N + 1).Field1; + end Get_Field4; + + + procedure Set_Field5 (N : Node; V : Node) is + begin + Nodet.Table (N + 1).Field2 := V; + end Set_Field5; + + function Get_Field5 (N : Node) return Node is + begin + return Nodet.Table (N + 1).Field2; + end Get_Field5; + + + procedure Set_Field6 (N : Node; V : Node) is + begin + Nodet.Table (N + 2).Field0 := V; + end Set_Field6; + + function Get_Field6 (N : Node) return Node is + begin + return Nodet.Table (N + 2).Field0; + end Get_Field6; + + + procedure Set_Field7 (N : Node; V : Node) is + begin + Nodet.Table (N + 2).Field1 := V; + end Set_Field7; + + function Get_Field7 (N : Node) return Node is + begin + return Nodet.Table (N + 2).Field1; + end Get_Field7; + + + procedure Set_Field8 (N : Node; V : Node) is + begin + Nodet.Table (N + 2).Field2 := V; + end Set_Field8; + + function Get_Field8 (N : Node) return Node is + begin + return Nodet.Table (N + 2).Field2; + end Get_Field8; + + + function Get_Format (Kind : Nkind) return Format_Type; + + function Create_Node (Kind : Nkind) return Node + is + Res : Node; + begin + case Get_Format (Kind) is + when Format_X1 => + if Free_Nodes /= Null_Node then + Res := Free_Nodes; + Free_Nodes := Get_Field1 (Res); + else + Nodet.Increment_Last; + Res := Nodet.Last; + end if; + when Format_X2 => + Res := Nodet.Allocate (2); + Nodet.Table (Res + 1) := Init_Node; + when Format_X4 => + Res := Nodet.Allocate (4); + Nodet.Table (Res + 1) := Init_Node; + Nodet.Table (Res + 2) := Init_Node; + Nodet.Table (Res + 3) := Init_Node; + end case; + Nodet.Table (Res) := Init_Node; + Set_Kind (Res, Kind); + return Res; + end Create_Node; + + procedure Free_Node (N : Node) + is + begin + -- FIXME: handle extended nodes. + Set_Kind (N, N_Error); + Set_Field1 (N, Free_Nodes); + Free_Nodes := N; + end Free_Node; + + function Get_Location (N : Node) return Location_Type is + begin + return Node_To_Location_Type (Get_Field0 (N)); + end Get_Location; + + procedure Set_Location (N : Node; Loc : Location_Type) is + begin + Set_Field0 (N, Location_Type_To_Node (Loc)); + end Set_Location; + + pragma Unreferenced (Get_Last_Node); + + -- Subprograms + +end Edif.Nodes; diff --git a/src/edif/edif-nodes.ads b/src/edif/edif-nodes.ads new file mode 100644 index 000000000..78d413d0f --- /dev/null +++ b/src/edif/edif-nodes.ads @@ -0,0 +1,418 @@ +with Types; use Types; + +package Edif.Nodes is + + type Nkind is + ( + N_Error, + + -- Generic nodes. + N_Keyword, + N_Symbol, + N_Number, + N_String, + N_Chain, + + -- Edif 2.0.0 nodes + N_Edif, + N_External, + N_Cell, + N_View, + N_Port, + N_Library, + N_Interface, + N_Instance, + N_Net, + N_Design, + N_Port_Ref, + N_Cell_Ref, + N_View_Ref, + N_Member, + N_Property, + N_Userdata, + N_Port_Instance, + + N_Array, + N_Rename, + N_Boolean + + ); + + type Node is new Nat32; + for Node'Size use 32; + + Null_Node : constant Node := 0; + + type Direction_Type is + ( + Dir_Input, + Dir_Output, + Dir_Inout + ); + + -- The next line marks the start of the node description. + -- Start of Nkind. + + -- N_Error (X1) + + -- N_Keyword (X1) + -- Get/Set_Keyword (Field1) + -- + -- Get/Set_CDR (Field2) + + -- N_Chain (X1) + -- Get/Set_CAR (Field1) + -- + -- Get/Set_CDR (Field2) + + -- N_Symbol (X1) + -- Get/Set_Symbol (Field1) + + -- N_Number (X1) + -- Get/Set_Number (Field1) + + -- N_String (X1) + -- Get/Set_String_Id (Field1) + -- + -- Get/Set_String_Len (Field2) + + -- N_Edif (X4) + -- Get/Set_Name (Field1) + -- + -- Get/Set_Edif_Version (Field3) + -- + -- Get/Set_Edif_Level (Field2) + -- + -- Get/Set_Keyword_Map (Field4) + -- + -- Get/Set_Status (Field5) + -- + -- Get/Set_External_Chain (Field6) + -- + -- Get/Set_Library_Chain (Field7) + -- + -- Get/Set_Design (Field8) + + -- N_External (X2) + -- N_Library (X2) + -- Get/Set_Name (Field1) + -- + -- Get/Set_Edif_Level (Field2) + -- + -- Get/Set_Technology (Field3) + -- + -- Get/Set_Cells_Chain (Field4) + -- + -- Get/Set_Chain (Field5) + + -- N_Cell (X2) + -- Get/Set_Name (Field1) + -- + -- Get/Set_Cell_Type (Field2) + -- + -- Get/Set_Properties_Chain (Field3) + -- + -- Get/Set_View (Field4) + -- + -- Get/Set_Chain (Field5) + + -- N_Interface (X2) + -- Get/Set_Ports_Chain (Field2) + -- + -- Get/Set_Properties_Chain (Field3) + -- + -- Get/Set_Designator (Field4) + + -- N_View (X4) + -- Get/Set_Name (Field1) + -- + -- Get/Set_View_Type (Field2) + -- + -- Get/Set_Interface (Field6) + -- + -- Get/Set_Properties_Chain (Field3) + -- + -- Instances and nets. + -- Get/Set_Contents_Chain (Field4) + -- + -- Get/Set_Chain (Field5) + + -- N_Port (X2) + -- Get/Set_Name (Field1) + -- + -- Get/Set_Direction (State1) + -- + -- Get/Set_Properties_Chain (Field3) + -- + -- Get/Set_Designator (Field4) + -- + -- Get/Set_Chain (Field5) + + -- N_Property (X2) + -- Get/Set_Name (Field1) + -- + -- Get/Set_Value (Field2) + -- + -- Get/Set_Owner (Field3) + -- + -- Get/Set_Unit (Field4) + -- + -- Get/Set_Chain (Field5) + + -- N_Userdata (X2) + -- Get/Set_Name (Field1) + -- + -- Get/Set_CDR (Field2) + -- + -- Get/Set_Chain (Field5) + + -- N_Instance (X2) + -- Get/Set_Name (Field1) + -- + -- Get/Set_Instance_Ref (Field2) + -- + -- Get/Set_Port_Instances_Chain (Field4) + -- + -- Get/Set_Properties_Chain (Field3) + -- + -- Get/Set_Chain (Field5) + + -- N_Net (X2) + -- Get/Set_Name (Field1) + -- + -- Get/Set_Joined_Chain (Field2) + -- + -- Get/Set_Properties_Chain (Field3) + -- + -- Get/Set_Chain (Field5) + + -- N_Design (X2) + -- Get/Set_Name (Field1) + -- + -- Get/Set_Cell_Ref (Field2) + -- + -- Get/Set_Properties_Chain (Field3) + + -- N_Port_Ref (X2) + -- Get/Set_Port (Field1) + -- + -- Get/Set_Instance_Ref (Field2) + -- + -- Get/Set_Chain (Field5) + + -- N_View_Ref (X1) + -- + -- Get/Set_Name (Field1) + -- + -- Get/Set_Cell_Ref (Field2) + + -- N_Cell_Ref (X1) + -- Get/Set_Name (Field1) + -- + -- Get/Set_Library_Ref (Field2) + + -- N_Port_Instance (X2) + -- Get/Set_Name (Field1) + -- + -- Get/Set_Properties_Chain (Field3) + -- + -- Get/Set_Chain (Field5) + + -- N_Member (X1) + -- Get/Set_Name (Field1) + -- + -- Get/Set_Index (Field2) + + -- N_Array (X1) + -- Get/Set_Name (Field1) + -- + -- Get/Set_Array_Length (Field2) + + -- N_Rename (X1) + -- Get/Set_Name (Field1) + -- + -- Get/Set_String (Field2) + + -- N_Boolean (X1) + -- Get/Set_Boolean (Flag1) + + -- End of Nkind. + + -- General methods. + + function Create_Node (Kind : Nkind) return Node; + procedure Free_Node (N : Node); + + -- Note: use Field0 + function Get_Location (N : Node) return Location_Type; + procedure Set_Location (N : Node; Loc : Location_Type); + + function Get_Kind (N : Node) return Nkind; + + -- Field: Field1 + function Get_CAR (N : Node) return Node; + procedure Set_CAR (N : Node; V : Node); + + -- Field: Field2 + function Get_CDR (N : Node) return Node; + procedure Set_CDR (N : Node; V : Node); + + -- Field: Field1 (pos) + function Get_Symbol (N : Node) return Name_Id; + procedure Set_Symbol (N : Node; Id : Name_Id); + + -- Field: Field1 (pos) + function Get_Keyword (N : Node) return Name_Id; + procedure Set_Keyword (N : Node; Id : Name_Id); + + -- Field: Field1 (uc) + function Get_Number (N : Node) return Int32; + procedure Set_Number (N : Node; Val : Int32); + + -- Field: Field1 (pos) + function Get_String_Id (N : Node) return String8_Id; + procedure Set_String_Id (N : Node; Id : String8_Id); + + -- Field: Field2 (uc) + function Get_String_Len (N : Node) return Uns32; + procedure Set_String_Len (N : Node; Bn : Uns32); + + + -- Field: Field1 + function Get_Name (N : Node) return Node; + procedure Set_Name (N : Node; Name : Node); + + -- Field: Field2 (uc) + function Get_Edif_Level (N : Node) return Int32; + procedure Set_Edif_Level (N : Node; Level : Int32); + + -- Major*100 + Minor*10 + Release + -- Field: Field3 (uc) + function Get_Edif_Version (N : Node) return Int32; + procedure Set_Edif_Version (N : Node; Version : Int32); + + -- Field: Field4 + function Get_Keyword_Map (N : Node) return Node; + procedure Set_Keyword_Map (N : Node; Map : Node); + + -- Field: Field5 + function Get_Status (N : Node) return Node; + procedure Set_Status (N : Node; Status : Node); + + -- Field: Field5 Chain_Next + function Get_Chain (N : Node) return Node; + procedure Set_Chain (N : Node; Chain : Node); + + -- Field: Field6 Chain + function Get_External_Chain (N : Node) return Node; + procedure Set_External_Chain (N : Node; Chain : Node); + + -- Field: Field7 Chain + function Get_Library_Chain (N : Node) return Node; + procedure Set_Library_Chain (N : Node; Chain : Node); + + -- Field: Field4 Chain + function Get_Cells_Chain (N : Node) return Node; + procedure Set_Cells_Chain (N : Node; Chain : Node); + + -- Field: Field2 Chain + function Get_Ports_Chain (N : Node) return Node; + procedure Set_Ports_Chain (N : Node; Chain : Node); + + -- Field: Field4 Chain + function Get_Contents_Chain (N : Node) return Node; + procedure Set_Contents_Chain (N : Node; Chain : Node); + + -- Field: Field3 Chain + function Get_Properties_Chain (N : Node) return Node; + procedure Set_Properties_Chain (N : Node; Chain : Node); + + -- Field: Field4 Chain + function Get_Port_Instances_Chain (N : Node) return Node; + procedure Set_Port_Instances_Chain (N : Node; Chain : Node); + + -- Field: Field2 Chain + function Get_Joined_Chain (N : Node) return Node; + procedure Set_Joined_Chain (N : Node; Chain : Node); + + -- Field: Field8 + function Get_Design (N : Node) return Node; + procedure Set_Design (N : Node; Design : Node); + + -- Field: Field4 + function Get_Designator (N : Node) return Node; + procedure Set_Designator (N : Node; Id : Node); + + -- Field: Field3 + function Get_Technology (N : Node) return Node; + procedure Set_Technology (N : Node; Design : Node); + + -- Field: Field2 (pos) + function Get_Cell_Type (N : Node) return Name_Id; + procedure Set_Cell_Type (N : Node; Ctype : Name_Id); + + -- Field: Field2 (pos) + function Get_View_Type (N : Node) return Name_Id; + procedure Set_View_Type (N : Node; Vtype : Name_Id); + + -- Field: Field6 + function Get_Interface (N : Node) return Node; + procedure Set_Interface (N : Node; Inter : Node); + + -- Field: Field1 (pos) + function Get_View_Ref (N : Node) return Name_Id; + procedure Set_View_Ref (N : Node; Ref : Name_Id); + + -- Field: Field2 + function Get_Cell_Ref (N : Node) return Node; + procedure Set_Cell_Ref (N : Node; Ref : Node); + + -- Field: Field2 + function Get_Library_Ref (N : Node) return Node; + procedure Set_Library_Ref (N : Node; Ref : Node); + + -- Field: Field4 + function Get_View (N : Node) return Node; + procedure Set_View (N : Node; View : Node); + + -- Field: State1 (uc) + function Get_Direction (N : Node) return Direction_Type; + procedure Set_Direction (N : Node; Dir : Direction_Type); + + -- Field: Flag1 + function Get_Boolean (N : Node) return Boolean; + procedure Set_Boolean (N : Node; Val : Boolean); + + -- Field: Field2 + function Get_Value (N : Node) return Node; + procedure Set_Value (N : Node; Val : Node); + + -- Field: Field3 + function Get_Owner (N : Node) return Node; + procedure Set_Owner (N : Node; Owner : Node); + + -- Field: Field2 + function Get_Instance_Ref (N : Node) return Node; + procedure Set_Instance_Ref (N : Node; Ref : Node); + + -- Field: Field1 + function Get_Port (N : Node) return Node; + procedure Set_Port (N : Node; Port : Node); + + -- Field: Field2 (uc) + function Get_Index (N : Node) return Int32; + procedure Set_Index (N : Node; Idx : Int32); + + -- Field: Field2 (uc) + function Get_Array_Length (N : Node) return Int32; + procedure Set_Array_Length (N : Node; Len : Int32); + + -- Field: Field4 (pos) + function Get_Unit (N : Node) return Name_Id; + procedure Set_Unit (N : Node; Unit : Name_Id); + + -- Field: Field2 + function Get_String (N : Node) return Node; + procedure Set_String (N : Node; Str : Node); + +end Edif.Nodes; diff --git a/src/edif/edif-nodes_meta.adb b/src/edif/edif-nodes_meta.adb new file mode 100644 index 000000000..2b3368d31 --- /dev/null +++ b/src/edif/edif-nodes_meta.adb @@ -0,0 +1,1062 @@ +-- Meta description of nodes. +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +package body Edif.Nodes_Meta is + Fields_Type : constant array (Fields_Enum) of Types_Enum := + ( + Field_CAR => Type_Node, + Field_CDR => Type_Node, + Field_Symbol => Type_Name_Id, + Field_Keyword => Type_Name_Id, + Field_Number => Type_Int32, + Field_String_Id => Type_String8_Id, + Field_String_Len => Type_Uns32, + Field_Name => Type_Node, + Field_Edif_Level => Type_Int32, + Field_Edif_Version => Type_Int32, + Field_Keyword_Map => Type_Node, + Field_Status => Type_Node, + Field_Chain => Type_Node, + Field_External_Chain => Type_Node, + Field_Library_Chain => Type_Node, + Field_Cells_Chain => Type_Node, + Field_Ports_Chain => Type_Node, + Field_Contents_Chain => Type_Node, + Field_Properties_Chain => Type_Node, + Field_Port_Instances_Chain => Type_Node, + Field_Joined_Chain => Type_Node, + Field_Design => Type_Node, + Field_Designator => Type_Node, + Field_Technology => Type_Node, + Field_Cell_Type => Type_Name_Id, + Field_View_Type => Type_Name_Id, + Field_Interface => Type_Node, + Field_View_Ref => Type_Name_Id, + Field_Cell_Ref => Type_Node, + Field_Library_Ref => Type_Node, + Field_View => Type_Node, + Field_Direction => Type_Direction_Type, + Field_Boolean => Type_Boolean, + Field_Value => Type_Node, + Field_Owner => Type_Node, + Field_Instance_Ref => Type_Node, + Field_Port => Type_Node, + Field_Index => Type_Int32, + Field_Array_Length => Type_Int32, + Field_Unit => Type_Name_Id, + Field_String => Type_Node + ); + + function Get_Field_Type (F : Fields_Enum) return Types_Enum is + begin + return Fields_Type (F); + end Get_Field_Type; + + function Get_Field_Image (F : Fields_Enum) return String is + begin + case F is + when Field_CAR => + return "car"; + when Field_CDR => + return "cdr"; + when Field_Symbol => + return "symbol"; + when Field_Keyword => + return "keyword"; + when Field_Number => + return "number"; + when Field_String_Id => + return "string_id"; + when Field_String_Len => + return "string_len"; + when Field_Name => + return "name"; + when Field_Edif_Level => + return "edif_level"; + when Field_Edif_Version => + return "edif_version"; + when Field_Keyword_Map => + return "keyword_map"; + when Field_Status => + return "status"; + when Field_Chain => + return "chain"; + when Field_External_Chain => + return "external_chain"; + when Field_Library_Chain => + return "library_chain"; + when Field_Cells_Chain => + return "cells_chain"; + when Field_Ports_Chain => + return "ports_chain"; + when Field_Contents_Chain => + return "contents_chain"; + when Field_Properties_Chain => + return "properties_chain"; + when Field_Port_Instances_Chain => + return "port_instances_chain"; + when Field_Joined_Chain => + return "joined_chain"; + when Field_Design => + return "design"; + when Field_Designator => + return "designator"; + when Field_Technology => + return "technology"; + when Field_Cell_Type => + return "cell_type"; + when Field_View_Type => + return "view_type"; + when Field_Interface => + return "interface"; + when Field_View_Ref => + return "view_ref"; + when Field_Cell_Ref => + return "cell_ref"; + when Field_Library_Ref => + return "library_ref"; + when Field_View => + return "view"; + when Field_Direction => + return "direction"; + when Field_Boolean => + return "boolean"; + when Field_Value => + return "value"; + when Field_Owner => + return "owner"; + when Field_Instance_Ref => + return "instance_ref"; + when Field_Port => + return "port"; + when Field_Index => + return "index"; + when Field_Array_Length => + return "array_length"; + when Field_Unit => + return "unit"; + when Field_String => + return "string"; + end case; + end Get_Field_Image; + + function Get_Nkind_Image (K : Nkind) return String is + begin + case K is + when N_Error => + return "error"; + when N_Keyword => + return "keyword"; + when N_Symbol => + return "symbol"; + when N_Number => + return "number"; + when N_String => + return "string"; + when N_Chain => + return "chain"; + when N_Edif => + return "edif"; + when N_External => + return "external"; + when N_Cell => + return "cell"; + when N_View => + return "view"; + when N_Port => + return "port"; + when N_Library => + return "library"; + when N_Interface => + return "interface"; + when N_Instance => + return "instance"; + when N_Net => + return "net"; + when N_Design => + return "design"; + when N_Port_Ref => + return "port_ref"; + when N_Cell_Ref => + return "cell_ref"; + when N_View_Ref => + return "view_ref"; + when N_Member => + return "member"; + when N_Property => + return "property"; + when N_Userdata => + return "userdata"; + when N_Port_Instance => + return "port_instance"; + when N_Array => + return "array"; + when N_Rename => + return "rename"; + when N_Boolean => + return "boolean"; + end case; + end Get_Nkind_Image; + + function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute is + begin + case F is + when Field_CAR => + return Attr_None; + when Field_CDR => + return Attr_None; + when Field_Symbol => + return Attr_None; + when Field_Keyword => + return Attr_None; + when Field_Number => + return Attr_None; + when Field_String_Id => + return Attr_None; + when Field_String_Len => + return Attr_None; + when Field_Name => + return Attr_None; + when Field_Edif_Level => + return Attr_None; + when Field_Edif_Version => + return Attr_None; + when Field_Keyword_Map => + return Attr_None; + when Field_Status => + return Attr_None; + when Field_Chain => + return Attr_Chain_Next; + when Field_External_Chain => + return Attr_Chain; + when Field_Library_Chain => + return Attr_Chain; + when Field_Cells_Chain => + return Attr_Chain; + when Field_Ports_Chain => + return Attr_Chain; + when Field_Contents_Chain => + return Attr_Chain; + when Field_Properties_Chain => + return Attr_Chain; + when Field_Port_Instances_Chain => + return Attr_Chain; + when Field_Joined_Chain => + return Attr_Chain; + when Field_Design => + return Attr_None; + when Field_Designator => + return Attr_None; + when Field_Technology => + return Attr_None; + when Field_Cell_Type => + return Attr_None; + when Field_View_Type => + return Attr_None; + when Field_Interface => + return Attr_None; + when Field_View_Ref => + return Attr_None; + when Field_Cell_Ref => + return Attr_None; + when Field_Library_Ref => + return Attr_None; + when Field_View => + return Attr_None; + when Field_Direction => + return Attr_None; + when Field_Boolean => + return Attr_None; + when Field_Value => + return Attr_None; + when Field_Owner => + return Attr_None; + when Field_Instance_Ref => + return Attr_None; + when Field_Port => + return Attr_None; + when Field_Index => + return Attr_None; + when Field_Array_Length => + return Attr_None; + when Field_Unit => + return Attr_None; + when Field_String => + return Attr_None; + end case; + end Get_Field_Attribute; + + Fields_Of_Iir : constant Fields_Array := + ( + -- N_Error + -- N_Keyword + Field_Keyword, + Field_CDR, + -- N_Symbol + Field_Symbol, + -- N_Number + Field_Number, + -- N_String + Field_String_Id, + Field_String_Len, + -- N_Chain + Field_CAR, + Field_CDR, + -- N_Edif + Field_Name, + Field_Edif_Version, + Field_Edif_Level, + Field_Keyword_Map, + Field_Status, + Field_External_Chain, + Field_Library_Chain, + Field_Design, + -- N_External + Field_Name, + Field_Edif_Level, + Field_Technology, + Field_Cells_Chain, + Field_Chain, + -- N_Cell + Field_Name, + Field_Cell_Type, + Field_Properties_Chain, + Field_View, + Field_Chain, + -- N_View + Field_Name, + Field_View_Type, + Field_Interface, + Field_Properties_Chain, + Field_Contents_Chain, + Field_Chain, + -- N_Port + Field_Name, + Field_Direction, + Field_Properties_Chain, + Field_Designator, + Field_Chain, + -- N_Library + Field_Name, + Field_Edif_Level, + Field_Technology, + Field_Cells_Chain, + Field_Chain, + -- N_Interface + Field_Ports_Chain, + Field_Properties_Chain, + Field_Designator, + -- N_Instance + Field_Name, + Field_Instance_Ref, + Field_Port_Instances_Chain, + Field_Properties_Chain, + Field_Chain, + -- N_Net + Field_Name, + Field_Joined_Chain, + Field_Properties_Chain, + Field_Chain, + -- N_Design + Field_Name, + Field_Cell_Ref, + Field_Properties_Chain, + -- N_Port_Ref + Field_Port, + Field_Instance_Ref, + Field_Chain, + -- N_Cell_Ref + Field_Name, + Field_Library_Ref, + -- N_View_Ref + Field_Name, + Field_Cell_Ref, + -- N_Member + Field_Name, + Field_Index, + -- N_Property + Field_Name, + Field_Value, + Field_Owner, + Field_Unit, + Field_Chain, + -- N_Userdata + Field_Name, + Field_CDR, + Field_Chain, + -- N_Port_Instance + Field_Name, + Field_Properties_Chain, + Field_Chain, + -- N_Array + Field_Name, + Field_Array_Length, + -- N_Rename + Field_Name, + Field_String, + -- N_Boolean + Field_Boolean + ); + + Fields_Of_Iir_Last : constant array (Nkind) of Integer := + ( + N_Error => -1, + N_Keyword => 1, + N_Symbol => 2, + N_Number => 3, + N_String => 5, + N_Chain => 7, + N_Edif => 15, + N_External => 20, + N_Cell => 25, + N_View => 31, + N_Port => 36, + N_Library => 41, + N_Interface => 44, + N_Instance => 49, + N_Net => 53, + N_Design => 56, + N_Port_Ref => 59, + N_Cell_Ref => 61, + N_View_Ref => 63, + N_Member => 65, + N_Property => 70, + N_Userdata => 73, + N_Port_Instance => 76, + N_Array => 78, + N_Rename => 80, + N_Boolean => 81 + ); + + function Get_Fields (K : Nkind) return Fields_Array + is + First : Natural; + Last : Integer; + begin + if K = Nkind'First then + First := Fields_Of_Iir'First; + else + First := Fields_Of_Iir_Last (Nkind'Pred (K)) + 1; + end if; + Last := Fields_Of_Iir_Last (K); + return Fields_Of_Iir (First .. Last); + end Get_Fields; + + function Get_Boolean + (N : Node; F : Fields_Enum) return Boolean is + begin + pragma Assert (Fields_Type (F) = Type_Boolean); + case F is + when Field_Boolean => + return Get_Boolean (N); + when others => + raise Internal_Error; + end case; + end Get_Boolean; + + procedure Set_Boolean + (N : Node; F : Fields_Enum; V: Boolean) is + begin + pragma Assert (Fields_Type (F) = Type_Boolean); + case F is + when Field_Boolean => + Set_Boolean (N, V); + when others => + raise Internal_Error; + end case; + end Set_Boolean; + + function Get_Direction_Type + (N : Node; F : Fields_Enum) return Direction_Type is + begin + pragma Assert (Fields_Type (F) = Type_Direction_Type); + case F is + when Field_Direction => + return Get_Direction (N); + when others => + raise Internal_Error; + end case; + end Get_Direction_Type; + + procedure Set_Direction_Type + (N : Node; F : Fields_Enum; V: Direction_Type) is + begin + pragma Assert (Fields_Type (F) = Type_Direction_Type); + case F is + when Field_Direction => + Set_Direction (N, V); + when others => + raise Internal_Error; + end case; + end Set_Direction_Type; + + function Get_Int32 + (N : Node; F : Fields_Enum) return Int32 is + begin + pragma Assert (Fields_Type (F) = Type_Int32); + case F is + when Field_Number => + return Get_Number (N); + when Field_Edif_Level => + return Get_Edif_Level (N); + when Field_Edif_Version => + return Get_Edif_Version (N); + when Field_Index => + return Get_Index (N); + when Field_Array_Length => + return Get_Array_Length (N); + when others => + raise Internal_Error; + end case; + end Get_Int32; + + procedure Set_Int32 + (N : Node; F : Fields_Enum; V: Int32) is + begin + pragma Assert (Fields_Type (F) = Type_Int32); + case F is + when Field_Number => + Set_Number (N, V); + when Field_Edif_Level => + Set_Edif_Level (N, V); + when Field_Edif_Version => + Set_Edif_Version (N, V); + when Field_Index => + Set_Index (N, V); + when Field_Array_Length => + Set_Array_Length (N, V); + when others => + raise Internal_Error; + end case; + end Set_Int32; + + function Get_Name_Id + (N : Node; F : Fields_Enum) return Name_Id is + begin + pragma Assert (Fields_Type (F) = Type_Name_Id); + case F is + when Field_Symbol => + return Get_Symbol (N); + when Field_Keyword => + return Get_Keyword (N); + when Field_Cell_Type => + return Get_Cell_Type (N); + when Field_View_Type => + return Get_View_Type (N); + when Field_View_Ref => + return Get_View_Ref (N); + when Field_Unit => + return Get_Unit (N); + when others => + raise Internal_Error; + end case; + end Get_Name_Id; + + procedure Set_Name_Id + (N : Node; F : Fields_Enum; V: Name_Id) is + begin + pragma Assert (Fields_Type (F) = Type_Name_Id); + case F is + when Field_Symbol => + Set_Symbol (N, V); + when Field_Keyword => + Set_Keyword (N, V); + when Field_Cell_Type => + Set_Cell_Type (N, V); + when Field_View_Type => + Set_View_Type (N, V); + when Field_View_Ref => + Set_View_Ref (N, V); + when Field_Unit => + Set_Unit (N, V); + when others => + raise Internal_Error; + end case; + end Set_Name_Id; + + function Get_Node + (N : Node; F : Fields_Enum) return Node is + begin + pragma Assert (Fields_Type (F) = Type_Node); + case F is + when Field_CAR => + return Get_CAR (N); + when Field_CDR => + return Get_CDR (N); + when Field_Name => + return Get_Name (N); + when Field_Keyword_Map => + return Get_Keyword_Map (N); + when Field_Status => + return Get_Status (N); + when Field_Chain => + return Get_Chain (N); + when Field_External_Chain => + return Get_External_Chain (N); + when Field_Library_Chain => + return Get_Library_Chain (N); + when Field_Cells_Chain => + return Get_Cells_Chain (N); + when Field_Ports_Chain => + return Get_Ports_Chain (N); + when Field_Contents_Chain => + return Get_Contents_Chain (N); + when Field_Properties_Chain => + return Get_Properties_Chain (N); + when Field_Port_Instances_Chain => + return Get_Port_Instances_Chain (N); + when Field_Joined_Chain => + return Get_Joined_Chain (N); + when Field_Design => + return Get_Design (N); + when Field_Designator => + return Get_Designator (N); + when Field_Technology => + return Get_Technology (N); + when Field_Interface => + return Get_Interface (N); + when Field_Cell_Ref => + return Get_Cell_Ref (N); + when Field_Library_Ref => + return Get_Library_Ref (N); + when Field_View => + return Get_View (N); + when Field_Value => + return Get_Value (N); + when Field_Owner => + return Get_Owner (N); + when Field_Instance_Ref => + return Get_Instance_Ref (N); + when Field_Port => + return Get_Port (N); + when Field_String => + return Get_String (N); + when others => + raise Internal_Error; + end case; + end Get_Node; + + procedure Set_Node + (N : Node; F : Fields_Enum; V: Node) is + begin + pragma Assert (Fields_Type (F) = Type_Node); + case F is + when Field_CAR => + Set_CAR (N, V); + when Field_CDR => + Set_CDR (N, V); + when Field_Name => + Set_Name (N, V); + when Field_Keyword_Map => + Set_Keyword_Map (N, V); + when Field_Status => + Set_Status (N, V); + when Field_Chain => + Set_Chain (N, V); + when Field_External_Chain => + Set_External_Chain (N, V); + when Field_Library_Chain => + Set_Library_Chain (N, V); + when Field_Cells_Chain => + Set_Cells_Chain (N, V); + when Field_Ports_Chain => + Set_Ports_Chain (N, V); + when Field_Contents_Chain => + Set_Contents_Chain (N, V); + when Field_Properties_Chain => + Set_Properties_Chain (N, V); + when Field_Port_Instances_Chain => + Set_Port_Instances_Chain (N, V); + when Field_Joined_Chain => + Set_Joined_Chain (N, V); + when Field_Design => + Set_Design (N, V); + when Field_Designator => + Set_Designator (N, V); + when Field_Technology => + Set_Technology (N, V); + when Field_Interface => + Set_Interface (N, V); + when Field_Cell_Ref => + Set_Cell_Ref (N, V); + when Field_Library_Ref => + Set_Library_Ref (N, V); + when Field_View => + Set_View (N, V); + when Field_Value => + Set_Value (N, V); + when Field_Owner => + Set_Owner (N, V); + when Field_Instance_Ref => + Set_Instance_Ref (N, V); + when Field_Port => + Set_Port (N, V); + when Field_String => + Set_String (N, V); + when others => + raise Internal_Error; + end case; + end Set_Node; + + function Get_String8_Id + (N : Node; F : Fields_Enum) return String8_Id is + begin + pragma Assert (Fields_Type (F) = Type_String8_Id); + case F is + when Field_String_Id => + return Get_String_Id (N); + when others => + raise Internal_Error; + end case; + end Get_String8_Id; + + procedure Set_String8_Id + (N : Node; F : Fields_Enum; V: String8_Id) is + begin + pragma Assert (Fields_Type (F) = Type_String8_Id); + case F is + when Field_String_Id => + Set_String_Id (N, V); + when others => + raise Internal_Error; + end case; + end Set_String8_Id; + + function Get_Uns32 + (N : Node; F : Fields_Enum) return Uns32 is + begin + pragma Assert (Fields_Type (F) = Type_Uns32); + case F is + when Field_String_Len => + return Get_String_Len (N); + when others => + raise Internal_Error; + end case; + end Get_Uns32; + + procedure Set_Uns32 + (N : Node; F : Fields_Enum; V: Uns32) is + begin + pragma Assert (Fields_Type (F) = Type_Uns32); + case F is + when Field_String_Len => + Set_String_Len (N, V); + when others => + raise Internal_Error; + end case; + end Set_Uns32; + + function Has_CAR (K : Nkind) return Boolean is + begin + return K = N_Chain; + end Has_CAR; + + function Has_CDR (K : Nkind) return Boolean is + begin + case K is + when N_Keyword + | N_Chain + | N_Userdata => + return True; + when others => + return False; + end case; + end Has_CDR; + + function Has_Symbol (K : Nkind) return Boolean is + begin + return K = N_Symbol; + end Has_Symbol; + + function Has_Keyword (K : Nkind) return Boolean is + begin + return K = N_Keyword; + end Has_Keyword; + + function Has_Number (K : Nkind) return Boolean is + begin + return K = N_Number; + end Has_Number; + + function Has_String_Id (K : Nkind) return Boolean is + begin + return K = N_String; + end Has_String_Id; + + function Has_String_Len (K : Nkind) return Boolean is + begin + return K = N_String; + end Has_String_Len; + + function Has_Name (K : Nkind) return Boolean is + begin + case K is + when N_Edif + | N_External + | N_Cell + | N_View + | N_Port + | N_Library + | N_Instance + | N_Net + | N_Design + | N_Cell_Ref + | N_View_Ref + | N_Member + | N_Property + | N_Userdata + | N_Port_Instance + | N_Array + | N_Rename => + return True; + when others => + return False; + end case; + end Has_Name; + + function Has_Edif_Level (K : Nkind) return Boolean is + begin + case K is + when N_Edif + | N_External + | N_Library => + return True; + when others => + return False; + end case; + end Has_Edif_Level; + + function Has_Edif_Version (K : Nkind) return Boolean is + begin + return K = N_Edif; + end Has_Edif_Version; + + function Has_Keyword_Map (K : Nkind) return Boolean is + begin + return K = N_Edif; + end Has_Keyword_Map; + + function Has_Status (K : Nkind) return Boolean is + begin + return K = N_Edif; + end Has_Status; + + function Has_Chain (K : Nkind) return Boolean is + begin + case K is + when N_External + | N_Cell + | N_View + | N_Port + | N_Library + | N_Instance + | N_Net + | N_Port_Ref + | N_Property + | N_Userdata + | N_Port_Instance => + return True; + when others => + return False; + end case; + end Has_Chain; + + function Has_External_Chain (K : Nkind) return Boolean is + begin + return K = N_Edif; + end Has_External_Chain; + + function Has_Library_Chain (K : Nkind) return Boolean is + begin + return K = N_Edif; + end Has_Library_Chain; + + function Has_Cells_Chain (K : Nkind) return Boolean is + begin + case K is + when N_External + | N_Library => + return True; + when others => + return False; + end case; + end Has_Cells_Chain; + + function Has_Ports_Chain (K : Nkind) return Boolean is + begin + return K = N_Interface; + end Has_Ports_Chain; + + function Has_Contents_Chain (K : Nkind) return Boolean is + begin + return K = N_View; + end Has_Contents_Chain; + + function Has_Properties_Chain (K : Nkind) return Boolean is + begin + case K is + when N_Cell + | N_View + | N_Port + | N_Interface + | N_Instance + | N_Net + | N_Design + | N_Port_Instance => + return True; + when others => + return False; + end case; + end Has_Properties_Chain; + + function Has_Port_Instances_Chain (K : Nkind) return Boolean is + begin + return K = N_Instance; + end Has_Port_Instances_Chain; + + function Has_Joined_Chain (K : Nkind) return Boolean is + begin + return K = N_Net; + end Has_Joined_Chain; + + function Has_Design (K : Nkind) return Boolean is + begin + return K = N_Edif; + end Has_Design; + + function Has_Designator (K : Nkind) return Boolean is + begin + case K is + when N_Port + | N_Interface => + return True; + when others => + return False; + end case; + end Has_Designator; + + function Has_Technology (K : Nkind) return Boolean is + begin + case K is + when N_External + | N_Library => + return True; + when others => + return False; + end case; + end Has_Technology; + + function Has_Cell_Type (K : Nkind) return Boolean is + begin + return K = N_Cell; + end Has_Cell_Type; + + function Has_View_Type (K : Nkind) return Boolean is + begin + return K = N_View; + end Has_View_Type; + + function Has_Interface (K : Nkind) return Boolean is + begin + return K = N_View; + end Has_Interface; + + function Has_View_Ref (K : Nkind) return Boolean is + pragma Unreferenced (K); + begin + return False; + end Has_View_Ref; + + function Has_Cell_Ref (K : Nkind) return Boolean is + begin + case K is + when N_Design + | N_View_Ref => + return True; + when others => + return False; + end case; + end Has_Cell_Ref; + + function Has_Library_Ref (K : Nkind) return Boolean is + begin + return K = N_Cell_Ref; + end Has_Library_Ref; + + function Has_View (K : Nkind) return Boolean is + begin + return K = N_Cell; + end Has_View; + + function Has_Direction (K : Nkind) return Boolean is + begin + return K = N_Port; + end Has_Direction; + + function Has_Boolean (K : Nkind) return Boolean is + begin + return K = N_Boolean; + end Has_Boolean; + + function Has_Value (K : Nkind) return Boolean is + begin + return K = N_Property; + end Has_Value; + + function Has_Owner (K : Nkind) return Boolean is + begin + return K = N_Property; + end Has_Owner; + + function Has_Instance_Ref (K : Nkind) return Boolean is + begin + case K is + when N_Instance + | N_Port_Ref => + return True; + when others => + return False; + end case; + end Has_Instance_Ref; + + function Has_Port (K : Nkind) return Boolean is + begin + return K = N_Port_Ref; + end Has_Port; + + function Has_Index (K : Nkind) return Boolean is + begin + return K = N_Member; + end Has_Index; + + function Has_Array_Length (K : Nkind) return Boolean is + begin + return K = N_Array; + end Has_Array_Length; + + function Has_Unit (K : Nkind) return Boolean is + begin + return K = N_Property; + end Has_Unit; + + function Has_String (K : Nkind) return Boolean is + begin + return K = N_Rename; + end Has_String; + +end Edif.Nodes_Meta; diff --git a/src/edif/edif-nodes_meta.adb.in b/src/edif/edif-nodes_meta.adb.in new file mode 100644 index 000000000..77a22ea88 --- /dev/null +++ b/src/edif/edif-nodes_meta.adb.in @@ -0,0 +1,76 @@ +-- Meta description of nodes. +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +package body Edif.Nodes_Meta is + Fields_Type : constant array (Fields_Enum) of Types_Enum := + ( + -- FIELDS_TYPE + ); + + function Get_Field_Type (F : Fields_Enum) return Types_Enum is + begin + return Fields_Type (F); + end Get_Field_Type; + + function Get_Field_Image (F : Fields_Enum) return String is + begin + case F is + -- FIELD_IMAGE + end case; + end Get_Field_Image; + + function Get_Nkind_Image (K : Nkind) return String is + begin + case K is + -- IIR_IMAGE + end case; + end Get_Nkind_Image; + + function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute is + begin + case F is + -- FIELD_ATTRIBUTE + end case; + end Get_Field_Attribute; + + Fields_Of_Iir : constant Fields_Array := + ( + -- FIELDS_ARRAY + ); + + Fields_Of_Iir_Last : constant array (Nkind) of Integer := + ( + -- FIELDS_ARRAY_POS + ); + + function Get_Fields (K : Nkind) return Fields_Array + is + First : Natural; + Last : Integer; + begin + if K = Nkind'First then + First := Fields_Of_Iir'First; + else + First := Fields_Of_Iir_Last (Nkind'Pred (K)) + 1; + end if; + Last := Fields_Of_Iir_Last (K); + return Fields_Of_Iir (First .. Last); + end Get_Fields; + + -- FUNCS_BODY +end Edif.Nodes_Meta; diff --git a/src/edif/edif-nodes_meta.ads b/src/edif/edif-nodes_meta.ads new file mode 100644 index 000000000..b2422b044 --- /dev/null +++ b/src/edif/edif-nodes_meta.ads @@ -0,0 +1,191 @@ +-- Meta description of nodes. +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Types; use Types; +with Edif.Nodes; use Edif.Nodes; + +package Edif.Nodes_Meta is + -- The enumeration of all possible types in the nodes. + type Types_Enum is + ( + Type_Boolean, + Type_Direction_Type, + Type_Int32, + Type_Name_Id, + Type_Node, + Type_String8_Id, + Type_Uns32 + ); + + -- The enumeration of all fields defined in iirs. + type Fields_Enum is + ( + Field_CAR, + Field_CDR, + Field_Symbol, + Field_Keyword, + Field_Number, + Field_String_Id, + Field_String_Len, + Field_Name, + Field_Edif_Level, + Field_Edif_Version, + Field_Keyword_Map, + Field_Status, + Field_Chain, + Field_External_Chain, + Field_Library_Chain, + Field_Cells_Chain, + Field_Ports_Chain, + Field_Contents_Chain, + Field_Properties_Chain, + Field_Port_Instances_Chain, + Field_Joined_Chain, + Field_Design, + Field_Designator, + Field_Technology, + Field_Cell_Type, + Field_View_Type, + Field_Interface, + Field_View_Ref, + Field_Cell_Ref, + Field_Library_Ref, + Field_View, + Field_Direction, + Field_Boolean, + Field_Value, + Field_Owner, + Field_Instance_Ref, + Field_Port, + Field_Index, + Field_Array_Length, + Field_Unit, + Field_String + ); + pragma Discard_Names (Fields_Enum); + + -- Return the type of field F. + function Get_Field_Type (F : Fields_Enum) return Types_Enum; + + -- Get the name of a field. + function Get_Field_Image (F : Fields_Enum) return String; + + -- Get the name of a kind. + function Get_Nkind_Image (K : Nkind) return String; + + -- Possible attributes of a field. + type Field_Attribute is + ( + Attr_Maybe_Ref, Attr_Maybe_Ref2, + Attr_None, + Attr_Ref, Attr_Forward_Ref, + Attr_Chain, Attr_Chain_Next + ); + + -- Attributes without Maybe_Ref* + subtype Field_Actual_Attribute is Field_Attribute range + Attr_None .. Field_Attribute'Last; + + -- Get the attribute of a field. + function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute; + + type Fields_Array is array (Natural range <>) of Fields_Enum; + + -- Return the list of fields for node K. The fields are sorted: first + -- the non nodes/list of nodes, then the nodes/lists that aren't reference, + -- and then the reference. + function Get_Fields (K : Nkind) return Fields_Array; + + -- Get/Set a field. + function Get_Boolean + (N : Node; F : Fields_Enum) return Boolean; + procedure Set_Boolean + (N : Node; F : Fields_Enum; V: Boolean); + + function Get_Direction_Type + (N : Node; F : Fields_Enum) return Direction_Type; + procedure Set_Direction_Type + (N : Node; F : Fields_Enum; V: Direction_Type); + + function Get_Int32 + (N : Node; F : Fields_Enum) return Int32; + procedure Set_Int32 + (N : Node; F : Fields_Enum; V: Int32); + + function Get_Name_Id + (N : Node; F : Fields_Enum) return Name_Id; + procedure Set_Name_Id + (N : Node; F : Fields_Enum; V: Name_Id); + + function Get_Node + (N : Node; F : Fields_Enum) return Node; + procedure Set_Node + (N : Node; F : Fields_Enum; V: Node); + + function Get_String8_Id + (N : Node; F : Fields_Enum) return String8_Id; + procedure Set_String8_Id + (N : Node; F : Fields_Enum; V: String8_Id); + + function Get_Uns32 + (N : Node; F : Fields_Enum) return Uns32; + procedure Set_Uns32 + (N : Node; F : Fields_Enum; V: Uns32); + + function Has_CAR (K : Nkind) return Boolean; + function Has_CDR (K : Nkind) return Boolean; + function Has_Symbol (K : Nkind) return Boolean; + function Has_Keyword (K : Nkind) return Boolean; + function Has_Number (K : Nkind) return Boolean; + function Has_String_Id (K : Nkind) return Boolean; + function Has_String_Len (K : Nkind) return Boolean; + function Has_Name (K : Nkind) return Boolean; + function Has_Edif_Level (K : Nkind) return Boolean; + function Has_Edif_Version (K : Nkind) return Boolean; + function Has_Keyword_Map (K : Nkind) return Boolean; + function Has_Status (K : Nkind) return Boolean; + function Has_Chain (K : Nkind) return Boolean; + function Has_External_Chain (K : Nkind) return Boolean; + function Has_Library_Chain (K : Nkind) return Boolean; + function Has_Cells_Chain (K : Nkind) return Boolean; + function Has_Ports_Chain (K : Nkind) return Boolean; + function Has_Contents_Chain (K : Nkind) return Boolean; + function Has_Properties_Chain (K : Nkind) return Boolean; + function Has_Port_Instances_Chain (K : Nkind) return Boolean; + function Has_Joined_Chain (K : Nkind) return Boolean; + function Has_Design (K : Nkind) return Boolean; + function Has_Designator (K : Nkind) return Boolean; + function Has_Technology (K : Nkind) return Boolean; + function Has_Cell_Type (K : Nkind) return Boolean; + function Has_View_Type (K : Nkind) return Boolean; + function Has_Interface (K : Nkind) return Boolean; + function Has_View_Ref (K : Nkind) return Boolean; + function Has_Cell_Ref (K : Nkind) return Boolean; + function Has_Library_Ref (K : Nkind) return Boolean; + function Has_View (K : Nkind) return Boolean; + function Has_Direction (K : Nkind) return Boolean; + function Has_Boolean (K : Nkind) return Boolean; + function Has_Value (K : Nkind) return Boolean; + function Has_Owner (K : Nkind) return Boolean; + function Has_Instance_Ref (K : Nkind) return Boolean; + function Has_Port (K : Nkind) return Boolean; + function Has_Index (K : Nkind) return Boolean; + function Has_Array_Length (K : Nkind) return Boolean; + function Has_Unit (K : Nkind) return Boolean; + function Has_String (K : Nkind) return Boolean; +end Edif.Nodes_Meta; diff --git a/src/edif/edif-nodes_meta.ads.in b/src/edif/edif-nodes_meta.ads.in new file mode 100644 index 000000000..7bda6e481 --- /dev/null +++ b/src/edif/edif-nodes_meta.ads.in @@ -0,0 +1,70 @@ +-- Meta description of nodes. +-- Copyright (C) 2014 Tristan Gingold +-- +-- GHDL 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, or (at your option) any later +-- version. +-- +-- GHDL 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 GHDL; see the file COPYING. If not, write to the Free +-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA +-- 02111-1307, USA. + +with Types; use Types; +with Edif.Nodes; use Edif.Nodes; + +package Edif.Nodes_Meta is + -- The enumeration of all possible types in the nodes. + type Types_Enum is + ( + -- TYPES + ); + + -- The enumeration of all fields defined in iirs. + type Fields_Enum is + ( + -- FIELDS + ); + pragma Discard_Names (Fields_Enum); + + -- Return the type of field F. + function Get_Field_Type (F : Fields_Enum) return Types_Enum; + + -- Get the name of a field. + function Get_Field_Image (F : Fields_Enum) return String; + + -- Get the name of a kind. + function Get_Nkind_Image (K : Nkind) return String; + + -- Possible attributes of a field. + type Field_Attribute is + ( + Attr_Maybe_Ref, Attr_Maybe_Ref2, + Attr_None, + Attr_Ref, Attr_Forward_Ref, + Attr_Chain, Attr_Chain_Next + ); + + -- Attributes without Maybe_Ref* + subtype Field_Actual_Attribute is Field_Attribute range + Attr_None .. Field_Attribute'Last; + + -- Get the attribute of a field. + function Get_Field_Attribute (F : Fields_Enum) return Field_Attribute; + + type Fields_Array is array (Natural range <>) of Fields_Enum; + + -- Return the list of fields for node K. The fields are sorted: first + -- the non nodes/list of nodes, then the nodes/lists that aren't reference, + -- and then the reference. + function Get_Fields (K : Nkind) return Fields_Array; + + -- Get/Set a field. + -- FUNCS +end Edif.Nodes_Meta; diff --git a/src/edif/edif-nutils.adb b/src/edif/edif-nutils.adb new file mode 100644 index 000000000..c7755dc08 --- /dev/null +++ b/src/edif/edif-nutils.adb @@ -0,0 +1,21 @@ +package body Edif.Nutils is + procedure Init_Constr (Constr : out Constr_Type) is + begin + Constr := (Null_Node, Null_Node); + end Init_Constr; + + procedure Append_Node (Constr : in out Constr_Type; N : Node) is + begin + if Constr.First = Null_Node then + Constr.First := N; + else + Set_Chain (Constr.Last, N); + end if; + Constr.Last := N; + end Append_Node; + + function Get_Constr_Chain (Constr : Constr_Type) return Node is + begin + return Constr.First; + end Get_Constr_Chain; +end Edif.Nutils; diff --git a/src/edif/edif-nutils.ads b/src/edif/edif-nutils.ads new file mode 100644 index 000000000..a53f46bfc --- /dev/null +++ b/src/edif/edif-nutils.ads @@ -0,0 +1,15 @@ +with Edif.Nodes; use Edif.Nodes; + +package Edif.Nutils is + type Constr_Type is limited private; + + procedure Init_Constr (Constr : out Constr_Type); + procedure Append_Node (Constr : in out Constr_Type; N : Node); + function Get_Constr_Chain (Constr : Constr_Type) return Node; + +private + type Constr_Type is record + First : Node; + Last : Node; + end record; +end Edif.Nutils; diff --git a/src/edif/edif-parse.adb b/src/edif/edif-parse.adb new file mode 100644 index 000000000..a3169bd63 --- /dev/null +++ b/src/edif/edif-parse.adb @@ -0,0 +1,1088 @@ +with Types; use Types; +with Std_Names; use Std_Names; +with Errorout; use Errorout; +with Edif.Tokens; use Edif.Tokens; +with Edif.Scans; use Edif.Scans; +with Edif.Nutils; use Edif.Nutils; + +package body Edif.Parse is + Parse_Error : exception; + + procedure Error_Msg_Parse (Msg : String; Args : Earg_Arr := No_Eargs) is + begin + Report_Msg (Msgid_Error, Errorout.Parse, +Get_Token_Location, Msg, Args); + end Error_Msg_Parse; + + procedure Error_Msg_Parse (Msg : String; Arg : Earg_Type) is + begin + Report_Msg (Msgid_Error, Errorout.Parse, +Get_Token_Location, + Msg, (1 => Arg)); + end Error_Msg_Parse; + + procedure Set_Token_Location (N : Node) is + begin + Set_Location (N, Get_Token_Location); + end Set_Token_Location; + + function Parse_Simple return Node; + + procedure Parse_Simple_List_Body (Bod : Node) + is + Last : Node; + El : Node; + begin + Last := Bod; + while Current_Token /= Tok_Right_Paren loop + if Current_Token = Tok_Eof then + Error_Msg_Parse ("missing ')'"); + exit; + end if; + El := Create_Node (N_Chain); + Set_Token_Location (El); + Set_CDR (Last, El); + Set_CAR (El, Parse_Simple); + Last := El; + end loop; + + Set_CDR (Last, Null_Node); + + if Current_Token = Tok_Right_Paren then + -- Skip ')'. + Scan; + end if; + end Parse_Simple_List_Body; + + function Parse_Simple_List return Node + is + Res : Node; + begin + Res := Create_Node (N_Keyword); + Set_Token_Location (Res); + + Set_Keyword (Res, Current_Identifier); + + -- Skip '(' + keyword. + Scan; + + Parse_Simple_List_Body (Res); + + return Res; + end Parse_Simple_List; + + function Parse_Symbol return Node + is + Res : Node; + begin + pragma Assert (Current_Token = Tok_Symbol); + + Res := Create_Node (N_Symbol); + Set_Token_Location (Res); + Set_Symbol (Res, Current_Identifier); + + -- Skip symbol. + Scan; + + return Res; + end Parse_Symbol; + + function Parse_String return Node + is + Res : Node; + begin + Res := Create_Node (N_String); + Set_Token_Location (Res); + Set_String_Id (Res, Current_String); + Set_String_Len (Res, Current_String_Len); + + -- Skip string. + Scan; + + return Res; + end Parse_String; + + function Parse_Number return Node + is + Res : Node; + begin + Res := Create_Node (N_Number); + Set_Token_Location (Res); + Set_Number (Res, Current_Number); + + -- Skip number. + Scan; + + return Res; + end Parse_Number; + + function Parse_Simple return Node is + begin + case Current_Token is + when Tok_Keyword => + return Parse_Simple_List; + + when Tok_Right_Paren => + Error_Msg_Parse ("unexpected ')'"); + + -- Skip it. + Scan; + + return Parse_Simple; + + when Tok_Eof => + Error_Msg_Parse ("unexpected end of file"); + return Null_Node; + + when Tok_Symbol => + return Parse_Symbol; + + when Tok_String => + return Parse_String; + + when Tok_Number => + return Parse_Number; + end case; + end Parse_Simple; + + function Parse_File_Simple return Node + is + Res : Node; + begin + -- Start the scanner. + Scan; + + Res := Parse_Simple; + + return Res; + end Parse_File_Simple; + + procedure Expect_Keyword (Id : Name_Id) is + begin + if Current_Token /= Tok_Keyword + or else Current_Identifier /= Id + then + Error_Msg_Parse ("keyword %i expected here", +Id); + raise Parse_Error; + end if; + end Expect_Keyword; + + procedure Expect_Symbol is + begin + if Current_Token /= Tok_Symbol then + Error_Msg_Parse ("symbol expected here"); + raise Parse_Error; + end if; + end Expect_Symbol; + + procedure Expect_String is + begin + if Current_Token /= Tok_String then + Error_Msg_Parse ("string expected here"); + raise Parse_Error; + end if; + end Expect_String; + + procedure Skip_Right_Paren is + begin + while Current_Token = Tok_Keyword loop + Error_Msg_Parse + ("unexpected %i keyword, skipped", +Current_Identifier); + + declare + Count : Natural; + begin + Count := 1; + loop + -- Skip. + Scan; + + if Current_Token = Tok_Right_Paren then + Count := Count - 1; + exit when Count = 0; + end if; + end loop; + + -- Skip ')'. + Scan; + end; + end loop; + + if Current_Token /= Tok_Right_Paren then + Error_Msg_Parse ("')' expected here"); + else + -- Skip ')'. + Scan; + end if; + end Skip_Right_Paren; + + procedure Expect_Number is + begin + if Current_Token /= Tok_Number then + Error_Msg_Parse ("number expected here"); + raise Parse_Error; + end if; + end Expect_Number; + + procedure Skip_Comments is + begin + while Current_Token = Tok_Keyword + and then Current_Identifier = Name_Comment + loop + -- Skip '(comment'. + Scan; + + if Current_Token = Tok_String then + -- Skip string. + Scan; + else + Error_Msg_Parse ("string expected after comment"); + end if; + + -- Skip ')' (for comment). + Skip_Right_Paren; + end loop; + end Skip_Comments; + + function Parse_Rename return Node + is + Res : Node; + begin + pragma Assert (Current_Token = Tok_Keyword); + + -- Skip 'rename'. + Scan; + + Res := Create_Node (N_Rename); + Expect_Symbol; + Set_Name (Res, Parse_Symbol); + + Expect_String; + Set_String (Res, Parse_String); + + Skip_Right_Paren; + + return Res; + end Parse_Rename; + + function Parse_Name return Node is + begin + if Current_Token = Tok_Symbol then + return Parse_Symbol; + elsif Current_Token = Tok_Keyword then + if Current_Identifier = Name_Rename then + return Parse_Rename; + end if; + end if; + + Error_Msg_Parse ("symbol or rename expected"); + raise Parse_Error; + end Parse_Name; + + function Parse_Boolean return Node + is + Res : Node; + begin + if Current_Token /= Tok_Keyword then + Error_Msg_Parse ("true or false expected"); + raise Parse_Error; + end if; + + Res := Create_Node (N_Boolean); + Set_Token_Location (Res); + + if Current_Identifier = Name_True then + Set_Boolean (Res, True); + elsif Current_Identifier = Name_False then + Set_Boolean (Res, False); + else + Error_Msg_Parse ("true or false expected"); + end if; + + -- Skip keyword. + Scan; + + -- Skip ')' (for true/false). + Skip_Right_Paren; + + return Res; + end Parse_Boolean; + + function Parse_Userdata return Node + is + Res : Node; + begin + Res := Create_Node (N_Userdata); + Set_Token_Location (Res); + + -- Skip '(property' or '(userdata'. + Scan; + + Set_Name (Res, Parse_Name); + + Parse_Simple_List_Body (Res); + + return Res; + end Parse_Userdata; + + function Parse_Property return Node + is + Prop : Node; + Ptype : Name_Id; + begin + Prop := Create_Node (N_Property); + Set_Token_Location (Prop); + + -- Skip '(property' or '(userdata'. + Scan; + + Set_Name (Prop, Parse_Name); + + if Current_Token /= Tok_Keyword then + Error_Msg_Parse ("property value expected"); + raise Parse_Error; + end if; + + Ptype := Current_Identifier; + + -- Skip type keyword. + Scan; + + case Ptype is + when Name_String => + Set_Value (Prop, Parse_String); + + when Name_Integer => + Set_Value (Prop, Parse_Number); + + when Name_Boolean => + Set_Value (Prop, Parse_Boolean); + + when Name_Number => + Set_Value (Prop, Parse_Simple); + + when others => + Error_Msg_Parse ("unknown property type %i", +Ptype); + raise Parse_Error; + end case; + + -- Skip ')' (for value). + Skip_Right_Paren; + + if Current_Token = Tok_Keyword + and then Current_Identifier = Name_Unit + then + -- Skip '(unit'. + Scan; + + Expect_Symbol; + Set_Unit (Prop, Current_Identifier); + Scan; + + -- Skip ')' (for unit). + Skip_Right_Paren; + end if; + + if Current_Token = Tok_Keyword + and then Current_Identifier = Name_Owner + then + -- Skip '(owner'. + Scan; + + Expect_String; + Set_Owner (Prop, Parse_String); + + -- Skip ')' (for owner). + Skip_Right_Paren; + end if; + + -- Skip ')' (for property). + Skip_Right_Paren; + + return Prop; + end Parse_Property; + + procedure Parse_Properties (Constr : in out Constr_Type) + is + El : Node; + begin + while Current_Token = Tok_Keyword loop + case Current_Identifier is + when Name_Property => + El := Parse_Property; + when Name_Userdata => + El := Parse_Userdata; + when others => + exit; + end case; + Append_Node (Constr, El); + end loop; + end Parse_Properties; + + procedure Parse_Properties (N : Node) + is + Constr : Constr_Type; + begin + Init_Constr (Constr); + + Parse_Properties (Constr); + + Set_Properties_Chain (N, Get_Constr_Chain (Constr)); + end Parse_Properties; + + function Parse_Edif_Version return Int32 + is + Res : Int32; + begin + Expect_Keyword (Name_Edifversion); + + -- Skip '(edifversion'. + Scan; + + -- Major + -- FIXME: small number. + Expect_Number; + Res := Current_Number * 100; + Scan; + + -- Minor + Expect_Number; + Res := Res + Current_Number * 10; + Scan; + + -- Revision + Expect_Number; + Res := Res + Current_Number; + Scan; + + -- Skip ')'. + Skip_Right_Paren; + + return Res; + end Parse_Edif_Version; + + function Parse_Edif_Level return Int32 + is + Res : Int32; + begin + Expect_Keyword (Name_Ediflevel); + + -- Skip '(ediflevel'. + Scan; + + Expect_Number; + Res := Current_Number; + + -- Skip number. + Scan; + + -- Skip ')'. + Skip_Right_Paren; + + return Res; + end Parse_Edif_Level; + + function Parse_Technology return Node is + begin + Expect_Keyword (Name_Technology); + + return Parse_Simple_List; + end Parse_Technology; + + procedure Parse_Designator_Opt (N : Node) is + begin + if Current_Token = Tok_Keyword + and then Current_Identifier = Name_Designator + then + -- Skip '(designator'. + Scan; + + Expect_String; + Set_Designator (N, Parse_String); + + -- Skip ')' (for designator). + Skip_Right_Paren; + end if; + end Parse_Designator_Opt; + + function Parse_Array return Node + is + Res : Node; + begin + Res := Create_Node (N_Array); + Set_Token_Location (Res); + + -- Skip '(array'. + Scan; + + Set_Name (Res, Parse_Name); + + Expect_Number; + Set_Array_Length (Res, Current_Number); + + -- Skip number. + Scan; + + -- Skip ')' (for array). + Skip_Right_Paren; + + return Res; + end Parse_Array; + + function Parse_Port return Node + is + -- Constr : Constr_Type; + Res : Node; + Name : Node; + begin + Res := Create_Node (N_Port); + Set_Token_Location (Res); + + -- Skip '(port'. + Scan; + + if Current_Token = Tok_Keyword + and then Current_Identifier = Name_Array + then + Name := Parse_Array; + else + Name := Parse_Name; + end if; + Set_Name (Res, Name); + + Expect_Keyword (Name_Direction); + -- Skip '(direction'. + Scan; + + Expect_Symbol; + case Current_Identifier is + when Name_Input => + Set_Direction (Res, Dir_Input); + when Name_Output => + Set_Direction (Res, Dir_Output); + when Name_Inout => + Set_Direction (Res, Dir_Inout); + when others => + Error_Msg_Parse + ("unhandled port direction %i", +Current_Identifier); + raise Parse_Error; + end case; + + -- Skip symbol. + Scan; + + -- Skip ')' (for direction). + Skip_Right_Paren; + + Parse_Designator_Opt (Res); + + Parse_Properties (Res); + + -- Skip ')' (for port). + Skip_Right_Paren; + + return Res; + end Parse_Port; + + function Parse_Library_Ref_Opt return Node + is + Res : Node; + begin + if Current_Token = Tok_Keyword + and then Current_Identifier = Name_Libraryref + then + -- Skip '(libraryref'. + Scan; + + Expect_Symbol; + Res := Parse_Symbol; + + -- Skip ')' (for libraryref). + Skip_Right_Paren; + else + Res := Null_Node; + end if; + + return Res; + end Parse_Library_Ref_Opt; + + function Parse_Cell_Ref return Node + is + Res : Node; + begin + Res := Create_Node (N_Cell_Ref); + Set_Token_Location (Res); + + -- Skip '(cellref'. + Scan; + + Expect_Symbol; + Set_Name (Res, Parse_Symbol); + + Set_Library_Ref (Res, Parse_Library_Ref_Opt); + + -- Skip ')' (for cellref). + Skip_Right_Paren; + + return Res; + end Parse_Cell_Ref; + + function Parse_View_Ref return Node + is + Res : Node; + begin + Res := Create_Node (N_View_Ref); + Set_Token_Location (Res); + + Expect_Keyword (Name_Viewref); + + -- Skip '(viewref'. + Scan; + + Set_Name (Res, Parse_Name); + + Set_Cell_Ref (Res, Parse_Cell_Ref); + + -- Skip ')' (for viewref). + Skip_Right_Paren; + + return Res; + end Parse_View_Ref; + + procedure Parse_Port_Instances (N : Node) + is + Constr : Constr_Type; + Inst : Node; + begin + Init_Constr (Constr); + + while Current_Token = Tok_Keyword + and then Current_Identifier = Name_Portinstance + loop + Inst := Create_Node (N_Port_Instance); + Set_Token_Location (Inst); + Append_Node (Constr, Inst); + + -- Skip '(portinstance'. + Scan; + + Set_Name (Inst, Parse_Name); + Parse_Properties (Inst); + + -- Skip ')' (for portinstance). + Skip_Right_Paren; + + end loop; + + Set_Port_Instances_Chain (N, Get_Constr_Chain (Constr)); + end Parse_Port_Instances; + + function Parse_Instance return Node + is + Res : Node; + begin + Res := Create_Node (N_Instance); + Set_Token_Location (Res); + + -- Skip '(instance'. + Scan; + + Set_Name (Res, Parse_Name); + Set_Instance_Ref (Res, Parse_View_Ref); + + Parse_Port_Instances (Res); + + Parse_Properties (Res); + + -- Skip ')' (for instance). + Skip_Right_Paren; + + return Res; + end Parse_Instance; + + function Parse_Member return Node + is + Res : Node; + begin + Res := Create_Node (N_Member); + Set_Token_Location (Res); + + -- Skip '(member'. + Scan; + + Set_Name (Res, Parse_Name); + + Expect_Number; + Set_Index (Res, Current_Number); + + -- Skip number. + Scan; + + -- Skip ')' (for member). + Skip_Right_Paren; + + return Res; + end Parse_Member; + + function Parse_Net return Node + is + Constr : Constr_Type; + Res : Node; + Ref : Node; + begin + Res := Create_Node (N_Net); + Set_Token_Location (Res); + + -- Skip '(net'. + Scan; + + Set_Name (Res, Parse_Name); + + if Current_Token = Tok_Keyword + and then Current_Identifier = Name_Joined + then + Init_Constr (Constr); + + -- Skip '(joined'. + Scan; + + while Current_Token = Tok_Keyword + and then Current_Identifier = Name_Portref + loop + Ref := Create_Node (N_Port_Ref); + Set_Token_Location (Ref); + Append_Node (Constr, Ref); + + -- Skip '(portref'. + Scan; + + if Current_Token = Tok_Keyword + and then Current_Identifier = Name_Member + then + Set_Port (Ref, Parse_Member); + else + Set_Port (Ref, Parse_Name); + end if; + + if Current_Token = Tok_Keyword + and then Current_Identifier = Name_Instanceref + then + -- Skip '(instanceref'. + Scan; + + Set_Instance_Ref (Ref, Parse_Name); + + -- Skip ')' (for instanceref). + Skip_Right_Paren; + end if; + + -- Skip ')' (for portref). + Skip_Right_Paren; + end loop; + Set_Joined_Chain (Res, Get_Constr_Chain (Constr)); + + -- Skip ')' (for joined). + Skip_Right_Paren; + end if; + + Parse_Properties (Res); + + -- Skip ')' (for net). + Skip_Right_Paren; + + return Res; + end Parse_Net; + + function Parse_Interface return Node + is + Constr : Constr_Type; + Res : Node; + begin + Res := Create_Node (N_Interface); + Set_Token_Location (Res); + + -- Skip '(interface'. + Scan; + + Parse_Designator_Opt (Res); + + Init_Constr (Constr); + while Current_Token = Tok_Keyword + and then Current_Identifier = Name_Port + loop + Append_Node (Constr, Parse_Port); + end loop; + Set_Ports_Chain (Res, Get_Constr_Chain (Constr)); + + Parse_Designator_Opt (Res); + + Parse_Properties (Res); + + -- Skip ')' (for interface). + Skip_Right_Paren; + + return Res; + end Parse_Interface; + + function Parse_View return Node + is + Constr : Constr_Type; + Prop_Constr : Constr_Type; + Res : Node; + begin + Res := Create_Node (N_View); + Set_Token_Location (Res); + + -- Skip '(view'. + Scan; + + Set_Name (Res, Parse_Name); + + Expect_Keyword (Name_Viewtype); + + -- Skip '(viewtype'. + Scan; + + Expect_Symbol; + Set_View_Type (Res, Current_Identifier); + + -- Skip symbol. + Scan; + + -- Skip ')' (for viewtype). + Skip_Right_Paren; + + Expect_Keyword (Name_Interface); + Set_Interface (Res, Parse_Interface); + + Init_Constr (Prop_Constr); + Parse_Properties (Prop_Constr); + + if Current_Token = Tok_Keyword + and then Current_Identifier = Name_Contents + then + -- Skip '(contents'. + Scan; + + Init_Constr (Constr); + while Current_Token = Tok_Keyword loop + case Current_Identifier is + when Name_Instance => + Append_Node (Constr, Parse_Instance); + when Name_Net => + Append_Node (Constr, Parse_Net); + when Name_Userdata => + Append_Node (Constr, Parse_Userdata); + when others => + Error_Msg_Parse + ("%i not supported in contents", +Current_Identifier); + raise Parse_Error; + end case; + end loop; + Set_Contents_Chain (Res, Get_Constr_Chain (Constr)); + + -- Skip ')' (for contents). + Skip_Right_Paren; + end if; + + Parse_Properties (Prop_Constr); + Set_Properties_Chain (Res, Get_Constr_Chain (Prop_Constr)); + + -- Skip ')' (for view). + Skip_Right_Paren; + + return Res; + end Parse_View; + + function Parse_Cell return Node + is + Res : Node; + Status : Node; + Prop_Constr : Constr_Type; + pragma Unreferenced (Status); + begin + Res := Create_Node (N_Cell); + + -- Skip '(cell'. + Scan; + + Set_Name (Res, Parse_Name); + + Expect_Keyword (Name_Celltype); + + -- Skip '(celltype'. + Scan; + + Expect_Symbol; + Set_Cell_Type (Res, Current_Identifier); + + -- Skip symbol. + Scan; + + -- Skip ')' (for celltype). + Skip_Right_Paren; + + Skip_Comments; + + if Current_Token = Tok_Keyword + and then Current_Identifier = Name_Status + then + Status := Parse_Simple_List; + -- FIXME: free. + end if; + + Init_Constr (Prop_Constr); + Parse_Properties (Prop_Constr); + + Set_View (Res, Parse_View); + + -- Properties can appear at several places... + Parse_Properties (Prop_Constr); + Set_Properties_Chain (Res, Get_Constr_Chain (Prop_Constr)); + + -- Skip ')' (for cell). + Skip_Right_Paren; + + return Res; + end Parse_Cell; + + procedure Parse_Library_Body (Res : Node) + is + Constr : Constr_Type; + begin + -- Skip '(external'. + Scan; + + Set_Name (Res, Parse_Name); + + Set_Edif_Level (Res, Parse_Edif_Level); + Set_Technology (Res, Parse_Technology); + + Init_Constr (Constr); + while Current_Token = Tok_Keyword + and then Current_Identifier = Name_Cell + loop + Append_Node (Constr, Parse_Cell); + end loop; + Set_Cells_Chain (Res, Get_Constr_Chain (Constr)); + + -- Skip ')' (for external). + Skip_Right_Paren; + end Parse_Library_Body; + + function Parse_Library return Node + is + Res : Node; + begin + Expect_Keyword (Name_Library); + + Res := Create_Node (N_Library); + Set_Token_Location (Res); + + Parse_Library_Body (Res); + + return Res; + end Parse_Library; + + function Parse_External return Node + is + Res : Node; + begin + Expect_Keyword (Name_External); + + Res := Create_Node (N_External); + Set_Token_Location (Res); + + Parse_Library_Body (Res); + + return Res; + end Parse_External; + + function Parse_Design return Node + is + Res : Node; + begin + Res := Create_Node (N_Design); + Set_Token_Location (Res); + + -- Skip '(design'. + Scan; + + Set_Name (Res, Parse_Name); + Set_Cell_Ref (Res, Parse_Cell_Ref); + Parse_Properties (Res); + + -- Skip ')' (for design). + Skip_Right_Paren; + + return Res; + end Parse_Design; + + function Parse_Edif200 return Node + is + Res : Node; + Constr : Constr_Type; + begin + -- Start the scanner. + Scan; + + Expect_Keyword (Name_Edif); + + -- Skip '(edif' + Scan; + + Res := Create_Node (N_Edif); + + Set_Name (Res, Parse_Name); + Set_Edif_Version (Res, Parse_Edif_Version); + Set_Edif_Level (Res, Parse_Edif_Level); + + Expect_Keyword (Name_Keywordmap); + -- Skip '(keywordmap'. + Scan; + Set_Keyword_Map (Res, Parse_Simple); + -- Skip ')' (for keywordmap). + Skip_Right_Paren; + + if Current_Token = Tok_Keyword + and then Current_Identifier = Name_Status + then + Set_Status (Res, Parse_Simple); + end if; + + Skip_Comments; + + -- Parse externals. + Init_Constr (Constr); + while Current_Token = Tok_Keyword + and then Current_Identifier = Name_External + loop + Append_Node (Constr, Parse_External); + end loop; + Set_External_Chain (Res, Get_Constr_Chain (Constr)); + + -- Parse libraries. + Init_Constr (Constr); + while Current_Token = Tok_Keyword + and then Current_Identifier = Name_Library + loop + Append_Node (Constr, Parse_Library); + end loop; + Set_Library_Chain (Res, Get_Constr_Chain (Constr)); + + -- Parse design. + if Current_Token = Tok_Keyword + and then Current_Identifier = Name_Design + then + Set_Design (Res, Parse_Design); + end if; + + -- Skip ')' (for edif). + Skip_Right_Paren; + + if Current_Token /= Tok_Eof then + Error_Msg_Parse ("end of file expected"); + end if; + + return Res; + end Parse_Edif200; + +end Edif.Parse; diff --git a/src/edif/edif-parse.ads b/src/edif/edif-parse.ads new file mode 100644 index 000000000..929be9b1e --- /dev/null +++ b/src/edif/edif-parse.ads @@ -0,0 +1,12 @@ +with Edif.Nodes; use Edif.Nodes; + +package Edif.Parse is + -- Simple parser: return generic constructs (lists). + -- Do not try to interpret EDIF. + function Parse_File_Simple return Node; + + -- Parse as EDIF 2.0.0 + -- There is almost no error recovery: the parser stops at the first error, + -- and it return Null_Node. + function Parse_Edif200 return Node; +end Edif.Parse; diff --git a/src/edif/edif-scans.adb b/src/edif/edif-scans.adb new file mode 100644 index 000000000..e8d8fb199 --- /dev/null +++ b/src/edif/edif-scans.adb @@ -0,0 +1,306 @@ +with Ada.Characters.Latin_1; use Ada.Characters.Latin_1; +with Files_Map; use Files_Map; +with Name_Table; use Name_Table; +with Str_Table; +with Errorout; use Errorout; + +package body Edif.Scans is + -- Maximum length of identifiers or names. + Max_Name_Length : constant := 512; + + -- Length of the file. This is used to catch EOF embedded in the + -- file. + File_Length : Source_Ptr; + + -- Number of the current line. + Line_Number : Natural; + + -- Position of the start of the line. + Line_Pos : Source_Ptr; + + Source_File : Source_File_Entry; + Pos : Source_Ptr; + Token_Pos : Source_Ptr; + + -- Not required to be saved. + Source : File_Buffer_Acc := null; + + function Get_Scan_Coord return Source_Coord_Type is + begin + return (File => Source_File, + Line_Pos => Line_Pos, + Line => Line_Number, + Offset => Natural (Pos - Line_Pos)); + end Get_Scan_Coord; + + function Get_Token_Location return Location_Type is + begin + return File_Pos_To_Location (Source_File, Token_Pos); + end Get_Token_Location; + + procedure Error_Msg_Scan (Msg : String; Args : Earg_Arr := No_Eargs) is + begin + Report_Msg (Msgid_Error, Errorout.Scan, Get_Scan_Coord, Msg, Args); + end Error_Msg_Scan; + + procedure Warning_Msg_Scan (Msg : String; Args : Earg_Arr := No_Eargs) is + begin + Report_Msg (Msgid_Warning, Errorout.Scan, Get_Scan_Coord, Msg, Args); + end Warning_Msg_Scan; + + procedure Set_File (File : Source_File_Entry) is + begin + -- Can be called only when not in use. + pragma Assert (Source_File = No_Source_File_Entry); + + -- FILE must be a real file. + pragma Assert (File /= No_Source_File_Entry); + + Source_File := File; + Source := Get_File_Source (File); + Pos := Source'First; + + File_Length := Get_File_Length (File); + Line_Number := 1; + Line_Pos := Source_Ptr_Org; + + Token_Pos := Pos; + end Set_File; + + procedure Skip_Newline (C : Character) is + begin + if (C = LF and then Source (Pos) = CR) + or else (C = CR and then Source (Pos) = LF) + then + Pos := Pos + 1; + end if; + + -- Save the position of the next line. + Line_Number := Line_Number + 1; + Line_Pos := Pos; + File_Add_Line_Number (Source_File, Line_Number, Pos); + end Skip_Newline; + + procedure Skip_Blanks + is + C : Character; + begin + loop + C := Source (Pos); + case C is + when ' ' | HT => + Pos := Pos + 1; + when CR | LF => + Pos := Pos + 1; + Skip_Newline (C); + when others => + exit; + end case; + end loop; + end Skip_Blanks; + + procedure Current_String_Append (C : Character) is + begin + Str_Table.Append_String8_Char (C); + Current_String_Len := Current_String_Len + 1; + end Current_String_Append; + + procedure Scan_Decimal_Number + is + V : Int32; + C : Character; + begin + V := 0; + Pos := Pos - 1; + loop + C := Source (Pos); + if C in '0' .. '9' then + -- FIXME: handle overflow. + V := V * 10 + Character'Pos (C) - Character'Pos ('0'); + else + exit; + end if; + Pos := Pos + 1; + end loop; + -- Check character after the number ? + Current_Number := V; + Current_Token := Tok_Number; + end Scan_Decimal_Number; + + procedure Scan_String + is + C : Character; + begin + -- FIXME: Scan_String; + Current_String := Str_Table.Create_String8; + Current_String_Len := 0; + loop + C := Source (Pos); + if C = '"' then + -- Skip the final quote. + Pos := Pos + 1; + -- Append a NUL. + Str_Table.Append_String8_Char (NUL); + return; + elsif C < ' ' then + case C is + when Files_Map.EOT => + Error_Msg_Scan ("non terminated string"); + return; + when LF | CR => + Warning_Msg_Scan ("multi-line strings are not allowed"); + Skip_Newline (C); + C := LF; + -- But continue. + when others => + -- FIXME: ref ? + Error_Msg_Scan ("control character not allowed in strings"); + -- Continue as string ? + end case; + else + -- Normal case. + null; + end if; + Current_String_Append (C); + Pos := Pos + 1; + end loop; + end Scan_String; + + -- A valid character for EDIF identifiers. + function Is_Char_Id (C : Character) return Boolean is + begin + return (C in 'a' .. 'z' + or C in 'A' .. 'Z' + or C in '0' .. '9' + or C = '_'); + end Is_Char_Id; + + procedure Scan_Identifier + is + Buffer : String (1 .. Max_Name_Length); + Length : Natural; + C : Character; + begin + Length := 0; + C := Source (Pos - 1); + loop + Length := Length + 1; + + if C in 'A' .. 'Z' then + -- Convert to lowercase (assuming ASCII). + C := Character'Val (Character'Pos (C) + 32); + end if; + Buffer (Length) := C; + + C := Source (Pos); + exit when not Is_Char_Id (C); + Pos := Pos + 1; + end loop; + Current_Identifier := Name_Table.Get_Identifier (Buffer (1 .. Length)); + end Scan_Identifier; + + procedure Scan + is + C : Character; + begin + loop + Token_Pos := Pos; + + C := Source (Pos); + Pos := Pos + 1; + + case C is + when ASCII.NUL .. ASCII.ETX + | ASCII.ENQ .. ASCII.BS + | ASCII.VT + | ASCII.SO .. ASCII.US => + Error_Msg_Scan ("unexpected control character ^" + & Character'Val (Character'Pos (C) + 64)); + when ASCII.DEL .. Character'Val (255) => + Error_Msg_Scan ("unexpected 8 bit character"); + when Files_Map.EOT => + if Pos < File_Length then + Error_Msg_Scan ("unexpected ^@ character in file"); + else + Current_Token := Tok_Eof; + exit; + end if; + when LF | CR => + Skip_Newline (C); + -- Skip. + when ' ' | HT => + -- Skip spaces. + null; + when ASCII.FF => + -- Also considered as a space. + null; + when '&' => + -- EDIF identifier consits of alphanumeric or underscore + -- characters. '&' must be used if the first character is not + -- alphabetic. + if not Is_Char_Id (Source (Pos)) then + Error_Msg_Scan ("invalid identifier char after '&'"); + else + Pos := Pos + 1; + Scan_Identifier; + Current_Token := Tok_Symbol; + exit; + end if; + when 'a' .. 'z' + | 'A' .. 'Z' + | '_' => + Scan_Identifier; + Current_Token := Tok_Symbol; + exit; + when '0' .. '9' => + Scan_Decimal_Number; + exit; + when '"' => + Scan_String; + Current_Token := Tok_String; + exit; + when '(' => + -- Be tolerante: allow blanks after '('. + Skip_Blanks; + + C := Source (Pos); + if C in 'a' .. 'z' or C in 'A' .. 'Z' then + Pos := Pos + 1; + Scan_Identifier; + else + Error_Msg_Scan ("keyword expected after '('"); + Current_Identifier := Null_Identifier; + end if; + Current_Token := Tok_Keyword; + exit; + when ')' => + Current_Token := Tok_Right_Paren; + exit; + when '!' | '#' | ''' | '*' | '%' | ',' | ':' | ';' + | '<' | '=' | '>' | '?' | '@' | '$' | '\' | '[' | ']' + | '^' | '`' | '/' | '{' | '|' | '}' | '~' | '.' => + -- Not allowed ? + Error_Msg_Scan ("unexpected character '" & C & "'"); + when '+' => + if Source (Pos) in '0' .. '9' then + Pos := Pos + 1; + Scan_Decimal_Number; + exit; + else + Error_Msg_Scan ("unexpected '+' character"); + end if; + when '-' => + if Source (Pos) in '0' .. '9' then + Pos := Pos + 1; + Scan_Decimal_Number; + -- Overflow ? + Current_Number := -Current_Number; + exit; + else + Error_Msg_Scan ("unexpected '-' character"); + end if; + end case; + end loop; + end Scan; + +end Edif.Scans; diff --git a/src/edif/edif-scans.ads b/src/edif/edif-scans.ads new file mode 100644 index 000000000..8dc9e7546 --- /dev/null +++ b/src/edif/edif-scans.ads @@ -0,0 +1,19 @@ +with Types; use Types; +with Edif.Tokens; use Edif.Tokens; + +package Edif.Scans is + Current_Token : Token_Type; + Current_Identifier : Name_Id; + Current_Number : Int32; + Current_String : String8_Id; + Current_String_Len : Uns32; + + -- Initialize the scanner with FILE. + procedure Set_File (File : Source_File_Entry); + + -- Return the location of the token that has just been scaned. + function Get_Token_Location return Location_Type; + + -- Scan the source file until the next token. + procedure Scan; +end Edif.Scans; diff --git a/src/edif/edif-tokens.ads b/src/edif/edif-tokens.ads new file mode 100644 index 000000000..c78ef1cc3 --- /dev/null +++ b/src/edif/edif-tokens.ads @@ -0,0 +1,15 @@ +package Edif.Tokens is + pragma Pure (Tokens); + + type Token_Type is + ( + Tok_Keyword, -- '(' followed by a symbol (case insensitive). + Tok_Right_Paren, -- ')' + + Tok_Symbol, + Tok_String, + Tok_Number, + + Tok_Eof + ); +end Edif.Tokens; diff --git a/src/edif/edif.ads b/src/edif/edif.ads new file mode 100644 index 000000000..889897442 --- /dev/null +++ b/src/edif/edif.ads @@ -0,0 +1,3 @@ +package Edif is + pragma Pure (Edif); +end Edif; -- cgit v1.2.3