Assume alice.inp in local directory.
[u/mrichter/AliRoot.git] / TFluka / scripts / c2h.pl
CommitLineData
b9d0a01d 1#!/usr/bin/perl
2
3# Written by Endre Futo
4# 21-May-2002
5
6# read the filename from the command argument
7$inputfn = shift @ARGV;
8$len = length($inputfn);
9if ($len == 0) {
10 die "\nUsage: perl c2h \\(commonname\\)\n";
11}
12open(in, $inputfn) || die "\nCannot open the input file\n";
13
14# construct the output file name
15$outputfn = $inputfn;
16# chop last character
17$rightpar = chop($outputfn);
18# translate to lower case
19$commonname = $outputfn;
20$commonname =~ tr/(/F/;
21$commonname = join("",$commonname,"_H");
22$outputfn =~ tr/A-Z/a-z/;
23# translate '(' to 'F'
24$outputfn =~ tr/(/F/;
25# append '.h' to the output file name and prefix it by '>'
26$outputfn = join("",">",$outputfn,".h");
27open(out,$outputfn);
28print out "#ifndef ",$commonname,"\n";
29print out "#define ",$commonname," 1 \n";
30$newline = join("","#include \"cfortran.h\"\n");
31print out $newline;
32$newline = join("","#include \"Rtypes.h\" \n");
33print out $newline;
34$newline = join("","#include \"Fdimpar.h\" \n");
35print out $newline;
36$newline = join("","extern \"C\" {\n");
37print out $newline;
38
39# Print the hints
40# ===============
41$newline = join ("","\nCheck in the input file",$inputfn,":\n");
42print $newline;
43print "1. At the end of the input file must be at least one blank line\n";
44
45$newline = $outputfn;
46$newline =~ tr/>/ /;
47$newline = join("","\nIn the C++ header file",$newline," created from the FORTRAN common file ",$inputfn," always check: \n");
48print $newline;
49print "1. Mutidimensional arrays - swap the dimensions\n";
50print "2. Arrays dimensioned as X(x:y) - should became X[x-y+1]\n";
51print "3. CHARACTER* variables - swap the dimension and CHARACTER* size\n";
52print "4. LOGICAL variables - all should be integers\n";
53print "5. All comment lines\n";
54print "6. All continuation lines\n";
55print "7. All unions created from EQUIVALENCEs\n";
56print "8. All double constants - exponent should be e not d\n";
57print "9. All constants with exponent- exponent should not start with 0\n";
58
59$oncommon = 0;
60$firstcom = 0;
61
62# Loop over lines read from the input file
63# ========================================
64while($line = <in>) {
65
66# Translate everything to lower case
67# ==================================
68
69 $line =~ tr/A-Z/a-z/;
70#---------------------------------------------------------------------------
71
72# Treat comments
73# ==============
74
75 if ($line =~ /^\*/) {
76 $newline = join("","\/\/",$line);
77 print out $newline;
78 }
79#---------------------------------------------------------------------------
80
81# Treat equivalence (became unions)
82# ================================
83
84 elsif ($line =~ /equivalence/) {
85# chop last two characters
86 $rightpar = chop($line);
87 $rightpar = chop($line);
88# search for '('
89 $pos = index($line,'(');
90# shift out everything before '(' inclusive
91 $newline1 = substr($line,$pos+1);
92# split the rest of the line according to blank
93 @vars = split(" ",$newline1);
94# join the line again - the line will now be without blanks
95 $newline1 = join("",@vars);
96# translate '(' to '['
97 $newline1 =~ tr/(/[/;
98# translate ')' to ']'
99 $newline1 =~ tr/)/]/;
100# split the rest of the line according to comma
101 ($var1,$var2) = split(",",$newline1);
102# here may come handling of variables
103#
104# first variable is an integer
105 if ($var1 =~ /^[i-n]/) {
106 if ($var2 =~ /^[i-n]/) {
107 $newline = join("","union { int ",$var1,";"," int ",$var2,";};\n");
108 }
109 else {
110 $newline = join("","union { int ",$var1,";"," double ",$var2,";};\n");
111 }
112 }
113# first variable is a double precision
114 else {
115 if ($var2 =~ /^[i-n]/) {
116 $newline = join("","union { double ",$var1,";"," int ",$var2,";};\n");
117 }
118 else {
119 $newline = join("","union { double ",$var1,";"," double ",$var2,";};\n");
120 }
121 }
122 print out $newline;
123 }
124#---------------------------------------------------------------------------
125
126# Treat parameters (became constants)
127# ===================================
128
129 elsif ($line =~ /parameter/) {
130# chop last two characters
131 $rightpar = chop($line);
132 $rightpar = chop($line);
133# search for '('
134 $pos = index($line,'(');
135# shift out everything before '(' inclusive
136 $newline1 = substr($line,$pos+1);
137# store the variable name
138 ($var) = split("=",$newline1);
139# split the variable name according to blank
140 @vars = split(" ",$var);
141# join the line again - the variable name will now be without blanks
142 $var = join("",@vars);
143# search for '='
144 $pos = index($line,'=');
145# shift out everything before '=' inclusive
146 $newline1 = substr($line,$pos+1);
147# split the rest of the line according to blank
148 @vars = split(" ",$newline1);
149# join the line again - the line will now be without blanks
150 $newline1 = join("",@vars);
151
152# parameter is an integer
153 if ($var =~ /^[i-n]/) {
154 $newline = join("","const int ",$var," = ",$newline1,";\n");
155 print out $newline;
156 }
157# parameter is real in double precision
158 else {
159 $newline = join("","const double ",$var," = ",,$newline1,";\n");
160 print out $newline;
161 }
162 }
163#---------------------------------------------------------------------------
164
165# Treat commons (became struct)
166# =============================
167
168# first line of the common
169# ------------------------
170 elsif ($line =~ /common/) {
171# finish the previous common - for the first one there is nothing to finish
172 if ($firstcom eq 1) {
173 $newline = join("","} ",$comname,"Common;","\n");
174 print out $newline;
175 $comnamebig = $comname;
176# translate common name back to capitals
177 $comnamebig =~ tr/a-z/A-Z/;
178 $newline = join("","#define ",$comnamebig," COMMON_BLOCK(",$comnamebig,",",$comname,")\n");
179 print out $newline;
180 $newline = join("","COMMON_BLOCK_DEF(",$comname,"Common",",",$comnamebig,");\n");
181 print out $newline;
182 }
183# from now on the first common is over
184 $firstcom = 1;
185 $newline = join("","\ntypedef struct {","\n");
186 print out $newline;
187# we are inside a common
188 $oncommon = 1;
189# look for the first '/'
190 $pos = index($line,'/');
191# shift out everything before first '/' inclusive
192 $newline1 = substr($line,$pos+1);
193 $newline2 = $newline1;
194# eliminate the second '/'
195 $newline2 =~ tr/\// /;
196# determine the common name
197 ($comname) = split(" ",$newline2);
198# look for the second '/'
199 $pos = index($newline1,'/');
200# shift out everything before second '/' inclusive
201 $newline2 = substr($newline1,$pos+1);
202# split the rest of the line according to blank
203 @vars = split(" ",$newline2);
204# join the line again - the line will now be without blanks
205 $newline2 = join("",@vars);
206# here may come handling of multidimensional arrays
207#
208# translate comma to blank
209 $newline2 =~ tr/,/ /;
210# translate '(' to '['
211 $newline2 =~ tr/(/[/;
212# translate ')' to ']'
213 $newline2 =~ tr/)/]/;
214# split the rest of the line according to blank
215 @vars = split(" ",$newline2);
216# loop over common variables
217 for ($i=0; $i < @vars; $i++) {
218 if ($vars[$i] =~ /^[i-n]/) {
219 $newline = join(""," int ",$vars[$i],";\n");
220 print out $newline;
221 }
222 else {
223 $newline = join(""," double ",$vars[$i],";\n");
224 print out $newline;
225 }
226 }
227 }
228
229# continuation line of the common
230# -------------------------------
231 elsif (($line =~ /&/) && ($oncommon eq 1)) {
232# look for '&'
233 $pos = index($line,'&');
234# shift out everything before '&' inclusive
235 $newline1 = substr($line,$pos+1);
236# split the rest of the line according to blank
237 @vars = split(" ",$newline1);
238# join the line again - the line will now be without blanks
239 $newline2 = join("",@vars);
240# here may come handling of multidimensional arrays
241#
242# translate comma to blank
243 $newline2 =~ tr/,/ /;
244# translate '(' to '['
245 $newline2 =~ tr/(/[/;
246# translate ')' to ']'
247 $newline2 =~ tr/)/]/;
248# split the rest of the line according to blank
249 @vars = split(" ",$newline2);
250# loop over common variables
251 for ($i=0; $i < @vars; $i++) {
252 if ($vars[$i] =~ /^[i-n]/) {
253 $newline = join(""," int ",$vars[$i],";\n");
254 print out $newline;
255 }
256 else {
257 $newline = join(""," double ",$vars[$i],";\n");
258 print out $newline;
259 }
260 }
261 }
262
263# the line does not belong to the common (end of common)
264# ------------------------------------------------------
265 elsif ($oncommon eq 1) {
266 $newline = join("","} ",$comname,"Common;","\n");
267 print out $newline;
268 $comnamebig = $comname;
269# translate common name back to capital
270 $comnamebig =~ tr/a-z/A-Z/;
271 $newline = join("","#define ",$comnamebig," COMMON_BLOCK(",$comnamebig,",",$comname,")\n");
272 print out $newline;
273 $newline = join("","COMMON_BLOCK_DEF(",$comname,"Common",",",$comnamebig,");\n");
274 print out $newline;
275 $oncommon = 0;
276 }
277#---------------------------------------------------------------------------
278
279# all other lines are just repeated as comments
280# ---------------------------------------------
281 else {
282# prefix line with '//'
283 $newline = join("","\/\/",$line);
284# translate common name back to capitals
285 $newline =~ tr/a-z/A-Z/;
286 print out $newline;
287 }
288
289
290}
291# closing curly parenthesis od the extern "C" { statement
292print out "}\n";
293print out "#endif\n";
294
295close(in);
296close(out);
297
298