diff options
Diffstat (limited to 'translate')
| -rwxr-xr-x | translate/gcc/dist.sh | 5 | ||||
| -rw-r--r-- | translate/grt/Makefile | 3 | ||||
| -rw-r--r-- | translate/grt/Makefile.inc | 8 | ||||
| -rw-r--r-- | translate/grt/config/ia64.S | 245 | ||||
| -rw-r--r-- | translate/grt/config/linux.c | 14 | ||||
| -rw-r--r-- | translate/grt/grt-main.adb | 4 | ||||
| -rw-r--r-- | translate/grt/grt-options.adb | 16 | ||||
| -rw-r--r-- | translate/grt/grt-options.ads | 7 | ||||
| -rw-r--r-- | translate/grt/grt-processes.adb | 276 | ||||
| -rw-r--r-- | translate/grt/grt-processes.ads | 67 | ||||
| -rw-r--r-- | translate/grt/grt-signals.adb | 11 | ||||
| -rw-r--r-- | translate/grt/grt-stacks.ads | 6 | ||||
| -rw-r--r-- | translate/grt/grt-stats.adb | 158 | ||||
| -rw-r--r-- | translate/grt/grt-stats.ads | 8 | ||||
| -rw-r--r-- | translate/grt/grt-threads.ads | 20 | ||||
| -rw-r--r-- | translate/grt/grt-unithread.adb | 107 | ||||
| -rw-r--r-- | translate/grt/grt-unithread.ads | 66 | ||||
| -rw-r--r-- | translate/translation.adb | 244 |
18 files changed, 859 insertions, 406 deletions
diff --git a/translate/gcc/dist.sh b/translate/gcc/dist.sh index e16475aad..dab7afbf0 100755 --- a/translate/gcc/dist.sh +++ b/translate/gcc/dist.sh @@ -346,6 +346,9 @@ grt-waves.ads grt-waves.adb grt-avls.ads grt-avls.adb +grt-unithread.ads +grt-unithread.adb +grt-threads.ads grt.ads main.adb main.ads @@ -610,7 +613,7 @@ put manual.html put more.html put links.html put bug.html -put waveform.html +put waveviewer.html put gtkwave-patch.tgz put favicon.ico lcd ghdl 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; diff --git a/translate/translation.adb b/translate/translation.adb index a0e63eef4..17c80f923 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -1995,12 +1995,12 @@ package body Translation is -- Get the offset in the range pointed by RANGE_PTR of INDEX. -- This checks INDEX belongs to the range. -- INDEX_TYPE is the subtype of the array index. - function Translate_Index_To_Offset (Range_Ptr : O_Dnode; + function Translate_Index_To_Offset (Rng : Mnode; Index : O_Enode; Index_Expr : Iir; Index_Type : Iir; Loc : Iir) - return O_Enode; + return O_Enode; end Chap6; package Chap7 is @@ -4277,15 +4277,13 @@ package body Translation is end; when Iir_Kind_Indexed_Name => declare - Range_Ptr : O_Dnode; + Rng : Mnode; begin Open_Temp; - Range_Ptr := Create_Temp_Ptr - (Type_Info.T.Range_Ptr_Type, - Get_Var (Get_Info (Iter_Type).T.Range_Var)); + Rng := Stabilize (Chap3.Type_To_Range (Iter_Type)); Gen_Subblock_Call (Chap6.Translate_Index_To_Offset - (Range_Ptr, + (Rng, Chap7.Translate_Expression (Get_Nth_Element (Get_Index_List (Spec), 0), Iter_Type), @@ -4295,7 +4293,7 @@ package body Translation is end; when Iir_Kind_Slice_Name => declare - Range_Ptr : O_Dnode; + Rng : Mnode; Slice : O_Dnode; Slice_Ptr : O_Dnode; Left, Right : O_Dnode; @@ -4305,9 +4303,7 @@ package body Translation is Label : O_Snode; begin Open_Temp; - Range_Ptr := Create_Temp_Ptr - (Type_Info.T.Range_Ptr_Type, - Get_Var (Get_Info (Iter_Type).T.Range_Var)); + Rng := Stabilize (Chap3.Type_To_Range (Iter_Type)); Slice := Create_Temp (Type_Info.T.Range_Type); Slice_Ptr := Create_Temp_Ptr (Type_Info.T.Range_Ptr_Type, New_Obj (Slice)); @@ -4316,14 +4312,14 @@ package body Translation is Left := Create_Temp_Init (Ghdl_Index_Type, Chap6.Translate_Index_To_Offset - (Range_Ptr, + (Rng, New_Value (New_Selected_Element (New_Obj (Slice), Type_Info.T.Range_Left)), Spec, Iter_Type, Spec)); Right := Create_Temp_Init (Ghdl_Index_Type, Chap6.Translate_Index_To_Offset - (Range_Ptr, + (Rng, New_Value (New_Selected_Element (New_Obj (Slice), Type_Info.T.Range_Right)), @@ -4333,9 +4329,7 @@ package body Translation is Start_If_Stmt (If_Blk, New_Compare_Op (ON_Eq, - New_Value_Selected_Acc_Value - (New_Obj (Range_Ptr), - Type_Info.T.Range_Dir), + M2E (Chap3.Range_To_Dir (Rng)), New_Value (New_Selected_Element (New_Obj (Slice), @@ -12048,17 +12042,20 @@ package body Translation is is Rng : Iir; begin + -- Do checks if type of the expression is not a subtype. + if Expr_Type = Null_Iir -- FIXME: to be removed (generate stmt) + or else + Get_Kind (Expr_Type) not in Iir_Kinds_Discrete_Subtype_Definition + then + return True; + end if; + -- No check if the expression has the type of the index. if Expr_Type = Rng_Type then return False; end if; -- No check for 'Range or 'Reverse_Range. - if Get_Kind (Expr_Type) not in Iir_Kinds_Discrete_Subtype_Definition - then - return True; - end if; - Rng := Get_Range_Constraint (Expr_Type); if (Get_Kind (Rng) = Iir_Kind_Range_Array_Attribute or Get_Kind (Rng) = Iir_Kind_Reverse_Range_Array_Attribute) @@ -12070,42 +12067,174 @@ package body Translation is return True; end Need_Index_Check; + procedure Get_Deep_Range_Expression + (Atype : Iir; Rng : out Iir; Is_Reverse : out Boolean) + is + T : Iir; + R : Iir; + begin + Is_Reverse := False; + + -- T is an integer/enumeration subtype. + T := Atype; + loop + if Get_Kind (T) not in Iir_Kinds_Discrete_Subtype_Definition then + Error_Kind ("get_deep_range_expression(1)", T); + end if; - function Translate_Index_To_Offset (Range_Ptr : O_Dnode; + R := Get_Range_Constraint (T); + case Get_Kind (R) is + when Iir_Kind_Range_Expression => + Rng := R; + return; + when Iir_Kind_Range_Array_Attribute => + null; + when Iir_Kind_Reverse_Range_Array_Attribute => + Is_Reverse := not Is_Reverse; + when others => + Error_Kind ("get_deep_range_expression(2)", R); + end case; + T := Get_Index_Subtype (R); + if T = Null_Iir then + Rng := Null_Iir; + return; + end if; + end loop; + end Get_Deep_Range_Expression; + + function Translate_Index_To_Offset (Rng : Mnode; Index : O_Enode; Index_Expr : Iir; Index_Type : Iir; Loc : Iir) - return O_Enode + return O_Enode is + Need_Check : Boolean; Dir : O_Enode; If_Blk : O_If_Block; Res : O_Dnode; Off : O_Dnode; + Bound : O_Enode; Cond1, Cond2: O_Enode; Index_Node : O_Dnode; Bound_Node : O_Dnode; Index_Info : Type_Info_Acc; + Deep_Rng : Iir; + Deep_Reverse : Boolean; begin Index_Info := Get_Info (Get_Base_Type (Index_Type)); + Need_Check := Need_Index_Check (Get_Type (Index_Expr), Index_Type); + Get_Deep_Range_Expression (Index_Type, Deep_Rng, Deep_Reverse); Res := Create_Temp (Ghdl_Index_Type); Open_Temp; + Off := Create_Temp (Index_Info.Ortho_Type (Mode_Value)); + + Bound := M2E (Chap3.Range_To_Left (Rng)); + + if Deep_Rng /= Null_Iir then + if Get_Direction (Deep_Rng) = Iir_To xor Deep_Reverse then + -- Direction TO: INDEX - LEFT. + New_Assign_Stmt (New_Obj (Off), + New_Dyadic_Op (ON_Sub_Ov, + Index, Bound)); + else + -- Direction DOWNTO: LEFT - INDEX. + New_Assign_Stmt (New_Obj (Off), + New_Dyadic_Op (ON_Sub_Ov, + Bound, Index)); + end if; + else + Index_Node := Create_Temp_Init + (Index_Info.Ortho_Type (Mode_Value), Index); + Bound_Node := Create_Temp_Init + (Index_Info.Ortho_Type (Mode_Value), Bound); + Dir := M2E (Chap3.Range_To_Dir (Rng)); + + -- Non-static direction. + Start_If_Stmt (If_Blk, + New_Compare_Op (ON_Eq, Dir, + New_Lit (Ghdl_Dir_To_Node), + Ghdl_Bool_Type)); + -- Direction TO: INDEX - LEFT. + New_Assign_Stmt (New_Obj (Off), + New_Dyadic_Op (ON_Sub_Ov, + New_Obj_Value (Index_Node), + New_Obj_Value (Bound_Node))); + New_Else_Stmt (If_Blk); + -- Direction DOWNTO: LEFT - INDEX. + New_Assign_Stmt (New_Obj (Off), + New_Dyadic_Op (ON_Sub_Ov, + New_Obj_Value (Bound_Node), + New_Obj_Value (Index_Node))); + Finish_If_Stmt (If_Blk); + end if; + + -- Get the offset. + New_Assign_Stmt + (New_Obj (Res), New_Convert_Ov (New_Obj_Value (Off), + Ghdl_Index_Type)); + + -- Check bounds. + if Need_Check then + Cond1 := New_Compare_Op + (ON_Lt, + New_Obj_Value (Off), + New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value), + 0)), + Ghdl_Bool_Type); + + Cond2 := New_Compare_Op + (ON_Ge, + New_Obj_Value (Res), + M2E (Chap3.Range_To_Length (Rng)), + Ghdl_Bool_Type); + Check_Bound_Error (New_Dyadic_Op (ON_Or, Cond1, Cond2), Loc, 0); + end if; + + Close_Temp; + + return New_Obj_Value (Res); + end Translate_Index_To_Offset; + + function Translate_Fat_Index_To_Offset (Rng : Mnode; + Index : O_Enode; + Index_Type : Iir; + Loc : Iir) + return O_Enode + is + Dir : O_Enode; + If_Blk : O_If_Block; + Res : O_Dnode; + Off : O_Dnode; + Bound : O_Enode; + Cond1, Cond2: O_Enode; + Index_Node : O_Dnode; + Bound_Node : O_Dnode; + Index_Info : Type_Info_Acc; + begin + Index_Info := Get_Info (Get_Base_Type (Index_Type)); + + Res := Create_Temp (Ghdl_Index_Type); + + Open_Temp; + + Off := Create_Temp (Index_Info.Ortho_Type (Mode_Value)); + + Bound := M2E (Chap3.Range_To_Left (Rng)); + Index_Node := Create_Temp_Init (Index_Info.Ortho_Type (Mode_Value), Index); Bound_Node := Create_Temp_Init - (Index_Info.Ortho_Type (Mode_Value), - New_Value_Selected_Acc_Value (New_Obj (Range_Ptr), - Index_Info.T.Range_Left)); - Off := Create_Temp (Index_Info.Ortho_Type (Mode_Value)); - - Dir := New_Value_Selected_Acc_Value (New_Obj (Range_Ptr), - Index_Info.T.Range_Dir); + (Index_Info.Ortho_Type (Mode_Value), Bound); + Dir := M2E (Chap3.Range_To_Dir (Rng)); + -- Non-static direction. Start_If_Stmt (If_Blk, - New_Compare_Op (ON_Eq, Dir, New_Lit (Ghdl_Dir_To_Node), + New_Compare_Op (ON_Eq, Dir, + New_Lit (Ghdl_Dir_To_Node), Ghdl_Bool_Type)); -- Direction TO: INDEX - LEFT. New_Assign_Stmt (New_Obj (Off), @@ -12126,27 +12255,24 @@ package body Translation is Ghdl_Index_Type)); -- Check bounds. - if Need_Index_Check (Get_Type (Index_Expr), Index_Type) then - Cond1 := New_Compare_Op - (ON_Lt, - New_Obj_Value (Off), - New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value), - 0)), - Ghdl_Bool_Type); - - Cond2 := New_Compare_Op - (ON_Ge, - New_Obj_Value (Res), - New_Value_Selected_Acc_Value (New_Obj (Range_Ptr), - Index_Info.T.Range_Length), - Ghdl_Bool_Type); - Check_Bound_Error (New_Dyadic_Op (ON_Or, Cond1, Cond2), Loc, 0); - end if; + Cond1 := New_Compare_Op + (ON_Lt, + New_Obj_Value (Off), + New_Lit (New_Signed_Literal (Index_Info.Ortho_Type (Mode_Value), + 0)), + Ghdl_Bool_Type); + + Cond2 := New_Compare_Op + (ON_Ge, + New_Obj_Value (Res), + M2E (Chap3.Range_To_Length (Rng)), + Ghdl_Bool_Type); + Check_Bound_Error (New_Dyadic_Op (ON_Or, Cond1, Cond2), Loc, 0); Close_Temp; return New_Obj_Value (Res); - end Translate_Index_To_Offset; + end Translate_Fat_Index_To_Offset; -- Translate index EXPR in dimension DIM of thin array into an -- offset. @@ -12262,23 +12388,21 @@ package body Translation is -- Compute index for the current dimension. case Prefix_Info.Type_Mode is when Type_Mode_Fat_Array => - Range_Ptr := Chap3.Get_Array_Range - (Prefix, Prefix_Type, Dim); + Range_Ptr := Stabilize + (Chap3.Get_Array_Range (Prefix, Prefix_Type, Dim)); + R := Translate_Fat_Index_To_Offset + (Range_Ptr, + Chap7.Translate_Expression (Index, Ibasetype), + Itype, Index); when Type_Mode_Ptr_Array => + -- Manually extract range since there is no infos for + -- index subtype. Range_Ptr := Chap3.Bounds_To_Range (Chap3.Get_Array_Type_Bounds (Prefix_Type), Prefix_Type, Dim); - when Type_Mode_Array => - null; - when others => - raise Internal_Error; - end case; - case Prefix_Info.Type_Mode is - when Type_Mode_Fat_Array - | Type_Mode_Ptr_Array => - Range_Ptr := Stabilize (Range_Ptr); + Stabilize (Range_Ptr); R := Translate_Index_To_Offset - (M2Dp (Range_Ptr), + (Range_Ptr, Chap7.Translate_Expression (Index, Ibasetype), Index, Itype, Index); when Type_Mode_Array => |