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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
#/*@@
# @file CreateImplementationBindings.pl
# @date Sun Jul 4 17:09:54 1999
# @author Tom Goodale
# @desc
#
# @enddesc
#@@*/
sub CreateImplementationBindings
{
my($bindings_dir, $rhparameter_db, $rhinterface_db) = @_;
my($start_dir);
my($thorn);
my(@data);
if(! $build_dir)
{
$build_dir = "$bindings_dir/build";
}
if(! -d $bindings_dir)
{
mkdir("$bindings_dir", 0755) || die "Unable to create $bindings_dir";
}
$start_dir = `pwd`;
chdir $bindings_dir;
if(! -d "Implementations")
{
mkdir("Implementations", 0755) || die "Unable to create Implementations directory";
}
if(! -d "include")
{
mkdir("include", 0755) || die "Unable to create include directory";
}
chdir "Implementations";
@data = ();
foreach $thorn (sort split(" ", $rhinterface_db->{"THORNS"}))
{
push(@data, "int CCTKi_BindingsThorn_$thorn(void);\n")
}
push(@data, "int CCTKi_BindingsImplementationsInitialise(void)\n{\n");
foreach $thorn (sort split(" ", $rhinterface_db->{"THORNS"}))
{
push(@data, " CCTKi_BindingsThorn_$thorn();\n")
}
push(@data, "\n return 0;\n}\n");
&OutputFile(".", "ImplementationBindings.c", @data);
$dataout = "";
$dataout .= "\n";
$dataout .= "SRCS = ImplementationBindings.c\n\n";
&WriteFile("make.code.defn",\$dataout);
if(! -d "$build_dir")
{
mkdir("$build_dir", 0755) || die "Unable to create $build_dir";
}
chdir "$build_dir";
foreach $thorn (sort split(" ", $rhinterface_db->{"THORNS"}))
{
if(! -d "$thorn")
{
mkdir("$thorn", 0755) || die "Unable to create $build_dir/$thorn";
}
chdir "$thorn";
$myimp = $rhinterface_db->{"\U$thorn\E IMPLEMENTS"};
@data = ();
push(@data, "#include <stdio.h>\n");
push(@data, "#include \"cctki_ActiveThorns.h\"\n\n");
push(@data, "int CCTKi_BindingsThorn_${thorn}(void)\n{\n");
push(@data, " int retval;\n");
push(@data, " const char *name[] = {\"$thorn\",0};");
push(@data, " const char *implementation[]={\"$myimp\",0};");
push(@data, " const char *ancestors[]=\n {");
foreach $ancestor (split(" ",$rhinterface_db->{"IMPLEMENTATION \U$myimp\E ANCESTORS"}))
{
push(@data, " \"$ancestor\",");
}
push(@data, " 0,");
push(@data, " };\n");
# Just pass the ones this thorn has declared itself to be friends with.
push(@data, " const char *friends[]=\n {");
foreach $friend (split(" ",$rhinterface_db->{"\U$thorn\E FRIEND"}))
{
push(@data, " \"$friend\",");
}
push(@data, " 0,");
push(@data, " };\n");
push(@data, " /* Should be able to do below with a constant initialiser but sr8000 compiler complains");
push(@data, " * So have to laboriously assign values to each member of array.");
push(@data, " */");
push(@data, " struct iAttributeList attributes[5];");
push(@data, "");
push(@data, " attributes[0].attribute = \"name\";");
push(@data, " attributes[0].AttributeData.StringList = name;");
push(@data, " attributes[1].attribute = \"implementation\";");
push(@data, " attributes[1].AttributeData.StringList = implementation;");
push(@data, " attributes[2].attribute = \"ancestors\";");
push(@data, " attributes[2].AttributeData.StringList = ancestors;");
push(@data, " attributes[3].attribute = \"friends\";");
push(@data, " attributes[3].AttributeData.StringList = friends;");
push(@data, " attributes[4].attribute = 0;");
push(@data, " attributes[4].AttributeData.StringList = 0;");
push(@data, "\n");
push(@data, " retval = CCTKi_RegisterThorn(attributes);");
push(@data, "\n return retval;\n}\n");
&OutputFile(".", "cctk_ThornBindings.c", @data);
$dataout = "";
$dataout .= "\n";
$dataout .= "SRCS = cctk_ThornBindings.c\n\n";
&WriteFile("make.code.defn",\$dataout);
chdir "..";
}
}
1;
|
