synchronize: add support for MacOSX, fix bogus type conversion

12 files changed, 109 insertions, 55 deletions

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;