1 %************************************************************************
3 \section[Driver-asm-fiddling]{Fiddling with assembler files (SPARC)}
5 %************************************************************************
10 Utterly stomp out C functions' prologues and epilogues; i.e., the
11 stuff to do with the C stack.
13 (SPARC) [Related] Utterly stomp out the changing of register windows.
15 Any other required tidying up.
20 local($in_asmf, $out_asmf) = @_;
22 # multi-line regexp matching:
27 open(INASM, "< $in_asmf")
28 || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
29 open(OUTASM,"> $out_asmf")
30 || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
32 # read whole file, divide into "chunks":
33 # record some info about what we've found...
35 @chk = (); # contents of the chunk
36 $numchks = 0; # number of them
37 @chkcat = (); # what category of thing in each chunk
38 @chksymb = (); # what symbol(base) is defined in this chunk
39 %slowchk = (); # ditto, its regular "slow" entry code
40 %fastchk = (); # ditto, fast entry code
41 %closurechk = (); # ditto, the (static) closure
42 %infochk = (); # given a symbol base, say what chunk its info tbl is in
43 %vectorchk = (); # ditto, return vector table
44 %directchk = (); # ditto, direct return code
50 next if /^\.stab.*___stg_split_marker/;
51 next if /^\.stab.*ghc.*c_ID/;
53 if ( /^\s+/ ) { # most common case first -- a simple line!
54 # duplicated from the bottom
58 } elsif ( /^LC(\d+):$/ ) {
60 $chkcat[$i] = 'string';
63 } elsif ( /^___stg_split_marker(\d+):$/ ) {
65 $chkcat[$i] = 'splitmarker';
68 } elsif ( /^_([A-Za-z0-9_]+)_info:$/ ) {
71 $chkcat[$i] = 'infotbl';
74 die "Info table already? $symb; $i\n" if defined($infochk{$symb});
78 } elsif ( /^_([A-Za-z0-9_]+)_entry:$/ ) {
85 } elsif ( /^_([A-Za-z0-9_]+)_fast\d+:$/ ) {
92 } elsif ( /^_([A-Za-z0-9_]+)_closure:$/ ) {
94 $chkcat[$i] = 'closure';
99 } elsif ( /^_ghc.*c_ID:/ ) {
101 $chkcat[$i] = 'consist';
103 } elsif ( /^(___gnu_compiled_c|gcc2_compiled\.):/ ) {
106 } elsif ( /^_ErrorIO_call_count:/ # HACK!!!!
107 || /^_[A-Za-z0-9_]+\.\d+:$/
108 || /^_.*_CAT:/ # PROF: _entryname_CAT
109 || /^_CC_.*_struct:/ # PROF: _CC_ccident_struct
110 || /^_.*_done:/ # PROF: _module_done
111 || /^__module_registered:/ # PROF: _module_registered
114 $chkcat[$i] = 'data';
117 } elsif ( /^_(ret_|djn_)/ ) {
119 $chkcat[$i] = 'misc';
122 } elsif ( /^_vtbl_([A-Za-z0-9_]+):$/ ) {
124 $chkcat[$i] = 'vector';
129 } elsif ( /^_([A-Za-z0-9_]+)DirectReturn:$/ ) {
131 $chkcat[$i] = 'direct';
136 } elsif ( /^_[A-Za-z0-9_]+_upd:$/ ) {
138 $chkcat[$i] = 'misc';
141 } elsif ( /^_[A-Za-z0-9_]/ ) {
144 print STDERR "Funny global thing?: $_"
145 unless $KNOWN_FUNNY_THING{$thing}
146 || /^__(PRIn|PRStart).*:/ # pointer reversal GC routines
147 || /^_CC_.*:/ # PROF: _CC_ccident
148 || /^__reg.*:/; # PROF: __reg<module>
150 $chkcat[$i] = 'misc';
153 } else { # simple line (duplicated at the top)
158 $numchks = $#chk + 1;
160 # the division into chunks is imperfect;
161 # we throw some things over the fence into the next
164 # also, there are things we would like to know
165 # about the whole module before we start spitting
168 # NB: we start meddling at chunk 1, not chunk 0
170 for ($i = 1; $i < $numchks; $i++) {
171 $c = $chk[$i]; # convenience copy
173 # print STDERR "\nCHK $i (BEFORE):\n", $c;
175 # toss all reg-window stuff (save/restore/ret[l] s):
176 $c =~ s/^\t(save .*|restore|ret|retl)\n//g;
177 # throw away PROLOGUE comments
178 $c =~ s/^\t!#PROLOGUE# 0\n\t!#PROLOGUE# 1\n//;
180 # pin a funny end-thing on (for easier matching):
181 $c .= 'FUNNY#END#THING';
183 # pick some end-things and move them to the next chunk
185 while ( $c =~ /^(\s+\.align\s+\d+\n|\s+\.proc\s+\d+\n|\s+\.global\s+\S+\n|\.text\n|\.data\n|\.stab.*\n)FUNNY#END#THING/ ) {
188 if ( $to_move =~ /\.(global|proc|stab)/ && $i < ($numchks - 1) ) {
189 $chk[$i + 1] = $to_move . $chk[$i + 1];
190 # otherwise they're tossed
193 $c =~ s/^.*\nFUNNY#END#THING/FUNNY#END#THING/;
196 $c =~ s/FUNNY#END#THING//;
197 $chk[$i] = $c; # update w/ convenience copy
199 # print STDERR "\nCHK $i (AFTER):\n", $c;
202 # print out all the literal strings first
203 for ($i = 0; $i < $numchks; $i++) {
204 if ( $chkcat[$i] eq 'string' ) {
205 print OUTASM "\.text\n\t\.align 8\n";
206 print OUTASM $chk[$i];
208 $chkcat[$i] = 'DONE ALREADY';
212 for ($i = 0; $i < $numchks; $i++) {
213 # print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
215 next if $chkcat[$i] eq 'DONE ALREADY';
217 if ( $chkcat[$i] eq 'misc' ) {
218 print OUTASM "\.text\n\t\.align 4\n";
219 print OUTASM $chk[$i];
221 } elsif ( $chkcat[$i] eq 'data' ) {
222 print OUTASM "\.data\n\t\.align 8\n";
223 print OUTASM $chk[$i];
225 } elsif ( $chkcat[$i] eq 'consist' ) {
226 if ( $chk[$i] =~ /\.ascii.*\)(hsc|cc) (.*)\\11"\n\t\.ascii\s+"(.*)\\0"/ ) {
227 local($consist) = "$1.$2.$3";
229 $consist =~ s/\//./g;
231 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
232 print OUTASM "\.text\n$consist:\n";
234 print STDERR "Couldn't grok consistency: ", $chk[$i];
237 } elsif ( $chkcat[$i] eq 'splitmarker' ) {
238 # we can just re-constitute this one...
239 print OUTASM "___stg_split_marker",$chksymb[$i],":\n";
241 } elsif ( $chkcat[$i] eq 'closure'
242 || $chkcat[$i] eq 'infotbl'
243 || $chkcat[$i] eq 'slow'
244 || $chkcat[$i] eq 'fast' ) { # do them in that order
245 $symb = $chksymb[$i];
247 # print STDERR "$i: cat $chkcat[$i], symb $symb ",defined($closurechk{$symb}),":",defined($infochk{$symb}),":",defined($slowchk{$symb}),":",defined($fastchk{$symb}),"\n";
250 if ( defined($closurechk{$symb}) ) {
251 print OUTASM "\.data\n\t\.align 4\n";
252 print OUTASM $chk[$closurechk{$symb}];
253 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
257 if ( defined($infochk{$symb}) ) {
259 print OUTASM "\.text\n\t\.align 4\n";
260 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
261 # entry code will follow, here!
264 if ( $chk[$infochk{$symb}] =~ /\.word\s+([A-Za-z0-9_]+_entry)$/
265 && $1 ne "_${symb}_entry" ) {
266 print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
269 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
273 if ( defined($slowchk{$symb}) ) {
275 # teach it to drop through to the fast entry point:
276 $c = $chk[$slowchk{$symb}];
278 if ( defined($fastchk{$symb}) ) {
279 $c =~ s/^\tcall _${symb}_fast\d+,.*\n\tnop\n//;
280 $c =~ s/^\tcall _${symb}_fast\d+,.*\n(\t[a-z].*\n)/\1/;
283 print STDERR "still has jump to fast entry point:\n$c"
284 if $c =~ /_${symb}_fast/; # NB: paranoia
286 print OUTASM "\.text\n\t\.align 4\n";
288 $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
292 if ( defined($fastchk{$symb}) ) {
293 print OUTASM "\.text\n\t\.align 4\n";
294 print OUTASM $chk[$fastchk{$symb}];
295 $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
298 } elsif ( $chkcat[$i] eq 'vector'
299 || $chkcat[$i] eq 'direct' ) { # do them in that order
300 $symb = $chksymb[$i];
303 if ( defined($vectorchk{$symb}) ) {
304 print OUTASM "\.text\n\t\.align 4\n";
305 print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
306 # direct return code will be put here!
307 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
311 if ( defined($directchk{$symb}) ) {
312 print OUTASM "\.text\n\t\.align 4\n";
313 print OUTASM $chk[$directchk{$symb}];
314 $chkcat[$directchk{$symb}] = 'DONE ALREADY';
318 &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm SPARC)\n$chkcat[$i]\n$chk[$i]\n");
323 close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
324 close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
329 sub init_FUNNY_THINGS {
330 %KNOWN_FUNNY_THING = (
331 '_CheckHeapCode:', 1,
332 '_CommonUnderflow:', 1,
334 '_EnterNodeCode:', 1,
335 '_ErrorIO_call_count:', 1,
336 '_ErrorIO_innards:', 1,
346 '_PrimUnderflow:', 1,
347 '_StackUnderflowEnterNode:', 1,
349 '_UnderflowVect0:', 1,
350 '_UnderflowVect1:', 1,
351 '_UnderflowVect2:', 1,
352 '_UnderflowVect3:', 1,
353 '_UnderflowVect4:', 1,
354 '_UnderflowVect5:', 1,
355 '_UnderflowVect6:', 1,
356 '_UnderflowVect7:', 1,
359 '_WorldStateToken:', 1,
360 '__Enter_Internal:', 1,
361 '__PRMarking_MarkNextAStack:', 1,
362 '__PRMarking_MarkNextBStack:', 1,
363 '__PRMarking_MarkNextCAF:', 1,
364 '__PRMarking_MarkNextGA:', 1,
365 '__PRMarking_MarkNextRoot:', 1,
366 '__PRMarking_MarkNextSpark:', 1,
367 '__Scavenge_Forward_Ref:', 1,
368 '___std_entry_error__:', 1,
369 '__startMarkWorld:', 1,
371 '_startCcRegisteringWorld:', 1,
372 '_startEnterFloat:', 1,
373 '_startEnterInt:', 1,
374 '_startPerformIO:', 1,
375 '_startStgWorld:', 1,
381 The following table reversal is used for both info tables and return
382 vectors. In both cases, we remove the first entry from the table,
383 reverse the table, put the label at the end, and paste some code
384 (that which is normally referred to by the first entry in the table)
385 right after the table itself. (The code pasting is done elsewhere.)
389 local($symb, $tbl, $discard1) = @_;
395 local(@lines) = split(/\n/, $tbl);
398 for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t\.word\s+/; $i++) {
399 $label .= $lines[$i] . "\n",
400 next if $lines[$i] =~ /^[A-Za-z0-9_]+:$/
401 || $lines[$i] =~ /^\t\.global/;
403 $before .= $lines[$i] . "\n"; # otherwise...
406 for ( ; $i <= $#lines && $lines[$i] =~ /^\t\.word\s+/; $i++) {
407 push(@words, $lines[$i]);
409 # now throw away the first word (entry code):
410 shift(@words) if $discard1;
412 for (; $i <= $#lines; $i++) {
413 $after .= $lines[$i] . "\n";
416 $tbl = $before . join("\n", (reverse @words)) . "\n" . $label . $after;
418 # print STDERR "before=$before\n";
419 # print STDERR "label=$label\n";
420 # print STDERR "words=",(reverse @words),"\n";
421 # print STDERR "after=$after\n";
427 %************************************************************************
429 \subsection[Driver-asm-info]{Collect interesting (static) info from an assembler file}
431 %************************************************************************
433 How many times is each asm instruction used?
436 %AsmInsn = (); # init
438 sub dump_asm_insn_counts {
441 open(INASM, "< $asmf") || &tidy_up_and_die(1,"$Pgm: failed to open `$asmf' (to read)\n");
443 if ( /^\t([a-z][a-z0-9]+)\b/ ) {
447 close(INASM) || &tidy_up_and_die(1,"Failed reading from $asmf\n");
449 # OK, now print what we collected (to stderr)
450 foreach $i (sort (keys %AsmInsn)) {
451 print STDERR "INSN:: $i\t",$AsmInsn{$i},"\n";
456 How many times is each ``global variable'' used in a \tr{sethi}
457 instruction (SPARC)? This can give some guidance about what should be
458 put in machine registers...
461 %SethiGlobal = (); # init
463 sub dump_asm_globals_info {
468 open(INASM, "< $asmf") || &tidy_up_and_die(1,"$Pgm: failed to open `$asmf' (to read)\n");
470 if ( /^\tsethi \%hi\(_([_A-Za-z0-9]+)/ ) {
472 next if $globl =~ /(ds|fail|stg|tpl|vtbl)_[0-9]+/;
474 $SethiGlobal{$globl} ++;
477 close(INASM) || &tidy_up_and_die(1,"Failed reading from $asmf\n");
479 # OK, now print what we collected (to stderr)
480 foreach $i (sort (keys %SethiGlobal)) {
481 print STDERR "GLOBAL:: $i\t",$SethiGlobal{$i},"\n";
485 # make "require"r happy...