From c1ab3fc41cb1962db2a6909dfd07e8f088fadb8f Mon Sep 17 00:00:00 2001
From: Jeffrey Armstrong <jeff@approximatrix.com>
Date: Fri, 18 Feb 2022 09:54:40 -0500
Subject: Added detection of 32bit Windows and prepend -m32 flags when
 detected, specific to using a mingw64 multilib compiler.  Moved default
 location to local app data.

---
 src/fpm_os.F90 | 75 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 74 insertions(+), 1 deletion(-)

(limited to 'src/fpm_os.F90')

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
-- 
cgit v1.2.3