1#! /usr/bin/env perl 2## 3## Copyright (C) by Argonne National Laboratory 4## See COPYRIGHT in top-level directory 5## 6 7use warnings; 8use strict; 9use Data::Dumper; 10 11# For a choice buffer arugment, usually it has two companion arguments (count, datatype) after it. 12# But this is not always true. So we have this table to store the info. An entry of the table is in 13# form of "func => pos". pos is a flattened array of triplet <buffer_idx, count_idx, datatype_idx>. 14# buffer_idx means the buffer_idx-th argument of func is a choice buffer; 15# count_idx means the count_idx-th arugment of func is the count argument for this choice buffer; 16# datatype_idx means the datatype_idx-th arugment of func is the datatype argument for this choice 17# buffer; Note these indices are 0-based. It is easy to see pos's size is a multiple of 3. 18# 19# For some choice buffers, they don't have the companion (count, datatype). We put special values 20# to their count_idx and datatype_idx. There are three cases here. 21# 22# 1. The buffer must be simply contiguous, such as that in MPI_Buffer_attach. 23# count_idx, datatype_idx are set to -1. 24# 2. The buffer share the same (count, datatype) with another buffer, such as sendbuf in MPI_Reduce. 25# Strictly speaking, we need to check at runtime the two buffers have the same shape and stride. 26# Currently, we just set count_idx and datatype_idx of the first choice buffer to -2. 27# 3. For some functions, such as MPI_Alltoallw, though MPI Standard doesn't say a choice buffer 28# arg must be simply contiguous, we don't support non-contiguous buffers there. Because generally 29# it is hard to implement it efficiently, and I don't see values of that. Please remember that 30# subarrays are meant to provide the programmer a convenient language construct with reasonable 31# overhead, not something that can hide the huge complexity of datatype creation but incurs a good 32# deal of overhead. If this complexity is needed, it shold be done by the programmer explicitly 33# but not implicitly done by the runtime. So we treat case 3 as case 1. We can checks to 34# enforce "simply contiguous". 35 36my %bufpos = ( 37 "MPI_Accumulate" => [0, 1, 2], 38 "MPI_Allgather" => [0, 1, 2, 3, 4, 5], 39 "MPI_Allgatherv" => [0, 1, 2, 3, -1, -1], 40 "MPI_Allreduce" => [0, -1, -1, 1, 2, 3], 41 "MPI_Alltoall" => [0, 1, 2, 3, 4, 5], 42 "MPI_Alltoallv" => [0, -1, -1, 4, -1, -1], 43 "MPI_Alltoallw" => [0, -1, -1, 4, -1, -1], 44 "MPI_Bcast" => [0, 1, 2], 45 "MPI_Bsend" => [0, 1, 2], 46 "MPI_Bsend_init" => [0, 1, 2], 47 "MPI_Buffer_attach" => [0, -1, -1], 48 "MPI_Compare_and_swap" =>[0, -1, -1, 1, -1, -1, 2, -1, -1], 49 "MPI_Exscan" => [0, -1, -1, 1, 2, 3], 50 "MPI_Fetch_and_op" => [0, -1, -1, 1, -1, -1], 51 "MPI_File_iread_at" => [2, 3, 4], 52 "MPI_File_iread" => [1, 2, 3], 53 "MPI_File_iread_shared" => [1, 2, 3], 54 "MPI_File_iwrite_at" => [2, 3, 4], 55 "MPI_File_iwrite" => [1, 2, 3], 56 "MPI_File_iwrite_shared" => [1, 2, 3], 57 "MPI_File_read_all_begin" => [1, 2, 3], 58 "MPI_File_read_all" => [1, 2, 3], 59 "MPI_File_read_all_end" => [1, -1, -1], 60 "MPI_File_read_at_all_begin" => [2, 3, 4], 61 "MPI_File_read_at_all" => [2, 3, 4], 62 "MPI_File_read_at_all_end" => [1, -1, -1], 63 "MPI_File_read_at" => [2, 3, 4], 64 "MPI_File_read" => [1, 2, 3], 65 "MPI_File_read_ordered_begin" => [1, 2, 3], 66 "MPI_File_read_ordered" => [1, 2, 3], 67 "MPI_File_read_ordered_end" => [1, -1, -1], 68 "MPI_File_read_shared" => [1, 2, 3], 69 "MPI_File_write_all_begin" => [1, 2, 3], 70 "MPI_File_write_all" => [1, 2, 3], 71 "MPI_File_write_all_end" => [1, -1, -1], 72 "MPI_File_write_at_all_begin" => [2, 3, 4], 73 "MPI_File_write_at_all" => [2, 3, 4], 74 "MPI_File_write_at_all_end" => [1, -1, -1], 75 "MPI_File_write_at" => [2, 3, 4], 76 "MPI_File_write" => [1, 2, 3], 77 "MPI_File_write_ordered_begin" => [1, 2, 3], 78 "MPI_File_write_ordered" => [1, 2, 3], 79 "MPI_File_write_ordered_end" => [1, -1, -1], 80 "MPI_File_write_shared" => [1, 2, 3], 81 "MPI_Free_mem" => [0, -1, -1], 82 "MPI_Gather" => [0, 1, 2, 3, 4, 5], 83 "MPI_Gatherv" => [0, 1, 2, 3, -1, -1], 84 "MPI_Get_accumulate" => [0, 1, 2, 3, -1, -1], 85 "MPI_Get_address" => [0, -1, -1], 86 "MPI_Get" => [0, 1, 2], 87 "MPI_Iallgather" => [0, 1, 2, 3, 4, 5], 88 "MPI_Iallgatherv" => [0, 1, 2, 3, -1, -1], 89 "MPI_Iallreduce" => [0, -2, -2, 1, 2, 3], 90 "MPI_Ialltoall" => [0, 1, 2, 3, 4, 5], 91 "MPI_Ialltoallv" => [0, -1, -1, 4, -1, -1], 92 "MPI_Ialltoallw" => [0, -1, -1, 4, -1, -1], 93 "MPI_Ibcast" => [0, 1, 2], 94 "MPI_Ibsend" => [0, 1, 2], 95 "MPI_Iexscan" => [0, -2, -2, 1, 2, 3], 96 "MPI_Igather" => [0, 1, 2, 3, 4, 5], 97 "MPI_Igatherv" => [0, 1, 2, 3, -1, -1], 98 "MPI_Imrecv" => [0, 1, 2], 99 "MPI_Ineighbor_allgather" => [0, 1, 2, 3, 4, 5], 100 "MPI_Ineighbor_allgatherv" => [0, 1, 2, 3, -1, -1], 101 "MPI_Ineighbor_alltoall" => [0, 1, 2, 3, 4, 5], 102 "MPI_Ineighbor_alltoallv" => [0, -1, -1, 4, -1, -1], 103 "MPI_Ineighbor_alltoallw" => [0, -1, -1, 4, -1, -1], 104 "MPI_Irecv" => [0, 1, 2], 105 "MPI_Ireduce" => [0, -2, -2, 1, 2, 3], 106 "MPI_Ireduce_scatter_block" => [0, -2, -2, 1, 2, 3], 107 "MPI_Ireduce_scatter" => [0, -2, -2, 1, -2, -2], 108 "MPI_Irsend" => [0, 1, 2], 109 "MPI_Iscan" => [0, -2, -2, 1, 2, 3], 110 "MPI_Iscatter" => [0, 1, 2, 3, 4, 5], 111 "MPI_Iscatterv" => [0, -1, -1, 4, -1, -1], 112 "MPI_Isend" => [0, 1, 2], 113 "MPI_Issend" => [0, 1, 2], 114 "MPI_Mrecv" => [0, 1, 2], 115 "MPI_Neighbor_allgather" => [0, 1, 2, 3, 4, 5], 116 "MPI_Neighbor_allgatherv" => [0, 1, 2, 3, -1, -1], 117 "MPI_Neighbor_alltoall" => [0, 1, 2, 3, 4, 5], 118 "MPI_Neighbor_alltoallv" => [0, -1, -1, 4, -1, -1], 119 "MPI_Neighbor_alltoallw" => [0, -1, -1, 4, -1, -1], 120 "MPI_Pack" => [0, 1, 2, 3, -1, -1], 121 "MPI_Pack_external" => [1, 2, 3, 4, -1, -1], 122 "MPI_Put" => [0, 1, 2], 123 "MPI_Raccumulate" => [0, 1, 2], 124 "MPI_Recv" => [0, 1, 2], 125 "MPI_Recv_init" => [0, 1, 2], 126 "MPI_Reduce" => [0, -2, -2, 1, 2, 3], 127 "MPI_Reduce_local" => [0, -2, -2, 1, 2, 3], 128 "MPI_Reduce_scatter_block" => [0, -2, -2, 1, 2, 3], 129 "MPI_Reduce_scatter" => [0, -2, -2, 1, -2, -2], 130 "MPI_Rget_accumulate" => [0, 1, 2, 3, 4, 5], 131 "MPI_Rget" => [0, 1, 2], 132 "MPI_Rput" => [0, 1, 2], 133 "MPI_Rsend" => [0, 1, 2], 134 "MPI_Rsend_init" => [0, 1, 2], 135 "MPI_Scan" => [0, -2, -2, 1, 2, 3], 136 "MPI_Scatter" => [0, 1, 2, 3, 4, 5], 137 "MPI_Scatterv" => [0, -1, -1, 4, -1, -1], 138 "MPI_Send" => [0, 1, 2], 139 "MPI_Send_init" => [0, 1, 2], 140 "MPI_Sendrecv" => [0, 1, 2, 5, 6, 7], 141 "MPI_Sendrecv_replace" => [0, 1, 2], 142 "MPI_Ssend" => [0, 1, 2], 143 "MPI_Ssend_init" => [0, 1, 2], 144 "MPI_Unpack" => [0, -1, -1, 3, 4, 5], 145 "MPI_Unpack_external" => [1, -1, -1, 4, 5, 6], 146 "MPI_Win_attach" => [1, -1, -1], 147 "MPI_Win_create" => [0, -1, -1], 148 "MPI_Win_detach" => [1, -1, -1], 149 "MPI_File_iread_all" => [1, 2, 3], 150 "MPI_File_iread_at_all" => [2, 3, 4], 151 "MPI_File_iwrite_all" => [1, 2, 3], 152 "MPI_File_iwrite_at_all" => [2, 3, 4] 153); 154 155# Choice buffers in some functions can be passed in MPI_IN_PLACE. We store such 156# info in this table. "func => idx" means the idx-th argument of func is a choice 157# buffer and can be passed in MPI_IN_PLACE. Here, idx starts from 0. Note that one 158# function can have at most one such argument. 159my %inplace = ( 160 "MPI_Allgather" => 0, 161 "MPI_Allgatherv" => 0, 162 "MPI_Allreduce" => 0, 163 "MPI_Alltoall" => 0, 164 "MPI_Alltoallv" => 0, 165 "MPI_Alltoallw" => 0, 166 "MPI_Exscan" => 0, 167 "MPI_Gather" => 0, 168 "MPI_Gatherv" => 0, 169 "MPI_Iallgather" => 0, 170 "MPI_Iallgatherv" => 0, 171 "MPI_Iallreduce" => 0, 172 "MPI_Ialltoall" => 0, 173 "MPI_Ialltoallv" => 0, 174 "MPI_Ialltoallw" => 0, 175 "MPI_Igather" => 0, 176 "MPI_Igatherv" => 0, 177 "MPI_Ireduce_scatter_block" => 0, 178 "MPI_Ireduce_scatter" => 0, 179 "MPI_Ireduce" => 0, 180 "MPI_Iscan" => 0, 181 "MPI_Iscatter" => 3, 182 "MPI_Iscatterv" => 4, 183 "MPI_Reduce_scatter" => 0, 184 "MPI_Reduce_scatter_block" => 0, 185 "MPI_Reduce" => 0, 186 "MPI_Scan" => 0, 187 "MPI_Scatter" => 3, 188 "MPI_Scatterv" => 4 189); 190 191# Some functions have a void* argument in C, but the argument is actually not 192# a choice buffer (i.e., of type assumed-type, assumed-rank). So we just skip 193# these functions in parsing. 194my @skipped_funcs_tmp = ( 195 "MPI_Address", 196 "MPI_Alloc_mem", 197 "MPI_Attr_get", 198 "MPI_Attr_put", 199 "MPI_DUP_FN", 200 "MPI_Grequest_start", 201 "MPI_Comm_create_keyval", 202 "MPI_Comm_set_attr", 203 "MPI_Comm_get_attr", 204 "MPI_Type_create_keyval", 205 "MPI_Type_set_attr", 206 "MPI_Type_get_attr", 207 "MPI_Win_create_keyval", 208 "MPI_Win_set_attr", 209 "MPI_Win_get_attr", 210 "MPI_Buffer_detach", 211 "MPI_Keyval_create", 212 "MPI_Register_datarep", 213 "MPI_Win_allocate", 214 "MPI_Win_allocate_shared", 215 "MPI_Win_shared_query" 216); 217 218my %skipped_funcs = map { $_ => 1 } @skipped_funcs_tmp; 219my $eol = 1; 220my $fullline = ""; 221my $tab = " "; 222my $retarg; 223my $routine; 224my $args; 225my @arglist; 226my $fname; 227my $cdesc_routine; 228my $x; 229my $y; 230my @argbits; 231my $num_dtypes; 232my @dtype_bind; 233my $io_header; 234my $make_exists = 0; 235 236# Check to make sure the file was passed in as a parameter 237if ($#ARGV != 0) { 238 print "Usage: buildiface <filename>\n"; 239 exit 1; 240} 241 242open(FD, $ARGV[0]) || die "Could not open file " . $ARGV[0]; 243 244while (<FD>) { 245 if (/\/\*\s*Begin Prototypes/) { last; } 246} 247 248# Check to see if this is mpio.h.in. If so, we have some more to do later 249if ($ARGV[0] =~ /mpio\.h\.in/) { 250 $io_header = 1; 251} else { 252 $io_header = 0; 253} 254 255if (-e "cdesc.h") { 256 open(CDESCH, ">>cdesc.h") || die "Could not open file cdesc.h"; 257} else { 258 open(CDESCH, ">cdesc.h") || die "Could not open file cdesc.h"; 259 print CDESCH <<EOT; 260/* 261 * Copyright (C) by Argonne National Laboratory 262 * See COPYRIGHT in top-level directory 263 * 264 * This file is automatically generated by buildiface 265 * DO NOT EDIT 266 */ 267 268#include <stdio.h> 269#include <stdlib.h> 270#include <ISO_Fortran_binding.h> 271#include <mpi.h> 272 273#ifndef HAVE_ROMIO 274#define MPIO_Request MPI_Request 275#endif 276 277extern MPI_Status *MPIR_C_MPI_STATUS_IGNORE; 278extern MPI_Status *MPIR_C_MPI_STATUSES_IGNORE; 279extern char **MPIR_C_MPI_ARGV_NULL; 280extern char ***MPIR_C_MPI_ARGVS_NULL; 281extern int *MPIR_C_MPI_ERRCODES_IGNORE; 282 283extern int cdesc_create_datatype(CFI_cdesc_t *cdesc, int oldcount, MPI_Datatype oldtype, MPI_Datatype *newtype); 284extern int MPIR_Fortran_array_of_string_f2c(const char* strs_f, char*** strs_c, int str_len, int know_size, int size); 285extern int MPIR_Comm_spawn_c(const char *command, char *argv_f, int maxprocs, MPI_Info info, int root, 286 MPI_Comm comm, MPI_Comm *intercomm, int* array_of_errcodes, int argv_elem_len); 287extern int MPIR_Comm_spawn_multiple_c(int count, char *array_of_commands_f, 288 char *array_of_argv_f, const int* array_of_maxprocs, 289 const MPI_Info *array_of_info, int root, MPI_Comm comm, 290 MPI_Comm *intercomm, int* array_of_errcodes, 291 int commands_elem_len, int argv_elem_len); 292extern int MPIR_F_sync_reg_cdesc(CFI_cdesc_t* buf); 293 294EOT 295} 296 297open(OUTFD, ">cdesc.c") || die "Could not open file cdesc.c"; 298print OUTFD <<EOT; 299/* 300 * Copyright (C) by Argonne National Laboratory 301 * See COPYRIGHT in top-level directory 302 * 303 * This file is automatically generated by buildiface 304 * DO NOT EDIT 305 */ 306 307#include "cdesc.h" 308 309MPI_Status *MPIR_C_MPI_STATUS_IGNORE = MPI_STATUS_IGNORE; 310MPI_Status *MPIR_C_MPI_STATUSES_IGNORE = MPI_STATUSES_IGNORE; 311char **MPIR_C_MPI_ARGV_NULL = MPI_ARGV_NULL; 312char ***MPIR_C_MPI_ARGVS_NULL = MPI_ARGVS_NULL; 313int *MPIR_C_MPI_ERRCODES_IGNORE = MPI_ERRCODES_IGNORE; 314 315/* Fortran 2008 specifies a maximum rank of 15 */ 316#define MAX_RANK (15) 317 318int cdesc_create_datatype(CFI_cdesc_t *cdesc, int oldcount, MPI_Datatype oldtype, MPI_Datatype *newtype) 319{ 320 MPI_Datatype types[MAX_RANK + 1]; /* Use a fixed size array to avoid malloc. + 1 for oldtype */ 321 int mpi_errno = MPI_SUCCESS; 322 int accum_elems = 1; 323 int accum_sm = cdesc->elem_len; 324 int done = 0; /* Have we created a datatype for oldcount of oldtype? */ 325 int last; /* Index of the last successfully created datatype in types[] */ 326 int extent; 327 int i, j; 328 329#ifdef HAVE_ERROR_CHECKING 330 { 331 int size; 332 MPIR_Assert(cdesc->rank <= MAX_RANK); 333 MPI_Type_size(oldtype, &size); 334 /* When cdesc->elem_len != size, things suddenly become complicated. Generally, it is hard to create 335 * a composite datatype based on two datatypes. Currently we don't support it and doubt it is usefull. 336 */ 337 MPIR_Assert(cdesc->elem_len == size); 338 } 339#endif 340 341 types[0] = oldtype; 342 i = 0; 343 done = 0; 344 while (i < cdesc->rank && !done) { 345 if (oldcount % accum_elems) { 346 /* oldcount should be a multiple of accum_elems, otherwise we might need an 347 * MPI indexed datatype to describle the irregular region, which is not supported yet. 348 */ 349 mpi_errno = MPI_ERR_INTERN; 350 last = 0; 351 goto fn_fail; 352 } 353 354 extent = oldcount / accum_elems; 355 if (extent > cdesc->dim[i].extent) { 356 extent = cdesc->dim[i].extent; 357 } else { 358 /* Up to now, we have accumlated enough elements */ 359 done = 1; 360 } 361 362 if (cdesc->dim[i].sm == accum_sm) { 363 mpi_errno = MPI_Type_contiguous(extent, types[i], &types[i+1]); 364 } else { 365 mpi_errno = MPI_Type_create_hvector(extent, 1, cdesc->dim[i].sm, types[i], &types[i+1]); 366 } 367 if (mpi_errno != MPI_SUCCESS) { 368 last = i; goto fn_fail; 369 } 370 371 mpi_errno = MPI_Type_commit(&types[i+1]); 372 if (mpi_errno != MPI_SUCCESS) { 373 last = i + 1; goto fn_fail; 374 } 375 376 accum_sm = cdesc->dim[i].sm * cdesc->dim[i].extent; 377 accum_elems *= cdesc->dim[i].extent; 378 i++; 379 } 380 381 if (done) { 382 *newtype = types[i]; 383 last = i - 1; /* To avoid freeing newtype */ 384 } else { 385 /* If # of elements given by "oldcount oldtype" is bigger than 386 * what cdesc describles, then we will reach here. 387 */ 388 last = i; 389 mpi_errno = MPI_ERR_ARG; 390 goto fn_fail; 391 } 392 393fn_exit: 394 for (j = 1; j <= last; j++) 395 MPI_Type_free(&types[j]); 396 return mpi_errno; 397fn_fail: 398 goto fn_exit; 399} 400EOT 401close OUTFD; 402 403unless (-e "Makefile.mk") { 404 open(MAKEFD, ">Makefile.mk") || die "Could not open Makefile.mk\n"; 405 print MAKEFD <<EOT; 406## DO NOT EDIT 407## This file created by buildiface 408 409# ensure that the buildiface script ends up in the release tarball 410EXTRA_DIST += src/binding/fortran/use_mpi_f08/wrappers_c/buildiface 411 412if BUILD_F08_BINDING 413mpi_fc_sources += \\ 414EOT 415} else { 416 open(MAKEFD, ">>Makefile.mk") || die "Could not open Makefile.mk\n"; 417 $make_exists = 1; 418} 419 420while (<FD>) { 421 if (/\/\*\s*End Prototypes/) { last; } 422 423 if (/\/\*\s*Begin Skip Prototypes/) { 424 while (<FD>) { 425 if (/\/\*\s*End Skip Prototypes/) { last; } 426 } 427 } 428 429 # Skip lines starting with # such as #ifdef or #endif 430 if (/^\s*#/) { next; } 431 432 # If we found a semi-colon at the end, that's the end of the line. 433 # This is not perfect (e.g., does not work when a single line has 434 # multiple semi-colon separated statements), but should be good 435 # enough for the MPICH mpi.h file 436 if (/.*;$/) { $eol = 1; } 437 else { $eol = 0; } 438 439 chomp($_); 440 $fullline .= "$_"; 441 if ($eol == 0) { next; } 442 443 # We got the entire prototype in a single line 444 445 # parse out comments 446 $fullline =~ s+/\*.*\*/++g; 447 448 # parse out attributes 449 $fullline =~ s/MPICH_ATTR_POINTER_WITH_TYPE_TAG\(.*\)//g; 450 $fullline =~ s/MPICH_API_PUBLIC//g; 451 # parse out unnecessary spaces 452 $fullline =~ s/^ *//g; 453 $fullline =~ s/ *$//g; 454 455 # split the line into the return type, routine name, and arguments 456 $fullline =~ m/([^ ]*) ([^(]*)\((.*)\)/; 457 $retarg = $1; 458 $routine = $2; 459 $args = $3; 460 461 # cleanup args 462 $args =~ s/\s\s*/ /g; 463 $args =~ s/^\s*//g; 464 $args =~ s/\s*$//g; 465 466 # Skip routines with void* (but not choice buffer) arguments 467 if (exists($skipped_funcs{$routine})) { 468 $fullline = ""; 469 next; 470 } 471 472 @arglist = split(/,/, $args); 473 474 if (grep/void\s*\*/, @arglist) { 475 $fname = "$routine"; 476 $fname =~ s/MPI_//g; 477 $fname =~ s/MPIX_//g; 478 $fname =~ tr/A-Z/a-z/; 479 $fname .= "_cdesc.c"; 480 481 print MAKEFD "\tsrc/binding/fortran/use_mpi_f08/wrappers_c/$fname \\\n"; 482 open(CFILE, ">$fname") || die "Could not open $fname\n"; 483 484 # replace MPI(X)_Foo with MPIR_Foo_cdesc 485 $cdesc_routine = $routine; 486 $cdesc_routine =~ s/MPI_/MPIR_/g; 487 $cdesc_routine =~ s/MPIX_/MPIR_/g; 488 $cdesc_routine .= "_cdesc"; 489 490 print CFILE <<EOT; 491/* 492 * Copyright (C) by Argonne National Laboratory 493 * See COPYRIGHT in top-level directory 494 * 495 * This file is automatically generated by buildiface 496 * DO NOT EDIT 497 */ 498 499#include "cdesc.h" 500EOT 501 print CFILE "\n$retarg $cdesc_routine("; 502 print CDESCH "extern $retarg $cdesc_routine("; 503 for ($x = 0; $x <= $#arglist; $x++) { 504 $arglist[$x] =~ s/^\s*//g; 505 $arglist[$x] =~ s/\s*$//g; 506 } 507 508 for ($x = 0; $x <= $#arglist; $x++) { 509 # remove variable names in arguments 510 @argbits = split(/ /, $arglist[$x]); 511 $arglist[$x] = ""; 512 for ($y = 0; $y <= $#argbits; $y++) { 513 $argbits[$y] =~ s/\*.*/*/g; 514 $argbits[$y] =~ s/[^ ]*\[\]/[]/g; 515 if ($y < $#argbits) { 516 $arglist[$x] .= "$argbits[$y] "; 517 } 518 else { 519 if ($argbits[$y] =~ /\[\]/ || $argbits[$y] =~ /\*/) { 520 $arglist[$x] .= "$argbits[$y] "; 521 } 522 else { 523 # reduce the array size by one to drop the last bit 524 $#argbits--; 525 } 526 } 527 } 528 # replace void* with CFI_cdesc_t* 529 if ($arglist[$x] =~ /.*void\s*\*/) { 530 $arglist[$x] = "CFI_cdesc_t*"; 531 } 532 533 @argbits = split(/ /, $arglist[$x]); 534 535 if ($x) { 536 print CFILE ", "; 537 print CDESCH ", "; 538 } 539 540 # print out all but the last bit of the argument 541 for ($y = 0; $y < $#argbits; $y++) { 542 print CFILE "$argbits[$y] "; 543 print CDESCH "$argbits[$y] "; 544 } 545 546 # deal with [] structures for the last bit 547 if ($argbits[$#argbits] =~ /\[\]/) { 548 print CFILE "x$x\[\]"; 549 print CDESCH "x$x\[\]"; 550 } 551 else { 552 print CFILE "$argbits[$#argbits] x$x"; 553 print CDESCH "$argbits[$#argbits] x$x"; 554 } 555 } 556 print CFILE ")\n{\n"; 557 print CDESCH ");\n"; 558 559 #================================================ 560 # Print body of the C wrapper function 561 #================================================ 562 print CFILE " int err = MPI_SUCCESS;\n"; 563 if ($io_header) { 564 print CFILE "#ifdef MPI_MODE_RDONLY\n" 565 } 566 567 if (!exists($bufpos{$routine})) { 568 die "Error: $routine has choice buffer(s) but is not defined in bufpos!\n"; 569 } 570 571 my @vec = @{$bufpos{$routine}}; # directly copy since @vec is small 572 573 # Temp variable declaration 574 for (my $i = 0; $i < $#vec; $i += 3) { 575 print CFILE " void *buf$vec[$i] = x$vec[$i]"."->base_addr;\n"; 576 if ($vec[$i + 1] >= 0) { 577 print CFILE " int count$vec[$i] = x$vec[$i+1];\n"; 578 print CFILE " MPI_Datatype dtype$vec[$i] = x$vec[$i+2];\n"; 579 } 580 } 581 print CFILE "\n"; 582 583 # Handle MPI_BOTTOM and MPI_IN_PLACE 584 for (my $i = 0; $i < $#vec; $i += 3) { 585 print CFILE " if (buf$vec[$i] == &MPIR_F08_MPI_BOTTOM) {\n"; 586 print CFILE " buf$vec[$i] = MPI_BOTTOM;\n"; 587 if (defined($inplace{$routine}) && $i == $inplace{$routine}) { 588 print CFILE " } else if (buf$vec[$i] == &MPIR_F08_MPI_IN_PLACE) {\n"; 589 print CFILE " buf$vec[$i] = MPI_IN_PLACE;\n"; 590 } 591 print CFILE " }\n\n"; 592 } 593 594 # Test if a subarray arg is contiguous. If it is, generate a new datatype for it. 595 for (my $i = 0; $i < $#vec; $i += 3) { 596 if ($vec[$i + 1] >= 0) { 597 print CFILE " if (x$vec[$i]"."->rank != 0 && !CFI_is_contiguous(x$vec[$i])) {\n"; 598 print CFILE " err = cdesc_create_datatype(x$vec[$i], x$vec[$i+1], x$vec[$i+2], &dtype$vec[$i]);\n"; 599 print CFILE " count$vec[$i] = 1;\n"; 600 print CFILE " }\n\n"; 601 } 602 } 603 604 # Print the function call with proper argument substitution. 605 print CFILE " err = $routine("; 606 for (my $i = 0; $i <= $#arglist; ) { 607 if ($i) { print CFILE ", "; } 608 if ($arglist[$i] =~ /CFI_cdesc_t\*/) { 609 my $j = 0; 610 while ($vec[$j] != $i) { $j++; } 611 if ($vec[$j + 1] >= 0) { 612 print CFILE "buf$i, count$i, dtype$i"; 613 $i += 3; 614 } else { 615 print CFILE "buf$i"; 616 $i++; 617 } 618 } else { 619 print CFILE "x$i"; 620 $i++; 621 } 622 } 623 print CFILE ");\n\n"; 624 625 # Free newly created datatypes if any 626 for (my $i = 0; $i < $#vec; $i += 3) { 627 if ($vec[$i + 1] >= 0) { 628 print CFILE " if (dtype$vec[$i] != x$vec[$i+2]) MPI_Type_free(&dtype$vec[$i]);\n"; 629 } 630 } 631 632 if ($io_header) { print CFILE "#else\n"; } 633 if ($io_header) { print CFILE " err = MPI_ERR_INTERN;\n"; } 634 if ($io_header) { print CFILE "#endif\n"; } 635 636 print CFILE " return err;\n"; 637 print CFILE "}\n"; 638 close CFILE; 639 } 640 $fullline = ""; 641} 642 643if ($make_exists) { 644 print MAKEFD "\tsrc/binding/fortran/use_mpi_f08/wrappers_c/cdesc.c \\\n"; 645 print MAKEFD "\tsrc/binding/fortran/use_mpi_f08/wrappers_c/comm_spawn_c.c \\\n"; 646 print MAKEFD "\tsrc/binding/fortran/use_mpi_f08/wrappers_c/comm_spawn_multiple_c.c \\\n"; 647 print MAKEFD "\tsrc/binding/fortran/use_mpi_f08/wrappers_c/f_sync_reg_c.c \\\n"; 648 print MAKEFD "\tsrc/binding/fortran/use_mpi_f08/wrappers_c/utils.c\n\n"; 649 print MAKEFD <<EOT; 650AM_CPPFLAGS += -I\${main_top_srcdir}/src/binding/fortran/use_mpi_f08/wrappers_c 651 652noinst_HEADERS += src/binding/fortran/use_mpi_f08/wrappers_c/cdesc.h 653 654endif BUILD_F08_BINDING 655EOT 656} 657 658close MAKEFD; 659close CDESCH; 660