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    = 'NOT APPLICABLE'; # regexp for what such a lbl looks like
 229 #    $T_CONST_LBL    = '^LC\.\.(\d+):$'; # regexp for what such a lbl looks like
 230     $T_POST_LBL     = ':';
 231
 232     $T_MOVE_DIRVS   = '^(\s*(\.toc|\.align \d+|\.csect \S+|\t\.?l?globl \S+)\n)';
 233 #    $T_MOVE_DIRVS  = '^(\s*(\.toc|.csect \S+|\.l?globl \S+|\.align \d+)\n)';
 234     $T_COPY_DIRVS   = '\.(l?globl)';
 235
 236     $T_hsc_cc_PAT   = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
 237     $T_DOT_WORD     = '\.long';
 238     $T_DOT_GLOBAL   = '\.globl';
 239     $T_HDR_toc      = "\.toc\n";
 240     $T_HDR_literal  = "# literal\n\.csect .data[RW]\n\t\.align 2\n"; #not RO!?
 241     $T_HDR_misc     = "# misc\n\.csect \.text[PR]\n\t\.align 2\n";
 242     $T_HDR_data     = "# data\n\.csect \.data[RW]\n\t\.align 2\n";
 243     $T_HDR_consist  = "# consist\n\.csect \.data[RW]\n\t\.align 2\n";
 244     $T_HDR_closure  = "# closure\n\.csect \.data[RW]\n\t\.align 2\n";
 245     $T_HDR_info     = "# info\n\.csect \.data[RW]\n\t\.align 2\n"; #not RO!?
 246     $T_HDR_entry    = "# entry\n";
 247     $T_HDR_fast     = "# fast\n\.csect \.text[PR]\n\t\.align 2\n";
 248     $T_HDR_vector   = "# vector\n\.csect \.data[RW]\n\t\.align 2\n"; #not RO!?
 249     $T_HDR_direct   = "# direct\n";
 250
 251 #   $T_HDR_literal  = "\.section\t\.rodata\n";
 252 #   $T_HDR_misc     = "\.text\n\t\.align 2\n";
 253 #   $T_HDR_data     = "\.data\n\t\.align 2\n";
 254 #   $T_HDR_consist  = "\.text\n";
 255 #   $T_HDR_closure  = "\.data\n\t\.align 2\n";
 256 #   $T_HDR_info     = "\.text\n\t\.align 2\n";
 257 #   $T_HDR_entry    = "\.text\n";
 258 #   $T_HDR_fast     = "\.text\n\t\.align 2\n";
 259 #   $T_HDR_vector   = "\.text\n\t\.align 2\n";
 260 #   $T_HDR_direct   = "\.text\n\t\.align 2\n";
 261
 262     #--------------------------------------------------------#
 263     } elsif ( $TargetPlatform =~ /^sparc-.*-solaris2/ ) {
 264
 265     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 266     $T_US           = ''; # _ if symbols have an underscore on the front
 267     $T_DO_GC        = 'PerformGC_wrapper';
 268     $T_PRE_APP      = 'DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
 269     $T_CONST_LBL    = '^\.LLC(\d+):$'; # regexp for what such a lbl looks like
 270     $T_POST_LBL     = ':';
 271
 272     $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*|\.section.*|\s+\.type.*|\s+\.size.*)\n)';
 273     $T_COPY_DIRVS   = '\.(global|proc|stab)';
 274
 275     $T_hsc_cc_PAT   = '\.asciz.*\)(hsc|cc) (.*)\\\\t(.*)"';
 276     $T_DOT_WORD     = '\.word';
 277     $T_DOT_GLOBAL   = '^\t\.global';
 278     $T_HDR_literal  = "\.text\n\t\.align 8\n";
 279     $T_HDR_misc     = "\.text\n\t\.align 4\n";
 280     $T_HDR_data     = "\.data\n\t\.align 8\n";
 281     $T_HDR_consist  = "\.text\n";
 282     $T_HDR_closure  = "\.data\n\t\.align 4\n";
 283     $T_HDR_info     = "\.text\n\t\.align 4\n";
 284     $T_HDR_entry    = "\.text\n\t\.align 4\n";
 285     $T_HDR_fast     = "\.text\n\t\.align 4\n";
 286     $T_HDR_vector   = "\.text\n\t\.align 4\n";
 287     $T_HDR_direct   = "\.text\n\t\.align 4\n";
 288
 289     #--------------------------------------------------------#
 290     } elsif ( $TargetPlatform =~ /^sparc-.*-sunos4/ ) {
 291
 292     $T_STABBY       = 1; # 1 iff .stab things (usually if a.out format)
 293     $T_US           = '_'; # _ if symbols have an underscore on the front
 294     $T_DO_GC        = '_PerformGC_wrapper';
 295     $T_PRE_APP      = '^# DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
 296     $T_CONST_LBL    = '^LC(\d+):$';
 297     $T_POST_LBL     = ':';
 298
 299     $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*)\n)';
 300     $T_COPY_DIRVS   = '\.(global|proc|stab)';
 301     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
 302
 303     $T_DOT_WORD     = '\.word';
 304     $T_DOT_GLOBAL   = '^\t\.global';
 305     $T_HDR_literal  = "\.text\n\t\.align 8\n";
 306     $T_HDR_misc     = "\.text\n\t\.align 4\n";
 307     $T_HDR_data     = "\.data\n\t\.align 8\n";
 308     $T_HDR_consist  = "\.text\n";
 309     $T_HDR_closure  = "\.data\n\t\.align 4\n";
 310     $T_HDR_info     = "\.text\n\t\.align 4\n";
 311     $T_HDR_entry    = "\.text\n\t\.align 4\n";
 312     $T_HDR_fast     = "\.text\n\t\.align 4\n";
 313     $T_HDR_vector   = "\.text\n\t\.align 4\n";
 314     $T_HDR_direct   = "\.text\n\t\.align 4\n";
 315
 316     #--------------------------------------------------------#
 317     } else {
 318         print STDERR "$Pgm: don't know how to mangle assembly language for: $TargetPlatform\n";
 319         exit 1;
 320     }
 321
 322 if ( 0 ) {
 323 print STDERR "T_STABBY: $T_STABBY\n";
 324 print STDERR "T_US: $T_US\n";
 325 print STDERR "T_DO_GC: $T_DO_GC\n";
 326 print STDERR "T_PRE_APP: $T_PRE_APP\n";
 327 print STDERR "T_CONST_LBL: $T_CONST_LBL\n";
 328 print STDERR "T_POST_LBL: $T_POST_LBL\n";
 329 if ( $TargetPlatform =~ /^i386-/ ) {
 330     print STDERR "T_X86_PRE_LLBL_PAT: $T_X86_PRE_LLBL_PAT\n";
 331     print STDERR "T_X86_PRE_LLBL: $T_X86_PRE_LLBL\n";
 332     print STDERR "T_X86_BADJMP: $T_X86_BADJMP\n";
 333 }
 334 print STDERR "T_MOVE_DIRVS: $T_MOVE_DIRVS\n";
 335 print STDERR "T_COPY_DIRVS: $T_COPY_DIRVS\n";
 336 print STDERR "T_hsc_cc_PAT: $T_hsc_cc_PAT\n";
 337 print STDERR "T_DOT_WORD: $T_DOT_WORD\n";
 338 print STDERR "T_HDR_literal: $T_HDR_literal\n";
 339 print STDERR "T_HDR_misc: $T_HDR_misc\n";
 340 print STDERR "T_HDR_data: $T_HDR_data\n";
 341 print STDERR "T_HDR_consist: $T_HDR_consist\n";
 342 print STDERR "T_HDR_closure: $T_HDR_closure\n";
 343 print STDERR "T_HDR_info: $T_HDR_info\n";
 344 print STDERR "T_HDR_entry: $T_HDR_entry\n";
 345 print STDERR "T_HDR_fast: $T_HDR_fast\n";
 346 print STDERR "T_HDR_vector: $T_HDR_vector\n";
 347 print STDERR "T_HDR_direct: $T_HDR_direct\n";
 348 }
 349
 350 }
 351 \end{code}
 352
 353 %************************************************************************
 354 %*                                                                      *
 355 \subsection{Mangle away}
 356 %*                                                                      *
 357 %************************************************************************
 358
 359 \begin{code}
 360 sub mangle_asm {
 361     local($in_asmf, $out_asmf) = @_;
 362
 363     # multi-line regexp matching:
 364     local($*) = 1;
 365     local($i, $c);
 366
 367
 368     &init_TARGET_STUFF();
 369     &init_FUNNY_THINGS();
 370
 371     # perl4 on alphas SEGVs when give ${foo} substitutions in patterns.
 372     # To avoid them we declare some locals that allows to avoid using curlies.
 373     local($TUS)      = ${T_US};
 374     local($TPOSTLBL) = ${T_POST_LBL};
 375     local($TMOVEDIRVS) = ${T_MOVE_DIRVS};
 376     local($TPREAPP)    = ${T_PRE_APP};
 377     local($TCOPYDIRVS) = ${T_COPY_DIRVS};
 378     local($TDOTWORD)   = ${T_DOT_WORD};
 379
 380     open(INASM, "< $in_asmf")
 381         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
 382     open(OUTASM,"> $out_asmf")
 383         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
 384
 385     # read whole file, divide into "chunks":
 386     #   record some info about what we've found...
 387
 388     @chk = ();          # contents of the chunk
 389     $numchks = 0;       # number of them
 390     @chkcat = ();       # what category of thing in each chunk
 391     @chksymb = ();      # what symbol(base) is defined in this chunk
 392     %slowchk = ();      # ditto, its regular "slow" entry code
 393     %fastchk = ();      # ditto, fast entry code
 394     %closurechk = ();   # ditto, the (static) closure
 395     %infochk = ();      # given a symbol base, say what chunk its info tbl is in
 396     %vectorchk = ();    # ditto, return vector table
 397     %directchk = ();    # ditto, direct return code
 398     $EXTERN_DECLS = ''; # .globl <foo> .text (MIPS only)
 399
 400     $i = 0; $chkcat[0] = 'misc'; $chk[0] = '';
 401
 402     while (<INASM>) {
 403         next if $T_STABBY && /^\.stab.*$TUS[@]?__stg_split_marker/o;
 404         next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
 405         next if /$TPREAPP(NO_)?APP/o;
 406         next if /^;/ && $TargetPlatform =~ /^hppa/;
 407
 408         next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|powerpc)-/;
 409
 410         last if /^_section_\.text:$/ && $TargetPlatform =~ /^powerpc-/;
 411
 412         if ( $TargetPlatform =~ /^mips-/
 413           && /^\t\.(globl \S+ \.text|comm\t)/ ) {
 414             $EXTERN_DECLS .= $_ unless /(__DISCARD__|\b(PK_|ASSIGN_)(FLT|DBL)\b)/;
 415
 416         } elsif ( /^\s+/ ) { # most common case first -- a simple line!
 417             # duplicated from the bottom
 418
 419             $chk[$i] .= $_;
 420
 421         } elsif ( /\.\.ng:$/ && $TargetPlatform =~ /^alpha-/ ) {
 422             # Alphas: Local labels not to be confused with new chunks
 423             $chk[$i] .= $_;
 424
 425         # NB: all the rest start with a non-space
 426
 427         } elsif ( $TargetPlatform =~ /^mips-/
 428                && /^\d+:/ ) { # a funny-looking very-local label
 429             $chk[$i] .= $_;
 430
 431         } elsif ( /$T_CONST_LBL/o ) {
 432             $chk[++$i]   = $_;
 433             $chkcat[$i]  = 'literal';
 434             $chksymb[$i] = $1;
 435
 436         } elsif ( /^$TUS[@]?__stg_split_marker(\d+)$TPOSTLBL[@]?$/o ) {
 437             $chk[++$i]   = $_;
 438             $chkcat[$i]  = 'splitmarker';
 439             $chksymb[$i] = $1;
 440
 441         } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_info$TPOSTLBL[@]?$/o ) {
 442             $symb = $1;
 443             $chk[++$i]   = $_;
 444             $chkcat[$i]  = 'infotbl';
 445             $chksymb[$i] = $symb;
 446
 447             die "Info table already? $symb; $i\n" if defined($infochk{$symb});
 448
 449             $infochk{$symb} = $i;
 450
 451         } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_entry$TPOSTLBL[@]?$/o ) {
 452             $chk[++$i]   = $_;
 453             $chkcat[$i]  = 'slow';
 454             $chksymb[$i] = $1;
 455
 456             $slowchk{$1} = $i;
 457
 458         } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_fast\d+$TPOSTLBL[@]?$/o ) {
 459             $chk[++$i]   = $_;
 460             $chkcat[$i]  = 'fast';
 461             $chksymb[$i] = $1;
 462
 463             $fastchk{$1} = $i;
 464
 465         } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_closure$TPOSTLBL[@]?$/o ) {
 466             $chk[++$i]   = $_;
 467             $chkcat[$i]  = 'closure';
 468             $chksymb[$i] = $1;
 469
 470             $closurechk{$1} = $i;
 471
 472         } elsif ( /^$TUS[@]?ghc.*c_ID$TPOSTLBL/o ) {
 473             $chk[++$i]  = $_;
 474             $chkcat[$i] = 'consist';
 475
 476         } elsif ( /^($TUS[@]?__gnu_compiled_c|gcc2_compiled\.)$TPOSTLBL/o ) {
 477             ; # toss it
 478
 479         } elsif ( /^$TUS[@]?ErrorIO_call_count$TPOSTLBL[@]?$/o  # HACK!!!!
 480                || /^$TUS[A-Za-z0-9_]+\.\d+$TPOSTLBL[@]?$/o
 481                || /^$TUS[@]?.*_CAT$TPOSTLBL[@]?$/o              # PROF: _entryname_CAT
 482                || /^$TUS[@]?CC_.*_struct$TPOSTLBL[@]?$/o        # PROF: _CC_ccident_struct
 483                || /^$TUS[@]?.*_done$TPOSTLBL[@]?$/o             # PROF: _module_done
 484                || /^$TUS[@]?_module_registered$TPOSTLBL[@]?$/o  # PROF: _module_registered
 485                ) {
 486             $chk[++$i]   = $_;
 487             $chkcat[$i]  = 'data';
 488             $chksymb[$i] = '';
 489
 490         } elsif ( /^([A-Za-z0-9_]+)\s+\.comm/ && $TargetPlatform =~ /^hppa/ ) {
 491             $chk[++$i]   = $_;
 492             $chkcat[$i]  = 'bss';
 493             $chksymb[$i] = $1; # useless, $1 is always '', since we end up using the second
 494                                # pattern /^hppa/. Change $1 to ''. Or reverse the pattern.
 495                                # Anyway, it is never used. - andre
 496             $chksymb[$i] = $1;
 497
 498         } elsif ( $TargetPlatform =~ /^powerpc-/ && /^LC\.\.([0-9]+)/ ) {
 499 #       } elsif ( /^LC\.\.([0-9]+)/ && $TargetPlatform =~ /^powerpc-/ ) {
 500             $chk[++$i]   = $_;
 501             $chkcat[$i]  = 'toc';
 502             $chksymb[$i] = $1;
 503
 504         } elsif ( /^$TUS[@]?(ret_|djn_)/o ) {
 505             $chk[++$i]   = $_;
 506             $chkcat[$i]  = 'misc';
 507             $chksymb[$i] = '';
 508             $symbtmp = $1;
 509             $chksymb[$i] = $symbtmp if ($TargetPlatform =~ /^powerpc-/) ;
 510
 511         } elsif ( /^$TUS[@]?vtbl_([A-Za-z0-9_]+)$TPOSTLBL[@]?$/o ) {
 512             $chk[++$i]   = $_;
 513             $chkcat[$i]  = 'vector';
 514             $chksymb[$i] = $1;
 515
 516             $vectorchk{$1} = $i;
 517
 518         } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)DirectReturn$TPOSTLBL[@]?$/o ) {
 519             $chk[++$i]   = $_;
 520             $chkcat[$i]  = 'direct';
 521             $chksymb[$i] = $1;
 522
 523             $directchk{$1} = $i;
 524
 525         } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_upd$TPOSTLBL[@]?$/o ) {
 526             $chk[++$i]   = $_;
 527             $chkcat[$i]  = 'misc';
 528             if ($TargetPlatform =~ /^powerpc-/)
 529                { $chksymb[$i] = $symbtmp;}
 530             else { $chksymb[$i] = ''; };
 531
 532
 533         } elsif ( $TargetPlatform =~ /^i386-.*-solaris2/
 534              &&   /^(_uname|uname|stat|fstat):/ ) {
 535             # for some utterly bizarre reason, this platform
 536             # likes to drop little local C routines with these names
 537             # into each and every .o file that #includes the
 538             # relevant system .h file.  Yuck.  We just don't
 539             # tolerate them in .hc files (which we are processing
 540             # here).  If you need to call one of these things from
 541             # Haskell, make a call to your own C wrapper, then
 542             # put that C wrapper (which calls one of these) in a
 543             # plain .c file.  WDP 95/12
 544             $chk[++$i]   = $_;
 545             $chkcat[$i]  = 'toss';
 546             $chksymb[$i] = $1;
 547
 548         } elsif ( /^$TUS[@]?[A-Za-z0-9_]/o
 549                 && ( $TargetPlatform !~ /^hppa/ # need to avoid local labels in this case
 550                    || ! /^L\$\d+$/ )
 551                 && ( $TargetPlatform !~ /^powerpc/ # ditto
 552                    || ! /^(L\.\.\d+|LT\.\..*):$/ ) ) {
 553             local($thing);
 554             chop($thing = $_);
 555             print STDERR "Funny global thing?: $_"
 556                 unless $KNOWN_FUNNY_THING{$thing}
 557                     || /^$TUS[@]?_(PRIn|PRStart).*$TPOSTLBL[@]?$/o # pointer reversal GC routines
 558                     || /^$TUS[@]?CC_.*$TPOSTLBL$/o              # PROF: _CC_ccident  ([@]? is a silly hack (see above))
 559                     || /^$TUS[@]?_reg.*$TPOSTLBL$/o;            # PROF: __reg<module>
 560             $chk[++$i]   = $_;
 561             $chkcat[$i]  = 'misc';
 562             if ($TargetPlatform =~ /^powerpc-/)
 563                { $chksymb[$i] = $thing; }
 564             else { $chksymb[$i] = ''; };
 565
 566         } else { # simple line (duplicated at the top)
 567
 568             $chk[$i] .= $_;
 569         }
 570     }
 571     $numchks = $#chk + 1;
 572
 573     # the division into chunks is imperfect;
 574     # we throw some things over the fence into the next
 575     # chunk.
 576     #
 577     # also, there are things we would like to know
 578     # about the whole module before we start spitting
 579     # output.
 580
 581     local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-|power)/) ? 1 : 0;
 582
 583 #   print STDERR "first chunk to mangle: $FIRST_MANGLABLE\n";
 584
 585     # Alphas: NB: we start meddling at chunk 1, not chunk 0
 586     # The first ".rdata" is quite magical; as of GCC 2.7.x, it
 587     # spits a ".quad 0" in after the v first ".rdata"; we
 588     # detect this special case (tossing the ".quad 0")!
 589     local($magic_rdata_seen) = 0;
 590
 591     # HPPAs, MIPSen: also start medding at chunk 1
 592
 593 # AIX hack for the moment, to join up multiple identical tocs
 594     if ($TargetPlatform =~ /^powerpc/) {
 595     print OUTASM ".toc\n.csect .text[PR]\ngcc2_compiled.:\n__gnu_compiled_c:\n";
 596 #   print OUTASM ".csect _ghc88142.rw_c[RW]\n\t.align 2\nghc_cc_ID:\n\t.byte \"@(#)cc prelude/Prelude.hc\"\n\t.byte 9\n\t.byte "35.0,,"\n\t.byte 0"
 597     print OUTASM $T_HDR_toc;
 598     %tocequiv = ();          # maps toc symbol number to toc symbol
 599     %revtocequiv = ();       # maps toc symbol to toc symbol number
 600     for ($i = 1; $i < $numchks; $i++) {
 601         $chk[$i] =~ s/\[RW\]//g;
 602         $chk[$i] =~ s/\[DS\]//g;
 603         $chk[$i] =~ s/^\.csect .*\[DS\]$//g;
 604         if ( $chkcat[$i] eq 'toc' && $chk[$i] !~ /\.byte/ )
 605            { $chk[$i] =~ s/$T_MOVE_DIRVS//g;
 606              $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(\S+_fast\d+)/\t\.tc \1\[TC\],\.\2/;
 607              $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(\S+_entry)\n/\t\.tc \1\[TC\],\.\2\n/;
 608              $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(ret_\S+)/\t\.tc \1\[TC\],\.\2/;
 609              $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(djn_\S+)/\t\.tc \1\[TC\],\.\2/;
 610              $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(vtbl_\S+)/\t\.tc \1\[TC\],\.\2/;
 611              $chk[$i] =~ s/\t\.tc (\S+)\[TC\],ErrorIO_innards/\t\.tc \1\[TC\],\.ErrorIO_innards/;
 612              $chk[$i] =~ s/\t\.tc (\S+)\[TC\],startStgWorld/\t\.tc \1\[TC\],\.startStgWorld/;
 613              $chk[$i] =~ s/\.tc UpdatePAP\[TC\],UpdatePAP/\.tc UpdatePAP\[TC\],\.UpdatePAP/;
 614              $chk[$i] =~ s/\.tc IndUpdRetDir\[TC\],IndUpdRetDir/\.tc IndUpdRetDir\[TC\],\.IndUpdRetDir/;
 615              $chk[$i] =~ s/\t\.tc (_PRStart_\S+)\[TC\],_PRStart_\S+/\t\.tc \1\[TC\],\.\1/;
 616
 617              $tocnumber = $chksymb[$i];
 618              $tocsymb = $chk[$i];
 619              $tocsymb =~ s/^LC\.\.\d+:\n//;
 620              $tocsymb =~ s/^\t\.tc \S+,(\S+)\n/\1/;
 621              $tocequiv{$tocnumber} = $tocsymb;
 622
 623              # limit is the limit of the scope of the current toc (either eof or find a new toc)
 624              $limit = $i;
 625              while ($chkcat[$limit] eq 'toc') {$limit++;};
 626              while (($limit < $numchks) && ($chkcat[$limit] ne 'toc')) {$limit++;};
 627
 628              if ( $revtocequiv{$tocsymb} eq '') {
 629                $revtocequiv{$tocsymb} = $tocnumber;
 630                if (   $chk[$i] !~ /\.tc \S+_fast\d+\[TC\],\.\S+_fast\d+/ # no need to print these
 631                    || $chk[$i] !~ /\.tc UpdatePAP\[TC\],\.UpdatePAP/
 632                    || $chk[$i] !~ /\.tc \S+\[TC\],\.\S+_entry\n/ )
 633                  { print OUTASM $chk[$i]; };
 634              } else {
 635                for ($j = $i; $j <= $limit; $j++) {
 636                  $chk[$j] =~ s/LC\.\.$tocnumber\(/LC\.\.${revtocequiv{$tocsymb}}\(/g;
 637                };
 638              };
 639              $chkcat[$i] = 'DONE ALREADY';
 640              }
 641             }
 642          };
 643
 644     for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
 645         $c = $chk[$i]; # convenience copy
 646
 647 #       print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
 648
 649         # toss all prologue stuff; HPPA is pretty weird
 650         # (see elsewhere)
 651         $c = &mash_hppa_prologue($c) if $TargetPlatform =~ /^hppa/;
 652
 653         # be slightly paranoid to make sure there's
 654         # nothing surprising in there
 655         if ( $c =~ /--- BEGIN ---/ ) {
 656             if (($p, $r) = split(/--- BEGIN ---/, $c)) {
 657
 658                 if ($TargetPlatform =~ /^i386-/) {
 659                     $p =~ s/^\tpushl \%edi\n//;
 660                     $p =~ s/^\tpushl \%esi\n//;
 661                     $p =~ s/^\tsubl \$\d+,\%esp\n//;
 662                     $p =~ s/^\tmovl \$\d+,\%eax\n\tcall __alloca\n// if ($TargetPlatform =~ /^.*-cygwin32/);
 663                 } elsif ($TargetPlatform =~ /^m68k-/) {
 664                     $p =~ s/^\tlink a6,#-?\d.*\n//;
 665                     $p =~ s/^\tpea a6@\n\tmovel sp,a6\n//;
 666                                 # The above showed up in the asm code,
 667                                 # so I added it here.
 668                                 # I hope it's correct.
 669                                 # CaS
 670                     $p =~ s/^\tmovel d2,sp\@-\n//;
 671                     $p =~ s/^\tmovel d5,sp\@-\n//; # SMmark.* only?
 672                     $p =~ s/^\tmoveml \#0x[0-9a-f]+,sp\@-\n//; # SMmark.* only?
 673                 } elsif ($TargetPlatform =~ /^mips-/) {
 674                     # the .frame/.mask/.fmask that we use is the same
 675                     # as that produced by GCC for miniInterpret; this
 676                     # gives GDB some chance of figuring out what happened
 677                     $FRAME = "\t.frame\t\$sp,2168,\$31\n\t.mask\t0x90000000,-4\n\t.fmask\t0x00000000,0\n";
 678                     $p =~ s/^\t\.(frame).*\n/__FRAME__/g;
 679                     $p =~ s/^\t\.(mask|fmask).*\n//g;
 680                     $p =~ s/^\t\.cprestore.*\n/\t\.cprestore 416\n/; # 16 + 100 4-byte args
 681                     $p =~ s/^\tsubu\t\$sp,\$sp,\d+\n//;
 682                     $p =~ s/^\tsw\t\$31,\d+\(\$sp\)\n//;
 683                     $p =~ s/^\tsw\t\$fp,\d+\(\$sp\)\n//;
 684                     $p =~ s/^\tsw\t\$28,\d+\(\$sp\)\n//;
 685                     $p =~ s/__FRAME__/$FRAME/;
 686                 } elsif ($TargetPlatform =~ /^powerpc-/) {
 687                     $p =~ s/^\tmflr 0\n//;
 688                     $p =~ s/^\tstm \d+,-\d+\(1\)\n//;
 689                     $p =~ s/^\tst 0,\d+\(1\)\n//;
 690                     $p =~ s/^\tstu 1,-\d+\(1\)\n//;
 691                 } else {
 692                     print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n";
 693                 }
 694
 695                 die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/
 696                     && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
 697
 698                 # glue together what's left
 699                 $c = $p . $r;
 700                 $c =~ s/\n\t\n/\n/; # junk blank line
 701             }
 702         }
 703
 704         if ( $TargetPlatform =~ /^mips-/ ) {
 705             # MIPS: first, this basic sequence may occur "--- END ---" or not
 706             $c =~ s/^\tlw\t\$31,\d+\(\$sp\)\n\taddu\t\$sp,\$sp,\d+\n\tj\t\$31\n\t\.end/\t\.end/;
 707         }
 708
 709         # toss all epilogue stuff; again, paranoidly
 710         if ( $c =~ /--- END ---/ ) {
 711             if (($r, $e) = split(/--- END ---/, $c)) {
 712                 if ($TargetPlatform =~ /^i386-/) {
 713                     $e =~ s/^\tret\n//;
 714                     $e =~ s/^\tpopl \%edi\n//;
 715                     $e =~ s/^\tpopl \%esi\n//;
 716                     $e =~ s/^\taddl \$\d+,\%esp\n//;
 717                 } elsif ($TargetPlatform =~ /^m68k-/) {
 718                     $e =~ s/^\tunlk a6\n//;
 719                     $e =~ s/^\trts\n//;
 720                 } elsif ($TargetPlatform =~ /^mips-/) {
 721                     $e =~ s/^\tlw\t\$31,\d+\(\$sp\)\n//;
 722                     $e =~ s/^\tlw\t\$fp,\d+\(\$sp\)\n//;
 723                     $e =~ s/^\taddu\t\$sp,\$sp,\d+\n//;
 724                     $e =~ s/^\tj\t\$31\n//;
 725                 } elsif ($TargetPlatform =~ /^powerpc-/) {
 726                     $e =~ s/^\cal 1,\d+\(1\)\n//;
 727                     $e =~ s/^\tl \d+,\d+\(1\)\n//;
 728                     $e =~ s/^\tmtlr 0\n//;
 729                     $e =~ s/^\tbr\n//;
 730                 } else {
 731                     print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n";
 732                 }
 733                 die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/
 734                     && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
 735
 736                 # glue together what's left
 737                 $c = $r . $e;
 738                 $c =~ s/\n\t\n/\n/; # junk blank line
 739             }
 740         }
 741
 742         # On SPARCs, we don't do --- BEGIN/END ---, we just
 743         # toss the register-windowing save/restore/ret* instructions
 744         # directly:
 745         if ( $TargetPlatform =~ /^sparc-/ ) {
 746             $c =~ s/^\t(save .*|restore|ret|retl)\n//g;
 747             # throw away PROLOGUE comments
 748             $c =~ s/^\t!#PROLOGUE# 0\n\t!#PROLOGUE# 1\n//;
 749         }
 750
 751         # On Alphas, the prologue mangling is done a little later (below)
 752
 753         # toss all calls to __DISCARD__
 754         $c =~ s/^\t(call|jbsr|jal)\s+$TUS[@]?__DISCARD__\n//go;
 755
 756         # MIPS: that may leave some gratuitous asm macros around
 757         # (no harm done; but we get rid of them to be tidier)
 758         $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/
 759             if $TargetPlatform =~ /^mips-/;
 760
 761         # toss stack adjustment after DoSparks
 762         $c =~ s/^(\tjbsr _DoSparks\n)\taddqw #8,sp/$1/g
 763                 if $TargetPlatform =~ /^m68k-/; # this looks old...
 764
 765         if ( $TargetPlatform =~ /^alpha-/ &&
 766            ! $magic_rdata_seen &&
 767            $c =~ /^\s*\.rdata\n\t\.quad 0\n\t\.align \d\n/ ) {
 768             $c =~ s/^\s*\.rdata\n\t\.quad 0\n\t\.align (\d)\n/\.rdata\n\t\.align $1\n/;
 769             $magic_rdata_seen = 1;
 770         }
 771
 772         # pick some end-things and move them to the next chunk
 773
 774         # pin a funny end-thing on (for easier matching):
 775         $c .= 'FUNNY#END#THING';
 776
 777         while ( $c =~ /$TMOVEDIRVS[@]?FUNNY#END#THING/o ) {  # [@]? is a silly hack to avoid having to use curlies for T_PRE_APP
 778                                                            # (this SEGVs perl4 on alphas, you see)
 779
 780             $to_move = $1;
 781             if ( $i < ($numchks - 1)
 782               && ( $to_move =~ /$TCOPYDIRVS/
 783                 || ($TargetPlatform =~ /^hppa/ && $to_move =~ /align/ && $chkcat[$i+1] eq 'literal') )) {
 784                 $chk[$i + 1] = $to_move . $chk[$i + 1];
 785                 # otherwise they're tossed
 786             }
 787
 788             $c =~ s/$TMOVEDIRVS[@]?FUNNY#END#THING/FUNNY#END#THING/o; # [@]? is a hack (see above)
 789         }
 790
 791         if ( $TargetPlatform =~ /^alpha-/ && $c =~ /^\t\.ent\s+(\S+)/ ) {
 792             $ent = $1;
 793             # toss all prologue stuff, except for loading gp, and the ..ng address
 794             if (($p, $r) = split(/^\t\.prologue/, $c)) {
 795                 if (($keep, $junk) = split(/\.\.ng:/, $p)) {
 796                     $c = $keep . "..ng:\n";
 797                 } else {
 798                     print STDERR "malformed code block ($ent)?\n"
 799                 }
 800             }
 801             $c .= "\t.frame \$30,0,\$26,0\n\t.prologue" . $r;
 802         }
 803
 804         $c =~ s/FUNNY#END#THING//;
 805
 806 #       print STDERR "\nCHK $i (AFTER) (",$chkcat[$i],"):\n", $c;
 807
 808         $chk[$i] = $c; # update w/ convenience copy
 809     }
 810
 811     if ( $TargetPlatform =~ /^alpha-/ ) {
 812         # print out the header stuff first
 813         $chk[0] =~ s/^(\t\.file.*)"(ghc\d+\.c)"/$1"$ifile_root.hc"/;
 814         print OUTASM $chk[0];
 815
 816     } elsif ( $TargetPlatform =~ /^hppa/ ) {
 817         print OUTASM $chk[0];
 818
 819     } elsif ( $TargetPlatform =~ /^mips-/ ) {
 820         $chk[0] = "\t\.file\t1 \"$ifile_root.hc\"\n" . $chk[0];
 821
 822         # get rid of horrible "<dollar>Revision: .*$" strings
 823         local(@lines0) = split(/\n/, $chk[0]);
 824         local($z) = 0;
 825         while ( $z <= $#lines0 ) {
 826             if ( $lines0[$z] =~ /^\t\.byte\t0x24,0x52,0x65,0x76,0x69,0x73,0x69,0x6f$/ ) {
 827                 undef($lines0[$z]);
 828                 $z++;
 829                 while ( $z <= $#lines0 ) {
 830                     undef($lines0[$z]);
 831                     last if $lines0[$z] =~ /[,\t]0x0$/;
 832                     $z++;
 833                 }
 834             }
 835             $z++;
 836         }
 837         $chk[0] = join("\n", @lines0);
 838         $chk[0] =~ s/\n\n+/\n/;
 839         print OUTASM $chk[0];
 840     }
 841
 842     # print out all the literal strings next
 843     for ($i = 0; $i < $numchks; $i++) {
 844         if ( $chkcat[$i] eq 'literal' ) {
 845             print OUTASM $T_HDR_literal, $chk[$i];
 846             print OUTASM "; end literal\n" if $TargetPlatform =~ /^hppa/; # for the splitter
 847
 848             $chkcat[$i] = 'DONE ALREADY';
 849         }
 850     }
 851
 852     # on the HPPA, print out all the bss next
 853     if ( $TargetPlatform =~ /^hppa/ ) {
 854         for ($i = 1; $i < $numchks; $i++) {
 855             if ( $chkcat[$i] eq 'bss' ) {
 856                 print OUTASM "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$BSS\$\n\t.align 4\n";
 857                 print OUTASM $chk[$i];
 858
 859                 $chkcat[$i] = 'DONE ALREADY';
 860             }
 861         }
 862     }
 863
 864     for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
 865 #       print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
 866
 867         next if $chkcat[$i] eq 'DONE ALREADY';
 868
 869         if ( $chkcat[$i] eq 'misc' ) {
 870             if ($chk[$i] ne '') {
 871                 print OUTASM $T_HDR_misc;
 872                 if ($TargetPlatform =~ /^powerpc-/) {
 873                    $chksymb[$i] =~ s/://;
 874                    if ($chksymb[$i] =~ /ret.*upd/ || $KNOWN_FUNNY_THING{$chksymb[$i]}
 875                     || $chksymb[$i] =~ /^${T_US}_(PRIn|PRStart).*${T_POST_LBL}$/o )
 876                       { print OUTASM "\t\.globl $chksymb[$i]\n\t\.globl \.$chksymb[$i]\n";
 877                    } else { print OUTASM "\t\.lglobl \.$chksymb[$i]\n"; };
 878                    if ($chk[$i] =~ /TOC\[tc0\], 0\n/)
 879                      { ($p, $r) = split(/TOC\[tc0\], 0\n/, $chk[$i]); $printDS = 1;}
 880                    else { $r = $chk[$i]; $printDS = 0; };
 881                    $chk[$i] = &mangle_powerpc_tailjump($r);
 882                 };
 883                 &print_doctored($chk[$i], 0);
 884                 if ($TargetPlatform =~ /^powerpc-/ && $printDS) {
 885                    print OUTASM "\.csect ${chksymb[$i]}[DS]\n";
 886                    print OUTASM "${p}TOC[tc0], 0\n";
 887                 }
 888             }
 889
 890         } elsif ( $chkcat[$i] eq 'toss' ) {
 891             print STDERR "*** NB: TOSSING code for $chksymb[$i] !!! ***\n";
 892
 893         } elsif ( $chkcat[$i] eq 'data' ) {
 894             if ($chk[$i] ne '') {
 895                 print OUTASM $T_HDR_data;
 896                 print OUTASM $chk[$i];
 897             }
 898
 899         } elsif ( $chkcat[$i] eq 'consist' ) {
 900             if ( $chk[$i] =~ /$T_hsc_cc_PAT/o ) {
 901                 local($consist) = "$1.$2.$3";
 902                 $consist =~ s/,/./g;
 903                 $consist =~ s/\//./g;
 904                 $consist =~ s/-/_/g;
 905                 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
 906                 print OUTASM $T_HDR_consist, "${consist}${T_POST_LBL}\n";
 907
 908             } elsif ( $TargetPlatform !~ /^(mips|powerpc)-/ ) { # we just don't try in those case (ToDo)
 909                 # on mips: consistency string is just a v
 910                 # horrible bunch of .bytes,
 911                 # which I am too lazy to sort out (WDP 95/05)
 912
 913                 print STDERR "Couldn't grok consistency: ", $chk[$i];
 914             }
 915
 916         } elsif ( $chkcat[$i] eq 'splitmarker' ) {
 917             # we can just re-constitute this one...
 918             # NB: we emit _three_ underscores no matter what,
 919             # so ghc-split doesn't have to care.
 920             print OUTASM "___stg_split_marker",$chksymb[$i],"${T_POST_LBL}\n";
 921
 922         } elsif ( $chkcat[$i] eq 'closure'
 923                || $chkcat[$i] eq 'infotbl'
 924                || $chkcat[$i] eq 'slow'
 925                || $chkcat[$i] eq 'fast' ) { # do them in that order
 926             $symb = $chksymb[$i];
 927
 928             # CLOSURE
 929             if ( defined($closurechk{$symb}) ) {
 930                 print OUTASM $T_HDR_closure;
 931                 print OUTASM $chk[$closurechk{$symb}];
 932                 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
 933             }
 934
 935             # INFO TABLE
 936             if ( defined($infochk{$symb}) ) {
 937
 938                 print OUTASM $T_HDR_info;
 939                 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
 940                 # entry code will be put here!
 941
 942                 # paranoia
 943                 if ( $chk[$infochk{$symb}] =~ /$TDOTWORD[@]?\s+([A-Za-z0-9_]+_entry)$/o
 944                   && $1 ne "${T_US}${symb}_entry" ) {
 945                     print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
 946                 }
 947
 948                 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
 949             }
 950
 951             # STD ENTRY POINT
 952             if ( defined($slowchk{$symb}) ) {
 953
 954                 # teach it to drop through to the fast entry point:
 955                 $c = $chk[$slowchk{$symb}];
 956
 957                 if ($TargetPlatform =~ /^powerpc-/) {
 958                 ($p, $r) = split(/TOC\[tc0\], 0\n/, $c);
 959                 if ($symb =~ /^[_A-Z]/)
 960                 {
 961                   print OUTASM "\t\.globl ${chksymb[$i]}_entry\n";
 962                   print OUTASM "\t\.globl \.${chksymb[$i]}_entry\n";
 963                   print OUTASM "\.csect ${symb}_entry[DS]\n";
 964                   print OUTASM "${p}TOC[tc0], 0\n";
 965                 }
 966                 else { print OUTASM "\t\.lglobl \.${symb}_entry\n"; };
 967                  $c = &mangle_powerpc_tailjump($r);
 968                 };
 969
 970                 if ( defined($fastchk{$symb}) ) {
 971                     if ( $TargetPlatform =~ /^alpha-/ ) {
 972                         $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
 973                     } elsif ( $TargetPlatform =~ /^hppa/ ) {
 974                         $c =~ s/^\s+ldil.*\n\s+ldo.*\n\s+bv.*\n(.*\n)?\s+\.EXIT/$1\t.EXIT/;
 975                     } elsif ( $TargetPlatform =~ /^i386-/ ) {
 976                         $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%edx\n\tjmp \*\%edx\n//;
 977                         $c =~ s/^\tmovl \$${T_US}${symb}_fast\d+,\%eax\n\tjmp \*\%eax\n//;
 978                     } elsif ( $TargetPlatform =~ /^mips-/ ) {
 979                         $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
 980                     } elsif ( $TargetPlatform =~ /^m68k-/ ) {
 981                         $c =~ s/^\tjmp ${T_US}${symb}_fast\d+.*\n\tnop\n//;
 982                         $c =~ s/^\tjmp ${T_US}${symb}_fast\d+.*\n//;
 983                     } elsif ( $TargetPlatform =~ /^powerpc-/ ) {
 984                         $c =~ s/^\tb \.${T_US}${symb}_fast\d+\n//;
 985                     } elsif ( $TargetPlatform =~ /^sparc-/ ) {
 986                         $c =~ s/^\tcall ${T_US}${symb}_fast\d+,.*\n\tnop\n//;
 987                         $c =~ s/^\tcall ${T_US}${symb}_fast\d+,.*\n(\t[a-z].*\n)/$1/;
 988                     } else {
 989                         print STDERR "$Pgm: mystery slow-fast dropthrough: $TargetPlatform\n";
 990                     }
 991                 }
 992
 993                 if ( $TargetPlatform !~ /^(alpha-|hppa|mips-)/ ) {
 994                     # On alphas, hppa: no very good way to look for "dangling"
 995                     # references to fast-entry point.
 996                     # (questionable re hppa and mips...)
 997                     print STDERR "still has jump to fast entry point:\n$c"
 998                         if $c =~ /$TUS[@]?$symb[@]?_fast/; # NB: paranoia
 999                 }
1000
1001                 print OUTASM $T_HDR_entry;
1002
1003                 &print_doctored($c, 1); # NB: the 1!!!
1004
1005                 $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
1006             }
1007
1008             # FAST ENTRY POINT
1009             if ( defined($fastchk{$symb}) ) {
1010                 $c = $chk[$fastchk{$symb}];
1011                 if ( ! defined($slowchk{$symb})
1012                    # ToDo: the || clause can go once we're no longer
1013                    # concerned about producing exactly the same output as before
1014 #OLD:              || $TargetPlatform =~ /^(m68k|sparc|i386)-/
1015                    ) {
1016                     print OUTASM $T_HDR_fast;
1017                 }
1018                   if ($TargetPlatform =~ /^powerpc-/) {
1019                     local(@lbls) = split(/:/, $c);
1020                     $fullname = $lbls[0];
1021                     $fullname =~ s/$T_MOVE_DIRVS//g;
1022                     if ( $fullname =~ /^[A-Z]/)
1023                        { print OUTASM "\t\.globl \.${fullname}\n";
1024                     } else {
1025                        print OUTASM "\t\.lglobl \.${fullname}\n";
1026                     };
1027                     $c =~ s/((.*\n)*)\t.long \S+, TOC\[tc0\], 0\n\.csect \.text\[PR\]\n((.*\n)*)/\1\3/;
1028                     $c = &mangle_powerpc_tailjump($c);
1029                   };
1030                 &print_doctored($c, 0);
1031                 $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
1032             }
1033
1034         } elsif ( $chkcat[$i] eq 'vector'
1035                || $chkcat[$i] eq 'direct' ) { # do them in that order
1036             $symb = $chksymb[$i];
1037
1038             # VECTOR TABLE
1039             if ( defined($vectorchk{$symb}) ) {
1040                 print OUTASM $T_HDR_vector;
1041                 if ($TargetPlatform =~ /^powerpc-/) {
1042                   if ( $symb =~ /^[A-Z]/) {
1043                      print OUTASM "\t\.globl \.vtbl_${symb}\n";
1044                      print OUTASM "\t\.globl vtbl_${symb}\n";
1045                   };
1046                   $chk[$vectorchk{$symb}] =~ s/\.long (\S+)/\.long \.\1/g;
1047                   print OUTASM ".vtbl_${symb}:\n";
1048                   print OUTASM $chk[$vectorchk{$symb}];
1049                 } else {
1050                   print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
1051                 }
1052                 # direct return code will be put here!
1053                 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
1054             }
1055
1056             # DIRECT RETURN
1057             if ( defined($directchk{$symb}) ) {
1058                 print OUTASM $T_HDR_direct;
1059                 if ($TargetPlatform =~ /^powerpc-/) {
1060                   ($p, $r) = split(/TOC\[tc0\], 0\n/, $chk[$directchk{$symb}]);
1061                   &print_doctored($r, 0);
1062                   print OUTASM "\.csect ${symb}DirectReturn[DS]\n";
1063                   print OUTASM "${p}TOC[tc0], 0\n";
1064                 } else {
1065                   &print_doctored($chk[$directchk{$symb}], 0);
1066                 }
1067                 $chkcat[$directchk{$symb}] = 'DONE ALREADY';
1068
1069             } elsif ( $TargetPlatform =~ /^alpha-/ ) {
1070                 # Alphas: the commented nop is for the splitter, to ensure
1071                 # that no module ends with a label as the very last
1072                 # thing.  (The linker will adjust the label to point
1073                 # to the first code word of the next module linked in,
1074                 # even if alignment constraints cause the label to move!)
1075
1076                 print OUTASM "\t# nop\n";
1077             }
1078
1079         } elsif ( $chkcat[$i] eq 'toc' ) {
1080             if ($chk[$i] ne '') {
1081                 print OUTASM $T_HDR_literal;
1082                 print OUTASM $chk[$i];
1083             }
1084
1085         } else {
1086             &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n");
1087         }
1088     }
1089
1090     print OUTASM $EXTERN_DECLS if $TargetPlatform =~ /^mips-/;
1091
1092     if ($TargetPlatform =~ /^powerpc-/) {
1093          print OUTASM ".csect .text[PR]\n_section_.text:\n.csect .data[RW]\n\t.long _section_.text\n"
1094     };
1095
1096 #    print OUTASM ".csect .text[PR]\n_section_.text:\n.csect .data[RW]\n\t.long _section_.text\n"
1097 #       if $TargetPlatform =~ /^powerpc-/;
1098
1099     # finished
1100     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1101     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1102 }
1103 \end{code}
1104
1105 \begin{code}
1106 sub mash_hppa_prologue { # OK, epilogue, too
1107     local($_) = @_;
1108
1109     # toss all prologue stuff
1110     s/^\s+\.ENTRY[^\0]*--- BEGIN ---/\t.ENTRY/;
1111
1112     # Lie about our .CALLINFO
1113     s/^\s+\.CALLINFO.*$/\t.CALLINFO NO_CALLS,NO_UNWIND/;
1114
1115     # Get rid of P'
1116
1117     s/LP'/L'/g;
1118     s/RP'/R'/g;
1119
1120     # toss all epilogue stuff
1121     s/^\s+--- END ---[^\0]*\.EXIT/\t.EXIT/;
1122
1123     # Sorry; we moved the _info stuff to the code segment.
1124     s/_info,DATA/_info,CODE/g;
1125
1126     return($_);
1127 }
1128 \end{code}
1129
1130 \begin{code}
1131 sub print_doctored {
1132     local($_, $need_fallthru_patch) = @_;
1133
1134     if ( $TargetPlatform !~ /^i386-/
1135       || ! /^\t[a-z]/ ) { # no instructions in here, apparently
1136         print OUTASM $_;
1137         return;
1138     }
1139     # OK, must do some x86 **HACKING**
1140
1141     local($entry_patch) = '';
1142     local($exit_patch)  = '';
1143     local($call_entry_patch)= '';
1144     local($call_exit_patch)     = '';
1145
1146 #OLD:   # first, convert calls to *very magic form*: (ToDo: document
1147     # for real!)  from
1148     #
1149     #   pushl $768
1150     #   call _?PerformGC_wrapper
1151     #   addl $4,%esp
1152     # to
1153     #   movl $768, %eax
1154     #   call _?PerformGC_wrapper
1155     #
1156     # The reason we do this now is to remove the apparent use of
1157     # %esp, which would throw off the "what patch code do we need"
1158     # decision.
1159     #
1160     # Special macros in ghc/includes/COptWraps.lh, used in
1161     # ghc/runtime/CallWrap_C.lc, are required for this to work!
1162     #
1163
1164     s/^\tpushl \$(\d+)\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \$$1,\%eax\n\tcall ${T_DO_GC}\n/go;
1165     s/^\tpushl \%eax\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tcall ${T_DO_GC}\n/go;
1166     s/^\tpushl \%edx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%edx,\%eax\n\tcall ${T_DO_GC}\n/go;
1167
1168 #=  if ( $StolenX86Regs <= 4 ) { # %ecx is ordinary reg
1169 #=      s/^\tpushl \%ecx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%ecx,\%eax\n\tcall ${T_DO_GC}\n/go;
1170 #=  }
1171
1172     # gotta watch out for weird instructions that
1173     # invisibly smash various regs:
1174     #   rep*    %ecx used for counting
1175     #   scas*   %edi used for destination index
1176     #   cmps*   %e[sd]i used for indices
1177     #   loop*   %ecx used for counting
1178     #
1179     # SIGH.
1180
1181     # We cater for:
1182     #  * use of STG reg [ nn(%ebx) ] where no machine reg avail
1183     #
1184     #  * GCC used an "STG reg" for its own purposes
1185     #
1186     #  * some secret uses of machine reg, requiring STG reg
1187     #    to be saved/restored
1188
1189     # The most dangerous "GCC uses" of an "STG reg" are when
1190     # the reg holds the target of a jmp -- it's tricky to
1191     # insert the patch-up code before we get to the target!
1192     # So here we change the jmps:
1193
1194     # --------------------------------------------------------
1195     # it can happen that we have jumps of the form...
1196     #   jmp *<something involving %esp>
1197     # or
1198     #   jmp <something involving another naughty register...>
1199     #
1200     # a reasonably-common case is:
1201     #
1202     #   movl $_blah,<bad-reg>
1203     #   jmp  *<bad-reg>
1204     #
1205     # which is easily fixed as:
1206     #
1207     # sigh! try to hack around it...
1208     #
1209
1210     if ($StolenX86Regs <= 2 ) { # YURGH! spurious uses of esi?
1211         s/^\tmovl (.*),\%esi\n\tjmp \*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1212         s/^\tjmp \*(-?\d*)\((.*\%esi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
1213         s/^\tjmp \*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/g;
1214         die "$Pgm: (mangler) still have jump involving \%esi!\n$_"
1215             if /(jmp|call) .*\%esi/;
1216     }
1217     if ($StolenX86Regs <= 3 ) { # spurious uses of edi?
1218         s/^\tmovl (.*),\%edi\n\tjmp \*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1219         s/^\tjmp \*(-?\d*)\((.*\%edi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
1220         s/^\tjmp \*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/g;
1221         die "$Pgm: (mangler) still have jump involving \%edi!\n$_"
1222             if /(jmp|call) .*\%edi/;
1223     }
1224 #=  if ($StolenX86Regs <= 4 ) { # spurious uses of ecx?
1225 #=      s/^\tmovl (.*),\%ecx\n\tjmp \*%ecx\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1226 #=      s/^\tjmp \*(-?\d*)\((.*\%ecx.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
1227 #=      s/^\tjmp \*\%ecx\n/\tmovl \%ecx,\%eax\n\tjmp \*\%eax\n/g;
1228 #=      die "$Pgm: (mangler) still have jump involving \%ecx!\n$_"
1229 #=          if /(jmp|call) .*\%ecx/;
1230 #=  }
1231
1232     # OK, now we can decide what our patch-up code is going to
1233     # be:
1234     if ( $StolenX86Regs <= 2
1235          && ( /32\(\%ebx\)/ || /\%esi/ || /^\tcmps/ ) ) { # R1 (esi)
1236         $entry_patch .= "\tmovl \%esi,32(\%ebx)\n";
1237         $exit_patch  .= "\tmovl 32(\%ebx),\%esi\n";
1238         # nothing for call_{entry,exit} because %esi is callee-save
1239     }
1240     if ( $StolenX86Regs <= 3
1241          && ( /64\(\%ebx\)/ || /\%edi/ || /^\t(scas|cmps)/ ) ) { # SpA (edi)
1242         $entry_patch .= "\tmovl \%edi,64(\%ebx)\n";
1243         $exit_patch  .= "\tmovl 64(\%ebx),\%edi\n";
1244         # nothing for call_{entry,exit} because %edi is callee-save
1245     }
1246 #=  if ( $StolenX86Regs <= 4
1247 #=       && ( /80\(\%ebx\)/ || /\%ecx/ || /^\t(rep|loop)/ ) ) { # Hp (ecx)
1248 #=      $entry_patch .= "\tmovl \%ecx,80(\%ebx)\n";
1249 #=      $exit_patch  .= "\tmovl 80(\%ebx),\%ecx\n";
1250 #=
1251 #=      $call_exit_patch  .= "\tmovl \%ecx,108(\%ebx)\n";
1252 #=      $call_entry_patch .= "\tmovl 108(\%ebx),\%ecx\n";
1253 #=      # I have a really bad feeling about this if we ever
1254 #=      # have a nested call...
1255 #=      # NB: should just hide it somewhere in the C stack.
1256 #=  }
1257     # --------------------------------------------------------
1258     # next, here we go with non-%esp patching!
1259     #
1260     s/^(\t[a-z])/$entry_patch$1/; # before first instruction
1261     s/^(\tcall .*\n(\taddl \$\d+,\%esp\n)?)/$call_exit_patch$1$call_entry_patch/g; # _all_ calls
1262
1263     # fix _all_ non-local jumps:
1264
1265     s/^\tjmp \*${T_X86_PRE_LLBL_PAT}/\tJMP___SL/go;
1266     s/^\tjmp ${T_X86_PRE_LLBL_PAT}/\tJMP___L/go;
1267
1268     s/^(\tjmp .*\n)/$exit_patch$1/g; # here's the fix...
1269
1270     s/^\tJMP___SL/\tjmp \*${T_X86_PRE_LLBL}/go;
1271     s/^\tJMP___L/\tjmp ${T_X86_PRE_LLBL}/go;
1272
1273     # fix post-PerformGC wrapper (re-)entries ???
1274
1275     if ($StolenX86Regs == 2 ) {
1276         die "ARGH! Jump uses \%esi or \%edi with -monly-2-regs:\n$_"
1277             if /^\t(jmp|call) .*\%e(si|di)/;
1278 #=      die "ARGH! Jump uses \%esi, \%edi, or \%ecx with -monly-2-regs:\n$_"
1279 #=          if /^\t(jmp|call) .*\%e(si|di|cx)/;
1280     } elsif ($StolenX86Regs == 3 ) {
1281         die "ARGH! Jump uses \%edi with -monly-3-regs:\n$_"
1282             if /^\t(jmp|call) .*\%edi/;
1283 #=      die "ARGH! Jump uses \%edi or \%ecx with -monly-3-regs:\n$_"
1284 #=          if /^\t(jmp|call) .*\%e(di|cx)/;
1285 #=  } elsif ($StolenX86Regs == 4 ) {
1286 #=      die "ARGH! Jump uses \%ecx with -monly-4-regs:\n$_"
1287 #=          if /^\t(jmp|call) .*\%ecx/;
1288     }
1289
1290     # final peephole fixes
1291
1292     s/^\tmovl \%eax,36\(\%ebx\)\n\tjmp \*36\(\%ebx\)\n/\tmovl \%eax,36\(\%ebx\)\n\tjmp \*\%eax\n/;
1293 # the short form may tickle perl bug:
1294 #    s/^\tmovl \$${T_US}(.*),(\%e[abcd]x)\n\tjmp \*$2/\tjmp $T_US$1/g;
1295     s/^\tmovl \$${T_US}(.*),\%eax\n\tjmp \*\%eax/\tjmp $T_US$1/g;
1296     s/^\tmovl \$${T_US}(.*),\%ebx\n\tjmp \*\%ebx/\tjmp $T_US$1/g;
1297     s/^\tmovl \$${T_US}(.*),\%ecx\n\tjmp \*\%ecx/\tjmp $T_US$1/g;
1298     s/^\tmovl \$${T_US}(.*),\%edx\n\tjmp \*\%edx/\tjmp $T_US$1/g;
1299
1300     # Hacks to eliminate some reloads of Hp.  Worth about 5% code size.
1301     # We could do much better than this, but at least it catches about
1302     # half of the unnecessary reloads.
1303     # Note that these will stop working if either:
1304     #  (i) the offset of Hp from BaseReg changes from 80, or
1305     #  (ii) the register assignment of BaseReg changes from %ebx
1306
1307     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;
1308
1309     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;
1310
1311     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;
1312     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;
1313
1314     # --------------------------------------------------------
1315     # that's it -- print it
1316     #
1317     #die "Funny jumps?\n$_" if /${T_X86_BADJMP}/o; # paranoia
1318
1319     print OUTASM $_;
1320
1321     if ( $need_fallthru_patch ) { # exit patch for end of slow entry code
1322         print OUTASM $exit_patch;
1323         # ToDo: make it not print if there is a "jmp" at the end
1324     }
1325 }
1326 \end{code}
1327
1328 \begin{code}
1329 sub init_FUNNY_THINGS {
1330     %KNOWN_FUNNY_THING = (
1331         "${T_US}CheckHeapCode${T_POST_LBL}", 1,
1332         "${T_US}CommonUnderflow${T_POST_LBL}", 1,
1333         "${T_US}Continue${T_POST_LBL}", 1,
1334         "${T_US}EnterNodeCode${T_POST_LBL}", 1,
1335         "${T_US}ErrorIO_call_count${T_POST_LBL}", 1,
1336         "${T_US}ErrorIO_innards${T_POST_LBL}", 1,
1337         "${T_US}IndUpdRetDir${T_POST_LBL}", 1,
1338         "${T_US}IndUpdRetV0${T_POST_LBL}", 1,
1339         "${T_US}IndUpdRetV1${T_POST_LBL}", 1,
1340         "${T_US}IndUpdRetV2${T_POST_LBL}", 1,
1341         "${T_US}IndUpdRetV3${T_POST_LBL}", 1,
1342         "${T_US}IndUpdRetV4${T_POST_LBL}", 1,
1343         "${T_US}IndUpdRetV5${T_POST_LBL}", 1,
1344         "${T_US}IndUpdRetV6${T_POST_LBL}", 1,
1345         "${T_US}IndUpdRetV7${T_POST_LBL}", 1,
1346         "${T_US}PrimUnderflow${T_POST_LBL}", 1,
1347         "${T_US}StackUnderflowEnterNode${T_POST_LBL}", 1,
1348         "${T_US}StdErrorCode${T_POST_LBL}", 1,
1349         "${T_US}UnderflowVect0${T_POST_LBL}", 1,
1350         "${T_US}UnderflowVect1${T_POST_LBL}", 1,
1351         "${T_US}UnderflowVect2${T_POST_LBL}", 1,
1352         "${T_US}UnderflowVect3${T_POST_LBL}", 1,
1353         "${T_US}UnderflowVect4${T_POST_LBL}", 1,
1354         "${T_US}UnderflowVect5${T_POST_LBL}", 1,
1355         "${T_US}UnderflowVect6${T_POST_LBL}", 1,
1356         "${T_US}UnderflowVect7${T_POST_LBL}", 1,
1357         "${T_US}UpdErr${T_POST_LBL}", 1,
1358         "${T_US}UpdatePAP${T_POST_LBL}", 1,
1359         "${T_US}WorldStateToken${T_POST_LBL}", 1,
1360         "${T_US}_Enter_Internal${T_POST_LBL}", 1,
1361         "${T_US}_PRMarking_MarkNextAStack${T_POST_LBL}", 1,
1362         "${T_US}_PRMarking_MarkNextBStack${T_POST_LBL}", 1,
1363         "${T_US}_PRMarking_MarkNextCAF${T_POST_LBL}", 1,
1364         "${T_US}_PRMarking_MarkNextGA${T_POST_LBL}", 1,
1365         "${T_US}_PRMarking_MarkNextRoot${T_POST_LBL}", 1,
1366         "${T_US}_PRMarking_MarkNextSpark${T_POST_LBL}", 1,
1367         "${T_US}_PRMarking_MarkNextEvent${T_POST_LBL}", 1,
1368         "${T_US}_PRMarking_MarkNextClosureInFetchBuffer${T_POST_LBL}", 1,
1369         "${T_US}_Scavenge_Forward_Ref${T_POST_LBL}", 1,
1370         "${T_US}__std_entry_error__${T_POST_LBL}", 1,
1371         "${T_US}_startMarkWorld${T_POST_LBL}", 1,
1372         "${T_US}resumeThread${T_POST_LBL}", 1,
1373         "${T_US}startCcRegisteringWorld${T_POST_LBL}", 1,
1374         "${T_US}startEnterFloat${T_POST_LBL}", 1,
1375         "${T_US}startEnterInt${T_POST_LBL}", 1,
1376         "${T_US}startPerformIO${T_POST_LBL}", 1,
1377         "${T_US}startStgWorld${T_POST_LBL}", 1,
1378         "${T_US}stopPerformIO${T_POST_LBL}", 1
1379     );
1380 }
1381 \end{code}
1382
1383 The following table reversal is used for both info tables and return
1384 vectors.  In both cases, we remove the first entry from the table,
1385 reverse the table, put the label at the end, and paste some code
1386 (that which is normally referred to by the first entry in the table)
1387 right after the table itself.  (The code pasting is done elsewhere.)
1388
1389 \begin{code}
1390 sub rev_tbl {
1391     local($symb, $tbl, $discard1) = @_;
1392
1393     local($before) = '';
1394     local($label) = '';
1395     local(@imports) = (); # hppa only
1396     local(@words) = ();
1397     local($after) = '';
1398     local(@lines) = split(/\n/, $tbl);
1399     local($i, $j); #local ($i, $extra, $words_to_pad, $j);
1400
1401     # see comment in mangleAsm as to why this silliness is needed.
1402     local($TDOTWORD) = ${T_DOT_WORD};
1403     local($TDOTGLOBAL) = ${T_DOT_GLOBAL};
1404     local($TUS) = ${T_US};
1405     local($TPOSTLBL) = ${T_POST_LBL};
1406
1407     for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t$TDOTWORD\s+/o; $i++) {
1408         $label .= $lines[$i] . "\n",
1409             next if $lines[$i] =~ /^[A-Za-z0-9_]+_info$TPOSTLBL[@]?$/o
1410                  || $lines[$i] =~ /$TDOTGLOBAL/o
1411                  || $lines[$i] =~ /^$TUS[@]?vtbl_\S+$TPOSTLBL[@]?$/o;
1412
1413         $before .= $lines[$i] . "\n"; # otherwise...
1414     }
1415
1416     if ( $TargetPlatform !~ /^hppa/ ) {
1417         for ( ; $i <= $#lines && $lines[$i] =~ /^\t$TDOTWORD\s+/o; $i++) {
1418             push(@words, $lines[$i]);
1419         }
1420     } else { # hppa weirdness
1421         for ( ; $i <= $#lines && $lines[$i] =~ /^\s+\.(word|IMPORT)/; $i++) {
1422             if ($lines[$i] =~ /^\s+\.IMPORT/) {
1423                 push(@imports, $lines[$i]);
1424             } else {
1425                 # We don't use HP's ``function pointers''
1426                 # We just use labels in code space, like normal people
1427                 $lines[$i] =~ s/P%//;
1428                 push(@words, $lines[$i]);
1429             }
1430         }
1431     }
1432
1433     # now throw away the first word (entry code):
1434     shift(@words) if $discard1;
1435
1436 # Padding removed to reduce code size and improve performance on Pentiums.
1437 # Simon M. 13/4/96
1438     # for 486-cache-friendliness, we want our tables aligned
1439     # on 16-byte boundaries (.align 4).  Let's pad:
1440 #    $extra = ($#words + 1) % 4;
1441 #    $words_to_pad = ($extra == 0) ? 0 : 4 - $extra;
1442 #    for ($j = 0; $j < $words_to_pad; $j++) { push(@words, "\t${T_DOT_WORD} 0"); }
1443
1444     for (; $i <= $#lines; $i++) {
1445         $after .= $lines[$i] . "\n";
1446     }
1447
1448     # Alphas:If we have anonymous text (not part of a procedure), the
1449     # linker may complain about missing exception information.  Bleh.
1450     if ( $TargetPlatform =~ /^alpha-/ && $label =~ /^([A-Za-z0-9_]+):$/) {
1451         $before = "\t.ent $1\n" . $before;
1452         $after .= "\t.end $1\n";
1453     }
1454
1455     $tbl = $before
1456          . (($TargetPlatform !~ /^hppa/) ? '' : join("\n", @imports) . "\n")
1457          . join("\n", (reverse @words)) . "\n"
1458          . $label . $after;
1459
1460 #   print STDERR "before=$before\n";
1461 #   print STDERR "label=$label\n";
1462 #   print STDERR "words=",(reverse @words),"\n";
1463 #   print STDERR "after=$after\n";
1464
1465     $tbl;
1466 }
1467 \end{code}
1468
1469 \begin{code}
1470 sub mini_mangle_asm_i386 {
1471     local($in_asmf, $out_asmf) = @_;
1472
1473     &init_TARGET_STUFF();
1474
1475     # see mangleAsm comment
1476     local($TUS) = ${T_US};
1477     local($TPOSTLBL)=${T_POST_LBL};
1478
1479     open(INASM, "< $in_asmf")
1480         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
1481     open(OUTASM,"> $out_asmf")
1482         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
1483
1484     while (<INASM>) {
1485         print OUTASM;
1486
1487         next unless
1488             /^$TUS[@]?(PerformGC|StackOverflow|Yield|PerformReschedule)_wrapper$TPOSTLBL\n/o;
1489         print OUTASM "\tmovl \%esp, ${T_US}__temp_esp\n";
1490         print OUTASM "\tmovl \%eax, ${T_US}__temp_eax\n";
1491     }
1492
1493     # finished:
1494     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1495     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1496 }
1497 \end{code}
1498
1499 The HP is a major nuisance.  The threaded code mangler moved info
1500 tables from data space to code space, but unthreaded code in the RTS
1501 still has references to info tables in data space.  Since the HP
1502 linker is very precise about where symbols live, we need to patch the
1503 references in the unthreaded RTS as well.
1504
1505 \begin{code}
1506 sub mini_mangle_asm_hppa {
1507     local($in_asmf, $out_asmf) = @_;
1508
1509     open(INASM, "< $in_asmf")
1510         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
1511     open(OUTASM,"> $out_asmf")
1512         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
1513
1514     while (<INASM>) {
1515         s/_info,DATA/_info,CODE/;   # Move _info references to code space
1516         s/P%_PR/_PR/;
1517         print OUTASM;
1518     }
1519
1520     # finished:
1521     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1522     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1523 }
1524
1525 \end{code}
1526
1527 \begin{code}
1528 sub mini_mangle_asm_powerpc {
1529     local($in_asmf, $out_asmf) = @_;
1530
1531     open(INASM, "< $in_asmf")
1532         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
1533     open(OUTASM,"> $out_asmf")
1534         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
1535
1536     while (<INASM>) {
1537         s/long _PRStart/long ._PRStart/;
1538         s/long _PRIn_/long ._PRIn_/;
1539         s/long _Dummy_(\S+)_entry/long ._Dummy_\1_entry/;
1540         s/long _PRMarking_MarkNextRoot\[DS\]/long ._PRMarking_MarkNextRoot/;
1541         s/long _PRMarking_MarkNextCAF\[DS\]/long ._PRMarking_MarkNextCAF/;
1542         s/long _PRMarking_MarkNextAStack\[DS\]/long ._PRMarking_MarkNextAStack/;
1543         s/long _PRMarking_MarkNextBStack\[DS\]/long ._PRMarking_MarkNextBStack/;
1544         print OUTASM;
1545     }
1546
1547     # finished:
1548     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1549     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1550 }
1551
1552 sub mangle_powerpc_tailjump {
1553     local($c) = @_;
1554     local($maybe_more) = 1;
1555     while (($c =~ /\tl \d+,LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n/) && $maybe_more)
1556       { $maybe_more = 0;
1557         $lcsymb = $c;
1558         $lcsymb =~ s/(.*\n)*\tl \d+,LC\.\.(\d+)\(2\)\n\tmtctr \d+\n\tbctr\n(.*\n)*/\2/;
1559 # the checks for r1 and r2 are mostly paranoia...
1560         $r1 = $c;
1561         $r1 =~ s/(.*\n)*\tl (\d+),LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n(.*\n)*/\2/;
1562         $r2 = $c;
1563         $r2 =~ s/(.*\n)*\tl \d+,LC\.\.(\d+)\(2\)\n\tmtctr (\d+)\n\tbctr\n(.*\n)*/\3/;
1564         if (r1 eq r2)
1565           { $maybe_more = 1;
1566             $c =~ s/((.*\n)*)\tl \d+,LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n((.*\n)*)/\1\tb $tocequiv{$lcsymb}\n\3/;
1567           }
1568       };
1569     $c;
1570 }
1571
1572 # make "require"r happy...
1573 1;
1574 \end{code}