1#! /usr/bin/env perl 2# 3# This file contains common routines for reading a file of function prototypes 4# (such as mpi.h) and extracting the function prototypes. 5 6# 7# ReadInterface( filename, routineprefix, routinepattern, routinehash ) 8# Read file filename, look for routines that have a given prefix and name 9# pattern, and insert that routine into routinehash with value the 10# arguments of the routine. 11 12#$Finalized_args = "bool"; 13 14sub ReadInterface { 15 my $prototype_file = $_[0]; 16 my $routine_prefix = $_[1]; 17 my $routine_pattern = $_[2]; 18 my $routine_hash = $_[3]; 19 # $debug is a global variable 20 21 open( FD, "<$prototype_file" ) || die "Cannot open $prototype_file\n"; 22 23 # Skip to prototypes 24 while (<FD>) { 25 if ( /\/\*\s*Begin Prototypes/ ) { last; } 26 } 27 28 # Read each one 29 while (<FD>) { 30 # Handle the special case of prototypes to ignore 31 if (/\/\*\s*Begin Skip Prototypes/) { 32 while (<FD>) { 33 if (/\/\*\s*End Skip Prototypes/) { last; } 34 } 35 } 36 if (/\/\*\s*End Prototypes/) { last; } 37 # Remove any comments 38 $origline = $_; 39 while (/(.*)\/\*(.*?)\*\/(.*)/) { 40 my $removed = $2; 41 $_ = $1.$3; 42 if ($2 =~ /\/\*/) { 43 print STDERR "Error in processing comment within interface file $prototype_file in line $origline"; 44 } 45 } 46 print "binding: read $_" if $gDebug; 47 if (/^int\s+$routine_prefix($routine_pattern)\s*\((.*)/) { 48 $routine_name = $1; 49 $args = $2; 50 while (! ($args =~ /;/)) { 51 $args .= <FD>; 52 } 53 $args =~ s/MPICH_ATTR[A-Z_]*\([^)]*\)//g; 54 $args =~ s/\)\s*;//g; 55 $args =~ s/[\r\n]*//g; 56 # remove qualifiers from args 57 $args =~ s/\s*const\s+//g; 58 59 print "binding: $routine_name ( $args )\n" if $gDebug; 60 # Eventually, we'll create a new file here. 61 # For C++, we may create similar files by looking up 62 # the corresponding routines. 63 # Check for duplicates in the list of routines 64 if (defined($$routine_hash{$routine_name})) { 65 print STDERR "Duplicate prototypes for $routine_name\n"; 66 next; 67 } 68 # Clear variables 69 $args = &clean_args( $args ); 70# # Handle special cases 71# my $testname = $routine_name . "_args"; 72# if (defined($$testname)) { 73# print "replacing args for $routine_name\n" if $gDebug; 74# $args = $$testname; 75# } 76 $$routine_hash{$routine_name} = $args; 77 } 78 } 79} 80 81# 82# Look through $args for parameter names (foo\s+name) 83# and remove them 84sub clean_args { 85 my $args = $_[0]; 86 my $newargs = ""; 87 my $comma = ""; 88 for my $parm (split(',',$args)) { 89 # Remove any leading or trailing spaces 90 $parm =~ s/^\s*//; 91 $parm =~ s/\s*$//; 92 # Handle parameters with parameter names 93 # First if handles "int foo", second handles "int *foo" 94 if ( ($parm =~ /^([A-Za-z0-9_]+)\s+[A-Za-z0-9_]+$/) ) { 95 $parm = $1; 96 } 97 elsif ( ($parm =~ /([A-Za-z0-9_]+\s*\*)\s*[A-Za-z0-9_]+$/) ) { 98 $parm = $1; 99 } 100 elsif ( ($parm =~ /([A-Za-z0-9_]+)\s*[A-Za-z0-9_]+(\[.*\])\s*$/) ) { 101 my $basename = $1; 102 my $arrayarg = $2; 103 #if ($arrayarg =~ /\[\s*\]/) { $arrayarg = "*"; } 104 $parm = $basename . $arrayarg; 105 } 106 elsif ( ($parm =~ /([A-Za-z0-9_]+)\s\*?\s*[A-Za-z0-9_]+(\[.*\])\s*$/) ) { 107 my $basename = $1; 108 my $arrayarg = $2; 109 #if ($arrayarg =~ /\[\s*\]/) { $arrayarg = "*"; } 110 $parm = $basename . $arrayarg; 111 } 112 $newargs .= "$comma$parm"; 113 $comma = ","; 114 } 115 print STDERR "$newargs\n" if $gDebug; 116 $args = $newargs; 117 return $args; 118} 119 120# Since this is a required package, indicate that we are successful. 121return 1; 122