diff options
Diffstat (limited to 'src/grt/grt-sdf.adb')
-rw-r--r-- | src/grt/grt-sdf.adb | 1389 |
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; |