aboutsummaryrefslogtreecommitdiff
path: root/src/fpm_os.F90
diff options
context:
space:
mode:
Diffstat (limited to 'src/fpm_os.F90')
-rw-r--r--src/fpm_os.F9075
1 files changed, 74 insertions, 1 deletions
diff --git a/src/fpm_os.F90 b/src/fpm_os.F90
index 71663fe..9b2be10 100644
--- a/src/fpm_os.F90
+++ b/src/fpm_os.F90
@@ -3,7 +3,7 @@ module fpm_os
use fpm_error, only : error_t, fatal_error
implicit none
private
- public :: change_directory, get_current_directory
+ public :: change_directory, get_current_directory, windows_is_wow64
#ifndef _WIN32
character(len=*), parameter :: pwd_env = "PWD"
@@ -101,5 +101,78 @@ contains
lhs = transfer(rhs(1:ii-1), lhs)
end subroutine c_f_character
+
+#ifdef _WIN32
+ function windows_is_wow64() result(wow64)
+ use iso_c_binding
+ implicit none
+
+ logical(kind=c_bool), target::wow64
+
+ ! If compiled for 64-bit, then the answer is no
+#ifndef __i386__
+
+ wow64 = .false.
+
+#else
+
+ interface
+ function IsWow64Process(h, cptrbool)
+ type(c_ptr), value::h, cptrbool
+ logical(kind=c_bool)::IsWow64Process
+ end function IsWow64Process
+ end interface
+
+ interface
+ function GetModuleHandle(str) bind(c)
+ character(len=*, kind=c_char)::str
+ type(c_ptr)::GetModuleHandle
+ end function GetModuleHandle
+ end interface
+
+ interface
+ function GetProcAddress(libptr, str) bind(c)
+ type(c_ptr), value::libptr
+ character(len=*, kind=c_char)::str
+ type(c_funptr)::GetProcAddress
+ end function GetProcAddress
+ end interface
+
+ interface
+ function GetCurrentProcess() bind(c)
+ type(c_ptr)::GetCurrentProcess
+ end function GetCurrentProcess
+ end interface
+
+ type(c_funptr)::wow64_c
+ procedure(IsWow64Process), pointer::wow64_f
+
+
+ wow64_c = GetProcAddress( &
+ GetModuleHandle("kernel32"//c_null_char), &
+ "IsWow64Process"//c_null_char)
+
+ if(wow64_c == c_null_funptr) then
+ wow64 = .false.
+ else
+ call c_f_procpointer(wow64_c, wow64_f)
+ if(.not. wow64_f(GetCurrentProcess(), c_loc(wow64))) then
+ wow64 = .false.
+ end if
+ end if
+#endif
+
+ end function windows_is_wow64
+
+#else
+
+ ! Non-windows systems...
+ function windows_is_wow64()
+ implicit none
+ logical::windows_is_wow64
+ windows_is_wow64 = .false.
+ end function windows_is_wow64
+
+#endif
end module fpm_os