From dad8fb6d64a2b12a7b929f1c63b7dfd6b177b3ea Mon Sep 17 00:00:00 2001
From: gingold
Date: Thu, 5 Oct 2006 00:23:04 +0000
Subject: add one more underscore to chkstk, use program path for install path
 (windows)

---
 ortho/mcode/ortho_code-x86-abi.adb               |  2 +-
 ortho/mcode/ortho_code-x86-emits.adb             |  2 +-
 translate/grt/config/chkstk.S                    | 12 ++---
 translate/mcode/winbuild.bat                     |  6 ++-
 translate/mcode/windows/complib.bat              |  4 +-
 translate/mcode/windows/windows_default_path.adb | 64 +++++++++++++++++-------
 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 db22384..67b4de2 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 97f3896..85327fd 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 1f29245..79abfb2 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 ef16f1e..bbe031d 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 038a80e..88a43ce 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 8ad27ed..2538e5d 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;
+
-- 
cgit