Skip to content

Commit

Permalink
More Fortran functions
Browse files Browse the repository at this point in the history
  • Loading branch information
@eschnett
eschnett committed Nov 25, 2023
1 parent 1e1c897 commit b7df8ba
Show file tree
Hide file tree
Showing 9 changed files with 1,533 additions and 1,242 deletions.
4 changes: 0 additions & 4 deletions mpitrampoline/mpi_functions_fortran.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -194,10 +194,6 @@ void mpi_psend_init_(const void *buf, MPIABI_Fint *partitions, MPIABI_Count *cou

// A.3.3 Datatypes C Bindings

MPI_Aint mpi_aint_add_(MPIABI_Aint *base, MPIABI_Aint *disp) { return (*mpiabi_aint_add_ptr)(base, disp); }

MPI_Aint mpi_aint_diff_(MPIABI_Aint *addr1, MPIABI_Aint *addr2) { return (*mpiabi_aint_diff_ptr)(addr1, addr2); }

void mpi_get_address_(const void *location, MPIABI_Aint *address, MPIABI_Fint *ierror) { (*mpiabi_get_address_ptr)(location, address, ierror); }

void mpi_get_elements_(const MPIABI_Fint *status, MPIABI_Fint *datatype, MPIABI_Fint *count, MPIABI_Fint *ierror) { (*mpiabi_get_elements_ptr)(status, datatype, count, ierror); }
Expand Down
2 changes: 0 additions & 2 deletions mpitrampoline/mpiabi_function_pointers_fortran.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -102,8 +102,6 @@ void (*mpiabi_psend_init_ptr)(const void *buf, MPIABI_Fint *partitions, MPIABI_C

// A.3.3 Datatypes C Bindings

MPIABI_Aint (*mpiabi_aint_add_ptr)(MPIABI_Aint *base, MPIABI_Aint *disp);
MPIABI_Aint (*mpiabi_aint_diff_ptr)(MPIABI_Aint *addr1, MPIABI_Aint *addr2);
void (*mpiabi_get_address_ptr)(const void *location, MPIABI_Aint *address, MPIABI_Fint *ierror);
void (*mpiabi_get_elements_ptr)(const MPIABI_Fint *status, MPIABI_Fint *datatype, MPIABI_Fint *count, MPIABI_Fint *ierror);
// void (*mpiabi_get_elements_c_ptr)(const MPIABI_Fint *status, MPIABI_Fint *datatype, MPIABI_Count *count, MPIABI_Fint *ierror);
Expand Down
2 changes: 0 additions & 2 deletions mpitrampoline/mpiabi_function_pointers_fortran.h
View file
Original file line number Diff line number Diff line change
Expand Up @@ -105,8 +105,6 @@ extern void (*mpiabi_psend_init_ptr)(const void *buf, MPIABI_Fint *partitions, M

// A.3.3 Datatypes C Bindings

extern MPIABI_Aint (*mpiabi_aint_add_ptr)(MPIABI_Aint *base, MPIABI_Aint *disp);
extern MPIABI_Aint (*mpiabi_aint_diff_ptr)(MPIABI_Aint *addr1, MPIABI_Aint *addr2);
extern void (*mpiabi_get_address_ptr)(const void *location, MPIABI_Aint *address, MPIABI_Fint *ierror);
extern void (*mpiabi_get_elements_ptr)(const MPIABI_Fint *status, MPIABI_Fint *datatype, MPIABI_Fint *count, MPIABI_Fint *ierror);
// extern void (*mpiabi_get_elements_c_ptr)(const MPIABI_Fint *status, MPIABI_Fint *datatype, MPIABI_Count *count, MPIABI_Fint *ierror);
Expand Down
74 changes: 36 additions & 38 deletions mpitrampoline/set_mpiabi_function_pointers_fortran.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -48,46 +48,46 @@ mpiabi_recv_ptr = get_symbol(handle, "mpiabi_recv_");
mpiabi_recv_init_ptr = get_symbol(handle, "mpiabi_recv_init_");
// mpiabi_recv_init_c_ptr = get_symbol(handle, "mpiabi_recv_init_c_");
mpiabi_request_free_ptr = get_symbol(handle, "mpiabi_request_free_");
//TODO mpiabi_request_get_status_ptr = get_symbol(handle, "mpiabi_request_get_status_");
//TODO mpiabi_request_get_status_all_ptr = get_symbol(handle, "mpiabi_request_get_status_all_");
//TODO mpiabi_request_get_status_any_ptr = get_symbol(handle, "mpiabi_request_get_status_any_");
//TODO mpiabi_request_get_status_some_ptr = get_symbol(handle, "mpiabi_request_get_status_some_");
//TODO mpiabi_rsend_ptr = get_symbol(handle, "mpiabi_rsend_");
//TODO // mpiabi_rsend_c_ptr = get_symbol(handle, "mpiabi_rsend_c_");
//TODO mpiabi_rsend_init_ptr = get_symbol(handle, "mpiabi_rsend_init_");
//TODO // mpiabi_rsend_init_c_ptr = get_symbol(handle, "mpiabi_rsend_init_c_");
mpiabi_request_get_status_ptr = get_symbol(handle, "mpiabi_request_get_status_");
mpiabi_request_get_status_all_ptr = get_symbol(handle, "mpiabi_request_get_status_all_");
mpiabi_request_get_status_any_ptr = get_symbol(handle, "mpiabi_request_get_status_any_");
mpiabi_request_get_status_some_ptr = get_symbol(handle, "mpiabi_request_get_status_some_");
mpiabi_rsend_ptr = get_symbol(handle, "mpiabi_rsend_");
// mpiabi_rsend_c_ptr = get_symbol(handle, "mpiabi_rsend_c_");
mpiabi_rsend_init_ptr = get_symbol(handle, "mpiabi_rsend_init_");
// mpiabi_rsend_init_c_ptr = get_symbol(handle, "mpiabi_rsend_init_c_");
mpiabi_send_ptr = get_symbol(handle, "mpiabi_send_");
// mpiabi_send_c_ptr = get_symbol(handle, "mpiabi_send_c_");
mpiabi_send_init_ptr = get_symbol(handle, "mpiabi_send_init_");
// mpiabi_send_init_c_ptr = get_symbol(handle, "mpiabi_send_init_c_");
//TODO mpiabi_sendrecv_ptr = get_symbol(handle, "mpiabi_sendrecv_");
//TODO // mpiabi_sendrecv_c_ptr = get_symbol(handle, "mpiabi_sendrecv_c_");
//TODO mpiabi_sendrecv_replace_ptr = get_symbol(handle, "mpiabi_sendrecv_replace_");
//TODO // mpiabi_sendrecv_replace_c_ptr = get_symbol(handle, "mpiabi_sendrecv_replace_c_");
//TODO mpiabi_session_attach_buffer_ptr = get_symbol(handle, "mpiabi_session_attach_buffer_");
//TODO // mpiabi_session_attach_buffer_c_ptr = get_symbol(handle, "mpiabi_session_attach_buffer_c_");
//TODO mpiabi_session_detach_buffer_ptr = get_symbol(handle, "mpiabi_session_detach_buffer_");
//TODO // mpiabi_session_detach_buffer_c_ptr = get_symbol(handle, "mpiabi_session_detach_buffer_c_");
//TODO mpiabi_session_flush_buffer_ptr = get_symbol(handle, "mpiabi_session_flush_buffer_");
//TODO mpiabi_session_iflush_buffer_ptr = get_symbol(handle, "mpiabi_session_iflush_buffer_");
//TODO mpiabi_ssend_ptr = get_symbol(handle, "mpiabi_ssend_");
//TODO // mpiabi_ssend_c_ptr = get_symbol(handle, "mpiabi_ssend_c_");
//TODO mpiabi_ssend_init_ptr = get_symbol(handle, "mpiabi_ssend_init_");
//TODO // mpiabi_ssend_init_c_ptr = get_symbol(handle, "mpiabi_ssend_init_c_");
//TODO mpiabi_start_ptr = get_symbol(handle, "mpiabi_start_");
//TODO mpiabi_startall_ptr = get_symbol(handle, "mpiabi_startall_");
//TODO mpiabi_status_get_error_ptr = get_symbol(handle, "mpiabi_status_get_error_");
//TODO mpiabi_status_get_source_ptr = get_symbol(handle, "mpiabi_status_get_source_");
//TODO mpiabi_status_get_tag_ptr = get_symbol(handle, "mpiabi_status_get_tag_");
//TODO mpiabi_test_ptr = get_symbol(handle, "mpiabi_test_");
//TODO mpiabi_test_cancelled_ptr = get_symbol(handle, "mpiabi_test_cancelled_");
//TODO mpiabi_testall_ptr = get_symbol(handle, "mpiabi_testall_");
//TODO mpiabi_testany_ptr = get_symbol(handle, "mpiabi_testany_");
//TODO mpiabi_testsome_ptr = get_symbol(handle, "mpiabi_testsome_");
//TODO mpiabi_wait_ptr = get_symbol(handle, "mpiabi_wait_");
//TODO mpiabi_waitall_ptr = get_symbol(handle, "mpiabi_waitall_");
//TODO mpiabi_waitany_ptr = get_symbol(handle, "mpiabi_waitany_");
//TODO mpiabi_waitsome_ptr = get_symbol(handle, "mpiabi_waitsome_");
mpiabi_sendrecv_ptr = get_symbol(handle, "mpiabi_sendrecv_");
// mpiabi_sendrecv_c_ptr = get_symbol(handle, "mpiabi_sendrecv_c_");
mpiabi_sendrecv_replace_ptr = get_symbol(handle, "mpiabi_sendrecv_replace_");
// mpiabi_sendrecv_replace_c_ptr = get_symbol(handle, "mpiabi_sendrecv_replace_c_");
mpiabi_session_attach_buffer_ptr = get_symbol(handle, "mpiabi_session_attach_buffer_");
// mpiabi_session_attach_buffer_c_ptr = get_symbol(handle, "mpiabi_session_attach_buffer_c_");
mpiabi_session_detach_buffer_ptr = get_symbol(handle, "mpiabi_session_detach_buffer_");
// mpiabi_session_detach_buffer_c_ptr = get_symbol(handle, "mpiabi_session_detach_buffer_c_");
mpiabi_session_flush_buffer_ptr = get_symbol(handle, "mpiabi_session_flush_buffer_");
mpiabi_session_iflush_buffer_ptr = get_symbol(handle, "mpiabi_session_iflush_buffer_");
mpiabi_ssend_ptr = get_symbol(handle, "mpiabi_ssend_");
// mpiabi_ssend_c_ptr = get_symbol(handle, "mpiabi_ssend_c_");
mpiabi_ssend_init_ptr = get_symbol(handle, "mpiabi_ssend_init_");
// mpiabi_ssend_init_c_ptr = get_symbol(handle, "mpiabi_ssend_init_c_");
mpiabi_start_ptr = get_symbol(handle, "mpiabi_start_");
mpiabi_startall_ptr = get_symbol(handle, "mpiabi_startall_");
mpiabi_status_get_error_ptr = get_symbol(handle, "mpiabi_status_get_error_");
mpiabi_status_get_source_ptr = get_symbol(handle, "mpiabi_status_get_source_");
mpiabi_status_get_tag_ptr = get_symbol(handle, "mpiabi_status_get_tag_");
mpiabi_test_ptr = get_symbol(handle, "mpiabi_test_");
mpiabi_test_cancelled_ptr = get_symbol(handle, "mpiabi_test_cancelled_");
mpiabi_testall_ptr = get_symbol(handle, "mpiabi_testall_");
mpiabi_testany_ptr = get_symbol(handle, "mpiabi_testany_");
mpiabi_testsome_ptr = get_symbol(handle, "mpiabi_testsome_");
mpiabi_wait_ptr = get_symbol(handle, "mpiabi_wait_");
mpiabi_waitall_ptr = get_symbol(handle, "mpiabi_waitall_");
mpiabi_waitany_ptr = get_symbol(handle, "mpiabi_waitany_");
mpiabi_waitsome_ptr = get_symbol(handle, "mpiabi_waitsome_");

// A.3.2 Partitioned Communication C Bindings

Expand All @@ -100,8 +100,6 @@ mpiabi_send_init_ptr = get_symbol(handle, "mpiabi_send_init_");

// A.3.3 Datatypes C Bindings

//TODO mpiabi_aint_add_ptr = get_symbol(handle, "mpiabi_aint_add_");
//TODO mpiabi_aint_diff_ptr = get_symbol(handle, "mpiabi_aint_diff_");
//TODO mpiabi_get_address_ptr = get_symbol(handle, "mpiabi_get_address_");
//TODO mpiabi_get_elements_ptr = get_symbol(handle, "mpiabi_get_elements_");
//TODO // mpiabi_get_elements_c_ptr = get_symbol(handle, "mpiabi_get_elements_c_");
Expand Down
14 changes: 14 additions & 0 deletions mpiwrapper/mpiwrapper-mpi3.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,6 +4,8 @@

// Fake MPI 4 support, just enough to make the linker happy

// C functions

void MPI_Accumulate_c() { assert(0); }
void MPI_Allgather_c() { assert(0); }
void MPI_Allgather_init_c() { assert(0); }
Expand Down Expand Up @@ -182,11 +184,23 @@ void MPI_File_write_ordered_c() { assert(0); }
void MPI_File_write_shared_c() { assert(0); }
void MPI_Register_datarep_c() { assert(0); }

// Fortran functions

void mpi_buffer_flush_() { assert(0); }
void mpi_buffer_iflush_() { assert(0); }
void mpi_comm_attach_buffer_() { assert(0); }
void mpi_comm_detach_buffer_() { assert(0); }
void mpi_comm_flush_buffer_() { assert(0); }
void mpi_comm_iflush_buffer_() { assert(0); }
void mpi_request_get_status_all_() { assert(0); }
void mpi_request_get_status_any_() { assert(0); }
void mpi_request_get_status_some_() { assert(0); }
void mpi_session_attach_buffer_() { assert(0); }
void mpi_session_detach_buffer_() { assert(0); }
void mpi_session_flush_buffer_() { assert(0); }
void mpi_session_iflush_buffer_() { assert(0); }
void mpi_status_get_error_() { assert(0); }
void mpi_status_get_source_() { assert(0); }
void mpi_status_get_tag_() { assert(0); }

#endif
59 changes: 48 additions & 11 deletions mpiwrapper/mpiwrapper.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,12 +10,16 @@ module mpiwrapper

subroutine assert(cond)
logical, intent(in) :: cond
if (.not.cond) stop
integer ierror
if (cond) return
write(0, '("Assertion failure")')
call MPI_Abort(MPI_COMM_SELF, 1, ierror)
stop
end subroutine assert

! Translate (non-handle) integers

integer function mpi2abi_errorcode(ierror)
elemental integer function mpi2abi_errorcode(ierror)
integer, intent(in) :: ierror
! Fast path
if (ierror == MPI_SUCCESS) then
Expand All @@ -42,7 +46,20 @@ integer function abi2mpi_proc(proc)
end select
end function abi2mpi_proc

integer function abi2mpi_root(root)
integer function mpi2abi_proc(proc)
integer, intent(in) :: proc
select case (proc)
case (MPI_ANY_SOURCE)
mpi2abi_proc = MPIABI_ANY_SOURCE
case (MPI_PROC_NULL)
mpi2abi_proc = MPIABI_PROC_NULL
case default
call assert(proc >= 0)
mpi2abi_proc = proc
end select
end function mpi2abi_proc

elemental integer function abi2mpi_root(root)
integer, intent(in) :: root
select case (root)
case (MPIABI_ROOT)
Expand All @@ -52,7 +69,7 @@ integer function abi2mpi_root(root)
end select
end function abi2mpi_root

integer function abi2mpi_source(source)
elemental integer function abi2mpi_source(source)
integer, intent(in) :: source
select case (source)
case (MPIABI_ANY_SOURCE)
Expand All @@ -62,7 +79,7 @@ integer function abi2mpi_source(source)
end select
end function abi2mpi_source

integer function abi2mpi_tag(tag)
elemental integer function abi2mpi_tag(tag)
integer, intent(in) ::tag
select case (tag)
case (MPIABI_ANY_TAG)
Expand All @@ -72,6 +89,16 @@ integer function abi2mpi_tag(tag)
end select
end function abi2mpi_tag

elemental integer function mpi2abi_tag(tag)
integer, intent(in) ::tag
select case (tag)
case (MPI_ANY_TAG)
mpi2abi_tag = MPIABI_ANY_TAG
case default
mpi2abi_tag = tag
end select
end function mpi2abi_tag

integer function abi2mpi_threadlevel(threadlevel)
integer, intent(in) ::threadlevel
select case (threadlevel)
Expand Down Expand Up @@ -110,7 +137,7 @@ end function mpi2abi_buffer_ptr

! Translate handles

integer function abi2mpi_comm(comm)
elemental integer function abi2mpi_comm(comm)
integer, intent(in) :: comm
select case (comm)
case (MPIABI_COMM_NULL)
Expand All @@ -124,7 +151,7 @@ integer function abi2mpi_comm(comm)
end select
end function abi2mpi_comm

integer function abi2mpi_datatype(datatype)
elemental integer function abi2mpi_datatype(datatype)
integer, intent(in) :: datatype
select case (datatype)
case (MPIABI_DATATYPE_NULL)
Expand All @@ -137,7 +164,7 @@ integer function abi2mpi_datatype(datatype)
end select
end function abi2mpi_datatype

integer function abi2mpi_info(info)
elemental integer function abi2mpi_info(info)
integer, intent(in) :: info
select case (info)
case (MPIABI_INFO_ENV)
Expand All @@ -149,7 +176,7 @@ integer function abi2mpi_info(info)
end select
end function abi2mpi_info

integer function abi2mpi_message(message)
elemental integer function abi2mpi_message(message)
integer, intent(in) :: message
select case (message)
case (MPIABI_MESSAGE_NO_PROC)
Expand All @@ -161,7 +188,7 @@ integer function abi2mpi_message(message)
end select
end function abi2mpi_message

integer function abi2mpi_request(request)
elemental integer function abi2mpi_request(request)
integer, intent(in) :: request
if (request == MPI_REQUEST_NULL) then
abi2mpi_request = MPIABI_REQUEST_NULL
Expand All @@ -170,7 +197,7 @@ integer function abi2mpi_request(request)
abi2mpi_request = request
end function abi2mpi_request

integer function mpi2abi_request(request)
elemental integer function mpi2abi_request(request)
integer, intent(in) :: request
if (request == MPIABI_REQUEST_NULL) then
mpi2abi_request = MPI_REQUEST_NULL
Expand All @@ -179,6 +206,16 @@ integer function mpi2abi_request(request)
mpi2abi_request = request
end function mpi2abi_request

elemental integer function abi2mpi_session(session)
integer, intent(in) :: session
select case (session)
case (MPIABI_SESSION_NULL)
abi2mpi_session = MPI_SESSION_NULL
case default
abi2mpi_session = session
end select
end function abi2mpi_session

! Translate statuses

subroutine abi2mpi_status(abi_status, mpi_status)
Expand Down
Loading

0 comments on commit b7df8ba

Please sign in to comment.