- implement full native Fortran support for fstarpu_sched_ctx_create

include/fstarpu_mod.f90

@@ -64,6 +64,15 @@ module fstarpu_mod
 
         integer(c_int), bind(C) :: FSTARPU_NMAXBUFS
 
+        type(c_ptr), bind(C) :: FSTARPU_SCHED_CTX_POLICY_NAME
+        type(c_ptr), bind(C) :: FSTARPU_SCHED_CTX_POLICY_STRUCT
+        type(c_ptr), bind(C) :: FSTARPU_SCHED_CTX_POLICY_MIN_PRIO
+        type(c_ptr), bind(C) :: FSTARPU_SCHED_CTX_POLICY_MAX_PRIO
+        type(c_ptr), bind(C) :: FSTARPU_SCHED_CTX_HIERARCHY_LEVEL
+        type(c_ptr), bind(C) :: FSTARPU_SCHED_CTX_NESTED
+        type(c_ptr), bind(C) :: FSTARPU_SCHED_CTX_AWAKE_WORKERS
+        type(c_ptr), bind(C) :: FSTARPU_SCHED_CTX_POLICY_INIT
+
         ! (some) portable iso_c_binding types
         type(c_ptr), bind(C) :: FSTARPU_SZ_C_DOUBLE
         type(c_ptr), bind(C) :: FSTARPU_SZ_C_FLOAT
@@ -1612,12 +1621,13 @@ module fstarpu_mod
                 ! == starpu_sched_ctx.h ==
 
                 ! starpu_sched_ctx_create: see fstarpu_sched_ctx_create
-                function fstarpu_sched_ctx_create(workers_array,nworkers,ctx_name) bind(C)
-                        use iso_c_binding, only: c_int, c_char
+                function fstarpu_sched_ctx_create(workers_array,nworkers,ctx_name, arglist) bind(C)
+                        use iso_c_binding, only: c_int, c_char, c_ptr
                         integer(c_int) :: fstarpu_sched_ctx_create
                         integer(c_int), intent(in) :: workers_array(*)
                         integer(c_int), value, intent(in) :: nworkers
                         character(c_char), intent(in) :: ctx_name
+                        type(c_ptr), dimension(:), intent(in) :: arglist
                 end function fstarpu_sched_ctx_create
 
                 ! unsigned starpu_sched_ctx_create_inside_interval(const char *policy_name, const char *sched_ctx_name, int min_ncpus, int max_ncpus, int min_ngpus, int max_ngpus, unsigned allow_overlap);
@@ -2233,6 +2243,23 @@ module fstarpu_mod
 
                         FSTARPU_NMAXBUFS   = int(p_to_ip(fstarpu_get_constant(C_CHAR_"FSTARPU_NMAXBUFS"//C_NULL_CHAR)),c_int)
 
+                        FSTARPU_SCHED_CTX_POLICY_NAME    = &
+                            fstarpu_get_constant(C_CHAR_"FSTARPU_SCHED_CTX_POLICY_NAME"//C_NULL_CHAR)
+                        FSTARPU_SCHED_CTX_POLICY_STRUCT    = &
+                            fstarpu_get_constant(C_CHAR_"FSTARPU_SCHED_CTX_POLICY_STRUCT"//C_NULL_CHAR)
+                        FSTARPU_SCHED_CTX_POLICY_MIN_PRIO    = &
+                            fstarpu_get_constant(C_CHAR_"FSTARPU_SCHED_CTX_POLICY_MIN_PRIO"//C_NULL_CHAR)
+                        FSTARPU_SCHED_CTX_POLICY_MAX_PRIO    = &
+                            fstarpu_get_constant(C_CHAR_"FSTARPU_SCHED_CTX_POLICY_MAX_PRIO"//C_NULL_CHAR)
+                        FSTARPU_SCHED_CTX_HIERARCHY_LEVEL    = &
+                            fstarpu_get_constant(C_CHAR_"FSTARPU_SCHED_CTX_HIERARCHY_LEVEL"//C_NULL_CHAR)
+                        FSTARPU_SCHED_CTX_NESTED    = &
+                            fstarpu_get_constant(C_CHAR_"FSTARPU_SCHED_CTX_NESTED"//C_NULL_CHAR)
+                        FSTARPU_SCHED_CTX_AWAKE_WORKERS    = &
+                            fstarpu_get_constant(C_CHAR_"FSTARPU_SCHED_CTX_AWAKE_WORKERS"//C_NULL_CHAR)
+                        FSTARPU_SCHED_CTX_POLICY_INIT    = &
+                            fstarpu_get_constant(C_CHAR_"FSTARPU_SCHED_CTX_POLICY_INIT"//C_NULL_CHAR)
+
                         ! Initialize size constants as 'c_ptr'
                         FSTARPU_SZ_C_DOUBLE        = sz_to_p(c_sizeof(FSTARPU_SZ_C_DOUBLE_dummy))
                         FSTARPU_SZ_C_FLOAT        = sz_to_p(c_sizeof(FSTARPU_SZ_C_FLOAT_dummy))

src/core/sched_ctx.c

@@ -824,6 +824,108 @@ unsigned starpu_sched_ctx_create(int *workerids, int nworkers, const char *sched
 	return sched_ctx->id;
 }
 
+int fstarpu_sched_ctx_create(int *workerids, int nworkers, const char *sched_ctx_name, void **arglist)
+{
+	int arg_i = 0;
+	int min_prio_set = 0;
+	int max_prio_set = 0;
+	int min_prio = 0;
+	int max_prio = 0;
+	struct starpu_sched_policy *sched_policy = NULL;
+	unsigned hierarchy_level = 0;
+	unsigned nesting_sched_ctx = STARPU_NMAX_SCHED_CTXS;
+	unsigned awake_workers = 0;
+	void (*init_sched)(void) = NULL;
+
+	while (arglist[arg_i] != NULL)
+	{
+		const int arg_type = (int)(intptr_t)arglist[arg_i];
+		if (arg_type == STARPU_SCHED_CTX_POLICY_NAME)
+		{
+			arg_i++;
+			char *policy_name = arglist[arg_i];
+			struct _starpu_machine_config *config = (struct _starpu_machine_config *)_starpu_get_machine_config();
+			sched_policy = _starpu_select_sched_policy(config, policy_name);
+		}
+		else if (arg_type == STARPU_SCHED_CTX_POLICY_STRUCT)
+		{
+			arg_i++;
+			sched_policy = arglist[arg_i];
+		}
+		else if (arg_type == STARPU_SCHED_CTX_POLICY_MIN_PRIO)
+		{
+			arg_i++;
+			min_prio = *(int *)arglist[arg_i];
+			min_prio_set = 1;
+		}
+		else if (arg_type == STARPU_SCHED_CTX_POLICY_MAX_PRIO)
+		{
+			arg_i++;
+			max_prio = *(int *)arglist[arg_i];
+			max_prio_set = 1;
+		}
+		else if (arg_type == STARPU_SCHED_CTX_HIERARCHY_LEVEL)
+		{
+			arg_i++;
+			int val = *(int *)arglist[arg_i];
+			STARPU_ASSERT(val >= 0);
+			hierarchy_level = (unsigned)val;
+		}
+		else if (arg_type == STARPU_SCHED_CTX_NESTED)
+		{
+			arg_i++;
+			int val = *(int *)arglist[arg_i];
+			STARPU_ASSERT(val >= 0);
+			nesting_sched_ctx = (unsigned)val;
+		}
+		else if (arg_type == STARPU_SCHED_CTX_AWAKE_WORKERS)
+		{
+			awake_workers = 1;
+		}
+		else if (arg_type == STARPU_SCHED_CTX_POLICY_INIT)
+		{
+			arg_i++;
+			init_sched = arglist[arg_i];
+		}
+		else
+		{
+			STARPU_ABORT_MSG("Unrecognized argument %d\n", arg_type);
+		}
+
+	}
+
+	if (workerids && nworkers != -1)
+	{
+		/* Make sure the user doesn't use invalid worker IDs. */
+		unsigned num_workers = starpu_worker_get_count();
+		int i;
+		for (i = 0; i < nworkers; i++)
+		{
+			if (workerids[i] < 0 || workerids[i] >= num_workers)
+			{
+				_STARPU_ERROR("Invalid worker ID (%d) specified!\n", workerids[i]);
+				return STARPU_NMAX_SCHED_CTXS;
+			}
+		}
+	}
+
+	struct _starpu_sched_ctx *sched_ctx = NULL;
+	sched_ctx = _starpu_create_sched_ctx(sched_policy, workerids, nworkers, 0, sched_ctx_name, min_prio_set, min_prio, max_prio_set, max_prio, awake_workers, init_sched);
+	sched_ctx->hierarchy_level = hierarchy_level;
+	sched_ctx->nesting_sched_ctx = nesting_sched_ctx;
+
+	_starpu_unlock_mutex_if_prev_locked();
+	int *added_workerids;
+	unsigned nw_ctx = starpu_sched_ctx_get_workers_list(sched_ctx->id, &added_workerids);
+	_starpu_update_workers_with_ctx(added_workerids, nw_ctx, sched_ctx->id);
+	free(added_workerids);
+	_starpu_relock_mutex_if_prev_locked();
+#ifdef STARPU_USE_SC_HYPERVISOR
+	sched_ctx->perf_counters = NULL;
+#endif
+	return (int)sched_ctx->id;
+}
+
 void starpu_sched_ctx_register_close_callback(unsigned sched_ctx_id, void (*close_callback)(unsigned sched_ctx_id, void* args), void *args)
 {
 	struct _starpu_sched_ctx *sched_ctx = _starpu_get_sched_ctx_struct(sched_ctx_id);

src/util/fstarpu.c

@@ -67,6 +67,15 @@ static const intptr_t fstarpu_any_worker = STARPU_ANY_WORKER;
 
 static const intptr_t fstarpu_nmaxbufs = STARPU_NMAXBUFS;
 
+static const intptr_t fstarpu_sched_ctx_policy_name	= STARPU_SCHED_CTX_POLICY_NAME;
+static const intptr_t fstarpu_sched_ctx_policy_struct	= STARPU_SCHED_CTX_POLICY_STRUCT;
+static const intptr_t fstarpu_sched_ctx_policy_min_prio	= STARPU_SCHED_CTX_POLICY_MIN_PRIO;
+static const intptr_t fstarpu_sched_ctx_policy_max_prio	= STARPU_SCHED_CTX_POLICY_MAX_PRIO;
+static const intptr_t fstarpu_sched_ctx_hierarchy_level	= STARPU_SCHED_CTX_HIERARCHY_LEVEL;
+static const intptr_t fstarpu_sched_ctx_nested	= STARPU_SCHED_CTX_NESTED;
+static const intptr_t fstarpu_sched_ctx_awake_workers	= STARPU_SCHED_CTX_AWAKE_WORKERS;
+static const intptr_t fstarpu_sched_ctx_policy_init	= STARPU_SCHED_CTX_POLICY_INIT;
+
 intptr_t fstarpu_get_constant(char *s)
 {
 	if	(!strcmp(s, "FSTARPU_R"))	{ return fstarpu_r; }
@@ -113,6 +122,15 @@ intptr_t fstarpu_get_constant(char *s)
 
 	else if (!strcmp(s, "FSTARPU_NMAXBUFS"))	{ return fstarpu_nmaxbufs; }
 
+	else if (!strcmp(s, "FSTARPU_SCHED_CTX_POLICY_NAME"))	{ return fstarpu_sched_ctx_policy_name; }
+	else if (!strcmp(s, "FSTARPU_SCHED_CTX_POLICY_STRUCT"))	{ return fstarpu_sched_ctx_policy_struct; }
+	else if (!strcmp(s, "FSTARPU_SCHED_CTX_POLICY_MIN_PRIO"))	{ return fstarpu_sched_ctx_policy_min_prio; }
+	else if (!strcmp(s, "FSTARPU_SCHED_CTX_POLICY_MAX_PRIO"))	{ return fstarpu_sched_ctx_policy_max_prio; }
+	else if (!strcmp(s, "FSTARPU_SCHED_CTX_HIERARCHY_LEVEL"))	{ return fstarpu_sched_ctx_hierarchy_level; }
+	else if (!strcmp(s, "FSTARPU_SCHED_CTX_NESTED"))	{ return fstarpu_sched_ctx_nested; }
+	else if (!strcmp(s, "FSTARPU_SCHED_CTX_AWAKE_WORKERS"))	{ return fstarpu_sched_ctx_awake_workers; }
+	else if (!strcmp(s, "FSTARPU_SCHED_CTX_POLICY_INIT"))	{ return fstarpu_sched_ctx_policy_init; }
+
 	else { _FSTARPU_ERROR("unknown constant"); }
 }
 
@@ -420,11 +438,6 @@ void fstarpu_unpack_arg(char *cl_arg, void ***_buffer_list)
 	free(cl_arg);
 }
 
-int fstarpu_sched_ctx_create(int *workers_array, int nworkers, const char *name)
-{
-	return (int)starpu_sched_ctx_create(workers_array, nworkers, name, STARPU_SCHED_CTX_POLICY_NAME, "eager", 0);
-}
-
 void fstarpu_sched_ctx_display_workers(int ctx)
 {
 	starpu_sched_ctx_display_workers((unsigned)ctx, stderr);