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 ( /^(ret_|djn_)/ ) {
61 } elsif ( /^vtbl_([A-Za-z0-9_]+):$/ ) {
63 $chkcat[$i] = 'vector';
68 } elsif ( /^([A-Za-z0-9_]+)DirectReturn:$/ ) {
70 $chkcat[$i] = 'direct';
75 } elsif ( /^[A-Za-z0-9_]+_upd:$/ ) {
80 } elsif ( /^\.LLC(\d+):$/ ) {
82 $chkcat[$i] = 'string';
85 } elsif ( /^__stg_split_marker(\d+):$/ ) {
87 $chkcat[$i] = 'splitmarker';
90 } elsif ( /^([A-Za-z0-9_]+)_info:$/ ) {
93 $chkcat[$i] = 'infotbl';
98 } elsif ( /^([A-Za-z0-9_]+)_entry:$/ ) {
100 $chkcat[$i] = 'slow';
105 } elsif ( /^([A-Za-z0-9_]+)_fast\d+:$/ ) {
107 $chkcat[$i] = 'fast';
112 } elsif ( /^([A-Za-z0-9_]+)_closure:$/ ) {
114 $chkcat[$i] = 'closure';
117 $closurechk{$1} = $i;
119 } elsif ( /^ghc.*c_ID:/ ) {
121 $chkcat[$i] = 'consist';
123 } elsif ( /^(__gnu_compiled_c|gcc2_compiled\.):/ ) {
126 } elsif ( /^ErrorIO_call_count:/ # HACK!!!!
127 || /^[A-Za-z0-9_]+\.\d+:$/
128 || /_CAT:/ # PROF: _entryname_CAT
129 || /^CC_.*_struct:/ # PROF: _CC_ccident_struct
130 || /_done:/ # PROF: _module_done
131 || /^_module_registered:/ # PROF: _module_registered
134 $chkcat[$i] = 'data';
137 } elsif ( /^[A-Za-z0-9_]/ ) {
140 print STDERR "Funny global thing?: $_"
141 unless $KNOWN_FUNNY_THING{$thing}
142 || /^_(PRIn|PRStart).*:/ # pointer reversal GC routines
143 || /^CC_.*:/ # PROF: _CC_ccident
144 || /^_reg.*:/; # PROF: __reg<module>
146 $chkcat[$i] = 'misc';
149 } else { # simple line (duplicated at the top)
154 $numchks = $#chk + 1;
156 # print STDERR "\nCLOSURES:\n";
157 # foreach $s (sort (keys %closurechk)) {
158 # print STDERR "$s:\t\t",$closurechk{$s},"\n";
160 # print STDERR "\nINFOS:\n";
161 # foreach $s (sort (keys %infochk)) {
162 # print STDERR "$s:\t\t",$infochk{$s},"\n";
164 # print STDERR "SLOWS:\n";
165 # foreach $s (sort (keys %slowchk)) {
166 # print STDERR "$s:\t\t",$slowchk{$s},"\n";
168 # print STDERR "\nFASTS:\n";
169 # foreach $s (sort (keys %fastchk)) {
170 # print STDERR "$s:\t\t",$fastchk{$s},"\n";
173 # the division into chunks is imperfect;
174 # we throw some things over the fence into the next
177 # also, there are things we would like to know
178 # about the whole module before we start spitting
181 # NB: we start meddling at chunk 1, not chunk 0
183 for ($i = 1; $i < $numchks; $i++) {
184 $c = $chk[$i]; # convenience copy
186 # print STDERR "\nCHK $i (BEFORE):\n", $c;
188 # toss all reg-window stuff (save/restore/ret[l] s):
189 $c =~ s/^\t(save .*|restore|ret|retl)\n//g;
190 # throw away PROLOGUE comments
191 $c =~ s/^\t!#PROLOGUE# 0\n\t!#PROLOGUE# 1\n//;
193 # pin a funny end-thing on (for easier matching):
194 $c .= 'FUNNY#END#THING';
196 # pick some end-things and move them to the next chunk
198 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/ ) {
201 if ( $to_move =~ /\.(global|proc|stab)/ && $i < ($numchks - 1) ) {
202 $chk[$i + 1] = $to_move . $chk[$i + 1];
203 # otherwise they're tossed
206 $c =~ s/^.*\nFUNNY#END#THING/FUNNY#END#THING/;
209 $c =~ s/FUNNY#END#THING//;
210 $chk[$i] = $c; # update w/ convenience copy
213 # print out all the literal strings first
214 for ($i = 0; $i < $numchks; $i++) {
215 if ( $chkcat[$i] eq 'string' ) {
216 print OUTASM "\.text\n\t\.align 8\n";
217 print OUTASM $chk[$i];
219 $chkcat[$i] = 'DONE ALREADY';
223 for ($i = 1; $i < $numchks; $i++) {
224 # print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
226 next if $chkcat[$i] eq 'DONE ALREADY';
228 if ( $chkcat[$i] eq 'misc' ) {
229 print OUTASM "\.text\n\t\.align 4\n";
230 print OUTASM $chk[$i];
232 } elsif ( $chkcat[$i] eq 'data' ) {
233 print OUTASM "\.data\n\t\.align 8\n";
234 print OUTASM $chk[$i];
236 } elsif ( $chkcat[$i] eq 'consist' ) {
237 if ( $chk[$i] =~ /\.asciz.*\)(hsc|cc) (.*)\\t(.*)"/ ) {
238 local($consist) = "$1.$2.$3";
240 $consist =~ s/\//./g;
242 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
243 print OUTASM "\.text\n$consist:\n";
245 print STDERR "Couldn't grok consistency: ", $chk[$i];
248 } elsif ( $chkcat[$i] eq 'splitmarker' ) {
249 # we can just re-constitute this one...
250 print OUTASM "___stg_split_marker",$chksymb[$i],":\n";
252 } elsif ( $chkcat[$i] eq 'closure'
253 || $chkcat[$i] eq 'infotbl'
254 || $chkcat[$i] eq 'slow'
255 || $chkcat[$i] eq 'fast' ) { # do them in that order
256 $symb = $chksymb[$i];
259 if ( defined($closurechk{$symb}) ) {
260 print OUTASM "\.data\n\t\.align 4\n";
261 print OUTASM $chk[$closurechk{$symb}];
262 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
266 if ( defined($infochk{$symb}) ) {
268 print OUTASM "\.text\n\t\.align 4\n";
269 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
270 # entry code will be put here!
272 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
276 if ( defined($slowchk{$symb}) ) {
278 # teach it to drop through to the fast entry point:
279 $c = $chk[$slowchk{$symb}];
280 $c =~ s/^\tcall _${symb}_fast\d+,.*\n\tnop\n//;
281 $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/;
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 = (
332 'CommonUnderflow:', 1,
335 'ErrorIO_call_count:', 1,
336 'ErrorIO_innards:', 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,
374 'startPerformIO:', 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...