aboutsummaryrefslogtreecommitdiffstats
path: root/translate/grt
diff options
context:
space:
mode:
authorgingold <gingold@b72b5c32-5f01-0410-b925-b5c7b92870f7>2005-11-07 23:18:35 +0000
committergingold <gingold@b72b5c32-5f01-0410-b925-b5c7b92870f7>2005-11-07 23:18:35 +0000
commit004bd818080a8090ea61bfb9cd656b01fe4541e0 (patch)
treea09472ff8de767ccd7f84d64ffc3c3fc4179bb75 /translate/grt
parentd5888aa28f654fa58ec9f3914932885e36af3d5c (diff)
downloadghdl-004bd818080a8090ea61bfb9cd656b01fe4541e0.tar.gz
ghdl-004bd818080a8090ea61bfb9cd656b01fe4541e0.tar.bz2
ghdl-004bd818080a8090ea61bfb9cd656b01fe4541e0.zip
handle universal real div integer evaluation,
more optimizations added, multi-thread ready grt, bug fixes
Diffstat (limited to 'translate/grt')
-rw-r--r--translate/grt/Makefile3
-rw-r--r--translate/grt/Makefile.inc8
-rw-r--r--translate/grt/config/ia64.S245
-rw-r--r--translate/grt/config/linux.c14
-rw-r--r--translate/grt/grt-main.adb4
-rw-r--r--translate/grt/grt-options.adb16
-rw-r--r--translate/grt/grt-options.ads7
-rw-r--r--translate/grt/grt-processes.adb276
-rw-r--r--translate/grt/grt-processes.ads67
-rw-r--r--translate/grt/grt-signals.adb11
-rw-r--r--translate/grt/grt-stacks.ads6
-rw-r--r--translate/grt/grt-stats.adb158
-rw-r--r--translate/grt/grt-stats.ads8
-rw-r--r--translate/grt/grt-threads.ads20
-rw-r--r--translate/grt/grt-unithread.adb107
-rw-r--r--translate/grt/grt-unithread.ads66
16 files changed, 671 insertions, 345 deletions
diff --git a/translate/grt/Makefile b/translate/grt/Makefile
index 5e0a7cdb9..ff68bc7b0 100644
--- a/translate/grt/Makefile
+++ b/translate/grt/Makefile
@@ -15,7 +15,8 @@
# 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.
-GRT_FLAGS=-g
+GRT_FLAGS=-g -O
+GRT_ADAFLAGS=-gnatn
ADAC=gnatgcc
GNATFLAGS=$(CFLAGS) -gnatf -gnaty3befhkmr -gnatwlu
diff --git a/translate/grt/Makefile.inc b/translate/grt/Makefile.inc
index 4e4388ace..02fa8d943 100644
--- a/translate/grt/Makefile.inc
+++ b/translate/grt/Makefile.inc
@@ -26,7 +26,8 @@
# grt_libdir: the place to put grt.
# GRTSRCDIR: the source directory of grt.
# target: GCC target
-# GRT_FLAGS: compilation flags.
+# GRT_FLAGS: common (Ada + C + asm) compilation flags.
+# GRT_ADAFLAGS: compilation flags for Ada
# Convert the target variable into a space separated list of architecture,
# manufacturer, and operating system and assign each of those to its own
@@ -92,7 +93,7 @@ libgrt.a: $(GRT_ADD_OBJS) run-bind.o main.o grt-files
run-bind.adb: grt-force
gnatmake -c $(GNATFLAGS) -aI$(GRTSRCDIR) $(GRT_PRAGMA_FLAG) ghdl_main \
- -cargs $(GRT_FLAGS)
+ $(GRT_ADAFLAGS) -cargs $(GRT_FLAGS)
gnatbind -Lgrt_ -o run-bind.adb -n ghdl_main.ali
run-bind.o: run-bind.adb
@@ -137,6 +138,9 @@ grt-cbinding.o: $(GRTSRCDIR)/grt-cbinding.c
grt-cvpi.o: $(GRTSRCDIR)/grt-cvpi.c
$(CC) -c $(GRT_FLAGS) -o $@ $<
+grt-cthreads.o: $(GRTSRCDIR)/grt-cthreads.c
+ $(CC) -c $(GRT_FLAGS) -o $@ $<
+
grt-files: run-bind.adb
sed -e "1,/-- *BEGIN/d" -e "/-- *END/,\$$d" \
-e "s/ -- //" < $< > $@
diff --git a/translate/grt/config/ia64.S b/translate/grt/config/ia64.S
index cd77d497a..d7fb2d19a 100644
--- a/translate/grt/config/ia64.S
+++ b/translate/grt/config/ia64.S
@@ -13,6 +13,8 @@ grt_stack_loop:
;;
br 1b
.endp
+
+ frame_size = 480
.global grt_stack_switch#
.proc grt_stack_switch#
@@ -23,118 +25,209 @@ grt_stack_loop:
// f2-f5, f16-f31 [20]
// p1-p5, p16-p63 [1] ???
// b1-b5 [5]
+ // f2-f5, f16-f31 [20*16]
grt_stack_switch:
.prologue 2, 2
.vframe r2
+ {
alloc r31=ar.pfs, 2, 0, 0, 0
- adds r12 = -160, r12
+ mov r14 = ar.rsc
+ adds r12 = -(frame_size + 16), r12
.body
;;
+ }
// Save ar.rsc, ar.bsp, ar.pfs
{
- mov r14 = ar.rsc
+ st8 [r12] = r14 // sp + 0 <- ar.rsc
mov r15 = ar.bsp
adds r22 = (5*8), r12
- }
;;
+ }
{
- st8 [r12] = r14 // sp + 0 <- ar.rsc
st8.spill [r22] = r1, 8 // sp + 40 <- r1
+ ;;
+ st8.spill [r22] = r4, 8 // sp + 48 <- r4
adds r20 = 8, r12
- }
;;
+ }
st8 [r20] = r15, 8 // sp + 8 <- ar.bsp
- st8.spill [r22] = r4, 8 // sp + 48 <- r4
- ;;
- mov r15 = ar.lc
- st8 [r20] = r31, 8 // sp + 16 <- ar.pfs
st8.spill [r22] = r5, 8 // sp + 56 <- r5
+ mov r15 = ar.lc
;;
- mov r14 = b0
- st8 [r20] = r15, 8 // sp + 24 <- ar.lc
+ {
+ st8 [r20] = r31, 8 // sp + 16 <- ar.pfs
// Flush dirty registers to the backing store
flushrs
+ mov r14 = b0
;;
+ }
+ {
+ st8 [r20] = r15, 8 // sp + 24 <- ar.lc
// Set the RSE in enforced lazy mode.
mov ar.rsc = 0
- ;;
- mov r15 = ar.rnat
- st8.spill [r22] = r6, 8 // sp + 64 <- r6
;;
+ }
+ {
+ // Save sp.
+ st8 [r33] = r12
+ mov r15 = ar.rnat
mov r16 = b1
- st8.spill [r22] = r7, 16 // sp + 72 <- r7
+ ;;
+ }
+ {
+ st8.spill [r22] = r6, 8 // sp + 64 <- r6
st8 [r20] = r15, 64 // sp + 32 <- ar.rnat
;;
+ }
+ {
+ st8.spill [r22] = r7, 16 // sp + 72 <- r7
+ st8 [r20] = r14, 8 // sp + 96 <- b0
mov r15 = b2
+ ;;
+ }
+ {
mov r17 = ar.unat
- st8 [r20] = r14, 8 // sp + 96 <- b0
;;
- mov r14 = b3
st8 [r22] = r17, 24 // sp + 88 <- ar.unat
+ mov r14 = b3
+ ;;
+ }
+ {
st8 [r20] = r16, 16 // sp + 104 <- b1
- ;;
st8 [r22] = r15, 16 // sp + 112 <- b2
- st8 [r20] = r14, 16 // sp + 120 <- b3
- mov r16 = b4
+ mov r17 = b4
;;
- st8 [r22] = r16, 16 // sp + 128 <- b4
+ }
+ {
+ st8 [r20] = r14, 16 // sp + 120 <- b3
+ st8 [r22] = r17, 16 // sp + 128 <- b4
+ mov r15 = b5
+ ;;
+ }
+ {
// Read new sp.
ld8 r21 = [r32]
- mov r15 = b5
;;
+ st8 [r20] = r15, 24 // sp + 136 <- b5
mov r14 = pr
- st8 [r20] = r15 // sp + 136 <- b5
+ ;;
+ }
;;
- st8 [r22] = r14 // sp + 144 <- pr
- adds r20 = 8, r21
+ st8 [r22] = r14, 32 // sp + 144 <- pr
+ stf.spill [r20] = f2, 32 // sp + 160 <- f2
+ ;;
+ stf.spill [r22] = f3, 32 // sp + 176 <- f3
+ stf.spill [r20] = f4, 32 // sp + 192 <- f4
+ ;;
+ stf.spill [r22] = f5, 32 // sp + 208 <- f5
+ stf.spill [r20] = f16, 32 // sp + 224 <- f16
+ ;;
+ stf.spill [r22] = f17, 32 // sp + 240 <- f17
+ stf.spill [r20] = f18, 32 // sp + 256 <- f18
;;
+ stf.spill [r22] = f19, 32 // sp + 272 <- f19
+ stf.spill [r20] = f20, 32 // sp + 288 <- f20
+ ;;
+ stf.spill [r22] = f21, 32 // sp + 304 <- f21
+ stf.spill [r20] = f22, 32 // sp + 320 <- f22
+ ;;
+ stf.spill [r22] = f23, 32 // sp + 336 <- f23
+ stf.spill [r20] = f24, 32 // sp + 352 <- f24
+ ;;
+ stf.spill [r22] = f25, 32 // sp + 368 <- f25
+ stf.spill [r20] = f26, 32 // sp + 384 <- f26
+ ;;
+ stf.spill [r22] = f27, 32 // sp + 400 <- f27
+ stf.spill [r20] = f28, 32 // sp + 416 <- f28
+ ;;
+ stf.spill [r22] = f29, 32 // sp + 432 <- f29
+ stf.spill [r20] = f30, 32 // sp + 448 <- f30
+ ;;
+ {
+ stf.spill [r22] = f31, 32 // sp + 464 <- f31
invala
- // Save sp.
- st8 [r33] = r12
+ adds r20 = 8, r21
+ ;;
+ }
ld8 r14 = [r21], 88 // sp + 0 (ar.rsc)
+ ld8 r16 = [r20], 8 // sp + 8 (ar.bsp)
;;
ld8 r15 = [r21], -56 // sp + 88 (ar.unat)
- ld8 r16 = [r20], 8 // sp + 8 (ar.bsp)
- ;;
- ld8 r17 = [r21], 8 // sp + 32 (ar.rnat)
+ ;;
ld8 r18 = [r20], 8 // sp + 16 (ar.pfs)
mov ar.unat = r15
+ ld8 r17 = [r21], 8 // sp + 32 (ar.rnat)
;;
ld8 r15 = [r20], 72 // sp + 24 (ar.lc)
ld8.fill r1 = [r21], 8 // sp + 40 (r1)
mov ar.bspstore = r16
;;
- mov ar.rnat = r17
- mov ar.pfs = r18
ld8.fill r4 = [r21], 8 // sp + 48 (r4)
+ mov ar.pfs = r18
+ mov ar.rnat = r17
;;
mov ar.rsc = r14
mov ar.lc = r15
ld8 r17 = [r20], 8 // sp + 96 (b0)
;;
- mov b0 = r17
+ {
ld8.fill r5 = [r21], 8 // sp + 56 (r5)
ld8 r14 = [r20], 8 // sp + 104 (b1)
+ mov b0 = r17
;;
- mov b1 = r14
+ }
+ {
ld8.fill r6 = [r21], 8 // sp + 64 (r6)
ld8 r15 = [r20], 8 // sp + 112 (b2)
+ mov b1 = r14
;;
- mov b2 = r15
- ld8.fill r7 = [r21], 8 // sp + 72 (r7)
+ }
+ ld8.fill r7 = [r21], 64 // sp + 72 (r7)
ld8 r14 = [r20], 8 // sp + 120 (b3)
+ mov b2 = r15
;;
+ ld8 r15 = [r20], 16 // sp + 128 (b4)
+ ld8 r16 = [r21], 40 // sp + 136 (b5)
mov b3 = r14
- ld8 r15 = [r20], 8 // sp + 128 (b4)
;;
+ {
+ ld8 r14 = [r20], 16 // sp + 144 (pr)
+ ;;
+ ldf.fill f2 = [r20], 32 // sp + 160 (f2)
mov b4 = r15
- ld8 r14 = [r20], 8 // sp + 136 (b5)
;;
- mov b5 = r14
- ld8 r15 = [r20], 8 // sp + 144 (pr)
- mov r12 = r21
+ }
+ ldf.fill f3 = [r21], 32 // sp + 176 (f3)
+ ldf.fill f4 = [r20], 32 // sp + 192 (f4)
+ mov b5 = r16
+ ;;
+ ldf.fill f5 = [r21], 32 // sp + 208 (f5)
+ ldf.fill f16 = [r20], 32 // sp + 224 (f16)
+ mov pr = r14, -1
+ ;;
+ ldf.fill f17 = [r21], 32 // sp + 240 (f17)
+ ldf.fill f18 = [r20], 32 // sp + 256 (f18)
;;
- mov pr = r15, -1
+ ldf.fill f19 = [r21], 32 // sp + 272 (f19)
+ ldf.fill f20 = [r20], 32 // sp + 288 (f20)
+ ;;
+ ldf.fill f21 = [r21], 32 // sp + 304 (f21)
+ ldf.fill f22 = [r20], 32 // sp + 320 (f22)
+ ;;
+ ldf.fill f23 = [r21], 32 // sp + 336 (f23)
+ ldf.fill f24 = [r20], 32 // sp + 352 (f24)
+ ;;
+ ldf.fill f25 = [r21], 32 // sp + 368 (f25)
+ ldf.fill f26 = [r20], 32 // sp + 384 (f26)
+ ;;
+ ldf.fill f27 = [r21], 32 // sp + 400 (f27)
+ ldf.fill f28 = [r20], 32 // sp + 416 (f28)
+ ;;
+ ldf.fill f29 = [r21], 32 // sp + 432 (f29)
+ ldf.fill f30 = [r20], 32 // sp + 448 (f30)
+ ;;
+ ldf.fill f31 = [r21], 32 // sp + 464 (f31)
+ adds r12 = 16, r20
br.ret.sptk.many b0
;;
.endp grt_stack_switch#
@@ -146,48 +239,68 @@ grt_stack_switch:
grt_stack_create:
.prologue 14, 34
.save ar.pfs, r35
- alloc r35 = ar.pfs, 2, 4, 0, 0
+ alloc r35 = ar.pfs, 2, 3, 0, 0
.save rp, r34
- mov r34 = b0
+ // Compute backing store.
+ movl r14 = stack_max_size
;;
.body
+ {
+ ld4 r36 = [r14] // r14: bsp
+ mov r34 = b0
br.call.sptk.many b0 = grt_stack_allocate#
;;
- // Compute backing store.
- movl r14=stack_max_size
+ }
+ {
ld8 r22 = [r32], 8 // read ip (-> b1)
- adds r20 = -(160 + 16), r8
- adds r21 = -(160 + 16) + 32, r8
;;
- mov r18 = 0x0f // ar.rsc: LE, PL=3, Eager
- ld4 r14 = [r14] // r16: bsp
- st8 [r21] = r0, 8 // sp + 32 (ar.rnat = 0)
ld8 r23 = [r32] // read r1 from func
- st8 [r8] = r20 // Save cur_sp
+ adds r21 = -(frame_size + 16) + 32, r8
+ ;;
+ }
+ {
+ st8 [r21] = r0, -32 // sp + 32 (ar.rnat = 0)
+ ;;
+ st8 [r8] = r21 // Save cur_sp
+ mov r18 = 0x0f // ar.rsc: LE, PL=3, Eager
+ ;;
+ }
+ {
+ st8 [r21] = r18, 40 // sp + 0 (ar.rsc)
;;
- st8 [r20] = r18, 8 // sp + 0 (ar.rsc)
st8 [r21] = r23, 64 // sp + 40 (r1 = func.r1)
- sub r14 = r8, r14 // Backing store base
+ mov b0 = r34
;;
- adds r14 = 16, r14 // Add sizeof (stack_context)
- st8 [r21] = r22, -8 // sp + 104 (b1 = func.ip)
- ;;
+ }
+ {
+ st8 [r21] = r22, -96 // sp + 104 (b1 = func.ip)
movl r15 = grt_stack_loop
- mov r16 = (0 << 7) | 1 // CFM: sol=0, sof=1
- st8 [r20] = r14, 8 // sp + 8 (ar.bsp)
;;
- st8 [r21] = r15, -48 // sp + 96 (b0 = grt_stack_loop)
- st8 [r20] = r16, 8 // sp + 16 (ar.pfs)
+ }
+ sub r14 = r8, r36 // Backing store base
;;
- st8 [r20] = r0, 8 // sp + 24 (ar.lc)
- st8 [r21] = r33 // sp + 48 (r4 = arg)
+ adds r14 = 16, r14 // Add sizeof (stack_context)
+ adds r20 = 40, r21
;;
- st8 [r20] = r0, 8 // sp + 32 (ar.rnat)
+ {
+ st8 [r21] = r14, 88 // sp + 8 (ar.bsp)
;;
-
+ st8 [r21] = r15, -80 // sp + 96 (b0 = grt_stack_loop)
+ mov r16 = (0 << 7) | 1 // CFM: sol=0, sof=1
+ ;;
+ }
+ {
+ st8 [r21] = r16, 8 // sp + 16 (ar.pfs)
+ ;;
+ st8 [r21] = r0, 24 // sp + 24 (ar.lc)
mov ar.pfs = r35
- mov b0 = r34
+ ;;
+ }
+ {
+ st8 [r20] = r0, 8 // sp + 32 (ar.rnat)
+ st8 [r21] = r33 // sp + 48 (r4 = arg)
br.ret.sptk.many b0
;;
+ }
.endp grt_stack_create#
.ident "GCC: (GNU) 4.0.2"
diff --git a/translate/grt/config/linux.c b/translate/grt/config/linux.c
index 3159cd613..38641b67f 100644
--- a/translate/grt/config/linux.c
+++ b/translate/grt/config/linux.c
@@ -65,7 +65,7 @@ struct stack_context
/* Context for the main stack. */
static struct stack_context main_stack_context;
-extern struct stack_context *grt_stack_main_stack;
+extern void grt_stack_set_main_stack (struct stack_context *stack);
/* If MAP_ANONYMOUS is not defined, use /dev/zero. */
#ifndef MAP_ANONYMOUS
@@ -78,10 +78,8 @@ static int dev_zero_fd;
#endif
#if EXTEND_STACK
-/* Defined in Grt.Processes (body).
- This is the current process being run.
- FIXME: this won't work with pthread! */
-extern void **grt_cur_proc;
+/* This is the current process being run. */
+extern struct stack_context *grt_get_current_process (void);
/* Stack used for signals.
The stack must be different from the running stack, because we want to be
@@ -124,7 +122,7 @@ static void grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
}
#endif
- if (info == NULL || grt_cur_proc == NULL || in_handler > 1)
+ if (info == NULL || grt_get_current_process () == NULL || in_handler > 1)
{
/* We loose. */
sigaction (SIGSEGV, &prev_sigsegv_act, NULL);
@@ -134,7 +132,7 @@ static void grt_sigsegv_handler (int signo, siginfo_t *info, void *ptr)
addr = info->si_addr;
/* Check ADDR belong to the stack. */
- ctxt = *grt_cur_proc;
+ ctxt = grt_get_current_process ()->cur_sp;
stack_high = (void *)(ctxt + 1);
stack_low = stack_high - stack_max_size;
if (addr > stack_high || addr < stack_low)
@@ -216,7 +214,7 @@ grt_stack_init (void)
/* Initialize the main stack context. */
main_stack_context.cur_sp = NULL;
main_stack_context.cur_length = 0;
- grt_stack_main_stack = &main_stack_context;
+ grt_stack_set_main_stack (&main_stack_context);
#ifdef USE_DEV_ZERO
dev_zero_fd = open ("/dev/zero", O_RDWR);
diff --git a/translate/grt/grt-main.adb b/translate/grt/grt-main.adb
index fa56046fd..28bd8b045 100644
--- a/translate/grt/grt-main.adb
+++ b/translate/grt/grt-main.adb
@@ -159,10 +159,6 @@ package body Grt.Main is
Grt.Disp.Disp_Signals_Order;
end if;
- if Flag_Stats then
- Stats.Start_Cycles;
- end if;
-
-- Do the simulation.
Status := Grt.Processes.Simulation;
end if;
diff --git a/translate/grt/grt-options.adb b/translate/grt/grt-options.adb
index 9aa6f64e7..15b56d469 100644
--- a/translate/grt/grt-options.adb
+++ b/translate/grt/grt-options.adb
@@ -156,6 +156,7 @@ package body Grt.Options is
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;
P ("trace options:");
P (" --disp-time disp time as simulation advances");
@@ -457,6 +458,21 @@ package body Grt.Options is
else
Error ("bad argument for --activity, try --help");
end if;
+ elsif Len > 10 and then Argument (1 .. 10) = "--threads=" then
+ declare
+ Ok : Boolean;
+ Pos : Natural;
+ Val : Integer_64;
+ begin
+ Extract_Integer (Argument (11 .. Len), Ok, Val, Pos);
+ if not Ok or else Pos <= Len then
+ Error_C ("bad value in '");
+ Error_C (Argument);
+ Error_E ("'");
+ else
+ Nbr_Threads := Integer (Val);
+ end if;
+ end;
elsif not Grt.Hooks.Call_Option_Hooks (Argument) then
Error_C ("unknown option '");
Error_C (Argument);
diff --git a/translate/grt/grt-options.ads b/translate/grt/grt-options.ads
index 3257e9f22..756fe5dd6 100644
--- a/translate/grt/grt-options.ads
+++ b/translate/grt/grt-options.ads
@@ -118,10 +118,17 @@ package Grt.Options is
type Activity_Mode is (Activity_All, Activity_Minimal, Activity_None);
Flag_Activity : Activity_Mode := Activity_Minimal;
+ -- Set by --thread=
+ -- Number of threads used to do the simulation.
+ -- 1 mean no additionnal threads, 0 means as many threads as number of
+ -- CPUs.
+ Nbr_Threads : Natural := 1;
+
-- Set the time resolution.
-- Only call this subprogram if you are allowed to set the time resolution.
procedure Set_Time_Resolution (Res : Character);
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/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb
index 70ba85e9d..1bb0be854 100644
--- a/translate/grt/grt-processes.adb
+++ b/translate/grt/grt-processes.adb
@@ -32,81 +32,10 @@ with Grt.Hooks;
with Grt.Disp_Signals;
with Grt.Stdio;
with Grt.Stats;
+with Grt.Threads; use Grt.Threads;
package body Grt.Processes is
- -- Access to a process subprogram.
- type Proc_Acc is access procedure (Self : System.Address);
-
- -- Simply linked list for sensitivity.
- type Sensitivity_El;
- type Sensitivity_Acc is access Sensitivity_El;
- type Sensitivity_El is record
- Sig : Ghdl_Signal_Ptr;
- Next : Sensitivity_Acc;
- end record;
-
- Last_Time : Std_Time := Std_Time'Last;
-
- -- State of a process.
- type Process_State is
- (
- -- Sensitized process. Its state cannot change.
- State_Sensitized,
-
- -- Verilog process, being suspended.
- State_Delayed,
-
- -- Non-sensitized process being suspended.
- State_Wait,
-
- -- Non-sensitized process being awaked by a wait timeout. This state
- -- is transcient.
- State_Timeout,
-
- -- Non-sensitized process waiting until end.
- 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 : Stack_Type;
-
- -- Subprogram containing process code.
- Subprg : Proc_Acc;
-
- -- Instance (THIS parameter) for the subprogram.
- This : System.Address;
-
- -- Name of the process.
- Rti : 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 : Process_State;
-
- -- Timeout value for wait.
- Timeout : Std_Time;
-
- -- Sensitivity list.
- Sensitivity : Sensitivity_Acc;
- end record;
- type Process_Acc is access all Process_Type;
-
- -- Per 'thread' data.
- -- The process being executed.
- Cur_Proc_Id : Process_Id;
-
- Cur_Proc : Process_Acc;
- pragma Export (C, Cur_Proc, "grt_cur_proc");
-
- -- The secondary stack for the thread.
- Stack2 : Stack2_Ptr;
+ Last_Time : constant Std_Time := Std_Time'Last;
-- Table of processes.
package Process_Table is new GNAT.Table
@@ -148,12 +77,6 @@ package body Grt.Processes is
Process_Table.Init;
end Init;
- function Get_Current_Process_Id return Process_Id
- is
- begin
- return Cur_Proc_Id;
- end Get_Current_Process_Id;
-
function Get_Nbr_Processes return Natural is
begin
return Natural (Process_Table.Last);
@@ -203,10 +126,10 @@ package body Grt.Processes is
Timeout => Bad_Time,
Stack => Stack);
-- Used to create drivers.
- Cur_Proc_Id := Process_Table.Last;
+ Set_Current_Process (Process_Table.Last, null);
if State /= State_Sensitized then
- Non_Sensitized_Process_Table.Append (Cur_Proc_Id);
+ Non_Sensitized_Process_Table.Append (Process_Table.Last);
end if;
if Postponed then
Nbr_Postponed_Processes := Nbr_Postponed_Processes + 1;
@@ -274,7 +197,7 @@ package body Grt.Processes is
This => This,
Stack => Null_Stack);
-- Used to create drivers.
- Cur_Proc_Id := Process_Table.Last;
+ Set_Current_Process (Process_Table.Last, null);
end Verilog_Process_Register;
procedure Ghdl_Initial_Register (Instance : System.Address;
@@ -318,20 +241,23 @@ package body Grt.Processes is
return System.Address
is
begin
- return Grt.Stack2.Allocate (Stack2, Size);
+ return Grt.Stack2.Allocate (Get_Stack2, Size);
end Ghdl_Stack2_Allocate;
- function Ghdl_Stack2_Mark return Mark_Id is
+ function Ghdl_Stack2_Mark return Mark_Id
+ is
+ St2 : Stack2_Ptr := Get_Stack2;
begin
- if Stack2 = Null_Stack2_Ptr then
- Stack2 := Grt.Stack2.Create;
+ if St2 = Null_Stack2_Ptr then
+ St2 := Grt.Stack2.Create;
+ Set_Stack2 (St2);
end if;
- return Grt.Stack2.Mark (Stack2);
+ return Grt.Stack2.Mark (St2);
end Ghdl_Stack2_Mark;
procedure Ghdl_Stack2_Release (Mark : Mark_Id) is
begin
- Grt.Stack2.Release (Stack2, Mark);
+ Grt.Stack2.Release (Get_Stack2, Mark);
end Ghdl_Stack2_Release;
function To_Acc is new Ada.Unchecked_Conversion
@@ -342,8 +268,8 @@ package body Grt.Processes is
El : Sensitivity_Acc;
begin
El := new Sensitivity_El'(Sig => Sig,
- Next => Cur_Proc.Sensitivity);
- Cur_Proc.Sensitivity := El;
+ Next => Get_Current_Process.Sensitivity);
+ Get_Current_Process.Sensitivity := El;
end Ghdl_Process_Wait_Add_Sensitivity;
procedure Ghdl_Process_Wait_Set_Timeout (Time : Std_Time)
@@ -353,31 +279,33 @@ package body Grt.Processes is
-- LRM93 8.1
Error ("negative timeout clause");
end if;
- Cur_Proc.Timeout := Current_Time + Time;
+ Get_Current_Process.Timeout := Current_Time + Time;
end Ghdl_Process_Wait_Set_Timeout;
function Ghdl_Process_Wait_Suspend return Boolean
is
+ Proc : constant Process_Acc := Get_Current_Process;
begin
- if Cur_Proc.State = State_Sensitized then
+ if Proc.State = State_Sensitized then
Error ("wait statement in a sensitized process");
end if;
-- Suspend this process.
- Cur_Proc.State := State_Wait;
+ Proc.State := State_Wait;
-- if Cur_Proc.Timeout = Bad_Time then
-- Cur_Proc.Timeout := Std_Time'Last;
-- end if;
- Stack_Switch (Main_Stack, Cur_Proc.Stack);
- return Cur_Proc.State = State_Timeout;
+ Stack_Switch (Get_Main_Stack, Proc.Stack);
+ return Proc.State = State_Timeout;
end Ghdl_Process_Wait_Suspend;
procedure Ghdl_Process_Wait_Close
is
+ Proc : constant Process_Acc := Get_Current_Process;
El : Sensitivity_Acc;
N_El : Sensitivity_Acc;
begin
- El := Cur_Proc.Sensitivity;
- Cur_Proc.Sensitivity := null;
+ El := Proc.Sensitivity;
+ Proc.Sensitivity := null;
while El /= null loop
N_El := El.Next;
Free (El);
@@ -387,39 +315,42 @@ package body Grt.Processes is
procedure Ghdl_Process_Wait_Exit
is
+ Proc : constant Process_Acc := Get_Current_Process;
begin
- if Cur_Proc.State = State_Sensitized then
+ 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.
- Cur_Proc.State := State_Dead;
+ Proc.State := State_Dead;
-- Suspend this process.
- Stack_Switch (Main_Stack, Cur_Proc.Stack);
+ Stack_Switch (Get_Main_Stack, Proc.Stack);
end Ghdl_Process_Wait_Exit;
procedure Ghdl_Process_Wait_Timeout (Time : Std_Time)
is
+ Proc : constant Process_Acc := Get_Current_Process;
begin
- if Cur_Proc.State = State_Sensitized then
+ if Proc.State = State_Sensitized then
Error ("wait statement in a sensitized process");
end if;
if Time < 0 then
-- LRM93 8.1
Error ("negative timeout clause");
end if;
- Cur_Proc.Timeout := Current_Time + Time;
- Cur_Proc.State := State_Wait;
+ Proc.Timeout := Current_Time + Time;
+ Proc.State := State_Wait;
-- Suspend this process.
- Stack_Switch (Main_Stack, Cur_Proc.Stack);
+ Stack_Switch (Get_Main_Stack, Proc.Stack);
end Ghdl_Process_Wait_Timeout;
-- Verilog.
procedure Ghdl_Process_Delay (Del : Ghdl_U32)
is
+ Proc : constant Process_Acc := Get_Current_Process;
begin
- Cur_Proc.Timeout := Current_Time + Std_Time (Del);
- Cur_Proc.State := State_Delayed;
+ Proc.Timeout := Current_Time + Std_Time (Del);
+ Proc.State := State_Delayed;
end Ghdl_Process_Delay;
-- Protected object lock.
@@ -564,33 +495,26 @@ package body Grt.Processes is
-- Failure, simulation should stop.
Run_Failure : constant Integer := -1;
- function Run_Processes (Postponed : Boolean) return Integer
+ Mt_Last : Natural;
+ Mt_Table : Process_Id_Array_Acc;
+ Mt_Index : aliased Natural;
+
+ procedure Run_Processes_Threads
is
- Table : Process_Id_Array_Acc;
- Last : Natural;
- Status : Integer;
+ Pid : Process_Id;
+ Idx : Natural;
begin
- Status := Run_None;
-
- if Options.Flag_Stats then
- Stats.Start_Processes;
- end if;
+ loop
+ -- Atomically get a process to be executed
+ Idx := Grt.Threads.Atomic_Inc (Mt_Index'Access);
+ if Idx > Mt_Last then
+ return;
+ end if;
+ Pid := Mt_Table (Idx);
- if Postponed then
- Table := Postponed_Resume_Process_Table;
- Last := Last_Postponed_Resume_Process;
- else
- Table := Resume_Process_Table;
- Last := Last_Resume_Process;
- end if;
- for I in 1 .. Last loop
declare
- Pid : constant Process_Id := Table (I);
Proc : Process_Type renames Process_Table.Table (Pid);
begin
- if not Proc.Resumed then
- Internal_Error ("run non-resumed process");
- end if;
if Grt.Options.Trace_Processes then
Grt.Astdio.Put ("run process ");
Disp_Process_Name (Stdio.stdout, Pid);
@@ -599,33 +523,89 @@ package body Grt.Processes is
Grt.Astdio.Put ("]");
Grt.Astdio.New_Line;
end if;
- Nbr_Resumed_Processes := Nbr_Resumed_Processes + 1;
+ if not Proc.Resumed then
+ Internal_Error ("run non-resumed process");
+ end if;
Proc.Resumed := False;
- Status := Run_Resumed;
- Cur_Proc_Id := Pid;
- Cur_Proc := To_Acc (Process_Table.Table (Pid)'Address);
- if Cur_Proc.State = State_Sensitized then
- Cur_Proc.Subprg.all (Cur_Proc.This);
+ Set_Current_Process
+ (Pid, To_Acc (Process_Table.Table (Pid)'Address));
+ if Proc.State = State_Sensitized then
+ Proc.Subprg.all (Proc.This);
else
- Stack_Switch (Cur_Proc.Stack, Main_Stack);
+ Stack_Switch (Proc.Stack, Get_Main_Stack);
end if;
if Grt.Options.Checks then
Ghdl_Signal_Internal_Checks;
- Grt.Stack2.Check_Empty (Stack2);
+ Grt.Stack2.Check_Empty (Get_Stack2);
end if;
end;
end loop;
+ end Run_Processes_Threads;
+
+ function Run_Processes (Postponed : Boolean) return Integer
+ is
+ Table : Process_Id_Array_Acc;
+ Last : Natural;
+ begin
+ if Options.Flag_Stats then
+ Stats.Start_Processes;
+ end if;
if Postponed then
+ Table := Postponed_Resume_Process_Table;
+ Last := Last_Postponed_Resume_Process;
Last_Postponed_Resume_Process := 0;
else
+ Table := Resume_Process_Table;
+ Last := Last_Resume_Process;
Last_Resume_Process := 0;
end if;
+ Nbr_Resumed_Processes := Nbr_Resumed_Processes + Last;
- if Options.Flag_Stats then
- Stats.End_Processes;
+ if Options.Nbr_Threads = 1 then
+ for I in 1 .. Last loop
+ declare
+ Pid : constant Process_Id := Table (I);
+ Proc : Process_Type renames Process_Table.Table (Pid);
+ begin
+ if not Proc.Resumed then
+ Internal_Error ("run non-resumed process");
+ end if;
+ if Grt.Options.Trace_Processes then
+ Grt.Astdio.Put ("run process ");
+ Disp_Process_Name (Stdio.stdout, Pid);
+ Grt.Astdio.Put (" [");
+ Grt.Astdio.Put (Stdio.stdout, Proc.This);
+ Grt.Astdio.Put ("]");
+ Grt.Astdio.New_Line;
+ end if;
+
+ Proc.Resumed := False;
+ Set_Current_Process
+ (Pid, To_Acc (Process_Table.Table (Pid)'Address));
+ if Proc.State = State_Sensitized then
+ Proc.Subprg.all (Proc.This);
+ else
+ Stack_Switch (Proc.Stack, Get_Main_Stack);
+ end if;
+ if Grt.Options.Checks then
+ Ghdl_Signal_Internal_Checks;
+ Grt.Stack2.Check_Empty (Get_Stack2);
+ end if;
+ end;
+ end loop;
+ else
+ Mt_Last := Last;
+ Mt_Table := Table;
+ Mt_Index := 1;
+ Threads.Run_Parallel (Run_Processes_Threads'Access);
+ end if;
+
+ if Last >= 1 then
+ return Run_Resumed;
+ else
+ return Run_None;
end if;
- return Status;
end Run_Processes;
function Initialization_Phase return Integer
@@ -705,7 +685,6 @@ package body Grt.Processes is
end if;
Update_Signals;
if Options.Flag_Stats then
- Stats.End_Update;
Stats.Start_Resume;
end if;
@@ -753,10 +732,6 @@ package body Grt.Processes is
end;
end loop;
- if Options.Flag_Stats then
- Stats.End_Resume;
- end if;
-
-- e) Each nonpostponed that has resumed in the current simulation cycle
-- is executed until it suspends.
Status := Run_Processes (Postponed => False);
@@ -775,9 +750,6 @@ package body Grt.Processes is
Stats.Start_Next_Time;
end if;
Tn := Compute_Next_Time;
- if Options.Flag_Stats then
- Stats.End_Next_Time;
- end if;
-- g) If the next simulation cycle will be a delta cycle, the remainder
-- of the step is skipped.
@@ -805,9 +777,6 @@ package body Grt.Processes is
Stats.Start_Next_Time;
end if;
Tn := Compute_Next_Time;
- if Options.Flag_Stats then
- Stats.End_Next_Time;
- end if;
if Tn = Current_Time then
Error ("postponed process causes a delta cycle");
end if;
@@ -824,8 +793,9 @@ package body Grt.Processes is
use Options;
Status : Integer;
begin
- --Put_Line ("grt.processes:" & Process_Id'Image (Process_Table.Last)
- -- & " process(es)");
+ if Nbr_Threads /= 1 then
+ Threads.Init;
+ end if;
-- if Disp_Sig_Types then
-- Grt.Disp.Disp_Signals_Type;
@@ -889,6 +859,10 @@ package body Grt.Processes is
end if;
end loop;
+ if Nbr_Threads /= 1 then
+ Threads.Finish;
+ end if;
+
Grt.Hooks.Call_Finish_Hooks;
if Status = Run_Failure then
diff --git a/translate/grt/grt-processes.ads b/translate/grt/grt-processes.ads
index b81e42da1..2ef0653c5 100644
--- a/translate/grt/grt-processes.ads
+++ b/translate/grt/grt-processes.ads
@@ -19,7 +19,9 @@ with System;
with Grt.Stack2; use Grt.Stack2;
with Grt.Types; use Grt.Types;
with Grt.Signals; use Grt.Signals;
+with Grt.Stacks;
with Grt.Rtis; use Grt.Rtis;
+with Grt.Rtis_Addr;
with Grt.Stdio;
package Grt.Processes is
@@ -44,8 +46,6 @@ package Grt.Processes is
-- During the elaboration, this is the identifier of the last process
-- being elaborated. So, this function can be used to create signal
-- drivers.
- function Get_Current_Process_Id return Process_Id;
- pragma Inline (Get_Current_Process_Id);
-- Return the total number of processes and number of sensitized processes.
-- Used for statistics.
@@ -118,7 +118,70 @@ package Grt.Processes is
procedure Ghdl_Protected_Init (Obj : System.Address);
procedure Ghdl_Protected_Fini (Obj : System.Address);
+ type Process_Type is private;
+ type Process_Acc is access all Process_Type;
private
+ -- Access to a process subprogram.
+ type Proc_Acc is access procedure (Self : System.Address);
+
+ -- Simply linked list for sensitivity.
+ type Sensitivity_El;
+ type Sensitivity_Acc is access Sensitivity_El;
+ type Sensitivity_El is record
+ Sig : Ghdl_Signal_Ptr;
+ Next : Sensitivity_Acc;
+ end record;
+
+ -- State of a process.
+ type Process_State is
+ (
+ -- Sensitized process. Its state cannot change.
+ State_Sensitized,
+
+ -- Verilog process, being suspended.
+ State_Delayed,
+
+ -- Non-sensitized process being suspended.
+ State_Wait,
+
+ -- Non-sensitized process being awaked by a wait timeout. This state
+ -- is transcient.
+ State_Timeout,
+
+ -- Non-sensitized process waiting until end.
+ 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 : System.Address;
+
+ -- 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 : Process_State;
+
+ -- Timeout value for wait.
+ Timeout : Std_Time;
+
+ -- Sensitivity list.
+ Sensitivity : Sensitivity_Acc;
+ end record;
+
pragma Export (C, Ghdl_Process_Register,
"__ghdl_process_register");
pragma Export (C, Ghdl_Sensitized_Process_Register,
diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb
index fed178853..e0376c2ab 100644
--- a/translate/grt/grt-signals.adb
+++ b/translate/grt/grt-signals.adb
@@ -26,6 +26,7 @@ with Grt.Rtis_Types; use Grt.Rtis_Types;
with Grt.Disp_Signals;
with Grt.Astdio;
with Grt.Stdio;
+with Grt.Threads; use Grt.Threads;
package body Grt.Signals is
function Is_Signal_Guarded (Sig : Ghdl_Signal_Ptr) return Boolean
@@ -403,11 +404,11 @@ package body Grt.Signals is
Signal_End : Ghdl_Signal_Ptr;
-- List of active signals.
- Active_List : Ghdl_Signal_Ptr;
+ Active_List : aliased Ghdl_Signal_Ptr;
-- List of signals which have projected waveforms in the future (beyond
-- the next delta cycle).
- Future_List : Ghdl_Signal_Ptr;
+ Future_List : aliased Ghdl_Signal_Ptr;
procedure Ghdl_Signal_Start_Assign (Sign : Ghdl_Signal_Ptr;
Reject : Std_Time;
@@ -430,15 +431,13 @@ package body Grt.Signals is
-- Put SIGN on the active list if the transaction is scheduled
-- for the next delta cycle.
if Sign.Link = null then
- Sign.Link := Active_List;
- Active_List := Sign;
+ Sign.Link := Grt.Threads.Atomic_Insert (Active_List'access, Sign);
end if;
else
-- AFTER > 0.
-- Put SIGN on the future list.
if Sign.Flink = null then
- Sign.Flink := Future_List;
- Future_List := Sign;
+ Sign.Flink := Grt.Threads.Atomic_Insert (Future_List'access, Sign);
end if;
end if;
diff --git a/translate/grt/grt-stacks.ads b/translate/grt/grt-stacks.ads
index 2624f5c2b..920012cba 100644
--- a/translate/grt/grt-stacks.ads
+++ b/translate/grt/grt-stacks.ads
@@ -21,10 +21,6 @@ package Grt.Stacks is
type Stack_Type is new Address;
Null_Stack : constant Stack_Type := Stack_Type (Null_Address);
- -- The main stack. This is initialized by STACK_INIT.
- -- The return point.
- Main_Stack : Stack_Type;
-
-- Initialize the stacks package.
-- This may adjust stack sizes.
-- Must be called after grt.options.decode.
@@ -54,8 +50,6 @@ package Grt.Stacks is
procedure Error_Null_Access;
pragma No_Return (Error_Null_Access);
private
- pragma Export (C, Main_Stack, "grt_stack_main_stack");
-
pragma Import (C, Stack_Init, "grt_stack_init");
pragma Import (C, Stack_Create, "grt_stack_create");
pragma Import (C, Stack_Switch, "grt_stack_switch");
diff --git a/translate/grt/grt-stats.adb b/translate/grt/grt-stats.adb
index 065909b11..340c3dbc0 100644
--- a/translate/grt/grt-stats.adb
+++ b/translate/grt/grt-stats.adb
@@ -19,7 +19,6 @@ with System; use System;
with System.Storage_Elements; -- Work around GNAT bug.
with Grt.Stdio; use Grt.Stdio;
with Grt.Astdio; use Grt.Astdio;
-with Grt.Vstrings;
with Grt.Signals;
with Grt.Processes;
with Grt.Types; use Grt.Types;
@@ -71,29 +70,20 @@ package body Grt.Stats is
procedure Put (Stream : FILEs; Val : Clock_T)
is
- use Grt.Vstrings;
+ Fmt : constant String := "%3d.%03d" & Character'Val (0);
- Ms : Ghdl_I32;
- Buf : String (1 .. 11);
- First : Natural;
- C : Character;
+ procedure fprintf (Stream : FILEs; Fmt : Address; A, B : Clock_T);
+ pragma Import (C, fprintf);
+
+ Sec : Clock_T;
+ Ms : Clock_T;
begin
- To_String (Buf, First, Ghdl_I32 (Val / One_Second));
- if First > 8 then
- Buf (8 .. First - 1) := (others => ' ');
- First := 8;
- end if;
- Put (Stream, Buf (First .. Buf'Last));
- Put (Stream, '.');
+ Sec := Val / One_Second;
-- Avoid overflow.
- Ms := Ghdl_I32 (((Val mod One_Second) * 1000) / One_Second);
+ Ms := ((Val mod One_Second) * 1000) / One_Second;
- for I in 1 .. 3 loop
- C := Character'Val (Character'Pos ('0') + (Ms / 100));
- Put (Stream, C);
- Ms := (Ms * 10) mod 1000;
- end loop;
+ fprintf (Stream, Fmt'Address, Sec, Ms);
end Put;
procedure Put (Stream : FILEs; T : Time_Stats) is
@@ -106,103 +96,85 @@ package body Grt.Stats is
Put (Stream, T.Sys);
end Put;
- -- Stats at origin.
- Start_Time : Time_Stats;
- End_Elab_Time : Time_Stats;
- End_Order_Time : Time_Stats;
+ type Counter_Kind is (Counter_Elab, Counter_Order,
+ Counter_Process, Counter_Update,
+ Counter_Next, Counter_Resume);
+
+ type Counter_Array is array (Counter_Kind) of Time_Stats;
+ Counters : Counter_Array := (others => (0, 0, 0));
- Start_Proc_Time : Time_Stats;
- Proc_Times : Time_Stats;
+ Init_Time : Time_Stats;
+ Last_Counter : Counter_Kind;
+ Last_Time : Time_Stats;
- Start_Update_Time : Time_Stats;
- Update_Times : Time_Stats;
+-- -- Stats at origin.
+-- Start_Time : Time_Stats;
+-- End_Elab_Time : Time_Stats;
+-- End_Order_Time : Time_Stats;
- Start_Next_Time_Time : Time_Stats;
- Next_Time_Times : Time_Stats;
+-- Start_Proc_Time : Time_Stats;
+-- Proc_Times : Time_Stats;
- Start_Resume_Time : Time_Stats;
- Resume_Times : Time_Stats;
+-- Start_Update_Time : Time_Stats;
+-- Update_Times : Time_Stats;
- Running_Time : Time_Stats;
- Simu_Time : Time_Stats;
+-- Start_Next_Time_Time : Time_Stats;
+-- Next_Time_Times : Time_Stats;
+
+-- Start_Resume_Time : Time_Stats;
+-- Resume_Times : Time_Stats;
+
+-- Running_Time : Time_Stats;
+-- Simu_Time : Time_Stats;
procedure Start_Elaboration is
begin
One_Second := Get_Clk_Tck;
- Proc_Times := (0, 0, 0);
- Get_Stats (Start_Time);
+ Get_Stats (Init_Time);
+ Last_Time := Init_Time;
+ Last_Counter := Counter_Elab;
end Start_Elaboration;
- procedure Start_Order is
+ procedure Change_Counter (Cnt : Counter_Kind)
+ is
+ New_Time : Time_Stats;
begin
- Get_Stats (End_Elab_Time);
- end Start_Order;
+ Get_Stats (New_Time);
+ Counters (Last_Counter) := Counters (Last_Counter)
+ + (New_Time - Last_Time);
+ Last_Time := New_Time;
+ Last_Counter := Cnt;
+ end Change_Counter;
- procedure Start_Cycles is
+ procedure Start_Order is
begin
- Get_Stats (End_Order_Time);
- end Start_Cycles;
+ Change_Counter (Counter_Order);
+ end Start_Order;
procedure Start_Processes is
begin
- Get_Stats (Start_Proc_Time);
+ Change_Counter (Counter_Process);
end Start_Processes;
- procedure End_Processes
- is
- Now : Time_Stats;
- begin
- Get_Stats (Now);
- Proc_Times := Proc_Times + (Now - Start_Proc_Time);
- end End_Processes;
-
procedure Start_Update is
begin
- Get_Stats (Start_Update_Time);
+ Change_Counter (Counter_Update);
end Start_Update;
- procedure End_Update
- is
- Now : Time_Stats;
- begin
- Get_Stats (Now);
- Update_Times := Update_Times + (Now - Start_Update_Time);
- end End_Update;
-
procedure Start_Next_Time is
begin
- Get_Stats (Start_Next_Time_Time);
+ Change_Counter (Counter_Next);
end Start_Next_Time;
- procedure End_Next_Time
- is
- Now : Time_Stats;
- begin
- Get_Stats (Now);
- Next_Time_Times := Next_Time_Times + (Now - Start_Next_Time_Time);
- end End_Next_Time;
-
procedure Start_Resume is
begin
- Get_Stats (Start_Resume_Time);
+ Change_Counter (Counter_Resume);
end Start_Resume;
- procedure End_Resume
- is
- Now : Time_Stats;
- begin
- Get_Stats (Now);
- Resume_Times := Resume_Times + (Now - Start_Resume_Time);
- end End_Resume;
-
- procedure End_Simulation
- is
- Now : Time_Stats;
+ procedure End_Simulation is
begin
- Get_Stats (Now);
- Simu_Time := Now - Start_Time;
- Running_Time := Now - End_Order_Time;
+ Change_Counter (Last_Counter);
end End_Simulation;
procedure Disp_Signals_Stats
@@ -312,31 +284,29 @@ package body Grt.Stats is
N : Natural;
begin
Put (stdout, "total: ");
- Put (stdout, Simu_Time);
+ Put (stdout, Last_Time - Init_Time);
New_Line (stdout);
Put (stdout, " elab: ");
- Put (stdout, End_Elab_Time - Start_Time);
+ Put (stdout, Counters (Counter_Elab));
New_Line (stdout);
Put (stdout, " internal elab: ");
- Put (stdout, End_Order_Time - End_Elab_Time);
- New_Line (stdout);
- Put (stdout, " running time: ");
- Put (stdout, Running_Time);
+ Put (stdout, Counters (Counter_Order));
New_Line (stdout);
Put (stdout, " cycle (sum): ");
- Put (stdout, Proc_Times + Update_Times + Next_Time_Times + Resume_Times);
+ Put (stdout, Counters (Counter_Process) + Counters (Counter_Resume)
+ + Counters (Counter_Update) + Counters (Counter_Next));
New_Line (stdout);
Put (stdout, " processes: ");
- Put (stdout, Proc_Times);
+ Put (stdout, Counters (Counter_Process));
New_Line (stdout);
Put (stdout, " resume: ");
- Put (stdout, Resume_Times);
+ Put (stdout, Counters (Counter_Resume));
New_Line (stdout);
Put (stdout, " update: ");
- Put (stdout, Update_Times);
+ Put (stdout, Counters (Counter_Update));
New_Line (stdout);
Put (stdout, " next compute: ");
- Put (stdout, Next_Time_Times);
+ Put (stdout, Counters (Counter_Next));
New_Line (stdout);
Disp_Signals_Stats;
diff --git a/translate/grt/grt-stats.ads b/translate/grt/grt-stats.ads
index 7844a86eb..8b2307391 100644
--- a/translate/grt/grt-stats.ads
+++ b/translate/grt/grt-stats.ads
@@ -20,23 +20,21 @@ package Grt.Stats is
-- Entry points to gather statistics.
procedure Start_Elaboration;
procedure Start_Order;
- procedure Start_Cycles;
-- Time in user processes.
procedure Start_Processes;
- procedure End_Processes;
+
-- Time in next time computation.
procedure Start_Next_Time;
- procedure End_Next_Time;
+
-- Time in signals update.
procedure Start_Update;
- procedure End_Update;
+
-- Time in process resume
procedure Start_Resume;
- procedure End_Resume;
procedure End_Simulation;
diff --git a/translate/grt/grt-threads.ads b/translate/grt/grt-threads.ads
new file mode 100644
index 000000000..ada5d7e60
--- /dev/null
+++ b/translate/grt/grt-threads.ads
@@ -0,0 +1,20 @@
+-- GHDL Run Time (GRT) - threading.
+-- Copyright (C) 2005 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.
+with Grt.Unithread;
+
+package Grt.Threads renames Grt.Unithread;
diff --git a/translate/grt/grt-unithread.adb b/translate/grt/grt-unithread.adb
new file mode 100644
index 000000000..668e9b71f
--- /dev/null
+++ b/translate/grt/grt-unithread.adb
@@ -0,0 +1,107 @@
+-- GHDL Run Time (GRT) - mono-thread version.
+-- Copyright (C) 2005 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.
+with Grt.Types; use Grt.Types;
+
+package body Grt.Unithread is
+ procedure Init is
+ begin
+ null;
+ end Init;
+
+ procedure Finish is
+ begin
+ null;
+ end Finish;
+
+ procedure Run_Parallel (Subprg : Parallel_Subprg_Acc) is
+ begin
+ Subprg.all;
+ end Run_Parallel;
+
+ function Atomic_Insert (List : access Ghdl_Signal_Ptr; El : Ghdl_Signal_Ptr)
+ return Ghdl_Signal_Ptr
+ is
+ Prev : Ghdl_Signal_Ptr;
+ begin
+ Prev := List.all;
+ List.all := El;
+ return Prev;
+ end Atomic_Insert;
+
+ function Atomic_Inc (Val : access Natural) return Natural
+ is
+ Res : Natural;
+ begin
+ Res := Val.all;
+ Val.all := Val.all + 1;
+ return Res;
+ end Atomic_Inc;
+
+ Current_Process : Process_Acc;
+ Current_Process_Id : Process_Id;
+
+ -- Called by linux.c
+ function Grt_Get_Current_Process return Process_Acc;
+ pragma Export (C, Grt_Get_Current_Process);
+
+ function Grt_Get_Current_Process return Process_Acc is
+ begin
+ return Current_Process;
+ end Grt_Get_Current_Process;
+
+
+ procedure Set_Current_Process (Id : Process_Id; Proc : Process_Acc) is
+ begin
+ Current_Process := Proc;
+ Current_Process_Id := Id;
+ end Set_Current_Process;
+
+ function Get_Current_Process return Process_Acc is
+ begin
+ return Current_Process;
+ end Get_Current_Process;
+
+ function Get_Current_Process_Id return Process_Id is
+ begin
+ return Current_Process_Id;
+ end Get_Current_Process_Id;
+
+ Stack2 : Stack2_Ptr;
+
+ function Get_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;
+end Grt.Unithread;
diff --git a/translate/grt/grt-unithread.ads b/translate/grt/grt-unithread.ads
new file mode 100644
index 000000000..1dc371326
--- /dev/null
+++ b/translate/grt/grt-unithread.ads
@@ -0,0 +1,66 @@
+-- GHDL Run Time (GRT) - mono-thread version.
+-- Copyright (C) 2005 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.
+with System.Storage_Elements; -- Work around GNAT bug.
+with Grt.Signals; use Grt.Signals;
+with Grt.Stack2; use Grt.Stack2;
+with Grt.Stacks; use Grt.Stacks;
+with Grt.Types; use Grt.Types;
+with Grt.Processes; use Grt.Processes;
+
+package Grt.Unithread is
+ procedure Init;
+ procedure Finish;
+
+ type Parallel_Subprg_Acc is access procedure;
+ procedure Run_Parallel (Subprg : Parallel_Subprg_Acc);
+
+ -- Return the old value of LIST.all and store EL into LIST.all.
+ function Atomic_Insert (List : access Ghdl_Signal_Ptr; El : Ghdl_Signal_Ptr)
+ return Ghdl_Signal_Ptr;
+
+ -- Return the old value.
+ function Atomic_Inc (Val : access Natural) return Natural;
+
+ -- Set and get the current process being executed by the thread.
+ procedure Set_Current_Process (Id : Process_Id; Proc : Process_Acc);
+ function Get_Current_Process return Process_Acc;
+ function Get_Current_Process_Id return Process_Id;
+
+ -- The secondary stack for the thread.
+ 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);
+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_stack_set_main_stack");
+
+ pragma Inline (Set_Current_Process);
+ pragma Inline (Get_Current_Process);
+ pragma Inline (Get_Current_Process_Id);
+
+end Grt.Unithread;