1 %************************************************************************
3 \section[Driver-asm-fiddling]{Fiddling with assembler files (SGI MIPS box)}
5 %************************************************************************
9 local($in_asmf, $out_asmf) = @_;
11 # multi-line regexp matching:
16 open(INASM, "< $in_asmf")
17 || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
18 open(OUTASM,"> $out_asmf")
19 || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
21 # read whole file, divide into "chunks":
22 # record some info about what we've found...
24 @chk = (); # contents of the chunk
25 $numchks = 0; # number of them
26 @chkcat = (); # what category of thing in each chunk
27 @chksymb = (); # what symbol(base) is defined in this chunk
28 %slowchk = (); # ditto, its regular "slow" entry code
29 %fastchk = (); # ditto, fast entry code
30 %closurechk = (); # ditto, the (static) closure
31 %infochk = (); # given a symbol base, say what chunk its info tbl is in
32 %vectorchk = (); # ditto, return vector table
33 %directchk = (); # ditto, direct return code
34 $EXTERN_DECLS = ''; # .globl <foo> .text
41 next if /^$/; # blank line
42 next if /^\s*#(NO_)?APP/;
43 next if /^\t\.file\t/;
46 if ( /^\t\.(globl \S+ \.text|comm\t)/ ) {
47 $EXTERN_DECLS .= $_ unless /(__DISCARD__|\b(PK_|ASSIGN_)(FLT|DBL)\b)/;
49 } elsif ( /^\s+/ ) { # most common case first -- a simple line!
50 # duplicated from the bottom
53 # NB: all the rest start with a non-space
55 } elsif ( /^\d+:/ ) { # a funny-looking very-local label
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)
157 $numchks = $#chk + 1;
159 # print STDERR "\nCLOSURES:\n";
160 # foreach $s (sort (keys %closurechk)) {
161 # print STDERR "$s:\t\t",$closurechk{$s},"\n";
163 # print STDERR "\nINFOS:\n";
164 # foreach $s (sort (keys %infochk)) {
165 # print STDERR "$s:\t\t",$infochk{$s},"\n";
167 # print STDERR "SLOWS:\n";
168 # foreach $s (sort (keys %slowchk)) {
169 # print STDERR "$s:\t\t",$slowchk{$s},"\n";
171 # print STDERR "\nFASTS:\n";
172 # foreach $s (sort (keys %fastchk)) {
173 # print STDERR "$s:\t\t",$fastchk{$s},"\n";
176 # the division into chunks is imperfect;
177 # we throw some things over the fence into the next
180 # also, there are things we would like to know
181 # about the whole module before we start spitting
184 # NB: we start meddling at chunk 1, not chunk 0
186 for ($i = 1; $i < $numchks; $i++) {
187 $c = $chk[$i]; # convenience copy
189 # print STDERR "\nCHK $i (BEFORE):\n", $c;
191 # pin a funny end-thing on (for easier matching):
192 $c .= 'FUNNY#END#THING';
194 # pick some end-things and move them to the next chunk
196 while ( $c =~ /^(\s*\.align\s+\d+\n)FUNNY#END#THING/
197 || $c =~ /^(\s*\.(globl|ent)\s+\S+\n)FUNNY#END#THING/
198 || $c =~ /^(\s*\.text\n|\s*\.r?data\n)FUNNY#END#THING/ ) {
201 if ( $to_move =~ /\.(globl|ent)/ && $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 # toss all prologue stuff;
210 # be slightly paranoid to make sure there's
211 # nothing surprising in there
212 if ( $c =~ /--- BEGIN ---/ ) {
213 if (($p, $r) = split(/--- BEGIN ---/, $c)) {
214 # the .frame/.mask/.fmask that we use is the same
215 # as that produced by GCC for miniInterpret; this
216 # gives GDB some chance of figuring out what happened
217 $FRAME = "\t.frame\t\$sp,2168,\$31\n\t.mask\t0x90000000,-4\n\t.fmask\t0x00000000,0\n";
218 $p =~ s/^\t\.(frame).*\n/__FRAME__/g;
219 $p =~ s/^\t\.(mask|fmask).*\n//g;
220 $p =~ s/^\t\.cprestore.*\n/\t\.cprestore 416\n/; # 16 + 100 4-byte args
221 $p =~ s/^\tsubu\t\$sp,\$sp,\d+\n//;
222 $p =~ s/^\tsw\t\$31,\d+\(\$sp\)\n//;
223 $p =~ s/^\tsw\t\$fp,\d+\(\$sp\)\n//;
224 $p =~ s/^\tsw\t\$28,\d+\(\$sp\)\n//;
225 $p =~ s/__FRAME__/$FRAME/;
226 die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/;
228 # glue together what's left
230 $c =~ s/\n\t\n/\n/; # junk blank line
234 # toss all epilogue stuff; again, paranoidly;
235 # first, this basic sequence may occur "--- END ---" or not
236 $c =~ s/^\tlw\t\$31,\d+\(\$sp\)\n\taddu\t\$sp,\$sp,\d+\n\tj\t\$31\n\t\.end/\t\.end/;
238 if ( $c =~ /--- END ---/ ) {
239 if (($r, $e) = split(/--- END ---/, $c)) {
240 $e =~ s/^\tlw\t\$31,\d+\(\$sp\)\n//;
241 $e =~ s/^\tlw\t\$fp,\d+\(\$sp\)\n//;
242 $e =~ s/^\taddu\t\$sp,\$sp,\d+\n//;
243 $e =~ s/^\tj\t\$31\n//;
244 die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/;
246 # glue together what's left
248 $c =~ s/\n\t\n/\n/; # junk blank line
252 # toss all calls to __DISCARD__
253 $c =~ s/^\tjal\t__DISCARD__\n//g;
254 # that may leave some gratuitous asm macros around
255 # (no harm done; but we get rid of them to be tidier)
256 $c =~ s/^\t\.set\tnoreorder\n\t\.set\tnomacro\n\taddu\t(\S+)\n\t\.set\tmacro\n\t\.set\treorder\n/\taddu\t$1\n/;
258 $c =~ s/FUNNY#END#THING//;
259 $chk[$i] = $c; # update w/ convenience copy
261 print STDERR "NB: Contains magic stuff!\n$c\n" if $c =~ /^\t[^\.].*(\$28)\b/;
263 # print STDERR "\nCHK $i (AFTER):\n", $c;
267 # print out the header stuff first
268 $chk[0] = "\t\.file\t1 \"$ifile_root.hc\"\n" . $chk[0];
270 # get rid of horrible "<dollar>Revision: .*$" strings
271 local(@lines0) = split(/\n/, $chk[0]);
273 while ( $z <= $#lines0 ) {
274 if ( $lines0[$z] =~ /^\t\.byte\t0x24,0x52,0x65,0x76,0x69,0x73,0x69,0x6f$/ ) {
277 while ( $z <= $#lines0 ) {
279 last if $lines0[$z] =~ /[,\t]0x0$/;
285 $chk[0] = join("\n", @lines0);
286 $chk[0] =~ s/\n\n+/\n/;
287 print OUTASM $chk[0];
289 # print out all the literal strings second
290 for ($i = 1; $i < $numchks; $i++) {
291 if ( $chkcat[$i] eq 'string' ) {
292 print OUTASM "\t\.rdata\n\t\.align 2\n";
293 print OUTASM $chk[$i];
295 $chkcat[$i] = 'DONE ALREADY';
299 for ($i = 1; $i < $numchks; $i++) {
300 # print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
302 next if $chkcat[$i] eq 'DONE ALREADY';
304 if ( $chkcat[$i] eq 'misc' ) {
305 print OUTASM "\t\.text\n\t\.align 2\n";
306 print OUTASM $chk[$i];
308 } elsif ( $chkcat[$i] eq 'data' ) {
309 print OUTASM "\t\.data\n\t\.align 2\n";
310 print OUTASM $chk[$i];
312 } elsif ( $chkcat[$i] eq 'consist' ) {
313 #? consistency string is just a v
314 #? horrible bunch of .bytes,
315 #? which I am too lazy to sort out (WDP 95/05)
316 #? if ( $chk[$i] =~ /\.ascii.*\)(hsc|cc) (.*)\\11"\n\t\.ascii\s+"(.*)\\0"/ ) {
317 #? local($consist) = "$1.$2.$3";
318 #? $consist =~ s/,/./g;
319 #? $consist =~ s/\//./g;
320 #? $consist =~ s/-/_/g;
321 #? $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
322 #? print OUTASM "\t\.text\n$consist:\n";
324 #? print STDERR "Couldn't grok consistency: ", $chk[$i];
327 } elsif ( $chkcat[$i] eq 'splitmarker' ) {
328 # we can just re-constitute this one...
329 # ignore the final split marker, to save an empty object module
330 # Use _three_ underscores so that ghc-split doesn't get overly complicated
331 print OUTASM "___stg_split_marker",$chksymb[$i],":\n";
333 } elsif ( $chkcat[$i] eq 'closure'
334 || $chkcat[$i] eq 'infotbl'
335 || $chkcat[$i] eq 'slow'
336 || $chkcat[$i] eq 'fast' ) { # do them in that order
337 $symb = $chksymb[$i];
340 if ( defined($closurechk{$symb}) ) {
341 print OUTASM "\t\.data\n\t\.align 2\n";
342 print OUTASM $chk[$closurechk{$symb}];
343 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
347 if ( defined($infochk{$symb}) ) {
349 print OUTASM "\t\.text\n\t\.align 2\n";
350 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
351 # entry code will be put here!
354 if ( $chk[$infochk{$symb}] =~ /\.word\s+([A-Za-z0-9_]+_entry)$/
355 && $1 ne "${symb}_entry" ) {
356 print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
359 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
363 if ( defined($slowchk{$symb}) ) {
365 # teach it to drop through to the fast entry point:
366 $c = $chk[$slowchk{$symb}];
368 if ( defined($fastchk{$symb}) ) {
369 $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
372 # ToDo??? any good way to look for "dangling" references
373 # to fast-entry pt ???
375 print OUTASM "\t\.text\n\t\.align 2\n";
377 $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
381 if ( defined($fastchk{$symb}) ) {
382 $c = $chk[$fastchk{$symb}];
383 if ( ! defined($slowchk{$symb}) ) {
384 print OUTASM "\t\.text\n\t\.align 2\n";
387 $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
390 } elsif ( $chkcat[$i] eq 'vector'
391 || $chkcat[$i] eq 'direct' ) { # do them in that order
392 $symb = $chksymb[$i];
395 if ( defined($vectorchk{$symb}) ) {
396 print OUTASM "\t\.text\n\t\.align 2\n";
397 print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
398 # direct return code will be put here!
399 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
403 if ( defined($directchk{$symb}) ) {
404 print OUTASM "\t\.text\n\t\.align 2\n";
405 print OUTASM $chk[$directchk{$symb}];
406 $chkcat[$directchk{$symb}] = 'DONE ALREADY';
408 # The commented nop is for the splitter, to ensure
409 # that no module ends with a label as the very last
410 # thing. (The linker will adjust the label to point
411 # to the first code word of the next module linked in,
412 # even if alignment constraints cause the label to move!)
414 print OUTASM "\t# nop\n";
417 &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm alpha)\n$chkcat[$i]\n$chk[$i]\n");
421 print OUTASM $EXTERN_DECLS;
424 close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
425 close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
430 sub init_FUNNY_THINGS {
431 %KNOWN_FUNNY_THING = (
433 'CommonUnderflow:', 1,
436 'ErrorIO_call_count:', 1,
437 'ErrorIO_innards:', 1,
448 'StackUnderflowEnterNode:', 1,
450 'UnderflowVect0:', 1,
451 'UnderflowVect1:', 1,
452 'UnderflowVect2:', 1,
453 'UnderflowVect3:', 1,
454 'UnderflowVect4:', 1,
455 'UnderflowVect5:', 1,
456 'UnderflowVect6:', 1,
457 'UnderflowVect7:', 1,
460 'WorldStateToken:', 1,
461 '_Enter_Internal:', 1,
462 '_PRMarking_MarkNextAStack:', 1,
463 '_PRMarking_MarkNextBStack:', 1,
464 '_PRMarking_MarkNextCAF:', 1,
465 '_PRMarking_MarkNextGA:', 1,
466 '_PRMarking_MarkNextRoot:', 1,
467 '_PRMarking_MarkNextSpark:', 1,
468 '_Scavenge_Forward_Ref:', 1,
469 '__std_entry_error__:', 1,
470 '_startMarkWorld:', 1,
472 'startCcRegisteringWorld:', 1,
473 'startEnterFloat:', 1,
475 'startPerformIO:', 1,
482 The following table reversal is used for both info tables and return
483 vectors. In both cases, we remove the first entry from the table,
484 reverse the table, put the label at the end, and paste some code
485 (that which is normally referred to by the first entry in the table)
486 right after the table itself. (The code pasting is done elsewhere.)
490 local($symb, $tbl, $discard1) = @_;
496 local(@lines) = split(/\n/, $tbl);
499 for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t\.word\s+/; $i++) {
500 $label .= $lines[$i] . "\n",
501 next if $lines[$i] =~ /^[A-Za-z0-9_]+:$/
502 || $lines[$i] =~ /^\t\.globl/;
504 $before .= $lines[$i] . "\n"; # otherwise...
507 for ( ; $i <= $#lines && $lines[$i] =~ /^\t\.word\s+/; $i++) {
508 push(@words, $lines[$i]);
510 # now throw away the first word (entry code):
511 shift(@words) if $discard1;
513 for (; $i <= $#lines; $i++) {
514 $after .= $lines[$i] . "\n";
517 $tbl = $before . join("\n", (reverse @words)) . "\n" . $label . $after;
519 # print STDERR "before=$before\n";
520 # print STDERR "label=$label\n";
521 # print STDERR "words=",(reverse @words),"\n";
522 # print STDERR "after=$after\n";
527 # make "require"r happy...