ghc/driver/mangler/ghc-asm.lprl

   1 %************************************************************************
   2 %*                                                                      *
   3 \section[Driver-asm-fiddling]{Fiddling with assembler files}
   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 General note [chak]: Many regexps are very fragile because they rely on white
  17 space being in the right place.  This caused trouble with gcc 2.95 (at least
  18 on Linux), where the use of white space in .s files generated by gcc suddenly
  19 changed.  To guarantee compatibility across different versions of gcc, make
  20 sure (at least on i386-.*-linux) that regexps tolerate varying amounts of white
  21 space between an assembler statement and its arguments as well as after a the
  22 comma separating multiple arguments.
  23
  24 \emph{For the time being, I have corrected the regexps for i386-.*-linux.  I
  25 didn't touch all the regexps for other i386 platforms, as I don't have
  26 a box to test these changes.}
  27
  28 HPPA specific notes:
  29 \begin{itemize}
  30 \item
  31 The HP linker is very picky about symbols being in the appropriate
  32 space (code vs. data).  When we mangle the threaded code to put the
  33 info tables just prior to the code, they wind up in code space
  34 rather than data space.  This means that references to *_info from
  35 un-mangled parts of the RTS (e.g. unthreaded GC code) get
  36 unresolved symbols.  Solution:  mini-mangler for .c files on HP.  I
  37 think this should really be triggered in the driver by a new -rts
  38 option, so that user code doesn't get mangled inappropriately.
  39 \item
  40 With reversed tables, jumps are to the _info label rather than to
  41 the _entry label.  The _info label is just an address in code
  42 space, rather than an entry point with the descriptive blob we
  43 talked about yesterday.  As a result, you can't use the call-style
  44 JMP_ macro.  However, some JMP_ macros take _info labels as targets
  45 and some take code entry points within the RTS.  The latter won't
  46 work with the goto-style JMP_ macro.  Sigh.  Solution: Use the goto
  47 style JMP_ macro, and mangle some more assembly, changing all
  48 "RP'literal" and "LP'literal" references to "R'literal" and
  49 "L'literal," so that you get the real address of the code, rather
  50 than the descriptive blob.  Also change all ".word P%literal"
  51 entries in info tables and vector tables to just ".word literal,"
  52 for the same reason.  Advantage: No more ridiculous call sequences.
  53 \end{itemize}
  54
  55 %************************************************************************
  56 %*                                                                      *
  57 \subsection{Top-level code}
  58 %*                                                                      *
  59 %************************************************************************
  60
  61 \begin{code}
  62 $TargetPlatform = $TARGETPLATFORM;
  63
  64 ($Pgm = $0) =~ s|.*/||;
  65 $ifile = $ARGV[0];
  66 $ofile = $ARGV[1];
  67
  68 if ( $TargetPlatform =~ /^i386-/ ) {
  69     if ($ARGV[2] eq '') {
  70         $StolenX86Regs = 4;
  71     } else {
  72         $StolenX86Regs = $ARGV[2];
  73     }
  74 }
  75
  76 &mangle_asm($ifile,$ofile);
  77
  78 exit(0);
  79 \end{code}
  80
  81 %************************************************************************
  82 %*                                                                      *
  83 \subsection{Constants for various architectures}
  84 %*                                                                      *
  85 %************************************************************************
  86
  87 \begin{code}
  88 sub init_TARGET_STUFF {
  89
  90     #--------------------------------------------------------#
  91     if ( $TargetPlatform =~ /^alpha-.*-.*/ ) {
  92
  93     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
  94     $T_US           = ''; # _ if symbols have an underscore on the front
  95     $T_PRE_APP      = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP
  96     $T_CONST_LBL    = '^\$L?C(\d+):$'; # regexp for what such a lbl looks like
  97     $T_POST_LBL     = ':';
  98
  99     $T_MOVE_DIRVS   = '^(\s*(\$.*\.\.ng:|\.align\s+\d+|\.(globl|ent)\s+\S+|\#.*|\.(file|loc)\s+\S+\s+\S+|\.text|\.r?data)\n)';
 100     $T_COPY_DIRVS   = '^\s*(\$.*\.\.ng:|\#|\.(file|globl|ent|loc))';
 101
 102     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
 103     $T_DOT_WORD     = '\.(long|quad|byte|word)';
 104     $T_DOT_GLOBAL   = '^\t\.globl';
 105     $T_HDR_literal  = "\.rdata\n\t\.align 3\n";
 106     $T_HDR_misc     = "\.text\n\t\.align 3\n";
 107     $T_HDR_data     = "\.data\n\t\.align 3\n";
 108     $T_HDR_consist  = "\.text\n";
 109     $T_HDR_closure  = "\.data\n\t\.align 3\n";
 110     $T_HDR_srt      = "\.text\n\t\.align 3\n";
 111     $T_HDR_info     = "\.text\n\t\.align 3\n";
 112     $T_HDR_entry    = "\.text\n\t\.align 3\n";
 113     $T_HDR_vector   = "\.text\n\t\.align 3\n";
 114     $T_HDR_direct   = "\.text\n\t\.align 3\n";
 115
 116     #--------------------------------------------------------#
 117     } elsif ( $TargetPlatform =~ /^hppa/ ) {
 118
 119     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 120     $T_US           = ''; # _ if symbols have an underscore on the front
 121     $T_PRE_APP      = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP
 122     $T_CONST_LBL    = '^L\$C(\d+)$'; # regexp for what such a lbl looks like
 123     $T_POST_LBL     = '';
 124
 125     $T_MOVE_DIRVS   = '^((\s+\.(IMPORT|EXPORT|PARAM).*|\s+\.align\s+\d+|\s+\.(SPACE|SUBSPA)\s+\S+|\s*)\n)';
 126     $T_COPY_DIRVS   = '^\s+\.(IMPORT|EXPORT)';
 127
 128     $T_hsc_cc_PAT   = '\.STRING.*\)(hsc|cc) (.*)\\\\x09(.*)\\\\x00"';
 129     $T_DOT_WORD     = '\.(blockz|word|half|byte)';
 130     $T_DOT_GLOBAL   = '^\s+\.EXPORT';
 131     $T_HDR_literal  = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
 132     $T_HDR_misc     = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
 133     $T_HDR_data     = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
 134     $T_HDR_consist  = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
 135     $T_HDR_closure  = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
 136     $T_HDR_srt      = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
 137     $T_HDR_info     = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
 138     $T_HDR_entry    = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
 139     $T_HDR_vector   = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
 140     $T_HDR_direct   = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
 141
 142     #--------------------------------------------------------#
 143     } elsif ( $TargetPlatform =~ /^i386-.*-(linuxaout|freebsd2|nextstep3|cygwin32|mingw32)$/ ) {
 144                                 # NeXT added but not tested. CaS
 145
 146     $T_STABBY       = 1; # 1 iff .stab things (usually if a.out format)
 147     $T_US           = '_'; # _ if symbols have an underscore on the front
 148     $T_PRE_APP      = '^#'; # regexp that says what comes before APP/NO_APP
 149     $T_CONST_LBL    = '^LC(\d+):$';
 150     $T_POST_LBL     = ':';
 151     $T_X86_PRE_LLBL_PAT = 'L';
 152     $T_X86_PRE_LLBL         = 'L';
 153     $T_X86_BADJMP   = '^\tjmp [^L\*]';
 154
 155     $T_MOVE_DIRVS   = '^(\s*(\.(p2)?align\s+\d+(,0x90)?|\.globl\s+\S+|\.text|\.data|\.stab[^n].*|\.type\s+.*|\.size\s+.*|\.lcomm.*)\n)';
 156     $T_COPY_DIRVS   = '\.(globl|stab|lcomm)';
 157     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
 158     $T_DOT_WORD     = '\.(long|word|value|byte|space)';
 159     $T_DOT_GLOBAL   = '\.globl';
 160     $T_HDR_literal  = "\.text\n\t\.align 2\n";
 161     $T_HDR_misc     = "\.text\n\t\.align 2,0x90\n";
 162     $T_HDR_data     = "\.data\n\t\.align 2\n";
 163     $T_HDR_consist  = "\.text\n";
 164     $T_HDR_closure  = "\.data\n\t\.align 2\n";
 165     $T_HDR_srt      = "\.text\n\t\.align 2\n";
 166     $T_HDR_info     = "\.text\n\t\.align 2\n"; # NB: requires padding
 167     $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
 168     $T_HDR_vector   = "\.text\n\t\.align 2\n"; # NB: requires padding
 169     $T_HDR_direct   = "\.text\n\t\.align 2,0x90\n";
 170
 171     #--------------------------------------------------------#
 172     } elsif ( $TargetPlatform =~ /^i386-.*-(solaris2|linux|freebsd|netbsd|openbsd)$/ ) {
 173
 174     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 175     $T_US           = ''; # _ if symbols have an underscore on the front
 176     $T_PRE_APP      = # regexp that says what comes before APP/NO_APP
 177                       ($TargetPlatform =~ /-(linux|freebsd|netbsd)$/) ? '#' : '/' ;
 178     $T_CONST_LBL    = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
 179     $T_POST_LBL     = ':';
 180     $T_X86_PRE_LLBL_PAT = '\.L';
 181     $T_X86_PRE_LLBL         = '.L';
 182     $T_X86_BADJMP   = '^\tjmp\s+[^\.\*]';
 183
 184     $T_MOVE_DIRVS   = '^(\s*(\.(p2)?align\s+\d+(,\s*0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)';
 185     $T_COPY_DIRVS   = '^\s*\.(globl|type|size|local)';
 186
 187     if ( $TargetPlatform =~ /freebsd|netbsd/ ) {
 188         $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
 189     } else {
 190         $T_hsc_cc_PAT   = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
 191     }
 192
 193     $T_DOT_WORD     = '\.(long|value|word|byte|zero)';
 194     $T_DOT_GLOBAL   = '\.globl';
 195     $T_HDR_literal  = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11)
 196     $T_HDR_misc     = "\.text\n\t\.align 4\n";
 197     $T_HDR_data     = "\.data\n\t\.align 4\n"; # ToDo: change align??
 198     $T_HDR_consist  = "\.text\n";
 199     $T_HDR_closure  = "\.data\n\t\.align 4\n"; # ToDo: change align?
 200     $T_HDR_srt      = "\.text\n\t\.align 4\n"; # ToDo: change align?
 201     $T_HDR_info     = "\.text\n\t\.align 4\n"; # NB: requires padding
 202     $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
 203     $T_HDR_vector   = "\.text\n\t\.align 4\n"; # NB: requires padding
 204     $T_HDR_direct   = "\.text\n\t\.align 4\n";
 205
 206     #--------------------------------------------------------#
 207     } elsif ( $TargetPlatform =~ /^ia64-.*-linux$/ ) {
 208
 209     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 210     $T_US           = ''; # _ if symbols have an underscore on the front
 211     $T_PRE_APP      = '#';
 212     $T_CONST_LBL    = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
 213     $T_POST_LBL     = ':';
 214
 215     $T_MOVE_DIRVS   = '^(\s*\.(global|proc|pred\.safe_across_calls|text|data|section|subsection|align|size|type|ident)\s+.*\n)';
 216     $T_COPY_DIRVS   = '\.(global|proc)';
 217
 218     $T_hsc_cc_PAT   = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
 219     $T_DOT_WORD     = '\.(long|value|byte|zero)';
 220     $T_DOT_GLOBAL   = '\.global';
 221     $T_HDR_literal  = "\.section\t\.rodata\n";
 222     $T_HDR_misc     = "\.text\n\t\.align 8\n";
 223     $T_HDR_data     = "\.data\n\t\.align 8\n";
 224     $T_HDR_consist  = "\.text\n";
 225     $T_HDR_closure  = "\.data\n\t\.align 8\n";
 226     $T_HDR_srt      = "\.text\n\t\.align 8\n";
 227     $T_HDR_info     = "\.text\n\t\.align 8\n";
 228     $T_HDR_entry    = "\.text\n\t\.align 16\n";
 229     $T_HDR_vector   = "\.text\n\t\.align 8\n";
 230     $T_HDR_direct   = "\.text\n\t\.align 8\n";
 231
 232     #--------------------------------------------------------#
 233     } elsif ( $TargetPlatform =~ /^x86_64-.*-(linux|openbsd)$/ ) {
 234
 235     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 236     $T_US           = ''; # _ if symbols have an underscore on the front
 237     $T_PRE_APP      = '#';
 238     $T_CONST_LBL    = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
 239     $T_POST_LBL     = ':';
 240
 241     $T_MOVE_DIRVS   = '^(\s*\.(globl|text|data|section|align|size|type|ident|local)\s+.*\n)';
 242     $T_COPY_DIRVS   = '\.(globl|local)';
 243
 244     $T_hsc_cc_PAT   = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
 245     $T_DOT_WORD     = '\.(quad|long|value|byte|zero)';
 246     $T_DOT_GLOBAL   = '\.global';
 247     $T_HDR_literal  = "\.section\t\.rodata\n";
 248     $T_HDR_misc     = "\.text\n\t\.align 8\n";
 249     $T_HDR_data     = "\.data\n\t\.align 8\n";
 250     $T_HDR_consist  = "\.text\n";
 251     $T_HDR_closure  = "\.data\n\t\.align 8\n";
 252     $T_HDR_srt      = "\.text\n\t\.align 8\n";
 253     $T_HDR_info     = "\.text\n\t\.align 8\n";
 254     $T_HDR_entry    = "\.text\n\t\.align 8\n";
 255     $T_HDR_vector   = "\.text\n\t\.align 8\n";
 256     $T_HDR_direct   = "\.text\n\t\.align 8\n";
 257
 258     #--------------------------------------------------------#
 259     } elsif ( $TargetPlatform =~ /^m68k-.*-sunos4/ ) {
 260
 261     $T_STABBY       = 1; # 1 iff .stab things (usually if a.out format)
 262     $T_US           = '_'; # _ if symbols have an underscore on the front
 263     $T_PRE_APP      = '^# MAY NOT APPLY'; # regexp that says what comes before APP/NO_APP
 264     $T_CONST_LBL    = '^LC(\d+):$';
 265     $T_POST_LBL     = ':';
 266
 267     $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.proc\s+\d+|\.const|\.cstring|\.globl\s+\S+|\.text|\.data|\.even|\.stab[^n].*)\n)';
 268     $T_COPY_DIRVS   = '\.(globl|proc|stab)';
 269     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
 270
 271     $T_DOT_WORD     = '\.long';
 272     $T_DOT_GLOBAL   = '\.globl';
 273     $T_HDR_literal  = "\.text\n\t\.even\n";
 274     $T_HDR_misc     = "\.text\n\t\.even\n";
 275     $T_HDR_data     = "\.data\n\t\.even\n";
 276     $T_HDR_consist  = "\.text\n";
 277     $T_HDR_closure  = "\.data\n\t\.even\n";
 278     $T_HDR_srt      = "\.text\n\t\.even\n";
 279     $T_HDR_info     = "\.text\n\t\.even\n";
 280     $T_HDR_entry    = "\.text\n\t\.even\n";
 281     $T_HDR_vector   = "\.text\n\t\.even\n";
 282     $T_HDR_direct   = "\.text\n\t\.even\n";
 283
 284     #--------------------------------------------------------#
 285     } elsif ( $TargetPlatform =~ /^mips-.*/ ) {
 286
 287     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 288     $T_US           = ''; # _ if symbols have an underscore on the front
 289     $T_PRE_APP      = '^\s*#'; # regexp that says what comes before APP/NO_APP
 290     $T_CONST_LBL    = '^\$LC(\d+):$'; # regexp for what such a lbl looks like
 291     $T_POST_LBL     = ':';
 292
 293     $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\.text|\.r?data)\n)';
 294     $T_COPY_DIRVS   = '\.(globl|ent)';
 295
 296     $T_hsc_cc_PAT   = 'I WAS TOO LAZY TO DO THIS BIT (WDP 95/05)';
 297     $T_DOT_WORD     = '\.word';
 298     $T_DOT_GLOBAL   = '^\t\.globl';
 299     $T_HDR_literal  = "\t\.rdata\n\t\.align 2\n";
 300     $T_HDR_misc     = "\t\.text\n\t\.align 2\n";
 301     $T_HDR_data     = "\t\.data\n\t\.align 2\n";
 302     $T_HDR_consist  = 'TOO LAZY TO DO THIS TOO';
 303     $T_HDR_closure  = "\t\.data\n\t\.align 2\n";
 304     $T_HDR_srt      = "\t\.text\n\t\.align 2\n";
 305     $T_HDR_info     = "\t\.text\n\t\.align 2\n";
 306     $T_HDR_entry    = "\t\.text\n\t\.align 2\n";
 307     $T_HDR_vector   = "\t\.text\n\t\.align 2\n";
 308     $T_HDR_direct   = "\t\.text\n\t\.align 2\n";
 309
 310     #--------------------------------------------------------#
 311     } elsif ( $TargetPlatform =~ /^powerpc-apple-.*/ ) {
 312                                 # Apple PowerPC Darwin/MacOS X.
 313     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 314     $T_US           = '_'; # _ if symbols have an underscore on the front
 315     $T_PRE_APP      = 'DOESNT APPLY'; # regexp that says what comes before APP/NO_APP
 316     $T_CONST_LBL    = '^\LC\d+:'; # regexp for what such a lbl looks like
 317     $T_POST_LBL     = ':';
 318
 319     $T_MOVE_DIRVS   = '^(\s*(\.align \d+|\.text|\.data|\.const_data|\.cstring|\.non_lazy_symbol_pointer|\.const|\.static_const|\.literal4|\.literal8|\.static_data|\.globl \S+|\.section .*|\.lcomm.*)\n)';
 320     $T_COPY_DIRVS   = '\.(globl|lcomm)';
 321
 322     $T_hsc_cc_PAT   = '\.byte.*\)(hsc|cc) (.*)"\n\t\.byte \d+\n\t\.byte "(.*)"\n\t\.byte \d+';
 323     $T_DOT_WORD     = '\.(long|short|byte|fill|space)';
 324     $T_DOT_GLOBAL   = '\.globl';
 325     $T_HDR_toc      = "\.toc\n";
 326     $T_HDR_literal  = "\t\.const_data\n\t\.align 2\n";
 327     $T_HDR_misc     = "\t\.text\n\t\.align 2\n";
 328     $T_HDR_data     = "\t\.data\n\t\.align 2\n";
 329     $T_HDR_consist  = "\t\.text\n\t\.align 2\n";
 330     $T_HDR_closure  = "\t\.const_data\n\t\.align 2\n";
 331     $T_HDR_srt      = "\t\.text\n\t\.align 2\n";
 332     $T_HDR_info     = "\t\.text\n\t\.align 2\n";
 333     $T_HDR_entry    = "\t\.text\n\t\.align 2\n";
 334     $T_HDR_vector   = "\t\.text\n\t\.align 2\n";
 335     $T_HDR_direct   = "\t\.text\n\t\.align 2\n";
 336
 337     #--------------------------------------------------------#
 338     } elsif ( $TargetPlatform =~ /^powerpc-.*-linux/ ) {
 339                                 # PowerPC Linux
 340     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 341     $T_US           = ''; # _ if symbols have an underscore on the front
 342     $T_PRE_APP      = '^#'; # regexp that says what comes before APP/NO_APP
 343     $T_CONST_LBL    = '^\.LC\d+:'; # regexp for what such a lbl looks like
 344     $T_POST_LBL     = ':';
 345
 346     $T_MOVE_DIRVS   = '^(\s*(\.(p2)?align\s+\d+(,\s*0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)';
 347     $T_COPY_DIRVS   = '^\s*\.(globl|type|size|local)';
 348
 349     $T_hsc_cc_PAT   = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
 350     $T_DOT_WORD     = '\.(long|short|byte|fill|space)';
 351     $T_DOT_GLOBAL   = '\.globl';
 352     $T_HDR_toc      = "\.toc\n";
 353     $T_HDR_literal  = "\t\.section\t.rodata\n\t\.align 2\n";
 354     $T_HDR_misc     = "\t\.text\n\t\.align 2\n";
 355     $T_HDR_data     = "\t\.data\n\t\.align 2\n";
 356     $T_HDR_consist  = "\t\.text\n\t\.align 2\n";
 357     $T_HDR_closure  = "\t\.data\n\t\.align 2\n";
 358     $T_HDR_srt      = "\t\.text\n\t\.align 2\n";
 359     $T_HDR_info     = "\t\.text\n\t\.align 2\n";
 360     $T_HDR_entry    = "\t\.text\n\t\.align 2\n";
 361     $T_HDR_vector   = "\t\.text\n\t\.align 2\n";
 362     $T_HDR_direct   = "\t\.text\n\t\.align 2\n";
 363
 364     #--------------------------------------------------------#
 365     } elsif ( $TargetPlatform =~ /^sparc-.*-(solaris2|openbsd)/ ) {
 366
 367     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 368     $T_US           = ''; # _ if symbols have an underscore on the front
 369     $T_PRE_APP      = 'DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
 370     $T_CONST_LBL    = '^\.LLC(\d+):$'; # regexp for what such a lbl looks like
 371     $T_POST_LBL     = ':';
 372
 373     $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*|\.section.*|\s+\.type.*|\s+\.size.*)\n)';
 374     $T_COPY_DIRVS   = '\.(global|proc|stab)';
 375
 376     $T_hsc_cc_PAT   = '\.asciz.*\)(hsc|cc) (.*)\\\\t(.*)"';
 377     $T_DOT_WORD     = '\.(long|word|byte|half|skip|uahalf|uaword)';
 378     $T_DOT_GLOBAL   = '^\t\.global';
 379     $T_HDR_literal  = "\.text\n\t\.align 8\n";
 380     $T_HDR_misc     = "\.text\n\t\.align 4\n";
 381     $T_HDR_data     = "\.data\n\t\.align 8\n";
 382     $T_HDR_consist  = "\.text\n";
 383     $T_HDR_closure  = "\.data\n\t\.align 4\n";
 384     $T_HDR_srt      = "\.data\n\t\.align 4\n";
 385     $T_HDR_info     = "\.text\n\t\.align 4\n";
 386     $T_HDR_entry    = "\.text\n\t\.align 4\n";
 387     $T_HDR_vector   = "\.text\n\t\.align 4\n";
 388     $T_HDR_direct   = "\.text\n\t\.align 4\n";
 389
 390     #--------------------------------------------------------#
 391     } elsif ( $TargetPlatform =~ /^sparc-.*-sunos4/ ) {
 392
 393     $T_STABBY       = 1; # 1 iff .stab things (usually if a.out format)
 394     $T_US           = '_'; # _ if symbols have an underscore on the front
 395     $T_PRE_APP      = '^# DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
 396     $T_CONST_LBL    = '^LC(\d+):$';
 397     $T_POST_LBL     = ':';
 398
 399     $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*)\n)';
 400     $T_COPY_DIRVS   = '\.(global|proc|stab)';
 401     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
 402
 403     $T_DOT_WORD     = '\.word';
 404     $T_DOT_GLOBAL   = '^\t\.global';
 405     $T_HDR_literal  = "\.text\n\t\.align 8\n";
 406     $T_HDR_misc     = "\.text\n\t\.align 4\n";
 407     $T_HDR_data     = "\.data\n\t\.align 8\n";
 408     $T_HDR_consist  = "\.text\n";
 409     $T_HDR_closure  = "\.data\n\t\.align 4\n";
 410     $T_HDR_srt      = "\.data\n\t\.align 4\n";
 411     $T_HDR_info     = "\.text\n\t\.align 4\n";
 412     $T_HDR_entry    = "\.text\n\t\.align 4\n";
 413     $T_HDR_vector   = "\.text\n\t\.align 4\n";
 414     $T_HDR_direct   = "\.text\n\t\.align 4\n";
 415
 416     #--------------------------------------------------------#
 417     } elsif ( $TargetPlatform =~ /^sparc-.*-linux/ ) {
 418     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 419     $T_US           = ''; # _ if symbols have an underscore on the front
 420     $T_PRE_APP      = '#'; # regexp that says what comes before APP/NO_APP
 421                            # Probably doesn't apply anyway
 422     $T_CONST_LBL    = '^\.LLC(\d+):$'; # regexp for what such a lbl looks like
 423     $T_POST_LBL     = ':';
 424
 425     $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.seg|\.stab.*|\t?\.section.*|\s+\.type.*|\s+\.size.*)\n)';
 426     $T_COPY_DIRVS   = '\.(global|globl|proc|stab)';
 427
 428     $T_hsc_cc_PAT   = '\.asciz.*\)(hsc|cc) (.*)\\\\t(.*)"';
 429     $T_DOT_WORD     = '\.(long|word|nword|xword|byte|half|short|skip|uahalf|uaword)';
 430     $T_DOT_GLOBAL   = '^\t\.global';
 431     $T_HDR_literal  = "\.text\n\t\.align 8\n";
 432     $T_HDR_misc     = "\.text\n\t\.align 4\n";
 433     $T_HDR_data     = "\.data\n\t\.align 8\n";
 434     $T_HDR_consist  = "\.text\n";
 435     $T_HDR_closure  = "\.data\n\t\.align 4\n";
 436     $T_HDR_srt      = "\.data\n\t\.align 4\n";
 437     $T_HDR_info     = "\.text\n\t\.align 4\n";
 438     $T_HDR_entry    = "\.text\n\t\.align 4\n";
 439     $T_HDR_vector   = "\.text\n\t\.align 4\n";
 440     $T_HDR_direct   = "\.text\n\t\.align 4\n";
 441
 442     #--------------------------------------------------------#
 443     } else {
 444         print STDERR "$Pgm: don't know how to mangle assembly language for: $TargetPlatform\n";
 445         exit 1;
 446     }
 447
 448 if ( 0 ) {
 449 print STDERR "T_STABBY: $T_STABBY\n";
 450 print STDERR "T_US: $T_US\n";
 451 print STDERR "T_PRE_APP: $T_PRE_APP\n";
 452 print STDERR "T_CONST_LBL: $T_CONST_LBL\n";
 453 print STDERR "T_POST_LBL: $T_POST_LBL\n";
 454 if ( $TargetPlatform =~ /^i386-/ ) {
 455     print STDERR "T_X86_PRE_LLBL_PAT: $T_X86_PRE_LLBL_PAT\n";
 456     print STDERR "T_X86_PRE_LLBL: $T_X86_PRE_LLBL\n";
 457     print STDERR "T_X86_BADJMP: $T_X86_BADJMP\n";
 458 }
 459 print STDERR "T_MOVE_DIRVS: $T_MOVE_DIRVS\n";
 460 print STDERR "T_COPY_DIRVS: $T_COPY_DIRVS\n";
 461 print STDERR "T_hsc_cc_PAT: $T_hsc_cc_PAT\n";
 462 print STDERR "T_DOT_WORD: $T_DOT_WORD\n";
 463 print STDERR "T_HDR_literal: $T_HDR_literal\n";
 464 print STDERR "T_HDR_misc: $T_HDR_misc\n";
 465 print STDERR "T_HDR_data: $T_HDR_data\n";
 466 print STDERR "T_HDR_consist: $T_HDR_consist\n";
 467 print STDERR "T_HDR_closure: $T_HDR_closure\n";
 468 print STDERR "T_HDR_info: $T_HDR_info\n";
 469 print STDERR "T_HDR_entry: $T_HDR_entry\n";
 470 print STDERR "T_HDR_vector: $T_HDR_vector\n";
 471 print STDERR "T_HDR_direct: $T_HDR_direct\n";
 472 }
 473
 474 }
 475 \end{code}
 476
 477 %************************************************************************
 478 %*                                                                      *
 479 \subsection{Mangle away}
 480 %*                                                                      *
 481 %************************************************************************
 482
 483 \begin{code}
 484 sub mangle_asm {
 485     local($in_asmf, $out_asmf) = @_;
 486
 487     # multi-line regexp matching:
 488     local($*) = 1;
 489     local($i, $c);
 490
 491
 492     &init_TARGET_STUFF();
 493     &init_FUNNY_THINGS();
 494
 495     open(INASM, "< $in_asmf")
 496         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
 497     open(OUTASM,"> $out_asmf")
 498         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
 499
 500     # read whole file, divide into "chunks":
 501     #   record some info about what we've found...
 502
 503     @chk = ();          # contents of the chunk
 504     $numchks = 0;       # number of them
 505     @chkcat = ();       # what category of thing in each chunk
 506     @chksymb = ();      # what symbol(base) is defined in this chunk
 507     %entrychk = ();     # ditto, its entry code
 508     %closurechk = ();   # ditto, the (static) closure
 509     %srtchk = ();       # ditto, its SRT (for top-level things)
 510     %infochk = ();      # given a symbol base, say what chunk its info tbl is in
 511     %vectorchk = ();    # ditto, return vector table
 512     $EXTERN_DECLS = ''; # .globl <foo> .text (MIPS only)
 513
 514     $i = 0; $chkcat[0] = 'misc'; $chk[0] = '';
 515
 516     while (<INASM>) {
 517         tr/\r//d if $TargetPlatform =~ /-mingw32$/; # In case Perl doesn't convert line endings
 518         next if $T_STABBY && /^\.stab.*${T_US}__stg_split_marker/o;
 519         next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
 520         next if /^\t\.def.*endef$/;
 521         next if /${T_PRE_APP}(NO_)?APP/o;
 522         next if /^;/ && $TargetPlatform =~ /^hppa/;
 523
 524         next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|ia64)-/;
 525
 526         if ( $TargetPlatform =~ /^mips-/
 527           && /^\t\.(globl\S+\.text|comm\t)/ ) {
 528             $EXTERN_DECLS .= $_ unless /(__DISCARD__|\b(PK_|ASSIGN_)(FLT|DBL)\b)/;
 529         # Treat .comm variables as data.  These show up in two (known) places:
 530         #
 531         #    - the module_registered variable used in the __stginit fragment.
 532         #      even though these are declared static and initialised, gcc 3.3
 533         #      likes to make them .comm, presumably to save space in the
 534         #      object file.
 535         #
 536         #    - global variables used to pass arguments from C to STG in
 537         #      a foreign export.  (is this still true? --SDM)
 538         #
 539         } elsif ( /^\t\.comm.*$/ ) {
 540             $chk[++$i]   = $_;
 541             $chkcat[$i]  = 'data';
 542             $chksymb[$i] = '';
 543
 544         } elsif ( /^\s+/ ) { # most common case first -- a simple line!
 545             # duplicated from the bottom
 546
 547             $chk[$i] .= $_;
 548
 549         } elsif ( /\.\.ng:$/ && $TargetPlatform =~ /^alpha-/ ) {
 550             # Alphas: Local labels not to be confused with new chunks
 551             $chk[$i] .= $_;
 552
 553         # NB: all the rest start with a non-space
 554
 555         } elsif ( $TargetPlatform =~ /^mips-/
 556                && /^\d+:/ ) { # a funny-looking very-local label
 557             $chk[$i] .= $_;
 558
 559         } elsif ( /$T_CONST_LBL/o ) {
 560             $chk[++$i]   = $_;
 561             $chkcat[$i]  = 'literal';
 562             $chksymb[$i] = $1;
 563
 564         } elsif ( /^${T_US}__stg_split_marker(\d*)${T_POST_LBL}$/o ) {
 565             $chk[++$i]   = $_;
 566             $chkcat[$i]  = 'splitmarker';
 567             $chksymb[$i] = $1;
 568
 569         } elsif ( /^${T_US}([A-Za-z0-9_]+)_info${T_POST_LBL}$/o ) {
 570             $symb = $1;
 571             $chk[++$i]   = $_;
 572             $chkcat[$i]  = 'infotbl';
 573             $chksymb[$i] = $symb;
 574
 575             die "Info table already? $symb; $i\n" if defined($infochk{$symb});
 576
 577             $infochk{$symb} = $i;
 578
 579         } elsif ( /^${T_US}([A-Za-z0-9_]+)_(entry|ret)${T_POST_LBL}$/o ) {
 580             $chk[++$i]   = $_;
 581             $chkcat[$i]  = 'entry';
 582             $chksymb[$i] = $1;
 583
 584             $entrychk{$1} = $i;
 585
 586         } elsif ( /^${T_US}([A-Za-z0-9_]+)_closure${T_POST_LBL}$/o ) {
 587             $chk[++$i]   = $_;
 588             $chkcat[$i]  = 'closure';
 589             $chksymb[$i] = $1;
 590
 591             $closurechk{$1} = $i;
 592
 593         } elsif ( /^${T_US}([A-Za-z0-9_]+)_srt${T_POST_LBL}$/o ) {
 594             $chk[++$i]   = $_;
 595             $chkcat[$i]  = 'srt';
 596             $chksymb[$i] = $1;
 597
 598             $srtchk{$1} = $i;
 599
 600         } elsif ( /^${T_US}([A-Za-z0-9_]+)_ct${T_POST_LBL}$/o ) {
 601             $chk[++$i]   = $_;
 602             $chkcat[$i]  = 'data';
 603             $chksymb[$i] = '';
 604
 605         } elsif ( /^(${T_US}__gnu_compiled_c|gcc2_compiled\.)${T_POST_LBL}/o ) {
 606             ; # toss it
 607
 608         } elsif ( /^${T_US}[A-Za-z0-9_]+\.\d+${T_POST_LBL}$/o
 609                || /^${T_US}.*_CAT${T_POST_LBL}$/o               # PROF: _entryname_CAT
 610                || /^${T_US}.*_done${T_POST_LBL}$/o              # PROF: _module_done
 611                || /^${T_US}_module_registered${T_POST_LBL}$/o   # PROF: _module_registered
 612                ) {
 613             $chk[++$i]   = $_;
 614             $chkcat[$i]  = 'data';
 615             $chksymb[$i] = '';
 616
 617         } elsif ( /^([A-Za-z0-9_]+)\s+\.comm/ && $TargetPlatform =~ /^hppa/ ) {
 618             $chk[++$i]   = $_;
 619             $chkcat[$i]  = 'bss';
 620             $chksymb[$i] = '';
 621
 622         } elsif ( /^${T_US}([A-Za-z0-9_]+)_cc(s)?${T_POST_LBL}$/o ) {
 623             # all CC_ symbols go in the data section...
 624             $chk[++$i]   = $_;
 625             $chkcat[$i]  = 'data';
 626             $chksymb[$i] = '';
 627
 628         } elsif ( /^${T_US}([A-Za-z0-9_]+)_(alt|dflt)${T_POST_LBL}$/o ) {
 629             $chk[++$i]   = $_;
 630             $chkcat[$i]  = 'misc';
 631             $chksymb[$i] = '';
 632         } elsif ( /^${T_US}([A-Za-z0-9_]+)_vtbl${T_POST_LBL}$/o ) {
 633             $chk[++$i]   = $_;
 634             $chkcat[$i]  = 'vector';
 635             $chksymb[$i] = $1;
 636
 637             $vectorchk{$1} = $i;
 638
 639         } elsif ( $TargetPlatform =~ /^i386-.*-solaris2/
 640              &&   /^[A-Za-z0-9][A-Za-z0-9_]*:/ ) {
 641             # Some Solaris system headers contain function definitions (as
 642             # opposed to mere prototypes), which end up in the .hc file when
 643             # a Haskell module foreign imports the corresponding system
 644             # functions (most notably stat()).  We put them into the text
 645             # segment.  Note that this currently does not extend to function
 646             # names starting with an underscore.
 647             # - chak 7/2001
 648             $chk[++$i]   = $_;
 649             $chkcat[$i]  = 'misc';
 650             $chksymb[$i] = $1;
 651
 652         } elsif ( /^${T_US}[A-Za-z0-9_]/o
 653                 && ( $TargetPlatform !~ /^hppa/ # need to avoid local labels in this case
 654                    || ! /^L\$\d+$/ ) ) {
 655             local($thing);
 656             chop($thing = $_);
 657             $thing =~ s/:$//;
 658             print STDERR "Warning: retaining unknown function \`$thing' in output from C compiler\n"
 659                 unless # $KNOWN_FUNNY_THING{$thing}
 660                        /^${T_US}stg_.*${T_POST_LBL}$/o          # RTS internals
 661                     || /^${T_US}__stg_.*${T_POST_LBL}$/o        # more RTS internals
 662                     || /^${T_US}__fexp_.*${T_POST_LBL}$/o       # foreign export
 663                     || /^${T_US}.*_slow${T_POST_LBL}$/o         # slow entry
 664                     || /^${T_US}__stginit.*${T_POST_LBL}$/o     # __stginit<module>
 665                     || /^${T_US}.*_btm${T_POST_LBL}$/o          # large bitmaps
 666                     || /^${T_US}.*_srtd${T_POST_LBL}$/o          # large bitmaps
 667                     || /^${T_US}.*_fast${T_POST_LBL}$/o         # primops
 668                     || /^${T_US}.*_closure_tbl${T_POST_LBL}$/o  # closure tables
 669                     || /^_uname:/o;                             # x86/Solaris2
 670             $chk[++$i]   = $_;
 671             $chkcat[$i]  = 'misc';
 672             $chksymb[$i] = '';
 673
 674         } elsif ( $TargetPlatform =~ /^powerpc-apple-.*/ && (
 675                    /^\.picsymbol_stub/
 676                 || /^\.section __TEXT,__picsymbol_stub1,.*/
 677                 || /^\.symbol_stub/
 678                 || /^\.section __TEXT,__symbol_stub1,.*/
 679                 || /^\.lazy_symbol_pointer/
 680                 || /^\.non_lazy_symbol_pointer/ ))
 681         {
 682             $chk[++$i]   = $_;
 683             $chkcat[$i]  = 'dyld';
 684             $chksymb[$i] = '';
 685         } elsif ( $TargetPlatform =~ /^powerpc-apple-.*/ && /^\.data/ && $chkcat[$i] eq 'dyld')
 686         {       # non_lazy_symbol_ptrs that point to local symbols
 687             $chk[++$i]   = $_;
 688             $chkcat[$i]  = 'dyld';
 689             $chksymb[$i] = '';
 690         } else { # simple line (duplicated at the top)
 691
 692             $chk[$i] .= $_;
 693         }
 694     }
 695     $numchks = $#chk + 1;
 696
 697     # open CHUNKS, ">/tmp/chunks1" or die "Cannot open /tmp/chunks1: $!\n";
 698     # for (my $i = 0; $i < @chk; ++$i) { print CHUNKS "======= $i =======\n", $chk[$i] }
 699     # close CHUNKS;
 700
 701     # the division into chunks is imperfect;
 702     # we throw some things over the fence into the next
 703     # chunk.
 704     #
 705     # also, there are things we would like to know
 706     # about the whole module before we start spitting
 707     # output.
 708
 709     local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-)/) ? 1 : 0;
 710     local($FIRST_TOSSABLE ) = ($TargetPlatform =~ /^(hppa|mips-)/) ? 1 : 0;
 711
 712 #   print STDERR "first chunk to mangle: $FIRST_MANGLABLE\n";
 713
 714     # Alphas: NB: we start meddling at chunk 1, not chunk 0
 715     # The first ".rdata" is quite magical; as of GCC 2.7.x, it
 716     # spits a ".quad 0" in after the very first ".rdata"; we
 717     # detect this special case (tossing the ".quad 0")!
 718     local($magic_rdata_seen) = 0;
 719
 720     # HPPAs, MIPSen: also start medding at chunk 1
 721
 722     for ($i = $FIRST_TOSSABLE; $i < $numchks; $i++) {
 723         $c = $chk[$i]; # convenience copy
 724
 725 #       print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
 726
 727         # toss all prologue stuff; HPPA is pretty weird
 728         # (see elsewhere)
 729         $c = &hppa_mash_prologue($c) if $TargetPlatform =~ /^hppa-/;
 730
 731         # be slightly paranoid to make sure there's
 732         # nothing surprising in there
 733         if ( $c =~ /--- BEGIN ---/ ) {
 734             if (($p, $r) = split(/--- BEGIN ---/, $c)) {
 735
 736                 # remove junk whitespace around the split point
 737                 $p =~ s/\t+$//;
 738                 $r =~ s/^\s*\n//;
 739
 740                 if ($TargetPlatform =~ /^i386-/) {
 741                     $p =~ s/^\tpushl\s+\%edi\n//;
 742                     $p =~ s/^\tpushl\s+\%esi\n//;
 743                     $p =~ s/^\tpushl\s+\%ebx\n//;
 744                     $p =~ s/^\tmovl\s+\%esi,\s*\d*\(\%esp\)\n//;
 745                     $p =~ s/^\tmovl\s+\%edi,\s*\d*\(\%esp\)\n//;
 746                     $p =~ s/^\tsubl\s+\$\d+,\s*\%esp\n//;
 747                     $p =~ s/^\tmovl\s+\$\d+,\s*\%eax\n\tcall\s+__alloca\n// if ($TargetPlatform =~ /^.*-cygwin32/);
 748
 749                     # GCC 3.1 is in the habit of adding spurious writes to the
 750                     # stack in the prologue.  Just to be on the safe side,
 751                     # chuck these over the fence into the main code.
 752                     while ($p =~ /^\tmovl\s+\$\d+,\s*\d*\(\%esp\)\n/) {
 753                           # print "Spurious instruction: $&";
 754                           $p = $` . $';
 755                           $r = $& . $r;
 756                     }
 757
 758                 } elsif ($TargetPlatform =~ /^x86_64-/) {
 759                     $p =~ s/^\tpushq\s+\%r(bx|bp|12|13|14)\n//g;
 760                     $p =~ s/^\tmovq\s+\%r(bx|bp|12|13|14),\s*\d*\(\%rsp\)\n//g;
 761                     $p =~ s/^\tsubq\s+\$\d+,\s*\%rsp\n//;
 762
 763                 } elsif ($TargetPlatform =~ /^ia64-/) {
 764                     $p =~ s/^\t\.prologue .*\n//;
 765                     $p =~ s/^\t\.save ar\.pfs, r\d+\n\talloc r\d+ = ar\.pfs, 0, 3[12], \d+, 0\n//;
 766                     $p =~ s/^\t\.fframe \d+\n\tadds r12 = -\d+, r12\n//;
 767                     $p =~ s/^\t\.save rp, r\d+\n\tmov r\d+ = b0\n//;
 768                     $p =~ s/^\t\.(mii|mmi)\n//g;        # bundling is no longer sensible
 769                     $p =~ s/^\t;;\n//g;         # discard stops
 770                     $p =~ s/^\t\/\/.*\n//g;     # gcc inserts timings in // comments
 771
 772                     # GCC 3.3 saves r1 in the prologue, move this to the body
 773                     if ($p =~ /^\tmov r\d+ = r1\n/) {
 774                           $p = $` . $';
 775                           $r = $& . $r;
 776                     }
 777                 } elsif ($TargetPlatform =~ /^m68k-/) {
 778                     $p =~ s/^\tlink a6,#-?\d.*\n//;
 779                     $p =~ s/^\tpea a6@\n\tmovel sp,a6\n//;
 780                                 # The above showed up in the asm code,
 781                                 # so I added it here.
 782                                 # I hope it's correct.
 783                                 # CaS
 784                     $p =~ s/^\tmovel d2,sp\@-\n//;
 785                     $p =~ s/^\tmovel d5,sp\@-\n//; # SMmark.* only?
 786                     $p =~ s/^\tmoveml \#0x[0-9a-f]+,sp\@-\n//; # SMmark.* only?
 787                 } elsif ($TargetPlatform =~ /^mips-/) {
 788                     # the .frame/.mask/.fmask that we use is the same
 789                     # as that produced by GCC for miniInterpret; this
 790                     # gives GDB some chance of figuring out what happened
 791                     $FRAME = "\t.frame\t\$sp,2168,\$31\n\t.mask\t0x90000000,-4\n\t.fmask\t0x00000000,0\n";
 792                     $p =~ s/^\t\.(frame).*\n/__FRAME__/g;
 793                     $p =~ s/^\t\.(mask|fmask).*\n//g;
 794                     $p =~ s/^\t\.cprestore.*\n/\t\.cprestore 416\n/; # 16 + 100 4-byte args
 795                     $p =~ s/^\tsubu\t\$sp,\$sp,\d+\n//;
 796                     $p =~ s/^\tsw\t\$31,\d+\(\$sp\)\n//;
 797                     $p =~ s/^\tsw\t\$fp,\d+\(\$sp\)\n//;
 798                     $p =~ s/^\tsw\t\$28,\d+\(\$sp\)\n//;
 799                     $p =~ s/__FRAME__/$FRAME/;
 800                 } elsif ($TargetPlatform =~ /^powerpc-apple-.*/) {
 801                     $pcrel_label = $p;
 802                     $pcrel_label =~ s/(.|\n)*^(L\d+\$pb):\n(.|\n)*/$2/ or $pcrel_label = "";
 803
 804                     $p =~ s/^\tmflr r0\n//;
 805                     $p =~ s/^\tbl saveFP # f\d+\n//;
 806                     $p =~ s/^\tbl saveFP ; save f\d+-f\d+\n//;
 807                     $p =~ s/^L\d+\$pb:\n//;
 808                     $p =~ s/^\tstmw r\d+,-\d+\(r1\)\n//;
 809                     $p =~ s/^\tstfd f\d+,-\d+\(r1\)\n//g;
 810                     $p =~ s/^\tstw r0,\d+\(r1\)\n//g;
 811                     $p =~ s/^\tstwu r1,-\d+\(r1\)\n//;
 812                     $p =~ s/^\tstw r\d+,-\d+\(r1\)\n//g;
 813                     $p =~ s/^\tbcl 20,31,L\d+\$pb\n//;
 814                     $p =~ s/^L\d+\$pb:\n//;
 815                     $p =~ s/^\tmflr r31\n//;
 816
 817                     # This is bad: GCC 3 seems to zero-fill some local variables in the prologue
 818                     # under some circumstances, only when generating position dependent code.
 819                     # I have no idea why, and I don't think it is necessary, so let's toss it.
 820                     $p =~ s/^\tli r\d+,0\n//g;
 821                     $p =~ s/^\tstw r\d+,\d+\(r1\)\n//g;
 822                 } elsif ($TargetPlatform =~ /^powerpc-.*-linux/) {
 823                     $p =~ s/^\tmflr 0\n//;
 824                     $p =~ s/^\tstmw \d+,\d+\(1\)\n//;
 825                     $p =~ s/^\tstfd \d+,\d+\(1\)\n//g;
 826                     $p =~ s/^\tstw r0,8\(1\)\n//;
 827                     $p =~ s/^\tstwu 1,-\d+\(1\)\n//;
 828                     $p =~ s/^\tstw \d+,\d+\(1\)\n//g;
 829
 830                     # This is bad: GCC 3 seems to zero-fill some local variables in the prologue
 831                     # under some circumstances, only when generating position dependent code.
 832                     # I have no idea why, and I don't think it is necessary, so let's toss it.
 833                     $p =~ s/^\tli \d+,0\n//g;
 834                     $p =~ s/^\tstw \d+,\d+\(1\)\n//g;
 835                 } else {
 836                     print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n";
 837                 }
 838
 839                 # HWL HACK: dont die, just print a warning
 840                 #print stderr  "HWL: this should die! Prologue junk?: $p\n" if $p =~ /^\t[^\.]/;
 841                 die "Prologue junk?: $p\n" if $p =~ /^\s+[^\s\.]/;
 842
 843                 if ($TargetPlatform =~ /^powerpc-apple-.*/ && $pcrel_label ne "") {
 844                     # on PowerPC, we have to keep a part of the prologue
 845                     # (which loads the current instruction pointer into register r31)
 846                     $p .= "bcl 20,31,$pcrel_label\n";
 847                     $p .= "$pcrel_label:\n";
 848                     $p .= "\tmflr r31\n";
 849                 }
 850
 851                 # glue together what's left
 852                 $c = $p . $r;
 853             }
 854         }
 855
 856         if ( $TargetPlatform =~ /^mips-/ ) {
 857             # MIPS: first, this basic sequence may occur "--- END ---" or not
 858             $c =~ s/^\tlw\t\$31,\d+\(\$sp\)\n\taddu\t\$sp,\$sp,\d+\n\tj\t\$31\n\t\.end/\t\.end/;
 859         }
 860
 861         # toss all epilogue stuff; again, paranoidly
 862         if ( $c =~ /--- END ---/ ) {
 863             if (($r, $e) = split(/--- END ---/, $c)) {
 864                 if ($TargetPlatform =~ /^i386-/) {
 865                     $e =~ s/^\tret\n//;
 866                     $e =~ s/^\tpopl\s+\%edi\n//;
 867                     $e =~ s/^\tpopl\s+\%esi\n//;
 868                     $e =~ s/^\tpopl\s+\%edx\n//;
 869                     $e =~ s/^\tpopl\s+\%ecx\n//;
 870                     $e =~ s/^\taddl\s+\$\d+,\s*\%esp\n//;
 871                     $e =~ s/^\tsubl\s+\$-\d+,\s*\%esp\n//;
 872                 } elsif ($TargetPlatform =~ /^ia64-/) {
 873                     $e =~ s/^\tmov ar\.pfs = r\d+\n//;
 874                     $e =~ s/^\tmov b0 = r\d+\n//;
 875                     $e =~ s/^\t\.restore sp\n\tadds r12 = \d+, r12\n//;
 876                     $e =~ s/^\tbr\.ret\.sptk\.many b0\n//;
 877                     $e =~ s/^\t\.(mii|mmi|mib)\n//g;    # bundling is no longer sensible
 878                     $e =~ s/^\t;;\n//g;                 # discard stops - stop at end of body is sufficient
 879                     $e =~ s/^\t\/\/.*\n//g;             # gcc inserts timings in // comments
 880                 } elsif ($TargetPlatform =~ /^m68k-/) {
 881                     $e =~ s/^\tunlk a6\n//;
 882                     $e =~ s/^\trts\n//;
 883                 } elsif ($TargetPlatform =~ /^mips-/) {
 884                     $e =~ s/^\tlw\t\$31,\d+\(\$sp\)\n//;
 885                     $e =~ s/^\tlw\t\$fp,\d+\(\$sp\)\n//;
 886                     $e =~ s/^\taddu\t\$sp,\$sp,\d+\n//;
 887                     $e =~ s/^\tj\t\$31\n//;
 888                 } elsif ($TargetPlatform =~ /^powerpc-apple-.*/) {
 889                     $e =~ s/^\taddi r1,r1,\d+\n//;
 890                     $e =~ s/^\tcal r1,\d+\(r1\)\n//;
 891                     $e =~ s/^\tlw?z? r\d+,\d+\(r1\)\n//;
 892                     $e =~ s/^\tmtlr r0\n//;
 893                     $e =~ s/^\tblr\n//;
 894                 } else {
 895                     print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n";
 896                 }
 897
 898                 print STDERR "WARNING: Epilogue junk?: $e\n" if $e =~ /^\t\s*[^\.\s\n]/;
 899
 900                 # glue together what's left
 901                 $c = $r . $e;
 902                 $c =~ s/\n\t\n/\n/; # junk blank line
 903             }
 904         }
 905
 906         # On SPARCs, we don't do --- BEGIN/END ---, we just
 907         # toss the register-windowing save/restore/ret* instructions
 908         # directly:
 909         if ( $TargetPlatform =~ /^sparc-/ ) {
 910             $c =~ s/^\t(save.*|restore.*|ret|retl)\n//g;
 911             # throw away PROLOGUE comments
 912             $c =~ s/^\t!#PROLOGUE# 0\n\t!#PROLOGUE# 1\n//;
 913         }
 914
 915         # On Alphas, the prologue mangling is done a little later (below)
 916
 917         # toss all calls to __DISCARD__
 918         $c =~ s/^\t(call|jbsr|jal)\s+${T_US}__DISCARD__\n//go;
 919         $c =~ s/^\tjsr\s+\$26\s*,\s*${T_US}__DISCARD__\n//go if $TargetPlatform =~ /^alpha-/;
 920         $c =~ s/^\tbl\s+L___DISCARD__\$stub\n//go if $TargetPlatform =~ /^powerpc-apple-.*/;
 921         $c =~ s/^\tbl\s+__DISCARD__\n//go if $TargetPlatform =~ /^powerpc-.*-linux/;
 922
 923         # IA64: mangle tailcalls into jumps here
 924         if ($TargetPlatform =~ /^ia64-/) {
 925             while ($c =~ s/^\tbr\.call\.sptk\.many b0 = (.*)\n(?:^\.L([0-9]*):\n)?(?:\t;;\n)?(?:\tmov r1 = r\d+\n)?(?:\t;;\n)?\t--- TAILCALL ---\n(?:\t;;\n\tbr \.L\d+\n)?/\tbr\.few $1\n/) {
 926                 # Eek, the gcc optimiser is getting smarter... if we see a jump to the --- TAILCALL ---
 927                 # marker then we reapply the substitution at the source sites
 928                 $c =~ s/^\tbr \.L$2\n/\t--- TAILCALL ---\n/g if ($2);
 929             }
 930         }
 931
 932         # MIPS: that may leave some gratuitous asm macros around
 933         # (no harm done; but we get rid of them to be tidier)
 934         $c =~ s/^\t\.set\tnoreorder\n\t\.set\tnomacro\n\taddu\t(\S+)\n\t\.set\tmacro\n\t\.set\treorder\n/\taddu\t$1\n/
 935             if $TargetPlatform =~ /^mips-/;
 936
 937         # toss stack adjustment after DoSparks
 938         $c =~ s/^(\tjbsr _DoSparks\n)\taddqw #8,sp/$1/g
 939                 if $TargetPlatform =~ /^m68k-/; # this looks old...
 940
 941         if ( $TargetPlatform =~ /^alpha-/ &&
 942            ! $magic_rdata_seen &&
 943            $c =~ /^\s*\.rdata\n\t\.quad 0\n\t\.align \d\n/ ) {
 944             $c =~ s/^\s*\.rdata\n\t\.quad 0\n\t\.align (\d)\n/\.rdata\n\t\.align $1\n/;
 945             $magic_rdata_seen = 1;
 946         }
 947
 948         # pick some end-things and move them to the next chunk
 949
 950         # pin a funny end-thing on (for easier matching):
 951         $c .= 'FUNNY#END#THING';
 952
 953         while ( $c =~ /${T_MOVE_DIRVS}FUNNY#END#THING/o ) {
 954
 955             $to_move = $1;
 956
 957             # on x86 we try not to copy any directives into a literal
 958             # chunk, rather we keep looking for the next real chunk.  This
 959             # is because we get things like
 960             #
 961             #    .globl blah_closure
 962             #    .LC32
 963             #           .string "..."
 964             #    blah_closure:
 965             #           ...
 966             #
 967             if ( $TargetPlatform =~ /^(i386|sparc|powerpc)/ && $to_move =~ /${T_COPY_DIRVS}/ ) {
 968                 $j = $i + 1;
 969                 while ( $j < $numchks  && $chk[$j] =~ /$T_CONST_LBL/) {
 970                         $j++;
 971                 }
 972                 if ( $j < $numchks ) {
 973                         $chk[$j] = $to_move . $chk[$j];
 974                 }
 975             }
 976
 977             elsif ( $i < ($numchks - 1)
 978               && ( $to_move =~ /${T_COPY_DIRVS}/
 979                 || ($TargetPlatform =~ /^hppa/ && $to_move =~ /align/ && $chkcat[$i+1] eq 'literal') )) {
 980                 $chk[$i + 1] = $to_move . $chk[$i + 1];
 981                 # otherwise they're tossed
 982             }
 983
 984             $c =~ s/${T_MOVE_DIRVS}FUNNY#END#THING/FUNNY#END#THING/o;
 985         }
 986
 987         if ( $TargetPlatform =~ /^alpha-/ && $c =~ /^\t\.ent\s+(\S+)/ ) {
 988             $ent = $1;
 989             # toss all prologue stuff, except for loading gp, and the ..ng address
 990             unless ($c =~ /\.ent.*\n\$.*\.\.ng:/) {
 991                 if (($p, $r) = split(/^\t\.prologue/, $c)) {
 992                     if (($keep, $junk) = split(/\.\.ng:/, $p)) {
 993                         $keep =~ s/^\t\.frame.*\n/\t.frame \$30,0,\$26,0\n/;
 994                         $keep =~ s/^\t\.(mask|fmask).*\n//g;
 995                         $c = $keep . "..ng:\n";
 996                     } else {
 997                         print STDERR "malformed code block ($ent)?\n"
 998                     }
 999                 }
1000                 $c .= "\t.prologue" . $r;
1001             }
1002         }
1003
1004         $c =~ s/FUNNY#END#THING//;
1005
1006 #       print STDERR "\nCHK $i (AFTER) (",$chkcat[$i],"):\n", $c;
1007
1008         $chk[$i] = $c; # update w/ convenience copy
1009     }
1010
1011     # open CHUNKS, ">/tmp/chunks2" or die "Cannot open /tmp/chunks2: $!\n";
1012     # for (my $i = 0; $i < @chk; ++$i) { print CHUNKS "======= $i =======\n", $chk[$i] }
1013     # close CHUNKS;
1014
1015     if ( $TargetPlatform =~ /^alpha-/ ) {
1016         # print out the header stuff first
1017         $chk[0] =~ s/^(\t\.file.*)"(ghc\d+\.c)"/$1"$ifile_root.hc"/;
1018         print OUTASM $chk[0];
1019
1020     } elsif ( $TargetPlatform =~ /^hppa/ ) {
1021         print OUTASM $chk[0];
1022
1023     } elsif ( $TargetPlatform =~ /^mips-/ ) {
1024         $chk[0] = "\t\.file\t1 \"$ifile_root.hc\"\n" . $chk[0];
1025
1026         # get rid of horrible "<dollar>Revision: .*$" strings
1027         local(@lines0) = split(/\n/, $chk[0]);
1028         local($z) = 0;
1029         while ( $z <= $#lines0 ) {
1030             if ( $lines0[$z] =~ /^\t\.byte\t0x24,0x52,0x65,0x76,0x69,0x73,0x69,0x6f$/ ) {
1031                 undef($lines0[$z]);
1032                 $z++;
1033                 while ( $z <= $#lines0 ) {
1034                     undef($lines0[$z]);
1035                     last if $lines0[$z] =~ /[,\t]0x0$/;
1036                     $z++;
1037                 }
1038             }
1039             $z++;
1040         }
1041         $chk[0] = join("\n", @lines0);
1042         $chk[0] =~ s/\n\n+/\n/;
1043         print OUTASM $chk[0];
1044     }
1045
1046     # print out all the literal strings next
1047     for ($i = 0; $i < $numchks; $i++) {
1048         if ( $chkcat[$i] eq 'literal' ) {
1049             print OUTASM $T_HDR_literal, $chk[$i];
1050             print OUTASM "; end literal\n" if $TargetPlatform =~ /^hppa/; # for the splitter
1051
1052             $chkcat[$i] = 'DONE ALREADY';
1053         }
1054     }
1055
1056     # on the HPPA, print out all the bss next
1057     if ( $TargetPlatform =~ /^hppa/ ) {
1058         for ($i = 1; $i < $numchks; $i++) {
1059             if ( $chkcat[$i] eq 'bss' ) {
1060                 print OUTASM "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$BSS\$\n\t.align 4\n";
1061                 print OUTASM $chk[$i];
1062
1063                 $chkcat[$i] = 'DONE ALREADY';
1064             }
1065         }
1066     }
1067
1068     for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
1069 #       print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
1070
1071         next if $chkcat[$i] eq 'DONE ALREADY';
1072
1073         if ( $chkcat[$i] eq 'misc' ) {
1074             if ($chk[$i] ne '') {
1075                 print OUTASM $T_HDR_misc;
1076                 &print_doctored($chk[$i], 0);
1077             }
1078
1079         } elsif ( $chkcat[$i] eq 'toss' ) {
1080             print STDERR "*** NB: TOSSING code for $chksymb[$i] !!! ***\n";
1081
1082         } elsif ( $chkcat[$i] eq 'data' ) {
1083             if ($chk[$i] ne '') {
1084                 print OUTASM $T_HDR_data;
1085                 print OUTASM $chk[$i];
1086             }
1087
1088         } elsif ( $chkcat[$i] eq 'consist' ) {
1089             if ( $chk[$i] =~ /$T_hsc_cc_PAT/o ) {
1090                 local($consist) = "$1.$2.$3";
1091                 $consist =~ s/,/./g;
1092                 $consist =~ s/\//./g;
1093                 $consist =~ s/-/_/g;
1094                 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
1095                 #
1096                 # Using a cygnus-2.7-96q4 gcc build on hppas, the
1097                 # consistency chunk for ghc_cc_ID often (but not always!)
1098                 # gets lumped with a bunch of .IMPORT directives containing info on
1099                 # the code or data space nature of external symbols. We can't
1100                 # toss these, so once the consistency ID has been turned into
1101                 # a representable symbol, we substitute it for the symbol
1102                 # that the string was attached to in the first place (ghc_cc_ID.)
1103                 # (The original string is also substituted away.)
1104                 #
1105                 # This change may affect the code output on other platforms in
1106                 # adverse ways, hence we restrict this hack hppa targets only.
1107                 #
1108                 #    -- 2/98 SOF
1109                 if ( $TargetPlatform =~ /^hppa/ )  {
1110                         $chk[$i] =~ s/^${T_US}ghc.*c_ID$TPOSTLBL/$consist/o;
1111                         $chk[$i] =~ s/\t$T_hsc_cc_PAT/$T_HDR_misc/o;
1112                         $consist = $chk[$i]; #clumsily
1113                 }
1114                 print OUTASM $T_HDR_consist, "${consist}${T_POST_LBL}\n";
1115
1116             } elsif ( $TargetPlatform !~ /^(mips)-/ ) { # we just don't try in those case (ToDo)
1117                 # on mips: consistency string is just a v
1118                 # horrible bunch of .bytes,
1119                 # which I am too lazy to sort out (WDP 95/05)
1120
1121                 print STDERR "Couldn't grok consistency: ", $chk[$i];
1122             }
1123
1124         } elsif ( $chkcat[$i] eq 'splitmarker' ) {
1125             # we can just re-constitute this one...
1126             # NB: we emit _three_ underscores no matter what,
1127             # so ghc-split doesn't have to care.
1128             print OUTASM "___stg_split_marker",$chksymb[$i],"${T_POST_LBL}\n";
1129
1130         } elsif ( $chkcat[$i] eq 'closure'
1131                || $chkcat[$i] eq 'srt'
1132                || $chkcat[$i] eq 'infotbl'
1133                || $chkcat[$i] eq 'entry') { # do them in that order
1134             $symb = $chksymb[$i];
1135
1136             # CLOSURE
1137             if ( defined($closurechk{$symb}) ) {
1138                 print OUTASM $T_HDR_closure;
1139                 print OUTASM $chk[$closurechk{$symb}];
1140                 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
1141             }
1142
1143             # SRT
1144             if ( defined($srtchk{$symb}) ) {
1145                 print OUTASM $T_HDR_srt;
1146                 print OUTASM $chk[$srtchk{$symb}];
1147                 $chkcat[$srtchk{$symb}] = 'DONE ALREADY';
1148             }
1149
1150             # INFO TABLE
1151             if ( defined($infochk{$symb}) ) {
1152
1153                 print OUTASM $T_HDR_info;
1154                 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
1155
1156                 # entry code will be put here!
1157
1158                 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
1159             }
1160
1161             # STD ENTRY POINT
1162             if ( defined($entrychk{$symb}) ) {
1163
1164                 $c = $chk[$entrychk{$symb}];
1165
1166                 print OUTASM $T_HDR_entry;
1167
1168                 &print_doctored($c, 1); # NB: the 1!!!
1169
1170                 $chkcat[$entrychk{$symb}] = 'DONE ALREADY';
1171             }
1172
1173         } elsif ( $chkcat[$i] eq 'vector'
1174                || $chkcat[$i] eq 'direct' ) { # do them in that order
1175             $symb = $chksymb[$i];
1176
1177             # VECTOR TABLE
1178             if ( defined($vectorchk{$symb}) ) {
1179                 print OUTASM $T_HDR_vector;
1180                 print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
1181
1182                 # direct return code will be put here!
1183                 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
1184
1185             } elsif ( $TargetPlatform =~ /^alpha-/ ) {
1186                 # Alphas: the commented nop is for the splitter, to ensure
1187                 # that no module ends with a label as the very last
1188                 # thing.  (The linker will adjust the label to point
1189                 # to the first code word of the next module linked in,
1190                 # even if alignment constraints cause the label to move!)
1191
1192                 print OUTASM "\t# nop\n";
1193             }
1194
1195         } elsif ( $chkcat[$i] eq 'toc' ) {
1196             # silly optimisation to print tocs, since they come in groups...
1197             print OUTASM $T_HDR_toc;
1198             local($j)   = $i;
1199             while ($chkcat[$j] eq 'toc')
1200               { if (   $chk[$j] !~ /\.tc UpdatePAP\[TC\]/ # not needed: always turned into a jump.
1201                    )
1202                 {
1203                   print OUTASM $chk[$j];
1204                 }
1205                 $chkcat[$j] = 'DONE ALREADY';
1206                 $j++;
1207             }
1208
1209         } elsif ( $TargetPlatform =~ /^powerpc-apple-.*/ && $chkcat[$i] eq 'dyld' ) {
1210             # powerpc-apple: dynamic linker stubs
1211             if($chk[$i] !~ /\.indirect_symbol ___DISCARD__/)
1212             {   # print them out unchanged, but remove the stubs for __DISCARD__
1213                 print OUTASM $chk[$i];
1214             }
1215         } else {
1216             &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n");
1217         }
1218     }
1219
1220     print OUTASM $EXTERN_DECLS if $TargetPlatform =~ /^mips-/;
1221
1222     # finished
1223     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1224     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1225 }
1226 \end{code}
1227
1228 \begin{code}
1229 sub hppa_mash_prologue { # OK, epilogue, too
1230     local($_) = @_;
1231
1232     # toss all prologue stuff
1233     s/^\s+\.ENTRY[^\0]*--- BEGIN ---/\t.ENTRY/;
1234
1235     # Lie about our .CALLINFO
1236     s/^\s+\.CALLINFO.*$/\t.CALLINFO NO_CALLS,NO_UNWIND/;
1237
1238     # Get rid of P'
1239
1240     s/LP'/L'/g;
1241     s/RP'/R'/g;
1242
1243     # toss all epilogue stuff
1244     s/^\s+--- END ---[^\0]*\.EXIT/\t.EXIT/;
1245
1246     # Sorry; we moved the _info stuff to the code segment.
1247     s/_info,DATA/_info,CODE/g;
1248
1249     return($_);
1250 }
1251 \end{code}
1252
1253 \begin{code}
1254 sub print_doctored {
1255     local($_, $need_fallthru_patch) = @_;
1256
1257     if ( $TargetPlatform !~ /^i386-/
1258       || ! /^\t[a-z]/  # no instructions in here, apparently
1259       || /^${T_US}__stginit_[A-Za-z0-9_]+${T_POST_LBL}/) {
1260         print OUTASM $_;
1261         return;
1262     }
1263     # OK, must do some x86 **HACKING**
1264
1265     local($entry_patch) = '';
1266     local($exit_patch)  = '';
1267
1268     # gotta watch out for weird instructions that
1269     # invisibly smash various regs:
1270     #   rep*    %ecx used for counting
1271     #   scas*   %edi used for destination index
1272     #   cmps*   %e[sd]i used for indices
1273     #   loop*   %ecx used for counting
1274     #
1275     # SIGH.
1276
1277     # We cater for:
1278     #  * use of STG reg [ nn(%ebx) ] where no machine reg avail
1279     #
1280     #  * GCC used an "STG reg" for its own purposes
1281     #
1282     #  * some secret uses of machine reg, requiring STG reg
1283     #    to be saved/restored
1284
1285     # The most dangerous "GCC uses" of an "STG reg" are when
1286     # the reg holds the target of a jmp -- it's tricky to
1287     # insert the patch-up code before we get to the target!
1288     # So here we change the jmps:
1289
1290     # --------------------------------------------------------
1291     # it can happen that we have jumps of the form...
1292     #   jmp *<something involving %esp>
1293     # or
1294     #   jmp <something involving another naughty register...>
1295     #
1296     # a reasonably-common case is:
1297     #
1298     #   movl $_blah,<bad-reg>
1299     #   jmp  *<bad-reg>
1300     #
1301
1302     s/^\tmovl\s+\$${T_US}(.*),\s*(\%e[abcd]x)\n\tjmp\s+\*\2/\tjmp $T_US$1/g;
1303
1304     if ($StolenX86Regs <= 2 ) { # YURGH! spurious uses of esi?
1305         s/^\tmovl\s+(.*),\s*\%esi\n\tjmp\s+\*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1306         s/^\tjmp\s+\*(.*\(.*\%esi.*\))\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1307         s/^\tjmp\s+\*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/g;
1308         die "$Pgm: (mangler) still have jump involving \%esi!\n$_"
1309             if /(jmp|call)\s+.*\%esi/;
1310     }
1311     if ($StolenX86Regs <= 3 ) { # spurious uses of edi?
1312         s/^\tmovl\s+(.*),\s*\%edi\n\tjmp\s+\*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1313         s/^\tjmp\s+\*(.*\(.*\%edi.*\))\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1314         s/^\tjmp\s+\*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/g;
1315         die "$Pgm: (mangler) still have jump involving \%edi!\n$_"
1316             if /(jmp|call)\s+.*\%edi/;
1317     }
1318
1319     # OK, now we can decide what our patch-up code is going to
1320     # be:
1321
1322     # Offsets into register table - you'd better update these magic
1323     # numbers should you change its contents!
1324     # local($OFFSET_R1)=0;  No offset for R1 in new RTS.
1325     local($OFFSET_Hp)=88;
1326
1327         # Note funky ".=" stuff; we're *adding* to these _patch guys
1328     if ( $StolenX86Regs <= 2
1329          && ( /[^0-9]\(\%ebx\)/ || /\%esi/ || /^\tcmps/ ) ) { # R1 (esi)
1330         $entry_patch .= "\tmovl \%esi,(\%ebx)\n";
1331         $exit_patch  .= "\tmovl (\%ebx),\%esi\n";
1332
1333         # nothing for call_{entry,exit} because %esi is callee-save
1334     }
1335     if ( $StolenX86Regs <= 3
1336          && ( /${OFFSET_Hp}\(\%ebx\)/ || /\%edi/ || /^\t(scas|cmps)/ ) ) { # Hp (edi)
1337         $entry_patch .= "\tmovl \%edi,${OFFSET_Hp}(\%ebx)\n";
1338         $exit_patch  .= "\tmovl ${OFFSET_Hp}(\%ebx),\%edi\n";
1339
1340         # nothing for call_{entry,exit} because %edi is callee-save
1341     }
1342
1343     # --------------------------------------------------------
1344     # next, here we go with non-%esp patching!
1345     #
1346     s/^(\t[a-z])/$entry_patch$1/; # before first instruction
1347
1348 # Before calling GC we must set up the exit condition before the call
1349 # and entry condition when we come back
1350
1351     # fix _all_ non-local jumps:
1352
1353     s/^\tjmp\s+\*${T_X86_PRE_LLBL_PAT}/\tJMP___SL/go;
1354     s/^\tjmp\s+${T_X86_PRE_LLBL_PAT}/\tJMP___L/go;
1355
1356     s/^(\tjmp\s+.*\n)/$exit_patch$1/g; # here's the fix...
1357
1358     s/^\tJMP___SL/\tjmp \*${T_X86_PRE_LLBL}/go;
1359     s/^\tJMP___L/\tjmp ${T_X86_PRE_LLBL}/go;
1360
1361     if ($StolenX86Regs == 2 ) {
1362         die "ARGH! Jump uses \%esi or \%edi with -monly-2-regs:\n$_"
1363             if /^\t(jmp|call)\s+.*\%e(si|di)/;
1364     } elsif ($StolenX86Regs == 3 ) {
1365         die "ARGH! Jump uses \%edi with -monly-3-regs:\n$_"
1366             if /^\t(jmp|call)\s+.*\%edi/;
1367     }
1368
1369     # --------------------------------------------------------
1370     # that's it -- print it
1371     #
1372     #die "Funny jumps?\n$_" if /${T_X86_BADJMP}/o; # paranoia
1373
1374     print OUTASM $_;
1375
1376     if ( $need_fallthru_patch ) { # exit patch for end of slow entry code
1377         print OUTASM $exit_patch;
1378         # ToDo: make it not print if there is a "jmp" at the end
1379     }
1380 }
1381 \end{code}
1382
1383 \begin{code}
1384 sub init_FUNNY_THINGS {
1385     %KNOWN_FUNNY_THING = (
1386         # example
1387         # "${T_US}stg_.*{T_POST_LBL}", 1,
1388     );
1389 }
1390 \end{code}
1391
1392 The following table reversal is used for both info tables and return
1393 vectors.  In both cases, we remove the first entry from the table,
1394 reverse the table, put the label at the end, and paste some code
1395 (that which is normally referred to by the first entry in the table)
1396 right after the table itself.  (The code pasting is done elsewhere.)
1397
1398 \begin{code}
1399 sub rev_tbl {
1400     local($symb, $tbl, $discard1) = @_;
1401
1402     return ($tbl) if ($TargetPlatform =~ /^ia64-/);
1403
1404     local($before) = '';
1405     local($label) = '';
1406     local(@imports) = (); # hppa only
1407     local(@words) = ();
1408     local($after) = '';
1409     local(@lines) = split(/\n/, $tbl);
1410     local($i, $j);
1411
1412     # Deal with the header...
1413     for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t?${T_DOT_WORD}\s+/o; $i++) {
1414         $label .= $lines[$i] . "\n",
1415             next if $lines[$i] =~ /^[A-Za-z0-9_]+_info${T_POST_LBL}$/o
1416                  || $lines[$i] =~ /${T_DOT_GLOBAL}/o
1417                  || $lines[$i] =~ /^${T_US}\S+_vtbl${T_POST_LBL}$/o;
1418
1419         $before .= $lines[$i] . "\n"; # otherwise...
1420     }
1421
1422     # Grab the table data...
1423     if ( $TargetPlatform !~ /^hppa/ ) {
1424         for ( ; $i <= $#lines && $lines[$i] =~ /^\t?${T_DOT_WORD}\s+/o; $i++) {
1425             push(@words, $lines[$i]);
1426         }
1427     } else { # hppa weirdness
1428         for ( ; $i <= $#lines && $lines[$i] =~ /^\s+(${T_DOT_WORD}|\.IMPORT)/; $i++) {
1429             if ($lines[$i] =~ /^\s+\.IMPORT/) {
1430                 push(@imports, $lines[$i]);
1431             } else {
1432                 # We don't use HP's ``function pointers''
1433                 # We just use labels in code space, like normal people
1434                 $lines[$i] =~ s/P%//;
1435                 push(@words, $lines[$i]);
1436             }
1437         }
1438     }
1439
1440     # Now throw away any initial zero word from the table.  This is a hack
1441     # that lets us reduce the size of info tables when the SRT field is not
1442     # needed: see comments StgFunInfoTable in InfoTables.h.
1443     #
1444     # The .zero business is for Linux/ELF.
1445     # The .skip business is for Sparc/Solaris/ELF.
1446     # The .blockz business is for HPPA.
1447 #    if ($discard1) {
1448 #       if ($words[0] =~ /^\t?(${T_DOT_WORD}\s+0|\.zero\s+4|\.skip\s+4|\.blockz\s+4)/) {
1449 #               shift(@words);
1450 #       }
1451 #    }
1452
1453     for (; $i <= $#lines; $i++) {
1454         $after .= $lines[$i] . "\n";
1455     }
1456
1457     # Alphas: If we have anonymous text (not part of a procedure), the
1458     # linker may complain about missing exception information.  Bleh.
1459     # To suppress this, we place a .ent/.end pair around the code.
1460     # At the same time, we have to be careful and not enclose any leading
1461     # .file/.loc directives.
1462     if ( $TargetPlatform =~ /^alpha-/ && $label =~ /^([A-Za-z0-9_]+):$/) {
1463         local ($ident) = $1;
1464         $before =~ s/^((\s*\.(file|loc)\s+[^\n]*\n)*)/$1\t.ent $ident\n/;
1465         $after .= "\t.end $ident\n";
1466     }
1467
1468     # Alphas: The heroic Simon Marlow found a bug in the Digital UNIX
1469     # assembler (!) wherein .quad constants inside .text sections are
1470     # first narrowed to 32 bits then sign-extended back to 64 bits.
1471     # This obviously screws up our 64-bit bitmaps, so we work around
1472     # the bug by replacing .quad with .align 3 + .long + .long [ccshan]
1473     if ( $TargetPlatform =~ /^alpha-/ ) {
1474         foreach (@words) {
1475             if (/^\s*\.quad\s+([-+0-9].*\S)\s*$/ && length $1 >= 10) {
1476                 local ($number) = $1;
1477                 if ($number =~ /^([-+])?(0x?)?([0-9]+)$/) {
1478                     local ($sign, $base, $digits) = ($1, $2, $3);
1479                     $base = (10, 8, 16)[length $base];
1480                     local ($hi, $lo) = (0, 0);
1481                     foreach $i (split(//, $digits)) {
1482                         $j = $lo * $base + $i;
1483                         $lo = $j % 4294967296;
1484                         $hi = $hi * $base + ($j - $lo) / 4294967296;
1485                     }
1486                     ($hi, $lo) = (4294967295 - $hi, 4294967296 - $lo)
1487                         if $sign eq "-";
1488                     $_ = "\t.align 3\n\t.long $lo\n\t.long $hi\n";
1489                     # printf STDERR "TURNING %s into 0x %08x %08x\n", $number, $hi, $lo;
1490                 } else {
1491                     print STDERR "Cannot handle \".quad $number\" in info table\n";
1492                     exit 1;
1493                 }
1494             }
1495         }
1496     }
1497
1498     $tbl = $before
1499          . (($TargetPlatform !~ /^hppa/) ? '' : join("\n", @imports) . "\n")
1500          . join("\n", @words) . "\n"
1501          . $label . $after;
1502
1503 #   print STDERR "before=$before\n";
1504 #   print STDERR "label=$label\n";
1505 #   print STDERR "words=",(reverse @words),"\n";
1506 #   print STDERR "after=$after\n";
1507
1508     $tbl;
1509 }
1510 \end{code}
1511
1512 The HP is a major nuisance.  The threaded code mangler moved info
1513 tables from data space to code space, but unthreaded code in the RTS
1514 still has references to info tables in data space.  Since the HP
1515 linker is very precise about where symbols live, we need to patch the
1516 references in the unthreaded RTS as well.
1517
1518 \begin{code}
1519 sub mini_mangle_asm_hppa {
1520     local($in_asmf, $out_asmf) = @_;
1521
1522     open(INASM, "< $in_asmf")
1523         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
1524     open(OUTASM,"> $out_asmf")
1525         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
1526
1527     while (<INASM>) {
1528         s/_info,DATA/_info,CODE/;   # Move _info references to code space
1529         s/P%_PR/_PR/;
1530         print OUTASM;
1531     }
1532
1533     # finished:
1534     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1535     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1536 }
1537
1538 \end{code}
1539
1540 \begin{code}
1541 sub tidy_up_and_die {
1542     local($return_val, $msg) = @_;
1543     print STDERR $msg;
1544     exit (($return_val == 0) ? 0 : 1);
1545 }
1546 \end{code}