Move files and dirs from translate/

1 files changed, 1389 insertions, 0 deletions

diff --git a/src/grt/grt-sdf.adb b/src/grt/grt-sdf.adb
new file mode 100644
index 000000000..73534e3eb
--- /dev/null
+++ b/src/grt/grt-sdf.adb
@@ -0,0 +1,1389 @@
+--  GHDL Run Time (GRT) - SDF parser.
+--  Copyright (C) 2002 - 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 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 System.Storage_Elements; --  Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Grt.Stdio; use Grt.Stdio;
+with Grt.C; use Grt.C;
+with Grt.Errors; use Grt.Errors;
+with Ada.Characters.Latin_1;
+with Ada.Unchecked_Deallocation;
+with Grt.Vital_Annotate;
+
+package body Grt.Sdf is
+   EOT : constant Character := Character'Val (4);
+
+   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" & NUL;
+   begin
+      N_Filename (1 .. Filename'Length) := Filename;
+      N_Filename (N_Filename'Last) := NUL;
+      Sdf_Stream := fopen (N_Filename'Address, Mode'Address);
+      if Sdf_Stream = NULL_Stream then
+         Error_C ("cannot open SDF file '");
+         Error_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_C ("SDF line ");
+         Error_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_Sdf_C is
+   begin
+      Error_C (Sdf_Filename.all);
+      Error_C (":");
+      Error_C (Sdf_Line);
+      Error_C (":");
+      Error_C (Pos - Line_Start);
+      Error_C (": ");
+   end Error_Sdf_C;
+
+   procedure Error_Sdf (Msg : String) is
+   begin
+      Error_Sdf_C;
+      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 =>
+               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 =>
+               Read_Append;
+            when 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;
+   begin
+      Has_Dot := 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 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 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
+      use Ada.Characters.Latin_1;
+   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
+      use Ada.Characters.Latin_1;
+   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
+      use Ada.Characters.Latin_1;
+   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
+      use Ada.Characters.Latin_1;
+   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 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;
+
+      --  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_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_Sdf_C;
+         Error_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 ("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_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;