1 %************************************************************************
3 \section[Driver-asm-fiddling]{Fiddling with assembler files (m68k)}
5 %************************************************************************
10 Utterly stomp out C functions' prologues and epilogues; i.e., the
11 stuff to do with the C stack.
13 Any other required tidying up.
18 local($in_asmf, $out_asmf) = @_;
20 # multi-line regexp matching:
25 open(INASM, "< $in_asmf")
26 || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
27 open(OUTASM,"> $out_asmf")
28 || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
30 # read whole file, divide into "chunks":
31 # record some info about what we've found...
33 @chk = (); # contents of the chunk
34 $numchks = 0; # number of them
35 @chkcat = (); # what category of thing in each chunk
36 @chksymb = (); # what symbol(base) is defined in this chunk
37 %slowchk = (); # ditto, its regular "slow" entry code
38 %fastchk = (); # ditto, fast entry code
39 %closurechk = (); # ditto, the (static) closure
40 %infochk = (); # given a symbol base, say what chunk its info tbl is in
41 %vectorchk = (); # ditto, return vector table
42 %directchk = (); # ditto, direct return code
48 next if /^\.stab.*___stg_split_marker/;
49 next if /^\.stab.*ghc.*c_ID/;
50 next if /^#(NO_)?APP/;
52 if ( /^\s+/ ) { # most common case first -- a simple line!
53 # duplicated from the bottom
57 } elsif ( /^LC(\d+):$/ ) {
59 $chkcat[$i] = 'string';
62 } elsif ( /^___stg_split_marker(\d+):$/ ) {
64 $chkcat[$i] = 'splitmarker';
67 } elsif ( /^_([A-Za-z0-9_]+)_info:$/ ) {
70 $chkcat[$i] = 'infotbl';
73 die "Info table already? $symb; $i\n" if defined($infochk{$symb});
77 } elsif ( /^_([A-Za-z0-9_]+)_entry:$/ ) {
84 } elsif ( /^_([A-Za-z0-9_]+)_fast\d+:$/ ) {
91 } elsif ( /^_([A-Za-z0-9_]+)_closure:$/ ) {
93 $chkcat[$i] = 'closure';
98 } elsif ( /^_ghc.*c_ID:/ ) {
100 $chkcat[$i] = 'consist';
102 } elsif ( /^(___gnu_compiled_c|gcc2_compiled\.):/ ) {
105 } elsif ( /^_ErrorIO_call_count:/ # HACK!!!!
106 || /^_[A-Za-z0-9_]+\.\d+:$/
107 || /^_.*_CAT:/ # PROF: _entryname_CAT
108 || /^_CC_.*_struct:/ # PROF: _CC_ccident_struct
109 || /^_.*_done:/ # PROF: _module_done
110 || /^__module_registered:/ # PROF: _module_registered
113 $chkcat[$i] = 'data';
116 } elsif ( /^_(ret_|djn_)/ ) {
118 $chkcat[$i] = 'misc';
121 } elsif ( /^_vtbl_([A-Za-z0-9_]+):$/ ) {
123 $chkcat[$i] = 'vector';
128 } elsif ( /^_([A-Za-z0-9_]+)DirectReturn:$/ ) {
130 $chkcat[$i] = 'direct';
135 } elsif ( /^_[A-Za-z0-9_]+_upd:$/ ) {
137 $chkcat[$i] = 'misc';
140 } elsif ( /^_[A-Za-z0-9_]/ ) {
143 print STDERR "Funny global thing?: $_"
144 unless $KNOWN_FUNNY_THING{$thing}
145 || /^__(PRIn|PRStart).*:/ # pointer reversal GC routines
146 || /^_CC_.*:/ # PROF: _CC_ccident
147 || /^__reg.*:/; # PROF: __reg<module>
149 $chkcat[$i] = 'misc';
152 } else { # simple line (duplicated at the top)
157 $numchks = $#chk + 1;
159 # the division into chunks is imperfect;
160 # we throw some things over the fence into the next
163 # also, there are things we would like to know
164 # about the whole module before we start spitting
167 # NB: we start meddling at chunk 1, not chunk 0
169 for ($i = 1; $i < $numchks; $i++) {
170 $c = $chk[$i]; # convenience copy
172 # print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
174 # toss all prologue stuff;
175 # be slightly paranoid to make sure there's
176 # nothing surprising in there
177 if ( $c =~ /--- BEGIN ---/ ) {
178 if (($p, $r) = split(/--- BEGIN ---/, $c)) {
179 $p =~ s/^\tlink a6,#-?\d.*\n//;
180 $p =~ s/^\tmovel d2,sp\@-\n//;
181 $p =~ s/^\tmovel d5,sp\@-\n//; # SMmark.* only?
182 $p =~ s/^\tmoveml \#0x[0-9a-f]+,sp\@-\n//; # SMmark.* only?
183 die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/;
185 # glue together what's left
190 # toss all epilogue stuff; again, paranoidly
191 if ( $c =~ /--- END ---/ ) {
192 if (($r, $e) = split(/--- END ---/, $c)) {
193 $e =~ s/^\tunlk a6\n//;
195 die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/;
197 # glue together what's left
202 # toss all calls to __DISCARD__
203 $c =~ s/^\tjbsr ___DISCARD__\n//g;
205 # toss stack adjustment after DoSparks
206 $c =~ s/^(\tjbsr _DoSparks\n)\taddqw #8,sp/$1/g;
208 # pin a funny end-thing on (for easier matching):
209 $c .= 'FUNNY#END#THING';
211 # pick some end-things and move them to the next chunk
213 while ( $c =~ /^\s*(\.align\s+\d+\n|\.proc\s+\d+\n|\.const\n|\.cstring\n|\.globl\s+\S+\n|\.text\n|\.data\n|\.even\n|\.stab[^n].*\n)FUNNY#END#THING/ ) {
216 if ( $to_move =~ /\.(globl|proc|stab)/ && $i < ($numchks - 1) ) {
217 $chk[$i + 1] = $to_move . $chk[$i + 1];
218 # otherwise they're tossed
221 $c =~ s/^.*\nFUNNY#END#THING/FUNNY#END#THING/;
224 $c =~ s/FUNNY#END#THING//;
225 $chk[$i] = $c; # update w/ convenience copy
228 # print out all the literal strings first
229 for ($i = 0; $i < $numchks; $i++) {
230 if ( $chkcat[$i] eq 'string' ) {
231 print OUTASM "\.text\n\t\.even\n";
232 print OUTASM $chk[$i];
234 $chkcat[$i] = 'DONE ALREADY';
238 for ($i = 0; $i < $numchks; $i++) {
239 # print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
241 next if $chkcat[$i] eq 'DONE ALREADY';
243 if ( $chkcat[$i] eq 'misc' ) {
244 print OUTASM "\.text\n\t\.even\n";
245 print OUTASM $chk[$i];
247 } elsif ( $chkcat[$i] eq 'data' ) {
248 print OUTASM "\.data\n\t\.even\n";
249 print OUTASM $chk[$i];
251 } elsif ( $chkcat[$i] eq 'consist' ) {
252 if ( $chk[$i] =~ /\.ascii.*\)(hsc|cc) (.*)\\11"\n\t\.ascii\s+"(.*)\\0"/ ) {
253 local($consist) = "$1.$2.$3";
255 $consist =~ s/\//./g;
257 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
258 print OUTASM "\.text\n$consist:\n";
260 print STDERR "Couldn't grok consistency: ", $chk[$i];
263 } elsif ( $chkcat[$i] eq 'splitmarker' ) {
264 # we can just re-constitute this one...
265 print OUTASM "___stg_split_marker",$chksymb[$i],":\n";
267 } elsif ( $chkcat[$i] eq 'closure'
268 || $chkcat[$i] eq 'infotbl'
269 || $chkcat[$i] eq 'slow'
270 || $chkcat[$i] eq 'fast' ) { # do them in that order
271 $symb = $chksymb[$i];
274 if ( defined($closurechk{$symb}) ) {
275 print OUTASM "\.data\n\t\.even\n";
276 print OUTASM $chk[$closurechk{$symb}];
277 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
281 if ( defined($infochk{$symb}) ) {
283 print OUTASM "\.text\n\t\.even\n";
284 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
285 # entry code will be put here!
288 if ( $chk[$infochk{$symb}] =~ /\.long\s+([A-Za-z0-9_]+_entry)$/
289 && $1 ne "_${symb}_entry" ) {
290 print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
293 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
297 if ( defined($slowchk{$symb}) ) {
299 # teach it to drop through to the fast entry point:
300 $c = $chk[$slowchk{$symb}];
302 if ( defined($fastchk{$symb}) ) {
303 $c =~ s/^\tjmp _${symb}_fast\d+.*\n\tnop\n//;
304 $c =~ s/^\tjmp _${symb}_fast\d+.*\n//;
307 print STDERR "still has jump to fast entry point:\n$c"
308 if $c =~ /_${symb}_fast/; # NB: paranoia
310 print OUTASM "\.text\n\t\.even\n";
312 $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
316 if ( defined($fastchk{$symb}) ) {
317 print OUTASM "\.text\n\t\.even\n";
318 print OUTASM $chk[$fastchk{$symb}];
319 $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
322 } elsif ( $chkcat[$i] eq 'vector'
323 || $chkcat[$i] eq 'direct' ) { # do them in that order
324 $symb = $chksymb[$i];
327 if ( defined($vectorchk{$symb}) ) {
328 print OUTASM "\.text\n\t\.even\n";
329 print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
330 # direct return code will be put here!
331 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
335 if ( defined($directchk{$symb}) ) {
336 print OUTASM "\.text\n\t\.even\n";
337 print OUTASM $chk[$directchk{$symb}];
338 $chkcat[$directchk{$symb}] = 'DONE ALREADY';
342 &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm m68k)\n$chkcat[$i]\n$chk[$i]\n");
347 close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
348 close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
353 sub init_FUNNY_THINGS {
354 %KNOWN_FUNNY_THING = (
355 '_CheckHeapCode:', 1,
356 '_CommonUnderflow:', 1,
358 '_EnterNodeCode:', 1,
359 '_ErrorIO_call_count:', 1,
360 '_ErrorIO_innards:', 1,
370 '_PrimUnderflow:', 1,
371 '_StackUnderflowEnterNode:', 1,
373 '_UnderflowVect0:', 1,
374 '_UnderflowVect1:', 1,
375 '_UnderflowVect2:', 1,
376 '_UnderflowVect3:', 1,
377 '_UnderflowVect4:', 1,
378 '_UnderflowVect5:', 1,
379 '_UnderflowVect6:', 1,
380 '_UnderflowVect7:', 1,
383 '_WorldStateToken:', 1,
384 '__Enter_Internal:', 1,
385 '__PRMarking_MarkNextAStack:', 1,
386 '__PRMarking_MarkNextBStack:', 1,
387 '__PRMarking_MarkNextCAF:', 1,
388 '__PRMarking_MarkNextGA:', 1,
389 '__PRMarking_MarkNextRoot:', 1,
390 '__PRMarking_MarkNextSpark:', 1,
391 '__Scavenge_Forward_Ref:', 1,
392 '___std_entry_error__:', 1,
393 '__startMarkWorld:', 1,
395 '_startCcRegisteringWorld:', 1,
396 '_startEnterFloat:', 1,
397 '_startEnterInt:', 1,
398 '_startPerformIO:', 1,
399 '_startStgWorld:', 1,
405 The following table reversal is used for both info tables and return
406 vectors. In both cases, we remove the first entry from the table,
407 reverse the table, put the label at the end, and paste some code
408 (that which is normally referred to by the first entry in the table)
409 right after the table itself. (The code pasting is done elsewhere.)
413 local($symb, $tbl, $discard1) = @_;
419 local(@lines) = split(/\n/, $tbl);
422 for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t\.long\s+/; $i++) {
423 $label .= $lines[$i] . "\n",
424 next if $lines[$i] =~ /^[A-Za-z0-9_]+_info:$/
425 || $lines[$i] =~ /^\.globl/
426 || $lines[$i] =~ /^_vtbl_\S+:$/;
428 $before .= $lines[$i] . "\n"; # otherwise...
431 for ( ; $i <= $#lines && $lines[$i] =~ /^\t\.long\s+/; $i++) {
432 push(@words, $lines[$i]);
434 # now throw away the first word (entry code):
435 shift(@words) if $discard1;
437 for (; $i <= $#lines; $i++) {
438 $after .= $lines[$i] . "\n";
441 $tbl = $before . join("\n", (reverse @words)) . "\n" . $label . $after;
443 # print STDERR "before=$before\n";
444 # print STDERR "label=$label\n";
445 # print STDERR "words=",(reverse @words),"\n";
446 # print STDERR "after=$after\n";
452 %************************************************************************
454 \subsection[Driver-asm-info]{Collect interesting (static) info from an assembler file}
456 %************************************************************************
458 How many times is each asm instruction used?
461 %AsmInsn = (); # init
463 sub dump_asm_insn_counts {
466 open(INASM, "< $asmf") || &tidy_up_and_die(1,"$Pgm: failed to open `$asmf' (to read)\n");
468 if ( /^\t([a-z][a-z0-9]+)\b/ ) {
472 close(INASM) || &tidy_up_and_die(1,"Failed reading from $asmf\n");
474 # OK, now print what we collected (to stderr)
475 foreach $i (sort (keys %AsmInsn)) {
476 print STDERR "INSN:: $i\t",$AsmInsn{$i},"\n";
480 sub dump_asm_globals_info {
483 # make "require"r happy...