diff options
| -rw-r--r-- | bug.adb | 27 | ||||
| -rw-r--r-- | iirs.adb | 14 | ||||
| -rw-r--r-- | iirs.ads | 17 | ||||
| -rw-r--r-- | libraries/std/textio_body.vhdl | 6 | ||||
| -rw-r--r-- | sem_names.adb | 2 | ||||
| -rw-r--r-- | translate/ghdldrv/Makefile | 2 | ||||
| -rw-r--r-- | translate/grt/Makefile.inc | 16 | ||||
| -rw-r--r-- | translate/grt/config/ia64.S | 4 | ||||
| -rw-r--r-- | translate/grt/config/linux.c | 20 | ||||
| -rw-r--r-- | translate/grt/ghwlib.c | 12 | ||||
| -rw-r--r-- | translate/grt/ghwlib.h | 8 | ||||
| -rw-r--r-- | translate/grt/grt-astdio.adb | 32 | ||||
| -rw-r--r-- | translate/grt/grt-astdio.ads | 2 | ||||
| -rw-r--r-- | translate/grt/grt-processes.adb | 69 | ||||
| -rw-r--r-- | translate/grt/grt-processes.ads | 20 | ||||
| -rw-r--r-- | translate/grt/grt-signals.adb | 39 | ||||
| -rw-r--r-- | translate/grt/grt-unithread.ads | 2 | ||||
| -rw-r--r-- | translate/grt/grt-vcd.adb | 2 | ||||
| -rw-r--r-- | translate/grt/grt-vpi.adb | 12 | ||||
| -rw-r--r-- | translate/grt/grt-waves.adb | 5 | ||||
| -rw-r--r-- | translate/grt/grt.adc | 3 | ||||
| -rw-r--r-- | translate/grt/grt.ver | 25 | ||||
| -rw-r--r-- | translate/translation.adb | 260 |
23 files changed, 337 insertions, 262 deletions
@@ -30,12 +30,31 @@ package body Bug is GNAT_Version : constant String (1 .. 31 + 15); pragma Import (C, GNAT_Version, "__gnat_version"); - function Get_Gnat_Version return String is + function Get_Gnat_Version return String + is + C : Character; begin for I in GNAT_Version'Range loop - if GNAT_Version (I) = ')' then - return GNAT_Version (1 .. I); - end if; + C := GNAT_Version (I); + case C is + when ' ' + | 'A' .. 'Z' + | 'a' .. 'z' + | '0' .. '9' + | ':' + | '-' + | '.' + | '(' => + -- Accept only a few printable characters. + -- Underscore is excluded since the next bytes after + -- GNAT_Version is Ada_Main_Program_Name, which often starts + -- with _ada_. + null; + when ')' => + return GNAT_Version (1 .. I); + when others => + return GNAT_Version (1 .. I - 1); + end case; end loop; return GNAT_Version; end Get_Gnat_Version; @@ -358,8 +358,8 @@ package body Iirs is | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Integer_Type_Definition | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition | Iir_Kind_Floating_Type_Definition | Iir_Kind_Physical_Type_Definition | Iir_Kind_Range_Expression @@ -3128,8 +3128,8 @@ package body Iirs is | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Integer_Type_Definition | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition | Iir_Kind_Floating_Type_Definition | Iir_Kind_Physical_Type_Definition => null; @@ -3562,8 +3562,8 @@ package body Iirs is | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Integer_Type_Definition | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition | Iir_Kind_Floating_Type_Definition | Iir_Kind_Physical_Type_Definition => null; @@ -3653,8 +3653,8 @@ package body Iirs is | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Integer_Type_Definition | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition | Iir_Kind_Floating_Type_Definition | Iir_Kind_Physical_Type_Definition => null; @@ -4243,8 +4243,8 @@ package body Iirs is | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Integer_Type_Definition | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition | Iir_Kind_Floating_Type_Definition | Iir_Kind_Physical_Type_Definition => null; @@ -4283,8 +4283,8 @@ package body Iirs is | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Integer_Type_Definition | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition | Iir_Kind_Floating_Type_Definition | Iir_Kind_Physical_Type_Definition => null; @@ -4319,8 +4319,8 @@ package body Iirs is | Iir_Kind_Floating_Subtype_Definition | Iir_Kind_Integer_Subtype_Definition | Iir_Kind_Enumeration_Subtype_Definition - | Iir_Kind_Integer_Type_Definition | Iir_Kind_Enumeration_Type_Definition + | Iir_Kind_Integer_Type_Definition | Iir_Kind_Floating_Type_Definition | Iir_Kind_Physical_Type_Definition => null; @@ -2505,8 +2505,8 @@ package Iirs is Iir_Kind_Floating_Subtype_Definition, -- scalar, st Iir_Kind_Integer_Subtype_Definition, -- scalar, disc, st Iir_Kind_Enumeration_Subtype_Definition, -- scalar, disc, st - Iir_Kind_Integer_Type_Definition, -- scalar, disc Iir_Kind_Enumeration_Type_Definition, -- scalar, disc + Iir_Kind_Integer_Type_Definition, -- scalar, disc Iir_Kind_Floating_Type_Definition, -- scalar Iir_Kind_Physical_Type_Definition, -- scalar Iir_Kind_Range_Expression, @@ -3024,8 +3024,8 @@ package Iirs is --Iir_Kind_Floating_Subtype_Definition --Iir_Kind_Integer_Subtype_Definition --Iir_Kind_Enumeration_Subtype_Definition - --Iir_Kind_Integer_Type_Definition --Iir_Kind_Enumeration_Type_Definition + --Iir_Kind_Integer_Type_Definition --Iir_Kind_Floating_Type_Definition Iir_Kind_Physical_Type_Definition; @@ -3044,20 +3044,21 @@ package Iirs is --Iir_Kind_Floating_Subtype_Definition --Iir_Kind_Integer_Subtype_Definition --Iir_Kind_Enumeration_Subtype_Definition - --Iir_Kind_Integer_Type_Definition --Iir_Kind_Enumeration_Type_Definition + --Iir_Kind_Integer_Type_Definition --Iir_Kind_Floating_Type_Definition Iir_Kind_Physical_Type_Definition; subtype Iir_Kinds_Discrete_Type_Definition is Iir_Kind range Iir_Kind_Integer_Subtype_Definition .. --Iir_Kind_Enumeration_Subtype_Definition - --Iir_Kind_Integer_Type_Definition - Iir_Kind_Enumeration_Type_Definition; + --Iir_Kind_Enumeration_Type_Definition + Iir_Kind_Integer_Type_Definition; - subtype Iir_Kinds_Discrete_Subtype_Definition is Iir_Kind range - Iir_Kind_Integer_Subtype_Definition .. - Iir_Kind_Enumeration_Subtype_Definition; + +-- subtype Iir_Kinds_Discrete_Subtype_Definition is Iir_Kind range +-- Iir_Kind_Integer_Subtype_Definition .. +-- Iir_Kind_Enumeration_Subtype_Definition; subtype Iir_Kinds_Composite_Type_Definition is Iir_Kind range Iir_Kind_Record_Type_Definition .. diff --git a/libraries/std/textio_body.vhdl b/libraries/std/textio_body.vhdl index 0362ef61a..cf81036a9 100644 --- a/libraries/std/textio_body.vhdl +++ b/libraries/std/textio_body.vhdl @@ -453,12 +453,16 @@ package body textio is loop untruncated_text_read (f, str, len); exit when len = 0; - if str (len) = LF then + if str (len) = LF or str (len) = CR then -- LRM 14.3 -- The representation of the line does not contain the representation -- of the end of the line. is_eol := true; len := len - 1; + -- End of line is any of LF/CR/CR+LF/LF+CR. + if len > 0 and (str (len) = LF or str (len) = CR) then + len := len - 1; + end if; else is_eol := false; end if; diff --git a/sem_names.adb b/sem_names.adb index 0e36aba86..10df0d4f4 100644 --- a/sem_names.adb +++ b/sem_names.adb @@ -823,6 +823,8 @@ package body Sem_Names is raise Internal_Error; end case; if Parameter = Null_Iir then + Set_Parameter (Attr, Param); + Set_Expr_Staticness (Attr, None); return; end if; Set_Parameter (Attr, Parameter); diff --git a/translate/ghdldrv/Makefile b/translate/ghdldrv/Makefile index 467794c8f..e9b38f469 100644 --- a/translate/ghdldrv/Makefile +++ b/translate/ghdldrv/Makefile @@ -36,7 +36,7 @@ GRTSRCDIR=../grt include $(GRTSRCDIR)/Makefile.inc ghdl_mcode: default_pathes.ads $(GRT_ADD_OBJS) mmap_binding.o force - gnatmake -aI../../ortho/mcode $(GNATFLAGS) ghdl_mcode $(GNAT_BARGS) -largs mmap_binding.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(GRT_EXTRA_LIB) + gnatmake -aI../../ortho/mcode $(GNATFLAGS) ghdl_mcode $(GNAT_BARGS) -largs mmap_binding.o $(GNAT_LARGS) $(GRT_ADD_OBJS) $(GRT_EXTRA_LIB) -Wl,--version-script=$(GRTSRCDIR)/grt.ver -Wl,--export-dynamic mmap_binding.o: ../../ortho/mcode/mmap_binding.c $(CC) -c -g -o $@ $< diff --git a/translate/grt/Makefile.inc b/translate/grt/Makefile.inc index 02fa8d943..e5643bdfb 100644 --- a/translate/grt/Makefile.inc +++ b/translate/grt/Makefile.inc @@ -75,7 +75,15 @@ ifndef GRT_TARGET_OBJS endif # Additionnal object files (C or asm files). -GRT_ADD_OBJS=$(GRT_TARGET_OBJS) grt-cbinding.o grt-cvpi.o +GRT_ADD_OBJS:=$(GRT_TARGET_OBJS) grt-cbinding.o grt-cvpi.o + +#GRT_USE_PTHREADS=y +ifeq ($(GRT_USE_PTHREADS),y) + GRT_ADD_OBJS+=grt-cthreads.o + GRT_EXTRA_LIB+=-lpthread +endif + +GRT_ARCH?=None # Configuration pragmas. GRT_PRAGMA_FLAG=-gnatec$(GRTSRCDIR)/grt.adc @@ -85,7 +93,7 @@ GRT_ADACOMPILE=$(ADAC) -c $(GRT_FLAGS) $(GRT_PRAGMA_FLAG) -o $@ $< grt-all: libgrt.a grt.lst -libgrt.a: $(GRT_ADD_OBJS) run-bind.o main.o grt-files +libgrt.a: grt-arch.ads $(GRT_ADD_OBJS) run-bind.o main.o grt-files $(RM) -f $@ $(AR) rcv $@ `sed -e "/^-/d" < grt-files` $(GRT_ADD_OBJS) \ run-bind.o main.o @@ -145,6 +153,10 @@ grt-files: run-bind.adb sed -e "1,/-- *BEGIN/d" -e "/-- *END/,\$$d" \ -e "s/ -- //" < $< > $@ +grt-arch.ads: + echo "With Grt.Arch_$(GRT_ARCH);" > $@ + echo "Package Grt.Arch renames Grt.Arch_$(GRT_ARCH);" >> $@ + # Remove local files (they are now in the libgrt library). # Also, remove the -shared option, in order not to build a shared library # instead of an executable. diff --git a/translate/grt/config/ia64.S b/translate/grt/config/ia64.S index d7fb2d19a..34df82e0c 100644 --- a/translate/grt/config/ia64.S +++ b/translate/grt/config/ia64.S @@ -32,7 +32,7 @@ grt_stack_switch: { alloc r31=ar.pfs, 2, 0, 0, 0 mov r14 = ar.rsc - adds r12 = -(frame_size + 16), r12 + adds r12 = -frame_size, r12 .body ;; } @@ -227,7 +227,7 @@ grt_stack_switch: ldf.fill f30 = [r20], 32 // sp + 448 (f30) ;; ldf.fill f31 = [r21], 32 // sp + 464 (f31) - adds r12 = 16, r20 + mov r12 = r20 br.ret.sptk.many b0 ;; .endp grt_stack_switch# diff --git a/translate/grt/config/linux.c b/translate/grt/config/linux.c index 38641b67f..ab999c0a3 100644 --- a/translate/grt/config/linux.c +++ b/translate/grt/config/linux.c @@ -62,11 +62,6 @@ struct stack_context size_t cur_length; }; -/* Context for the main stack. */ -static struct stack_context main_stack_context; - -extern void grt_stack_set_main_stack (struct stack_context *stack); - /* If MAP_ANONYMOUS is not defined, use /dev/zero. */ #ifndef MAP_ANONYMOUS #define USE_DEV_ZERO @@ -193,6 +188,19 @@ static void grt_signal_setup (void) } #endif +/* Context for the main stack. */ +static __thread struct stack_context main_stack_context; + +extern void grt_set_main_stack (struct stack_context *stack); + +void +grt_stack_new_thread (void) +{ + main_stack_context.cur_sp = NULL; + main_stack_context.cur_length = 0; + grt_set_main_stack (&main_stack_context); +} + void grt_stack_init (void) { @@ -214,7 +222,7 @@ grt_stack_init (void) /* Initialize the main stack context. */ main_stack_context.cur_sp = NULL; main_stack_context.cur_length = 0; - grt_stack_set_main_stack (&main_stack_context); + grt_set_main_stack (&main_stack_context); #ifdef USE_DEV_ZERO dev_zero_fd = open ("/dev/zero", O_RDWR); diff --git a/translate/grt/ghwlib.c b/translate/grt/ghwlib.c index 984729246..e9b23e73b 100644 --- a/translate/grt/ghwlib.c +++ b/translate/grt/ghwlib.c @@ -225,6 +225,18 @@ ghw_read_range (struct ghw_handler *h) return NULL; switch (t & 0x7f) { + case ghdl_rtik_type_b2: + { + struct ghw_range_b2 *r; + r = malloc (sizeof (struct ghw_range_b2)); + r->kind = t & 0x7f; + r->dir = (t & 0x80) != 0; + if (ghw_read_byte (h, &r->left) != 0) + return NULL; + if (ghw_read_byte (h, &r->right) != 0) + return NULL; + return (union ghw_range *)r; + } case ghdl_rtik_type_e8: { struct ghw_range_e8 *r; diff --git a/translate/grt/ghwlib.h b/translate/grt/ghwlib.h index 500dd6e9f..93fb15329 100644 --- a/translate/grt/ghwlib.h +++ b/translate/grt/ghwlib.h @@ -83,6 +83,14 @@ enum ghw_wkt_type { ghw_wkt_std_ulogic }; +struct ghw_range_b2 +{ + enum ghdl_rtik kind : 8; + int dir : 8; /* 0: to, !0: downto. */ + unsigned char left; + unsigned char right; +}; + struct ghw_range_e8 { enum ghdl_rtik kind : 8; diff --git a/translate/grt/grt-astdio.adb b/translate/grt/grt-astdio.adb index de28094d1..ea1b4713f 100644 --- a/translate/grt/grt-astdio.adb +++ b/translate/grt/grt-astdio.adb @@ -95,7 +95,7 @@ package body Grt.Astdio is end if; end Put_Str_Len; - generic + generic type Ntype is range <>; Max_Len : Natural; procedure Put_Ntype (Stream : FILEs; N : Ntype); @@ -106,13 +106,14 @@ package body Grt.Astdio is P : Natural := Str'Last; V : Ntype; begin + -- V is negativ. if N > 0 then V := -N; else V := N; end if; loop - Str (P) := Character'Val (48 - (V rem 10)); + Str (P) := Character'Val (48 - (V rem 10)); -- V is <= 0. V := V / 10; exit when V = 0; P := P - 1; @@ -124,13 +125,38 @@ package body Grt.Astdio is Put (Stream, Str (P .. Max_Len)); end Put_Ntype; - procedure Put_I32_1 is new Put_Ntype (Ntype => Ghdl_I32, Max_Len => 11); + generic + type Utype is mod <>; + Max_Len : Natural; + procedure Put_Utype (Stream : FILEs; N : Utype); + + procedure Put_Utype (Stream : FILEs; N : Utype) + is + Str : String (1 .. Max_Len); + P : Natural := Str'Last; + V : Utype := N; + begin + loop + Str (P) := Character'Val (48 + (V rem 10)); + V := V / 10; + exit when V = 0; + P := P - 1; + end loop; + Put (Stream, Str (P .. Max_Len)); + end Put_Utype; + procedure Put_I32_1 is new Put_Ntype (Ntype => Ghdl_I32, Max_Len => 11); procedure Put_I32 (Stream : FILEs; I32 : Ghdl_I32) renames Put_I32_1; + procedure Put_U32_1 is new Put_Utype (Utype => Ghdl_U32, Max_Len => 11); + procedure Put_U32 (Stream : FILEs; U32 : Ghdl_U32) renames Put_U32_1; + procedure Put_I64_1 is new Put_Ntype (Ntype => Ghdl_I64, Max_Len => 20); procedure Put_I64 (Stream : FILEs; I64 : Ghdl_I64) renames Put_I64_1; + procedure Put_U64_1 is new Put_Utype (Utype => Ghdl_U64, Max_Len => 20); + procedure Put_U64 (Stream : FILEs; U64 : Ghdl_U64) renames Put_U64_1; + procedure Put_F64 (Stream : FILEs; F64 : Ghdl_F64) is procedure fprintf (Stream : FILEs; diff --git a/translate/grt/grt-astdio.ads b/translate/grt/grt-astdio.ads index 0791a1075..87a7feb68 100644 --- a/translate/grt/grt-astdio.ads +++ b/translate/grt/grt-astdio.ads @@ -25,7 +25,9 @@ package Grt.Astdio is -- Procedures to disp on STREAM. procedure Put (Stream : FILEs; Str : String); procedure Put_I32 (Stream : FILEs; I32 : Ghdl_I32); + procedure Put_U32 (Stream : FILEs; U32 : Ghdl_U32); procedure Put_I64 (Stream : FILEs; I64 : Ghdl_I64); + procedure Put_U64 (Stream : FILEs; U64 : Ghdl_U64); procedure Put_F64 (Stream : FILEs; F64 : Ghdl_F64); procedure Put (Stream : FILEs; Addr : System.Address); procedure Put (Stream : FILEs; Str : Ghdl_C_String); diff --git a/translate/grt/grt-processes.adb b/translate/grt/grt-processes.adb index 1bb0be854..a4cf3189d 100644 --- a/translate/grt/grt-processes.adb +++ b/translate/grt/grt-processes.adb @@ -15,7 +15,6 @@ -- 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 GNAT.Table; with Ada.Unchecked_Conversion; with Ada.Unchecked_Deallocation; with System.Storage_Elements; -- Work around GNAT bug. @@ -33,18 +32,11 @@ with Grt.Disp_Signals; with Grt.Stdio; with Grt.Stats; with Grt.Threads; use Grt.Threads; +with Grt.Arch; package body Grt.Processes is Last_Time : constant Std_Time := Std_Time'Last; - -- Table of processes. - package Process_Table is new GNAT.Table - (Table_Component_Type => Process_Type, - Table_Index_Type => Process_Id, - Table_Low_Bound => 1, - Table_Initial => 16, - Table_Increment => 100); - -- List of non_sensitized processes. package Non_Sensitized_Process_Table is new GNAT.Table (Table_Component_Type => Process_Id, @@ -124,7 +116,9 @@ package body Grt.Processes is Postponed => Postponed, State => State, Timeout => Bad_Time, - Stack => Stack); + Stack => Stack, + Stats_Time => 0, + Stats_Run => 0); -- Used to create drivers. Set_Current_Process (Process_Table.Last, null); @@ -195,7 +189,9 @@ package body Grt.Processes is Timeout => Bad_Time, Subprg => To_Proc_Acc (Proc), This => This, - Stack => Null_Stack); + Stack => Null_Stack, + Stats_Time => 0, + Stats_Run => 0); -- Used to create drivers. Set_Current_Process (Process_Table.Last, null); end Verilog_Process_Register; @@ -507,13 +503,12 @@ package body Grt.Processes is loop -- Atomically get a process to be executed Idx := Grt.Threads.Atomic_Inc (Mt_Index'Access); - if Idx > Mt_Last then - return; - end if; + exit when Idx > Mt_Last; Pid := Mt_Table (Idx); declare Proc : Process_Type renames Process_Table.Table (Pid); + Ts_Start, Ts_End : Ghdl_U64; begin if Grt.Options.Trace_Processes then Grt.Astdio.Put ("run process "); @@ -527,6 +522,7 @@ package body Grt.Processes is Internal_Error ("run non-resumed process"); end if; Proc.Resumed := False; + Ts_Start := Grt.Arch.Get_Time_Stamp; Set_Current_Process (Pid, To_Acc (Process_Table.Table (Pid)'Address)); if Proc.State = State_Sensitized then @@ -534,6 +530,9 @@ package body Grt.Processes is else Stack_Switch (Proc.Stack, Get_Main_Stack); end if; + Ts_End := Grt.Arch.Get_Time_Stamp; + Proc.Stats_Time := Proc.Stats_Time + (Ts_End - Ts_Start); + Proc.Stats_Run := Proc.Stats_Run + 1; if Grt.Options.Checks then Ghdl_Signal_Internal_Checks; Grt.Stack2.Check_Empty (Get_Stack2); @@ -544,60 +543,28 @@ package body Grt.Processes is 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; + Mt_Index := 1; if Postponed then - Table := Postponed_Resume_Process_Table; + Mt_Table := Postponed_Resume_Process_Table; Last := Last_Postponed_Resume_Process; Last_Postponed_Resume_Process := 0; else - Table := Resume_Process_Table; + Mt_Table := Resume_Process_Table; Last := Last_Resume_Process; Last_Resume_Process := 0; end if; Nbr_Resumed_Processes := Nbr_Resumed_Processes + Last; + Mt_Last := Last; 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; + Run_Processes_Threads; else - Mt_Last := Last; - Mt_Table := Table; - Mt_Index := 1; Threads.Run_Parallel (Run_Processes_Threads'Access); end if; diff --git a/translate/grt/grt-processes.ads b/translate/grt/grt-processes.ads index 2ef0653c5..777b9ddfc 100644 --- a/translate/grt/grt-processes.ads +++ b/translate/grt/grt-processes.ads @@ -16,6 +16,7 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with System; +with GNAT.Table; with Grt.Stack2; use Grt.Stack2; with Grt.Types; use Grt.Types; with Grt.Signals; use Grt.Signals; @@ -118,10 +119,7 @@ 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. + -- Access to a process subprogram. type Proc_Acc is access procedure (Self : System.Address); -- Simply linked list for sensitivity. @@ -180,8 +178,22 @@ private -- Sensitivity list. Sensitivity : Sensitivity_Acc; + + Stats_Time : Ghdl_U64; + Stats_Run : Ghdl_U32; end record; + type Process_Acc is access all Process_Type; + + -- Table of processes. + package Process_Table is new GNAT.Table + (Table_Component_Type => Process_Type, + Table_Index_Type => Process_Id, + Table_Low_Bound => 1, + Table_Initial => 16, + Table_Increment => 100); +private + 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 e0376c2ab..520fbe46f 100644 --- a/translate/grt/grt-signals.adb +++ b/translate/grt/grt-signals.adb @@ -1023,24 +1023,29 @@ package body Grt.Signals is Sig := Sig_Table.Table (I); -- Check drivers. - for J in 1 .. Sig.S.Nbr_Drivers loop - declare - Trans : Transaction_Acc; - begin - Trans := Sig.S.Drivers (J - 1).First_Trans; - while Trans.Next /= null loop - if Trans.Next.Time < Trans.Time then - Internal_Error ("ghdl_signal_internal_checks: " - & "bad transaction order"); - end if; - Trans := Trans.Next; + case Sig.S.Mode_Sig is + when Mode_Signal_User => + for J in 1 .. Sig.S.Nbr_Drivers loop + declare + Trans : Transaction_Acc; + begin + Trans := Sig.S.Drivers (J - 1).First_Trans; + while Trans.Next /= null loop + if Trans.Next.Time < Trans.Time then + Internal_Error ("ghdl_signal_internal_checks: " + & "bad transaction order"); + end if; + Trans := Trans.Next; + end loop; + if Trans /= Sig.S.Drivers (J - 1).Last_Trans then + Internal_Error ("ghdl_signal_internal_checks: " + & "last transaction mismatch"); + end if; + end; end loop; - if Trans /= Sig.S.Drivers (J - 1).Last_Trans then - Internal_Error ("ghdl_signal_internal_checks: " - & "last transaction mismatch"); - end if; - end; - end loop; + when others => + null; + end case; end loop; end Ghdl_Signal_Internal_Checks; diff --git a/translate/grt/grt-unithread.ads b/translate/grt/grt-unithread.ads index 1dc371326..2f244e643 100644 --- a/translate/grt/grt-unithread.ads +++ b/translate/grt/grt-unithread.ads @@ -57,7 +57,7 @@ private pragma Inline (Set_Stack2); pragma Inline (Get_Main_Stack); - pragma Export (C, Set_Main_Stack, "grt_stack_set_main_stack"); + pragma Export (C, Set_Main_Stack, "grt_set_main_stack"); pragma Inline (Set_Current_Process); pragma Inline (Get_Current_Process); diff --git a/translate/grt/grt-vcd.adb b/translate/grt/grt-vcd.adb index e2419cd2e..f7aa0d8d0 100644 --- a/translate/grt/grt-vcd.adb +++ b/translate/grt/grt-vcd.adb @@ -590,6 +590,7 @@ package body Grt.Vcd is when Vcd_Integer32 => Vcd_Putc ('b'); Vcd_Put_Integer32 (To_Signal_Arr_Ptr (Addr)(0).Value.E32); + Vcd_Putc (' '); when Vcd_Bitvector => Vcd_Putc ('b'); for J in 0 .. Len - 1 loop @@ -618,6 +619,7 @@ package body Grt.Vcd is Vcd_Putc ('b'); Vcd_Put_Integer32 (To_Signal_Arr_Ptr (Addr)(0).Driving_Value.E32); + Vcd_Putc (' '); when Vcd_Bitvector => Vcd_Putc ('b'); for J in 0 .. Len - 1 loop diff --git a/translate/grt/grt-vpi.adb b/translate/grt/grt-vpi.adb index f6c5c56ad..f8113069c 100644 --- a/translate/grt/grt-vpi.adb +++ b/translate/grt/grt-vpi.adb @@ -48,6 +48,7 @@ with Grt.Astdio; use Grt.Astdio; with Grt.Hooks; use Grt.Hooks; with Grt.Vcd; use Grt.Vcd; with Grt.Errors; use Grt.Errors; +with Grt.Rtis_Types; package body Grt.Vpi is -- The VPI interface requires libdl (dlopen, dlsym) to be linked in. @@ -57,7 +58,7 @@ package body Grt.Vpi is --errAnyString: constant String := "grt-vcd.adb: any string" & NUL; --errNoString: constant String := "grt-vcd.adb: no string" & NUL; - type Vpi_Index_Type is new Natural; + type Vpi_Index_Type is new Integer; ------------------------------------------------------------------------------- -- * * * h e l p e r s * * * * * * * * * * * * * * * * * * * * * * * * * * @@ -745,12 +746,15 @@ package body Grt.Vpi is is Res : Integer; begin + if Vpi_Filename = null then + return; + end if; + + Grt.Rtis_Types.Search_Types_RTI; + Register_Cycle_Hook (Vpi_Cycle'Access); if g_cbEndOfCompile /= null then Res := g_cbEndOfCompile.Cb_Rtn.all (g_cbEndOfCompile); end if; - if Vpi_Filename /= null then - Register_Cycle_Hook (Vpi_Cycle'Access); - end if; end Vpi_Start; ------------------------------------------------------------------------ diff --git a/translate/grt/grt-waves.adb b/translate/grt/grt-waves.adb index c571cfabf..cb1f32f17 100644 --- a/translate/grt/grt-waves.adb +++ b/translate/grt/grt-waves.adb @@ -1084,6 +1084,11 @@ package body Grt.Waves is Kind := To_Ghdl_Rtin_Subtype_Scalar_Acc (Rti).Basetype.Kind; end if; case Kind is + when Ghdl_Rtik_Type_B2 => + Wave_Put_Byte (Ghdl_Rtik'Pos (Kind) + + Ghdl_Dir_Type'Pos (Rng.B2.Dir) * 16#80#); + Wave_Put_Byte (Ghdl_B2'Pos (Rng.B2.Left)); + Wave_Put_Byte (Ghdl_B2'Pos (Rng.B2.Right)); when Ghdl_Rtik_Type_E8 => Wave_Put_Byte (Ghdl_Rtik'Pos (Kind) + Ghdl_Dir_Type'Pos (Rng.E8.Dir) * 16#80#); diff --git a/translate/grt/grt.adc b/translate/grt/grt.adc index 889fcbd9b..54b06c05d 100644 --- a/translate/grt/grt.adc +++ b/translate/grt/grt.adc @@ -32,5 +32,6 @@ pragma restrictions (No_Exceptions); pragma Restrictions (No_Secondary_Stack); --pragma Restrictions (No_Elaboration_Code); pragma Restrictions (No_Io); -pragma Restrictions (No_Tasking); +pragma Restrictions (Max_Tasks => 0); +pragma Restrictions (No_Implicit_Heap_Allocations); pragma No_Run_Time; diff --git a/translate/grt/grt.ver b/translate/grt/grt.ver new file mode 100644 index 000000000..2770d8e34 --- /dev/null +++ b/translate/grt/grt.ver @@ -0,0 +1,25 @@ +VERSION { + global: +vpi_free_object; +vpi_get; +vpi_get_str; +vpi_get_time; +vpi_get_value; +vpi_get_vlog_info; +vpi_handle; +vpi_handle_by_index; +vpi_iterate; +vpi_mcd_close; +vpi_mcd_name; +vpi_mcd_open; +vpi_put_value; +vpi_register_cb; +vpi_register_systf; +vpi_remove_cb; +vpi_scan; +vpi_vprintf; +vpi_printf; + local: + *; +}; + diff --git a/translate/translation.adb b/translate/translation.adb index 17c80f923..0eac1d064 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -237,13 +237,6 @@ package body Translation is -- Scopes must be poped in the reverse order they are pushed. procedure Pop_Scope (Scope_Type : O_Tnode); - -- Same as Push_Scope/Pop_Scope, but act only if SCOPE_TYPE is not - -- null. - procedure Push_Scope_Soft (Scope_Type : O_Tnode; Scope_Param : O_Dnode); - procedure Pop_Scope_Soft (Scope_Type : O_Tnode); - pragma Inline (Push_Scope_Soft); - pragma Inline (Pop_Scope_Soft); - -- Reset the identifier. type Id_Mark_Type is limited private; type Local_Identifier_Type is limited private; @@ -1793,7 +1786,7 @@ package body Translation is -- Return TRUE if base type of ATYPE is larger than its bounds, ie -- if a value of type ATYPE may be out of range. - function Need_Range_Check (Atype : Iir) return Boolean; + function Need_Range_Check (Expr : Iir; Atype : Iir) return Boolean; -- Generate an error if VALUE (computed from EXPR which may be NULL_IIR -- if not from a tree) is not in range specified by ATYPE. @@ -1992,13 +1985,21 @@ package body Translation is -- its location. procedure Check_Bound_Error (Cond : O_Enode; Loc : Iir; Dim : Natural); - -- Get the offset in the range pointed by RANGE_PTR of INDEX. + -- Get the deepest range_expression of ATYPE. + -- This follows 'range and 'reverse_range. + -- Set IS_REVERSE to true if the range must be reversed. + procedure Get_Deep_Range_Expression + (Atype : Iir; Rng : out Iir; Is_Reverse : out Boolean); + + -- Get the offset of INDEX in the range RNG. -- This checks INDEX belongs to the range. - -- INDEX_TYPE is the subtype of the array index. + -- RANGE_TYPE is the subtype of the array index (or the subtype of RNG). + -- For unconstrained ranges, INDEX_EXPR must be NULL_IIR and RANGE_TYPE + -- must be set. function Translate_Index_To_Offset (Rng : Mnode; Index : O_Enode; Index_Expr : Iir; - Index_Type : Iir; + Range_Type : Iir; Loc : Iir) return O_Enode; end Chap6; @@ -2258,6 +2259,12 @@ package body Translation is -- Close the temporary region. procedure Close_Temp; + -- Return TRUE if stack2 will be released. Used for fine-tuning only + -- (return statement). + function Has_Stack2_Mark return Boolean; + -- Manually release stack2. Used for fine-tuning only. + procedure Stack2_Release; + -- Check there is no temporary region. procedure Check_No_Temp; @@ -3149,10 +3156,27 @@ package body Translation is Temp_Level.Transient_Types := Atype; end Add_Transient_Type_In_Temp; + function Has_Stack2_Mark return Boolean is + begin + return Temp_Level.Stack2_Mark /= O_Dnode_Null; + end Has_Stack2_Mark; + + procedure Stack2_Release + is + Constr : O_Assoc_List; + begin + if Temp_Level.Stack2_Mark /= O_Dnode_Null then + Start_Association (Constr, Ghdl_Stack2_Release); + New_Association (Constr, + New_Value (New_Obj (Temp_Level.Stack2_Mark))); + New_Procedure_Call (Constr); + Temp_Level.Stack2_Mark := O_Dnode_Null; + end if; + end Stack2_Release; + procedure Close_Temp is L : Temp_Level_Acc; - Constr : O_Assoc_List; begin if Temp_Level = null then -- OPEN_TEMP was not called. @@ -3164,10 +3188,7 @@ package body Translation is end if; if Temp_Level.Stack2_Mark /= O_Dnode_Null then - Start_Association (Constr, Ghdl_Stack2_Release); - New_Association (Constr, - New_Value (New_Obj (Temp_Level.Stack2_Mark))); - New_Procedure_Call (Constr); + Stack2_Release; end if; if Temp_Level.Emitted then Finish_Declare_Stmt; @@ -8373,25 +8394,25 @@ package body Translation is return New_Obj_Value (Var_Res); end Not_In_Range; - function Need_Range_Check (Atype : Iir) return Boolean + function Need_Range_Check (Expr : Iir; Atype : Iir) return Boolean is Info : Type_Info_Acc; begin Info := Get_Info (Atype); if Info.T.Nocheck_Low and Info.T.Nocheck_Hi then return False; - else - return True; end if; + if Expr /= Null_Iir and then Get_Type (Expr) = Atype then + return False; + end if; + return True; end Need_Range_Check; procedure Check_Range (Value : O_Dnode; Expr : Iir; Atype : Iir) is If_Blk : O_If_Block; begin - if not Need_Range_Check (Atype) - or else (Expr /= Null_Iir and then Get_Type (Expr) = Atype) - then + if not Need_Range_Check (Expr, Atype) then return; end if; @@ -12043,12 +12064,18 @@ package body Translation 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 + -- FIXME: EXPR_TYPE shound not be NULL_IIR (generate stmt) + if Expr_Type = Null_Iir then return True; end if; + case Get_Kind (Expr_Type) is + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition => + null; + when others => + return True; + end case; -- No check if the expression has the type of the index. if Expr_Type = Rng_Type then @@ -12078,9 +12105,15 @@ package body Translation is -- 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; + case Get_Kind (T) is + when Iir_Kind_Integer_Subtype_Definition + | Iir_Kind_Enumeration_Subtype_Definition + | Iir_Kind_Enumeration_Type_Definition => + -- These types have a range. + null; + when others => + Error_Kind ("get_deep_range_expression(1)", T); + end case; R := Get_Range_Constraint (T); case Get_Kind (R) is @@ -12105,7 +12138,7 @@ package body Translation is function Translate_Index_To_Offset (Rng : Mnode; Index : O_Enode; Index_Expr : Iir; - Index_Type : Iir; + Range_Type : Iir; Loc : Iir) return O_Enode is @@ -12122,9 +12155,15 @@ package body Translation is 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); + Index_Info := Get_Info (Get_Base_Type (Range_Type)); + if Index_Expr = Null_Iir then + Need_Check := True; + Deep_Rng := Null_Iir; + Deep_Reverse := False; + else + Need_Check := Need_Index_Check (Get_Type (Index_Expr), Range_Type); + Get_Deep_Range_Expression (Range_Type, Deep_Rng, Deep_Reverse); + end if; Res := Create_Temp (Ghdl_Index_Type); @@ -12199,81 +12238,6 @@ package body Translation is 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), 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); - - -- Get the offset. - New_Assign_Stmt - (New_Obj (Res), New_Convert_Ov (New_Obj_Value (Off), - Ghdl_Index_Type)); - - -- Check bounds. - 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_Fat_Index_To_Offset; - -- Translate index EXPR in dimension DIM of thin array into an -- offset. -- This checks bounds. @@ -12390,10 +12354,10 @@ package body Translation is when Type_Mode_Fat_Array => Range_Ptr := Stabilize (Chap3.Get_Array_Range (Prefix, Prefix_Type, Dim)); - R := Translate_Fat_Index_To_Offset + R := Translate_Index_To_Offset (Range_Ptr, Chap7.Translate_Expression (Index, Ibasetype), - Itype, Index); + Null_Iir, Itype, Index); when Type_Mode_Ptr_Array => -- Manually extract range since there is no infos for -- index subtype. @@ -14416,7 +14380,7 @@ package body Translation is T_Info := Get_Info (Target_Type); case T_Info.Type_Mode is when Type_Mode_Scalar => - if not Chap3.Need_Range_Check (Target_Type) then + if not Chap3.Need_Range_Check (Expr, Target_Type) then New_Assign_Stmt (M2Lv (Target), Val); else declare @@ -17815,14 +17779,23 @@ package body Translation is -- * if the return type is scalar, simply returns. declare V : O_Dnode; + R : O_Enode; begin - V := Create_Temp (Ret_Info.Ortho_Type (Mode_Value)); - Open_Temp; - New_Assign_Stmt - (New_Obj (V), Chap7.Translate_Expression (Expr, Ret_Type)); - Close_Temp; - Chap3.Check_Range (V, Expr, Ret_Type); - Gen_Return_Value (New_Obj_Value (V)); + -- Always uses a temporary in case of the return expression + -- uses secondary stack. + -- FIXME: don't use the temp if not required. + R := Chap7.Translate_Expression (Expr, Ret_Type); + if Has_Stack2_Mark + or else Chap3.Need_Range_Check (Expr, Ret_Type) + then + V := Create_Temp (Ret_Info.Ortho_Type (Mode_Value)); + New_Assign_Stmt (New_Obj (V), R); + Stack2_Release; + Chap3.Check_Range (V, Expr, Ret_Type); + Gen_Return_Value (New_Obj_Value (V)); + else + Gen_Return_Value (R); + end if; end; when Type_Mode_Acc => -- * access: thin and no range. @@ -18027,8 +18000,6 @@ package body Translation is Get_Range_Ptr_Field_Value (New_Obj (Data.O_Range), Iter_Type_Info.T.Range_Length), New_Lit (Ghdl_Index_0), --- New_Lit (New_Signed_Literal --- (Iter_Type_Info.Ortho_Type (Mode_Value), 0)), Ghdl_Bool_Type); end if; @@ -18059,6 +18030,8 @@ package body Translation is Iter_Type_Info : Type_Info_Acc; Var_Iter : Var_Acc; Constraint : Iir; + Deep_Rng : Iir; + Deep_Reverse : Boolean; begin New_Exit_Stmt (Data.Label_Next); Finish_Loop_Stmt (Data.Label_Next); @@ -18083,10 +18056,15 @@ package body Translation is Cond, Ghdl_Bool_Type)); -- Update the iterator. - if Get_Kind (Constraint) = Iir_Kind_Range_Expression then - Gen_Update_Iterator - (Get_Var_Label (Var_Iter), Get_Direction (Constraint), - 1, Iter_Base_Type); + Chap6.Get_Deep_Range_Expression (Iter_Type, Deep_Rng, Deep_Reverse); + if Deep_Rng /= Null_Iir then + if Get_Direction (Deep_Rng) = Iir_To xor Deep_Reverse then + Gen_Update_Iterator + (Get_Var_Label (Var_Iter), Iir_To, 1, Iter_Base_Type); + else + Gen_Update_Iterator + (Get_Var_Label (Var_Iter), Iir_Downto, 1, Iter_Base_Type); + end if; else Start_If_Stmt (If_Blk1, New_Compare_Op @@ -18637,7 +18615,8 @@ package body Translation is Value := Create_Temp (Tinfo.Ortho_Type (Mode_Value)); New_Assign_Stmt (New_Obj (Value), - Chap7.Translate_Expression (Get_Actual (Value_Assoc))); + Chap7.Translate_Expression (Get_Actual (Value_Assoc), + Formal_Type)); New_Association (Assocs, New_Unchecked_Address (New_Obj (Value), Ghdl_Ptr_Type)); @@ -19431,7 +19410,7 @@ package body Translation is when others => Error_Kind ("gen_signal_assign_non_composite", Targ_Type); end case; - if Chap3.Need_Range_Check (Targ_Type) then + if Chap3.Need_Range_Check (Null_Iir, Targ_Type) then declare If_Blk : O_If_Block; Val2 : O_Dnode; @@ -19554,7 +19533,7 @@ package body Translation is Error_Kind ("gen_signal_assign_non_composite", Targ_Type); end case; -- Check range. - if Chap3.Need_Range_Check (Targ_Type) then + if Chap3.Need_Range_Check (Null_Iir, Targ_Type) then declare If_Blk : O_If_Block; V : Mnode; @@ -21539,22 +21518,6 @@ package body Translation is end if; end Pop_Scope; - procedure Push_Scope_Soft (Scope_Type : O_Tnode; Scope_Param : O_Dnode) - is - begin - if Scope_Type /= O_Tnode_Null then - Push_Scope (Scope_Type, Scope_Param); - end if; - end Push_Scope_Soft; - - procedure Pop_Scope_Soft (Scope_Type : O_Tnode) - is - begin - if Scope_Type /= O_Tnode_Null then - Pop_Scope (Scope_Type); - end if; - end Pop_Scope_Soft; - function Create_Global_Var (Name : O_Ident; Vtype : O_Tnode; Storage : O_Storage) return Var_Acc @@ -22915,26 +22878,20 @@ package body Translation is Pinfo : Type_Info_Acc; Subprg : O_Dnode; Assoc : O_Assoc_List; - Conv : O_Tnode; begin Prefix_Type := Get_Base_Type (Get_Type (Get_Prefix (Attr))); Pinfo := Get_Info (Prefix_Type); case Pinfo.Type_Mode is when Type_Mode_B2 => Subprg := Ghdl_Value_B2; - Conv := Ghdl_Bool_Type; when Type_Mode_E8 => Subprg := Ghdl_Value_E8; - Conv := Ghdl_I32_Type; when Type_Mode_I32 => Subprg := Ghdl_Value_I32; - Conv := Ghdl_I32_Type; when Type_Mode_P64 => Subprg := Ghdl_Value_P64; - Conv := Ghdl_I64_Type; when Type_Mode_F64 => Subprg := Ghdl_Value_F64; - Conv := Ghdl_Real_Type; when others => raise Internal_Error; end case; @@ -22955,7 +22912,8 @@ package body Translation is when others => raise Internal_Error; end case; - return New_Convert_Ov (New_Function_Call (Assoc), Conv); + return New_Convert_Ov (New_Function_Call (Assoc), + Pinfo.Ortho_Type (Mode_Value)); end Translate_Value_Attribute; -- Current path for name attributes. @@ -27023,6 +26981,8 @@ package body Translation is Rtis.Ghdl_Rti_Access); New_Interface_Decl (Interfaces, Param, Get_Identifier ("addr"), Ghdl_Ptr_Type); + New_Interface_Decl (Interfaces, Param, Get_Identifier ("name"), + Ghdl_Str_Len_Ptr_Node); Finish_Subprogram_Decl (Interfaces, Res); end Create_Get_Name; begin |