Commit | Line | Data |
---|---|---|
86530b38 AT |
1 | # -*- perl -*- |
2 | ||
3 | package Midas::PostProcessing; | |
4 | use strict; | |
5 | use warnings; | |
6 | ||
7 | use IO::File; | |
8 | use IO::Pipe; | |
9 | use File::Basename; | |
10 | ||
11 | use Midas::Command; | |
12 | use Midas::Configure; | |
13 | use Midas::State; | |
14 | use Midas::Paths; | |
15 | use Midas::Section; | |
16 | use Midas::Globals; | |
17 | # Cant' use Assembly ':internals' because of include circularity | |
18 | use Midas::Preprocess ':internals'; | |
19 | use Midas::Application; | |
20 | use Midas::Error; | |
21 | use Midas::Segment; | |
22 | ||
23 | require Exporter; | |
24 | ||
25 | our @ISA = qw(Exporter); | |
26 | our @EXPORT = qw(); | |
27 | our @EXPORT_OK = qw(); | |
28 | ||
29 | our @common_exports = qw( | |
30 | generate_events | |
31 | ); | |
32 | our @asm_exports = qw(generate_image | |
33 | postprocess_assembly | |
34 | ); | |
35 | our @external_exports = qw(postprocess_assembly); | |
36 | our %EXPORT_TAGS = ( | |
37 | common => [ @common_exports ], | |
38 | asm => [ @asm_exports, @common_exports ], | |
39 | external => [ @external_exports ], | |
40 | all => [ @asm_exports, @common_exports ], | |
41 | ); | |
42 | ||
43 | Exporter::export_ok_tags('common', 'asm', 'external', 'all'); | |
44 | ||
45 | ||
46 | ############################################################################## | |
47 | ||
48 | sub postprocess_assembly { | |
49 | my $image = shift; | |
50 | my $symtab = shift; | |
51 | my $sfile = shift; | |
52 | my $events = shift; | |
53 | ||
54 | banner "POSTPROCESSING PHASE"; | |
55 | ||
56 | generate_image($image); | |
57 | generate_events($sfile, $events); | |
58 | } | |
59 | ||
60 | ############################################################################## | |
61 | ||
62 | sub generate_image { | |
63 | my $image = shift; | |
64 | ||
65 | my $pushd = Midas::Paths->pushd($STATE->get_build_dir); | |
66 | ||
67 | ||
68 | $image = path_to_build_file($CONFIG{local_image}, $STATE) | |
69 | unless defined $image; | |
70 | ||
71 | my $symtab = path_to_build_file($CONFIG{local_symtab}, $STATE); | |
72 | ||
73 | my $goldfinger = path_to_build_file($CONFIG{local_goldfinger}, $STATE); | |
74 | ||
75 | chat "Generating $goldfinger...\n"; | |
76 | ||
77 | my $fh = IO::File->new(">$goldfinger") or | |
78 | fatal "Can't open $goldfinger: $!\n", M_FILE; | |
79 | ||
80 | ||
81 | print $fh "PA_SIZE = $PASIZE;\n"; | |
82 | print $fh "\n"; | |
83 | ||
84 | foreach my $app (keys %{$STATE->{apps}}) { | |
85 | my $appobj = $STATE->{apps}{$app}; | |
86 | $appobj->write_to_goldfinger($fh); | |
87 | } | |
88 | ||
89 | ||
90 | foreach my $tsbname (keys %{$STATE->{tsbs}}) { | |
91 | my $tsb = $STATE->{tsbs}{$tsbname}; | |
92 | $tsb->write_to_goldfinger_file($fh) if $tsb->is_touched(); | |
93 | } | |
94 | ||
95 | foreach my $tsblinkname (keys %{$STATE->{tsblinks}}) { | |
96 | my $tsblink = $STATE->{tsblinks}{$tsblinkname}; | |
97 | $tsblink->write_to_goldfinger_file($fh) if $tsblink->is_touched(); | |
98 | } | |
99 | ||
100 | undef $fh; | |
101 | ||
102 | my $Prg = basename $0; | |
103 | ||
104 | my $error_opt = $Midas::Error::Print_Errors ? '' : '-noprint_errors '; | |
105 | ||
106 | my $verbose = ($CONFIG{verbose} == 0) ? '-silent ' : | |
107 | ($CONFIG{verbose} == 2) ? '-v ' : ''; | |
108 | my $compress_opt = $CONFIG{compress_image} ? '' : '-nocompress '; | |
109 | my $allow_tsb_conflicts_opt = $CONFIG{allow_tsb_conflicts} ? | |
110 | '-allow_tsb_conflicts ' : ''; | |
111 | my $allow_duplicate_tags_opt = $CONFIG{allow_duplicate_tags} ? | |
112 | '-allow_duplicate_tags ' : ''; | |
113 | my $zero_env_opt = $CONFIG{env_zero} ? '' : '-noenvzero '; | |
114 | ||
115 | my $opts = "${error_opt}${compress_opt}${allow_tsb_conflicts_opt}". | |
116 | "${allow_duplicate_tags_opt}${zero_env_opt}"; | |
117 | ||
118 | my $command = | |
119 | "$CONFIG{goldfinger_cmd} ${verbose}-in $goldfinger ". | |
120 | "-gentsbs -genimage -imagefile $image -gensymtab -symtabfile $symtab ". | |
121 | "${opts}-prefix '${Midas::Error::Prg}: '"; | |
122 | ||
123 | run_command($command, '-pass_errcode'); | |
124 | ||
125 | if (-e $symtab) { | |
126 | chat "$symtab successfully created.\n"; | |
127 | } else { | |
128 | fatal "$symtab could not be generated.\n", M_GENFAIL; | |
129 | } | |
130 | ||
131 | if (-e $image) { | |
132 | chat "$image successfully created.\n"; | |
133 | } else { | |
134 | fatal "$image could not be generated.\n", M_GENFAIL; | |
135 | } | |
136 | ||
137 | ||
138 | } | |
139 | ||
140 | ############################################################################## | |
141 | ||
142 | sub generate_events { | |
143 | my $m4file = shift; | |
144 | my $symtab = shift; | |
145 | my $events = shift; | |
146 | ||
147 | my $pushd = Midas::Paths->pushd($STATE->get_build_dir); | |
148 | ||
149 | $m4file = path_to_build_file($CONFIG{local_m4}, $STATE) | |
150 | unless defined $m4file; | |
151 | $symtab = path_to_build_file($CONFIG{local_symtab}, $STATE) | |
152 | unless defined $symtab; | |
153 | $events = path_to_build_file($CONFIG{local_events}, $STATE) | |
154 | unless defined $events; | |
155 | ||
156 | chat "Generating $events...\n"; | |
157 | ||
158 | chat "Loading symbol table from $symtab.\n", 3; | |
159 | local ($_); | |
160 | my (%vahash, %rahash, %pahash); | |
161 | my $ifh = IO::File->new("<$symtab") or fatal "Can't open $symtab: $!\n", | |
162 | M_FILE; | |
163 | while(<$ifh>) { | |
164 | my ($sym, $va, $ra, $pa) = /([\w_\.]+)\s+(\w+)\s+(\w+)(?:\s+(\w+))/; | |
165 | next unless defined $va && defined $ra; | |
166 | if(not defined $pa) { | |
167 | $pa = $ra; | |
168 | undef $ra; | |
169 | } | |
170 | $vahash{$sym} = $va; | |
171 | $rahash{$sym} = $ra if defined $ra; | |
172 | $pahash{$sym} = $pa; | |
173 | } | |
174 | undef $ifh; | |
175 | ||
176 | my $ofh = IO::Pipe->new(); | |
177 | my $m4_incs = join ' ', map { "--include=$_"} get_m4_includes(); | |
178 | my $command = "$CONFIG{m4_cmd} $m4_incs > $events"; | |
179 | $ofh->writer("$command") or | |
180 | fatal "Cannot run m4 to create $events: $!\n", M_GENFAIL; | |
181 | ||
182 | $ofh->print("changequote({, })dnl\n"); | |
183 | ||
184 | my $full_line = ""; | |
185 | my $ev_null = 1; | |
186 | my $ev_collect = 0; | |
187 | my $ev_eval = 0; | |
188 | ||
189 | $ifh = IO::File->new("<$m4file") or | |
190 | fatal "Can't open file $m4file for reading: $!\n", M_FILE; | |
191 | ||
192 | ||
193 | CPPFL_LINE: | |
194 | while (<$ifh>) { | |
195 | my ($evline) = /.*!\s*\$EV\s+(.*)$/; | |
196 | my ($evlinep) = /.*!\s*\$EV\+\s+(.*)$/; | |
197 | ||
198 | # supress warnings | |
199 | $evline = "" unless defined $evline; | |
200 | $evlinep = "" unless defined $evlinep; | |
201 | ||
202 | if ($ev_null == 1) { | |
203 | if ($evlinep ne "") { | |
204 | fatal "Error in parsing event $_", M_EVENTERR; | |
205 | } | |
206 | if ($evline ne "") { | |
207 | $ev_null = 0; | |
208 | $ev_collect = 1; | |
209 | $full_line .= $evline; | |
210 | next CPPFL_LINE; | |
211 | } | |
212 | } | |
213 | if ($ev_collect == 1) { | |
214 | if ($evlinep ne "") { | |
215 | $full_line .= $evlinep; | |
216 | } | |
217 | elsif ($evline ne "") { | |
218 | $ev_eval = 1; | |
219 | } | |
220 | else { | |
221 | $ev_eval = 1; | |
222 | $ev_null = 1; | |
223 | $ev_collect = 0; | |
224 | } | |
225 | } | |
226 | if ($ev_eval == 1) { | |
227 | $_ = $full_line; | |
228 | my $va; | |
229 | while (/.*\@VA\([\w_\.]*\).*$/) { | |
230 | ($va) = /VA\(([\w_\.]*)\)/; | |
231 | if (not defined $vahash{$va}) | |
232 | {fatal "Error in va address: $_\n", M_EVENTERR;} | |
233 | s/\@VA\([\w_\.]*\)/"0x$vahash{$va}"/e; | |
234 | } | |
235 | while (/.*\@RA\([\w_\.]*\).*$/) { | |
236 | ($va) = /RA\(([\w_\.]*)\)/; | |
237 | if (not defined $rahash{$va}) | |
238 | {fatal "Error in ra address: $_\n", M_EVENTERR;} | |
239 | s/\@RA\([\w_\.]*\)/"0x$rahash{$va}"/e; | |
240 | } | |
241 | while (/.*\@PA\([\w_\.]*\).*$/) { | |
242 | ($va) = /PA\(([\w_\.]*)\)/; | |
243 | if (not defined $pahash{$va}) | |
244 | {fatal "Error in pa address: $_\n", M_EVENTERR;} | |
245 | s/\@PA\([\w_\.]*\)/"0x$pahash{$va}"/e; | |
246 | } | |
247 | while (/.*expr.*$/) { | |
248 | s/expr/"{64'h}mpeval"/e; | |
249 | } | |
250 | $ofh->print("$_\n"); | |
251 | $ev_eval = 0; | |
252 | $full_line = $evline; | |
253 | } | |
254 | } | |
255 | ||
256 | undef $ifh; | |
257 | $ofh->close(); | |
258 | ||
259 | if($?) { | |
260 | my $status = $?; | |
261 | my $exit = $status >> 8; | |
262 | my $sig = $status & 127; | |
263 | my $core = $status & 128; | |
264 | my $core_msg = $core ? "Dumped core." : ""; | |
265 | ||
266 | if($sig) { | |
267 | fatal "Command \"$command\" died via signal $sig. $core_msg\n", | |
268 | M_GENFAIL; | |
269 | } | |
270 | ||
271 | fatal "Command \"$command\" failed with status $exit. $core_msg\n", | |
272 | M_GENFAIL; | |
273 | } | |
274 | ||
275 | undef $ofh; | |
276 | ||
277 | if(-e $events) { | |
278 | chat "$events successfully created.\n"; | |
279 | } else { | |
280 | fatal "$events could not be generated.\n", M_GENFAIL; | |
281 | } | |
282 | } | |
283 | ||
284 | ############################################################################## | |
285 | 1; |