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_PRE_APP      = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP
  58     $T_CONST_LBL    = '^\$C(\d+):$'; # regexp for what such a lbl looks like
  59     $T_POST_LBL     = ':';
  60
  61     $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\#.*|\.(file|loc)\s+\S+\s+\S+|\.text|\.r?data)\n)';
  62     $T_COPY_DIRVS   = '^\s*(\#|\.(file|globl|ent|loc))';
  63
  64     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
  65     $T_DOT_WORD     = '\.quad';
  66     $T_DOT_GLOBAL   = '^\t\.globl';
  67     $T_HDR_literal  = "\.rdata\n\t\.align 3\n";
  68     $T_HDR_misc     = "\.text\n\t\.align 3\n";
  69     $T_HDR_data     = "\.data\n\t\.align 3\n";
  70     $T_HDR_consist  = "\.text\n";
  71     $T_HDR_closure  = "\.data\n\t\.align 3\n";
  72     $T_HDR_srt      = "\.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_PRE_APP      = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP
  85     $T_CONST_LBL    = '^L\$C(\d+)$'; # regexp for what such a lbl looks like
  86     $T_POST_LBL     = '';
  87
  88     $T_MOVE_DIRVS   = '^((\s+\.(IMPORT|EXPORT|PARAM).*|\s+\.align\s+\d+|\s+\.(SPACE|SUBSPA)\s+\S+|\s*)\n)';
  89     $T_COPY_DIRVS   = '^\s+\.(IMPORT|EXPORT)';
  90
  91     $T_hsc_cc_PAT   = '\.STRING.*\)(hsc|cc) (.*)\\\\x09(.*)\\\\x00"';
  92     $T_DOT_WORD     = '\.word';
  93     $T_DOT_GLOBAL   = '^\s+\.EXPORT';
  94     $T_HDR_literal  = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
  95     $T_HDR_misc     = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
  96     $T_HDR_data     = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
  97     $T_HDR_consist  = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
  98     $T_HDR_closure  = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
  99     $T_HDR_srt      = "\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|freebsd2|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_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*(\.(p2)?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_DOT_WORD     = '\.(long|word|value|byte|space)';
 123     $T_DOT_GLOBAL   = '\.globl';
 124     $T_HDR_literal  = "\.text\n\t\.align 2\n";
 125     $T_HDR_misc     = "\.text\n\t\.align 2,0x90\n";
 126     $T_HDR_data     = "\.data\n\t\.align 2\n";
 127     $T_HDR_consist  = "\.text\n";
 128     $T_HDR_closure  = "\.data\n\t\.align 2\n";
 129     $T_HDR_srt      = "\.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|freebsd3)$/ ) {
 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_PRE_APP      = # regexp that says what comes before APP/NO_APP
 142                       ($TargetPlatform =~ /-(linux|freebsd3)$/) ? '#' : '/' ;
 143     $T_CONST_LBL    = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
 144     $T_POST_LBL     = ':';
 145     $T_X86_PRE_LLBL_PAT = '\.L';
 146     $T_X86_PRE_LLBL         = '.L';
 147     $T_X86_BADJMP   = '^\tjmp [^\.\*]';
 148
 149     $T_MOVE_DIRVS   = '^(\s*(\.(p2)?align\s+\d+(,0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.Lfe.*\n\t\.size\s+.*|\.size\s+.*|\.ident.*)\n)';
 150     $T_COPY_DIRVS   = '\.(globl)';
 151
 152     if ( $TargetPlatform =~ /freebsd3/ ) {
 153         $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
 154     } else {
 155         $T_hsc_cc_PAT   = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
 156     }
 157
 158     $T_DOT_WORD     = '\.(long|value|byte|zero)';
 159     $T_DOT_GLOBAL   = '\.globl';
 160     $T_HDR_literal  = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11)
 161     $T_HDR_misc     = "\.text\n\t\.align 4\n";
 162     $T_HDR_data     = "\.data\n\t\.align 4\n"; # ToDo: change align??
 163     $T_HDR_consist  = "\.text\n";
 164     $T_HDR_closure  = "\.data\n\t\.align 4\n"; # ToDo: change align?
 165     $T_HDR_srt      = "\.data\n\t\.align 4\n"; # ToDo: change align?
 166     $T_HDR_info     = "\.text\n\t\.align 16\n"; # NB: requires padding
 167     $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
 168     $T_HDR_fast     = "\.text\n\t\.align 16\n";
 169     $T_HDR_vector   = "\.text\n\t\.align 16\n"; # NB: requires padding
 170     $T_HDR_direct   = "\.text\n\t\.align 16\n";
 171
 172     #--------------------------------------------------------#
 173     } elsif ( $TargetPlatform =~ /^m68k-.*-sunos4/ ) {
 174
 175     $T_STABBY       = 1; # 1 iff .stab things (usually if a.out format)
 176     $T_US           = '_'; # _ if symbols have an underscore on the front
 177     $T_PRE_APP      = '^# MAY NOT APPLY'; # regexp that says what comes before APP/NO_APP
 178     $T_CONST_LBL    = '^LC(\d+):$';
 179     $T_POST_LBL     = ':';
 180
 181     $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.proc\s+\d+|\.const|\.cstring|\.globl\s+\S+|\.text|\.data|\.even|\.stab[^n].*)\n)';
 182     $T_COPY_DIRVS   = '\.(globl|proc|stab)';
 183     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
 184
 185     $T_DOT_WORD     = '\.long';
 186     $T_DOT_GLOBAL   = '\.globl';
 187     $T_HDR_literal  = "\.text\n\t\.even\n";
 188     $T_HDR_misc     = "\.text\n\t\.even\n";
 189     $T_HDR_data     = "\.data\n\t\.even\n";
 190     $T_HDR_consist  = "\.text\n";
 191     $T_HDR_closure  = "\.data\n\t\.even\n";
 192     $T_HDR_srt      = "\.data\n\t\.even\n";
 193     $T_HDR_info     = "\.text\n\t\.even\n";
 194     $T_HDR_entry    = "\.text\n\t\.even\n";
 195     $T_HDR_fast     = "\.text\n\t\.even\n";
 196     $T_HDR_vector   = "\.text\n\t\.even\n";
 197     $T_HDR_direct   = "\.text\n\t\.even\n";
 198
 199     #--------------------------------------------------------#
 200     } elsif ( $TargetPlatform =~ /^mips-.*/ ) {
 201
 202     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 203     $T_US           = ''; # _ if symbols have an underscore on the front
 204     $T_PRE_APP      = '^\s*#'; # regexp that says what comes before APP/NO_APP
 205     $T_CONST_LBL    = '^\$LC(\d+):$'; # regexp for what such a lbl looks like
 206     $T_POST_LBL     = ':';
 207
 208     $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\.text|\.r?data)\n)';
 209     $T_COPY_DIRVS   = '\.(globl|ent)';
 210
 211     $T_hsc_cc_PAT   = 'I WAS TOO LAZY TO DO THIS BIT (WDP 95/05)';
 212     $T_DOT_WORD     = '\.word';
 213     $T_DOT_GLOBAL   = '^\t\.globl';
 214     $T_HDR_literal  = "\t\.rdata\n\t\.align 2\n";
 215     $T_HDR_misc     = "\t\.text\n\t\.align 2\n";
 216     $T_HDR_data     = "\t\.data\n\t\.align 2\n";
 217     $T_HDR_consist  = 'TOO LAZY TO DO THIS TOO';
 218     $T_HDR_closure  = "\t\.data\n\t\.align 2\n";
 219     $T_HDR_srt      = "\t\.data\n\t\.align 2\n";
 220     $T_HDR_info     = "\t\.text\n\t\.align 2\n";
 221     $T_HDR_entry    = "\t\.text\n\t\.align 2\n";
 222     $T_HDR_fast     = "\t\.text\n\t\.align 2\n";
 223     $T_HDR_vector   = "\t\.text\n\t\.align 2\n";
 224     $T_HDR_direct   = "\t\.text\n\t\.align 2\n";
 225
 226     #--------------------------------------------------------#
 227     } elsif ( $TargetPlatform =~ /^powerpc-.*|^rs6000-.*/ ) {
 228
 229     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 230     $T_US           = ''; # _ if symbols have an underscore on the front
 231     $T_PRE_APP      = 'NOT APPLICABLE'; # regexp that says what comes before APP/NO_APP
 232     $T_CONST_LBL    = 'NOT APPLICABLE'; # regexp for what such a lbl looks like
 233     $T_POST_LBL     = ':';
 234
 235     $T_MOVE_DIRVS   = '^(\s*(\.toc|\.align \d+|\.csect \S+|\t\.?l?globl \S+)\n)';
 236     $T_COPY_DIRVS   = '\.(l?globl)';
 237
 238     $T_hsc_cc_PAT   = '\.byte.*\)(hsc|cc) (.*)"\n\t\.byte \d+\n\t\.byte "(.*)"\n\t\.byte \d+';
 239     $T_DOT_WORD     = '\.long';
 240     $T_DOT_GLOBAL   = '\.globl';
 241     $T_HDR_toc      = "\.toc\n";
 242     $T_HDR_literal  = "\.csect .data[RW]\n\t\.align 2\n";               #not RO!?
 243     $T_HDR_misc     = "# misc\n\.csect \.text[PR]\n\t\.align 2\n";
 244     $T_HDR_data     = "# data\n\.csect \.data[RW]\n\t\.align 2\n";
 245     $T_HDR_consist  = "# consist\n\.csect \.data[RW]\n\t\.align 2\n";
 246     $T_HDR_closure  = "# closure\n\.csect \.data[RW]\n\t\.align 2\n";
 247     $T_HDR_srt      = "# closure\n\.csect \.data[RW]\n\t\.align 2\n";
 248     $T_HDR_info     = "# info\n\.csect \.data[RW]\n\t\.align 2\n"; #not RO!?
 249     $T_HDR_entry    = "# entry\n\.csect \.text[PR]\n\t\.align 2\n";
 250     $T_HDR_fast     = "# fast\n\.csect \.text[PR]\n\t\.align 2\n";
 251     $T_HDR_vector   = "# vector\n\.csect \.data[RW]\n\t\.align 2\n"; #not RO!?
 252     $T_HDR_direct   = "# direct\n";
 253
 254     #--------------------------------------------------------#
 255     } elsif ( $TargetPlatform =~ /^sparc-.*-solaris2/ ) {
 256
 257     $T_STABBY       = 0; # 1 iff .stab things (usually if a.out format)
 258     $T_US           = ''; # _ if symbols have an underscore on the front
 259     $T_PRE_APP      = 'DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
 260     $T_CONST_LBL    = '^\.LLC(\d+):$'; # regexp for what such a lbl looks like
 261     $T_POST_LBL     = ':';
 262
 263     $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*|\.section.*|\s+\.type.*|\s+\.size.*)\n)';
 264     $T_COPY_DIRVS   = '\.(global|proc|stab)';
 265
 266     $T_hsc_cc_PAT   = '\.asciz.*\)(hsc|cc) (.*)\\\\t(.*)"';
 267     $T_DOT_WORD     = '\.(word|byte|half|skip)';
 268     $T_DOT_GLOBAL   = '^\t\.global';
 269     $T_HDR_literal  = "\.text\n\t\.align 8\n";
 270     $T_HDR_misc     = "\.text\n\t\.align 4\n";
 271     $T_HDR_data     = "\.data\n\t\.align 8\n";
 272     $T_HDR_consist  = "\.text\n";
 273     $T_HDR_closure  = "\.data\n\t\.align 4\n";
 274     $T_HDR_srt      = "\.data\n\t\.align 4\n";
 275     $T_HDR_info     = "\.text\n\t\.align 4\n";
 276     $T_HDR_entry    = "\.text\n\t\.align 4\n";
 277     $T_HDR_fast     = "\.text\n\t\.align 4\n";
 278     $T_HDR_vector   = "\.text\n\t\.align 4\n";
 279     $T_HDR_direct   = "\.text\n\t\.align 4\n";
 280
 281     #--------------------------------------------------------#
 282     } elsif ( $TargetPlatform =~ /^sparc-.*-sunos4/ ) {
 283
 284     $T_STABBY       = 1; # 1 iff .stab things (usually if a.out format)
 285     $T_US           = '_'; # _ if symbols have an underscore on the front
 286     $T_PRE_APP      = '^# DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
 287     $T_CONST_LBL    = '^LC(\d+):$';
 288     $T_POST_LBL     = ':';
 289
 290     $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*)\n)';
 291     $T_COPY_DIRVS   = '\.(global|proc|stab)';
 292     $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
 293
 294     $T_DOT_WORD     = '\.word';
 295     $T_DOT_GLOBAL   = '^\t\.global';
 296     $T_HDR_literal  = "\.text\n\t\.align 8\n";
 297     $T_HDR_misc     = "\.text\n\t\.align 4\n";
 298     $T_HDR_data     = "\.data\n\t\.align 8\n";
 299     $T_HDR_consist  = "\.text\n";
 300     $T_HDR_closure  = "\.data\n\t\.align 4\n";
 301     $T_HDR_srt      = "\.data\n\t\.align 4\n";
 302     $T_HDR_info     = "\.text\n\t\.align 4\n";
 303     $T_HDR_entry    = "\.text\n\t\.align 4\n";
 304     $T_HDR_fast     = "\.text\n\t\.align 4\n";
 305     $T_HDR_vector   = "\.text\n\t\.align 4\n";
 306     $T_HDR_direct   = "\.text\n\t\.align 4\n";
 307
 308     #--------------------------------------------------------#
 309     } else {
 310         print STDERR "$Pgm: don't know how to mangle assembly language for: $TargetPlatform\n";
 311         exit 1;
 312     }
 313
 314 if ( 0 ) {
 315 print STDERR "T_STABBY: $T_STABBY\n";
 316 print STDERR "T_US: $T_US\n";
 317 print STDERR "T_PRE_APP: $T_PRE_APP\n";
 318 print STDERR "T_CONST_LBL: $T_CONST_LBL\n";
 319 print STDERR "T_POST_LBL: $T_POST_LBL\n";
 320 if ( $TargetPlatform =~ /^i386-/ ) {
 321     print STDERR "T_X86_PRE_LLBL_PAT: $T_X86_PRE_LLBL_PAT\n";
 322     print STDERR "T_X86_PRE_LLBL: $T_X86_PRE_LLBL\n";
 323     print STDERR "T_X86_BADJMP: $T_X86_BADJMP\n";
 324 }
 325 print STDERR "T_MOVE_DIRVS: $T_MOVE_DIRVS\n";
 326 print STDERR "T_COPY_DIRVS: $T_COPY_DIRVS\n";
 327 print STDERR "T_hsc_cc_PAT: $T_hsc_cc_PAT\n";
 328 print STDERR "T_DOT_WORD: $T_DOT_WORD\n";
 329 print STDERR "T_HDR_literal: $T_HDR_literal\n";
 330 print STDERR "T_HDR_misc: $T_HDR_misc\n";
 331 print STDERR "T_HDR_data: $T_HDR_data\n";
 332 print STDERR "T_HDR_consist: $T_HDR_consist\n";
 333 print STDERR "T_HDR_closure: $T_HDR_closure\n";
 334 print STDERR "T_HDR_info: $T_HDR_info\n";
 335 print STDERR "T_HDR_entry: $T_HDR_entry\n";
 336 print STDERR "T_HDR_fast: $T_HDR_fast\n";
 337 print STDERR "T_HDR_vector: $T_HDR_vector\n";
 338 print STDERR "T_HDR_direct: $T_HDR_direct\n";
 339 }
 340
 341 }
 342 \end{code}
 343
 344 %************************************************************************
 345 %*                                                                      *
 346 \subsection{Mangle away}
 347 %*                                                                      *
 348 %************************************************************************
 349
 350 \begin{code}
 351 sub mangle_asm {
 352     local($in_asmf, $out_asmf) = @_;
 353
 354     # multi-line regexp matching:
 355     local($*) = 1;
 356     local($i, $c);
 357
 358
 359     &init_TARGET_STUFF();
 360     &init_FUNNY_THINGS();
 361
 362     # perl4 on alphas SEGVs when give ${foo} substitutions in patterns.
 363     # To avoid them we declare some locals that allows to avoid using curlies.
 364     local($TUS)      = ${T_US};
 365     local($TPOSTLBL) = ${T_POST_LBL};
 366     local($TMOVEDIRVS) = ${T_MOVE_DIRVS};
 367     local($TPREAPP)    = ${T_PRE_APP};
 368     local($TCOPYDIRVS) = ${T_COPY_DIRVS};
 369     local($TDOTWORD)   = ${T_DOT_WORD};
 370
 371     open(INASM, "< $in_asmf")
 372         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
 373     open(OUTASM,"> $out_asmf")
 374         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
 375
 376     # read whole file, divide into "chunks":
 377     #   record some info about what we've found...
 378
 379     @chk = ();          # contents of the chunk
 380     $numchks = 0;       # number of them
 381     @chkcat = ();       # what category of thing in each chunk
 382     @chksymb = ();      # what symbol(base) is defined in this chunk
 383     %slowchk = ();      # ditto, its regular "slow" entry code
 384     %fastchk = ();      # ditto, fast entry code
 385     %closurechk = ();   # ditto, the (static) closure
 386     %srtchk = ();       # ditto, its SRT (for top-level things)
 387     %infochk = ();      # given a symbol base, say what chunk its info tbl is in
 388     %vectorchk = ();    # ditto, return vector table
 389     $EXTERN_DECLS = ''; # .globl <foo> .text (MIPS only)
 390
 391     $i = 0; $chkcat[0] = 'misc'; $chk[0] = '';
 392
 393     while (<INASM>) {
 394         next if $T_STABBY && /^\.stab.*$TUS[@]?__stg_split_marker/o;
 395         next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
 396         next if /$TPREAPP(NO_)?APP/o;
 397         next if /^;/ && $TargetPlatform =~ /^hppa/;
 398
 399         next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|powerpc|rs6000)-/;
 400
 401         last if /^_section_\.text:$/ && $TargetPlatform =~ /^powerpc-|^rs6000-/;
 402
 403         if ( $TargetPlatform =~ /^mips-/
 404           && /^\t\.(globl \S+ \.text|comm\t)/ ) {
 405             $EXTERN_DECLS .= $_ unless /(__DISCARD__|\b(PK_|ASSIGN_)(FLT|DBL)\b)/;
 406
 407         # As a temporary solution for compiling "foreign export" declarations,
 408         # we use global variables to pass arguments from C to STG land.
 409         # These declarations live in the .hc file and not in the generated C
 410         # stub file, so we let them pass through here.
 411         } elsif ( /^\t\.comm\t__fexp_.*$/ ) {
 412             $chk[++$i]   = $_;
 413             $chkcat[$i]  = 'data';
 414             $chksymb[$i] = '';
 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|ret)$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[@]?([A-Za-z0-9_]+)_srt$TPOSTLBL[@]?$/o ) {
 473             $chk[++$i]   = $_;
 474             $chkcat[$i]  = 'srt';
 475             $chksymb[$i] = $1;
 476
 477             $srtchk{$1} = $i;
 478
 479         } elsif ( /^$TUS[@]?ghc.*c_ID$TPOSTLBL/o ) {
 480             $chk[++$i]  = $_;
 481             $chkcat[$i] = 'consist';
 482
 483         } elsif ( /^($TUS[@]?__gnu_compiled_c|gcc2_compiled\.)$TPOSTLBL/o ) {
 484             ; # toss it
 485
 486         } elsif ( /^$TUS[A-Za-z0-9_]+\.\d+$TPOSTLBL[@]?$/o
 487                || /^$TUS[@]?.*_CAT$TPOSTLBL[@]?$/o              # PROF: _entryname_CAT
 488                || /^$TUS[@]?CC_.*_struct$TPOSTLBL[@]?$/o        # PROF: _CC_ccident_struct
 489                || /^$TUS[@]?.*_done$TPOSTLBL[@]?$/o             # PROF: _module_done
 490                || /^$TUS[@]?_module_registered$TPOSTLBL[@]?$/o  # PROF: _module_registered
 491                ) {
 492             $chk[++$i]   = $_;
 493             $chkcat[$i]  = 'data';
 494             $chksymb[$i] = '';
 495
 496         } elsif ( /^([A-Za-z0-9_]+)\s+\.comm/ && $TargetPlatform =~ /^hppa/ ) {
 497             $chk[++$i]   = $_;
 498             $chkcat[$i]  = 'bss';
 499             $chksymb[$i] = '';
 500
 501         } elsif ( $TargetPlatform =~ /^powerpc-|^rs6000-/ && /^LC\.\.([0-9]+)/ ) {
 502             $chk[++$i]   = $_;
 503             $chkcat[$i]  = 'toc';
 504             $chksymb[$i] = $1;
 505
 506         } elsif ( /^$TUS[@]?CC(S)?_.*$/ ) {
 507             # all CC_ symbols go in the data section...
 508             $chk[++$i]   = $_;
 509             $chkcat[$i]  = 'data';
 510             $chksymb[$i] = '';
 511
 512         } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_(alt|dflt)$TPOSTLBL[@]?$/o ) {
 513             $chk[++$i]   = $_;
 514             $chkcat[$i]  = 'misc';
 515             $chksymb[$i] = '';
 516             #$symbtmp = $1;
 517             #$chksymb[$i] = $symbtmp if ($TargetPlatform =~ /^powerpc-|^rs6000-/) ; #rm andre
 518
 519         } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_vtbl$TPOSTLBL[@]?$/o ) {
 520             $chk[++$i]   = $_;
 521             $chkcat[$i]  = 'vector';
 522             $chksymb[$i] = $1;
 523
 524             $vectorchk{$1} = $i;
 525
 526         # As a temporary solution for compiling "foreign export" declarations,
 527         # we use global variables to pass arguments from C to STG land.
 528         # These declarations live in the .hc file and not in the generated C
 529         # stub file, so we let them pass through here.
 530         } elsif ( /^[\t ]+\.comm[\t ]+__fexp_.*$/ ) {
 531             $chk[++$i]   = $_;
 532             $chkcat[$i]  = 'data';
 533             $chksymb[$i] = '';
 534
 535         } elsif ( $TargetPlatform =~ /^i386-.*-solaris2/
 536              &&   /^(_uname|uname|stat|fstat):/ ) {
 537             # for some utterly bizarre reason, this platform
 538             # likes to drop little local C routines with these names
 539             # into each and every .o file that #includes the
 540             # relevant system .h file.  Yuck.  We just don't
 541             # tolerate them in .hc files (which we are processing
 542             # here).  If you need to call one of these things from
 543             # Haskell, make a call to your own C wrapper, then
 544             # put that C wrapper (which calls one of these) in a
 545             # plain .c file.  WDP 95/12
 546             $chk[++$i]   = $_;
 547             $chkcat[$i]  = 'toss';
 548             $chksymb[$i] = $1;
 549
 550         } elsif ( /^$TUS[@]?[A-Za-z0-9_]/o
 551                 && ( $TargetPlatform !~ /^hppa/ # need to avoid local labels in this case
 552                    || ! /^L\$\d+$/ )
 553                 && ( $TargetPlatform !~ /^powerpc|^rs6000/ # ditto
 554                    || ! /^(L\.\.\d+|LT\.\..*):$/ ) ) {
 555             local($thing);
 556             chop($thing = $_);
 557             print "Funny global thing?: $_"
 558                 unless $KNOWN_FUNNY_THING{$thing}
 559                     || /^$TUS[@]?stg_.*$TPOSTLBL[@]?$/o    # RTS internals
 560                     || /^$TUS[@]__fexp_.*$TPOSTLBL$/o      # foreign export
 561                     || /^$TUS[@]?_reg.*$TPOSTLBL$/o        # PROF: __reg<module>
 562                     || /^$TUS[@]?.*_btm$TPOSTLBL$/o        # large bitmaps
 563                     || /^$TUS[@]?.*_closure_tbl$TPOSTLBL$/o; # closure tables
 564             $chk[++$i]   = $_;
 565             $chkcat[$i]  = 'misc';
 566             if ($TargetPlatform =~ /^powerpc-|^rs6000-/)
 567                { $chksymb[$i] = $thing; }
 568             else { $chksymb[$i] = ''; };
 569
 570         } else { # simple line (duplicated at the top)
 571
 572             $chk[$i] .= $_;
 573         }
 574     }
 575     $numchks = $#chk + 1;
 576
 577     # the division into chunks is imperfect;
 578     # we throw some things over the fence into the next
 579     # chunk.
 580     #
 581     # also, there are things we would like to know
 582     # about the whole module before we start spitting
 583     # output.
 584
 585     local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-)/) ? 1 : 0;
 586
 587 #   print STDERR "first chunk to mangle: $FIRST_MANGLABLE\n";
 588
 589     # Alphas: NB: we start meddling at chunk 1, not chunk 0
 590     # The first ".rdata" is quite magical; as of GCC 2.7.x, it
 591     # spits a ".quad 0" in after the v first ".rdata"; we
 592     # detect this special case (tossing the ".quad 0")!
 593     local($magic_rdata_seen) = 0;
 594
 595     # HPPAs, MIPSen: also start medding at chunk 1
 596
 597     if ($TargetPlatform =~ /^powerpc|^rs6000/) {
 598        print OUTASM $T_HDR_toc; # yes, we have to put a .toc
 599                                 # in the beginning of every file!
 600     %tocequiv = ();          # maps toc symbol number to toc symbol
 601     %revtocequiv = ();       # maps toc symbol to toc symbol number
 602     for ($i = 1; $i < $numchks; $i++) {
 603         $chk[$i] =~ s/\[RW\]//g;
 604         $chk[$i] =~ s/\[DS\]//g;
 605         $chk[$i] =~ s/^\.csect .*\[DS\]$//g;
 606
 607         if ( $chkcat[$i] eq 'toc' && $chk[$i] !~ /\.byte/ )
 608 #ToDo: instead of all these changes, just fix mangle_powerpc_tailjump and delete/ignore these tocs?
 609            { $chk[$i] =~ s/$T_MOVE_DIRVS//g;
 610              $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(\S+_fast\d+)/\t\.tc \1\[TC\],\.\2/;
 611              $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(\S+_entry)\n/\t\.tc \1\[TC\],\.\2\n/;
 612              $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(ret_\S+)/\t\.tc \1\[TC\],\.\2/;
 613              $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(alt_\S+)/\t\.tc \1\[TC\],\.\2/;
 614              $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(vtbl_\S+)/\t\.tc \1\[TC\],\.\2/;
 615
 616              $tocnumber = $chksymb[$i];
 617              $tocsymb = $chk[$i];
 618              $tocsymb =~ s/^LC\.\.\d+:\n//;
 619              $tocsymb =~ s/^\t\.tc \S+,(\S+)\n/\1/;
 620              $tocequiv{$tocnumber} = $tocsymb;
 621
 622            } elsif ( $chkcat[$i] eq 'toc' && $chk[$i] =~ /\.byte/ ) {
 623              $chkcat[$i] = 'literal';
 624            }
 625     }
 626     };
 627
 628     for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
 629         $c = $chk[$i]; # convenience copy
 630
 631 #       print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
 632
 633         # toss all prologue stuff; HPPA is pretty weird
 634         # (see elsewhere)
 635         $c = &mash_hppa_prologue($c) if $TargetPlatform =~ /^hppa/;
 636
 637         # be slightly paranoid to make sure there's
 638         # nothing surprising in there
 639         if ( $c =~ /--- BEGIN ---/ ) {
 640             if (($p, $r) = split(/--- BEGIN ---/, $c)) {
 641
 642                 if ($TargetPlatform =~ /^i386-/) {
 643                     $p =~ s/^\tpushl \%edi\n//;
 644                     $p =~ s/^\tpushl \%esi\n//;
 645                     $p =~ s/^\tsubl \$\d+,\%esp\n//;
 646                     $p =~ s/^\tmovl \$\d+,\%eax\n\tcall __alloca\n// if ($TargetPlatform =~ /^.*-cygwin32/);
 647                 } elsif ($TargetPlatform =~ /^m68k-/) {
 648                     $p =~ s/^\tlink a6,#-?\d.*\n//;
 649                     $p =~ s/^\tpea a6@\n\tmovel sp,a6\n//;
 650                                 # The above showed up in the asm code,
 651                                 # so I added it here.
 652                                 # I hope it's correct.
 653                                 # CaS
 654                     $p =~ s/^\tmovel d2,sp\@-\n//;
 655                     $p =~ s/^\tmovel d5,sp\@-\n//; # SMmark.* only?
 656                     $p =~ s/^\tmoveml \#0x[0-9a-f]+,sp\@-\n//; # SMmark.* only?
 657                 } elsif ($TargetPlatform =~ /^mips-/) {
 658                     # the .frame/.mask/.fmask that we use is the same
 659                     # as that produced by GCC for miniInterpret; this
 660                     # gives GDB some chance of figuring out what happened
 661                     $FRAME = "\t.frame\t\$sp,2168,\$31\n\t.mask\t0x90000000,-4\n\t.fmask\t0x00000000,0\n";
 662                     $p =~ s/^\t\.(frame).*\n/__FRAME__/g;
 663                     $p =~ s/^\t\.(mask|fmask).*\n//g;
 664                     $p =~ s/^\t\.cprestore.*\n/\t\.cprestore 416\n/; # 16 + 100 4-byte args
 665                     $p =~ s/^\tsubu\t\$sp,\$sp,\d+\n//;
 666                     $p =~ s/^\tsw\t\$31,\d+\(\$sp\)\n//;
 667                     $p =~ s/^\tsw\t\$fp,\d+\(\$sp\)\n//;
 668                     $p =~ s/^\tsw\t\$28,\d+\(\$sp\)\n//;
 669                     $p =~ s/__FRAME__/$FRAME/;
 670                 } elsif ($TargetPlatform =~ /^powerpc-|^rs6000/) {
 671                     $p =~ s/^\tmflr 0\n//;
 672                     $p =~ s/^\tstm \d+,-\d+\(1\)\n//;
 673                     $p =~ s/^\tstw? 0,\d+\(1\)\n//g;
 674                     $p =~ s/^\tstw? 1,\d+\(1\)\n//g; #mc
 675                     $p =~ s/^\tlw?z 0,0\(1\)\n//g;   #mc
 676                     $p =~ s/^\tstw?u 1,-\d+\(1\)\n//;
 677                     $p =~ s/^\tstw? \d+,-\d+\(1\)\n//g;
 678                     $p =~ s/^\tstfd \d+,-\d+\(1\)\n//g;
 679                 } else {
 680                     print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n";
 681                 }
 682
 683                 die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/
 684                     && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
 685
 686                 # glue together what's left
 687                 $c = $p . $r;
 688                 $c =~ s/\n\t\n/\n/; # junk blank line
 689             }
 690         }
 691
 692         if ( $TargetPlatform =~ /^mips-/ ) {
 693             # MIPS: first, this basic sequence may occur "--- END ---" or not
 694             $c =~ s/^\tlw\t\$31,\d+\(\$sp\)\n\taddu\t\$sp,\$sp,\d+\n\tj\t\$31\n\t\.end/\t\.end/;
 695         }
 696
 697         # toss all epilogue stuff; again, paranoidly
 698         if ( $c =~ /--- END ---/ ) {
 699             if (($r, $e) = split(/--- END ---/, $c)) {
 700                 if ($TargetPlatform =~ /^i386-/) {
 701                     $e =~ s/^\tret\n//;
 702                     $e =~ s/^\tpopl \%edi\n//;
 703                     $e =~ s/^\tpopl \%esi\n//;
 704                     $e =~ s/^\taddl \$\d+,\%esp\n//;
 705                 } elsif ($TargetPlatform =~ /^m68k-/) {
 706                     $e =~ s/^\tunlk a6\n//;
 707                     $e =~ s/^\trts\n//;
 708                 } elsif ($TargetPlatform =~ /^mips-/) {
 709                     $e =~ s/^\tlw\t\$31,\d+\(\$sp\)\n//;
 710                     $e =~ s/^\tlw\t\$fp,\d+\(\$sp\)\n//;
 711                     $e =~ s/^\taddu\t\$sp,\$sp,\d+\n//;
 712                     $e =~ s/^\tj\t\$31\n//;
 713                 } elsif ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
 714                     $e =~ s/^\taddi 1,1,\d+\n//;
 715                     $e =~ s/^\tcal 1,\d+\(1\)\n//;
 716                     $e =~ s/^\tlw?z? \d+,\d+\(1\)\n//;
 717                     $e =~ s/^\tmtlr 0\n//;
 718                     $e =~ s/^\tbl?r\n//;
 719                 } else {
 720                     print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n";
 721                 }
 722                 die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/
 723                     && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
 724
 725                 # glue together what's left
 726                 $c = $r . $e;
 727                 $c =~ s/\n\t\n/\n/; # junk blank line
 728             }
 729         }
 730
 731         # On SPARCs, we don't do --- BEGIN/END ---, we just
 732         # toss the register-windowing save/restore/ret* instructions
 733         # directly:
 734         if ( $TargetPlatform =~ /^sparc-/ ) {
 735             $c =~ s/^\t(save .*|restore|ret|retl)\n//g;
 736             # throw away PROLOGUE comments
 737             $c =~ s/^\t!#PROLOGUE# 0\n\t!#PROLOGUE# 1\n//;
 738         }
 739
 740         # On Alphas, the prologue mangling is done a little later (below)
 741
 742         # toss all calls to __DISCARD__
 743         $c =~ s/^\t(call|jbsr|jal)\s+$TUS[@]?__DISCARD__\n//go;
 744
 745         # MIPS: that may leave some gratuitous asm macros around
 746         # (no harm done; but we get rid of them to be tidier)
 747         $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/
 748             if $TargetPlatform =~ /^mips-/;
 749
 750         # toss stack adjustment after DoSparks
 751         $c =~ s/^(\tjbsr _DoSparks\n)\taddqw #8,sp/$1/g
 752                 if $TargetPlatform =~ /^m68k-/; # this looks old...
 753
 754         if ( $TargetPlatform =~ /^alpha-/ &&
 755            ! $magic_rdata_seen &&
 756            $c =~ /^\s*\.rdata\n\t\.quad 0\n\t\.align \d\n/ ) {
 757             $c =~ s/^\s*\.rdata\n\t\.quad 0\n\t\.align (\d)\n/\.rdata\n\t\.align $1\n/;
 758             $magic_rdata_seen = 1;
 759         }
 760
 761         # pick some end-things and move them to the next chunk
 762
 763         # pin a funny end-thing on (for easier matching):
 764         $c .= 'FUNNY#END#THING';
 765
 766         while ( $c =~ /$TMOVEDIRVS[@]?FUNNY#END#THING/o ) {  # [@]? is a silly hack to avoid having to use curlies for T_PRE_APP
 767                                                            # (this SEGVs perl4 on alphas, you see)
 768
 769             $to_move = $1;
 770             if ( $i < ($numchks - 1)
 771               && ( $to_move =~ /$TCOPYDIRVS/
 772                 || ($TargetPlatform =~ /^hppa/ && $to_move =~ /align/ && $chkcat[$i+1] eq 'literal') )) {
 773                 $chk[$i + 1] = $to_move . $chk[$i + 1];
 774                 # otherwise they're tossed
 775             }
 776
 777             $c =~ s/$TMOVEDIRVS[@]?FUNNY#END#THING/FUNNY#END#THING/o; # [@]? is a hack (see above)
 778         }
 779
 780         if ( $TargetPlatform =~ /^alpha-/ && $c =~ /^\t\.ent\s+(\S+)/ ) {
 781             $ent = $1;
 782             # toss all prologue stuff, except for loading gp, and the ..ng address
 783             if (($p, $r) = split(/^\t\.prologue/, $c)) {
 784                 if (($keep, $junk) = split(/\.\.ng:/, $p)) {
 785                     $c = $keep . "..ng:\n";
 786                 } else {
 787                     print STDERR "malformed code block ($ent)?\n"
 788                 }
 789             }
 790             $c .= "\t.frame \$30,0,\$26,0\n\t.prologue" . $r;
 791         }
 792
 793         $c =~ s/FUNNY#END#THING//;
 794
 795 #       print STDERR "\nCHK $i (AFTER) (",$chkcat[$i],"):\n", $c;
 796
 797         $chk[$i] = $c; # update w/ convenience copy
 798     }
 799
 800     if ( $TargetPlatform =~ /^alpha-/ ) {
 801         # print out the header stuff first
 802         $chk[0] =~ s/^(\t\.file.*)"(ghc\d+\.c)"/$1"$ifile_root.hc"/;
 803         print OUTASM $chk[0];
 804
 805     } elsif ( $TargetPlatform =~ /^hppa/ ) {
 806         print OUTASM $chk[0];
 807
 808     } elsif ( $TargetPlatform =~ /^mips-/ ) {
 809         $chk[0] = "\t\.file\t1 \"$ifile_root.hc\"\n" . $chk[0];
 810
 811         # get rid of horrible "<dollar>Revision: .*$" strings
 812         local(@lines0) = split(/\n/, $chk[0]);
 813         local($z) = 0;
 814         while ( $z <= $#lines0 ) {
 815             if ( $lines0[$z] =~ /^\t\.byte\t0x24,0x52,0x65,0x76,0x69,0x73,0x69,0x6f$/ ) {
 816                 undef($lines0[$z]);
 817                 $z++;
 818                 while ( $z <= $#lines0 ) {
 819                     undef($lines0[$z]);
 820                     last if $lines0[$z] =~ /[,\t]0x0$/;
 821                     $z++;
 822                 }
 823             }
 824             $z++;
 825         }
 826         $chk[0] = join("\n", @lines0);
 827         $chk[0] =~ s/\n\n+/\n/;
 828         print OUTASM $chk[0];
 829     }
 830
 831     # print out all the literal strings next
 832     for ($i = 0; $i < $numchks; $i++) {
 833         if ( $chkcat[$i] eq 'literal' ) {
 834             print OUTASM $T_HDR_literal, $chk[$i];
 835             print OUTASM "; end literal\n" if $TargetPlatform =~ /^hppa/; # for the splitter
 836
 837             $chkcat[$i] = 'DONE ALREADY';
 838         }
 839     }
 840
 841     # on the HPPA, print out all the bss next
 842     if ( $TargetPlatform =~ /^hppa/ ) {
 843         for ($i = 1; $i < $numchks; $i++) {
 844             if ( $chkcat[$i] eq 'bss' ) {
 845                 print OUTASM "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$BSS\$\n\t.align 4\n";
 846                 print OUTASM $chk[$i];
 847
 848                 $chkcat[$i] = 'DONE ALREADY';
 849             }
 850         }
 851     }
 852
 853     for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
 854 #       print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";
 855
 856         next if $chkcat[$i] eq 'DONE ALREADY';
 857
 858         if ( $chkcat[$i] eq 'misc' ) {
 859             if ($chk[$i] ne '') {
 860                 print OUTASM $T_HDR_misc;
 861                 if ($TargetPlatform =~ /^powerpc-|^rs6000/) {
 862                    $chksymb[$i] =~ s/://;
 863 #new                   if ($chksymb[$i] =~ /ret.*upd/ || $KNOWN_FUNNY_THING{$chksymb[$i]}
 864 #new                    || $chksymb[$i] =~ /^$.{T_US}_(PRIn|PRStart).*${T_POST_LBL}$/o )
 865 #new                      { print OUTASM "\t\.globl $chksymb[$i]\n"; }
 866 #                   if ($chksymb[$i] ne '' && $chksymb[$i] !~ /ret_[a-z]/ && $chksymb[$i] !~ /djn_[a-z]/)
 867                    if ($chksymb[$i] ne '')
 868                        { print OUTASM "\t\.globl \.$chksymb[$i]\n"; };
 869                    if ($chk[$i] =~ /TOC\[tc0\], 0\n/)
 870                      { ($p, $r) = split(/TOC\[tc0\], 0\n/, $chk[$i]); $printDS = 1;}
 871                    else { $r = $chk[$i]; $printDS = 0; };
 872                    $chk[$i] = &mangle_powerpc_tailjump($r);
 873                 };
 874                 &print_doctored($chk[$i], 0);
 875                 if ($TargetPlatform =~ /^powerpc-|^rs6000-/ && $printDS) {
 876 #ok                   if ($chksymb[$i] !~ /\_regMain/) {
 877                      print OUTASM "\.csect ${chksymb[$i]}[DS]\n";
 878                      print OUTASM "${p}TOC[tc0], 0\n";
 879 #ok                   }
 880                 }
 881             }
 882
 883         } elsif ( $chkcat[$i] eq 'toss' ) {
 884             print STDERR "*** NB: TOSSING code for $chksymb[$i] !!! ***\n";
 885
 886         } elsif ( $chkcat[$i] eq 'data' ) {
 887             if ($chk[$i] ne '') {
 888                 print OUTASM $T_HDR_data;
 889                 print OUTASM $chk[$i];
 890             }
 891
 892         } elsif ( $chkcat[$i] eq 'consist' ) {
 893             if ( $chk[$i] =~ /$T_hsc_cc_PAT/o ) {
 894                 local($consist) = "$1.$2.$3";
 895                 $consist =~ s/,/./g;
 896                 $consist =~ s/\//./g;
 897                 $consist =~ s/-/_/g;
 898                 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
 899                 #
 900                 # Using a cygnus-2.7-96q4 gcc build on hppas, the
 901                 # consistency chunk for ghc_cc_ID often (but not always!)
 902                 # gets lumped with a bunch of .IMPORT directives containing info on
 903                 # the code or data space nature of external symbols. We can't
 904                 # toss these, so once the consistency ID has been turned into
 905                 # a representable symbol, we substitute it for the symbol
 906                 # that the string was attached to in the first place (ghc_cc_ID.)
 907                 # (The original string is also substituted away.)
 908                 #
 909                 # This change may affect the code output on other platforms in
 910                 # adverse ways, hence we restrict this hack hppa targets only.
 911                 #
 912                 #    -- 2/98 SOF
 913                 if ( $TargetPlatform =~ /^hppa/ )  {
 914                         $chk[$i] =~ s/^$TUS[@]?ghc.*c_ID$TPOSTLBL/$consist/o;
 915                         $chk[$i] =~ s/\t$T_hsc_cc_PAT/$T_HDR_misc/o;
 916                         $consist = $chk[$i]; #clumsily
 917                 }
 918                 print OUTASM $T_HDR_consist, "${consist}${T_POST_LBL}\n";
 919
 920             } elsif ( $TargetPlatform !~ /^(mips)-/ ) { # we just don't try in those case (ToDo)
 921                 # on mips: consistency string is just a v
 922                 # horrible bunch of .bytes,
 923                 # which I am too lazy to sort out (WDP 95/05)
 924
 925                 print STDERR "Couldn't grok consistency: ", $chk[$i];
 926             }
 927
 928         } elsif ( $chkcat[$i] eq 'splitmarker' ) {
 929             # we can just re-constitute this one...
 930             # NB: we emit _three_ underscores no matter what,
 931             # so ghc-split doesn't have to care.
 932             print OUTASM "___stg_split_marker",$chksymb[$i],"${T_POST_LBL}\n";
 933
 934         } elsif ( $chkcat[$i] eq 'closure'
 935                || $chkcat[$i] eq 'srt'
 936                || $chkcat[$i] eq 'infotbl'
 937                || $chkcat[$i] eq 'slow'
 938                || $chkcat[$i] eq 'fast' ) { # do them in that order
 939             $symb = $chksymb[$i];
 940
 941             # CLOSURE
 942             if ( defined($closurechk{$symb}) ) {
 943                 print OUTASM $T_HDR_closure;
 944                 print OUTASM $chk[$closurechk{$symb}];
 945                 $chkcat[$closurechk{$symb}] = 'DONE ALREADY';
 946             }
 947
 948             # SRT
 949             if ( defined($srtchk{$symb}) ) {
 950                 print OUTASM $T_HDR_srt;
 951                 print OUTASM $chk[$srtchk{$symb}];
 952                 $chkcat[$srtchk{$symb}] = 'DONE ALREADY';
 953             }
 954
 955             # INFO TABLE
 956             if ( defined($infochk{$symb}) ) {
 957
 958                 print OUTASM $T_HDR_info;
 959                 if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
 960                   if ( !defined($slowchk{$symb}) && defined($fastchk{$symb}) ) {
 961                      $fastname = $chk[$fastchk{$symb}];
 962                      $fastname =~ s/([_A-Za-z]*_fast\d+):.*(.*\n)*/\1/;
 963                      $chk[$infochk{$symb}] =~ s/\.long StdErrorCode/\.long $fastname/;
 964                   }
 965                   $chk[$infochk{$symb}] =~ s/\.long ([_A-Za-z]\S+_entry)/\.long \.\1/;
 966                   $chk[$infochk{$symb}] =~ s/\.long ([A-Za-z]\S+_upd)/\.long \.\1/;
 967                   print OUTASM $chk[$infochk{$symb}];
 968                 } else {
 969                 print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
 970                 }
 971                 # entry code will be put here!
 972
 973                 $chkcat[$infochk{$symb}] = 'DONE ALREADY';
 974             }
 975
 976             # STD ENTRY POINT
 977             if ( defined($slowchk{$symb}) ) {
 978
 979                 # teach it to drop through to the fast entry point:
 980                 $c = $chk[$slowchk{$symb}];
 981
 982                 if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
 983                   ($p, $r) = split(/TOC\[tc0\], 0\n/, $c);
 984                   if ($symb =~ /^[_A-Z]/)
 985                   {
 986                     print OUTASM "\t\.globl \.${chksymb[$i]}_entry\n";
 987                     print OUTASM "\.csect ${symb}_entry[DS]\n";
 988                     print OUTASM "${p}TOC[tc0], 0\n";
 989                   };
 990                   $r =~ s/\.csect \.text\[PR\]\n//; # todo: properly - andre
 991                   $c = &mangle_powerpc_tailjump($r);
 992                 };
 993
 994                 if ( defined($fastchk{$symb}) ) {
 995                     if ( $TargetPlatform =~ /^alpha-/ ) {
 996                         $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
 997                     } elsif ( $TargetPlatform =~ /^hppa/ ) {
 998                         $c =~ s/^\s+ldil.*\n\s+ldo.*\n\s+bv.*\n(.*\n)?\s+\.EXIT/$1\t.EXIT/;
 999                     } elsif ( $TargetPlatform =~ /^i386-/ ) {
1000                         # Reg alloc depending, gcc generated code may jump to the fast entry point via
1001                         # a number of registers.
1002                         $c =~ s/^\tmovl \$${T_US}${symb}_fast\d*,\%edx\n\tjmp \*\%edx\n//;
1003                         $c =~ s/^\tmovl \$${T_US}${symb}_fast\d*,\%ecx\n\tjmp \*\%ecx\n//;
1004                         $c =~ s/^\tmovl \$${T_US}${symb}_fast\d*,\%eax\n\tjmp \*\%eax\n//;
1005                         # The next two only apply if we're not stealing %esi or %edi.
1006                         $c =~ s/^\tmovl \$${T_US}${symb}_fast\d*,\%esi\n\tjmp \*\%esi\n// if ($StolenX86Regs < 3);
1007                         $c =~ s/^\tmovl \$${T_US}${symb}_fast\d*,\%edi\n\tjmp \*\%edi\n// if ($StolenX86Regs < 4);
1008                     } elsif ( $TargetPlatform =~ /^mips-/ ) {
1009                         $c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
1010                     } elsif ( $TargetPlatform =~ /^m68k-/ ) {
1011                         $c =~ s/^\tjmp ${T_US}${symb}_fast\d+.*\n\tnop\n//;
1012                         $c =~ s/^\tjmp ${T_US}${symb}_fast\d+.*\n//;
1013                     } elsif ( $TargetPlatform =~ /^powerpc-|^rs6000-/ ) {
1014                         $c =~ s/^\tb \.${T_US}${symb}_fast\d+\n//;
1015                     } elsif ( $TargetPlatform =~ /^sparc-/ ) {
1016                         $c =~ s/^\tcall ${T_US}${symb}_fast\d+,.*\n\tnop\n//;
1017                         $c =~ s/^\tcall ${T_US}${symb}_fast\d+,.*\n(\t[a-z].*\n)/$1/;
1018                     } else {
1019                         print STDERR "$Pgm: mystery slow-fast dropthrough: $TargetPlatform\n";
1020                     }
1021                 }
1022
1023                 if ( $TargetPlatform !~ /^(alpha-|hppa|mips-)/ ) {
1024                     # On alphas, hppa: no very good way to look for "dangling"
1025                     # references to fast-entry point.
1026                     # (questionable re hppa and mips...)
1027                     print STDERR "still has jump to fast entry point:\n$c"
1028                         if $c =~ /$TUS[@]?$symb[@]?_fast/; # NB: paranoia
1029                 }
1030
1031                 print OUTASM $T_HDR_entry;
1032
1033                 &print_doctored($c, 1); # NB: the 1!!!
1034
1035                 $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
1036             }
1037
1038             # FAST ENTRY POINT
1039             if ( defined($fastchk{$symb}) ) {
1040                 $c = $chk[$fastchk{$symb}];
1041                 if ( ! defined($slowchk{$symb})
1042                    # ToDo: the || clause can go once we're no longer
1043                    # concerned about producing exactly the same output as before
1044 #OLD:              || $TargetPlatform =~ /^(m68k|sparc|i386)-/
1045                    ) {
1046                     print OUTASM $T_HDR_fast;
1047                 }
1048                   if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
1049                     local(@lbls) = split(/:/, $c);
1050                     $fullname = $lbls[0];
1051                     $fullname =~ s/$T_MOVE_DIRVS//g;
1052                     if ( $fullname =~ /^[A-Z]/)
1053                        { print OUTASM "\t\.globl \.${fullname}\n";
1054                     } else {
1055 #                       print OUTASM "\t\.lglobl \.${fullname}\n"; #todo: rm - andre
1056                     };
1057                     $c =~ s/((.*\n)*)\t.long \S+, TOC\[tc0\], 0\n\.csect \.text\[PR\]\n((.*\n)*)/\1\3/;
1058                     $c = &mangle_powerpc_tailjump($c);
1059                   };
1060                 &print_doctored($c, 0);
1061                 $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
1062             }
1063
1064         } elsif ( $chkcat[$i] eq 'vector'
1065                || $chkcat[$i] eq 'direct' ) { # do them in that order
1066             $symb = $chksymb[$i];
1067
1068             # VECTOR TABLE
1069             if ( defined($vectorchk{$symb}) ) {
1070                 print OUTASM $T_HDR_vector;
1071                 if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
1072                   if ( $symb =~ /^[A-Z]/) {
1073                      print OUTASM "\t\.globl \.${symb}_vtbl\n";
1074                      print OUTASM "\t\.globl ${symb}_vtbl\n";
1075                   };
1076                   $chk[$vectorchk{$symb}] =~ s/\.long (\S+)/\.long \.\1/g;
1077                   print OUTASM ".${symb}_vtbl:\n";
1078                   print OUTASM $chk[$vectorchk{$symb}];
1079                 } else {
1080                   print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
1081                 }
1082                 # direct return code will be put here!
1083                 $chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
1084
1085             } elsif ( $TargetPlatform =~ /^alpha-/ ) {
1086                 # Alphas: the commented nop is for the splitter, to ensure
1087                 # that no module ends with a label as the very last
1088                 # thing.  (The linker will adjust the label to point
1089                 # to the first code word of the next module linked in,
1090                 # even if alignment constraints cause the label to move!)
1091
1092                 print OUTASM "\t# nop\n";
1093             }
1094
1095         } elsif ( $chkcat[$i] eq 'toc' ) {
1096             # silly optimisation to print tocs, since they come in groups...
1097             print OUTASM $T_HDR_toc;
1098             local($j)   = $i;
1099             while ($chkcat[$j] eq 'toc')
1100               { if (   $chk[$j] !~ /\.tc UpdatePAP\[TC\]/ # not needed: always turned into a jump.
1101                    )
1102                 {
1103                   print OUTASM $chk[$j];
1104                 }
1105                 $chkcat[$j] = 'DONE ALREADY';
1106                 $j++;
1107             }
1108
1109         } else {
1110             &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n");
1111         }
1112     }
1113
1114     print OUTASM $EXTERN_DECLS if $TargetPlatform =~ /^mips-/;
1115
1116     if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
1117          print OUTASM ".csect .text[PR]\n_section_.text:\n.csect .data[RW]\n\t.long _section_.text\n"
1118     };
1119
1120     # finished
1121     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1122     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1123 }
1124 \end{code}
1125
1126 \begin{code}
1127 sub mash_hppa_prologue { # OK, epilogue, too
1128     local($_) = @_;
1129
1130     # toss all prologue stuff
1131     s/^\s+\.ENTRY[^\0]*--- BEGIN ---/\t.ENTRY/;
1132
1133     # Lie about our .CALLINFO
1134     s/^\s+\.CALLINFO.*$/\t.CALLINFO NO_CALLS,NO_UNWIND/;
1135
1136     # Get rid of P'
1137
1138     s/LP'/L'/g;
1139     s/RP'/R'/g;
1140
1141     # toss all epilogue stuff
1142     s/^\s+--- END ---[^\0]*\.EXIT/\t.EXIT/;
1143
1144     # Sorry; we moved the _info stuff to the code segment.
1145     s/_info,DATA/_info,CODE/g;
1146
1147     return($_);
1148 }
1149 \end{code}
1150
1151 \begin{code}
1152 sub print_doctored {
1153     local($_, $need_fallthru_patch) = @_;
1154
1155     if ( $TargetPlatform !~ /^i386-/
1156       || ! /^\t[a-z]/ ) { # no instructions in here, apparently
1157         print OUTASM $_;
1158         return;
1159     }
1160     # OK, must do some x86 **HACKING**
1161
1162     local($entry_patch) = '';
1163     local($exit_patch)  = '';
1164
1165     # gotta watch out for weird instructions that
1166     # invisibly smash various regs:
1167     #   rep*    %ecx used for counting
1168     #   scas*   %edi used for destination index
1169     #   cmps*   %e[sd]i used for indices
1170     #   loop*   %ecx used for counting
1171     #
1172     # SIGH.
1173
1174     # We cater for:
1175     #  * use of STG reg [ nn(%ebx) ] where no machine reg avail
1176     #
1177     #  * GCC used an "STG reg" for its own purposes
1178     #
1179     #  * some secret uses of machine reg, requiring STG reg
1180     #    to be saved/restored
1181
1182     # The most dangerous "GCC uses" of an "STG reg" are when
1183     # the reg holds the target of a jmp -- it's tricky to
1184     # insert the patch-up code before we get to the target!
1185     # So here we change the jmps:
1186
1187     # --------------------------------------------------------
1188     # it can happen that we have jumps of the form...
1189     #   jmp *<something involving %esp>
1190     # or
1191     #   jmp <something involving another naughty register...>
1192     #
1193     # a reasonably-common case is:
1194     #
1195     #   movl $_blah,<bad-reg>
1196     #   jmp  *<bad-reg>
1197     #
1198
1199 # the short form may tickle perl bug:
1200 #    s/^\tmovl \$${T_US}(.*),(\%e[abcd]x)\n\tjmp \*$2/\tjmp $T_US$1/g;
1201     s/^\tmovl \$${T_US}(.*),\%eax\n\tjmp \*\%eax/\tjmp $T_US$1/g;
1202     s/^\tmovl \$${T_US}(.*),\%ebx\n\tjmp \*\%ebx/\tjmp $T_US$1/g;
1203     s/^\tmovl \$${T_US}(.*),\%ecx\n\tjmp \*\%ecx/\tjmp $T_US$1/g;
1204     s/^\tmovl \$${T_US}(.*),\%edx\n\tjmp \*\%edx/\tjmp $T_US$1/g;
1205
1206     if ($StolenX86Regs <= 2 ) { # YURGH! spurious uses of esi?
1207         s/^\tmovl (.*),\%esi\n\tjmp \*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1208         s/^\tjmp \*(-?\d*)\((.*\%esi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
1209         s/^\tjmp \*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/g;
1210         die "$Pgm: (mangler) still have jump involving \%esi!\n$_"
1211             if /(jmp|call) .*\%esi/;
1212     }
1213     if ($StolenX86Regs <= 3 ) { # spurious uses of edi?
1214         s/^\tmovl (.*),\%edi\n\tjmp \*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
1215         s/^\tjmp \*(-?\d*)\((.*\%edi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
1216         s/^\tjmp \*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/g;
1217         die "$Pgm: (mangler) still have jump involving \%edi!\n$_"
1218             if /(jmp|call) .*\%edi/;
1219     }
1220
1221     # OK, now we can decide what our patch-up code is going to
1222     # be:
1223
1224     # Offsets into register table - you'd better update these magic
1225     # numbers should you change its contents!
1226     # local($OFFSET_R1)=0;  No offset for R1 in new RTS.
1227     local($OFFSET_Hp)=92;
1228
1229         # Note funky ".=" stuff; we're *adding* to these _patch guys
1230     if ( $StolenX86Regs <= 2
1231          && ( /[^0-9]\(\%ebx\)/ || /\%esi/ || /^\tcmps/ ) ) { # R1 (esi)
1232         $entry_patch .= "\tmovl \%esi,(\%ebx)\n";
1233         $exit_patch  .= "\tmovl (\%ebx),\%esi\n";
1234
1235         # nothing for call_{entry,exit} because %esi is callee-save
1236     }
1237     if ( $StolenX86Regs <= 3
1238          && ( /${OFFSET_Hp}\(\%ebx\)/ || /\%edi/ || /^\t(scas|cmps)/ ) ) { # Hp (edi)
1239         $entry_patch .= "\tmovl \%edi,${OFFSET_Hp}(\%ebx)\n";
1240         $exit_patch  .= "\tmovl ${OFFSET_Hp}(\%ebx),\%edi\n";
1241
1242         # nothing for call_{entry,exit} because %edi is callee-save
1243     }
1244
1245     # --------------------------------------------------------
1246     # next, here we go with non-%esp patching!
1247     #
1248     s/^(\t[a-z])/$entry_patch$1/; # before first instruction
1249
1250 # Before calling GC we must set up the exit condition before the call
1251 # and entry condition when we come back
1252
1253     # fix _all_ non-local jumps:
1254
1255     s/^\tjmp \*${T_X86_PRE_LLBL_PAT}/\tJMP___SL/go;
1256     s/^\tjmp ${T_X86_PRE_LLBL_PAT}/\tJMP___L/go;
1257
1258     s/^(\tjmp .*\n)/$exit_patch$1/g; # here's the fix...
1259
1260     s/^\tJMP___SL/\tjmp \*${T_X86_PRE_LLBL}/go;
1261     s/^\tJMP___L/\tjmp ${T_X86_PRE_LLBL}/go;
1262
1263     if ($StolenX86Regs == 2 ) {
1264         die "ARGH! Jump uses \%esi or \%edi with -monly-2-regs:\n$_"
1265             if /^\t(jmp|call) .*\%e(si|di)/;
1266     } elsif ($StolenX86Regs == 3 ) {
1267         die "ARGH! Jump uses \%edi with -monly-3-regs:\n$_"
1268             if /^\t(jmp|call) .*\%edi/;
1269     }
1270
1271     # --------------------------------------------------------
1272     # that's it -- print it
1273     #
1274     #die "Funny jumps?\n$_" if /${T_X86_BADJMP}/o; # paranoia
1275
1276     print OUTASM $_;
1277
1278     if ( $need_fallthru_patch ) { # exit patch for end of slow entry code
1279         print OUTASM $exit_patch;
1280         # ToDo: make it not print if there is a "jmp" at the end
1281     }
1282 }
1283 \end{code}
1284
1285 \begin{code}
1286 sub init_FUNNY_THINGS {
1287     %KNOWN_FUNNY_THING = (
1288         # example
1289         # "${T_US}stg_.*{T_POST_LBL}", 1,
1290     );
1291 }
1292 \end{code}
1293
1294 The following table reversal is used for both info tables and return
1295 vectors.  In both cases, we remove the first entry from the table,
1296 reverse the table, put the label at the end, and paste some code
1297 (that which is normally referred to by the first entry in the table)
1298 right after the table itself.  (The code pasting is done elsewhere.)
1299
1300 \begin{code}
1301 sub rev_tbl {
1302     local($symb, $tbl, $discard1) = @_;
1303
1304     local($before) = '';
1305     local($label) = '';
1306     local(@imports) = (); # hppa only
1307     local(@words) = ();
1308     local($after) = '';
1309     local(@lines) = split(/\n/, $tbl);
1310     local($i, $j); #local ($i, $extra, $words_to_pad, $j);
1311
1312     # see comment in mangleAsm as to why this silliness is needed.
1313     local($TDOTWORD) = ${T_DOT_WORD};
1314     local($TDOTGLOBAL) = ${T_DOT_GLOBAL};
1315     local($TUS) = ${T_US};
1316     local($TPOSTLBL) = ${T_POST_LBL};
1317
1318     # Deal with the header...
1319     for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t?$TDOTWORD\s+/o; $i++) {
1320         $label .= $lines[$i] . "\n",
1321             next if $lines[$i] =~ /^[A-Za-z0-9_]+_info$TPOSTLBL[@]?$/o
1322                  || $lines[$i] =~ /$TDOTGLOBAL/o
1323                  || $lines[$i] =~ /^$TUS[@]?\S+_vtbl$TPOSTLBL[@]?$/o;
1324
1325         $before .= $lines[$i] . "\n"; # otherwise...
1326     }
1327
1328     # Grab the table data...
1329     if ( $TargetPlatform !~ /^hppa/ ) {
1330         for ( ; $i <= $#lines && $lines[$i] =~ /^\t?$TDOTWORD\s+/o; $i++) {
1331             push(@words, $lines[$i]);
1332         }
1333     } else { # hppa weirdness
1334         for ( ; $i <= $#lines && $lines[$i] =~ /^\s+\.(word|IMPORT)/; $i++) {
1335             if ($lines[$i] =~ /^\s+\.IMPORT/) {
1336                 push(@imports, $lines[$i]);
1337             } else {
1338                 # We don't use HP's ``function pointers''
1339                 # We just use labels in code space, like normal people
1340                 $lines[$i] =~ s/P%//;
1341                 push(@words, $lines[$i]);
1342             }
1343         }
1344     }
1345
1346     # now throw away the first word (SRT) iff it is empty.
1347     # The .zero business is for Linux/ELF.
1348     # The .skip business is for Sparc/Solaris/ELF.
1349     if ($discard1 && $words[0] =~ /^\t?($TDOTWORD\s+0|\.zero\s+4|\.skip\s+4)/) {
1350         shift(@words)
1351     }
1352
1353 # Padding removed to reduce code size and improve performance on Pentiums.
1354 # Simon M. 13/4/96
1355     # for 486-cache-friendliness, we want our tables aligned
1356     # on 16-byte boundaries (.align 4).  Let's pad:
1357 #    $extra = ($#words + 1) % 4;
1358 #    $words_to_pad = ($extra == 0) ? 0 : 4 - $extra;
1359 #    for ($j = 0; $j < $words_to_pad; $j++) { push(@words, "\t${T_DOT_WORD} 0"); }
1360
1361     for (; $i <= $#lines; $i++) {
1362         $after .= $lines[$i] . "\n";
1363     }
1364
1365     # Alphas:If we have anonymous text (not part of a procedure), the
1366     # linker may complain about missing exception information.  Bleh.
1367     if ( $TargetPlatform =~ /^alpha-/ && $label =~ /^([A-Za-z0-9_]+):$/) {
1368         $before = "\t.ent $1\n" . $before;
1369         $after .= "\t.end $1\n";
1370     }
1371
1372     $tbl = $before
1373          . (($TargetPlatform !~ /^hppa/) ? '' : join("\n", @imports) . "\n")
1374          . join("\n", @words) . "\n"
1375          . $label . $after;
1376
1377 #   print STDERR "before=$before\n";
1378 #   print STDERR "label=$label\n";
1379 #   print STDERR "words=",(reverse @words),"\n";
1380 #   print STDERR "after=$after\n";
1381
1382     $tbl;
1383 }
1384 \end{code}
1385
1386 The HP is a major nuisance.  The threaded code mangler moved info
1387 tables from data space to code space, but unthreaded code in the RTS
1388 still has references to info tables in data space.  Since the HP
1389 linker is very precise about where symbols live, we need to patch the
1390 references in the unthreaded RTS as well.
1391
1392 \begin{code}
1393 sub mini_mangle_asm_hppa {
1394     local($in_asmf, $out_asmf) = @_;
1395
1396     open(INASM, "< $in_asmf")
1397         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
1398     open(OUTASM,"> $out_asmf")
1399         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
1400
1401     while (<INASM>) {
1402         s/_info,DATA/_info,CODE/;   # Move _info references to code space
1403         s/P%_PR/_PR/;
1404         print OUTASM;
1405     }
1406
1407     # finished:
1408     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1409     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1410 }
1411
1412 \end{code}
1413
1414 \begin{code}
1415 sub mini_mangle_asm_powerpc {
1416     local($in_asmf, $out_asmf) = @_;
1417
1418     open(INASM, "< $in_asmf")
1419         || &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
1420     open(OUTASM,"> $out_asmf")
1421         || &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");
1422
1423     while (<INASM>) {
1424         s/long _PRStart/long ._PRStart/;
1425         s/long _PRIn_/long ._PRIn_/;
1426         s/long _Dummy_(\S+)_entry/long ._Dummy_\1_entry/;
1427         s/long _PRMarking_MarkNextRoot\[DS\]/long ._PRMarking_MarkNextRoot/;
1428         s/long _PRMarking_MarkNextCAF\[DS\]/long ._PRMarking_MarkNextCAF/;
1429         s/long _PRMarking_MarkNextAStack\[DS\]/long ._PRMarking_MarkNextAStack/;
1430         s/long _PRMarking_MarkNextBStack\[DS\]/long ._PRMarking_MarkNextBStack/;
1431         s/\.tc EnterNodeCode\[TC]\,EnterNodeCode\[DS\]/\.tc EnterNodeCode\[TC]\,.EnterNodeCode/; # CONC
1432         s/\.tc CheckHeapCode\[TC]\,CheckHeapCode\[DS\]/\.tc CheckHeapCode\[TC]\,.CheckHeapCode/; # CONC
1433         print OUTASM;
1434     }
1435
1436     # finished:
1437     close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
1438     close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
1439 }
1440
1441 sub mangle_powerpc_tailjump {
1442     local($c) = @_;
1443     local($maybe_more) = 1;
1444     while (($c =~ /\tlw?z? \d+,LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n/) && $maybe_more)
1445       { $maybe_more = 0;
1446         $lcsymb = $c;
1447         $lcsymb =~ s/(.*\n)*\tlw?z? \d+,LC\.\.(\d+)\(2\)\n\tmtctr \d+\n\tbctr\n(.*\n)*/\2/;
1448 # the checks for r1 and r2 are mostly paranoia...
1449         $r1 = $c;
1450         $r1 =~ s/(.*\n)*\tlw?z? (\d+),LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n(.*\n)*/\2/;
1451         $r2 = $c;
1452         $r2 =~ s/(.*\n)*\tlw?z? \d+,LC\.\.(\d+)\(2\)\n\tmtctr (\d+)\n\tbctr\n(.*\n)*/\3/;
1453         if (r1 == r2)
1454           { $maybe_more = 1;
1455             $c =~ s/((.*\n)*)\tlw?z? \d+,LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n((.*\n)*)/\1\tb $tocequiv{$lcsymb}\n\3/;
1456           }
1457       };
1458     $c;
1459 }
1460
1461 # make "require"r happy...
1462 1;
1463 \end{code}