aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/ghdldrv/ghdldrv.adb41
-rw-r--r--src/ghdldrv/ghdlmain.adb4
-rw-r--r--src/ghdldrv/ghdlrun.adb5
-rw-r--r--src/grt/ghdl_main.adb3
-rw-r--r--src/grt/grt-errors.adb1
-rw-r--r--src/grt/grt-errors.ads1
-rw-r--r--src/grt/grt-main.adb4
-rw-r--r--src/grt/grt-processes.adb11
-rw-r--r--src/grt/grt-processes.ads4
9 files changed, 51 insertions, 23 deletions
diff --git a/src/ghdldrv/ghdldrv.adb b/src/ghdldrv/ghdldrv.adb
index 492e47dc0..28613c727 100644
--- a/src/ghdldrv/ghdldrv.adb
+++ b/src/ghdldrv/ghdldrv.adb
@@ -95,10 +95,9 @@ package body Ghdldrv is
Linker_Args : Argument_Table_Pkg.Instance;
-- Display the program spawned in Flag_Disp_Commands is TRUE.
- -- Raise COMPILE_ERROR in case of failure.
- procedure My_Spawn (Program_Name : String; Args : Argument_List)
- is
- Status : Integer;
+ -- Return the exit status.
+ function My_Spawn_Status (Program_Name : String; Args : Argument_List)
+ return Integer is
begin
if Flag_Disp_Commands then
Put (Program_Name);
@@ -108,7 +107,16 @@ package body Ghdldrv is
end loop;
New_Line;
end if;
- Status := Spawn (Program_Name, Args);
+ return Spawn (Program_Name, Args);
+ end My_Spawn_Status;
+
+ -- Display the program spawned in Flag_Disp_Commands is TRUE.
+ -- Raise COMPILE_ERROR in case of failure.
+ procedure My_Spawn (Program_Name : String; Args : Argument_List)
+ is
+ Status : Integer;
+ begin
+ Status := My_Spawn_Status (Program_Name, Args);
if Status = 0 then
return;
elsif Status = 1 then
@@ -953,6 +961,19 @@ package body Ghdldrv is
return "-r UNIT [ARCH] [OPTS] Run UNIT";
end Get_Short_Help;
+ procedure Run_Design (Exec : String_Access; Args : Argument_List)
+ is
+ Status : Integer;
+ begin
+ if Is_Absolute_Path (Exec.all) then
+ Status := My_Spawn_Status (Exec.all, Args);
+ else
+ Status := My_Spawn_Status
+ ('.' & Directory_Separator & Exec.all, Args);
+ end if;
+ Set_Exit_Status (Exit_Status (Status));
+ end Run_Design;
+
procedure Perform_Action (Cmd : in out Command_Run; Args : Argument_List)
is
pragma Unreferenced (Cmd);
@@ -969,8 +990,7 @@ package body Ghdldrv is
Error ("Please elaborate your design.");
raise Exec_Error;
end if;
- My_Spawn ('.' & Directory_Separator & Base_Name.all,
- Args (Opt_Arg .. Args'Last));
+ Run_Design (Base_Name, Args (Opt_Arg .. Args'Last));
end Perform_Action;
-- Command Elab_Run.
@@ -1012,12 +1032,7 @@ package body Ghdldrv is
else
Link (Add_Std => True, Disp_Only => False);
Delete_File (Filelist_Name.all, Success);
- if Is_Absolute_Path (Output_File.all) then
- My_Spawn (Output_File.all, Args (Run_Arg .. Args'Last));
- else
- My_Spawn ('.' & Directory_Separator & Output_File.all,
- Args (Run_Arg .. Args'Last));
- end if;
+ Run_Design (Output_File, Args (Run_Arg .. Args'Last));
end if;
end Perform_Action;
diff --git a/src/ghdldrv/ghdlmain.adb b/src/ghdldrv/ghdlmain.adb
index 45d9615f9..606119e63 100644
--- a/src/ghdldrv/ghdlmain.adb
+++ b/src/ghdldrv/ghdlmain.adb
@@ -321,6 +321,9 @@ package body Ghdlmain is
First_Arg := Argument_Count + 1;
end if;
+ -- Set before running the action, so that it can be changed.
+ Set_Exit_Status (Success);
+
declare
Args : Argument_List (1 .. Argument_Count - First_Arg + 1);
begin
@@ -336,7 +339,6 @@ package body Ghdlmain is
-- Name_Table.Disp_Stats;
-- Iirs.Disp_Stats;
--end if;
- Set_Exit_Status (Success);
exception
when Option_Error
| Compile_Error
diff --git a/src/ghdldrv/ghdlrun.adb b/src/ghdldrv/ghdlrun.adb
index cc93bd827..13bb6f890 100644
--- a/src/ghdldrv/ghdlrun.adb
+++ b/src/ghdldrv/ghdlrun.adb
@@ -58,6 +58,7 @@ with Grt.Images;
with Grt.Values;
with Grt.Names;
with Grt.Std_Logic_1164;
+with Grt.Errors;
with Ghdlcomp;
with Foreigns;
@@ -605,7 +606,9 @@ package body Ghdlrun is
end if;
Grt.Main.Run;
- --V := Ghdl_Main (1, Gnat_Argv);
+
+ Ada.Command_Line.Set_Exit_Status
+ (Ada.Command_Line.Exit_Status (Grt.Errors.Exit_Status));
end Run;
diff --git a/src/grt/ghdl_main.adb b/src/grt/ghdl_main.adb
index ce5b67d7e..2d1a00813 100644
--- a/src/grt/ghdl_main.adb
+++ b/src/grt/ghdl_main.adb
@@ -32,6 +32,7 @@ with Grt.Types; use Grt.Types;
pragma Warnings (Off);
with Grt.Rtis_Binding;
with Grt.Std_Logic_1164;
+with Grt.Errors;
pragma Warnings (On);
@@ -57,5 +58,5 @@ begin
Grt_Init;
Grt.Main.Run;
- return 0;
+ return Grt.Errors.Exit_Status;
end Ghdl_Main;
diff --git a/src/grt/grt-errors.adb b/src/grt/grt-errors.adb
index eddea38c1..ed936688b 100644
--- a/src/grt/grt-errors.adb
+++ b/src/grt/grt-errors.adb
@@ -48,6 +48,7 @@ package body Grt.Errors is
procedure Exit_Simulation is
begin
+ -- -2 is Grt.Errors.Run_Stop
Maybe_Return_Via_Longjump (-2);
Internal_Error ("exit_simulation");
end Exit_Simulation;
diff --git a/src/grt/grt-errors.ads b/src/grt/grt-errors.ads
index c797a71bd..33c993226 100644
--- a/src/grt/grt-errors.ads
+++ b/src/grt/grt-errors.ads
@@ -67,6 +67,7 @@ package Grt.Errors is
pragma No_Return (Fatal_Error);
pragma Export (C, Fatal_Error, "__ghdl_fatal");
+ -- Stop or finish simulation (for VHPI or std.env).
Exit_Status : Integer := 0;
procedure Exit_Simulation;
diff --git a/src/grt/grt-main.adb b/src/grt/grt-main.adb
index 6d595b4cc..4d4106bee 100644
--- a/src/grt/grt-main.adb
+++ b/src/grt/grt-main.adb
@@ -182,6 +182,10 @@ package body Grt.Main is
Disp_Stats_Hook (0);
end if;
+ if Status = -2 then
+ return;
+ end if;
+
if Expect_Failure then
if Status >= 0 then
Expect_Failure := False;
diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb
index 4a124e689..01e8394bc 100644
--- a/src/grt/grt-processes.adb
+++ b/src/grt/grt-processes.adb
@@ -707,6 +707,9 @@ package body Grt.Processes is
Run_Finished : constant Integer := 3;
-- Failure, simulation should stop.
Run_Failure : constant Integer := -1;
+ -- Stop/finish request from user (via std.env).
+ Run_Stop : constant Integer := -2;
+ pragma Unreferenced (Run_Stop);
Mt_Last : Natural;
Mt_Table : Process_Acc_Array_Acc;
@@ -1015,7 +1018,7 @@ package body Grt.Processes is
Status := Run_Through_Longjump (Initialization_Phase'Access);
if Status /= Run_Resumed then
- return -1;
+ return Status;
end if;
Nbr_Delta_Cycles := 0;
@@ -1074,11 +1077,7 @@ package body Grt.Processes is
Grt.Hooks.Call_Finish_Hooks;
- if Status = Run_Failure then
- return -1;
- else
- return Exit_Status ;
- end if;
+ return Status;
end Simulation;
end Grt.Processes;
diff --git a/src/grt/grt-processes.ads b/src/grt/grt-processes.ads
index 534a129ad..2d953ecf1 100644
--- a/src/grt/grt-processes.ads
+++ b/src/grt/grt-processes.ads
@@ -38,7 +38,9 @@ package Grt.Processes is
procedure Init;
-- Do the VHDL simulation.
- -- Return 0 in case of success (end of time reached).
+ -- Return simulation status:
+ -- >= 0 in case of success (end of time reached).
+ -- < 0 in case of failure or stop request.
function Simulation return Integer;
-- Number of delta cycles.
generated by cgit v1.2.3 (git 2.25.1) at 2024-10-12 08:04:55 +0000