diff options
author | umarcor <unai.martinezcorral@ehu.eus> | 2021-01-05 20:46:15 +0100 |
---|---|---|
committer | tgingold <tgingold@users.noreply.github.com> | 2021-01-06 07:30:46 +0100 |
commit | 99853361819bff87e7cf8103c5205721ec195c32 (patch) | |
tree | 29a6dda1199534497f5a09ea1268aa3a619c41b8 /dist/windows/mcode/windows_default_path.adb | |
parent | 301f442a6e66a83b47ed7d40e5b61389b9c33446 (diff) | |
download | ghdl-99853361819bff87e7cf8103c5205721ec195c32.tar.gz ghdl-99853361819bff87e7cf8103c5205721ec195c32.tar.bz2 ghdl-99853361819bff87e7cf8103c5205721ec195c32.zip |
mv dist/* scripts/
Diffstat (limited to 'dist/windows/mcode/windows_default_path.adb')
-rw-r--r-- | dist/windows/mcode/windows_default_path.adb | 68 |
1 files changed, 0 insertions, 68 deletions
diff --git a/dist/windows/mcode/windows_default_path.adb b/dist/windows/mcode/windows_default_path.adb deleted file mode 100644 index c627356f9..000000000 --- a/dist/windows/mcode/windows_default_path.adb +++ /dev/null @@ -1,68 +0,0 @@ --- 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; |