I am new to openMP so bear with me. I use a macbook pro with OX Mavericks and installed a version of gfortran compatible with my OS.
I implemented a very simple dynamic programming problem to solve something that economist call the Neoclassical Growth Model.
I find no problem when I run it without openMP, however when trying to compile the program with -fopenmp option I get either
Illegal Instruction: 4 or
Segmentation Fault: 11
... probably I am doing something very wrong.
I attach the main program, subroutines, modules and .sh compilation file
PROGRAM prg_dp1
! PRG_DP1 SOLVES THE GROWTH MODEL BY VALUE FUNCTION ITERATION OVER A DISCRETE GRID
! WITHOUT INTERPOLATION. EVALUATION IS DONE OVER NEXT PERIOD CAPITAL
! PROBLEM: PROGRAMMED AS MATRICES IT LIMITS THE SIZE OF THE PROGRAM BEFORE !SEGMENTATION FAULTS OCCUR
USE modvar
IMPLICIT NONE
REAL(DP), DIMENSION(nk) :: v,v0,kp,c
REAL(DP), DIMENSION(nk,nk) :: cm,um,vm
REAL(DP) :: kstar,tbegin,tend
INTEGER :: it,ik1,ik2,ind(nk)
! INVOCATION OF THE OUTPUT FILES WHERE THE INFORMATION IS GOING TO BE WRITTEN
CALL CPU_TIME(tbegin)
! DEFINITION OF THE PARAMETERS OF THE MODEL
p(1)=1.0001 ! Intertemporal elasticity of substitution (SIGMA)
p(2)=0.96 ! Intertemporal discount factor (BETA)
p(3)=0.06 ! Depreciation rate (DELTA)
p(4)=0.36 ! Share of capital in production (ALPHA)
p(5)=0.00 ! (Parameter not needed)
! COMPUTATION OF THE STEADY STATE CAPITAL STOCK
kstar=((1.0/p(2)-(1.0-p(3)))/p(4))**(1.0/(p(4)-1.0))
! FIRST I ALLOCATE AND CONSTRUCT THE GRID
slope=1.0
gkmin=0.0001
gkmax=5.0*kstar
! ALLOCATE(gk(nk),ones(nk,nk))
ALLOCATE(gk(nk))
! ones=1.0
CALL sub_grid_generation(gk,nk,slope,gkmin,gkmax)
! DEFINITION OF THE MATRICES OF CONSUMPTION AND UTILITY
!$OMP PARALLEL DEFAULT(SHARED) PRIVATE(ik1,ik2)
!$OMP DO SCHEDULE(DYNAMIC)
DO ik1=1,nk
DO ik2=1,nk
cm(ik1,ik2)=gk(ik1)**p(4)+(1.0-p(3))*gk(ik1)-gk(ik2)
END DO
END DO
!$OMP END DO
!$OMP END PARALLEL
! cm = gk**p(4)+(1.0-p(3))*gk-gk*ones
WHERE (cm .le. 0.0)
um=-1.0e+6
ELSEWHERE
um=(cm**(1.0-p(1))-1.0)/(1.0-p(1))
END WHERE
! DINAMIC PROGRAMMING STEP
! I first initialize the value function to zeros
v0=0.0
! Main do has to be done by master-thread ... can I parallelize more?
DO
!$OMP PARALLEL DO PRIVATE(ik2)
DO ik2=1,nk
vm(:,ik2)=um(:,ik2)+p(2)*v0(ik2)
END DO
!$OMP END PARALLEL DO
v=MAXVAL(vm,DIM=2)
print *, MAXVAL(ABS(v-v0))
IF (MAXVAL(ABS(v-v0)) .le. dp_tol) THEN
EXIT
ELSE
v0=v
END IF
END DO
ind=MAXLOC(v,DIM=1)
kp=gk(ind)
c=gk**p(4)+(1.0-p(3))*gk-kp
open(unit=1,file='output.txt')
DO ik1=1,nk
write(1,'(4F10.5)') gk(ik1),v(ik1),kp(ik1),c(ik1)
END DO
close(1)
DEALLOCATE(gk)
CALL CPU_TIME(tend)
PRINT *, tend-tbegin
END PROGRAM prg_dp1
SUBROUTINE sub_grid_generation(grid,gsize,slope,gridmin,gridmax)
USE nrtype
INTEGER, INTENT(IN) :: gsize
REAL(DP), INTENT(IN) :: slope,gridmin,gridmax
REAL(DP), INTENT(OUT) :: grid(gsize)
INTEGER :: ig
grid(1)=gridmin
DO ig=2,gsize
grid(ig)=gridmin+((gridmax-gridmin)/dfloat(gsize)**slope)*dfloat(ig)**slope
END DO
END SUBROUTINE sub_grid_generation
MODULE nrtype
INTEGER, PARAMETER :: I4B = SELECTED_INT_KIND(9)
INTEGER, PARAMETER :: I2B = SELECTED_INT_KIND(4)
INTEGER, PARAMETER :: I1B = SELECTED_INT_KIND(2)
INTEGER, PARAMETER :: SP = KIND(1.0)
INTEGER, PARAMETER :: DP = KIND(1.0D0)
INTEGER, PARAMETER :: SPC = KIND((1.0,1.0))
INTEGER, PARAMETER :: DPC = KIND((1.0D0,1.0D0))
INTEGER, PARAMETER :: LGT = KIND(.true.)
REAL(SP), PARAMETER :: PI=3.141592653589793238462643383279502884197_sp
REAL(SP), PARAMETER :: PIO2=1.57079632679489661923132169163975144209858_sp
REAL(SP), PARAMETER :: TWOPI=6.283185307179586476925286766559005768394_sp
REAL(SP), PARAMETER :: SQRT2=1.41421356237309504880168872420969807856967_sp
REAL(SP), PARAMETER :: EULER=0.5772156649015328606065120900824024310422_sp
REAL(DP), PARAMETER :: PI_D=3.141592653589793238462643383279502884197_dp
REAL(DP), PARAMETER :: PIO2_D=1.57079632679489661923132169163975144209858_dp
REAL(DP), PARAMETER :: TWOPI_D=6.283185307179586476925286766559005768394_dp
REAL(DP), PARAMETER :: gr=(5.0**0.5-1.0)/2.0
TYPE sprs2_sp
INTEGER(I4B) :: n,len
REAL(SP), DIMENSION(:), POINTER :: val
INTEGER(I4B), DIMENSION(:), POINTER :: irow
INTEGER(I4B), DIMENSION(:), POINTER :: jcol
END TYPE sprs2_sp
TYPE sprs2_dp
INTEGER(I4B) :: n,len
REAL(DP), DIMENSION(:), POINTER :: val
INTEGER(I4B), DIMENSION(:), POINTER :: irow
INTEGER(I4B), DIMENSION(:), POINTER :: jcol
END TYPE sprs2_dp
END MODULE nrtype
MODULE modvar
USE nrtype
IMPLICIT NONE
REAL(DP), PARAMETER :: r_tol=1e-8
REAL(DP), PARAMETER :: p_tol=1e-6
REAL(DP), PARAMETER :: dp_tol=1e-6
REAL(DP), PARAMETER :: c_tol=0.001
REAL(DP), PARAMETER :: adj=0.5
INTEGER, PARAMETER :: r_m=10000
! PARAMETER THAT DEFINE THE DIMENSION OF THE PROBLEM
INTEGER, PARAMETER :: nk=5000
INTEGER, PARAMETER :: nz=21
INTEGER, PARAMETER :: np=20000
INTEGER, PARAMETER :: nt=5000
INTEGER, PARAMETER :: maxit=10000
INTEGER, PARAMETER :: dist_maxit=5000
! POLICY PARAMETER, COMMON ENDOGENOUS VARIABLES AND OTHER ALLOCATABLE ARRAYS
REAL(DP), PARAMETER :: nw=0.0
REAL(DP), PARAMETER :: ft=0.33
REAL(DP) :: p(5),gkmin,gkmax,slope
REAL(DP), ALLOCATABLE :: gk(:),gz(:),m(:,:),mss(:),ones(:,:)
END MODULE modvar
and the .sh file I use to compile
export OMP_NUM_THREADS=8
gfortran -O2 -fopenmp -c nrtype.f90 modvar.f90 sub_grid_generation.f90 prg_dp1.f90
gfortran -O2 -fopenmp -fcheck=bounds -o myprog nrtype.o modvar.o sub_grid_generation.o prg_dp1.o
I know this is tedious but I would appreciate some help
Thank you
The other options is to make the global arrays cm,um,vm, and possibly also the smaller other ones, allocatable. This will become handy when you change the problem size, read it from somewhere and maintain the executable.
REAL(DP), DIMENSION(:,:),allocatable :: cm,um,vm
allocate(cm(nk,nk),um(nk,nk),vm(nk,nk))
It is a stack space issue. I tried running it with ifort and even without openmp I get illegal instruction and I had to specify -heap-arrays in order to get it to run properly. Once I added openmp the illegal instruction error came back. The WHERE statement seems to be the problem code. In both the openmp and non-openmp runs that is the part that causes it to fail
OS X stack space is rather limited and you are creating large arrays. Using -heap-arrays helps, but once you use openmp that is no longer a possibility and ulimit is maxed out as ~64 MB.
I found adding this to your compilation works:
-Wl,-stack_size,0x40000000,-stack_addr,0xf0000000
Which increases the stack size to 1GB. This could probably be fine tuned, but I tried using 256 MB and it was still not enough.
Related
I'm trying to make a fortan code for displaying a colored ASCII art of 2D graphics in command prompt on Windows 10 systems, like a code distributed in the website below.
https://sites.google.com/site/akohlmey/random-hacks/text-mode-graphics-for-fortran
I have heard that command prompt on Windows 10 partially support ANSI escape sequences, and it is available if we enable the virtual terminal processing option.
There are some examples in C code, but I want to make a function or subroutine to enable ANSI escape sequences by Fortran code. For example, is it difficult to rewrite following simple C function by a Fortran function (or subroutine)?
bool enable_virtual_terminal_processing(FILE *stream) {
HANDLE handle = (HANDLE)_get_osfhandle(_fileno(stream));
DWORD mode = 0;
if (!GetConsoleMode(handle, &mode)) {
return false;
}
if (!SetConsoleMode(handle, mode | ENABLE_VIRTUAL_TERMINAL_PROCESSING)) {
return false;
}
return true;
}
An example below of Fortran source calling the necessary Windows APIs to set the console to the correct mode. Calling Windows APIs makes this source inherently platform specific - there are also some compiler specific directives (ifort and gfortran variants provided) necessary to fully define the API interfaces.
The library for the Win32 kernel API's will also need to be accessible, but this is often installed (or required) as part of installing a compiler on Windows.
Some compilers provide modules with the relevant interfaces to the Windows API, saving you the trouble of having to write them yourself.
PROGRAM WriteAnsi
IMPLICIT NONE
CALL set_ansi
PRINT "(A)", &
ACHAR(27) // '[31m' // 'H' // &
ACHAR(27) // '[32m' // 'e' // &
ACHAR(27) // '[33m' // 'l' // &
ACHAR(27) // '[34m' // 'l' // &
ACHAR(27) // '[35m' // 'o' // &
ACHAR(27) // '[0m'
CONTAINS
SUBROUTINE set_ansi
USE, INTRINSIC :: ISO_C_BINDING, ONLY: &
DWORD => C_LONG, & ! C_INT32_T really, but this is per the docs
HANDLE => C_INTPTR_T, &
BOOL => C_INT
INTEGER(HANDLE), PARAMETER :: INVALID_HANDLE_VALUE = -1_HANDLE
INTERFACE
FUNCTION GetStdHandle(nStdHandle) BIND(C, NAME='GetStdHandle')
IMPORT :: DWORD
IMPORT :: HANDLE
IMPLICIT NONE
INTEGER(DWORD), INTENT(IN), VALUE :: nStdHandle
INTEGER(HANDLE) :: GetStdHandle
!DEC$ ATTRIBUTES STDCALL :: GetStdHandle
!GCC$ ATTRIBUTES STDCALL :: GetStdHandle
END FUNCTION GetStdHandle
END INTERFACE
INTEGER(DWORD), PARAMETER :: STD_INPUT_HANDLE = -10_DWORD
INTEGER(DWORD), PARAMETER :: STD_OUTPUT_HANDLE = -11_DWORD
INTEGER(DWORD), PARAMETER :: STD_ERROR_HANDLE = -12_DWORD
INTERFACE
FUNCTION GetConsoleMode(hConsoleHandle, lpMode) BIND(C, NAME='GetConsoleMode')
IMPORT :: HANDLE
IMPORT :: DWORD
IMPORT :: BOOL
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN), VALUE :: hConsoleHandle
INTEGER(DWORD), INTENT(OUT) :: lpMode
!DEC$ ATTRIBUTES REFERENCE :: lpMode
INTEGER(BOOL) :: GetConsoleMode
!DEC$ ATTRIBUTES STDCALL :: GetConsoleMode
!GCC$ ATTRIBUTES STDCALL :: GetConsoleMode
END FUNCTION GetConsoleMode
END INTERFACE
INTEGER(DWORD), PARAMETER :: ENABLE_ECHO_INPUT = INT(Z'0004', DWORD)
INTEGER(DWORD), PARAMETER :: ENABLE_INSERT_MODE = INT(Z'0020', DWORD)
INTEGER(DWORD), PARAMETER :: ENABLE_LINE_INPUT = INT(Z'0002', DWORD)
INTEGER(DWORD), PARAMETER :: ENABLE_MOUSE_INPUT = INT(Z'0010', DWORD)
INTEGER(DWORD), PARAMETER :: ENABLE_PROCESSED_INPUT = INT(Z'0001', DWORD)
INTEGER(DWORD), PARAMETER :: ENABLE_QUICK_EDIT_MODE = INT(Z'0040', DWORD)
INTEGER(DWORD), PARAMETER :: ENABLE_WINDOW_INPUT = INT(Z'0008', DWORD)
INTEGER(DWORD), PARAMETER :: ENABLE_VIRTUAL_TERMINAL_INPUT = INT(Z'0200', DWORD)
INTEGER(DWORD), PARAMETER :: ENABLE_PROCESSED_OUTPUT = INT(Z'0001', DWORD)
INTEGER(DWORD), PARAMETER :: ENABLE_WRAP_AT_EOL_OUTPUT = INT(Z'0002', DWORD)
INTEGER(DWORD), PARAMETER :: ENABLE_VIRTUAL_TERMINAL_PROCESSING = INT(Z'0004', DWORD)
INTEGER(DWORD), PARAMETER :: DISABLE_NEWLINE_AUTO_RETURN = INT(Z'00008', DWORD)
INTEGER(DWORD), PARAMETER :: ENABLE_LVB_GRID_WORLDWIDE = INT(Z'0010', DWORD)
INTERFACE
FUNCTION SetConsoleMode(hConsoleHandle, dwMode) BIND(C, NAME='SetConsoleMode')
IMPORT :: HANDLE
IMPORT :: DWORD
IMPORT :: BOOL
IMPLICIT NONE
INTEGER(HANDLE), INTENT(IN), VALUE :: hConsoleHandle
INTEGER(DWORD), INTENT(IN), VALUE :: dwMode
INTEGER(BOOL) :: SetConsoleMode
!DEC$ ATTRIBUTES STDCALL :: SetConsoleMode
!GCC$ ATTRIBUTES STDCALL :: SetConsoleMode
END FUNCTION SetConsoleMode
END INTERFACE
INTEGER(DWORD), PARAMETER :: ENABLE_EXTENDED_FLAGS = INT(Z'0080', DWORD)
INTEGER(HANDLE) :: output_handle
INTEGER(BOOL) :: api_result
INTEGER(DWORD) :: mode
output_handle = GetStdHandle(STD_OUTPUT_HANDLE)
IF (output_handle == INVALID_HANDLE_VALUE) THEN
ERROR STOP 'GetStdHandle failed'
END IF
api_result = GetConsoleMode(output_handle, mode)
IF (api_result == 0_BOOL) THEN
ERROR STOP 'GetConsoleMode failed'
END IF
api_result = SetConsoleMode( &
output_handle, &
IOR(mode, ENABLE_VIRTUAL_TERMINAL_PROCESSING) )
IF (api_result == 0_BOOL) THEN
ERROR STOP 'SetConsoleMode failed'
END IF
END SUBROUTINE set_ansi
END PROGRAM WriteAnsi
It is easy to call a C function from Fortran (hundreds of questions and answers here).
And it is almost impossible to write the above in Fortran, it is systems programming, you would need the right libraries Maybe some compilers supply them, but it is not standard.
Just call your C function from Fortran. The FILE * argument wonn't be available in Fortran directly, you need to get the pointer in C as well.
After enabling, you can write the sequences very easily How to print in the same position in fortran clear screen in Fortran
Is it possible to have a Fortran program load a Fortran library at run time? If so, would it be possible to modify a function and recompile only the library to have the originally-compiled program call the modified function in the library at run time?
If anyone can provide a minimal working example of how this could be achieved that would be great.
Here are some few links that can be helpfull:
This page on rosettacode.org which gives complete example with details and discuss implementation on linux and MACOS
This intel forum post where Steve Lionel give some advice on how to do the dynamic loading with ifort
this IBM page with a great explanation of dynamic libraries and their usage
If you want a small easy to understand code, keep reading. Few days ago, I was playing with dynamic loading. My test code below might be of help to you. However I work in the linux environment and you might have to adapt few thing here and there for it to work on your OS X environment. The rosettacode.org link above will come handy to help you.
Here is the code for the test dynamic lib
[username#hostname:~/test]$cat test.f90
module test
use, intrinsic :: iso_c_binding
contains
subroutine t_times2(v_in, v_out) bind(c, name='t_times2')
integer, intent(in) :: v_in
integer, intent(out) :: v_out
!
v_out=v_in*2
end subroutine t_times2
!
subroutine t_square(v_in, v_out) bind(c, name='t_square')
integer(c_int), intent(in) :: v_in
integer(c_int), intent(out) :: v_out
!
v_out=v_in**2
end subroutine t_square
end module test
Compiled as
[username#hostname:~/test]$gfortran -c test.f90
[username#hostname:~/test]$gfortran -shared -o test.so test.o
Here is the test program
[username#hostname:~/test]$cat example.f90
program example
use :: iso_c_binding
implicit none
integer(c_int), parameter :: rtld_lazy=1 ! value extracte from the C header file
integer(c_int), parameter :: rtld_now=2 ! value extracte from the C header file
!
! interface to linux API
interface
function dlopen(filename,mode) bind(c,name="dlopen")
! void *dlopen(const char *filename, int mode);
use iso_c_binding
implicit none
type(c_ptr) :: dlopen
character(c_char), intent(in) :: filename(*)
integer(c_int), value :: mode
end function
function dlsym(handle,name) bind(c,name="dlsym")
! void *dlsym(void *handle, const char *name);
use iso_c_binding
implicit none
type(c_funptr) :: dlsym
type(c_ptr), value :: handle
character(c_char), intent(in) :: name(*)
end function
function dlclose(handle) bind(c,name="dlclose")
! int dlclose(void *handle);
use iso_c_binding
implicit none
integer(c_int) :: dlclose
type(c_ptr), value :: handle
end function
end interface
! Define interface of call-back routine.
abstract interface
subroutine called_proc (i, i2) bind(c)
use, intrinsic :: iso_c_binding
integer(c_int), intent(in) :: i
integer(c_int), intent(out) :: i2
end subroutine called_proc
end interface
! testing the dynamic loading
integer i, i2
type(c_funptr) :: proc_addr
type(c_ptr) :: handle
character(256) :: pName, lName
procedure(called_proc), bind(c), pointer :: proc
!
i = 15
handle=dlopen("./test.so"//c_null_char, RTLD_LAZY)
if (.not. c_associated(handle))then
print*, 'Unable to load DLL ./test.so'
stop
end if
!
proc_addr=dlsym(handle, "t_times2"//c_null_char)
if (.not. c_associated(proc_addr))then
write(*,*) 'Unable to load the procedure t_times2'
stop
end if
call c_f_procpointer( proc_addr, proc )
call proc(i,i2)
write(*,*) "t_times2, i2=", i2
!
proc_addr=dlsym( handle, "t_square"//c_null_char )
if ( .not. c_associated(proc_addr) )then
write(*,*)'Unable to load the procedure t_square'
stop
end if
call c_f_procpointer(proc_addr, proc)
call proc(i,i2)
write(*,*) "t_square, i2=", i2
contains
end program example
Compiled and run as:
[username#hostname:~/test]$gfortran -o example example.f90 -ldl
[username#hostname:~/test]$./example
t_times2, i2= 30
t_square, i2= 225
[username#hostname:~/test]$
I am trying to compile a package written mainly in F90 that looks like this:
subroutine soil_default_fill(cgrid,ifm,ipy)
implicit none
!----- Arguments -----------------------------------------------------------------------!
type(edtype) , target :: cgrid
integer , intent(in) :: ifm
integer , intent(in) :: ipy
!----- Local variables -----------------------------------------------------------------!
STUFF
return
end subroutine soil_default_fill
!==========================================================================================!
subroutine set_site_defprops()
implicit none
!----- Local variables -----------------------------------------------------------------!
type(edtype) , pointer :: cgrid
integer :: ifm
integer :: ipy
STUFF
call soil_default_fill(cgrid,ifm,ipy)
STUFF
return
end subroutine set_site_defprops
!==========================================================================================!
When I try to compile I get the following error:
mpif90 -c -DUSE_INTERF=1 -DUSENC=0 -DMAC_OS_X -DUSE_HDF5=1 -DUSE_COLLECTIVE_MPIO=0 -DUSE_MPIWTIME=0 -O3 -ffree-line-length-none -fno-whole-file -I/Users/manfredo/Desktop/ED2/ED/src/include -I/usr/hdf5/include -DRAMS_MPI ed_init.F90
ed_init.F90:131.31:
call soil_default_fill(cgrid,ifm,ipy)
1
Error: Explicit interface required for 'soil_default_fill' at (1): target argument
make[1]: *** [ed_init.o] Error 1
make: *** [all] Error 2
I already tried to include the subroutine in an interface or in a module but it didn't worked (as I said I am new to Fortran so it is likely that I made some mistakes).
Thanks for help
It's a very simple answer but,
Did you set up your module file like this example?
!----------------------------------------------------------!
module "Your Name here (without commas)"
use a_module !!! if you need one, in the other case delete it
use b_module !!! if you need another one, in the other case delete it
implicit none
public :: set_site_defprops !!! put a comment here if you want
public :: soil_default_fill !!! put a comment here if you want
contains
subroutine soil_default_fill(cgrid,ifm,ipy)
implicit none
!----- Arguments ----------------------------------------------------------!
type(edtype) , target :: cgrid
integer , intent(in) :: ifm
integer , intent(in) :: ipy
!----- Local variables ----------------------------------------------------!
STUFF
return
end subroutine soil_default_fill
!==============================================================================!
subroutine set_site_defprops()
implicit none
!----- Local variables -------------------------------------------------!
type(edtype) , pointer :: cgrid
integer :: ifm
integer :: ipy
STUFF
call soil_default_fill(cgrid,ifm,ipy)
STUFF
return
end subroutine set_site_defprops
!==============================================================================!
end module "Your Name here (without commas)"
I want to write a small program that reads data from a text file and then imports it into the Windows Registry. I've found the bindings to the Windows functions in the System.Win32.Registry package, but ran into an issue with the regSetValueEx function. When I want to import a number as a DWORD (Word32) I can't figure out how to pass it to regSetValueEx to get the desired result.
Right now I'm storing the number as a TCHAR and using alloca and poke to get a pointer. Here's the code I'm using for testing:
module Main where
import Foreign.Marshal.Alloc
import Foreign.Storable
import System.Win32.Registry
import System.Win32.Types
number :: TCHAR
number = 42
getKey :: IO HKEY
getKey = regOpenKey hKEY_CURRENT_USER "test"
importFromTCHAR :: IO ()
importFromTCHAR = alloca $ \ptr -> do
poke ptr number
key <- getKey
regSetValueEx key "tchar" rEG_DWORD ptr (sizeOf (undefined::DWORD))
main :: IO ()
main = importFromTCHAR
The result: 0x0184002a
It kinda works, but since the size of a TCHAR value is only 2 bytes the other two bytes is taken up by junk. How can I prevent this? Any help would be greatly appreciated. I'm fairly new to Haskell (only recently finished LYAH), so please go easy on me. :)
Also, I'd really like to know what libraries more experienced Haskellers use to interface with the Windows Registry. Is there any libraries that makes working with it easier?
EDIT: Alright, as it turns out while looking through the packages on Hackage I somehow missed the castPtr function in the Foreign.Ptr package. I feel like an idiot, because with it the solution is really easy. As per Ilya's answer I just need to store the number as a Word32 (or DWORD), poke it into the pointer alloca gives me and then call castPtr on it before I pass it to regSetValueEx. Here's the modified code:
module Main where
import Foreign.Marshal.Alloc
import Foreign.Ptr
import Foreign.Storable
import System.Win32.Registry
import System.Win32.Types
number :: DWORD
number = 42
getKey :: IO HKEY
getKey = regOpenKey hKEY_CURRENT_USER "test"
importFromDWORD :: IO ()
importFromDWORD = alloca $ \ptr -> do
poke ptr number
key <- getKey
regSetValueEx key "dword" rEG_DWORD (castPtr ptr) (sizeOf number)
main :: IO ()
main = importFromDWORD
Just define number as Word32 from Data.Word:
number :: Word32
number = 42
Also you can use sizeOf on normal value like: sizeOf number
I have some fortran tests I would like to run in CTest using create_test_sourcelist. This is a utility that creates a driver in C or C++, which calls the fortran test routines and expects the signature:
int fortname(int argv, char** argc)
Can someone explain the correct way to interface this signature, probably with iso_c_bindings as I understand these are getting pretty standard. I believe it is the char** that is making me hurt -- there are plenty of examples around for the integer argument.
Thanks!
Assuming that the meaning of argc and argv in the context of a C program's main function apply, then you could do something like:
! Default binding label is already lower case, but for clarity
! it is good practice to specify the binding label explicitly.
function fortname(argc, argv) bind(c, name='fortname')
use, intrinsic :: iso_c_binding, only: c_int, c_ptr
implicit none
!----
! Note C std allows argc == 0
integer(c_int), intent(in), value :: argc
! Lower bound set to match C convention where element 0 probably
! is name of program. May be zero size.
type(c_ptr), intent(in) :: argv(0:argc-1)
! Function result.
integer(c_int) :: fortname
To convert those arguments across to something that is easier to use in Fortran (and further assuming that your Fortran processor supports all applicable parts of the Fortran 2003 standard, noting that deferred length character components are not currently supported by at least one commonly used processor) you could then...
!----
! Name of the program.
character(:), allocatable :: prog_name
! Type to use for arrays of pointers to variable length strings.
type :: string
character(:), allocatable :: item
end type string
! Our arguments. May be zero size.
type(string) :: arguments(argc-1)
integer :: i ! argument index.
!****
if (argc > 0) then ! argv has something useful
! make program name accessible to fortran code.
call c_f_string(argv(0), prog_name)
! make arguments accessible to fortran code.
do i = 1, size(arguments)
call c_f_string(argv(i), arguments(i)%item)
end do
else ! no useful information provided in argv
prog_name = ''
end if
! Work with arguments%item and prog_name...
print "(A)", prog_name
do i = 1, size(arguments) ; print "(A)", arguments(i)%item ; end do
fortname = 0
contains
! Copy a null terminated C string (specified via a non-null c_ptr) to an
! allocatable deferred length default character variable.
subroutine c_f_string(c_string, f_string)
use, intrinsic :: iso_c_binding, only: c_char, c_null_char, c_f_pointer
!----
type(c_ptr), intent(in) :: c_string
character(:), intent(out), allocatable :: f_string
!----
! Array for accessing string pointed at by C pointer
character(kind=c_char), pointer :: string_ptr(:)
integer :: i ! string index
interface
! Steal std C library function rather than writing our own.
function strlen(s) bind(c, name='strlen')
use, intrinsic :: iso_c_binding, only: c_ptr, c_size_t
implicit none
!----
type(c_ptr), intent(in), value :: s
integer(c_size_t) :: strlen
end function strlen
end interface
!****
! Map C pointer to fortran character array
call c_f_pointer(c_string, string_ptr, [strlen(c_string)])
! Allocate fortran character variable to the c string's length
allocate(character(size(string_ptr)) :: f_string)
! Copy across (with possible kind conversion) characters
forall (i = 1:size(string_ptr)) f_string(i:i) = string_ptr(i)
end subroutine c_f_string
end function fortname
Your fortran declaration would be something like this (I think you got argc and argv mixed up so I swapped them):
function fortname(argc, argv) bind(c)
use iso_c_binding
integer(c_int), value :: argc
type(c_ptr) :: argv
end function
You then need to write some code to convert argc to a fortran type. You can convert c pointer to fortran pointers using the c_f_ptr instrinsic. The tricky bit is that you have the double indirection, since fortran doesn't support the concept of a pointer to a pointer. Possibly the following would work, which prints out each argument
type(c_ptr), pointer :: argv_f
character(c_char), pointer :: string_n
call c_f_ptr(argv, argv_f)
do n=1,argc
call_c_f_ptr(argvf(n), string_n)
print *, string_n
end do
Disclaimer: I haven't compiled or run this code!