aboutsummaryrefslogtreecommitdiffstats
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/ghdldrv/ghdllocal.adb6
-rw-r--r--src/grt/grt-options.adb10
-rw-r--r--src/grt/grt-processes.adb7
-rw-r--r--src/grt/grt-sdf.adb41
-rw-r--r--src/grt/grt-strings.adb41
-rw-r--r--src/grt/grt-strings.ads36
-rw-r--r--src/grt/grt-values.adb22
-rw-r--r--src/grt/grt-values.ads6
-rw-r--r--src/grt/grt-vpi.adb114
9 files changed, 184 insertions, 99 deletions
diff --git a/src/ghdldrv/ghdllocal.adb b/src/ghdldrv/ghdllocal.adb
index a28c44bee..fbffb5f1d 100644
--- a/src/ghdldrv/ghdllocal.adb
+++ b/src/ghdldrv/ghdllocal.adb
@@ -442,11 +442,7 @@ package body Ghdllocal is
when Lib_Standard =>
Add_Library_Path ("ieee");
when Lib_Synopsys =>
- if Vhdl_Std >= Vhdl_08 then
- Warning ("--ieee=synopsys is ignored for --std=08");
- else
- Add_Library_Path ("synopsys");
- end if;
+ Add_Library_Path ("synopsys");
when Lib_Mentor =>
if Vhdl_Std >= Vhdl_08 then
Warning ("--ieee=mentor is ignored for --std=08");
diff --git a/src/grt/grt-options.adb b/src/grt/grt-options.adb
index 3c4acb215..81fa962f0 100644
--- a/src/grt/grt-options.adb
+++ b/src/grt/grt-options.adb
@@ -23,6 +23,7 @@
-- however invalidate any other reasons why the executable file might be
-- covered by the GNU Public License.
with Interfaces; use Interfaces;
+with Grt.Strings; use Grt.Strings;
with Grt.Errors; use Grt.Errors;
with Grt.Astdio;
with Grt.Hooks;
@@ -210,15 +211,6 @@ package body Grt.Options is
end loop;
end Extract_Integer;
- function To_Lower (C : Character) return Character is
- begin
- if C in 'A' .. 'Z' then
- return Character'Val (Character'Pos (C) + 32);
- else
- return C;
- end if;
- end To_Lower;
-
procedure Decode_Option
(Option : String; Status : out Decode_Option_Status)
is
diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb
index 91e56b6ca..67b7a88a5 100644
--- a/src/grt/grt-processes.adb
+++ b/src/grt/grt-processes.adb
@@ -842,6 +842,13 @@ package body Grt.Processes is
-- of step f of the simulation cycle, below.
Next_Time := Compute_Next_Time;
if Next_Time /= 0 then
+ if Has_Callbacks (Hooks.Cb_Last_Known_Delta) then
+ Call_Callbacks (Hooks.Cb_Last_Known_Delta);
+ Flush_Active_Chain;
+ Next_Time := Compute_Next_Time;
+ end if;
+ end if;
+ if Next_Time /= 0 then
Update_Active_Chain;
end if;
diff --git a/src/grt/grt-sdf.adb b/src/grt/grt-sdf.adb
index 75dfefe4d..1cb04e5e1 100644
--- a/src/grt/grt-sdf.adb
+++ b/src/grt/grt-sdf.adb
@@ -1,5 +1,5 @@
-- GHDL Run Time (GRT) - SDF parser.
--- Copyright (C) 2002 - 2014 Tristan Gingold
+-- 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
@@ -22,17 +22,16 @@
-- 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.Strings; use Grt.Strings;
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);
+ use ASCII;
type Sdf_Token_Type is
(
@@ -71,10 +70,10 @@ package body Grt.Sdf is
function Open_Sdf (Filename : String) return Boolean
is
N_Filename : String (1 .. Filename'Length + 1);
- Mode : constant String := "rt" & NUL;
+ Mode : constant String := "rt" & ASCII.NUL;
begin
N_Filename (1 .. Filename'Length) := Filename;
- N_Filename (N_Filename'Last) := NUL;
+ N_Filename (N_Filename'Last) := ASCII.NUL;
Sdf_Stream := fopen (N_Filename'Address, Mode'Address);
if Sdf_Stream = NULL_Stream then
Error_C ("cannot open SDF file '");
@@ -212,7 +211,7 @@ package body Grt.Sdf is
-- Continue to read.
Read_Append;
Pos := Pos - 1;
- when NUL .. Character'Val (3)
+ when ASCII.NUL .. Character'Val (3)
| Character'Val (5) .. Character'Val (31)
| Character'Val (127) .. Character'Val (255) =>
Error_Bad_Character;
@@ -295,9 +294,7 @@ package body Grt.Sdf is
Pos := 1;
end Refill_Buf;
- procedure Skip_Spaces
- is
- use Ada.Characters.Latin_1;
+ procedure Skip_Spaces is
begin
-- Fast blanks skipping.
while Buf (Pos) = ' ' loop
@@ -359,9 +356,7 @@ package body Grt.Sdf is
end loop;
end Skip_Spaces;
- function Get_Token return Sdf_Token_Type
- is
- use Ada.Characters.Latin_1;
+ function Get_Token return Sdf_Token_Type is
begin
Skip_Spaces;
@@ -410,9 +405,7 @@ package body Grt.Sdf is
end case;
end Get_Token;
- function Is_White_Space (C : Character) return Boolean
- is
- use Ada.Characters.Latin_1;
+ function Is_White_Space (C : Character) return Boolean is
begin
case C is
when ' '
@@ -425,9 +418,7 @@ package body Grt.Sdf is
end case;
end Is_White_Space;
- function Get_Edge_Token return Edge_Type
- is
- use Ada.Characters.Latin_1;
+ function Get_Edge_Token return Edge_Type is
begin
Skip_Spaces;
@@ -664,16 +655,6 @@ package body Grt.Sdf is
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
diff --git a/src/grt/grt-strings.adb b/src/grt/grt-strings.adb
new file mode 100644
index 000000000..38e2c6b4e
--- /dev/null
+++ b/src/grt/grt-strings.adb
@@ -0,0 +1,41 @@
+-- GHDL Run Time (GRT) - Misc subprograms for characters and strings
+-- Copyright (C) 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.
+
+package body Grt.Strings is
+ function Is_Whitespace (C : in Character) return Boolean is
+ use ASCII;
+ begin
+ return C = ' ' or C = NBSP or C = HT;
+ end Is_Whitespace;
+
+ function To_Lower (C : Character) return Character is
+ begin
+ if C in 'A' .. 'Z' then
+ return Character'Val (Character'Pos (C) + 32);
+ else
+ return C;
+ end if;
+ end To_Lower;
+end Grt.Strings;
diff --git a/src/grt/grt-strings.ads b/src/grt/grt-strings.ads
new file mode 100644
index 000000000..d11c799f0
--- /dev/null
+++ b/src/grt/grt-strings.ads
@@ -0,0 +1,36 @@
+-- GHDL Run Time (GRT) - Misc subprograms for characters and strings
+-- Copyright (C) 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.
+
+package Grt.Strings is
+ pragma Pure;
+
+ NBSP : constant Character := Character'Val (160);
+
+ -- Return True IFF C is a whitespace character (as defined in LRM93 14.3)
+ function Is_Whitespace (C : in Character) return Boolean;
+
+ -- Convert C to lowercase.
+ function To_Lower (C : Character) return Character;
+end Grt.Strings;
diff --git a/src/grt/grt-values.adb b/src/grt/grt-values.adb
index e87182791..e64e7b943 100644
--- a/src/grt/grt-values.adb
+++ b/src/grt/grt-values.adb
@@ -1,5 +1,5 @@
-- GHDL Run Time (GRT) - 'value subprograms.
--- Copyright (C) 2002 - 2014 Tristan Gingold
+-- 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
@@ -24,18 +24,13 @@
-- covered by the GNU Public License.
with Grt.Errors; use Grt.Errors;
with Grt.Rtis_Utils;
+with Grt.Strings; use Grt.Strings;
package body Grt.Values is
NBSP : constant Character := Character'Val (160);
HT : constant Character := Character'Val (9);
- -- Return True IFF C is a whitespace character (as defined in LRM93 14.3)
- function Is_Whitespace (C : in Character) return Boolean is
- begin
- return C = ' ' or C = NBSP or C = HT;
- end Is_Whitespace;
-
-- Increase POS to skip leading whitespace characters, decrease LEN to
-- skip trailing whitespaces in string S.
procedure Remove_Whitespaces (S : Std_String_Basep;
@@ -58,17 +53,6 @@ package body Grt.Values is
end if;
end Remove_Whitespaces;
- -- Convert C to lowercase.
- function To_LC (C : in Character) return Character is
- begin
- if C in 'A' .. 'Z' then
- return Character'Val
- (Character'Pos (C) + Character'Pos ('a') - Character'Pos ('A'));
- else
- return C;
- end if;
- end To_LC;
-
-- Return TRUE iff user string S (POS .. LEN - 1) is equal to REF.
-- Comparaison is case insensitive, but REF must be lowercase (REF is
-- supposed to come from an RTI).
@@ -90,7 +74,7 @@ package body Grt.Values is
end if;
C_S := S (Pos + P);
if not Is_Char then
- C_S := To_LC (C_S);
+ C_S := To_Lower (C_S);
end if;
if C_S /= C_Ref or else C_Ref = ASCII.NUL then
return False;
diff --git a/src/grt/grt-values.ads b/src/grt/grt-values.ads
index 5f1e5169d..ee76109d5 100644
--- a/src/grt/grt-values.ads
+++ b/src/grt/grt-values.ads
@@ -26,12 +26,6 @@ with Grt.Types; use Grt.Types;
with Grt.Rtis; use Grt.Rtis;
package Grt.Values is
- -- Return True IFF C is a whitespace character (as defined in LRM93 14.3)
- function Is_Whitespace (C : in Character) return Boolean;
-
- -- Convert C to lowercase.
- function To_LC (C : in Character) return Character;
-
-- Extract position of numeric literal and unit in string STR.
-- Set IS_REAL if the unit is a real number (presence of '.').
-- Set UNIT_POS to the position of the first character of the unit name.
diff --git a/src/grt/grt-vpi.adb b/src/grt/grt-vpi.adb
index 90c75ef93..d7a62330f 100644
--- a/src/grt/grt-vpi.adb
+++ b/src/grt/grt-vpi.adb
@@ -45,6 +45,7 @@ with Grt.Stdio; use Grt.Stdio;
with Grt.C; use Grt.C;
with Grt.Signals; use Grt.Signals;
with Grt.Astdio; use Grt.Astdio;
+with Grt.Strings; use Grt.Strings;
with Grt.Hooks; use Grt.Hooks;
with Grt.Options;
with Grt.Vcd; use Grt.Vcd;
@@ -131,13 +132,6 @@ package body Grt.Vpi is
-- Clear error status.
procedure Reset_Error;
- procedure Vpi_Trace (Msg : String) is
- begin
- if Flag_Trace then
- Put_Line (Trace_File, Msg);
- end if;
- end Vpi_Trace;
-
procedure Trace_Start (Msg : String) is
begin
for I in 1 .. Trace_Indent loop
@@ -213,11 +207,53 @@ package body Grt.Vpi is
when vpiRightRange =>
Trace ("vpiRightRange");
+ when vpiStop =>
+ Trace ("vpiStop");
+ when vpiFinish =>
+ Trace ("vpiFinish");
+ when vpiReset =>
+ Trace ("vpiReset");
+
when others =>
Trace (V);
end case;
end Trace_Property;
+ procedure Trace_Format (F : Integer) is
+ begin
+ case F is
+ when vpiBinStrVal =>
+ Trace ("BinStr");
+ when vpiOctStrVal =>
+ Trace ("OctStr");
+ when vpiDecStrVal =>
+ Trace ("DecStr");
+ when vpiHexStrVal =>
+ Trace ("HexStr");
+ when vpiScalarVal =>
+ Trace ("Scalar");
+ when vpiIntVal =>
+ Trace ("Int");
+ when vpiRealVal =>
+ Trace ("Real");
+ when vpiStringVal =>
+ Trace ("String");
+ when vpiVectorVal =>
+ Trace ("Vector");
+ when vpiStrengthVal =>
+ Trace ("Strength");
+ when vpiTimeVal =>
+ Trace ("Time");
+ when vpiObjTypeVal =>
+ Trace ("ObjType");
+ when vpiSuppressVal =>
+ Trace ("Suppress");
+
+ when others =>
+ Trace (F);
+ end case;
+ end Trace_Format;
+
procedure Trace_Time_Tag (V : Integer) is
begin
case V is
@@ -796,7 +832,7 @@ package body Grt.Vpi is
Trace_Start ("vpi_get_value (");
Trace (Expr);
Trace (", {format=");
- Trace (Value.Format);
+ Trace_Format (Value.Format);
Trace ("}) = ");
end if;
@@ -1130,7 +1166,21 @@ package body Grt.Vpi is
Res : Integer;
pragma Unreferenced (Res);
begin
+ if Flag_Trace then
+ Trace_Start ("vpi call callback ");
+ Trace_Cb_Reason (Hand.Cb.Reason);
+ Trace (" ");
+ Trace (Hand);
+ Trace_Newline;
+ Trace_Indent := Trace_Indent + 1;
+ end if;
Res := Hand.Cb.Cb_Rtn (Hand.Cb'Access);
+ if Flag_Trace then
+ Trace_Indent := Trace_Indent - 1;
+ Trace_Start ("vpi end callback ");
+ Trace (Hand);
+ Trace_Newline;
+ end if;
end Execute_Callback;
procedure Execute_Callback_List (List : Callback_List)
@@ -1157,25 +1207,12 @@ package body Grt.Vpi is
function To_vpiHandle is new Ada.Unchecked_Conversion
(System.Address, vpiHandle);
+ -- Wrapper
procedure Call_Callback (Arg : System.Address)
is
Hand : constant vpiHandle := To_vpiHandle (Arg);
begin
- if Flag_Trace then
- Trace_Start ("vpi call callback ");
- Trace_Cb_Reason (Hand.Cb.Reason);
- Trace (" ");
- Trace (Hand);
- Trace_Newline;
- Trace_Indent := Trace_Indent + 1;
- end if;
Execute_Callback (Hand);
- if Flag_Trace then
- Trace_Indent := Trace_Indent - 1;
- Trace_Start ("vpi end callback ");
- Trace (Hand);
- Trace_Newline;
- end if;
end Call_Callback;
procedure Call_Valuechange_Callback (Arg : System.Address)
@@ -1290,7 +1327,10 @@ package body Grt.Vpi is
-- int vpi_get_vlog_info(p_vpi_vlog_info vlog_info_p)
function vpi_get_vlog_info (info : p_vpi_vlog_info) return integer is
begin
- Vpi_Trace ("vpi_get_vlog_info");
+ if Flag_Trace then
+ Trace_Start ("vpi_get_vlog_info");
+ Trace_Newline;
+ end if;
info.all := (Argc => 0,
Argv => Null_Address,
@@ -1306,6 +1346,11 @@ package body Grt.Vpi is
pragma Unreferenced (aRef);
pragma Unreferenced (aIndex);
begin
+ if Flag_Trace then
+ Trace_Start ("vpi_handle_by_index UNIMPLEMENTED!");
+ Trace_Newline;
+ end if;
+
return null;
end vpi_handle_by_index;
@@ -1323,7 +1368,7 @@ package body Grt.Vpi is
-- NUL not allowed in L.
return False;
end if;
- if L (I) /= R (I - L'First + 1) then
+ if To_Lower (L (I)) /= R (I - L'First + 1) then
return False;
end if;
end loop;
@@ -1353,7 +1398,7 @@ package body Grt.Vpi is
exit when Err /= AvhpiErrorOk;
El_Name := Avhpi_Get_Base_Name (Res);
- exit when Strcmp (Name , El_Name);
+ exit when Strcmp (Name, El_Name);
end loop;
end Find_By_Name;
@@ -1474,7 +1519,10 @@ package body Grt.Vpi is
is
pragma Unreferenced (aSs);
begin
- Vpi_Trace ("vpi_register_systf");
+ if Flag_Trace then
+ Trace_Start ("vpi_register_systf");
+ Trace_Newline;
+ end if;
end vpi_register_systf;
-- int vpi_remove_cb(vpiHandle ref)
@@ -1561,11 +1609,17 @@ package body Grt.Vpi is
return Err_Status;
end vpi_chk_error;
- function vpi_control (Op : Integer; Status : Integer) return Integer
- is
- pragma Unreferenced (Status);
+ function vpi_control (Op : Integer; Status : Integer) return Integer is
begin
- Vpi_Trace ("vpi_control");
+ if Flag_Trace then
+ Trace_Start ("vpi_control (");
+ Trace_Property (Op);
+ Trace (", ");
+ Trace (Status);
+ Trace (")");
+ Trace_Newline;
+ end if;
+
case Op is
when vpiFinish
| vpiStop =>
generated by cgit v1.2.3 (git 2.25.1) at 2025-05-12 22:49:52 +0000