aboutsummaryrefslogtreecommitdiffstats
path: root/src/grt
diff options
context:
space:
mode:
Diffstat (limited to 'src/grt')
-rw-r--r--src/grt/Makefile.inc101
-rw-r--r--src/grt/config/jumps.c171
-rw-r--r--src/grt/config/math.c55
-rw-r--r--src/grt/grt-errors.adb8
-rw-r--r--src/grt/grt-errors.ads3
-rw-r--r--src/grt/grt-main.adb8
-rw-r--r--src/grt/grt-main.ads7
-rw-r--r--src/grt/grt-options.adb47
-rw-r--r--src/grt/grt-options.ads8
-rw-r--r--src/grt/grt-processes.adb154
-rw-r--r--src/grt/grt-processes.ads67
-rw-r--r--src/grt/grt-stack2.adb10
-rw-r--r--src/grt/grt-stack2.ads35
-rw-r--r--src/grt/grt-stacks.adb43
-rw-r--r--src/grt/grt-stacks.ads87
-rw-r--r--src/grt/grt-unithread.adb25
-rw-r--r--src/grt/grt-unithread.ads22
17 files changed, 402 insertions, 449 deletions
diff --git a/src/grt/Makefile.inc b/src/grt/Makefile.inc
index df368946f..5b64a5440 100644
--- a/src/grt/Makefile.inc
+++ b/src/grt/Makefile.inc
@@ -45,63 +45,22 @@ endif
GRT_ELF_OPTS:=-Wl,--version-script=@/grt.ver -Wl,--export-dynamic
# Set target files.
-ifeq ($(filter-out i%86 linux,$(arch) $(osys)),)
- GRT_TARGET_OBJS=i386.o linux.o times.o
- GRT_EXTRA_LIB=-ldl -lm $(GRT_ELF_OPTS)
-endif
-ifeq ($(filter-out x86_64 linux,$(arch) $(osys)),)
- GRT_TARGET_OBJS=amd64.o linux.o times.o
- GRT_EXTRA_LIB=-ldl -lm $(GRT_ELF_OPTS)
-endif
-ifeq ($(filter-out i%86 netbsd,$(arch) $(osys)),)
- GRT_TARGET_OBJS=i386.o linux.o times.o
- GRT_EXTRA_LIB=-lm $(GRT_ELF_OPTS)
-endif
-ifeq ($(filter-out x86_64 netbsd,$(arch) $(osys)),)
- GRT_TARGET_OBJS=amd64.o linux.o times.o
- GRT_EXTRA_LIB=-lm $(GRT_ELF_OPTS)
-endif
-ifeq ($(filter-out i%86 freebsd%,$(arch) $(osys)),)
- GRT_TARGET_OBJS=i386.o linux.o times.o
- GRT_EXTRA_LIB=-lm $(GRT_ELF_OPTS)
- ADAC=ada
-endif
-ifeq ($(filter-out x86_64 freebsd% dragonfly%,$(arch) $(osys)),)
- GRT_TARGET_OBJS=amd64.o linux.o times.o
- GRT_EXTRA_LIB=-lm $(GRT_ELF_OPTS)
- ADAC=ada
-endif
-ifeq ($(filter-out i%86 darwin%,$(arch) $(osys)),)
- GRT_TARGET_OBJS=i386.o linux.o times.o
- GRT_EXTRA_LIB=
-endif
-ifeq ($(filter-out x86_64 darwin%,$(arch) $(osys)),)
- GRT_TARGET_OBJS=amd64.o linux.o times.o
- GRT_EXTRA_LIB=
-endif
-ifeq ($(filter-out sparc solaris%,$(arch) $(osys)),)
- GRT_TARGET_OBJS=sparc.o linux.o times.o
- GRT_EXTRA_LIB=-ldl -lm
-endif
-ifeq ($(filter-out powerpc linux%,$(arch) $(osys)),)
- GRT_TARGET_OBJS=ppc.o linux.o times.o
- GRT_EXTRA_LIB=-ldl -lm $(GRT_ELF_OPTS)
-endif
-ifeq ($(filter-out ia64 linux,$(arch) $(osys)),)
- GRT_TARGET_OBJS=ia64.o linux.o times.o
- GRT_EXTRA_LIB=-ldl -lm $(GRT_ELF_OPTS)
-endif
-ifeq ($(filter-out i%86 mingw32,$(arch) $(osys)),)
- GRT_TARGET_OBJS=win32.o clock.o
-endif
-# Doesn't work for unknown reasons.
-#ifeq ($(filter-out i%86 cygwin,$(arch) $(osys)),)
-# GRT_TARGET_OBJS=win32.o clock.o
-#endif
-# Fall-back: use a generic implementation based on pthreads.
-ifndef GRT_TARGET_OBJS
- GRT_TARGET_OBJS=pthread.o times.o
- GRT_EXTRA_LIB=-lpthread -ldl -lm
+ifeq ($(filter-out mingw32,$(arch) $(osys)),)
+ GRT_TARGET_OBJS=jumps.o math.o clock.o
+else
+ GRT_TARGET_OBJS=jumps.o times.o
+ ifeq ($(filter-out linux,$(arch) $(osys)),)
+ GRT_EXTRA_LIB=-ldl -lm $(GRT_ELF_OPTS)
+ endif
+ ifeq ($(filter-out netbsd freebsd% dragonfly%,$(arch) $(osys)),)
+ GRT_EXTRA_LIB=-lm $(GRT_ELF_OPTS)
+ endif
+ ifeq ($(filter-out solaris%,$(arch) $(osys)),)
+ GRT_EXTRA_LIB=-ldl -lm
+ endif
+ ifeq ($(filter-out darwin%,$(arch) $(osys)),)
+ GRT_EXTRA_LIB=
+ endif
endif
GRT_FST_OBJS := fstapi.o lz4.o fastlz.o
@@ -148,34 +107,13 @@ run-bind.o: run-bind.adb
main.o: $(GRTSRCDIR)/main.adb
$(GRT_ADACOMPILE)
-i386.o: $(GRTSRCDIR)/config/i386.S
- $(CC) -c $(GRT_FLAGS) -o $@ $<
-
-chkstk.o: $(GRTSRCDIR)/config/chkstk.S
- $(CC) -c $(GRT_FLAGS) -o $@ $<
-
-sparc.o: $(GRTSRCDIR)/config/sparc.S
- $(CC) -c $(GRT_FLAGS) -o $@ $<
-
-ppc.o: $(GRTSRCDIR)/config/ppc.S
- $(CC) -c $(GRT_FLAGS) -o $@ $<
-
-ia64.o: $(GRTSRCDIR)/config/ia64.S
- $(CC) -c $(GRT_FLAGS) -o $@ $<
-
-amd64.o: $(GRTSRCDIR)/config/amd64.S
- $(CC) -c $(GRT_FLAGS) -o $@ $<
-
-linux.o: $(GRTSRCDIR)/config/linux.c
+jumps.o: $(GRTSRCDIR)/config/jumps.c
$(CC) -c $(GRT_FLAGS) $(GRT_CFLAGS) -o $@ $<
win32.o: $(GRTSRCDIR)/config/win32.c
$(CC) -c $(GRT_FLAGS) -o $@ $<
-win32thr.o: $(GRTSRCDIR)/config/win32thr.c
- $(CC) -c $(GRT_FLAGS) -o $@ $<
-
-pthread.o: $(GRTSRCDIR)/config/pthread.c
+math.o: $(GRTSRCDIR)/config/math.c
$(CC) -c $(GRT_FLAGS) -o $@ $<
times.o : $(GRTSRCDIR)/config/times.c
@@ -202,6 +140,9 @@ lz4.o: $(GRTSRCDIR)/fst/lz4.c
fastlz.o: $(GRTSRCDIR)/fst/fastlz.c
$(CC) -c $(GRT_FLAGS) -o $@ $<
+chkstk.o: $(GRTSRCDIR)/config/chkstk.S
+ $(CC) -c $(GRT_FLAGS) -o $@ $<
+
grt-disp-config:
@echo "target: $(target)"
@echo "targ: $(targ)"
diff --git a/src/grt/config/jumps.c b/src/grt/config/jumps.c
new file mode 100644
index 000000000..360ea8089
--- /dev/null
+++ b/src/grt/config/jumps.c
@@ -0,0 +1,171 @@
+/* Longjump/Setjump wrapper
+ Copyright (C) 2002 - 2015 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.
+*/
+
+#include <stddef.h>
+#include <signal.h>
+#include <fcntl.h>
+#include <sys/ucontext.h>
+
+/* There is a simple setjmp/longjmp mechanism used to report failures.
+ We have the choice between 3 mechanisms:
+ * USE_BUITLIN_SJLJ: gcc builtin setjmp/longjmp, very fast but gcc specific.
+ * USE__SETJMP: _setjmp/_longjmp
+ * USE_SETJMP: setjmp/longjmp, slower because signals mask is saved/restored.
+*/
+
+#if defined (__GNUC__) && !defined (__clang__)
+#define USE_BUILTIN_SJLJ
+#else
+#define USE__SETJMP
+#endif
+/* #define USE_SETJMP */
+
+#ifdef USE_BUILTIN_SJLJ
+typedef void *JMP_BUF[5];
+static int sjlj_val;
+# define SETJMP(BUF) (__builtin_setjmp (BUF), sjlj_val)
+# define LONGJMP(BUF, VAL) \
+ do { sjlj_val = (VAL); __builtin_longjmp (BUF, 1); } while (0)
+#else
+# include <setjmp.h>
+typedef jmp_buf JMP_BUF;
+# ifdef USE__SETJMP
+# define SETJMP _setjmp
+# define LONGJMP _longjmp
+# elif defined (USE_SETJMP)
+# define SETJMP setjmp
+# define LONGJMP longjmp
+# else
+# error "SETJMP/LONGJMP not configued"
+# endif
+#endif
+
+static int run_env_en;
+static JMP_BUF run_env;
+
+extern void grt_overflow_error (void);
+
+#ifdef __APPLE__
+#define NEED_SIGFPE_HANDLER
+#endif
+#if defined (__linux__) && defined (__i386__)
+#define NEED_SIGSEGV_HANDLER
+#endif
+
+#ifdef NEED_SIGFPE_HANDLER
+static struct sigaction prev_sigfpe_act;
+
+/* Handler for SIGFPE signal, raised in case of overflow (i386). */
+static void grt_overflow_handler (int signo, siginfo_t *info, void *ptr)
+{
+ grt_overflow_error ();
+}
+#endif
+
+#ifdef NEED_SIGSEGV_HANDLER
+static struct sigaction prev_sigsegv_act;
+
+/* Linux handler for overflow. This is used only by mcode. */
+static void grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
+{
+#if defined (__linux__) && defined (__i386__)
+ /* Linux generates a SIGSEGV (!) for an overflow exception. */
+ if (uctxt->uc_mcontext.gregs[REG_TRAPNO] == 4)
+ {
+ grt_overflow_error ();
+ }
+#endif
+
+ /* We loose. */
+}
+#endif /* __linux__ && __i386__ */
+
+static void grt_signal_setup (void)
+{
+#ifdef NEED_SIGSEGV_HANDLER
+ {
+ struct sigaction sigsegv_act;
+
+ sigsegv_act.sa_sigaction = &grt_sigsegv_handler;
+ sigemptyset (&sigsegv_act.sa_mask);
+ sigsegv_act.sa_flags = SA_ONSTACK | SA_SIGINFO;
+#ifdef SA_ONESHOT
+ sigsegv_act.sa_flags |= SA_ONESHOT;
+#elif defined (SA_RESETHAND)
+ sigsegv_act.sa_flags |= SA_RESETHAND;
+#endif
+
+ /* We don't care about the return status.
+ If the handler is not installed, then some feature are lost. */
+ sigaction (SIGSEGV, &sigsegv_act, &prev_sigsegv_act);
+ }
+#endif
+
+#ifdef NEED_SIGFPE_HANDLER
+ {
+ struct sigaction sig_ovf_act;
+
+ sig_ovf_act.sa_sigaction = &grt_overflow_handler;
+ sigemptyset (&sig_ovf_act.sa_mask);
+ sig_ovf_act.sa_flags = SA_SIGINFO;
+
+ sigaction (SIGFPE, &sig_ovf_act, &prev_sigfpe_act);
+ }
+#endif
+}
+
+static void grt_signal_restore (void)
+{
+#ifdef NEED_SIGSEGV_HANDLER
+ sigaction (SIGSEGV, &prev_sigsegv_act, NULL);
+#endif
+
+#ifdef NEED_SIGFPE_HANDLER
+ sigaction (SIGFPE, &prev_sigfpe_act, NULL);
+#endif
+}
+
+void
+__ghdl_maybe_return_via_longjump (int val)
+{
+ if (run_env_en)
+ LONGJMP (run_env, val);
+}
+
+int
+__ghdl_run_through_longjump (int (*func)(void))
+{
+ int res;
+
+ run_env_en = 1;
+ grt_signal_setup ();
+ res = SETJMP (run_env);
+ if (res == 0)
+ res = (*func)();
+ grt_signal_restore ();
+ run_env_en = 0;
+ return res;
+}
diff --git a/src/grt/config/math.c b/src/grt/config/math.c
new file mode 100644
index 000000000..704225f67
--- /dev/null
+++ b/src/grt/config/math.c
@@ -0,0 +1,55 @@
+/* Math routines for Win32
+ Copyright (C) 2005 - 2015 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.
+*/
+
+#include <math.h>
+
+double acosh (double x)
+{
+ return log (x + sqrt (x*x - 1));
+}
+
+double asinh (double x)
+{
+ return log (x + sqrt (x*x + 1));
+}
+
+double atanh (double x)
+{
+ return log ((1 + x) / (1 - x)) / 2;
+}
+
+#ifndef WITH_GNAT_RUN_TIME
+void __gnat_raise_storage_error(void)
+{
+ abort ();
+}
+
+void __gnat_raise_program_error(void)
+{
+ abort ();
+}
+#endif
+
diff --git a/src/grt/grt-errors.adb b/src/grt/grt-errors.adb
index ed936688b..29da11206 100644
--- a/src/grt/grt-errors.adb
+++ b/src/grt/grt-errors.adb
@@ -238,6 +238,14 @@ package body Grt.Errors is
Newline_Err;
end Info;
+ procedure Warning (Str : String) is
+ begin
+ Put_Err (Progname);
+ Put_Err (":warning: ");
+ Put_Err (Str);
+ Newline_Err;
+ end Warning;
+
procedure Internal_Error (Msg : String) is
begin
Put_Err (Progname);
diff --git a/src/grt/grt-errors.ads b/src/grt/grt-errors.ads
index 33c993226..8dcf55b4d 100644
--- a/src/grt/grt-errors.ads
+++ b/src/grt/grt-errors.ads
@@ -51,6 +51,9 @@ package Grt.Errors is
-- Complete error message.
procedure Error (Str : String);
+ -- Warning message.
+ procedure Warning (Str : String);
+
-- Internal error. The message must contain the subprogram name which
-- has called this procedure.
procedure Internal_Error (Msg : String);
diff --git a/src/grt/grt-main.adb b/src/grt/grt-main.adb
index 4d4106bee..5d825deb4 100644
--- a/src/grt/grt-main.adb
+++ b/src/grt/grt-main.adb
@@ -26,7 +26,6 @@ with System.Storage_Elements; -- Work around GNAT bug.
pragma Unreferenced (System.Storage_Elements);
with Grt.Types; use Grt.Types;
with Grt.Errors;
-with Grt.Stacks;
with Grt.Processes;
with Grt.Signals;
with Grt.Options; use Grt.Options;
@@ -133,8 +132,6 @@ package body Grt.Main is
end if;
-- Internal initializations.
- Grt.Stacks.Stack_Init;
-
Grt.Hooks.Call_Init_Hooks;
Grt.Processes.Init;
@@ -146,8 +143,7 @@ package body Grt.Main is
end if;
-- Elaboration. Run through longjump to catch errors.
- if Grt.Processes.Run_Through_Longjump (Ghdl_Elaborate_Wrapper'Access) < 0
- then
+ if Run_Through_Longjump (Ghdl_Elaborate_Wrapper'Access) < 0 then
Grt.Errors.Error ("error during elaboration");
return;
end if;
@@ -175,7 +171,7 @@ package body Grt.Main is
end if;
-- Do the simulation.
- Status := Grt.Processes.Simulation;
+ Status := Run_Through_Longjump (Grt.Processes.Simulation'Access);
end if;
if Flag_Stats then
diff --git a/src/grt/grt-main.ads b/src/grt/grt-main.ads
index 6dd774197..9fbf7b167 100644
--- a/src/grt/grt-main.ads
+++ b/src/grt/grt-main.ads
@@ -31,4 +31,11 @@ package Grt.Main is
-- been assigned to generics, but before being used.
procedure Ghdl_Init_Top_Generics;
pragma Export (C, Ghdl_Init_Top_Generics, "__ghdl_init_top_generics");
+
+ type Run_Handler is access function return Integer;
+
+ -- Run HAND through a wrapper that catch some errors (in particular on
+ -- windows). Returns < 0 in case of error.
+ function Run_Through_Longjump (Hand : Run_Handler) return Integer;
+ pragma Import (Ada, Run_Through_Longjump, "__ghdl_run_through_longjump");
end Grt.Main;
diff --git a/src/grt/grt-options.adb b/src/grt/grt-options.adb
index f3b9e8cdb..446439f5f 100644
--- a/src/grt/grt-options.adb
+++ b/src/grt/grt-options.adb
@@ -160,8 +160,6 @@ package body Grt.Options is
P (" X is expressed as a time value, without spaces: 1ns, ps...");
P (" --stop-delta=X stop the simulation cycle after X delta");
P (" --expect-failure invert exit status");
- P (" --stack-size=X set the stack size of non-sensitized processes");
- P (" --stack-max-size=X set the maximum stack size");
P (" --no-run do not simulate, only elaborate");
-- P (" --threads=N use N threads for simulation");
Grt.Hooks.Call_Help_Hooks;
@@ -210,39 +208,6 @@ package body Grt.Options is
end loop;
end Extract_Integer;
- function Extract_Size (Str : String; Option_Name : String) return Natural
- is
- Ok : Boolean;
- Val : Integer_64;
- Pos : Natural;
- begin
- Extract_Integer (Str, Ok, Val, Pos);
- if not Ok then
- Val := 1;
- end if;
- if Pos > Str'Last then
- -- No suffix.
- if Val > Integer_64(Natural'Last) then
- Error_C ("Size exceeds limit for option ");
- Error_E (Option_Name);
- else
- return Natural (Val);
- end if;
- end if;
- if Pos = Str'Last
- or else (Pos + 1 = Str'Last
- and then (Str (Pos + 1) = 'b' or Str (Pos + 1) = 'o'))
- then
- if Str (Pos) = 'k' or Str (Pos) = 'K' then
- return Natural (Val) * 1024;
- elsif Str (Pos) = 'm' or Str (Pos) = 'M' then
- return Natural (Val) * 1024 * 1024;
- end if;
- end if;
- Error_C ("bad memory unit for option ");
- Error_E (Option_Name);
- end Extract_Size;
-
function To_Lower (C : Character) return Character is
begin
if C in 'A' .. 'Z' then
@@ -434,17 +399,9 @@ package body Grt.Options is
elsif Option = "--expect-failure" then
Expect_Failure := True;
elsif Len >= 13 and then Option (1 .. 13) = "--stack-size=" then
- Stack_Size := Extract_Size
- (Option (14 .. Len), "--stack-size");
- if Stack_Size > Stack_Max_Size then
- Stack_Max_Size := Stack_Size;
- end if;
+ Warning ("option --stack-size is deprecated");
elsif Len >= 17 and then Option (1 .. 17) = "--stack-max-size=" then
- Stack_Max_Size := Extract_Size
- (Option (18 .. Len), "--stack-size");
- if Stack_Size > Stack_Max_Size then
- Stack_Size := Stack_Max_Size;
- end if;
+ Warning ("option --stack-max-size is deprecated");
elsif Len >= 11 and then Option (1 .. 11) = "--activity=" then
if Option (12 .. Len) = "none" then
Flag_Activity := Activity_None;
diff --git a/src/grt/grt-options.ads b/src/grt/grt-options.ads
index eaf3d022d..34180f15d 100644
--- a/src/grt/grt-options.ads
+++ b/src/grt/grt-options.ads
@@ -125,12 +125,6 @@ package Grt.Options is
-- Set by --stop-delta=XXX to stop the simulation after XXX delta cycles.
Stop_Delta : Natural := 5000;
- -- The default stack size for non-sensitized processes.
- Stack_Size : Natural := 8 * 1024;
-
- -- The maximum stack size for non-sensitized processes.
- Stack_Max_Size : Natural := 128 * 1024;
-
-- Set by --no-run
-- If set, do not simulate, only elaborate.
Flag_No_Run : Boolean := False;
@@ -166,7 +160,5 @@ package Grt.Options is
First_Generic_Override : Generic_Override_Acc;
Last_Generic_Override : Generic_Override_Acc;
private
- pragma Export (C, Stack_Size);
- pragma Export (C, Stack_Max_Size);
pragma Export (C, Nbr_Threads, "grt_nbr_threads");
end Grt.Options;
diff --git a/src/grt/grt-processes.adb b/src/grt/grt-processes.adb
index 01e8394bc..748ab6dd9 100644
--- a/src/grt/grt-processes.adb
+++ b/src/grt/grt-processes.adb
@@ -23,7 +23,6 @@
-- however invalidate any other reasons why the executable file might be
-- covered by the GNU Public License.
with Grt.Table;
-with Ada.Unchecked_Conversion;
with Ada.Unchecked_Deallocation;
with System.Storage_Elements; -- Work around GNAT bug.
pragma Unreferenced (System.Storage_Elements);
@@ -87,9 +86,23 @@ package body Grt.Processes is
Process_First_Timeout : Std_Time := Last_Time;
Process_Timeout_Chain : Process_Acc := null;
+ Elab_Process : Process_Acc;
+
procedure Init is
begin
- null;
+ -- Create a dummy process so that elaboration has a context.
+ Elab_Process := new Process_Type'(Subprg => null,
+ This => null,
+ Rti => Null_Context,
+ Sensitivity => null,
+ Stack2 => Null_Stack2_Ptr,
+ Resumed => False,
+ Postponed => False,
+ State => State_Sensitized,
+ Timeout => Bad_Time,
+ Timeout_Chain_Next => null,
+ Timeout_Chain_Prev => null);
+ Set_Current_Process (Elab_Process);
end Init;
function Get_Nbr_Processes return Natural is
@@ -120,28 +133,19 @@ package body Grt.Processes is
State : Process_State;
Postponed : Boolean)
is
- Stack : Stack_Type;
P : Process_Acc;
begin
- if State /= State_Sensitized and then not One_Stack then
- Stack := Stack_Create (Proc, This);
- if Stack = Null_Stack then
- Internal_Error ("cannot allocate stack: memory exhausted");
- end if;
- else
- Stack := Null_Stack;
- end if;
P := new Process_Type'(Subprg => Proc,
This => This,
Rti => Ctxt,
Sensitivity => null,
+ Stack2 => Null_Stack2_Ptr,
Resumed => False,
Postponed => Postponed,
State => State,
Timeout => Bad_Time,
Timeout_Chain_Next => null,
- Timeout_Chain_Prev => null,
- Stack => Stack);
+ Timeout_Chain_Prev => null);
Process_Table.Append (P);
-- Used to create drivers.
Set_Current_Process (P);
@@ -203,12 +207,12 @@ package body Grt.Processes is
Resumed => False,
Postponed => False,
State => State_Sensitized,
+ Stack2 => Null_Stack2_Ptr,
Timeout => Bad_Time,
Timeout_Chain_Next => null,
Timeout_Chain_Prev => null,
Subprg => Proc,
- This => This,
- Stack => Null_Stack);
+ This => This);
Process_Table.Append (P);
-- Used to create drivers.
Set_Current_Process (P);
@@ -268,26 +272,42 @@ package body Grt.Processes is
end Resume_Process;
function Ghdl_Stack2_Allocate (Size : Ghdl_Index_Type)
- return System.Address
+ return System.Address
is
+ Proc : constant Process_Acc := Get_Current_Process;
begin
- return Grt.Stack2.Allocate (Get_Stack2, Size);
+ return Grt.Stack2.Allocate (Proc.Stack2, Size);
end Ghdl_Stack2_Allocate;
function Ghdl_Stack2_Mark return Mark_Id
is
- St2 : Stack2_Ptr := Get_Stack2;
+ Proc : constant Process_Acc := Get_Current_Process;
+ St2 : Stack2_Ptr;
begin
+ St2 := Proc.Stack2;
+
+ -- Check that stack2 has been created. This check is done only here,
+ -- because Mark is called before Release (obviously) but also before
+ -- Allocate.
if St2 = Null_Stack2_Ptr then
- St2 := Grt.Stack2.Create;
- Set_Stack2 (St2);
+ if Proc.State = State_Sensitized then
+ -- Sensitized processes share the stack2, as the stack2 is empty
+ -- when sensitized processes suspend.
+ St2 := Get_Common_Stack2;
+ else
+ St2 := Grt.Stack2.Create;
+ end if;
+ Proc.Stack2 := St2;
end if;
+
return Grt.Stack2.Mark (St2);
end Ghdl_Stack2_Mark;
- procedure Ghdl_Stack2_Release (Mark : Mark_Id) is
+ procedure Ghdl_Stack2_Release (Mark : Mark_Id)
+ is
+ Proc : constant Process_Acc := Get_Current_Process;
begin
- Grt.Stack2.Release (Get_Stack2, Mark);
+ Grt.Stack2.Release (Proc.Stack2, Mark);
end Ghdl_Stack2_Release;
procedure Free is new Ada.Unchecked_Deallocation
@@ -374,16 +394,16 @@ package body Grt.Processes is
Update_Process_First_Timeout (Proc);
end Ghdl_Process_Wait_Set_Timeout;
- function Ghdl_Process_Wait_Has_Timeout return Boolean
+ function Ghdl_Process_Wait_Timed_Out return Boolean
is
Proc : constant Process_Acc := Get_Current_Process;
begin
-- Note: in case of timeout, the timeout is removed when process is
-- woken up.
return Proc.State = State_Timeout;
- end Ghdl_Process_Wait_Has_Timeout;
+ end Ghdl_Process_Wait_Timed_Out;
- procedure Ghdl_Process_Wait_Wait
+ procedure Ghdl_Process_Wait_Suspend
is
Proc : constant Process_Acc := Get_Current_Process;
begin
@@ -392,22 +412,6 @@ package body Grt.Processes is
end if;
-- Suspend this process.
Proc.State := State_Wait;
--- if Cur_Proc.Timeout = Bad_Time then
--- Cur_Proc.Timeout := Std_Time'Last;
--- end if;
- end Ghdl_Process_Wait_Wait;
-
- function Ghdl_Process_Wait_Suspend return Boolean
- is
- Proc : constant Process_Acc := Get_Current_Process;
- begin
- Ghdl_Process_Wait_Wait;
- if One_Stack then
- Internal_Error ("wait_suspend");
- else
- Stack_Switch (Get_Main_Stack, Proc.Stack);
- end if;
- return Ghdl_Process_Wait_Has_Timeout;
end Ghdl_Process_Wait_Suspend;
procedure Ghdl_Process_Wait_Close
@@ -497,14 +501,10 @@ package body Grt.Processes is
if Proc.State = State_Sensitized then
Error ("wait statement in a sensitized process");
end if;
+
-- Mark this process as dead, in order to kill it.
-- It cannot be killed now, since this code is still in the process.
Proc.State := State_Dead;
-
- -- Suspend this process.
- if not One_Stack then
- Stack_Switch (Get_Main_Stack, Proc.Stack);
- end if;
end Ghdl_Process_Wait_Exit;
procedure Ghdl_Process_Wait_Timeout (Time : Std_Time)
@@ -519,18 +519,8 @@ package body Grt.Processes is
Error ("negative timeout clause");
end if;
Proc.Timeout := Current_Time + Time;
- Proc.State := State_Wait;
+ Proc.State := State_Delayed;
Update_Process_First_Timeout (Proc);
- -- Suspend this process.
- if One_Stack then
- Internal_Error ("wait_timeout");
- else
- Stack_Switch (Get_Main_Stack, Proc.Stack);
- end if;
- -- Clean-up.
- Proc.Timeout := Bad_Time;
- Remove_Process_From_Timeout_Chain (Proc);
- Proc.State := State_Ready;
end Ghdl_Process_Wait_Timeout;
-- Verilog.
@@ -705,8 +695,6 @@ package body Grt.Processes is
Run_Resumed : constant Integer := 2;
-- Simulation is finished.
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);
@@ -741,19 +729,14 @@ package body Grt.Processes is
end if;
Proc.Resumed := False;
Set_Current_Process (Proc);
- if Proc.State = State_Sensitized or else One_Stack then
- Proc.Subprg.all (Proc.This);
- else
- Stack_Switch (Proc.Stack, Get_Main_Stack);
- end if;
+ Proc.Subprg.all (Proc.This);
if Grt.Options.Checks then
Ghdl_Signal_Internal_Checks;
- Grt.Stack2.Check_Empty (Get_Stack2);
end if;
end loop;
end Run_Processes_Threads;
- function Run_Processes (Postponed : Boolean) return Integer
+ function Run_Processes (Postponed : Boolean) return Natural
is
Table : Process_Acc_Array_Acc;
Last : Natural;
@@ -792,14 +775,9 @@ package body Grt.Processes is
Proc.Resumed := False;
Set_Current_Process (Proc);
- if Proc.State = State_Sensitized or else One_Stack then
- Proc.Subprg.all (Proc.This);
- else
- Stack_Switch (Proc.Stack, Get_Main_Stack);
- end if;
+ Proc.Subprg.all (Proc.This);
if Grt.Options.Checks then
Ghdl_Signal_Internal_Checks;
- Grt.Stack2.Check_Empty (Get_Stack2);
end if;
end;
end loop;
@@ -817,9 +795,10 @@ package body Grt.Processes is
end if;
end Run_Processes;
- function Initialization_Phase return Integer
+ procedure Initialization_Phase
is
- Status : Integer;
+ Status : Natural;
+ pragma Unreferenced (Status);
begin
-- Allocate processes arrays.
Resume_Process_Table :=
@@ -857,15 +836,9 @@ package body Grt.Processes is
-- - Each nonpostponed process in the model is executed until it
-- suspends.
Status := Run_Processes (Postponed => False);
- if Status = Run_Failure then
- return Run_Failure;
- end if;
-- - Each postponed process in the model is executed until it suspends.
Status := Run_Processes (Postponed => True);
- if Status = Run_Failure then
- return Run_Failure;
- end if;
-- - The time of the next simulation cycle (which in this case is the
-- first simulation cycle), Tn, is calculated according to the rules
@@ -874,8 +847,6 @@ package body Grt.Processes is
-- Clear current_delta, will be set by Simulation_Cycle.
Current_Delta := 0;
-
- return Run_Resumed;
end Initialization_Phase;
-- Launch a simulation cycle.
@@ -913,17 +884,20 @@ package body Grt.Processes is
Tn := Last_Time;
declare
Proc : Process_Acc;
+ Next_Proc : Process_Acc;
begin
Proc := Process_Timeout_Chain;
while Proc /= null loop
+ Next_Proc := Proc.Timeout_Chain_Next;
case Proc.State is
when State_Sensitized =>
null;
when State_Delayed =>
if Proc.Timeout = Current_Time then
Proc.Timeout := Bad_Time;
+ Remove_Process_From_Timeout_Chain (Proc);
Resume_Process (Proc);
- Proc.State := State_Sensitized;
+ Proc.State := State_Ready;
elsif Proc.Timeout > 0 and then Proc.Timeout < Tn then
Tn := Proc.Timeout;
end if;
@@ -941,7 +915,7 @@ package body Grt.Processes is
when State_Dead =>
null;
end case;
- Proc := Proc.Timeout_Chain_Next;
+ Proc := Next_Proc;
end loop;
end;
Process_First_Timeout := Tn;
@@ -950,9 +924,6 @@ package body Grt.Processes is
-- e) Each nonpostponed that has resumed in the current simulation cycle
-- is executed until it suspends.
Status := Run_Processes (Postponed => False);
- if Status = Run_Failure then
- return Run_Failure;
- end if;
-- f) The time of the next simulation cycle, Tn, is determined by
-- setting it to the earliest of
@@ -995,8 +966,6 @@ package body Grt.Processes is
if Tn = Current_Time then
Error ("postponed process causes a delta cycle");
end if;
- elsif Status = Run_Failure then
- return Run_Failure;
end if;
Current_Time := Tn;
return Run_Resumed;
@@ -1016,10 +985,7 @@ package body Grt.Processes is
-- Grt.Disp.Disp_Signals_Type;
-- end if;
- Status := Run_Through_Longjump (Initialization_Phase'Access);
- if Status /= Run_Resumed then
- return Status;
- end if;
+ Initialization_Phase;
Nbr_Delta_Cycles := 0;
Nbr_Cycles := 0;
@@ -1039,7 +1005,7 @@ package body Grt.Processes is
if Disp_Time then
Grt.Disp.Disp_Now;
end if;
- Status := Run_Through_Longjump (Simulation_Cycle'Access);
+ Status := Simulation_Cycle;
exit when Status < 0;
if Trace_Signals then
Grt.Disp_Signals.Disp_All_Signals;
diff --git a/src/grt/grt-processes.ads b/src/grt/grt-processes.ads
index 2d953ecf1..ecef800d4 100644
--- a/src/grt/grt-processes.ads
+++ b/src/grt/grt-processes.ads
@@ -23,10 +23,10 @@
-- however invalidate any other reasons why the executable file might be
-- covered by the GNU Public License.
with System;
+with Ada.Unchecked_Conversion;
with Grt.Stack2; use Grt.Stack2;
with Grt.Types; use Grt.Types;
with Grt.Signals; use Grt.Signals;
-with Grt.Stacks; use Grt.Stacks;
with Grt.Rtis; use Grt.Rtis;
with Grt.Rtis_Addr;
with Grt.Stdio;
@@ -51,10 +51,6 @@ package Grt.Processes is
-- If true, the simulation should be stopped.
Break_Simulation : Boolean;
- -- If true, there is one stack for all processes. Non-sensitized
- -- processes must save their state.
- One_Stack : Boolean := False;
-
type Process_Type is private;
-- type Process_Acc is access all Process_Type;
@@ -74,6 +70,21 @@ package Grt.Processes is
-- Disp the name of process PROC.
procedure Disp_Process_Name (Stream : Grt.Stdio.FILEs; Proc : Process_Acc);
+ -- Instance is the parameter of the process procedure.
+ -- This is in fact a fully opaque type whose content is private to the
+ -- process.
+ type Instance is limited private;
+ type Instance_Acc is access all Instance;
+ pragma Convention (C, Instance_Acc);
+
+ -- A process is identified by a procedure having a single private
+ -- parameter (its instance).
+ type Proc_Acc is access procedure (Self : Instance_Acc);
+ pragma Convention (C, Proc_Acc);
+
+ function To_Address is new Ada.Unchecked_Conversion
+ (Instance_Acc, System.Address);
+
-- Register a process during elaboration.
-- This procedure is called by vhdl elaboration code.
procedure Ghdl_Process_Register (Instance : Instance_Acc;
@@ -131,16 +142,12 @@ package Grt.Processes is
-- Add a sensitivity for a wait.
procedure Ghdl_Process_Wait_Add_Sensitivity (Sig : Ghdl_Signal_Ptr);
-- Wait until timeout or sensitivity.
- -- Return TRUE in case of timeout.
- function Ghdl_Process_Wait_Suspend return Boolean;
+ procedure Ghdl_Process_Wait_Suspend;
+ -- Return TRUE if woken up by a timeout.
+ function Ghdl_Process_Wait_Timed_Out return Boolean;
-- Finish a wait statement.
procedure Ghdl_Process_Wait_Close;
- -- For one stack setups, wait_suspend is decomposed into the suspension
- -- procedure and the function to get resume status.
- procedure Ghdl_Process_Wait_Wait;
- function Ghdl_Process_Wait_Has_Timeout return Boolean;
-
-- Verilog.
procedure Ghdl_Process_Delay (Del : Ghdl_U32);
@@ -156,14 +163,9 @@ package Grt.Processes is
procedure Ghdl_Protected_Init (Obj : System.Address);
procedure Ghdl_Protected_Fini (Obj : System.Address);
- type Run_Handler is access function return Integer;
-
- -- Run HAND through a wrapper that catch some errors (in particular on
- -- windows). Returns < 0 in case of error.
- function Run_Through_Longjump (Hand : Run_Handler) return Integer;
- pragma Import (Ada, Run_Through_Longjump, "__ghdl_run_through_longjump");
-
private
+ type Instance is null record;
+
-- State of a process.
type Process_State is
(
@@ -173,10 +175,11 @@ private
-- Non-sensitized process, ready to run.
State_Ready,
- -- Verilog process, being suspended.
+ -- Non-sensitized process being suspended on a timeout (without
+ -- sensitivity).
State_Delayed,
- -- Non-sensitized process being suspended.
+ -- Non-sensitized process being suspended, with sensitivity.
State_Wait,
-- Non-sensitized process being awaked by a wait timeout. This state
@@ -189,35 +192,33 @@ private
State_Dead);
type Process_Type is record
- -- Stack for the process.
- -- This must be the first field of the record (and this is the only
- -- part visible).
- -- Must be NULL_STACK for sensitized processes.
- Stack : Stacks.Stack_Type;
-
-- Subprogram containing process code.
Subprg : Proc_Acc;
-- Instance (THIS parameter) for the subprogram.
This : Instance_Acc;
- -- Name of the process.
- Rti : Rtis_Addr.Rti_Context;
-
-- True if the process is resumed and will be run at next cycle.
Resumed : Boolean;
-- True if the process is postponed.
Postponed : Boolean;
+ -- State of the process.
State : Process_State;
- -- Timeout value for wait.
- Timeout : Std_Time;
+ -- Secondary stack for this process.
+ Stack2 : Stack2_Ptr;
-- Sensitivity list while the (non-sensitized) process is waiting.
Sensitivity : Action_List_Acc;
+ -- Name of the process.
+ Rti : Rtis_Addr.Rti_Context;
+
+ -- Timeout value for wait.
+ Timeout : Std_Time;
+
Timeout_Chain_Next : Process_Acc;
Timeout_Chain_Prev : Process_Acc;
end record;
@@ -249,6 +250,8 @@ private
"__ghdl_process_wait_set_timeout");
pragma Export (Ada, Ghdl_Process_Wait_Suspend,
"__ghdl_process_wait_suspend");
+ pragma Export (Ada, Ghdl_Process_Wait_Timed_Out,
+ "__ghdl_process_wait_timed_out");
pragma Export (C, Ghdl_Process_Wait_Close,
"__ghdl_process_wait_close");
diff --git a/src/grt/grt-stack2.adb b/src/grt/grt-stack2.adb
index 82341d072..cb56225b7 100644
--- a/src/grt/grt-stack2.adb
+++ b/src/grt/grt-stack2.adb
@@ -149,16 +149,6 @@ package body Grt.Stack2 is
return To_Addr (Res);
end Create;
- procedure Check_Empty (S : Stack2_Ptr)
- is
- S2 : Stack2_Acc;
- begin
- S2 := To_Acc (S);
- if S2 /= null and then S2.Top /= S2.First_Chunk.First then
- Internal_Error ("stack2.check_empty: stack is not empty");
- end if;
- end Check_Empty;
-
-- May be used to debug.
procedure Dump_Stack2 (S : Stack2_Ptr);
pragma Unreferenced (Dump_Stack2);
diff --git a/src/grt/grt-stack2.ads b/src/grt/grt-stack2.ads
index b3de6b76d..1c0c79afe 100644
--- a/src/grt/grt-stack2.ads
+++ b/src/grt/grt-stack2.ads
@@ -26,18 +26,41 @@ with System;
with Grt.Types; use Grt.Types;
-- Secondary stack management.
+-- The secondary stack is used by vhdl to return object from function whose
+-- type is unconstrained. This is less efficient than returning the object
+-- on the stack, but compatible with any ABI.
+--
+-- The management is very simple: mark and release. Allocate reserved a
+-- chunk of memory from the secondary stack, Release deallocate all the
+-- memory allocated since the mark.
+
package Grt.Stack2 is
- type Stack2_Ptr is new System.Address;
- Null_Stack2_Ptr : constant Stack2_Ptr := Stack2_Ptr (System.Null_Address);
+ -- Designate a secondary stack.
+ type Stack2_Ptr is private;
- type Mark_Id is new Integer_Address;
+ -- Indicator for a non-existing secondary stack. Create never return that
+ -- value.
+ Null_Stack2_Ptr : constant Stack2_Ptr;
+
+ -- Type of a mark.
+ type Mark_Id is private;
+ -- Get the current mark, which indicate a current amount of allocated
+ -- memory.
function Mark (S : Stack2_Ptr) return Mark_Id;
+
+ -- Deallocate (free) all the memory allocated since MARK.
procedure Release (S : Stack2_Ptr; Mark : Mark_Id);
+
+ -- Allocate SIZE bytes (aligned on the maximum alignment) on stack S.
function Allocate (S : Stack2_Ptr; Size : Ghdl_Index_Type)
- return System.Address;
+ return System.Address;
+
+ -- Create a secondary stack.
function Create return Stack2_Ptr;
+private
+ type Stack2_Ptr is new System.Address;
+ Null_Stack2_Ptr : constant Stack2_Ptr := Stack2_Ptr (System.Null_Address);
- -- Check S is empty.
- procedure Check_Empty (S : Stack2_Ptr);
+ type Mark_Id is new Integer_Address;
end Grt.Stack2;
diff --git a/src/grt/grt-stacks.adb b/src/grt/grt-stacks.adb
deleted file mode 100644
index adb008d02..000000000
--- a/src/grt/grt-stacks.adb
+++ /dev/null
@@ -1,43 +0,0 @@
--- GHDL Run Time (GRT) - process stacks.
--- 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 Grt.Errors; use Grt.Errors;
-
-package body Grt.Stacks is
- procedure Error_Grow_Failed is
- begin
- Error ("cannot grow the stack");
- end Error_Grow_Failed;
-
- procedure Error_Memory_Access is
- begin
- Error
- ("invalid memory access (dangling accesses or stack size too small)");
- end Error_Memory_Access;
-
- procedure Error_Null_Access is
- begin
- Error ("NULL access dereferenced");
- end Error_Null_Access;
-end Grt.Stacks;
diff --git a/src/grt/grt-stacks.ads b/src/grt/grt-stacks.ads
deleted file mode 100644
index dd9434080..000000000
--- a/src/grt/grt-stacks.ads
+++ /dev/null
@@ -1,87 +0,0 @@
--- GHDL Run Time (GRT) - process stacks.
--- 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; use System;
-with Ada.Unchecked_Conversion;
-
-package Grt.Stacks is
- -- Instance is the parameter of the process procedure.
- -- This is in fact a fully opaque type whose content is private to the
- -- process.
- type Instance is limited private;
- type Instance_Acc is access all Instance;
- pragma Convention (C, Instance_Acc);
-
- -- A process is identified by a procedure having a single private
- -- parameter (its instance).
- type Proc_Acc is access procedure (Self : Instance_Acc);
- pragma Convention (C, Proc_Acc);
-
- function To_Address is new Ada.Unchecked_Conversion
- (Instance_Acc, System.Address);
-
- type Stack_Type is new Address;
- Null_Stack : constant Stack_Type := Stack_Type (Null_Address);
-
- -- Initialize the stacks package.
- -- This may adjust stack sizes.
- -- Must be called after grt.options.decode.
- procedure Stack_Init;
-
- -- Create a new stack, which on first execution will call FUNC with
- -- an argument ARG.
- function Stack_Create (Func : Proc_Acc; Arg : Instance_Acc)
- return Stack_Type;
-
- -- Resume stack TO and save the current context to the stack pointed by
- -- CUR.
- procedure Stack_Switch (To : Stack_Type; From : Stack_Type);
-
- -- Delete stack STACK, which must not be currently executed.
- procedure Stack_Delete (Stack : Stack_Type);
-
- -- Error during stack handling:
- -- Cannot grow the stack.
- procedure Error_Grow_Failed;
- pragma No_Return (Error_Grow_Failed);
-
- -- Invalid memory access detected (other than dereferencing a NULL access).
- procedure Error_Memory_Access;
- pragma No_Return (Error_Memory_Access);
-
- -- A NULL access is dereferenced.
- procedure Error_Null_Access;
- pragma No_Return (Error_Null_Access);
-private
- type Instance is null record;
-
- pragma Import (C, Stack_Init, "grt_stack_init");
- pragma Import (C, Stack_Create, "grt_stack_create");
- pragma Import (C, Stack_Switch, "grt_stack_switch");
- pragma Import (C, Stack_Delete, "grt_stack_delete");
-
- pragma Export (C, Error_Grow_Failed, "grt_stack_error_grow_failed");
- pragma Export (C, Error_Memory_Access, "grt_stack_error_memory_access");
- pragma Export (C, Error_Null_Access, "grt_stack_error_null_access");
-end Grt.Stacks;
diff --git a/src/grt/grt-unithread.adb b/src/grt/grt-unithread.adb
index 6acb52169..7e135339b 100644
--- a/src/grt/grt-unithread.adb
+++ b/src/grt/grt-unithread.adb
@@ -80,27 +80,10 @@ package body Grt.Unithread is
return Current_Process;
end Get_Current_Process;
- Stack2 : Stack2_Ptr;
+ Common_Stack2 : constant Stack2_Ptr := Create;
- function Get_Stack2 return Stack2_Ptr is
+ function Get_Common_Stack2 return Stack2_Ptr is
begin
- return Stack2;
- end Get_Stack2;
-
- procedure Set_Stack2 (St : Stack2_Ptr) is
- begin
- Stack2 := St;
- end Set_Stack2;
-
- Main_Stack : Stack_Type;
-
- function Get_Main_Stack return Stack_Type is
- begin
- return Main_Stack;
- end Get_Main_Stack;
-
- procedure Set_Main_Stack (St : Stack_Type) is
- begin
- Main_Stack := St;
- end Set_Main_Stack;
+ return Common_Stack2;
+ end Get_Common_Stack2;
end Grt.Unithread;
diff --git a/src/grt/grt-unithread.ads b/src/grt/grt-unithread.ads
index b35b7be33..6bfacab21 100644
--- a/src/grt/grt-unithread.ads
+++ b/src/grt/grt-unithread.ads
@@ -26,7 +26,6 @@ with System.Storage_Elements; -- Work around GNAT bug.
pragma Unreferenced (System.Storage_Elements);
with Grt.Signals; use Grt.Signals;
with Grt.Stack2; use Grt.Stack2;
-with Grt.Stacks; use Grt.Stacks;
package Grt.Unithread is
procedure Init;
@@ -46,28 +45,17 @@ package Grt.Unithread is
procedure Set_Current_Process (Proc : Process_Acc);
function Get_Current_Process return Process_Acc;
- -- The secondary stack for the thread. In this implementation, there is
- -- only one secondary stack, shared by all processes. This is allowed,
- -- because a wait statement cannot appear within a function. So at a wait
- -- statement, the secondary stack must be empty.
- function Get_Stack2 return Stack2_Ptr;
- procedure Set_Stack2 (St : Stack2_Ptr);
-
- -- The main stack. This is initialized by STACK_INIT.
- -- The return point.
- function Get_Main_Stack return Stack_Type;
- procedure Set_Main_Stack (St : Stack_Type);
+ -- The stack2 for all sensitized process. Since they cannot have
+ -- wait statements, the stack2 is always empty when the process is
+ -- suspended.
+ function Get_Common_Stack2 return Stack2_Ptr;
private
pragma Inline (Run_Parallel);
pragma Inline (Atomic_Insert);
pragma Inline (Atomic_Inc);
- pragma Inline (Get_Stack2);
- pragma Inline (Set_Stack2);
-
- pragma Inline (Get_Main_Stack);
- pragma Export (C, Set_Main_Stack, "grt_set_main_stack");
pragma Inline (Set_Current_Process);
pragma Inline (Get_Current_Process);
+ pragma Inline (Get_Common_Stack2);
end Grt.Unithread;
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-14 00:24:15 +0000