ghc/driver/ghc-asm-alpha.lprl

   1 %************************************************************************
   2 %*                                                                      *
   3 \section[Driver-asm-fiddling]{Fiddling with assembler files (alpha)}
   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
  51         next if /^\s*$/;
  52
  53         if ( /^\s+/ ) { # most common case first -- a simple line!
  54             # duplicated from the bottom
  55             $chk[$i] .= $_;
  56
  57         } elsif ( /\.\.ng:$/ ) { # Local labels not to be confused with new chunks
  58             $chk[$i] .= $_;
  59
  60         } elsif ( /^(ret_|djn_)/ ) {
  61             $chk[++$i] .= $_;
  62             $chkcat[$i] = 'misc';
  63             $chksymb[$i] = '';
  64
  65         } elsif ( /^vtbl_([A-Za-z0-9_]+):$/ ) {
  66             $chk[++$i] .= $_;
  67             $chkcat[$i] = 'vector';
  68             $chksymb[$i] = $1;
  69
  70             $vectorchk{$1} = $i;
  71
  72         } elsif ( /^([A-Za-z0-9_]+)DirectReturn:$/ ) {
  73             $chk[++$i] .= $_;
  74             $chkcat[$i] = 'direct';
  75             $chksymb[$i] = $1;
  76
  77             $directchk{$1} = $i;
  78
  79         } elsif ( /^[A-Za-z0-9_]+_upd:$/ ) {
  80             $chk[++$i] .= $_;
  81             $chkcat[$i] = 'misc';
  82             $chksymb[$i] = '';
  83
  84         } elsif ( /^\$C(\d+):$/ ) {
  85             $chk[++$i] .= $_;
  86             $chkcat[$i] = 'string';
  87             $chksymb[$i] = $1;
  88
  89         } elsif ( /^__stg_split_marker(\d+):$/ ) {
  90             $chk[++$i] .= $_;
  91             $chkcat[$i] = 'splitmarker';
  92             $chksymb[$i] = $1;
  93
  94         } elsif ( /^([A-Za-z0-9_]+)_info:$/ ) {
  95             $symb = $1;
  96             $chk[++$i] .= $_;
  97             $chkcat[$i] = 'infotbl';
  98             $chksymb[$i] = $symb;
  99
 100             $infochk{$symb} = $i;
 101
 102         } elsif ( /^([A-Za-z0-9_]+)_entry:$/ ) {
 103             $chk[++$i] .= $_;
 104             $chkcat[$i] = 'slow';
 105             $chksymb[$i] = $1;
 106
 107             $slowchk{$1} = $i;
 108
 109         } elsif ( /^([A-Za-z0-9_]+)_fast\d+:$/ ) {
 110             $chk[++$i] .= $_;
 111             $chkcat[$i] = 'fast';
 112             $chksymb[$i] = $1;
 113
 114             $fastchk{$1} = $i;
 115
 116         } elsif ( /^([A-Za-z0-9_]+)_closure:$/ ) {
 117             $chk[++$i] .= $_;
 118             $chkcat[$i] = 'closure';
 119             $chksymb[$i] = $1;
 120
 121             $closurechk{$1} = $i;
 122
 123         } elsif ( /^ghc.*c_ID:/ ) {
 124             $chk[++$i] .= $_;
 125             $chkcat[$i] = 'consist';
 126
 127         } elsif ( /^(__gnu_compiled_c|gcc2_compiled\.):/ ) {
 128             ; # toss it
 129
 130         } elsif ( /^ErrorIO_call_count:/         # HACK!!!!
 131                || /^[A-Za-z0-9_]+\.\d+:$/
 132                || /^.*_CAT:/                    # PROF: _entryname_CAT
 133                || /^CC_.*_struct:/              # PROF: _CC_ccident_struct
 134                || /^.*_done:/                   # PROF: _module_done
 135                || /^_module_registered:/        # PROF: _module_registered
 136                ) {
 137             $chk[++$i] .= $_;
 138             $chkcat[$i] = 'data';
 139             $chksymb[$i] = '';
 140
 141         } elsif ( /^[A-Za-z0-9_]/ ) {
 142             local($thing);
 143             chop($thing = $_);
 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>
 149             $chk[++$i] .= $_;
 150             $chkcat[$i] = 'misc';
 151             $chksymb[$i] = '';
 152
 153         } else { # simple line (duplicated at the top)
 154             $chk[$i] .= $_;
 155         }
 156     }
 157     $numchks = $#chk + 1;
 158
 159 #    print STDERR "\nCLOSURES:\n";
 160 #    foreach $s (sort (keys %closurechk)) {
 161 #       print STDERR "$s:\t\t",$closurechk{$s},"\n";
 162 #    }
 163 #    print STDERR "\nINFOS:\n";
 164 #    foreach $s (sort (keys %infochk)) {
 165 #       print STDERR "$s:\t\t",$infochk{$s},"\n";
 166 #    }
 167 #    print STDERR "SLOWS:\n";
 168 #    foreach $s (sort (keys %slowchk)) {
 169 #       print STDERR "$s:\t\t",$slowchk{$s},"\n";
 170 #    }
 171 #    print STDERR "\nFASTS:\n";
 172 #    foreach $s (sort (keys %fastchk)) {
 173 #       print STDERR "$s:\t\t",$fastchk{$s},"\n";
 174 #    }
 175
 176     # the division into chunks is imperfect;
 177     # we throw some things over the fence into the next
 178     # chunk.
 179     #
 180     # also, there are things we would like to know
 181     # about the whole module before we start spitting
 182     # output.
 183
 184     # NB: we start meddling at chunk 1, not chunk 0
 185
 186     # the first ".rdata" is quite magical; as of GCC 2.7.x, it
 187     # spits a ".quad 0" in after the v first ".rdata"; we
 188     # detect this special case (tossing the ".quad 0")!
 189     $magic_rdata_seen = 0;
 190
 191     for ($i = 1; $i < $numchks; $i++) {
 192         $c = $chk[$i]; # convenience copy
 193
 194 #       print STDERR "\nCHK $i (BEFORE):\n", $c;
 195
 196         # pin a funny end-thing on (for easier matching):
 197         $c .= 'FUNNY#END#THING';
 198
 199         if ( ! $magic_rdata_seen && $c =~ /^\s*\.rdata\n\t\.quad 0\n\t\.align \d\n/ ) {
 200             $c =~ s/^\s*\.rdata\n\t\.quad 0\n\t\.align (\d)\n/\.rdata\n\t\.align $1\n/;
 201             $magic_rdata_seen = 1;
 202         }
 203
 204         # pick some end-things and move them to the next chunk
 205
 206         while ( $c =~ /^(\s*\.align\s+\d+\n)FUNNY#END#THING/
 207              || $c =~ /^(\s*\.(globl|ent)\s+\S+\n)FUNNY#END#THING/
 208              || $c =~ /^(\s*\#.*\n)FUNNY#END#THING/
 209              || $c =~ /^(\s*\.(file|loc)\s+\S+\s+\S+\n)FUNNY#END#THING/
 210              || $c =~ /^(\s*\.text\n|\s*\.r?data\n)FUNNY#END#THING/ ) {
 211             $to_move = $1;
 212
 213             if ( $to_move =~ /^\s*(\#|\.(file|globl|ent|loc))/ && $i < ($numchks - 1) ) {
 214                 $chk[$i + 1] = $to_move . $chk[$i + 1];
 215                 # otherwise they're tossed
 216             }
 217
 218             $c =~ s/^.*\nFUNNY#END#THING/FUNNY#END#THING/;
 219         }
 220
 221         if ($c =~ /^\t\.ent\s+(\S+)/) {
 222             $ent = $1;
 223             # toss all prologue stuff, except for loading gp, and the ..ng address
 224             if (($p, $r) = split(/^\t\.prologue/, $c)) {
 225 # print STDERR "$ent: prologue:\n$p\nrest:\n$r\n";
 226                 if (($keep, $junk) = split(/\.\.ng:/, $p)) {
 227                     $c = $keep . "..ng:\n";
 228                 } else {
 229                     print STDERR "malformed code block ($ent)?\n"
 230                 }
 231             }
 232             $c .= "\t.frame \$30,0,\$26,0\n\t.prologue" . $r;
 233         }
 234
 235         $c =~ s/FUNNY#END#THING//;
 236         $chk[$i] = $c; # update w/ convenience copy
 237
 238 #       print STDERR "\nCHK $i (AFTER):\n", $c;
 239     }
 240
 241     # print out the header stuff first
 242
 243     $chk[0] =~ s/^(\t\.file.*)"(ghc\d+\.c)"/\1"$ifile_root.hc"/;
 244     print OUTASM $chk[0];
 245
 246     # print out all the literal strings second
 247     for ($i = 1; $i < $numchks; $i++) {
 248         if ( $chkcat[$i] eq 'string' ) {
 249             print OUTASM "\.rdata\n\t\.align 3\n";
 250             print OUTASM $chk[$i];
 251
 252             $chkcat[$i] = 'DONE ALREADY';
 253         }
 254     }
 255
 256     for ($i = 1; $i < $numchks; $i++) {
 257 #       print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
 258
 259         next if $chkcat[$i] eq 'DONE ALREADY';
 260
 261         if ( $chkcat[$i] eq 'misc' ) {
 262             print OUTASM "\.text\n\t\.align 3\n";
 263             print OUTASM $chk[$i];
 264
 265         } elsif ( $chkcat[$i] eq 'data' ) {
 266             print OUTASM "\.data\n\t\.align 3\n";
 267             print OUTASM $chk[$i];
 268
 269         } elsif ( $chkcat[$i] eq 'consist' ) {
 270             if ( $chk[$i] =~ /\.ascii.*\)(hsc|cc) (.*)\\11"\n\t\.ascii\s+"(.*)\\0"/ ) {
 271                 local($consist) = "$1.$2.$3";
 272                 $consist =~ s/,/./g;
 273                 $consist =~ s/\//./g;
 274                 $consist =~ s/-/_/g;
 275                 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
 276                 print OUTASM "\.text\n$consist:\n";
 277             } else {
 278                 print STDERR "Couldn't grok consistency: ", $chk[$i];
 279             }
 280
 281         } elsif ( $chkcat[$i] eq 'splitmarker' ) {
 282             # we can just re-constitute this one...
 283             # ignore the final split marker, to save an empty object module
 284             # Use _three_ underscores so that ghc-split doesn't get overly complicated
 285             print OUTASM "___stg_split_marker",$chksymb[$i],":\n";
 286
 287         } elsif ( $chkcat[$i] eq 'closure'
 288                || $chkcat[$i] eq 'infotbl'
 289                || $chkcat[$i] eq 'slow'
 290                || $chkcat[$i] eq 'fast' ) { # do them in that order
 291             $symb = $chksymb[$i];
 292
 293             # CLOSURE
 294             if ( defined($closurechk{$symb}) ) {
 295                 print OUTASM "\.data\n\t\.align 3\n";
 296                 print OUTASM $chk[$closurechk{$symb}];
 297                 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
 298             }
 299
 300             # INFO TABLE
 301             if ( defined($infochk{$symb}) ) {
 302
 303                 print OUTASM "\.text\n\t\.align 3\n";
 304                 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
 305                 # entry code will be put here!
 306
 307                 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
 308             }
 309
 310             # STD ENTRY POINT
 311             if ( defined($slowchk{$symb}) ) {
 312
 313                 # teach it to drop through to the fast entry point:
 314                 $c = $chk[$slowchk{$symb}];
 315                 if ( defined($fastchk{$symb}) ) {
 316                     $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
 317                 }
 318
 319                 print OUTASM "\.text\n\t\.align 3\n";
 320                 print OUTASM $c;
 321                 $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
 322             }
 323
 324             # FAST ENTRY POINT
 325             if ( defined($fastchk{$symb}) ) {
 326                 $c = $chk[$fastchk{$symb}];
 327                 if ( ! defined($slowchk{$symb}) ) {
 328                     print OUTASM "\.text\n\t\.align 3\n";
 329                 }
 330                 print OUTASM $c;
 331                 $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
 332             }
 333
 334         } elsif ( $chkcat[$i] eq 'vector'
 335                || $chkcat[$i] eq 'direct' ) { # do them in that order
 336             $symb = $chksymb[$i];
 337
 338             # VECTOR TABLE
 339             if ( defined($vectorchk{$symb}) ) {
 340                 print OUTASM "\.text\n\t\.align 3\n";
 341                 print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
 342                 # direct return code will be put here!
 343                 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
 344             }
 345
 346             # DIRECT RETURN
 347             if ( defined($directchk{$symb}) ) {
 348                 print OUTASM "\.text\n\t\.align 3\n";
 349                 print OUTASM $chk[$directchk{$symb}];
 350                 $chkcat[$directchk{$symb}] = 'DONE ALREADY';
 351             } else {
 352                 # The commented nop is for the splitter, to ensure
 353                 # that no module ends with a label as the very last
 354                 # thing.  (The linker will adjust the label to point
 355                 # to the first code word of the next module linked in,
 356                 # even if alignment constraints cause the label to move!)
 357
 358                 print OUTASM "\t# nop\n";
 359             }
 360         } else {
 361             &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm alpha)\n$chkcat[$i]\n$chk[$i]\n");
 362         }
 363     }
 364
 365     # finished:
 366     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
 367     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
 368 }
 369 \end{code}
 370
 371 \begin{code}
 372 sub init_FUNNY_THINGS {
 373     %KNOWN_FUNNY_THING = (
 374         'CheckHeapCode:', 1,
 375         'CommonUnderflow:', 1,
 376         'Continue:', 1,
 377         'EnterNodeCode:', 1,
 378         'ErrorIO_call_count:', 1,
 379         'ErrorIO_innards:', 1,
 380         'IndUpdRetDir:', 1,
 381         'IndUpdRetV0:', 1,
 382         'IndUpdRetV1:', 1,
 383         'IndUpdRetV2:', 1,
 384         'IndUpdRetV3:', 1,
 385         'IndUpdRetV4:', 1,
 386         'IndUpdRetV5:', 1,
 387         'IndUpdRetV6:', 1,
 388         'IndUpdRetV7:', 1,
 389         'PrimUnderflow:', 1,
 390         'StackUnderflowEnterNode:', 1,
 391         'StdErrorCode:', 1,
 392         'UnderflowVect0:', 1,
 393         'UnderflowVect1:', 1,
 394         'UnderflowVect2:', 1,
 395         'UnderflowVect3:', 1,
 396         'UnderflowVect4:', 1,
 397         'UnderflowVect5:', 1,
 398         'UnderflowVect6:', 1,
 399         'UnderflowVect7:', 1,
 400         'UpdErr:', 1,
 401         'UpdatePAP:', 1,
 402         'WorldStateToken:', 1,
 403         '_Enter_Internal:', 1,
 404         '_PRMarking_MarkNextAStack:', 1,
 405         '_PRMarking_MarkNextBStack:', 1,
 406         '_PRMarking_MarkNextCAF:', 1,
 407         '_PRMarking_MarkNextGA:', 1,
 408         '_PRMarking_MarkNextRoot:', 1,
 409         '_PRMarking_MarkNextSpark:', 1,
 410         '_Scavenge_Forward_Ref:', 1,
 411         '__std_entry_error__:', 1,
 412         '_startMarkWorld:', 1,
 413         'resumeThread:', 1,
 414         'startCcRegisteringWorld:', 1,
 415         'startEnterFloat:', 1,
 416         'startEnterInt:', 1,
 417         'startPerformIO:', 1,
 418         'startStgWorld:', 1,
 419         'stopPerformIO:', 1
 420   );
 421 }
 422 \end{code}
 423
 424 The following table reversal is used for both info tables and return
 425 vectors.  In both cases, we remove the first entry from the table,
 426 reverse the table, put the label at the end, and paste some code
 427 (that which is normally referred to by the first entry in the table)
 428 right after the table itself.  (The code pasting is done elsewhere.)
 429
 430 \begin{code}
 431 sub rev_tbl {
 432     local($symb, $tbl, $discard1) = @_;
 433
 434     local($before) = '';
 435     local($label) = '';
 436     local(@words) = ();
 437     local($after) = '';
 438     local(@lines) = split(/\n/, $tbl);
 439     local($i);
 440
 441     for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t\.quad\s+/; $i++) {
 442         $label .= $lines[$i] . "\n",
 443             next if $lines[$i] =~ /^[A-Za-z0-9_]+:$/
 444                  || $lines[$i] =~ /^\t\.globl/;
 445
 446         $before .= $lines[$i] . "\n"; # otherwise...
 447     }
 448
 449     for ( ; $i <= $#lines && $lines[$i] =~ /^\t\.quad\s+/; $i++) {
 450         push(@words, $lines[$i]);
 451     }
 452     # now throw away the first word (entry code):
 453     shift(@words) if $discard1;
 454
 455     for (; $i <= $#lines; $i++) {
 456         $after .= $lines[$i] . "\n";
 457     }
 458
 459     # If we have anonymous text (not part of a procedure), the linker
 460     # may complain about missing exception information.  Bleh.
 461     if ($label =~ /^([A-Za-z0-9_]+):$/) {
 462         $before = "\t.ent $1\n" . $before;
 463         $after .= "\t.end $1\n";
 464     }
 465
 466     $tbl = $before . join("\n", (reverse @words)) . "\n" . $label . $after;
 467
 468 #    print STDERR "before=$before\n";
 469 #    print STDERR "label=$label\n";
 470 #    print STDERR "words=",(reverse @words),"\n";
 471 #    print STDERR "after=$after\n";
 472
 473     $tbl;
 474 }
 475 \end{code}
 476
 477 %************************************************************************
 478 %*                                                                      *
 479 \subsection[Driver-asm-info]{Collect interesting (static) info from an assembler file}
 480 %*                                                                      *
 481 %************************************************************************
 482
 483 How many times is each asm instruction used?
 484
 485 \begin{code}
 486 %AsmInsn = (); # init
 487
 488 sub dump_asm_insn_counts {
 489     local($asmf) = @_;
 490
 491     open(INASM, "< $asmf")  || &tidy_up_and_die(1,"$Pgm: failed to open `$asmf' (to read)\n");
 492     while (<INASM>) {
 493         if ( /^\t([a-z][a-z0-9]+)\b/ ) {
 494             $AsmInsn{$1} ++;
 495         }
 496     }
 497     close(INASM) || &tidy_up_and_die(1,"Failed reading from $asmf\n");
 498
 499     # OK, now print what we collected (to stderr)
 500     foreach $i (sort (keys %AsmInsn)) {
 501         print STDERR "INSN:: $i\t",$AsmInsn{$i},"\n";
 502     }
 503 }
 504
 505 sub dump_asm_globals_info {
 506 }
 507
 508 # make "require"r happy...
 509 1;
 510 \end{code}