1 %************************************************************************
3 \section[Driver-asm-fiddling]{Fiddling with assembler files (HP-PA)}
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.
19 The HP linker is very picky about symbols being in the appropriate
20 space (code vs. data). When we mangle the threaded code to put the
21 info tables just prior to the code, they wind up in code space
22 rather than data space. This means that references to *_info from
23 un-mangled parts of the RTS (e.g. unthreaded GC code) get
24 unresolved symbols. Solution: mini-mangler for .c files on HP. I
25 think this should really be triggered in the driver by a new -rts
26 option, so that user code doesn't get mangled inappropriately.
28 With reversed tables, jumps are to the _info label rather than to
29 the _entry label. The _info label is just an address in code
30 space, rather than an entry point with the descriptive blob we
31 talked about yesterday. As a result, you can't use the call-style
32 JMP_ macro. However, some JMP_ macros take _info labels as targets
33 and some take code entry points within the RTS. The latter won't
34 work with the goto-style JMP_ macro. Sigh. Solution: Use the goto
35 style JMP_ macro, and mangle some more assembly, changing all
36 "RP'literal" and "LP'literal" references to "R'literal" and
37 "L'literal," so that you get the real address of the code, rather
38 than the descriptive blob. Also change all ".word P%literal"
39 entries in info tables and vector tables to just ".word literal,"
40 for the same reason. Advantage: No more ridiculous call sequences.
45 local($in_asmf, $out_asmf) = @_;
47 # multi-line regexp matching:
52 open(INASM, "< $in_asmf")
53 || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
54 open(OUTASM,"> $out_asmf")
55 || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
57 # read whole file, divide into "chunks":
58 # record some info about what we've found...
60 @chk = (); # contents of the chunk
61 $numchks = 0; # number of them
62 @chkcat = (); # what category of thing in each chunk
63 @chksymb = (); # what symbol(base) is defined in this chunk
64 %slowchk = (); # ditto, its regular "slow" entry code
65 %fastchk = (); # ditto, fast entry code
66 %closurechk = (); # ditto, the (static) closure
67 %infochk = (); # ditto, normal info tbl
68 %vectorchk = (); # ditto, return vector table
69 %directchk = (); # ditto, direct return code
75 #??? next if /^\.stab.*___stg_split_marker/;
76 #??? next if /^\.stab.*ghc.*c_ID/;
80 if ( /^\s+/ ) { # most common case first -- a simple line!
81 # duplicated from the bottom
84 } elsif ( /^L\$C(\d+)$/ ) {
86 $chkcat[$i] = 'literal';
89 } elsif ( /^__stg_split_marker(\d+)$/ ) {
91 $chkcat[$i] = 'splitmarker';
94 } elsif ( /^([A-Za-z0-9_]+)_info$/ ) {
97 $chkcat[$i] = 'infotbl';
100 die "Info table already? $symb; $i\n" if defined($infochk{$symb});
102 $infochk{$symb} = $i;
104 } elsif ( /^([A-Za-z0-9_]+)_entry$/ ) {
106 $chkcat[$i] = 'slow';
111 } elsif ( /^([A-Za-z0-9_]+)_fast\d+$/ ) {
113 $chkcat[$i] = 'fast';
118 } elsif ( /^([A-Za-z0-9_]+)_closure$/ ) {
120 $chkcat[$i] = 'closure';
123 $closurechk{$1} = $i;
125 } elsif ( /^ghc.*c_ID/ ) {
127 $chkcat[$i] = 'consist';
129 } elsif ( /^(__gnu_compiled_c|gcc2_compiled\.)/ ) {
132 } elsif ( /^ErrorIO_call_count/ # HACK!!!!
133 || /^[A-Za-z0-9_]+\.\d+$/
134 || /^.*_CAT/ # PROF: _entryname_CAT
135 || /^CC_.*_struct/ # PROF: _CC_ccident_struct
136 || /^.*_done/ # PROF: _module_done
137 || /^_module_registered/ # PROF: _module_registered
140 $chkcat[$i] = 'data';
143 } elsif ( /^([A-Za-z0-9_]+)\s+\.comm/ ) {
148 } elsif ( /^(ret_|djn_)/ ) {
150 $chkcat[$i] = 'misc';
153 } elsif ( /^vtbl_([A-Za-z0-9_]+)$/ ) {
155 $chkcat[$i] = 'vector';
160 } elsif ( /^([A-Za-z0-9_]+)DirectReturn$/ ) {
162 $chkcat[$i] = 'direct';
167 } elsif ( /^[A-Za-z0-9_]+_upd$/ ) {
169 $chkcat[$i] = 'misc';
172 } elsif ( /^[A-Za-z0-9_]/ && ! /^L\$\d+$/) {
175 print STDERR "Funny global thing?: $_"
176 unless $KNOWN_FUNNY_THING{$thing}
177 || /^_(PRIn|PRStart)/ # pointer reversal GC routines
178 || /^CC_.*/ # PROF: _CC_ccident
179 || /^_reg.*/; # PROF: _reg<module>
181 $chkcat[$i] = 'misc';
184 } else { # simple line (duplicated at the top)
188 $numchks = $#chk + 1;
190 # print STDERR "\nCLOSURES:\n";
191 # foreach $s (sort (keys %closurechk)) {
192 # print STDERR "$s:\t\t",$closurechk{$s},"\n";
194 # print STDERR "\nNORMAL INFOS:\n";
195 # foreach $s (sort (keys %infochk)) {
196 # print STDERR "$s:\t\t",$infochk{$s},"\n";
198 # print STDERR "SLOWS:\n";
199 # foreach $s (sort (keys %slowchk)) {
200 # print STDERR "$s:\t\t",$slowchk{$s},"\n";
202 # print STDERR "\nFASTS:\n";
203 # foreach $s (sort (keys %fastchk)) {
204 # print STDERR "$s:\t\t",$fastchk{$s},"\n";
207 # the division into chunks is imperfect;
208 # we throw some things over the fence into the next
211 # also, there are things we would like to know
212 # about the whole module before we start spitting
215 # NB: we start meddling at chunk 1, not chunk 0
217 for ($i = 1; $i < $numchks; $i++) {
218 $c = $chk[$i]; # convenience copy
220 # print STDERR "\nCHK $i (BEFORE):\n", $c;
222 # toss all prologue stuff
223 $c =~ s/^\s+\.ENTRY[^\0]*--- BEGIN ---/\t.ENTRY/;
225 # Lie about our .CALLINFO
226 $c =~ s/^\s+\.CALLINFO.*$/\t.CALLINFO NO_CALLS,NO_UNWIND/;
233 # print STDERR "\nCHK $i (STEP 1):\n", $c;
235 # toss all epilogue stuff
236 $c =~ s/^\s+--- END ---[^\0]*\.EXIT/\t.EXIT/;
238 # print STDERR "\nCHK $i (STEP 2):\n", $c;
240 # Sorry; we moved the _info stuff to the code segment.
241 $c =~ s/_info,DATA/_info,CODE/g;
243 # pin a funny end-thing on (for easier matching):
244 $c .= 'FUNNY#END#THING';
246 # pick some end-things and move them to the next chunk
248 # print STDERR "\nCHK $i (STEP 3):\n", $c;
249 while ($c =~ /^(\s+\.(IMPORT|EXPORT|PARAM).*\n)FUNNY#END#THING/
250 || $c =~ /^(\s+\.align\s+\d+\n)FUNNY#END#THING/
251 || $c =~ /^(\s+\.(SPACE|SUBSPA)\s+\S+\n)FUNNY#END#THING/
252 || $c =~ /^(\s*\n)FUNNY#END#THING/ ) {
255 if ( $i < ($numchks - 1) && ($to_move =~ /^\s+\.(IMPORT|EXPORT)/
256 || ($to_move =~ /align/ && $chkcat[$i+1] eq 'literal')) ) {
257 $chk[$i + 1] = $to_move . $chk[$i + 1];
258 # otherwise they're tossed
260 $c =~ s/^.*\nFUNNY#END#THING/FUNNY#END#THING/;
262 # print STDERR "\nCHK $i (STEP 4):\n", $c;
264 $c =~ s/FUNNY#END#THING//;
265 $chk[$i] = $c; # update w/ convenience copy
268 # print out the header stuff first
270 print OUTASM $chk[0];
272 # print out all the literals second
274 for ($i = 1; $i < $numchks; $i++) {
275 if ( $chkcat[$i] eq 'literal' ) {
276 print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
277 print OUTASM $chk[$i];
278 print OUTASM "; end literal\n"; # for the splitter
280 $chkcat[$i] = 'DONE ALREADY';
284 # print out all the bss third
286 for ($i = 1; $i < $numchks; $i++) {
287 if ( $chkcat[$i] eq 'bss' ) {
288 print OUTASM "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$BSS\$\n\t.align 4\n";
289 print OUTASM $chk[$i];
291 $chkcat[$i] = 'DONE ALREADY';
295 for ($i = 1; $i < $numchks; $i++) {
296 # print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
298 next if $chkcat[$i] eq 'DONE ALREADY';
300 if ( $chkcat[$i] eq 'misc' ) {
301 print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
302 print OUTASM $chk[$i];
304 } elsif ( $chkcat[$i] eq 'data' ) {
305 print OUTASM "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
306 print OUTASM $chk[$i];
308 } elsif ( $chkcat[$i] eq 'consist' ) {
309 if ( $chk[$i] =~ /\.STRING.*\)(hsc|cc) (.*)\\x09(.*)\\x00/ ) {
310 local($consist) = "$1.$2.$3";
312 $consist =~ s/\//./g;
314 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
315 print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n$consist\n";
317 print STDERR "Couldn't grok consistency: ", $chk[$i];
320 } elsif ( $chkcat[$i] eq 'splitmarker' ) {
321 # we can just re-constitute this one...
322 # ignore the final split marker, to save an empty object module
323 # Use _three_ underscores so that ghc-split doesn't get overly complicated
324 print OUTASM "___stg_split_marker$chksymb[$i]\n";
326 } elsif ( $chkcat[$i] eq 'closure'
327 || $chkcat[$i] eq 'infotbl'
328 || $chkcat[$i] eq 'slow'
329 || $chkcat[$i] eq 'fast' ) { # do them in that order
330 $symb = $chksymb[$i];
333 if ( defined($closurechk{$symb}) ) {
334 print OUTASM "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
335 print OUTASM $chk[$closurechk{$symb}];
336 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
340 if ( defined($infochk{$symb}) ) {
341 print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
342 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
343 # entry code will be put here!
346 if ( $chk[$infochk{$symb}] =~ /\.word\s+([A-Za-z0-9_]+_entry)$/
347 && $1 ne "${symb}_entry" ) {
348 print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
351 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
355 if ( defined($slowchk{$symb}) ) {
357 # teach it to drop through to the fast entry point:
358 $c = $chk[$slowchk{$symb}];
359 if ( defined($fastchk{$symb}) ) {
360 $c =~ s/^\s+ldil.*\n\s+ldo.*\n\s+bv.*\n(.*\n)?\s+\.EXIT/$1\t.EXIT/;
363 # ToDo: ???? any good way to look for "dangling" references
364 # to fast-entry pt ???
366 print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
368 $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
372 if ( defined($fastchk{$symb}) ) {
373 $c = $chk[$fastchk{$symb}];
374 if ( ! defined($slowchk{$symb}) ) {
375 print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
378 $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
381 } elsif ( $chkcat[$i] eq 'vector'
382 || $chkcat[$i] eq 'direct' ) { # do them in that order
383 $symb = $chksymb[$i];
386 if ( defined($vectorchk{$symb}) ) {
387 print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
388 print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
389 # direct return code will be put here!
390 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
394 if ( defined($directchk{$symb}) ) {
395 print OUTASM "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
396 print OUTASM $chk[$directchk{$symb}];
397 $chkcat[$directchk{$symb}] = 'DONE ALREADY';
400 &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm hppa)\n$chkcat[$i]\n$chk[$i]\n");
405 close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
406 close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
410 The HP is a major nuisance. The threaded code mangler moved info tables
411 from data space to code space, but unthreaded code in the RTS still has
412 references to info tables in data space. Since the HP linker is very precise
413 about where symbols live, we need to patch the references in the unthreaded
418 sub mini_mangle_asm {
419 local($in_asmf, $out_asmf) = @_;
421 open(INASM, "< $in_asmf")
422 || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
423 open(OUTASM,"> $out_asmf")
424 || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
427 s/_info,DATA/_info,CODE/; # Move _info references to code space
433 close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
434 close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
440 sub init_FUNNY_THINGS {
441 %KNOWN_FUNNY_THING = (
443 'CommonUnderflow', 1,
446 'ErrorIO_call_count', 1,
447 'ErrorIO_innards', 1,
458 'StackUnderflowEnterNode', 1,
470 'WorldStateToken', 1,
471 '_Enter_Internal', 1,
472 '_PRMarking_MarkNextAStack', 1,
473 '_PRMarking_MarkNextBStack', 1,
474 '_PRMarking_MarkNextCAF', 1,
475 '_PRMarking_MarkNextGA', 1,
476 '_PRMarking_MarkNextRoot', 1,
477 '_PRMarking_MarkNextSpark', 1,
478 '_Scavenge_Forward_Ref', 1,
479 '__std_entry_error__', 1,
480 '_startMarkWorld', 1,
482 'startCcRegisteringWorld', 1,
483 'startEnterFloat', 1,
492 The following table reversal is used for both info tables and return
493 vectors. In both cases, we remove the first entry from the table,
494 reverse the table, put the label at the end, and paste some code
495 (that which is normally referred to by the first entry in the table)
496 right after the table itself. (The code pasting is done elsewhere.)
500 local($symb, $tbl, $discard1) = @_;
504 local(@imports) = ();
507 local(@lines) = split(/\n/, $tbl);
510 for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\s+\.word\s+/; $i++) {
511 $label .= $lines[$i] . "\n",
512 next if $lines[$i] =~ /^[A-Za-z0-9_]+$/
513 || $lines[$i] =~ /^\s+\.EXPORT/;
515 $before .= $lines[$i] . "\n"; # otherwise...
518 for ( ; $i <= $#lines && $lines[$i] =~ /^\s+\.(word|IMPORT)/; $i++) {
519 if ($lines[$i] =~ /^\s+\.IMPORT/) {
520 push(@imports, $lines[$i]);
522 # We don't use HP's ``function pointers''
523 # We just use labels in code space, like normal people
524 $lines[$i] =~ s/P%//;
525 push(@words, $lines[$i]);
528 # now throw away the first word (entry code):
533 for (; $i <= $#lines; $i++) {
534 $after .= $lines[$i] . "\n";
537 $tbl = $before . join("\n", @imports) . "\n" .
538 join("\n", (reverse @words)) . "\n" . $label . $after;
540 # print STDERR "before=$before\n";
541 # print STDERR "label=$label\n";
542 # print STDERR "words=",(reverse @words),"\n";
543 # print STDERR "after=$after\n";
549 %************************************************************************
551 \subsection[Driver-asm-info]{Collect interesting (static) info from an assembler file}
553 %************************************************************************
555 How many times is each asm instruction used?
558 %AsmInsn = (); # init
560 sub dump_asm_insn_counts {
563 open(INASM, "< $asmf") || &tidy_up_and_die(1,"$Pgm: failed to open `$asmf' (to read)\n");
565 if ( /^\t([a-z][a-z0-9]+)\b/ ) {
569 close(INASM) || &tidy_up_and_die(1,"Failed reading from $asmf\n");
571 # OK, now print what we collected (to stderr)
572 foreach $i (sort (keys %AsmInsn)) {
573 print STDERR "INSN:: $i\t",$AsmInsn{$i},"\n";
577 sub dump_asm_globals_info {
580 # make "require"r happy...