ghc/driver/ghc-asm.lprl

   1 %************************************************************************
   2 %*                                                                      *
   3 \section[Driver-asm-fiddling]{Fiddling with assembler files (iX86)}
   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 init_TARGET_STUFF {
  18
  19     if ( $TargetPlatform =~ /^i386-.*-linuxaout/ ) {
  20
  21     $T_STABBY       = 1; # 1 iff .stab things (usually if a.out format)
  22     $T_US           = '_'; # _ if symbols have an underscore on the front
  23     $T_DO_GC        = '_PerformGC_wrapper';
  24     $T_PRE_APP      = '^#'; # regexp that says what comes before APP/NO_APP
  25     $T_CONST_LBL    = '^LC(\d+):$';
  26     $T_POST_LBL     = ':';
  27     $T_PRE_LLBL_PAT = 'L';
  28     $T_PRE_LLBL     = 'L';
  29     $T_X86_BADJMP   = '^\tjmp [^L\*]';
  30
  31     $T_MOVE_DIRVS   = '^\s*(\.align\s+\d+(,0x90)?\n|\.globl\s+\S+\n|\.text\n|\.data\n|\.stab[^n].*\n)';
  32     $T_COPY_DIRVS   = '\.(globl|stab)';
  33     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
  34     $T_DOT_WORD     = '\.long';
  35     $T_HDR_string   = "\.text\n\t\.align 4\n"; # .align 4 is 486-cache friendly
  36     $T_HDR_misc     = "\.text\n\t\.align 4\n";
  37     $T_HDR_data     = "\.data\n\t\.align 2\n"; # ToDo: change align??
  38     $T_HDR_consist  = "\.text\n";
  39     $T_HDR_closure  = "\.data\n\t\.align 2\n"; # ToDo: change align?
  40     $T_HDR_info     = "\.text\n\t\.align 4\n"; # NB: requires padding
  41     $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
  42     $T_HDR_fast     = "\.text\n\t\.align 4\n";
  43     $T_HDR_vector   = "\.text\n\t\.align 4\n"; # NB: requires padding
  44     $T_HDR_direct   = "\.text\n\t\.align 4\n";
  45
  46     } elsif ( $TargetPlatform =~ /^i386-.*-solaris2/ ) {
  47
  48     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
  49     $T_US           = ''; # _ if symbols have an underscore on the front
  50     $T_DO_GC        = 'PerformGC_wrapper';
  51     $T_PRE_APP      = '/'; # regexp that says what comes before APP/NO_APP
  52     $T_CONST_LBL    = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
  53     $T_POST_LBL     = ':';
  54     $T_PRE_LLBL_PAT = '\.L';
  55     $T_PRE_LLBL     = '.L';
  56     $T_X86_BADJMP   = '^\tjmp [^\.\*]';
  57
  58     $T_MOVE_DIRVS   = '^\s*(\.align\s+\d+(,0x90)?\n|\.globl\s+\S+\n|\.text\n|\.data\n|\.section\s+.*\n|\.type\s+.*\n|\.Lfe.*\n\t\.size\s+.*\n|\.size\s+.*\n|\.ident.*\n)';
  59     $T_COPY_DIRVS   = '\.(globl)';
  60
  61     $T_hsc_cc_PAT   = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
  62     $T_DOT_WORD     = '\.long';
  63     $T_HDR_string   = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11)
  64     $T_HDR_misc     = "\.text\n\t\.align 16\n";
  65     $T_HDR_data     = "\.data\n\t\.align 4\n"; # ToDo: change align??
  66     $T_HDR_consist  = "\.text\n";
  67     $T_HDR_closure  = "\.data\n\t\.align 4\n"; # ToDo: change align?
  68     $T_HDR_info     = "\.text\n\t\.align 16\n"; # NB: requires padding
  69     $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
  70     $T_HDR_fast     = "\.text\n\t\.align 16\n";
  71     $T_HDR_vector   = "\.text\n\t\.align 16\n"; # NB: requires padding
  72     $T_HDR_direct   = "\.text\n\t\.align 16\n";
  73     }
  74
  75 if ( 0 ) {
  76 print STDERR "T_STABBY: $T_STABBY\n";
  77 print STDERR "T_US: $T_US\n";
  78 print STDERR "T_DO_GC: $T_DO_GC\n";
  79 print STDERR "T_PRE_APP: $T_PRE_APP\n";
  80 print STDERR "T_CONST_LBL: $T_CONST_LBL\n";
  81 print STDERR "T_POST_LBL: $T_POST_LBL\n";
  82 print STDERR "T_PRE_LLBL_PAT: $T_PRE_LLBL_PAT\n";
  83 print STDERR "T_PRE_LLBL: $T_PRE_LLBL\n";
  84 print STDERR "T_X86_BADJMP: $T_X86_BADJMP\n";
  85
  86 print STDERR "T_MOVE_DIRVS: $T_MOVE_DIRVS\n";
  87 print STDERR "T_COPY_DIRVS: $T_COPY_DIRVS\n";
  88 print STDERR "T_hsc_cc_PAT: $T_hsc_cc_PAT\n";
  89 print STDERR "T_DOT_WORD: $T_DOT_WORD\n";
  90 print STDERR "T_HDR_string: $T_HDR_string\n";
  91 print STDERR "T_HDR_misc: $T_HDR_misc\n";
  92 print STDERR "T_HDR_data: $T_HDR_data\n";
  93 print STDERR "T_HDR_consist: $T_HDR_consist\n";
  94 print STDERR "T_HDR_closure: $T_HDR_closure\n";
  95 print STDERR "T_HDR_info: $T_HDR_info\n";
  96 print STDERR "T_HDR_entry: $T_HDR_entry\n";
  97 print STDERR "T_HDR_fast: $T_HDR_fast\n";
  98 print STDERR "T_HDR_vector: $T_HDR_vector\n";
  99 print STDERR "T_HDR_direct: $T_HDR_direct\n";
 100 }
 101
 102 }
 103 \end{code}
 104
 105 \begin{code}
 106 sub mangle_asm {
 107     local($in_asmf, $out_asmf) = @_;
 108
 109     # multi-line regexp matching:
 110     local($*) = 1;
 111     local($i, $c);
 112     &init_TARGET_STUFF();
 113     &init_FUNNY_THINGS();
 114
 115     open(INASM, "< $in_asmf")
 116         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
 117     open(OUTASM,"> $out_asmf")
 118         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
 119
 120     # read whole file, divide into "chunks":
 121     #   record some info about what we've found...
 122
 123     @chk = ();          # contents of the chunk
 124     $numchks = 0;       # number of them
 125     @chkcat = ();       # what category of thing in each chunk
 126     @chksymb = ();      # what symbol(base) is defined in this chunk
 127     %slowchk = ();      # ditto, its regular "slow" entry code
 128     %fastchk = ();      # ditto, fast entry code
 129     %closurechk = ();   # ditto, the (static) closure
 130     %infochk = ();      # given a symbol base, say what chunk its info tbl is in
 131     %vectorchk = ();    # ditto, return vector table
 132     %directchk = ();    # ditto, direct return code
 133
 134     $i = 0;
 135     $chkcat[0] = 'misc';
 136
 137     while (<INASM>) {
 138         next if $T_STABBY && /^\.stab.*${T_US}__stg_split_marker/o;
 139         next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
 140         next if /${T_PRE_APP}(NO_)?APP/o;
 141
 142         if ( /^\s+/ ) { # most common case first -- a simple line!
 143             # duplicated from the bottom
 144
 145             $chk[$i] .= $_;
 146
 147         } elsif ( /$T_CONST_LBL/o ) {
 148             $chk[++$i] .= $_;
 149             $chkcat[$i] = 'string';
 150             $chksymb[$i] = $1;
 151
 152         } elsif ( /^${T_US}__stg_split_marker(\d+)${T_POST_LBL}$/o ) {
 153             $chk[++$i] .= $_;
 154             $chkcat[$i] = 'splitmarker';
 155             $chksymb[$i] = $1;
 156
 157         } elsif ( /^${T_US}([A-Za-z0-9_]+)_info${T_POST_LBL}$/o ) {
 158             $symb = $1;
 159             $chk[++$i] .= $_;
 160             $chkcat[$i] = 'infotbl';
 161             $chksymb[$i] = $symb;
 162
 163             die "Info table already? $symb; $i\n" if defined($infochk{$symb});
 164
 165             $infochk{$symb} = $i;
 166
 167         } elsif ( /^${T_US}([A-Za-z0-9_]+)_entry${T_POST_LBL}$/o ) {
 168             $chk[++$i] .= $_;
 169             $chkcat[$i] = 'slow';
 170             $chksymb[$i] = $1;
 171
 172             $slowchk{$1} = $i;
 173
 174         } elsif ( /^${T_US}([A-Za-z0-9_]+)_fast\d+${T_POST_LBL}$/o ) {
 175             $chk[++$i] .= $_;
 176             $chkcat[$i] = 'fast';
 177             $chksymb[$i] = $1;
 178
 179             $fastchk{$1} = $i;
 180
 181         } elsif ( /^${T_US}([A-Za-z0-9_]+)_closure${T_POST_LBL}$/o ) {
 182             $chk[++$i] .= $_;
 183             $chkcat[$i] = 'closure';
 184             $chksymb[$i] = $1;
 185
 186             $closurechk{$1} = $i;
 187
 188         } elsif ( /^${T_US}ghc.*c_ID${T_POST_LBL}/o ) {
 189             $chk[++$i] .= $_;
 190             $chkcat[$i] = 'consist';
 191
 192         } elsif ( /^(___gnu_compiled_c|gcc2_compiled\.)${T_POST_LBL}/o ) {
 193             ; # toss it
 194
 195         } elsif ( /^${T_US}ErrorIO_call_count${T_POST_LBL}$/o   # HACK!!!!
 196                || /^${T_US}[A-Za-z0-9_]+\.\d+${T_POST_LBL}$/o
 197                || /^${T_US}.*_CAT${T_POST_LBL}$/o               # PROF: _entryname_CAT
 198                || /^${T_US}CC_.*_struct${T_POST_LBL}$/o         # PROF: _CC_ccident_struct
 199                || /^${T_US}.*_done${T_POST_LBL}$/o              # PROF: _module_done
 200                || /^${T_US}_module_registered${T_POST_LBL}$/o   # PROF: _module_registered
 201                ) {
 202             $chk[++$i] .= $_;
 203             $chkcat[$i] = 'data';
 204             $chksymb[$i] = '';
 205
 206         } elsif ( /^${T_US}(ret_|djn_)/o ) {
 207             $chk[++$i] .= $_;
 208             $chkcat[$i] = 'misc';
 209             $chksymb[$i] = '';
 210
 211         } elsif ( /^${T_US}vtbl_([A-Za-z0-9_]+)${T_POST_LBL}$/o ) {
 212             $chk[++$i] .= $_;
 213             $chkcat[$i] = 'vector';
 214             $chksymb[$i] = $1;
 215
 216             $vectorchk{$1} = $i;
 217
 218         } elsif ( /^${T_US}([A-Za-z0-9_]+)DirectReturn${T_POST_LBL}$/o ) {
 219             $chk[++$i] .= $_;
 220             $chkcat[$i] = 'direct';
 221             $chksymb[$i] = $1;
 222
 223             $directchk{$1} = $i;
 224
 225         } elsif ( /^${T_US}[A-Za-z0-9_]+_upd${T_POST_LBL}$/o ) {
 226             $chk[++$i] .= $_;
 227             $chkcat[$i] = 'misc';
 228             $chksymb[$i] = '';
 229
 230         } elsif ( $TargetPlatform =~ /^i386-.*-solaris2/
 231              &&   /^(_uname|uname|stat|fstat):/ ) {
 232             # for some utterly bizarre reason, this platform
 233             # likes to drop little local C routines with these names
 234             # into each and every .o file that #includes the
 235             # relevant system .h file.  Yuck.  We just don't
 236             # tolerate them in .hc files (which we are processing
 237             # here).  If you need to call one of these things from
 238             # Haskell, make a call to your own C wrapper, then
 239             # put that C wrapper (which calls one of these) in a
 240             # plain .c file.  WDP 95/12
 241             $chk[++$i] .= $_;
 242             $chkcat[$i] = 'toss';
 243             $chksymb[$i] = $1;
 244
 245         } elsif ( /^${T_US}[A-Za-z0-9_]/o ) {
 246             local($thing);
 247             chop($thing = $_);
 248             print STDERR "Funny global thing?: $_"
 249                 unless $KNOWN_FUNNY_THING{$thing}
 250                     || /^${T_US}_(PRIn|PRStart).*${T_POST_LBL}$/o # pointer reversal GC routines
 251                     || /^${T_US}CC_.*${T_POST_LBL}$/            # PROF: _CC_ccident
 252                     || /^${T_US}_reg.*${T_POST_LBL}$/;          # PROF: __reg<module>
 253             $chk[++$i] .= $_;
 254             $chkcat[$i] = 'misc';
 255             $chksymb[$i] = '';
 256
 257         } else { # simple line (duplicated at the top)
 258
 259             $chk[$i] .= $_;
 260         }
 261     }
 262     $numchks = $#chk + 1;
 263
 264     # the division into chunks is imperfect;
 265     # we throw some things over the fence into the next
 266     # chunk.
 267     #
 268     # also, there are things we would like to know
 269     # about the whole module before we start spitting
 270     # output.
 271
 272     for ($i = 0; $i < $numchks; $i++) {
 273         $c = $chk[$i]; # convenience copy
 274
 275 #       print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
 276
 277         # toss all prologue stuff;
 278         # be slightly paranoid to make sure there's
 279         # nothing surprising in there
 280         if ( $c =~ /--- BEGIN ---/ ) {
 281             if (($p, $r) = split(/--- BEGIN ---/, $c)) {
 282                 $p =~ s/^\tpushl \%edi\n//;
 283                 $p =~ s/^\tpushl \%esi\n//;
 284                 $p =~ s/^\tsubl \$\d+,\%esp\n//;
 285                 die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/;
 286
 287                 # glue together what's left
 288                 $c = $p . $r;
 289             }
 290         }
 291
 292         # toss all epilogue stuff; again, paranoidly
 293         if ( $c =~ /--- END ---/ ) {
 294             if (($r, $e) = split(/--- END ---/, $c)) {
 295                 $e =~ s/^\tret\n//;
 296                 $e =~ s/^\tpopl \%edi\n//;
 297                 $e =~ s/^\tpopl \%esi\n//;
 298                 $e =~ s/^\taddl \$\d+,\%esp\n//;
 299                 die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/;
 300
 301                 # glue together what's left
 302                 $c = $r . $e;
 303             }
 304         }
 305
 306         # toss all calls to __DISCARD__
 307         $c =~ s/^\tcall ${T_US}__DISCARD__\n//go;
 308
 309         # pin a funny end-thing on (for easier matching):
 310         $c .= 'FUNNY#END#THING';
 311
 312         # pick some end-things and move them to the next chunk
 313
 314         while ( $c =~ /${T_MOVE_DIRVS}FUNNY#END#THING/o ) {
 315             $to_move = $1;
 316
 317             if ( $to_move =~ /${T_COPY_DIRVS}/ && $i < ($numchks - 1) ) {
 318                 $chk[$i + 1] = $to_move . $chk[$i + 1];
 319                 # otherwise they're tossed
 320             }
 321
 322             $c =~ s/${T_MOVE_DIRVS}FUNNY#END#THING/FUNNY#END#THING/o;
 323         }
 324
 325         $c =~ s/FUNNY#END#THING//;
 326
 327 #       print STDERR "\nCHK $i (AFTER) (",$chkcat[$i],"):\n", $c;
 328
 329         $chk[$i] = $c; # update w/ convenience copy
 330     }
 331
 332     # print out all the literal strings first
 333     for ($i = 0; $i < $numchks; $i++) {
 334         if ( $chkcat[$i] eq 'string' ) {
 335             print OUTASM $T_HDR_string, $chk[$i];
 336
 337             $chkcat[$i] = 'DONE ALREADY';
 338         }
 339     }
 340
 341     for ($i = 0; $i < $numchks; $i++) {
 342 #       print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
 343
 344         next if $chkcat[$i] eq 'DONE ALREADY';
 345
 346         if ( $chkcat[$i] eq 'misc' ) {
 347             print OUTASM $T_HDR_misc;
 348             &print_doctored($chk[$i], 0);
 349
 350         } elsif ( $chkcat[$i] eq 'toss' ) {
 351             print STDERR "*** NB: TOSSING code for $chksymb[$i] !!! ***\n";
 352
 353         } elsif ( $chkcat[$i] eq 'data' ) {
 354             print OUTASM $T_HDR_data;
 355             print OUTASM $chk[$i];
 356
 357         } elsif ( $chkcat[$i] eq 'consist' ) {
 358             if ( $chk[$i] =~ /$T_hsc_cc_PAT/o ) {
 359                 local($consist) = "$1.$2.$3";
 360                 $consist =~ s/,/./g;
 361                 $consist =~ s/\//./g;
 362                 $consist =~ s/-/_/g;
 363                 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
 364                 print OUTASM $T_HDR_consist, "${consist}${T_POST_LBL}\n";
 365             } else {
 366                 print STDERR "Couldn't grok consistency: ", $chk[$i];
 367             }
 368
 369         } elsif ( $chkcat[$i] eq 'splitmarker' ) {
 370             # we can just re-constitute this one...
 371             print OUTASM "${T_US}__stg_split_marker",$chksymb[$i],"${T_POST_LBL}\n";
 372
 373         } elsif ( $chkcat[$i] eq 'closure'
 374                || $chkcat[$i] eq 'infotbl'
 375                || $chkcat[$i] eq 'slow'
 376                || $chkcat[$i] eq 'fast' ) { # do them in that order
 377             $symb = $chksymb[$i];
 378
 379             # CLOSURE
 380             if ( defined($closurechk{$symb}) ) {
 381                 print OUTASM $T_HDR_closure;
 382                 print OUTASM $chk[$closurechk{$symb}];
 383                 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
 384             }
 385
 386             # INFO TABLE
 387             if ( defined($infochk{$symb}) ) {
 388
 389                 print OUTASM $T_HDR_info;
 390                 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
 391                 # entry code will be put here!
 392
 393                 # paranoia
 394                 if ( $chk[$infochk{$symb}] =~ /${T_DOT_WORD}\s+([A-Za-z0-9_]+_entry)$/o
 395                   && $1 ne "${T_US}${symb}_entry" ) {
 396                     print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
 397                 }
 398
 399                 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
 400             }
 401
 402             # STD ENTRY POINT
 403             if ( defined($slowchk{$symb}) ) {
 404
 405                 # teach it to drop through to the fast entry point:
 406                 $c = $chk[$slowchk{$symb}];
 407
 408                 if ( defined($fastchk{$symb}) ) {
 409                     $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%edx\n\tjmp \*\%edx\n//;
 410                     $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%eax\n\tjmp \*\%eax\n//;
 411                 }
 412
 413                 print STDERR "still has jump to fast entry point:\n$c"
 414                     if $c =~ /${T_US}${symb}_fast/; # NB: paranoia
 415
 416                 print OUTASM $T_HDR_entry;
 417
 418                 &print_doctored($c, 1); # NB: the 1!!!
 419
 420                 $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
 421             }
 422
 423             # FAST ENTRY POINT
 424             if ( defined($fastchk{$symb}) ) {
 425                 print OUTASM $T_HDR_fast;
 426                 &print_doctored($chk[$fastchk{$symb}], 0);
 427                 $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
 428             }
 429
 430         } elsif ( $chkcat[$i] eq 'vector'
 431                || $chkcat[$i] eq 'direct' ) { # do them in that order
 432             $symb = $chksymb[$i];
 433
 434             # VECTOR TABLE
 435             if ( defined($vectorchk{$symb}) ) {
 436                 print OUTASM $T_HDR_vector;
 437                 print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
 438                 # direct return code will be put here!
 439                 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
 440             }
 441
 442             # DIRECT RETURN
 443             if ( defined($directchk{$symb}) ) {
 444                 print OUTASM $T_HDR_direct;
 445                 &print_doctored($chk[$directchk{$symb}], 0);
 446                 $chkcat[$directchk{$symb}] = 'DONE ALREADY';
 447             }
 448
 449         } else {
 450             &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n");
 451         }
 452     }
 453     # finished
 454     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
 455     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
 456 }
 457 \end{code}
 458
 459 \begin{code}
 460 sub print_doctored {
 461     local($_, $need_fallthru_patch) = @_;
 462
 463     if ( $TargetPlatform !~ /^i386-/
 464       || ! /^\t[a-z]/ ) { # no instructions in here, apparently
 465         print OUTASM $_;
 466         return;
 467     }
 468     # OK, must do some x86 **HACKING**
 469
 470     local($entry_patch) = '';
 471     local($exit_patch)  = '';
 472     local($call_entry_patch)= '';
 473     local($call_exit_patch)     = '';
 474
 475 #OLD:   # first, convert calls to *very magic form*: (ToDo: document
 476     # for real!)  from
 477     #
 478     #   pushl $768
 479     #   call _?PerformGC_wrapper
 480     #   addl $4,%esp
 481     # to
 482     #   movl $768, %eax
 483     #   call _?PerformGC_wrapper
 484     #
 485     # The reason we do this now is to remove the apparent use of
 486     # %esp, which would throw off the "what patch code do we need"
 487     # decision.
 488     #
 489     # Special macros in ghc/includes/COptWraps.lh, used in
 490     # ghc/runtime/CallWrap_C.lc, are required for this to work!
 491     #
 492
 493     s/^\tpushl \$(\d+)\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \$$1,\%eax\n\tcall ${T_DO_GC}\n/go;
 494     s/^\tpushl \%eax\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tcall ${T_DO_GC}\n/go;
 495     s/^\tpushl \%edx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%edx,\%eax\n\tcall ${T_DO_GC}\n/go;
 496
 497 #=  if ( $StolenX86Regs <= 4 ) { # %ecx is ordinary reg
 498 #=      s/^\tpushl \%ecx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%ecx,\%eax\n\tcall ${T_DO_GC}\n/go;
 499 #=  }
 500
 501     # gotta watch out for weird instructions that
 502     # invisibly smash various regs:
 503     #   rep*    %ecx used for counting
 504     #   scas*   %edi used for destination index
 505     #   cmps*   %e[sd]i used for indices
 506     #   loop*   %ecx used for counting
 507     #
 508     # SIGH.
 509
 510     # We cater for:
 511     #  * use of STG reg [ nn(%ebx) ] where no machine reg avail
 512     #
 513     #  * GCC used an "STG reg" for its own purposes
 514     #
 515     #  * some secret uses of machine reg, requiring STG reg
 516     #    to be saved/restored
 517
 518     # The most dangerous "GCC uses" of an "STG reg" are when
 519     # the reg holds the target of a jmp -- it's tricky to
 520     # insert the patch-up code before we get to the target!
 521     # So here we change the jmps:
 522
 523     # --------------------------------------------------------
 524     # it can happen that we have jumps of the form...
 525     #   jmp *<something involving %esp>
 526     # or
 527     #   jmp <something involving another naughty register...>
 528     #
 529     # a reasonably-common case is:
 530     #
 531     #   movl $_blah,<bad-reg>
 532     #   jmp  *<bad-reg>
 533     #
 534     # which is easily fixed as:
 535     #
 536     # sigh! try to hack around it...
 537     #
 538
 539     if ($StolenX86Regs <= 2 ) { # YURGH! spurious uses of esi?
 540         s/^\tmovl (.*),\%esi\n\tjmp \*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
 541         s/^\tjmp \*(-?\d*)\((.*\%esi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
 542         s/^\tjmp \*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/g;
 543         die "$Pgm: (mangler) still have jump involving \%esi!\n$_"
 544             if /(jmp|call) .*\%esi/;
 545     }
 546     if ($StolenX86Regs <= 3 ) { # spurious uses of edi?
 547         s/^\tmovl (.*),\%edi\n\tjmp \*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
 548         s/^\tjmp \*(-?\d*)\((.*\%edi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
 549         s/^\tjmp \*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/g;
 550         die "$Pgm: (mangler) still have jump involving \%edi!\n$_"
 551             if /(jmp|call) .*\%edi/;
 552     }
 553 #=  if ($StolenX86Regs <= 4 ) { # spurious uses of ecx?
 554 #=      s/^\tmovl (.*),\%ecx\n\tjmp \*%ecx\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
 555 #=      s/^\tjmp \*(-?\d*)\((.*\%ecx.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
 556 #=      s/^\tjmp \*\%ecx\n/\tmovl \%ecx,\%eax\n\tjmp \*\%eax\n/g;
 557 #=      die "$Pgm: (mangler) still have jump involving \%ecx!\n$_"
 558 #=          if /(jmp|call) .*\%ecx/;
 559 #=  }
 560
 561     # OK, now we can decide what our patch-up code is going to
 562     # be:
 563     if ( $StolenX86Regs <= 2
 564          && ( /32\(\%ebx\)/ || /\%esi/ || /^\tcmps/ ) ) { # R1 (esi)
 565         $entry_patch .= "\tmovl \%esi,32(\%ebx)\n";
 566         $exit_patch  .= "\tmovl 32(\%ebx),\%esi\n";
 567         # nothing for call_{entry,exit} because %esi is callee-save
 568     }
 569     if ( $StolenX86Regs <= 3
 570          && ( /64\(\%ebx\)/ || /\%edi/ || /^\t(scas|cmps)/ ) ) { # SpA (edi)
 571         $entry_patch .= "\tmovl \%edi,64(\%ebx)\n";
 572         $exit_patch  .= "\tmovl 64(\%ebx),\%edi\n";
 573         # nothing for call_{entry,exit} because %edi is callee-save
 574     }
 575 #=  if ( $StolenX86Regs <= 4
 576 #=       && ( /80\(\%ebx\)/ || /\%ecx/ || /^\t(rep|loop)/ ) ) { # Hp (ecx)
 577 #=      $entry_patch .= "\tmovl \%ecx,80(\%ebx)\n";
 578 #=      $exit_patch  .= "\tmovl 80(\%ebx),\%ecx\n";
 579 #=
 580 #=      $call_exit_patch  .= "\tmovl \%ecx,108(\%ebx)\n";
 581 #=      $call_entry_patch .= "\tmovl 108(\%ebx),\%ecx\n";
 582 #=      # I have a really bad feeling about this if we ever
 583 #=      # have a nested call...
 584 #=      # NB: should just hide it somewhere in the C stack.
 585 #=  }
 586     # --------------------------------------------------------
 587     # next, here we go with non-%esp patching!
 588     #
 589     s/^(\t[a-z])/$entry_patch$1/; # before first instruction
 590     s/^(\tcall .*\n(\taddl \$\d+,\%esp\n)?)/$call_exit_patch$1$call_entry_patch/g; # _all_ calls
 591
 592     # fix _all_ non-local jumps:
 593
 594     s/^\tjmp \*${T_PRE_LLBL_PAT}/\tJMP___SL/go;
 595     s/^\tjmp ${T_PRE_LLBL_PAT}/\tJMP___L/go;
 596
 597     s/^(\tjmp .*\n)/$exit_patch$1/g; # here's the fix...
 598
 599     s/^\tJMP___SL/\tjmp \*${T_PRE_LLBL}/go;
 600     s/^\tJMP___L/\tjmp ${T_PRE_LLBL}/go;
 601
 602     # fix post-PerformGC wrapper (re-)entries ???
 603
 604     if ($StolenX86Regs == 2 ) {
 605         die "ARGH! Jump uses \%esi or \%edi with -monly-2-regs:\n$_"
 606             if /^\t(jmp|call) .*\%e(si|di)/;
 607 #=      die "ARGH! Jump uses \%esi, \%edi, or \%ecx with -monly-2-regs:\n$_"
 608 #=          if /^\t(jmp|call) .*\%e(si|di|cx)/;
 609     } elsif ($StolenX86Regs == 3 ) {
 610         die "ARGH! Jump uses \%edi with -monly-3-regs:\n$_"
 611             if /^\t(jmp|call) .*\%edi/;
 612 #=      die "ARGH! Jump uses \%edi or \%ecx with -monly-3-regs:\n$_"
 613 #=          if /^\t(jmp|call) .*\%e(di|cx)/;
 614 #=  } elsif ($StolenX86Regs == 4 ) {
 615 #=      die "ARGH! Jump uses \%ecx with -monly-4-regs:\n$_"
 616 #=          if /^\t(jmp|call) .*\%ecx/;
 617     }
 618
 619     # final peephole fix
 620
 621     s/^\tmovl \%eax,36\(\%ebx\)\n\tjmp \*36\(\%ebx\)\n/\tmovl \%eax,36\(\%ebx\)\n\tjmp \*\%eax\n/;
 622
 623     # --------------------------------------------------------
 624     # that's it -- print it
 625     #
 626     die "Funny jumps?\n$_" if /${T_X86_BADJMP}/o; # paranoia
 627
 628     print OUTASM $_;
 629
 630     if ( $need_fallthru_patch ) { # exit patch for end of slow entry code
 631         print OUTASM $exit_patch;
 632         # ToDo: make it not print if there is a "jmp" at the end
 633     }
 634 }
 635 \end{code}
 636
 637 \begin{code}
 638 sub init_FUNNY_THINGS {
 639     %KNOWN_FUNNY_THING = (
 640         "${T_US}CheckHeapCode${T_POST_LBL}", 1,
 641         "${T_US}CommonUnderflow${T_POST_LBL}", 1,
 642         "${T_US}Continue${T_POST_LBL}", 1,
 643         "${T_US}EnterNodeCode${T_POST_LBL}", 1,
 644         "${T_US}ErrorIO_call_count${T_POST_LBL}", 1,
 645         "${T_US}ErrorIO_innards${T_POST_LBL}", 1,
 646         "${T_US}IndUpdRetDir${T_POST_LBL}", 1,
 647         "${T_US}IndUpdRetV0${T_POST_LBL}", 1,
 648         "${T_US}IndUpdRetV1${T_POST_LBL}", 1,
 649         "${T_US}IndUpdRetV2${T_POST_LBL}", 1,
 650         "${T_US}IndUpdRetV3${T_POST_LBL}", 1,
 651         "${T_US}IndUpdRetV4${T_POST_LBL}", 1,
 652         "${T_US}IndUpdRetV5${T_POST_LBL}", 1,
 653         "${T_US}IndUpdRetV6${T_POST_LBL}", 1,
 654         "${T_US}IndUpdRetV7${T_POST_LBL}", 1,
 655         "${T_US}PrimUnderflow${T_POST_LBL}", 1,
 656         "${T_US}StackUnderflowEnterNode${T_POST_LBL}", 1,
 657         "${T_US}StdErrorCode${T_POST_LBL}", 1,
 658         "${T_US}UnderflowVect0${T_POST_LBL}", 1,
 659         "${T_US}UnderflowVect1${T_POST_LBL}", 1,
 660         "${T_US}UnderflowVect2${T_POST_LBL}", 1,
 661         "${T_US}UnderflowVect3${T_POST_LBL}", 1,
 662         "${T_US}UnderflowVect4${T_POST_LBL}", 1,
 663         "${T_US}UnderflowVect5${T_POST_LBL}", 1,
 664         "${T_US}UnderflowVect6${T_POST_LBL}", 1,
 665         "${T_US}UnderflowVect7${T_POST_LBL}", 1,
 666         "${T_US}UpdErr${T_POST_LBL}", 1,
 667         "${T_US}UpdatePAP${T_POST_LBL}", 1,
 668         "${T_US}WorldStateToken${T_POST_LBL}", 1,
 669         "${T_US}_Enter_Internal${T_POST_LBL}", 1,
 670         "${T_US}_PRMarking_MarkNextAStack${T_POST_LBL}", 1,
 671         "${T_US}_PRMarking_MarkNextBStack${T_POST_LBL}", 1,
 672         "${T_US}_PRMarking_MarkNextCAF${T_POST_LBL}", 1,
 673         "${T_US}_PRMarking_MarkNextGA${T_POST_LBL}", 1,
 674         "${T_US}_PRMarking_MarkNextRoot${T_POST_LBL}", 1,
 675         "${T_US}_PRMarking_MarkNextSpark${T_POST_LBL}", 1,
 676         "${T_US}_Scavenge_Forward_Ref${T_POST_LBL}", 1,
 677         "${T_US}__std_entry_error__${T_POST_LBL}", 1,
 678         "${T_US}_startMarkWorld${T_POST_LBL}", 1,
 679         "${T_US}resumeThread${T_POST_LBL}", 1,
 680         "${T_US}startCcRegisteringWorld${T_POST_LBL}", 1,
 681         "${T_US}startEnterFloat${T_POST_LBL}", 1,
 682         "${T_US}startEnterInt${T_POST_LBL}", 1,
 683         "${T_US}startPerformIO${T_POST_LBL}", 1,
 684         "${T_US}startStgWorld${T_POST_LBL}", 1,
 685         "${T_US}stopPerformIO${T_POST_LBL}", 1
 686     );
 687 }
 688 \end{code}
 689
 690 The following table reversal is used for both info tables and return
 691 vectors.  In both cases, we remove the first entry from the table,
 692 reverse the table, put the label at the end, and paste some code
 693 (that which is normally referred to by the first entry in the table)
 694 right after the table itself.  (The code pasting is done elsewhere.)
 695
 696 \begin{code}
 697 sub rev_tbl {
 698     local($symb, $tbl, $discard1) = @_;
 699
 700     local($before) = '';
 701     local($label) = '';
 702     local(@words) = ();
 703     local($after) = '';
 704     local(@lines) = split(/\n/, $tbl);
 705     local($i, $extra, $words_to_pad, $j);
 706
 707     for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t\.long\s+/; $i++) {
 708         $label .= $lines[$i] . "\n",
 709             next if $lines[$i] =~ /^[A-Za-z0-9_]+_info:$/
 710                  || $lines[$i] =~ /^\.globl/
 711                  || $lines[$i] =~ /^${T_US}vtbl_\S+:$/;
 712
 713         $before .= $lines[$i] . "\n"; # otherwise...
 714     }
 715
 716     for ( ; $i <= $#lines && $lines[$i] =~ /^\t\.long\s+/; $i++) {
 717         push(@words, $lines[$i]);
 718     }
 719     # now throw away the first word (entry code):
 720     shift(@words) if $discard1;
 721
 722     # for 486-cache-friendliness, we want our tables aligned
 723     # on 16-byte boundaries (.align 4).  Let's pad:
 724     $extra = ($#words + 1) % 4;
 725     $words_to_pad = ($extra == 0) ? 0 : 4 - $extra;
 726     for ($j = 0; $j < $words_to_pad; $j++) { push(@words, "\t\.long 0"); }
 727
 728     for (; $i <= $#lines; $i++) {
 729         $after .= $lines[$i] . "\n";
 730     }
 731
 732     $tbl = $before . join("\n", (reverse @words)) . "\n" . $label . $after;
 733
 734 #   print STDERR "before=$before\n";
 735 #   print STDERR "label=$label\n";
 736 #   print STDERR "words=",(reverse @words),"\n";
 737 #   print STDERR "after=$after\n";
 738
 739     $tbl;
 740 }
 741 \end{code}
 742
 743 \begin{code}
 744 sub mini_mangle_asm {
 745     local($in_asmf, $out_asmf) = @_;
 746
 747     &init_TARGET_STUFF();
 748
 749     open(INASM, "< $in_asmf")
 750         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
 751     open(OUTASM,"> $out_asmf")
 752         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
 753
 754     while (<INASM>) {
 755         print OUTASM;
 756
 757         next unless
 758             /^${T_US}(PerformGC|StackOverflow|Yield|PerformReschedule)_wrapper${T_POST_LBL}\n/o;
 759         print OUTASM "\tmovl \%esp, ${T_US}__temp_esp\n";
 760         print OUTASM "\tmovl \%eax, ${T_US}__temp_eax\n";
 761     }
 762
 763     # finished:
 764     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
 765     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
 766 }
 767
 768 # make "require"r happy...
 769 1;
 770 \end{code}