comparison src/gearsTools/generate_stub.pl @ 323:6d96bba13d5d

merged
author anatofuz <anatofuz@cr.ie.u-ryukyu.ac.jp>
date Fri, 07 Feb 2020 14:58:30 +0900
parents edc8e6c71dc6 42a37a8a02c9
children fde5f96c6ff1
comparison
equal deleted inserted replaced
322:7d77c5005cb6 323:6d96bba13d5d
73 # Gearef(cbc_context, Stack)->next = C_stackTest3; 73 # Gearef(cbc_context, Stack)->next = C_stackTest3;
74 # goto meta(cbc_context, nodeStack->push); 74 # goto meta(cbc_context, nodeStack->push);
75 75
76 sub getDataGear { 76 sub getDataGear {
77 my ($filename) = @_; 77 my ($filename) = @_;
78 my ($codeGearName, $name, $inTypedef); 78 my ($codeGearName, $name, $inTypedef,$described_data_gear);
79 open my $fd,"<",$filename or die("can't open $filename $!"); 79 open my $fd,"<",$filename or die("can't open $filename $!");
80 while (<$fd>) { 80 while (<$fd>) {
81 if (! $inTypedef) { 81 if (! $inTypedef) {
82 if (/^typedef struct (\w+)\s*<(.*)>/) { 82 if (/^typedef struct (\w+)\s*<(.*)>/) {
83 $inTypedef = 1; 83 $inTypedef = 1;
108 $codeGearName = "$1/$codeGearName"; 108 $codeGearName = "$1/$codeGearName";
109 } 109 }
110 if ( -f "$codeGearName.cbc") { 110 if ( -f "$codeGearName.cbc") {
111 &getCodeGear("$codeGearName.cbc"); 111 &getCodeGear("$codeGearName.cbc");
112 } 112 }
113 } elsif(/^#interface "(.*)"/) { 113 } elsif(/^#interface "(.*)"/) {
114 # use interface 114 # use interface
115 my $interfaceHeader = $1; 115 my $interfaceHeader = $1;
116 next if ($interfaceHeader =~ /context.h/); 116 next if ($interfaceHeader =~ /context.h/);
117 if (-f $interfaceHeader) { 117 if (-f $interfaceHeader) {
118 &getDataGear("$interfaceHeader"); 118 &getDataGear("$interfaceHeader");
139 $ttype = $2; 139 $ttype = $2;
140 } else { 140 } else {
141 $ttype = "const $2"; 141 $ttype = "const $2";
142 } 142 }
143 } 143 }
144 $described_data_gear = 1;
144 $var{$name}->{$tname} = $ttype; 145 $var{$name}->{$tname} = $ttype;
146 }
147 if (/__code (\w+)/) {
148 next if $described_data_gear;
149 my $args = $';
150 while ($args =~ /\s*(struct|union|const)?\s*([\w\[\]_]+)\*?\s*(\w+),?/g) {
151 #$args eq (Impl* vm, pde_t* pgdir, char* init, uint sz, __code next(...));
152 my $const_type = $1;
153 my $ttype = $2;
154 my $tname = $3;
155
156 $ttype =~ s/(Impl|Isa|Type)/Data/;
157 if ($const_type eq 'const') {
158 $ttype = "const $ttype";
159 }
160 $var{$name}->{$tname} = $ttype;
161 }
145 } 162 }
146 if (/^}/) { 163 if (/^}/) {
147 $inTypedef = 0; 164 $inTypedef = 0;
148 } 165 }
149 } 166 }