ghc/driver/ghc-asm-m68k.lprl

   1 %************************************************************************
   2 %*                                                                      *
   3 \section[Driver-asm-fiddling]{Fiddling with assembler files (m68k)}
   4 %*                                                                      *
   5 %************************************************************************
   6
   7 Tasks:
   8 \begin{itemize}
   9 \item
  10 Utterly stomp out C functions' prologues and epilogues; i.e., the
  11 stuff to do with the C stack.
  12 \item
  13 Any other required tidying up.
  14 \end{itemize}
  15
  16 \begin{code}
  17 sub mangle_asm {
  18     local($in_asmf, $out_asmf) = @_;
  19
  20     # multi-line regexp matching:
  21     local($*) = 1;
  22     local($i, $c);
  23     &init_FUNNY_THINGS();
  24
  25     open(INASM, "< $in_asmf")
  26         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
  27     open(OUTASM,"> $out_asmf")
  28         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
  29
  30     # read whole file, divide into "chunks":
  31     #   record some info about what we've found...
  32
  33     @chk = ();          # contents of the chunk
  34     $numchks = 0;       # number of them
  35     @chkcat = ();       # what category of thing in each chunk
  36     @chksymb = ();      # what symbol(base) is defined in this chunk
  37     %slowchk = ();      # ditto, its regular "slow" entry code
  38     %fastchk = ();      # ditto, fast entry code
  39     %closurechk = ();   # ditto, the (static) closure
  40     %infochk = ();      # given a symbol base, say what chunk its info tbl is in
  41     %vectorchk = ();    # ditto, return vector table
  42     %directchk = ();    # ditto, direct return code
  43
  44     $i = 0;
  45     $chkcat[0] = 'misc';
  46
  47     while (<INASM>) {
  48         next if /^\.stab.*___stg_split_marker/;
  49         next if /^\.stab.*ghc.*c_ID/;
  50         next if /^#(NO_)?APP/;
  51
  52         if ( /^\s+/ ) { # most common case first -- a simple line!
  53             # duplicated from the bottom
  54
  55             $chk[$i] .= $_;
  56
  57         } elsif ( /^LC(\d+):$/ ) {
  58             $chk[++$i] .= $_;
  59             $chkcat[$i] = 'string';
  60             $chksymb[$i] = $1;
  61
  62         } elsif ( /^___stg_split_marker(\d+):$/ ) {
  63             $chk[++$i] .= $_;
  64             $chkcat[$i] = 'splitmarker';
  65             $chksymb[$i] = $1;
  66
  67         } elsif ( /^_([A-Za-z0-9_]+)_info:$/ ) {
  68             $symb = $1;
  69             $chk[++$i] .= $_;
  70             $chkcat[$i] = 'infotbl';
  71             $chksymb[$i] = $symb;
  72
  73             die "Info table already? $symb; $i\n" if defined($infochk{$symb});
  74
  75             $infochk{$symb} = $i;
  76
  77         } elsif ( /^_([A-Za-z0-9_]+)_entry:$/ ) {
  78             $chk[++$i] .= $_;
  79             $chkcat[$i] = 'slow';
  80             $chksymb[$i] = $1;
  81
  82             $slowchk{$1} = $i;
  83
  84         } elsif ( /^_([A-Za-z0-9_]+)_fast\d+:$/ ) {
  85             $chk[++$i] .= $_;
  86             $chkcat[$i] = 'fast';
  87             $chksymb[$i] = $1;
  88
  89             $fastchk{$1} = $i;
  90
  91         } elsif ( /^_([A-Za-z0-9_]+)_closure:$/ ) {
  92             $chk[++$i] .= $_;
  93             $chkcat[$i] = 'closure';
  94             $chksymb[$i] = $1;
  95
  96             $closurechk{$1} = $i;
  97
  98         } elsif ( /^_ghc.*c_ID:/ ) {
  99             $chk[++$i] .= $_;
 100             $chkcat[$i] = 'consist';
 101
 102         } elsif ( /^(___gnu_compiled_c|gcc2_compiled\.):/ ) {
 103             ; # toss it
 104
 105         } elsif ( /^_ErrorIO_call_count:/        # HACK!!!!
 106                || /^_[A-Za-z0-9_]+\.\d+:$/
 107                || /^_.*_CAT:/                   # PROF: _entryname_CAT
 108                || /^_CC_.*_struct:/             # PROF: _CC_ccident_struct
 109                || /^_.*_done:/                  # PROF: _module_done
 110                || /^__module_registered:/       # PROF: _module_registered
 111                ) {
 112             $chk[++$i] .= $_;
 113             $chkcat[$i] = 'data';
 114             $chksymb[$i] = '';
 115
 116         } elsif ( /^_(ret_|djn_)/ ) {
 117             $chk[++$i] .= $_;
 118             $chkcat[$i] = 'misc';
 119             $chksymb[$i] = '';
 120
 121         } elsif ( /^_vtbl_([A-Za-z0-9_]+):$/ ) {
 122             $chk[++$i] .= $_;
 123             $chkcat[$i] = 'vector';
 124             $chksymb[$i] = $1;
 125
 126             $vectorchk{$1} = $i;
 127
 128         } elsif ( /^_([A-Za-z0-9_]+)DirectReturn:$/ ) {
 129             $chk[++$i] .= $_;
 130             $chkcat[$i] = 'direct';
 131             $chksymb[$i] = $1;
 132
 133             $directchk{$1} = $i;
 134
 135         } elsif ( /^_[A-Za-z0-9_]+_upd:$/ ) {
 136             $chk[++$i] .= $_;
 137             $chkcat[$i] = 'misc';
 138             $chksymb[$i] = '';
 139
 140         } elsif ( /^_[A-Za-z0-9_]/ ) {
 141             local($thing);
 142             chop($thing = $_);
 143             print STDERR "Funny global thing?: $_"
 144                 unless $KNOWN_FUNNY_THING{$thing}
 145                     || /^__(PRIn|PRStart).*:/   # pointer reversal GC routines
 146                     || /^_CC_.*:/               # PROF: _CC_ccident
 147                     || /^__reg.*:/;             # PROF: __reg<module>
 148             $chk[++$i] .= $_;
 149             $chkcat[$i] = 'misc';
 150             $chksymb[$i] = '';
 151
 152         } else { # simple line (duplicated at the top)
 153
 154             $chk[$i] .= $_;
 155         }
 156     }
 157     $numchks = $#chk + 1;
 158
 159     # the division into chunks is imperfect;
 160     # we throw some things over the fence into the next
 161     # chunk.
 162     #
 163     # also, there are things we would like to know
 164     # about the whole module before we start spitting
 165     # output.
 166
 167     # NB: we start meddling at chunk 1, not chunk 0
 168
 169     for ($i = 1; $i < $numchks; $i++) {
 170         $c = $chk[$i]; # convenience copy
 171
 172 #       print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
 173
 174         # toss all prologue stuff;
 175         # be slightly paranoid to make sure there's
 176         # nothing surprising in there
 177         if ( $c =~ /--- BEGIN ---/ ) {
 178             if (($p, $r) = split(/--- BEGIN ---/, $c)) {
 179                 $p =~ s/^\tlink a6,#-?\d.*\n//;
 180                 $p =~ s/^\tmovel d2,sp\@-\n//;
 181                 $p =~ s/^\tmovel d5,sp\@-\n//; # SMmark.* only?
 182                 $p =~ s/^\tmoveml \#0x[0-9a-f]+,sp\@-\n//; # SMmark.* only?
 183                 die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/;
 184
 185                 # glue together what's left
 186                 $c = $p . $r;
 187             }
 188         }
 189
 190         # toss all epilogue stuff; again, paranoidly
 191         if ( $c =~ /--- END ---/ ) {
 192             if (($r, $e) = split(/--- END ---/, $c)) {
 193                 $e =~ s/^\tunlk a6\n//;
 194                 $e =~ s/^\trts\n//;
 195                 die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/;
 196
 197                 # glue together what's left
 198                 $c = $r . $e;
 199             }
 200         }
 201
 202         # toss all calls to __DISCARD__
 203         $c =~ s/^\tjbsr ___DISCARD__\n//g;
 204
 205         # toss stack adjustment after DoSparks
 206         $c =~ s/^(\tjbsr _DoSparks\n)\taddqw #8,sp/$1/g;
 207
 208         # pin a funny end-thing on (for easier matching):
 209         $c .= 'FUNNY#END#THING';
 210
 211         # pick some end-things and move them to the next chunk
 212
 213         while ( $c =~ /^\s*(\.align\s+\d+\n|\.proc\s+\d+\n|\.const\n|\.cstring\n|\.globl\s+\S+\n|\.text\n|\.data\n|\.even\n|\.stab[^n].*\n)FUNNY#END#THING/ ) {
 214             $to_move = $1;
 215
 216             if ( $to_move =~ /\.(globl|proc|stab)/ && $i < ($numchks - 1) ) {
 217                 $chk[$i + 1] = $to_move . $chk[$i + 1];
 218                 # otherwise they're tossed
 219             }
 220
 221             $c =~ s/^.*\nFUNNY#END#THING/FUNNY#END#THING/;
 222         }
 223
 224         $c =~ s/FUNNY#END#THING//;
 225         $chk[$i] = $c; # update w/ convenience copy
 226     }
 227
 228     # print out all the literal strings first
 229     for ($i = 0; $i < $numchks; $i++) {
 230         if ( $chkcat[$i] eq 'string' ) {
 231             print OUTASM "\.text\n\t\.even\n";
 232             print OUTASM $chk[$i];
 233
 234             $chkcat[$i] = 'DONE ALREADY';
 235         }
 236     }
 237
 238     for ($i = 0; $i < $numchks; $i++) {
 239 #       print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
 240
 241         next if $chkcat[$i] eq 'DONE ALREADY';
 242
 243         if ( $chkcat[$i] eq 'misc' ) {
 244             print OUTASM "\.text\n\t\.even\n";
 245             print OUTASM $chk[$i];
 246
 247         } elsif ( $chkcat[$i] eq 'data' ) {
 248             print OUTASM "\.data\n\t\.even\n";
 249             print OUTASM $chk[$i];
 250
 251         } elsif ( $chkcat[$i] eq 'consist' ) {
 252             if ( $chk[$i] =~ /\.ascii.*\)(hsc|cc) (.*)\\11"\n\t\.ascii\s+"(.*)\\0"/ ) {
 253                 local($consist) = "$1.$2.$3";
 254                 $consist =~ s/,/./g;
 255                 $consist =~ s/\//./g;
 256                 $consist =~ s/-/_/g;
 257                 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
 258                 print OUTASM "\.text\n$consist:\n";
 259             } else {
 260                 print STDERR "Couldn't grok consistency: ", $chk[$i];
 261             }
 262
 263         } elsif ( $chkcat[$i] eq 'splitmarker' ) {
 264             # we can just re-constitute this one...
 265             print OUTASM "___stg_split_marker",$chksymb[$i],":\n";
 266
 267         } elsif ( $chkcat[$i] eq 'closure'
 268                || $chkcat[$i] eq 'infotbl'
 269                || $chkcat[$i] eq 'slow'
 270                || $chkcat[$i] eq 'fast' ) { # do them in that order
 271             $symb = $chksymb[$i];
 272
 273             # CLOSURE
 274             if ( defined($closurechk{$symb}) ) {
 275                 print OUTASM "\.data\n\t\.even\n";
 276                 print OUTASM $chk[$closurechk{$symb}];
 277                 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
 278             }
 279
 280             # INFO TABLE
 281             if ( defined($infochk{$symb}) ) {
 282
 283                 print OUTASM "\.text\n\t\.even\n";
 284                 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
 285                 # entry code will be put here!
 286
 287                 # paranoia
 288                 if ( $chk[$infochk{$symb}] =~ /\.long\s+([A-Za-z0-9_]+_entry)$/
 289                   && $1 ne "_${symb}_entry" ) {
 290                     print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
 291                 }
 292
 293                 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
 294             }
 295
 296             # STD ENTRY POINT
 297             if ( defined($slowchk{$symb}) ) {
 298
 299                 # teach it to drop through to the fast entry point:
 300                 $c = $chk[$slowchk{$symb}];
 301
 302                 if ( defined($fastchk{$symb}) ) {
 303                     $c =~ s/^\tjmp _${symb}_fast\d+.*\n\tnop\n//;
 304                     $c =~ s/^\tjmp _${symb}_fast\d+.*\n//;
 305                 }
 306
 307                 print STDERR "still has jump to fast entry point:\n$c"
 308                     if $c =~ /_${symb}_fast/; # NB: paranoia
 309
 310                 print OUTASM "\.text\n\t\.even\n";
 311                 print OUTASM $c;
 312                 $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
 313             }
 314
 315             # FAST ENTRY POINT
 316             if ( defined($fastchk{$symb}) ) {
 317                 print OUTASM "\.text\n\t\.even\n";
 318                 print OUTASM $chk[$fastchk{$symb}];
 319                 $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
 320             }
 321
 322         } elsif ( $chkcat[$i] eq 'vector'
 323                || $chkcat[$i] eq 'direct' ) { # do them in that order
 324             $symb = $chksymb[$i];
 325
 326             # VECTOR TABLE
 327             if ( defined($vectorchk{$symb}) ) {
 328                 print OUTASM "\.text\n\t\.even\n";
 329                 print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
 330                 # direct return code will be put here!
 331                 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
 332             }
 333
 334             # DIRECT RETURN
 335             if ( defined($directchk{$symb}) ) {
 336                 print OUTASM "\.text\n\t\.even\n";
 337                 print OUTASM $chk[$directchk{$symb}];
 338                 $chkcat[$directchk{$symb}] = 'DONE ALREADY';
 339             }
 340
 341         } else {
 342             &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm m68k)\n$chkcat[$i]\n$chk[$i]\n");
 343         }
 344     }
 345
 346     # finished:
 347     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
 348     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
 349 }
 350 \end{code}
 351
 352 \begin{code}
 353 sub init_FUNNY_THINGS {
 354     %KNOWN_FUNNY_THING = (
 355         '_CheckHeapCode:', 1,
 356         '_CommonUnderflow:', 1,
 357         '_Continue:', 1,
 358         '_EnterNodeCode:', 1,
 359         '_ErrorIO_call_count:', 1,
 360         '_ErrorIO_innards:', 1,
 361         '_IndUpdRetDir:', 1,
 362         '_IndUpdRetV0:', 1,
 363         '_IndUpdRetV1:', 1,
 364         '_IndUpdRetV2:', 1,
 365         '_IndUpdRetV3:', 1,
 366         '_IndUpdRetV4:', 1,
 367         '_IndUpdRetV5:', 1,
 368         '_IndUpdRetV6:', 1,
 369         '_IndUpdRetV7:', 1,
 370         '_PrimUnderflow:', 1,
 371         '_StackUnderflowEnterNode:', 1,
 372         '_StdErrorCode:', 1,
 373         '_UnderflowVect0:', 1,
 374         '_UnderflowVect1:', 1,
 375         '_UnderflowVect2:', 1,
 376         '_UnderflowVect3:', 1,
 377         '_UnderflowVect4:', 1,
 378         '_UnderflowVect5:', 1,
 379         '_UnderflowVect6:', 1,
 380         '_UnderflowVect7:', 1,
 381         '_UpdErr:', 1,
 382         '_UpdatePAP:', 1,
 383         '_WorldStateToken:', 1,
 384         '__Enter_Internal:', 1,
 385         '__PRMarking_MarkNextAStack:', 1,
 386         '__PRMarking_MarkNextBStack:', 1,
 387         '__PRMarking_MarkNextCAF:', 1,
 388         '__PRMarking_MarkNextGA:', 1,
 389         '__PRMarking_MarkNextRoot:', 1,
 390         '__PRMarking_MarkNextSpark:', 1,
 391         '__Scavenge_Forward_Ref:', 1,
 392         '___std_entry_error__:', 1,
 393         '__startMarkWorld:', 1,
 394         '_resumeThread:', 1,
 395         '_startCcRegisteringWorld:', 1,
 396         '_startEnterFloat:', 1,
 397         '_startEnterInt:', 1,
 398         '_startPerformIO:', 1,
 399         '_startStgWorld:', 1,
 400         '_stopPerformIO:', 1
 401     );
 402 }
 403 \end{code}
 404
 405 The following table reversal is used for both info tables and return
 406 vectors.  In both cases, we remove the first entry from the table,
 407 reverse the table, put the label at the end, and paste some code
 408 (that which is normally referred to by the first entry in the table)
 409 right after the table itself.  (The code pasting is done elsewhere.)
 410
 411 \begin{code}
 412 sub rev_tbl {
 413     local($symb, $tbl, $discard1) = @_;
 414
 415     local($before) = '';
 416     local($label) = '';
 417     local(@words) = ();
 418     local($after) = '';
 419     local(@lines) = split(/\n/, $tbl);
 420     local($i);
 421
 422     for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t\.long\s+/; $i++) {
 423         $label .= $lines[$i] . "\n",
 424             next if $lines[$i] =~ /^[A-Za-z0-9_]+_info:$/
 425                  || $lines[$i] =~ /^\.globl/
 426                  || $lines[$i] =~ /^_vtbl_\S+:$/;
 427
 428         $before .= $lines[$i] . "\n"; # otherwise...
 429     }
 430
 431     for ( ; $i <= $#lines && $lines[$i] =~ /^\t\.long\s+/; $i++) {
 432         push(@words, $lines[$i]);
 433     }
 434     # now throw away the first word (entry code):
 435     shift(@words) if $discard1;
 436
 437     for (; $i <= $#lines; $i++) {
 438         $after .= $lines[$i] . "\n";
 439     }
 440
 441     $tbl = $before . join("\n", (reverse @words)) . "\n" . $label . $after;
 442
 443 #   print STDERR "before=$before\n";
 444 #   print STDERR "label=$label\n";
 445 #   print STDERR "words=",(reverse @words),"\n";
 446 #   print STDERR "after=$after\n";
 447
 448     $tbl;
 449 }
 450 \end{code}
 451
 452 %************************************************************************
 453 %*                                                                      *
 454 \subsection[Driver-asm-info]{Collect interesting (static) info from an assembler file}
 455 %*                                                                      *
 456 %************************************************************************
 457
 458 How many times is each asm instruction used?
 459
 460 \begin{code}
 461 %AsmInsn = (); # init
 462
 463 sub dump_asm_insn_counts {
 464     local($asmf) = @_;
 465
 466     open(INASM, "< $asmf")  || &tidy_up_and_die(1,"$Pgm: failed to open `$asmf' (to read)\n");
 467     while (<INASM>) {
 468         if ( /^\t([a-z][a-z0-9]+)\b/ ) {
 469             $AsmInsn{$1} ++;
 470         }
 471     }
 472     close(INASM) || &tidy_up_and_die(1,"Failed reading from $asmf\n");
 473
 474     # OK, now print what we collected (to stderr)
 475     foreach $i (sort (keys %AsmInsn)) {
 476         print STDERR "INSN:: $i\t",$AsmInsn{$i},"\n";
 477     }
 478 }
 479
 480 sub dump_asm_globals_info {
 481 }
 482
 483 # make "require"r happy...
 484 1;
 485
 486 \end{code}