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 ( /^(ret_|djn_)/ ) {
63 } elsif ( /^vtbl_([A-Za-z0-9_]+):$/ ) {
65 $chkcat[$i] = 'vector';
70 } elsif ( /^([A-Za-z0-9_]+)DirectReturn:$/ ) {
72 $chkcat[$i] = 'direct';
77 } elsif ( /^[A-Za-z0-9_]+_upd:$/ ) {
82 } elsif ( /^\$LC(\d+):$/ ) {
84 $chkcat[$i] = 'string';
87 } elsif ( /^__stg_split_marker(\d+):$/ ) {
89 $chkcat[$i] = 'splitmarker';
92 } elsif ( /^([A-Za-z0-9_]+)_info:$/ ) {
95 $chkcat[$i] = 'infotbl';
100 } elsif ( /^([A-Za-z0-9_]+)_entry:$/ ) {
102 $chkcat[$i] = 'slow';
107 } elsif ( /^([A-Za-z0-9_]+)_fast\d+:$/ ) {
109 $chkcat[$i] = 'fast';
114 } elsif ( /^([A-Za-z0-9_]+)_closure:$/ ) {
116 $chkcat[$i] = 'closure';
119 $closurechk{$1} = $i;
121 } elsif ( /^ghc.*c_ID:/ ) {
123 $chkcat[$i] = 'consist';
125 } elsif ( /^(__gnu_compiled_c|gcc2_compiled\.):/ ) {
128 } elsif ( /^ErrorIO_call_count:/ # HACK!!!!
129 || /^[A-Za-z0-9_]+\.\d+:$/
130 || /^.*_CAT:/ # PROF: _entryname_CAT
131 || /^CC_.*_struct:/ # PROF: _CC_ccident_struct
132 || /^.*_done:/ # PROF: _module_done
133 || /^_module_registered:/ # PROF: _module_registered
136 $chkcat[$i] = 'data';
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)
155 $numchks = $#chk + 1;
157 # print STDERR "\nCLOSURES:\n";
158 # foreach $s (sort (keys %closurechk)) {
159 # print STDERR "$s:\t\t",$closurechk{$s},"\n";
161 # print STDERR "\nINFOS:\n";
162 # foreach $s (sort (keys %infochk)) {
163 # print STDERR "$s:\t\t",$infochk{$s},"\n";
165 # print STDERR "SLOWS:\n";
166 # foreach $s (sort (keys %slowchk)) {
167 # print STDERR "$s:\t\t",$slowchk{$s},"\n";
169 # print STDERR "\nFASTS:\n";
170 # foreach $s (sort (keys %fastchk)) {
171 # print STDERR "$s:\t\t",$fastchk{$s},"\n";
174 # the division into chunks is imperfect;
175 # we throw some things over the fence into the next
178 # also, there are things we would like to know
179 # about the whole module before we start spitting
182 # NB: we start meddling at chunk 1, not chunk 0
184 for ($i = 1; $i < $numchks; $i++) {
185 $c = $chk[$i]; # convenience copy
187 # print STDERR "\nCHK $i (BEFORE):\n", $c;
189 # pin a funny end-thing on (for easier matching):
190 $c .= 'FUNNY#END#THING';
192 # pick some end-things and move them to the next chunk
194 while ( $c =~ /^(\s*\.align\s+\d+\n)FUNNY#END#THING/
195 || $c =~ /^(\s*\.(globl|ent)\s+\S+\n)FUNNY#END#THING/
196 || $c =~ /^(\s*\.text\n|\s*\.r?data\n)FUNNY#END#THING/ ) {
199 if ( $to_move =~ /\.(globl|ent)/ && $i < ($numchks - 1) ) {
200 $chk[$i + 1] = $to_move . $chk[$i + 1];
201 # otherwise they're tossed
204 $c =~ s/^.*\nFUNNY#END#THING/FUNNY#END#THING/;
207 # toss all prologue stuff;
208 # be slightly paranoid to make sure there's
209 # nothing surprising in there
210 if ( $c =~ /--- BEGIN ---/ ) {
211 if (($p, $r) = split(/--- BEGIN ---/, $c)) {
212 # the .frame/.mask/.fmask that we use is the same
213 # as that produced by GCC for miniInterpret; this
214 # gives GDB some chance of figuring out what happened
215 $FRAME = "\t.frame\t\$sp,2168,\$31\n\t.mask\t0x90000000,-4\n\t.fmask\t0x00000000,0\n";
216 $p =~ s/^\t\.(frame).*\n/__FRAME__/g;
217 $p =~ s/^\t\.(mask|fmask).*\n//g;
218 $p =~ s/^\t\.cprestore.*\n/\t\.cprestore 416\n/; # 16 + 100 4-byte args
219 $p =~ s/^\tsubu\t\$sp,\$sp,\d+\n//;
220 $p =~ s/^\tsw\t\$31,\d+\(\$sp\)\n//;
221 $p =~ s/^\tsw\t\$fp,\d+\(\$sp\)\n//;
222 $p =~ s/^\tsw\t\$28,\d+\(\$sp\)\n//;
223 $p =~ s/__FRAME__/$FRAME/;
224 die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/;
226 # glue together what's left
228 $c =~ s/\n\t\n/\n/; # junk blank line
232 # toss all epilogue stuff; again, paranoidly;
233 # first, this basic sequence may occur "--- END ---" or not
234 $c =~ s/^\tlw\t\$31,\d+\(\$sp\)\n\taddu\t\$sp,\$sp,\d+\n\tj\t\$31\n\t\.end/\t\.end/;
236 if ( $c =~ /--- END ---/ ) {
237 if (($r, $e) = split(/--- END ---/, $c)) {
238 $e =~ s/^\tlw\t\$31,\d+\(\$sp\)\n//;
239 $e =~ s/^\tlw\t\$fp,\d+\(\$sp\)\n//;
240 $e =~ s/^\taddu\t\$sp,\$sp,\d+\n//;
241 $e =~ s/^\tj\t\$31\n//;
242 die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/;
244 # glue together what's left
246 $c =~ s/\n\t\n/\n/; # junk blank line
250 # toss all calls to __DISCARD__
251 $c =~ s/^\tjal\t__DISCARD__\n//g;
252 # that may leave some gratuitous asm macros around
253 # (no harm done; but we get rid of them to be tidier)
254 $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/;
256 $c =~ s/FUNNY#END#THING//;
257 $chk[$i] = $c; # update w/ convenience copy
259 print STDERR "NB: Contains magic stuff!\n$c\n" if $c =~ /^\t[^\.].*(\$28)\b/;
261 # print STDERR "\nCHK $i (AFTER):\n", $c;
265 # print out the header stuff first
266 $chk[0] = "\t\.file\t1 \"$ifile_root.hc\"\n" . $chk[0];
268 # get rid of horrible "$Revision: 1.1 $" strings
269 local(@lines0) = split(/\n/, $chk[0]);
271 while ( $z <= $#lines0 ) {
272 if ( $lines0[$z] =~ /^\t\.byte\t0x24,0x52,0x65,0x76,0x69,0x73,0x69,0x6f$/ ) {
275 while ( $z <= $#lines0 ) {
277 last if $lines0[$z] =~ /[,\t]0x0$/;
283 $chk[0] = join("\n", @lines0);
284 $chk[0] =~ s/\n\n+/\n/;
285 print OUTASM $chk[0];
287 # print out all the literal strings second
288 for ($i = 1; $i < $numchks; $i++) {
289 if ( $chkcat[$i] eq 'string' ) {
290 print OUTASM "\t\.rdata\n\t\.align 2\n";
291 print OUTASM $chk[$i];
293 $chkcat[$i] = 'DONE ALREADY';
297 for ($i = 1; $i < $numchks; $i++) {
298 # print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
300 next if $chkcat[$i] eq 'DONE ALREADY';
302 if ( $chkcat[$i] eq 'misc' ) {
303 print OUTASM "\t\.text\n\t\.align 2\n";
304 print OUTASM $chk[$i];
306 } elsif ( $chkcat[$i] eq 'data' ) {
307 print OUTASM "\t\.data\n\t\.align 2\n";
308 print OUTASM $chk[$i];
310 } elsif ( $chkcat[$i] eq 'consist' ) {
311 #? consistency string is just a v
312 #? horrible bunch of .bytes,
313 #? which I am too lazy to sort out (WDP 95/05)
314 #? if ( $chk[$i] =~ /\.ascii.*\)(hsc|cc) (.*)\\11"\n\t\.ascii\s+"(.*)\\0"/ ) {
315 #? local($consist) = "$1.$2.$3";
316 #? $consist =~ s/,/./g;
317 #? $consist =~ s/\//./g;
318 #? $consist =~ s/-/_/g;
319 #? $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
320 #? print OUTASM "\t\.text\n$consist:\n";
322 #? print STDERR "Couldn't grok consistency: ", $chk[$i];
325 } elsif ( $chkcat[$i] eq 'splitmarker' ) {
326 # we can just re-constitute this one...
327 # ignore the final split marker, to save an empty object module
328 # Use _three_ underscores so that ghc-split doesn't get overly complicated
329 print OUTASM "___stg_split_marker",$chksymb[$i],":\n";
331 } elsif ( $chkcat[$i] eq 'closure'
332 || $chkcat[$i] eq 'infotbl'
333 || $chkcat[$i] eq 'slow'
334 || $chkcat[$i] eq 'fast' ) { # do them in that order
335 $symb = $chksymb[$i];
338 if ( defined($closurechk{$symb}) ) {
339 print OUTASM "\t\.data\n\t\.align 2\n";
340 print OUTASM $chk[$closurechk{$symb}];
341 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
345 if ( defined($infochk{$symb}) ) {
347 print OUTASM "\t\.text\n\t\.align 2\n";
348 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
349 # entry code will be put here!
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/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
363 print OUTASM "\t\.text\n\t\.align 2\n";
365 $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
369 if ( defined($fastchk{$symb}) ) {
370 $c = $chk[$fastchk{$symb}];
371 if ( ! defined($slowchk{$symb}) ) {
372 print OUTASM "\t\.text\n\t\.align 2\n";
375 $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
378 } elsif ( $chkcat[$i] eq 'vector'
379 || $chkcat[$i] eq 'direct' ) { # do them in that order
380 $symb = $chksymb[$i];
383 if ( defined($vectorchk{$symb}) ) {
384 print OUTASM "\t\.text\n\t\.align 2\n";
385 print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
386 # direct return code will be put here!
387 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
391 if ( defined($directchk{$symb}) ) {
392 print OUTASM "\t\.text\n\t\.align 2\n";
393 print OUTASM $chk[$directchk{$symb}];
394 $chkcat[$directchk{$symb}] = 'DONE ALREADY';
396 # The commented nop is for the splitter, to ensure
397 # that no module ends with a label as the very last
398 # thing. (The linker will adjust the label to point
399 # to the first code word of the next module linked in,
400 # even if alignment constraints cause the label to move!)
402 print OUTASM "\t# nop\n";
405 &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm alpha)\n$chkcat[$i]\n$chk[$i]\n");
409 print OUTASM $EXTERN_DECLS;
412 close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
413 close(INASM) || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
418 sub init_FUNNY_THINGS {
419 %KNOWN_FUNNY_THING = (
421 'CommonUnderflow:', 1,
424 'ErrorIO_call_count:', 1,
425 'ErrorIO_innards:', 1,
436 'StackUnderflowEnterNode:', 1,
438 'UnderflowVect0:', 1,
439 'UnderflowVect1:', 1,
440 'UnderflowVect2:', 1,
441 'UnderflowVect3:', 1,
442 'UnderflowVect4:', 1,
443 'UnderflowVect5:', 1,
444 'UnderflowVect6:', 1,
445 'UnderflowVect7:', 1,
448 'WorldStateToken:', 1,
449 '_Enter_Internal:', 1,
450 '_PRMarking_MarkNextAStack:', 1,
451 '_PRMarking_MarkNextBStack:', 1,
452 '_PRMarking_MarkNextCAF:', 1,
453 '_PRMarking_MarkNextGA:', 1,
454 '_PRMarking_MarkNextRoot:', 1,
455 '_PRMarking_MarkNextSpark:', 1,
456 '_Scavenge_Forward_Ref:', 1,
457 '__std_entry_error__:', 1,
458 '_startMarkWorld:', 1,
460 'startCcRegisteringWorld:', 1,
461 'startEnterFloat:', 1,
463 'startPerformIO:', 1,
470 The following table reversal is used for both info tables and return
471 vectors. In both cases, we remove the first entry from the table,
472 reverse the table, put the label at the end, and paste some code
473 (that which is normally referred to by the first entry in the table)
474 right after the table itself. (The code pasting is done elsewhere.)
478 local($symb, $tbl, $discard1) = @_;
484 local(@lines) = split(/\n/, $tbl);
487 for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t\.word\s+/; $i++) {
488 $label .= $lines[$i] . "\n",
489 next if $lines[$i] =~ /^[A-Za-z0-9_]+:$/
490 || $lines[$i] =~ /^\t\.globl/;
492 $before .= $lines[$i] . "\n"; # otherwise...
495 for ( ; $i <= $#lines && $lines[$i] =~ /^\t\.word\s+/; $i++) {
496 push(@words, $lines[$i]);
498 # now throw away the first word (entry code):
499 shift(@words) if $discard1;
501 for (; $i <= $#lines; $i++) {
502 $after .= $lines[$i] . "\n";
505 $tbl = $before . join("\n", (reverse @words)) . "\n" . $label . $after;
507 # print STDERR "before=$before\n";
508 # print STDERR "label=$label\n";
509 # print STDERR "words=",(reverse @words),"\n";
510 # print STDERR "after=$after\n";
515 # make "require"r happy...