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)

---
 translate/mcode/windows/complib.bat              |  4 +-
 translate/mcode/windows/windows_default_path.adb | 64 +++++++++++++++++-------
 2 files changed, 47 insertions(+), 21 deletions(-)

(limited to 'translate/mcode/windows')

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