synchronize: add support for MacOSX, fix bogus type conversion

28 files changed, 227 insertions, 115 deletions

diff --git a/iirs_utils.adb b/iirs_utils.adb
index a16fa0b2d..a3ca40820 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 cdec5c40f..182397a9e 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 58c5a7988..488aac8a4 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 c53cd4817..28186d094 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 a35d6956a..c3114230b 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 b8da44cc8..0724bcc19 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 ffff28e2a..0ac6ceed8 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 75fedd0ed..83071b446 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 446fde6ea..fda7a2123 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 0087bb1b9..5456235fe 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 613e37b2c..d13004295 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 85327fd52..3f71f8709 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 44179a443..699a38c9e 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 cc83afa40..bfd1635c3 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 404c9be7f..0657b07e6 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 c42c3dab3..686ff439a 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 229fb14c1..3838f5cfb 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 002d177c1..b82e33b7d 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 79abfb21f..3fa5cc683 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 fbd8954cb..2490ea1dd 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 4a6aca83c..627316119 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 b531aef11..b83902362 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 9037fcebe..6da675d1b 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 3b3f1f388..d1de1d7a3 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 819b5db22..6fd0bb616 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 f2c30b60c..2af34a237 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 9f4ffa93c..a7f06f77a 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 90f961f0a..8ce7e0f4d 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;