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