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