diff options
28 files changed, 227 insertions, 115 deletions
diff --git a/iirs_utils.adb b/iirs_utils.adb index a16fa0b..a3ca408 100644 --- a/iirs_utils.adb +++ b/iirs_utils.adb @@ -827,7 +827,9 @@ package body Iirs_Utils is | Iir_Kind_Function_Call => return False; when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration => + | Iir_Kind_Signal_Interface_Declaration + | Iir_Kind_Guard_Signal_Declaration + | Iir_Kinds_Signal_Attribute => return True; when Iir_Kind_Object_Alias_Declaration => Adecl := Get_Base_Name (Get_Name (Adecl)); diff --git a/ortho/mcode/Makefile b/ortho/mcode/Makefile index cdec5c4..182397a 100644 --- a/ortho/mcode/Makefile +++ b/ortho/mcode/Makefile @@ -11,7 +11,7 @@ memsegs_c.o: $(ortho_srcdir)/mcode/memsegs_c.c $(CC) -c $(CFLAGS) -o $@ $< oread: force - gnatmake -m -o $@ -g $(GNAT_FLAGS) -aI../oread ortho_code_main -aI.. + gnatmake -m -o $@ -g $(GNAT_FLAGS) -aI../oread ortho_code_main -aI.. -largs memsegs_c.o elfdump: force gnatmake -m -g $(GNAT_FLAGS) $@ diff --git a/ortho/mcode/binary_file.adb b/ortho/mcode/binary_file.adb index 58c5a79..488aac8 100644 --- a/ortho/mcode/binary_file.adb +++ b/ortho/mcode/binary_file.adb @@ -111,6 +111,7 @@ package body Binary_File is begin return Get_Scope (Sym) /= Sym_Undef; end S_Defined; + pragma Unreferenced (S_Defined); function S_Local (Sym : Symbol) return Boolean is begin diff --git a/ortho/mcode/elf_common.ads b/ortho/mcode/elf_common.ads index c53cd48..28186d0 100644 --- a/ortho/mcode/elf_common.ads +++ b/ortho/mcode/elf_common.ads @@ -16,7 +16,6 @@ -- Software Foundation, 59 Temple Place - Suite 330, Boston, MA -- 02111-1307, USA. with Interfaces; use Interfaces; -with System; package Elf_Common is subtype Elf_Half is Unsigned_16; diff --git a/ortho/mcode/memsegs_c.c b/ortho/mcode/memsegs_c.c index a35d695..c311423 100644 --- a/ortho/mcode/memsegs_c.c +++ b/ortho/mcode/memsegs_c.c @@ -28,17 +28,21 @@ set rights. */ +#ifdef __APPLE__ +#define MAP_ANONYMOUS MAP_ANON +#else +#define HAVE_MREMAP +#endif + void * mmap_malloc (int size) { void *res; res = mmap (NULL, size, PROT_READ | PROT_WRITE, - MAP_PRIVATE | MAP_ANONYMOUS, 0, 0); + MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); /* printf ("mmap (%d) = %p\n", size, res); */ -#if 0 if (res == MAP_FAILED) return NULL; -#endif return res; } @@ -46,7 +50,16 @@ void * mmap_realloc (void *ptr, int old_size, int size) { void *res; +#ifdef HAVE_MREMAP res = mremap (ptr, old_size, size, MREMAP_MAYMOVE); +#else + res = mmap (NULL, size, PROT_READ | PROT_WRITE, + MAP_PRIVATE | MAP_ANONYMOUS, -1, 0); + if (res == MAP_FAILED) + return NULL; + memcpy (res, ptr, old_size); + munmap (ptr, old_size); +#endif /* printf ("mremap (%p, %d, %d) = %p\n", ptr, old_size, size, res); */ #if 0 if (res == MAP_FAILED) diff --git a/ortho/mcode/ortho_code-exprs.adb b/ortho/mcode/ortho_code-exprs.adb index b8da44c..0724bcc 100644 --- a/ortho/mcode/ortho_code-exprs.adb +++ b/ortho/mcode/ortho_code-exprs.adb @@ -251,6 +251,7 @@ package body Ortho_Code.Exprs is begin return Enodes.Table (Stmt).Arg1; end Get_BB_Next; + pragma Unreferenced (Get_BB_Next); procedure Set_BB_Next (Stmt : O_Enode; Next : O_Enode) is begin diff --git a/ortho/mcode/ortho_code-exprs.ads b/ortho/mcode/ortho_code-exprs.ads index ffff28e..0ac6cee 100644 --- a/ortho/mcode/ortho_code-exprs.ads +++ b/ortho/mcode/ortho_code-exprs.ads @@ -111,6 +111,8 @@ package Ortho_Code.Exprs is -- ARG1 is subprogram -- ARG2 is arguments. OE_Call, + -- ARG1 is the subprogram. + OE_Setup_Frame, -- ARG1 is intrinsic operation. OE_Intrinsic, diff --git a/ortho/mcode/ortho_code-opts.adb b/ortho/mcode/ortho_code-opts.adb index 75fedd0..83071b4 100644 --- a/ortho/mcode/ortho_code-opts.adb +++ b/ortho/mcode/ortho_code-opts.adb @@ -120,6 +120,7 @@ package body Ortho_Code.Opts is end case; end loop; end Get_Fall_Stmt; + pragma Unreferenced (Get_Fall_Stmt); procedure Thread_Jump (Subprg : Subprogram_Data_Acc) is diff --git a/ortho/mcode/ortho_code-types.adb b/ortho/mcode/ortho_code-types.adb index 446fde6..fda7a21 100644 --- a/ortho/mcode/ortho_code-types.adb +++ b/ortho/mcode/ortho_code-types.adb @@ -645,6 +645,7 @@ package body Ortho_Code.Types is null; end case; end Disp_Type; + pragma Unreferenced (Disp_Type); procedure Mark (M : out Mark_Type) is begin diff --git a/ortho/mcode/ortho_code-x86-abi.adb b/ortho/mcode/ortho_code-x86-abi.adb index 0087bb1..5456235 100644 --- a/ortho/mcode/ortho_code-x86-abi.adb +++ b/ortho/mcode/ortho_code-x86-abi.adb @@ -36,6 +36,7 @@ package body Ortho_Code.X86.Abi is is pragma Unreferenced (Subprg); begin + -- First argument is at %ebp + 8 Abi.Offset := 8; end Start_Subprogram; @@ -59,6 +60,7 @@ package body Ortho_Code.X86.Abi is begin Set_Decl_Info (Subprg, To_Int32 (Create_Symbol (Get_Decl_Ident (Subprg)))); + -- Offset is 8 biased. Set_Subprg_Stack (Subprg, Abi.Offset - 8); end Finish_Subprogram; diff --git a/ortho/mcode/ortho_code-x86-abi.ads b/ortho/mcode/ortho_code-x86-abi.ads index 613e37b..d130042 100644 --- a/ortho/mcode/ortho_code-x86-abi.ads +++ b/ortho/mcode/ortho_code-x86-abi.ads @@ -34,7 +34,7 @@ package Ortho_Code.X86.Abi is Mode_B2 => 0); Mode_Ptr : constant Mode_Type := Mode_P32; - + -- Procedures to layout a subprogram declaration. procedure Start_Subprogram (Subprg : O_Dnode; Abi : out O_Abi_Subprg); procedure New_Interface (Inter : O_Dnode; Abi : in out O_Abi_Subprg); diff --git a/ortho/mcode/ortho_code-x86-emits.adb b/ortho/mcode/ortho_code-x86-emits.adb index 85327fd..3f71f87 100644 --- a/ortho/mcode/ortho_code-x86-emits.adb +++ b/ortho/mcode/ortho_code-x86-emits.adb @@ -767,17 +767,39 @@ package body Ortho_Code.X86.Emits is End_Insn; end Gen_Call; + procedure Emit_Setup_Frame (Stmt : O_Enode) + is + use Ortho_Code.Decls; + Subprg : O_Dnode; + Val : Unsigned_32; + begin + Subprg := Get_Call_Subprg (Stmt); + Val := Unsigned_32 (Get_Subprg_Stack (Subprg)); + -- Pad the stack if necessary. + Val := Val and (Flags.Stack_Boundary - 1); + if Val /= 0 then + Start_Insn; + -- subl esp, val + Gen_B8 (2#100000_11#); + Gen_B8 (2#11_101_100#); + Gen_B8 (Byte (Flags.Stack_Boundary - Val)); + End_Insn; + end if; + end Emit_Setup_Frame; + procedure Emit_Call (Stmt : O_Enode) is use Ortho_Code.Decls; Subprg : O_Dnode; Sym : Symbol; - Val : Int32; + Val : Unsigned_32; begin Subprg := Get_Call_Subprg (Stmt); Sym := Get_Decl_Symbol (Subprg); Gen_Call (Sym); - Val := Get_Subprg_Stack (Subprg); + Val := Unsigned_32 (Get_Subprg_Stack (Subprg)); + Val := (Val + Flags.Stack_Boundary - 1) + and not (Flags.Stack_Boundary - 1); if Val /= 0 then Start_Insn; if Val <= 127 then @@ -1819,6 +1841,10 @@ package body Ortho_Code.X86.Emits is when others => Error_Emit ("emit_insn: oe_arg", Stmt); end case; + when OE_Setup_Frame => + if Flags.Stack_Boundary > 4 then + Emit_Setup_Frame (Stmt); + end if; when OE_Call => Emit_Call (Stmt); when OE_Intrinsic => diff --git a/ortho/mcode/ortho_code-x86-flags.ads b/ortho/mcode/ortho_code-x86-flags.ads index 44179a4..699a38c 100644 --- a/ortho/mcode/ortho_code-x86-flags.ads +++ b/ortho/mcode/ortho_code-x86-flags.ads @@ -24,5 +24,5 @@ package Ortho_Code.X86.Flags is -- Prefered stack alignment. -- Must be a power of 2. - Stack_Boundary : Unsigned_32 := 2 ** 3; + Stack_Boundary : Unsigned_32 := 2 ** 3; -- 4 for MacOSX, 3 for Linux end Ortho_Code.X86.Flags; diff --git a/ortho/mcode/ortho_code-x86-insns.adb b/ortho/mcode/ortho_code-x86-insns.adb index cc83afa..bfd1635 100644 --- a/ortho/mcode/ortho_code-x86-insns.adb +++ b/ortho/mcode/ortho_code-x86-insns.adb @@ -911,6 +911,59 @@ package body Ortho_Code.X86.Insns is -- end; end Gen_Conv_From_Fp_Insn; + function Gen_Call (Stmt : O_Enode; Reg : O_Reg; Pnum : O_Inum) + return O_Enode + is + Left : O_Enode; + Reg_Res : O_Reg; + begin + Link_Stmt + (New_Enode (OE_Setup_Frame, Mode_Nil, O_Tnode_Null, + O_Enode (Get_Call_Subprg (Stmt)), O_Enode_Null)); + Left := Get_Arg_Link (Stmt); + if Left /= O_Enode_Null then + -- Generate code for arguments. + Left := Gen_Insn (Left, R_None, Pnum); + end if; + + -- Clobber registers. + Clobber_R32 (R_Ax); + Clobber_R32 (R_Dx); + Clobber_R32 (R_Cx); + -- FIXME: fp regs. + + Reg_Res := Get_Call_Register (Get_Expr_Mode (Stmt)); + Set_Expr_Reg (Stmt, Reg_Res); + Link_Stmt (Stmt); + + case Reg is + when R_Any32 + | R_Any64 + | R_Any8 + | R_Irm + | R_Rm + | R_Ir + | R_Sib + | R_Ax + | R_St0 + | R_Edx_Eax => + Reg_Res := Alloc_Reg (Reg_Res, Stmt, Pnum); + return Stmt; + when R_Any_Cc => + -- Move to register. + -- (use the 'test' instruction). + Alloc_Cc (Stmt, Pnum); + return Insert_Move (Stmt, R_Ne); + when R_None => + if Reg_Res /= R_None then + raise Program_Error; + end if; + return Stmt; + when others => + Error_Gen_Insn (Stmt, Reg); + end case; + end Gen_Call; + function Gen_Insn (Stmt : O_Enode; Reg : O_Reg; Pnum : O_Inum) return O_Enode is @@ -1692,48 +1745,7 @@ package body Ortho_Code.X86.Insns is Free_Insn_Regs (Left); return Stmt; when OE_Call => - Left := Get_Arg_Link (Stmt); - if Left /= O_Enode_Null then - -- Generate code for arguments. - Left := Gen_Insn (Left, R_None, Pnum); - end if; - - -- Clobber registers. - Clobber_R32 (R_Ax); - Clobber_R32 (R_Dx); - Clobber_R32 (R_Cx); - -- FIXME: fp regs. - - Reg_Res := Get_Call_Register (Get_Expr_Mode (Stmt)); - Set_Expr_Reg (Stmt, Reg_Res); - Link_Stmt (Stmt); - - case Reg is - when R_Any32 - | R_Any64 - | R_Any8 - | R_Irm - | R_Rm - | R_Ir - | R_Sib - | R_Ax - | R_St0 - | R_Edx_Eax => - Reg_Res := Alloc_Reg (Reg_Res, Stmt, Pnum); - return Stmt; - when R_Any_Cc => - -- Move to register. - -- (use the 'test' instruction). - Alloc_Cc (Stmt, Pnum); - return Insert_Move (Stmt, R_Ne); - when R_None => - if Reg_Res /= R_None then - raise Program_Error; - end if; - return Stmt; - when others => - Error_Gen_Insn (Stmt, Reg); - end case; + return Gen_Call (Stmt, Reg, Pnum); when OE_Case_Expr => Left := Get_Expr_Operand (Stmt); Set_Expr_Reg (Stmt, Alloc_Reg (Get_Expr_Reg (Left), Stmt, Pnum)); @@ -1823,13 +1835,7 @@ package body Ortho_Code.X86.Insns is when OE_Leave => Link_Stmt (Stmt); when OE_Call => - Left := Get_Arg_Link (Stmt); - if Left /= O_Enode_Null then - -- Generate code for arguments. - Left := Gen_Insn (Left, R_None, Num); - end if; - Set_Expr_Reg (Stmt, R_None); - Link_Stmt (Stmt); + Link_Stmt (Gen_Call (Stmt, R_None, Num)); when OE_Ret => Left := Get_Expr_Operand (Stmt); P_Reg := Get_Call_Register (Get_Expr_Mode (Stmt)); diff --git a/ortho/mcode/ortho_code.ads b/ortho/mcode/ortho_code.ads index 404c9be..0657b07 100644 --- a/ortho/mcode/ortho_code.ads +++ b/ortho/mcode/ortho_code.ads @@ -28,6 +28,9 @@ package Ortho_Code is function Shift_Right (L : Uns32; R : Natural) return Uns32; pragma Import (Intrinsic, Shift_Right); + function Shift_Right_Arithmetic (L : Uns32; R : Natural) return Uns32; + pragma Import (Intrinsic, Shift_Right_Arithmetic); + function Shift_Left (L : Uns32; R : Natural) return Uns32; pragma Import (Intrinsic, Shift_Left); diff --git a/sem_names.adb b/sem_names.adb index c42c3da..686ff43 100644 --- a/sem_names.adb +++ b/sem_names.adb @@ -1573,7 +1573,8 @@ package body Sem_Names is | Iir_Kind_Selected_Element | Iir_Kind_Dereference | Iir_Kind_Implicit_Dereference - | Iir_Kind_Attribute_Value => + | Iir_Kind_Attribute_Value + | Iir_Kind_Function_Call => if Get_Kind (Get_Type (Prefix)) = Iir_Kind_Protected_Type_Declaration then diff --git a/translate/ghdldrv/Makefile b/translate/ghdldrv/Makefile index 229fb14..3838f5c 100644 --- a/translate/ghdldrv/Makefile +++ b/translate/ghdldrv/Makefile @@ -111,6 +111,7 @@ install.mcode: install.v87 install.v93 clean: force $(RM) -f *.o *.ali ghdl_gcc ghdl_mcode $(RM) -f b~*.ad? *~ default_pathes.ads + $(RM) -rf ../lib force: diff --git a/translate/grt/Makefile.inc b/translate/grt/Makefile.inc index 002d177..b82e33b 100644 --- a/translate/grt/Makefile.inc +++ b/translate/grt/Makefile.inc @@ -57,6 +57,10 @@ ifeq ($(filter-out i%86 freebsd%,$(arch) $(osys)),) GRT_EXTRA_LIB=-lm $(GRT_ELF_OPTS) ADAC=gnatgcc endif +ifeq ($(filter-out i%86 darwin%,$(arch) $(osys)),) + GRT_TARGET_OBJS=i386.o linux.o times.o + GRT_EXTRA_LIB=-lm +endif ifeq ($(filter-out sparc solaris%,$(arch) $(osys)),) GRT_TARGET_OBJS=sparc.o linux.o times.o GRT_EXTRA_LIB=-ldl -lm @@ -164,6 +168,12 @@ grt-cvpi.o: $(GRTSRCDIR)/grt-cvpi.c grt-cthreads.o: $(GRTSRCDIR)/grt-cthreads.c $(CC) -c $(GRT_FLAGS) -o $@ $< +grt-disp-config: + @echo "target: $(target)" + @echo "targ: $(targ)" + @echo "arch: $(arch)" + @echo "osys: $(osys)" + grt-files: run-bind.adb sed -e "1,/-- *BEGIN/d" -e "/-- *END/,\$$d" \ -e "s/ -- //" < $< > $@ diff --git a/translate/grt/config/chkstk.S b/translate/grt/config/chkstk.S index 79abfb2..3fa5cc6 100644 --- a/translate/grt/config/chkstk.S +++ b/translate/grt/config/chkstk.S @@ -3,10 +3,16 @@ .text - /* Function called to loop on the process. */ +#ifdef __APPLE__ +#define __chkstk ___chkstk +#endif + + /* Function called to loop on the process. */ .align 4 +#ifdef __ELF__ .type __chkstk,@function - .global __chkstk +#endif + .globl __chkstk __chkstk: testl %eax,%eax je 0f @@ -15,6 +21,8 @@ __chkstk: jmp *(%esp,%eax) 0: ret +#ifdef __ELF__ .size __chkstk, . - __chkstk +#endif .ident "Written by T.Gingold" diff --git a/translate/grt/config/i386.S b/translate/grt/config/i386.S index fbd8954..2490ea1 100644 --- a/translate/grt/config/i386.S +++ b/translate/grt/config/i386.S @@ -21,21 +21,30 @@ .text - /* Function called to loop on the process. */ - .align 4 - .type grt_stack_loop,@function -grt_stack_loop: +#ifdef __ELF__ +#define ENTRY(func) .align 4; .globl func; .type func,@function; func: +#define END(func) .size func, . - func +#define NAME(name) name +#elif __APPLE__ +#define ENTRY(func) .align 4; .globl _##func; _##func: +#define END(func) +#define NAME(name) _##name +#else +#define ENTRY(func) .align 4; func: +#define END(func) +#define NAME(name) name +#endif + + /* Function called to loop on the process. */ +ENTRY(grt_stack_loop) call *4(%esp) - jmp grt_stack_loop - .size grt_stack_loop, . - grt_stack_loop + jmp NAME(grt_stack_loop) +END(grt_stack_loop) /* function Stack_Create (Func : Address; Arg : Address) return Stack_Type; */ - .align 4 - .globl grt_stack_create - .type grt_stack_create,@function -grt_stack_create: +ENTRY(grt_stack_create) /* Standard prologue. */ pushl %ebp movl %esp,%ebp @@ -43,7 +52,7 @@ grt_stack_create: subl $8,%esp /* Allocate the stack, and exit in case of failure */ - call grt_stack_allocate + call NAME(grt_stack_allocate) testl %eax,%eax je .Ldone @@ -58,7 +67,7 @@ grt_stack_create: movl 12(%ebp), %ecx movl %ecx, -8(%eax) /* The return function. */ - movl $grt_stack_loop, -12(%eax) + movl $NAME(grt_stack_loop), -12(%eax) /* The context. */ movl %ebx, -16(%eax) movl %esi, -20(%eax) @@ -72,16 +81,12 @@ grt_stack_create: .Ldone: leave ret - .size grt_stack_create,. - grt_stack_create - +END(grt_stack_create) - .align 4 - .globl grt_stack_switch /* Arguments: TO, FROM Both are pointers to a stack_context. */ - .type grt_stack_switch,@function -grt_stack_switch: +ENTRY(grt_stack_switch) /* TO -> ECX. */ movl 4(%esp), %ecx /* FROM -> EDX. */ @@ -102,7 +107,7 @@ grt_stack_switch: popl %ebx /* Run. */ ret - .size grt_stack_switch, . - grt_stack_switch +END(grt_stack_switch) .ident "Written by T.Gingold" diff --git a/translate/grt/grt-errors.adb b/translate/grt/grt-errors.adb index 4a6aca8..6273161 100644 --- a/translate/grt/grt-errors.adb +++ b/translate/grt/grt-errors.adb @@ -125,6 +125,16 @@ package body Grt.Errors is Newline_Err; end Report_E; + procedure Report_E (Str : Std_String_Ptr) + is + subtype Ada_Str is String (1 .. Natural (Str.Bounds.Dim_1.Length)); + begin + if Ada_Str'Length > 0 then + Put_Err (Ada_Str (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1))); + end if; + Newline_Err; + end Report_E; + procedure Error_H is begin Put_Err (Progname); @@ -193,6 +203,13 @@ package body Grt.Errors is Fatal_Error; end Error_E; + procedure Error_E_Std (Str : Std_String_Uncons) + is + subtype Str_Subtype is String (1 .. Str'Length); + begin + Error_E (Str_Subtype (Str)); + end Error_E_Std; + procedure Error (Str : String) is begin Error_H; diff --git a/translate/grt/grt-errors.ads b/translate/grt/grt-errors.ads index b531aef..b839023 100644 --- a/translate/grt/grt-errors.ads +++ b/translate/grt/grt-errors.ads @@ -27,6 +27,7 @@ package Grt.Errors is procedure Error_C (Str : Ghdl_C_String); --procedure Error_C (Inst : Ghdl_Instance_Name_Acc); procedure Error_E (Str : String); + procedure Error_E_Std (Str : Std_String_Uncons); pragma No_Return (Error_E); -- Multi-call report procedure. Do not exit at end. @@ -36,6 +37,7 @@ package Grt.Errors is procedure Report_C (N : Integer); procedure Report_Now_C; procedure Report_E (Str : String); + procedure Report_E (Str : Std_String_Ptr); -- Complete error message. procedure Error (Str : String); diff --git a/translate/grt/grt-files.adb b/translate/grt/grt-files.adb index 9037fce..6da675d 100644 --- a/translate/grt/grt-files.adb +++ b/translate/grt/grt-files.adb @@ -1,5 +1,5 @@ -- GHDL Run Time (GRT) - VHDL files subprograms. --- Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold +-- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 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 @@ -247,7 +247,7 @@ package body Grt.Files is if Res /= Open_Ok then Error_C ("open: cannot open text file "); - Error_E (String (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1))); + Error_E_Std (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1)); end if; end Ghdl_Text_File_Open; @@ -262,7 +262,7 @@ package body Grt.Files is if Res /= Open_Ok then Error_C ("open: cannot open file "); - Error_E (String (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1))); + Error_E_Std (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1)); end if; end Ghdl_File_Open; diff --git a/translate/grt/grt-lib.adb b/translate/grt/grt-lib.adb index 3b3f1f3..d1de1d7 100644 --- a/translate/grt/grt-lib.adb +++ b/translate/grt/grt-lib.adb @@ -63,7 +63,7 @@ package body Grt.Lib is Report_C ("???"); end case; Report_C ("): "); - Report_E (String (Str.Base (0 .. Str.Bounds.Dim_1.Length - 1))); + Report_E (Str); if Level >= Grt.Options.Severity_Level then Error_C (Msg); Error_E (" failed"); diff --git a/translate/grt/grt-types.ads b/translate/grt/grt-types.ads index 819b5db..6fd0bb6 100644 --- a/translate/grt/grt-types.ads +++ b/translate/grt/grt-types.ads @@ -58,7 +58,8 @@ package Grt.Types is end record; subtype Std_Character is Character; - type Std_String_Base is array (Ghdl_Index_Type) of Std_Character; + type Std_String_Uncons is array (Ghdl_Index_Type range <>) of Std_Character; + subtype Std_String_Base is Std_String_Uncons (Ghdl_Index_Type); type Std_String_Basep is access Std_String_Base; type Std_String_Bound is record diff --git a/translate/grt/grt-vpi.adb b/translate/grt/grt-vpi.adb index f2c30b6..2af34a2 100644 --- a/translate/grt/grt-vpi.adb +++ b/translate/grt/grt-vpi.adb @@ -661,27 +661,33 @@ package body Grt.Vpi is -- Checks the format of aValue. Only vpiBinStrVal will be accepted -- for now. case aValue.Format is - when vpiObjTypeVal=> + when vpiObjTypeVal => dbgPut_Line ("vpi_put_value: vpiObjTypeVal"); - when vpiBinStrVal=> + when vpiBinStrVal => ii_vpi_put_value_bin_str(aObj.Ref, aValue.Str); - dbgPut_Line ("vpi_put_value: vpiBinStrVal"); - when vpiOctStrVal=> + -- dbgPut_Line ("vpi_put_value: vpiBinStrVal"); + when vpiOctStrVal => dbgPut_Line ("vpi_put_value: vpiNet, vpiOctStrVal"); - when vpiDecStrVal=> + when vpiDecStrVal => dbgPut_Line ("vpi_put_value: vpiNet, vpiDecStrVal"); - when vpiHexStrVal=> + when vpiHexStrVal => dbgPut_Line ("vpi_put_value: vpiNet, vpiHexStrVal"); - when vpiScalarVal=> + when vpiScalarVal => dbgPut_Line ("vpi_put_value: vpiNet, vpiScalarVal"); - when vpiIntVal=> + when vpiIntVal => dbgPut_Line ("vpi_put_value: vpiIntVal"); - when vpiRealVal=> dbgPut_Line("vpi_put_value: vpiRealVal"); - when vpiStringVal=> dbgPut_Line("vpi_put_value: vpiStringVal"); - when vpiTimeVal=> dbgPut_Line("vpi_put_value: vpiTimeVal"); - when vpiVectorVal=> dbgPut_Line("vpi_put_value: vpiVectorVal"); - when vpiStrengthVal=> dbgPut_Line("vpi_put_value: vpiStrengthVal"); - when others=> dbgPut_Line("vpi_put_value: unknown mFormat"); + when vpiRealVal => + dbgPut_Line("vpi_put_value: vpiRealVal"); + when vpiStringVal => + dbgPut_Line("vpi_put_value: vpiStringVal"); + when vpiTimeVal => + dbgPut_Line("vpi_put_value: vpiTimeVal"); + when vpiVectorVal => + dbgPut_Line("vpi_put_value: vpiVectorVal"); + when vpiStrengthVal => + dbgPut_Line("vpi_put_value: vpiStrengthVal"); + when others => + dbgPut_Line("vpi_put_value: unknown mFormat"); end case; -- Must return a scheduled event caused by vpi_put_value() diff --git a/translate/grt/grt-vpi.ads b/translate/grt/grt-vpi.ads index 9f4ffa9..a7f06f7 100644 --- a/translate/grt/grt-vpi.ads +++ b/translate/grt/grt-vpi.ads @@ -79,10 +79,10 @@ package Grt.Vpi is -- double real; -- } s_vpi_time, *p_vpi_time; type s_vpi_time is record - mType : integer; - mHigh : integer; -- this should be unsigned - mLow : integer; -- this should be unsigned - mReal : float; -- this should be double + mType : Integer; + mHigh : Integer; -- this should be unsigned + mLow : Integer; -- this should be unsigned + mReal : Float; -- this should be double end record; type p_vpi_time is access s_vpi_time; diff --git a/translate/translation.adb b/translate/translation.adb index 90f961f..8ce7e0f 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -11794,15 +11794,16 @@ package body Translation is begin Obj := Sem_Names.Name_To_Object (Expr); if Obj /= Null_Iir then - case Get_Kind (Get_Base_Name (Obj)) is - when Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_Guard_Signal_Declaration - | Iir_Kinds_Signal_Attribute => - return True; - when others => - return False; - end case; + return Is_Signal_Object (Obj); +-- case Get_Kind (Get_Base_Name (Obj)) is +-- when Iir_Kind_Signal_Declaration +-- | Iir_Kind_Signal_Interface_Declaration +-- | Iir_Kind_Guard_Signal_Declaration +-- | Iir_Kinds_Signal_Attribute => +-- return True; +-- when others => +-- return False; +-- end case; else return False; end if; @@ -26794,9 +26795,9 @@ package body Translation is (Mark, Name_Table.Get_Identifier ("DEFAULT_CONFIG")); Chap1.Translate_Configuration_Declaration (El); Pop_Identifier_Prefix (Mark); - Pop_Identifier_Prefix (Mark_Entity); - Pop_Identifier_Prefix (Mark_Sep); Pop_Identifier_Prefix (Mark_Arch); + Pop_Identifier_Prefix (Mark_Sep); + Pop_Identifier_Prefix (Mark_Entity); end; else Chap1.Translate_Configuration_Declaration (El); @@ -28308,6 +28309,7 @@ package body Translation is Assoc : O_Assoc_List; Instance : O_Dnode; Arch_Instance : O_Dnode; + Mark : Id_Mark_Type; begin Arch_Info := Get_Info (Arch); Entity_Info := Get_Info (Entity); @@ -28376,6 +28378,7 @@ package body Translation is -- init instance Push_Scope (Entity_Info.Block_Decls_Type, Instance); + Push_Identifier_Prefix (Mark, ""); Chap1.Translate_Entity_Init (Entity); -- elab instance @@ -28390,6 +28393,7 @@ package body Translation is New_Association (Assoc, New_Obj_Value (Arch_Instance)); New_Procedure_Call (Assoc); + Pop_Identifier_Prefix (Mark); Pop_Scope (Entity_Info.Block_Decls_Type); Finish_Subprogram_Body; |