blob: b948a7f17bc9e57269d688adb3e3410079dd7c9d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
#!/bin/perl
#/*@@
# @file c_file_processor.pl
# @date Fri Jan 22 18:09:47 1999
# @author Tom Goodale / Gerd Lanfermann / Thomas Radke
# @desc
# Processes certain things within a C source file
# which can't be dealt with by the normal C preprocessor.
#
# This script puts everything after a DECLARE_CCTK macro
# until the end of the routine into a new block.
# It also fixes the function names for fortran wrappers.
# @enddesc
# @version $Header$
#@@*/
$home = shift(@ARGV);
$fortran_name_file = "$home/fortran_name.pl";
if (! -e "$fortran_name_file" )
{
die "Unable to get fortran name file $fortran_name_file!";
}
require "$fortran_name_file";
#if($source_file_name)
#{
# print "# 1 $source_file_name\n";
#}
$closing_brackets = '';
$routine = '';
$n_arg_braces = -3;
# parse the file up to a ";\n"
$/ = ";\n";
$* = 1;
while (<>)
{
# split in lines... and collect in routine;
foreach $mline (split ("\n"))
{
# skip one-line comments
# (note that this is still incomplete for multi-line C comments -
# it is not checked if some code follows after the closing '*/')
if ($mline !~ m/^\s*\/\// && $mline !~ m/^\s*\/\*.*\*\/\s*$/)
{
# check if the DECLARE macros are found on a line
if ($mline =~ s/(DECLARE_CCTK_(PARAMETERS|ARGUMENTS))(\s*;)?/$1 {/g)
{
$closing_brackets = "} /* closing bracket for $1 block */ " . $closing_brackets;
$n_arg_braces = -1;
}
# start counting braces if there has been a DECLARE macro
if ($closing_brackets)
{
$n_arg_braces-- while ($mline =~ m/(})/g);
$n_arg_braces++ while ($mline =~ m/({)/g);
}
$mline = "$closing_brackets$mline" if ($n_arg_braces == -1);
}
$routine .= $mline . "\n";
if ($n_arg_braces == -1)
{
$closing_brackets = '';
$n_arg_braces = -2;
# call the fortran namefix routine/reset routine
fixfnames ($routine);
$routine = '';
}
}
}
fixfnames ($routine);
sub fixfnames
{
my $myroutine = shift (@_);
@flines = split /(;)/,$myroutine;
# print $myroutine;
foreach $fline (@flines)
{
while ($fline =~ m:CCTK_FNAME\s*\(([^\)]*)\):)
{
$arglist = $1;
$arglist =~ s:[\s\n\t]+::g;
@args = split(",", $arglist );
$new = &fortran_name($args[$#args]);
$fline =~ s:CCTK_FNAME\s*\(([^\)]*)\):$new:;
}
while ($fline =~ m:CCTK_FORTRAN_COMMON_NAME\s*\(([^\)]*)\):)
{
$arglist = $1;
$arglist =~ s:[\s\n\t]+::g;
@args = split(",", $arglist );
$new = &fortran_common_name($args[$#args]);
$fline =~ s:CCTK_FORTRAN_COMMON_NAME\s*\(([^\)]*)\):$new:;
}
print $fline;
}
}
|
