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
51 if ( /^\s+/ ) { # most common case first -- a simple line!
52 # duplicated from the bottom
56 } elsif ( /^\.LLC(\d+):$/ ) {
58 $chkcat[$i] = 'string';
61 } elsif ( /^__stg_split_marker(\d+):$/ ) {
63 $chkcat[$i] = 'splitmarker';
66 } elsif ( /^([A-Za-z0-9_]+)_info:$/ ) {
69 $chkcat[$i] = 'infotbl';
72 die "Info table already? $symb; $i\n" if defined($infochk{$symb});
76 } elsif ( /^([A-Za-z0-9_]+)_entry:$/ ) {
83 } elsif ( /^([A-Za-z0-9_]+)_fast\d+:$/ ) {
90 } elsif ( /^([A-Za-z0-9_]+)_closure:$/ ) {
92 $chkcat[$i] = 'closure';
97 } elsif ( /^ghc.*c_ID:/ ) {
99 $chkcat[$i] = 'consist';
101 } elsif ( /^(__gnu_compiled_c|gcc2_compiled\.):/ ) {
104 } elsif ( /^ErrorIO_call_count:/ # HACK!!!!
105 || /^[A-Za-z0-9_]+\.\d+:$/
106 || /_CAT:/ # PROF: _entryname_CAT
107 || /^CC_.*_struct:/ # PROF: _CC_ccident_struct
108 || /_done:/ # PROF: _module_done
109 || /^_module_registered:/ # PROF: _module_registered
112 $chkcat[$i] = 'data';
115 } elsif ( /^(ret_|djn_)/ ) {
117 $chkcat[$i] = 'misc';
120 } elsif ( /^vtbl_([A-Za-z0-9_]+):$/ ) {
122 $chkcat[$i] = 'vector';
127 } elsif ( /^([A-Za-z0-9_]+)DirectReturn:$/ ) {
129 $chkcat[$i] = 'direct';
134 } elsif ( /^[A-Za-z0-9_]+_upd:$/ ) {
136 $chkcat[$i] = 'misc';
139 } elsif ( /^[A-Za-z0-9_]/ ) {
142 print STDERR "Funny global thing?: $_"
143 unless $KNOWN_FUNNY_THING{$thing}
144 || /^_(PRIn|PRStart).*:/ # pointer reversal GC routines
145 || /^CC_.*:/ # PROF: _CC_ccident
146 || /^_reg.*:/; # PROF: __reg<module>
148 $chkcat[$i] = 'misc';
151 } else { # simple line (duplicated at the top)
156 $numchks = $#chk + 1;
158 # print STDERR "\nCLOSURES:\n";
159 # foreach $s (sort (keys %closurechk)) {
160 # print STDERR "$s:\t\t",$closurechk{$s},"\n";
162 # print STDERR "\nINFOS:\n";
163 # foreach $s (sort (keys %infochk)) {
164 # print STDERR "$s:\t\t",$infochk{$s},"\n";
166 # print STDERR "SLOWS:\n";
167 # foreach $s (sort (keys %slowchk)) {
168 # print STDERR "$s:\t\t",$slowchk{$s},"\n";
170 # print STDERR "\nFASTS:\n";
171 # foreach $s (sort (keys %fastchk)) {
172 # print STDERR "$s:\t\t",$fastchk{$s},"\n";
175 # the division into chunks is imperfect;
176 # we throw some things over the fence into the next
179 # also, there are things we would like to know
180 # about the whole module before we start spitting
183 # NB: we start meddling at chunk 1, not chunk 0
185 for ($i = 1; $i < $numchks; $i++) {
186 $c = $chk[$i]; # convenience copy
188 # print STDERR "\nCHK $i (BEFORE):\n", $c;
190 # toss all reg-window stuff (save/restore/ret[l] s):
191 $c =~ s/^\t(save .*|restore|ret|retl)\n//g;
192 # throw away PROLOGUE comments
193 $c =~ s/^\t!#PROLOGUE# 0\n\t!#PROLOGUE# 1\n//;
195 # pin a funny end-thing on (for easier matching):
196 $c .= 'FUNNY#END#THING';
198 # pick some end-things and move them to the next chunk
200 while ( $c =~ /^(\s+\.align\s+\d+\n|\s+\.proc\s+\d+\n|\s+\.global\s+\S+\n|\.text\n|\.data\n|\.stab.*\n|\.section.*\n|\s+\.type.*\n|\s+\.size.*\n)FUNNY#END#THING/ ) {
203 if ( $to_move =~ /\.(global|proc|stab)/ && $i < ($numchks - 1) ) {
204 $chk[$i + 1] = $to_move . $chk[$i + 1];
205 # otherwise they're tossed
208 $c =~ s/^.*\nFUNNY#END#THING/FUNNY#END#THING/;
211 $c =~ s/FUNNY#END#THING//;
212 $chk[$i] = $c; # update w/ convenience copy
215 # print out all the literal strings first
216 for ($i = 0; $i < $numchks; $i++) {
217 if ( $chkcat[$i] eq 'string' ) {
218 print OUTASM "\.text\n\t\.align 8\n";
219 print OUTASM $chk[$i];
221 $chkcat[$i] = 'DONE ALREADY';
225 for ($i = 1; $i < $numchks; $i++) {
226 # print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
228 next if $chkcat[$i] eq 'DONE ALREADY';
230 if ( $chkcat[$i] eq 'misc' ) {
231 print OUTASM "\.text\n\t\.align 4\n";
232 print OUTASM $chk[$i];
234 } elsif ( $chkcat[$i] eq 'data' ) {
235 print OUTASM "\.data\n\t\.align 8\n";
236 print OUTASM $chk[$i];
238 } elsif ( $chkcat[$i] eq 'consist' ) {
239 if ( $chk[$i] =~ /\.asciz.*\)(hsc|cc) (.*)\\t(.*)"/ ) {
240 local($consist) = "$1.$2.$3";
242 $consist =~ s/\//./g;
244 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
245 print OUTASM "\.text\n$consist:\n";
247 print STDERR "Couldn't grok consistency: ", $chk[$i];
250 } elsif ( $chkcat[$i] eq 'splitmarker' ) {
251 # we can just re-constitute this one...
252 print OUTASM "___stg_split_marker",$chksymb[$i],":\n";
254 } elsif ( $chkcat[$i] eq 'closure'
255 || $chkcat[$i] eq 'infotbl'
256 || $chkcat[$i] eq 'slow'
257 || $chkcat[$i] eq 'fast' ) { # do them in that order
258 $symb = $chksymb[$i];
261 if ( defined($closurechk{$symb}) ) {
262 print OUTASM "\.data\n\t\.align 4\n";
263 print OUTASM $chk[$closurechk{$symb}];
264 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
268 if ( defined($infochk{$symb}) ) {
270 print OUTASM "\.text\n\t\.align 4\n";
271 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
272 # entry code will be put here!
275 if ( $chk[$infochk{$symb}] =~ /\.word\s+([A-Za-z0-9_]+_entry)$/
276 && $1 ne "${symb}_entry" ) {
277 print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
280 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
284 if ( defined($slowchk{$symb}) ) {
286 # teach it to drop through to the fast entry point:
287 $c = $chk[$slowchk{$symb}];
289 if ( defined($fastchk{$symb}) ) {
290 $c =~ s/^\tcall ${symb}_fast\d+,.*\n\tnop\n//;
291 $c =~ s/^\tcall ${symb}_fast\d+,.*\n(\t[a-z].*\n)/\1/;
294 print STDERR "still has jump to fast entry point:\n$c"
295 if $c =~ /${symb}_fast/; # NB: paranoia
297 print OUTASM "\.text\n\t\.align 4\n";
299 $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
303 if ( defined($fastchk{$symb}) ) {
304 print OUTASM "\.text\n\t\.align 4\n";
305 print OUTASM $chk[$fastchk{$symb}];
306 $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
309 } elsif ( $chkcat[$i] eq 'vector'
310 || $chkcat[$i] eq 'direct' ) { # do them in that order
311 $symb = $chksymb[$i];
314 if ( defined($vectorchk{$symb}) ) {
315 print OUTASM "\.text\n\t\.align 4\n";
316 print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
317 # direct return code will be put here!
318 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
322 if ( defined($directchk{$symb}) ) {
323 print OUTASM "\.text\n\t\.align 4\n";
324 print OUTASM $chk[$directchk{$symb}];
325 $chkcat[$directchk{$symb}] = 'DONE ALREADY';
329 &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm SPARC)\n$chkcat[$i]\n$chk[$i]\n");
334 close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
335 close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
340 sub init_FUNNY_THINGS {
341 %KNOWN_FUNNY_THING = (
343 'CommonUnderflow:', 1,
346 'ErrorIO_call_count:', 1,
347 'ErrorIO_innards:', 1,
358 'StackUnderflowEnterNode:', 1,
360 'UnderflowVect0:', 1,
361 'UnderflowVect1:', 1,
362 'UnderflowVect2:', 1,
363 'UnderflowVect3:', 1,
364 'UnderflowVect4:', 1,
365 'UnderflowVect5:', 1,
366 'UnderflowVect6:', 1,
367 'UnderflowVect7:', 1,
370 'WorldStateToken:', 1,
371 '_Enter_Internal:', 1,
372 '_PRMarking_MarkNextAStack:', 1,
373 '_PRMarking_MarkNextBStack:', 1,
374 '_PRMarking_MarkNextCAF:', 1,
375 '_PRMarking_MarkNextGA:', 1,
376 '_PRMarking_MarkNextRoot:', 1,
377 '_PRMarking_MarkNextSpark:', 1,
378 '_Scavenge_Forward_Ref:', 1,
379 '__std_entry_error__:', 1,
380 '_startMarkWorld:', 1,
382 'startCcRegisteringWorld:', 1,
383 'startEnterFloat:', 1,
385 'startPerformIO:', 1,
392 The following table reversal is used for both info tables and return
393 vectors. In both cases, we remove the first entry from the table,
394 reverse the table, put the label at the end, and paste some code
395 (that which is normally referred to by the first entry in the table)
396 right after the table itself. (The code pasting is done elsewhere.)
400 local($symb, $tbl, $discard1) = @_;
406 local(@lines) = split(/\n/, $tbl);
409 for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t\.word\s+/; $i++) {
410 $label .= $lines[$i] . "\n",
411 next if $lines[$i] =~ /^[A-Za-z0-9_]+:$/
412 || $lines[$i] =~ /^\t\.global/;
414 $before .= $lines[$i] . "\n"; # otherwise...
417 for ( ; $i <= $#lines && $lines[$i] =~ /^\t\.word\s+/; $i++) {
418 push(@words, $lines[$i]);
420 # now throw away the first word (entry code):
421 shift(@words) if $discard1;
423 for (; $i <= $#lines; $i++) {
424 $after .= $lines[$i] . "\n";
427 $tbl = $before . join("\n", (reverse @words)) . "\n" . $label . $after;
429 # print STDERR "before=$before\n";
430 # print STDERR "label=$label\n";
431 # print STDERR "words=",(reverse @words),"\n";
432 # print STDERR "after=$after\n";
438 %************************************************************************
440 \subsection[Driver-asm-info]{Collect interesting (static) info from an assembler file}
442 %************************************************************************
444 How many times is each asm instruction used?
447 %AsmInsn = (); # init
449 sub dump_asm_insn_counts {
452 open(INASM, "< $asmf") || &tidy_up_and_die(1,"$Pgm: failed to open `$asmf' (to read)\n");
454 if ( /^\t([a-z][a-z0-9]+)\b/ ) {
458 close(INASM) || &tidy_up_and_die(1,"Failed reading from $asmf\n");
460 # OK, now print what we collected (to stderr)
461 foreach $i (sort (keys %AsmInsn)) {
462 print STDERR "INSN:: $i\t",$AsmInsn{$i},"\n";
467 How many times is each ``global variable'' used in a \tr{sethi}
468 instruction (SPARC)? This can give some guidance about what should be
469 put in machine registers...
472 %SethiGlobal = (); # init
474 sub dump_asm_globals_info {
479 open(INASM, "< $asmf") || &tidy_up_and_die(1,"$Pgm: failed to open `$asmf' (to read)\n");
481 if ( /^\tsethi \%hi\(_([_A-Za-z0-9]+)/ ) {
483 next if $globl =~ /(ds|fail|stg|tpl|vtbl)_[0-9]+/;
485 $SethiGlobal{$globl} ++;
488 close(INASM) || &tidy_up_and_die(1,"Failed reading from $asmf\n");
490 # OK, now print what we collected (to stderr)
491 foreach $i (sort (keys %SethiGlobal)) {
492 print STDERR "GLOBAL:: $i\t",$SethiGlobal{$i},"\n";
496 # make "require"r happy...