├── src ├── iface │ ├── forthread_types.f03 │ ├── fortypes.h │ ├── Makefile │ ├── forthread_data.f03 │ ├── ciface.h │ └── forthread.f03 ├── ft_consts.h ├── Makefile ├── ft_data.c ├── ft_data.h ├── ft_attr.h ├── forthread.h ├── ft_attr.c └── forthread.c ├── .gitignore ├── test ├── Makefile ├── test01.c ├── test02.f03 ├── test03.f03 ├── test04.f03 └── test05.f03 ├── Makefile ├── LICENSE └── README.md /src/iface/forthread_types.f03: -------------------------------------------------------------------------------- 1 | module forthread_types 2 | 3 | use iso_c_binding 4 | #include "fortypes.h" 5 | 6 | end module forthread_types 7 | -------------------------------------------------------------------------------- /src/ft_consts.h: -------------------------------------------------------------------------------- 1 | 2 | /** 3 | * global parameters 4 | **/ 5 | 6 | #define INIT_SIZE 4 7 | 8 | /** 9 | * error codes 10 | **/ 11 | #define FT_OK 0 12 | #define FT_EINIT -1 13 | #define FT_EINVALID -2 14 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # Object files 2 | *.o 3 | 4 | # Libraries 5 | *.lib 6 | *.a 7 | 8 | # Shared objects (inc. Windows DLLs) 9 | *.dll 10 | *.so 11 | *.so.* 12 | *.dylib 13 | 14 | # Executables 15 | *.exe 16 | *.out 17 | *.app 18 | -------------------------------------------------------------------------------- /src/iface/fortypes.h: -------------------------------------------------------------------------------- 1 | 2 | type, bind(c) :: sched_param 3 | integer(c_int) :: sched_priority 4 | end type sched_param 5 | 6 | ! wrapping the C timespec type - maybe we can 7 | ! skip this and only use primite fortran types 8 | type, bind(c) :: timespec 9 | integer(c_int) :: tv_sec ! seconds 10 | integer(c_long) :: tv_nsec ! nanoseconds 11 | end type timespec 12 | 13 | integer, parameter :: size_t = c_size_t 14 | -------------------------------------------------------------------------------- /test/Makefile: -------------------------------------------------------------------------------- 1 | LDFLAGS = -L../src/ -lforthread 2 | LD_LIBRARY_PATH += ../src/ 3 | CSOURCES := $(wildcard *.c) 4 | FSOURCES := $(wildcard *.f03) 5 | CTARGETS := $(patsubst %.c,%,$(CSOURCES)) 6 | FTARGETS := $(patsubst %.f03,%,$(FSOURCES)) 7 | 8 | all: $(FTARGETS) 9 | 10 | %: %.c 11 | $(CC) -o $@ $< $(CFLAGS) $(CDEBUG) $(LDFLAGS) 12 | ./$@ 13 | 14 | %: %.f03 15 | $(FC) -o $@ $< $(FFLAGS) $(FDEBUG) $(LDFLAGS) 16 | ./$@ 17 | 18 | clean: 19 | rm -f $(CTARGETS) $(FTARGETS) 20 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | #CC = icc 2 | #CC = gcc 3 | CC = gcc 4 | #FC = ifort 5 | FC = gfortran 6 | #CFLAGS = -fPIC 7 | PLATFORM = -D__DARWIN 8 | CFLAGS = $(PLATFORM) -fPIC -Wimplicit-function-declaration 9 | FFLAGS = $(PLATFORM) -cpp -fPIC -frecursive 10 | DEBUG = -g 11 | #CDEBUG = $(DEBUG) -I/usr/include/x86_64-linux-gnu/ 12 | CDEBUG = $(DEBUG) 13 | FDEBUG = $(DEBUG) 14 | 15 | export 16 | 17 | .PHONY: all clean test 18 | 19 | all: forthread 20 | 21 | forthread: 22 | $(MAKE) -C src 23 | 24 | 25 | test: 26 | $(MAKE) -C test 27 | 28 | clean: 29 | $(MAKE) -C src $@ 30 | $(MAKE) -C test clean 31 | -------------------------------------------------------------------------------- /src/iface/Makefile: -------------------------------------------------------------------------------- 1 | 2 | %.o: %.mod 3 | true 4 | 5 | forthread_types.o: forthread_types.f03 fortypes.h 6 | $(FC) $(FDEFINES) $(FFLAGS) $(FDEBUG) -c $< -o $@ 7 | 8 | forthread_data.o: forthread_data.f03 forthread_types.f03 forthread_types.o ciface.h 9 | $(FC) $(FDEFINES) $(FFLAGS) $(FDEBUG) -c $< -o $@ 10 | 11 | forthread.o: forthread.f03 \ 12 | ciface.h \ 13 | forthread_data.f03 \ 14 | forthread_data.o \ 15 | forthread_types.f03 \ 16 | forthread_types.o 17 | $(FC) $(FFLAGS) $(FDEBUG) -c $< -o $@ 18 | 19 | #forthread_data.o: forthread_data.f03 20 | # $(FC) $(FDEFINES) $(FFLAGS) $(FDEBUG) -c -Tf$< -o $@ 21 | # 22 | #forthread.o: forthread.f03 ciface.h forthread_data.f03 forthread_data.o 23 | # $(FC) $(FDEFINES) $(FFLAGS) $(FDEBUG) -c -Tf$< -o $@ 24 | 25 | clean: 26 | rm -f *.o *.mod 27 | -------------------------------------------------------------------------------- /src/Makefile: -------------------------------------------------------------------------------- 1 | # see /usr/include/features.h (on linux) for different possibilites 2 | # _XOPEN_SOURCE >= 700 means SUSv4 (revision 7). 3 | # This is needed to be compliant with the POSIX.1-2001 standard. 4 | # We may be able to relax this to SUSv2 to cover more systems, either way this 5 | # define is most probably only needed when compiling on linux, other systems 6 | # might have to be treated differently. 7 | DEFINES = -D_XOPEN_SOURCE=700 8 | LDFLAGS = -shared -pthread 9 | 10 | TARGET = libforthread.so 11 | SOURCES := $(wildcard *.c) 12 | IFACE_SOURCES := $(wildcard iface/*.f03) $(wildcard iface/*.h) 13 | OBJECTS := $(patsubst %.c,%.o,$(SOURCES)) iface/forthread.o iface/forthread_data.o iface/forthread_types.o 14 | all: $(TARGET) 15 | 16 | $(TARGET): $(OBJECTS) 17 | $(FC) -o $@ $(DEBUG) $(LDFLAGS) $^ 18 | 19 | iface/forthread.o: $(IFACE_SOURCES) 20 | $(MAKE) -C iface forthread.o 21 | 22 | %.o: %.c 23 | $(CC) $(DEFINES) $(CFLAGS) $(CDEBUG) -c $< -o $@ 24 | 25 | %.o: %.mod 26 | true 27 | 28 | clean: 29 | rm -f *.o $(TARGET) 30 | $(MAKE) -C iface clean 31 | -------------------------------------------------------------------------------- /test/test01.c: -------------------------------------------------------------------------------- 1 | #include "../src/forthread.h" 2 | #include 3 | #include 4 | 5 | void *run(void *arg) { 6 | printf("Hello World! %d\n",*(int*)arg); 7 | return NULL; 8 | } 9 | 10 | int main(int argc, char** argv) { 11 | int tid[1000]; 12 | int arg[1000]; 13 | int aid = -1; 14 | int info = 0; 15 | int i = 0; 16 | void *(*routine)(void*) = &run; 17 | 18 | printf("====================== test01 ======================\n"); 19 | printf("Initializing fort_threads\n"); 20 | 21 | thread_init(&info); 22 | 23 | printf("creating a thread\n"); 24 | for (i = 0; i < 10;i++) { 25 | arg[i] = i; 26 | thread_alloc(&tid[i],&info); 27 | thread_create(&tid[i],&aid,&routine,&arg[i],&info); 28 | if (info) { 29 | printf("error %d\n",info); 30 | } 31 | printf("thread %d created\n",tid[i]); 32 | } 33 | 34 | for (i = 0; i < 10; i++) { 35 | printf("join thread %d\n",tid[i]); 36 | thread_join(&tid[i],NULL,&info); 37 | if (info) { 38 | printf("error %d\n",info); 39 | } 40 | } 41 | printf("==================== end test01 ====================\n"); 42 | return 0; 43 | } 44 | 45 | 46 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | BSD 3-Clause License 2 | 3 | Copyright 2012-2017 MOSAIC Group (ETH Zurich & MPI-CBG Dresden), Omar Awile 4 | 5 | Redistribution and use in source and binary forms, with or without modification, 6 | are permitted provided that the following conditions are met: 7 | 8 | 1. Redistributions of source code must retain the above copyright notice, this 9 | list of conditions and the following disclaimer. 10 | 11 | 2. Redistributions in binary form must reproduce the above copyright notice, 12 | this list of conditions and the following disclaimer in the documentation and/or 13 | other materials provided with the distribution. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND 16 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 17 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 18 | DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR 19 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES 20 | (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; 21 | LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON 22 | ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS 24 | SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | -------------------------------------------------------------------------------- /test/test02.f03: -------------------------------------------------------------------------------- 1 | module procmod 2 | contains 3 | subroutine example(arg) 4 | implicit none 5 | integer :: arg 6 | 7 | print *,'hello world',arg 8 | 9 | end subroutine example 10 | end module procmod 11 | 12 | program test01 13 | 14 | use procmod 15 | 16 | !include '../src/iface/ciface.h' 17 | 18 | integer, parameter :: n = 1000 19 | integer, dimension(n) :: tid 20 | integer, dimension(n) :: arg 21 | integer :: ret_val 22 | integer :: thread_id 23 | integer :: aid 24 | integer :: i 25 | integer :: info 26 | 27 | aid = -1 28 | print *, '====================== test02 ======================' 29 | print *,'initializing threads' 30 | 31 | call forthread_init(info) 32 | if (info.ne.0) then 33 | print *,'error initializing ' 34 | endif 35 | 36 | do i=1,n 37 | arg(i) = i**2 38 | call forthread_create(thread_id,aid,example,arg(i),info) 39 | tid(i) = thread_id 40 | if (info.ne.0) then 41 | print *,'error creating thread ',i 42 | else 43 | print *,'successfully created thread ',i 44 | endif 45 | enddo 46 | 47 | do i=1,n 48 | print *,'join thread',i 49 | call forthread_join(tid(i),ret_val,info) 50 | if (info.ne.0) then 51 | print *,'error joining thread ',i 52 | endif 53 | enddo 54 | 55 | call forthread_destroy(info) 56 | if (info.ne.0) then 57 | print *,'error destroying.' 58 | endif 59 | 60 | print *, '==================== end test02 ====================' 61 | 62 | 63 | end program test01 64 | -------------------------------------------------------------------------------- /src/iface/forthread_data.f03: -------------------------------------------------------------------------------- 1 | module forthread_data 2 | 3 | 4 | abstract interface 5 | subroutine i_run(arg) 6 | integer :: arg 7 | end subroutine i_run 8 | end interface 9 | 10 | abstract interface 11 | subroutine i_once() bind(c) 12 | end subroutine i_once 13 | end interface 14 | 15 | abstract interface 16 | subroutine i_destructor(arg) bind(c) 17 | use iso_c_binding 18 | integer(c_int) :: arg 19 | end subroutine i_destructor 20 | end interface 21 | 22 | type t_run 23 | procedure(i_run), pointer, nopass :: run 24 | integer, pointer :: arg 25 | end type t_run 26 | 27 | type ptr_t_run 28 | type(t_run), pointer :: t => NULL() 29 | end type ptr_t_run 30 | 31 | integer, parameter :: init_size = 16 32 | type(ptr_t_run), dimension(:), pointer :: routine_table => NULL() 33 | integer :: routine_table_size 34 | integer :: routine_table_mutex 35 | contains 36 | 37 | ! the return value still needs work to be done 38 | ! currently the start_routine cannot return any value. 39 | ! This should be handled similarly to thread_exit 40 | type(c_ptr) function start_routine(arg) bind(c) 41 | use iso_c_binding 42 | implicit none 43 | 44 | #include "ciface.h" 45 | 46 | type(c_ptr), value, intent(in) :: arg 47 | !returns? 48 | 49 | type(t_run), pointer :: exec 50 | integer,pointer :: ret 51 | 52 | call c_f_pointer(arg,exec) 53 | call exec%run(exec%arg) 54 | start_routine = c_null_ptr 55 | end function start_routine 56 | 57 | 58 | end module forthread_data 59 | -------------------------------------------------------------------------------- /test/test03.f03: -------------------------------------------------------------------------------- 1 | module procmod 2 | 3 | integer :: is_initialized = 0 4 | 5 | integer :: somevar 6 | 7 | contains 8 | 9 | subroutine initializer() 10 | 11 | implicit none 12 | 13 | somevar = 42 14 | print *,'initialized',somevar 15 | 16 | end subroutine initializer 17 | 18 | subroutine example(arg) 19 | implicit none 20 | integer :: arg 21 | integer :: info 22 | 23 | print *, 'hello world from',arg 24 | 25 | call forthread_once(is_initialized,initializer,info) 26 | 27 | end subroutine example 28 | end module procmod 29 | 30 | program test03 31 | 32 | use procmod 33 | 34 | !include '../src/iface/ciface.h' 35 | 36 | integer, parameter :: n = 3 37 | integer, dimension(n) :: tid 38 | integer, dimension(n) :: arg 39 | integer :: ret_val 40 | integer :: thread_id 41 | integer :: aid 42 | integer :: i 43 | integer :: info 44 | 45 | aid = -1 46 | print *, '====================== test03 ======================' 47 | print *,'initializing threads' 48 | call forthread_init(info) 49 | if (info.ne.0) then 50 | print *,'error initializing ' 51 | endif 52 | 53 | call forthread_once_init(is_initialized,info) 54 | print *,is_initialized 55 | 56 | do i=1,n 57 | arg(i) = i 58 | call forthread_create(thread_id,aid,example,arg(i),info) 59 | tid(i) = thread_id 60 | if (info.ne.0) then 61 | print *,'error creating thread ',i 62 | endif 63 | enddo 64 | 65 | do i=1,n 66 | print *,'join thread',tid(i) 67 | call forthread_join(tid(i),ret_val,info) 68 | if (info.ne.0) then 69 | print *,'error joining thread ',i 70 | endif 71 | enddo 72 | 73 | call forthread_destroy(info) 74 | if (info.ne.0) then 75 | print *,'error destroying.' 76 | endif 77 | 78 | print *,'somevar:',somevar 79 | 80 | print *, '==================== end test03 ====================' 81 | 82 | 83 | end program test03 84 | -------------------------------------------------------------------------------- /test/test04.f03: -------------------------------------------------------------------------------- 1 | module procmod 2 | 3 | 4 | integer :: counter 5 | integer :: counter_mutex 6 | 7 | 8 | contains 9 | 10 | subroutine example(arg) 11 | implicit none 12 | integer :: arg 13 | integer :: info 14 | 15 | integer :: i 16 | integer :: lcnt 17 | 18 | do i=1,100 19 | call forthread_mutex_lock(counter_mutex,info) 20 | lcnt = counter 21 | lcnt = lcnt + 1 22 | counter = lcnt 23 | call forthread_mutex_unlock(counter_mutex,info) 24 | end do 25 | end subroutine example 26 | end module procmod 27 | 28 | program test04 29 | 30 | use procmod 31 | 32 | !include '../src/iface/ciface.h' 33 | 34 | integer, parameter :: n = 100 35 | integer, dimension(n) :: tid 36 | integer :: arg 37 | integer :: ret_val 38 | integer :: thread_id 39 | integer :: aid 40 | integer :: i 41 | integer :: info 42 | 43 | 44 | aid = -1 45 | arg = 0 46 | print *, '====================== test04 ======================' 47 | print *,'initializing threads' 48 | call forthread_init(info) 49 | if (info.ne.0) then 50 | print *,'error initializing ' 51 | endif 52 | 53 | call forthread_mutex_init(counter_mutex,aid,info) 54 | 55 | do i=1,n 56 | call forthread_create(thread_id,aid,example,arg,info) 57 | tid(i) = thread_id 58 | if (info.ne.0) then 59 | print *,'error creating thread ',i 60 | endif 61 | enddo 62 | 63 | do i=1,n 64 | call forthread_join(tid(i),ret_val,info) 65 | if (info.ne.0) then 66 | print *,'error joining thread ',i 67 | endif 68 | enddo 69 | 70 | call forthread_mutex_destroy(counter_mutex,info) 71 | call forthread_destroy(info) 72 | if (info.ne.0) then 73 | print *,'error destroying.' 74 | endif 75 | 76 | print *,'counter (10000):',counter 77 | 78 | print *, '==================== end test04 ====================' 79 | 80 | 81 | end program test04 82 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | forthreads 2 | ========== 3 | 4 | Fortran 2003 wrappers for POSIX threads 5 | 6 | _Copyright (c) 2012-2017 MOSAIC Group (ETH Zurich & MPI-CBG Dresden), Omar Awile_ 7 | 8 | This project and all files pertaining to it are licensed under the BSD 3-Clause 9 | License. Please see the enclosed LICENSE file for the terms. 10 | 11 | In order to ensure financial support for our project and allow further 12 | development of this software, please cite the following publication in all your 13 | documents and manuscripts that made use of this software. Thanks a lot! 14 | 15 | O. Awile and I. F. Sbalzarini. A pthreads wrapper for Fortran 2003. ACM Trans. 16 | Math. Softw., 40(3):19:1–19:15, 2014. 17 | 18 | Introduction 19 | ------------ 20 | 21 | This library provides Fortran 2003 interfaces to almost all POSIX threads 22 | functions. Following functions are not available in fortrheads: 23 | 24 | * pthread\_cleanup\_push and pthread\_cleanup\_pop: These functions allow the 25 | programmer to register callback functions into a calling thread’s cancellation 26 | cleanup stack that will be popped and executed in order whenever the thread 27 | exits, is cancelled, or calls pthread\_cleanup\_pop itself. These functions cannot 28 | be wrapped, as push and pop must be called in pairs in the same scope. Hence, 29 | the POSIX standard foresees their implementation to be done using C macros. 30 | * Pthread thread-specific data management routines (pthread\_key\_\* and 31 | pthread\_getspecific / pthread\_setspecific): These routines heavily rely on the C 32 | programming language’s void pointers. Unfortunately such pointers are not 33 | available in Fortran. Therefore, it seems difficult to provide portable and safe 34 | wrappers to these functions. 35 | 36 | Also, thread start routines can only take an integer and return an integer for 37 | the same "void-pointer" limitation. 38 | Maybe in the future a mechanism can be added to allow for more generic argument 39 | handling. 40 | 41 | 42 | -------------------------------------------------------------------------------- /src/ft_data.c: -------------------------------------------------------------------------------- 1 | #include "ft_data.h" 2 | 3 | 4 | 5 | 6 | /** 7 | * Initializes a given array. The argument array must be either 8 | * already allocated or a NULL pointer. 9 | **/ 10 | void array_init(array_t **array,int size) { 11 | int i; 12 | 13 | if (*array == NULL) 14 | *array = (array_t*)malloc(sizeof(array_t)); 15 | pthread_mutex_init(&((*array)->mutex),NULL); 16 | (*array)->data = (void**)malloc(sizeof(void*)*size); 17 | for(i = 0; i < size; i++) 18 | (*array)->data[i] = NULL; 19 | (*array)->size = size; 20 | (*array)->after = 0; 21 | } 22 | 23 | /** 24 | * Initializes a given varray. The argument array must be either 25 | * already allocated or a NULL pointer. 26 | **/ 27 | void varray_init(varray_t **array,int size) { 28 | int i; 29 | 30 | if (*array == NULL) 31 | *array = (varray_t*)malloc(sizeof(varray_t)); 32 | pthread_mutex_init(&((*array)->mutex),NULL); 33 | (*array)->data = (volatile void**)malloc(sizeof(void*)*size); 34 | for(i = 0; i < size; i++) 35 | (*array)->data[i] = NULL; 36 | (*array)->size = size; 37 | (*array)->after = 0; 38 | } 39 | 40 | /** 41 | * Resize array to size. We assume array to be NOT NULL 42 | **/ 43 | void array_resize(array_t **array,int size) { 44 | int i; 45 | 46 | (*array)->data = (void**)realloc((*array)->data,sizeof(void*)*size); 47 | (*array)->size = size; 48 | 49 | for(i = (*array)->after; i < size; i++) 50 | (*array)->data[i] = NULL; 51 | 52 | } 53 | 54 | /** 55 | * Resize varray to size. We assume varray to be NOT NULL 56 | **/ 57 | void varray_resize(varray_t **array,int size) { 58 | int i; 59 | 60 | (*array)->data = (volatile void**)realloc((*array)->data,sizeof(volatile void*)*size); 61 | (*array)->size = size; 62 | 63 | for(i = (*array)->after; i < size; i++) 64 | (*array)->data[i] = NULL; 65 | 66 | } 67 | 68 | /** 69 | * Free memory for array 70 | **/ 71 | void array_delete(array_t *array) { 72 | free(array->data); 73 | free(array); 74 | } 75 | 76 | /** 77 | * Free memory for varray 78 | **/ 79 | void varray_delete(varray_t *array) { 80 | free(array->data); 81 | free(array); 82 | } 83 | 84 | /** 85 | * A simple helper function to check whether an ID 86 | * is pointing to a valid element in arr. This assumes 87 | * that changes in arr are alwys done using this library. 88 | * 89 | * This function is not thread safe 90 | **/ 91 | int is_valid(array_t *arr, int id) { 92 | if ((id >= 0) && (id < arr->after) && 93 | (arr->data[id] != NULL)) 94 | return 1; 95 | else 96 | return 0; 97 | } 98 | 99 | /** 100 | * (varray version) 101 | * A simple helper function to check whether an ID 102 | * is pointing to a valid element in arr. This assumes 103 | * that changes in arr are alwys done using this library. 104 | * 105 | * This function is not thread safe 106 | **/ 107 | int vis_valid(varray_t *arr, int id) { 108 | if ((id >= 0) && (id < arr->after) && 109 | (arr->data[id] != NULL)) 110 | return 1; 111 | else 112 | return 0; 113 | } 114 | -------------------------------------------------------------------------------- /src/ft_data.h: -------------------------------------------------------------------------------- 1 | #ifndef FT_DATA_H_ 2 | #define FT_DATA_H_ 3 | 4 | #include 5 | #include 6 | 7 | 8 | 9 | /** 10 | * A convenient array type 11 | **/ 12 | typedef struct array_tag { 13 | void **data; 14 | int size; 15 | int after; 16 | pthread_mutex_t mutex; 17 | } array_t; 18 | 19 | /** 20 | * A convenient volatile array type 21 | **/ 22 | typedef struct varray_tag { 23 | volatile void **data; 24 | int size; 25 | int after; 26 | pthread_mutex_t mutex; 27 | } varray_t; 28 | 29 | 30 | 31 | /** 32 | * global data structures 33 | **/ 34 | 35 | int is_initialized; 36 | 37 | /** 38 | * holds the thread IDs 39 | **/ 40 | array_t *threads; 41 | 42 | /** 43 | * holds thread attributes, the index does not 44 | * necesseraly conincide with the one of threads. 45 | * 46 | * This array is just to allow different threads spawn new 47 | * threads at the same time. 48 | **/ 49 | array_t *thread_attrs; 50 | 51 | /** 52 | * holds thread keys for storing thread specific data 53 | **/ 54 | array_t *thread_keys; 55 | 56 | /* 57 | * holds the mutex IDs 58 | **/ 59 | array_t *mutexes; 60 | 61 | /** 62 | * holds thread mutex attributes, the index does not 63 | * necesseraly concide with the one of mutexes. 64 | * 65 | * This array is just to allow different threads handle 66 | * their mutexes 67 | **/ 68 | array_t *mutex_attrs; 69 | 70 | /** 71 | * an array to hold pthread_once_t structures 72 | **/ 73 | array_t *once_ctrls; 74 | 75 | /** 76 | * an array to hold thread condition variable (pthread_cond_t) 77 | * structures 78 | **/ 79 | array_t *conds; 80 | 81 | /** 82 | * holds thread condition variable attributes, the index does not 83 | * necesseraly concide with the one of conds. 84 | * 85 | * This array is just to allow different threads handle 86 | * their condition variables 87 | **/ 88 | array_t *cond_attrs ; 89 | 90 | /** 91 | * an array to hold thread barrier variable (pthread_barrier_t) 92 | * structures 93 | **/ 94 | array_t *barriers; 95 | 96 | /** 97 | * holds thread barrier variable attributes, the index does not 98 | * necesseraly concide with the one of conds. 99 | * 100 | * This array is just to allow different threads handle 101 | * their condition variables 102 | **/ 103 | array_t *barrier_attrs; 104 | 105 | /** 106 | * an array to hold spinlock variable (pthread_spinlock_t) 107 | * structures 108 | **/ 109 | varray_t *spinlocks; 110 | 111 | /** 112 | * an array to hold thread read-write lock variable (pthread_rwlock_t) 113 | * structures 114 | **/ 115 | array_t *rwlocks; 116 | 117 | /** 118 | * holds thread rwlock variable attributes, the index does not 119 | * necesseraly concide with the one of conds. 120 | * 121 | * This array is just to allow different threads handle 122 | * their condition variables 123 | **/ 124 | array_t *rwlock_attrs; 125 | 126 | void array_init(array_t **array,int size); 127 | 128 | void varray_init(varray_t **array,int size); 129 | 130 | void array_resize(array_t **array,int size); 131 | 132 | void varray_resize(varray_t **array,int size); 133 | 134 | void array_delete(array_t *array); 135 | 136 | void varray_delete(varray_t *array); 137 | 138 | // This only works for pointer arrays!! 139 | int is_valid(array_t *arr, int id); 140 | 141 | // varray version 142 | int vis_valid(varray_t *arr, int id); 143 | 144 | 145 | #endif //FT_DATA_H_ 146 | -------------------------------------------------------------------------------- /test/test05.f03: -------------------------------------------------------------------------------- 1 | ! testing condition variables and signaling single threads 2 | 3 | module procmod 4 | 5 | integer, parameter :: maxcount = 100 6 | integer :: counter 7 | integer :: counter_print_cv 8 | integer :: counter_mutex 9 | logical :: printed 10 | integer :: printed_cv 11 | 12 | contains 13 | 14 | subroutine countert(arg) 15 | implicit none 16 | integer :: arg 17 | integer :: info 18 | 19 | do while(.true.) 20 | call forthread_mutex_lock(counter_mutex,info) 21 | if (counter.gt.maxcount) then 22 | call forthread_cond_signal(counter_print_cv,info) 23 | call forthread_mutex_unlock(counter_mutex,info) 24 | return 25 | endif 26 | counter = counter + 1 27 | if (printed) printed = .false. 28 | if (mod(counter,10).eq.0) then 29 | call forthread_cond_signal(counter_print_cv,info) 30 | do while (.not.printed) 31 | call forthread_cond_wait(printed_cv,counter_mutex,info) 32 | enddo 33 | endif 34 | 35 | call forthread_mutex_unlock(counter_mutex,info) 36 | enddo 37 | end subroutine countert 38 | 39 | subroutine printer(arg) 40 | implicit none 41 | integer :: arg 42 | integer :: info 43 | 44 | 45 | do while(.true.) 46 | call forthread_mutex_lock(counter_mutex,info) 47 | do while (.not.(mod(counter,10).eq.0).and.(counter.le.maxcount)) 48 | call forthread_cond_wait(counter_print_cv,counter_mutex,info) 49 | end do 50 | if ((.not.printed).and.(mod(counter,10).eq.0)) then 51 | print *,'counter is:',counter 52 | printed = .true. 53 | endif 54 | if (counter.gt.maxcount) then 55 | call forthread_mutex_unlock(counter_mutex,info) 56 | return 57 | endif 58 | call forthread_cond_signal(printed_cv,info) 59 | 60 | call forthread_mutex_unlock(counter_mutex,info) 61 | enddo 62 | 63 | end subroutine printer 64 | 65 | end module procmod 66 | 67 | program test05 68 | 69 | use procmod 70 | 71 | !include '../src/iface/ciface.h' 72 | 73 | integer, parameter :: n = 2 74 | integer, dimension(n) :: tid 75 | integer :: arg 76 | integer :: ret_val 77 | integer :: thread_id 78 | integer :: aid 79 | integer :: i 80 | integer :: info 81 | 82 | counter = 1 83 | aid = -1 84 | arg = 0 85 | printed = .false. 86 | print *, '====================== test05 ======================' 87 | print *,'initializing threads' 88 | call forthread_init(info) 89 | if (info.ne.0) then 90 | print *,'error initializing ' 91 | endif 92 | 93 | call forthread_mutex_init(counter_mutex,aid,info) 94 | call forthread_cond_init(counter_print_cv,aid,info) 95 | call forthread_cond_init(printed_cv,aid,info) 96 | 97 | call forthread_create(thread_id,aid,printer,arg,info) 98 | tid(1) = thread_id 99 | do i=2,n 100 | call forthread_create(thread_id,aid,countert,arg,info) 101 | tid(i) = thread_id 102 | if (info.ne.0) then 103 | print *,'error creating thread ',i 104 | endif 105 | enddo 106 | 107 | do i=1,n 108 | call forthread_join(tid(i),ret_val,info) 109 | if (info.ne.0) then 110 | print *,'error joining thread ',i 111 | endif 112 | enddo 113 | 114 | call forthread_mutex_destroy(counter_mutex,info) 115 | call forthread_cond_destroy(counter_print_cv,info) 116 | call forthread_destroy(info) 117 | if (info.ne.0) then 118 | print *,'error destroying.' 119 | endif 120 | 121 | print *,'counter (101):',counter 122 | 123 | print *, '==================== end test05 ====================' 124 | 125 | 126 | end program test05 127 | -------------------------------------------------------------------------------- /src/ft_attr.h: -------------------------------------------------------------------------------- 1 | #ifndef _FT_ATTR_H_ 2 | #define _FT_ATTR_H_ 3 | 4 | /** 5 | * NOTE: 6 | * The routines: 7 | * - pthread_attr_setstack 8 | * - pthread_attr_setstackaddr 9 | * - pthread_attr_getstack 10 | * - pthread_attr_getstackaddr 11 | * are not wrapped and shall not be visible to 12 | * Fortran programs. This had to be done because Fortran generally does not 13 | * expose memory addresses to the programmer. For most applications it should 14 | * anyway not be necessary for the programmer to allocate the thread stack 15 | * manually. 16 | * 17 | * To explicitly set the size of the stack the routine thread_setstacksize 18 | * should be used. 19 | **/ 20 | 21 | #include 22 | #include 23 | #include "ft_consts.h" 24 | #include "ft_data.h" 25 | 26 | #if defined(_POSIX_BARRIERS) && ((_POSIX_BARRIERS + 0) >= 200112L) 27 | #define THREAD_POSIX_BARRIERS 28 | #endif 29 | 30 | 31 | /*****************************************/ 32 | /* attribute object routines */ 33 | /*****************************************/ 34 | 35 | void thread_attr_destroy(int *attr, int *info); 36 | 37 | 38 | void thread_attr_init(int *attr, int *info); 39 | 40 | void thread_attr_getdetachstate(int *attr, int *detachstate, int *info); 41 | 42 | void thread_attr_setdetachstate(int *attr, int *detachstate, int *info); 43 | 44 | void thread_attr_getguardsize(int *attr, size_t *guardsize, int *info); 45 | 46 | void thread_attr_setguardsize(int *attr, size_t *guardsize, int *info); 47 | 48 | void thread_attr_getinheritsched(int *attr, int *inheritsched, int *info); 49 | 50 | void thread_attr_setinheritsched(int *attr, int *inheritsched, int *info); 51 | 52 | void thread_attr_getschedparam(int *attr, struct sched_param *param, int *info); 53 | 54 | void thread_attr_setschedparam(int *attr, struct sched_param *param, int *info); 55 | 56 | void thread_attr_getschedpolicy(int *attr, int *policy, int *info); 57 | 58 | void thread_attr_setschedpolicy(int *attr, int *policy, int *info); 59 | 60 | void thread_attr_getscope(int *attr, int *scope, int *info); 61 | 62 | void thread_attr_setscope(int *attr, int *scope, int *info); 63 | 64 | void thread_attr_getstacksize(int *attr, size_t *stacksize, int *info); 65 | 66 | void thread_attr_setstacksize(int *attr, size_t *stacksize, int *info); 67 | 68 | /*****************************************/ 69 | /* mutex attribute routines */ 70 | /*****************************************/ 71 | 72 | void thread_mutexattr_destroy(int *attr,int *info); 73 | 74 | void thread_mutexattr_init(int *attr,int *info); 75 | 76 | void thread_mutexattr_getpshared(int *attr, int *pshared, int *info); 77 | 78 | void thread_mutexattr_setpshared(int *attr, int *pshared, int *info); 79 | 80 | void thread_mutexattr_getprioceiling(int *attr, int *prioceiling, int *info); 81 | 82 | void thread_mutexattr_setprioceiling(int *attr, int *prioceiling, int *info); 83 | 84 | void thread_mutexattr_getprotocol(int *attr, int *protocol, int *info); 85 | 86 | void thread_mutexattr_setprotocol(int *attr, int *protocol, int *info); 87 | 88 | void thread_mutexattr_gettype(int *attr, int *type, int *info); 89 | 90 | void thread_mutexattr_settype(int *attr, int *type, int *info); 91 | 92 | 93 | /*****************************************************/ 94 | /* condition attriubute variable routines */ 95 | /*****************************************************/ 96 | 97 | 98 | void thread_condattr_destroy(int *attr,int *info); 99 | 100 | 101 | void thread_condattr_init(int *attr,int *info); 102 | 103 | void thread_condattr_getpshared(int *attr, int *pshared, int *info); 104 | 105 | void thread_condattr_setpshared(int *attr, int *pshared, int *info); 106 | 107 | #ifndef __DARWIN 108 | void thread_condattr_getclock(int *attr, int *clock_id, int *info); 109 | 110 | void thread_condattr_setclock(int *attr, int *clock_id, int *info); 111 | #endif 112 | 113 | #ifdef THREAD_POSIX_BARRIERS 114 | /**************************************************/ 115 | /* barrier attribute variable routines */ 116 | /**************************************************/ 117 | 118 | 119 | void thread_barrierattr_destroy(int *attr,int *info); 120 | 121 | void thread_barrierattr_init(int *attr,int *info); 122 | 123 | void thread_barrierattr_getpshared(int *attr, int *pshared, int *info); 124 | 125 | void thread_barrierattr_setpshared(int *attr, int *pshared, int *info); 126 | #endif 127 | 128 | /**************************************************/ 129 | /* rwlock attribute variable routines */ 130 | /**************************************************/ 131 | 132 | 133 | void thread_rwlockattr_destroy(int *attr,int *info); 134 | 135 | void thread_rwlockattr_init(int *attr,int *info); 136 | 137 | void thread_rwlockattr_getpshared(int *attr, int *pshared, int *info); 138 | 139 | void thread_rwlockattr_setpshared(int *attr, int *pshared, int *info); 140 | 141 | 142 | 143 | #endif //_FT_ATTR_H 144 | -------------------------------------------------------------------------------- /src/forthread.h: -------------------------------------------------------------------------------- 1 | #ifndef FORT_PTHREAD_H_ 2 | #define FORT_PTHREAD_H_ 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | 11 | 12 | 13 | 14 | void thread_init(int *info); 15 | 16 | void thread_destroy(int* info); 17 | 18 | 19 | /*****************************************/ 20 | 21 | void thread_alloc(int *thread_id, int *info); 22 | 23 | void thread_create(int *thread_id, int *attr_id, 24 | void *(**start_routine)(void *), 25 | void *arg, int* info); 26 | 27 | void thread_detach(int *thread_id, int *info); 28 | 29 | void thread_equal(int *t1, int *t2, int *info); 30 | 31 | 32 | void thread_exit(void *value_ptr); 33 | 34 | 35 | void thread_join(int *thread_id, void **value_ptr, int *info); 36 | 37 | void thread_cancel(int *thread_id, int *info); 38 | 39 | void thread_kill(int *thread_id, int *sig, int *info); 40 | 41 | void thread_once_init(int *once_ctrl, int *info); 42 | 43 | void thread_once(int *once_ctrl_id, void (**routine)(void), int *info); 44 | 45 | void thread_self(int *thread_id, int *info); 46 | 47 | 48 | void thread_atfork(void (**prepare)(void), 49 | void (**parent)(void), 50 | void (**child)(void), int *info); 51 | 52 | // cannot be implemented using pthreads 53 | // this should be done in fortran 54 | // TODO provide fortran implementation if possible 55 | void thread_cleanup_pop(int *execute, 56 | int *info); 57 | 58 | // cannot be implemented using pthreads 59 | // this should be done in fortran 60 | // TODO provide fortran implementation if possible 61 | void thread_cleanup_push(void *(*routine)(void *), 62 | void *arg, int* info); 63 | 64 | void thread_getconcurrency(int *currlevel, int *info); 65 | 66 | void thread_setconcurrency(int *newlevel, int *info); 67 | 68 | 69 | #ifndef __DARWIN 70 | void thread_getcpuclockid(int *thread, int *clock_id, int *info); 71 | #endif 72 | 73 | void thread_getschedparam(int *thread, int *policy, struct sched_param *param, int *info); 74 | void thread_setschedparam(int *thread, int *policy, struct sched_param *param, int *info); 75 | #ifndef __DARWIN 76 | void thread_setschedprio(int *thread, int *prio, int *info); 77 | #endif 78 | 79 | void thread_setcancelstate(int *state, int *oldstate, int *info); 80 | void thread_setcanceltype(int *type, int *oldtype, int *info); 81 | 82 | 83 | /*****************************************/ 84 | /* storing private data in threads */ 85 | /*****************************************/ 86 | 87 | void thread_key_delete(int *key_id, int *info); 88 | 89 | void thread_key_create(int *key_id,void (*destructor)(void *),int *info); 90 | 91 | void thread_getspecific(int *key, void **value, int *info); 92 | 93 | void thread_setspecific(int *key, void **value, int *info); 94 | 95 | /*****************************************/ 96 | /* mutex routines */ 97 | /*****************************************/ 98 | 99 | void thread_mutex_destroy(int *mutex_id, int *info); 100 | 101 | void thread_mutex_init(int *mutex_id, int *attr_id, int *info); 102 | 103 | void thread_mutex_lock(int *mutex_id, int *info); 104 | 105 | void thread_mutex_trylock(int *mutex_id, int *info); 106 | 107 | void thread_mutex_unlock(int *mutex_id, int *info); 108 | 109 | void thread_mutex_getprioceiling(int *mutex, int *prioceiling, int *info); 110 | 111 | void thread_mutex_setprioceiling(int *mutex, int *prioceiling, int *old_ceiling, int *info); 112 | 113 | #ifndef __DARWIN 114 | void thread_mutex_timedlock(int *mutex, struct timespec *abs_timeout, int *info); 115 | #endif 116 | 117 | /*****************************************/ 118 | /* condition variable routines */ 119 | /*****************************************/ 120 | 121 | 122 | void thread_cond_destroy(int *cond_id, int *info); 123 | 124 | void thread_cond_init(int *cond_id, int *attr_id, int *info); 125 | 126 | void thread_cond_timedwait(int *cond_id, int *mutex_id, struct timespec *abstime, int *info); 127 | 128 | void thread_cond_wait(int *cond_id, int *mutex_id, int *info); 129 | 130 | void thread_cond_broadcast(int *cond_id, int *info); 131 | 132 | void thread_cond_signal(int *cond_id, int *info); 133 | 134 | 135 | 136 | #ifdef THREAD_POSIX_BARRIERS 137 | /****************************************/ 138 | /* barrier variable routines */ 139 | /****************************************/ 140 | 141 | void thread_barrier_destroy(int *barrier_id, int *info); 142 | 143 | 144 | void thread_barrier_init(int *barrier_id, int *attr_id, int *count, int *info); 145 | 146 | void thread_barrier_wait(int *barrier_id, int *info); 147 | #endif 148 | 149 | 150 | #ifndef __DARWIN 151 | /*************************************/ 152 | /* spin variable routines */ 153 | /*************************************/ 154 | 155 | void thread_spin_destroy(int *spinlock_id, int *info); 156 | 157 | 158 | void thread_spin_init(int *spinlock_id, int *pshared, int *info); 159 | 160 | void thread_spin_lock(int *lock_id, int *info); 161 | 162 | void thread_spin_trylock(int *lock_id, int *info); 163 | 164 | 165 | void thread_spin_unlock(int *lock_id, int *info); 166 | #endif 167 | 168 | /*************************************/ 169 | /* rwlock variable routines */ 170 | /*************************************/ 171 | 172 | 173 | void thread_rwlock_destroy(int *rwlock_id, int *info); 174 | 175 | void thread_rwlock_init(int *rwlock_id, int *attr_id, int *info); 176 | 177 | void thread_rwlock_rdlock(int *lock_id, int *info); 178 | 179 | void thread_rwlock_tryrdlock(int *lock_id, int *info); 180 | 181 | void thread_rwlock_wrlock(int *lock_id, int *info); 182 | 183 | void thread_rwlock_trywrlock(int *lock_id, int *info); 184 | 185 | void thread_rwlock_unlock(int *lock_id, int *info); 186 | 187 | #ifndef __DARWIN 188 | void thread_rwlock_timedrdlock(int *lock_id, struct timespec *abs_timeout, int *info); 189 | 190 | void thread_rwlock_timedwrlock(int *lock_id, struct timespec *abs_timeout, int *info); 191 | #endif 192 | 193 | 194 | #endif //FORT_PTHREAD_H_ 195 | -------------------------------------------------------------------------------- /src/ft_attr.c: -------------------------------------------------------------------------------- 1 | 2 | #include "ft_attr.h" 3 | 4 | 5 | /*****************************************/ 6 | /* attribute object routines */ 7 | /*****************************************/ 8 | 9 | 10 | 11 | void thread_attr_destroy(int *attr, int *info) { 12 | *info = FT_OK; 13 | 14 | if (!is_initialized) { 15 | *info = FT_EINIT; 16 | return; 17 | } 18 | 19 | pthread_mutex_lock(&(thread_attrs->mutex)); 20 | 21 | if (!is_valid(thread_attrs,*attr)) { 22 | pthread_mutex_unlock(&(thread_attrs->mutex)); 23 | *info = FT_EINVALID; 24 | return; 25 | } 26 | 27 | *info = pthread_attr_destroy(((pthread_attr_t*)(thread_attrs->data[*attr]))); 28 | 29 | if (*info) { 30 | pthread_mutex_unlock(&(thread_attrs->mutex)); 31 | return; 32 | } 33 | free(thread_attrs->data[*attr]); 34 | thread_attrs->data[*attr] = NULL; 35 | 36 | pthread_mutex_unlock(&(thread_attrs->mutex)); 37 | 38 | } 39 | 40 | 41 | void thread_attr_init(int *attr, int *info) { 42 | *info = FT_OK; 43 | 44 | if (!is_initialized) { 45 | *info = FT_EINIT; 46 | return; 47 | } 48 | 49 | pthread_mutex_lock(&(thread_attrs->mutex)); 50 | 51 | if (thread_attrs->after == thread_attrs->size) { 52 | // we exhausted the thread id and attribute arrays, double space 53 | array_resize(&thread_attrs,thread_attrs->size*2); 54 | } 55 | thread_attrs->data[thread_attrs->after] = 56 | (pthread_attr_t*) malloc(sizeof(pthread_attr_t)); 57 | 58 | *info = pthread_attr_init(thread_attrs->data[thread_attrs->after]); 59 | 60 | if (*info) { 61 | pthread_mutex_unlock(&(thread_attrs->mutex)); 62 | return; 63 | } 64 | 65 | *attr = thread_attrs->after; 66 | thread_attrs->after++; 67 | 68 | pthread_mutex_unlock(&thread_attrs->mutex); 69 | 70 | } 71 | 72 | void thread_attr_getdetachstate(int *attr, int *detachstate, int *info) { 73 | *info = FT_OK; 74 | 75 | if (!is_initialized) { 76 | *info = FT_EINIT; 77 | return; 78 | } 79 | 80 | pthread_mutex_lock(&(thread_attrs->mutex)); 81 | if (!is_valid(thread_attrs,*attr)) { 82 | pthread_mutex_unlock(&(thread_attrs->mutex)); 83 | *info = FT_EINVALID; 84 | return; 85 | } 86 | 87 | *info = pthread_attr_getdetachstate((pthread_attr_t*)(thread_attrs->data[*attr]),detachstate); 88 | 89 | pthread_mutex_unlock(&(thread_attrs->mutex)); 90 | 91 | } 92 | 93 | void thread_attr_setdetachstate(int *attr, int *detachstate, int *info) { 94 | *info = FT_OK; 95 | 96 | if (!is_initialized) { 97 | *info = FT_EINIT; 98 | return; 99 | } 100 | 101 | pthread_mutex_lock(&(thread_attrs->mutex)); 102 | if (!is_valid(thread_attrs,*attr)) { 103 | pthread_mutex_unlock(&(thread_attrs->mutex)); 104 | *info = FT_EINVALID; 105 | return; 106 | } 107 | 108 | *info = pthread_attr_setdetachstate((pthread_attr_t*)(thread_attrs->data[*attr]),*detachstate); 109 | 110 | pthread_mutex_unlock(&(thread_attrs->mutex)); 111 | 112 | } 113 | 114 | void thread_attr_getguardsize(int *attr, size_t *guardsize, int *info) { 115 | *info = FT_OK; 116 | 117 | if (!is_initialized) { 118 | *info = FT_EINIT; 119 | return; 120 | } 121 | 122 | pthread_mutex_lock(&(thread_attrs->mutex)); 123 | if (!is_valid(thread_attrs,*attr)) { 124 | pthread_mutex_unlock(&(thread_attrs->mutex)); 125 | *info = FT_EINVALID; 126 | return; 127 | } 128 | 129 | *info = pthread_attr_getguardsize((pthread_attr_t*)(thread_attrs->data[*attr]),guardsize); 130 | 131 | pthread_mutex_unlock(&(thread_attrs->mutex)); 132 | 133 | } 134 | 135 | void thread_attr_setguardsize(int *attr, size_t *guardsize, int *info) { 136 | *info = FT_OK; 137 | 138 | if (!is_initialized) { 139 | *info = FT_EINIT; 140 | return; 141 | } 142 | 143 | pthread_mutex_lock(&(thread_attrs->mutex)); 144 | if (!is_valid(thread_attrs,*attr)) { 145 | pthread_mutex_unlock(&(thread_attrs->mutex)); 146 | *info = FT_EINVALID; 147 | return; 148 | } 149 | 150 | *info = pthread_attr_setguardsize((pthread_attr_t*)(thread_attrs->data[*attr]),*guardsize); 151 | 152 | pthread_mutex_unlock(&(thread_attrs->mutex)); 153 | 154 | } 155 | 156 | void thread_attr_getinheritsched(int *attr, int *inheritsched, int *info) { 157 | *info = FT_OK; 158 | 159 | if (!is_initialized) { 160 | *info = FT_EINIT; 161 | return; 162 | } 163 | 164 | pthread_mutex_lock(&(thread_attrs->mutex)); 165 | if (!is_valid(thread_attrs,*attr)) { 166 | pthread_mutex_unlock(&(thread_attrs->mutex)); 167 | *info = FT_EINVALID; 168 | return; 169 | } 170 | 171 | *info = pthread_attr_getinheritsched((pthread_attr_t*)(thread_attrs->data[*attr]),inheritsched); 172 | 173 | pthread_mutex_unlock(&(thread_attrs->mutex)); 174 | 175 | } 176 | 177 | void thread_attr_setinheritsched(int *attr, int *inheritsched, int *info) { 178 | *info = FT_OK; 179 | 180 | if (!is_initialized) { 181 | *info = FT_EINIT; 182 | return; 183 | } 184 | 185 | pthread_mutex_lock(&(thread_attrs->mutex)); 186 | if (!is_valid(thread_attrs,*attr)) { 187 | pthread_mutex_unlock(&(thread_attrs->mutex)); 188 | *info = FT_EINVALID; 189 | return; 190 | } 191 | 192 | *info = pthread_attr_setinheritsched((pthread_attr_t*)(thread_attrs->data[*attr]),*inheritsched); 193 | 194 | pthread_mutex_unlock(&(thread_attrs->mutex)); 195 | 196 | } 197 | 198 | void thread_attr_getschedparam(int *attr, struct sched_param *param, int *info) { 199 | *info = FT_OK; 200 | 201 | if (!is_initialized) { 202 | *info = FT_EINIT; 203 | return; 204 | } 205 | 206 | pthread_mutex_lock(&(thread_attrs->mutex)); 207 | if (!is_valid(thread_attrs,*attr)) { 208 | pthread_mutex_unlock(&(thread_attrs->mutex)); 209 | *info = FT_EINVALID; 210 | return; 211 | } 212 | 213 | *info = pthread_attr_getschedparam((pthread_attr_t*)(thread_attrs->data[*attr]),param); 214 | 215 | 216 | pthread_mutex_unlock(&(thread_attrs->mutex)); 217 | 218 | } 219 | 220 | void thread_attr_setschedparam(int *attr, struct sched_param *param, int *info) { 221 | *info = FT_OK; 222 | 223 | if (!is_initialized) { 224 | *info = FT_EINIT; 225 | return; 226 | } 227 | 228 | pthread_mutex_lock(&(thread_attrs->mutex)); 229 | if (!is_valid(thread_attrs,*attr)) { 230 | pthread_mutex_unlock(&(thread_attrs->mutex)); 231 | *info = FT_EINVALID; 232 | return; 233 | } 234 | 235 | *info = pthread_attr_setschedparam((pthread_attr_t*)(thread_attrs->data[*attr]),param); 236 | 237 | pthread_mutex_unlock(&(thread_attrs->mutex)); 238 | 239 | } 240 | 241 | void thread_attr_getschedpolicy(int *attr, int *policy, int *info) { 242 | *info = FT_OK; 243 | 244 | if (!is_initialized) { 245 | *info = FT_EINIT; 246 | return; 247 | } 248 | 249 | pthread_mutex_lock(&(thread_attrs->mutex)); 250 | if (!is_valid(thread_attrs,*attr)) { 251 | pthread_mutex_unlock(&(thread_attrs->mutex)); 252 | *info = FT_EINVALID; 253 | return; 254 | } 255 | 256 | *info = pthread_attr_getschedpolicy((pthread_attr_t*)(thread_attrs->data[*attr]),policy); 257 | 258 | pthread_mutex_unlock(&(thread_attrs->mutex)); 259 | 260 | } 261 | 262 | void thread_attr_setschedpolicy(int *attr, int *policy, int *info) { 263 | *info = FT_OK; 264 | 265 | if (!is_initialized) { 266 | *info = FT_EINIT; 267 | return; 268 | } 269 | 270 | pthread_mutex_lock(&(thread_attrs->mutex)); 271 | if (!is_valid(thread_attrs,*attr)) { 272 | pthread_mutex_unlock(&(thread_attrs->mutex)); 273 | *info = FT_EINVALID; 274 | return; 275 | } 276 | 277 | *info = pthread_attr_setschedpolicy((pthread_attr_t*)(thread_attrs->data[*attr]),*policy); 278 | 279 | pthread_mutex_unlock(&(thread_attrs->mutex)); 280 | 281 | } 282 | 283 | void thread_attr_getscope(int *attr, int *scope, int *info) { 284 | *info = FT_OK; 285 | 286 | if (!is_initialized) { 287 | *info = FT_EINIT; 288 | return; 289 | } 290 | 291 | pthread_mutex_lock(&(thread_attrs->mutex)); 292 | if (!is_valid(thread_attrs,*attr)) { 293 | pthread_mutex_unlock(&(thread_attrs->mutex)); 294 | *info = FT_EINVALID; 295 | return; 296 | } 297 | 298 | *info = pthread_attr_getscope((pthread_attr_t*)(thread_attrs->data[*attr]),scope); 299 | 300 | pthread_mutex_unlock(&(thread_attrs->mutex)); 301 | 302 | } 303 | 304 | void thread_attr_setscope(int *attr, int *scope, int *info) { 305 | *info = FT_OK; 306 | 307 | if (!is_initialized) { 308 | *info = FT_EINIT; 309 | return; 310 | } 311 | 312 | pthread_mutex_lock(&(thread_attrs->mutex)); 313 | if (!is_valid(thread_attrs,*attr)) { 314 | pthread_mutex_unlock(&(thread_attrs->mutex)); 315 | *info = FT_EINVALID; 316 | return; 317 | } 318 | 319 | *info = pthread_attr_setscope((pthread_attr_t*)(thread_attrs->data[*attr]),*scope); 320 | 321 | pthread_mutex_unlock(&(thread_attrs->mutex)); 322 | 323 | } 324 | 325 | void thread_attr_getstacksize(int *attr, size_t *stacksize, int *info) { 326 | *info = FT_OK; 327 | 328 | if (!is_initialized) { 329 | *info = FT_EINIT; 330 | return; 331 | } 332 | 333 | pthread_mutex_lock(&(thread_attrs->mutex)); 334 | if (!is_valid(thread_attrs,*attr)) { 335 | pthread_mutex_unlock(&(thread_attrs->mutex)); 336 | *info = FT_EINVALID; 337 | return; 338 | } 339 | 340 | *info = pthread_attr_getstacksize((pthread_attr_t*)(thread_attrs->data[*attr]),stacksize); 341 | 342 | pthread_mutex_unlock(&(thread_attrs->mutex)); 343 | 344 | } 345 | 346 | void thread_attr_setstacksize(int *attr, size_t *stacksize, int *info) { 347 | *info = FT_OK; 348 | 349 | if (!is_initialized) { 350 | *info = FT_EINIT; 351 | return; 352 | } 353 | 354 | pthread_mutex_lock(&(thread_attrs->mutex)); 355 | if (!is_valid(thread_attrs,*attr)) { 356 | pthread_mutex_unlock(&(thread_attrs->mutex)); 357 | *info = FT_EINVALID; 358 | return; 359 | } 360 | 361 | *info = pthread_attr_setstacksize((pthread_attr_t*)(thread_attrs->data[*attr]),*stacksize); 362 | 363 | pthread_mutex_unlock(&(thread_attrs->mutex)); 364 | 365 | } 366 | 367 | 368 | /*****************************************/ 369 | /* mutex attribute routines */ 370 | /*****************************************/ 371 | 372 | void thread_mutexattr_destroy(int *attr,int *info) { 373 | *info = FT_OK; 374 | 375 | if (!is_initialized) { 376 | *info = FT_EINIT; 377 | return; 378 | } 379 | 380 | pthread_mutex_lock(&(mutex_attrs->mutex)); 381 | 382 | if (!is_valid(mutex_attrs,*attr)) { 383 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 384 | *info = FT_EINVALID; 385 | return; 386 | } 387 | 388 | *info = pthread_mutexattr_destroy(((pthread_mutexattr_t*)( 389 | mutex_attrs->data[*attr]))); 390 | 391 | if (*info) { 392 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 393 | return; 394 | } 395 | 396 | free(mutex_attrs->data[*attr]); 397 | mutex_attrs->data[*attr] = NULL; 398 | 399 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 400 | 401 | 402 | 403 | } 404 | 405 | 406 | void thread_mutexattr_init(int *attr,int *info) { 407 | *info = FT_OK; 408 | 409 | if (!is_initialized) { 410 | *info = FT_EINIT; 411 | return; 412 | } 413 | 414 | pthread_mutex_lock(&(mutex_attrs->mutex)); 415 | 416 | if (mutex_attrs->after == mutex_attrs->size) { 417 | // we exhausted the mutex attribute array, double space 418 | array_resize(&mutex_attrs,mutex_attrs->size*2); 419 | } 420 | mutex_attrs->data[mutex_attrs->after] = 421 | (pthread_mutexattr_t*) malloc(sizeof(pthread_mutexattr_t)); 422 | 423 | *info = pthread_mutexattr_init(mutex_attrs->data[mutex_attrs->after]); 424 | 425 | if (*info) { 426 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 427 | return; 428 | } 429 | 430 | *attr = mutex_attrs->after; 431 | mutex_attrs->after++; 432 | 433 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 434 | 435 | } 436 | 437 | void thread_mutexattr_getpshared(int *attr, int *pshared, int *info) { 438 | *info = FT_OK; 439 | 440 | if (!is_initialized) { 441 | *info = FT_EINIT; 442 | return; 443 | } 444 | 445 | pthread_mutex_lock(&(mutex_attrs->mutex)); 446 | if (!is_valid(mutex_attrs,*attr)) { 447 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 448 | *info = FT_EINVALID; 449 | return; 450 | } 451 | 452 | *info = pthread_mutexattr_getpshared( 453 | (pthread_mutexattr_t*)(mutex_attrs->data[*attr]), 454 | pshared); 455 | 456 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 457 | 458 | } 459 | 460 | void thread_mutexattr_setpshared(int *attr, int *pshared, int *info) { 461 | *info = FT_OK; 462 | 463 | if (!is_initialized) { 464 | *info = FT_EINIT; 465 | return; 466 | } 467 | 468 | pthread_mutex_lock(&(mutex_attrs->mutex)); 469 | if (!is_valid(mutex_attrs,*attr)) { 470 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 471 | *info = FT_EINVALID; 472 | return; 473 | } 474 | 475 | *info = pthread_mutexattr_setpshared( 476 | (pthread_mutexattr_t*)(mutex_attrs->data[*attr]), 477 | *pshared); 478 | 479 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 480 | 481 | } 482 | 483 | void thread_mutexattr_getprioceiling(int *attr, int *prioceiling, int *info) { 484 | *info = FT_OK; 485 | 486 | if (!is_initialized) { 487 | *info = FT_EINIT; 488 | return; 489 | } 490 | 491 | pthread_mutex_lock(&(mutex_attrs->mutex)); 492 | if (!is_valid(mutex_attrs,*attr)) { 493 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 494 | *info = FT_EINVALID; 495 | return; 496 | } 497 | 498 | *info = pthread_mutexattr_getprioceiling( 499 | (pthread_mutexattr_t*)(mutex_attrs->data[*attr]), 500 | prioceiling); 501 | 502 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 503 | 504 | } 505 | 506 | void thread_mutexattr_setprioceiling(int *attr, int *prioceiling, int *info) { 507 | *info = FT_OK; 508 | 509 | if (!is_initialized) { 510 | *info = FT_EINIT; 511 | return; 512 | } 513 | 514 | pthread_mutex_lock(&(mutex_attrs->mutex)); 515 | if (!is_valid(mutex_attrs,*attr)) { 516 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 517 | *info = FT_EINVALID; 518 | return; 519 | } 520 | 521 | *info = pthread_mutexattr_setprioceiling( 522 | (pthread_mutexattr_t*)(mutex_attrs->data[*attr]), 523 | *prioceiling); 524 | 525 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 526 | 527 | } 528 | 529 | void thread_mutexattr_getprotocol(int *attr, int *protocol, int *info) { 530 | *info = FT_OK; 531 | 532 | if (!is_initialized) { 533 | *info = FT_EINIT; 534 | return; 535 | } 536 | 537 | pthread_mutex_lock(&(mutex_attrs->mutex)); 538 | if (!is_valid(mutex_attrs,*attr)) { 539 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 540 | *info = FT_EINVALID; 541 | return; 542 | } 543 | 544 | *info = pthread_mutexattr_getprotocol( 545 | (pthread_mutexattr_t*)(mutex_attrs->data[*attr]), 546 | protocol); 547 | 548 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 549 | 550 | } 551 | 552 | void thread_mutexattr_setprotocol(int *attr, int *protocol, int *info) { 553 | *info = FT_OK; 554 | 555 | if (!is_initialized) { 556 | *info = FT_EINIT; 557 | return; 558 | } 559 | 560 | pthread_mutex_lock(&(mutex_attrs->mutex)); 561 | if (!is_valid(mutex_attrs,*attr)) { 562 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 563 | *info = FT_EINVALID; 564 | return; 565 | } 566 | 567 | *info = pthread_mutexattr_setprotocol( 568 | (pthread_mutexattr_t*)(mutex_attrs->data[*attr]), 569 | *protocol); 570 | 571 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 572 | 573 | } 574 | 575 | void thread_mutexattr_gettype(int *attr, int *type, int *info) { 576 | *info = FT_OK; 577 | 578 | if (!is_initialized) { 579 | *info = FT_EINIT; 580 | return; 581 | } 582 | 583 | pthread_mutex_lock(&(mutex_attrs->mutex)); 584 | if (!is_valid(mutex_attrs,*attr)) { 585 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 586 | *info = FT_EINVALID; 587 | return; 588 | } 589 | 590 | *info = pthread_mutexattr_gettype( 591 | (pthread_mutexattr_t*)(mutex_attrs->data[*attr]), 592 | type); 593 | 594 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 595 | 596 | } 597 | 598 | void thread_mutexattr_settype(int *attr, int *type, int *info) { 599 | *info = FT_OK; 600 | 601 | if (!is_initialized) { 602 | *info = FT_EINIT; 603 | return; 604 | } 605 | 606 | pthread_mutex_lock(&(mutex_attrs->mutex)); 607 | if (!is_valid(mutex_attrs,*attr)) { 608 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 609 | *info = FT_EINVALID; 610 | return; 611 | } 612 | 613 | *info = pthread_mutexattr_settype( 614 | (pthread_mutexattr_t*)(mutex_attrs->data[*attr]), 615 | *type); 616 | 617 | pthread_mutex_unlock(&(mutex_attrs->mutex)); 618 | 619 | } 620 | 621 | /*****************************************************/ 622 | /* condition attriubute variable routines */ 623 | /*****************************************************/ 624 | 625 | 626 | void thread_condattr_destroy(int *attr,int *info) { 627 | *info = FT_OK; 628 | 629 | if (!is_initialized) { 630 | *info = FT_EINIT; 631 | return; 632 | } 633 | 634 | pthread_mutex_lock(&(cond_attrs->mutex)); 635 | 636 | if (!is_valid(cond_attrs,*attr)) { 637 | pthread_mutex_unlock(&(cond_attrs->mutex)); 638 | *info = FT_EINVALID; 639 | return; 640 | } 641 | 642 | *info = pthread_condattr_destroy(((pthread_condattr_t*)( 643 | cond_attrs->data[*attr]))); 644 | 645 | if (*info) { 646 | pthread_mutex_unlock(&(cond_attrs->mutex)); 647 | return; 648 | } 649 | 650 | free(cond_attrs->data[*attr]); 651 | cond_attrs->data[*attr] = NULL; 652 | 653 | pthread_mutex_unlock(&(cond_attrs->mutex)); 654 | 655 | } 656 | 657 | 658 | void thread_condattr_init(int *attr,int *info) { 659 | *info = FT_OK; 660 | 661 | if (!is_initialized) { 662 | *info = FT_EINIT; 663 | return; 664 | } 665 | 666 | pthread_mutex_lock(&(cond_attrs->mutex)); 667 | 668 | if (cond_attrs->after == cond_attrs->size) { 669 | // we exhausted the mutex attribute array, double space 670 | array_resize(&cond_attrs,cond_attrs->size*2); 671 | } 672 | cond_attrs->data[cond_attrs->after] = 673 | (pthread_condattr_t*) malloc(sizeof(pthread_condattr_t)); 674 | 675 | *info = pthread_condattr_init(cond_attrs->data[cond_attrs->after]); 676 | 677 | if (*info) { 678 | pthread_mutex_unlock(&(cond_attrs->mutex)); 679 | return; 680 | } 681 | 682 | *attr = cond_attrs->after; 683 | cond_attrs->after++; 684 | 685 | pthread_mutex_unlock(&(cond_attrs->mutex)); 686 | 687 | } 688 | 689 | void thread_condattr_getpshared(int *attr, int *pshared, int *info) { 690 | *info = FT_OK; 691 | 692 | if (!is_initialized) { 693 | *info = FT_EINIT; 694 | return; 695 | } 696 | 697 | pthread_mutex_lock(&(cond_attrs->mutex)); 698 | if (!is_valid(cond_attrs,*attr)) { 699 | pthread_mutex_unlock(&(cond_attrs->mutex)); 700 | *info = FT_EINVALID; 701 | return; 702 | } 703 | 704 | *info = pthread_condattr_getpshared( 705 | (pthread_condattr_t*)(cond_attrs->data[*attr]), 706 | pshared); 707 | 708 | pthread_mutex_unlock(&(cond_attrs->mutex)); 709 | 710 | } 711 | 712 | void thread_condattr_setpshared(int *attr, int *pshared, int *info) { 713 | *info = FT_OK; 714 | 715 | if (!is_initialized) { 716 | *info = FT_EINIT; 717 | return; 718 | } 719 | 720 | pthread_mutex_lock(&(cond_attrs->mutex)); 721 | if (!is_valid(cond_attrs,*attr)) { 722 | pthread_mutex_unlock(&(cond_attrs->mutex)); 723 | *info = FT_EINVALID; 724 | return; 725 | } 726 | 727 | *info = pthread_condattr_setpshared( 728 | (pthread_condattr_t*)(cond_attrs->data[*attr]), 729 | *pshared); 730 | 731 | pthread_mutex_unlock(&(cond_attrs->mutex)); 732 | 733 | } 734 | 735 | #ifndef __DARWIN 736 | void thread_condattr_getclock(int *attr, int *clock_id, int *info) { 737 | *info = FT_OK; 738 | clockid_t cid; //we'll it casting onto an int. This may be dangerous 739 | 740 | if (!is_initialized) { 741 | *info = FT_EINIT; 742 | return; 743 | } 744 | 745 | pthread_mutex_lock(&(cond_attrs->mutex)); 746 | if (!is_valid(cond_attrs,*attr)) { 747 | pthread_mutex_unlock(&(cond_attrs->mutex)); 748 | *info = FT_EINVALID; 749 | return; 750 | } 751 | 752 | *info = pthread_condattr_getclock( 753 | (pthread_condattr_t*)(cond_attrs->data[*attr]), 754 | &cid); 755 | *clock_id = (int)cid; 756 | 757 | pthread_mutex_unlock(&(cond_attrs->mutex)); 758 | 759 | } 760 | 761 | void thread_condattr_setclock(int *attr, int *clock_id, int *info) { 762 | *info = FT_OK; 763 | clockid_t cid; //we'll be casting an int onto it. This may be dangerous. 764 | cid = (clockid_t)clock_id; // this works with libc 2.13 x86_64 - check if there are any notable exceptions 765 | 766 | if (!is_initialized) { 767 | *info = FT_EINIT; 768 | return; 769 | } 770 | 771 | pthread_mutex_lock(&(cond_attrs->mutex)); 772 | if (!is_valid(cond_attrs,*attr)) { 773 | pthread_mutex_unlock(&(cond_attrs->mutex)); 774 | *info = FT_EINVALID; 775 | return; 776 | } 777 | 778 | *info = pthread_condattr_setclock( 779 | (pthread_condattr_t*)(cond_attrs->data[*attr]), 780 | cid); 781 | 782 | pthread_mutex_unlock(&(cond_attrs->mutex)); 783 | 784 | } 785 | #endif 786 | 787 | 788 | #ifdef THREAD_POSIX_BARRIERS 789 | /**************************************************/ 790 | /* barrier attribute variable routines */ 791 | /**************************************************/ 792 | 793 | 794 | void thread_barrierattr_destroy(int *attr,int *info) { 795 | *info = FT_OK; 796 | 797 | if (!is_initialized) { 798 | *info = FT_EINIT; 799 | return; 800 | } 801 | 802 | pthread_mutex_lock(&(barrier_attrs->mutex)); 803 | 804 | if (!is_valid(barrier_attrs,*attr)) { 805 | pthread_mutex_unlock(&(barrier_attrs->mutex)); 806 | *info = FT_EINVALID; 807 | return; 808 | } 809 | 810 | *info = pthread_barrierattr_destroy(((pthread_barrierattr_t*)( 811 | barrier_attrs->data[*attr]))); 812 | 813 | if (*info) { 814 | pthread_mutex_unlock(&(barrier_attrs->mutex)); 815 | return; 816 | } 817 | 818 | free(barrier_attrs->data[*attr]); 819 | barrier_attrs->data[*attr] = NULL; 820 | 821 | pthread_mutex_unlock(&(barrier_attrs->mutex)); 822 | 823 | } 824 | 825 | 826 | void thread_barrierattr_init(int *attr,int *info) { 827 | *info = FT_OK; 828 | 829 | if (!is_initialized) { 830 | *info = FT_EINIT; 831 | return; 832 | } 833 | 834 | pthread_mutex_lock(&(barrier_attrs->mutex)); 835 | 836 | if (barrier_attrs->after == barrier_attrs->size) { 837 | // we exhausted the mutex attribute array, double space 838 | array_resize(&barrier_attrs,barrier_attrs->size*2); 839 | } 840 | barrier_attrs->data[barrier_attrs->after] = 841 | (pthread_barrierattr_t*) malloc(sizeof(pthread_barrierattr_t)); 842 | 843 | *info = pthread_barrierattr_init(barrier_attrs->data[barrier_attrs->after]); 844 | 845 | if (*info) { 846 | pthread_mutex_unlock(&(barrier_attrs->mutex)); 847 | return; 848 | } 849 | 850 | *attr = barrier_attrs->after; 851 | barrier_attrs->after++; 852 | 853 | pthread_mutex_unlock(&(barrier_attrs->mutex)); 854 | 855 | } 856 | 857 | void thread_barrierattr_getpshared(int *attr, int *pshared, int *info) { 858 | *info = FT_OK; 859 | 860 | if (!is_initialized) { 861 | *info = FT_EINIT; 862 | return; 863 | } 864 | 865 | pthread_mutex_lock(&(barrier_attrs->mutex)); 866 | if (!is_valid(barrier_attrs,*attr)) { 867 | pthread_mutex_unlock(&(barrier_attrs->mutex)); 868 | *info = FT_EINVALID; 869 | return; 870 | } 871 | 872 | *info = pthread_barrierattr_getpshared( 873 | (pthread_barrierattr_t*)(barrier_attrs->data[*attr]), 874 | pshared); 875 | 876 | pthread_mutex_unlock(&(barrier_attrs->mutex)); 877 | 878 | } 879 | 880 | void thread_barrierattr_setpshared(int *attr, int *pshared, int *info) { 881 | *info = FT_OK; 882 | 883 | if (!is_initialized) { 884 | *info = FT_EINIT; 885 | return; 886 | } 887 | 888 | pthread_mutex_lock(&(barrier_attrs->mutex)); 889 | if (!is_valid(barrier_attrs,*attr)) { 890 | pthread_mutex_unlock(&(barrier_attrs->mutex)); 891 | *info = FT_EINVALID; 892 | return; 893 | } 894 | 895 | *info = pthread_barrierattr_setpshared( 896 | (pthread_barrierattr_t*)(barrier_attrs->data[*attr]), 897 | *pshared); 898 | 899 | pthread_mutex_unlock(&(barrier_attrs->mutex)); 900 | 901 | } 902 | #endif 903 | 904 | /**************************************************/ 905 | /* rwlock attribute variable routines */ 906 | /**************************************************/ 907 | 908 | 909 | void thread_rwlockattr_destroy(int *attr,int *info) { 910 | *info = FT_OK; 911 | 912 | if (!is_initialized) { 913 | *info = FT_EINIT; 914 | return; 915 | } 916 | 917 | pthread_mutex_lock(&(rwlock_attrs->mutex)); 918 | 919 | if (!is_valid(rwlock_attrs,*attr)) { 920 | pthread_mutex_unlock(&(rwlock_attrs->mutex)); 921 | *info = FT_EINVALID; 922 | return; 923 | } 924 | 925 | *info = pthread_rwlockattr_destroy(((pthread_rwlockattr_t*)( 926 | rwlock_attrs->data[*attr]))); 927 | 928 | if (*info) { 929 | pthread_mutex_unlock(&(rwlock_attrs->mutex)); 930 | return; 931 | } 932 | 933 | free(rwlock_attrs->data[*attr]); 934 | rwlock_attrs->data[*attr] = NULL; 935 | 936 | pthread_mutex_unlock(&(rwlock_attrs->mutex)); 937 | 938 | } 939 | 940 | 941 | void thread_rwlockattr_init(int *attr,int *info) { 942 | *info = FT_OK; 943 | 944 | if (!is_initialized) { 945 | *info = FT_EINIT; 946 | return; 947 | } 948 | 949 | pthread_mutex_lock(&(rwlock_attrs->mutex)); 950 | 951 | if (rwlock_attrs->after == rwlock_attrs->size) { 952 | // we exhausted the mutex attribute array, double space 953 | array_resize(&rwlock_attrs,rwlock_attrs->size*2); 954 | } 955 | rwlock_attrs->data[rwlock_attrs->after] = 956 | (pthread_rwlockattr_t*) malloc(sizeof(pthread_rwlockattr_t)); 957 | 958 | *info = pthread_rwlockattr_init(rwlock_attrs->data[rwlock_attrs->after]); 959 | 960 | if (*info) { 961 | pthread_mutex_unlock(&(rwlock_attrs->mutex)); 962 | return; 963 | } 964 | 965 | *attr = rwlock_attrs->after; 966 | rwlock_attrs->after++; 967 | 968 | pthread_mutex_unlock(&(rwlock_attrs->mutex)); 969 | 970 | } 971 | 972 | void thread_rwlockattr_getpshared(int *attr, int *pshared, int *info) { 973 | *info = FT_OK; 974 | 975 | if (!is_initialized) { 976 | *info = FT_EINIT; 977 | return; 978 | } 979 | 980 | pthread_mutex_lock(&(rwlock_attrs->mutex)); 981 | if (!is_valid(rwlock_attrs,*attr)) { 982 | pthread_mutex_unlock(&(rwlock_attrs->mutex)); 983 | *info = FT_EINVALID; 984 | return; 985 | } 986 | 987 | *info = pthread_rwlockattr_getpshared( 988 | (pthread_rwlockattr_t*)(rwlock_attrs->data[*attr]), 989 | pshared); 990 | 991 | pthread_mutex_unlock(&(rwlock_attrs->mutex)); 992 | 993 | } 994 | 995 | void thread_rwlockattr_setpshared(int *attr, int *pshared, int *info) { 996 | *info = FT_OK; 997 | 998 | if (!is_initialized) { 999 | *info = FT_EINIT; 1000 | return; 1001 | } 1002 | 1003 | pthread_mutex_lock(&(rwlock_attrs->mutex)); 1004 | if (!is_valid(rwlock_attrs,*attr)) { 1005 | pthread_mutex_unlock(&(rwlock_attrs->mutex)); 1006 | *info = FT_EINVALID; 1007 | return; 1008 | } 1009 | 1010 | *info = pthread_rwlockattr_setpshared( 1011 | (pthread_rwlockattr_t*)(rwlock_attrs->data[*attr]), 1012 | *pshared); 1013 | 1014 | pthread_mutex_unlock(&(rwlock_attrs->mutex)); 1015 | 1016 | } 1017 | 1018 | 1019 | 1020 | 1021 | 1022 | 1023 | -------------------------------------------------------------------------------- /src/iface/ciface.h: -------------------------------------------------------------------------------- 1 | 2 | ! pthread interfaces for fortran 3 | ! these interfaces are used in the Fortran code. 4 | 5 | interface 6 | subroutine thread_init(info) bind(c) 7 | use iso_c_binding 8 | integer(c_int), intent(out) :: info 9 | end subroutine thread_init 10 | end interface 11 | 12 | 13 | interface 14 | subroutine thread_destroy(info) bind(c) 15 | use iso_c_binding 16 | integer(c_int), intent(out) :: info 17 | end subroutine thread_destroy 18 | end interface 19 | 20 | abstract interface 21 | function i_start_routine(arg) bind(c) 22 | use iso_c_binding 23 | type(c_ptr) :: i_start_routine 24 | type(c_ptr), value, intent(in) :: arg 25 | end function i_start_routine 26 | end interface 27 | 28 | 29 | 30 | interface 31 | subroutine thread_alloc(thread_id,info) bind(c) 32 | use iso_c_binding 33 | integer(c_int), intent(out) :: thread_id 34 | integer(c_int), intent(out) :: info 35 | end subroutine thread_alloc 36 | end interface 37 | 38 | interface 39 | subroutine thread_create(thread_id,attr_id,start_routine,arg,info) bind(c) 40 | use iso_c_binding 41 | integer(c_int), intent(in) :: thread_id 42 | integer(c_int), intent(in) :: attr_id 43 | type(c_funptr), intent(in) :: start_routine 44 | type(c_ptr), value, intent(in) :: arg 45 | integer(c_int), intent(out) :: info 46 | end subroutine thread_create 47 | end interface 48 | 49 | interface 50 | subroutine thread_detach(thread_id,info) bind(c) 51 | use iso_c_binding 52 | integer(c_int), intent(in) :: thread_id 53 | integer(c_int), intent(out) :: info 54 | end subroutine thread_detach 55 | end interface 56 | 57 | interface 58 | subroutine thread_equal(t1,t2,info) bind(c) 59 | use iso_c_binding 60 | integer(c_int), intent(in) :: t1 61 | integer(c_int), intent(in) :: t2 62 | integer(c_int), intent(out) :: info 63 | end subroutine thread_equal 64 | end interface 65 | 66 | interface 67 | subroutine thread_exit(value_ptr) bind(c) 68 | use iso_c_binding 69 | type(c_ptr), intent(in) :: value_ptr 70 | end subroutine thread_exit 71 | end interface 72 | 73 | interface 74 | subroutine thread_join(thread_id,value_ptr,info) bind(c) 75 | use iso_c_binding 76 | integer(c_int), intent(in) :: thread_id 77 | type(c_ptr), intent(out) :: value_ptr 78 | integer(c_int), intent(out) :: info 79 | end subroutine thread_join 80 | end interface 81 | 82 | interface 83 | subroutine thread_cancel(thread_id,info) bind(c) 84 | use iso_c_binding 85 | integer(c_int), intent(in) :: thread_id 86 | integer(c_int), intent(out) :: info 87 | end subroutine thread_cancel 88 | end interface 89 | 90 | interface 91 | subroutine thread_kill(thread_id,sig,info) bind(c) 92 | use iso_c_binding 93 | integer(c_int), intent(in) :: thread_id 94 | integer(c_int), intent(in) :: sig 95 | integer(c_int), intent(out) :: info 96 | end subroutine thread_kill 97 | end interface 98 | 99 | interface 100 | subroutine thread_once_init(once_ctrl,info) bind(c) 101 | use iso_c_binding 102 | integer(c_int), intent(out) :: once_ctrl 103 | integer(c_int), intent(out) :: info 104 | end subroutine thread_once_init 105 | end interface 106 | 107 | interface 108 | subroutine thread_once(once_ctrl_id,routine,info) bind(c) 109 | use iso_c_binding 110 | integer(c_int), intent(in) :: once_ctrl_id 111 | type(c_funptr), intent(in) :: routine 112 | integer(c_int), intent(out) :: info 113 | end subroutine thread_once 114 | end interface 115 | 116 | interface 117 | subroutine thread_atfork(prepare,parent,child,info) bind(c) 118 | use iso_c_binding 119 | type(c_funptr), intent(in) :: prepare 120 | type(c_funptr), intent(in) :: parent 121 | type(c_funptr), intent(in) :: child 122 | integer(c_int), intent(out) :: info 123 | end subroutine thread_atfork 124 | end interface 125 | 126 | ! TODO implemented thread_cleanup_pop and thread_cleanup_push 127 | 128 | interface 129 | subroutine thread_getconcurrency(currlevel,info) bind(c) 130 | use iso_c_binding 131 | integer(c_int), intent(out) :: currlevel 132 | integer(c_int), intent(out) :: info 133 | end subroutine thread_getconcurrency 134 | end interface 135 | 136 | interface 137 | subroutine thread_setconcurrency(newlevel,info) bind(c) 138 | use iso_c_binding 139 | integer(c_int), intent(in) :: newlevel 140 | integer(c_int), intent(out) :: info 141 | end subroutine thread_setconcurrency 142 | end interface 143 | 144 | #ifndef __DARWIN 145 | interface 146 | subroutine thread_getcpuclockid(thread,clock_id,info) bind(c) 147 | use iso_c_binding 148 | integer(c_int), intent(in) :: thread 149 | integer(c_int), intent(out) :: clock_id 150 | integer(c_int), intent(out) :: info 151 | end subroutine thread_getcpuclockid 152 | end interface 153 | #endif 154 | 155 | 156 | interface 157 | subroutine thread_getschedparam(thread,policy,param,info) bind(c) 158 | use iso_c_binding 159 | use forthread_types 160 | integer(c_int), intent(in) :: thread 161 | integer(c_int), intent(out) :: policy 162 | type(sched_param), intent(out) :: param 163 | integer(c_int), intent(out) :: info 164 | end subroutine thread_getschedparam 165 | end interface 166 | 167 | interface 168 | subroutine thread_setschedparam(thread,policy,param,info) bind(c) 169 | use iso_c_binding 170 | use forthread_types 171 | integer(c_int), intent(in) :: thread 172 | integer(c_int), intent(in) :: policy 173 | type(sched_param), intent(in) :: param 174 | integer(c_int), intent(out) :: info 175 | end subroutine thread_setschedparam 176 | end interface 177 | 178 | #ifndef __DARWIN 179 | interface 180 | subroutine thread_setschedprio(thread,prio,info) bind(c) 181 | use iso_c_binding 182 | integer(c_int), intent(in) :: thread 183 | integer(c_int), intent(in) :: prio 184 | integer(c_int), intent(out) :: info 185 | end subroutine thread_setschedprio 186 | end interface 187 | #endif 188 | 189 | interface 190 | subroutine thread_setcancelstate(state,oldstate,info) bind(c) 191 | use iso_c_binding 192 | integer(c_int), intent(in) :: state 193 | integer(c_int), intent(in) :: oldstate 194 | integer(c_int), intent(out) :: info 195 | end subroutine thread_setcancelstate 196 | end interface 197 | 198 | interface 199 | subroutine thread_setcanceltype(ctype,oldctype,info) bind(c) 200 | use iso_c_binding 201 | integer(c_int), intent(in) :: ctype 202 | integer(c_int), intent(in) :: oldctype 203 | integer(c_int), intent(out) :: info 204 | end subroutine thread_setcanceltype 205 | end interface 206 | 207 | !*****************************************! 208 | !* sharing private data in threads *! 209 | !*****************************************! 210 | 211 | 212 | !void thread_key_delete(int *key_id, int *info); 213 | interface 214 | subroutine thread_key_delete(key_id,info) bind(c) 215 | use iso_c_binding 216 | integer(c_int), intent(in) :: key_id 217 | integer(c_int), intent(out) :: info 218 | end subroutine thread_key_delete 219 | end interface 220 | 221 | !void thread_key_create(int *key_id,void (*destructor)(void *),int *info); 222 | interface 223 | subroutine thread_key_create(key_id,destructor,info) bind(c) 224 | use iso_c_binding 225 | integer(c_int), intent(out) :: key_id 226 | type(c_funptr), intent(in) :: destructor 227 | integer(c_int), intent(out) :: info 228 | end subroutine thread_key_create 229 | end interface 230 | 231 | !void thread_getspecific(int *key, void **value, int *info); 232 | interface 233 | subroutine thread_getspecific(key,val,info) bind(c) 234 | use iso_c_binding 235 | integer(c_int), intent(in) :: key 236 | type(c_ptr), intent(out) :: val 237 | integer(c_int), intent(out) :: info 238 | end subroutine thread_getspecific 239 | end interface 240 | 241 | !void thread_setspecific(int *key, void **value, int *info); 242 | interface 243 | subroutine thread_setspecific(key,val,info) bind(c) 244 | use iso_c_binding 245 | integer(c_int), intent(in) :: key 246 | type(c_ptr), intent(in) :: val 247 | integer(c_int), intent(out) :: info 248 | end subroutine thread_setspecific 249 | end interface 250 | 251 | !*****************************************! 252 | !* mutex routines *! 253 | !*****************************************! 254 | 255 | interface 256 | subroutine thread_mutex_destroy(mutex_id,info) bind(c) 257 | use iso_c_binding 258 | integer(c_int), intent(in) :: mutex_id 259 | integer(c_int), intent(out) :: info 260 | end subroutine thread_mutex_destroy 261 | end interface 262 | 263 | interface 264 | subroutine thread_mutex_init(mutex_id,attr_id,info) bind(c) 265 | use iso_c_binding 266 | integer(c_int), intent(out) :: mutex_id 267 | integer(c_int), intent(in) :: attr_id 268 | integer(c_int), intent(out) :: info 269 | end subroutine thread_mutex_init 270 | end interface 271 | 272 | interface 273 | subroutine thread_mutex_lock(mutex_id,info) bind(c) 274 | use iso_c_binding 275 | integer(c_int), intent(in) :: mutex_id 276 | integer(c_int), intent(out) :: info 277 | end subroutine thread_mutex_lock 278 | end interface 279 | 280 | interface 281 | subroutine thread_mutex_trylock(mutex_id,info) bind(c) 282 | use iso_c_binding 283 | integer(c_int), intent(in) :: mutex_id 284 | integer(c_int), intent(out) :: info 285 | end subroutine thread_mutex_trylock 286 | end interface 287 | 288 | interface 289 | subroutine thread_mutex_unlock(mutex_id,info) bind(c) 290 | use iso_c_binding 291 | integer(c_int), intent(in) :: mutex_id 292 | integer(c_int), intent(out) :: info 293 | end subroutine thread_mutex_unlock 294 | end interface 295 | 296 | interface 297 | subroutine thread_mutex_getprioceiling(mutex,prioceiling,info) bind(c) 298 | use iso_c_binding 299 | integer(c_int), intent(in) :: mutex 300 | integer(c_int), intent(out) :: prioceiling 301 | integer(c_int), intent(out) :: info 302 | end subroutine thread_mutex_getprioceiling 303 | end interface 304 | 305 | interface 306 | subroutine thread_mutex_setprioceiling(mutex,prioceiling,old_ceiling,info) bind(c) 307 | use iso_c_binding 308 | integer(c_int), intent(in) :: mutex 309 | integer(c_int), intent(in) :: prioceiling 310 | integer(c_int), intent(out) :: old_ceiling 311 | integer(c_int), intent(out) :: info 312 | end subroutine thread_mutex_setprioceiling 313 | end interface 314 | 315 | #ifndef __DARWIN 316 | interface 317 | subroutine thread_mutex_timedlock(mutex,abs_timeout,info) bind(c) 318 | use iso_c_binding 319 | use forthread_types 320 | integer(c_int), intent(in) :: mutex 321 | type(timespec), intent(in) :: abs_timeout 322 | integer(c_int), intent(out) :: info 323 | end subroutine thread_mutex_timedlock 324 | end interface 325 | #endif 326 | 327 | !*****************************************! 328 | !* condition variable routines *! 329 | !*****************************************! 330 | 331 | interface 332 | subroutine thread_cond_destroy(cond_id,info) bind(c) 333 | use iso_c_binding 334 | integer(c_int), intent(in) :: cond_id 335 | integer(c_int), intent(out) :: info 336 | end subroutine thread_cond_destroy 337 | end interface 338 | 339 | interface 340 | subroutine thread_cond_init(cond_id,attr_id,info) bind(c) 341 | use iso_c_binding 342 | integer(c_int), intent(out) :: cond_id 343 | integer(c_int), intent(in) :: attr_id 344 | integer(c_int), intent(out) :: info 345 | end subroutine thread_cond_init 346 | end interface 347 | 348 | interface 349 | subroutine thread_cond_timedwait(mutex,abstime,info) bind(c) 350 | use iso_c_binding 351 | use forthread_types 352 | integer(c_int), intent(in) :: mutex 353 | type(timespec), intent(in) :: abstime 354 | integer(c_int), intent(out) :: info 355 | end subroutine thread_cond_timedwait 356 | end interface 357 | 358 | interface 359 | subroutine thread_cond_wait(cond_id,mutex_id,info) bind(c) 360 | use iso_c_binding 361 | integer(c_int), intent(in) :: cond_id 362 | integer(c_int), intent(in) :: mutex_id 363 | integer(c_int), intent(out) :: info 364 | end subroutine thread_cond_wait 365 | end interface 366 | 367 | interface 368 | subroutine thread_cond_broadcast(cond_id,info) bind(c) 369 | use iso_c_binding 370 | integer(c_int), intent(in) :: cond_id 371 | integer(c_int), intent(out) :: info 372 | end subroutine thread_cond_broadcast 373 | end interface 374 | 375 | interface 376 | subroutine thread_cond_signal(cond_id,info) bind(c) 377 | use iso_c_binding 378 | integer(c_int), intent(in) :: cond_id 379 | integer(c_int), intent(out) :: info 380 | end subroutine thread_cond_signal 381 | end interface 382 | 383 | #ifndef __DARWIN 384 | !****************************************! 385 | !* barrier variable routines *! 386 | !****************************************! 387 | 388 | 389 | interface 390 | subroutine thread_barrier_destroy(barrier_id,info) bind(c) 391 | use iso_c_binding 392 | integer(c_int), intent(in) :: barrier_id 393 | integer(c_int), intent(out) :: info 394 | end subroutine thread_barrier_destroy 395 | end interface 396 | 397 | interface 398 | subroutine thread_barrier_init(barrier_id,attr_id,tcount,info) bind(c) 399 | use iso_c_binding 400 | integer(c_int), intent(out) :: barrier_id 401 | integer(c_int), intent(in) :: attr_id 402 | integer(c_int), intent(in) :: tcount 403 | integer(c_int), intent(out) :: info 404 | end subroutine thread_barrier_init 405 | end interface 406 | 407 | interface 408 | subroutine thread_barrier_wait(barrier_id,info) bind(c) 409 | use iso_c_binding 410 | integer(c_int), intent(in) :: barrier_id 411 | integer(c_int), intent(out) :: info 412 | end subroutine thread_barrier_wait 413 | end interface 414 | 415 | !*************************************! 416 | !* spin variable routines *! 417 | !*************************************! 418 | 419 | interface 420 | subroutine thread_spin_destroy(spinlock_id,info) bind(c) 421 | use iso_c_binding 422 | integer(c_int), intent(in) :: spinlock_id 423 | integer(c_int), intent(out) :: info 424 | end subroutine thread_spin_destroy 425 | end interface 426 | 427 | interface 428 | subroutine thread_spin_init(spinlock_id,pshared,info) bind(c) 429 | use iso_c_binding 430 | integer(c_int), intent(out) :: spinlock_id 431 | integer(c_int), intent(in) :: pshared 432 | integer(c_int), intent(out) :: info 433 | end subroutine thread_spin_init 434 | end interface 435 | 436 | interface 437 | subroutine thread_spin_lock(lock_id,info) bind(c) 438 | use iso_c_binding 439 | integer(c_int), intent(in) :: lock_id 440 | integer(c_int), intent(out) :: info 441 | end subroutine thread_spin_lock 442 | end interface 443 | 444 | interface 445 | subroutine thread_spin_trylock(lock_id,info) bind(c) 446 | use iso_c_binding 447 | integer(c_int), intent(in) :: lock_id 448 | integer(c_int), intent(out) :: info 449 | end subroutine thread_spin_trylock 450 | end interface 451 | 452 | interface 453 | subroutine thread_spin_unlock(lock_id,info) bind(c) 454 | use iso_c_binding 455 | integer(c_int), intent(in) :: lock_id 456 | integer(c_int), intent(out) :: info 457 | end subroutine thread_spin_unlock 458 | end interface 459 | #endif 460 | 461 | !*************************************! 462 | !* rwlock variable routines *! 463 | !*************************************! 464 | 465 | interface 466 | subroutine thread_rwlock_destroy(rwlock_id,info) bind(c) 467 | use iso_c_binding 468 | integer(c_int), intent(in) :: rwlock_id 469 | integer(c_int), intent(out) :: info 470 | end subroutine thread_rwlock_destroy 471 | end interface 472 | 473 | interface 474 | subroutine thread_rwlock_init(rwlock_id,attr_id,info) bind(c) 475 | use iso_c_binding 476 | integer(c_int), intent(out) :: rwlock_id 477 | integer(c_int), intent(in) :: attr_id 478 | integer(c_int), intent(out) :: info 479 | end subroutine thread_rwlock_init 480 | end interface 481 | 482 | interface 483 | subroutine thread_rwlock_rdlock(lock_id,info) bind(c) 484 | use iso_c_binding 485 | integer(c_int), intent(in) :: lock_id 486 | integer(c_int), intent(out) :: info 487 | end subroutine thread_rwlock_rdlock 488 | end interface 489 | 490 | interface 491 | subroutine thread_rwlock_tryrdlock(lock_id,info) bind(c) 492 | use iso_c_binding 493 | integer(c_int), intent(in) :: lock_id 494 | integer(c_int), intent(out) :: info 495 | end subroutine thread_rwlock_tryrdlock 496 | end interface 497 | 498 | interface 499 | subroutine thread_rwlock_wrlock(lock_id,info) bind(c) 500 | use iso_c_binding 501 | integer(c_int), intent(in) :: lock_id 502 | integer(c_int), intent(out) :: info 503 | end subroutine thread_rwlock_wrlock 504 | end interface 505 | 506 | interface 507 | subroutine thread_rwlock_trywrlock(lock_id,info) bind(c) 508 | use iso_c_binding 509 | integer(c_int), intent(in) :: lock_id 510 | integer(c_int), intent(out) :: info 511 | end subroutine thread_rwlock_trywrlock 512 | end interface 513 | 514 | interface 515 | subroutine thread_rwlock_unlock(lock_id,info) bind(c) 516 | use iso_c_binding 517 | integer(c_int), intent(in) :: lock_id 518 | integer(c_int), intent(out) :: info 519 | end subroutine thread_rwlock_unlock 520 | end interface 521 | 522 | #ifndef __DARWIN 523 | interface 524 | subroutine thread_rwlock_timedrdlock(lock_id,abs_timeout,info) bind(c) 525 | use forthread_types 526 | use iso_c_binding 527 | integer(c_int), intent(in) :: lock_id 528 | type(timespec), intent(in) :: abs_timeout 529 | integer(c_int), intent(out) :: info 530 | end subroutine thread_rwlock_timedrdlock 531 | end interface 532 | 533 | interface 534 | subroutine thread_rwlock_timedwrlock(lock_id,abs_timeout,info) bind(c) 535 | use forthread_types 536 | use iso_c_binding 537 | integer(c_int), intent(in) :: lock_id 538 | type(timespec), intent(in) :: abs_timeout 539 | integer(c_int), intent(out) :: info 540 | end subroutine thread_rwlock_timedwrlock 541 | end interface 542 | #endif 543 | 544 | 545 | 546 | !*****************************************! 547 | !* attribute object routines *! 548 | !*****************************************! 549 | 550 | interface 551 | subroutine thread_attr_destroy(attr,info) bind(c) 552 | use iso_c_binding 553 | integer(c_int), intent(in) :: attr 554 | integer(c_int), intent(out) :: info 555 | end subroutine thread_attr_destroy 556 | end interface 557 | 558 | interface 559 | subroutine thread_attr_init(attr,info) bind(c) 560 | use iso_c_binding 561 | integer(c_int), intent(in) :: attr 562 | integer(c_int), intent(out) :: info 563 | end subroutine thread_attr_init 564 | end interface 565 | 566 | interface 567 | subroutine thread_attr_getdetachstate(attr,detachstate,info) bind(c) 568 | use iso_c_binding 569 | integer(c_int), intent(in) :: attr 570 | integer(c_int), intent(out) :: detachstate 571 | integer(c_int), intent(out) :: info 572 | end subroutine thread_attr_getdetachstate 573 | end interface 574 | 575 | interface 576 | subroutine thread_attr_setdetachstate(attr,detachstate,info) bind(c) 577 | use iso_c_binding 578 | integer(c_int), intent(in) :: attr 579 | integer(c_int), intent(in) :: detachstate 580 | integer(c_int), intent(out) :: info 581 | end subroutine thread_attr_setdetachstate 582 | end interface 583 | 584 | interface 585 | subroutine thread_attr_getguardsize(attr,guardsize,info) bind(c) 586 | use iso_c_binding 587 | integer(c_int), intent(in) :: attr 588 | integer(c_size_t), intent(out) :: guardsize 589 | integer(c_int), intent(out) :: info 590 | end subroutine thread_attr_getguardsize 591 | end interface 592 | 593 | interface 594 | subroutine thread_attr_setguardsize(attr,guardsize,info) bind(c) 595 | use iso_c_binding 596 | integer(c_int), intent(in) :: attr 597 | integer(c_size_t), intent(in) :: guardsize 598 | integer(c_int), intent(out) :: info 599 | end subroutine thread_attr_setguardsize 600 | end interface 601 | 602 | interface 603 | subroutine thread_attr_getinheritsched(attr,inheritsched,info) bind(c) 604 | use iso_c_binding 605 | integer(c_int), intent(in) :: attr 606 | integer(c_int), intent(out) :: inheritsched 607 | integer(c_int), intent(out) :: info 608 | end subroutine thread_attr_getinheritsched 609 | end interface 610 | 611 | interface 612 | subroutine thread_attr_setinheritsched(attr,inheritsched,info) bind(c) 613 | use iso_c_binding 614 | integer(c_int), intent(in) :: attr 615 | integer(c_int), intent(in) :: inheritsched 616 | integer(c_int), intent(out) :: info 617 | end subroutine thread_attr_setinheritsched 618 | end interface 619 | 620 | interface 621 | subroutine thread_attr_getschedparam(attr,param,info) bind(c) 622 | use iso_c_binding 623 | use forthread_types 624 | integer(c_int), intent(in) :: attr 625 | type(sched_param), intent(out) :: param 626 | integer(c_int), intent(out) :: info 627 | end subroutine thread_attr_getschedparam 628 | end interface 629 | 630 | interface 631 | subroutine thread_attr_setschedparam(attr,param,info) bind(c) 632 | use iso_c_binding 633 | use forthread_types 634 | integer(c_int), intent(in) :: attr 635 | type(sched_param), intent(in) :: param 636 | integer(c_int), intent(out) :: info 637 | end subroutine thread_attr_setschedparam 638 | end interface 639 | 640 | interface 641 | subroutine thread_attr_getschedpolicy(attr,policy,info) bind(c) 642 | use iso_c_binding 643 | integer(c_int), intent(in) :: attr 644 | integer(c_int), intent(out) :: policy 645 | integer(c_int), intent(out) :: info 646 | end subroutine thread_attr_getschedpolicy 647 | end interface 648 | 649 | interface 650 | subroutine thread_attr_setschedpolicy(attr,policy,info) bind(c) 651 | use iso_c_binding 652 | integer(c_int), intent(in) :: attr 653 | integer(c_int), intent(in) :: policy 654 | integer(c_int), intent(out) :: info 655 | end subroutine thread_attr_setschedpolicy 656 | end interface 657 | 658 | interface 659 | subroutine thread_attr_getscope(attr,scope,info) bind(c) 660 | use iso_c_binding 661 | integer(c_int), intent(in) :: attr 662 | integer(c_int), intent(out) :: scope 663 | integer(c_int), intent(out) :: info 664 | end subroutine thread_attr_getscope 665 | end interface 666 | 667 | interface 668 | subroutine thread_attr_setscope(attr,scope,info) bind(c) 669 | use iso_c_binding 670 | integer(c_int), intent(in) :: attr 671 | integer(c_int), intent(in) :: scope 672 | integer(c_int), intent(out) :: info 673 | end subroutine thread_attr_setscope 674 | end interface 675 | 676 | interface 677 | subroutine thread_attr_getstacksize(attr,stacksize,info) bind(c) 678 | use iso_c_binding 679 | integer(c_int), intent(in) :: attr 680 | integer(c_size_t), intent(out) :: stacksize 681 | integer(c_int), intent(out) :: info 682 | end subroutine thread_attr_getstacksize 683 | end interface 684 | 685 | interface 686 | subroutine thread_attr_setstacksize(attr,stacksize,info) bind(c) 687 | use iso_c_binding 688 | integer(c_int), intent(in) :: attr 689 | integer(c_size_t), intent(in) :: stacksize 690 | integer(c_int), intent(out) :: info 691 | end subroutine thread_attr_setstacksize 692 | end interface 693 | 694 | !*****************************************! 695 | !* mutex attribute routines *! 696 | !*****************************************! 697 | 698 | interface 699 | subroutine thread_mutexattr_destroy(attr,info) bind(c) 700 | use iso_c_binding 701 | integer(c_int), intent(in) :: attr 702 | integer(c_int), intent(out) :: info 703 | end subroutine thread_mutexattr_destroy 704 | end interface 705 | 706 | interface 707 | subroutine thread_mutexattr_init(attr,info) bind(c) 708 | use iso_c_binding 709 | integer(c_int), intent(in) :: attr 710 | integer(c_int), intent(out) :: info 711 | end subroutine thread_mutexattr_init 712 | end interface 713 | 714 | interface 715 | subroutine thread_mutexattr_getpshared(attr,pshared,info) bind(c) 716 | use iso_c_binding 717 | integer(c_int), intent(in) :: attr 718 | integer(c_int), intent(out) :: pshared 719 | integer(c_int), intent(out) :: info 720 | end subroutine thread_mutexattr_getpshared 721 | end interface 722 | 723 | interface 724 | subroutine thread_mutexattr_setpshared(attr,pshared,info) bind(c) 725 | use iso_c_binding 726 | integer(c_int), intent(in) :: attr 727 | integer(c_int), intent(in) :: pshared 728 | integer(c_int), intent(out) :: info 729 | end subroutine thread_mutexattr_setpshared 730 | end interface 731 | 732 | interface 733 | subroutine thread_mutexattr_getprioceiling(attr,prioceiling,info) bind(c) 734 | use iso_c_binding 735 | integer(c_int), intent(in) :: attr 736 | integer(c_int), intent(out) :: prioceiling 737 | integer(c_int), intent(out) :: info 738 | end subroutine thread_mutexattr_getprioceiling 739 | end interface 740 | 741 | interface 742 | subroutine thread_mutexattr_setprioceiling(attr,prioceiling,info) bind(c) 743 | use iso_c_binding 744 | integer(c_int), intent(in) :: attr 745 | integer(c_int), intent(in) :: prioceiling 746 | integer(c_int), intent(out) :: info 747 | end subroutine thread_mutexattr_setprioceiling 748 | end interface 749 | 750 | interface 751 | subroutine thread_mutexattr_getprotocol(attr,protocol,info) bind(c) 752 | use iso_c_binding 753 | integer(c_int), intent(in) :: attr 754 | integer(c_int), intent(out) :: protocol 755 | integer(c_int), intent(out) :: info 756 | end subroutine thread_mutexattr_getprotocol 757 | end interface 758 | 759 | interface 760 | subroutine thread_mutexattr_setprotocol(attr,protocol,info) bind(c) 761 | use iso_c_binding 762 | integer(c_int), intent(in) :: attr 763 | integer(c_int), intent(in) :: protocol 764 | integer(c_int), intent(out) :: info 765 | end subroutine thread_mutexattr_setprotocol 766 | end interface 767 | 768 | interface 769 | subroutine thread_mutexattr_gettype(attr,mtype,info) bind(c) 770 | use iso_c_binding 771 | integer(c_int), intent(in) :: attr 772 | integer(c_int), intent(out) :: mtype 773 | integer(c_int), intent(out) :: info 774 | end subroutine thread_mutexattr_gettype 775 | end interface 776 | 777 | interface 778 | subroutine thread_mutexattr_settype(attr,mtype,info) bind(c) 779 | use iso_c_binding 780 | integer(c_int), intent(in) :: attr 781 | integer(c_int), intent(in) :: mtype 782 | integer(c_int), intent(out) :: info 783 | end subroutine thread_mutexattr_settype 784 | end interface 785 | 786 | 787 | !*****************************************************! 788 | !* condition attriubute variable routines *! 789 | !*****************************************************! 790 | 791 | interface 792 | subroutine thread_condattr_destroy(attr,info) bind(c) 793 | use iso_c_binding 794 | integer(c_int), intent(in) :: attr 795 | integer(c_int), intent(out) :: info 796 | end subroutine thread_condattr_destroy 797 | end interface 798 | 799 | interface 800 | subroutine thread_condattr_init(attr,info) bind(c) 801 | use iso_c_binding 802 | integer(c_int), intent(in) :: attr 803 | integer(c_int), intent(out) :: info 804 | end subroutine thread_condattr_init 805 | end interface 806 | 807 | interface 808 | subroutine thread_condattr_getpshared(attr,pshared,info) bind(c) 809 | use iso_c_binding 810 | integer(c_int), intent(in) :: attr 811 | integer(c_int), intent(out) :: pshared 812 | integer(c_int), intent(out) :: info 813 | end subroutine thread_condattr_getpshared 814 | end interface 815 | 816 | interface 817 | subroutine thread_condattr_setpshared(attr,pshared,info) bind(c) 818 | use iso_c_binding 819 | integer(c_int), intent(in) :: attr 820 | integer(c_int), intent(in) :: pshared 821 | integer(c_int), intent(out) :: info 822 | end subroutine thread_condattr_setpshared 823 | end interface 824 | 825 | #ifndef __DARWIN 826 | interface 827 | subroutine thread_condattr_getclock(attr,clock_id,info) bind(c) 828 | use iso_c_binding 829 | integer(c_int), intent(in) :: attr 830 | integer(c_int), intent(out) :: clock_id 831 | integer(c_int), intent(out) :: info 832 | end subroutine thread_condattr_getclock 833 | end interface 834 | 835 | interface 836 | subroutine thread_condattr_setclock(attr,clock_id,info) bind(c) 837 | use iso_c_binding 838 | integer(c_int), intent(in) :: attr 839 | integer(c_int), intent(in) :: clock_id 840 | integer(c_int), intent(out) :: info 841 | end subroutine thread_condattr_setclock 842 | end interface 843 | 844 | 845 | !**************************************************! 846 | !* barrier attribute variable routines *! 847 | !**************************************************! 848 | 849 | 850 | interface 851 | subroutine thread_barrierattr_destroy(attr,info) bind(c) 852 | use iso_c_binding 853 | integer(c_int), intent(in) :: attr 854 | integer(c_int), intent(out) :: info 855 | end subroutine thread_barrierattr_destroy 856 | end interface 857 | 858 | interface 859 | subroutine thread_barrierattr_init(attr,info) bind(c) 860 | use iso_c_binding 861 | integer(c_int), intent(in) :: attr 862 | integer(c_int), intent(out) :: info 863 | end subroutine thread_barrierattr_init 864 | end interface 865 | 866 | interface 867 | subroutine thread_barrierattr_getpshared(attr,pshared,info) bind(c) 868 | use iso_c_binding 869 | integer(c_int), intent(in) :: attr 870 | integer(c_int), intent(out) :: pshared 871 | integer(c_int), intent(out) :: info 872 | end subroutine thread_barrierattr_getpshared 873 | end interface 874 | 875 | interface 876 | subroutine thread_barrierattr_setpshared(attr,pshared,info) bind(c) 877 | use iso_c_binding 878 | integer(c_int), intent(in) :: attr 879 | integer(c_int), intent(in) :: pshared 880 | integer(c_int), intent(out) :: info 881 | end subroutine thread_barrierattr_setpshared 882 | end interface 883 | #endif 884 | 885 | !**************************************************! 886 | !* rwlock attribute variable routines *! 887 | !**************************************************! 888 | 889 | interface 890 | subroutine thread_rwlockattr_destroy(attr,info) bind(c) 891 | use iso_c_binding 892 | integer(c_int), intent(in) :: attr 893 | integer(c_int), intent(out) :: info 894 | end subroutine thread_rwlockattr_destroy 895 | end interface 896 | 897 | interface 898 | subroutine thread_rwlockattr_init(attr,info) bind(c) 899 | use iso_c_binding 900 | integer(c_int), intent(in) :: attr 901 | integer(c_int), intent(out) :: info 902 | end subroutine thread_rwlockattr_init 903 | end interface 904 | 905 | interface 906 | subroutine thread_rwlockattr_getpshared(attr,pshared,info) bind(c) 907 | use iso_c_binding 908 | integer(c_int), intent(in) :: attr 909 | integer(c_int), intent(out) :: pshared 910 | integer(c_int), intent(out) :: info 911 | end subroutine thread_rwlockattr_getpshared 912 | end interface 913 | 914 | interface 915 | subroutine thread_rwlockattr_setpshared(attr,pshared,info) bind(c) 916 | use iso_c_binding 917 | integer(c_int), intent(in) :: attr 918 | integer(c_int), intent(in) :: pshared 919 | integer(c_int), intent(out) :: info 920 | end subroutine thread_rwlockattr_setpshared 921 | end interface 922 | 923 | 924 | 925 | 926 | -------------------------------------------------------------------------------- /src/iface/forthread.f03: -------------------------------------------------------------------------------- 1 | 2 | 3 | subroutine forthread_init(info) 4 | 5 | use forthread_data 6 | implicit none 7 | 8 | #include "ciface.h" 9 | 10 | integer, intent(out) :: info 11 | 12 | allocate(routine_table(init_size)) 13 | routine_table_size = init_size 14 | 15 | call thread_init(info) 16 | 17 | call thread_mutex_init(routine_table_mutex,-1,info) 18 | 19 | end subroutine forthread_init 20 | 21 | 22 | subroutine forthread_destroy(info) 23 | 24 | use forthread_data 25 | implicit none 26 | 27 | #include "ciface.h" 28 | 29 | integer, intent(out) :: info 30 | 31 | deallocate(routine_table) 32 | routine_table_size = 0 33 | call thread_mutex_destroy(routine_table_mutex,info) 34 | call thread_destroy(info) 35 | end subroutine forthread_destroy 36 | 37 | 38 | subroutine forthread_create(thread_id,attr_id,run,arg,info) 39 | 40 | use iso_c_binding 41 | use forthread_data 42 | implicit none 43 | 44 | #include "ciface.h" 45 | 46 | integer, intent(out) :: thread_id 47 | integer, intent(in) :: attr_id 48 | procedure(i_run) :: run !type i_run 49 | integer , target :: arg 50 | integer, intent(out) :: info 51 | 52 | integer :: i 53 | procedure(i_start_routine), bind(c), pointer :: start_routinep 54 | type(ptr_t_run), dimension(:), pointer :: tmp 55 | type(t_run), pointer :: runp 56 | call thread_mutex_lock(routine_table_mutex,info) 57 | 58 | call thread_alloc(thread_id,info) 59 | if (thread_id.gt.routine_table_size) then 60 | nullify(tmp) 61 | allocate(tmp(routine_table_size*2)) 62 | do i=1,routine_table_size 63 | tmp(i) = routine_table(i) 64 | enddo 65 | deallocate(routine_table) 66 | routine_table => tmp 67 | routine_table_size = routine_table_size*2 68 | endif 69 | allocate(routine_table(thread_id)%t) 70 | routine_table(thread_id)%t%run => run 71 | routine_table(thread_id)%t%arg => arg 72 | start_routinep => start_routine 73 | 74 | call thread_create(thread_id,attr_id,c_funloc(start_routinep),& 75 | c_loc(routine_table(thread_id)%t),info) 76 | 77 | call thread_mutex_unlock(routine_table_mutex,info) 78 | 79 | 80 | end subroutine forthread_create 81 | 82 | subroutine forthread_detach(thread_id,info) 83 | implicit none 84 | 85 | #include "ciface.h" 86 | 87 | integer, intent(in) :: thread_id 88 | integer, intent(out) :: info 89 | 90 | call thread_detach(thread_id,info) 91 | end subroutine forthread_detach 92 | 93 | subroutine forthread_equal(t1,t2,info) 94 | implicit none 95 | 96 | #include "ciface.h" 97 | 98 | integer, intent(in) :: t1 99 | integer, intent(in) :: t2 100 | integer, intent(out) :: info 101 | 102 | call thread_equal(t1,t2,info) 103 | end subroutine forthread_equal 104 | 105 | ! Exits the current thread 106 | subroutine forthread_exit(val) 107 | 108 | use iso_c_binding 109 | implicit none 110 | 111 | #include "ciface.h" 112 | 113 | 114 | integer, pointer :: val 115 | 116 | 117 | call thread_exit(c_loc(val)) 118 | end subroutine forthread_exit 119 | 120 | subroutine forthread_join(thread_id,val,info) 121 | 122 | use iso_c_binding 123 | implicit none 124 | 125 | #include "ciface.h" 126 | 127 | 128 | integer, intent(in) :: thread_id 129 | integer, pointer:: val 130 | integer, intent(out) :: info 131 | 132 | type(c_ptr) :: value_ptr 133 | call thread_join(thread_id,value_ptr,info) 134 | call c_f_pointer(value_ptr,val) 135 | end subroutine forthread_join 136 | 137 | subroutine forthread_cancel(thread_id,info) 138 | implicit none 139 | 140 | #include "ciface.h" 141 | 142 | integer, intent(in) :: thread_id 143 | integer, intent(out) :: info 144 | 145 | call thread_cancel(thread_id,info) 146 | end subroutine forthread_cancel 147 | 148 | subroutine forthread_kill(thread_id,sig,info) 149 | implicit none 150 | 151 | #include "ciface.h" 152 | 153 | integer, intent(in) :: thread_id 154 | integer, intent(in) :: sig 155 | integer, intent(out) :: info 156 | 157 | call thread_kill(thread_id,sig,info) 158 | end subroutine forthread_kill 159 | 160 | subroutine forthread_once_init(once_ctrl_id,info) 161 | use iso_c_binding 162 | implicit none 163 | 164 | integer, intent(out) :: once_ctrl_id 165 | integer, intent(out) :: info 166 | 167 | #include "ciface.h" 168 | 169 | call thread_once_init(once_ctrl_id,info) 170 | end subroutine 171 | 172 | subroutine forthread_once(once_ctrl_id,init_routine,info) 173 | use iso_c_binding 174 | use forthread_data 175 | implicit none 176 | 177 | #include "ciface.h" 178 | 179 | integer, intent(in) :: once_ctrl_id 180 | procedure(i_once), bind(c) :: init_routine 181 | ! dangerous but works! (gfortran) 182 | ! TODO test in other compilers 183 | integer, intent(out) :: info 184 | 185 | 186 | call thread_once(once_ctrl_id,c_funloc(init_routine),info) 187 | 188 | end subroutine 189 | 190 | ! TODO implement thread_atfork 191 | 192 | subroutine forthread_getconcurrency(currlevel,info) 193 | implicit none 194 | 195 | #include "ciface.h" 196 | 197 | integer , intent(out) :: currlevel 198 | integer , intent(out) :: info 199 | 200 | call thread_getconcurrency(currlevel,info) 201 | 202 | end subroutine forthread_getconcurrency 203 | 204 | subroutine forthread_setconcurrency(newlevel,info) 205 | implicit none 206 | 207 | #include "ciface.h" 208 | 209 | integer , intent(in) :: newlevel 210 | integer , intent(out) :: info 211 | 212 | call thread_setconcurrency(newlevel,info) 213 | 214 | end subroutine forthread_setconcurrency 215 | 216 | #ifndef __DARWIN 217 | subroutine forthread_getcpuclockid(thread,clock_id,info) 218 | implicit none 219 | 220 | #include "ciface.h" 221 | 222 | integer , intent(in) :: thread 223 | integer , intent(out) :: clock_id 224 | integer , intent(out) :: info 225 | 226 | call thread_getcpuclockid(thread,clock_id,info) 227 | 228 | end subroutine forthread_getcpuclockid 229 | #endif 230 | 231 | subroutine forthread_getschedparam(thread,policy,param,info) 232 | 233 | use iso_c_binding 234 | use forthread_types 235 | implicit none 236 | 237 | #include "ciface.h" 238 | integer , intent(in) :: thread 239 | integer , intent(out) :: policy 240 | type(sched_param), intent(out) :: param 241 | integer , intent(out) :: info 242 | 243 | call thread_getschedparam(thread,policy,param,info) 244 | end subroutine forthread_getschedparam 245 | 246 | subroutine forthread_setschedparam(thread,policy,param,info) 247 | 248 | use iso_c_binding 249 | use forthread_types 250 | implicit none 251 | 252 | #include "ciface.h" 253 | integer , intent(in) :: thread 254 | integer , intent(in) :: policy 255 | type(sched_param), intent(in) :: param 256 | integer , intent(out) :: info 257 | 258 | call thread_setschedparam(thread,policy,param,info) 259 | end subroutine forthread_setschedparam 260 | 261 | #ifndef __DARWIN 262 | subroutine forthread_setschedprio(thread,prio,info) 263 | implicit none 264 | 265 | #include "ciface.h" 266 | integer , intent(in) :: thread 267 | integer , intent(in) :: prio 268 | integer , intent(out) :: info 269 | 270 | call thread_setschedprio(thread,prio,info) 271 | end subroutine forthread_setschedprio 272 | #endif 273 | 274 | subroutine forthread_setcancelstate(state,oldstate,info) 275 | implicit none 276 | 277 | #include "ciface.h" 278 | integer , intent(in) :: state 279 | integer , intent(out) :: oldstate 280 | integer , intent(out) :: info 281 | 282 | call thread_setcancelstate(state,oldstate,info) 283 | end subroutine forthread_setcancelstate 284 | 285 | subroutine forthread_setcanceltype(ctype,oldctype,info) 286 | implicit none 287 | 288 | #include "ciface.h" 289 | integer , intent(in) :: ctype 290 | integer , intent(out) :: oldctype 291 | integer , intent(out) :: info 292 | 293 | call thread_setcanceltype(ctype,oldctype,info) 294 | end subroutine forthread_setcanceltype 295 | 296 | !*****************************************! 297 | !* sharing private data in threads *! 298 | !*****************************************! 299 | 300 | subroutine forthread_key_delete(key_id,info) 301 | implicit none 302 | 303 | #include "ciface.h" 304 | integer , intent(in) :: key_id 305 | integer , intent(out) :: info 306 | 307 | call thread_key_delete(key_id,info) 308 | end subroutine forthread_key_delete 309 | 310 | subroutine forthread_key_create(key_id,destructor,info) 311 | use iso_c_binding 312 | use forthread_data 313 | implicit none 314 | 315 | #include "ciface.h" 316 | 317 | integer, intent(out) :: key_id 318 | procedure(i_destructor), bind(c) :: destructor 319 | ! dangerous but works! (gfortran) 320 | ! TODO test in other compilers 321 | integer, intent(out) :: info 322 | 323 | 324 | call thread_key_create(key_id,c_funloc(destructor),info) 325 | 326 | end subroutine 327 | 328 | ! no wrappers provided for the following two routines 329 | !void thread_getspecific(int *key, void **value, int *info); 330 | 331 | !void thread_setspecific(int *key, void **value, int *info); 332 | 333 | 334 | 335 | !*****************************************! 336 | !* mutex routines *! 337 | !*****************************************! 338 | 339 | 340 | subroutine forthread_mutex_destroy(mutex_id,info) 341 | implicit none 342 | 343 | #include "ciface.h" 344 | integer, intent(in) :: mutex_id 345 | integer, intent(out) :: info 346 | 347 | call thread_mutex_destroy(mutex_id,info) 348 | end subroutine forthread_mutex_destroy 349 | 350 | subroutine forthread_mutex_init(mutex_id,attr_id,info) 351 | implicit none 352 | 353 | #include "ciface.h" 354 | integer, intent(out) :: mutex_id 355 | integer, intent(in) :: attr_id 356 | integer, intent(out) :: info 357 | 358 | call thread_mutex_init(mutex_id,attr_id,info) 359 | end subroutine forthread_mutex_init 360 | 361 | subroutine forthread_mutex_lock(mutex_id,info) 362 | implicit none 363 | 364 | #include "ciface.h" 365 | integer, intent(in) :: mutex_id 366 | integer, intent(out) :: info 367 | 368 | call thread_mutex_lock(mutex_id,info) 369 | end subroutine forthread_mutex_lock 370 | 371 | subroutine forthread_mutex_trylock(mutex_id,info) 372 | implicit none 373 | 374 | #include "ciface.h" 375 | integer, intent(in) :: mutex_id 376 | integer, intent(out) :: info 377 | 378 | call thread_mutex_trylock(mutex_id,info) 379 | end subroutine forthread_mutex_trylock 380 | 381 | subroutine forthread_mutex_unlock(mutex_id,info) 382 | implicit none 383 | 384 | #include "ciface.h" 385 | integer, intent(in) :: mutex_id 386 | integer, intent(out) :: info 387 | 388 | call thread_mutex_unlock(mutex_id,info) 389 | end subroutine forthread_mutex_unlock 390 | 391 | subroutine forthread_mutex_getprioceiling(mutex,prioceiling,info) 392 | implicit none 393 | 394 | #include "ciface.h" 395 | integer, intent(in) :: mutex 396 | integer, intent(out) :: prioceiling 397 | integer, intent(out) :: info 398 | 399 | call thread_mutex_getprioceiling(mutex,prioceiling,info) 400 | end subroutine forthread_mutex_getprioceiling 401 | 402 | subroutine forthread_mutex_setprioceiling(mutex,prioceiling,old_ceiling,info) 403 | implicit none 404 | 405 | #include "ciface.h" 406 | integer, intent(in) :: mutex 407 | integer, intent(in) :: prioceiling 408 | integer, intent(out) :: old_ceiling 409 | integer, intent(out) :: info 410 | 411 | call thread_mutex_setprioceiling(mutex,prioceiling,old_ceiling,info) 412 | end subroutine forthread_mutex_setprioceiling 413 | 414 | #ifndef __DARWIN 415 | subroutine forthread_mutex_timedlock(mutex,abs_timeout,info) 416 | use forthread_types 417 | implicit none 418 | 419 | #include "ciface.h" 420 | integer, intent(in) :: mutex 421 | type(timespec), intent(in) :: abs_timeout 422 | integer, intent(out) :: info 423 | 424 | call thread_mutex_timedlock(mutex,abs_timeout,info) 425 | 426 | end subroutine forthread_mutex_timedlock 427 | #endif 428 | 429 | !*****************************************! 430 | !* condition variable routines *! 431 | !*****************************************! 432 | 433 | subroutine forthread_cond_destroy(cond_id,info) 434 | implicit none 435 | 436 | #include "ciface.h" 437 | integer, intent(in) :: cond_id 438 | integer, intent(out) :: info 439 | 440 | call thread_cond_destroy(cond_id,info) 441 | end subroutine forthread_cond_destroy 442 | 443 | subroutine forthread_cond_init(cond_id,attr_id,info) 444 | implicit none 445 | 446 | #include "ciface.h" 447 | integer, intent(out) :: cond_id 448 | integer, intent(in) :: attr_id 449 | integer, intent(out) :: info 450 | 451 | call thread_cond_init(cond_id,attr_id,info) 452 | end subroutine forthread_cond_init 453 | 454 | subroutine forthread_cond_timedwait(mutex,abstime,info) 455 | use forthread_types 456 | implicit none 457 | 458 | #include "ciface.h" 459 | integer, intent(in) :: mutex 460 | type(timespec), intent(in) :: abstime 461 | integer, intent(out) :: info 462 | 463 | call thread_cond_timedwait(mutex,abstime,info) 464 | end subroutine forthread_cond_timedwait 465 | 466 | subroutine forthread_cond_wait(cond_id,mutex_id,info) 467 | implicit none 468 | 469 | #include "ciface.h" 470 | integer, intent(in) :: cond_id 471 | integer, intent(in) :: mutex_id 472 | integer, intent(out) :: info 473 | 474 | call thread_cond_wait(cond_id,mutex_id,info) 475 | end subroutine forthread_cond_wait 476 | 477 | subroutine forthread_cond_broadcast(cond_id,info) 478 | implicit none 479 | 480 | #include "ciface.h" 481 | integer, intent(in) :: cond_id 482 | integer, intent(out) :: info 483 | 484 | call thread_cond_broadcast(cond_id,info) 485 | end subroutine forthread_cond_broadcast 486 | 487 | subroutine forthread_cond_signal(cond_id,info) 488 | implicit none 489 | 490 | #include "ciface.h" 491 | integer, intent(in) :: cond_id 492 | integer, intent(out) :: info 493 | 494 | call thread_cond_signal(cond_id,info) 495 | end subroutine forthread_cond_signal 496 | 497 | 498 | #ifndef __DARWIN 499 | !****************************************! 500 | !* barrier variable routines *! 501 | !****************************************! 502 | 503 | 504 | 505 | subroutine forthread_barrier_destroy(barrier_id,info) 506 | implicit none 507 | 508 | #include "ciface.h" 509 | integer , intent(in) :: barrier_id 510 | integer , intent(out) :: info 511 | 512 | call thread_barrier_destroy(barrier_id,info) 513 | end subroutine forthread_barrier_destroy 514 | 515 | 516 | 517 | subroutine forthread_barrier_init(barrier_id,attr_id,tcount,info) 518 | implicit none 519 | 520 | #include "ciface.h" 521 | integer , intent(out) :: barrier_id 522 | integer , intent(in) :: attr_id 523 | integer , intent(in) :: tcount 524 | integer , intent(out) :: info 525 | 526 | call thread_barrier_init(barrier_id,attr_id,tcount,info) 527 | end subroutine forthread_barrier_init 528 | 529 | 530 | 531 | subroutine forthread_barrier_wait(barrier_id,info) 532 | implicit none 533 | 534 | #include "ciface.h" 535 | integer , intent(in) :: barrier_id 536 | integer , intent(out) :: info 537 | 538 | call thread_barrier_wait(barrier_id,info) 539 | end subroutine forthread_barrier_wait 540 | 541 | 542 | !*************************************! 543 | !* spin variable routines *! 544 | !*************************************! 545 | 546 | 547 | subroutine forthread_spin_destroy(spinlock_id,info) 548 | implicit none 549 | 550 | #include "ciface.h" 551 | integer , intent(in) :: spinlock_id 552 | integer , intent(out) :: info 553 | 554 | call thread_spin_destroy(spinlock_id,info) 555 | end subroutine forthread_spin_destroy 556 | 557 | 558 | 559 | subroutine forthread_spin_init(spinlock_id,pshared,info) 560 | implicit none 561 | 562 | #include "ciface.h" 563 | integer , intent(out) :: spinlock_id 564 | integer , intent(in) :: pshared 565 | integer , intent(out) :: info 566 | 567 | call thread_spin_init(spinlock_id,pshared,info) 568 | end subroutine forthread_spin_init 569 | 570 | 571 | 572 | subroutine forthread_spin_lock(lock_id,info) 573 | implicit none 574 | 575 | #include "ciface.h" 576 | integer , intent(in) :: lock_id 577 | integer , intent(out) :: info 578 | 579 | call thread_spin_lock(lock_id,info) 580 | end subroutine forthread_spin_lock 581 | 582 | 583 | 584 | subroutine forthread_spin_trylock(lock_id,info) 585 | implicit none 586 | 587 | #include "ciface.h" 588 | integer , intent(in) :: lock_id 589 | integer , intent(out) :: info 590 | 591 | call thread_spin_trylock(lock_id,info) 592 | end subroutine forthread_spin_trylock 593 | 594 | 595 | 596 | subroutine forthread_spin_unlock(lock_id,info) 597 | implicit none 598 | 599 | #include "ciface.h" 600 | integer , intent(in) :: lock_id 601 | integer , intent(out) :: info 602 | 603 | call thread_spin_unlock(lock_id,info) 604 | end subroutine forthread_spin_unlock 605 | 606 | #endif 607 | 608 | !*************************************! 609 | !* rwlock variable routines *! 610 | !*************************************! 611 | 612 | 613 | subroutine forthread_rwlock_destroy(rwlock_id,info) 614 | implicit none 615 | 616 | #include "ciface.h" 617 | integer , intent(in) :: rwlock_id 618 | integer , intent(out) :: info 619 | 620 | call thread_rwlock_destroy(rwlock_id,info) 621 | end subroutine forthread_rwlock_destroy 622 | 623 | 624 | 625 | subroutine forthread_rwlock_init(rwlock_id,attr_id,info) 626 | implicit none 627 | 628 | #include "ciface.h" 629 | integer , intent(out) :: rwlock_id 630 | integer , intent(in) :: attr_id 631 | integer , intent(out) :: info 632 | 633 | call thread_rwlock_init(rwlock_id,attr_id,info) 634 | end subroutine forthread_rwlock_init 635 | 636 | 637 | 638 | subroutine forthread_rwlock_rdlock(lock_id,info) 639 | implicit none 640 | 641 | #include "ciface.h" 642 | integer , intent(in) :: lock_id 643 | integer , intent(out) :: info 644 | 645 | call thread_rwlock_rdlock(lock_id,info) 646 | end subroutine forthread_rwlock_rdlock 647 | 648 | 649 | 650 | subroutine forthread_rwlock_tryrdlock(lock_id,info) 651 | implicit none 652 | 653 | #include "ciface.h" 654 | integer , intent(in) :: lock_id 655 | integer , intent(out) :: info 656 | 657 | call thread_rwlock_tryrdlock(lock_id,info) 658 | end subroutine forthread_rwlock_tryrdlock 659 | 660 | 661 | 662 | subroutine forthread_rwlock_wrlock(lock_id,info) 663 | implicit none 664 | 665 | #include "ciface.h" 666 | integer , intent(in) :: lock_id 667 | integer , intent(out) :: info 668 | 669 | call thread_rwlock_wrlock(lock_id,info) 670 | end subroutine forthread_rwlock_wrlock 671 | 672 | 673 | 674 | subroutine forthread_rwlock_trywrlock(lock_id,info) 675 | implicit none 676 | 677 | #include "ciface.h" 678 | integer , intent(in) :: lock_id 679 | integer , intent(out) :: info 680 | 681 | call thread_rwlock_trywrlock(lock_id,info) 682 | end subroutine forthread_rwlock_trywrlock 683 | 684 | 685 | 686 | subroutine forthread_rwlock_unlock(lock_id,info) 687 | implicit none 688 | 689 | #include "ciface.h" 690 | integer , intent(in) :: lock_id 691 | integer , intent(out) :: info 692 | 693 | call thread_rwlock_unlock(lock_id,info) 694 | end subroutine forthread_rwlock_unlock 695 | 696 | 697 | 698 | #ifndef __DARWIN 699 | subroutine forthread_rwlock_timedrdlock(lock_id,abs_timeout,info) 700 | use forthread_types 701 | implicit none 702 | 703 | #include "ciface.h" 704 | integer , intent(in) :: lock_id 705 | type(timespec), intent(in) :: abs_timeout 706 | integer , intent(out) :: info 707 | 708 | call thread_rwlock_timedrdlock(lock_id,abs_timeout,info) 709 | end subroutine forthread_rwlock_timedrdlock 710 | 711 | 712 | 713 | subroutine forthread_rwlock_timedwrlock(lock_id,abs_timeout,info) 714 | use forthread_types 715 | implicit none 716 | 717 | #include "ciface.h" 718 | integer , intent(in) :: lock_id 719 | type(timespec), intent(in) :: abs_timeout 720 | integer , intent(out) :: info 721 | 722 | call thread_rwlock_timedwrlock(lock_id,abs_timeout,info) 723 | end subroutine forthread_rwlock_timedwrlock 724 | #endif 725 | 726 | !*****************************************! 727 | !* attribute object routines *! 728 | !*****************************************! 729 | 730 | 731 | subroutine forthread_attr_destroy(attr,info) 732 | implicit none 733 | 734 | #include "ciface.h" 735 | integer , intent(in) :: attr 736 | integer , intent(out) :: info 737 | 738 | call thread_attr_destroy(attr,info) 739 | end subroutine forthread_attr_destroy 740 | 741 | 742 | 743 | subroutine forthread_attr_init(attr,info) 744 | implicit none 745 | 746 | #include "ciface.h" 747 | integer , intent(in) :: attr 748 | integer , intent(out) :: info 749 | 750 | call thread_attr_init(attr,info) 751 | end subroutine forthread_attr_init 752 | 753 | 754 | 755 | subroutine forthread_attr_getdetachstate(attr,detachstate,info) 756 | implicit none 757 | 758 | #include "ciface.h" 759 | integer , intent(in) :: attr 760 | integer , intent(out) :: detachstate 761 | integer , intent(out) :: info 762 | 763 | call thread_attr_getdetachstate(attr,detachstate,info) 764 | end subroutine forthread_attr_getdetachstate 765 | 766 | 767 | 768 | subroutine forthread_attr_setdetachstate(attr,detachstate,info) 769 | implicit none 770 | 771 | #include "ciface.h" 772 | integer , intent(in) :: attr 773 | integer , intent(in) :: detachstate 774 | integer , intent(out) :: info 775 | 776 | call thread_attr_setdetachstate(attr,detachstate,info) 777 | end subroutine forthread_attr_setdetachstate 778 | 779 | 780 | 781 | subroutine forthread_attr_getguardsize(attr,guardsize,info) 782 | use forthread_types 783 | implicit none 784 | 785 | #include "ciface.h" 786 | integer , intent(in) :: attr 787 | integer(size_t), intent(out) :: guardsize 788 | integer , intent(out) :: info 789 | 790 | call thread_attr_getguardsize(attr,guardsize,info) 791 | end subroutine forthread_attr_getguardsize 792 | 793 | 794 | 795 | subroutine forthread_attr_setguardsize(attr,guardsize,info) 796 | use forthread_types 797 | implicit none 798 | 799 | #include "ciface.h" 800 | integer , intent(in) :: attr 801 | integer(size_t), intent(in) :: guardsize 802 | integer , intent(out) :: info 803 | 804 | call thread_attr_setguardsize(attr,guardsize,info) 805 | end subroutine forthread_attr_setguardsize 806 | 807 | 808 | 809 | subroutine forthread_attr_getinheritsched(attr,inheritsched,info) 810 | implicit none 811 | 812 | #include "ciface.h" 813 | integer , intent(in) :: attr 814 | integer , intent(out) :: inheritsched 815 | integer , intent(out) :: info 816 | 817 | call thread_attr_getinheritsched(attr,inheritsched,info) 818 | end subroutine forthread_attr_getinheritsched 819 | 820 | 821 | 822 | subroutine forthread_attr_setinheritsched(attr,inheritsched,info) 823 | implicit none 824 | 825 | #include "ciface.h" 826 | integer , intent(in) :: attr 827 | integer , intent(in) :: inheritsched 828 | integer , intent(out) :: info 829 | 830 | call thread_attr_setinheritsched(attr,inheritsched,info) 831 | end subroutine forthread_attr_setinheritsched 832 | 833 | 834 | 835 | subroutine forthread_attr_getschedparam(attr,param,info) 836 | use forthread_types 837 | implicit none 838 | 839 | #include "ciface.h" 840 | integer , intent(in) :: attr 841 | type(sched_param), intent(out) :: param 842 | integer , intent(out) :: info 843 | 844 | call thread_attr_getschedparam(attr,param,info) 845 | end subroutine forthread_attr_getschedparam 846 | 847 | 848 | 849 | subroutine forthread_attr_setschedparam(attr,param,info) 850 | use forthread_types 851 | implicit none 852 | 853 | #include "ciface.h" 854 | integer , intent(in) :: attr 855 | type(sched_param), intent(in) :: param 856 | integer , intent(out) :: info 857 | 858 | call thread_attr_setschedparam(attr,param,info) 859 | end subroutine forthread_attr_setschedparam 860 | 861 | 862 | 863 | subroutine forthread_attr_getschedpolicy(attr,policy,info) 864 | implicit none 865 | 866 | #include "ciface.h" 867 | integer , intent(in) :: attr 868 | integer , intent(out) :: policy 869 | integer , intent(out) :: info 870 | 871 | call thread_attr_getschedpolicy(attr,policy,info) 872 | end subroutine forthread_attr_getschedpolicy 873 | 874 | 875 | 876 | subroutine forthread_attr_setschedpolicy(attr,policy,info) 877 | implicit none 878 | 879 | #include "ciface.h" 880 | integer , intent(in) :: attr 881 | integer , intent(in) :: policy 882 | integer , intent(out) :: info 883 | 884 | call thread_attr_setschedpolicy(attr,policy,info) 885 | end subroutine forthread_attr_setschedpolicy 886 | 887 | 888 | 889 | subroutine forthread_attr_getscope(attr,scope,info) 890 | implicit none 891 | 892 | #include "ciface.h" 893 | integer , intent(in) :: attr 894 | integer , intent(out) :: scope 895 | integer , intent(out) :: info 896 | 897 | call thread_attr_getscope(attr,scope,info) 898 | end subroutine forthread_attr_getscope 899 | 900 | 901 | 902 | subroutine forthread_attr_setscope(attr,scope,info) 903 | implicit none 904 | 905 | #include "ciface.h" 906 | integer , intent(in) :: attr 907 | integer , intent(in) :: scope 908 | integer , intent(out) :: info 909 | 910 | call thread_attr_setscope(attr,scope,info) 911 | end subroutine forthread_attr_setscope 912 | 913 | 914 | 915 | subroutine forthread_attr_getstacksize(attr,stacksize,info) 916 | use forthread_types 917 | implicit none 918 | 919 | #include "ciface.h" 920 | integer , intent(in) :: attr 921 | integer(size_t), intent(out) :: stacksize 922 | integer , intent(out) :: info 923 | 924 | call thread_attr_getstacksize(attr,stacksize,info) 925 | end subroutine forthread_attr_getstacksize 926 | 927 | 928 | 929 | subroutine forthread_attr_setstacksize(attr,stacksize,info) 930 | use forthread_types 931 | implicit none 932 | 933 | #include "ciface.h" 934 | integer , intent(in) :: attr 935 | integer(size_t), intent(in) :: stacksize 936 | integer , intent(out) :: info 937 | 938 | call thread_attr_setstacksize(attr,stacksize,info) 939 | end subroutine forthread_attr_setstacksize 940 | 941 | 942 | !*****************************************! 943 | !* mutex attribute routines *! 944 | !*****************************************! 945 | 946 | 947 | subroutine forthread_mutexattr_destroy(attr,info) 948 | implicit none 949 | 950 | #include "ciface.h" 951 | integer , intent(in) :: attr 952 | integer , intent(out) :: info 953 | 954 | call thread_mutexattr_destroy(attr,info) 955 | end subroutine forthread_mutexattr_destroy 956 | 957 | 958 | 959 | subroutine forthread_mutexattr_init(attr,info) 960 | implicit none 961 | 962 | #include "ciface.h" 963 | integer , intent(in) :: attr 964 | integer , intent(out) :: info 965 | 966 | call thread_mutexattr_init(attr,info) 967 | end subroutine forthread_mutexattr_init 968 | 969 | 970 | 971 | subroutine forthread_mutexattr_getpshared(attr,pshared,info) 972 | implicit none 973 | 974 | #include "ciface.h" 975 | integer , intent(in) :: attr 976 | integer , intent(out) :: pshared 977 | integer , intent(out) :: info 978 | 979 | call thread_mutexattr_getpshared(attr,pshared,info) 980 | end subroutine forthread_mutexattr_getpshared 981 | 982 | 983 | 984 | subroutine forthread_mutexattr_setpshared(attr,pshared,info) 985 | implicit none 986 | 987 | #include "ciface.h" 988 | integer , intent(in) :: attr 989 | integer , intent(in) :: pshared 990 | integer , intent(out) :: info 991 | 992 | call thread_mutexattr_setpshared(attr,pshared,info) 993 | end subroutine forthread_mutexattr_setpshared 994 | 995 | 996 | 997 | subroutine forthread_mutexattr_getprioceiling(attr,prioceiling,info) 998 | implicit none 999 | 1000 | #include "ciface.h" 1001 | integer , intent(in) :: attr 1002 | integer , intent(out) :: prioceiling 1003 | integer , intent(out) :: info 1004 | 1005 | call thread_mutexattr_getprioceiling(attr,prioceiling,info) 1006 | end subroutine forthread_mutexattr_getprioceiling 1007 | 1008 | 1009 | 1010 | subroutine forthread_mutexattr_setprioceiling(attr,prioceiling,info) 1011 | implicit none 1012 | 1013 | #include "ciface.h" 1014 | integer , intent(in) :: attr 1015 | integer , intent(in) :: prioceiling 1016 | integer , intent(out) :: info 1017 | 1018 | call thread_mutexattr_setprioceiling(attr,prioceiling,info) 1019 | end subroutine forthread_mutexattr_setprioceiling 1020 | 1021 | 1022 | 1023 | subroutine forthread_mutexattr_getprotocol(attr,protocol,info) 1024 | implicit none 1025 | 1026 | #include "ciface.h" 1027 | integer , intent(in) :: attr 1028 | integer , intent(out) :: protocol 1029 | integer , intent(out) :: info 1030 | 1031 | call thread_mutexattr_getprotocol(attr,protocol,info) 1032 | end subroutine forthread_mutexattr_getprotocol 1033 | 1034 | 1035 | 1036 | subroutine forthread_mutexattr_setprotocol(attr,protocol,info) 1037 | implicit none 1038 | 1039 | #include "ciface.h" 1040 | integer , intent(in) :: attr 1041 | integer , intent(in) :: protocol 1042 | integer , intent(out) :: info 1043 | 1044 | call thread_mutexattr_setprotocol(attr,protocol,info) 1045 | end subroutine forthread_mutexattr_setprotocol 1046 | 1047 | 1048 | 1049 | subroutine forthread_mutexattr_gettype(attr,mtype,info) 1050 | implicit none 1051 | 1052 | #include "ciface.h" 1053 | integer , intent(in) :: attr 1054 | integer , intent(out) :: mtype 1055 | integer , intent(out) :: info 1056 | 1057 | call thread_mutexattr_gettype(attr,mtype,info) 1058 | end subroutine forthread_mutexattr_gettype 1059 | 1060 | 1061 | 1062 | subroutine forthread_mutexattr_settype(attr,mtype,info) 1063 | implicit none 1064 | 1065 | #include "ciface.h" 1066 | integer , intent(in) :: attr 1067 | integer , intent(in) :: mtype 1068 | integer , intent(out) :: info 1069 | 1070 | call thread_mutexattr_settype(attr,mtype,info) 1071 | end subroutine forthread_mutexattr_settype 1072 | 1073 | 1074 | 1075 | !*****************************************************! 1076 | !* condition attriubute variable routines *! 1077 | !*****************************************************! 1078 | 1079 | 1080 | subroutine forthread_condattr_destroy(attr,info) 1081 | implicit none 1082 | 1083 | #include "ciface.h" 1084 | integer , intent(in) :: attr 1085 | integer , intent(out) :: info 1086 | 1087 | call thread_condattr_destroy(attr,info) 1088 | end subroutine forthread_condattr_destroy 1089 | 1090 | 1091 | 1092 | subroutine forthread_condattr_init(attr,info) 1093 | implicit none 1094 | 1095 | #include "ciface.h" 1096 | integer , intent(in) :: attr 1097 | integer , intent(out) :: info 1098 | 1099 | call thread_condattr_init(attr,info) 1100 | end subroutine forthread_condattr_init 1101 | 1102 | 1103 | 1104 | subroutine forthread_condattr_getpshared(attr,pshared,info) 1105 | implicit none 1106 | 1107 | #include "ciface.h" 1108 | integer , intent(in) :: attr 1109 | integer , intent(out) :: pshared 1110 | integer , intent(out) :: info 1111 | 1112 | call thread_condattr_getpshared(attr,pshared,info) 1113 | end subroutine forthread_condattr_getpshared 1114 | 1115 | 1116 | 1117 | subroutine forthread_condattr_setpshared(attr,pshared,info) 1118 | implicit none 1119 | 1120 | #include "ciface.h" 1121 | integer , intent(in) :: attr 1122 | integer , intent(in) :: pshared 1123 | integer , intent(out) :: info 1124 | 1125 | call thread_condattr_setpshared(attr,pshared,info) 1126 | end subroutine forthread_condattr_setpshared 1127 | 1128 | 1129 | 1130 | #ifndef __DARWIN 1131 | subroutine forthread_condattr_getclock(attr,clock_id,info) 1132 | implicit none 1133 | 1134 | #include "ciface.h" 1135 | integer , intent(in) :: attr 1136 | integer , intent(out) :: clock_id 1137 | integer , intent(out) :: info 1138 | 1139 | call thread_condattr_getclock(attr,clock_id,info) 1140 | end subroutine forthread_condattr_getclock 1141 | 1142 | 1143 | 1144 | subroutine forthread_condattr_setclock(attr,clock_id,info) 1145 | implicit none 1146 | 1147 | #include "ciface.h" 1148 | integer , intent(in) :: attr 1149 | integer , intent(in) :: clock_id 1150 | integer , intent(out) :: info 1151 | 1152 | call thread_condattr_setclock(attr,clock_id,info) 1153 | end subroutine forthread_condattr_setclock 1154 | 1155 | 1156 | !**************************************************! 1157 | !* barrier attribute variable routines *! 1158 | !**************************************************! 1159 | 1160 | 1161 | 1162 | subroutine forthread_barrierattr_destroy(attr,info) 1163 | implicit none 1164 | 1165 | #include "ciface.h" 1166 | integer , intent(in) :: attr 1167 | integer , intent(out) :: info 1168 | 1169 | call thread_barrierattr_destroy(attr,info) 1170 | end subroutine forthread_barrierattr_destroy 1171 | 1172 | 1173 | 1174 | subroutine forthread_barrierattr_init(attr,info) 1175 | implicit none 1176 | 1177 | #include "ciface.h" 1178 | integer , intent(in) :: attr 1179 | integer , intent(out) :: info 1180 | 1181 | call thread_barrierattr_init(attr,info) 1182 | end subroutine forthread_barrierattr_init 1183 | 1184 | 1185 | 1186 | subroutine forthread_barrierattr_getpshared(attr,pshared,info) 1187 | implicit none 1188 | 1189 | #include "ciface.h" 1190 | integer , intent(in) :: attr 1191 | integer , intent(out) :: pshared 1192 | integer , intent(out) :: info 1193 | 1194 | call thread_barrierattr_getpshared(attr,pshared,info) 1195 | end subroutine forthread_barrierattr_getpshared 1196 | 1197 | 1198 | 1199 | subroutine forthread_barrierattr_setpshared(attr,pshared,info) 1200 | implicit none 1201 | 1202 | #include "ciface.h" 1203 | integer , intent(in) :: attr 1204 | integer , intent(in) :: pshared 1205 | integer , intent(out) :: info 1206 | 1207 | call thread_barrierattr_setpshared(attr,pshared,info) 1208 | end subroutine forthread_barrierattr_setpshared 1209 | #endif 1210 | 1211 | 1212 | !**************************************************! 1213 | !* rwlock attribute variable routines *! 1214 | !**************************************************! 1215 | 1216 | 1217 | subroutine forthread_rwlockattr_destroy(attr,info) 1218 | implicit none 1219 | 1220 | #include "ciface.h" 1221 | integer , intent(in) :: attr 1222 | integer , intent(out) :: info 1223 | 1224 | call thread_rwlockattr_destroy(attr,info) 1225 | end subroutine forthread_rwlockattr_destroy 1226 | 1227 | 1228 | 1229 | subroutine forthread_rwlockattr_init(attr,info) 1230 | implicit none 1231 | 1232 | #include "ciface.h" 1233 | integer , intent(in) :: attr 1234 | integer , intent(out) :: info 1235 | 1236 | call thread_rwlockattr_init(attr,info) 1237 | end subroutine forthread_rwlockattr_init 1238 | 1239 | 1240 | 1241 | subroutine forthread_rwlockattr_getpshared(attr,pshared,info) 1242 | implicit none 1243 | 1244 | #include "ciface.h" 1245 | integer , intent(in) :: attr 1246 | integer , intent(out) :: pshared 1247 | integer , intent(out) :: info 1248 | 1249 | call thread_rwlockattr_getpshared(attr,pshared,info) 1250 | end subroutine forthread_rwlockattr_getpshared 1251 | 1252 | 1253 | 1254 | subroutine forthread_rwlockattr_setpshared(attr,pshared,info) 1255 | implicit none 1256 | 1257 | #include "ciface.h" 1258 | integer , intent(in) :: attr 1259 | integer , intent(in) :: pshared 1260 | integer , intent(out) :: info 1261 | 1262 | call thread_rwlockattr_setpshared(attr,pshared,info) 1263 | end subroutine forthread_rwlockattr_setpshared 1264 | 1265 | -------------------------------------------------------------------------------- /src/forthread.c: -------------------------------------------------------------------------------- 1 | /* 2 | * C wrappers to pthreads to make wrapping with Fortran simpler 3 | * 4 | * Most routines are wrappers to the POSIX threads API. Extensive 5 | * documentation is found in the respective manpages. 6 | * 7 | * We use _POSIX_BARRIERS and __DARWIN to test for 8 | * system capabilities. Some functions are only supported on Linux 9 | * or systems that also implement optional POSIX threads APIs 10 | */ 11 | 12 | 13 | #include "ft_consts.h" 14 | #include "ft_data.h" 15 | #include "ft_attr.h" 16 | #include "forthread.h" 17 | 18 | /* 19 | * Forthreads initialization routine 20 | */ 21 | void thread_init(int *info) { 22 | int i = 0; 23 | pthread_t stid; 24 | static int init = 0; 25 | *info = FT_OK; 26 | 27 | if (init) { 28 | *info = FT_EINIT; 29 | return; 30 | } 31 | threads = NULL; 32 | array_init(&threads,INIT_SIZE); 33 | thread_attrs = NULL; 34 | array_init(&thread_attrs,INIT_SIZE); 35 | thread_keys = NULL; 36 | array_init(&thread_keys,INIT_SIZE); 37 | once_ctrls = NULL; 38 | array_init(&once_ctrls,INIT_SIZE); 39 | mutexes = NULL; 40 | array_init(&mutexes,INIT_SIZE); 41 | mutex_attrs = NULL; 42 | array_init(&mutex_attrs,INIT_SIZE); 43 | conds = NULL; 44 | array_init(&conds,INIT_SIZE); 45 | cond_attrs = NULL; 46 | array_init(&cond_attrs,INIT_SIZE); 47 | barriers = NULL; 48 | array_init(&barriers,INIT_SIZE); 49 | barrier_attrs = NULL; 50 | array_init(&barrier_attrs,INIT_SIZE); 51 | spinlocks = NULL; 52 | varray_init(&spinlocks,INIT_SIZE); 53 | rwlocks = NULL; 54 | array_init(&rwlocks,INIT_SIZE); 55 | rwlock_attrs = NULL; 56 | array_init(&rwlock_attrs,INIT_SIZE); 57 | // allocate and store the thread master ID 58 | threads->data[0] = (pthread_t*) malloc(sizeof(pthread_t)); 59 | stid = pthread_self(); 60 | memcpy(threads->data[0],&stid,sizeof(pthread_t)); 61 | threads->after++; 62 | 63 | init = 1; 64 | is_initialized = init; 65 | } 66 | 67 | /* 68 | * Destruction routine, should be only called at the program end 69 | */ 70 | void thread_destroy(int* info) { 71 | int id; 72 | for(id = 1; id < threads->after; id++) { 73 | thread_cancel(&id,info); 74 | } 75 | array_delete(threads); 76 | array_delete(thread_attrs); 77 | array_delete(thread_keys); 78 | array_delete(once_ctrls); 79 | for(id = 0; id < mutexes->after; id++) { 80 | thread_mutex_destroy(&id,info); 81 | } 82 | array_delete(mutexes); 83 | array_delete(mutex_attrs); 84 | for(id = 0; id < conds->after; id++) { 85 | thread_cond_destroy(&id,info); 86 | } 87 | array_delete(conds); 88 | array_delete(cond_attrs); 89 | 90 | #ifdef THREAD_POSIX_BARRIERS 91 | for(id = 0; id < barriers->after; id++) { 92 | thread_barrier_destroy(&id,info); 93 | } 94 | array_delete(barriers); 95 | array_delete(barrier_attrs); 96 | #endif 97 | #ifndef __DARWIN 98 | for(id = 0; id < spinlocks->after; id++) { 99 | thread_spin_destroy(&id,info); 100 | } 101 | varray_delete(spinlocks); 102 | #endif 103 | for(id = 0; id < rwlocks->after; id++) { 104 | thread_rwlock_destroy(&id,info); 105 | } 106 | array_delete(rwlocks); 107 | array_delete(rwlock_attrs); 108 | *info = FT_OK; 109 | } 110 | 111 | 112 | /*****************************************/ 113 | /* Thread routines */ 114 | /*****************************************/ 115 | 116 | /* 117 | * Allocate needed memory for the forthreads wrapping 118 | * data structures 119 | */ 120 | void thread_alloc(int *thread_id, int *info) { 121 | 122 | if (!is_initialized) { 123 | *info = FT_EINIT; 124 | return; 125 | } 126 | 127 | pthread_mutex_lock(&(threads->mutex)); 128 | if (threads->after == threads->size) { 129 | // we exhausted the thread id array, double space 130 | array_resize(&threads,threads->size*2); 131 | } 132 | threads->data[threads->after] = (pthread_t*) malloc(sizeof(pthread_t)); 133 | 134 | *thread_id = threads->after; 135 | threads->after++; 136 | 137 | pthread_mutex_unlock(&(threads->mutex)); 138 | 139 | } 140 | 141 | void thread_create(int *thread_id, int *attr_id, 142 | void *(**start_routine)(void *), void *arg, int* info) { 143 | int i = 0; 144 | pthread_attr_t *attr; 145 | *info = FT_OK; 146 | 147 | if (!is_initialized) { 148 | *info = FT_EINIT; 149 | return; 150 | } 151 | 152 | if (!is_valid(threads,*thread_id)) { 153 | *info = FT_EINVALID; 154 | return; 155 | } 156 | 157 | pthread_mutex_lock(&(threads->mutex)); 158 | 159 | if (*attr_id == -1) { 160 | // TODO: This should be revisited in the future. 161 | // setting attr to NULL would be cleaner, but creating 162 | // joinable threads is more practical. 163 | attr = (pthread_attr_t*) malloc(sizeof(pthread_attr_t)); 164 | pthread_attr_init(attr); 165 | pthread_attr_setdetachstate(attr, PTHREAD_CREATE_JOINABLE); 166 | } else { 167 | if (!is_valid(thread_attrs,*attr_id)) { 168 | pthread_mutex_unlock(&(threads->mutex)); 169 | *info = FT_EINVALID; 170 | return; 171 | } 172 | attr = thread_attrs->data[*attr_id]; 173 | } 174 | 175 | *info = pthread_create(threads->data[*thread_id], attr, (*start_routine), arg); 176 | 177 | // TODO: goes with the comment above 178 | if (*attr_id == -1) 179 | free(attr); 180 | 181 | if (*info) { 182 | pthread_mutex_unlock(&(threads->mutex)); 183 | return; 184 | } 185 | 186 | pthread_mutex_unlock(&(threads->mutex)); 187 | 188 | } 189 | 190 | void thread_detach(int *thread_id, int *info) { 191 | 192 | *info = FT_OK; 193 | 194 | if (!is_initialized) { 195 | *info = FT_EINIT; 196 | return; 197 | } 198 | 199 | if (!is_valid(threads,*thread_id)) { 200 | *info = FT_EINVALID; 201 | return; 202 | } 203 | 204 | *info = pthread_detach(*((pthread_t*)(threads->data[*thread_id]))); 205 | } 206 | 207 | void thread_equal(int *t1, int *t2, int *info) { 208 | *info = FT_OK; 209 | 210 | if (!is_initialized) 211 | *info = FT_EINIT; 212 | else if (!is_valid(threads,*t1)) 213 | *info = FT_EINVALID; 214 | else if (!is_valid(threads,*t2)) 215 | *info = FT_EINVALID; 216 | else 217 | *info = pthread_equal(*((pthread_t*)(threads->data[*t1])), 218 | *((pthread_t*)(threads->data[*t2]))); 219 | 220 | } 221 | 222 | void thread_exit(void *value_ptr) { 223 | 224 | pthread_exit(value_ptr); 225 | 226 | } 227 | 228 | void thread_join(int *thread_id, void **value_ptr, int *info) { 229 | *info = FT_OK; 230 | 231 | if (!is_initialized) { 232 | *info = FT_EINIT; 233 | return; 234 | } 235 | 236 | pthread_mutex_lock(&(threads->mutex)); 237 | if (!is_valid(threads,*thread_id)) { 238 | *info = FT_EINVALID; 239 | return; 240 | } 241 | 242 | *info = pthread_join(*((pthread_t*)(threads->data[*thread_id])),value_ptr); 243 | 244 | if (*info) { 245 | pthread_mutex_unlock(&(threads->mutex)); 246 | return; 247 | } 248 | 249 | free(threads->data[*thread_id]); 250 | threads->data[*thread_id] = NULL; 251 | 252 | pthread_mutex_unlock(&(threads->mutex)); 253 | } 254 | 255 | void thread_cancel(int *thread_id, int *info) { 256 | *info = FT_OK; 257 | 258 | if (!is_initialized) { 259 | *info = FT_EINIT; 260 | return; 261 | } 262 | 263 | if (!is_valid(threads,*thread_id)) { 264 | *info = FT_EINVALID; 265 | return; 266 | } 267 | 268 | *info = pthread_cancel(*((pthread_t*)(threads->data[*thread_id]))); 269 | 270 | } 271 | 272 | void thread_testcancel(int *info) { 273 | *info = FT_OK; 274 | 275 | if (!is_initialized) { 276 | *info = FT_EINIT; 277 | return; 278 | } 279 | 280 | 281 | pthread_testcancel(); 282 | 283 | } 284 | 285 | 286 | void thread_kill(int *thread_id, int *sig, int *info) { 287 | *info = FT_OK; 288 | 289 | if (!is_initialized) { 290 | *info = FT_EINIT; 291 | return; 292 | } 293 | 294 | if (!is_valid(threads,*thread_id)) { 295 | *info = FT_EINVALID; 296 | return; 297 | } 298 | 299 | *info = pthread_kill(*((pthread_t*)(threads->data[*thread_id])),*sig); 300 | 301 | } 302 | 303 | void thread_once_init(int *once_ctrl, int *info) { 304 | 305 | *info = 0; 306 | static pthread_once_t once_control_init = PTHREAD_ONCE_INIT; 307 | 308 | if (!is_initialized) { 309 | *info = FT_EINIT; 310 | return; 311 | } 312 | 313 | pthread_mutex_lock(&(once_ctrls->mutex)); 314 | if (once_ctrls->after == once_ctrls->size) { 315 | // we exhausted the thread id array, double space 316 | array_resize(&once_ctrls,once_ctrls->size*2); 317 | } 318 | once_ctrls->data[once_ctrls->after] = (pthread_once_t*) malloc(sizeof(pthread_once_t)); 319 | 320 | *((pthread_once_t*)once_ctrls->data[once_ctrls->after]) = once_control_init; 321 | 322 | *once_ctrl = once_ctrls->after; 323 | once_ctrls->after++; 324 | 325 | pthread_mutex_unlock(&(once_ctrls->mutex)); 326 | } 327 | 328 | void thread_once(int *once_ctrl_id, void (**routine)(void), int *info) { 329 | *info = FT_OK; 330 | 331 | if (!is_initialized) 332 | *info = FT_EINIT; 333 | else if (!is_valid(once_ctrls,*once_ctrl_id)) 334 | *info = FT_EINVALID; 335 | else 336 | *info = pthread_once(once_ctrls->data[*once_ctrl_id],*routine); 337 | 338 | } 339 | 340 | void thread_self(int *thread_id, int *info) { 341 | pthread_t tid; 342 | int i = 0; 343 | *info = FT_OK; 344 | *thread_id = -1; 345 | 346 | if (!is_initialized) { 347 | *info = FT_EINIT; 348 | return; 349 | } 350 | 351 | tid = pthread_self(); 352 | for (i = 0; i < threads->after; i++) { 353 | if (threads->data[i] == NULL) 354 | continue; 355 | if (pthread_equal(tid,*((pthread_t*)(threads->data[i])))) { 356 | *thread_id = i; 357 | return; 358 | } 359 | } 360 | *info = FT_EINVALID; 361 | } 362 | 363 | 364 | void thread_atfork(void (**prepare)(void), 365 | void (**parent)(void), void (**child)(void), int *info) { 366 | 367 | *info = pthread_atfork(*prepare,*parent,*child); 368 | 369 | } 370 | 371 | /* 372 | * Connot be wrapped because the standard suggests C macros and 373 | * stipulates that _pop and _push must be called in the same scope. 374 | * Hence, wrapping and calling from Fortran would break the standard 375 | * and most probably crash any code using this. 376 | */ 377 | void thread_cleanup_pop(int *execute, int *info) { 378 | *info = FT_EINVALID; 379 | 380 | 381 | } 382 | 383 | /* 384 | * Connot be wrapped because the standard suggests C macros and 385 | * stipulates that _pop and _push must be called in the same scope. 386 | * Hence, wrapping and calling from Fortran would break the standard 387 | * and most probably crash any code using this. 388 | */ 389 | void thread_cleanup_push(void *(*routine)(void *), void *arg, int* info) { 390 | *info = FT_EINVALID; 391 | 392 | } 393 | 394 | void thread_getconcurrency(int *currlevel, int *info) { 395 | *info = FT_OK; 396 | 397 | if (!is_initialized) { 398 | *info = FT_EINIT; 399 | return; 400 | } 401 | 402 | *currlevel = pthread_getconcurrency(); 403 | 404 | } 405 | 406 | 407 | void thread_setconcurrency(int *new_level, int *info) { 408 | *info = FT_OK; 409 | 410 | if (!is_initialized) { 411 | *info = FT_EINIT; 412 | return; 413 | } 414 | 415 | *info = pthread_setconcurrency(*new_level); 416 | 417 | } 418 | 419 | #ifndef __DARWIN 420 | void thread_getcpuclockid(int *thread, int *clock_id, int *info) { 421 | *info = FT_OK; 422 | // we'll be casting this onto an int. This may be dangerous 423 | // but Fortran does not know this type (and we want to avoid 424 | // creating Fortran type wrappers). 425 | clockid_t cid; 426 | 427 | if (!is_initialized) { 428 | *info = FT_EINIT; 429 | return; 430 | } 431 | 432 | pthread_mutex_lock(&(threads->mutex)); 433 | if (!is_valid(threads,*thread)) { 434 | pthread_mutex_unlock(&(threads->mutex)); 435 | *info = FT_EINVALID; 436 | return; 437 | } 438 | 439 | *info = pthread_getcpuclockid( 440 | *((pthread_t*)(threads->data[*thread])), 441 | &cid); 442 | *clock_id = (int)cid; 443 | 444 | pthread_mutex_unlock(&(threads->mutex)); 445 | 446 | } 447 | #endif 448 | 449 | void thread_getschedparam(int *thread, int *policy, struct sched_param *param, int *info) { 450 | *info = FT_OK; 451 | ; 452 | 453 | if (!is_initialized) { 454 | *info = FT_EINIT; 455 | return; 456 | } 457 | 458 | pthread_mutex_lock(&(threads->mutex)); 459 | if (!is_valid(threads,*thread)) { 460 | pthread_mutex_unlock(&(threads->mutex)); 461 | *info = FT_EINVALID; 462 | return; 463 | } 464 | 465 | *info = pthread_getschedparam(*((pthread_t*)(threads->data[*thread])),policy,param); 466 | 467 | pthread_mutex_unlock(&(threads->mutex)); 468 | 469 | } 470 | 471 | void thread_setschedparam(int *thread, int *policy, struct sched_param *param, int *info) { 472 | *info = FT_OK; 473 | 474 | if (!is_initialized) { 475 | *info = FT_EINIT; 476 | return; 477 | } 478 | 479 | pthread_mutex_lock(&(threads->mutex)); 480 | if (!is_valid(threads,*thread)) { 481 | pthread_mutex_unlock(&(threads->mutex)); 482 | *info = FT_EINVALID; 483 | return; 484 | } 485 | 486 | *info = pthread_setschedparam(*((pthread_t*)(threads->data[*thread])),*policy,param); 487 | 488 | pthread_mutex_unlock(&(threads->mutex)); 489 | 490 | } 491 | 492 | #ifndef __DARWIN 493 | void thread_setschedprio(int *thread, int *prio, int *info) { 494 | *info = FT_OK; 495 | 496 | if (!is_initialized) { 497 | *info = FT_EINIT; 498 | return; 499 | } 500 | 501 | pthread_mutex_lock(&(threads->mutex)); 502 | if (!is_valid(threads,*thread)) { 503 | pthread_mutex_unlock(&(threads->mutex)); 504 | *info = FT_EINVALID; 505 | return; 506 | } 507 | 508 | *info = pthread_setschedprio(*((pthread_t*)(threads->data[*thread])),*prio); 509 | 510 | pthread_mutex_unlock(&(threads->mutex)); 511 | 512 | } 513 | #endif 514 | void thread_setcancelstate(int *state, int *oldstate, int *info) { 515 | *info = FT_OK; 516 | 517 | if (!is_initialized) { 518 | *info = FT_EINIT; 519 | return; 520 | } 521 | 522 | *info = pthread_setcancelstate(*state,oldstate); 523 | 524 | } 525 | 526 | void thread_setcanceltype(int *type, int *oldtype, int *info) { 527 | *info = FT_OK; 528 | 529 | if (!is_initialized) { 530 | *info = FT_EINIT; 531 | return; 532 | } 533 | 534 | *info = pthread_setcanceltype(*type,oldtype); 535 | 536 | } 537 | 538 | /*****************************************/ 539 | /* storing private data in threads */ 540 | /*****************************************/ 541 | 542 | 543 | void thread_key_delete(int *key_id, int *info) { 544 | *info = FT_OK; 545 | 546 | if (!is_initialized) { 547 | *info = FT_EINIT; 548 | return; 549 | } 550 | 551 | pthread_mutex_lock(&(thread_keys->mutex)); 552 | 553 | if (!is_valid(thread_keys,*key_id)) { 554 | pthread_mutex_unlock(&(thread_keys->mutex)); 555 | *info = FT_EINVALID; 556 | return; 557 | } 558 | 559 | *info = pthread_key_delete(*((pthread_key_t*)(thread_keys->data[*key_id]))); 560 | 561 | pthread_mutex_unlock(&(thread_keys->mutex)); 562 | } 563 | 564 | void thread_key_create(int *key_id,void (*destructor)(void *),int *info) { 565 | *info = FT_OK; 566 | 567 | if (!is_initialized) { 568 | *info = FT_EINIT; 569 | return; 570 | } 571 | 572 | pthread_mutex_lock(&(thread_keys->mutex)); 573 | if (thread_keys->after == thread_keys->size) { 574 | // we exhausted the mutex id array, double space 575 | array_resize(&thread_keys,thread_keys->size*2); 576 | } 577 | thread_keys->data[thread_keys->after] = (pthread_key_t*) malloc(sizeof(pthread_key_t)); 578 | 579 | *info = pthread_key_create((pthread_key_t*)(thread_keys->data[thread_keys->after]),destructor); 580 | 581 | if (*info) { 582 | pthread_mutex_unlock(&(thread_keys->mutex)); 583 | return; 584 | } 585 | 586 | *key_id = thread_keys->after; 587 | thread_keys->after++; 588 | 589 | pthread_mutex_unlock(&(thread_keys->mutex)); 590 | 591 | } 592 | 593 | /** 594 | * This will need some more testing because void pointers don't 595 | * make much sense in Fortran. 596 | */ 597 | void thread_getspecific(int *key, void **value, int *info) { 598 | 599 | *info = FT_OK; 600 | 601 | if (!is_initialized) { 602 | *info = FT_EINIT; 603 | return; 604 | } 605 | 606 | pthread_mutex_lock(&(thread_keys->mutex)); 607 | 608 | if (!is_valid(thread_keys,*key)) { 609 | pthread_mutex_unlock(&(thread_keys->mutex)); 610 | *info = FT_EINVALID; 611 | return; 612 | } 613 | 614 | *value = pthread_getspecific(*((pthread_key_t*)(thread_keys->data[*key]))); 615 | 616 | pthread_mutex_unlock(&(thread_keys->mutex)); 617 | } 618 | 619 | /** 620 | * This will need some more testing because void pointers don't 621 | * make much sense in Fortran. 622 | */ 623 | void thread_setspecific(int *key, void **value, int *info) { 624 | 625 | *info = FT_OK; 626 | 627 | if (!is_initialized) { 628 | *info = FT_EINIT; 629 | return; 630 | } 631 | 632 | pthread_mutex_lock(&(thread_keys->mutex)); 633 | 634 | if (!is_valid(thread_keys,*key)) { 635 | pthread_mutex_unlock(&(thread_keys->mutex)); 636 | *info = FT_EINVALID; 637 | return; 638 | } 639 | 640 | *info = pthread_setspecific(*((pthread_key_t*)(thread_keys->data[*key])), 641 | *value); 642 | 643 | pthread_mutex_unlock(&(thread_keys->mutex)); 644 | } 645 | 646 | 647 | /*****************************************/ 648 | /* mutex routines */ 649 | /*****************************************/ 650 | 651 | void thread_mutex_destroy(int *mutex_id, int *info) { 652 | 653 | *info = FT_OK; 654 | 655 | if (!is_initialized) { 656 | *info = FT_EINIT; 657 | return; 658 | } 659 | 660 | pthread_mutex_lock(&(mutexes->mutex)); 661 | 662 | if (!is_valid(mutexes,*mutex_id)) { 663 | pthread_mutex_unlock(&(mutexes->mutex)); 664 | *info = FT_EINVALID; 665 | return; 666 | } 667 | 668 | *info = pthread_mutex_destroy(((pthread_mutex_t*)(mutexes->data[*mutex_id]))); 669 | 670 | if (*info) { 671 | pthread_mutex_unlock(&(mutexes->mutex)); 672 | return; 673 | } 674 | 675 | free(mutexes->data[*mutex_id]); 676 | mutexes->data[*mutex_id] = NULL; 677 | 678 | 679 | pthread_mutex_unlock(&(mutexes->mutex)); 680 | 681 | } 682 | 683 | 684 | void thread_mutex_init(int *mutex_id, int *attr_id, int *info) { 685 | int i = 0; 686 | *info = FT_OK; 687 | 688 | pthread_mutexattr_t *attr; 689 | 690 | if (!is_initialized) { 691 | *info = FT_EINIT; 692 | return; 693 | } 694 | 695 | pthread_mutex_lock(&(mutexes->mutex)); 696 | if (mutexes->after == mutexes->size) { 697 | // we exhausted the mutex id array, double space 698 | array_resize(&mutexes,mutexes->size*2); 699 | } 700 | mutexes->data[mutexes->after] = (pthread_mutex_t*) malloc(sizeof(pthread_mutex_t)); 701 | 702 | if (*attr_id == -1) { 703 | attr = NULL; 704 | } else { 705 | attr = mutex_attrs->data[*attr_id]; 706 | } 707 | 708 | *info = pthread_mutex_init((pthread_mutex_t*)( 709 | mutexes->data[mutexes->after]), attr); 710 | 711 | if (*info) { 712 | pthread_mutex_unlock(&(mutexes->mutex)); 713 | return; 714 | } 715 | 716 | *mutex_id = mutexes->after; 717 | mutexes->after++; 718 | 719 | pthread_mutex_unlock(&(mutexes->mutex)); 720 | 721 | 722 | } 723 | 724 | void thread_mutex_lock(int *mutex_id, int *info) { 725 | *info = FT_OK; 726 | 727 | if (!is_initialized) { 728 | *info = FT_EINIT; 729 | return; 730 | } 731 | 732 | if (!is_valid(mutexes,*mutex_id)) { 733 | *info = FT_EINVALID; 734 | return; 735 | } 736 | 737 | *info = pthread_mutex_lock((pthread_mutex_t*)(mutexes->data[*mutex_id])); 738 | 739 | } 740 | 741 | void thread_mutex_trylock(int *mutex_id, int *info) { 742 | *info = FT_OK; 743 | 744 | if (!is_initialized) { 745 | *info = FT_EINIT; 746 | return; 747 | } 748 | 749 | if (!is_valid(mutexes,*mutex_id)) { 750 | *info = FT_EINVALID; 751 | return; 752 | } 753 | 754 | *info = pthread_mutex_trylock((pthread_mutex_t*)(mutexes->data[*mutex_id])); 755 | 756 | 757 | } 758 | 759 | void thread_mutex_unlock(int *mutex_id, int *info) { 760 | *info = FT_OK; 761 | 762 | if (!is_initialized) { 763 | *info = FT_EINIT; 764 | return; 765 | } 766 | 767 | if (!is_valid(mutexes,*mutex_id)) { 768 | *info = FT_EINVALID; 769 | return; 770 | } 771 | 772 | *info = pthread_mutex_unlock((pthread_mutex_t*)(mutexes->data[*mutex_id])); 773 | 774 | } 775 | 776 | void thread_mutex_getprioceiling(int *mutex, int *prioceiling, int *info) { 777 | *info = FT_OK; 778 | 779 | if (!is_initialized) { 780 | *info = FT_EINIT; 781 | return; 782 | } 783 | 784 | pthread_mutex_lock(&(mutexes->mutex)); 785 | if (!is_valid(mutexes,*mutex)) { 786 | pthread_mutex_unlock(&(mutexes->mutex)); 787 | *info = FT_EINVALID; 788 | return; 789 | } 790 | 791 | *info = pthread_mutex_getprioceiling( 792 | (pthread_mutex_t*)(mutexes->data[*mutex]), 793 | prioceiling); 794 | 795 | pthread_mutex_unlock(&(mutexes->mutex)); 796 | 797 | } 798 | 799 | void thread_mutex_setprioceiling(int *mutex, int *prioceiling, int *old_ceiling, int *info) { 800 | *info = FT_OK; 801 | 802 | if (!is_initialized) { 803 | *info = FT_EINIT; 804 | return; 805 | } 806 | 807 | pthread_mutex_lock(&(mutexes->mutex)); 808 | if (!is_valid(mutexes,*mutex)) { 809 | pthread_mutex_unlock(&(mutexes->mutex)); 810 | *info = FT_EINVALID; 811 | return; 812 | } 813 | 814 | *info = pthread_mutex_setprioceiling( 815 | (pthread_mutex_t*)(mutexes->data[*mutex]), 816 | *prioceiling,old_ceiling); 817 | 818 | pthread_mutex_unlock(&(mutexes->mutex)); 819 | 820 | } 821 | 822 | #ifndef __DARWIN 823 | /* 824 | * An API change will be needed here to make calling from Fortran 825 | * simpler. 826 | */ 827 | void thread_mutex_timedlock(int *mutex, struct timespec *abs_timeout, int *info) { 828 | *info = FT_OK; 829 | 830 | 831 | if (!is_initialized) { 832 | *info = FT_EINIT; 833 | return; 834 | } 835 | 836 | if (!is_valid(mutexes,*mutex)) { 837 | *info = FT_EINVALID; 838 | return; 839 | } 840 | 841 | *info = pthread_mutex_timedlock((pthread_mutex_t*)(mutexes->data[*mutex]), 842 | abs_timeout); 843 | 844 | } 845 | #endif 846 | 847 | 848 | /*****************************************/ 849 | /* condition variable routines */ 850 | /*****************************************/ 851 | 852 | 853 | void thread_cond_destroy(int *cond_id, int *info) { 854 | 855 | *info = FT_OK; 856 | 857 | if (!is_initialized) { 858 | *info = FT_EINIT; 859 | return; 860 | } 861 | 862 | pthread_mutex_lock(&(conds->mutex)); 863 | 864 | if (!is_valid(conds,*cond_id)) { 865 | pthread_mutex_unlock(&(conds->mutex)); 866 | *info = FT_EINVALID; 867 | return; 868 | } 869 | 870 | *info = pthread_cond_destroy(((pthread_cond_t*)(conds->data[*cond_id]))); 871 | 872 | if (*info) { 873 | pthread_mutex_unlock(&(conds->mutex)); 874 | return; 875 | } 876 | 877 | free(conds->data[*cond_id]); 878 | conds->data[*cond_id] = NULL; 879 | 880 | pthread_mutex_unlock(&(conds->mutex)); 881 | 882 | } 883 | 884 | 885 | void thread_cond_init(int *cond_id, int *attr_id, int *info) { 886 | int i = 0; 887 | *info = FT_OK; 888 | pthread_condattr_t *attr; 889 | 890 | if (!is_initialized) { 891 | *info = FT_EINIT; 892 | return; 893 | } 894 | 895 | pthread_mutex_lock(&(conds->mutex)); 896 | if (conds->after == conds->size) { 897 | // we exhausted the mutex id array, double space 898 | array_resize(&conds,conds->size*2); 899 | } 900 | conds->data[conds->after] = (pthread_cond_t*) malloc(sizeof(pthread_cond_t)); 901 | 902 | if (*attr_id == -1) { 903 | attr = NULL; 904 | } else { 905 | attr = cond_attrs->data[*attr_id]; 906 | } 907 | 908 | *info = pthread_cond_init((pthread_cond_t*)(conds->data[conds->after]), attr); 909 | 910 | if (*info) { 911 | pthread_mutex_unlock(&(conds->mutex)); 912 | return; 913 | } 914 | 915 | *cond_id = conds->after; 916 | conds->after++; 917 | 918 | pthread_mutex_unlock(&(conds->mutex)); 919 | 920 | } 921 | 922 | void thread_cond_timedwait(int *cond_id, int *mutex_id, struct timespec *abstime, int *info) { 923 | *info = FT_OK; 924 | 925 | if (!is_initialized) { 926 | *info = FT_EINIT; 927 | return; 928 | } 929 | 930 | if ((!is_valid(mutexes,*mutex_id)) || (!is_valid(conds,*cond_id))) { 931 | *info = FT_EINVALID; 932 | return; 933 | } 934 | 935 | *info = pthread_cond_timedwait((pthread_cond_t*)(conds->data[*cond_id]), 936 | (pthread_mutex_t*)(mutexes->data[*mutex_id]), 937 | abstime); 938 | 939 | } 940 | 941 | 942 | void thread_cond_wait(int *cond_id, int *mutex_id, int *info) { 943 | *info = FT_OK; 944 | 945 | if (!is_initialized) { 946 | *info = FT_EINIT; 947 | return; 948 | } 949 | 950 | if ((!is_valid(mutexes,*mutex_id)) || (!is_valid(conds,*cond_id))) { 951 | *info = FT_EINVALID; 952 | return; 953 | } 954 | 955 | *info = pthread_cond_wait((pthread_cond_t*)(conds->data[*cond_id]), 956 | (pthread_mutex_t*)(mutexes->data[*mutex_id])); 957 | 958 | } 959 | 960 | 961 | void thread_cond_broadcast(int *cond_id, int *info) { 962 | *info = FT_OK; 963 | 964 | if (!is_initialized) { 965 | *info = FT_EINIT; 966 | return; 967 | } 968 | 969 | if (!is_valid(conds,*cond_id)) { 970 | *info = FT_EINVALID; 971 | return; 972 | } 973 | 974 | *info = pthread_cond_broadcast((pthread_cond_t*)(conds->data[*cond_id])); 975 | 976 | } 977 | 978 | 979 | void thread_cond_signal(int *cond_id, int *info) { 980 | *info = FT_OK; 981 | 982 | if (!is_initialized) { 983 | *info = FT_EINIT; 984 | return; 985 | } 986 | 987 | if (!is_valid(conds,*cond_id)) { 988 | *info = FT_EINVALID; 989 | return; 990 | } 991 | 992 | *info = pthread_cond_signal((pthread_cond_t*)(conds->data[*cond_id])); 993 | 994 | } 995 | 996 | 997 | 998 | #ifdef THREAD_POSIX_BARRIERS 999 | /****************************************/ 1000 | /* barrier variable routines */ 1001 | /****************************************/ 1002 | 1003 | void thread_barrier_destroy(int *barrier_id, int *info) { 1004 | 1005 | *info = FT_OK; 1006 | 1007 | if (!is_initialized) { 1008 | *info = FT_EINIT; 1009 | return; 1010 | } 1011 | 1012 | pthread_mutex_lock(&(barriers->mutex)); 1013 | 1014 | if (!is_valid(barriers,*barrier_id)) { 1015 | pthread_mutex_unlock(&(barriers->mutex)); 1016 | *info = FT_EINVALID; 1017 | return; 1018 | } 1019 | 1020 | *info = pthread_barrier_destroy(((pthread_barrier_t*)(barriers->data[*barrier_id]))); 1021 | 1022 | if (*info) { 1023 | pthread_mutex_unlock(&(barriers->mutex)); 1024 | return; 1025 | } 1026 | 1027 | free(barriers->data[*barrier_id]); 1028 | barriers->data[*barrier_id] = NULL; 1029 | 1030 | pthread_mutex_unlock(&(barriers->mutex)); 1031 | 1032 | } 1033 | 1034 | 1035 | void thread_barrier_init(int *barrier_id, int *attr_id, int *count, int *info) { 1036 | int i = 0; 1037 | *info = FT_OK; 1038 | pthread_barrierattr_t *attr; 1039 | 1040 | if (!is_initialized) { 1041 | *info = FT_EINIT; 1042 | return; 1043 | } 1044 | 1045 | pthread_mutex_lock(&(barriers->mutex)); 1046 | if (barriers->after == barriers->size) { 1047 | // we exhausted the mutex id array, double space 1048 | array_resize(&barriers,barriers->size*2); 1049 | } 1050 | barriers->data[barriers->after] = (pthread_barrier_t*) malloc(sizeof(pthread_barrier_t)); 1051 | 1052 | if (*attr_id == -1) { 1053 | attr = NULL; 1054 | } else { 1055 | attr = barrier_attrs->data[*attr_id]; 1056 | } 1057 | 1058 | *info = pthread_barrier_init((pthread_barrier_t*)(barriers->data[barriers->after]) 1059 | ,attr, *count); 1060 | 1061 | if (*info) { 1062 | pthread_mutex_unlock(&(barriers->mutex)); 1063 | return; 1064 | } 1065 | 1066 | *barrier_id = barriers->after; 1067 | barriers->after++; 1068 | 1069 | pthread_mutex_unlock(&(barriers->mutex)); 1070 | 1071 | } 1072 | 1073 | void thread_barrier_wait(int *barrier_id, int *info) { 1074 | *info = FT_OK; 1075 | 1076 | if (!is_initialized) { 1077 | *info = FT_EINIT; 1078 | return; 1079 | } 1080 | 1081 | if (!is_valid(barriers,*barrier_id)) { 1082 | *info = FT_EINVALID; 1083 | return; 1084 | } 1085 | 1086 | *info = pthread_barrier_wait((pthread_barrier_t*)(barriers->data[*barrier_id])); 1087 | 1088 | } 1089 | #endif 1090 | 1091 | 1092 | #ifndef __DARWIN 1093 | /*************************************/ 1094 | /* spin variable routines */ 1095 | /*************************************/ 1096 | 1097 | void thread_spin_destroy(int *spinlock_id, int *info) { 1098 | 1099 | *info = FT_OK; 1100 | 1101 | if (!is_initialized) { 1102 | *info = FT_EINIT; 1103 | return; 1104 | } 1105 | 1106 | pthread_mutex_lock(&(spinlocks->mutex)); 1107 | 1108 | if (!vis_valid(spinlocks,*spinlock_id)) { 1109 | pthread_mutex_unlock(&(spinlocks->mutex)); 1110 | *info = FT_EINVALID; 1111 | return; 1112 | } 1113 | 1114 | *info = pthread_spin_destroy(((pthread_spinlock_t*)(spinlocks->data[*spinlock_id]))); 1115 | 1116 | if (*info) { 1117 | pthread_mutex_unlock(&(spinlocks->mutex)); 1118 | return; 1119 | } 1120 | 1121 | free((void *)spinlocks->data[*spinlock_id]); 1122 | spinlocks->data[*spinlock_id] = NULL; 1123 | 1124 | pthread_mutex_unlock(&(spinlocks->mutex)); 1125 | 1126 | } 1127 | 1128 | 1129 | void thread_spin_init(int *spinlock_id, int *pshared, int *info) { 1130 | int i = 0; 1131 | *info = FT_OK; 1132 | 1133 | if (!is_initialized) { 1134 | *info = FT_EINIT; 1135 | return; 1136 | } 1137 | 1138 | pthread_mutex_lock(&(spinlocks->mutex)); 1139 | if (spinlocks->after == spinlocks->size) { 1140 | // we exhausted the mutex id array, double space 1141 | varray_resize(&spinlocks,spinlocks->size*2); 1142 | } 1143 | spinlocks->data[spinlocks->after] = (pthread_spinlock_t*) malloc(sizeof(pthread_spinlock_t)); 1144 | 1145 | *info = pthread_spin_init((pthread_spinlock_t*)(spinlocks->data[spinlocks->after]) 1146 | , *pshared); 1147 | 1148 | if (*info) { 1149 | pthread_mutex_unlock(&(spinlocks->mutex)); 1150 | return; 1151 | } 1152 | 1153 | *spinlock_id = spinlocks->after; 1154 | spinlocks->after++; 1155 | 1156 | pthread_mutex_unlock(&(spinlocks->mutex)); 1157 | 1158 | } 1159 | 1160 | void thread_spin_lock(int *lock_id, int *info) { 1161 | *info = FT_OK; 1162 | 1163 | if (!is_initialized) { 1164 | *info = FT_EINIT; 1165 | return; 1166 | } 1167 | 1168 | 1169 | if (!vis_valid(spinlocks,*lock_id)) { 1170 | *info = FT_EINVALID; 1171 | return; 1172 | } 1173 | 1174 | // TODO: this might need a lock 1175 | *info = pthread_spin_lock((pthread_spinlock_t*)(spinlocks->data[*lock_id])); 1176 | 1177 | 1178 | } 1179 | 1180 | void thread_spin_trylock(int *lock_id, int *info) { 1181 | *info = FT_OK; 1182 | 1183 | if (!is_initialized) { 1184 | *info = FT_EINIT; 1185 | return; 1186 | } 1187 | 1188 | 1189 | if (!vis_valid(spinlocks,*lock_id)) { 1190 | pthread_mutex_unlock(&(spinlocks->mutex)); 1191 | *info = FT_EINVALID; 1192 | return; 1193 | } 1194 | 1195 | // TODO: this might need a lock 1196 | *info = pthread_spin_trylock((pthread_spinlock_t*)(spinlocks->data[*lock_id])); 1197 | 1198 | } 1199 | 1200 | 1201 | void thread_spin_unlock(int *lock_id, int *info) { 1202 | *info = FT_OK; 1203 | 1204 | if (!is_initialized) { 1205 | *info = FT_EINIT; 1206 | return; 1207 | } 1208 | 1209 | 1210 | if (!vis_valid(spinlocks,*lock_id)) { 1211 | pthread_mutex_unlock(&(spinlocks->mutex)); 1212 | *info = FT_EINVALID; 1213 | return; 1214 | } 1215 | 1216 | // TODO: this might need a lock 1217 | *info = pthread_spin_unlock((pthread_spinlock_t*)(spinlocks->data[*lock_id])); 1218 | 1219 | } 1220 | #endif 1221 | 1222 | 1223 | /*************************************/ 1224 | /* variable routines */ 1225 | /*************************************/ 1226 | 1227 | 1228 | void thread_rwlock_destroy(int *rwlock_id, int *info) { 1229 | 1230 | *info = FT_OK; 1231 | 1232 | if (!is_initialized) { 1233 | *info = FT_EINIT; 1234 | return; 1235 | } 1236 | 1237 | pthread_mutex_lock(&(rwlocks->mutex)); 1238 | 1239 | if (!is_valid(rwlocks,*rwlock_id)) { 1240 | pthread_mutex_unlock(&(rwlocks->mutex)); 1241 | *info = FT_EINVALID; 1242 | return; 1243 | } 1244 | 1245 | *info = pthread_rwlock_destroy(((pthread_rwlock_t*)(rwlocks->data[*rwlock_id]))); 1246 | 1247 | if (*info) { 1248 | pthread_mutex_unlock(&(rwlocks->mutex)); 1249 | return; 1250 | } 1251 | 1252 | free(rwlocks->data[*rwlock_id]); 1253 | rwlocks->data[*rwlock_id] = NULL; 1254 | 1255 | pthread_mutex_unlock(&(rwlocks->mutex)); 1256 | 1257 | } 1258 | 1259 | 1260 | void thread_rwlock_init(int *rwlock_id, int *attr_id, int *info) { 1261 | int i = 0; 1262 | *info = FT_OK; 1263 | pthread_rwlockattr_t *attr; 1264 | 1265 | if (!is_initialized) { 1266 | *info = FT_EINIT; 1267 | return; 1268 | } 1269 | 1270 | pthread_mutex_lock(&(rwlocks->mutex)); 1271 | if (rwlocks->after == rwlocks->size) { 1272 | // we exhausted the mutex id array, double space 1273 | array_resize(&rwlocks,rwlocks->size*2); 1274 | } 1275 | rwlocks->data[rwlocks->after] = (pthread_rwlock_t*) malloc(sizeof(pthread_rwlock_t)); 1276 | 1277 | if (*attr_id == -1) { 1278 | attr = NULL; 1279 | } else { 1280 | attr = rwlock_attrs->data[*attr_id]; 1281 | } 1282 | 1283 | *info = pthread_rwlock_init((pthread_rwlock_t*)(rwlocks->data[rwlocks->after]) 1284 | ,attr); 1285 | 1286 | if (*info) { 1287 | pthread_mutex_unlock(&(rwlocks->mutex)); 1288 | return; 1289 | } 1290 | 1291 | *rwlock_id = rwlocks->after; 1292 | rwlocks->after++; 1293 | 1294 | pthread_mutex_unlock(&(rwlocks->mutex)); 1295 | 1296 | } 1297 | 1298 | 1299 | void thread_rwlock_rdlock(int *lock_id, int *info) { 1300 | *info = FT_OK; 1301 | 1302 | if (!is_initialized) { 1303 | *info = FT_EINIT; 1304 | return; 1305 | } 1306 | 1307 | if (!is_valid(rwlocks,*lock_id)) { 1308 | pthread_mutex_unlock(&(rwlocks->mutex)); 1309 | *info = FT_EINVALID; 1310 | return; 1311 | } 1312 | 1313 | *info = pthread_rwlock_rdlock((pthread_rwlock_t*)(rwlocks->data[*lock_id])); 1314 | 1315 | } 1316 | 1317 | void thread_rwlock_tryrdlock(int *lock_id, int *info) { 1318 | *info = FT_OK; 1319 | 1320 | if (!is_initialized) { 1321 | *info = FT_EINIT; 1322 | return; 1323 | } 1324 | 1325 | if (!is_valid(rwlocks,*lock_id)) { 1326 | pthread_mutex_unlock(&(rwlocks->mutex)); 1327 | *info = FT_EINVALID; 1328 | return; 1329 | } 1330 | 1331 | *info = pthread_rwlock_tryrdlock((pthread_rwlock_t*)(rwlocks->data[*lock_id])); 1332 | 1333 | } 1334 | 1335 | 1336 | void thread_rwlock_wrlock(int *lock_id, int *info) { 1337 | *info = FT_OK; 1338 | 1339 | if (!is_initialized) { 1340 | *info = FT_EINIT; 1341 | return; 1342 | } 1343 | 1344 | if (!is_valid(rwlocks,*lock_id)) { 1345 | pthread_mutex_unlock(&(rwlocks->mutex)); 1346 | *info = FT_EINVALID; 1347 | return; 1348 | } 1349 | 1350 | *info = pthread_rwlock_wrlock((pthread_rwlock_t*)(rwlocks->data[*lock_id])); 1351 | 1352 | } 1353 | 1354 | void thread_rwlock_trywrlock(int *lock_id, int *info) { 1355 | *info = FT_OK; 1356 | 1357 | if (!is_initialized) { 1358 | *info = FT_EINIT; 1359 | return; 1360 | } 1361 | 1362 | if (!is_valid(rwlocks,*lock_id)) { 1363 | pthread_mutex_unlock(&(rwlocks->mutex)); 1364 | *info = FT_EINVALID; 1365 | return; 1366 | } 1367 | 1368 | *info = pthread_rwlock_trywrlock((pthread_rwlock_t*)(rwlocks->data[*lock_id])); 1369 | 1370 | } 1371 | 1372 | void thread_rwlock_unlock(int *lock_id, int *info) { 1373 | *info = FT_OK; 1374 | 1375 | if (!is_initialized) { 1376 | *info = FT_EINIT; 1377 | return; 1378 | } 1379 | 1380 | if (!is_valid(rwlocks,*lock_id)) { 1381 | pthread_mutex_unlock(&(rwlocks->mutex)); 1382 | *info = FT_EINVALID; 1383 | return; 1384 | } 1385 | 1386 | *info = pthread_rwlock_unlock((pthread_rwlock_t*)(rwlocks->data[*lock_id])); 1387 | 1388 | } 1389 | 1390 | 1391 | #ifndef __DARWIN 1392 | /* 1393 | * An API change will be needed here to make calling from Fortran 1394 | * simpler. 1395 | */ 1396 | void thread_rwlock_timedrdlock(int *lock_id, struct timespec *abs_timeout, int *info) { 1397 | *info = FT_OK; 1398 | 1399 | 1400 | if (!is_initialized) { 1401 | *info = FT_EINIT; 1402 | return; 1403 | } 1404 | 1405 | if (!is_valid(rwlocks,*lock_id)) { 1406 | *info = FT_EINVALID; 1407 | return; 1408 | } 1409 | 1410 | *info = pthread_rwlock_timedrdlock((pthread_rwlock_t*)(rwlocks->data[*lock_id]), 1411 | abs_timeout); 1412 | 1413 | } 1414 | 1415 | /* 1416 | * An API change will be needed here to make calling from Fortran 1417 | * simpler. 1418 | */ 1419 | void thread_rwlock_timedwrlock(int *lock_id, struct timespec *abs_timeout, int *info) { 1420 | *info = FT_OK; 1421 | 1422 | 1423 | if (!is_initialized) { 1424 | *info = FT_EINIT; 1425 | return; 1426 | } 1427 | 1428 | if (!is_valid(rwlocks,*lock_id)) { 1429 | *info = FT_EINVALID; 1430 | return; 1431 | } 1432 | 1433 | *info = pthread_rwlock_timedwrlock((pthread_rwlock_t*)(rwlocks->data[*lock_id]), 1434 | abs_timeout); 1435 | 1436 | } 1437 | #endif 1438 | 1439 | 1440 | 1441 | 1442 | --------------------------------------------------------------------------------