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 HPPA specific notes:
  17 \begin{itemize}
  18 \item
  19 The HP linker is very picky about symbols being in the appropriate
  20 space (code vs. data).  When we mangle the threaded code to put the
  21 info tables just prior to the code, they wind up in code space
  22 rather than data space.  This means that references to *_info from
  23 un-mangled parts of the RTS (e.g. unthreaded GC code) get
  24 unresolved symbols.  Solution:  mini-mangler for .c files on HP.  I
  25 think this should really be triggered in the driver by a new -rts
  26 option, so that user code doesn't get mangled inappropriately.
  27 \item
  28 With reversed tables, jumps are to the _info label rather than to
  29 the _entry label.  The _info label is just an address in code
  30 space, rather than an entry point with the descriptive blob we
  31 talked about yesterday.  As a result, you can't use the call-style
  32 JMP_ macro.  However, some JMP_ macros take _info labels as targets
  33 and some take code entry points within the RTS.  The latter won't
  34 work with the goto-style JMP_ macro.  Sigh.  Solution: Use the goto
  35 style JMP_ macro, and mangle some more assembly, changing all
  36 "RP'literal" and "LP'literal" references to "R'literal" and
  37 "L'literal," so that you get the real address of the code, rather
  38 than the descriptive blob.  Also change all ".word P%literal"
  39 entries in info tables and vector tables to just ".word literal,"
  40 for the same reason.  Advantage: No more ridiculous call sequences.
  41 \end{itemize}
  42
  43 %************************************************************************
  44 %*                                                                      *
  45 \subsection{Constants for various architectures}
  46 %*                                                                      *
  47 %************************************************************************
  48
  49 \begin{code}
  50 sub init_TARGET_STUFF {
  51
  52     #--------------------------------------------------------#
  53     if ( $TargetPlatform =~ /^alpha-.*-.*/ ) {
  54
  55     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
  56     $T_US           = ''; # _ if symbols have an underscore on the front
  57     $T_DO_GC        = 'PerformGC_wrapper';
  58     $T_PRE_APP      = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP
  59     $T_CONST_LBL    = '^\$C(\d+):$'; # regexp for what such a lbl looks like
  60     $T_POST_LBL     = ':';
  61
  62     $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\#.*|\.(file|loc)\s+\S+\s+\S+|\.text|\.r?data)\n)';
  63     $T_COPY_DIRVS   = '^\s*(\#|\.(file|globl|ent|loc))';
  64
  65     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
  66     $T_DOT_WORD     = '\.quad';
  67     $T_DOT_GLOBAL   = '^\t\.globl';
  68     $T_HDR_literal  = "\.rdata\n\t\.align 3\n";
  69     $T_HDR_misc     = "\.text\n\t\.align 3\n";
  70     $T_HDR_data     = "\.data\n\t\.align 3\n";
  71     $T_HDR_consist  = "\.text\n";
  72     $T_HDR_closure  = "\.data\n\t\.align 3\n";
  73     $T_HDR_info     = "\.text\n\t\.align 3\n";
  74     $T_HDR_entry    = "\.text\n\t\.align 3\n";
  75     $T_HDR_fast     = "\.text\n\t\.align 3\n";
  76     $T_HDR_vector   = "\.text\n\t\.align 3\n";
  77     $T_HDR_direct   = "\.text\n\t\.align 3\n";
  78
  79     #--------------------------------------------------------#
  80     } elsif ( $TargetPlatform =~ /^hppa/ ) {
  81
  82     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
  83     $T_US           = ''; # _ if symbols have an underscore on the front
  84     $T_DO_GC        = 'PerformGC_wrapper';
  85     $T_PRE_APP      = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP
  86     $T_CONST_LBL    = '^L\$C(\d+)$'; # regexp for what such a lbl looks like
  87     $T_POST_LBL     = '';
  88
  89     $T_MOVE_DIRVS   = '^((\s+\.(IMPORT|EXPORT|PARAM).*|\s+\.align\s+\d+|\s+\.(SPACE|SUBSPA)\s+\S+|\s*)\n)';
  90     $T_COPY_DIRVS   = '^\s+\.(IMPORT|EXPORT)';
  91
  92     $T_hsc_cc_PAT   = '\.STRING.*\)(hsc|cc) (.*)\\\\x09(.*)\\\\x00';
  93     $T_DOT_WORD     = '\.word';
  94     $T_DOT_GLOBAL   = '^\s+\.EXPORT';
  95     $T_HDR_literal  = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
  96     $T_HDR_misc     = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
  97     $T_HDR_data     = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
  98     $T_HDR_consist  = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
  99     $T_HDR_closure  = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
 100     $T_HDR_info     = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
 101     $T_HDR_entry    = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
 102     $T_HDR_fast     = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
 103     $T_HDR_vector   = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
 104     $T_HDR_direct   = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
 105
 106     #--------------------------------------------------------#
 107     } elsif ( $TargetPlatform =~ /^i386-.*-(linuxaout|freebsd|nextstep3|cygwin32)/ ) {
 108                                 # NeXT added but not tested. CaS
 109
 110     $T_STABBY       = 1; # 1 iff .stab things (usually if a.out format)
 111     $T_US           = '_'; # _ if symbols have an underscore on the front
 112     $T_DO_GC        = '_PerformGC_wrapper';
 113     $T_PRE_APP      = '^#'; # regexp that says what comes before APP/NO_APP
 114     $T_CONST_LBL    = '^LC(\d+):$';
 115     $T_POST_LBL     = ':';
 116     $T_X86_PRE_LLBL_PAT = 'L';
 117     $T_X86_PRE_LLBL         = 'L';
 118     $T_X86_BADJMP   = '^\tjmp [^L\*]';
 119
 120     $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+(,0x90)?|\.globl\s+\S+|\.text|\.data|\.stab[^n].*|\.type\s+.*|\.size\s+.*)\n)';
 121     $T_COPY_DIRVS   = '\.(globl|stab)';
 122     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
 123     $T_DOT_WORD     = '\.long';
 124     $T_DOT_GLOBAL   = '\.globl';
 125     $T_HDR_literal  = "\.text\n\t\.align 2\n";
 126     $T_HDR_misc     = "\.text\n\t\.align 2,0x90\n";
 127     $T_HDR_data     = "\.data\n\t\.align 2\n";
 128     $T_HDR_consist  = "\.text\n";
 129     $T_HDR_closure  = "\.data\n\t\.align 2\n";
 130     $T_HDR_info     = "\.text\n\t\.align 2\n"; # NB: requires padding
 131     $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
 132     $T_HDR_fast     = "\.text\n\t\.align 2,0x90\n";
 133     $T_HDR_vector   = "\.text\n\t\.align 2\n"; # NB: requires padding
 134     $T_HDR_direct   = "\.text\n\t\.align 2,0x90\n";
 135
 136     #--------------------------------------------------------#
 137     } elsif ( $TargetPlatform =~ /^i386-.*-(solaris2|linux)$/ ) {
 138
 139     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 140     $T_US           = ''; # _ if symbols have an underscore on the front
 141     $T_DO_GC        = 'PerformGC_wrapper';
 142     $T_PRE_APP      = # regexp that says what comes before APP/NO_APP
 143                       ($TargetPlatform =~ /-linux$/) ? '#' : '/' ;
 144     $T_CONST_LBL    = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
 145     $T_POST_LBL     = ':';
 146     $T_X86_PRE_LLBL_PAT = '\.L';
 147     $T_X86_PRE_LLBL         = '.L';
 148     $T_X86_BADJMP   = '^\tjmp [^\.\*]';
 149
 150     $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+(,0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.Lfe.*\n\t\.size\s+.*|\.size\s+.*|\.ident.*)\n)';
 151     $T_COPY_DIRVS   = '\.(globl)';
 152
 153     $T_hsc_cc_PAT   = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
 154     $T_DOT_WORD     = '\.long';
 155     $T_DOT_GLOBAL   = '\.globl';
 156     $T_HDR_literal  = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11)
 157     $T_HDR_misc     = "\.text\n\t\.align 16\n";
 158     $T_HDR_data     = "\.data\n\t\.align 4\n"; # ToDo: change align??
 159     $T_HDR_consist  = "\.text\n";
 160     $T_HDR_closure  = "\.data\n\t\.align 4\n"; # ToDo: change align?
 161     $T_HDR_info     = "\.text\n\t\.align 16\n"; # NB: requires padding
 162     $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
 163     $T_HDR_fast     = "\.text\n\t\.align 16\n";
 164     $T_HDR_vector   = "\.text\n\t\.align 16\n"; # NB: requires padding
 165     $T_HDR_direct   = "\.text\n\t\.align 16\n";
 166
 167     #--------------------------------------------------------#
 168     } elsif ( $TargetPlatform =~ /^m68k-.*-sunos4/ ) {
 169
 170     $T_STABBY       = 1; # 1 iff .stab things (usually if a.out format)
 171     $T_US           = '_'; # _ if symbols have an underscore on the front
 172     $T_DO_GC        = '_PerformGC_wrapper';
 173     $T_PRE_APP      = '^# MAY NOT APPLY'; # regexp that says what comes before APP/NO_APP
 174     $T_CONST_LBL    = '^LC(\d+):$';
 175     $T_POST_LBL     = ':';
 176
 177     $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.proc\s+\d+|\.const|\.cstring|\.globl\s+\S+|\.text|\.data|\.even|\.stab[^n].*)\n)';
 178     $T_COPY_DIRVS   = '\.(globl|proc|stab)';
 179     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
 180
 181     $T_DOT_WORD     = '\.long';
 182     $T_DOT_GLOBAL   = '\.globl';
 183     $T_HDR_literal  = "\.text\n\t\.even\n";
 184     $T_HDR_misc     = "\.text\n\t\.even\n";
 185     $T_HDR_data     = "\.data\n\t\.even\n";
 186     $T_HDR_consist  = "\.text\n";
 187     $T_HDR_closure  = "\.data\n\t\.even\n";
 188     $T_HDR_info     = "\.text\n\t\.even\n";
 189     $T_HDR_entry    = "\.text\n\t\.even\n";
 190     $T_HDR_fast     = "\.text\n\t\.even\n";
 191     $T_HDR_vector   = "\.text\n\t\.even\n";
 192     $T_HDR_direct   = "\.text\n\t\.even\n";
 193
 194     #--------------------------------------------------------#
 195     } elsif ( $TargetPlatform =~ /^mips-.*/ ) {
 196
 197     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 198     $T_US           = ''; # _ if symbols have an underscore on the front
 199     $T_DO_GC        = 'PerformGC_wrapper';
 200     $T_PRE_APP      = '^\s*#'; # regexp that says what comes before APP/NO_APP
 201     $T_CONST_LBL    = '^\$LC(\d+):$'; # regexp for what such a lbl looks like
 202     $T_POST_LBL     = ':';
 203
 204     $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\.text|\.r?data)\n)';
 205     $T_COPY_DIRVS   = '\.(globl|ent)';
 206
 207     $T_hsc_cc_PAT   = 'I WAS TOO LAZY TO DO THIS BIT (WDP 95/05)';
 208     $T_DOT_WORD     = '\.word';
 209     $T_DOT_GLOBAL   = '^\t\.globl';
 210     $T_HDR_literal  = "\t\.rdata\n\t\.align 2\n";
 211     $T_HDR_misc     = "\t\.text\n\t\.align 2\n";
 212     $T_HDR_data     = "\t\.data\n\t\.align 2\n";
 213     $T_HDR_consist  = 'TOO LAZY TO DO THIS TOO';
 214     $T_HDR_closure  = "\t\.data\n\t\.align 2\n";
 215     $T_HDR_info     = "\t\.text\n\t\.align 2\n";
 216     $T_HDR_entry    = "\t\.text\n\t\.align 2\n";
 217     $T_HDR_fast     = "\t\.text\n\t\.align 2\n";
 218     $T_HDR_vector   = "\t\.text\n\t\.align 2\n";
 219     $T_HDR_direct   = "\t\.text\n\t\.align 2\n";
 220
 221     #--------------------------------------------------------#
 222     } elsif ( $TargetPlatform =~ /^powerpc-.*/ ) {
 223
 224     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 225     $T_US           = ''; # _ if symbols have an underscore on the front
 226     $T_DO_GC        = 'PerformGC_wrapper';
 227     $T_PRE_APP      = 'NOT APPLICABLE'; # regexp that says what comes before APP/NO_APP
 228     $T_CONST_LBL    = '^LC\.\.(\d+):$'; # regexp for what such a lbl looks like
 229     $T_POST_LBL     = ':';
 230
 231     $T_MOVE_DIRVS   = '^(\s*(\.toc|.csect \S+|\.l?globl \S+|\.align \d+)\n)';
 232     $T_COPY_DIRVS   = '\.(l?globl)';
 233
 234     $T_hsc_cc_PAT   = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
 235     $T_DOT_WORD     = '\.long';
 236     $T_DOT_GLOBAL   = '\.globl';
 237     $T_HDR_literal  = "\.section\t\.rodata\n";
 238     $T_HDR_misc     = "\.text\n\t\.align 2\n";
 239     $T_HDR_data     = "\.data\n\t\.align 2\n";
 240     $T_HDR_consist  = "\.text\n";
 241     $T_HDR_closure  = "\.data\n\t\.align 2\n";
 242     $T_HDR_info     = "\.text\n\t\.align 2\n";
 243     $T_HDR_entry    = "\.text\n";
 244     $T_HDR_fast     = "\.text\n\t\.align 2\n";
 245     $T_HDR_vector   = "\.text\n\t\.align 2\n";
 246     $T_HDR_direct   = "\.text\n\t\.align 2\n";
 247
 248     #--------------------------------------------------------#
 249     } elsif ( $TargetPlatform =~ /^sparc-.*-solaris2/ ) {
 250
 251     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 252     $T_US           = ''; # _ if symbols have an underscore on the front
 253     $T_DO_GC        = 'PerformGC_wrapper';
 254     $T_PRE_APP      = 'DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
 255     $T_CONST_LBL    = '^\.LLC(\d+):$'; # regexp for what such a lbl looks like
 256     $T_POST_LBL     = ':';
 257
 258     $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*|\.section.*|\s+\.type.*|\s+\.size.*)\n)';
 259     $T_COPY_DIRVS   = '\.(global|proc|stab)';
 260
 261     $T_hsc_cc_PAT   = '\.asciz.*\)(hsc|cc) (.*)\\\\t(.*)"';
 262     $T_DOT_WORD     = '\.word';
 263     $T_DOT_GLOBAL   = '^\t\.global';
 264     $T_HDR_literal  = "\.text\n\t\.align 8\n";
 265     $T_HDR_misc     = "\.text\n\t\.align 4\n";
 266     $T_HDR_data     = "\.data\n\t\.align 8\n";
 267     $T_HDR_consist  = "\.text\n";
 268     $T_HDR_closure  = "\.data\n\t\.align 4\n";
 269     $T_HDR_info     = "\.text\n\t\.align 4\n";
 270     $T_HDR_entry    = "\.text\n\t\.align 4\n";
 271     $T_HDR_fast     = "\.text\n\t\.align 4\n";
 272     $T_HDR_vector   = "\.text\n\t\.align 4\n";
 273     $T_HDR_direct   = "\.text\n\t\.align 4\n";
 274
 275     #--------------------------------------------------------#
 276     } elsif ( $TargetPlatform =~ /^sparc-.*-sunos4/ ) {
 277
 278     $T_STABBY       = 1; # 1 iff .stab things (usually if a.out format)
 279     $T_US           = '_'; # _ if symbols have an underscore on the front
 280     $T_DO_GC        = '_PerformGC_wrapper';
 281     $T_PRE_APP      = '^# DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
 282     $T_CONST_LBL    = '^LC(\d+):$';
 283     $T_POST_LBL     = ':';
 284
 285     $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*)\n)';
 286     $T_COPY_DIRVS   = '\.(global|proc|stab)';
 287     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
 288
 289     $T_DOT_WORD     = '\.word';
 290     $T_DOT_GLOBAL   = '^\t\.global';
 291     $T_HDR_literal  = "\.text\n\t\.align 8\n";
 292     $T_HDR_misc     = "\.text\n\t\.align 4\n";
 293     $T_HDR_data     = "\.data\n\t\.align 8\n";
 294     $T_HDR_consist  = "\.text\n";
 295     $T_HDR_closure  = "\.data\n\t\.align 4\n";
 296     $T_HDR_info     = "\.text\n\t\.align 4\n";
 297     $T_HDR_entry    = "\.text\n\t\.align 4\n";
 298     $T_HDR_fast     = "\.text\n\t\.align 4\n";
 299     $T_HDR_vector   = "\.text\n\t\.align 4\n";
 300     $T_HDR_direct   = "\.text\n\t\.align 4\n";
 301
 302     #--------------------------------------------------------#
 303     } else {
 304         print STDERR "$Pgm: don't know how to mangle assembly language for: $TargetPlatform\n";
 305         exit 1;
 306     }
 307
 308 if ( 0 ) {
 309 print STDERR "T_STABBY: $T_STABBY\n";
 310 print STDERR "T_US: $T_US\n";
 311 print STDERR "T_DO_GC: $T_DO_GC\n";
 312 print STDERR "T_PRE_APP: $T_PRE_APP\n";
 313 print STDERR "T_CONST_LBL: $T_CONST_LBL\n";
 314 print STDERR "T_POST_LBL: $T_POST_LBL\n";
 315 if ( $TargetPlatform =~ /^i386-/ ) {
 316     print STDERR "T_X86_PRE_LLBL_PAT: $T_X86_PRE_LLBL_PAT\n";
 317     print STDERR "T_X86_PRE_LLBL: $T_X86_PRE_LLBL\n";
 318     print STDERR "T_X86_BADJMP: $T_X86_BADJMP\n";
 319 }
 320 print STDERR "T_MOVE_DIRVS: $T_MOVE_DIRVS\n";
 321 print STDERR "T_COPY_DIRVS: $T_COPY_DIRVS\n";
 322 print STDERR "T_hsc_cc_PAT: $T_hsc_cc_PAT\n";
 323 print STDERR "T_DOT_WORD: $T_DOT_WORD\n";
 324 print STDERR "T_HDR_literal: $T_HDR_literal\n";
 325 print STDERR "T_HDR_misc: $T_HDR_misc\n";
 326 print STDERR "T_HDR_data: $T_HDR_data\n";
 327 print STDERR "T_HDR_consist: $T_HDR_consist\n";
 328 print STDERR "T_HDR_closure: $T_HDR_closure\n";
 329 print STDERR "T_HDR_info: $T_HDR_info\n";
 330 print STDERR "T_HDR_entry: $T_HDR_entry\n";
 331 print STDERR "T_HDR_fast: $T_HDR_fast\n";
 332 print STDERR "T_HDR_vector: $T_HDR_vector\n";
 333 print STDERR "T_HDR_direct: $T_HDR_direct\n";
 334 }
 335
 336 }
 337 \end{code}
 338
 339 %************************************************************************
 340 %*                                                                      *
 341 \subsection{Mangle away}
 342 %*                                                                      *
 343 %************************************************************************
 344
 345 \begin{code}
 346 sub mangle_asm {
 347     local($in_asmf, $out_asmf) = @_;
 348
 349     # multi-line regexp matching:
 350     local($*) = 1;
 351     local($i, $c);
 352
 353
 354     &init_TARGET_STUFF();
 355     &init_FUNNY_THINGS();
 356
 357     # perl4 on alphas SEGVs when give ${foo} substitutions in patterns.
 358     # To avoid them we declare some locals that allows to avoid using curlies.
 359     local($TUS)      = ${T_US};
 360     local($TPOSTLBL) = ${T_POST_LBL};
 361     local($TMOVEDIRVS) = ${T_MOVE_DIRVS};
 362     local($TPREAPP)    = ${T_PRE_APP};
 363     local($TCOPYDIRVS) = ${T_COPY_DIRVS};
 364     local($TDOTWORD)   = ${T_DOT_WORD};
 365
 366     open(INASM, "< $in_asmf")
 367         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
 368     open(OUTASM,"> $out_asmf")
 369         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
 370
 371     # read whole file, divide into "chunks":
 372     #   record some info about what we've found...
 373
 374     @chk = ();          # contents of the chunk
 375     $numchks = 0;       # number of them
 376     @chkcat = ();       # what category of thing in each chunk
 377     @chksymb = ();      # what symbol(base) is defined in this chunk
 378     %slowchk = ();      # ditto, its regular "slow" entry code
 379     %fastchk = ();      # ditto, fast entry code
 380     %closurechk = ();   # ditto, the (static) closure
 381     %infochk = ();      # given a symbol base, say what chunk its info tbl is in
 382     %vectorchk = ();    # ditto, return vector table
 383     %directchk = ();    # ditto, direct return code
 384     $EXTERN_DECLS = ''; # .globl <foo> .text (MIPS only)
 385
 386     $i = 0; $chkcat[0] = 'misc'; $chk[0] = '';
 387
 388     while (<INASM>) {
 389         next if $T_STABBY && /^\.stab.*$TUS[@]?__stg_split_marker/o;
 390         next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
 391         next if /$TPREAPP(NO_)?APP/o;
 392         next if /^;/ && $TargetPlatform =~ /^hppa/;
 393
 394         next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|powerpc)-/;
 395
 396         last if /^_section_\.text:$/ && $TargetPlatform =~ /^powerpc-/;
 397
 398         if ( $TargetPlatform =~ /^mips-/
 399           && /^\t\.(globl \S+ \.text|comm\t)/ ) {
 400             $EXTERN_DECLS .= $_ unless /(__DISCARD__|\b(PK_|ASSIGN_)(FLT|DBL)\b)/;
 401
 402         } elsif ( /^\s+/ ) { # most common case first -- a simple line!
 403             # duplicated from the bottom
 404
 405             $chk[$i] .= $_;
 406
 407         } elsif ( /\.\.ng:$/ && $TargetPlatform =~ /^alpha-/ ) {
 408             # Alphas: Local labels not to be confused with new chunks
 409             $chk[$i] .= $_;
 410
 411         # NB: all the rest start with a non-space
 412
 413         } elsif ( $TargetPlatform =~ /^mips-/
 414                && /^\d+:/ ) { # a funny-looking very-local label
 415             $chk[$i] .= $_;
 416
 417         } elsif ( /$T_CONST_LBL/o ) {
 418             $chk[++$i]   = $_;
 419             $chkcat[$i]  = 'literal';
 420             $chksymb[$i] = $1;
 421
 422         } elsif ( /^$TUS[@]?__stg_split_marker(\d+)$TPOSTLBL[@]?$/o ) {
 423             $chk[++$i]   = $_;
 424             $chkcat[$i]  = 'splitmarker';
 425             $chksymb[$i] = $1;
 426
 427         } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_info$TPOSTLBL[@]?$/o ) {
 428             $symb = $1;
 429             $chk[++$i]   = $_;
 430             $chkcat[$i]  = 'infotbl';
 431             $chksymb[$i] = $symb;
 432
 433             die "Info table already? $symb; $i\n" if defined($infochk{$symb});
 434
 435             $infochk{$symb} = $i;
 436
 437         } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_entry$TPOSTLBL[@]?$/o ) {
 438             $chk[++$i]   = $_;
 439             $chkcat[$i]  = 'slow';
 440             $chksymb[$i] = $1;
 441
 442             $slowchk{$1} = $i;
 443
 444         } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_fast\d+$TPOSTLBL[@]?$/o ) {
 445             $chk[++$i]   = $_;
 446             $chkcat[$i]  = 'fast';
 447             $chksymb[$i] = $1;
 448
 449             $fastchk{$1} = $i;
 450
 451         } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_closure$TPOSTLBL[@]?$/o ) {
 452             $chk[++$i]   = $_;
 453             $chkcat[$i]  = 'closure';
 454             $chksymb[$i] = $1;
 455
 456             $closurechk{$1} = $i;
 457
 458         } elsif ( /^$TUS[@]?ghc.*c_ID$TPOSTLBL/o ) {
 459             $chk[++$i]  = $_;
 460             $chkcat[$i] = 'consist';
 461
 462         } elsif ( /^($TUS[@]?__gnu_compiled_c|gcc2_compiled\.)$TPOSTLBL/o ) {
 463             ; # toss it
 464
 465         } elsif ( /^$TUS[@]?ErrorIO_call_count$TPOSTLBL[@]?$/o  # HACK!!!!
 466                || /^$TUS[A-Za-z0-9_]+\.\d+$TPOSTLBL[@]?$/o
 467                || /^$TUS[@]?.*_CAT$TPOSTLBL[@]?$/o              # PROF: _entryname_CAT
 468                || /^$TUS[@]?CC_.*_struct$TPOSTLBL[@]?$/o        # PROF: _CC_ccident_struct
 469                || /^$TUS[@]?.*_done$TPOSTLBL[@]?$/o             # PROF: _module_done
 470                || /^$TUS[@]?_module_registered$TPOSTLBL[@]?$/o  # PROF: _module_registered
 471                ) {
 472             $chk[++$i]   = $_;
 473             $chkcat[$i]  = 'data';
 474             $chksymb[$i] = '';
 475
 476         } elsif ( /^([A-Za-z0-9_]+)\s+\.comm/ && $TargetPlatform =~ /^hppa/ ) {
 477             $chk[++$i]   = $_;
 478             $chkcat[$i]  = 'bss';
 479             $chksymb[$i] = $1;
 480
 481         } elsif ( /^$TUS[@]?(ret_|djn_)/o ) {
 482             $chk[++$i]   = $_;
 483             $chkcat[$i]  = 'misc';
 484             $chksymb[$i] = '';
 485
 486         } elsif ( /^$TUS[@]?vtbl_([A-Za-z0-9_]+)$TPOSTLBL[@]?$/o ) {
 487             $chk[++$i]   = $_;
 488             $chkcat[$i]  = 'vector';
 489             $chksymb[$i] = $1;
 490
 491             $vectorchk{$1} = $i;
 492
 493         } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)DirectReturn$TPOSTLBL[@]?$/o ) {
 494             $chk[++$i]   = $_;
 495             $chkcat[$i]  = 'direct';
 496             $chksymb[$i] = $1;
 497
 498             $directchk{$1} = $i;
 499
 500         } elsif ( /^$TUS[@]?[A-Za-z0-9_]+_upd$TPOSTLBL[@]?$/o ) {
 501             $chk[++$i]   = $_;
 502             $chkcat[$i]  = 'misc';
 503             $chksymb[$i] = '';
 504
 505         } elsif ( $TargetPlatform =~ /^i386-.*-solaris2/
 506              &&   /^(_uname|uname|stat|fstat):/ ) {
 507             # for some utterly bizarre reason, this platform
 508             # likes to drop little local C routines with these names
 509             # into each and every .o file that #includes the
 510             # relevant system .h file.  Yuck.  We just don't
 511             # tolerate them in .hc files (which we are processing
 512             # here).  If you need to call one of these things from
 513             # Haskell, make a call to your own C wrapper, then
 514             # put that C wrapper (which calls one of these) in a
 515             # plain .c file.  WDP 95/12
 516             $chk[++$i]   = $_;
 517             $chkcat[$i]  = 'toss';
 518             $chksymb[$i] = $1;
 519
 520         } elsif ( /^$TUS[@]?[A-Za-z0-9_]/o
 521                 && ( $TargetPlatform !~ /^hppa/ # need to avoid local labels in this case
 522                    || ! /^L\$\d+$/ )
 523                 && ( $TargetPlatform !~ /^powerpc/ # ditto
 524                    || ! /^(L\.\.\d+|LT\.\..*):$/ ) ) {
 525             local($thing);
 526             chop($thing = $_);
 527             print STDERR "Funny global thing?: $_"
 528                 unless $KNOWN_FUNNY_THING{$thing}
 529                     || /^$TUS[@]?_(PRIn|PRStart).*$TPOSTLBL[@]?$/o # pointer reversal GC routines
 530                     || /^$TUS[@]?CC_.*$TPOSTLBL$/o              # PROF: _CC_ccident  ([@]? is a silly hack (see above))
 531                     || /^$TUS[@]?_reg.*$TPOSTLBL$/o;            # PROF: __reg<module>
 532             $chk[++$i]   = $_;
 533             $chkcat[$i]  = 'misc';
 534             $chksymb[$i] = '';
 535
 536         } else { # simple line (duplicated at the top)
 537
 538             $chk[$i] .= $_;
 539         }
 540     }
 541     $numchks = $#chk + 1;
 542
 543     # the division into chunks is imperfect;
 544     # we throw some things over the fence into the next
 545     # chunk.
 546     #
 547     # also, there are things we would like to know
 548     # about the whole module before we start spitting
 549     # output.
 550
 551     local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-)/) ? 1 : 0;
 552
 553 #   print STDERR "first chunk to mangle: $FIRST_MANGLABLE\n";
 554
 555     # Alphas: NB: we start meddling at chunk 1, not chunk 0
 556     # The first ".rdata" is quite magical; as of GCC 2.7.x, it
 557     # spits a ".quad 0" in after the v first ".rdata"; we
 558     # detect this special case (tossing the ".quad 0")!
 559     local($magic_rdata_seen) = 0;
 560
 561     # HPPAs, MIPSen: also start medding at chunk 1
 562
 563     for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
 564         $c = $chk[$i]; # convenience copy
 565
 566 #       print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
 567
 568         # toss all prologue stuff; HPPA is pretty weird
 569         # (see elsewhere)
 570         $c = &mash_hppa_prologue($c) if $TargetPlatform =~ /^hppa/;
 571
 572         # be slightly paranoid to make sure there's
 573         # nothing surprising in there
 574         if ( $c =~ /--- BEGIN ---/ ) {
 575             if (($p, $r) = split(/--- BEGIN ---/, $c)) {
 576
 577                 if ($TargetPlatform =~ /^i386-/) {
 578                     $p =~ s/^\tpushl \%edi\n//;
 579                     $p =~ s/^\tpushl \%esi\n//;
 580                     $p =~ s/^\tsubl \$\d+,\%esp\n//;
 581                     $p =~ s/^\tmovl \$\d+,\%eax\n\tcall __alloca\n// if ($TargetPlatform =~ /^.*-cygwin32/);
 582                 } elsif ($TargetPlatform =~ /^m68k-/) {
 583                     $p =~ s/^\tlink a6,#-?\d.*\n//;
 584                     $p =~ s/^\tpea a6@\n\tmovel sp,a6\n//;
 585                                 # The above showed up in the asm code,
 586                                 # so I added it here.
 587                                 # I hope it's correct.
 588                                 # CaS
 589                     $p =~ s/^\tmovel d2,sp\@-\n//;
 590                     $p =~ s/^\tmovel d5,sp\@-\n//; # SMmark.* only?
 591                     $p =~ s/^\tmoveml \#0x[0-9a-f]+,sp\@-\n//; # SMmark.* only?
 592                 } elsif ($TargetPlatform =~ /^mips-/) {
 593                     # the .frame/.mask/.fmask that we use is the same
 594                     # as that produced by GCC for miniInterpret; this
 595                     # gives GDB some chance of figuring out what happened
 596                     $FRAME = "\t.frame\t\$sp,2168,\$31\n\t.mask\t0x90000000,-4\n\t.fmask\t0x00000000,0\n";
 597                     $p =~ s/^\t\.(frame).*\n/__FRAME__/g;
 598                     $p =~ s/^\t\.(mask|fmask).*\n//g;
 599                     $p =~ s/^\t\.cprestore.*\n/\t\.cprestore 416\n/; # 16 + 100 4-byte args
 600                     $p =~ s/^\tsubu\t\$sp,\$sp,\d+\n//;
 601                     $p =~ s/^\tsw\t\$31,\d+\(\$sp\)\n//;
 602                     $p =~ s/^\tsw\t\$fp,\d+\(\$sp\)\n//;
 603                     $p =~ s/^\tsw\t\$28,\d+\(\$sp\)\n//;
 604                     $p =~ s/__FRAME__/$FRAME/;
 605                 } else {
 606                     print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n";
 607                 }
 608
 609                 die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/
 610                     && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
 611
 612                 # glue together what's left
 613                 $c = $p . $r;
 614                 $c =~ s/\n\t\n/\n/; # junk blank line
 615             }
 616         }
 617
 618         if ( $TargetPlatform =~ /^mips-/ ) {
 619             # MIPS: first, this basic sequence may occur "--- END ---" or not
 620             $c =~ s/^\tlw\t\$31,\d+\(\$sp\)\n\taddu\t\$sp,\$sp,\d+\n\tj\t\$31\n\t\.end/\t\.end/;
 621         }
 622
 623         # toss all epilogue stuff; again, paranoidly
 624         if ( $c =~ /--- END ---/ ) {
 625             if (($r, $e) = split(/--- END ---/, $c)) {
 626                 if ($TargetPlatform =~ /^i386-/) {
 627                     $e =~ s/^\tret\n//;
 628                     $e =~ s/^\tpopl \%edi\n//;
 629                     $e =~ s/^\tpopl \%esi\n//;
 630                     $e =~ s/^\taddl \$\d+,\%esp\n//;
 631                 } elsif ($TargetPlatform =~ /^m68k-/) {
 632                     $e =~ s/^\tunlk a6\n//;
 633                     $e =~ s/^\trts\n//;
 634                 } elsif ($TargetPlatform =~ /^mips-/) {
 635                     $e =~ s/^\tlw\t\$31,\d+\(\$sp\)\n//;
 636                     $e =~ s/^\tlw\t\$fp,\d+\(\$sp\)\n//;
 637                     $e =~ s/^\taddu\t\$sp,\$sp,\d+\n//;
 638                     $e =~ s/^\tj\t\$31\n//;
 639                 } else {
 640                     print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n";
 641                 }
 642                 die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/
 643                     && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
 644
 645                 # glue together what's left
 646                 $c = $r . $e;
 647                 $c =~ s/\n\t\n/\n/; # junk blank line
 648             }
 649         }
 650
 651         # On SPARCs, we don't do --- BEGIN/END ---, we just
 652         # toss the register-windowing save/restore/ret* instructions
 653         # directly:
 654         if ( $TargetPlatform =~ /^sparc-/ ) {
 655             $c =~ s/^\t(save .*|restore|ret|retl)\n//g;
 656             # throw away PROLOGUE comments
 657             $c =~ s/^\t!#PROLOGUE# 0\n\t!#PROLOGUE# 1\n//;
 658         }
 659
 660         # On Alphas, the prologue mangling is done a little later (below)
 661
 662         # toss all calls to __DISCARD__
 663         $c =~ s/^\t(call|jbsr|jal)\s+$TUS[@]?__DISCARD__\n//go;
 664
 665         # MIPS: that may leave some gratuitous asm macros around
 666         # (no harm done; but we get rid of them to be tidier)
 667         $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/
 668             if $TargetPlatform =~ /^mips-/;
 669
 670         # toss stack adjustment after DoSparks
 671         $c =~ s/^(\tjbsr _DoSparks\n)\taddqw #8,sp/$1/g
 672                 if $TargetPlatform =~ /^m68k-/; # this looks old...
 673
 674         if ( $TargetPlatform =~ /^alpha-/ &&
 675            ! $magic_rdata_seen &&
 676            $c =~ /^\s*\.rdata\n\t\.quad 0\n\t\.align \d\n/ ) {
 677             $c =~ s/^\s*\.rdata\n\t\.quad 0\n\t\.align (\d)\n/\.rdata\n\t\.align $1\n/;
 678             $magic_rdata_seen = 1;
 679         }
 680
 681         # pick some end-things and move them to the next chunk
 682
 683         # pin a funny end-thing on (for easier matching):
 684         $c .= 'FUNNY#END#THING';
 685
 686         while ( $c =~ /$TMOVEDIRVS[@]?FUNNY#END#THING/o ) {  # [@]? is a silly hack to avoid having to use curlies for T_PRE_APP
 687                                                            # (this SEGVs perl4 on alphas, you see)
 688
 689             $to_move = $1;
 690             if ( $i < ($numchks - 1)
 691               && ( $to_move =~ /$TCOPYDIRVS/
 692                 || ($TargetPlatform =~ /^hppa/ && $to_move =~ /align/ && $chkcat[$i+1] eq 'literal') )) {
 693                 $chk[$i + 1] = $to_move . $chk[$i + 1];
 694                 # otherwise they're tossed
 695             }
 696
 697             $c =~ s/$TMOVEDIRVS[@]?FUNNY#END#THING/FUNNY#END#THING/o; # [@]? is a hack (see above)
 698         }
 699
 700         if ( $TargetPlatform =~ /^alpha-/ && $c =~ /^\t\.ent\s+(\S+)/ ) {
 701             $ent = $1;
 702             # toss all prologue stuff, except for loading gp, and the ..ng address
 703             if (($p, $r) = split(/^\t\.prologue/, $c)) {
 704                 if (($keep, $junk) = split(/\.\.ng:/, $p)) {
 705                     $c = $keep . "..ng:\n";
 706                 } else {
 707                     print STDERR "malformed code block ($ent)?\n"
 708                 }
 709             }
 710             $c .= "\t.frame \$30,0,\$26,0\n\t.prologue" . $r;
 711         }
 712
 713         $c =~ s/FUNNY#END#THING//;
 714
 715 #       print STDERR "\nCHK $i (AFTER) (",$chkcat[$i],"):\n", $c;
 716
 717         $chk[$i] = $c; # update w/ convenience copy
 718     }
 719
 720     if ( $TargetPlatform =~ /^alpha-/ ) {
 721         # print out the header stuff first
 722         $chk[0] =~ s/^(\t\.file.*)"(ghc\d+\.c)"/$1"$ifile_root.hc"/;
 723         print OUTASM $chk[0];
 724
 725     } elsif ( $TargetPlatform =~ /^hppa/ ) {
 726         print OUTASM $chk[0];
 727
 728     } elsif ( $TargetPlatform =~ /^mips-/ ) {
 729         $chk[0] = "\t\.file\t1 \"$ifile_root.hc\"\n" . $chk[0];
 730
 731         # get rid of horrible "<dollar>Revision: .*$" strings
 732         local(@lines0) = split(/\n/, $chk[0]);
 733         local($z) = 0;
 734         while ( $z <= $#lines0 ) {
 735             if ( $lines0[$z] =~ /^\t\.byte\t0x24,0x52,0x65,0x76,0x69,0x73,0x69,0x6f$/ ) {
 736                 undef($lines0[$z]);
 737                 $z++;
 738                 while ( $z <= $#lines0 ) {
 739                     undef($lines0[$z]);
 740                     last if $lines0[$z] =~ /[,\t]0x0$/;
 741                     $z++;
 742                 }
 743             }
 744             $z++;
 745         }
 746         $chk[0] = join("\n", @lines0);
 747         $chk[0] =~ s/\n\n+/\n/;
 748         print OUTASM $chk[0];
 749     }
 750
 751     # print out all the literal strings next
 752     for ($i = 0; $i < $numchks; $i++) {
 753         if ( $chkcat[$i] eq 'literal' ) {
 754             print OUTASM $T_HDR_literal, $chk[$i];
 755             print OUTASM "; end literal\n" if $TargetPlatform =~ /^hppa/; # for the splitter
 756
 757             $chkcat[$i] = 'DONE ALREADY';
 758         }
 759     }
 760
 761     # on the HPPA, print out all the bss next
 762     if ( $TargetPlatform =~ /^hppa/ ) {
 763         for ($i = 1; $i < $numchks; $i++) {
 764             if ( $chkcat[$i] eq 'bss' ) {
 765                 print OUTASM "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$BSS\$\n\t.align 4\n";
 766                 print OUTASM $chk[$i];
 767
 768                 $chkcat[$i] = 'DONE ALREADY';
 769             }
 770         }
 771     }
 772
 773     for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
 774 #       print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
 775
 776         next if $chkcat[$i] eq 'DONE ALREADY';
 777
 778         if ( $chkcat[$i] eq 'misc' ) {
 779             if ($chk[$i] ne '') {
 780                 print OUTASM $T_HDR_misc;
 781                 &print_doctored($chk[$i], 0);
 782             }
 783
 784         } elsif ( $chkcat[$i] eq 'toss' ) {
 785             print STDERR "*** NB: TOSSING code for $chksymb[$i] !!! ***\n";
 786
 787         } elsif ( $chkcat[$i] eq 'data' ) {
 788             if ($chk[$i] ne '') {
 789                 print OUTASM $T_HDR_data;
 790                 print OUTASM $chk[$i];
 791             }
 792
 793         } elsif ( $chkcat[$i] eq 'consist' ) {
 794             if ( $chk[$i] =~ /$T_hsc_cc_PAT/o ) {
 795                 local($consist) = "$1.$2.$3";
 796                 $consist =~ s/,/./g;
 797                 $consist =~ s/\//./g;
 798                 $consist =~ s/-/_/g;
 799                 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
 800                 print OUTASM $T_HDR_consist, "${consist}${T_POST_LBL}\n";
 801
 802             } elsif ( $TargetPlatform !~ /^(mips|powerpc)-/ ) { # we just don't try in those case (ToDo)
 803                 # on mips: consistency string is just a v
 804                 # horrible bunch of .bytes,
 805                 # which I am too lazy to sort out (WDP 95/05)
 806
 807                 print STDERR "Couldn't grok consistency: ", $chk[$i];
 808             }
 809
 810         } elsif ( $chkcat[$i] eq 'splitmarker' ) {
 811             # we can just re-constitute this one...
 812             # NB: we emit _three_ underscores no matter what,
 813             # so ghc-split doesn't have to care.
 814             print OUTASM "___stg_split_marker",$chksymb[$i],"${T_POST_LBL}\n";
 815
 816         } elsif ( $chkcat[$i] eq 'closure'
 817                || $chkcat[$i] eq 'infotbl'
 818                || $chkcat[$i] eq 'slow'
 819                || $chkcat[$i] eq 'fast' ) { # do them in that order
 820             $symb = $chksymb[$i];
 821
 822             # CLOSURE
 823             if ( defined($closurechk{$symb}) ) {
 824                 print OUTASM $T_HDR_closure;
 825                 print OUTASM $chk[$closurechk{$symb}];
 826                 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
 827             }
 828
 829             # INFO TABLE
 830             if ( defined($infochk{$symb}) ) {
 831
 832                 print OUTASM $T_HDR_info;
 833                 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
 834                 # entry code will be put here!
 835
 836                 # paranoia
 837                 if ( $chk[$infochk{$symb}] =~ /$TDOTWORD[@]?\s+([A-Za-z0-9_]+_entry)$/o
 838                   && $1 ne "${T_US}${symb}_entry" ) {
 839                     print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
 840                 }
 841
 842                 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
 843             }
 844
 845             # STD ENTRY POINT
 846             if ( defined($slowchk{$symb}) ) {
 847
 848                 # teach it to drop through to the fast entry point:
 849                 $c = $chk[$slowchk{$symb}];
 850
 851                 if ( defined($fastchk{$symb}) ) {
 852                     if ( $TargetPlatform =~ /^alpha-/ ) {
 853                         $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
 854                     } elsif ( $TargetPlatform =~ /^hppa/ ) {
 855                         $c =~ s/^\s+ldil.*\n\s+ldo.*\n\s+bv.*\n(.*\n)?\s+\.EXIT/$1\t.EXIT/;
 856                     } elsif ( $TargetPlatform =~ /^i386-/ ) {
 857                         $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%edx\n\tjmp \*\%edx\n//;
 858                         $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%eax\n\tjmp \*\%eax\n//;
 859                     } elsif ( $TargetPlatform =~ /^mips-/ ) {
 860                         $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
 861                     } elsif ( $TargetPlatform =~ /^m68k-/ ) {
 862                         $c =~ s/^\tjmp ${T_US}${symb}_fast\d+.*\n\tnop\n//;
 863                         $c =~ s/^\tjmp ${T_US}${symb}_fast\d+.*\n//;
 864                     } elsif ( $TargetPlatform =~ /^sparc-/ ) {
 865                         $c =~ s/^\tcall ${T_US}${symb}_fast\d+,.*\n\tnop\n//;
 866                         $c =~ s/^\tcall ${T_US}${symb}_fast\d+,.*\n(\t[a-z].*\n)/$1/;
 867                     } else {
 868                         print STDERR "$Pgm: mystery slow-fast dropthrough: $TargetPlatform\n";
 869                     }
 870                 }
 871
 872                 if ( $TargetPlatform !~ /^(alpha-|hppa|mips-)/ ) {
 873                     # On alphas, hppa: no very good way to look for "dangling"
 874                     # references to fast-entry point.
 875                     # (questionable re hppa and mips...)
 876                     print STDERR "still has jump to fast entry point:\n$c"
 877                         if $c =~ /$TUS[@]?$symb[@]?_fast/; # NB: paranoia
 878                 }
 879
 880                 print OUTASM $T_HDR_entry;
 881
 882                 &print_doctored($c, 1); # NB: the 1!!!
 883
 884                 $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
 885             }
 886
 887             # FAST ENTRY POINT
 888             if ( defined($fastchk{$symb}) ) {
 889                 if ( ! defined($slowchk{$symb})
 890                    # ToDo: the || clause can go once we're no longer
 891                    # concerned about producing exactly the same output as before
 892 #OLD:              || $TargetPlatform =~ /^(m68k|sparc|i386)-/
 893                    ) {
 894                     print OUTASM $T_HDR_fast;
 895                 }
 896                 &print_doctored($chk[$fastchk{$symb}], 0);
 897                 $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
 898             }
 899
 900         } elsif ( $chkcat[$i] eq 'vector'
 901                || $chkcat[$i] eq 'direct' ) { # do them in that order
 902             $symb = $chksymb[$i];
 903
 904             # VECTOR TABLE
 905             if ( defined($vectorchk{$symb}) ) {
 906                 print OUTASM $T_HDR_vector;
 907                 print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
 908                 # direct return code will be put here!
 909                 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
 910             }
 911
 912             # DIRECT RETURN
 913             if ( defined($directchk{$symb}) ) {
 914                 print OUTASM $T_HDR_direct;
 915                 &print_doctored($chk[$directchk{$symb}], 0);
 916                 $chkcat[$directchk{$symb}] = 'DONE ALREADY';
 917
 918             } elsif ( $TargetPlatform =~ /^alpha-/ ) {
 919                 # Alphas: the commented nop is for the splitter, to ensure
 920                 # that no module ends with a label as the very last
 921                 # thing.  (The linker will adjust the label to point
 922                 # to the first code word of the next module linked in,
 923                 # even if alignment constraints cause the label to move!)
 924
 925                 print OUTASM "\t# nop\n";
 926             }
 927
 928         } else {
 929             &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n");
 930         }
 931     }
 932
 933     print OUTASM $EXTERN_DECLS if $TargetPlatform =~ /^mips-/;
 934
 935     print OUTASM ".csect .text[PR]\n_section_.text:\n.csect .data[RW]\n\t.long _section_.text\n"
 936         if $TargetPlatform =~ /^powerpc-/;
 937
 938     # finished
 939     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
 940     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
 941 }
 942 \end{code}
 943
 944 \begin{code}
 945 sub mash_hppa_prologue { # OK, epilogue, too
 946     local($_) = @_;
 947
 948     # toss all prologue stuff
 949     s/^\s+\.ENTRY[^\0]*--- BEGIN ---/\t.ENTRY/;
 950
 951     # Lie about our .CALLINFO
 952     s/^\s+\.CALLINFO.*$/\t.CALLINFO NO_CALLS,NO_UNWIND/;
 953
 954     # Get rid of P'
 955
 956     s/LP'/L'/g;
 957     s/RP'/R'/g;
 958
 959     # toss all epilogue stuff
 960     s/^\s+--- END ---[^\0]*\.EXIT/\t.EXIT/;
 961
 962     # Sorry; we moved the _info stuff to the code segment.
 963     s/_info,DATA/_info,CODE/g;
 964
 965     return($_);
 966 }
 967 \end{code}
 968
 969 \begin{code}
 970 sub print_doctored {
 971     local($_, $need_fallthru_patch) = @_;
 972
 973     if ( $TargetPlatform !~ /^i386-/
 974       || ! /^\t[a-z]/ ) { # no instructions in here, apparently
 975         print OUTASM $_;
 976         return;
 977     }
 978     # OK, must do some x86 **HACKING**
 979
 980     local($entry_patch) = '';
 981     local($exit_patch)  = '';
 982     local($call_entry_patch)= '';
 983     local($call_exit_patch)     = '';
 984
 985 #OLD:   # first, convert calls to *very magic form*: (ToDo: document
 986     # for real!)  from
 987     #
 988     #   pushl $768
 989     #   call _?PerformGC_wrapper
 990     #   addl $4,%esp
 991     # to
 992     #   movl $768, %eax
 993     #   call _?PerformGC_wrapper
 994     #
 995     # The reason we do this now is to remove the apparent use of
 996     # %esp, which would throw off the "what patch code do we need"
 997     # decision.
 998     #
 999     # Special macros in ghc/includes/COptWraps.lh, used in
1000     # ghc/runtime/CallWrap_C.lc, are required for this to work!
1001     #
1002
1003     s/^\tpushl \$(\d+)\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \$$1,\%eax\n\tcall ${T_DO_GC}\n/go;
1004     s/^\tpushl \%eax\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tcall ${T_DO_GC}\n/go;
1005     s/^\tpushl \%edx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%edx,\%eax\n\tcall ${T_DO_GC}\n/go;
1006
1007 #=  if ( $StolenX86Regs <= 4 ) { # %ecx is ordinary reg
1008 #=      s/^\tpushl \%ecx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%ecx,\%eax\n\tcall ${T_DO_GC}\n/go;
1009 #=  }
1010
1011     # gotta watch out for weird instructions that
1012     # invisibly smash various regs:
1013     #   rep*    %ecx used for counting
1014     #   scas*   %edi used for destination index
1015     #   cmps*   %e[sd]i used for indices
1016     #   loop*   %ecx used for counting
1017     #
1018     # SIGH.
1019
1020     # We cater for:
1021     #  * use of STG reg [ nn(%ebx) ] where no machine reg avail
1022     #
1023     #  * GCC used an "STG reg" for its own purposes
1024     #
1025     #  * some secret uses of machine reg, requiring STG reg
1026     #    to be saved/restored
1027
1028     # The most dangerous "GCC uses" of an "STG reg" are when
1029     # the reg holds the target of a jmp -- it's tricky to
1030     # insert the patch-up code before we get to the target!
1031     # So here we change the jmps:
1032
1033     # --------------------------------------------------------
1034     # it can happen that we have jumps of the form...
1035     #   jmp *<something involving %esp>
1036     # or
1037     #   jmp <something involving another naughty register...>
1038     #
1039     # a reasonably-common case is:
1040     #
1041     #   movl $_blah,<bad-reg>
1042     #   jmp  *<bad-reg>
1043     #
1044     # which is easily fixed as:
1045     #
1046     # sigh! try to hack around it...
1047     #
1048
1049     if ($StolenX86Regs <= 2 ) { # YURGH! spurious uses of esi?
1050         s/^\tmovl (.*),\%esi\n\tjmp \*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1051         s/^\tjmp \*(-?\d*)\((.*\%esi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
1052         s/^\tjmp \*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/g;
1053         die "$Pgm: (mangler) still have jump involving \%esi!\n$_"
1054             if /(jmp|call) .*\%esi/;
1055     }
1056     if ($StolenX86Regs <= 3 ) { # spurious uses of edi?
1057         s/^\tmovl (.*),\%edi\n\tjmp \*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1058         s/^\tjmp \*(-?\d*)\((.*\%edi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
1059         s/^\tjmp \*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/g;
1060         die "$Pgm: (mangler) still have jump involving \%edi!\n$_"
1061             if /(jmp|call) .*\%edi/;
1062     }
1063 #=  if ($StolenX86Regs <= 4 ) { # spurious uses of ecx?
1064 #=      s/^\tmovl (.*),\%ecx\n\tjmp \*%ecx\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1065 #=      s/^\tjmp \*(-?\d*)\((.*\%ecx.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
1066 #=      s/^\tjmp \*\%ecx\n/\tmovl \%ecx,\%eax\n\tjmp \*\%eax\n/g;
1067 #=      die "$Pgm: (mangler) still have jump involving \%ecx!\n$_"
1068 #=          if /(jmp|call) .*\%ecx/;
1069 #=  }
1070
1071     # OK, now we can decide what our patch-up code is going to
1072     # be:
1073     if ( $StolenX86Regs <= 2
1074          && ( /32\(\%ebx\)/ || /\%esi/ || /^\tcmps/ ) ) { # R1 (esi)
1075         $entry_patch .= "\tmovl \%esi,32(\%ebx)\n";
1076         $exit_patch  .= "\tmovl 32(\%ebx),\%esi\n";
1077         # nothing for call_{entry,exit} because %esi is callee-save
1078     }
1079     if ( $StolenX86Regs <= 3
1080          && ( /64\(\%ebx\)/ || /\%edi/ || /^\t(scas|cmps)/ ) ) { # SpA (edi)
1081         $entry_patch .= "\tmovl \%edi,64(\%ebx)\n";
1082         $exit_patch  .= "\tmovl 64(\%ebx),\%edi\n";
1083         # nothing for call_{entry,exit} because %edi is callee-save
1084     }
1085 #=  if ( $StolenX86Regs <= 4
1086 #=       && ( /80\(\%ebx\)/ || /\%ecx/ || /^\t(rep|loop)/ ) ) { # Hp (ecx)
1087 #=      $entry_patch .= "\tmovl \%ecx,80(\%ebx)\n";
1088 #=      $exit_patch  .= "\tmovl 80(\%ebx),\%ecx\n";
1089 #=
1090 #=      $call_exit_patch  .= "\tmovl \%ecx,108(\%ebx)\n";
1091 #=      $call_entry_patch .= "\tmovl 108(\%ebx),\%ecx\n";
1092 #=      # I have a really bad feeling about this if we ever
1093 #=      # have a nested call...
1094 #=      # NB: should just hide it somewhere in the C stack.
1095 #=  }
1096     # --------------------------------------------------------
1097     # next, here we go with non-%esp patching!
1098     #
1099     s/^(\t[a-z])/$entry_patch$1/; # before first instruction
1100     s/^(\tcall .*\n(\taddl \$\d+,\%esp\n)?)/$call_exit_patch$1$call_entry_patch/g; # _all_ calls
1101
1102     # fix _all_ non-local jumps:
1103
1104     s/^\tjmp \*${T_X86_PRE_LLBL_PAT}/\tJMP___SL/go;
1105     s/^\tjmp ${T_X86_PRE_LLBL_PAT}/\tJMP___L/go;
1106
1107     s/^(\tjmp .*\n)/$exit_patch$1/g; # here's the fix...
1108
1109     s/^\tJMP___SL/\tjmp \*${T_X86_PRE_LLBL}/go;
1110     s/^\tJMP___L/\tjmp ${T_X86_PRE_LLBL}/go;
1111
1112     # fix post-PerformGC wrapper (re-)entries ???
1113
1114     if ($StolenX86Regs == 2 ) {
1115         die "ARGH! Jump uses \%esi or \%edi with -monly-2-regs:\n$_"
1116             if /^\t(jmp|call) .*\%e(si|di)/;
1117 #=      die "ARGH! Jump uses \%esi, \%edi, or \%ecx with -monly-2-regs:\n$_"
1118 #=          if /^\t(jmp|call) .*\%e(si|di|cx)/;
1119     } elsif ($StolenX86Regs == 3 ) {
1120         die "ARGH! Jump uses \%edi with -monly-3-regs:\n$_"
1121             if /^\t(jmp|call) .*\%edi/;
1122 #=      die "ARGH! Jump uses \%edi or \%ecx with -monly-3-regs:\n$_"
1123 #=          if /^\t(jmp|call) .*\%e(di|cx)/;
1124 #=  } elsif ($StolenX86Regs == 4 ) {
1125 #=      die "ARGH! Jump uses \%ecx with -monly-4-regs:\n$_"
1126 #=          if /^\t(jmp|call) .*\%ecx/;
1127     }
1128
1129     # final peephole fixes
1130
1131     s/^\tmovl \%eax,36\(\%ebx\)\n\tjmp \*36\(\%ebx\)\n/\tmovl \%eax,36\(\%ebx\)\n\tjmp \*\%eax\n/;
1132 # the short form may tickle perl bug:
1133 #    s/^\tmovl \$${T_US}(.*),(\%e[abcd]x)\n\tjmp \*$2/\tjmp $T_US$1/g;
1134     s/^\tmovl \$${T_US}(.*),\%eax\n\tjmp \*\%eax/\tjmp $T_US$1/g;
1135     s/^\tmovl \$${T_US}(.*),\%ebx\n\tjmp \*\%ebx/\tjmp $T_US$1/g;
1136     s/^\tmovl \$${T_US}(.*),\%ecx\n\tjmp \*\%ecx/\tjmp $T_US$1/g;
1137     s/^\tmovl \$${T_US}(.*),\%edx\n\tjmp \*\%edx/\tjmp $T_US$1/g;
1138
1139     # Hacks to eliminate some reloads of Hp.  Worth about 5% code size.
1140     # We could do much better than this, but at least it catches about
1141     # half of the unnecessary reloads.
1142     # Note that these will stop working if either:
1143     #  (i) the offset of Hp from BaseReg changes from 80, or
1144     #  (ii) the register assignment of BaseReg changes from %ebx
1145
1146     s/^\tmovl 80\(\%ebx\),\%e.x\n\tmovl \$(.*),(-?[0-9]*)\(\%e.x\)\n\tmovl 80\(\%ebx\),\%e(.)x/\tmovl 80\(\%ebx\),\%e$3x\n\tmovl \$$1,$2\(\%e$3x\)/g;
1147
1148     s/^\tmovl 80\(\%ebx\),\%e(.)x\n\tmovl (.*),\%e(.)x\n\tmovl \%e$3x,(-?[0-9]*\(\%e$1x\))\n\tmovl 80\(\%ebx\),\%e$1x/\tmovl 80\(\%ebx\),\%e$1x\n\tmovl $2,\%e$3x\n\tmovl \%e$3x,$4/g;
1149
1150     s/^\tmovl 80\(\%ebx\),\%edx((\n\t(movl|addl) .*,((-?[0-9]*\(.*)|(\%e[abc]x)))+)\n\tmovl 80\(\%ebx\),\%edx/\tmovl 80\(\%ebx\),\%edx$1/g;
1151     s/^\tmovl 80\(\%ebx\),\%eax((\n\t(movl|addl) .*,((-?[0-9]*\(.*)|(\%e[bcd]x)))+)\n\tmovl 80\(\%ebx\),\%eax/\tmovl 80\(\%ebx\),\%eax$1/g;
1152
1153     # --------------------------------------------------------
1154     # that's it -- print it
1155     #
1156     #die "Funny jumps?\n$_" if /${T_X86_BADJMP}/o; # paranoia
1157
1158     print OUTASM $_;
1159
1160     if ( $need_fallthru_patch ) { # exit patch for end of slow entry code
1161         print OUTASM $exit_patch;
1162         # ToDo: make it not print if there is a "jmp" at the end
1163     }
1164 }
1165 \end{code}
1166
1167 \begin{code}
1168 sub init_FUNNY_THINGS {
1169     %KNOWN_FUNNY_THING = (
1170         "${T_US}CheckHeapCode${T_POST_LBL}", 1,
1171         "${T_US}CommonUnderflow${T_POST_LBL}", 1,
1172         "${T_US}Continue${T_POST_LBL}", 1,
1173         "${T_US}EnterNodeCode${T_POST_LBL}", 1,
1174         "${T_US}ErrorIO_call_count${T_POST_LBL}", 1,
1175         "${T_US}ErrorIO_innards${T_POST_LBL}", 1,
1176         "${T_US}IndUpdRetDir${T_POST_LBL}", 1,
1177         "${T_US}IndUpdRetV0${T_POST_LBL}", 1,
1178         "${T_US}IndUpdRetV1${T_POST_LBL}", 1,
1179         "${T_US}IndUpdRetV2${T_POST_LBL}", 1,
1180         "${T_US}IndUpdRetV3${T_POST_LBL}", 1,
1181         "${T_US}IndUpdRetV4${T_POST_LBL}", 1,
1182         "${T_US}IndUpdRetV5${T_POST_LBL}", 1,
1183         "${T_US}IndUpdRetV6${T_POST_LBL}", 1,
1184         "${T_US}IndUpdRetV7${T_POST_LBL}", 1,
1185         "${T_US}PrimUnderflow${T_POST_LBL}", 1,
1186         "${T_US}StackUnderflowEnterNode${T_POST_LBL}", 1,
1187         "${T_US}StdErrorCode${T_POST_LBL}", 1,
1188         "${T_US}UnderflowVect0${T_POST_LBL}", 1,
1189         "${T_US}UnderflowVect1${T_POST_LBL}", 1,
1190         "${T_US}UnderflowVect2${T_POST_LBL}", 1,
1191         "${T_US}UnderflowVect3${T_POST_LBL}", 1,
1192         "${T_US}UnderflowVect4${T_POST_LBL}", 1,
1193         "${T_US}UnderflowVect5${T_POST_LBL}", 1,
1194         "${T_US}UnderflowVect6${T_POST_LBL}", 1,
1195         "${T_US}UnderflowVect7${T_POST_LBL}", 1,
1196         "${T_US}UpdErr${T_POST_LBL}", 1,
1197         "${T_US}UpdatePAP${T_POST_LBL}", 1,
1198         "${T_US}WorldStateToken${T_POST_LBL}", 1,
1199         "${T_US}_Enter_Internal${T_POST_LBL}", 1,
1200         "${T_US}_PRMarking_MarkNextAStack${T_POST_LBL}", 1,
1201         "${T_US}_PRMarking_MarkNextBStack${T_POST_LBL}", 1,
1202         "${T_US}_PRMarking_MarkNextCAF${T_POST_LBL}", 1,
1203         "${T_US}_PRMarking_MarkNextGA${T_POST_LBL}", 1,
1204         "${T_US}_PRMarking_MarkNextRoot${T_POST_LBL}", 1,
1205         "${T_US}_PRMarking_MarkNextSpark${T_POST_LBL}", 1,
1206         "${T_US}_PRMarking_MarkNextEvent${T_POST_LBL}", 1,
1207         "${T_US}_PRMarking_MarkNextClosureInFetchBuffer${T_POST_LBL}", 1,
1208         "${T_US}_Scavenge_Forward_Ref${T_POST_LBL}", 1,
1209         "${T_US}__std_entry_error__${T_POST_LBL}", 1,
1210         "${T_US}_startMarkWorld${T_POST_LBL}", 1,
1211         "${T_US}resumeThread${T_POST_LBL}", 1,
1212         "${T_US}startCcRegisteringWorld${T_POST_LBL}", 1,
1213         "${T_US}startEnterFloat${T_POST_LBL}", 1,
1214         "${T_US}startEnterInt${T_POST_LBL}", 1,
1215         "${T_US}startPerformIO${T_POST_LBL}", 1,
1216         "${T_US}startStgWorld${T_POST_LBL}", 1,
1217         "${T_US}stopPerformIO${T_POST_LBL}", 1
1218     );
1219 }
1220 \end{code}
1221
1222 The following table reversal is used for both info tables and return
1223 vectors.  In both cases, we remove the first entry from the table,
1224 reverse the table, put the label at the end, and paste some code
1225 (that which is normally referred to by the first entry in the table)
1226 right after the table itself.  (The code pasting is done elsewhere.)
1227
1228 \begin{code}
1229 sub rev_tbl {
1230     local($symb, $tbl, $discard1) = @_;
1231
1232     local($before) = '';
1233     local($label) = '';
1234     local(@imports) = (); # hppa only
1235     local(@words) = ();
1236     local($after) = '';
1237     local(@lines) = split(/\n/, $tbl);
1238     local($i, $extra, $words_to_pad, $j);
1239
1240     # see comment in mangleAsm as to why this silliness is needed.
1241     local($TDOTWORD) = ${T_DOT_WORD};
1242     local($TDOTGLOBAL) = ${T_DOT_GLOBAL};
1243     local($TUS) = ${T_US};
1244     local($TPOSTLBL) = ${T_POST_LBL};
1245
1246     for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t$TDOTWORD\s+/o; $i++) {
1247         $label .= $lines[$i] . "\n",
1248             next if $lines[$i] =~ /^[A-Za-z0-9_]+_info$TPOSTLBL[@]?$/o
1249                  || $lines[$i] =~ /$TDOTGLOBAL/o
1250                  || $lines[$i] =~ /^$TUS[@]?vtbl_\S+$TPOSTLBL[@]?$/o;
1251
1252         $before .= $lines[$i] . "\n"; # otherwise...
1253     }
1254
1255     if ( $TargetPlatform !~ /^hppa/ ) {
1256         for ( ; $i <= $#lines && $lines[$i] =~ /^\t$TDOTWORD\s+/o; $i++) {
1257             push(@words, $lines[$i]);
1258         }
1259     } else { # hppa weirdness
1260         for ( ; $i <= $#lines && $lines[$i] =~ /^\s+\.(word|IMPORT)/; $i++) {
1261             if ($lines[$i] =~ /^\s+\.IMPORT/) {
1262                 push(@imports, $lines[$i]);
1263             } else {
1264                 # We don't use HP's ``function pointers''
1265                 # We just use labels in code space, like normal people
1266                 $lines[$i] =~ s/P%//;
1267                 push(@words, $lines[$i]);
1268             }
1269         }
1270     }
1271
1272     # now throw away the first word (entry code):
1273     shift(@words) if $discard1;
1274
1275 # Padding removed to reduce code size and improve performance on Pentiums.
1276 # Simon M. 13/4/96
1277     # for 486-cache-friendliness, we want our tables aligned
1278     # on 16-byte boundaries (.align 4).  Let's pad:
1279 #    $extra = ($#words + 1) % 4;
1280 #    $words_to_pad = ($extra == 0) ? 0 : 4 - $extra;
1281 #    for ($j = 0; $j < $words_to_pad; $j++) { push(@words, "\t${T_DOT_WORD} 0"); }
1282
1283     for (; $i <= $#lines; $i++) {
1284         $after .= $lines[$i] . "\n";
1285     }
1286
1287     # Alphas:If we have anonymous text (not part of a procedure), the
1288     # linker may complain about missing exception information.  Bleh.
1289     if ( $TargetPlatform =~ /^alpha-/ && $label =~ /^([A-Za-z0-9_]+):$/) {
1290         $before = "\t.ent $1\n" . $before;
1291         $after .= "\t.end $1\n";
1292     }
1293
1294     $tbl = $before
1295          . (($TargetPlatform !~ /^hppa/) ? '' : join("\n", @imports) . "\n")
1296          . join("\n", (reverse @words)) . "\n"
1297          . $label . $after;
1298
1299 #   print STDERR "before=$before\n";
1300 #   print STDERR "label=$label\n";
1301 #   print STDERR "words=",(reverse @words),"\n";
1302 #   print STDERR "after=$after\n";
1303
1304     $tbl;
1305 }
1306 \end{code}
1307
1308 \begin{code}
1309 sub mini_mangle_asm_i386 {
1310     local($in_asmf, $out_asmf) = @_;
1311
1312     &init_TARGET_STUFF();
1313
1314     # see mangleAsm comment
1315     local($TUS) = ${T_US};
1316     local($TPOSTLBL)=${T_POST_LBL};
1317
1318     open(INASM, "< $in_asmf")
1319         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
1320     open(OUTASM,"> $out_asmf")
1321         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
1322
1323     while (<INASM>) {
1324         print OUTASM;
1325
1326         next unless
1327             /^$TUS[@]?(PerformGC|StackOverflow|Yield|PerformReschedule)_wrapper$TPOSTLBL\n/o;
1328         print OUTASM "\tmovl \%esp, ${T_US}__temp_esp\n";
1329         print OUTASM "\tmovl \%eax, ${T_US}__temp_eax\n";
1330     }
1331
1332     # finished:
1333     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1334     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1335 }
1336 \end{code}
1337
1338 The HP is a major nuisance.  The threaded code mangler moved info
1339 tables from data space to code space, but unthreaded code in the RTS
1340 still has references to info tables in data space.  Since the HP
1341 linker is very precise about where symbols live, we need to patch the
1342 references in the unthreaded RTS as well.
1343
1344 \begin{code}
1345 sub mini_mangle_asm_hppa {
1346     local($in_asmf, $out_asmf) = @_;
1347
1348     open(INASM, "< $in_asmf")
1349         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
1350     open(OUTASM,"> $out_asmf")
1351         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
1352
1353     while (<INASM>) {
1354         s/_info,DATA/_info,CODE/;   # Move _info references to code space
1355         s/P%_PR/_PR/;
1356         print OUTASM;
1357     }
1358
1359     # finished:
1360     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1361     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1362 }
1363
1364 # make "require"r happy...
1365 1;
1366 \end{code}