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 ( /^(ret_|djn_)/ ) {
  57             $chk[++$i] .= $_;
  58             $chkcat[$i] = 'misc';
  59             $chksymb[$i] = '';
  60
  61         } elsif ( /^vtbl_([A-Za-z0-9_]+):$/ ) {
  62             $chk[++$i] .= $_;
  63             $chkcat[$i] = 'vector';
  64             $chksymb[$i] = $1;
  65
  66             $vectorchk{$1} = $i;
  67
  68         } elsif ( /^([A-Za-z0-9_]+)DirectReturn:$/ ) {
  69             $chk[++$i] .= $_;
  70             $chkcat[$i] = 'direct';
  71             $chksymb[$i] = $1;
  72
  73             $directchk{$1} = $i;
  74
  75         } elsif ( /^[A-Za-z0-9_]+_upd:$/ ) {
  76             $chk[++$i] .= $_;
  77             $chkcat[$i] = 'misc';
  78             $chksymb[$i] = '';
  79
  80         } elsif ( /^\.LLC(\d+):$/ ) {
  81             $chk[++$i] .= $_;
  82             $chkcat[$i] = 'string';
  83             $chksymb[$i] = $1;
  84
  85         } elsif ( /^__stg_split_marker(\d+):$/ ) {
  86             $chk[++$i] .= $_;
  87             $chkcat[$i] = 'splitmarker';
  88             $chksymb[$i] = $1;
  89
  90         } elsif ( /^([A-Za-z0-9_]+)_info:$/ ) {
  91             $symb = $1;
  92             $chk[++$i] .= $_;
  93             $chkcat[$i] = 'infotbl';
  94             $chksymb[$i] = $symb;
  95
  96             $infochk{$symb} = $i;
  97
  98         } elsif ( /^([A-Za-z0-9_]+)_entry:$/ ) {
  99             $chk[++$i] .= $_;
 100             $chkcat[$i] = 'slow';
 101             $chksymb[$i] = $1;
 102
 103             $slowchk{$1} = $i;
 104
 105         } elsif ( /^([A-Za-z0-9_]+)_fast\d+:$/ ) {
 106             $chk[++$i] .= $_;
 107             $chkcat[$i] = 'fast';
 108             $chksymb[$i] = $1;
 109
 110             $fastchk{$1} = $i;
 111
 112         } elsif ( /^([A-Za-z0-9_]+)_closure:$/ ) {
 113             $chk[++$i] .= $_;
 114             $chkcat[$i] = 'closure';
 115             $chksymb[$i] = $1;
 116
 117             $closurechk{$1} = $i;
 118
 119         } elsif ( /^ghc.*c_ID:/ ) {
 120             $chk[++$i] .= $_;
 121             $chkcat[$i] = 'consist';
 122
 123         } elsif ( /^(__gnu_compiled_c|gcc2_compiled\.):/ ) {
 124             ; # toss it
 125
 126         } elsif ( /^ErrorIO_call_count:/         # HACK!!!!
 127                || /^[A-Za-z0-9_]+\.\d+:$/
 128                || /_CAT:/                       # PROF: _entryname_CAT
 129                || /^CC_.*_struct:/              # PROF: _CC_ccident_struct
 130                || /_done:/                      # PROF: _module_done
 131                || /^_module_registered:/        # PROF: _module_registered
 132                ) {
 133             $chk[++$i] .= $_;
 134             $chkcat[$i] = 'data';
 135             $chksymb[$i] = '';
 136
 137         } elsif ( /^[A-Za-z0-9_]/ ) {
 138             local($thing);
 139             chop($thing = $_);
 140             print STDERR "Funny global thing?: $_"
 141                 unless $KNOWN_FUNNY_THING{$thing}
 142                     || /^_(PRIn|PRStart).*:/    # pointer reversal GC routines
 143                     || /^CC_.*:/                # PROF: _CC_ccident
 144                     || /^_reg.*:/;              # PROF: __reg<module>
 145             $chk[++$i] .= $_;
 146             $chkcat[$i] = 'misc';
 147             $chksymb[$i] = '';
 148
 149         } else { # simple line (duplicated at the top)
 150
 151             $chk[$i] .= $_;
 152         }
 153     }
 154     $numchks = $#chk + 1;
 155
 156 #    print STDERR "\nCLOSURES:\n";
 157 #    foreach $s (sort (keys %closurechk)) {
 158 #       print STDERR "$s:\t\t",$closurechk{$s},"\n";
 159 #    }
 160 #    print STDERR "\nINFOS:\n";
 161 #    foreach $s (sort (keys %infochk)) {
 162 #       print STDERR "$s:\t\t",$infochk{$s},"\n";
 163 #    }
 164 #    print STDERR "SLOWS:\n";
 165 #    foreach $s (sort (keys %slowchk)) {
 166 #       print STDERR "$s:\t\t",$slowchk{$s},"\n";
 167 #    }
 168 #    print STDERR "\nFASTS:\n";
 169 #    foreach $s (sort (keys %fastchk)) {
 170 #       print STDERR "$s:\t\t",$fastchk{$s},"\n";
 171 #    }
 172
 173     # the division into chunks is imperfect;
 174     # we throw some things over the fence into the next
 175     # chunk.
 176     #
 177     # also, there are things we would like to know
 178     # about the whole module before we start spitting
 179     # output.
 180
 181     # NB: we start meddling at chunk 1, not chunk 0
 182
 183     for ($i = 1; $i < $numchks; $i++) {
 184         $c = $chk[$i]; # convenience copy
 185
 186 #       print STDERR "\nCHK $i (BEFORE):\n", $c;
 187
 188         # toss all reg-window stuff (save/restore/ret[l] s):
 189         $c =~ s/^\t(save .*|restore|ret|retl)\n//g;
 190         # throw away PROLOGUE comments
 191         $c =~ s/^\t!#PROLOGUE# 0\n\t!#PROLOGUE# 1\n//;
 192
 193         # pin a funny end-thing on (for easier matching):
 194         $c .= 'FUNNY#END#THING';
 195
 196         # pick some end-things and move them to the next chunk
 197
 198         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/ ) {
 199             $to_move = $1;
 200
 201             if ( $to_move =~ /\.(global|proc|stab)/ && $i < ($numchks - 1) ) {
 202                 $chk[$i + 1] = $to_move . $chk[$i + 1];
 203                 # otherwise they're tossed
 204             }
 205
 206             $c =~ s/^.*\nFUNNY#END#THING/FUNNY#END#THING/;
 207         }
 208
 209         $c =~ s/FUNNY#END#THING//;
 210         $chk[$i] = $c; # update w/ convenience copy
 211     }
 212
 213     # print out all the literal strings first
 214     for ($i = 0; $i < $numchks; $i++) {
 215         if ( $chkcat[$i] eq 'string' ) {
 216             print OUTASM "\.text\n\t\.align 8\n";
 217             print OUTASM $chk[$i];
 218
 219             $chkcat[$i] = 'DONE ALREADY';
 220         }
 221     }
 222
 223     for ($i = 1; $i < $numchks; $i++) {
 224 #       print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
 225
 226         next if $chkcat[$i] eq 'DONE ALREADY';
 227
 228         if ( $chkcat[$i] eq 'misc' ) {
 229             print OUTASM "\.text\n\t\.align 4\n";
 230             print OUTASM $chk[$i];
 231
 232         } elsif ( $chkcat[$i] eq 'data' ) {
 233             print OUTASM "\.data\n\t\.align 8\n";
 234             print OUTASM $chk[$i];
 235
 236         } elsif ( $chkcat[$i] eq 'consist' ) {
 237             if ( $chk[$i] =~ /\.asciz.*\)(hsc|cc) (.*)\\t(.*)"/ ) {
 238                 local($consist) = "$1.$2.$3";
 239                 $consist =~ s/,/./g;
 240                 $consist =~ s/\//./g;
 241                 $consist =~ s/-/_/g;
 242                 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
 243                 print OUTASM "\.text\n$consist:\n";
 244             } else {
 245                 print STDERR "Couldn't grok consistency: ", $chk[$i];
 246             }
 247
 248         } elsif ( $chkcat[$i] eq 'splitmarker' ) {
 249             # we can just re-constitute this one...
 250             print OUTASM "___stg_split_marker",$chksymb[$i],":\n";
 251
 252         } elsif ( $chkcat[$i] eq 'closure'
 253                || $chkcat[$i] eq 'infotbl'
 254                || $chkcat[$i] eq 'slow'
 255                || $chkcat[$i] eq 'fast' ) { # do them in that order
 256             $symb = $chksymb[$i];
 257
 258             # CLOSURE
 259             if ( defined($closurechk{$symb}) ) {
 260                 print OUTASM "\.data\n\t\.align 4\n";
 261                 print OUTASM $chk[$closurechk{$symb}];
 262                 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
 263             }
 264
 265             # INFO TABLE
 266             if ( defined($infochk{$symb}) ) {
 267
 268                 print OUTASM "\.text\n\t\.align 4\n";
 269                 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
 270                 # entry code will be put here!
 271
 272                 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
 273             }
 274
 275             # STD ENTRY POINT
 276             if ( defined($slowchk{$symb}) ) {
 277
 278                 # teach it to drop through to the fast entry point:
 279                 $c = $chk[$slowchk{$symb}];
 280                 $c =~ s/^\tcall _${symb}_fast\d+,.*\n\tnop\n//;
 281                 $c =~ s/^\tcall _${symb}_fast\d+,.*\n(\t[a-z].*\n)/\1/;
 282
 283                 print STDERR "still has jump to fast entry point:\n$c"
 284                     if $c =~ /_${symb}_fast/;
 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}