- add a preliminary framework for native Fortran support for StarPU

. basic codelet declaration/definition routines
. data registration routines for vectors
. insert_task routine
. support for native Fortran routines without C wrappers
. an example of use
. an example external Makefile

Note: experimental, but tested successfully with GNU GFortran and Intel Ifort

Makefile.am

@@ -3,6 +3,7 @@
 # Copyright (C) 2009-2015  Université de Bordeaux
 # Copyright (C) 2010, 2011, 2012, 2013, 2015  CNRS
 # Copyright (C) 2014  INRIA
+# Copyright (C) 2016  Inria
 #
 # StarPU is free software; you can redistribute it and/or modify
 # it under the terms of the GNU Lesser General Public License as published by
@@ -96,6 +97,7 @@ versinclude_HEADERS = 				\
 	include/starpu_tree.h			\
 	include/starpu_simgrid_wrap.h		\
 	include/starpu_mod.f90			\
+	include/fstarpu_mod.f90			\
 	include/starpu_clusters_util.h
 
 nodist_versinclude_HEADERS = 			\

examples/Makefile.am

@@ -4,7 +4,7 @@
 # Copyright (C) 2010, 2011, 2012, 2013, 2014, 2015  CNRS
 # Copyright (C) 2011  Télécom-SudParis
 # Copyright (C) 2011-2012  INRIA
-# Copyright (C) 2015  Inria
+# Copyright (C) 2015-2016  Inria
 #
 # StarPU is free software; you can redistribute it and/or modify
 # it under the terms of the GNU Lesser General Public License as published by
@@ -228,7 +228,8 @@ endif
 if STARPU_HAVE_FC
 if !STARPU_SANITIZE
 STARPU_EXAMPLES +=				\
-	fortran90/f90_example
+	fortran90/f90_example			\
+	native_fortran/native_fortran_example
 endif
 endif
 endif
@@ -347,6 +348,11 @@ fortran90_f90_example_SOURCES =	\
 	fortran90/mod_compute.f90	\
 	fortran90/marshalling.c		\
 	fortran90/f90_example.f90
+
+native_fortran_native_fortran_example_SOURCES =	\
+	native_fortran/codelets.f90		\
+	$(top_srcdir)/include/fstarpu_mod.f90	\
+	native_fortran/native_fortran_example.f90
 endif
 
 #######################
@@ -971,4 +977,20 @@ mod_compute.o: $(top_srcdir)/examples/fortran90/mod_compute.f90 mod_types.mod mo
 
 f90_example.o: $(top_srcdir)/examples/fortran90/f90_example.f90 $(top_srcdir)/examples/fortran90/marshalling.c mod_types.mod mod_interface.mod mod_compute.mod starpu_mod.mod
 	$(AM_V_FC)$(FC) $(fortran90_f90_example_FCFLAGS) $(FCFLAGS) -c -o $@ `test -f 'fortran90/f90_example.f90' || echo '$(srcdir)/'`fortran90/f90_example.f90
+
+# Native Fortran example
+# - list explicit dependences to control proper module files generation
+# - the overriding rule fully disables the corresponing default rule, thus
+#   the default rule body must be copied entirely
+fstarpu_mod.mod: fstarpu_mod.o
+codelets.mod: codelets.o
+
+fstarpu_mod.o: $(top_srcdir)/include/fstarpu_mod.f90
+	$(AM_V_FC)$(FC) $(native_fortran_native_fortran_example_FCFLAGS) $(FCFLAGS) -c -o $@ '$(top_srcdir)/'include/fstarpu_mod.f90
+
+codelets.o: $(top_srcdir)/examples/native_fortran/codelets.f90 fstarpu_mod.mod
+	$(AM_V_FC)$(FC) $(native_fortran_native_fortran_example_FCFLAGS) $(FCFLAGS) -c -o $@ `test -f 'native_fortran/codelets.f90' || echo '$(srcdir)/'`native_fortran/codelets.f90
+
+native_fortran_example.o: $(top_srcdir)/examples/native_fortran/native_fortran_example.f90 codelets.mod fstarpu_mod.mod
+	$(AM_V_FC)$(FC) $(native_fortran_native_fortran_example_FCFLAGS) $(FCFLAGS) -c -o $@ `test -f 'native_fortran/native_fortran_example.f90' || echo '$(srcdir)/'`native_fortran/native_fortran_example.f90
 endif

examples/native_fortran/Makefile

@@ -0,0 +1,50 @@
+# StarPU --- Runtime system for heterogeneous multicore architectures.
+#
+# Copyright (C) 2016  Inria
+#
+# StarPU is free software; you can redistribute it and/or modify
+# it under the terms of the GNU Lesser General Public License as published by
+# the Free Software Foundation; either version 2.1 of the License, or (at
+# your option) any later version.
+#
+# StarPU 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 Lesser General Public License in COPYING.LGPL for more details.
+
+PROG = native_fortran_example
+
+FSTARPU_MOD = $(shell pkg-config --cflags-only-I starpu-1.3|sed -e 's/ *$$//;s/^.* //;s/^-I//')/fstarpu_mod.f90
+
+SRCSF = native_fortran_example.f90		\
+	codelets.f90
+
+FC = gfortran
+CC = gcc
+
+CFLAGS = -g $(shell pkg-config --cflags starpu-1.3)
+FCFLAGS = -fdefault-real-8 -J. -g
+LDLIBS =  $(shell pkg-config --libs starpu-1.3)
+
+OBJS = $(SRCSC:%.c=%.o) fstarpu_mod.o $(SRCSF:%.f90=%.o)
+
+.phony: all clean
+all: $(PROG)
+
+$(PROG): $(OBJS)
+	$(FC) $(LDFLAGS) -o $@ $^ $(LDLIBS)
+
+%.o: %.c
+	$(CC) $(CFLAGS) -c -o $@ $<
+
+fstarpu_mod.o: $(FSTARPU_MOD)
+	$(FC) $(FCFLAGS) -c -o $@ $<
+
+%.o: %.f90
+	$(FC) $(FCFLAGS) -c -o $@ $<
+
+clean:
+	rm -fv *.o *.mod $(PROG)
+
+native_fortran_example.o: native_fortran_example.f90 codelets.o

examples/native_fortran/codelets.f90

@@ -0,0 +1,60 @@
+! StarPU --- Runtime system for heterogeneous multicore architectures.
+!
+! Copyright (C) 2016  Inria
+!
+! StarPU is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at
+! your option) any later version.
+!
+! StarPU 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 Lesser General Public License in COPYING.LGPL for more details.
+
+module codelets
+contains
+        ! 'cl1' codelet routine
+        !
+        ! Note: codelet routines must:
+        ! . be declared recursive (~ 'reentrant routine')
+        ! . be declared with the 'bind(C)' attribute for proper C interfacing
+recursive subroutine cl_cpu_func1 (buffers, cl_args) bind(C)
+        use iso_c_binding       ! C interfacing module
+        use fstarpu_mod         ! StarPU interfacing module
+        implicit none
+
+        type(c_ptr), value, intent(in) :: buffers, cl_args ! cl_args is unused
+        real(8), dimension(:), pointer :: va
+        integer, dimension(:), pointer :: vb
+        integer :: nx_va,nx_vb,i
+
+        write(*,*) "task -->"
+        ! get 'va' number of elements
+        nx_va = fstarpu_vector_get_nx(buffers, 0)
+        write(*,*) "nx_va"
+        write(*,*) nx_va
+
+        ! get 'vb' number of elements
+        nx_vb = fstarpu_vector_get_nx(buffers, 1)
+        write(*,*) "nx_vb"
+        write(*,*) nx_vb
+
+        ! get 'va' converted Fortran pointer
+        call c_f_pointer(fstarpu_vector_get_ptr(buffers, 0), va, shape=[nx_va])
+        write(*,*) "va"
+        do i=1,nx_va
+                write(*,*) i,va(i)
+        end do
+
+        ! get 'vb' converted Fortran pointer
+        call c_f_pointer(fstarpu_vector_get_ptr(buffers, 1), vb, shape=[nx_vb])
+        write(*,*) "vb"
+        do i=1,nx_vb
+                write(*,*) i,vb(i)
+        end do
+        write(*,*) "task <--"
+
+end subroutine cl_cpu_func1
+end module codelets

examples/native_fortran/native_fortran_example.f90

@@ -0,0 +1,90 @@
+! StarPU --- Runtime system for heterogeneous multicore architectures.
+!
+! Copyright (C) 2016  Inria
+!
+! StarPU is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at
+! your option) any later version.
+!
+! StarPU 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 Lesser General Public License in COPYING.LGPL for more details.
+
+program native_fortran_example
+        use iso_c_binding       ! C interfacing module
+        use fstarpu_mod         ! StarPU interfacing module
+        use codelets
+        implicit none
+
+        real(8), dimension(:), allocatable, target :: va
+        integer, dimension(:), allocatable, target :: vb
+        integer :: i
+
+        type(c_ptr) :: cl1      ! a pointer for the codelet structure
+        type(c_ptr) :: dh_va    ! a pointer for the 'va' vector data handle
+        type(c_ptr) :: dh_vb    ! a pointer for the 'vb' vector data handle
+
+        allocate(va(5))
+        va = (/ (i,i=1,5) /)
+
+        allocate(vb(7))
+        vb = (/ (i,i=1,7) /)
+
+        ! initialize StarPU with default settings
+        call fstarpu_init()
+
+        ! allocate an empty codelet structure
+        cl1 = fstarpu_codelet_allocate()
+
+        ! add a CPU implementation function to the codelet
+        call fstarpu_codelet_add_cpu_func(cl1, C_FUNLOC(cl_cpu_func1))
+
+        ! add a Read-only mode data buffer to the codelet
+        call fstarpu_codelet_add_buffer(cl1, FSTARPU_R)
+
+        ! add a Read-Write mode data buffer to the codelet
+        call fstarpu_codelet_add_buffer(cl1, FSTARPU_RW)
+
+        ! register 'va', a vector of real(8) elements
+        dh_va = fstarpu_vector_data_register(c_loc(va), 1+ubound(va,1)-lbound(va,1), c_sizeof(va(lbound(va,1))), 0)
+
+        ! register 'vb', a vector of integer elements
+        dh_vb = fstarpu_vector_data_register(c_loc(vb), 1+ubound(vb,1)-lbound(vb,1), c_sizeof(vb(lbound(vb,1))), 0)
+
+        ! insert a task with codelet cl1, and vectors 'va' and 'vb'
+        !
+        ! Note: The array argument must follow the layout:
+        !   (/
+        !     <codelet_ptr>,
+        !     [<argument_type> [<argument_value(s)],]
+        !     . . .
+        !     C_NULL_PTR
+        !   )/
+        !
+        ! Note: The argument type for data handles is FSTARPU_DATA, regardless
+        ! of the buffer access mode (specified in the codelet)
+        call fstarpu_insert_task((/ cl1, FSTARPU_DATA, dh_va, FSTARPU_DATA, dh_vb, C_NULL_PTR /))
+
+        ! wait for task completion
+        call fstarpu_task_wait_for_all()
+
+        ! unregister 'va'
+        call fstarpu_data_unregister(dh_va)
+
+        ! unregister 'vb'
+        call fstarpu_data_unregister(dh_vb)
+
+        ! free codelet structure
+        call fstarpu_codelet_free(cl1)
+
+        ! shut StarPU down
+        call fstarpu_shutdown()
+
+        deallocate(vb)
+        deallocate(va)
+
+end program native_fortran_example
+

include/fstarpu_mod.f90

@@ -0,0 +1,108 @@
+! StarPU --- Runtime system for heterogeneous multicore architectures.
+!
+! Copyright (C) 2016  Inria
+!
+! StarPU is free software; you can redistribute it and/or modify
+! it under the terms of the GNU Lesser General Public License as published by
+! the Free Software Foundation; either version 2.1 of the License, or (at
+! your option) any later version.
+!
+! StarPU 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 Lesser General Public License in COPYING.LGPL for more details.
+
+module fstarpu_mod
+        use iso_c_binding
+
+        integer(c_int), bind(C, name="fstarpu_r") :: FSTARPU_R
+        integer(c_int), bind(C, name="fstarpu_w") :: FSTARPU_W
+        integer(c_int), bind(C, name="fstarpu_rw") :: FSTARPU_RW
+        integer(c_int), bind(C, name="fstarpu_scratch") :: FSTARPU_SCRATCH
+        integer(c_int), bind(C, name="fstarpu_redux") :: FSTARPU_REDUX
+
+        type(c_ptr), bind(C, name="fstarpu_data") :: FSTARPU_DATA
+
+        interface
+                subroutine fstarpu_init () bind(C)
+                end subroutine fstarpu_init
+
+                subroutine fstarpu_shutdown () bind(C,name="starpu_shutdown")
+                end subroutine fstarpu_shutdown
+
+                function fstarpu_codelet_allocate () bind(C)
+                        use iso_c_binding, only: c_ptr
+                        type(c_ptr) :: fstarpu_codelet_allocate
+                end function fstarpu_codelet_allocate
+
+                subroutine fstarpu_codelet_free (cl) bind(C)
+                        use iso_c_binding, only: c_ptr
+                        type(c_ptr), value, intent(in) :: cl
+                end subroutine fstarpu_codelet_free
+
+                subroutine fstarpu_codelet_add_cpu_func (cl, f_ptr) bind(C)
+                        use iso_c_binding, only: c_ptr, c_funptr
+                        type(c_ptr), value, intent(in) :: cl
+                        type(c_funptr), value, intent(in) :: f_ptr
+                end subroutine fstarpu_codelet_add_cpu_func
+
+                subroutine fstarpu_codelet_add_cuda_func (cl, f_ptr) bind(C)
+                        use iso_c_binding, only: c_ptr, c_funptr
+                        type(c_ptr), value, intent(in) :: cl
+                        type(c_funptr), value, intent(in) :: f_ptr
+                end subroutine fstarpu_codelet_add_cuda_func
+
+                subroutine fstarpu_codelet_add_opencl_func (cl, f_ptr) bind(C)
+                        use iso_c_binding, only: c_ptr, c_funptr
+                        type(c_ptr), value, intent(in) :: cl
+                        type(c_funptr), value, intent(in) :: f_ptr
+                end subroutine fstarpu_codelet_add_opencl_func
+
+                subroutine fstarpu_codelet_add_buffer (cl, mode) bind(C)
+                        use iso_c_binding, only: c_ptr, c_int
+                        type(c_ptr), value, intent(in) :: cl
+                        integer(c_int), value, intent(in) :: mode
+                end subroutine fstarpu_codelet_add_buffer
+
+                function fstarpu_vector_data_register(vector, nx, elt_size, ram) bind(C)
+                        use iso_c_binding
+                        type(c_ptr) :: fstarpu_vector_data_register
+                        type(c_ptr), value, intent(in) :: vector
+                        integer(c_int), value, intent(in) :: nx
+                        integer(c_size_t), value, intent(in) :: elt_size
+                        integer(c_int), value, intent(in) :: ram
+                end function fstarpu_vector_data_register
+
+                function fstarpu_vector_get_ptr(buffers, i) bind(C)
+                        use iso_c_binding
+                        type(c_ptr) :: fstarpu_vector_get_ptr
+                        type(c_ptr), value, intent(in) :: buffers
+                        integer(c_int), value, intent(in) :: i
+                end function fstarpu_vector_get_ptr
+
+                function fstarpu_vector_get_nx(buffers, i) bind(C)
+                        use iso_c_binding
+                        integer(c_int) :: fstarpu_vector_get_nx
+                        type(c_ptr), value, intent(in) :: buffers
+                        integer(c_int), value, intent(in) :: i
+                end function fstarpu_vector_get_nx
+
+                subroutine fstarpu_data_unregister (dh) bind(C)
+                        use iso_c_binding, only: c_ptr
+                        type(c_ptr), value, intent(in) :: dh
+                end subroutine fstarpu_data_unregister
+
+                subroutine fstarpu_insert_task(arglist) bind(C)
+                        use iso_c_binding, only: c_ptr
+                        type(c_ptr), dimension(:), intent(in) :: arglist
+                end subroutine fstarpu_insert_task
+
+                subroutine fstarpu_task_wait_for_all () bind(C,name="starpu_task_wait_for_all")
+                end subroutine fstarpu_task_wait_for_all
+
+        end interface
+
+        ! contains
+
+end module fstarpu_mod

src/Makefile.am

@@ -3,6 +3,7 @@
 # Copyright (C) 2009-2016  Université de Bordeaux
 # Copyright (C) 2010, 2011, 2012, 2013, 2015  CNRS
 # Copyright (C) 2011, 2014  INRIA
+# Copyright (C) 2016  Inria
 #
 # StarPU is free software; you can redistribute it and/or modify
 # it under the terms of the GNU Lesser General Public License as published by
@@ -241,6 +242,7 @@ libstarpu_@STARPU_EFFECTIVE_VERSION@_la_SOURCES = 		\
 	util/execute_on_all.c					\
 	util/starpu_create_sync_task.c				\
 	util/file.c						\
+	util/fstarpu.c						\
 	util/misc.c						\
 	util/openmp_runtime_support.c				\
 	util/openmp_runtime_support_environment.c		\

src/util/fstarpu.c

@@ -0,0 +1,174 @@
+/* StarPU --- Runtime system for heterogeneous multicore architectures.
+ *
+ * Copyright (C) 2016  Inria
+ *
+ * StarPU is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation; either version 2.1 of the License, or (at
+ * your option) any later version.
+ *
+ * StarPU 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 Lesser General Public License in COPYING.LGPL for more details.
+ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <starpu.h>
+
+#define _FSTARPU_ERROR(msg) do {fprintf(stderr, "fstarpu error: %s\n", (msg));abort();} while(0)
+
+const int fstarpu_r = STARPU_R;
+const int fstarpu_w = STARPU_W;
+const int fstarpu_rw = STARPU_RW;
+const int fstarpu_scratch = STARPU_SCRATCH;
+const int fstarpu_redux = STARPU_REDUX;
+
+static const int _fstarpu_data = STARPU_R | STARPU_W | STARPU_SCRATCH | STARPU_REDUX;
+const void * const fstarpu_data = &_fstarpu_data;
+
+void fstarpu_init(void)
+{
+	int ret = starpu_init(NULL);
+	if (ret != 0)
+	{
+		_FSTARPU_ERROR("starpu_init failed");
+	}
+}
+
+struct starpu_codelet *fstarpu_codelet_allocate(void)
+{
+	struct starpu_codelet *cl = malloc(sizeof(*cl));
+	memset(cl, 0, sizeof(*cl));
+	return cl;
+}
+
+void fstarpu_codelet_free(struct starpu_codelet *cl)
+{
+	memset(cl, 0, sizeof(*cl));
+	free(cl);
+}
+
+void fstarpu_codelet_add_cpu_func(struct starpu_codelet *cl, void *f_ptr)
+{
+	int i;
+	for (i = 0; i < sizeof(cl->cpu_funcs)-1; i++)
+	{
+		if (cl->cpu_funcs[i] == NULL)
+		{
+			cl->cpu_funcs[i] = f_ptr;
+			return;
+		}
+	}
+	_FSTARPU_ERROR("fstarpu: too many cpu functions in Fortran codelet");
+}
+
+void fstarpu_codelet_add_cuda_func(struct starpu_codelet *cl, void *f_ptr)
+{
+	int i;
+	for (i = 0; i < sizeof(cl->cuda_funcs)-1; i++)
+	{
+		if (cl->cuda_funcs[i] == NULL)
+		{
+			cl->cuda_funcs[i] = f_ptr;
+			return;
+		}
+	}
+	_FSTARPU_ERROR("fstarpu: too many cuda functions in Fortran codelet");
+}
+
+void fstarpu_codelet_add_opencl_func(struct starpu_codelet *cl, void *f_ptr)
+{
+	int i;
+	for (i = 0; i < sizeof(cl->opencl_funcs)-1; i++)
+	{
+		if (cl->opencl_funcs[i] == NULL)
+		{
+			cl->opencl_funcs[i] = f_ptr;
+			return;
+		}
+	}
+	_FSTARPU_ERROR("fstarpu: too many opencl functions in Fortran codelet");
+}
+
+void fstarpu_codelet_add_buffer(struct starpu_codelet *cl, int mode)
+{
+	if  (cl->nbuffers < sizeof(cl->modes)-1)
+	{
+		cl->modes[cl->nbuffers] = (unsigned int)mode;
+		cl->nbuffers++;
+	}
+	else
+	{
+		_FSTARPU_ERROR("fstarpu: too many buffers in Fortran codelet");
+	}
+}
+
+starpu_data_handle_t fstarpu_vector_data_register(void *vector, int nx, size_t elt_size, int ram)
+{
+	starpu_data_handle_t handle;
+	starpu_vector_data_register(&handle, ram, (uintptr_t)vector, nx, elt_size);
+	return handle;
+}
+
+void * fstarpu_vector_get_ptr(void *buffers[], int i)
+{
+	return (void *)STARPU_VECTOR_GET_PTR(buffers[i]);
+}
+
+int fstarpu_vector_get_nx(void *buffers[], int i)
+{
+	return STARPU_VECTOR_GET_NX(buffers[i]);
+}
+
+void fstarpu_data_unregister(starpu_data_handle_t handle)
+{
+	starpu_data_unregister(handle);
+}
+
+void fstarpu_insert_task(void ***_arglist)
+{
+	void **arglist = *_arglist;
+	int i = 0;
+	int current_buffer = 0;
+	struct starpu_task *task = NULL;
+	struct starpu_codelet *cl = arglist[i++];
+	if (cl == NULL)
+	{
+		_FSTARPU_ERROR("task without codelet");
+	}
+	task = starpu_task_create();
+	task->cl = cl;
+	task->name = NULL;
+	task->cl_arg_free = 0;
+	while (arglist[i] != NULL)
+	{
+		if (arglist[i] == fstarpu_data)
+		{
+			i++;
+			starpu_data_handle_t handle = arglist[i];
+			if (current_buffer >= cl->nbuffers)
+			{
+				_FSTARPU_ERROR("too many buffers");
+			}
+			STARPU_TASK_SET_HANDLE(task, handle, current_buffer);
+			if (!STARPU_CODELET_GET_MODE(cl, current_buffer))
+			{
+				_FSTARPU_ERROR("unsupported late access mode definition");
+			}
+			current_buffer++;
+		}
+		else
+		{
+			_FSTARPU_ERROR("unknown/unsupported argument type");
+		}
+		i++;
+	}
+	int ret = starpu_task_submit(task);
+	if (ret != 0)
+	{
+		_FSTARPU_ERROR("starpu_task_submit failed");
+	}
+}