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