ghc-asm.lprl 55.2 KB
Newer Older
1 2
%************************************************************************
%*									*
3
\section[Driver-asm-fiddling]{Fiddling with assembler files}
4 5 6 7 8 9 10 11 12 13 14 15
%*									*
%************************************************************************

Tasks:
\begin{itemize}
\item
Utterly stomp out C functions' prologues and epilogues; i.e., the
stuff to do with the C stack.
\item
Any other required tidying up.
\end{itemize}

16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42
HPPA specific notes:
\begin{itemize}
\item
The HP linker is very picky about symbols being in the appropriate
space (code vs. data).  When we mangle the threaded code to put the
info tables just prior to the code, they wind up in code space
rather than data space.  This means that references to *_info from
un-mangled parts of the RTS (e.g. unthreaded GC code) get
unresolved symbols.  Solution:  mini-mangler for .c files on HP.  I
think this should really be triggered in the driver by a new -rts
option, so that user code doesn't get mangled inappropriately.
\item
With reversed tables, jumps are to the _info label rather than to
the _entry label.  The _info label is just an address in code
space, rather than an entry point with the descriptive blob we
talked about yesterday.  As a result, you can't use the call-style
JMP_ macro.  However, some JMP_ macros take _info labels as targets
and some take code entry points within the RTS.  The latter won't
work with the goto-style JMP_ macro.  Sigh.  Solution: Use the goto
style JMP_ macro, and mangle some more assembly, changing all
"RP'literal" and "LP'literal" references to "R'literal" and
"L'literal," so that you get the real address of the code, rather
than the descriptive blob.  Also change all ".word P%literal"
entries in info tables and vector tables to just ".word literal,"
for the same reason.  Advantage: No more ridiculous call sequences.
\end{itemize}

43 44 45 46 47 48
%************************************************************************
%*									*
\subsection{Constants for various architectures}
%*									*
%************************************************************************

49 50 51
\begin{code}
sub init_TARGET_STUFF {

52 53 54 55 56 57 58 59 60 61 62 63 64 65
    #--------------------------------------------------------#
    if ( $TargetPlatform =~ /^alpha-.*-.*/ ) {

    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
    $T_US	    = ''; # _ if symbols have an underscore on the front
    $T_PRE_APP	    = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP
    $T_CONST_LBL    = '^\$C(\d+):$'; # regexp for what such a lbl looks like
    $T_POST_LBL	    = ':';

    $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\#.*|\.(file|loc)\s+\S+\s+\S+|\.text|\.r?data)\n)';
    $T_COPY_DIRVS   = '^\s*(\#|\.(file|globl|ent|loc))';

    $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
    $T_DOT_WORD	    = '\.quad';
66
    $T_DOT_GLOBAL   = '^\t\.globl';
67 68 69 70 71
    $T_HDR_literal  = "\.rdata\n\t\.align 3\n";
    $T_HDR_misc	    = "\.text\n\t\.align 3\n";
    $T_HDR_data	    = "\.data\n\t\.align 3\n";
    $T_HDR_consist  = "\.text\n";
    $T_HDR_closure  = "\.data\n\t\.align 3\n";
72
    $T_HDR_srt      = "\.text\n\t\.align 3\n";
73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90
    $T_HDR_info	    = "\.text\n\t\.align 3\n";
    $T_HDR_entry    = "\.text\n\t\.align 3\n";
    $T_HDR_fast	    = "\.text\n\t\.align 3\n";
    $T_HDR_vector   = "\.text\n\t\.align 3\n";
    $T_HDR_direct   = "\.text\n\t\.align 3\n";

    #--------------------------------------------------------#
    } elsif ( $TargetPlatform =~ /^hppa/ ) {

    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
    $T_US	    = ''; # _ if symbols have an underscore on the front
    $T_PRE_APP	    = 'DONT THINK THIS APPLIES'; # regexp that says what comes before APP/NO_APP
    $T_CONST_LBL    = '^L\$C(\d+)$'; # regexp for what such a lbl looks like
    $T_POST_LBL	    = '';

    $T_MOVE_DIRVS   = '^((\s+\.(IMPORT|EXPORT|PARAM).*|\s+\.align\s+\d+|\s+\.(SPACE|SUBSPA)\s+\S+|\s*)\n)';
    $T_COPY_DIRVS   = '^\s+\.(IMPORT|EXPORT)';

sof's avatar
sof committed
91
    $T_hsc_cc_PAT   = '\.STRING.*\)(hsc|cc) (.*)\\\\x09(.*)\\\\x00"';
92
    $T_DOT_WORD	    = '\.(blockz|word|half|byte)';
93
    $T_DOT_GLOBAL   = '^\s+\.EXPORT';
94 95 96 97 98
    $T_HDR_literal  = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
    $T_HDR_misc	    = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
    $T_HDR_data	    = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
    $T_HDR_consist  = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n";
    $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 101 102 103 104 105 106
    $T_HDR_info	    = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
    $T_HDR_entry    = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
    $T_HDR_fast	    = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
    $T_HDR_vector   = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";
    $T_HDR_direct   = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$CODE\$\n\t\.align 4\n";

    #--------------------------------------------------------#
107
    } elsif ( $TargetPlatform =~ /^i386-.*-(linuxaout|freebsd2|netbsd|nextstep3|cygwin32|mingw32)$/ ) {
sof's avatar
sof committed
108
				# NeXT added but not tested. CaS
109 110 111 112 113 114

    $T_STABBY	    = 1; # 1 iff .stab things (usually if a.out format)
    $T_US	    = '_'; # _ if symbols have an underscore on the front
    $T_PRE_APP	    = '^#'; # regexp that says what comes before APP/NO_APP
    $T_CONST_LBL    = '^LC(\d+):$';
    $T_POST_LBL	    = ':';
115 116
    $T_X86_PRE_LLBL_PAT = 'L';
    $T_X86_PRE_LLBL	    = 'L';
117 118
    $T_X86_BADJMP   = '^\tjmp [^L\*]';

119
    $T_MOVE_DIRVS   = '^(\s*(\.(p2)?align\s+\d+(,0x90)?|\.globl\s+\S+|\.text|\.data|\.stab[^n].*|\.type\s+.*|\.size\s+.*)\n)';
120 121
    $T_COPY_DIRVS   = '\.(globl|stab)';
    $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";
sof's avatar
sof committed
129
    $T_HDR_closure  = "\.data\n\t\.align 2\n\t.long 0\n" if ( $TargetPlatform =~ /.*-mingw32$/ );
130
    $T_HDR_srt      = "\.text\n\t\.align 2\n";
131
    $T_HDR_info	    = "\.text\n\t\.align 2\n"; # NB: requires padding
132
    $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
133 134 135
    $T_HDR_fast	    = "\.text\n\t\.align 2,0x90\n";
    $T_HDR_vector   = "\.text\n\t\.align 2\n"; # NB: requires padding
    $T_HDR_direct   = "\.text\n\t\.align 2,0x90\n";
136

137
    #--------------------------------------------------------#
138
    } elsif ( $TargetPlatform =~ /^i386-.*-(solaris2|linux|freebsd|netbsd_elf)$/ ) {
139 140 141

    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
    $T_US	    = ''; # _ if symbols have an underscore on the front
142
    $T_PRE_APP	    = # regexp that says what comes before APP/NO_APP
143
		      ($TargetPlatform =~ /-(linux|freebsd|netbsd_elf)$/) ? '#' : '/' ;
144 145
    $T_CONST_LBL    = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
    $T_POST_LBL	    = ':';
146 147
    $T_X86_PRE_LLBL_PAT = '\.L';
    $T_X86_PRE_LLBL	    = '.L';
148 149
    $T_X86_BADJMP   = '^\tjmp [^\.\*]';

150
    $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)';
151 152
    $T_COPY_DIRVS   = '\.(globl)';

153
    if ( $TargetPlatform =~ /freebsd|netbsd_elf/ ) {
154 155 156 157 158 159
        $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
    } else {
        $T_hsc_cc_PAT   = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
    }

    $T_DOT_WORD	    = '\.(long|value|byte|zero)';
160 161
    $T_DOT_GLOBAL   = '\.globl';
    $T_HDR_literal  = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11)
162
    $T_HDR_misc	    = "\.text\n\t\.align 4\n";
163 164 165
    $T_HDR_data	    = "\.data\n\t\.align 4\n"; # ToDo: change align??
    $T_HDR_consist  = "\.text\n";
    $T_HDR_closure  = "\.data\n\t\.align 4\n"; # ToDo: change align?
166
    $T_HDR_srt      = "\.text\n\t\.align 4\n"; # ToDo: change align?
167
    $T_HDR_info	    = "\.text\n\t\.align 4\n"; # NB: requires padding
168
    $T_HDR_entry    = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
169 170 171
    $T_HDR_fast	    = "\.text\n\t\.align 4\n";
    $T_HDR_vector   = "\.text\n\t\.align 4\n"; # NB: requires padding
    $T_HDR_direct   = "\.text\n\t\.align 4\n";
172

173 174 175 176 177 178 179 180 181
    #--------------------------------------------------------#
    } elsif ( $TargetPlatform =~ /^m68k-.*-sunos4/ ) {

    $T_STABBY	    = 1; # 1 iff .stab things (usually if a.out format)
    $T_US	    = '_'; # _ if symbols have an underscore on the front
    $T_PRE_APP	    = '^# MAY NOT APPLY'; # regexp that says what comes before APP/NO_APP
    $T_CONST_LBL    = '^LC(\d+):$';
    $T_POST_LBL	    = ':';

182
    $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.proc\s+\d+|\.const|\.cstring|\.globl\s+\S+|\.text|\.data|\.even|\.stab[^n].*)\n)';
183 184 185 186 187 188 189 190 191 192
    $T_COPY_DIRVS   = '\.(globl|proc|stab)';
    $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';

    $T_DOT_WORD	    = '\.long';
    $T_DOT_GLOBAL   = '\.globl';
    $T_HDR_literal  = "\.text\n\t\.even\n";
    $T_HDR_misc	    = "\.text\n\t\.even\n";
    $T_HDR_data	    = "\.data\n\t\.even\n";
    $T_HDR_consist  = "\.text\n";
    $T_HDR_closure  = "\.data\n\t\.even\n";
193
    $T_HDR_srt      = "\.text\n\t\.even\n";
194 195 196 197 198 199 200 201 202 203 204 205 206 207 208
    $T_HDR_info	    = "\.text\n\t\.even\n";
    $T_HDR_entry    = "\.text\n\t\.even\n";
    $T_HDR_fast	    = "\.text\n\t\.even\n";
    $T_HDR_vector   = "\.text\n\t\.even\n";
    $T_HDR_direct   = "\.text\n\t\.even\n";

    #--------------------------------------------------------#
    } elsif ( $TargetPlatform =~ /^mips-.*/ ) {

    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
    $T_US	    = ''; # _ if symbols have an underscore on the front
    $T_PRE_APP	    = '^\s*#'; # regexp that says what comes before APP/NO_APP
    $T_CONST_LBL    = '^\$LC(\d+):$'; # regexp for what such a lbl looks like
    $T_POST_LBL	    = ':';

209
    $T_MOVE_DIRVS   = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\.text|\.r?data)\n)';
210 211 212 213
    $T_COPY_DIRVS   = '\.(globl|ent)';

    $T_hsc_cc_PAT   = 'I WAS TOO LAZY TO DO THIS BIT (WDP 95/05)';
    $T_DOT_WORD	    = '\.word';
214
    $T_DOT_GLOBAL   = '^\t\.globl';
215 216 217 218 219
    $T_HDR_literal  = "\t\.rdata\n\t\.align 2\n";
    $T_HDR_misc	    = "\t\.text\n\t\.align 2\n";
    $T_HDR_data	    = "\t\.data\n\t\.align 2\n";
    $T_HDR_consist  = 'TOO LAZY TO DO THIS TOO';
    $T_HDR_closure  = "\t\.data\n\t\.align 2\n";
220
    $T_HDR_srt      = "\t\.text\n\t\.align 2\n";
221 222 223 224 225 226 227
    $T_HDR_info	    = "\t\.text\n\t\.align 2\n";
    $T_HDR_entry    = "\t\.text\n\t\.align 2\n";
    $T_HDR_fast	    = "\t\.text\n\t\.align 2\n";
    $T_HDR_vector   = "\t\.text\n\t\.align 2\n";
    $T_HDR_direct   = "\t\.text\n\t\.align 2\n";

    #--------------------------------------------------------#
228
    } elsif ( $TargetPlatform =~ /^powerpc-.*|^rs6000-.*/ ) {
229 230

    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
231
    $T_US	    = ''; # _ if symbols have an underscore on the front
232
    $T_PRE_APP	    = 'NOT APPLICABLE'; # regexp that says what comes before APP/NO_APP
sof's avatar
sof committed
233
    $T_CONST_LBL    = 'NOT APPLICABLE'; # regexp for what such a lbl looks like
234 235
    $T_POST_LBL	    = ':';

sof's avatar
sof committed
236
    $T_MOVE_DIRVS   = '^(\s*(\.toc|\.align \d+|\.csect \S+|\t\.?l?globl \S+)\n)';
237
    $T_COPY_DIRVS   = '\.(l?globl)';
238

239
    $T_hsc_cc_PAT   = '\.byte.*\)(hsc|cc) (.*)"\n\t\.byte \d+\n\t\.byte "(.*)"\n\t\.byte \d+';
240
    $T_DOT_WORD	    = '\.long';
241
    $T_DOT_GLOBAL   = '\.globl';
sof's avatar
sof committed
242
    $T_HDR_toc      = "\.toc\n";
243
    $T_HDR_literal  = "\.csect .data[RW]\n\t\.align 2\n";		#not RO!?
sof's avatar
sof committed
244 245 246 247
    $T_HDR_misc	    = "# misc\n\.csect \.text[PR]\n\t\.align 2\n";
    $T_HDR_data	    = "# data\n\.csect \.data[RW]\n\t\.align 2\n";
    $T_HDR_consist  = "# consist\n\.csect \.data[RW]\n\t\.align 2\n";
    $T_HDR_closure  = "# closure\n\.csect \.data[RW]\n\t\.align 2\n";
248
    $T_HDR_srt      = "# closure\n\.csect \.data[RW]\n\t\.align 2\n";
sof's avatar
sof committed
249
    $T_HDR_info	    = "# info\n\.csect \.data[RW]\n\t\.align 2\n"; #not RO!?
250
    $T_HDR_entry    = "# entry\n\.csect \.text[PR]\n\t\.align 2\n";
sof's avatar
sof committed
251 252 253 254
    $T_HDR_fast	    = "# fast\n\.csect \.text[PR]\n\t\.align 2\n";
    $T_HDR_vector   = "# vector\n\.csect \.data[RW]\n\t\.align 2\n"; #not RO!?
    $T_HDR_direct   = "# direct\n";

255 256 257 258 259 260 261 262 263 264 265 266 267
    #--------------------------------------------------------#
    } elsif ( $TargetPlatform =~ /^sparc-.*-solaris2/ ) {

    $T_STABBY	    = 0; # 1 iff .stab things (usually if a.out format)
    $T_US	    = ''; # _ if symbols have an underscore on the front
    $T_PRE_APP	    = 'DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
    $T_CONST_LBL    = '^\.LLC(\d+):$'; # regexp for what such a lbl looks like
    $T_POST_LBL	    = ':';

    $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*|\.section.*|\s+\.type.*|\s+\.size.*)\n)';
    $T_COPY_DIRVS   = '\.(global|proc|stab)';

    $T_hsc_cc_PAT   = '\.asciz.*\)(hsc|cc) (.*)\\\\t(.*)"';
268
    $T_DOT_WORD	    = '\.(word|byte|half|skip|uahalf|uaword)';
269
    $T_DOT_GLOBAL   = '^\t\.global';
270 271 272 273 274
    $T_HDR_literal  = "\.text\n\t\.align 8\n";
    $T_HDR_misc	    = "\.text\n\t\.align 4\n";
    $T_HDR_data	    = "\.data\n\t\.align 8\n";
    $T_HDR_consist  = "\.text\n";
    $T_HDR_closure  = "\.data\n\t\.align 4\n";
275
    $T_HDR_srt      = "\.data\n\t\.align 4\n";
276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301
    $T_HDR_info	    = "\.text\n\t\.align 4\n";
    $T_HDR_entry    = "\.text\n\t\.align 4\n";
    $T_HDR_fast	    = "\.text\n\t\.align 4\n";
    $T_HDR_vector   = "\.text\n\t\.align 4\n";
    $T_HDR_direct   = "\.text\n\t\.align 4\n";

    #--------------------------------------------------------#
    } elsif ( $TargetPlatform =~ /^sparc-.*-sunos4/ ) {

    $T_STABBY	    = 1; # 1 iff .stab things (usually if a.out format)
    $T_US	    = '_'; # _ if symbols have an underscore on the front
    $T_PRE_APP	    = '^# DOES NOT SEEM TO APPLY'; # regexp that says what comes before APP/NO_APP
    $T_CONST_LBL    = '^LC(\d+):$';
    $T_POST_LBL	    = ':';

    $T_MOVE_DIRVS   = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\.text|\.data|\.stab.*)\n)';
    $T_COPY_DIRVS   = '\.(global|proc|stab)';
    $T_hsc_cc_PAT   = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';

    $T_DOT_WORD	    = '\.word';
    $T_DOT_GLOBAL   = '^\t\.global';
    $T_HDR_literal  = "\.text\n\t\.align 8\n";
    $T_HDR_misc	    = "\.text\n\t\.align 4\n";
    $T_HDR_data	    = "\.data\n\t\.align 8\n";
    $T_HDR_consist  = "\.text\n";
    $T_HDR_closure  = "\.data\n\t\.align 4\n";
302
    $T_HDR_srt      = "\.data\n\t\.align 4\n";
303 304 305 306 307 308 309 310 311 312
    $T_HDR_info	    = "\.text\n\t\.align 4\n";
    $T_HDR_entry    = "\.text\n\t\.align 4\n";
    $T_HDR_fast	    = "\.text\n\t\.align 4\n";
    $T_HDR_vector   = "\.text\n\t\.align 4\n";
    $T_HDR_direct   = "\.text\n\t\.align 4\n";

    #--------------------------------------------------------#
    } else {
	print STDERR "$Pgm: don't know how to mangle assembly language for: $TargetPlatform\n";
	exit 1;
313 314 315 316 317 318 319 320
    }

if ( 0 ) {
print STDERR "T_STABBY: $T_STABBY\n";
print STDERR "T_US: $T_US\n";
print STDERR "T_PRE_APP: $T_PRE_APP\n";
print STDERR "T_CONST_LBL: $T_CONST_LBL\n";
print STDERR "T_POST_LBL: $T_POST_LBL\n";
321 322 323 324 325
if ( $TargetPlatform =~ /^i386-/ ) {
    print STDERR "T_X86_PRE_LLBL_PAT: $T_X86_PRE_LLBL_PAT\n";
    print STDERR "T_X86_PRE_LLBL: $T_X86_PRE_LLBL\n";
    print STDERR "T_X86_BADJMP: $T_X86_BADJMP\n";
}
326 327 328 329
print STDERR "T_MOVE_DIRVS: $T_MOVE_DIRVS\n";
print STDERR "T_COPY_DIRVS: $T_COPY_DIRVS\n";
print STDERR "T_hsc_cc_PAT: $T_hsc_cc_PAT\n";
print STDERR "T_DOT_WORD: $T_DOT_WORD\n";
330
print STDERR "T_HDR_literal: $T_HDR_literal\n";
331 332 333 334 335 336 337 338 339 340 341 342 343 344
print STDERR "T_HDR_misc: $T_HDR_misc\n";
print STDERR "T_HDR_data: $T_HDR_data\n";
print STDERR "T_HDR_consist: $T_HDR_consist\n";
print STDERR "T_HDR_closure: $T_HDR_closure\n";
print STDERR "T_HDR_info: $T_HDR_info\n";
print STDERR "T_HDR_entry: $T_HDR_entry\n";
print STDERR "T_HDR_fast: $T_HDR_fast\n";
print STDERR "T_HDR_vector: $T_HDR_vector\n";
print STDERR "T_HDR_direct: $T_HDR_direct\n";
}

}
\end{code}

345 346 347 348 349 350
%************************************************************************
%*									*
\subsection{Mangle away}
%*									*
%************************************************************************

351 352 353 354 355 356 357
\begin{code}
sub mangle_asm {
    local($in_asmf, $out_asmf) = @_;

    # multi-line regexp matching:
    local($*) = 1;
    local($i, $c);
358 359


360 361 362
    &init_TARGET_STUFF();
    &init_FUNNY_THINGS();

363 364 365 366 367 368 369 370 371
    # perl4 on alphas SEGVs when give ${foo} substitutions in patterns.
    # To avoid them we declare some locals that allows to avoid using curlies.
    local($TUS)      = ${T_US};
    local($TPOSTLBL) = ${T_POST_LBL};
    local($TMOVEDIRVS) = ${T_MOVE_DIRVS};
    local($TPREAPP)    = ${T_PRE_APP};
    local($TCOPYDIRVS) = ${T_COPY_DIRVS};
    local($TDOTWORD)   = ${T_DOT_WORD};

372 373 374 375 376 377 378 379 380 381 382 383 384 385 386
    open(INASM, "< $in_asmf")
	|| &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
    open(OUTASM,"> $out_asmf")
	|| &tidy_up_and_die(1,"$Pgm: failed to open `$out_asmf' (to write)\n");

    # read whole file, divide into "chunks":
    #	record some info about what we've found...

    @chk = ();		# contents of the chunk
    $numchks = 0;	# number of them
    @chkcat = ();	# what category of thing in each chunk
    @chksymb = ();	# what symbol(base) is defined in this chunk
    %slowchk = ();	# ditto, its regular "slow" entry code
    %fastchk = ();	# ditto, fast entry code
    %closurechk = ();	# ditto, the (static) closure
387
    %srtchk = ();	# ditto, its SRT (for top-level things)
388 389
    %infochk = (); 	# given a symbol base, say what chunk its info tbl is in
    %vectorchk = ();    # ditto, return vector table
390
    $EXTERN_DECLS = '';	# .globl <foo> .text (MIPS only)
391

392
    $i = 0; $chkcat[0] = 'misc'; $chk[0] = '';
393 394

    while (<INASM>) {
395
	next if $T_STABBY && /^\.stab.*$TUS[@]?__stg_split_marker/o;
396
	next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
sof's avatar
sof committed
397
	next if /^\t\.def.*endef$/;
398
	next if /$TPREAPP(NO_)?APP/o; 
399 400
    	next if /^;/ && $TargetPlatform =~ /^hppa/;

401
	next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|powerpc|rs6000)-/;
402

403
	last if /^_section_\.text:$/ && $TargetPlatform =~ /^powerpc-|^rs6000-/;
404 405 406 407 408

	if ( $TargetPlatform =~ /^mips-/ 
	  && /^\t\.(globl \S+ \.text|comm\t)/ ) {
	    $EXTERN_DECLS .= $_ unless /(__DISCARD__|\b(PK_|ASSIGN_)(FLT|DBL)\b)/;
  
sof's avatar
sof committed
409 410 411 412
	# As a temporary solution for compiling "foreign export" declarations,
	# we use global variables to pass arguments from C to STG land.
	# These declarations live in the .hc file and not in the generated C
	# stub file, so we let them pass through here.
413
	} elsif ( /^\t\.comm\t__fexp_.*$/ ) {
sof's avatar
sof committed
414 415 416 417
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'data';
	    $chksymb[$i] = '';

418
	} elsif ( /^\s+/ ) { # most common case first -- a simple line!
419 420 421 422
	    # duplicated from the bottom

	    $chk[$i] .= $_;

423 424 425 426 427 428 429 430 431 432
	} elsif ( /\.\.ng:$/ && $TargetPlatform =~ /^alpha-/ ) {
	    # Alphas: Local labels not to be confused with new chunks
	    $chk[$i] .= $_;
  
	# NB: all the rest start with a non-space

	} elsif ( $TargetPlatform =~ /^mips-/
	       && /^\d+:/ ) { # a funny-looking very-local label
	    $chk[$i] .= $_;

433
	} elsif ( /$T_CONST_LBL/o ) {
434 435
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'literal';
436 437
	    $chksymb[$i] = $1;

438
	} elsif ( /^$TUS[@]?__stg_split_marker(\d+)$TPOSTLBL[@]?$/o ) {
439 440
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'splitmarker';
441 442
	    $chksymb[$i] = $1;

443
	} elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_info$TPOSTLBL[@]?$/o ) {
444
	    $symb = $1;
445 446
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'infotbl';
447 448 449 450 451 452
	    $chksymb[$i] = $symb;

	    die "Info table already? $symb; $i\n" if defined($infochk{$symb});

	    $infochk{$symb} = $i;

453
	} elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_(entry|ret)$TPOSTLBL[@]?$/o ) {
454 455
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'slow';
456 457 458 459
	    $chksymb[$i] = $1;

	    $slowchk{$1} = $i;

460
	} elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_fast\d*$TPOSTLBL[@]?$/o ) {
461 462
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'fast';
463 464 465 466
	    $chksymb[$i] = $1;

	    $fastchk{$1} = $i;

467
	} elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_closure$TPOSTLBL[@]?$/o ) {
468 469
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'closure';
470 471 472 473
	    $chksymb[$i] = $1;

	    $closurechk{$1} = $i;

474 475 476 477 478 479 480
	} elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_srt$TPOSTLBL[@]?$/o ) {
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'srt';
	    $chksymb[$i] = $1;

	    $srtchk{$1} = $i;

481 482 483 484 485
	} elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_ct$TPOSTLBL[@]?$/o ) {
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'data';
	    $chksymb[$i] = '';

486
	} elsif ( /^$TUS[@]?ghc.*c_ID$TPOSTLBL/o ) {
487
	    $chk[++$i]  = $_;
488 489
	    $chkcat[$i] = 'consist';

490
	} elsif ( /^($TUS[@]?__gnu_compiled_c|gcc2_compiled\.)$TPOSTLBL/o ) {
491 492
	    ; # toss it

493
	} elsif ( /^$TUS[A-Za-z0-9_]+\.\d+$TPOSTLBL[@]?$/o
494 495 496
	       || /^$TUS[@]?.*_CAT$TPOSTLBL[@]?$/o 		# PROF: _entryname_CAT
	       || /^$TUS[@]?.*_done$TPOSTLBL[@]?$/o		# PROF: _module_done
	       || /^$TUS[@]?_module_registered$TPOSTLBL[@]?$/o	# PROF: _module_registered
497
	       ) {
498 499
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'data';
500 501
	    $chksymb[$i] = '';

502 503 504
	} elsif ( /^([A-Za-z0-9_]+)\s+\.comm/ && $TargetPlatform =~ /^hppa/ ) {
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'bss';
505
  	    $chksymb[$i] = '';
506

507
 	} elsif ( $TargetPlatform =~ /^powerpc-|^rs6000-/ && /^LC\.\.([0-9]+)/ ) {
sof's avatar
sof committed
508 509 510
 	    $chk[++$i]   = $_;
 	    $chkcat[$i]  = 'toc';
   	    $chksymb[$i] = $1;
511

512
	} elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_cc(s)?$TPOSTLBL[@]?$/o ) {
513 514 515 516 517
            # all CC_ symbols go in the data section...
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'data';
	    $chksymb[$i] = '';

518
	} elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_(alt|dflt)$TPOSTLBL[@]?$/o ) {
519 520
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'misc';
521
	    $chksymb[$i] = '';
522 523
 	    #$symbtmp = $1;
            #$chksymb[$i] = $symbtmp if ($TargetPlatform =~ /^powerpc-|^rs6000-/) ; #rm andre
524

525
	} elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_vtbl$TPOSTLBL[@]?$/o ) {
526 527
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'vector';
528 529 530 531
	    $chksymb[$i] = $1;

	    $vectorchk{$1} = $i;

sof's avatar
sof committed
532 533 534 535
	# As a temporary solution for compiling "foreign export" declarations,
	# we use global variables to pass arguments from C to STG land.
	# These declarations live in the .hc file and not in the generated C
	# stub file, so we let them pass through here.
536
	} elsif ( /^[\t ]+\.comm[\t ]+__fexp_.*$/ ) {
sof's avatar
sof committed
537 538 539 540
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'data';
	    $chksymb[$i] = '';

541 542 543 544 545 546 547 548 549 550 551
	} elsif ( $TargetPlatform =~ /^i386-.*-solaris2/
	     &&   /^(_uname|uname|stat|fstat):/ ) {
	    # for some utterly bizarre reason, this platform
	    # likes to drop little local C routines with these names
	    # into each and every .o file that #includes the
	    # relevant system .h file.  Yuck.  We just don't
	    # tolerate them in .hc files (which we are processing
	    # here).  If you need to call one of these things from
	    # Haskell, make a call to your own C wrapper, then
	    # put that C wrapper (which calls one of these) in a
	    # plain .c file.  WDP 95/12
552 553
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'toss';
554 555
	    $chksymb[$i] = $1;

556
	} elsif ( /^$TUS[@]?[A-Za-z0-9_]/o
557
		&& ( $TargetPlatform !~ /^hppa/ # need to avoid local labels in this case
558
		   || ! /^L\$\d+$/ )
559
		&& ( $TargetPlatform !~ /^powerpc|^rs6000/ # ditto
560
		   || ! /^(L\.\.\d+|LT\.\..*):$/ ) ) {
561 562
	    local($thing);
	    chop($thing = $_);
563
	    print "Funny global thing?: $_"
564
		unless $KNOWN_FUNNY_THING{$thing}
565 566
		    || /^$TUS[@]?stg_.*$TPOSTLBL[@]?$/o    # RTS internals
		    || /^$TUS[@]__fexp_.*$TPOSTLBL$/o	   # foreign export
567
		    || /^$TUS[@]?__init.*$TPOSTLBL$/o	   # __init<module>
568 569
		    || /^$TUS[@]?.*_btm$TPOSTLBL$/o        # large bitmaps
		    || /^$TUS[@]?.*_closure_tbl$TPOSTLBL$/o; # closure tables
570 571
	    $chk[++$i]   = $_;
	    $chkcat[$i]  = 'misc';
572
            if ($TargetPlatform =~ /^powerpc-|^rs6000-/) 
sof's avatar
sof committed
573 574
	       { $chksymb[$i] = $thing; }
	    else { $chksymb[$i] = ''; };
575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590

	} else { # simple line (duplicated at the top)

	    $chk[$i] .= $_;
	}
    }
    $numchks = $#chk + 1;

    # the division into chunks is imperfect;
    # we throw some things over the fence into the next
    # chunk.
    #
    # also, there are things we would like to know
    # about the whole module before we start spitting
    # output.

591
    local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-)/) ? 1 : 0;
592 593 594 595 596 597 598 599 600 601 602

#   print STDERR "first chunk to mangle: $FIRST_MANGLABLE\n";

    # Alphas: NB: we start meddling at chunk 1, not chunk 0
    # The first ".rdata" is quite magical; as of GCC 2.7.x, it
    # spits a ".quad 0" in after the v first ".rdata"; we
    # detect this special case (tossing the ".quad 0")!
    local($magic_rdata_seen) = 0;
  
    # HPPAs, MIPSen: also start medding at chunk 1

603 604 605
    if ($TargetPlatform =~ /^powerpc|^rs6000/) {
       print OUTASM $T_HDR_toc; # yes, we have to put a .toc 
                                # in the beginning of every file!
sof's avatar
sof committed
606 607 608 609 610 611
    %tocequiv = ();          # maps toc symbol number to toc symbol
    %revtocequiv = ();       # maps toc symbol to toc symbol number
    for ($i = 1; $i < $numchks; $i++) {
	$chk[$i] =~ s/\[RW\]//g;
	$chk[$i] =~ s/\[DS\]//g;
	$chk[$i] =~ s/^\.csect .*\[DS\]$//g;
612

sof's avatar
sof committed
613
	if ( $chkcat[$i] eq 'toc' && $chk[$i] !~ /\.byte/ )
614
#ToDo: instead of all these changes, just fix mangle_powerpc_tailjump and delete/ignore these tocs?
sof's avatar
sof committed
615 616 617 618
	   { $chk[$i] =~ s/$T_MOVE_DIRVS//g;
	     $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(\S+_fast\d+)/\t\.tc \1\[TC\],\.\2/; 
	     $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(\S+_entry)\n/\t\.tc \1\[TC\],\.\2\n/;
	     $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(ret_\S+)/\t\.tc \1\[TC\],\.\2/;
619
	     $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(alt_\S+)/\t\.tc \1\[TC\],\.\2/;
sof's avatar
sof committed
620 621 622 623 624 625 626 627
	     $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(vtbl_\S+)/\t\.tc \1\[TC\],\.\2/;

             $tocnumber = $chksymb[$i];
             $tocsymb = $chk[$i];
             $tocsymb =~ s/^LC\.\.\d+:\n//;
             $tocsymb =~ s/^\t\.tc \S+,(\S+)\n/\1/;
             $tocequiv{$tocnumber} = $tocsymb;

628 629 630 631 632
           } elsif ( $chkcat[$i] eq 'toc' && $chk[$i] =~ /\.byte/ ) {
             $chkcat[$i] = 'literal';
           }
    }
    };
sof's avatar
sof committed
633

634
    for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
635 636 637 638
	$c = $chk[$i]; # convenience copy

#	print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;

639 640 641 642
	# toss all prologue stuff; HPPA is pretty weird
	# (see elsewhere)
	$c = &mash_hppa_prologue($c) if $TargetPlatform =~ /^hppa/;

643 644 645 646
	# be slightly paranoid to make sure there's
	# nothing surprising in there
	if ( $c =~ /--- BEGIN ---/ ) {
	    if (($p, $r) = split(/--- BEGIN ---/, $c)) {
647 648 649 650

		if ($TargetPlatform =~ /^i386-/) {
		    $p =~ s/^\tpushl \%edi\n//;
		    $p =~ s/^\tpushl \%esi\n//;
651
		    $p =~ s/^\tpushl \%ebx\n//;
652
		    $p =~ s/^\tsubl \$\d+,\%esp\n//;
sof's avatar
sof committed
653
                    $p =~ s/^\tmovl \$\d+,\%eax\n\tcall __alloca\n// if ($TargetPlatform =~ /^.*-cygwin32/);
654 655
		} elsif ($TargetPlatform =~ /^m68k-/) {
		    $p =~ s/^\tlink a6,#-?\d.*\n//;
sof's avatar
sof committed
656 657 658 659 660
 		    $p =~ s/^\tpea a6@\n\tmovel sp,a6\n//;    
 				# The above showed up in the asm code,
 				# so I added it here.
 				# I hope it's correct.
 				# CaS
661 662 663 664 665 666 667 668 669 670 671 672 673 674 675 676
		    $p =~ s/^\tmovel d2,sp\@-\n//;
		    $p =~ s/^\tmovel d5,sp\@-\n//; # SMmark.* only?
		    $p =~ s/^\tmoveml \#0x[0-9a-f]+,sp\@-\n//; # SMmark.* only?
		} elsif ($TargetPlatform =~ /^mips-/) {
		    # the .frame/.mask/.fmask that we use is the same
		    # as that produced by GCC for miniInterpret; this
		    # gives GDB some chance of figuring out what happened
		    $FRAME = "\t.frame\t\$sp,2168,\$31\n\t.mask\t0x90000000,-4\n\t.fmask\t0x00000000,0\n";
		    $p =~ s/^\t\.(frame).*\n/__FRAME__/g;
		    $p =~ s/^\t\.(mask|fmask).*\n//g;
		    $p =~ s/^\t\.cprestore.*\n/\t\.cprestore 416\n/; # 16 + 100 4-byte args
		    $p =~ s/^\tsubu\t\$sp,\$sp,\d+\n//;
		    $p =~ s/^\tsw\t\$31,\d+\(\$sp\)\n//;
		    $p =~ s/^\tsw\t\$fp,\d+\(\$sp\)\n//;
		    $p =~ s/^\tsw\t\$28,\d+\(\$sp\)\n//;
		    $p =~ s/__FRAME__/$FRAME/;
677
 		} elsif ($TargetPlatform =~ /^powerpc-|^rs6000/) {
sof's avatar
sof committed
678 679
 		    $p =~ s/^\tmflr 0\n//;
 		    $p =~ s/^\tstm \d+,-\d+\(1\)\n//;
680 681 682
  		    $p =~ s/^\tstw? 0,\d+\(1\)\n//g;
  		    $p =~ s/^\tstw? 1,\d+\(1\)\n//g; #mc
  		    $p =~ s/^\tlw?z 0,0\(1\)\n//g;   #mc
683 684
  		    $p =~ s/^\tstw?u 1,-\d+\(1\)\n//; 
  		    $p =~ s/^\tstw? \d+,-\d+\(1\)\n//g; 
685
  		    $p =~ s/^\tstfd \d+,-\d+\(1\)\n//g; 
686 687 688 689
		} else {
		    print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n";
		}

690 691 692
		# HWL HACK: dont die, just print a warning
		#print stderr  "HWL: this should die! Prologue junk?: $p\n" if $p =~ /^\t[^\.]/
		#    && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
693
		die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/
694
		    && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
695 696 697

		# glue together what's left
		$c = $p . $r;
698
		$c =~ s/\n\t\n/\n/; # junk blank line
699 700 701
	    }
	}

702 703 704 705 706
	if ( $TargetPlatform =~ /^mips-/ ) {
	    # MIPS: first, this basic sequence may occur "--- END ---" or not
	    $c =~ s/^\tlw\t\$31,\d+\(\$sp\)\n\taddu\t\$sp,\$sp,\d+\n\tj\t\$31\n\t\.end/\t\.end/;
	}

707 708 709
	# toss all epilogue stuff; again, paranoidly
	if ( $c =~ /--- END ---/ ) {
	    if (($r, $e) = split(/--- END ---/, $c)) {
710 711 712 713
		if ($TargetPlatform =~ /^i386-/) {
		    $e =~ s/^\tret\n//;
		    $e =~ s/^\tpopl \%edi\n//;
		    $e =~ s/^\tpopl \%esi\n//;
714
		    $e =~ s/^\tpopl \%ecx\n//;
715
		    $e =~ s/^\taddl \$\d+,\%esp\n//;
rrt's avatar
rrt committed
716
		    $e =~ s/^\tsubl \$-\d+,\%esp\n//;
717 718 719 720 721 722 723 724
		} elsif ($TargetPlatform =~ /^m68k-/) {
		    $e =~ s/^\tunlk a6\n//;
		    $e =~ s/^\trts\n//;
		} elsif ($TargetPlatform =~ /^mips-/) {
		    $e =~ s/^\tlw\t\$31,\d+\(\$sp\)\n//;
		    $e =~ s/^\tlw\t\$fp,\d+\(\$sp\)\n//;
		    $e =~ s/^\taddu\t\$sp,\$sp,\d+\n//;
		    $e =~ s/^\tj\t\$31\n//;
725 726 727 728
 		} elsif ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
  		    $e =~ s/^\taddi 1,1,\d+\n//;
  		    $e =~ s/^\tcal 1,\d+\(1\)\n//;
  		    $e =~ s/^\tlw?z? \d+,\d+\(1\)\n//; 
sof's avatar
sof committed
729
 		    $e =~ s/^\tmtlr 0\n//;
730
  		    $e =~ s/^\tbl?r\n//;
731 732 733
		} else {
		    print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n";
		}
734 735 736
		# HWL HACK: dont die, just print a warning
		#print stderr "HWL: this should die! Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/
		#    && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
737 738
		die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/
		    && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
739 740 741

		# glue together what's left
		$c = $r . $e;
742
		$c =~ s/\n\t\n/\n/; # junk blank line
743 744 745
	    }
	}

746 747 748 749
	# On SPARCs, we don't do --- BEGIN/END ---, we just
	# toss the register-windowing save/restore/ret* instructions
	# directly:
	if ( $TargetPlatform =~ /^sparc-/ ) {
750
	    $c =~ s/^\t(save.*|restore|ret|retl)\n//g;
751 752 753 754 755 756
	    # throw away PROLOGUE comments
	    $c =~ s/^\t!#PROLOGUE# 0\n\t!#PROLOGUE# 1\n//;
	}

	# On Alphas, the prologue mangling is done a little later (below)

757
    	# toss all calls to __DISCARD__
758
	$c =~ s/^\t(call|jbsr|jal)\s+$TUS[@]?__DISCARD__\n//go;
759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776

	# MIPS: that may leave some gratuitous asm macros around
	# (no harm done; but we get rid of them to be tidier)
	$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/
	    if $TargetPlatform =~ /^mips-/;

    	# toss stack adjustment after DoSparks
    	$c =~ s/^(\tjbsr _DoSparks\n)\taddqw #8,sp/$1/g
		if $TargetPlatform =~ /^m68k-/; # this looks old...

	if ( $TargetPlatform =~ /^alpha-/ &&
	   ! $magic_rdata_seen &&
	   $c =~ /^\s*\.rdata\n\t\.quad 0\n\t\.align \d\n/ ) {
	    $c =~ s/^\s*\.rdata\n\t\.quad 0\n\t\.align (\d)\n/\.rdata\n\t\.align $1\n/;
	    $magic_rdata_seen = 1;
	}

	# pick some end-things and move them to the next chunk
777 778 779 780

	# pin a funny end-thing on (for easier matching):
	$c .= 'FUNNY#END#THING';

781 782 783
	while ( $c =~ /$TMOVEDIRVS[@]?FUNNY#END#THING/o ) {  # [@]? is a silly hack to avoid having to use curlies for T_PRE_APP
				                           # (this SEGVs perl4 on alphas, you see)

784
	    $to_move = $1;
785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804 805 806

	    # on x86 we try not to copy any directives into a literal
	    # chunk, rather we keep looking for the next real chunk.  This
	    # is because we get things like
	    #
	    #    .globl blah_closure
	    #    .LC32
	    #    	.string "..."
	    #    blah_closure:
	    #		...
            #
	    if ( $TargetPlatform =~ /^i386/ && $to_move =~ /$TCOPYDIRVS/ ) {
		$j = $i + 1;
		while ( $j < ($numchks - 1)  && $chk[$j] =~ /$T_CONST_LBL/) {
			$j++;
		}
		if ( $j < ($numchks - 1)) {
			$chk[$j] = $to_move . $chk[$j];
	        }
	    }

	    elsif ( $i < ($numchks - 1)
807
	      && ( $to_move =~ /$TCOPYDIRVS/
808
	        || ($TargetPlatform =~ /^hppa/ && $to_move =~ /align/ && $chkcat[$i+1] eq 'literal') )) {
809 810 811 812
		$chk[$i + 1] = $to_move . $chk[$i + 1];
		# otherwise they're tossed
	    }

813
	    $c =~ s/$TMOVEDIRVS[@]?FUNNY#END#THING/FUNNY#END#THING/o; # [@]? is a hack (see above)
814 815
	}

816 817 818 819 820 821 822 823 824 825 826 827 828
    	if ( $TargetPlatform =~ /^alpha-/ && $c =~ /^\t\.ent\s+(\S+)/ ) {
    	    $ent = $1;
	    # toss all prologue stuff, except for loading gp, and the ..ng address
	    if (($p, $r) = split(/^\t\.prologue/, $c)) {
    	        if (($keep, $junk) = split(/\.\.ng:/, $p)) {
    	    	    $c = $keep . "..ng:\n";
    	        } else {
    	    	    print STDERR "malformed code block ($ent)?\n"
    	    	}
    	    }
    	    $c .= "\t.frame \$30,0,\$26,0\n\t.prologue" . $r;
    	}
  
829 830 831 832 833 834 835
	$c =~ s/FUNNY#END#THING//;

#	print STDERR "\nCHK $i (AFTER) (",$chkcat[$i],"):\n", $c;

	$chk[$i] = $c; # update w/ convenience copy
    }

836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867
    if ( $TargetPlatform =~ /^alpha-/ ) {
	# print out the header stuff first
	$chk[0] =~ s/^(\t\.file.*)"(ghc\d+\.c)"/$1"$ifile_root.hc"/;
	print OUTASM $chk[0];

    } elsif ( $TargetPlatform =~ /^hppa/ ) {
	print OUTASM $chk[0];

    } elsif ( $TargetPlatform =~ /^mips-/ ) {
	$chk[0] = "\t\.file\t1 \"$ifile_root.hc\"\n" . $chk[0];

	# get rid of horrible "<dollar>Revision: .*$" strings
	local(@lines0) = split(/\n/, $chk[0]);
	local($z) = 0;
	while ( $z <= $#lines0 ) {
	    if ( $lines0[$z] =~ /^\t\.byte\t0x24,0x52,0x65,0x76,0x69,0x73,0x69,0x6f$/ ) {
		undef($lines0[$z]);
		$z++;
		while ( $z <= $#lines0 ) {
		    undef($lines0[$z]);
		    last if $lines0[$z] =~ /[,\t]0x0$/;
		    $z++;
		}
	    }
	    $z++;
	}
	$chk[0] = join("\n", @lines0);
	$chk[0] =~ s/\n\n+/\n/;
	print OUTASM $chk[0];
    }

    # print out all the literal strings next
868
    for ($i = 0; $i < $numchks; $i++) {
869 870 871 872
	if ( $chkcat[$i] eq 'literal' ) {
	    print OUTASM $T_HDR_literal, $chk[$i];
	    print OUTASM "; end literal\n" if $TargetPlatform =~ /^hppa/; # for the splitter

873 874 875 876
	    $chkcat[$i] = 'DONE ALREADY';
	}
    }

877 878 879 880 881 882 883 884 885 886 887 888 889
    # on the HPPA, print out all the bss next
    if ( $TargetPlatform =~ /^hppa/ ) {
	for ($i = 1; $i < $numchks; $i++) {
	    if ( $chkcat[$i] eq 'bss' ) {
		print OUTASM "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$BSS\$\n\t.align 4\n";
		print OUTASM $chk[$i];

		$chkcat[$i] = 'DONE ALREADY';
	    }
	}
    }

    for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
890 891 892 893 894
#	print STDERR "$i: cat $chkcat[$i], symb $chksymb[$i]\n";

	next if $chkcat[$i] eq 'DONE ALREADY';

	if ( $chkcat[$i] eq 'misc' ) {
895 896
	    if ($chk[$i] ne '') {
		print OUTASM $T_HDR_misc;
897
                if ($TargetPlatform =~ /^powerpc-|^rs6000/) { 
sof's avatar
sof committed
898
                   $chksymb[$i] =~ s/://;
899 900 901
#new                   if ($chksymb[$i] =~ /ret.*upd/ || $KNOWN_FUNNY_THING{$chksymb[$i]}
#new                    || $chksymb[$i] =~ /^$.{T_US}_(PRIn|PRStart).*${T_POST_LBL}$/o )
#new                      { print OUTASM "\t\.globl $chksymb[$i]\n"; }
902 903
#                   if ($chksymb[$i] ne '' && $chksymb[$i] !~ /ret_[a-z]/ && $chksymb[$i] !~ /djn_[a-z]/) 
                   if ($chksymb[$i] ne '')
904
                       { print OUTASM "\t\.globl \.$chksymb[$i]\n"; };
sof's avatar
sof committed
905 906 907 908 909 910
                   if ($chk[$i] =~ /TOC\[tc0\], 0\n/)
	             { ($p, $r) = split(/TOC\[tc0\], 0\n/, $chk[$i]); $printDS = 1;}
                   else { $r = $chk[$i]; $printDS = 0; };
                   $chk[$i] = &mangle_powerpc_tailjump($r);
                };
 		&print_doctored($chk[$i], 0);
911
                if ($TargetPlatform =~ /^powerpc-|^rs6000-/ && $printDS) { 
912
#ok                   if ($chksymb[$i] !~ /\__init_Main/) {
913 914 915
  		     print OUTASM "\.csect ${chksymb[$i]}[DS]\n"; 	
  		     print OUTASM "${p}TOC[tc0], 0\n";
#ok                   }
sof's avatar
sof committed
916
                }
917
	    }
918 919 920 921 922

	} elsif ( $chkcat[$i] eq 'toss' ) {
	    print STDERR "*** NB: TOSSING code for $chksymb[$i] !!! ***\n";

	} elsif ( $chkcat[$i] eq 'data' ) {
923 924 925 926
	    if ($chk[$i] ne '') {
		print OUTASM $T_HDR_data;
		print OUTASM $chk[$i];
	    }
927 928 929 930 931 932 933 934

	} elsif ( $chkcat[$i] eq 'consist' ) {
	    if ( $chk[$i] =~ /$T_hsc_cc_PAT/o ) {
		local($consist) = "$1.$2.$3";
		$consist =~ s/,/./g;
		$consist =~ s/\//./g;
		$consist =~ s/-/_/g;
		$consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
sof's avatar
sof committed
935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953
		#
		# Using a cygnus-2.7-96q4 gcc build on hppas, the 
		# consistency chunk for ghc_cc_ID often (but not always!)
		# gets lumped with a bunch of .IMPORT directives containing info on
		# the code or data space nature of external symbols. We can't
		# toss these, so once the consistency ID has been turned into
		# a representable symbol, we substitute it for the symbol
		# that the string was attached to in the first place (ghc_cc_ID.)
		# (The original string is also substituted away.)
		#
		# This change may affect the code output on other platforms in
		# adverse ways, hence we restrict this hack hppa targets only.
		#
		#    -- 2/98 SOF
		if ( $TargetPlatform =~ /^hppa/ )  {
			$chk[$i] =~ s/^$TUS[@]?ghc.*c_ID$TPOSTLBL/$consist/o;
			$chk[$i] =~ s/\t$T_hsc_cc_PAT/$T_HDR_misc/o;
			$consist = $chk[$i]; #clumsily
                }
954 955
		print OUTASM $T_HDR_consist, "${consist}${T_POST_LBL}\n";

956
	    } elsif ( $TargetPlatform !~ /^(mips)-/ ) { # we just don't try in those case (ToDo)
957 958 959 960
		# on mips: consistency string is just a v
		# horrible bunch of .bytes,
		# which I am too lazy to sort out (WDP 95/05)

961 962 963 964 965
		print STDERR "Couldn't grok consistency: ", $chk[$i];
	    }

	} elsif ( $chkcat[$i] eq 'splitmarker' ) {
	    # we can just re-constitute this one...
966 967 968
	    # NB: we emit _three_ underscores no matter what,
	    # so ghc-split doesn't have to care.
	    print OUTASM "___stg_split_marker",$chksymb[$i],"${T_POST_LBL}\n";
969 970

	} elsif ( $chkcat[$i] eq 'closure'
971
	       || $chkcat[$i] eq 'srt'
972 973 974 975 976 977 978 979 980 981 982 983
	       || $chkcat[$i] eq 'infotbl'
	       || $chkcat[$i] eq 'slow'
	       || $chkcat[$i] eq 'fast' ) { # do them in that order
	    $symb = $chksymb[$i];

	    # CLOSURE
	    if ( defined($closurechk{$symb}) ) {
		print OUTASM $T_HDR_closure;
		print OUTASM $chk[$closurechk{$symb}];
		$chkcat[$closurechk{$symb}] = 'DONE ALREADY';
	    }

984 985 986 987 988 989 990
	    # SRT
	    if ( defined($srtchk{$symb}) ) {
		print OUTASM $T_HDR_srt;
		print OUTASM $chk[$srtchk{$symb}];
		$chkcat[$srtchk{$symb}] = 'DONE ALREADY';
	    }

991 992 993 994
	    # INFO TABLE
	    if ( defined($infochk{$symb}) ) {

		print OUTASM $T_HDR_info;
995
                if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
996 997 998 999 1000
	          if ( !defined($slowchk{$symb}) && defined($fastchk{$symb}) ) {
 		     $fastname = $chk[$fastchk{$symb}];
 		     $fastname =~ s/([_A-Za-z]*_fast\d+):.*(.*\n)*/\1/;
                     $chk[$infochk{$symb}] =~ s/\.long StdErrorCode/\.long $fastname/;
                  }
1001 1002 1003 1004
                  $chk[$infochk{$symb}] =~ s/\.long ([_A-Za-z]\S+_entry)/\.long \.\1/;
                  $chk[$infochk{$symb}] =~ s/\.long ([A-Za-z]\S+_upd)/\.long \.\1/;
                  print OUTASM $chk[$infochk{$symb}];
                } else {
1005
		  print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
1006
                }
1007 1008 1009 1010 1011 1012 1013 1014 1015 1016 1017
		# entry code will be put here!

		$chkcat[$infochk{$symb}] = 'DONE ALREADY';
	    }

	    # STD ENTRY POINT
	    if ( defined($slowchk{$symb}) ) {

		# teach it to drop through to the fast entry point:
		$c = $chk[$slowchk{$symb}];

1018
                if ($TargetPlatform =~ /^powerpc-|^rs6000-/) { 
1019 1020 1021 1022 1023 1024
	          ($p, $r) = split(/TOC\[tc0\], 0\n/, $c); 
                  if ($symb =~ /^[_A-Z]/)
		  { 
		    print OUTASM "\t\.globl \.${chksymb[$i]}_entry\n"; 
		    print OUTASM "\.csect ${symb}_entry[DS]\n"; 	
		    print OUTASM "${p}TOC[tc0], 0\n";
1025 1026 1027
                  }; 
                  $r =~ s/\.csect \.text\[PR\]\n//; # todo: properly - andre
                  $c = &mangle_powerpc_tailjump($r);
sof's avatar
sof committed
1028 1029
                };

1030
		if ( defined($fastchk{$symb}) ) {
1031 1032 1033 1034 1035
		    if ( $TargetPlatform =~ /^alpha-/ ) {
			$c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
		    } elsif ( $TargetPlatform =~ /^hppa/ ) {
			$c =~ s/^\s+ldil.*\n\s+ldo.*\n\s+bv.*\n(.*\n)?\s+\.EXIT/$1\t.EXIT/;
		    } elsif ( $TargetPlatform =~ /^i386-/ ) {
sof's avatar
sof committed
1036 1037
			# Reg alloc depending, gcc generated code may jump to the fast entry point via
			# a number of registers.
1038 1039 1040
			$c =~ s/^\tmovl \$${T_US}${symb}_fast\d*,\%edx\n\tjmp \*\%edx\n//;
			$c =~ s/^\tmovl \$${T_US}${symb}_fast\d*,\%ecx\n\tjmp \*\%ecx\n//;
			$c =~ s/^\tmovl \$${T_US}${symb}_fast\d*,\%eax\n\tjmp \*\%eax\n//;
sof's avatar
sof committed
1041
			# The next two only apply if we're not stealing %esi or %edi.
1042 1043
			$c =~ s/^\tmovl \$${T_US}${symb}_fast\d*,\%esi\n\tjmp \*\%esi\n// if ($StolenX86Regs < 3);
			$c =~ s/^\tmovl \$${T_US}${symb}_fast\d*,\%edi\n\tjmp \*\%edi\n// if ($StolenX86Regs < 4);
1044 1045 1046 1047 1048
		    } elsif ( $TargetPlatform =~ /^mips-/ ) {
			$c =~ s/^\tjmp \$31,\(\$27\),0\n\t\.align 4\n\t\.end/\t.align 4\n\t.end/;
		    } elsif ( $TargetPlatform =~ /^m68k-/ ) {
			$c =~ s/^\tjmp ${T_US}${symb}_fast\d+.*\n\tnop\n//;
			$c =~ s/^\tjmp ${T_US}${symb}_fast\d+.*\n//;
1049
		    } elsif ( $TargetPlatform =~ /^powerpc-|^rs6000-/ ) {
sof's avatar
sof committed
1050
			$c =~ s/^\tb \.${T_US}${symb}_fast\d+\n//;
1051
		    } elsif ( $TargetPlatform =~ /^sparc-/ ) {
1052 1053
			$c =~ s/^\tcall\s+${T_US}${symb}_fast\d+,.*\n\t\s*nop\n//;
			$c =~ s/^\tcall\s+${T_US}${symb}_fast\d+,.*\n(\t\s*[a-z].*\n)/$1/;
1054 1055 1056
		    } else {
			print STDERR "$Pgm: mystery slow-fast dropthrough: $TargetPlatform\n";
		    }
1057 1058
		}

1059 1060 1061 1062 1063
		if ( $TargetPlatform !~ /^(alpha-|hppa|mips-)/ ) {
		    # On alphas, hppa: no very good way to look for "dangling"
		    # references to fast-entry point.
		    # (questionable re hppa and mips...)
		    print STDERR "still has jump to fast entry point:\n$c"
1064
			if $c =~ /$TUS[@]?$symb[@]?_fast/; # NB: paranoia
1065
		}
1066 1067 1068 1069 1070 1071 1072 1073 1074 1075

		print OUTASM $T_HDR_entry;

		&print_doctored($c, 1); # NB: the 1!!!

		$chkcat[$slowchk{$symb}] = 'DONE ALREADY';
	    }
	    
	    # FAST ENTRY POINT
	    if ( defined($fastchk{$symb}) ) {
sof's avatar
sof committed
1076
 		$c = $chk[$fastchk{$symb}];
1077 1078 1079
    	    	if ( ! defined($slowchk{$symb})
		   # ToDo: the || clause can go once we're no longer
		   # concerned about producing exactly the same output as before
1080
#OLD:		   || $TargetPlatform =~ /^(m68k|sparc|i386)-/
1081 1082 1083
		   ) {
		    print OUTASM $T_HDR_fast;
		}
1084
                  if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
sof's avatar
sof committed
1085 1086 1087 1088 1089 1090
                    local(@lbls) = split(/:/, $c);
                    $fullname = $lbls[0];
 	            $fullname =~ s/$T_MOVE_DIRVS//g;
                    if ( $fullname =~ /^[A-Z]/)
                       { print OUTASM "\t\.globl \.${fullname}\n";
                    } else {
1091
#                       print OUTASM "\t\.lglobl \.${fullname}\n"; #todo: rm - andre
sof's avatar
sof committed
1092 1093 1094 1095 1096
                    };
                    $c =~ s/((.*\n)*)\t.long \S+, TOC\[tc0\], 0\n\.csect \.text\[PR\]\n((.*\n)*)/\1\3/;
                    $c = &mangle_powerpc_tailjump($c);
                  };
 		&print_doctored($c, 0);
1097 1098 1099 1100 1101 1102 1103 1104 1105 1106
		$chkcat[$fastchk{$symb}] = 'DONE ALREADY';
	    }

	} elsif ( $chkcat[$i] eq 'vector'
	       || $chkcat[$i] eq 'direct' ) { # do them in that order
	    $symb = $chksymb[$i];

	    # VECTOR TABLE
	    if ( defined($vectorchk{$symb}) ) {
		print OUTASM $T_HDR_vector;
1107
                if ($TargetPlatform =~ /^powerpc-|^rs6000-/) { 
sof's avatar
sof committed
1108
                  if ( $symb =~ /^[A-Z]/) {
1109 1110
                     print OUTASM "\t\.globl \.${symb}_vtbl\n";
		     print OUTASM "\t\.globl ${symb}_vtbl\n";
sof's avatar
sof committed
1111 1112
                  };
		  $chk[$vectorchk{$symb}] =~ s/\.long (\S+)/\.long \.\1/g;
1113
		  print OUTASM ".${symb}_vtbl:\n";
sof's avatar
sof committed
1114 1115
		  print OUTASM $chk[$vectorchk{$symb}];
		} else {
1116
  		  print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
sof's avatar
sof committed
1117
		}
1118 1119
		# direct return code will be put here!
		$chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
1120 1121 1122 1123 1124 1125 1126 1127 1128

	    } elsif ( $TargetPlatform =~ /^alpha-/ ) {
		# Alphas: the commented nop is for the splitter, to ensure
		# that no module ends with a label as the very last
		# thing.  (The linker will adjust the label to point
		# to the first code word of the next module linked in,
		# even if alignment constraints cause the label to move!)

		print OUTASM "\t# nop\n";
1129 1130
	    }
	    
sof's avatar
sof committed
1131
 	} elsif ( $chkcat[$i] eq 'toc' ) {
1132 1133 1134 1135
            # silly optimisation to print tocs, since they come in groups...
 	    print OUTASM $T_HDR_toc;
            local($j)	= $i;
            while ($chkcat[$j] eq 'toc')
1136 1137 1138 1139 1140
              { if (   $chk[$j] !~ /\.tc UpdatePAP\[TC\]/ # not needed: always turned into a jump.
                   ) 
                {
                  print OUTASM $chk[$j];
                }
1141 1142
                $chkcat[$j] = 'DONE ALREADY';
                $j++;
sof's avatar
sof committed
1143 1144
 	    }
 	    
1145 1146 1147 1148
	} else {
	    &tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n");
	}
    }
1149 1150 1151

    print OUTASM $EXTERN_DECLS if $TargetPlatform =~ /^mips-/;

1152
    if ($TargetPlatform =~ /^powerpc-|^rs6000-/) { 
sof's avatar
sof committed
1153 1154 1155
         print OUTASM ".csect .text[PR]\n_section_.text:\n.csect .data[RW]\n\t.long _section_.text\n"
    };

1156 1157 1158 1159 1160 1161
    # finished
    close(OUTASM) || &tidy_up_and_die(1,"Failed writing to $out_asmf\n");
    close(INASM)  || &tidy_up_and_die(1,"Failed reading from $in_asmf\n");
}
\end{code}

1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176 1177 1178 1179 1180 1181 1182 1183 1184 1185 1186
\begin{code}
sub mash_hppa_prologue { # OK, epilogue, too
    local($_) = @_;

    # toss all prologue stuff
    s/^\s+\.ENTRY[^\0]*--- BEGIN ---/\t.ENTRY/;

    # Lie about our .CALLINFO
    s/^\s+\.CALLINFO.*$/\t.CALLINFO NO_CALLS,NO_UNWIND/;

    # Get rid of P'

    s/LP'/L'/g;
    s/RP'/R'/g;

    # toss all epilogue stuff
    s/^\s+--- END ---[^\0]*\.EXIT/\t.EXIT/;

    # Sorry; we moved the _info stuff to the code segment.
    s/_info,DATA/_info,CODE/g;

    return($_);
}
\end{code}

1187 1188 1189 1190 1191
\begin{code}
sub print_doctored {
    local($_, $need_fallthru_patch) = @_;

    if ( $TargetPlatform !~ /^i386-/ 
1192
      || ! /^\t[a-z]/  # no instructions in here, apparently
1193
      || /^${T_US}__init_[A-Za-z0-9_]+${T_POST_LBL}/) {
1194 1195 1196 1197 1198 1199 1200 1201 1202 1203 1204 1205 1206 1207 1208 1209 1210 1211 1212 1213 1214 1215 1216 1217 1218 1219 1220 1221 1222 1223 1224 1225 1226 1227 1228 1229 1230 1231 1232 1233 1234
	print OUTASM $_;
	return;
    }
    # OK, must do some x86 **HACKING**

    local($entry_patch)	= '';
    local($exit_patch)	= '';

    # gotta watch out for weird instructions that
    # invisibly smash various regs:
    #   rep*	%ecx used for counting
    #   scas*	%edi used for destination index
    #   cmps*	%e[sd]i used for indices
    #   loop*	%ecx used for counting
    #
    # SIGH.

    # We cater for:
    #  * use of STG reg [ nn(%ebx) ] where no machine reg avail
    #
    #  * GCC used an "STG reg" for its own purposes
    #
    #  * some secret uses of machine reg, requiring STG reg
    #    to be saved/restored

    # The most dangerous "GCC uses" of an "STG reg" are when
    # the reg holds the target of a jmp -- it's tricky to
    # insert the patch-up code before we get to the target!
    # So here we change the jmps:

    # --------------------------------------------------------
    # it can happen that we have jumps of the form...
    #   jmp *<something involving %esp>
    # or
    #   jmp <something involving another naughty register...>
    #
    # a reasonably-common case is:
    #
    #   movl $_blah,<bad-reg>
    #   jmp  *<bad-reg>
    #
1235