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