1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
-- Find installation path (using executable).
-- Copyright (C) 2002 - 2016 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
-- Software Foundation; either version 2, or (at your option) any later
-- version.
--
-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
-- for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with GCC; see the file COPYING. If not, write to the Free
-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
--
-- As a special exception, if other files instantiate generics from this
-- unit, or you link this unit with other files to produce an executable,
-- this unit does not by itself cause the resulting executable to be
-- covered by the GNU General Public License. This exception does not
-- however invalidate any other reasons why the executable file might be
-- covered by the GNU Public License.
with Interfaces.C; use Interfaces.C;
with System; use System;
package body Windows_Default_Path is
subtype DWORD is Interfaces.C.Unsigned_Long;
subtype HINSTANCE is Address;
function GetModuleFileName (Inst : HINSTANCE; Buf : Address; Size : DWORD)
return DWORD;
pragma Import (Stdcall, GetModuleFileName, "GetModuleFileNameA");
function Get_Windows_Exec_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);
end Get_Windows_Exec_Path;
end Windows_Default_Path;
|
