Mercurial > hg > Gears > GearsAgda

comparison src/parallel_execution/generate_stub.pl @ 252:682b1195e604

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fix stub
author mir3636
date Thu, 26 Jan 2017 17:38:33 +0900
parents 0ab52d6e2fd9
children ebc13549394c
comparison
equal deleted inserted replaced
251:0ab52d6e2fd9 252:682b1195e604
11 # enum Code taskRecive; 11 # enum Code taskRecive;
12 # enum Code shutdown; 12 # enum Code shutdown;
13 # struct Queue* tasks; 13 # struct Queue* tasks;
14 # } Worker; 14 # } Worker;
15 15
16 while (<*.cbc>) { 16 #while (<*.cbc>) {
17 while (<SingleLinkedStack.cbc>) {
17 my $fn = $_; 18 my $fn = $_;
18 &getDataGear($fn); 19 &getDataGear($fn);
19 &generateDataGear($fn); 20 &generateDataGear($fn);
20 } 21 }
21 22
46 &getDataGear("$interface.cbc"); 47 &getDataGear("$interface.cbc");
47 } 48 }
48 } elsif (/^\_\_code (\w+)/) { 49 } elsif (/^\_\_code (\w+)/) {
49 $codeGearName = $1; 50 $codeGearName = $1;
50 $dataGearVar{$codeGearName} = []; 51 $dataGearVar{$codeGearName} = [];
51 args:while (/(struct|union) (\w+)\*\s(\w+)/g) { 52 args:while (/(struct|union) (\w+)(\*)+\s(\w+)/g) {
52 my $structType = $1; 53 my $structType = $1;
53 my $typeName = $2; 54 my $typeName = $2;
54 my $varName = $3; 55 my $varName = $4;
55 my $typeField = lcfirst($typeName); 56 my $typeField = lcfirst($typeName);
56 push @{$dataGearVar{$codeGearName}},$varName; 57 push @{$dataGearVar{$codeGearName}},$varName;
57 if ($typeField ne $varName) { 58 if ($typeField ne $varName) {
58 $dataGearName{$codeGearName} .= "\t$typeName* $varName = (" . $typeName . "*)GearImpl(context, " . $varName . ", " . $varName . ");\n"; 59 $dataGearName{$codeGearName} .= "\t$typeName* $varName = ($typeName*)GearImpl(context, $varName, $varName);\n";
60 print STDOUT "$codeGearName \t$typeName* $varName = ($typeName*)GearImpl(context, $varName, $varName);\n";
59 } else { 61 } else {
60 for my $ivar ( $var{$interface}) { 62 for my $ivar ($var{$interface}) {
61 if ($varName eq $ivar) { 63 if ($varName eq $ivar) {
62 $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $interface)->$varName;\n"; 64 $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $interface)->$varName;\n";
65 print STDOUT "$codeGearName \t$typeName* $varName = Gearef(context, $interface)->$varName;\n";
63 next args; 66 next args;
64 } 67 }
65 } 68 }
66 $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, " . $typeName . ")->$typeField;\n"; 69 $dataGearName{$codeGearName} .= "\t$typeName* $varName = Gearef(context, $typeName)->$typeField;\n";
70 print STDOUT "$codeGearName \t$typeName* $varName = Gearef(context, $typeName)->$typeField;\n";
67 } 71 }
68 } 72 }
69 $dataGearName{$codeGearName} .= "\tgoto $codeGearName(context"; 73 $dataGearName{$codeGearName} .= "\tgoto $codeGearName(context";
70 for my $arg ( @{$dataGearVar{$codeGearName}}) { 74 for my $arg ( @{$dataGearVar{$codeGearName}}) {
71 $dataGearName{$codeGearName} .= ", $arg"; 75 $dataGearName{$codeGearName} .= ", $arg";
128 if ($codeGearName =~ /_stub$/) { 132 if ($codeGearName =~ /_stub$/) {
129 $stub{$codeGearName} = 1; 133 $stub{$codeGearName} = 1;
130 print $fd $_; 134 print $fd $_;
131 next; 135 next;
132 } 136 }
137 $prevCodeGearName = $codeGearName;
133 if (defined $prevCodeGearName) { 138 if (defined $prevCodeGearName) {
134 if (defined $stub{$prevCodeGearName."_stub"}) { 139 if (defined $stub{$prevCodeGearName."_stub"}) {
135 undef $prevCodeGearName; 140 undef $prevCodeGearName;
136 print $fd $_; 141 print $fd $_;
137 next; 142 next;
138 } 143 }
139 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName}); 144 $stub{$prevCodeGearName."_stub"} = &generateStub($fd,$prevCodeGearName,$dataGearName{$codeGearName});
140 } 145 }
141 $prevCodeGearName = $codeGearName; 146 #$prevCodeGearName = $codeGearName;
142 } elsif (/^(.*)goto next\(\.\.\.(.*)\);/) { 147 } elsif (/^(.*)goto next\(\.\.\.(.*)\);/) {
143 my $prev = $1; 148 my $prev = $1;
144 my $args = $2; 149 my $args = $2;
145 print $fd "${prev}goto meta(context, next);\n"; 150 print $fd "${prev}goto meta(context, next);\n";
146 next; 151 next;