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