grt-sdf.adb

来自「vhdl集成电路设计软件.需要用gcc-4.0.2版本编译.」· ADB 代码 · 共 1,333 行 · 第 1/3 页

      end loop;
      Error_Sdf ("edge_identifier expected");
      return Edge_Error;
   end Get_Edge_Token;

   procedure Error_Sdf (Tok : Sdf_Token_Type)
   is
   begin
      case Tok is
         when Tok_Qstring =>
            Error_Sdf ("qstring expected");
         when Tok_Oparen =>
            Error_Sdf ("'(' expected");
         when Tok_Identifier =>
            Error_Sdf ("identifier expected");
         when Tok_Cln =>
            Error_Sdf ("':' (colon) expected");
         when others =>
            Error_Sdf ("parse error");
      end case;
   end Error_Sdf;

   function Expect (Tok : Sdf_Token_Type) return Boolean
   is
   begin
      if Get_Token = Tok then
         return True;
      end if;
      Error_Sdf (Tok);
      return False;
   end Expect;

   function Expect_Cp_Op_Ident (Tok : Sdf_Token_Type) return Boolean
   is
   begin
      if Tok /= Tok_Cparen then
         Error_Sdf (Tok_Cparen);
         return False;
      end if;
      if not Expect (Tok_Oparen)
        or else not Expect (Tok_Identifier)
      then
         return False;
      end if;
      return True;
   end Expect_Cp_Op_Ident;

   function Expect_Qstr_Cp_Op_Ident (Str : String) return Boolean
   is
      Tok : Sdf_Token_Type;
   begin
      if not Is_Ident (Str) then
         return True;
      end if;

      Tok := Get_Token;
      if Tok = Tok_Qstring then
         Tok := Get_Token;
      end if;

      return Expect_Cp_Op_Ident (Tok);
   end Expect_Qstr_Cp_Op_Ident;

   procedure Start_Generic_Name (Kind : Timing_Generic_Kind) is
   begin
      Sdf_Context.Kind := Kind;
      Sdf_Context.Port_Num := 0;
      Sdf_Context.Ports (1).Edge := Edge_None;
      Sdf_Context.Ports (2).Edge := Edge_None;
   end Start_Generic_Name;

   --  Status of a parsing.
   --  ERROR: parse error (syntax is not correct)
   --  OPTIONAL: the construct is absent.
   --  FOUND: the construct is present.
   --  SET: the construct is present and a value was extracted from.
   type Parse_Status_Type is
     (
      Status_Error,
      Status_Altern,
      Status_Optional,
      Status_Found,
      Status_Set
     );

   function Num_To_Time return Ghdl_I64
   is
      Res : Ghdl_I64;
   begin
      Res := Ghdl_I64 (Scan_Int) * Ghdl_I64 (Sdf_Context.Timescale);
      while Scan_Exp < 0 loop
         Res := Res / 10;
         Scan_Exp := Scan_Exp + 1;
      end loop;
      return Res;
   end Num_To_Time;

   --  Parse: REXPRESSION? ')'
   procedure Parse_Rexpression
     (Status : out Parse_Status_Type; Val : out Ghdl_I64)
   is
      Tok : Sdf_Token_Type;

      procedure Pr_Rnumber (Mtm : Mtm_Type)
      is
      begin
         if Tok = Tok_Rnumber or Tok = Tok_Dnumber then
            if Mtm = Sdf_Mtm then
               Val := Num_To_Time;
               Status := Status_Set;
            elsif Status /= Status_Set then
               Status := Status_Found;
            end if;
            Tok := Get_Token;
         end if;
      end Pr_Rnumber;

      function Pr_Colon return Boolean
      is
      begin
         if Tok /= Tok_Cln then
            Error_Sdf (Tok_Cln);
            Status := Status_Error;
            return False;
         else
            Tok := Get_Token;
            return True;
         end if;
      end Pr_Colon;

   begin
      Val := 0;
      Tok := Get_Token;
      Status := Status_Error;
      if Tok = Tok_Cparen then
         Status := Status_Optional;
         return;
      end if;

      Pr_Rnumber (Minimum);

      if not Pr_Colon then
         return;
      end if;

      Pr_Rnumber (Typical);

      if not Pr_Colon then
         return;
      end if;

      Pr_Rnumber (Maximum);

      if Status = Status_Error then
         Error_Sdf ("at least one number required in an rexpression");
         return;
      end if;

      if Tok /= Tok_Cparen then
         Error_Sdf (Tok_Cparen);
         Status := Status_Error;
      end if;
   end Parse_Rexpression;

   function Expect_Rexpr_Cp_Op_Ident return Boolean
   is
      Status : Parse_Status_Type;
      Val : Ghdl_I64;
   begin
      Parse_Rexpression (Status, Val);
      if Status = Status_Error then
         return False;
      end if;
      if not Expect (Tok_Oparen)
        or else not Expect (Tok_Identifier)
      then
         Error_Sdf (Tok_Identifier);
         return False;
      end if;
      return True;
   end Expect_Rexpr_Cp_Op_Ident;

   function To_Lower (C : Character) return Character is
   begin
      if C >= 'A' and C <= 'Z' then
         return Character'Val (Character'Pos (C)
                               - Character'Pos ('A') + Character'Pos ('a'));
      else
         return C;
      end if;
   end To_Lower;

   function Parse_Port_Path1 (Tok : Sdf_Token_Type) return Boolean
   is
      Port_Spec : Port_Spec_Type
         renames Sdf_Context.Ports (Sdf_Context.Port_Num);
      Len : Natural;
   begin
      if Tok /= Tok_Identifier then
         Error_Sdf ("port path expected");
         return False;
      end if;
      Len := 0;
      for I in Ident_Start .. Ident_End loop
         Len := Len + 1;
         Port_Spec.Name (Len) := To_Lower (Buf (I));
      end loop;
      Port_Spec.Name_Len := Len;
      return True;
   end Parse_Port_Path1;

   function Parse_Port_Path return Boolean
   is
   begin
      Sdf_Context.Port_Num := Sdf_Context.Port_Num + 1;
      return Parse_Port_Path1 (Get_Token);
   end Parse_Port_Path;

   function Parse_Port_Spec return Boolean
   is
      Tok : Sdf_Token_Type;
      Edge : Edge_Type;
   begin
      Sdf_Context.Port_Num := Sdf_Context.Port_Num + 1;
      Tok := Get_Token;
      if Tok = Tok_Identifier then
         return Parse_Port_Path1 (Tok);
      elsif Tok /= Tok_Oparen then
         Error_Sdf ("port spec expected");
         return False;
      end if;
      Edge := Get_Edge_Token;
      if Edge = Edge_Error then
         return False;
      end if;
      Sdf_Context.Ports (Sdf_Context.Port_Num).Edge := Edge;
      if not Parse_Port_Path1 (Get_Token) then
         return False;
      end if;
      if Get_Token /= Tok_Cparen then
         Error_Sdf (Tok_Cparen);
         return False;
      end if;
      return True;
   end Parse_Port_Spec;

   function Parse_Port_Tchk return Boolean renames Parse_Port_Spec;

   --  tc_rvalue ::= ( RNUMBER )
   --            ||= ( rexpression )
   --  Return status_optional for ( )
   function Parse_Tc_Rvalue return Parse_Status_Type
   is
      Tok : Sdf_Token_Type;
      Res : Parse_Status_Type;
   begin
      if Get_Token /= Tok_Oparen then
         Error_Sdf (Tok_Oparen);
         return Status_Error;
      end if;
      Res := Status_Found;
      Tok := Get_Token;
      if Tok = Tok_Rnumber or Tok = Tok_Dnumber then
         Sdf_Context.Timing (1) := Num_To_Time;
         Tok := Get_Token;
         if Tok = Tok_Cparen then
            --  This is a simple RNUMBER.
            if Get_Token = Tok_Cparen then
               return Status_Altern;
            else
               Error_Sdf (Tok_Cparen);
               return Status_Error;
            end if;
         end if;
         if Sdf_Mtm = Minimum then
            Res := Status_Set;
         end if;
      end if;
      if Tok = Tok_Cparen then
         return Status_Optional;
      end if;
      if Tok /= Tok_Cln then
         Error_Sdf (Tok_Cln);
         return Status_Error;
      end if;
      Tok := Get_Token;
      if Tok = Tok_Rnumber or Tok = Tok_Dnumber then
         if Sdf_Mtm = Typical then
            Sdf_Context.Timing (1) := Num_To_Time;
            Res := Status_Set;
         end if;
         Tok := Get_Token;
      end if;
      if Tok /= Tok_Cln then
         Error_Sdf (Tok_Cln);
         return Status_Error;
      end if;
      Tok := Get_Token;
      if Tok = Tok_Rnumber or Tok = Tok_Dnumber then
         if Sdf_Mtm = Maximum then
            Sdf_Context.Timing (1) := Num_To_Time;
            Res := Status_Set;
         end if;
         Tok := Get_Token;
      end if;
      if Tok /= Tok_Cparen then
         Error_Sdf (Tok_Cparen);
         return Status_Error;
      end if;
      return Res;
   end Parse_Tc_Rvalue;

   function Parse_Simple_Tc_Rvalue return Boolean is
   begin
      Sdf_Context.Timing_Nbr := 0;

      case Parse_Tc_Rvalue is
         when Status_Error
           | Status_Optional =>
            return False;
         when Status_Altern =>
            null;
         when Status_Found =>
            Sdf_Context.Timing_Set (1) := False;
         when Status_Set =>
            Sdf_Context.Timing_Set (1) := True;
      end case;
      return True;
   end Parse_Simple_Tc_Rvalue;

   --  rvalue ::= ( RNUMBER )
   --         ||= rexp_list
   --  Parse: rvalue )
   function Parse_Rvalue return Boolean
   is
      Tok : Sdf_Token_Type;
   begin
      Sdf_Context.Timing_Nbr := 0;
      Sdf_Context.Timing_Set := (others => False);

      case Parse_Tc_Rvalue is
         when Status_Error =>
            return False;
         when Status_Altern =>
            return True;
         when Status_Found
           | Status_Optional =>
            null;
         when Status_Set =>
            Sdf_Context.Timing_Set (1) := True;
      end case;

      Sdf_Context.Timing_Nbr := 1;
      loop
         Tok := Get_Token;
         exit when Tok = Tok_Cparen;
         if Tok /= Tok_Oparen then
            Error_Sdf (Tok_Oparen);
            return False;
         end if;

         Sdf_Context.Timing_Nbr := Sdf_Context.Timing_Nbr + 1;
         declare
            Status : Parse_Status_Type;
            Val : Ghdl_I64;
         begin
            Parse_Rexpression (Status, Val);
            case Status is
               when Status_Error
                 | Status_Altern =>
                  return False;
               when Status_Optional
                 | Status_Found =>
                  null;
               when Status_Set =>
                  Sdf_Context.Timing_Set (Sdf_Context.Timing_Nbr) := True;
                  Sdf_Context.Timing (Sdf_Context.Timing_Nbr) := Val;
            end case;
         end;
      end loop;
      if Boolean'(False) then
         --  Do not expand here, since the most used is 01.
         case Sdf_Context.Timing_Nbr is
            when 1 =>
               for I in 2 .. 6 loop
                  Sdf_Context.Timing (I) := Sdf_Context.Timing (1);
                  Sdf_Context.Timing_Set (I) := Sdf_Context.Timing_Set (1);
               end loop;
            when 2 =>
               for I in 3 .. 4 loop
                  Sdf_Context.Timing (I) := Sdf_Context.Timing (1);
                  Sdf_Context.Timing_Set (I) := Sdf_Context.Timing_Set (1);
               end loop;
               for I in 5 .. 6 loop
                  Sdf_Context.Timing (I) := Sdf_Context.Timing (2);
                  Sdf_Context.Timing_Set (I) := Sdf_Context.Timing_Set (2);
               end loop;
            when 3 =>
               for I in 4 .. 6 loop
                  Sdf_Context.Timing (I) := Sdf_Context.Timing (I - 3);
                  Sdf_Context.Timing_Set (I) := Sdf_Context.Timing_Set (I - 3);
               end loop;
            when 6
              | 12 =>
               null;
            when others =>
               Error_Sdf ("bad number of rvalue");
               return False;
         end case;
      end if;
      return True;
   end Parse_Rvalue;

   function Handle_Generic return Boolean
   is
      Name : String (1 .. 1024);
      Len : Natural;

      procedure Start (Str : String) is
      begin
         Name (1 .. Str'Length) := Str;
         Len := Str'Length;
      end Start;

      procedure Add (Str : String)
      is
         Nlen : Natural;
      begin
         Len := Len + 1;
         Name (Len) := '_';
         Nlen := Len + Str'Length;
         Name (Len + 1 .. Nlen) := Str;
         Len := Nlen;
      end Add;

      procedure Add_Edge (Edge : Edge_Type; Force : Boolean) is
      begin
         case Edge is
            when Edge_Posedge =>
               Add ("posedge");
            when Edge_Negedge =>
               Add ("negedge");
            when Edge_01 =>
               Add ("01");
            when Edge_10 =>