blob: b71f2e53db8a74b2170aa3107c20d09dc36823ba (
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
120
121
122
123
|
#!/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);
# Do we want line directives?
$line_directives = $line_directives eq 'yes';
$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";
$routine = '';
$n_arg_left_braces = $n_arg_right_braces = 0;
$do_fix_fnames = 0;
# parse the file up to a ";\n"
$/ = ";\n";
#$* = 1; enable multiline support -- no longer supported in perl 5.10
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*\/\//m && $mline !~ m/^\s*\/\*.*\*\/\s*$/m)
{
# Remove a ; from after the DECLARE_CCTK_* macros
$mline =~ s/(DECLARE_CCTK_(PARAMETERS|ARGUMENTS))(\s*;)?/$1/m;
# Remove a ; from after the fileversion macro
# such a semicolon could lead to warning messages.
$mline =~ s/^\s*(CCTK_FILEVERSION\s*\([^)]*\))(\s*;)?/$1/m;
$mline =~ s/^\s*((ONE|TWO|THREE|FOUR|FIVE)_FORTSTRING_(CREATE|PTR)\s*\([^)]*\))(\s*;)?/$1/m;
# start counting braces
$n_arg_left_braces++ while ($mline =~ m/({)/gm);
$n_arg_right_braces++ while ($mline =~ m/(})/gm);
# check if we have to fix names of fortran wrappers
$do_fix_fnames = 1 if ($mline =~ /(CCTK_FNAME|CCTK_FORTRAN_COMMON_NAME)/m);
}
$routine .= $mline . "\n";
if ($n_arg_left_braces > 0 && $n_arg_left_braces - $n_arg_right_braces == 0)
{
$n_arg_left_braces = $n_arg_right_braces = 0;
# call the fortran namefix routine/reset routine
if ($do_fix_fnames)
{
fixfnames ($routine);
$do_fix_fnames = 0;
}
else
{
print $routine;
}
$routine = '';
}
}
}
fixfnames ($routine);
sub fixfnames
{
my $myroutine = shift (@_);
@flines = split /(;)/m,$myroutine;
# print $myroutine;
foreach $fline (@flines)
{
while ($fline =~ m:CCTK_FNAME\s*\(([^\)]*)\):m)
{
$arglist = $1;
$arglist =~ s:[\s\n\t]+::gm;
@args = split(",", $arglist );
$new = &fortran_name($args[$#args]);
$fline =~ s:CCTK_FNAME\s*\(([^\)]*)\):$new:m;
}
while ($fline =~ m:CCTK_FORTRAN_COMMON_NAME\s*\(([^\)]*)\):m)
{
$arglist = $1;
$arglist =~ s:[\s\n\t]+::gm;
@args = split(",", $arglist );
$new = &fortran_common_name($args[$#args]);
$fline =~ s:CCTK_FORTRAN_COMMON_NAME\s*\(([^\)]*)\):$new:m;
}
print $fline;
}
}
|
