add one more underscore to chkstk, use program path for install path (windows)

6 files changed, 59 insertions, 31 deletions

diff --git a/ortho/mcode/ortho_code-x86-abi.adb b/ortho/mcode/ortho_code-x86-abi.adb
index db223849a..67b4de236 100644
--- a/ortho/mcode/ortho_code-x86-abi.adb
+++ b/ortho/mcode/ortho_code-x86-abi.adb
@@ -717,7 +717,7 @@ package body Ortho_Code.X86.Abi is
    pragma Import (C, Muldi3, "__muldi3");
 
    procedure Chkstk (Sz : Integer);
-   pragma Import (C, Chkstk, "_chkstk");
+   pragma Import (C, Chkstk, "__chkstk");
 
    procedure Link_Intrinsics
    is
diff --git a/ortho/mcode/ortho_code-x86-emits.adb b/ortho/mcode/ortho_code-x86-emits.adb
index 97f389656..85327fd52 100644
--- a/ortho/mcode/ortho_code-x86-emits.adb
+++ b/ortho/mcode/ortho_code-x86-emits.adb
@@ -2243,7 +2243,7 @@ package body Ortho_Code.X86.Emits is
       end if;
 
       if X86.Flags.Flag_Alloca_Call then
-         Chkstk_Symbol := Create_Symbol (Get_Identifier ("__chkstk"));
+         Chkstk_Symbol := Create_Symbol (Get_Identifier ("___chkstk"));
       end if;
 
       Intrinsics_Symbol (Intrinsic_Mul_Ov_U64) :=
diff --git a/translate/grt/config/chkstk.S b/translate/grt/config/chkstk.S
index 1f29245d8..79abfb21f 100644
--- a/translate/grt/config/chkstk.S
+++ b/translate/grt/config/chkstk.S
@@ -5,16 +5,16 @@
 
 	/* Function called to loop on the process.  */	
 	.align 4
-	.type	_chkstk,@function
-	.global _chkstk
-_chkstk:
+	.type	__chkstk,@function
+	.global __chkstk
+__chkstk:
 	testl	%eax,%eax
-	je	_chkstk_zero
+	je	0f
 	subl	$4,%eax		/* 4 bytes already used by call.  */
 	subl	%eax,%esp
 	jmp	*(%esp,%eax)
-_chkstk_zero:
+0:
 	ret
-	.size	_chkstk, . - _chkstk
+	.size	__chkstk, . - __chkstk
 
 	.ident	"Written by T.Gingold"
diff --git a/translate/mcode/winbuild.bat b/translate/mcode/winbuild.bat
index ef16f1ee0..bbe031d61 100644
--- a/translate/mcode/winbuild.bat
+++ b/translate/mcode/winbuild.bat
@@ -1,13 +1,15 @@
 call windows\compile

 if errorlevel 1 goto end

+

 call windows\complib

 if errorlevel 1 goto end

-"f:\Program Files\NSIS\makensis" windows\ghdl.nsi

-if errorlevel 1 goto end

 

 gnatmake windows/ghdlversion -o windows/ghdlversion.exe

 windows\ghdlversion < ../../version.ads > windows/version.nsi

 

+"f:\Program Files\NSIS\makensis" windows\ghdl.nsi

+if errorlevel 1 goto end

+

 exit /b 0

 

 :end

diff --git a/translate/mcode/windows/complib.bat b/translate/mcode/windows/complib.bat
index 038a80e7f..88a43ce60 100644
--- a/translate/mcode/windows/complib.bat
+++ b/translate/mcode/windows/complib.bat
@@ -52,7 +52,7 @@ mkdir ieee
 cd ieee

 echo Base ieee

 for %%F in (%IEEE_SRCS%) do %REL%\build\ghdlfilter -v93 < %LIBSRC%\ieee\%%F.vhdl > %%F.v93 && %REL%\build\%GHDL% -a --std=93 -P..\std --work=ieee %%F.v93

-echo Vital 2000
+echo Vital 2000

 for %%F in (%VITAL2000_SRCS%) do copy %LIBSRC%\vital2000\%%F.vhdl %%F.vhd && %REL%\build\%GHDL% -a --std=93 -P..\std --work=ieee %%F.vhd

 cd ..

 

@@ -65,4 +65,4 @@ cd ..
 

 cd ..

 

-cd ..
\ No newline at end of file
+cd ..

diff --git a/translate/mcode/windows/windows_default_path.adb b/translate/mcode/windows/windows_default_path.adb
index 8ad27ed85..2538e5df9 100644
--- a/translate/mcode/windows/windows_default_path.adb
+++ b/translate/mcode/windows/windows_default_path.adb
@@ -1,19 +1,45 @@
-with GNAT.Registry; use GNAT.Registry;

-

-package body Windows_Default_Path is

-   function Get_Windows_Default_Path return String

-   is

-      Key : HKEY;

-   begin

-      Key := Open_Key (HKEY_LOCAL_MACHINE, "Software\Ghdl");

-      declare

-	 Res : String := Query_Value (Key, "Install_Dir");

-      begin

-	 return Res & "\lib\";

-      end;

-   exception

-      when Registry_Error =>

-	 --  Do not write an error message, but return a useful default path.

-	 return "{missing HKLM\Software\Ghdl\Install_Dir key}\lib\";

-   end Get_Windows_Default_Path;

-end Windows_Default_Path;

+with Interfaces.C; use Interfaces.C;
+with System; use System;
+
+package body Windows_Default_Path is
+
+   subtype DWORD is Interfaces.C.Unsigned_Long;
+   subtype LPWSTR is String;
+   subtype HINSTANCE is Address;
+   function GetModuleFileName (Inst : HINSTANCE; Buf : Address; Size : DWORD)
+                              return DWORD;
+   pragma Import (Stdcall, GetModuleFileName, "GetModuleFileNameA");
+
+   function Get_Windows_Default_Path return String
+   is
+      File : String (1 .. 256);
+      Size : DWORD;
+      P : Natural;
+   begin
+      --  Get exe file path.
+      Size := GetModuleFileName (Null_Address, File'Address, File'Length);
+      if Size = 0 or Size = File'Length then
+         return "{cannot find install path}\lib";
+      end if;
+
+      --  Remove Program file.
+      P := Natural (Size);
+      while P > 0 loop
+         exit when File (P) = '\';
+         exit when File (P) = ':' and P = 2;
+         P := P - 1;
+      end loop;
+      if File (P) = '\' and P > 1 then
+         --  Remove directory
+         P := P - 1;
+         while P > 0 loop
+            exit when File (P) = '\';
+            exit when File (P) = ':' and P = 2;
+            P := P - 1;
+         end loop;
+      end if;
+
+      return File (1 .. P) & "lib";
+   end Get_Windows_Default_Path;
+end Windows_Default_Path;
+