ghc/driver/ghc-asm-sparc.lprl

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