path: root/src/grt/grt-sdf.adb

--  GHDL Run Time (GRT) - SDF parser.
--  Copyright (C) 2002 - 2016 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 GCC; see the file COPYING.  If not, write to the Free
--  Software Foundation, 59 Temple Place - Suite 330, Boston, MA
--  02111-1307, USA.
--
--  As a special exception, if other files instantiate generics from this
--  unit, or you link this unit with other files to produce an executable,
--  this unit does not by itself cause the resulting executable to be
--  covered by the GNU General Public License. This exception does not
--  however invalidate any other reasons why the executable file might be
--  covered by the GNU Public License.

with Grt.Stdio; use Grt.Stdio;
with Grt.C; use Grt.C;
with Grt.Strings; use Grt.Strings;
with Grt.Errors; use Grt.Errors;
with Ada.Unchecked_Deallocation;
with Grt.Vital_Annotate;

package body Grt.Sdf is
   use ASCII;

   type Sdf_Token_Type is
     (
      Tok_Oparen, -- (
      Tok_Cparen, -- )
      Tok_Qstring,
      Tok_Identifier,
      Tok_Rnumber,
      Tok_Dnumber,
      Tok_Div, -- /
      Tok_Dot, -- .
      Tok_Cln, -- :

      Tok_Error,
      Tok_Eof
     );

   type Sdf_Context_Acc is access Sdf_Context_Type;
   procedure Unchecked_Deallocation is new Ada.Unchecked_Deallocation
     (Name => Sdf_Context_Acc, Object => Sdf_Context_Type);

   Sdf_Context : Sdf_Context_Acc;

   --  Current data read from the file.
   Buf : String_Access (1 .. Buf_Size) := null;

   --  Length of the buffer, including the EOT.
   Buf_Len : Natural;
   Pos : Natural;
   Line_Start : Integer;

   Sdf_Stream : FILEs := NULL_Stream;
   Sdf_Filename : String_Access := null;
   Sdf_Line : Natural;

   function Open_Sdf (Filename : String) return Boolean
   is
      N_Filename : String (1 .. Filename'Length + 1);
      Mode : constant String := "rt" & ASCII.NUL;
   begin
      N_Filename (1 .. Filename'Length) := Filename;
      N_Filename (N_Filename'Last) := ASCII.NUL;
      Sdf_Stream := fopen (N_Filename'Address, Mode'Address);
      if Sdf_Stream = NULL_Stream then
         Error_S ("cannot open SDF file '");
         Diag_C (Filename);
         Error_E ("'");
         return False;
      end if;
      Sdf_Context := new Sdf_Context_Type;

      Sdf_Context.Version := Sdf_Version_Unknown;

      --  Set the timescale to 1 ns.
      Sdf_Context.Timescale := 1000;

      Buf := new String (1 .. Buf_Size);
      Buf_Len := 1;
      Buf (1) := EOT;
      Sdf_Line := 1;
      Sdf_Filename := new String'(Filename);
      Pos := 1;
      Line_Start := 1;
      return True;
   end Open_Sdf;

   procedure Close_Sdf
   is
   begin
      fclose (Sdf_Stream);
      Sdf_Stream := NULL_Stream;
      Unchecked_Deallocation (Sdf_Context);
      Unchecked_Deallocation (Buf);
   end Close_Sdf;

   procedure Read_Sdf
   is
      Res : size_t;
   begin
      Res := fread (Buf (Pos)'Address, 1, size_t (Read_Size), Sdf_Stream);
      Line_Start := Line_Start - Buf_Len + Pos;
      Buf_Len := Pos + Natural (Res);
      Buf (Buf_Len) := EOT;
   end Read_Sdf;


   Ident_Start : Natural;
   Ident_End : Natural;

   procedure Read_Append
   is
      Len : Natural;
   begin
      Len := Pos - Ident_Start;
      if Ident_Start = 1 or Len >= 1024 then
         Error_S ("SDF line ");
         Diag_C (Sdf_Line);
         Error_E (" is too long");
         return;
      end if;
      Buf (1 .. Len) := Buf (Ident_Start .. Ident_Start + Len - 1);
      Pos := Len + 1;
      Ident_Start := 1;
      Read_Sdf;
   end Read_Append;

   procedure Error_S_Sdf is
   begin
      Error_S (Sdf_Filename.all);
      Diag_C (':');
      Diag_C (Sdf_Line);
      Diag_C (':');
      Diag_C (Pos - Line_Start);
      Diag_C (": ");
   end Error_S_Sdf;

   procedure Error_Sdf (Msg : String) is
   begin
      Error_S_Sdf;
      Error_E (Msg);
   end Error_Sdf;

   procedure Error_Bad_Character is
   begin
      Error_Sdf ("bad character in SDF file");
   end Error_Bad_Character;

   procedure Scan_Identifier is
   begin
      Ident_Start := Pos;
      loop
         Pos := Pos + 1;
         case Buf (Pos) is
            when 'a' .. 'z'
              | 'A' .. 'Z'
              | '0' .. '9'
              | '_' =>
               null;
            when '\' =>
               Error_Sdf ("escape character not handled");
               Ident_End := Pos - 1;
               return;
            when EOT =>
               --  Continue to read.
               Read_Append;
               Pos := Pos - 1;
            when others =>
               Ident_End := Pos - 1;
               return;
         end case;
      end loop;
   end Scan_Identifier;

   function Ident_Length return Natural is
   begin
      return Ident_End - Ident_Start + 1;
   end Ident_Length;

   function Is_Ident (Str : String) return Boolean
   is
   begin
      if Ident_Length /= Str'Length then
         return False;
      end if;
      return Buf (Ident_Start .. Ident_End) = Str;
   end Is_Ident;

   procedure Scan_Qstring
   is
   begin
      Ident_Start := Pos + 1;
      loop
         Pos := Pos + 1;
         case Buf (Pos) is
            when EOT =>
               --  Continue to read.
               Read_Append;
               Pos := Pos - 1;
            when ASCII.NUL .. Character'Val (3)
              | Character'Val (5) .. Character'Val (31)
              | Character'Val (127) .. Character'Val (255) =>
               Error_Bad_Character;
            when ' '
              | '!'
              | '#' .. '~' =>
               null;
            when '"' => -- "
               Ident_End := Pos - 1;
               Pos := Pos + 1;
               exit;
         end case;
      end loop;
   end Scan_Qstring;

   Scan_Int : Integer;
   Scan_Exp : Integer;

   function Scan_Number return Sdf_Token_Type
   is
      Has_Dot : Boolean;
      Is_Negative : Boolean;
   begin
      Has_Dot := False;
      Is_Negative := False;
      Scan_Int := 0;
      Scan_Exp := 0;
      loop
         case Buf (Pos) is
            when '0' .. '9' =>
               Scan_Int := Scan_Int * 10
                 + Character'Pos (Buf (Pos)) - Character'Pos ('0');
               if Has_Dot then
                  Scan_Exp := Scan_Exp - 1;
               end if;
               Pos := Pos + 1;
            when '.' =>
               if Has_Dot then
                  Error_Bad_Character;
                  return Tok_Error;
               else
                  Has_Dot := True;
               end if;
               Pos := Pos + 1;
            when '-' =>
               if Is_Negative then
                  Error_Bad_Character;
                  return Tok_Error;
               else
                  Is_Negative := True;
               end if;
               Pos := Pos + 1;
            when EOT =>
               if Pos /= Buf_Len then
                  Error_Bad_Character;
                  return Tok_Error;
               end if;
               Pos := 1;
               Read_Sdf;
               exit when Buf_Len = 1;
            when others =>
               exit;
         end case;
      end loop;
      if Is_Negative then
         Scan_Int := -Scan_Int;
      end if;
      if Has_Dot then
         return Tok_Rnumber;
      else
         return Tok_Dnumber;
      end if;
   end Scan_Number;

   procedure Refill_Buf is
   begin
      Buf (1 .. Buf_Len - Pos) := Buf (Pos .. Buf_Len - 1);
      Pos := Buf_Len - Pos + 1;
      Read_Sdf;
      Pos := 1;
   end Refill_Buf;

   procedure Skip_Spaces is
   begin
      --  Fast blanks skipping.
      while Buf (Pos) = ' ' loop
         Pos := Pos + 1;
      end loop;

      loop
         --  Be sure there is at least 1 character.
         if Pos + 1 >= Buf_Len then
            Refill_Buf;
         end if;

         case Buf (Pos) is
            when EOT =>
               if Pos /= Buf_Len then
                  return;
               end if;
               Pos := 1;
               Read_Sdf;
               if Buf_Len = 1 then
                  return;
               end if;
            when LF =>
               Pos := Pos + 1;
               if Buf (Pos) = CR then
                  Pos := Pos + 1;
               end if;
               Line_Start := Pos;
               Sdf_Line := Sdf_Line + 1;
            when CR =>
               Pos := Pos + 1;
               if Buf (Pos) = LF then
                  Pos := Pos + 1;
               end if;
               Line_Start := Pos;
               Sdf_Line := Sdf_Line + 1;
            when ' '
              | HT =>
               Pos := Pos + 1;
            when '/' =>
               if Buf (Pos + 1) = '/' then
                  Pos := Pos + 2;
                  --  Skip line comment.
                  loop
                     exit when Buf (Pos) = CR;
                     exit when Buf (Pos) = LF;
                     exit when Buf (Pos) = EOT;
                     Pos := Pos + 1;
                     if Pos >= Buf_Len then
                        Refill_Buf;
                     end if;
                  end loop;
               else
                  return;
               end if;
            when others =>
               return;
         end case;
      end loop;
   end Skip_Spaces;

   function Get_Token return Sdf_Token_Type is
   begin
      Skip_Spaces;

      --  Be sure there is at least 4 characters.
      if Pos + 4 >= Buf_Len then
         Refill_Buf;
      end if;

      case Buf (Pos) is
         when EOT =>
            if Buf_Len = 1 then
               return Tok_Eof;
            else
               Error_Bad_Character;
               return Tok_Error;
            end if;
         when '"' => -- "
            Scan_Qstring;
            return Tok_Qstring;
         when '/' =>
            --  Skip_Spaces has already handled line comments.
            Pos := Pos + 1;
            return Tok_Div;
         when '.' =>
            Pos := Pos + 1;
            return Tok_Dot;
         when ':' =>
            Pos := Pos + 1;
            return Tok_Cln;
         when '(' =>
            Pos := Pos + 1;
            return Tok_Oparen;
         when ')' =>
            Pos := Pos + 1;
            return Tok_Cparen;
         when 'a' .. 'z'
           | 'A' .. 'Z' =>
            Scan_Identifier;
            return Tok_Identifier;
         when '0' .. '9'
           | '-' =>
            return Scan_Number;
         when others =>
            Error_Bad_Character;
            return Tok_Error;
      end case;
   end Get_Token;

   function Is_White_Space (C : Character) return Boolean is
   begin
      case C is
         when ' '
           | HT
           | CR
           | LF =>
            return True;
         when others =>
            return False;
      end case;
   end Is_White_Space;

   function Get_Edge_Token return Edge_Type is
   begin
      Skip_Spaces;

      --  Be sure there is at least 4 characters.
      if Pos + 4 >= Buf_Len then
         Refill_Buf;
      end if;

      case Buf (Pos) is
         when '0' =>
            if Is_White_Space (Buf (Pos + 2)) then
               if Buf (Pos + 1) = 'z' then
                  Pos := Pos + 2;
                  return Edge_0z;
               elsif Buf (Pos + 1) = '1' then
                  Pos := Pos + 2;
                  return Edge_01;
               end if;
            end if;
         when '1' =>
            if Is_White_Space (Buf (Pos + 2)) then
               if Buf (Pos + 1) = 'z' then
                  Pos := Pos + 2;
                  return Edge_1z;
               elsif Buf (Pos + 1) = '0' then
                  Pos := Pos + 2;
                  return Edge_10;
               end if;
            end if;
         when 'z' =>
            if Is_White_Space (Buf (Pos + 2)) then
               if Buf (Pos + 1) = '0' then
                  Pos := Pos + 2;
                  return Edge_Z0;
               elsif Buf (Pos + 1) = '1' then
                  Pos := Pos + 2;
                  return Edge_Z1;
               end if;
            end if;
         when 'p' =>
            Scan_Identifier;
            if Is_Ident ("posedge") then
               return Edge_Posedge;
            end if;
         when 'n' =>
            Scan_Identifier;
            if Is_Ident ("negedge") then
               return Edge_Negedge;
            end if;
         when others =>
            null;
      end case;
      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).L := Invalid_Dnumber;
      Sdf_Context.Ports (2).L := Invalid_Dnumber;
      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)
   --  ALTERN: alternate construct parsed (ie simple RNUMBER for tc_rvalue).
   --  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 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;

      --  Parse   [ DNUMBER ]
      --        | [ DNUMBER : DNUMBER ]
      Skip_Spaces;
      if Buf (Pos) = '[' then
         Port_Spec.R := Invalid_Dnumber;
         Pos := Pos + 1;
         if Get_Token /= Tok_Dnumber then
            Error_Sdf (Tok);
         else
            Port_Spec.L := Ghdl_I32 (Scan_Int);
         end if;
         Skip_Spaces;
         if Buf (Pos) = ':' then
            Pos := Pos + 1;
            if Get_Token /= Tok_Dnumber then
               Error_Sdf (Tok);
            else
               Port_Spec.R := Ghdl_I32 (Scan_Int);
            end if;
            Skip_Spaces;
         end if;
         if Buf (Pos) /= ']' then
            Error_Sdf ("']' expected");
         else
            Pos := Pos + 1;
         end if;
      end if;

      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.
            return Status_Altern;
         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 =>
            Sdf_Context.Timing_Nbr := 1;
            if Get_Token /= Tok_Cparen then
               Error_Sdf (Tok_Cparen);
            end if;
            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 =>
               Add ("10");
            when Edge_0z =>
               Add ("0z");
            when Edge_Z1 =>
               Add ("Z1");
            when Edge_1z =>
               Add ("1z");
            when Edge_Z0 =>
               Add ("ZO");
            when Edge_None =>
               if Force then
                  Add ("noedge");
               end if;
            when Edge_Error =>
               Add ("?");
         end case;
      end Add_Edge;

      Ok : Boolean;
   begin
      case Sdf_Context.Kind is
         when Delay_Iopath =>
            Start ("tpd");
         when Delay_Port =>
            Start ("tipd");
         when Timingcheck_Setup =>
            Start ("tsetup");
         when Timingcheck_Hold =>
            Start ("thold");
         when Timingcheck_Setuphold =>
            Start ("tsetup");
         when Timingcheck_Recovery =>
            Start ("trecovery");
         when Timingcheck_Removal =>
            Start ("tremoval");
         when Timingcheck_Skew =>
            Start ("tskew");
         when Timingcheck_Width =>
            Start ("tpw");
         when Timingcheck_Period =>
            Start ("tperiod");
         when Timingcheck_Nochange =>
            Start ("tncsetup");
      end case;
      for I in 1 .. Sdf_Context.Port_Num loop
         Add (Sdf_Context.Ports (I).Name
              (1 .. Sdf_Context.Ports (I).Name_Len));
      end loop;
      if Sdf_Context.Kind in Timing_Generic_Full_Condition then
         Add_Edge (Sdf_Context.Ports (1).Edge, True);
         Add_Edge (Sdf_Context.Ports (2).Edge, False);
      elsif Sdf_Context.Kind in Timing_Generic_Simple_Condition then
         Add_Edge (Sdf_Context.Ports (1).Edge, False);
      end if;
      Vital_Annotate.Sdf_Generic (Sdf_Context.all, Name (1 .. Len), Ok);
      if not Ok then
         Error_S_Sdf;
         Diag_C ("could not annotate generic ");
         Error_E (Name (1 .. Len));
         return False;
      end if;
      return True;
   end Handle_Generic;

   function Parse_Sdf return Boolean
   is
      Tok : Sdf_Token_Type;
      Ok : Boolean;
   begin
      if Get_Token /= Tok_Oparen
        or else Get_Token /= Tok_Identifier
        or else not Is_Ident ("DELAYFILE")
        or else Get_Token /= Tok_Oparen
        or else Get_Token /= Tok_Identifier
      then
         Error_Sdf ("not an SDF file");
         return False;
      end if;

      if Is_Ident ("SDFVERSION") then
         Tok := Get_Token;
         if Tok = Tok_Qstring then
            Sdf_Context.Version := Sdf_Version_Bad;
            if Ident_Length = 3 and then Buf (Ident_Start + 1) = '.' then
               --  Version has the format '"X.Y"' (without simple quote).
               if Buf (Ident_Start) = '2'
                 and then Buf (Ident_Start + 2) = '1'
               then
                  Sdf_Context.Version := Sdf_2_1;
               end if;
            end if;
            Tok := Get_Token;
         end if;

         if not Expect_Cp_Op_Ident (Tok) then
            return False;
         end if;
      end if;

      if not Expect_Qstr_Cp_Op_Ident ("DESIGN") then
         return False;
      end if;

      if not Expect_Qstr_Cp_Op_Ident ("DATE") then
         return False;
      end if;

      if not Expect_Qstr_Cp_Op_Ident ("VENDOR") then
         return False;
      end if;

      if not Expect_Qstr_Cp_Op_Ident ("PROGRAM") then
         return False;
      end if;

      if not Expect_Qstr_Cp_Op_Ident ("VERSION") then
         return False;
      end if;

      if Is_Ident ("DIVIDER") then
         Tok := Get_Token;
         if Tok = Tok_Div or Tok = Tok_Dot then
            Tok := Get_Token;
         end if;
         if not Expect_Cp_Op_Ident (Tok) then
            return False;
         end if;
      end if;

      if Is_Ident ("VOLTAGE") then
         if not Expect_Rexpr_Cp_Op_Ident then
            return False;
         end if;
      end if;

      if not Expect_Qstr_Cp_Op_Ident ("PROCESS") then
         return False;
      end if;

      if Is_Ident ("TEMPERATURE") then
         if not Expect_Rexpr_Cp_Op_Ident then
            return False;
         end if;
      end if;

      if Is_Ident ("TIMESCALE") then
         Tok := Get_Token;
         if Tok = Tok_Rnumber or Tok = Tok_Dnumber then
            if Scan_Exp = 0 and (Scan_Int = 1
                                 or Scan_Int = 10
                                 or Scan_Int = 100)
            then
               Sdf_Context.Timescale := Scan_Int;
            else
               Error_Sdf ("bad timescale value");
               return False;
            end if;
            Tok := Get_Token;
            if Tok /= Tok_Identifier then
               Error_Sdf (Tok_Identifier);
            end if;
            if Is_Ident ("ps") then
               null;
            elsif Is_Ident ("ns") then
               Sdf_Context.Timescale := Sdf_Context.Timescale * 1000;
            elsif Is_Ident ("us") then
               Sdf_Context.Timescale := Sdf_Context.Timescale * 1000_000;
            else
               Error_Sdf ("bad timescale unit");
               return False;
            end if;
            Tok := Get_Token;
         end if;
         if not Expect_Cp_Op_Ident (Tok) then
            return False;
         end if;
      end if;

      Vital_Annotate.Sdf_Header (Sdf_Context.all);

      --  Parse cell+
      loop
         if not Is_Ident ("CELL") then
            Error_Sdf ("CELL expected");
            return False;
         end if;
         --  Parse celltype
         if Get_Token /= Tok_Oparen
           or else Get_Token /= Tok_Identifier
           or else not Is_Ident ("CELLTYPE")
           or else Get_Token /= Tok_Qstring
         then
            Error_Sdf ("CELLTYPE expected");
            return False;
         end if;
         Sdf_Context.Celltype_Len := Ident_Length;
         if Sdf_Context.Celltype_Len > Sdf_Context.Celltype'Length then
            Error_Sdf ("CELLTYPE qstring is too long");
            return False;
         end if;
         for I in Ident_Start .. Ident_End loop
            Sdf_Context.Celltype (I - Ident_Start + 1) := To_Lower (Buf (I));
         end loop;
         Vital_Annotate.Sdf_Celltype (Sdf_Context.all);
         if Get_Token /= Tok_Cparen
           or else Get_Token /= Tok_Oparen
           or else Get_Token /= Tok_Identifier
           or else not Is_Ident ("INSTANCE")
         then
            Error_Sdf ("INSTANCE expected");
            return False;
         end if;
         --  Parse instance+
         loop
            exit when not Is_Ident ("INSTANCE");
            Tok := Get_Token;
            if Tok /= Tok_Cparen then
               loop
                  if Tok /= Tok_Identifier then
                     Error_Sdf ("instance identifier expected");
                     return False;
                  end if;
                  for I in Ident_Start .. Ident_End loop
                     Buf (I) := To_Lower (Buf (I));
                  end loop;
                  Vital_Annotate.Sdf_Instance
                    (Sdf_Context.all, Buf (Ident_Start .. Ident_End), Ok);
                  if not Ok then
                     Error_Sdf ("cannot find instance");
                     return False;
                  end if;
                  Tok := Get_Token;
                  exit when Tok /= Tok_Dot;
                  Tok := Get_Token;
               end loop;
            end if;
            if Tok /= Tok_Cparen
              or else Get_Token /= Tok_Oparen
              or else Get_Token /= Tok_Identifier
            then
               Error_Sdf ("instance or timing_spec expected");
               return False;
            end if;
         end loop;
         Vital_Annotate.Sdf_Instance_End (Sdf_Context.all, Ok);
         if not Ok then
            Error_Sdf ("bad instance or celltype mistmatch");
            return False;
         end if;

         --  Parse timing_spec+
         loop
            if Is_Ident ("DELAY") then
               --  Parse deltype+
               Tok := Get_Token;
               loop
                  if Tok /= Tok_Oparen
                    or else Get_Token /= Tok_Identifier
                  then
                     Error_Sdf ("deltype expected");
                     return False;
                  end if;
                  if Is_Ident ("PATHPULSE")
                    or else Is_Ident ("GLOBALPATHPULSE")
                  then
                     Error_Sdf ("PATHPULSE and GLOBALPATHPULSE not allowed");
                     return False;
                  end if;
                  if Is_Ident ("ABSOLUTE") then
                     null;
                  elsif Is_Ident ("INCREMENT") then
                     null;
                  else
                     Error_Sdf ("ABSOLUTE or INCREMENT expected");
                     return False;
                  end if;
                  --  Parse absvals+ or incvals+
                  Tok := Get_Token;
                  loop
                     if Tok /= Tok_Oparen
                       or else Get_Token /= Tok_Identifier
                     then
                        Error_Sdf ("absvals or incvals expected");
                        return False;
                     end if;
                     if Is_Ident ("IOPATH") then
                        Start_Generic_Name (Delay_Iopath);
                        if not Parse_Port_Spec
                          or else not Parse_Port_Path
                          or else not Parse_Rvalue
                        then
                           return False;
                        end if;
                     elsif Is_Ident ("PORT") then
                        Start_Generic_Name (Delay_Port);
                        if not Parse_Port_Path
                          or else not Parse_Rvalue
                        then
                           return False;
                        end if;
                     elsif Is_Ident ("COND")
                       or else Is_Ident ("INTERCONNECT")
                       or else Is_Ident ("DEVICE")
                     then
                        Error_Sdf
                          ("COND, INTERCONNECT, or DEVICE not handled");
                        return False;
                     elsif Is_Ident ("NETDELAY") then
                        Error_Sdf ("NETDELAY not allowed in VITAL SDF");
                        return False;
                     else
                        Error_Sdf ("absvals or incvals expected");
                        return False;
                     end if;

                     if not Handle_Generic then
                        return False;
                     end if;

                     Tok := Get_Token;
                     exit when Tok = Tok_Cparen;
                  end loop;
                  Tok := Get_Token;
                  exit when Tok = Tok_Cparen;
               end loop;
            elsif Is_Ident ("TIMINGCHECK") then
               --  parse tc_def+
               Tok := Get_Token;
               loop
                  if Tok /= Tok_Oparen
                    or else Get_Token /= Tok_Identifier
                  then
                     Error_Sdf ("tc_def expected");
                     return False;
                  end if;
                  if Is_Ident ("SETUP") then
                     Start_Generic_Name (Timingcheck_Setup);
                  elsif Is_Ident ("HOLD") then
                     Start_Generic_Name (Timingcheck_Hold);
                  elsif Is_Ident ("SETUPHOLD") then
                     Start_Generic_Name (Timingcheck_Setuphold);
                  elsif Is_Ident ("RECOVERY") then
                     Start_Generic_Name (Timingcheck_Recovery);
                  elsif Is_Ident ("REMOVAL") then
                     Start_Generic_Name (Timingcheck_Removal);
                  elsif Is_Ident ("SKEW") then
                     Start_Generic_Name (Timingcheck_Skew);
                  elsif Is_Ident ("WIDTH") then
                     Start_Generic_Name (Timingcheck_Width);
                  elsif Is_Ident ("PERIOD") then
                     Start_Generic_Name (Timingcheck_Period);
                  elsif Is_Ident ("NOCHANGE") then
                     Start_Generic_Name (Timingcheck_Nochange);
                  elsif Is_Ident ("PATHCONSTRAINT")
                    or else Is_Ident ("SUM")
                    or else Is_Ident ("DIFF")
                    or else Is_Ident ("SKEWCONSTRAINT")
                  then
                     Error_Sdf ("non-VITAL tc_def");
                     return False;
                  else
                     Error_Sdf ("bad tc_def");
                     return False;
                  end if;

                  case Sdf_Context.Kind is
                     when Timingcheck_Setup
                       | Timingcheck_Hold
                       | Timingcheck_Recovery
                       | Timingcheck_Removal
                       | Timingcheck_Skew
                       | Timingcheck_Setuphold
                       | Timingcheck_Nochange =>
                        if not Parse_Port_Tchk
                          or else not Parse_Port_Tchk
                          or else not Parse_Simple_Tc_Rvalue
                        then
                           return False;
                        end if;
                     when Timingcheck_Width
                       | Timingcheck_Period =>
                        if not Parse_Port_Tchk
                          or else not Parse_Simple_Tc_Rvalue
                        then
                           return False;
                        end if;
                     when others =>
                        Internal_Error ("sdf_parse");
                  end case;

                  if not Handle_Generic then
                     return False;
                  end if;

                  case Sdf_Context.Kind is
                     when Timingcheck_Setuphold
                       | Timingcheck_Nochange =>
                        if not Parse_Simple_Tc_Rvalue then
                           return False;
                        end if;
                        Error_Sdf ("setuphold and nochange not yet handled");
                        return False;
                     when others =>
                        null;
                  end case;

                  if Get_Token /= Tok_Cparen then
                     Error_Sdf (Tok_Cparen);
                     return False;
                  end if;
                  Tok := Get_Token;
                  exit when Tok = Tok_Cparen;
               end loop;
            end if;
            Tok := Get_Token;
            exit when Tok = Tok_Cparen;
            if Tok /= Tok_Oparen then
               Error_Sdf (Tok_Oparen);
               return False;
            end if;
            if Get_Token /= Tok_Identifier then
               Error_Sdf (Tok_Identifier);
               return False;
            end if;
         end loop;
         Tok := Get_Token;
         exit when Tok = Tok_Cparen;
         if Tok /= Tok_Oparen
           or else Get_Token /= Tok_Identifier
         then
            Error_Sdf (Tok_Identifier);
         end if;
      end loop;
      if Get_Token /= Tok_Eof then
         Error_Sdf ("EOF expected");
         return False;
      end if;
      return True;
   end Parse_Sdf;

   function Parse_Sdf_File (Filename : String) return Boolean
   is
      Res : Boolean;
   begin
      if not Open_Sdf (Filename) then
         return False;
      end if;
      Res := Parse_Sdf;
      Close_Sdf;
      return Res;
   end Parse_Sdf_File;

end Grt.Sdf;