1#! /usr/bin/env perl 2## 3## Copyright (C) by Argonne National Laboratory 4## See COPYRIGHT in top-level directory 5## 6 7# This file builds candidate interface files from the descriptions in 8# mpi.h 9# 10# Here are the steps: 11# 1) Find the prototypes in mpi.h.in (Look for *Begin Prototypes*) 12# 2) For each function, match the name and args: 13# int MPI_xxxx( ... ) 14# 3) By groups, create a new file with the name {catname}.h containing 15# Copyright 16# For each function in the group, the expansion of the method 17# 18# Each MPI routine is assigned to a group. Within each group, 19# a particular argument is (usually) eliminated from the C++ call. 20# E.g., in MPI::Send, the communicator argument is removed from the 21# call sequence. 22# Routines that have out parameters (e.g., the request in MPI_Isend) 23# remove them as well. Other routines return void. 24# 25# The replacement text will look something like 26# void Name( args ) const { 27# MPIX_CALLOBJ( obj, MPI_Name( args, with (cast)((class).the_real_(class)) ); } 28# (there is also a CALLREF for calls with a reference to an object and CALLWORLD 29# to use the error handler on COMM_WORLD). 30# 31# If coverage analysis is desired, consider using the -coverage 32# switch. This (will, once done) allow generating crude coverage data. 33# We'd prefer to use gcov, but gcov aborts (!) when used on the data 34# generated by the g++. The coverage switch changes the replacement text 35# to something like 36# void Name( args ) const { 37# COVERAGE_ENTER(Name,argcount); 38# MPIX_Call .... 39# COVERAGE_EXIT(Name,argcount); } 40# The COVERAGE_ENTER and EXIT can be used as macros to invoke code to keep 41# track of each entry and exit. The argcount is the number of parameters, 42# and can be used to distinquish between routines with the same name but 43# different number of arguments. 44# 45# (const applies only if the function does not modify its object (e.g., 46# get_name may be const but set_name must not be.) 47# 48# A capability of this approach is that a stripped-down interface that 49# implements only the required routines can be created. 50# 51# Data structures 52# %<class>_members (e.g., mpi1comm): keys are names of routines. 53# Values are string indicating processing: 54# returnvalue-arg (0 if void, type if unique, position if not) 55# Pass by reference to process routine 56# 57# Notes: 58# "NULL" isn't the rigth way to specify a NULL pointer in C++; use "0" (this 59# will have the correct type and some C++ compilers don't recognize NULL 60# unless you include header files that needed it and are otherwise unneeded 61# by the C++ interface) 62# 63# To fix the order of virtual methods, the arrays 64# @routinesMpi1base 65# @routinesMpi2base 66# @routines<classname> 67# may be defined. If these are not defined, then the order will be determined 68# by the perl implementation of the "keys" function. 69# 70# TODO: 71# The derived classes (such as Intracomm) must *not* have their own 72# protected the_real_intracomm; instead, the must refer to the 73# parent class's private storage. - DONE 74# 75# The pack, unpack, packsize, init, and finalize routines must be 76# placed in initcpp.cpp. - DONE 77# 78# externs for the predefined objects need to be added to the 79# end of mpicxx.h - DONE 80# 81# The optional no-status versions need to be created for 82# methods such as Recv, Test, and Sendrecv . - DONE 83# 84# Setup global variables 85$build_io = 1; # If false, exclude the MPI-IO routines 86$oldSeek = 0; # Use old code for seek_set etc. 87$indent = " "; 88$print_line_len = 0; 89$gDebug = 0; 90$gDebugRoutine = "NONE"; 91@mpilevels = ( 'mpi1' , 'mpi2', 'post' ); 92# feature variables (for the -feature commandline option) 93$do_subdecls = 1; 94 95# Other features 96$doCoverage = 0; 97$doFuncspec = 1; 98$do_DistGraphComm = 0; 99$outputRoutineLists = 0; 100 101# Process environment variables 102# CXX_COVERAGE - yes : turn on coverage code 103if (defined($ENV{"CXX_COVERAGE"}) && $ENV{"CXX_COVERAGE"} eq "yes") { 104 setCoverage(1); 105} 106 107# Process arguments 108# 109# Args 110# -feature={subdecls}, separated by :, value given 111# by =on or =off, eg 112# -feature=subdecls=on:fint=off 113# The feature names mean: 114# subdecls - Declarations for PC-C++ compilers added 115# -routines=name - provide a list of routines or a file that 116# lists the routines to use. The names must be in the same form as the 117# the class_xxx variables. E.g., comm-Send, dtype-Commit. 118# -routinelist - output files containing the routines to output in the 119# classes (mostly as virtual functions) and the order in which they are output 120# This can be used to change the output order if it is desired to specify 121# a particular order. 122$routine_list = ""; 123$initFile = ""; 124foreach $_ (@ARGV) { 125 if (/--?feature=(.*)/) { 126 foreach $feature (split(/:/,$1)) { 127 print "Processing feature $feature\n" if $gDebug; 128 # Feature values are foo=on,off 129 ($name,$value) = split(/=/,$feature); 130 if ($value eq "on") { $value = 1; } 131 elsif ($value eq "off") { $value = 0; } 132 # Set the variable based on the string 133 $varname = "do_$name"; 134 if (!defined($$varname)) { 135 die "Feature $name is unknown!\n"; 136 } 137 $$varname = $value; 138 } 139 } 140 elsif (/--?nosep/ || /--?sep/) { ; } # Old argument; ignore 141 elsif (/--?noromio/) { $build_io = 0; } 142 elsif (/--?oldseek/) { $oldSeek = 1; } 143 elsif (/--?newseek/) { $oldSeek = 0; } 144 elsif (/--?debug=(.*)/) { 145 $gDebug = 0; 146 $gDebugRoutine = $1; 147 } 148 elsif (/--?debug/) { $gDebug = 1; } 149 elsif (/--?routines=(.*)/) { 150 $routine_list = $1; 151 } 152 elsif (/--?routinelist/) { $outputRoutineLists = 1; } 153 elsif (/--?initfile=(.*)/) { $initFile = $1; } 154 elsif (/--?coverage/) { &setCoverage( 1 ); } 155 elsif (/--?nocoverage/) { &setCoverage( 0 ); } 156 else { 157 print STDERR "Unrecognized argument $_\n"; 158 } 159} 160 161if (! -d "../../mpi/romio") { $build_io = 0; } 162 163if ($initFile ne "" && -f $initFile) { 164 do $initFile; 165} 166# ---------------------------------------------------------------------------- 167# 168# The following hashes define each of the methods that belongs to each class. 169# To allow us to differentiate between MPI-1 and MPI-2, the methods for 170# are separated. The hash names have the form 171# class_mpi<1 or 2><short classname> 172# The value of each key is the POSITION (from 1) of the return argument 173# if an integer is used or the MPI-1 type (e.g., MPI_Request) if a string is 174# used. The position form is normally used to return an int or other value 175# whose type does not give an unambiguous argument. A value of 0 indicates 176# that the routine does not return a value. 177# Value of the hash is the argument of the routine that returns a value 178# ToDo: 179# Add to the value of each routine any special instructions on 180# processing the arguments. See the Fortran version of buildiface. 181# Needed are: 182# in:array, out:array - Convert array of class members to/from 183# arrays of the_real_xxx. Question: for 184# simplicity, should we have just in:reqarray, 185# inout:reqarray, out:reqarray? Answer: the 186# current approach uses separate routines for 187# each array type. 188# in:const - Add const in the C++ declaration (e.g., 189# in send, make the buf const void * instead 190# of just void *) 191# in:bool,out:bool - Convert value from bool to/from int 192# 193# We'll indicate these with to fields returnvalue:argnum:... 194# For each method with special processing for an arg, there is 195# methodname-argnum. 196# Eg, Isend is 197# Isend => 'MPI_Request:1', Isend-1 => 'in:const' 198# and Send is 199# Send => '0:1', Send-1 => 'in:const' 200# The mappings for the arguments are kept in a 201# separate hash, %funcArgMap. 202# 203%class_mpi1comm = ( Send => '0:1', Recv => 0, 204 Bsend => '0:1', Ssend => '0:1', 205 Rsend => '0:1', Isend => 'MPI_Request:1', 206 Irsend => 'MPI_Request:1', Issend => 'MPI_Request:1', 207 Ibsend => 'MPI_Request:1', Irecv => MPI_Request, 208 Iprobe => 'int;bool', Probe => 0, 209 Send_init => 'MPI_Request:1', 210 Ssend_init => 'MPI_Request:1', 211 Bsend_init => 'MPI_Request:1', 212 Rsend_init => 'MPI_Request:1', Recv_init => MPI_Request, 213 Sendrecv => 0, Sendrecv_replace => 0, Get_size => 'int', 214 Get_rank => 'int', Free => 0, Get_topology => 2, 215 Get_group => MPI_Group, 216 Compare => 'static:int', 217 Abort => 0, 218 Set_errhandler => 0, 219 Get_errhandler => MPI_Errhandler, 220 Is_inter => '2;bool', 221 ); 222%funcArgMap = ( 223 'Send-1' => 'in:const', 224 'Bsend-1' => 'in:const', 225 'Rsend-1' => 'in:const', 226 'Ssend-1' => 'in:const', 227 'Irsend-1' => 'in:const', 228 'Isend-1' => 'in:const', 229 'Ibsend-1' => 'in:const', 230 'Issend-1' => 'in:const', 231 'Send_init-1' => 'in:const', 232 'Ssend_init-1' => 'in:const', 233 'Bsend_init-1' => 'in:const', 234 'Rsend_init-1' => 'in:const', 235 236 'Free_keyval-1' => 'in:refint', 237 238 'Waitany-2' => 'inout:reqarray:1', 239 'Waitsome-2' => 'inout:reqarray:1', 240 'Waitsome-5' => 'out:statusarray:1', # or 4? 241 'Waitall-2' => 'inout:reqarray:1', 242 'Waitall-3' => 'out:statusarray:1', 243 'Testany-2' => 'inout:reqarray:1', 244 'Testany-3' => 'in:refint', 245 'Testsome-2' => 'inout:reqarray:1', 246 'Testsome-5' => 'out:statusarray:1', # or 4? 247 'Testall-2' => 'inout:reqarray:1', 248 'Testall-4' => 'out:statusarray:1', 249 'Startall-2' => 'inout:preqarray:1', 250 'Pack-1' => 'in:const', 251 'Unpack-1' => 'in:const', 252 'Pack-6' => 'in:refint', 253 'Unpack-5' => 'in:refint', 254 255 'Get_error_string-3' => 'in:refint', 256 'Create_struct-4' => 'in:dtypearray:1', 257 258 'Merge-2' => 'in:bool', 259 'Create_cart-4' => 'in:boolarray:2', 260 'Create_cart-5' => 'in:bool', 261 'Create_graph-5' => 'in:bool', 262# Because there are multiple versions of the Distgraph create routines, 263# to allow for the optional weights, 264# we don't use the automatic method to create them. Thus, there are 265# no entries for Dist_graph_create, Dist_graph_create_adjacent, or 266# Dist_graph_neighrbors_count 267 'cart-Get_topo-4' => 'out:boolarray:2', 268 'Sub-2' => 'in:boolarray:-10', # Use -10 for immediate number 269 'Shift-4' => 'in:refint', 270 'Shift-5' => 'in:refint', 271 # Bug - there are cartcomm map and graphcomm map. The 272 # call routine will find this 273 'cart-Map-4' => 'in:boolarray:2', 274 275 'Get_processor_name-2' => 'in:refint', 276 277 'info-Set-2' => 'in:const', 278 'info-Set-3' => 'in:const', 279 'info-Get-2' => 'in:const', 280 'Get_valuelen-2' => 'in:const', 281 282 'file-Open-2' => 'in:const', 283 'file-Delete-1' => 'in:const', 284 'Set_view-4' => 'in:const', 285 'Write-2' => 'in:const', 286 'Write_all-2' => 'in:const', 287 'Iwrite_at-2' => 'in:const', 288 'Iwrite-2' => 'in:const', 289 'Write_at-3' => 'in:const', 290 'Write_at_all-3' => 'in:const', 291 'Write_at_all_begin-3' => 'in:const', 292 'Write_at_all_end-2' => 'in:const', 293 'Write_all_begin-2' => 'in:const', 294 'Write_all_end-2' => 'in:const', 295 'Write_ordered_begin-2' => 'in:const', 296 'Write_ordered_end-2' => 'in:const', 297 'Write_ordered-2' => 'in:const', 298 'Write_shared-2' => 'in:const', 299 'Set_atomicity-2' => 'in:bool', 300 301 'Put-1' => 'in:const', 302 'Accumulate-1' => 'in:const', 303 'Alloc_mem-2' => 'in:constref:Info', 304 305 'Detach_buffer-1' => 'inout:ptrref', 306 'Get_version-1' => 'in:refint', 307 'Get_version-2' => 'in:refint', 308 'Get_name-3' => 'in:refint', 309 'Set_name-2' => 'in:const', 310 'Add_error_string-2' => 'in:const', 311 ); 312%class_mpi1cart = ( 'Dup' => MPI_Comm, 313 'Get_dim' => 'int', 314 'Get_topo' => '0:4', 315 'Get_cart_rank' => '3', 316 'Get_coords' => 0, 317 'Shift' => '0:4:5', 318 'Sub' => 'MPI_Comm:2', 319 'Map' => '5:4', 320); 321$specialReturnType{"cart-Dup"} = "Cartcomm"; 322$specialReturnType{"cart-Sub"} = "Cartcomm"; 323$specialReturnType{"cart-Split"} = "Cartcomm"; 324 325# Pack, and Unpack are handled through definitions elsewhere 326# Create_struct is also handled through definitions elsewhere, but for 327# compatibility with some previous versions, a slightly different 328# declaration is generated for this class. 329%class_mpi1dtype = ( 'Create_contiguous' => 'MPI_Datatype', 330 'Create_vector' => 'MPI_Datatype', 331 'Create_indexed' => 'MPI_Datatype', 332 'Create_struct' => 'static:5:4', 333 'Get_size' => 2, 334 'Commit' => 0, 335 'Free' => 0, 336# 'Pack' => '0:1:6', 337# 'Unpack' => '0:1:5', 338 'Pack_size' => 4, 339 ); 340%class_mpi1errh = ( 'Free' => 0, 341 # Init missing 342 ); 343%class_mpi1graph = ( 'Get_dims' => 0, 344 'Get_topo' => 0, 345 'Get_neighbors_count' => 'int', 346 'Get_neighbors' => 0, 347 'Map' => 5, 348 ); 349$specialReturnType{"graph-Dup"} = "Graphcomm"; 350$specialReturnType{"graph-Split"} = "Graphcomm"; 351if ($do_DistGraphComm) { 352 $specialReturnType{"distgraph-Dup"} = "Distgraphcomm"; 353 $specialReturnType{"distgraph-Split"} = "Distgraphcomm"; 354} 355 356# Range routines will require special handling 357# The Translate_ranks, Union, Intersect, Difference, and Compare routines are 358# static and don't work on an instance of a group 359%class_mpi1group = ( 'Get_size' => 'int', 360 'Get_rank' => 'int', 361 'Translate_ranks' => 'static:0', 362 'Compare' => 'static:int', 363 'Union' => 'static:MPI_Group', 364 'Intersect' => 'static:MPI_Group', 365 'Difference' => 'static:MPI_Group', 366 'Incl', MPI_Group, 367 'Excl', MPI_Group, 368 'Range_incl', MPI_Group, 369 'Range_excl', MPI_Group, 370 'Free' => 0, 371); 372%class_mpi1inter = ( 'Dup' => MPI_Comm, 373 'Get_remote_size' => 'int', 374 'Get_remote_group' => MPI_Group, 375 'Merge' => 'MPI_Comm:2', 376 ); 377$specialReturnType{"inter-Dup"} = "Intercomm"; 378$specialReturnType{"inter-Split"} = "Intercomm"; 379 380%class_mpi1intra = ( #'Barrier' => 0, 381 #'Bcast' => 0, 382 #'Gather' => 0, 383 #'Gatherv' => 0, 384 #'Scatter' => 0, 385 #'Scatterv' => 0, 386 #'Allgather' => 0, 387 #'Allgatherv' => 0, 388 #'Alltoall' => 0, 389 #'Alltoallv' => 0, 390 #'Reduce' => 0, 391 #'Allreduce' => 0, 392 #'Reduce_scatter' => 0, 393 'Scan' => 0, 394 'Dup' => MPI_Comm, 395 'Create' => MPI_Comm, 396 'Split' => MPI_Comm, 397 'Create_intercomm' => MPI_Comm, 398 'Create_cart' => 'MPI_Comm:4:5', 399 'Create_graph' => 'MPI_Comm:5', 400# Because the Dist_graph_create and Dist_graph_create_adjacent routines 401# have two signatures, their definitions are handled as a special case 402); 403$specialReturnType{"intra-Split"} = "Intracomm"; 404$specialReturnType{"intra-Create"} = "Intracomm"; 405$specialReturnType{"intra-Dup"} = "Intracomm"; 406 407%class_mpi1op = ( 'Free' => 0); 408%class_mpi1preq = ( 'Start' => 0, 409 'Startall' => 'static:0:2' ); 410%class_mpi1req = ( 'Wait' => 0, 411 'Test' => 'int;bool', 412 'Free' => 0, 413 'Cancel' => 0, 414 'Waitall' => 'static:0:2:3', 415 'Waitany' => 'static:int:2', 416 'Waitsome' => 'static:3:2:5', 417 'Testall' => 'static:int;bool:2:4', 418 'Testany' => 'static:4;bool:2:3:4', 419 'Testsome' => 'static:3:2:5', 420); 421%class_mpi1st = ( 'Get_count' => 'int', 422 'Is_cancelled' => 'int;bool', 423 'Get_elements' => 'int', 424 # get/set source, tag, error have no C binding 425 ); 426 427# These are the routines that are in no class, minus the few that require 428# special handling (Init, Wtime, and Wtick). 429%class_mpi1base = ( 'Get_processor_name' => '0:2', 430 'Get_error_string' => '0:3', 431 'Get_error_class', => '2', 432 'Compute_dims' => 0, 433 'Finalize' => 0, 434 'Is_initialized', => '1;bool', 435 'Attach_buffer' => 0, 436 'Detach_buffer' => '2:1', 437 'Pcontrol' => '0', 438 'Get_version' => '0:1:2', # MPI 1.2 439 ); 440# 441# Here are the MPI-2 methods 442# WARNING: These are incomplete. They primarily define only the 443# MPI-2 routines implemented by MPICH. 444%class_mpi2base = ( 'Alloc_mem' => '3;void *:2', 445 'Free_mem' => '0', 446 'Open_port' => '1', 447 'Close_port' => '0', 448 'Publish_name' => '0', 449 'Lookup_name' => '0', 450 'Unpublish_name' => '0', 451 'Is_finalized' => '1;bool', 452 'Query_thread' => '1', 453 'Is_thread_main' => '1;bool', 454 'Add_error_class' => '1', 455 'Add_error_code' => '2', 456 'Add_error_string' => '0:2', 457 ); 458%class_mpi2comm = ( 'Barrier' => '0', 459 'Get_attr' => 'int', 460 'Set_attr' => '0', 461 'Delete_attr' => '0', 462# 'Create_keyval' => 'int', 463 'Free_keyval' => 'static:0:1', 464 'Set_name' => '0:2', 465 'Get_name' => '0:3', 466 'Disconnect' => '0', 467 'Get_parent' => 'static:0;Intercomm', 468 ); 469%class_postcomm = ( 'Call_errhandler' => '0', 470 ); 471%class_mpi2cart = (); 472%class_mpi2dtype = ( 'Set_name' => '0:2', 473 'Get_name' => '0:3', 474 'Dup' => 'MPI_Datatype', 475 'Get_extent' => '0', 476 'Create_hvector' => 'MPI_Datatype', 477 'Create_hindexed' => 'MPI_Datatype', 478 'Get_extent' => '0', 479 'Create_resized' => 'MPI_Datatype', # FIXME Check not just resized 480 'Get_true_extent' => '0', 481 'Create_subarray' => 'MPI_Datatype', 482 'Create_darray' => 'MPI_Datatype', 483 'Get_attr' => 'int', 484 'Set_attr' => '0', 485 'Delete_attr' => '0', 486# 'Create_keyval' => 'int', 487 'Free_keyval' => 'static:0:1', 488); 489%class_mpi2errh = ( 490 ); 491%class_mpi2graph = (); 492%class_mpi2distgraph = ( 493# Because of the weights option, Get_dist_neighbors_count is handled as 494# special case 495 'Get_dist_neighbors' => '0', 496); 497%class_mpi2group = (); 498%class_mpi2inter = ( #'Barrier' => 0, # MPI-2 adds intercomm collective 499 #'Bcast' => 0, # These are moved into the Comm class 500 #'Gather' => 0, 501 #'Gatherv' => 0, 502 #'Scatter' => 0, 503 #'Scatterv' => 0, 504 #'Allgather' => 0, 505 #'Allgatherv' => 0, 506 #'Alltoall' => 0, 507 #'Alltoallv' => 0, 508 #'Reduce' => 0, 509 #'Allreduce' => 0, 510 #'Reduce_scatter' => 0, 511 #'Scan' => 0, 512 #'Exscan' => 0, 513); 514#$specialReturnType{"inter-Split"} = "Intercomm"; 515 516# Alltoallw uses an array of datatypes, which requires special handling 517# Spawn and spawn multiple uses arrays of character strings, which 518# also require special handling 519%class_mpi2intra = ( #'Alltoallw' => 0, 520 'Exscan' => 0, 521 # Because Spawn and Spawn_multiple have two different 522 # signaturs, they are handled as special cases. 523 'Accept' => 'MPI_Comm', 524 'Connect' => 'MPI_Comm', 525 ); 526%class_mpi2op = ( 527 'Is_commutative' => '2;bool', 528 'Reduce_local' => '0:4', 529 ); 530%class_mpi2preq = (); 531%class_mpi2req = (); 532# Start requires C++ to C function interposers (like errhandlers) 533%class_mpi2greq = ( 'Complete' => 0, 534# 'Start' => 'MPI_Request', 535); 536%class_mpi2st = (); 537%class_mpi2file = ( ); 538if ($build_io) { 539 %class_mpi2file = ( 540 'Open' => 'static:MPI_File:2', 541 'Close' => 0, 542 'Delete' => 'static:0:1', 543 'Set_size' => 0, 544 'Preallocate' => 0, 545 'Get_size' => 'MPI_Offset', 546 'Get_group' => 'MPI_Group', 547 'Get_amode' => 'int', 548 'Set_info' => 0, 549 'Get_info' => 'MPI_Info', 550 'Set_view' => '0:4', 551 'Get_view' => 0, 552 'Read_at' => 0, 553 'Read_at_all' => 0, 554 'Write_at' => '0:3', 555 'Write_at_all' => '0:3', 556 'Iread_at' => 'MPI_Request', 557 'Iwrite_at' => 'MPI_Request:2', 558 'Read' => 0, 559 'Read_all' => 0, 560 'Write' => '0:2', 561 'Write_all' => '0:2', 562 'Iread' => 'MPI_Request', 563 'Iwrite' => 'MPI_Request:2', 564 'Seek' => 0, 565 'Get_position' => 'MPI_Offset', 566 'Get_byte_offset' => 'MPI_Offset', 567 'Read_shared' => 0, 568 'Write_shared' => '0:2', 569 'Iread_shared' => 'MPI_Request', 570 'Iwrite_shared' => 'MPI_Request:2', 571 'Read_ordered' => 0, 572 'Write_ordered' => '0:2', 573 'Seek_shared' => 0, 574 'Get_position_shared' => 'MPI_Offset', 575 'Read_at_all_begin' => 0, 576 'Read_at_all_end' => 0, 577 'Write_at_all_begin' => '0:3', 578 'Write_at_all_end' => '0:2', 579 'Read_all_begin' => 0, 580 'Read_all_end' => 0, 581 'Write_all_begin' => '0:2', 582 'Write_all_end' => '0:2', 583 'Read_ordered_begin' => 0, 584 'Read_ordered_end' => 0, 585 'Write_ordered_begin' => '0:2', 586 'Write_ordered_end' => '0:2', 587 'Get_type_extent' => 'MPI_Aint', 588 'Set_atomicity' => '0:2', 589 'Get_atomicity' => 'int;bool', 590 'Sync' => '0', 591 'Get_errhandler' => 'MPI_Errhandler', 592 'Set_errhandler' => '0', 593 ); 594 %class_postfile = ( 'Call_errhandler' => '0', 595 ); 596# %class_mpi2file = ( 597# 'File_open' => 'static:MPI_File:2', 598# 'File_close' => 0, 599# 'File_delete' => 'static:0:1', 600# 'File_set_size' => 0, 601# 'File_preallocate' => 0, 602# 'File_get_size' => 'MPI_Offset', 603# 'File_get_group' => 'MPI_Group', 604# 'File_get_amode' => 'int', 605# 'File_set_info' => 0, 606# 'File_get_info' => 'MPI_Info', 607# 'File_set_view' => '0:4', 608# 'File_get_view' => 0, 609# 'File_read_at' => 0, 610# 'File_read_at_all' => 0, 611# 'File_write_at' => '0:2', 612# 'File_write_at_all' => '0:2', 613# 'File_iread_at' => 'MPI_Request', 614# 'File_iwrite_at' => 'MPI_Request:1', 615# 'File_read' => 0, 616# 'File_read_all' => 0, 617# 'File_write' => '0:1', 618# 'File_write_all' => '0:1', 619# 'File_iread' => 'MPI_Request', 620# 'File_iwrite' => 'MPI_Request:1', 621# 'File_seek' => 0, 622# 'File_get_position' => 'MPI_Offset', 623# 'File_get_byte_offset' => 'MPI_Offset', 624# 'File_read_shared' => 0, 625# 'File_write_shared' => 0, 626# 'File_iread_shared' => 'MPI_Request', 627# 'File_iwrite_shared' => 'MPI_Request:1', 628# 'File_read_ordered' => 0, 629# 'File_write_ordered' => '0:1', 630# 'File_seek_shared' => 0, 631# 'File_get_position_shared' => 'MPI_Offset', 632# 'File_read_at_all_begin' => 0, 633# 'File_read_at_all_end' => 0, 634# 'File_write_at_all_begin' => '0:2', 635# 'File_write_at_all_end' => '0:1', 636# 'File_read_all_begin' => 0, 637# 'File_read_all_end' => 0, 638# 'File_write_all_begin' => '0:1', 639# 'File_write_all_end' => '0:1', 640# 'File_read_ordered_begin' => 0, 641# 'File_read_ordered_end' => 0, 642# 'File_write_ordered_begin' => '0:1', 643# 'File_write_ordered_end' => '0:1', 644# 'File_get_type_extent' => 'MPI_Aint', 645# 'File_set_atomicity' => '0:1', 646# 'File_get_atomicity' => 'bool', 647# 'File_sync' => 0, 648# 'File_set_errhandler' => 'MPI_Errhandler', 649# 'File_get_errhandler' => 0, 650# ); 651} 652%class_mpi2win = ( 'Put' => '0:1', 'Get' => '0', 653 'Accumulate' => '0', 654 'Create' => 'static:MPI_Win', 655 'Free' => '0', 656 'Fence' => '0', 657 'Get_group' => 'MPI_Group', 658 'Get_attr' => '0', 659 'Start' => '0', 660 'Complete' => '0', 661 'Post' => '0', 662 'Wait' => '0', 663 'Test' => 'int;bool', 664 'Lock' => '0', 665 'Unlock' => '0', 666 'Set_name' => '0:2', 667 'Get_name' => '0:3', 668 'Get_attr' => 'int', 669 'Set_attr' => '0', 670 'Delete_attr' => '0', 671 'Free_keyval' => 'static:0:1', 672 ); 673%class_postwin = ( 'Call_errhandler' => 0, 674 ); 675%class_mpi2info = ( 'Create' => 'static:1', 676 'Set' => '0:2:3', 677 'Delete' => '0:2', 678 'Get' => '5;bool:2', 679 'Get_valuelen' => '4;bool:2', 680 'Get_nkeys' => '2', 681 'Get_nthkey' => '0', 682 'Dup' => '2', 683 'Free' => '0', 684 ); 685 686# Name of classes, in the order in which they must be declared. This 687# includes all classes, by their short names 688@classes = ( 689 'except', 690 'dtype', 691 'info', 692 'st', 693 'group', 694 'op', 695 'errh', 696 'req', 697 'preq', 698 'comm', 699 'null', 700 'inter', 701 'intra', 702 'greq', 703 'win', 704 'file', 705 'graph', 706# 'distgraph', 707 'cart', 708); 709if ($do_DistGraphComm) { 710 $classes[$#classes+1] = 'distgraph'; 711} 712 713 714# 715# Some classes have additional methods. This hash on the classes (by 716# short name) gives the name of a routine that will add additional methods. 717# Primarily used for the Status methods (get/set_tag etc) and for 718# Communicator clone methods. 719%class_extra_fnc = ( 'st' => 'Status_methods', 720 'except' => 'Exception_methods', 721 'comm' => 'Comm_methods', 722 'null' => 'Nullcomm_methods', 723 'inter' => 'Intercomm_methods', 724 'intra' => 'Intracomm_methods', 725 'graph' => 'Graphcomm_methods', 726# 'distgraph' => 'Distgraphcomm_methods', 727 'cart' => 'Cartcomm_methods', 728 'dtype' => 'Datatype_methods', 729 'op' => 'Op_methods', 730 'file' => 'File_methods', 731 'win' => 'Win_methods', 732 'greq' => 'Grequest_methods', 733 ); 734if ($do_DistGraphComm) { 735 $class_extra_fnc{'distgraph'} = 'Distgraphcomm_methods'; 736} 737 738# ---------------------------------------------------------------------------- 739# If there is a specific list of routines, replace the list with this 740# list 741%newclasses = (); 742if ($routine_list ne "") { 743 for $routine (split(/\s+/,$routine_list)) { 744 print "$routine\n" if $gDebug; 745 ($class,$rname) = split(/-/,$routine); 746 # Look up name in the class list 747 $classvar = "class-mpi1$class"; 748 $result_type = 0; 749 if (defined($$classvar{$rname})) { 750 $result_type = $$classvar{$rname}; 751 } 752 else { 753 $classvar = "class-mpi2$class"; 754 if (defined($$classvar{$rname})) { 755 $result_type = $$classvar{$rname}; 756 } 757 } 758 $newclasses{$class} .= " $rname=>$result_type"; 759 } 760 # Now, clear all of the classes 761 foreach $class (@classes) { 762 $class_name = "class_mpi1$class"; 763 %$class_name = (); 764 $class_name = "class_mpi2$class"; 765 %$class_name = (); 766 } 767 # And unpack newclasses 768 foreach $class (keys(%newclasses)) { 769 $class_name = "class_mpi1$class"; 770 foreach $rpair (split(/\s+/,$newclasses{$class})) { 771 if ($rpair eq "") { next; } 772 print "$rpair\n" if $gDebug; 773 ($routine, $rval) = split(/=>/,$rpair); 774 $$class_name{$routine} = $rval; 775 } 776 } 777 # At this point, we should generate only the routines requested, 778 # plus all of the classes (we may need the empty classes for the 779 # predefined types) 780} 781 782# ---------------------------------------------------------------------------- 783 784# MPI objects 785# dtypes gives all of the MPI datatypes whose C version are this name 786# with MPI_ in front. E.g., MPI::CHAR is the same as MPI_CHAR. 787# The size-specific types were added in MPI-2, and are required for 788# C and C++ as well as for Fortran 789@dtypes = ( 'CHAR', 'UNSIGNED_CHAR', 'BYTE', 'SHORT', 'UNSIGNED_SHORT', 790 'INT', 'UNSIGNED', 'LONG', 'UNSIGNED_LONG', 'FLOAT', 791 'DOUBLE', 'LONG_DOUBLE', 'LONG_LONG_INT', 'LONG_LONG', 792 'PACKED', 'LB', 'UB', 'FLOAT_INT', 'DOUBLE_INT', 793 'LONG_INT', 'SHORT_INT', 'LONG_DOUBLE_INT', 794 'REAL4', 'REAL8', 'REAL16', 'COMPLEX8', 'COMPLEX16', 795 'COMPLEX32', 'INTEGER1', 'INTEGER2', 'INTEGER4', 796 'INTEGER8', 'INTEGER16', 'WCHAR', 'SIGNED_CHAR', 797 'UNSIGNED_LONG_LONG' ); 798 799@typeclasses = ( 'TYPECLASS_REAL', 'TYPECLASS_INTEGER', 'TYPECLASS_COMPLEX' ); 800 801 802# 803# Still missing: C++ only types: BOOL, COMPLEX, DOUBLE_COMPLEX, 804# LONG_DOUBLE_COMPLEX. 805@cppdtypes = ( 'BOOL', 'COMPLEX', 'DOUBLE_COMPLEX', 'LONG_DOUBLE_COMPLEX' ); 806 807# ops is like dtypes 808@ops = ( 'MAX', 'MIN', 'SUM', 'PROD', 'LAND', 'BAND', 'LOR', 'BOR', 809 'LXOR', 'BXOR', 'MINLOC', 'MAXLOC', 'REPLACE' ); 810# errclasses is like dtypes. Contains both MPI-1 and MPI-2 classes 811@errclasses = ( 'SUCCESS', 'ERR_BUFFER', 'ERR_COUNT', 'ERR_TYPE', 812 'ERR_TAG', 'ERR_COMM', 'ERR_RANK', 'ERR_REQUEST', 813 'ERR_ROOT', 'ERR_GROUP', 'ERR_OP', 'ERR_TOPOLOGY', 814 'ERR_DIMS', 'ERR_ARG', 'ERR_UNKNOWN', 'ERR_TRUNCATE', 815 'ERR_OTHER', 'ERR_INTERN', 'ERR_PENDING', 'ERR_IN_STATUS', 816 'ERR_LASTCODE', 817 'ERR_FILE', 'ERR_ACCESS', 'ERR_AMODE', 'ERR_BAD_FILE', 818 'ERR_FILE_EXISTS', 'ERR_FILE_IN_USE', 'ERR_NO_SPACE', 819 'ERR_NO_SUCH_FILE', 'ERR_IO', 'ERR_READ_ONLY', 820 'ERR_CONVERSION', 'ERR_DUP_DATAREP', 'ERR_UNSUPPORTED_DATAREP', 821 'ERR_INFO', 'ERR_INFO_KEY', 'ERR_INFO_VALUE', 'ERR_INFO_NOKEY', 822 'ERR_NAME', 'ERR_NO_MEM', 'ERR_NOT_SAME', 'ERR_PORT', 823 'ERR_QUOTA', 'ERR_SERVICE', 'ERR_SPAWN', 824 'ERR_UNSUPPORTED_OPERATION', 'ERR_WIN', 'ERR_BASE', 825 'ERR_LOCKTYPE', 'ERR_KEYVAL', 'ERR_RMA_CONFLICT', 826 'ERR_RMA_SYNC', 'ERR_SIZE', 'ERR_DISP', 'ERR_ASSERT', 827 ); 828 829# 830# Special routines require special processing in C++ 831%special_routines = ( 'Init' => 1, 'Init_thread' => 1, 'Pcontrol' => '1' ); 832 833# 834# Most routines can be processed automatically. However, some 835# require some special processing. (See the Fortran version 836# of buildiface) 837 838$arg_string = join( ' ', @ARGV ); 839 840# --------------------------------------------------------------------------- 841# Here begins more executable code. Read the definitions of the 842# routines. The argument list for routine xxx is placed into the hash 843# mpi_routine{xxx}. 844&ReadInterface( "../../include/mpi.h.in" ); 845# Special case: Add Pcontrol 846$mpi_routine{'Pcontrol'} = "int,..."; 847 848# if doing MPI2, we also need to read the MPI-2 protottypes 849if ( -s "../../mpi/romio/include/mpio.h.in" ) { 850 &ReadInterface( "../../mpi/romio/include/mpio.h.in" ); 851} 852 853# Class_type gives the C datatype for each class, except for the 854# exception class, which has no C counterpart 855%class_type = ( 'comm' => MPI_Comm, 856 'cart' => MPI_Comm, 857 'dtype' => MPI_Datatype, 858 'errh' => MPI_Errhandler, 859 'null' => MPI_Comm, 860 'graph' => MPI_Comm, 861# 'distgraph' => MPI_Comm, 862 'group' => MPI_Group, 863 'inter' => MPI_Comm, 864 'intra' => MPI_Comm, 865 'op' => MPI_Op, 866 'preq' => MPI_Request, 867 'req' => MPI_Request, 868 'greq' => MPI_Request, 869 'st' => MPI_Status, 870 'info' => MPI_Info, 871 'win' => MPI_Win, 872 'file' => MPI_File, 873 'except' => 'int', 874 ); 875if ($do_DistGraphComm) { 876 $class_type{'distgraph'} = 'MPI_Comm'; 877} 878 879# 880# fullclassname gives the C++ binding class name for each shorthand version 881%fullclassname = ( 'comm' => 'Comm', 882 'cart' => 'Cartcomm', 883 'dtype' => 'Datatype', 884 'errh' => 'Errhandler', 885 'graph' => 'Graphcomm', 886# 'distgraph' => 'Distgraphcomm', 887 'group' => 'Group', 888 'null' => 'Nullcomm', 889 'inter' => 'Intercomm', 890 'intra' => 'Intracomm', 891 'op' => 'Op', 892 'preq' => 'Prequest', 893 'req' => 'Request', 894 'st' => 'Status', 895 'greq' => 'Grequest', 896 'info' => 'Info', 897 'win' => 'Win', 898 'file' => 'File', 899 'except' => 'Exception', 900); 901if ($do_DistGraphComm) { 902 $fullclassname{'distgraph'} = 'Distgraphcomm'; 903} 904# 905# Each class may need to access internal elements of another class. 906# This has gives the list of friends for each class (i.e., the 907# classes that are allowed to directly access the protected members). 908# The friends are the full class names 909%class_friends = ( 'comm' => 'Cartcomm,Intercomm,Intracomm,Graphcomm,Distgraphcomm,Nullcomm,Datatype,Win,File', 910 'cart' => '', 911 'dtype' => 'Comm,Status,Intracomm,Intercomm,Win,File,Op', 912 'errh' => 'Comm,File,Win', 913 'graph' => '', 914 'distgraph' => '', 915 'group' => 'Comm,Intracomm,Intercomm,Win,File', 916 'inter' => 'Intracomm', 917 'intra' => 'Cartcomm,Graphcomm,Distgraphcomm,Datatype', 918 # Op adds comm as a friend because of MPI2 919 'op' => 'Intracomm,Intercomm,Win,Comm', 920 'preq' => '', 921 'req' => 'Comm,File,Grequest', 922 'st' => 'Comm,File,Request', 923 'greq' => '', 924 'info' => 'File,Win,Comm,Intracomm', 925 'win' => '', 926 'file' => '', 927 ); 928if (!$do_DistGraphComm) { 929 # Remove Distgraphcomm from the friends list 930 $class_friends{'comm'} = 'Cartcomm,Intercomm,Intracomm,Graphcomm,Nullcomm,Datatype,Win,File'; 931 $class_friends{'intra'} = 'Cartcomm,Graphcomm,Datatype'; 932} 933# 934# We also need to know the derived classes. This gives the class that 935# a class is derived from. Base classes are not included here. 936%derived_class = ( 'graph' => 'Intracomm', 937 # 'distgraph' => 'Intracomm', 938 'preq' => 'Request', 939 'greq' => 'Request', 940 'null' => 'Comm', 941 'inter' => 'Comm', 942 'intra' => 'Comm', 943 'cart' => 'Intracomm', 944 ); 945if ($do_DistGraphComm) { 946 $derived_class{'distgraph'} = 'Intracomm'; 947} 948 949# 950# Maps all of the derived classes to their ultimate parent. This is 951# used to find the name of the correct protected element (the_real_xxx), 952# used to store the C version of the class handle. 953%mytopclass = ( 'graph' => 'comm', 954 'graphcomm' => 'comm', 955# 'distgraph' => 'comm', 956# 'distgraphcomm' => 'comm', 957 'nullcomm' => 'comm', 958 'intracomm' => 'comm', 959 'intercomm' => 'comm', 960 'intra' => 'comm', 961 'inter' => 'comm', 962 'cart' => 'comm', 963 'cartcomm' => 'comm', 964 'grequest' => 'request', 965 'prequest' => 'request', 966 'greq' => 'request', 967 'preq' => 'request' ); 968if ($do_DistGraphComm) { 969 $mytopclass{'distgraph'} = 'comm'; 970 $mytopclass{'distgraphcomm'} = 'comm'; 971} 972 973# 974# Many of the C++ binding names are easily derived from the C name. 975# For those names that are not so derived, this hash provides a mapping from 976# the C names to the C++ names. 977# WARNING: This list is incomplete 978# 979# These have the form <short-class-name>-<C++name> => <C-name>; i.e., 980# MPI_Comm_rank becomes 'comm-rank'. Routines that are part of the MPI 981# namespace but not in any class leave the class field blank, i.e., 982# -Attach_buffer . 983%altname = ( 'base-Attach_buffer' => 'Buffer_attach', 984 'base-Detach_buffer' => 'Buffer_detach', 985 'base-Compute_dims' => 'Dims_create', 986 'base-Get_error_class' => 'Error_class', 987 'base-Get_error_string' => 'Error_string', 988 'base-Is_initialized' => 'Initialized', 989 'base-Is_finalized' => 'Finalized', 990 'base-Register_datarep' => 'Register_datarep', 991 'comm-Sendrecv_replace' => 'Sendrecv_replace', 992 'comm-Get_topology' => 'Topo_test', 993 'comm-Get_rank' => 'Comm_rank', 994 'comm-Get_size' => 'Comm_size', 995 'comm-Get_group' => 'Comm_group', 996 'comm-Is_inter' => 'Comm_test_inter', 997 'dtype-Create_contiguous' => 'Type_contiguous', 998 'dtype-Create_vector' => 'Type_vector', 999 'dtype-Create_indexed' => 'Type_indexed', 1000 'dtype-Create_indexed_block' => 'Type_create_indexed_block', 1001 'dtype-Create_struct' => 'Type_create_struct', 1002 'dtype-Get_envelope' => 'Type_get_envelope', 1003 'dtype-Get_contents' => 'Type_get_contents', 1004 'dtype-Match_size' => 'Type_match_size', 1005 'dtype-Create_f90_real' => 'Type_create_f90_real', 1006 'dtype-Create_f90_complex' => 'Type_create_f90_complex', 1007 'dtype-Create_f90_integer' => 'Type_create_f90_integer', 1008 'dtype-Commit' => 'Type_commit', 1009 'dtype-Pack' => 'Pack', 1010# 'dtype-Unpack' => 'Unpack', 1011# Unpack is a special case because the C++ binding doesn't follow a simple 1012# rule to derive from the C binding 1013 'dtype-Pack_size' => 'Pack_size', 1014 'dtype-Free' => 'Type_free', 1015 'dtype-Get_size' => 'Type_size', 1016 'dtype-Get_name' => 'Type_get_name', 1017 'dtype-Set_name' => 'Type_set_name', 1018 'dtype-Get_extent' => 'Type_get_extent', 1019 'dtype-Dup' => 'Type_dup', 1020 'dtype-Create_subarray' => 'Type_create_subarray', 1021 'dtype-Create_resized' => 'Type_create_resized', 1022 'dtype-Create_hvector' => 'Type_create_hvector', 1023 'dtype-Create_darray' => 'Type_create_darray', 1024 'dtype-Create_hindexed' => 'Type_create_hindexed', 1025 'dtype-Get_true_extent' => 'Type_get_true_extent', 1026 'dtype-Get_attr' => 'Type_get_attr', 1027 'dtype-Set_attr' => 'Type_set_attr', 1028 'dtype-Delete_attr' => 'Type_delete_attr', 1029 'dtype-Free_keyval' => 'Type_free_keyval', 1030 'group-Get_size' => 'Group_size', 1031 'group-Get_rank' => 'Group_rank', 1032 'group-Intersect' => 'Group_intersection', 1033 'intra-Create_intercomm' => 'Intercomm_create', 1034 'inter-Create' => 'Comm_create', 1035 'inter-Split' => 'Comm_split', 1036 'intra-Split' => 'Comm_split', 1037 'inter-Get_remote_group' => 'Comm_remote_group', 1038 'inter-Get_remote_size' => 'Comm_remote_size', 1039 'inter-Dup' => 'Comm_dup', 1040 'intra-Create' => 'Comm_create', 1041 'intra-Dup' => 'Comm_dup', 1042 'intra-Split' => 'Comm_split', 1043 'intra-Create_cart' => 'Cart_create', 1044 'intra-Create_graph' => 'Graph_create', 1045 # Dist_graph_create and Dist_graph_create_adjacent are handled 1046 # as a special case 1047 'intra-Connect' => 'Comm_connect', 1048 'intra-Spawn' => 'Comm_spawn', 1049 'intra-Spawn_multiple' => 'Comm_spawn_multiple', 1050 'intra-Accept' => 'Comm_accept', 1051 'st-Is_cancelled' => 'Test_cancelled', 1052 'cart-Get_cart_rank' => 'Cart_rank', 1053 'cart-Map' => 'Cart_map', 1054 'cart-Get_topo' => 'Cart_get', 1055 'cart-Shift' => 'Cart_shift', 1056 'cart-Sub' => 'Cart_sub', 1057 'cart-Dup' => 'Comm_dup', 1058 'cart-Get_dim' => 'Cartdim_get', 1059 'cart-Get_coords' => 'Cart_coords', 1060 'cart-Get_rank' => 'Cart_rank', 1061 'graph-Map' => 'Graph_map', 1062 'graph-Get_topo' => 'Graph_get', 1063 'graph-Get_neighbors' => 'Graph_neighbors', 1064 'graph-Get_neighbors_count' => 'Graph_neighbors_count', 1065 'graph-Get_dims' => 'Graphdims_get', 1066 'graph-Dup' => 'Comm_dup', 1067# 'distgraph-Dup' => 'Comm_dup', 1068# 'distgraph-Get_dist_neighbors' => 'Dist_graph_neighbors', 1069# 'distgraph-Get_dist_neighbors_count' => 'Dist_graph_neighbors_count', 1070 'op-Is_commutative' => 'Op_commutative', 1071 'op-Reduce_local' => 'Reduce_local', 1072 ); 1073if ($do_DistGraphComm) { 1074 $altname{'distgraph-Dup'} = 'Comm_dup'; 1075 $altname{'distgraph-Get_dist_neighbors'} = 'Dist_graph_neighbors'; 1076 $altname{'distgraph-Get_dist_neighbors_count'} = 1077 'Dist_graph_neighbors_count'; 1078} 1079 1080# These routines must be defered because their implementations need 1081# definitions of classes that must be made later than the class that they 1082# are in. In particular, these need both datatypes and communicators. 1083%defer_definition = ( 'Pack' => Datatype, 1084 'Pack_size' => Datatype, 1085 'Unpack' => Datatype 1086 ); 1087 1088# These classes (in the binding name) do not have a compare operation, or 1089# use the parent class's compare operation. 1090# These use the Full class name. 1091%class_has_no_compare = ( 'Status' => 1, 1092 'Intracomm' => 1, 1093 'Intercomm' => 1, 1094 'Nullcomm' => 1, 1095 'Cartcomm' => 1, 1096 'Graphcomm' => 1, 1097# 'Distgraphcomm' => 1, 1098 'Prequest' => 1, 1099 ); 1100if ($do_DistGraphComm) { 1101 $class_has_no_compare{'Distgraphcomm'} = 1; 1102} 1103 1104# These classes do not have a default intialization 1105# These use the Full class name 1106%class_has_no_default = ( 'Status' => 1 ); 1107 1108# Read the function specification (will eventually replace the hard-coded 1109# values set in this file). This file contains information that is not 1110# derived from the ReadInterface 1111if ($doFuncspec) { 1112 &ReadFuncSpec( "cxxdecl3.dat" ); 1113 # Use the MPI C++ binding names for the defered definitions 1114 $defer_definition{"Create_cart"} = "Comm"; 1115 $defer_definition{"Create_graph"} = "Comm"; 1116 $defer_definition{"Get_parent"} = "Comm"; 1117 $defer_definition{"Join"} = "Comm"; 1118 $defer_definition{"Merge"} = "Intercomm"; 1119 $defer_definition{"Call_errhandler"} = "Comm"; 1120 $defer_definition{"Call_errhandler"} = "File"; 1121 $defer_definition{"Call_errhandler"} = "Win"; 1122 1123 $dtype_Get_name_init = " MPIR_CXX_InitDatatypeNames();"; 1124} 1125 1126# FIXME: TODO 1127# Some of the routine definitions require future class definitions; e.g., 1128# The Intracomm routine Create_cart needs to create a Cartcomm. These 1129# routines must have their definitions in initcxx.cxx, not 1130# mpicxx.h . How should we mark these? 1131# (The original buildiface incorrectly generated Comm objects for these) 1132# Because there are only a few routines, we can keep track of these here 1133 1134# create a stamp file for use by Makefile.mk rebuild make logic 1135open STAMPFD, '>', 'buildiface-stamp'; 1136close STAMPFD; 1137 1138# create the main file 1139$filename = "mpicxx.h.in"; 1140$OUTFD = OUTFILEHANDLE; 1141open ( $OUTFD, ">${filename}.new" ) || die "Could not open ${filename}.new\n"; 1142# Use the derived file as a source 1143$files[$#files+1] = "mpicxx.h"; 1144&print_header; 1145&printDefineChecks; 1146 1147&printCoverageHeader( $OUTFD, 1 ); 1148 1149&PrintNewSeek( $OUTFD ); 1150 1151print $OUTFD "namespace MPI {\n"; 1152 1153# Provide a way to invoke the error handler on the object 1154print $OUTFD "#if \@HAVE_CXX_EXCEPTIONS\@ 1155#define MPIX_CALLREF( _objptr, fnc ) \\ 1156 { int err = fnc; if (err) { (_objptr)->Call_errhandler( err ); }} 1157#define MPIX_CALLOBJ( _obj, fnc ) \\ 1158 { int err = fnc; if (err) { (_obj).Call_errhandler( err ); }} 1159#define MPIX_CALLWORLD( fnc ) \\ 1160 { int err = fnc ; if (err) MPIR_Call_world_errhand( err ); } 1161extern void MPIR_Call_world_errhand( int ); 1162#else 1163#define MPIX_CALLREF( _objptr, fnc ) (void)fnc 1164#define MPIX_CALLOBJ( _obj, fnc ) (void)fnc 1165#define MPIX_CALLWORLD( fnc ) (void)fnc 1166#endif\n"; 1167 1168# 1169# Within a "namespace" qualifier, the namespace name should not be used. 1170# Thus, we use Offset, not MPI::Offset. 1171print $OUTFD " 1172// Typedefs for basic int types 1173typedef MPI_Offset Offset; 1174typedef MPI_Aint Aint; 1175typedef MPI_Fint Fint; 1176 1177// Special internal routine 1178void MPIR_CXX_InitDatatypeNames( void ); 1179 1180// Forward class declarations 1181class Comm; 1182class Nullcomm; 1183class Intercomm; 1184class Intracomm; 1185class Cartcomm; 1186class Graphcomm;\n"; 1187if ($do_DistGraphComm) { 1188 print $OUTFD "class Distgraphcomm;\n"; 1189} 1190print $OUTFD "class File;\n\n"; 1191 1192# 1193# Add the base routines. Since these are not in any class, we 1194# place only their prototype in the header file. The 1195# implementation is then placed in the source file. We can 1196# put these here because none of them use any of the other classes, 1197# and we'll want to use a few of them in the implementations of the 1198# other functions. 1199print $OUTFD "// base (classless) routines\n"; 1200@routines = keys(%class_mpi1base); 1201if (@routinesMpi1base) { 1202 @routines = @routinesMpi1base; 1203} 1204if ($outputRoutineLists) { 1205 open (FD, ">order.mpi1base.txt" ); 1206 print FD "\@routinesMpi1base = (\n"; 1207} 1208foreach $routine (@routines) { 1209 print FD "\t\"$routine\",\n" if ($outputRoutineLists); 1210 # These aren't really a class, so they don't use Begin/EndClass 1211 $arginfo = $class_mpi1base{$routine}; 1212 print $OUTFD "extern "; 1213 &PrintRoutineDef( $OUTFD, "base", $routine, $arginfo, 1 ); 1214} 1215if ($outputRoutineLists) { 1216 print FD ");\n"; 1217 close (FD); 1218} 1219 1220# Forward references for externals, used in error handling 1221print $OUTFD "extern Intracomm COMM_WORLD;\n"; 1222print $OUTFD "extern File FILE_NULL;\n"; 1223 1224# mpi2base adds a few routines which need definitions (Info), so 1225# all of them are at the end, right before the extern declarations 1226 1227# 1228# Here's the loop structure 1229# foreach class 1230# output class header 1231# for mpi1, mpi2 1232# for the routines in that class and choice of mpi1, mpi2 1233# output any special methods 1234# 1235 1236# Build the routines by class 1237foreach $class (@classes) { 1238 my $printed_extra_fnc = 0; 1239 $shortclass = $class; 1240 $Class = $fullclassname{$class}; 1241 #$mpi_type = $class_type{$class}; 1242 1243 # Special case to skip over the file routines (whose prototypes cause 1244 # us some problems). 1245 if ($class eq "file") { 1246 if (!$build_io) { next; } 1247 # Add a definition for MPI_FILE_NULL and MPI_File if none available 1248 print $OUTFD "#ifndef MPI_FILE_NULL\ 1249#define MPI_FILE_NULL 0\ 1250typedef int MPI_File;\ 1251#endif\n"; 1252 } 1253 1254 # Begin the class, writing the common operations (destructors etc.) 1255 &BeginClass( $class ); 1256 1257 # Hack to ifdef out the file routines 1258 if ($class eq "file") { 1259 # Define the file type only if supported. 1260 print $OUTFD "#ifdef MPI_MODE_RDONLY\n"; 1261 } 1262 1263 foreach $mpilevel (@mpilevels) { 1264 if ($mpilevel eq "post") { 1265 $printed_extra_fnc = 1; 1266 if (defined($class_extra_fnc{$class})) { 1267 $extrafnc = $class_extra_fnc{$class}; 1268 &$extrafnc( $OUTFD ); 1269 } 1270 } 1271 1272 $mpiclass = "$mpilevel$class"; 1273 $class_hash = "class_$mpiclass"; 1274 @routines = keys(%$class_hash); 1275 $arrname = "routines$mpiclass"; 1276 if (@$arrname) { 1277 @routines = @$arrname; 1278 } 1279 if ($#routines < 0) { next; } 1280 if ($outputRoutineLists) { 1281 open (FD, ">order.$arrname.txt" ); 1282 print FD "\@$arrname = (\n"; 1283 } 1284 foreach $routine (@routines) { 1285 print "processing $routine in $mpiclass\n" if $gDebug; 1286 print FD "\t\"$routine\",\n" if ($outputRoutineLists); 1287 # info describes the return parameter and any special 1288 # processing for this routine. 1289 $arginfo = $$class_hash{$routine}; 1290 print "Arginfo is $arginfo\n" if $gDebug; 1291 &PrintRoutineDef( $OUTFD, $class, $routine, $arginfo, 0 ); 1292 1293 # Check for Status as an arg (handle MPI_STATUS_IGNORE 1294 # by providing a definition without using Status). 1295 if ($args =~ /Status/ && $class ne "st") { 1296 &PrintRoutineDefNoStatus( $OUTFD, $class, 1297 $routine, $arginfo, 0 ); 1298 } 1299 } 1300 if ($outputRoutineLists) { 1301 print FD ");\n"; 1302 close (FD); 1303 } 1304 } 1305 if (defined($class_extra_fnc{$class}) && !$printed_extra_fnc) { 1306 $extrafnc = $class_extra_fnc{$class}; 1307 &$extrafnc( $OUTFD ); 1308 } 1309 1310 # Hack to ifdef out the file routines 1311 if ($class eq "file") { 1312 # Define the file type only if supported. 1313 print $OUTFD "#endif\n"; 1314 } 1315 &EndClass; 1316 1317 # Special case. Once we define a Datatype, add this typedef 1318 if ($class eq "dtype") { 1319 print $OUTFD " 1320 typedef void User_function(const void *, void*, int, const Datatype&); 1321"; 1322 } 1323} 1324 1325 # Add a few more external functions (some require the above definitions) 1326 @routines = keys(%class_mpi2base); 1327 if (@routinesMpi2base) { 1328 @routines = @routinesMpi2base; 1329 } 1330 if ($outputRoutineLists) { 1331 open (FD, ">order.$arrname.txt" ); 1332 print FD "\@routinesMpi2base = (\n"; 1333 } 1334 foreach $routine (@routines) { 1335 print FD "\t\"$routine\",\n" if ($outputRoutineLists); 1336 # These aren't really a class, so they don't use Begin/EndClass 1337 $arginfo = $class_mpi2base{$routine}; 1338 print $OUTFD "extern "; 1339 #print "$routine - $arginfo\n"; 1340 &PrintRoutineDef( $OUTFD, "base", $routine, $arginfo, 1 ); 1341 } 1342 if ($outputRoutineLists) { 1343 print FD ");\n"; 1344 close (FD); 1345 } 1346 # Special case: the typedefs for the datarep function 1347 # Only define these typedefs when MPI-IO is available (this is the same 1348 # test as used for the rest of the I/O routines ); 1349print $OUTFD "\ 1350#ifdef MPI_MODE_RDONLY 1351typedef int Datarep_extent_function( const Datatype&, Aint&, void *); 1352typedef int Datarep_conversion_function( void *, Datatype &, int, void *, 1353 Offset, void * ); 1354#endif 1355\n"; 1356 1357 print $OUTFD "\n"; 1358 1359 # Print the extern names for the various constants defined in the 1360 # MPI namespace 1361 &PrintConstants( $OUTFD, 0 ); 1362 1363 # Other routines 1364 print $OUTFD "extern void Init(void);\n"; 1365 print $OUTFD "extern void Init(int &, char **& );\n"; 1366 print $OUTFD "extern int Init_thread(int);\n"; 1367 print $OUTFD "extern int Init_thread(int &, char **&, int );\n"; 1368 print $OUTFD "extern double Wtime(void);\n"; 1369 print $OUTFD "extern double Wtick(void);\n"; 1370 1371 print $OUTFD "} // namespace MPI\n"; 1372 1373 close ( $OUTFD ); 1374 &ReplaceIfDifferent( $filename, "${filename}.new" ); 1375 1376 1377# Build the special routines 1378&build_specials; 1379 1380# ------------------------------------------------------------------------ 1381# Procedures 1382# print_line( FD, line, count, continue, continuelen ) 1383# Print line to FD; if line size > count, output continue string and 1384# continue. Use print_endline to finish a line 1385sub print_line { 1386 my $FD = $_[0]; 1387 my $line = $_[1]; 1388 my $count = $_[2]; 1389 my $continue = $_[3]; 1390 my $continue_len = $_[4]; 1391 1392 $linelen = length( $line ); 1393 #print "linelen = $linelen, print_line_len = $print_line_len\n"; 1394 if ($print_line_len + $linelen > $count) { 1395 print $FD $continue; 1396 $print_line_len = $continue_len; 1397 } 1398 print $FD $line; 1399 $print_line_len += $linelen; 1400} 1401sub print_endline { 1402 my $FD = $_[0]; 1403 print $FD "\n"; 1404 $print_line_len = 0; 1405} 1406 1407# Print the header of the file, containing the definitions etc. 1408sub print_header { 1409 print $OUTFD "/*\ 1410 * Copyright (C) by Argonne National Laboratory\ 1411 * See COPYRIGHT in top-level directory\ 1412 *\ 1413 * This file is automatically generated by buildiface $arg_string\ 1414 * DO NOT EDIT\ 1415 */ 1416/* style: c++ header */\ 1417\n"; 1418} 1419 1420# Print checks for names that might be defined but that conflict with 1421# MPI 1422sub printDefineChecks { 1423 # Add a test for definitions that will cause problems 1424 # Unfortunately, #warning isn't part of standard C, so we can't use 1425 # it. 1426 print $OUTFD "#ifdef MPI 1427#error \"You cannot define MPI; that name is reserved for the MPI namespace\" 1428#endif\n"; 1429 if ($oldSeek) { 1430 # Let the user define MPICH_IGNORE_CXX_SEEK to both 1431 # suppress the check for SEEK_SET etc. and to suppress the definition 1432 # of the values. 1433 print $OUTFD " 1434// There is a name conflict between stdio.h and iostream (or iostream.h) 1435// and the MPI C++ binding 1436// with respect to the names SEEK_SET, SEEK_CUR, and SEEK_END. MPI 1437// wants these in the MPI namespace, but stdio.h will #define these 1438// to integer values. #undef'ing these can cause obscure problems 1439// with other include files (such as iostream), so we instead use 1440// #error to indicate a fatal error. Users can either #undef 1441// the names before including mpi.h or include mpi.h *before* stdio.h 1442// or iostream. 1443\n"; 1444 print $OUTFD "#ifndef MPICH_IGNORE_CXX_SEEK 1445#ifdef SEEK_SET 1446#error \"SEEK_SET is #defined but must not be for the C++ binding of MPI\" 1447//#undef SEEK_SET 1448#endif 1449#ifdef SEEK_CUR 1450#error \"SEEK_CUR is #defined but must not be for the C++ binding of MPI\" 1451//#undef SEEK_CUR 1452#endif 1453#ifdef SEEK_END 1454//#undef SEEK_END 1455#error \"SEEK_END is #defined but must not be for the C++ binding of MPI\" 1456#endif 1457#endif\n\n"; 1458 } 1459 1460 print $OUTFD " 1461/* 1462 * Because the API is defined, some methods have parameters that are 1463 * not used. The following definition allows us to suppress warnings 1464 * about unused arguments in methods when -Wall -Wextra are specified. 1465 * this definition is removed at the end of this file. 1466 */ 1467#ifdef MPIR_ARGUNUSED 1468#error MPIR_ARGUNUSED defined 1469#endif 1470#if defined(__GNUC__) && __GNUC__ >= 4 1471#define MPIR_ARGUNUSED __attribute__((unused)) 1472#else 1473#define MPIR_ARGUNUSED 1474#endif\n"; 1475} 1476 1477# Use this after the MPI namespace is defined 1478sub PrintNewSeek { 1479 my $OUTFD = $_[0]; 1480 1481 if (! $oldSeek) { 1482 print $OUTFD <<EOT; 1483// There is a name conflict between stdio.h and iostream (or iostream.h) 1484// and the MPI C++ binding with respect to the names SEEK_SET, SEEK_CUR, 1485// and SEEK_END. MPI wants these in the MPI namespace, but stdio.h, 1486// iostream, or iostream.h will #define these to integer values. 1487// #undef'ing these can cause obscure problems. 1488#ifndef MPICH_IGNORE_CXX_SEEK 1489 1490// MPICH_DONT_INCLUDE_STDIO_H is another escape hatch for us, just like 1491// MPICH_IGNORE_CXX_SEEK. If we encounter a wacky environment or user in the 1492// wild that does not want our workaround and/or the stdio.h header, then we can 1493// offer them a way out. 1494#ifndef MPICH_DONT_INCLUDE_STDIO_H 1495// ensure that we have SEEK_* defined 1496# include <stdio.h> 1497#endif 1498 1499enum MPIR_Dummy_seek_type { 1500 MPIR_DUMMY_SEEK_COMMA_VAL = -1 // permits cleaner comma logic 1501#ifdef SEEK_SET 1502 , MPIR_SEEK_SET = SEEK_SET 1503# undef SEEK_SET 1504 , SEEK_SET = MPIR_SEEK_SET 1505#endif 1506#ifdef SEEK_CUR 1507 , MPIR_SEEK_CUR = SEEK_CUR 1508# undef SEEK_CUR 1509 , SEEK_CUR = MPIR_SEEK_CUR 1510#endif 1511#ifdef SEEK_END 1512 , MPIR_SEEK_END = SEEK_END 1513# undef SEEK_END 1514 , SEEK_END = MPIR_SEEK_END 1515#endif 1516#ifdef LOCK_SHARED 1517 , MPIR_LOCK_SHARED = LOCK_SHARED 1518# undef LOCK_SHARED 1519 , LOCK_SHARED = MPIR_LOCK_SHARED 1520#endif 1521}; 1522 1523#endif // MPICH_IGNORE_CXX_SEEK 1524EOT 1525 } 1526} 1527 1528# Print the arguments for the routine DEFINITION. 1529# TODO : Remove any output parameters. This is stored in info by position 1530# if an integer or type (if a string). If 0, there is no return object 1531sub print_args { 1532 my $OUTFD = $_[0]; 1533 my @parms = split(/\s*,\s*/, $_[1] ); # the original parameter list 1534 my $class_type = $_[2]; # Is this a Comm, Info, or othe 1535 # class? Use to find the position 1536 # of the "this" entry in the C 1537 # version of the routine. 1538 my $arginfo = $_[3]; # Value of <class>_hash{routine)} 1539 1540 my $count = 1; 1541 my $last_args = ""; 1542 $first = 1; 1543 my $args_printed = 0; 1544 my $is_static = 0; # set to true if function is static 1545 1546 &debugPrint( $routine, "In print_args" ); 1547 my $special_args = "::"; 1548 if (defined($arginfo)) { 1549 if ($arginfo =~ /^static:/) { 1550 $arginfo =~ s/^static://; 1551 $is_static = 1; 1552 } 1553 if ($arginfo =~ /(^[^:]+):(.*)/) { 1554 $returnarg = $1; 1555 $special_args = ":".$2.":"; # makes the numbers :\d+:... 1556 &debugPrint( $routine, "Routine $routine special args $special_args" ); 1557 } 1558 } 1559 1560 # Special case: if the only parm is "void", remove it from the list 1561 print "Nparms = $#parms, parms = " . join(',',@parms) . "\n" if $gDebug; 1562 if ($#parms == 0 && $parms[0] eq "void") { 1563 &debugPrint( $routine, "Setting nparms to -1" ); 1564 $#parms = -1; 1565 } 1566 # class_pos is the position of the class variable in the argument list. 1567 # If specified by parm type, we must find it 1568 $class_pos = -1; 1569 if ($class_pos == -1 && defined($class_type) && $class_type ne "" && 1570 !$is_static) { 1571 &debugPrint( $routine, "Looking for class $class_type" ); 1572 $class_pos = 0; 1573 $pos = 1; 1574 foreach $parm (@parms) { 1575 if ($parm =~ /$class_type/) { 1576 # Found the type; set the position of the class variable 1577 $class_pos = $pos; 1578 last; 1579 } 1580 $pos++; 1581 } 1582 } 1583 1584 # Output the list 1585 print "special args at: $special_args\n" if $gDebug; 1586 print $OUTFD "( "; 1587 foreach $parm (@parms) { 1588 $pos_check = ":" . $count . ":"; 1589 print "parm = :$parm:\n" if $gDebug; 1590 1591 # Check whether this argument has special processing 1592 # Otherwise, apply standardized rules (currently, this 1593 # is used only to prepend a qualifier, such as "const"). 1594 if ($special_args =~ /$pos_check/) { 1595 if (&DoSpecialArgProcessing( $OUTFD, $routine, $count, 1596 "methoddecl" ) ) { 1597 $args_printed ++; 1598 $count++; 1599 if ($first) { $first = 0; } 1600 next; 1601 } 1602 } 1603 # Match type to replacement 1604 if ($count == $class_pos || $count == $return_parm_pos) { 1605 &debugPrint( $routine, "Skipping parm $parm because of position or return" ); 1606 # Skip this arg in the definition 1607 ; 1608 } 1609 else { 1610 $args_printed ++; 1611 if ($first) { $first = 0; } 1612 else { print $OUTFD ", "; } 1613 1614 if ($parm =~/\[/) { 1615 print "Processing array argument ...\n" if $gDebug; 1616 $qualifier = ""; 1617 if ($parm =~ /^\s*const\s+(.*)/) { 1618 $qualifier = "const "; 1619 $parm = $1; 1620 } 1621 # Argument type is array, so we need to 1622 # a) place parameter correctly 1623 # Split into raw type and [] 1624 # Handle multidim arrays as well (Range_excl/incl) 1625 # Use \S* instead of the equivalent [^\s]*. 1626 # See ../f77/buildiface for an explanation 1627 $foundbrack = ""; # We actually ignore foundbrack 1628 if ($parm =~ /\s*(\S*)\s*(\[\s*\])(.*)/) { 1629 $basetype = $1; 1630 $foundbrack = $2; 1631 $extrabracks = $3; 1632 $otherdims = ""; 1633 } 1634 else { 1635 print STDERR "Internal error. Could not find basetype\n"; 1636 print STDERR "This may be a bug in perl in the handling of certain expressions\n"; 1637 } 1638 # Convert C to C++ types 1639 $cxxtype = $basetype; 1640 $cxxtype =~ s/MPI_//; 1641 if ($extrabracks =~ /(\[[\d\s]*\])/) { 1642 $otherdims = $1; 1643 } 1644 print $OUTFD "$qualifier$cxxtype v$count\[\]$otherdims"; 1645 } 1646 elsif ($parm =~ /\.\.\./) { 1647 # Special case for varargs. Only ints! 1648 print $OUTFD $parm; 1649 } 1650 else { 1651 # Convert C to C++ types 1652 $cxxtype = $parm; 1653 if ($cxxtype =~ /MPI_/) { 1654 $cxxtype =~ s/\*/\&/; 1655 } 1656 $cxxtype =~ s/MPI_//; 1657 print $OUTFD "${cxxtype} v$count"; 1658 } 1659 } 1660 $count++; 1661 } 1662 if ($args_printed == 0) { print $OUTFD "void"; } 1663 print $OUTFD " )"; 1664} 1665 1666# Count the number of parameters. Don't count MPI_xxx_IGNORE 1667sub GetArgCount { 1668 my $args = $_[0]; 1669 # First, remove any special chars 1670 $args =~ s/,\s*%%\w*%%//g; 1671 my @parms = split(/\s*,\s*/,$args); 1672 return $#parms + 1; 1673} 1674 1675# Print the arguments for the routine CALL. 1676# Handle the special arguments 1677sub print_call_args { 1678 my @parms = split(/\s*,\s*/, $_[1] ); 1679 my $OUTFD = $_[0]; 1680 my $class_type = $_[2]; # ?? 1681 my $arginfo = $_[3]; # Value of <class>_hash{routine)} 1682 my $count = 1; 1683 $first = 1; 1684 1685 my $is_static = 0; 1686 1687 if ($arginfo =~ /^static:/) { $is_static = 1; } 1688 1689 print $OUTFD "( "; 1690 1691 # Special case: if the only parm is "void", remove it from the list 1692 if ($#parms == 0 && $parms[0] eq "void") { 1693 $#parms = -1; 1694 } 1695 1696 # class_pos is the position of the class variable in the argument list. 1697 # If specified by parm type, we must find it 1698 $class_pos = ""; 1699 if ($class_pos eq "" && !$is_static) { 1700 $class_pos = 1; 1701 foreach $parm (@parms) { 1702 if ($parm =~ /$class_type/) { 1703 last; 1704 } 1705 $class_pos++; 1706 } 1707 } 1708 1709 my $lcclass = lc($fullclassname{$class}); 1710 my $shortclass = $class; # ??? FIXME 1711 my $lctopclass = $lcclass; 1712 # For derived classes, we sometimes need to know the name of the 1713 # top-most class, particularly for the "the_real_xxx" name. 1714 if (defined($mytopclass{$lcclass})) { 1715 $lctopclass = $mytopclass{$lcclass}; 1716 } 1717 print "$routine-$count\n" if $gDebug; 1718 foreach $parm (@parms) { 1719 if (!$first) { print $OUTFD ", "; } else { $first = 0; } 1720 1721 # Special handling must preempt any other handling 1722 if (defined($funcArgMap{"${routine}-$count"}) || 1723 defined($funcArgMap{"${class}-${routine}-${count}"})) { 1724 &DoSpecialArgProcessing( $OUTFD, $routine, $count, "call" ); 1725 } 1726 elsif ($count == $return_parm_pos) { 1727 # We may need to pass the address of a temporary object 1728 # We'll unilateraly assume this for now 1729 # This must be first, so that it has a priority over the 1730 # class pos location. 1731 if ($parm =~ /MPI_/ && !($parm =~ /MPI_Offset/) && 1732 !($parm =~ /MPI_Aint/) ) { 1733 my $lctype = $real_return_type; 1734 # Convert class_type to the appropriate name 1735 $lctype = lc($lctype); 1736 if (defined($mytopclass{$lctype})) { 1737 $lctype = $mytopclass{$lctype}; 1738 } 1739 # Handle the MPIO_Request problem (temp until ROMIO uses 1740 # MPI_Requests) 1741 $cast = ""; 1742 if ($parm =~ /MPI_Request/ && 1743 $class eq "file") { 1744 $cast = "(MPIO_Request *)"; 1745 } 1746 print $OUTFD "$cast&(v$count.the_real_$lctype)"; 1747 } 1748 else { 1749 print $OUTFD "&v$count"; 1750 } 1751 } 1752 elsif ($count == $class_pos) { 1753 # Skip this arg in the definition 1754 if ($parm =~ /\*/) { 1755 print $OUTFD "($parm) &the_real_$lctopclass"; 1756 } 1757 else { 1758 print $OUTFD "($parm) the_real_$lctopclass"; 1759 } 1760 } 1761 elsif ($parm =~ /%%(.*)%%/) { 1762 print $OUTFD "$1"; 1763 } 1764 else { 1765 # Convert to/from object type as required. 1766 if (defined($argsneedcast{$parm})) { 1767 $argval = "v$count"; 1768 $callparm = $argsneedcast{$parm}; 1769 $callparm =~ s/ARG/$argval/; 1770 1771 print $OUTFD &HandleObjectParm( $parm, $argval ); 1772 } 1773 else { 1774 print $OUTFD &HandleObjectParm( $parm, "v$count" ); 1775 } 1776 } 1777 $count++; 1778 } 1779 print $OUTFD " )"; 1780} 1781 1782# Print the option function attribute; this supports GCC, particularly 1783# the __atribute__ weak option. 1784sub print_attr { 1785# if ($do_weak) { 1786# print $OUTFD "FUNC_ATTRIBUTES\n"; 1787# } 1788} 1789 1790# 1791# Look through $args for parameter names (foo\s\s*name) 1792# and remove them 1793sub clean_args { 1794 my $newargs = ""; 1795 my $comma = ""; 1796 my $qualifier = ""; 1797 for $parm (split(',',$args)) { 1798 $saveparm = $parm; 1799 $qualifier = ""; 1800 # Remove any leading or trailing spaces 1801 #$parm =~ s/^const\s//; # Remove const if present 1802 # In MPI-2, we needed to remove const in a few places. 1803 # In MPI-3, we need to preserve the const, since these values 1804 # are used to perform the necessary casts 1805 $parm =~ s/^\s*//; 1806 $parm =~ s/\s*$//; 1807 # First, strip off (but remember!) any qualifiers. These 1808 # could be const or restrict, though for MPI, only restrict 1809 # is used. 1810 if ($parm =~ /^(const\s+)(.*)/) { 1811 $qualifier = $1; 1812 $parm = $2; 1813 } 1814 # Handle parameters with parameter names 1815 # Handle these cases: 1816 # <type> name 1817 # <type> *name 1818 # <type> name[] 1819 if ( ($parm =~ /^([A-Za-z0-9_]+)\s+[A-Za-z0-9_]+$/) ) { 1820 $parm = $1; 1821 } 1822 elsif ( ($parm =~ /^([A-Za-z0-9_]+\s*\*)\s*[A-Za-z0-9_]+$/) ) { 1823 $parm = $1; 1824 } 1825 elsif ( ($parm =~ /^([A-Za-z0-9_]+\s)\s*[A-Za-z0-9_]+\s*(\[\])(\[3\])?$/) ) { 1826 $parm = "$1$2$3"; 1827 } 1828 # Restore qualifier, if any 1829 $parm = $qualifier.$parm; 1830 print "$saveparm -> $parm\n" if $gDebug; 1831 $newargs .= "$comma$parm"; 1832 $comma = ","; 1833 } 1834 print "$newargs\n" if $gDebug; 1835 $args = $newargs; 1836} 1837 1838# Print out the constants. 1839# PrintConstants( FD, giveValue ) 1840# if GiveValue is true, defint the value, otherwise, make it external 1841sub PrintConstants { 1842 my ($OUTFD, $giveValue) = @_; 1843 my $extern = "extern "; 1844 if ($giveValue) { $extern = ""; } 1845 1846 # Initialize the datatypes. 1847 # We do not use MPI:: within the MPI namespace 1848 foreach $dtype (@dtypes) { 1849 print $OUTFD "${extern}Datatype $dtype"; 1850 if ($giveValue) { print $OUTFD "(MPI_$dtype);\n"; } 1851 else { print $OUTFD ";\n"; } 1852 } 1853 # special case 1854 if ($giveValue) { 1855 print $OUTFD "Datatype TWOINT(MPI_2INT);\n"; 1856 } 1857 else { 1858 print $OUTFD "extern Datatype TWOINT;\n"; 1859 } 1860 # Add the C++ only types (e.g., BOOL, COMPLEX). These have no 1861 # C counterpart; their MPI Datatype handles are determined by the 1862 # configure step and inserted into mpicxx.h as #define's 1863 foreach $dtype (@cppdtypes) { 1864 print $OUTFD "${extern}Datatype $dtype"; 1865 if ($giveValue) { print $OUTFD "(MPIR_CXX_$dtype);\n"; } 1866 else { 1867 print $OUTFD ";\n"; 1868 print $OUTFD "#define MPIR_CXX_$dtype \@MPIR_CXX_${dtype}\@\n"; 1869 } 1870 } 1871 1872 print $OUTFD "${extern}Datatype DATATYPE_NULL;\n"; 1873 1874 # Fortran types 1875 if ($giveValue) { 1876 print $OUTFD " 1877#ifdef HAVE_FORTRAN_BINDING 1878Datatype INTEGER(MPI_INTEGER); 1879Datatype REAL(MPI_REAL); 1880Datatype DOUBLE_PRECISION(MPI_DOUBLE_PRECISION); 1881Datatype F_COMPLEX(MPI_COMPLEX); 1882Datatype F_DOUBLE_COMPLEX(MPI_DOUBLE_COMPLEX); 1883Datatype LOGICAL(MPI_LOGICAL); 1884Datatype CHARACTER(MPI_CHARACTER); 1885Datatype TWOREAL(MPI_2REAL); 1886Datatype TWODOUBLE_PRECISION(MPI_2DOUBLE_PRECISION); 1887Datatype TWOINTEGER(MPI_2INTEGER); 1888#endif\n"; 1889 } 1890 else { 1891 # This is for the mpicxx.h.in file, so instead of assuming that 1892 # we have mpichconf.h (which we do not, so as to keep the user's 1893 # CPP name space clean), we directly set this value 1894 print $OUTFD " 1895#if \@FORTRAN_BINDING\@ 1896extern Datatype INTEGER; 1897extern Datatype REAL; 1898extern Datatype DOUBLE_PRECISION; 1899extern Datatype F_COMPLEX; 1900extern Datatype F_DOUBLE_COMPLEX; 1901extern Datatype LOGICAL; 1902extern Datatype CHARACTER; 1903extern Datatype TWOREAL; 1904extern Datatype TWODOUBLE_PRECISION; 1905extern Datatype TWOINTEGER; 1906#endif\n"; 1907 } 1908 # Still to do: Fortran optional types, integer1,2,4, real2,4,8, 1909 1910 # Initialize the operations 1911 foreach $op (@ops) { 1912 print $OUTFD "${extern}const Op $op"; 1913 if ($giveValue) { print $OUTFD "(MPI_$op);\n"; } 1914 else { print $OUTFD ";\n"; } 1915 } 1916 print $OUTFD "${extern}const Op OP_NULL;\n"; 1917 1918 # Predefined communicators and groups 1919 if ($giveValue) { 1920 print $OUTFD "Intracomm COMM_WORLD(MPI_COMM_WORLD);\n"; 1921 print $OUTFD "Intracomm COMM_SELF(MPI_COMM_SELF);\n"; 1922 print $OUTFD "const Group GROUP_EMPTY(MPI_GROUP_EMPTY);\n"; 1923 } 1924 else { 1925 #print $OUTFD "extern Intracomm COMM_WORLD;\n"; 1926 print $OUTFD "extern Intracomm COMM_SELF;\n"; 1927 print $OUTFD "extern const Group GROUP_EMPTY;\n"; 1928 } 1929 # COMM_NULL can't be a Comm since Comm is an abstract base class. 1930 # Following the model of Intracomm etc., we make this a separate class, 1931 # and a peer to the other communicator classes. 1932 print $OUTFD "${extern}const Nullcomm COMM_NULL;\n"; 1933 print $OUTFD "${extern}const Group GROUP_NULL;\n"; 1934 1935 # Predefined requests 1936 print $OUTFD "${extern}const Request REQUEST_NULL;\n"; 1937 1938 # Predefined errhandlers 1939 print $OUTFD "${extern}const Errhandler ERRHANDLER_NULL;\n"; 1940 if ($giveValue) { 1941 print $OUTFD "const Errhandler ERRORS_RETURN(MPI_ERRORS_RETURN);\n"; 1942 print $OUTFD "const Errhandler ERRORS_ARE_FATAL(MPI_ERRORS_ARE_FATAL);\n"; 1943 # Errors_return is not quite right for errors-throw-exceptions, 1944 # but it is close. 1945 print $OUTFD "const Errhandler ERRORS_THROW_EXCEPTIONS(MPIR_ERRORS_THROW_EXCEPTIONS);\n"; 1946 } 1947 else { 1948 print $OUTFD "extern const Errhandler ERRORS_RETURN;\n"; 1949 print $OUTFD "extern const Errhandler ERRORS_ARE_FATAL;\n"; 1950 print $OUTFD "extern const Errhandler ERRORS_THROW_EXCEPTIONS;\n"; 1951 } 1952 1953 # Predefined info 1954 print $OUTFD "${extern}const Info INFO_NULL;\n"; 1955 1956 # Predefined File and Win 1957 print $OUTFD "${extern}const Win WIN_NULL;\n"; 1958 # Note that FILE_NULL cannot be const because you can set the 1959 # error handler on it. Also, because of that, we need to define it 1960 # earlier. 1961 if ($extern ne "extern ") { 1962 print $OUTFD "${extern}File FILE_NULL(MPI_FILE_NULL);\n"; 1963 } 1964 1965 # Predefined integers 1966 foreach $int (BSEND_OVERHEAD, KEYVAL_INVALID, CART, GRAPH, 1967 IDENT, SIMILAR, CONGRUENT, UNEQUAL, PROC_NULL, 1968 ANY_TAG, ANY_SOURCE, ROOT, TAG_UB, IO, HOST, WTIME_IS_GLOBAL, 1969 UNIVERSE_SIZE, LASTUSEDCODE, APPNUM, 1970 MAX_PROCESSOR_NAME, MAX_ERROR_STRING, 1971 MAX_PORT_NAME, MAX_OBJECT_NAME, 1972 MAX_INFO_VAL, MAX_INFO_KEY, 1973 UNDEFINED, LOCK_EXCLUSIVE, LOCK_SHARED, 1974 WIN_BASE, WIN_DISP_UNIT, WIN_SIZE, 1975 @errclasses, @typeclasses ) { 1976 print $OUTFD "${extern}const int $int"; 1977 if ($giveValue) { print $OUTFD "= MPI_$int;\n"; } 1978 else { print $OUTFD ";\n"; } 1979 } 1980 if ($do_DistGraphComm) { 1981 print $OUTFD "${extern}const int DIST_GRAPH"; 1982 if ($giveValue) { print $OUTFD "= MPI_$int;\n"; } 1983 else { print $OUTFD ";\n"; } 1984 } 1985 # Handle seek as a special case 1986 print $OUTFD "#if defined(MPI_SEEK_SET) && !defined(MPICH_IGNORE_CXX_SEEK) && !defined(SEEK_SET)\n"; 1987 foreach $int (SEEK_SET, SEEK_END, SEEK_CUR) { 1988 print $OUTFD "${extern}const int $int"; 1989 if ($giveValue) { print $OUTFD " = MPI_$int;\n"; } 1990 else { print $OUTFD ";\n"; } 1991 } 1992 print $OUTFD "#endif\n"; 1993 1994 foreach $int (DISTRIBUTE_BLOCK, DISTRIBUTE_CYCLIC, 1995 DISTRIBUTE_DFLT_DARG, DISTRIBUTE_NONE, ORDER_C, 1996 ORDER_FORTRAN) { 1997 print $OUTFD "${extern}const int $int"; 1998 if ($giveValue) { print $OUTFD " = MPI_$int;\n"; } 1999 else { print $OUTFD ";\n"; } 2000 } 2001 2002 print $OUTFD "// Include these only if MPI-IO is available\n"; 2003 print $OUTFD "#ifdef MPI_MODE_RDONLY\n"; 2004 2005 # Other file constants 2006 foreach $int (MAX_DATAREP_STRING) { 2007 print $OUTFD "${extern}const int $int"; 2008 if ($giveValue) { print $OUTFD " = MPI_$int;\n"; } 2009 else { print $OUTFD ";\n"; } 2010 } 2011 foreach $int (DISPLACEMENT_CURRENT) { 2012 print $OUTFD "${extern}const MPI_Offset $int"; 2013 if ($giveValue) { print $OUTFD " = MPI_$int;\n"; } 2014 else { print $OUTFD ";\n"; } 2015 } 2016 2017 # MPI Mode 2018 foreach $int (APPEND, CREATE, DELETE_ON_CLOSE, EXCL, 2019 RDONLY, RDWR, SEQUENTIAL, UNIQUE_OPEN, WRONLY) { 2020 print $OUTFD "${extern}const int MODE_$int"; 2021 if ($giveValue) { print $OUTFD " = MPI_MODE_$int;\n"; } 2022 else { print $OUTFD ";\n"; } 2023 } 2024 print $OUTFD "#endif // IO\n"; 2025 2026 # Some modes are for RMA, not I/O 2027 foreach $int (NOCHECK,NOPRECEDE, NOPUT, NOSTORE, NOSUCCEED) { 2028 print $OUTFD "${extern}const int MODE_$int"; 2029 if ($giveValue) { print $OUTFD " = MPI_MODE_$int;\n"; } 2030 else { print $OUTFD ";\n"; } 2031 } 2032 2033 # Modes for comm_split_type 2034 foreach $int (SHARED) { 2035 print $OUTFD "${extern}const int COMM_TYPE_$int"; 2036 if ($giveValue) { print $OUTFD " = MPI_COMM_TYPE_$int;\n"; } 2037 else { print $OUTFD ";\n"; } 2038 } 2039 2040 # MPI Combiners 2041 foreach $int (CONTIGUOUS, DARRAY, DUP, F90_COMPLEX, F90_INTEGER, 2042 F90_REAL, HINDEXED_INTEGER, HINDEXED, HVECTOR_INTEGER, 2043 HVECTOR, INDEXED_BLOCK, INDEXED, NAMED, RESIZED, 2044 STRUCT_INTEGER, STRUCT, SUBARRAY, VECTOR, HINDEXED_BLOCK) { 2045 print $OUTFD "${extern}const int COMBINER_$int"; 2046 if ($giveValue) { print $OUTFD " = MPI_COMBINER_$int;\n"; } 2047 else { print $OUTFD ";\n"; } 2048 } 2049 2050 # MPI Thread levels 2051 foreach $int (FUNNELED, MULTIPLE, SERIALIZED, SINGLE) { 2052 print $OUTFD "${extern}const int THREAD_$int"; 2053 if ($giveValue) { print $OUTFD " = MPI_THREAD_$int;\n"; } 2054 else { print $OUTFD ";\n"; } 2055 } 2056 # MPI Empty argvs 2057 if ($giveValue) { 2058 print $OUTFD "const char ** const ARGV_NULL = 0;\n"; 2059 print $OUTFD "const char *** const ARGVS_NULL = 0;\n"; 2060 } 2061 else { 2062 print $OUTFD "extern const char ** const ARGV_NULL;\n"; 2063 print $OUTFD "extern const char *** const ARGVS_NULL;\n"; 2064 } 2065 2066 # Predefined other 2067 if ($giveValue) { 2068 print $OUTFD "void * const BOTTOM = MPI_BOTTOM;\n"; 2069 print $OUTFD "void * const IN_PLACE = MPI_IN_PLACE;\n"; 2070 } 2071 else { 2072 print $OUTFD "extern void * const BOTTOM;\n"; 2073 print $OUTFD "extern void * const IN_PLACE;\n"; 2074 } 2075} 2076 2077# 2078# Build the special routines 2079sub build_specials { 2080 # The init routine contains some configure-time values. 2081 my $filename = "initcxx.cxx"; 2082 open( $OUTFD, ">${filename}.new" ) || die "Cannot open ${filename}.new\n"; 2083 $files[$#files+1] = "initcxx.cxx"; 2084 &print_header; 2085 print $OUTFD "#include \"mpi.h\"\n"; 2086 print $OUTFD "#include <stdarg.h>\n"; # Required for pcontrol 2087 print $OUTFD "#include \"mpichconf.h\"\n"; # Requires for HAVE_FORTRAN_BINDING 2088 2089 # Add exception for coding style checker 2090 print $OUTFD "/* style:PMPIuse:PMPI_Type_set_name:4 sig:0 */\n"; 2091 2092 # The coverage header is included in mpicxx.h.in 2093 #&printCoverageHeader( $OUTFD, 0 ); 2094 2095 print $OUTFD " 2096// #define MPIX_TRACE_MEMORY 2097#ifdef MPIX_TRACE_MEMORY 2098int _mpi_lineno = __LINE__; 2099// We need stdlib.h for size_t. But that can cause problems if the 2100// header isn't C++ clean. Instead, we just include a definition 2101// for size_t. If this is not the correct size, then edit this line 2102// (Note that this is needed only when memory tracing is enabled) 2103// FIXME: determine whether the type definition is needed, and include the 2104// correct definition. 2105typedef unsigned int size_t; 2106extern \"C\" void *MPL_trmalloc( size_t, int, const char [] ); 2107extern \"C\" void MPL_trfree( void *, int, const char [] ); 2108extern \"C\" void MPL_trdump( void *, int ); 2109void *operator new(size_t size) { 2110 void *p = MPL_trmalloc( size, _mpi_lineno, __FILE__ ); 2111 return p;} 2112void operator delete(void *p) { 2113 MPL_trfree( p, _mpi_lineno, __FILE__ );} 2114void *operator new[]( size_t size) { 2115 void *p = MPL_trmalloc( size, _mpi_lineno, __FILE__ ); 2116 return p;} 2117void operator delete[](void *p) { 2118 MPL_trfree( p, _mpi_lineno, __FILE__ );} 2119#define MPIX_TRSummary() MPL_trdump( 0, -1 ) 2120#define MPIX_SetLineno _mpi_lineno = __LINE__ + 1 2121#else 2122#define MPIX_TRSummary() 2123#define MPIX_SetLineno 2124#endif\n"; 2125 2126 # Start the namespace 2127 print $OUTFD "namespace MPI {\n"; 2128 2129 &PrintConstants( $OUTFD, 1 ); 2130 2131 print $OUTFD "void Init"; 2132 $args = ""; 2133 &print_args( $OUTFD, $args ); 2134 &print_attr; 2135 print $OUTFD "{\n"; 2136 print $OUTFD " MPI_Init( 0, 0 );\n"; 2137 &printCoverageInitialize( $OUTFD ); 2138 print $OUTFD "}\n"; 2139 2140 # 2141 # The following may not be quite right because they don't include 2142 # any attributes that we may include with the definitions. However, 2143 # this is easier than forcing the print_args routine to handle these 2144 # simple cases. 2145 # 2146 print $OUTFD "void Init( int &argc, char **&argv ) 2147{ 2148 MPI_Init( &argc, &argv );\n"; 2149 &printCoverageInitialize( $OUTFD ); 2150 print $OUTFD "}\n"; 2151 2152 print $OUTFD "int Init_thread"; 2153 $routine = "Init_thread"; # So we'll know for debugging 2154 # The two args are needed to tell print_args that one is the output 2155 $return_parm_pos = 2; 2156 #$args = "int,int"; 2157 # Grr. Under Cygwin, we needed two... 2158 $args = "int"; 2159 &print_args( $OUTFD, $args ); 2160 &print_attr; 2161 print $OUTFD "{ 2162 int provided; 2163 MPI_Init_thread( 0, 0, v1, &provided );\n"; 2164 &printCoverageInitialize( $OUTFD ); 2165 print $OUTFD "\ 2166 return provided; 2167}\n"; 2168 # 2169 # The following may not be quite right because they don't include 2170 # any attributes that we may include with the definitions. However, 2171 # this is easier than forcing the print_args routine to handle these 2172 # simple cases. 2173 # 2174 print $OUTFD "int Init_thread( int &argc, char **&argv, int req ) 2175{ 2176 int provided; 2177 MPI_Init_thread( &argc, &argv, req, &provided );\n"; 2178 2179 &printCoverageInitialize( $OUTFD ); 2180 print $OUTFD " return provided;\n}\n"; 2181 2182 print $OUTFD "void Finalize"; 2183 $args = ""; 2184 &print_args( $OUTFD, $args ); 2185 &print_attr; 2186 print $OUTFD "{\n"; 2187 &printCoverageFinalize( $OUTFD ); 2188 print $OUTFD " MPIX_TRSummary();\n"; 2189 print $OUTFD " MPI_Finalize( );\n"; 2190 print $OUTFD "}\n"; 2191 2192 print $OUTFD "bool Is_initialized(void) 2193 { 2194 int flag;\n"; 2195 &printCoverageStart( $OUTFD, "Initialized", 0 ); 2196 print $OUTFD "\ 2197 MPI_Initialized( &flag );\n"; 2198 &printCoverageEnd( $OUTFD, "Initialized", 0 ); 2199 # Microsoft C++ compiler complains about using an explicit cast to bool (!) 2200 print $OUTFD "\ 2201 return (flag != 0); 2202 }\n"; 2203 2204 print $OUTFD "void Compute_dims( int nnodes, int ndims, int dims[] ) 2205 {\n"; 2206 &printCoverageStart( $OUTFD, "Dims_create", 3 ); 2207 print $OUTFD "\ 2208 MPIX_CALLWORLD( MPI_Dims_create( nnodes, ndims, dims ) );\n"; 2209 &printCoverageEnd( $OUTFD, "Dims_create", 3 ); 2210 print $OUTFD "\ 2211 }\n"; 2212 2213 print $OUTFD "void Attach_buffer( void *buffer, int size ) 2214 {\n"; 2215 &printCoverageStart( $OUTFD, "Buffer_attach", 2 ); 2216 print $OUTFD "\ 2217 MPIX_CALLWORLD( MPI_Buffer_attach( buffer, size ) );\n"; 2218 &printCoverageEnd( $OUTFD, "Buffer_attach", 2 ); 2219 print $OUTFD "\ 2220 }\n"; 2221 2222 print $OUTFD "int Detach_buffer( void *&buffer ) 2223 { 2224 int size;\n"; 2225 &printCoverageStart( $OUTFD, "Buffer_detach", 2 ); 2226 print $OUTFD "\ 2227 MPIX_CALLWORLD( MPI_Buffer_detach( &buffer, &size ) );\n"; 2228 &printCoverageEnd( $OUTFD, "Buffer_detach", 2 ); 2229 print $OUTFD "\ 2230 return size; 2231 }\n"; 2232 2233 print $OUTFD "void Get_processor_name( char *name, int &resultlen ) 2234 {\n"; 2235 &printCoverageStart( $OUTFD, "Get_processor_name", 2 ); 2236 print $OUTFD "\ 2237 MPIX_CALLWORLD( MPI_Get_processor_name( name, &resultlen ) );\n"; 2238 &printCoverageEnd( $OUTFD, "Get_processor_name", 2 ); 2239 print $OUTFD "\ 2240 }\n"; 2241 2242 # The MPI-2 specification specifies Pcontrol as taking const int, 2243 # not just int, and some C++ compilers will (correctly) require this 2244 print $OUTFD "void Pcontrol( const int v, ... ) 2245 { 2246 va_list ap; 2247 va_start(ap,v);\n"; 2248 &printCoverageStart( $OUTFD, "Pcontrol", -1 ); 2249 print $OUTFD "\ 2250 MPIX_CALLWORLD( MPI_Pcontrol( (int)v, ap ) );\n"; 2251 &printCoverageEnd( $OUTFD, "Pcontrol", -1 ); 2252 print $OUTFD "\ 2253 }\n"; 2254 2255 print $OUTFD "int Get_error_class( int errcode ) 2256 { 2257 int errclass;\n"; 2258 &printCoverageStart( $OUTFD, "Error_class", 1 ); 2259 print $OUTFD "\ 2260 MPIX_CALLWORLD( MPI_Error_class( errcode, &errclass ) );\n"; 2261 &printCoverageEnd( $OUTFD, "Error_class", 1 ); 2262 print $OUTFD "\ 2263 return errclass; 2264 }\n"; 2265 2266 print $OUTFD "void Get_error_string( int errcode, char *name, int &resultlen ) 2267 {\n"; 2268 &printCoverageStart( $OUTFD, "Error_string", 3 ); 2269 print $OUTFD "\ 2270 MPIX_CALLWORLD( MPI_Error_string( errcode, name, &resultlen ) );\n"; 2271 &printCoverageEnd( $OUTFD, "Error_string", 3 ); 2272 print $OUTFD "\ 2273 }\n"; 2274 2275 print $OUTFD "Aint Get_address( const void *ptr ) 2276 { 2277 MPI_Aint a;\n"; 2278 &printCoverageStart( $OUTFD, "Get_address", 2 ); 2279 print $OUTFD "\ 2280 MPI_Get_address( ptr, &a );\n"; 2281 &printCoverageEnd( $OUTFD, "Get_address", 2 ); 2282 print $OUTFD "\ 2283 return (Aint)a; 2284 }\n"; 2285 2286 2287 print $OUTFD "void *Alloc_mem( Aint size, const Info &info ) 2288 { 2289 void *result;\n"; 2290 &printCoverageStart( $OUTFD, "Alloc_mem", 2 ); 2291 print $OUTFD "\ 2292 MPIX_CALLWORLD( MPI_Alloc_mem( size, (MPI_Info)info, &result ) );\n"; 2293 &printCoverageEnd( $OUTFD, "Alloc_mem", 2 ); 2294 print $OUTFD "\ 2295 return result; 2296 }\n"; 2297 2298 print $OUTFD "void Free_mem( void * base ) 2299 {\n"; 2300 &printCoverageStart( $OUTFD, "Free_mem", 1 ); 2301 print $OUTFD "\ 2302 MPIX_CALLWORLD( MPI_Free_mem( base ) );\n"; 2303 &printCoverageEnd( $OUTFD, "Free_mem", 1 ); 2304 print $OUTFD "\ 2305 }\n"; 2306 2307 # Init is a difficult function because we must allow C to call a 2308 # C++ function. We do this by getting help from the MPI implementation 2309 # which invokes the MPIR_Call_op_fn routine, with a pointer to the 2310 # C++ routine to invoke. 2311 # 2312 # Note: Some compilers complain about the cast to the 2313 # (void (*)(void)) function, expecting an `extern "C"' as well, but 2314 # other compilers do not accept the extern "C". Sigh. 2315 print $OUTFD " 2316 extern \"C\" { 2317typedef void (*mpircallback)(void); 2318} 2319extern \"C\" void MPII_Op_set_cxx( MPI_Op, void (*)(void) ); 2320extern \"C\" 2321void MPIR_Call_op_fn( void *invec, void *outvec, int len, MPI_Datatype dtype, 2322 User_function *uop ) 2323{ 2324 MPI::Datatype cxxdtype = dtype; 2325 (*uop)( invec, outvec, len, cxxdtype ); 2326} 2327void Op::Init( User_function *f, bool commute ) 2328 {\n"; 2329&printCoverageStart( $OUTFD, "Op_create", 2 ); 2330 print $OUTFD "\ 2331 MPIX_CALLWORLD( MPI_Op_create( (MPI_User_function *)f, 2332 (int) commute, &the_real_op ) ); 2333 MPII_Op_set_cxx( the_real_op, (mpircallback) MPIR_Call_op_fn );\n"; 2334&printCoverageEnd( $OUTFD, "Op_create", 2 ); 2335print $OUTFD "\ 2336 }\n"; 2337 2338 # Keyval and attribute routines 2339 print $OUTFD <<EOT; 2340#include \"mpir_attr_generic.h\" 2341static 2342int 2343MPIR_Comm_delete_attr_cxx_proxy( 2344 MPI_Comm_delete_attr_function* user_function, 2345 MPI_Comm comm, 2346 int keyval, 2347 MPIR_Attr_type attrib_type, 2348 void* attrib, 2349 void* extra_state 2350 ) 2351{ 2352 void *value = 0; 2353 /* Make sure that the attribute value is delivered as a pointer */ 2354 if(MPII_ATTR_KIND(attrib_type) == MPII_ATTR_KIND(MPIR_ATTR_INT)){ 2355 value = &attrib; 2356 } 2357 else{ 2358 value = attrib; 2359 } 2360 MPI::Comm::Delete_attr_function* f = (MPI::Comm::Delete_attr_function*)user_function; 2361 2362 int ttype; 2363 MPI_Topo_test( comm, &ttype ); 2364 if (ttype == MPI_UNDEFINED) 2365 { 2366 MPI_Comm_test_inter( comm, &ttype ); 2367 if (ttype) 2368 { 2369 MPI::Intercomm c = comm; 2370 return f( c, keyval, value, extra_state ); 2371 } 2372 else 2373 { 2374 MPI::Intracomm c = comm; 2375 return f( c, keyval, value, extra_state ); 2376 } 2377 } 2378 else if (ttype == MPI_CART) 2379 { 2380 MPI::Cartcomm c = comm; 2381 return f( c, keyval, value, extra_state ); 2382 } 2383 else if (ttype == MPI_GRAPH) 2384 { 2385 MPI::Graphcomm c = comm; 2386 return f( c, keyval, value, extra_state ); 2387 } 2388EOT 2389 2390if ($do_DistGraphComm) { 2391 print $OUTFD <<EOT; 2392 else 2393 { 2394 MPI::Distgraphcomm c = comm; 2395 return f( c, keyval, value, extra_state ); 2396 } 2397EOT 2398} 2399else { 2400 print $OUTFD <<EOT; 2401 else return MPI_ERR_INTERN; 2402EOT 2403} 2404 print $OUTFD <<EOT; 2405} 2406static 2407int 2408MPII_Comm_copy_attr_cxx_proxy( 2409 MPI_Comm_copy_attr_function* user_function, 2410 MPI_Comm comm, 2411 int keyval, 2412 void* extra_state, 2413 MPIR_Attr_type attrib_type, 2414 void* attrib, 2415 void** new_value, 2416 int* flag 2417 ) 2418{ 2419 void *value = 0; 2420 /* Make sure that the attribute value is delivered as a pointer */ 2421 if(MPII_ATTR_KIND(attrib_type) == MPII_ATTR_KIND(MPIR_ATTR_INT)){ 2422 value = &attrib; 2423 } 2424 else{ 2425 value = attrib; 2426 } 2427 2428 *flag = 0; 2429 MPI::Comm::Copy_attr_function* f = (MPI::Comm::Copy_attr_function*)user_function; 2430 2431 int ttype; 2432 MPI_Topo_test( comm, &ttype ); 2433 if (ttype == MPI_UNDEFINED) 2434 { 2435 MPI_Comm_test_inter( comm, &ttype ); 2436 if (ttype) 2437 { 2438 MPI::Intercomm c = comm; 2439 return f( c, keyval, extra_state, value, new_value, *(bool*)flag ); 2440 } 2441 else 2442 { 2443 MPI::Intracomm c = comm; 2444 return f( c, keyval, extra_state, value, new_value, *(bool*)flag ); 2445 } 2446 } 2447 else if (ttype == MPI_CART) 2448 { 2449 MPI::Cartcomm c = comm; 2450 return f( c, keyval, extra_state, value, new_value, *(bool*)flag ); 2451 } 2452 else if (ttype == MPI_GRAPH) 2453 { 2454 MPI::Graphcomm c = comm; 2455 return f( c, keyval, extra_state, value, new_value, *(bool*)flag ); 2456 } 2457EOT 2458 2459if ($do_DistGraphComm) { 2460 print $OUTFD <<EOT; 2461else 2462 { 2463 MPI::Distgraphcomm c = comm; 2464 return f( c, keyval, extra_state, value, new_value, *(bool*)flag ); 2465 } 2466EOT 2467} 2468else { 2469 print $OUTFD <<EOT; 2470 else return MPI_ERR_INTERN; 2471EOT 2472} 2473 print $OUTFD <<EOT; 2474} 2475 2476int Comm::Create_keyval( Copy_attr_function *cf, Delete_attr_function *df, void *extra_state ) 2477{ 2478 int keyval; 2479 2480 if (cf == MPI::Comm::NULL_COPY_FN) cf = 0; 2481 if (df == MPI::Comm::NULL_DELETE_FN) df = 0; 2482EOT 2483 &printCoverageStart( $OUTFD, "Comm_create_keyval", 3 ); 2484 print $OUTFD <<EOT; 2485 MPIX_CALLWORLD( MPI_Comm_create_keyval( (MPI_Comm_copy_attr_function *)cf, 2486 (MPI_Comm_delete_attr_function *)df, 2487 &keyval, extra_state ) ); 2488 MPII_Keyval_set_proxy( keyval, MPII_Comm_copy_attr_cxx_proxy, MPIR_Comm_delete_attr_cxx_proxy ); 2489EOT 2490 &printCoverageEnd( $OUTFD, "Comm_create_keyval", 3 ); 2491 print $OUTFD <<EOT; 2492 return keyval; 2493} 2494 2495static 2496int 2497MPIR_Type_delete_attr_cxx_proxy( 2498 MPI_Type_delete_attr_function* user_function, 2499 MPI_Datatype datatype, 2500 int keyval, 2501 MPIR_Attr_type attrib_type, 2502 void* attrib, 2503 void* extra_state 2504 ) 2505{ 2506 MPI::Datatype d = datatype; 2507 MPI::Datatype::Delete_attr_function* f = (MPI::Datatype::Delete_attr_function*)user_function; 2508 void *value = 0; 2509 /* Make sure that the attribute value is delivered as a pointer */ 2510 if(MPII_ATTR_KIND(attrib_type) == MPII_ATTR_KIND(MPIR_ATTR_INT)){ 2511 value = &attrib; 2512 } 2513 else{ 2514 value = attrib; 2515 } 2516 return f( d, keyval, value, extra_state ); 2517} 2518 2519static 2520int 2521MPIR_Type_copy_attr_cxx_proxy( 2522 MPI_Type_copy_attr_function* user_function, 2523 MPI_Datatype datatype, 2524 int keyval, 2525 void* extra_state, 2526 MPIR_Attr_type attrib_type, 2527 void* attrib, 2528 void** new_value, 2529 int* flag 2530 ) 2531{ 2532 *flag = 0; 2533 MPI::Datatype d = datatype; 2534 MPI::Datatype::Copy_attr_function* f = (MPI::Datatype::Copy_attr_function*)user_function; 2535 void *value = 0; 2536 /* Make sure that the attribute value is delivered as a pointer */ 2537 if(MPII_ATTR_KIND(attrib_type) == MPII_ATTR_KIND(MPIR_ATTR_INT)){ 2538 value = &attrib; 2539 } 2540 else{ 2541 value = attrib; 2542 } 2543 return f( d, keyval, extra_state, value, new_value, *(bool*)flag ); 2544} 2545 2546int Datatype::Create_keyval( Copy_attr_function *cf, Delete_attr_function *df, void *extra_state ) 2547{ 2548 int keyval; 2549 2550 if (cf == MPI::Datatype::NULL_COPY_FN) cf = 0; 2551 if (df == MPI::Datatype::NULL_DELETE_FN) df = 0; 2552EOT 2553 &printCoverageStart( $OUTFD, "Type_create_keyval", 3 ); 2554 print $OUTFD <<EOT; 2555 MPIX_CALLWORLD( MPI_Type_create_keyval( (MPI_Type_copy_attr_function *)cf, 2556 (MPI_Type_delete_attr_function *)df, 2557 &keyval, extra_state ) ); 2558 MPII_Keyval_set_proxy( keyval, MPIR_Type_copy_attr_cxx_proxy, MPIR_Type_delete_attr_cxx_proxy ); 2559EOT 2560 &printCoverageEnd( $OUTFD, "Type_create_keyval", 3 ); 2561 print $OUTFD <<EOT; 2562 return keyval; 2563} 2564 2565static 2566int 2567MPIR_Win_delete_attr_cxx_proxy( 2568 MPI_Win_delete_attr_function* user_function, 2569 MPI_Win win, 2570 int keyval, 2571 MPIR_Attr_type attrib_type, 2572 void* attrib, 2573 void* extra_state 2574 ) 2575{ 2576 MPI::Win w = win; 2577 MPI::Win::Delete_attr_function* f = (MPI::Win::Delete_attr_function*)user_function; 2578 void *value = 0; 2579 /* Make sure that the attribute value is delivered as a pointer */ 2580 if(MPII_ATTR_KIND(attrib_type) == MPII_ATTR_KIND(MPIR_ATTR_INT)){ 2581 value = &attrib; 2582 } 2583 else{ 2584 value = attrib; 2585 } 2586 return f( w, keyval, value, extra_state ); 2587} 2588 2589static 2590int 2591MPIR_Win_copy_attr_cxx_proxy( 2592 MPI_Win_copy_attr_function* user_function, 2593 MPI_Win win, 2594 int keyval, 2595 void* extra_state, 2596 MPIR_Attr_type attrib_type, 2597 void* attrib, 2598 void** new_value, 2599 int* flag 2600 ) 2601{ 2602 *flag = 0; 2603 MPI::Win w = win; 2604 MPI::Win::Copy_attr_function* f = (MPI::Win::Copy_attr_function*)user_function; 2605 void *value = 0; 2606 /* Make sure that the attribute value is delivered as a pointer */ 2607 if(MPII_ATTR_KIND(attrib_type) == MPII_ATTR_KIND(MPIR_ATTR_INT)){ 2608 value = &attrib; 2609 } 2610 else{ 2611 value = attrib; 2612 } 2613 return f( w, keyval, extra_state, value, new_value, *(bool*)flag ); 2614} 2615 2616int Win::Create_keyval( Copy_attr_function *cf, Delete_attr_function *df, void *extra_state ) 2617{ 2618 int keyval; 2619 2620 if (cf == MPI::Win::NULL_COPY_FN) cf = 0; 2621 if (df == MPI::Win::NULL_DELETE_FN) df = 0; 2622EOT 2623 &printCoverageStart( $OUTFD, "Win_create_keyval", 3 ); 2624 print $OUTFD <<EOT; 2625 MPIX_CALLWORLD( MPI_Win_create_keyval( (MPI_Win_copy_attr_function *)cf, 2626 (MPI_Win_delete_attr_function *)df, 2627 &keyval, extra_state ) ); 2628 MPII_Keyval_set_proxy( keyval, MPIR_Win_copy_attr_cxx_proxy, MPIR_Win_delete_attr_cxx_proxy ); 2629EOT 2630 &printCoverageEnd( $OUTFD, "Win_create_keyval", 3 ); 2631 print $OUTFD <<EOT; 2632 return keyval; 2633} 2634 2635EOT 2636 2637print $OUTFD <<EOT; 2638// Provide a C routine that can call the C++ error handler, handling 2639// any calling-sequence change. 2640extern \"C\" void MPII_Errhandler_set_cxx( MPI_Errhandler, void (*)(void) ); 2641extern \"C\" 2642void MPIR_Call_errhandler_function( int kind, int *handle, int *errcode, 2643 void (*cxxfn)(void) ) 2644{ 2645 // Use horrible casts to get the correct routine signature 2646 switch (kind) { 2647 case 0: // comm 2648 { 2649 MPI_Comm *ch = (MPI_Comm *)handle; 2650 int flag; 2651 MPI::Comm::Errhandler_function *f = (MPI::Comm::Errhandler_function *)cxxfn; 2652 // Make an actual Comm (inter or intra-comm) 2653 MPI_Comm_test_inter( *ch, &flag ); 2654 if (flag) { 2655 MPI::Intercomm ic(*ch); 2656 (*f)( ic, errcode ); 2657 } 2658 else { 2659 MPI::Intracomm ic(*ch); 2660 (*f)( ic, errcode ); 2661 } 2662 } 2663 break; 2664#ifdef MPI_MODE_RDONLY 2665 case 1: // file 2666 { 2667 MPI::File fh = (MPI_File)*(MPI_File*)handle; 2668 MPI::File::Errhandler_function *f = (MPI::File::Errhandler_function *)cxxfn; 2669 (*f)( fh, errcode ); 2670 } 2671 break; 2672#endif // IO 2673 case 2: // win 2674 { 2675 MPI::Win fh = (MPI_Win)*(MPI_Win*)handle; 2676 MPI::Win::Errhandler_function *f = (MPI::Win::Errhandler_function *)cxxfn; 2677 (*f)( fh, errcode ); 2678 } 2679 break; 2680 } 2681} 2682#ifdef MPI_MODE_RDONLY 2683Errhandler File::Create_errhandler( Errhandler_function *f ) 2684{ 2685 MPI_Errhandler eh; 2686 MPI::Errhandler e1; 2687 MPI_File_create_errhandler( (MPI_File_errhandler_function *)f, &eh ); 2688 MPII_Errhandler_set_cxx( eh, 2689 (mpircallback)MPIR_Call_errhandler_function ); 2690 e1.the_real_errhandler = eh; 2691 return e1; 2692} 2693#endif // IO 2694Errhandler Comm::Create_errhandler( Errhandler_function *f ) 2695{ 2696 MPI_Errhandler eh; 2697 MPI::Errhandler e1; 2698 MPI_Comm_create_errhandler( (MPI_Comm_errhandler_function *)f, &eh ); 2699 MPII_Errhandler_set_cxx( eh, 2700 (mpircallback)MPIR_Call_errhandler_function ); 2701 e1.the_real_errhandler = eh; 2702 return e1; 2703} 2704Errhandler Win::Create_errhandler( Errhandler_function *f ) 2705{ 2706 MPI_Errhandler eh; 2707 MPI::Errhandler e1; 2708 MPI_Win_create_errhandler( (MPI_Win_errhandler_function *)f, &eh ); 2709 MPII_Errhandler_set_cxx( eh, 2710 (mpircallback)MPIR_Call_errhandler_function ); 2711 e1.the_real_errhandler = eh; 2712 return e1; 2713} 2714 2715 2716// Call_errhandler implementations. These sadly must contain a bit of logic to 2717// cover the ERRORS_THROW_EXCEPTIONS case. 2718void Comm::Call_errhandler( int errorcode ) const 2719{ 2720 // we must free the Errhandler object returned from Get_errhandler because 2721 // Get_errhandler adds a reference (the MPI Standard says as though a new 2722 // object were created) 2723 // First, be careful of the communicator. 2724 Errhandler current; 2725 if (the_real_comm == MPI_COMM_NULL) { 2726 current = MPI::COMM_WORLD.Get_errhandler(); 2727 } 2728 else { 2729 current = Get_errhandler(); 2730 } 2731 if (current == ERRORS_THROW_EXCEPTIONS) { 2732 current.Free(); 2733 throw Exception(errorcode); // throw by value, catch by reference 2734 } 2735 else { 2736 current.Free(); 2737 } 2738 MPI_Comm_call_errhandler( (MPI_Comm) the_real_comm, errorcode ); 2739} 2740 2741void Win::Call_errhandler( int errorcode ) const 2742{ 2743 // we must free the Errhandler object returned from Get_errhandler because 2744 // Get_errhandler adds a reference (the MPI Standard says as though a new 2745 // object were created) 2746 // First, be careful of the communicator. 2747 Errhandler current; 2748 if (the_real_win == MPI_WIN_NULL) { 2749 current = MPI::COMM_WORLD.Get_errhandler(); 2750 } 2751 else { 2752 current = Get_errhandler(); 2753 } 2754 if (current == ERRORS_THROW_EXCEPTIONS) { 2755 current.Free(); 2756 throw Exception(errorcode); // throw by value, catch by reference 2757 } 2758 else { 2759 current.Free(); 2760 } 2761 MPI_Win_call_errhandler( (MPI_Win) the_real_win, errorcode ); 2762} 2763 2764#ifdef MPI_MODE_RDONLY 2765void File::Call_errhandler( int errorcode ) const 2766{ 2767 // we must free the Errhandler object returned from Get_errhandler because 2768 // Get_errhandler adds a reference (the MPI Standard says as though a new 2769 // object were created) 2770 // Note that we are allowed to set handlers on FILE_NULL 2771 Errhandler current = Get_errhandler(); 2772 if (current == ERRORS_THROW_EXCEPTIONS) { 2773 current.Free(); 2774 throw Exception(errorcode); // throw by value, catch by reference 2775 } 2776 else { 2777 current.Free(); 2778 } 2779 MPI_File_call_errhandler( (MPI_File) the_real_file, errorcode ); 2780} 2781#endif // IO 2782 2783// Helper function to invoke the comm_world C++ error handler. 2784void MPIR_Call_world_errhand( int err ) 2785{ 2786 MPI::COMM_WORLD.Call_errhandler( err ); 2787} 2788 2789 2790EOT 2791 2792 # The data rep conversion functions need to be wrapped in C code 2793 # Only define this routine when MPI-IO is available (this is the same 2794 # test as used for the rest of the I/O routines ); 2795print $OUTFD "#ifdef MPI_MODE_RDONLY\n"; 2796 print $OUTFD " 2797extern \"C\" { 2798// 2799// Rather than use a registered interposer, instead we interpose, taking 2800// advantage of the extra_data field, similar to the handling of Grequest. 2801typedef struct { 2802 Datarep_conversion_function *read_fn; 2803 Datarep_conversion_function *write_fn; 2804 Datarep_extent_function *extent_fn; 2805 void *orig_extra_state; 2806 } MPIR_Datarep_data; 2807int MPIR_Call_datarep_read_fn( void *userbuf, MPI_Datatype datatype, 2808 int count, 2809 void *filebuf, MPI_Offset position, 2810 void *extra_state ) 2811{ 2812 MPIR_Datarep_data *ldata = (MPIR_Datarep_data *)extra_state; 2813 Datatype dtype = (Datatype)datatype; 2814 return (ldata->read_fn)( userbuf, dtype, count, filebuf, 2815 position, ldata->orig_extra_state); 2816} 2817int MPIR_Call_datarep_write_fn( void *userbuf, MPI_Datatype datatype, 2818 int count, 2819 void *filebuf, MPI_Offset position, 2820 void *extra_state ) 2821{ 2822 MPIR_Datarep_data *ldata = (MPIR_Datarep_data *)extra_state; 2823 Datatype dtype = (Datatype)datatype; 2824 return (ldata->write_fn)( userbuf, dtype, count, filebuf, 2825 position, ldata->orig_extra_state); 2826} 2827int MPIR_Call_datarep_extent_fn( MPI_Datatype datatype, MPI_Aint *extent, 2828 void *extra_state ) { 2829 MPIR_Datarep_data *ldata = (MPIR_Datarep_data *)extra_state; 2830 Aint myextent; 2831 int err; 2832 err = (ldata->extent_fn)( (Datatype)datatype, myextent, 2833 ldata->orig_extra_state); 2834 *extent = myextent; 2835 return err; 2836} 2837} /* extern C */ 2838void Register_datarep( const char *datarep, 2839 Datarep_conversion_function *read_fn, 2840 Datarep_conversion_function *write_fn, 2841 Datarep_extent_function *extent_fn, 2842 void *orig_extra_state ) 2843{ 2844 MPIR_Datarep_data *ldata = new(MPIR_Datarep_data); 2845 ldata->read_fn = read_fn; 2846 ldata->write_fn = write_fn; 2847 ldata->extent_fn = extent_fn; 2848 ldata->orig_extra_state = orig_extra_state; 2849 MPIX_CALLWORLD(MPI_Register_datarep( (char *)datarep, 2850 MPIR_Call_datarep_read_fn, 2851 MPIR_Call_datarep_write_fn, 2852 MPIR_Call_datarep_extent_fn, (void *)ldata )); 2853 /* Because datareps are never freed, the space allocated in this 2854 routine for ldata will never be freed */ 2855} 2856"; 2857print $OUTFD "#endif\n"; 2858 2859 2860 print $OUTFD "\ 2861void Datatype::Pack( const void *inbuf, int incount, void *outbuf, 2862 int outsize, int &position, const Comm &comm ) const {\n"; 2863 &printCoverageStart( $OUTFD, "Pack", 6 ); 2864 print $OUTFD "\ 2865 MPIX_CALLOBJ( comm, 2866 MPI_Pack( (void *)inbuf, incount, the_real_datatype, 2867 outbuf, outsize, &position, comm.the_real_comm ) );\n"; 2868 &printCoverageEnd( $OUTFD, "Pack", 6 ); 2869 print $OUTFD "\ 2870 }\n"; 2871 print $OUTFD "\ 2872int Datatype::Pack_size( int count, const Comm &comm ) const {\n"; 2873 &printCoverageStart( $OUTFD, "Pack_size", 6 ); 2874 print $OUTFD "\ 2875 int size; 2876 MPIX_CALLOBJ( comm, 2877 MPI_Pack_size( count, the_real_datatype, 2878 comm.the_real_comm, &size ) );\n"; 2879 &printCoverageEnd( $OUTFD, "Pack_size", 6 ); 2880 print $OUTFD "\ 2881 return size; 2882 }\n"; 2883 print $OUTFD "\ 2884void Datatype::Unpack( const void *inbuf, int insize, void *outbuf, 2885 int outcount, int &position, const Comm &comm ) const {\n"; 2886 &printCoverageStart( $OUTFD, "Unpack", 6 ); 2887 print $OUTFD "\ 2888 MPIX_CALLOBJ( comm, MPI_Unpack( (void *)inbuf, insize, 2889 &position, outbuf, outcount, 2890 the_real_datatype, comm.the_real_comm ) );\n"; 2891 &printCoverageEnd( $OUTFD, "Unpack", 6 ); 2892 print $OUTFD "\ 2893 }\n"; 2894 2895 # No coverage for Wtime and Wtick 2896 print $OUTFD "double Wtime(void) { return MPI_Wtime(); }\n"; 2897 print $OUTFD "double Wtick(void) { return MPI_Wtick(); }\n"; 2898 2899 print $OUTFD "\ 2900 Cartcomm Intracomm::Create_cart( int v2, const int * v3, const bool v4[], bool v5 ) const 2901 { 2902 Cartcomm v6; 2903 int *l4 = new int[v2]; 2904 int l5; 2905 { 2906 int i4; 2907 for (i4=0;i4<v2;i4++) { 2908 l4[i4] = v4[i4] == true ? 1 : 0; 2909 } 2910 } 2911 l5 = (v5 == true) ? 1 : 0;\n"; 2912 &printCoverageStart( $OUTFD, "Cart_create", 5 ); 2913 print $OUTFD "\ 2914 MPIX_CALLREF( this, 2915 MPI_Cart_create( (MPI_Comm) the_real_comm, v2, 2916 (int *)v3, l4, l5, &(v6.the_real_comm) ));\n"; 2917 &printCoverageEnd( $OUTFD, "Cart_create", 5 ); 2918 print $OUTFD "\ 2919 delete[] l4; 2920 return v6; 2921 }\n"; 2922 2923 print $OUTFD "\ 2924 Graphcomm Intracomm::Create_graph( int v2, const int * v3, const int * v4, bool v5 ) const 2925 { 2926 Graphcomm v6; 2927 int l5; 2928 l5 = (v5 == true) ? 1 : 0;\n"; 2929 &printCoverageStart( $OUTFD, "Graph_create", 6 ); 2930 print $OUTFD "\ 2931 MPIX_CALLREF( this, 2932 MPI_Graph_create( (MPI_Comm) the_real_comm, 2933 v2, (int *)v3, (int *)v4, l5, &(v6.the_real_comm) ));\n"; 2934 &printCoverageEnd( $OUTFD, "Graph_create", 6 ); 2935 print $OUTFD "\ 2936 return v6; 2937 }\n"; 2938 2939 if ($do_DistGraphComm) { 2940 print $OUTFD "\ 2941 Distgraphcomm Intracomm::Dist_graph_create( int v2, const int v3[], const int v4[], const int v5[], const int v6[], const MPI::Info &v7, bool v8 ) const 2942 { 2943 Distgraphcomm v9; 2944 int l8; 2945 l8 = (v8 == true) ? 1 : 0;\n"; 2946 &printCoverageStart( $OUTFD, "Dist_graph_create", 9 ); 2947 print $OUTFD "\ 2948 MPIX_CALLREF( this, 2949 MPI_Dist_graph_create( (MPI_Comm) the_real_comm, 2950 v2, (int *)v3, (int *)v4, (int *)v5, (int *)v6, 2951 (MPI_Info)v7, l8, &(v9.the_real_comm) ));\n"; 2952 &printCoverageEnd( $OUTFD, "Dist_graph_create", 9 ); 2953 print $OUTFD "\ 2954 return v9; 2955 } 2956 2957 Distgraphcomm Intracomm::Dist_graph_create( int v2, const int v3[], const int v4[], const int v5[], const MPI::Info &v7, bool v8 ) const 2958 { 2959 Distgraphcomm v9; 2960 int l8; 2961 l8 = (v8 == true) ? 1 : 0;\n"; 2962 &printCoverageStart( $OUTFD, "Dist_graph_create", 9 ); 2963 print $OUTFD "\ 2964 MPIX_CALLREF( this, 2965 MPI_Dist_graph_create( (MPI_Comm) the_real_comm, 2966 v2, (int *)v3, (int *)v4, (int *)v5, MPI_UNWEIGHTED, 2967 (MPI_Info)v7, l8, &(v9.the_real_comm) ));\n"; 2968 &printCoverageEnd( $OUTFD, "Dist_graph_create", 9 ); 2969 print $OUTFD "\ 2970 return v9; 2971 } 2972 2973 Distgraphcomm Intracomm::Dist_graph_create_adjacent( int v2, const int v3[], const int v4[], int v5, const int v6[], const int v7[], const MPI::Info &v8, bool v9 ) const 2974 { 2975 Distgraphcomm v10; 2976 int l9; 2977 l9 = (v9 == true) ? 1 : 0;\n"; 2978 &printCoverageStart( $OUTFD, "Dist_graph_create_adjacent", 9 ); 2979 print $OUTFD "\ 2980 MPIX_CALLREF( this, 2981 MPI_Dist_graph_create_adjacent( (MPI_Comm) the_real_comm, 2982 v2, (int *)v3, (int *)v4, v5, (int *)v6, (int *)v7, 2983 (MPI_Info)v8, l9, &(v10.the_real_comm) ));\n"; 2984 &printCoverageEnd( $OUTFD, "Dist_graph_create_adjacent", 10 ); 2985 print $OUTFD "\ 2986 return v10; 2987 } 2988 2989 Distgraphcomm Intracomm::Dist_graph_create_adjacent( int v2, const int v3[], int v5, const int v6[], const MPI::Info &v8, bool v9 ) const 2990 { 2991 Distgraphcomm v10; 2992 int l9; 2993 l9 = (v9 == true) ? 1 : 0;\n"; 2994 &printCoverageStart( $OUTFD, "Dist_graph_create_adjacent", 9 ); 2995 print $OUTFD "\ 2996 MPIX_CALLREF( this, 2997 MPI_Dist_graph_create_adjacent( (MPI_Comm) the_real_comm, 2998 v2, (int *)v3, MPI_UNWEIGHTED, v5, (int *)v6, MPI_UNWEIGHTED, 2999 (MPI_Info)v8, l9, &(v10.the_real_comm) ));\n"; 3000 &printCoverageEnd( $OUTFD, "Dist_graph_create_adjacent", 10 ); 3001 print $OUTFD "\ 3002 return v10; 3003 }\n"; 3004 3005 } # check on distgraphcomm implemented 3006 3007 print $OUTFD "\ 3008 Intracomm Intercomm::Merge( bool v2 ) const 3009 { 3010 Intracomm v3; 3011 int l2; 3012 l2 = (v2 == true) ? 1 : 0;\n"; 3013 &printCoverageStart( $OUTFD, "Intercomm_merge", 3 ); 3014 print $OUTFD "\ 3015 MPIX_CALLREF( this, 3016 MPI_Intercomm_merge( (MPI_Comm) the_real_comm, l2, 3017 &(v3.the_real_comm) ));\n"; 3018 &printCoverageEnd( $OUTFD, "Intercomm_merge", 3 ); 3019 print $OUTFD "\ 3020 return v3; 3021 }\n"; 3022 3023 # MPI-2 base routines 3024 &PrintWrapper( $OUTFD, "bool", "Is_finalized", "void", 3025 "int flag;", "Finalized", "&flag", "(flag != 0)" ); 3026 3027 &PrintWrapper( $OUTFD, "int", "Query_thread", "void", 3028 "int provided;", "Query_thread", "&provided", 3029 "provided" ); 3030 &PrintWrapper( $OUTFD, "bool", "Is_thread_main", "void", 3031 "int flag;", "Is_thread_main", "&flag", "(flag != 0)" ); 3032 &PrintWrapper( $OUTFD, "void", "Get_version", "int &v, int&sv", 3033 "", "", "&v,&sv", "" ); 3034 3035 &PrintWrapper( $OUTFD, "int", "Add_error_class", "void", 3036 "int eclass;", "", "&eclass", "eclass" ); 3037 &PrintWrapper( $OUTFD, "int", "Add_error_code", "int eclass", 3038 "int ecode;", "", "eclass, &ecode", "ecode" ); 3039 &PrintWrapper( $OUTFD, "void", "Add_error_string", 3040 "int ecode, const char *estring", 3041 "", "", "ecode, (char *)estring", "" ); 3042 3043 &PrintWrapper( $OUTFD, "void", "Lookup_name", 3044 "const char *sn, const Info &info, char *pn", 3045 "", "", "(char *)sn, (MPI_Info)info, pn", "" ); 3046 &PrintWrapper( $OUTFD, "void", "Publish_name", 3047 "const char *sn, const Info &info, const char *pn", 3048 "", "", "(char *)sn, (MPI_Info)info, (char *)pn", ""); 3049 &PrintWrapper( $OUTFD, "void", "Unpublish_name", 3050 "const char *sn, const Info &info, const char *pn", 3051 "", "", "(char *)sn, (MPI_Info)info, (char *)pn", ""); 3052 3053 &PrintWrapper( $OUTFD, "Intercomm", "Comm::Get_parent", "void", 3054 "MPI::Intercomm v;MPI_Comm vv;", 3055 "Comm_get_parent", 3056 "&vv", "(v = (Intercomm)vv, v)" ); 3057 &PrintWrapper( $OUTFD, "Intercomm", "Comm::Join", "const int fd", 3058 "MPI::Intercomm v;MPI_Comm vv;", 3059 "Comm_join", 3060 "fd,&vv", "(v = (Intercomm)vv,v)" ); 3061 3062 &PrintWrapper( $OUTFD, "void", "Close_port", 3063 "const char *pn", "", "", "(char *)pn", "" ); 3064 &PrintWrapper( $OUTFD, "void", "Open_port", 3065 "const Info &info, char *portname", "", "", 3066 "(MPI_Info)info, portname", "" ); 3067 3068 print $OUTFD " 3069// 3070// Rather than use a registered interposer, instead we interpose taking 3071// advantage of the extra_data field 3072typedef struct { 3073 MPI::Grequest::Query_function *query_fn; 3074 MPI::Grequest::Free_function *free_fn; 3075 MPI::Grequest::Cancel_function *cancel_fn; 3076 void *orig_extra_data; } MPIR_Grequest_data; 3077extern \"C\" int MPIR_Grequest_call_query_fn( void *extra_data, 3078 MPI_Status *status ) 3079{ 3080 int err; 3081 MPI::Status s; 3082 MPIR_Grequest_data *d = (MPIR_Grequest_data *)extra_data; 3083 3084 err = (d->query_fn)( d->orig_extra_data, s ); 3085 *status = s; 3086 3087 return err; 3088} 3089extern \"C\" int MPIR_Grequest_call_free_fn( void *extra_data ) 3090{ 3091 int err; 3092 MPIR_Grequest_data *d = (MPIR_Grequest_data *)extra_data; 3093 3094 err = (d->free_fn)( d->orig_extra_data ); 3095 3096 // Recover the storage that we used for the extra_data item. 3097 delete d; 3098 return err; 3099} 3100extern \"C\" int MPIR_Grequest_call_cancel_fn( void *extra_data, int done ) 3101{ 3102 int err; 3103 MPI::Status s; 3104 MPIR_Grequest_data *d = (MPIR_Grequest_data *)extra_data; 3105 3106 // Pass a C++ bool to the C++ version of the cancel function 3107 err = (d->cancel_fn)( d->orig_extra_data, done ? true : false ); 3108 return err; 3109} 3110Grequest Grequest::Start( Grequest::Query_function *query_fn, 3111 Grequest::Free_function *free_fn, 3112 Grequest::Cancel_function *cancel_fn, 3113 void *extra_state ) 3114{ 3115 MPI::Grequest req; 3116 MPIR_Grequest_data *d = new MPIR_Grequest_data; 3117 d->query_fn = query_fn; 3118 d->free_fn = free_fn; 3119 d->cancel_fn = cancel_fn; 3120 d->orig_extra_data = extra_state; 3121 MPI_Grequest_start( MPIR_Grequest_call_query_fn, 3122 MPIR_Grequest_call_free_fn, 3123 MPIR_Grequest_call_cancel_fn, 3124 (void *)d, &req.the_real_request ); 3125 return req; 3126} 3127"; 3128 3129# Add the routine to initialize MPI datatype names for the C++ datatypes 3130print $OUTFD " 3131// MT FIXME: this is not thread-safe 3132void MPIR_CXX_InitDatatypeNames( void ) 3133{ 3134 static int _isInit = 1; 3135 if (_isInit) { 3136 _isInit=0; 3137 PMPI_Type_set_name( MPI::BOOL, (char *)\"MPI::BOOL\" ); 3138 PMPI_Type_set_name( MPI::COMPLEX, (char *)\"MPI::COMPLEX\" );\ 3139 PMPI_Type_set_name( MPI::DOUBLE_COMPLEX, (char *)\"MPI::DOUBLE_COMPLEX\" );\ 3140#if defined(HAVE_LONG_DOUBLE) 3141 PMPI_Type_set_name( MPI::LONG_DOUBLE_COMPLEX, (char *)\"MPI::LONG_DOUBLE_COMPLEX\" );\ 3142#endif 3143 } 3144}\n"; 3145 3146 print $OUTFD "} // namespace MPI\n"; 3147 print $OUTFD "#undef MPIR_ARGUNUSED\n"; 3148 3149 close ($OUTFD); 3150 &ReplaceIfDifferent( $filename, "${filename}.new" ); 3151} 3152 3153# ------------------------------------------------------------------------ 3154# A special routine to add code to call an mpi routine: 3155# PrintWrapper ( fd, returntype, c++name, c++args, 3156# cdecls, mpiroutine, cArgs, return-exp ) 3157# if mpiroutine is empty, use the C++ name 3158sub PrintWrapper { 3159 my ($OUTFD, $returntype, $cxxname, $cxxargs, 3160 $cdecls, $mpiroutine, $cArgs, $returnExp ) = @_; 3161 3162 if ($mpiroutine eq "") { 3163 $mpiroutine = $cxxname; 3164 } 3165 3166 my $nargs = &GetArgCount( $cArgs ); 3167 print $OUTFD "\n$returntype $cxxname( $cxxargs ) 3168 { 3169 $cdecls\n"; 3170 &printCoverageStart( $OUTFD, $mpiroutine, $nargs ); 3171 print $OUTFD " MPIX_CALLWORLD( MPI_$mpiroutine( $cArgs ) );\n"; 3172 &printCoverageEnd( $OUTFD, $mpiroutine, $nargs ); 3173 if ($returntype ne "void") { 3174 print $OUTFD " return $returnExp;\n"; 3175 } 3176 print $OUTFD "}\n"; 3177} 3178# ------------------------------------------------------------------------ 3179 3180# Given an integer location of an argument, return the corresponding 3181# type, from the arg list 3182sub Convert_pos_to_type { 3183 my @parm = split( ',', $_[0] ); 3184 my $loc = $_[1]; 3185 3186 return $parm[$loc-1]; 3187} 3188sub Convert_type_to_pos { 3189 my @parm = split( ',', $_[0] ); 3190 my $type = $_[1]; 3191 my $loc = 1; 3192 3193 for $parm (@parm) { 3194 if ($parm =~ /$type/) { return $loc; } 3195 $loc ++; 3196 } 3197 return 0; 3198} 3199 3200# Print the class header 3201# PrintClassHead( $OUTFD, class, mpitype, friends ) 3202# E.g., PrintClassHead( $OUTFD, "Datatype", "MPI_Datatype", "Comm,Status" ) 3203sub PrintClassHead { 3204 my $OUTFD = $_[0]; 3205 my $class = $_[1]; 3206 my $mpi_type = $_[2]; 3207 my $friends = $_[3]; 3208 my $mpi_null_type = uc("${mpi_type}_NULL" ); 3209 3210 my $lcclass = lc($class); 3211 my $lctopclass = $lcclass; 3212 3213 if (! ($mpi_type =~ /^MPI_/) ) { 3214 # The mpi_type isn't an MPI type after all. Assume that 3215 # it is something (like an int) where we want the default to 3216 # be 0 3217 $mpi_null_type = "0"; 3218 } 3219 # For derived classes, we sometimes need to know the name of the 3220 # top-most class, particularly for the "the_real_xxx" name. 3221 if (defined($mytopclass{$lcclass})) { 3222 $lctopclass = $mytopclass{$lcclass}; 3223 } 3224 my $parent = ""; 3225 3226 my $baseclass = ""; 3227 if (defined($derived_class{$shortclass})) { 3228 $baseclass = $derived_class{$shortclass}; 3229 $parent = ": public $baseclass"; 3230 } 3231 3232 print $OUTFD "\nclass $class $parent {\n"; 3233 if (defined($friends) && $friends ne "") { 3234 foreach $name (split(/,/,$friends)) { 3235 print $OUTFD " friend class $name;\n"; 3236 } 3237 } 3238 if ($lcclass eq $lctopclass) { 3239 print $OUTFD "\ 3240 protected: 3241 $mpi_type the_real_$lcclass;\n"; 3242 # Check for special declarations 3243 $otherdeclfn = "$class" . "_extradecls"; 3244 if (defined(&$otherdeclfn)) { 3245 &$otherdeclfn( $OUTFD ); 3246 } 3247 } 3248 print $OUTFD "\ 3249 public: 3250 // new/delete\n"; 3251 if (0) { 3252 print $OUTFD "\ 3253 inline $class($mpi_type obj) { the_real_$lctopclass = obj; }\n"; 3254 } 3255 else { 3256 if ($lcclass eq $lctopclass) { 3257 print $OUTFD "\ 3258 inline $class($mpi_type obj) : the_real_$lctopclass(obj) {}\n"; 3259 } 3260 else { 3261 print $OUTFD "\ 3262 inline $class($mpi_type obj) : $baseclass(obj) {}\n"; 3263 } 3264 } 3265 3266 if (defined($class_has_no_default{$class})) { 3267 if (0) { 3268 print $OUTFD " inline $class(void) {}\n"; 3269 } 3270 else { 3271 if ($lcclass eq $lctopclass) { 3272 print $OUTFD " inline $class(void) : the_real_$lctopclass() {}\n"; 3273 } 3274 else { 3275 print $OUTFD " inline $class(void) : $baseclass\(\) {}\n"; 3276 } 3277 } 3278 } 3279 else { 3280 if (0) { 3281 print $OUTFD " inline $class(void) { the_real_$lctopclass = $mpi_null_type; }\n"; 3282 } 3283 else { 3284 if ($lcclass eq $lctopclass) { 3285 print $OUTFD " inline $class(void) : the_real_$lctopclass($mpi_null_type) {}\n"; 3286 } 3287 else { 3288 print $OUTFD " inline $class(void) : $baseclass\(\) {}\n"; 3289 } 3290 } 3291 } 3292 3293 # These had $class :: $class..., but pgCC complained, 3294 # so the $class :: was removed 3295 print $OUTFD "\ 3296 virtual ~$class() {} 3297 // copy/assignment\n"; 3298 # Three cases (two that we should really use): 3299 # If the base class, initialize directly 3300 # If a derived class, initialize with the base class initializer 3301 if (0) { 3302 print $OUTFD "\ 3303 $class(const $class &obj) { 3304 the_real_$lctopclass = obj.the_real_$lctopclass; }\n"; 3305 } 3306 else { 3307 if ($lcclass eq $lctopclass) { 3308 print $OUTFD "\ 3309 $class(const $class &obj) : the_real_$lctopclass(obj.the_real_$lctopclass){}\n"; 3310 } 3311 else { 3312 print $OUTFD "\ 3313 $class(const $class &obj) : $baseclass(obj) {}\n"; 3314 } 3315 } 3316 print $OUTFD "\ 3317 $class& operator=(const $class &obj) { 3318 the_real_$lctopclass = obj.the_real_$lctopclass; return *this; }\n"; 3319 if (!defined($class_has_no_compare{$class})) { 3320 # Some classes (e.g., Status) do not have compare operations 3321 # *or* they are derived classes that must use the parent's 3322 # comparison operations 3323 print $OUTFD " 3324 // logical 3325 bool operator== (const $class &obj) { 3326 return (the_real_$lctopclass == obj.the_real_$lctopclass); } 3327 bool operator!= (const $class &obj) { 3328 return (the_real_$lctopclass != obj.the_real_$lctopclass); }"; 3329 } 3330 3331 # These had $class :: $class..., but pgCC complained, 3332 # so the $class :: was removed on operator= 3333 print $OUTFD " 3334 // C/C++ cast and assignment 3335 inline operator $mpi_type*() { return &the_real_$lctopclass; } 3336 inline operator $mpi_type() const { return the_real_$lctopclass; } 3337 $class& operator=(const $mpi_type& obj) { 3338 the_real_$lctopclass = obj; return *this; } 3339"; 3340} 3341 3342sub PrintClassTail { 3343 my $OUTFD = $_[0]; 3344 print $OUTFD "};\n"; 3345} 3346 3347# ----------------------------------------------------------------------------- 3348# Here will go routines for handling return values. These need to move them 3349# from pointer arguments in the parameter list into a local declaration 3350# (possibly using new) 3351# 3352# We process a binding *first* and set the global variables 3353# return_type (type of return value, in the C binding) 3354# return_actual_type (real return type, in the C++ binding) 3355# return_parm_pos (number of location of arg in parm list; 0 if none) 3356# return_info is either a number or a type. If a type, it does NOT include 3357# the * (e.g., int instead of int *), but the * must be in the parameter 3358# FindReturnInfo( return_info, args ) 3359# The return info may also contain a ;<actual type>, as in 3360# 3;bool 3361# This is used for the cases where the return type isn't obvious 3362# from the return type. This is necessary for C++ returns of type bool 3363# that are int in C (since other int returns may in fact be ints). 3364sub FindReturnInfo { 3365 my @parms = split(/,/,$_[1] ); 3366 my $return_info = $_[0]; 3367 3368 $return_actual_type = ""; 3369 $return_parm_pos = -1; 3370 if ($return_info =~ /(.*);(.*)/) { 3371 $return_info = $1; 3372 $return_actual_type = $2; 3373 } 3374 if ($return_info eq "0") { 3375 $return_type = "void"; 3376 $return_parm_pos = 0; 3377 } 3378 elsif ($return_info =~ /^[0-9]/) { 3379 # We have the position but we need to find the type 3380 my $count = 1; 3381 for $parm (@parms) { 3382 if ($count == $return_info) { 3383 $return_type = $parm; 3384 $return_type =~ s/\s*\*$//; # Remove * 3385 $return_parm_pos = $count; 3386 } 3387 $count ++; 3388 } 3389 } 3390 else { 3391 # Return info is a type. Find the matching location 3392 my $count = 1; 3393 $return_type = ""; 3394 for $parm (@parms) { 3395 if ($parm =~ /$return_info\s*\*/) { 3396 $return_parm_pos = $count; 3397 $return_type = $return_info; 3398 last; 3399 } 3400 $count ++; 3401 } 3402 if ($return_type eq "") { 3403 print STDERR "Warning: no return type found for $routine\n"; 3404 } 3405 } 3406 if ($return_actual_type eq "") { $return_actual_type = $return_type; } 3407} 3408# ----------------------------------------------------------------------------- 3409# Convert other arguments from C to C++ versions. E.g., change the 3410# MPI_Datatype arg in Comm::Send from MPI_Datatype to Datatype. Use 3411# (MPI_Datatype)datatype.the_real_datatype (always). 3412# 3413# HandleObjectParms( parmtype, parm ) 3414# e.g., HandleObjectParms( MPI_Datatype, v7 ) 3415# returns appropriate string. If parmtype unknown, just return parm 3416sub HandleObjectParm { 3417 my $parmtype = $_[0]; 3418 my $parm = $_[1]; 3419 my $need_address = 0; 3420 my $newparm; 3421 3422 # Check for the special case of MPI_Aint, MPI_Offset 3423 if ($parmtype =~ /MPI_/ && 3424 ! ($parmtype =~/MPI_Aint/ || $parmtype =~ /MPI_Offset/)) { 3425 $ctype = $parmtype; 3426 if ($ctype =~ /\*/) { 3427 $need_address = 1; 3428 $ctype =~ s/\*//; 3429 } 3430 $ctype =~ s/MPI_//; 3431 $lctype = lc( $ctype ); 3432 # For derived classes, we sometimes need to know the name of the 3433 # top-most class, particularly for the "the_real_xxx" name. 3434 if (defined($mytopclass{$lctype})) { 3435 $lctype = $mytopclass{$lctype}; 3436 } 3437 3438 if ($need_address) { 3439 $newparm = "($parmtype)&($parm.the_real_$lctype)"; 3440 } 3441 else { 3442 $newparm = "($parmtype)($parm.the_real_$lctype)"; 3443 } 3444 return $newparm; 3445 } 3446 elsif ($parmtype =~ /MPI_Offset\s*\*/) { 3447 $newparm = "&$parm"; 3448 return $newparm; 3449 } 3450 elsif ($parmtype =~ /MPI_Aint\s*\*/) { 3451 $newparm = "&$parm"; 3452 return $newparm; 3453 } 3454 return $parm; 3455} 3456# ---------------------------------------------------------------------------- 3457# 3458# MUST DO BEFORE USABLE 3459# The initialization of the objects: 3460# const Datatype MPI::<name>(MPI_<name>); 3461# Intracomm MPI::COMM_WORLD(MPI_COMM_WORLD), SELF 3462# const COMM MPI::COMM_NULL; 3463# const Group MPI::GROUP_EMPTY(MPI_GROUP_EMPTY); 3464# const Op MPI::<op>(MPI_<op>) 3465# const int MPI::IDENT,CONGRUENT,SIMILAR,UNEQUAL 3466# (DONE!) 3467# 3468# static functions that are in no class (init already done) 3469# Get_error_class, Wtime, Wtick, Finalize, Is_initialized 3470# 3471# Namespace wrapper 3472# 3473# Insert use of const. Can we do this automatically, with some 3474# exceptions? E.g., all Datatype, void *, Comm, Group etc. 3475# Only recv of void *, output of collective aren't const (?) 3476# 3477# Returned objects that are not simple types must be created with new, not 3478# just declared and returned. In addition, make sure that the correct 3479# value is passed into the C version. E.g., 3480# Request *v7 = new Request; 3481# .... MPI_Isend( ..., &(v7->the_real_request) ) 3482# return *v7; 3483# 3484# ---------------------------------------------------------------------------- 3485# 3486# ReadInterface( filename ) 3487sub ReadInterface { 3488 my $filename =$_[0]; 3489 open( FD, "<$filename" ) || die "Cannot open $filename\n"; 3490 3491 # Skip to prototypes 3492 while (<FD>) { 3493 if ( /\/\*\s*Begin Prototypes/ ) { last; } 3494 } 3495 3496 # Read each one 3497 # Save as 3498 #$mpi_routine{name} = args; 3499 while (<FD>) { 3500 if (/\/\*\s*End Prototypes/ ) { last; } 3501 $origline = $_; 3502 while (/(.*)\/\*(.*?)\*\/(.*)/) { 3503 my $removed = $2; 3504 $_ = $1.$3; 3505 if ($2 =~ /\/\*/) { 3506 print STDERR "Error in processing comment within interface file $filename in line $origline"; 3507 } 3508 } 3509 if (/^int\s+MPI_([A-Z][a-z0-9_]*)\s*\((.*)/) { 3510 $routine_name = $1; 3511 $args = $2; 3512 while (! ($args =~ /;/)) { 3513 $args .= <FD>; 3514 } 3515 $args =~ s/MPICH_ATTR[A-Z_]*\([^)]*\)//g; 3516 $args =~ s/MPICH_API_PUBLIC//g; 3517 $args =~ s/ROMIO_API_PUBLIC//g; 3518 $args =~ s/\)\s*;//g; 3519 $args =~ s/[\r\n]*//g; 3520 # Special substitutions 3521 $args =~ s/MPIO_Request/MPI_Request/g; 3522 if (defined($special_routines{$routine_name})) { 3523 print "Skipping $routine_name\n" if $gDebug; 3524 } 3525 else { 3526 # Clear variables 3527 $clean_up = ""; 3528 print "$routine_name:\n" if $gDebug; 3529 &clean_args; 3530 $mpi_routine{$routine_name} = $args; 3531 print "Saving $routine_name ( $args )\n" if $gDebug; 3532 } 3533 } 3534 } 3535 close( FD ); 3536} 3537# ---------------------------------------------------------------------------- 3538# Implementation of the extra functions 3539sub Status_methods { 3540 my $OUTFD = $_[0]; 3541 3542 print $OUTFD "\ 3543 int Get_source(void) const { return the_real_status.MPI_SOURCE; } 3544 int Get_tag(void) const { return the_real_status.MPI_TAG; } 3545 int Get_error(void) const { return the_real_status.MPI_ERROR; } 3546 void Set_source(int source) { the_real_status.MPI_SOURCE = source; } 3547 void Set_tag(int tag) { the_real_status.MPI_TAG = tag; } 3548 void Set_error(int error) { the_real_status.MPI_ERROR = error; } 3549"; 3550} 3551 3552# Clone method is a helper that adds the clone methods for the communicators 3553sub Clone_method { 3554 my $OUTFD = $_[0]; 3555 my $classname = $_[1]; 3556 print $OUTFD " 3557// If the compiler does not support variable return types, return a 3558// reference to Comm. The user must then cast this to the correct type 3559// (Standard-conforming C++ compilers support variable return types) 3560#ifdef HAVE_NO_VARIABLE_RETURN_TYPE_SUPPORT 3561 virtual Comm & Clone(void) const { 3562 MPI_Comm ncomm; 3563 MPI_Comm_dup( (MPI_Comm)the_real_comm, &ncomm); 3564 Comm *clone = new $classname(ncomm); 3565 return *clone; 3566 } 3567#else 3568 virtual $classname & Clone(void) const { 3569 MPI_Comm ncomm; 3570 MPI_Comm_dup( (MPI_Comm)the_real_comm, &ncomm); 3571 $classname *clone = new $classname(ncomm); 3572 return *clone; 3573 } 3574#endif\n"; 3575} 3576sub Comm_methods { 3577 my $OUTFD = $_[0]; 3578 3579 # The Clone method is pure virtual in the Comm class 3580 # To accommodate C++ compilers that don't support 3581 print $OUTFD " virtual Comm &Clone(void) const = 0;\n"; 3582 3583 # The MPIR_ARGUNUSED provides a way to use __attribute__((unused)) for 3584 # the unused args 3585 # Typedefs 3586 print $OUTFD <<EOT; 3587 typedef int Copy_attr_function(const Comm& oldcomm, int comm_keyval, void* extra_state, void* attribute_val_in, void* attribute_val_out, bool& flag); 3588 typedef int Delete_attr_function(Comm& comm, int comm_keyval, void* attribute_val, void* extra_state); 3589 typedef void Errhandler_function(Comm &, int *, ... ); 3590 typedef Errhandler_function Errhandler_fn; 3591 3592 static int Create_keyval( Copy_attr_function *, Delete_attr_function *, 3593 void * ); 3594 3595 static int NULL_COPY_FN( const Comm &oldcomm MPIR_ARGUNUSED, 3596 int keyval MPIR_ARGUNUSED, void *ex MPIR_ARGUNUSED, 3597 void *attr_in MPIR_ARGUNUSED, void *attr_out MPIR_ARGUNUSED, 3598 bool &flag ) { flag = 0; return 0;} 3599 static int NULL_DELETE_FN( Comm &comm MPIR_ARGUNUSED, 3600 int keyval MPIR_ARGUNUSED, void * attr MPIR_ARGUNUSED, 3601 void *ex MPIR_ARGUNUSED ) { return 0; } 3602 static int DUP_FN( const Comm &oldcomm MPIR_ARGUNUSED, 3603 int keyval MPIR_ARGUNUSED, void *ex MPIR_ARGUNUSED, 3604 void *attr_in, void *attr_out, bool &flag ) { flag = 1; 3605 *(void **)attr_out = attr_in; return 0;} 3606 static Errhandler Create_errhandler( Errhandler_function * ); 3607 3608EOT 3609} 3610sub File_methods { 3611 my $OUTFD = $_[0]; 3612 3613 # Typedefs 3614 print $OUTFD <<EOT; 3615 typedef void Errhandler_function(File &, int *, ... ); 3616 typedef Errhandler_function Errhandler_fn; 3617 3618 static Errhandler Create_errhandler( Errhandler_function * ); 3619 3620EOT 3621} 3622sub Win_methods { 3623 my $OUTFD = $_[0]; 3624 3625 # Typedefs 3626 print $OUTFD <<EOT; 3627 typedef void Errhandler_function(Win &, int *, ... ); 3628 typedef Errhandler_function Errhandler_fn; 3629 3630 static Errhandler Create_errhandler( Errhandler_function * ); 3631 3632 typedef int Copy_attr_function(const Win& oldwin, int win_keyval, void* extra_state, void* attribute_val_in, void* attribute_val_out, bool& flag); 3633 typedef int Delete_attr_function(Win& win, int win_keyval, void* attribute_val, void* extra_state); 3634 3635 static int Create_keyval( Copy_attr_function *, Delete_attr_function *, 3636 void * ); 3637 // These functions are *not* part of MPI-2 but are provided 3638 // because they should have been included 3639 static int NULL_COPY_FN( const Win &oldwin MPIR_ARGUNUSED, 3640 int keyval MPIR_ARGUNUSED, void *ex MPIR_ARGUNUSED, 3641 void *attr_in MPIR_ARGUNUSED, void *attr_out MPIR_ARGUNUSED, 3642 bool &flag ) { flag = 1; return 0;} 3643 static int NULL_DELETE_FN( Win &win MPIR_ARGUNUSED, 3644 int keyval MPIR_ARGUNUSED, void * attr MPIR_ARGUNUSED, 3645 void *ex MPIR_ARGUNUSED ) { return 0; } 3646 static int DUP_FN( const Win &oldwin MPIR_ARGUNUSED, 3647 int keyval MPIR_ARGUNUSED, void *ex MPIR_ARGUNUSED, 3648 void *attr_in, void *attr_out, bool &flag ) { flag = 1; 3649 *(void **)attr_out = attr_in; return 0;} 3650 3651EOT 3652} 3653sub Nullcomm_methods { 3654 my $OUTFD = $_[0]; 3655 # We can't use Clone_method because 3656 # there is no (oldcomm) initializer. 3657 #&Clone_method( $OUTFD, "Nullcomm" ); 3658 print $OUTFD " 3659// If the compiler does not support variable return types, return a 3660// reference to Comm. The user must then cast this to the correct type 3661// (Standard-conforming C++ compilers support variable return types) 3662#ifdef HAVE_NO_VARIABLE_RETURN_TYPE_SUPPORT 3663 virtual Comm & Clone(void) const { 3664 Comm *clone = new Nullcomm(MPI_COMM_NULL); 3665 return *clone; 3666 } 3667#else 3668 virtual Nullcomm & Clone(void) const { 3669 Nullcomm *clone = new Nullcomm(); 3670 return *clone; 3671 } 3672#endif\n"; 3673} 3674 3675sub Cartcomm_methods { 3676 my $OUTFD = $_[0]; 3677 &Clone_method( $OUTFD, "Cartcomm" ); 3678} 3679sub Graphcomm_methods { 3680 my $OUTFD = $_[0]; 3681 &Clone_method( $OUTFD, "Graphcomm" ); 3682} 3683sub Distgraphcomm_methods { 3684 my $OUTFD = $_[0]; 3685 &Clone_method( $OUTFD, "Distgraphcomm" ); 3686} 3687sub Intercomm_methods { 3688 my $OUTFD = $_[0]; 3689 &Clone_method( $OUTFD, "Intercomm" ); 3690} 3691sub Intracomm_methods { 3692 my $OUTFD = $_[0]; 3693 &Clone_method( $OUTFD, "Intracomm" ); 3694 3695 print $OUTFD "\ 3696Intercomm Spawn(const char* command, const char* argv[], int maxprocs, const MPI::Info& info, int root) const { 3697 Intercomm ic; 3698 MPIX_CALLREF( this, MPI_Comm_spawn( (char *)command, 3699 (char **)argv, 3700 maxprocs, info.the_real_info, root, the_real_comm, 3701 &(ic.the_real_comm), MPI_ERRCODES_IGNORE ) ); 3702 return ic; 3703} 3704Intercomm Spawn(const char* command, const char* argv[], int maxprocs, const MPI::Info& info, int root, int array_of_errcodes[]) const { 3705 Intercomm ic; 3706 MPIX_CALLREF( this, MPI_Comm_spawn( (char *)command, 3707 (char **)argv, 3708 maxprocs, info.the_real_info, root, the_real_comm, 3709 &(ic.the_real_comm), array_of_errcodes ) ); 3710 return ic; 3711} 3712Intercomm Spawn_multiple(int count, const char* array_of_commands[], const char** array_of_argv[], const int array_of_maxprocs[], const MPI::Info array_of_info[], int root) { 3713 Intercomm ic; 3714 MPI_Info *li = new MPI_Info [count]; 3715 int i; 3716 for (i=0; i<count; i++) { 3717 li[i] = array_of_info[i].the_real_info; 3718 } 3719 MPIX_CALLREF( this, MPI_Comm_spawn_multiple( count, 3720 (char **)array_of_commands, 3721 (char ***)array_of_argv, (int *)array_of_maxprocs, 3722 li, root, the_real_comm, &(ic.the_real_comm), 3723 MPI_ERRCODES_IGNORE ) ); 3724 delete [] li; 3725 return ic; 3726} 3727Intercomm Spawn_multiple(int count, const char* array_of_commands[], const char** array_of_argv[], const int array_of_maxprocs[], const MPI::Info array_of_info[], int root, int array_of_errcodes[]) { 3728 Intercomm ic; 3729 MPI_Info *li = new MPI_Info [count]; 3730 int i; 3731 for (i=0; i<count; i++) { 3732 li[i] = array_of_info[i].the_real_info; 3733 } 3734 MPIX_CALLREF( this, MPI_Comm_spawn_multiple( count, 3735 (char **)array_of_commands, 3736 (char ***)array_of_argv, (int *)array_of_maxprocs, 3737 li, root, the_real_comm, &(ic.the_real_comm), 3738 array_of_errcodes ) ); 3739 delete [] li; 3740 return ic; 3741} 3742 3743"; 3744 3745 if ($do_DistGraphComm) { 3746 # Because there are two versions of each of the dist graph 3747 # create routines (fewer arguments for the case that uses 3748 # MPI_UNWEIGHTED in C or Fortran), we must define these explicitly 3749 # rather than generating them from the definitions. 3750 print $OUTFD "\ 3751 virtual Distgraphcomm Dist_graph_create( int v2, const int v3[], const int v4[], const int v5[], const int v6[], const MPI::Info &v7, bool v8 ) const; 3752 3753 virtual Distgraphcomm Dist_graph_create( int v2, const int v3[], const int v4[], const int v5[], const MPI::Info &v7, bool v8 ) const; 3754 3755 virtual Distgraphcomm Dist_graph_create_adjacent( int v2, const int v3[], const int v4[], int v5, const int v6[], const int v7[], const MPI::Info &v8, bool v9 ) const; 3756 3757 virtual Distgraphcomm Dist_graph_create_adjacent( int v2, const int v3[], int v5, const int v6[], const MPI::Info &v8, bool v9 ) const; 3758 \n"; 3759 } 3760} 3761 3762sub Op_methods { 3763 my $OUTFD = $_[0]; 3764 3765 print $OUTFD " 3766 void Init( User_function *, bool ); 3767"; 3768} 3769sub Grequest_methods { 3770 my $OUTFD = $_[0]; 3771 3772 print $OUTFD " 3773 typedef int Query_function( void *, Status & ); 3774 typedef int Free_function( void * ); 3775 typedef int Cancel_function( void *, bool ); 3776"; 3777 print $OUTFD <<EOT; 3778 3779 Grequest Start( Query_function *query_fn, 3780 Free_function *free_fn, 3781 Cancel_function *cancel_fn, 3782 void *extra_state ); 3783EOT 3784} 3785 3786# 3787# To properly implement Get_error_string, we need another 3788# protected member in the Exception that will contain the 3789# error string. 3790sub Exception_methods { 3791 my $OUTFD = $_[0]; 3792 3793 print $OUTFD "\ 3794 protected: 3795 char the_error_message[MPI_MAX_ERROR_STRING]; 3796 public: 3797 int Get_error_code(void) { return the_real_exception; } 3798 int Get_error_class(void) { return MPI::Get_error_class(the_real_exception); } 3799 const char *Get_error_string(void) 3800 { 3801 int len; 3802 MPI_Error_string(the_real_exception, the_error_message, &len); 3803 return the_error_message; 3804 } 3805"; 3806} 3807 3808sub Datatype_methods { 3809 my $OUTFD = $_[0]; 3810 3811 print $OUTFD "\ 3812 void Unpack( const void *, int, void *, int, int &, const Comm & ) const;\n"; 3813# void Pack( const void *, int, void *, int, int &, const Comm & ) const;\n"; 3814 print $OUTFD <<EOT; 3815 typedef int Copy_attr_function(const Datatype& oldtype, int type_keyval, void* extra_state, void* attribute_val_in, void* attribute_val_out, bool& flag); 3816 typedef int Delete_attr_function(Datatype& type, int type_keyval, void* attribute_val, void* extra_state); 3817 3818 static int Create_keyval( Copy_attr_function *, Delete_attr_function *, 3819 void * ); 3820 // These functions are *not* part of MPI-2 but are provided 3821 // because they should have been included 3822 static int NULL_COPY_FN( const Datatype &oldtype MPIR_ARGUNUSED, 3823 int keyval MPIR_ARGUNUSED, void *ex MPIR_ARGUNUSED, 3824 void *attr_in MPIR_ARGUNUSED, void *attr_out MPIR_ARGUNUSED, 3825 bool &flag ) { flag = 1; return 0;} 3826 static int NULL_DELETE_FN( Datatype &type MPIR_ARGUNUSED, 3827 int keyval MPIR_ARGUNUSED, void * attr MPIR_ARGUNUSED, 3828 void *ex MPIR_ARGUNUSED ) { return 0; } 3829 static int DUP_FN( const Datatype &oldtype MPIR_ARGUNUSED, 3830 int keyval MPIR_ARGUNUSED, void *ex MPIR_ARGUNUSED, 3831 void *attr_in, void *attr_out, bool &flag ) { flag = 1; 3832 *(void **)attr_out = attr_in; return 0;} 3833 3834EOT 3835} 3836# ---------------------------------------------------------------------------- 3837# We may eventually want to build separate files for each class rather than 3838# create a single header file. These routines handle that, as well as 3839# the 3840# ---------------------------------------------------------------------------- 3841sub BeginClass { 3842 my $class = $_[0]; 3843 # Here is where we add (some) of the code to write the 3844 # class definition, including the destructor, assignment, 3845 # and compare operations. 3846 my $Class = $fullclassname{$class}; 3847 my $mpi_type = $class_type{$class}; 3848 &PrintClassHead( $OUTFD, $Class, $mpi_type, $class_friends{$class} ); 3849} 3850 3851sub EndClass { 3852 &PrintClassTail( $OUTFD ); 3853} 3854# ---------------------------------------------------------------------------- 3855# Build the replacement functions: 3856# 1) Generate the method definition 3857# E.g., Send( void *v1, etc ) 3858# 2) Generate the inlined method definition 3859# a) Variable to hold return type, if any 3860# b) Declare Temporary variables for argument processing (e.g., to hold a 3861# copy of an array) 3862# c) Initialize any input temporaries (e.g., place values into the array) 3863# d) Call the original MPI routine 3864# using temporary variables as necessary 3865# e) Copy out from any temporaries 3866# f) return result value, if any 3867# 3868# The handling of the temporary variables is done by calling a named routine 3869# for each parameter that identifies itself as requring special processing 3870# ---------------------------------------------------------------------------- 3871# 3872# PrintRoutineDef( outfd, class, routine, arginfo, defonly ) 3873sub PrintRoutineDef { 3874 my $OUTFD = $_[0]; 3875 my $class = $_[1]; 3876 my $routine = $_[2]; 3877 my $arginfo = $_[3]; 3878 my $defonly = $_[4]; 3879 3880 my $fnchash = "$class-$routine"; 3881 3882 my $cArgs; # The argument string of the C binding 3883 my $Croutine; # Name of the MPI C binding routine to all; 3884 3885 # Extract the information on the special arguments 3886 my $returnarg = $arginfo; 3887 if ($returnarg =~ /^static:/) { $returnarg =~ s/^static://; } 3888 my $special_args = "::"; 3889 if ($returnarg =~ /(^[^:]+):(.*)/) { 3890 $returnarg = $1; 3891 $special_args = $2; 3892 $special_args = ":" . $special_args . ":"; 3893 print "special args for $routine is $special_args\n" if $gDebug; 3894 } 3895 3896 ($cArgs, $Croutine) = &GetCArgs( $class, $routine ); 3897 3898 # Hideous hack. To preserve ABI compatibility, for one particular 3899 # case for Create struct, remove the const values 3900 if ($routine eq "Create_struct" && $arginfo eq "static:5:4") { 3901 #print "$cArgs\n"; 3902 $cDefArgs = $cArgs; 3903 $cDefArgs =~ s/const\s+//g; 3904 } 3905 else { 3906 $cDefArgs = $cArgs; 3907 } 3908 3909 &PrintMethodDef( $OUTFD, $class, $routine, $arginfo, $cDefArgs ); 3910 3911 # This inserts a modifier, such as const or =0 (for pure virtual) 3912 if (defined($funcAttributes{$fnchash})) { 3913 print $OUTFD " $funcAttributes{$fnchash}"; 3914 } 3915 3916 # Some methods cannot be defined yet. In that case, we're done. 3917 if ($defonly || defined($defer_definition{$routine})) { 3918 print $OUTFD ";\n"; 3919 return; 3920 } 3921 3922 # output the body of the routine definition 3923 print $OUTFD "\n${indent}{\n"; 3924 3925 # Output any declaration needed for the return type 3926 &ReturnTypeDecl( $OUTFD ); 3927 3928 # Output any other declarations 3929 &RoutineTempDecls( $OUTFD, $routine, $cArgs, $special_args ); 3930 3931 # Output any initialization 3932 &RoutineTempIn( $OUTFD, $routine, $cArgs, $special_args ); 3933 3934 # Output the routine call 3935 &PrintRoutineCall( $OUTFD, $Croutine, $class, $arginfo, $cArgs ); 3936 3937 # Output code for any out variables 3938 &RoutineTempOut( $OUTFD, $routine, $cArgs, $special_args ); 3939 3940 # Return any value 3941 &PrintReturnType( $OUTFD ); 3942 3943 # Close the definition 3944 print $OUTFD "${indent}}\n"; 3945} 3946 3947# 3948# The following is a version of PrintRoutineDef that handles the 3949# "MPI_STATUS_IGNORE" features. 3950sub PrintRoutineDefNoStatus { 3951 my $OUTFD = $_[0]; 3952 my $class = $_[1]; 3953 my $routine = $_[2]; 3954 my $arginfo = $_[3]; 3955 my $defonly = $_[4]; 3956 3957 my $fnchash = "$class-$routine"; 3958 3959 my $cArgs; # The argument string of the C binding 3960 my $Croutine; # Name of the MPI C binding routine to all; 3961 3962 &SetStatusIgnore; # Tell the status array routine to ignore 3963 # status arrays. 3964 # Extract the information on the special arguments 3965 my $returnarg = $arginfo; 3966 if ($returnarg =~ /^static:/) { $returnarg =~ s/^static://; } 3967 my $special_args = "::"; 3968 if ($returnarg =~ /(^[^:]+):(.*)/) { 3969 $returnarg = $1; 3970 $special_args = $2; 3971 $special_args = ":" . $special_args . ":"; 3972 } 3973 3974 ($cArgs, $Croutine) = &GetCArgs( $class, $routine ); 3975 3976 $SavecArgs = $cArgs; 3977 # Also remove MPI_Status [] (Waitall/some; Testall/some) 3978 $cArgs =~ s/,\s*MPI_Status\s*\[\]//g; 3979 $cArgs =~ s/\s*MPI_Status\s*\[\]\s*,//g; 3980 # Remove MPI_Status and MPI_Status * 3981 $cArgs =~ s/,\s*MPI_Status\s*\*?//g; 3982 $cArgs =~ s/\s*MPI_Status\s*\*?\s*,//g; 3983 3984 3985 &PrintMethodDef( $OUTFD, $class, $routine, $arginfo, $cArgs ); 3986 3987 # This inserts a modifier, such as const or =0 (for pure virtual) 3988 if (defined($funcAttributes{$fnchash})) { 3989 print $OUTFD " $funcAttributes{$fnchash}"; 3990 } 3991 3992 # Some methods cannot be defined yet. In that case, we're done. 3993 if ($defonly || defined($defer_definition{$routine})) { 3994 print $OUTFD ";\n"; 3995 return; 3996 } 3997 3998 # output the body of the routine definition 3999 print $OUTFD "\n${indent}{\n"; 4000 4001 # Output any declaration needed for the return type 4002 &ReturnTypeDecl( $OUTFD ); 4003 4004 # Output any other declarations 4005 &RoutineTempDecls( $OUTFD, $routine, $cArgs, $special_args ); 4006 4007 # Output any initialization 4008 &RoutineTempIn( $OUTFD, $routine, $cArgs, $special_args ); 4009 4010 # Output the routine call 4011 $cArgs = $SavecArgs; 4012 $cArgs =~ s/\s*MPI_Status\s*\*?/%%MPI_STATUS_IGNORE%%/g; 4013 &PrintRoutineCall( $OUTFD, $Croutine, $class, $arginfo, $cArgs ); 4014 4015 # Output code for any out variables 4016 &RoutineTempOut( $OUTFD, $routine, $cArgs, $special_args ); 4017 4018 # Return any value 4019 &PrintReturnType( $OUTFD ); 4020 4021 # Close the definition 4022 print $OUTFD "${indent}}\n"; 4023 4024 &UnSetStatusIgnore; # Tell the status array routine to stop ignoring 4025 # status arrays. 4026} 4027 4028# Print only the method definition 4029sub PrintMethodDef { 4030 my $OUTFD = $_[0]; 4031 my $class = $_[1]; 4032 my $routine = $_[2]; 4033 my $arginfo = $_[3]; 4034 my $cArgs = $_[4]; 4035 4036 my $fnchash = "$class-$routine"; 4037 4038 my $is_static = 0; 4039 # Process info for finding the return value info. 4040 # This sets global variables return_type and return_parm_pos 4041 my $returnarg = $arginfo; 4042 if ($returnarg =~ /^static:/) { 4043 $returnarg =~ s/^static://; 4044 $is_static = 1; 4045 } 4046 my $special_args = ""; 4047 if ($returnarg =~ /(^[^:]+):(.*)/) { 4048 $returnarg = $1; 4049 $special_args = $2; 4050 } 4051 &FindReturnInfo( $returnarg, $cArgs ); 4052 4053 $real_return_type = $return_actual_type; 4054 if ($return_type =~ /MPI_/) { 4055 $real_return_type =~ s/MPI_//; 4056 } 4057 # Check for a special return type (e.g., IntraComm instead of Comm) 4058 if (defined($specialReturnType{"$class-$routine"})) { 4059 $real_return_type = $specialReturnType{"$class-$routine"}; 4060 } 4061 4062 print $OUTFD $indent; 4063 if (defined($funcDeclaration{$fnchash})) { 4064 my $decl = $funcDeclaration{$fnchash}; 4065 if ($decl eq "static") { $is_static = 1; } 4066# if ($is_static && $decl eq "static") { 4067# print STDERR "$routine has both decl static and args->static\n"; 4068# } 4069# else { 4070# print $OUTFD "$funcDeclaration{$fnchash} "; 4071# } 4072 } 4073 if ($is_static) { 4074 print $OUTFD "static "; 4075 } 4076 elsif ($class ne "base") { 4077 #print "Class for $routine = $class\n"; 4078 if ($routine ne "Dup") { 4079 print $OUTFD "virtual "; 4080 } 4081 } 4082 4083 print $OUTFD "$real_return_type $routine"; 4084 4085 # OUTFD, C declaration, C datatype for Class, output info 4086 &print_args( $OUTFD, $cArgs, $class_type{$class}, $arginfo ); 4087} 4088 4089# Get the argument string of the C binding for this routine and the name 4090# of the C routine to use for this method 4091sub GetCArgs { 4092 my $class = $_[0]; 4093 my $routine = $_[1]; 4094 my $Class = $fullclassname{$class}; 4095 4096 print "Routine $routine in Class $class\n" if $gDebug; 4097 4098 # Find the corresponding args. Some C++ routines don't use the 4099 # natural names, so we check for that here 4100 $args = ""; 4101 4102 # Check for $Class_$routine 4103 # (Skip if class == base and Class undefined) 4104 my $trial_name = "_" . lc($routine); 4105 if ($class ne "base" && defined($Class)) { 4106 $trial_name = "${Class}_" . lc($routine); 4107 # We need to do this to separate MPI_Get from MPI_Info_get. 4108 if (defined($mpi_routine{$trial_name})) { 4109# if (defined($altname{"$class-$routine"})) { 4110# print STDERR "Ambiguous name for $class-$routine\n"; 4111# } 4112 $args = $mpi_routine{$trial_name}; 4113 $mpi_routine_name = $trial_name; 4114 print "Matched $trial_name to $mpi_routine_name in mpi_routine{}\n" if $gDebug; 4115 return ($args,$mpi_routine_name); 4116 } 4117 } 4118 if (defined($mpi_routine{$routine})) { 4119# if (defined($altname{"$class-$routine"})) { 4120# print STDERR "Ambiguous name for $class-$routine\n"; 4121# } 4122 $args = $mpi_routine{$routine}; 4123 } 4124 $mpi_routine_name = $routine; 4125 if ($args eq "") { 4126 # Check for an alternate name 4127 print "Checking for $class-$routine\n" if $gDebug; 4128 print "Trial = $trial_name\n" if $gDebug; 4129 if (defined($mpi_routine{$trial_name})) { 4130 $mpi_routine_name = $trial_name; 4131 $args = $mpi_routine{$mpi_routine_name}; 4132 } 4133 elsif (defined($altname{"$class-$routine"})) { 4134 $mpi_routine_name = $altname{"$class-$routine"}; 4135 $args = $mpi_routine{$mpi_routine_name}; 4136 } 4137 elsif ($class eq "file") { 4138 # File routines have a systematic name mapping 4139 $lcroutine = lc($routine); 4140 $mpi_routine_name = "File_$lcroutine"; 4141 $args = $mpi_routine{$mpi_routine_name}; 4142 } 4143 else { 4144 print STDERR "Name $routine in class $class has no known MPI routine\n"; 4145 } 4146 } 4147 print "Matched $trial_name to $mpi_routine_name\n" if $gDebug; 4148 return ($args,$mpi_routine_name); 4149} 4150 4151# Output any declaration needed for the return type 4152# This uses the globals $return_type and $return_parm_pos 4153$finalcast = ""; 4154sub ReturnTypeDecl { 4155 my $OUTFD = $_[0]; 4156 4157 # If there is a return type, declare it here 4158 $finalcast = ""; 4159 $finalop = ""; 4160 if ($return_parm_pos > 0) { 4161 if ($return_type =~ /MPI_/ && !($return_type =~ /MPI_Offset/) 4162 && !($return_type =~ /MPI_Aint/)) { 4163 print $OUTFD "$indent $real_return_type v$return_parm_pos;\n"; 4164 $finalcast = ""; 4165 } 4166 else { 4167 print $OUTFD "$indent $return_type v$return_parm_pos;\n"; 4168 if ($real_return_type eq "bool") { 4169 # Unfortunately, at least one C++ compiler (Microsoft's) 4170 # generates wanring messages EVEN WHEN AN EXPLICIT CAST 4171 # IS USED (!). To avoid these messages, we 4172 # cause the generated code to explicitly compute a 4173 # boolean value (sigh) 4174# $finalcast = "(bool)"; 4175 $finalop = "!= 0" 4176 } 4177 } 4178 } 4179} 4180# Return value. Uses return_parm_pos and finalcast. 4181sub PrintReturnType { 4182 my $OUTFD = $_[0]; 4183 if ($return_parm_pos > 0) { 4184 print $OUTFD "$indent return ${finalcast}v$return_parm_pos${finalop};\n"; 4185 } 4186} 4187 4188 4189# Output any other declarations 4190sub RoutineTempDecls { 4191 my $OUTFD = $_[0]; 4192 my $routine = $_[1]; 4193 my @parms = split(/\s*,\s*/, $_[2] ); # the original parameter list 4194 my $special_args = $_[3]; 4195 my $count = 1; 4196 4197 foreach $parm (@parms) { 4198 my $pos_check = ":" . $count . ":"; 4199 if ($special_args =~ /$pos_check/) { 4200 &DoSpecialArgProcessing( $OUTFD, $routine, $count, "decl" ); 4201 } 4202 $count ++; 4203 } 4204} 4205 4206# Output any initialization 4207sub RoutineTempIn { 4208 my $OUTFD = $_[0]; 4209 my $routine = $_[1]; 4210 my @parms = split(/\s*,\s*/, $_[2] ); # the original parameter list 4211 my $special_args = $_[3]; 4212 my $count = 1; 4213 4214 my $initstring = "${class}_${routine}_init"; 4215 #print "Routine = $initstring\n"; 4216 if (defined($$initstring)) { 4217 print $OUTFD $$initstring . "\n"; 4218 } 4219 foreach $parm (@parms) { 4220 my $pos_check = ":" . $count . ":"; 4221 if ($special_args =~ /$pos_check/) { 4222 print "expecting $routine-$count cxxtoc\n" if $gDebug; 4223 &DoSpecialArgProcessing( $OUTFD, $routine, $count, "cxxtoc" ); 4224 } 4225 $count ++; 4226 } 4227} 4228 4229# Output the routine call 4230sub PrintRoutineCall { 4231 my $OUTFD = $_[0]; 4232 my $mpi_routine_name = $_[1]; 4233 my $class = $_[2]; 4234 my $arginfo = $_[3]; 4235 my $cArgs = $_[4]; 4236 my $nArgs = &GetArgCount( $cArgs ); 4237 4238 my $useThis = 0; 4239 my $TYPE = "OBJ", $obj = "COMM_WORLD"; 4240 if (!$do_DistGraphComm) { 4241 if ($class eq "distgraph") { 4242 die "PANIC: unexpected distgraph class when distgraph support disabled"; 4243 } 4244 } 4245 if ($class eq "comm" || $class eq "inter" || $class eq "intra" || 4246 $class eq "cart" || $class eq "graph" || $class eq "distgraph") { 4247 $useThis = 1; 4248 $TYPE = "REF"; 4249 $obj = "this"; 4250 # Handle special cases 4251 if ($mpi_routine_name eq "Comm_compare" || 4252 $mpi_routine_name eq "Comm_free_keyval") { 4253 $useThis = 0; 4254 } 4255 } 4256 elsif ($class eq "file") { 4257 $useThis = 1; 4258 $TYPE = "REF"; 4259 $obj = "this"; 4260 if ($mpi_routine_name eq "File_open" || 4261 $mpi_routine_name eq "File_delete") { 4262 $obj = "FILE_NULL"; 4263 $TYPE = "OBJ" 4264 } 4265 } 4266 elsif ($class eq "win") { 4267 $useThis = 1; 4268 $TYPE = "REF"; 4269 $obj = "this"; 4270 if ($mpi_routine_name eq "Win_create") { 4271 $TYPE = "OBJ"; 4272 $obj = "v5"; 4273 } 4274 elsif ($mpi_routine_name eq "Win_free_keyval") { 4275 $useThis = 0; 4276 } 4277 } 4278 &printCoverageStart( $OUTFD, "$mpi_routine_name", $nArgs ); 4279 if ($useThis) { 4280 print $OUTFD "$indent MPIX_CALL$TYPE( $obj, MPI_$mpi_routine_name"; 4281 } 4282 else { 4283 # COMM_WORLD may not be defined yet, so indirect 4284 print $OUTFD "$indent MPIX_CALLWORLD( MPI_$mpi_routine_name"; 4285 } 4286 &print_call_args( $OUTFD, $cArgs, $class_type{$class}, $arginfo ); 4287 print $OUTFD ");\n"; 4288 &printCoverageEnd( $OUTFD, "$mpi_routine_name", $nArgs ); 4289} 4290 4291# Output code for any out variables 4292sub RoutineTempOut { 4293 my $OUTFD = $_[0]; 4294 my $routine = $_[1]; 4295 my @parms = split(/\s*,\s*/, $_[2] ); # the original parameter list 4296 my $special_args = $_[3]; 4297 my $count = 1; 4298 4299 foreach $parm (@parms) { 4300 my $pos_check = ":" . $count . ":"; 4301 if ($special_args =~ /$pos_check/) { 4302 print "expecting $routine-$count ctocxx\n" if $gDebug; 4303 &DoSpecialArgProcessing( $OUTFD, $routine, $count, "ctocxx" ); 4304 } 4305 $count ++; 4306 } 4307} 4308 4309# ---------------------------------------------------------------------------- 4310# Routines for special processing 4311# ---------------------------------------------------------------------------- 4312# This routine makes the call for a particular function for a particular 4313# argument position and operation 4314# DoSpecialArgProcessing( OUTFD, routine, arg-pos, operation ) 4315sub DoSpecialArgProcessing { 4316 my $OUTFD = $_[0]; 4317 my $routine = $_[1]; 4318 my $count = $_[2]; 4319 my $op = $_[3]; # decl, arg, cxxtoc, ctocxx 4320 my $argdir; # either in, out, inout 4321 4322 $subname = ""; 4323 print "Checking for $routine - $count\n" if $gDebug; 4324 if (defined($funcArgMap{"${routine}-$count"})) { 4325 $subname = $funcArgMap{"${routine}-$count"}; 4326 } 4327 else { 4328 if (defined($class) && 4329 defined($funcArgMap{"${class}-${routine}-$count"})) { 4330 $subname = $funcArgMap{"${class}-${routine}-$count"}; 4331 } 4332 if ((!defined($class) || $class eq "") && $subname eq "") { 4333 # try base 4334 if (defined($funcArgMap{"base-${routine}-$count"})) { 4335 $subname = $funcArgMap{"base-${routine}-$count"}; 4336 } 4337 } 4338 print "Found class $class $routine $count\n" if $gDebug; 4339 } 4340 if ($subname =~ /([^:]*):([^:]*)(.*)/) { 4341 $argdir = $1; 4342 $subname = $2 . "_${argdir}_${op}"; 4343 $otherarg = $3; 4344 $otherarg =~ s/^://; 4345 print "expecting to find routine $subname\n" if $gDebug; 4346 if (defined(&$subname)) { 4347# if (op eq "methoddecl" || op eq "arg") { 4348 &$subname( $count ); 4349 return 1; 4350# } 4351# else { 4352# &$subname( "v$count", "l$count" ); 4353# } 4354 } 4355 else { 4356 print STDERR "Expected :$subname: for $routine but it was not defined\n"; 4357 } 4358 } 4359 return 0; 4360} 4361# ---------------------------------------------------------------------------- 4362# const: added only to the declaration 4363# $parm is defined outside 4364sub const_in_methoddecl { 4365 my $count = $_[0]; 4366 4367 my $lparm = $parm; 4368 4369 if (!$first) { print $OUTFD ", "; } 4370 # Convert part if it contains an MPI_ type 4371 $lparm =~ s/MPI_//; 4372 if ($lparm =~ /(\w*)\s*(\[\].*)/) { 4373 my $name = $1; 4374 my $array = $2; 4375 # Using $array allows us to handle both [] and [][3] 4376 print $OUTFD "const $name v$count$array"; 4377 } 4378 else { 4379 # Only add if a const is not already present 4380 if ($lparm =~ /^\s*const/) { 4381 # No need to add const 4382 print $OUTFD "$lparm v$count"; 4383 } 4384 else { 4385 print $OUTFD "const $lparm v$count"; 4386 print "const added to $lparm, argument $count for $routine(class $class)\n" if $gDebug; 4387 } 4388 } 4389} 4390# We have to explicitly remove the cast 4391sub const_in_call { 4392 my $count = $_[0]; 4393 my $lparm = $parm; 4394 if ($lparm =~ /^\s*([\w\s]+)\s*\[\]/) { 4395 my $basetype = $1; 4396 # ISO C++ forbids casting to an array type, but we can 4397 # cast to a pointer 4398 if ($lparm =~ /\[\](\[.*)/) { 4399 print $OUTFD "($basetype (*)$1)v$count"; 4400 } 4401 else { 4402 print $OUTFD "($basetype *)v$count"; 4403 } 4404 } 4405 else { 4406 print $OUTFD "($parm)v$count"; 4407 } 4408} 4409sub const_in_decl { 4410} 4411sub const_in_cxxtoc { 4412} 4413sub const_in_ctocxx { 4414} 4415# 4416# bool 4417# convert from C int 4418sub bool_in_methoddecl { 4419 my $count = $_[0]; 4420 if (!$first) { print $OUTFD ", "; } 4421 print $OUTFD "bool v$count"; 4422} 4423sub bool_out_methoddecl { 4424 my $count = $_[0]; 4425 if (!$first) { print $OUTFD ", "; } 4426 print $OUTFD "bool &v$count"; 4427} 4428sub bool_out_cxxtoc { 4429} 4430sub bool_out_decl { 4431 my $count = $_[0]; 4432 print $OUTFD "$indent int l$count;\n"; 4433} 4434sub bool_in_decl { 4435 my $count = $_[0]; 4436 print $OUTFD "$indent int l$count;\n"; 4437} 4438sub bool_in_ctocxx {} 4439sub bool_in_call { 4440 my $count = $_[0]; 4441 print $OUTFD "l$count"; 4442} 4443sub bool_out_call { 4444 my $count = $_[0]; 4445 print $OUTFD "&l$count"; 4446} 4447sub bool_out_ctocxx { 4448# my $cinvar = $_[0]; 4449# my $cxxoutvar = $_[1]; 4450 my $count = $_[0]; 4451 my $cinvar = "l" . $count; 4452 my $cxxoutvar = "v" . $count; 4453 4454 print $OUTFD "$indent $cxxoutvar = $cinvar ? true : false;\n"; 4455} 4456# conver to C int 4457sub bool_in_cxxtoc { 4458# my $cxxinvar = $_[0]; 4459# my $coutvar = $_[1]; 4460 4461 my $count = $_[0]; 4462 my $cxxinvar = "v" . $count; 4463 my $coutvar = "l" . $count; 4464 4465 print $OUTFD "$indent $coutvar = ($cxxinvar == true) ? 1 : 0;\n"; 4466} 4467# ---------------------------------------------------------------------------- 4468sub reqarray_inout_methoddecl { 4469 my $count = $_[0]; 4470 if (!$first) { print $OUTFD ", "; } 4471 print $OUTFD "Request v$count\[]"; 4472} 4473# We have to explicitly remove the cast 4474sub reqarray_inout_call { 4475 my $count = $_[0]; 4476 print $OUTFD "l$count"; 4477} 4478sub reqarray_inout_decl { 4479 my $count = $_[0]; 4480 my $n = "v$otherarg"; 4481 if ($n =~ /-(\d*)/) { $n = $1; } 4482 print $OUTFD "$indent MPI_Request *l$count = new MPI_Request[$n];\n"; 4483} 4484sub reqarray_inout_cxxtoc { 4485 my $count = $_[0]; 4486 my $n = "v$otherarg"; 4487 4488 my $cinvar = "l" . $count; 4489 my $cxxoutvar = "v" . $count; 4490 4491 if ($n =~ /-(\d*)/) { $n = $1; } 4492 print $OUTFD "$indent { 4493 int i$count; 4494 for (i$count=0;i$count<$n;i$count++) { 4495 l$count\[i$count] = v$count\[i$count].the_real_request; 4496 } 4497 }\n"; 4498} 4499sub reqarray_inout_ctocxx { 4500 my $count = $_[0]; 4501 my $n = "v$otherarg"; 4502 4503 my $cinvar = "l" . $count; 4504 my $cxxoutvar = "v" . $count; 4505 4506 if ($n =~ /-(\d*)/) { $n = $1; } 4507 print $OUTFD "$indent { 4508 int i$count; 4509 for (i$count=0;i$count<$n;i$count++) { 4510 v$count\[i$count].the_real_request = l$count\[i$count]; 4511 } 4512 delete[] l$count; 4513 }\n"; 4514} 4515# ---------------------------------------------------------------------------- 4516$InStatusIgnore = 0; 4517sub SetStatusIgnore { 4518 $InStatusIgnore = 1; 4519} 4520sub UnSetStatusIgnore { 4521 $InStatusIgnore = 0; 4522} 4523sub statusarray_out_methoddecl { 4524 my $count = $_[0]; 4525 if ($InStatusIgnore) { return; } 4526 if (!$first) { print $OUTFD ", "; } 4527 print $OUTFD "Status v$count\[]"; 4528} 4529# We have to explicitly remove the cast 4530sub statusarray_out_call { 4531 my $count = $_[0]; 4532 if ($InStatusIgnore) { 4533 print $OUTFD "MPI_STATUSES_IGNORE"; 4534 } 4535 else { 4536 print $OUTFD "l$count"; 4537 } 4538} 4539sub statusarray_out_decl { 4540 my $count = $_[0]; 4541 my $n = "v$otherarg"; 4542 if ($n =~ /-(\d*)/) { $n = $1; } 4543 if ($InStatusIgnore) { return; } 4544 print $OUTFD "$indent MPI_Status *l$count = new MPI_Status[$n];\n"; 4545} 4546sub statusarray_out_cxxtoc { 4547 my $count = $_[0]; 4548 my $n = "v$otherarg"; 4549 4550 my $cinvar = "l" . $count; 4551 my $cxxoutvar = "v" . $count; 4552 4553 if ($n =~ /-(\d*)/) { $n = $1; } 4554 if ($InStatusIgnore) { return; } 4555 4556# print $OUTFD "$indent { 4557# int i$count; 4558# for (i$count=0;i$count<$n;i$count++) { 4559# l$count\[i$count] = v$count\[i$count].the_real_request; 4560# } 4561# }\n"; 4562} 4563sub statusarray_out_ctocxx { 4564 my $count = $_[0]; 4565 my $n = "v$otherarg"; 4566 4567 my $cinvar = "l" . $count; 4568 my $cxxoutvar = "v" . $count; 4569 4570 if ($n =~ /-(\d*)/) { $n = $1; } 4571 if ($InStatusIgnore) { return; } 4572 print $OUTFD "$indent { 4573 int i$count; 4574 for (i$count=0;i$count<$n;i$count++) { 4575 v$count\[i$count].the_real_status = l$count\[i$count]; 4576 } 4577 delete[] l$count; 4578 }\n"; 4579} 4580# ---------------------------------------------------------------------------- 4581sub boolarray_in_methoddecl { 4582 my $count = $_[0]; 4583 if (!$first) { print $OUTFD ", "; } 4584 print $OUTFD "const bool v$count\[]"; 4585} 4586# We have to explicitly remove the cast 4587sub boolarray_in_call { 4588 my $count = $_[0]; 4589 print $OUTFD "l$count"; 4590} 4591sub boolarray_in_decl { 4592 my $count = $_[0]; 4593 my $n = "v$otherarg"; 4594 if ($n =~ /-(\d*)/) { $n = $1; } 4595 print $OUTFD "$indent int *l$count = new int[$n];\n"; 4596} 4597sub boolarray_in_cxxtoc { 4598 my $count = $_[0]; 4599 my $n = "v$otherarg"; 4600 4601 my $cinvar = "l" . $count; 4602 my $cxxoutvar = "v" . $count; 4603 4604 if ($n =~ /-(\d*)/) { $n = $1; } 4605 print $OUTFD "$indent { 4606 int i$count; 4607 for (i$count=0;i$count<$n;i$count++) { 4608 l$count\[i$count] = v$count\[i$count] == true ? 1 : 0; 4609 } 4610 }\n"; 4611} 4612sub boolarray_in_ctocxx { 4613 my $count = $_[0]; 4614 my $n = "v$otherarg"; 4615 4616 my $cinvar = "l" . $count; 4617 my $cxxoutvar = "v" . $count; 4618 4619 if ($n =~ /-(\d*)/) { $n = $1; } 4620 print $OUTFD " 4621 delete[] l$count;\n"; 4622 4623} 4624# ---------------------------------------------------------------------------- 4625sub boolarray_out_methoddecl { 4626 my $count = $_[0]; 4627 if (!$first) { print $OUTFD ", "; } 4628 print $OUTFD "bool v$count\[]"; 4629} 4630# We have to explicitly remove the cast 4631sub boolarray_out_call { 4632 my $count = $_[0]; 4633 print $OUTFD "l$count"; 4634} 4635sub boolarray_out_decl { 4636 my $count = $_[0]; 4637 my $n = "v$otherarg"; 4638 if ($n =~ /-(\d*)/) { $n = $1; } 4639 print $OUTFD "$indent int *l$count = new int[$n];\n"; 4640} 4641sub boolarray_out_cxxtoc { 4642 my $count = $_[0]; 4643 my $n = "v$otherarg"; 4644 4645 my $cinvar = "l" . $count; 4646 my $cxxoutvar = "v" . $count; 4647 4648} 4649sub boolarray_out_ctocxx { 4650 my $count = $_[0]; 4651 my $n = "v$otherarg"; 4652 4653 my $cinvar = "l" . $count; 4654 my $cxxoutvar = "v" . $count; 4655 4656 if ($n =~ /-(\d*)/) { $n = $1; } 4657 print $OUTFD "$indent { 4658 int i$count; 4659 for (i$count=0;i$count<$n;i$count++) { 4660 // Unfortunately, at least one C++ compiler (Microsoft's) 4661 // generates warning messages when the type size changes 4662 // even when an explicit cast is used. To avoid these messages, we 4663 // cause the generated code to explicitly compute a 4664 // boolean value 4665 v$count\[i$count] = l$count\[i$count] != 0; 4666 } 4667 delete[] l$count; 4668 }\n"; 4669} 4670# ---------------------------------------------------------------------------- 4671sub preqarray_inout_methoddecl { 4672 my $count = $_[0]; 4673 if (!$first) { print $OUTFD ", "; } 4674 print $OUTFD "Prequest v$count\[]"; 4675} 4676# We have to explicitly remove the cast 4677sub preqarray_inout_call { 4678 my $count = $_[0]; 4679 print $OUTFD "l$count"; 4680} 4681sub preqarray_inout_decl { 4682 my $count = $_[0]; 4683 my $n = "v$otherarg"; 4684 if ($n =~ /-(\d*)/) { $n = $1; } 4685 print $OUTFD "$indent MPI_Request *l$count = new MPI_Request[$n];\n"; 4686} 4687sub preqarray_inout_cxxtoc { 4688 my $count = $_[0]; 4689 my $n = "v$otherarg"; 4690 4691 my $cinvar = "l" . $count; 4692 my $cxxoutvar = "v" . $count; 4693 4694 if ($n =~ /-(\d*)/) { $n = $1; } 4695 print $OUTFD "$indent { 4696 int i$count; 4697 for (i$count=0;i$count<$n;i$count++) { 4698 l$count\[i$count] = v$count\[i$count].the_real_request; 4699 } 4700 }\n"; 4701} 4702sub preqarray_inout_ctocxx { 4703 my $count = $_[0]; 4704 my $n = "v$otherarg"; 4705 4706 my $cinvar = "l" . $count; 4707 my $cxxoutvar = "v" . $count; 4708 4709 if ($n =~ /-(\d*)/) { $n = $1; } 4710 print $OUTFD "$indent { 4711 int i$count; 4712 for (i$count=0;i$count<$n;i$count++) { 4713 v$count\[i$count].the_real_request = l$count\[i$count]; 4714 } 4715 delete[] l$count; 4716 }\n"; 4717} 4718# ---------------------------------------------------------------------------- 4719sub dtypearray_in_methoddecl { 4720 my $count = $_[0]; 4721 if (!$first) { print $OUTFD ", "; } 4722 print $OUTFD " const Datatype v$count\[\]"; 4723} 4724# We have to explicitly remove the cast 4725sub dtypearray_in_call { 4726 my $count = $_[0]; 4727 print $OUTFD "l$count"; 4728} 4729sub dtypearray_in_decl { 4730 my $count = $_[0]; 4731 my $n = "v$otherarg"; 4732 if ($n =~ /-(\d*)/) { $n = $1; } 4733 if ($otherarg eq "SIZE") { 4734 $n = "Get_size()"; 4735 } 4736 print $OUTFD "$indent MPI_Datatype *l$count = new MPI_Datatype[$n];\n"; 4737} 4738sub dtypearray_in_cxxtoc { 4739 my $count = $_[0]; 4740 my $n = "v$otherarg"; 4741 if ($otherarg eq "SIZE") { 4742 $n = "Get_size()"; 4743 } 4744 4745 my $cinvar = "l" . $count; 4746 my $cxxoutvar = "v" . $count; 4747 4748 if ($n =~ /-(\d*)/) { $n = $1; } 4749 print $OUTFD "$indent { 4750 int i$count; 4751 for (i$count=0;i$count<$n;i$count++) { 4752 l$count\[i$count] = v$count\[i$count].the_real_datatype; 4753 } 4754 }\n"; 4755} 4756# Use this to delete the array 4757sub dtypearray_in_ctocxx { 4758 my $count = $_[0]; 4759 my $n = "v$otherarg"; 4760 4761 my $cinvar = "l" . $count; 4762 my $cxxoutvar = "v" . $count; 4763 4764 if ($n =~ /-(\d*)/) { $n = $1; } 4765 print $OUTFD "$indent delete[] l$count;\n"; 4766} 4767 4768sub dtypearray_out_methoddecl { 4769 my $count = $_[0]; 4770 if (!$first) { print $OUTFD ", "; } 4771 print $OUTFD "Datatype v$count\[]"; 4772} 4773sub dtypearray_out_decl { 4774 my $count = $_[0]; 4775 my $n = "v$otherarg"; 4776 if ($n =~ /-(\d*)/) { $n = $1; } 4777 print $OUTFD "$indent MPI_Datatype *l$count = new MPI_Datatype[$n];\n"; 4778} 4779sub dtypearray_out_cxxtoc { 4780 my $count = $_[0]; 4781 my $n = "v$otherarg"; 4782 4783 my $cinvar = "l" . $count; 4784 my $cxxoutvar = "v" . $count; 4785 4786 if ($n =~ /-(\d*)/) { $n = $1; } 4787} 4788sub dtypearray_out_call { 4789 my $count = $_[0]; 4790 print $OUTFD "l$count"; 4791} 4792sub dtypearray_out_ctocxx { 4793 my $count = $_[0]; 4794 my $n = "v$otherarg"; 4795 4796 my $cinvar = "l" . $count; 4797 my $cxxoutvar = "v" . $count; 4798 4799 if ($n =~ /-(\d*)/) { $n = $1; } 4800 print $OUTFD "$indent { 4801 int i$count; 4802 for (i$count=0;i$count<$n;i$count++) { 4803 v$count\[i$count].the_real_datatype = l$count\[i$count]; 4804 } 4805 delete[] l$count; 4806 }\n"; 4807} 4808# ---------------------------------------------------------------------------- 4809# These are used to convert int *foo into int &foo 4810sub refint_in_methoddecl { 4811 my $count = $_[0]; 4812 if (!$first) { print $OUTFD ", "; } 4813 print $OUTFD "int &v$count"; 4814} 4815# We have to explicitly remove the cast 4816sub refint_in_call { 4817 my $count = $_[0]; 4818 print $OUTFD "&v$count"; 4819} 4820sub refint_in_decl {} 4821sub refint_in_cxxtoc {} 4822sub refint_in_ctocxx {} 4823# ---------------------------------------------------------------------------- 4824# These are used to convert <type> *foo or <type> foo into <type> &foo 4825sub constref_in_methoddecl { 4826 my $count = $_[0]; 4827 if (!$first) { print $OUTFD ", "; } 4828 print $OUTFD "const $otherarg &v$count"; 4829} 4830# We have to explicitly remove the cast 4831sub constref_in_call { 4832 my $count = $_[0]; 4833 my $lparm = $parm; 4834 4835 # Parm is usually in C, not C++ form. Make sure here 4836 $lparm =~ s/MPI::/MPI_/; 4837 if ($lparm =~ /MPI_/) { 4838 # If an MPI type, cast back to MPI type 4839 if ($lparm eq MPI_Aint && $lparm eq MPI_Offset) { 4840 print $OUTFD "($lparm *)&v$count"; 4841 } 4842 else { 4843 my $shortname = $lparm; 4844 $shortname =~ s/MPI_//; 4845 $shortname = lc($shortname); 4846 if (defined($mytopclass{$shortname})) { 4847 $shortname = $mytopclass{$shortname}; 4848 } 4849 print $OUTFD "($lparm)(v$count.the_real_$shortname)"; 4850 } 4851 } 4852 else { 4853 print $OUTFD "&v$count"; 4854 } 4855} 4856sub constref_in_decl {} 4857sub constref_in_cxxtoc {} 4858sub constref_in_ctocxx {} 4859# ---------------------------------------------------------------------------- 4860# These are used to handle C++ ref types to MPI * type (output) 4861sub reftype_out_methoddecl { 4862 my $count = $_[0]; 4863 if (!$first) { print $OUTFD ", "; } 4864 print $OUTFD "$otherarg &v$count"; 4865} 4866# We have to explicitly remove the cast 4867sub reftype_out_call { 4868 my $count = $_[0]; 4869 my $lparm = $parm; 4870 4871 # Parm is usually in C, not C++ form. Make sure here 4872 $lparm =~ s/MPI::/MPI_/; 4873 if ($lparm =~ /MPI_/) { 4874 # If an MPI type, cast back to MPI type 4875 if ($lparm ne MPI_Aint && $lparm ne MPI_Offset) { 4876 my $shortname = $lparm; 4877 $shortname =~ s/MPI_//; 4878 # Remove any * from the end of the C type 4879 $shortname =~ s/\s*\*\s*$//; 4880 $shortname = lc($shortname); 4881 if (defined($mytopclass{$shortname})) { 4882 $shortname = $mytopclass{$shortname}; 4883 } 4884 print $OUTFD "($lparm)&(v$count.the_real_$shortname)"; 4885 } 4886 else { 4887 print $OUTFD "($lparm)&v$count"; 4888 } 4889 } 4890 else { 4891 print $OUTFD "&v$count"; 4892 } 4893} 4894sub reftype_out_decl { 4895} 4896sub reftype_out_cxxtoc {} 4897sub reftype_out_ctocxx { 4898} 4899# ---------------------------------------------------------------------------- 4900sub ptrref_inout_methoddecl { 4901 my $count = $_[0]; 4902 print $OUTFD "void *&v$count"; 4903} 4904# ---------------------------------------------------------------------------- 4905# Coverage hooks 4906# setCoverage( flag ) 4907sub setCoverage { 4908 my $flag = $_[0]; 4909 $doCoverage = $flag; 4910} 4911# printCoverageStart( fd, name, argcount ) 4912sub printCoverageStart { 4913 my $FD = $_[0]; 4914 my $name = $_[1]; 4915 my $count = $_[2]; 4916 if ($doCoverage) { 4917 print $FD " COVERAGE_START($name,$count);\n"; 4918 } 4919} 4920sub printCoverageEnd { 4921 my $FD = $_[0]; 4922 my $name = $_[1]; 4923 my $count = $_[2]; 4924 if ($doCoverage) { 4925 print $FD " COVERAGE_END($name,$count);\n"; 4926 } 4927} 4928 4929sub printCoverageHeader { 4930 my $FD = $_[0]; 4931 my $isHeader = $_[1]; # Set to true for the mpicxx.h.in file 4932 4933 if ($doCoverage) { 4934 print $FD "// Support ad hoc coverage analysis\n"; 4935 if ($isHeader) { 4936 print $FD "\@DEFINE_FOR_COVERAGE\@\n"; 4937 print $FD "\@DEFINE_FOR_COVERAGE_KIND\@\n"; 4938 } 4939 print $FD "\ 4940#if defined(USE_COVERAGE) 4941#include \"mpicxxcov.h\" 4942#else 4943// Just make these empty in case we've created the coverage versions 4944#define COVERAGE_INITIALIZE() 4945#define COVERAGE_START(a,b) 4946#define COVERAGE_END(a,b) 4947#define COVERAGE_FINALIZE() 4948#endif\n\n"; 4949 } 4950} 4951# 4952# The idea here is that the coverage_finalize call is *not* parallel 4953# knowledgeable. This serializes the coverage 4954sub printCoverageFinalize { 4955 my $FD = $_[0]; 4956 if ($doCoverage) { 4957 print $FD " 4958#ifdef COVERAGE_FINALIZE_NEEDED 4959 { int _mysize, _myrank; 4960 MPI_Comm_size( MPI_COMM_WORLD, &_mysize ); 4961 MPI_Comm_rank( MPI_COMM_WORLD, &_myrank ); 4962 if (_myrank > 0) { 4963 MPI_Recv( MPI_BOTTOM, 0, MPI_INT, _myrank-1,77777,MPI_COMM_WORLD,MPI_STATUS_IGNORE); 4964 } 4965 COVERAGE_FINALIZE(); 4966 if (_myrank + 1 < _mysize) { 4967 MPI_Send( MPI_BOTTOM, 0, MPI_INT, _myrank+1,77777,MPI_COMM_WORLD); 4968 } 4969 } 4970#endif 4971\n"; 4972 } 4973} 4974sub printCoverageInitialize { 4975 my $FD = $_[0]; 4976 if ($doCoverage) { 4977 print $FD "COVERAGE_INITIALIZE();\n"; 4978 } 4979} 4980# ---------------------------------------------------------------------------- 4981# Read a specification file for a binding. This helps provide information on 4982# exceptions and enhancements to the binding automatically derived from the 4983# prototype file (the C header file). The format of this specificaiton 4984# file is: 4985# class-name: [static] return (args) [const] 4986# 4987# argument positions refer to the positions in the original (C) binding 4988# 4989# a \ at the end of the line is a continuation. # begins a comment 4990# 4991# Note that this sets values in GLOBAL variables for the classes and 4992# for each routine. The variables used are 4993# %funcAttributes - attribute for function (e.g., const) 4994# %funcDeclaration - declaration for function (e.g., static) 4995# %funcReturn - position and optional type for return value 4996# %funcArgMap - routine to call to handle a positional argument 4997# 4998# Example declaration 4999sub ReadFuncSpec { 5000 my $filename = $_[0]; 5001 my $linecount = 0; 5002 my $mpilevel = "mpi2"; 5003 open SFD, "<$filename" || die "Cannot open $filename\n"; 5004 5005 while (<SFD>) { 5006 $linecount++; 5007 # Remove comments 5008 s/#.*//g; 5009 # Remove newline 5010 s/\r?\n//; 5011 # Handle any continuations 5012 while (/\\\s*$/) { 5013 my $newline; 5014 s/\\\s*//; 5015 $newline = <SFD>; 5016 $linecount++; 5017 $newline =~ s/#.*//; 5018 $newline =~ s/\r?\n//; 5019 $_ .= $newline; 5020 } 5021 # Handle special cases 5022 if (/<(\w*)>/) { 5023 my $match = 0; 5024 $mpilevel = $1; 5025 foreach $level (@mpilevels) { 5026 if ($mpilevel eq $level) { 5027 $match = 1; 5028 } 5029 } 5030 if (!$match) { 5031 print STDERR "Unrecognized MPI level $mpilevel\n"; 5032 } 5033 next; 5034 } 5035 # Process any data 5036 if (/^\s*(\w*)-(\w*)\s*(.*)/) { 5037 my $class = $1; 5038 my $routine = $2; 5039 my $line = $3; 5040 if ($class eq "") { $class = "base"; } 5041 my $fnchash = "$class-$routine"; 5042 my $specialPos = ""; 5043 my $needsReturn = 0; 5044 my $returnPos = 0; 5045 my $returnType = ""; 5046 my $isStatic = 0; 5047 # Leading static decl 5048 if ($line =~ /^\s*static\s/) { 5049 $funcDeclaration{$fnchash} = "static"; 5050 $isStatic = 1; 5051 $line =~ s/^\s*static\s+//; 5052 } 5053 # Possible returning 5054 if ($line =~ /^(\w*\*?)\s+(.*)/) { 5055 $funcReturnType{$fnchash} = $1; 5056 my $endline = $2; 5057 if ($1 ne "void") { 5058 $needsReturn = 1; 5059 $returnType = $1; 5060 } 5061 $line = $endline; 5062 } 5063 else { 5064 $funcReturnType{$fnchash} = "void"; 5065 } 5066 5067 $line =~ s/\s*\(//; 5068 # Now, process all args 5069 my $argnum = 1; 5070 while ($line =~ /\S/) { 5071 if ($line =~ /\s*([^,\)\s]*)\s*([,\)])(.*)/) { 5072 my $endline = $3; 5073 my $sep = $2; 5074 my $arg = $1; 5075 5076 if ($arg eq "return") { 5077 $returnPos = $argnum; 5078 $funcReturnMap{$fnchash} = "$argnum;$returnType"; 5079 } 5080 elsif ($arg =~ /\S/) { 5081 #print "Setting $fnchash-$argnum = $arg\n"; 5082 $specialPos .= "$argnum:"; 5083 $funcArgMap{"$fnchash-$argnum"} = $arg; 5084 } 5085 5086 $line = $endline; 5087 if ($sep eq ")") { 5088 # break out of the loop to process any end-of-decl 5089 last; 5090 } 5091 $argnum ++; 5092 } 5093 else { 5094 print STDERR "Input line from $filename not recognized: $line\n"; 5095 last; 5096 } 5097 } 5098 # For things like const and =0 5099 if ($line =~ /\s*(\S*)/) { 5100 $funcAttributes{$fnchash} = $1; 5101 } 5102 5103 # This is a temporary until we fix the various hashes and 5104 # function fields 5105 if ($specialPos ne "" || $needsReturn) { 5106 my $classVar = "class_$mpilevel$class"; 5107 chop $specialPos; 5108 my $funcops; 5109 if ($needsReturn) { 5110 $funcops = "$returnPos"; 5111 my $classType = ""; 5112 if (defined($fullclassname{$class})) { 5113 $classType = $fullclassname{$class}; 5114 } 5115 if ($returnType ne "int" && 5116 $returnType ne $classType) { 5117 $funcops .= ";$returnType"; 5118 } 5119 } 5120 else { 5121 $funcops = "0"; 5122 } 5123 if ($specialPos ne "") { 5124 $funcops .= ":"; 5125 } 5126 if (defined($$classVar{$routine})) { 5127 my $newval = $funcops . $specialPos; 5128 if ($isStatic) { 5129 $newval = "static:" . $newval; 5130 } 5131 my $oldval = $$classVar{$routine}; 5132 if ($oldval ne $newval) { 5133 print "Changing $classVar\{$routine\} from $oldval to $newval\n" if $gDebug; 5134 } 5135 } 5136 $$classVar{$routine} = $funcops . $specialPos; 5137 #print "$routine:Special pos = <$funcops$specialPos>\n"; 5138 } 5139 } 5140 elsif (/\S/) { 5141 print STDERR "Unrecognized line $_\n"; 5142 } 5143 } 5144 5145 close SFD; 5146} 5147# ---------------------------------------------------------------------------- 5148# Special debugging: 5149# Somethimes it is valuable to debug just a single routine. This interface 5150# makes that relatively easy 5151sub debugPrint { 5152 my ($routine, $str) = @_; 5153 5154 if ($gDebugRoutine ne "NONE" && $routine eq $gDebugRoutine) { 5155 print $str . "\n"; 5156 } 5157} 5158# ---------------------------------------------------------------------------- 5159# These will be used to add memory tracing around all uses of new and delete 5160sub printNew { 5161 my ($FD, $name, $type, $isArray, $count) = @_; 5162 if ($isArray) { 5163 print $FD "$type *$name = new $type;\n"; 5164 } 5165 else { 5166 print $FD "$type *$name = new $type[$count];\n"; 5167 } 5168} 5169sub printDelete { 5170 my ($FD, $name, $isArray) = @_; 5171 if ($isArray) { 5172 print $FD "delete[] $name;\n"; 5173 } 5174 else { 5175 print $FD "delete $name;\n"; 5176 } 5177} 5178# ---------------------------------------------------------------------------- 5179# 5180# Replace old file with new file only if new file is different 5181# Otherwise, remove new filename 5182sub ReplaceIfDifferent { 5183 my ($oldfilename,$newfilename) = @_; 5184 my $rc = 1; 5185 if (-s $oldfilename) { 5186 $rc = system "cmp -s $newfilename $oldfilename"; 5187 $rc >>= 8; # Shift right to get exit status 5188 } 5189 if ($rc != 0) { 5190 # The files differ. Replace the old file 5191 # with the new one 5192 if (-s $oldfilename) { 5193 print STDERR "Replacing $oldfilename\n"; 5194 unlink $oldfilename; 5195 } 5196 else { 5197 print STDERR "Creating $oldfilename\n"; 5198 } 5199 rename $newfilename, $oldfilename || 5200 die "Could not replace $oldfilename"; 5201 } 5202 else { 5203 unlink $newfilename; 5204 } 5205} 5206# ---------------------------------------------------------------------------- 5207# 5208# ISSUES NOT YET HANDLED 5209# ---------------------------------------------------------------------------- 5210# This tool becomes particularly interesting if it allows custom generation 5211# of a mpicxx.h header file that contains references to only the 5212# requested routines (and even classes; e.g., no Groups if no-one is using 5213# them). 5214# 5215# Pack_size, Pack, and Unpack cannot be defined within the Datatype 5216# class definition because they also need Comm, and Comm needs datatype. 5217# We need to replace this with 5218# Just provide the Pack_size, Pack, Unpack prototypes in the Datatype 5219# class definition 5220# Add these to the end 5221# 5222# Routines with arrays of aggregate types (e.g., arrays of Datatypes) 5223# really require special processing. We need to either do something like 5224# is done for the Fortran routines (for any routine with special needs, 5225# enumerate which args require special handling and name the routine) 5226# or simply provide hand-written code for the internals of those operations. 5227# 5228# class Comm should be pure virtual. This makes it hard to define 5229# COMM_NULL. One possibility is to use a base class that contains 5230# only the null function and operation, then Comm as pure virtual, then 5231# the various communicators. We may also need methods to promote 5232# cart to intracomm and graph to intracomm. 5233# 5234# 5235# static functions. 5236# Rather than find an the class that is the input, the static functions 5237# don't have a current object. These are in the class but 5238# don't have a "this". 5239# These are, however, members of the class. 5240