ghc/driver/ghc-asm.lprl

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