Mercurial > hg > CbC > CbC_xv6
annotate src/gearsTools/generate_stub.pl @ 395:17e8a4bc06a7 default tip
add macOS AR/RANLIB
| author | Shinji KONO <kono@ie.u-ryukyu.ac.jp> |
|---|---|
| date | Mon, 14 Dec 2020 21:59:50 +0900 |
| parents | dccc1cb1350c |
| children |
| rev | line source |
|---|---|
| 44 | 1 #!/usr/bin/perl |
| 2 | |
| 3 use strict; | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
4 use Getopt::Long; |
| 44 | 5 use File::Path qw(make_path); |
| 6 | |
| 7 # interface.h | |
| 8 # typedef struct Worker { | |
| 9 # int id; | |
| 10 # struct Context* contexts; | |
| 11 # enum Code execute; | |
| 12 # enum Code taskSend; | |
| 13 # enum Code taskRecive; | |
| 14 # enum Code shutdown; | |
| 15 # struct Queue* tasks; | |
| 16 # } Worker; | |
| 17 | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
18 our($opt_o,$opt_d,$opt_h, $opt_project); |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
19 |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
20 GetOptions( |
| 357 | 21 "o=s" => \$opt_o, |
| 22 "d=s" => \$opt_d, | |
| 23 "h" => \$opt_h, | |
| 24 "project=s" => \$opt_project, | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
25 ); |
| 44 | 26 |
| 27 my $dir = "."; | |
| 28 if ($opt_d) { | |
| 29 $dir = $opt_d; | |
| 30 if (! -d $dir) { | |
| 31 make_path $dir; | |
| 32 } | |
| 33 } | |
| 34 | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
35 |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
36 |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
37 my %projects = ( |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
38 gears => { cotnext => "context" }, |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
39 xv6 => { context => "cbc_context" }, |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
40 ); |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
41 |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
42 |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
43 my $context_name = "context"; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
44 if ($opt_project && exists $projects{$opt_project}) { |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
45 $context_name = $projects{$opt_project}->{context}; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
46 } |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
47 |
| 44 | 48 for my $fn (@ARGV) { |
| 49 next if ($fn !~ /\.cbc$/); | |
| 50 &getDataGear($fn); | |
| 51 &generateDataGear($fn); | |
| 52 } | |
| 53 | |
| 54 my %var; | |
| 55 my %code; | |
| 56 my %dataGearVar; | |
| 57 my %outputVar; # output var initializer | |
| 58 my %outputArgs; # continuation's output variables | |
| 59 my %dataGear; | |
| 60 my %dataGearName; | |
| 61 my %generic; | |
| 62 my %dataGearVarType; | |
| 63 my %codeGear; | |
| 64 my $implementation; | |
| 65 my $interface; | |
| 386 | 66 my %filename2localCodes; |
| 44 | 67 |
| 68 # interface definision | |
| 69 # | |
| 70 # typedef struct Stack<Type, Impl>{ | |
| 71 # Type* stack; | |
| 72 # Type* data; | |
| 73 # Type* data1; | |
| 74 # __code whenEmpty(...); | |
| 75 # __code clear(Impl* stack,__code next(...)); | |
| 76 # __code push(Impl* stack,Type* data, __code next(...)); | |
| 77 # __code pop(Impl* stack, __code next(Type*, ...)); | |
| 78 # __code pop2(Impl* stack, Type** data, Type** data1, __code next(Type**, Type**, ...)); | |
| 79 # __code isEmpty(Impl* stack, __code next(...), __code whenEmpty(...)); | |
| 80 # __code get(Impl* stack, Type** data, __code next(...)); | |
| 81 # __code get2(Impl* stack,..., __code next(...)); | |
| 82 # __code next(...); | |
| 83 # } Stack; | |
| 84 # | |
| 85 # calling example | |
| 86 # | |
| 87 # goto nodeStack->push((union Data*)node, stackTest3); | |
| 88 # | |
| 89 # generated meta level code | |
| 90 # | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
91 # Gearef(context, Stack)->stack = (union Data*)nodeStack; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
92 # Gearef(context, Stack)->data = (union Data*)node; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
93 # Gearef(context, Stack)->next = C_stackTest3; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
94 # goto meta(context, nodeStack->push); |
| 44 | 95 |
| 96 sub getDataGear { | |
| 97 my ($filename) = @_; | |
| 386 | 98 |
| 99 setFilename2CodeGear($filename); | |
| 100 | |
|
249
42a37a8a02c9
impl described_data_gear mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
248
diff
changeset
|
101 my ($codeGearName, $name, $inTypedef,$described_data_gear); |
| 44 | 102 open my $fd,"<",$filename or die("can't open $filename $!"); |
| 103 while (<$fd>) { | |
| 104 if (! $inTypedef) { | |
| 105 if (/^typedef struct (\w+)\s*<(.*)>/) { | |
| 106 $inTypedef = 1; | |
| 107 $name = $1; | |
| 108 $dataGear{$name} = $_; | |
| 109 $var{$name} = {}; | |
| 110 $code{$name} = {}; | |
| 111 $generic{$name} = \split(/,/,$2); | |
| 112 } elsif (/^typedef struct (\w+)/) { | |
| 113 $inTypedef = 1; | |
| 114 $name = $1; | |
| 115 $dataGear{$name} = $_; | |
| 116 $var{$name} = {}; | |
| 117 $code{$name} = {}; | |
| 118 $generic{$name} = []; | |
| 119 } elsif (/^(\w+)(\*)+ create(\w+)\(/) { | |
| 120 if (defined $interface) { | |
| 121 die "duplicate interface $interface\n"; | |
| 122 } | |
| 123 $interface = $1; | |
| 124 $implementation = $3; | |
| 125 if ( -f "$interface.cbc") { | |
| 126 &getDataGear("$interface.cbc"); | |
| 127 } | |
| 128 } elsif(/^(.*)par goto (\w+)\((.*)\)/) { | |
| 129 my $codeGearName = $2; | |
| 130 if ($filename =~ /^(.*)\/(.*)/) { | |
| 131 $codeGearName = "$1/$codeGearName"; | |
| 132 } | |
| 133 if ( -f "$codeGearName.cbc") { | |
| 134 &getCodeGear("$codeGearName.cbc"); | |
| 135 } | |
|
242
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
136 } elsif(/^#interface "(.*)"/) { |
| 44 | 137 # use interface |
| 138 my $interfaceHeader = $1; | |
| 139 next if ($interfaceHeader =~ /context.h/); | |
| 140 if (-f $interfaceHeader) { | |
| 141 &getDataGear("$interfaceHeader"); | |
| 142 &getCodeGear("$interfaceHeader"); | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
143 } else { |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
144 if ($filename =~ /([\w\/]+)\/(.+)$/) { |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
145 $interfaceHeader = "$1/$interfaceHeader"; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
146 if (-f $interfaceHeader) { |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
147 &getDataGear("$interfaceHeader"); |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
148 &getCodeGear("$interfaceHeader"); |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
149 } |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
150 } |
| 44 | 151 } |
| 152 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { | |
| 153 my $codeGearName = $1; | |
| 154 if ($filename =~ /^(.*)\/(.*)/) { | |
| 155 $codeGearName = "$1/$codeGearName"; | |
| 156 } | |
| 157 if ( -f "$codeGearName.cbc") { | |
| 158 &getCodeGear("$codeGearName.cbc"); | |
| 159 } | |
| 160 } | |
| 161 next; | |
| 162 } | |
| 163 # gather type name and type | |
| 164 $dataGear{$name} .= $_; | |
| 165 if (/^\s*(.*)\s+(\w+);$/ ) { | |
| 166 my $ttype = $1; | |
| 167 my $tname = $2; | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
168 if ($ttype =~ /^(union|struct|const|enu,)?\s*(\w+)/) { |
| 298 | 169 if ($1 ne 'const') { |
| 170 $ttype = $2; | |
| 171 } else { | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
172 my $vname = $2; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
173 my $ttype = $1; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
174 if ($ttype =~ /(const|enum)/) { |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
175 $ttype = "$1 $vname"; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
176 } |
| 298 | 177 } |
| 44 | 178 } |
|
249
42a37a8a02c9
impl described_data_gear mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
248
diff
changeset
|
179 $described_data_gear = 1; |
| 44 | 180 $var{$name}->{$tname} = $ttype; |
| 181 } | |
|
242
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
182 if (/__code (\w+)/) { |
|
249
42a37a8a02c9
impl described_data_gear mode
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
248
diff
changeset
|
183 next if $described_data_gear; |
|
242
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
184 my $args = $'; |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
185 while ($args =~ /\s*(struct|union|const|enum)?\s*([\w\[\]_]+)\*?\s*(\w+),?/g) { |
|
242
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
186 #$args eq (Impl* vm, pde_t* pgdir, char* init, uint sz, __code next(...)); |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
187 my $const_type = $1; |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
188 my $ttype = $2; |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
189 my $tname = $3; |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
190 |
| 248 | 191 $ttype =~ s/(Impl|Isa|Type)/Data/; |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
192 if ($const_type =~ /(const|enum)/) { |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
193 $ttype = "$1 $ttype"; |
|
242
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
194 } |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
195 $var{$name}->{$tname} = $ttype; |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
196 } |
|
26be78edaf83
impl auto collection for data gears from interface
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
82
diff
changeset
|
197 } |
| 44 | 198 if (/^}/) { |
| 199 $inTypedef = 0; | |
| 200 } | |
| 201 } | |
| 202 | |
| 203 } | |
| 204 | |
| 205 sub getCodeGear { | |
| 206 my ($filename) = @_; | |
| 207 open my $fd,"<",$filename or die("can't open $filename $!"); | |
| 208 my ($name,$impln); | |
| 209 while (<$fd>) { | |
|
359
87a28b02c88f
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
357
diff
changeset
|
210 if (/^(\w+)\s*(\*)+ create(\w+)\(/) { |
| 44 | 211 $name = $1; |
| 212 $impln = $3; | |
|
359
87a28b02c88f
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
357
diff
changeset
|
213 } elsif(/^typedef struct (\w+)\s*<.*>\s*{/) { |
| 44 | 214 $name = $1; |
| 215 } | |
| 216 if (defined $name) { | |
| 217 if (/^\s*\_\_code (\w+)\((.*)\);/) { | |
| 218 my $args = $2; | |
| 219 my $method = $1; | |
| 220 $code{$name}->{$method} = []; | |
| 221 while($args) { | |
| 222 # replace comma | |
| 223 $args =~ s/(^\s*,\s*)//; | |
| 224 # continuation case | |
| 225 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) { | |
| 226 my $next = $2; | |
| 227 my @args = split(/,/,$3); | |
| 228 push(@{$code{$name}->{$method}},"\_\_code $next"); | |
| 298 | 229 } elsif ($args =~ s/^(struct|union|const)?\s*(\w+)(\**)\s+(\w+)//) { |
| 44 | 230 my $structType = $1; |
| 231 my $typeName = $2; | |
| 232 my $ptrType = $3; | |
| 233 my $varName = $4; | |
| 234 my $typeField = lcfirst($typeName); | |
| 298 | 235 if ($structType =~ /const/) { |
| 236 $typeName = "$structType $typeName"; | |
| 237 } | |
| 44 | 238 push(@{$code{$name}->{$method}},"$typeName$ptrType $varName"); |
| 239 } elsif ($args =~ s/(.*,)//) { | |
| 240 } else { | |
| 241 last; | |
| 242 } | |
| 243 } | |
| 244 } | |
| 245 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { | |
| 246 my $codeGearName = $1; | |
| 247 my $args = $2; | |
| 248 my $inputCount = 0; | |
| 249 my $outputCount = 0; | |
| 250 my $inputIncFlag = 1; | |
| 251 while($args) { | |
| 252 if ($args =~ s/(^\s*,\s*)//) { | |
| 253 } | |
| 254 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\((.*?)\)//) { | |
| 255 $codeGear{$codeGearName}->{"code"}->{$2} = "\_\_code"; | |
| 256 $inputIncFlag = 0; | |
| 257 my @outputs = split(/,/,$3); | |
| 258 for my $output (@outputs) { | |
| 298 | 259 if ($output =~ /\s*(struct|union|const)?\s*(\w+)(\*)?+\s(\w+)/) { |
| 260 my $structType = $1; | |
| 44 | 261 my $type = $2; |
| 262 my $varName = $4; | |
| 298 | 263 if ($structType =~ /const/) { |
| 264 $type = "$structType $type"; | |
| 265 } | |
| 44 | 266 $codeGear{$codeGearName}->{"var"}->{$varName} = "$type $outputCount"; |
| 267 $outputCount++; | |
| 268 } | |
| 269 } | |
| 298 | 270 } elsif ($args =~ s/^(struct|union|const)?\s*(\w+)(\*)?+\s(\w+)// && $inputIncFlag) { |
| 271 my $structType = $1; | |
| 44 | 272 my $type = $2; |
| 273 my $varName = $4; | |
| 298 | 274 if ($structType =~ /const/) { |
| 275 $type = "$structType $type"; | |
| 276 } | |
| 44 | 277 $codeGear{$codeGearName}->{"var"}->{$varName} = "$type $inputCount"; |
| 278 $inputCount++; | |
| 279 } elsif ($args =~ s/(.*,)//) { | |
| 280 } else { | |
| 281 last; | |
| 282 } | |
| 283 } | |
| 284 $codeGear{$codeGearName}->{"input"} = $inputCount; | |
| 285 $codeGear{$codeGearName}->{"output"} = $outputCount; | |
| 286 } | |
| 287 } | |
| 288 } | |
| 289 | |
| 290 sub generateStub { | |
| 291 my($fd,$prevCodeGearName,$dataGearName) = @_; | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
292 print $fd "__code ", $prevCodeGearName ,"_stub(struct Context* $context_name) {\n"; |
| 44 | 293 print $fd $dataGearName; |
| 294 print $fd "\n} \n\n"; | |
| 295 return 1; | |
| 296 } | |
| 297 | |
| 298 sub generateStubArgs { | |
| 299 my($codeGearName, $varName, $typeName, $ptrType, $typeField, $interface,$output) = @_; | |
| 300 my $varname1 = $output?"O_$varName":$varName; | |
| 301 for my $n ( @{$dataGearVar{$codeGearName}} ) { | |
| 302 # we already have it | |
| 303 return 0 if ( $n eq $varname1); | |
| 304 } | |
| 305 push @{$dataGearVar{$codeGearName}}, $varname1; | |
| 306 push @{$dataGearVarType{$codeGearName}}, $typeName; | |
| 307 if ($typeName eq $implementation) { | |
| 308 # get implementation | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
309 $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl($context_name, $interface, $varName);\n"; |
| 44 | 310 } else { |
| 311 # interface var | |
| 312 for my $ivar (keys %{$var{$interface}}) { | |
| 313 # input data gear field | |
| 314 if ($varName eq $ivar) { | |
| 315 if ($typeName eq $var{$interface}->{$ivar}) { | |
| 316 if ($output) { | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
317 $dataGearName{$codeGearName} .= "\t$typeName$ptrType* O_$varName = &Gearef($context_name, $interface)->$varName;\n"; |
| 82 | 318 $outputVar{$codeGearName} .= "\t$typeName$ptrType $varName __attribute__((unused)) = *O_$varName;\n"; |
| 44 | 319 return 1; |
| 320 } | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
321 $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = Gearef($context_name, $interface)->$varName;\n"; |
| 44 | 322 return 1; |
| 323 } | |
| 324 } | |
| 325 } | |
| 298 | 326 |
| 44 | 327 # interface continuation |
| 328 for my $cName (keys %{$code{$interface}}) { | |
| 329 if ($varName eq $cName) { | |
| 330 # continuation field | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
331 $dataGearName{$codeGearName} .= "\tenum Code $varName = Gearef($context_name, $interface)->$varName;\n"; |
| 44 | 332 return 1; |
| 333 } | |
| 334 } | |
| 335 # par goto var | |
| 336 for my $var (keys %{$codeGear{$codeGearName}->{"var"}}) { | |
| 337 # input data gear field | |
| 338 if ($varName eq $var) { | |
| 339 my ($type, $count) = split(/\s/, $codeGear{$codeGearName}->{"var"}->{$var}); | |
| 340 if ($typeName eq $type) { | |
| 341 if ($output) { | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
342 $dataGearName{$codeGearName} .= "\t$typeName$ptrType* O_$varName = ($typeName $ptrType*)&${context_name}->data[${context_name}\->odg + $count];\n"; |
| 44 | 343 $outputVar{$codeGearName} .= "\t$typeName$ptrType $varName = *O_$varName;\n"; |
| 344 return 1; | |
| 345 } | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
346 $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = &${context_name}->data[${context_name}\->idg + $count]->$typeName;\n"; |
| 44 | 347 return 1; |
| 348 } | |
| 349 } | |
| 350 } | |
| 351 | |
| 352 # par goto continuation | |
| 353 for my $cName (keys %{$codeGear{$codeGearName}->{"code"}}) { | |
| 354 if ($varName eq $cName) { | |
| 355 # continuation field | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
356 $dataGearName{$codeGearName} .= "\tenum Code $varName = ${context_name}\->next;\n"; |
| 44 | 357 return 1; |
| 358 } | |
| 359 } | |
| 360 | |
| 361 # par goto continuation | |
| 362 # global or local variable case | |
| 363 if ($typeName eq "Code") { | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
364 $dataGearName{$codeGearName} .= "\tenum $typeName$ptrType $varName = Gearef(${context_name}, $interface)->$varName;\n"; |
| 44 | 365 return 1; |
| 366 } | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
367 $dataGearName{$codeGearName} .= "\t$typeName$ptrType $varName = Gearef($context_name, $typeName);\n"; |
| 44 | 368 return 1; |
| 369 } | |
| 370 } | |
| 371 | |
| 372 sub generateDataGear { | |
| 373 my ($filename) = @_; | |
| 374 open my $in,"<",$filename or die("can't open $filename $!"); | |
| 375 | |
| 376 my $fn; | |
| 377 if ($opt_o) { | |
| 378 $fn = $opt_o; | |
| 379 } else { | |
| 380 my $fn1 = $filename; | |
| 381 $fn1 =~ s/\.cbc/.c/; | |
| 382 my $i = 1; | |
| 383 $fn = "$dir/$fn1"; | |
| 384 while ( -f $fn) { | |
| 385 $fn = "$dir/$fn1.$i"; | |
| 386 $i++; | |
| 387 } | |
| 388 } | |
| 389 if ( $fn =~ m=(.*)/[^/]+$= ) { | |
| 390 if (! -d $1) { | |
| 391 make_path $1; | |
| 392 } | |
| 393 } | |
| 394 open my $fd,">",$fn or die("can't write $fn $!"); | |
| 395 | |
| 396 my $prevCodeGearName; | |
| 397 my $inTypedef = 0; | |
| 398 my $inStub = 0; | |
| 45 | 399 my $hasParGoto = 0; |
| 44 | 400 my $inMain = 0 ; |
| 52 | 401 my $inCode = 0 ; |
| 44 | 402 my %stub; |
| 403 my $codeGearName; | |
| 404 my %localVarType; | |
| 405 | |
| 406 while (<$in>) { | |
| 407 if (! $inTypedef && ! $inStub && ! $inMain) { | |
|
359
87a28b02c88f
bump generate_stub.pl
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
357
diff
changeset
|
408 if (/^typedef struct (\w+)\s*\{/) { |
| 44 | 409 $inTypedef = 1; |
| 410 } elsif (/^int main\((.*)\) \{/) { | |
| 411 $inMain = 1; | |
| 412 } elsif(/^#interface "(.*)"/) { | |
| 413 my $interfaceHeader = $1; | |
| 414 # #interface not write | |
| 415 next unless ($interfaceHeader =~ /context.h/); | |
| 416 } elsif (/^\_\_code (\w+)\((.*)\)(.*)/) { | |
| 52 | 417 $inCode = 1; |
| 44 | 418 %localVarType = {}; |
| 419 $codeGearName = $1; | |
| 420 my $args = $2; | |
| 421 my $tail = $3; | |
| 422 if ($codeGearName =~ /_stub$/) { | |
| 423 # don't touch already existing stub | |
| 424 $inStub = 1; | |
| 425 $stub{$codeGearName} = 1; | |
| 426 print $fd $_; | |
| 427 next; | |
| 428 } | |
| 429 if (defined $prevCodeGearName) { | |
| 430 # stub is generated just before next CodeGear | |
| 431 if (defined $stub{$prevCodeGearName."_stub"}) { | |
| 432 undef $prevCodeGearName; | |
| 433 } else { | |
| 434 &generateStub($fd,$prevCodeGearName,$dataGearName{$prevCodeGearName}); | |
| 435 $stub{$prevCodeGearName."_stub"} = 1; | |
| 436 } | |
| 437 } | |
| 438 # analyzing CodeGear argument | |
| 439 # these arguments are extract from current context's arugment DataGear Interface | |
| 440 # and passed to the CodeGear | |
| 441 # struct Implementaion needs special handling | |
| 442 # __code next(...) ---> enum Code next | |
| 443 $prevCodeGearName = $codeGearName; | |
| 444 $dataGearVar{$codeGearName} = []; | |
| 445 $outputVar{$codeGearName} = ""; | |
| 446 $outputArgs{$codeGearName} = {}; | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
447 my $newArgs = "struct Context *${context_name},"; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
448 if ($args=~/^struct Context\s*\*\s*${context_name}/) { |
| 44 | 449 $newArgs = ""; |
| 450 } | |
| 451 if (!$args){ | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
452 $newArgs = "struct Context *${context_name}"; |
| 44 | 453 } |
| 454 while($args) { | |
| 455 if ($args =~ s/(^\s*,\s*)//) { | |
| 456 $newArgs .= $1; | |
| 457 } | |
| 458 # continuation case | |
| 459 if ($args =~ s/^(\s)*\_\_code\s+(\w+)\(([^)]*)\)//) { | |
| 460 my $next = $2; | |
| 461 my @args = split(/,/,$3); | |
| 462 if (&generateStubArgs($codeGearName, $next, "Code", "", $next, $interface,0) ) { | |
| 463 $newArgs .= "enum Code $next"; | |
| 464 } | |
| 465 # analyze continuation arguments | |
| 466 # output arguments are defined in the Interface take the pointer of these | |
| 467 # output arguments are put into the Interface DataGear just before the goto | |
| 468 for my $arg (@args) { | |
| 469 $arg =~ s/^\s*//; | |
| 470 last if ($arg =~ /\.\.\./); | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
471 $arg =~ s/^(struct|union|const|enum)?\s*(\w+)(\**)\s(\w+)//; |
| 44 | 472 my $structType = $1; |
| 473 my $typeName = $2; | |
| 474 my $ptrType = $3; | |
| 475 my $varName = $4; | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
476 if ($structType =~ /(const|enum)/) { |
| 298 | 477 $typeName = "$structType $typeName"; |
| 478 } | |
| 44 | 479 my $typeField = lcfirst($typeName); |
| 480 push(@{$outputArgs{$codeGearName}->{$next}}, $varName); | |
| 481 if (&generateStubArgs($codeGearName, $varName, $typeName, $ptrType, $typeField, $interface,1)) { | |
| 482 $newArgs .= ",$structType $typeName **O_$varName"; | |
| 483 } | |
| 484 } | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
485 } elsif ($args =~ s/^(struct|union|const|enum)?\s*(\w+)(\**)\s(\w+)//) { |
| 44 | 486 my $structType = $1; |
| 487 my $typeName = $2; | |
| 488 my $ptrType = $3; | |
| 489 my $varName = $4; | |
| 298 | 490 $newArgs .= $&; # assuming no duplicate |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
491 if ($structType =~ /(const|enum)/) { |
| 298 | 492 $typeName = "$structType $typeName"; |
| 493 } | |
| 44 | 494 my $typeField = lcfirst($typeName); |
| 495 &generateStubArgs($codeGearName, $varName, $typeName, $ptrType, $typeField, $interface,0); | |
| 496 } elsif ($args =~ s/(.*,)//) { | |
| 497 $newArgs .= $1; | |
| 498 } else { | |
| 499 $newArgs .= $args; | |
| 500 last; | |
| 501 } | |
| 502 } | |
| 503 # generate goto statement from stub to the CodeGear in the buffer | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
504 $dataGearName{$codeGearName} .= "\tgoto $codeGearName(${context_name}"; |
| 44 | 505 for my $arg ( @{$dataGearVar{$codeGearName}}) { |
| 506 $dataGearName{$codeGearName} .= ", $arg"; | |
| 507 } | |
| 508 $dataGearName{$codeGearName} .= ");"; | |
| 509 # generate CodeGear header with new arguments | |
| 510 print $fd "__code $codeGearName($newArgs)$tail\n"; | |
| 511 if ($outputVar{$codeGearName} ne "") { | |
| 512 # output data var can be use before write | |
| 513 # it should be initialze by gearef | |
| 514 print $fd $outputVar{$codeGearName}; | |
| 515 } | |
| 516 next; | |
| 52 | 517 } elsif (! $inCode) { |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
518 s/new\s+(\w+)\(\)/\&ALLOCATE(${context_name}, \1)->\1/g; # replacing new |
| 52 | 519 print $fd $_; |
| 520 next; | |
| 44 | 521 } elsif (/^(.*)goto (\w+)\-\>(\w+)\((.*)\);/) { |
| 522 # handling goto statement | |
| 523 # convert it to the meta call form with two arugments, that is context and enum Code | |
| 524 my $prev = $1; | |
| 525 my $next = $2; | |
| 526 my $method = $3; | |
| 527 my $tmpArgs = $4; | |
| 82 | 528 #$tmpArgs =~ s/\(.*\)/\(\)/; |
| 44 | 529 my @args = split(/,/,$tmpArgs); |
| 52 | 530 if (! defined $dataGearVarType{$codeGearName}) { |
| 531 print $fd $_ ; | |
| 532 next ; | |
| 533 } | |
| 44 | 534 my @types = @{$dataGearVarType{$codeGearName}}; |
| 535 my $ntype; | |
| 536 my $ftype; | |
| 537 for my $v (@{$dataGearVar{$codeGearName}}) { | |
| 538 my $t = shift @types; | |
| 539 if ($v eq $next || $v eq "O_$next") { | |
| 540 $ntype = $t; | |
| 541 $ftype = lcfirst($ntype); | |
| 542 } | |
| 543 } | |
| 544 if (!defined $ntype) { | |
| 545 $ntype = $localVarType{$next}; | |
| 546 $ftype = lcfirst($ntype); | |
| 547 } | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
548 print $fd "\tGearef(${context_name}, $ntype)->$ftype = (union Data*) $next;\n"; |
| 44 | 549 # Put interface argument |
| 550 my $prot = $code{$ntype}->{$method}; | |
| 551 my $i = 1; | |
| 552 for my $arg (@args) { | |
| 553 my $pType; | |
| 554 my $pName; | |
| 555 my $p = @$prot[$i]; | |
| 556 next if ($p eq $arg); | |
| 557 $p =~ s/^(.*)\s(\w+)//; | |
| 558 $pType = $1; | |
| 559 $pName = $2; | |
| 560 $arg =~ s/^(\s)*(\w+)/$2/; | |
| 561 if ($pType =~ s/\_\_code$//) { | |
| 562 if ($arg =~ /(\w+)\(.*\)/) { | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
563 print $fd "\tGearef(${context_name}, $ntype)->$pName = $1;\n"; |
| 44 | 564 } else { |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
565 print $fd "\tGearef(${context_name}, $ntype)->$pName = C_$arg;\n"; |
| 44 | 566 } |
| 567 } elsif ($pType =~ /Data\**$/){ | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
568 print $fd "\tGearef(${context_name}, $ntype)->$pName = (union $pType) $arg;\n"; |
| 44 | 569 } else { |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
570 print $fd "\tGearef(${context_name}, $ntype)->$pName = $arg;\n"; |
| 44 | 571 } |
| 572 $i++; | |
| 573 } | |
| 362 | 574 print $fd "${prev}${context_name}->before = C_$codeGearName;\n"; |
| 361 | 575 print $fd "${prev}goto meta(${context_name}, $next->$method);\n"; |
| 44 | 576 next; |
| 577 } elsif(/^(.*)par goto (\w+)\((.*)\);/) { | |
| 578 # handling par goto statement | |
| 579 # convert it to the parallel | |
| 580 my $prev = $1; | |
| 581 my $codeGearName = $2; | |
| 582 my $args = $3; | |
| 583 my $inputCount = $codeGear{$codeGearName}->{'input'}; | |
| 584 my $outputCount = $codeGear{$codeGearName}->{'output'}; | |
| 585 my @iterateCounts; | |
| 586 # parse examples 'par goto(.., iterate(10), exit);' | |
| 587 if ($args =~ /iterate\((.*)?\),/) { | |
| 588 @iterateCounts = split(/,/,$1);; | |
| 589 $inputCount--; | |
| 590 } | |
| 591 # replace iterate keyword | |
| 592 $args =~ s/iterate\((.*)?\),//; | |
| 593 my @dataGears = split(/,\s*/, $args); | |
| 594 my $nextCodeGear = pop(@dataGears); | |
| 45 | 595 if (! $hasParGoto) { |
| 596 $hasParGoto = 1; | |
| 44 | 597 print $fd "${prev}struct Element* element;\n"; |
| 598 } | |
| 599 my $initTask = << "EOFEOF"; | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
600 ${prev}${context_name}\->task = NEW(struct Context); |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
601 ${prev}initContext(${context_name}\->task); |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
602 ${prev}${context_name}\->task->next = C_$codeGearName; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
603 ${prev}${context_name}\->task->idgCount = $inputCount; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
604 ${prev}${context_name}\->task->idg = ${context_name}\->task->dataNum; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
605 ${prev}${context_name}\->task->maxIdg = ${context_name}\->task->idg + $inputCount; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
606 ${prev}${context_name}\->task->odg = ${context_name}\->task->maxIdg; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
607 ${prev}${context_name}\->task->maxOdg = ${context_name}\->task->odg + $outputCount; |
| 44 | 608 EOFEOF |
| 609 print $fd $initTask; | |
| 610 if (@iterateCounts) { | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
611 print $fd "${prev}${context_name}\->task->iterate = 0;\n"; |
| 44 | 612 my $len = @iterateCounts; |
| 613 if ($len == 1) { | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
614 print $fd "${prev}${context_name}\->task->iterator = createMultiDimIterator(${context_name}, $iterateCounts[0], 1, 1);\n"; |
| 44 | 615 } elsif ($len == 2) { |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
616 print $fd "${prev}${context_name}\->task->iterator = createMultiDimIterator(${context_name}, $iterateCounts[0], $iterateCounts[1], 1);\n"; |
| 44 | 617 } elsif ($len == 3) { |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
618 print $fd "${prev}${context_name}\->task->iterator = createMultiDimIterator(${context_name}, $iterateCounts[0], $iterateCounts[1], $iterateCounts[2]);\n"; |
| 44 | 619 } |
| 620 } | |
| 621 for my $dataGear (@dataGears) { | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
622 print $fd "${prev}GET_META($dataGear)->wait = createSynchronizedQueue(${context_name});\n"; |
| 44 | 623 } |
| 624 for my $i (0..$inputCount-1) { | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
625 print $fd "${prev}${context_name}\->task->data[${context_name}\->task->idg+$i] = (union Data*)@dataGears[$i];\n"; |
| 44 | 626 } |
| 627 for my $i (0..$outputCount-1) { | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
628 print $fd "${prev}${context_name}\->task->data[${context_name}\->task->odg+$i] = (union Data*)@dataGears[$inputCount+$i];\n"; |
| 44 | 629 } |
| 630 my $putTask = << "EOFEOF"; | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
631 ${prev}element = &ALLOCATE(${context_name}, Element)->Element; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
632 ${prev}element->data = (union Data*)${context_name}\->task; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
633 ${prev}element->next = ${context_name}\->taskList; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
634 ${prev}${context_name}\->taskList = element; |
| 44 | 635 EOFEOF |
| 636 print $fd $putTask; | |
| 637 next; | |
| 638 } elsif (/^(.*)goto (\w+)\((.*)\);/) { | |
| 639 # handling goto statement | |
| 640 # convert it to the meta call form with two arugments, that is context and enum Code | |
| 641 my $prev = $1; | |
| 642 my $next = $2; | |
| 643 my @args = split(/,/, $3); | |
| 644 my $v = 0; | |
| 390 | 645 my $arg_context = $context_name; |
| 646 if ($prev =~ /kernel/) { | |
| 647 $prev = ""; | |
| 648 $arg_context = "kernel_context"; | |
| 649 } | |
| 650 | |
| 388 | 651 if (exists $filename2localCodes{$filename}->{$next}) { |
| 52 | 652 print $fd $_; next; |
| 653 } | |
| 44 | 654 for my $n ( @{$dataGearVar{$codeGearName}} ) { |
| 655 # continuation arguments | |
| 656 $v = 1 if ( $n eq $next); | |
| 657 } | |
| 658 if ($v || defined $code{$interface}->{$next}) { | |
| 659 # write continuation's arguments into the interface arguments | |
| 660 # we may need a commit for a shared DataGear | |
| 661 for my $arg ( @{$outputArgs{$codeGearName}->{$next}} ) { | |
| 662 my $v = shift(@args); | |
| 663 print $fd "\t*O_$arg = $v;\n"; | |
| 664 } | |
| 45 | 665 if ($hasParGoto) { |
| 390 | 666 print $fd "${prev}Gearef(${arg_context}, TaskManager)->taskList = ${arg_context}->taskList;\n"; |
| 667 print $fd "${prev}Gearef(${arg_context}, TaskManager)->next1 = C_$next;\n"; | |
| 668 print $fd "${prev}goto meta(${arg_context}, C_$next);\n"; | |
| 44 | 669 } else { |
| 390 | 670 print $fd "${prev}${arg_context}->before = C_$codeGearName;\n"; |
| 671 print $fd "${prev}goto meta(${arg_context}, $next);\n"; | |
| 44 | 672 } |
| 673 next; | |
| 674 } | |
| 45 | 675 if ($hasParGoto) { |
| 390 | 676 print $fd "${prev}Gearef(${arg_context}, TaskManager)->taskList = ${arg_context}\->taskList;\n"; |
| 677 print $fd "${prev}Gearef(${arg_context}, TaskManager)->next1 = C_$next;\n"; | |
| 678 print $fd "${prev}goto parGotoMeta(${arg_context}, C_$next);\n"; | |
| 44 | 679 next; |
| 680 } elsif ($next eq "meta") { | |
| 681 print $fd $_; | |
| 682 next; | |
| 683 } else { | |
| 390 | 684 print $fd "${prev}${arg_context}\->before = C_$codeGearName;\n"; |
| 685 print $fd "${prev}goto meta(${arg_context}, C_$next);\n"; | |
| 44 | 686 next; |
| 687 } | |
| 688 } elsif(/^.*(struct|union)?\s(\w+)\*\s(\w+)\s?[=;]/) { | |
| 689 my $type = $2; | |
| 690 my $varName = $3; | |
| 691 $localVarType{$varName} = $type; | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
692 s/new\s+(\w+)\(\)/\&ALLOCATE(${context_name}, \1)->\1/g; # replacing new |
| 44 | 693 } elsif(/^}/) { |
| 45 | 694 $hasParGoto = 0; |
| 44 | 695 } else { |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
696 s/new\s+(\w+)\(\)/\&ALLOCATE(${context_name}, \1)->\1/g; # replacing new |
| 44 | 697 } |
| 698 # gather type name and type | |
| 699 } elsif ($inMain) { | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
700 if (/^(.*)goto start_code\(main_${context_name}\);/) { |
| 44 | 701 print $fd $_; |
| 702 next; | |
| 703 } elsif (/^(.*)goto (\w+)\((.*)\);/) { | |
| 704 my $prev = $1; | |
| 705 my $next = $2; | |
|
354
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
706 print $fd "${prev}struct Context* main_${context_name} = NEW(struct Context);\n"; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
707 print $fd "${prev}initContext(main_${context_name});\n"; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
708 print $fd "${prev}main_${context_name}->next = C_$next;\n"; |
|
fde5f96c6ff1
use common perl script
anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
parents:
323
diff
changeset
|
709 print $fd "${prev}goto start_code(main_${context_name});\n"; |
| 44 | 710 next; |
| 711 } | |
| 712 } | |
| 713 if (/^}/) { | |
| 714 $inStub = 0; | |
| 715 $inTypedef = 0; | |
| 716 $inMain = 0; | |
| 52 | 717 $inCode = 0; |
| 44 | 718 } |
| 719 print $fd $_; | |
| 720 } | |
| 721 if (defined $prevCodeGearName) { | |
| 722 if (!defined $stub{$prevCodeGearName."_stub"}) { | |
| 723 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName}); | |
| 724 } | |
| 725 } | |
| 726 } | |
| 727 | |
| 386 | 728 |
| 729 # create localCode from each cbc files | |
| 730 sub setFilename2CodeGear { | |
| 731 my ($filename) = @_; | |
| 732 open my $fh, '<', $filename; | |
| 733 while (my $line = <$fh>) { | |
| 734 if ($line =~ /extern\s+_\_code\s+(\w+)\((.*)\)/) { | |
| 388 | 735 $filename2localCodes{$filename}->{$1} = 1; |
| 387 | 736 } elsif ($line =~ /^\s*_\_code\s+(\w+)\((.*)\)(.*)/) { |
| 388 | 737 $filename2localCodes{$filename}->{$1} = 1; |
| 387 | 738 } elsif ($line =~ /^\s*_\_code *\(\s*\*\s*(\w+)\)\((.*)\)(.*)/) { |
| 388 | 739 $filename2localCodes{$filename}->{$1} = 1; |
| 386 | 740 } elsif ($line =~ /^\_\_code (\w+)\((.*)\)(.*)/) { |
| 388 | 741 $filename2localCodes{$filename}->{$1} = 1; |
| 386 | 742 } |
| 743 } | |
| 744 close $fh; | |
| 745 } | |
| 746 | |
| 44 | 747 # end |