"Nick Maclaren" wrote in message news:npudc3$ir2$1...@dont-email.me...
> Yes. Some older FORTRAN compilers relied on self-modifying code,
> and still allowed recursion; full (asynchronous) reentrancy is not
> needed, though it (arguably) is for OpenMP support. But, as Ivan
> says, nested functions do NOT need self-modifying code, nor does
> dynamic code generation, as was well-known in the 1960s.
While both you and Ivan, two sources whom I have cause to respect,
have asserted this, I still can't see how it works. I have rewritten my
previous example for greater clarity and flexibility and would like to
be informed how it might work with either the same address for all
functions or all different addresses without self-modifying code:
D:\gfortran\clf\nested>type Csub1.c
#include <stdio.h>
struct funs
{
void(*fset)(int x);
int(*fget)();
};
void Csub1(struct funs array[], int N)
{
int i, value, total;
for(i = 0; i < N; i++)
{
value = i+1;
printf("Address of setter function %2d = %p. Value set = %d\n",
i,(void *)array[i].fset,value);
array[i].fset(value);
}
total = 0;
for(i = 0; i < N; i++)
{
printf("Address of getter function %2d = %p. Value gotten = %d\n",
i,(void *)array[i].fget,array[i].fget());
total += array[i].fget();
}
printf("Sum of values gotten = %d\n", total);
}
D:\gfortran\clf\nested>gcc -Wall Csub1.c -c
D:\gfortran\clf\nested>type nested1.f90
module funcs
use ISO_C_BINDING
implicit none
type, bind(C) :: funs
type(C_FUNPTR) fset
type(C_FUNPTR) fget
end type funs
interface
subroutine Csub1(array, N) bind(C,name='Csub1')
import
implicit none
type(funs) array(*)
integer(C_INT), value :: N
end subroutine Csub1
end interface
contains
RECURSIVE subroutine outer(array, N, i)
type(funs) array(*)
integer(C_INT), value :: N, i
integer(C_INT) x
array(i) = funs(C_FUNLOC(fset),C_FUNLOC(fget))
call callback(array, N, i+1)
contains
subroutine fset(new) bind(C)
integer(C_INT), value :: new
x = new
end subroutine fset
function fget() bind(C)
integer(C_INT) fget
fget = x
end function fget
end subroutine outer
RECURSIVE subroutine callback(array, N, i)
type(funs) array(*)
integer(C_INT), value :: N, i
if(i <= N) then
call outer(array, N, i)
else
call Csub1(array, N)
end if
end subroutine callback
end module funcs
program test
use funcs
implicit none
integer N
type(funs), allocatable :: array(:)
write(*,'(a)',advance='no') 'Please enter the number of functions:> '
read(*,*) N
allocate(array(N))
call callback(array, N, 1)
end program test
D:\gfortran\clf\nested>gfortran -Wall nested1.f90 Csub1.o -onested1
nested1.f90:28:12:
function fget() bind(C)
1
Warning: 'fget' declared at (1) may shadow the intrinsic of the same name.
In o
rder to call the intrinsic, explicit INTRINSIC declarations may be required.
[-W
intrinsic-shadow]
D:\gfortran\clf\nested>nested1
Please enter the number of functions:> 10
Address of setter function 0 = 000000000023FB3C. Value set = 1
Address of setter function 1 = 000000000023FA2C. Value set = 2
Address of setter function 2 = 000000000023F91C. Value set = 3
Address of setter function 3 = 000000000023F80C. Value set = 4
Address of setter function 4 = 000000000023F6FC. Value set = 5
Address of setter function 5 = 000000000023F5EC. Value set = 6
Address of setter function 6 = 000000000023F4DC. Value set = 7
Address of setter function 7 = 000000000023F3CC. Value set = 8
Address of setter function 8 = 000000000023F2BC. Value set = 9
Address of setter function 9 = 000000000023F1AC. Value set = 10
Address of getter function 0 = 000000000023FB24. Value gotten = 1
Address of getter function 1 = 000000000023FA14. Value gotten = 2
Address of getter function 2 = 000000000023F904. Value gotten = 3
Address of getter function 3 = 000000000023F7F4. Value gotten = 4
Address of getter function 4 = 000000000023F6E4. Value gotten = 5
Address of getter function 5 = 000000000023F5D4. Value gotten = 6
Address of getter function 6 = 000000000023F4C4. Value gotten = 7
Address of getter function 7 = 000000000023F3B4. Value gotten = 8
Address of getter function 8 = 000000000023F2A4. Value gotten = 9
Address of getter function 9 = 000000000023F194. Value gotten = 10
Sum of values gotten = 55