Any other required tidying up.
\end{itemize}
+General note [chak]: Many regexps are very fragile because they rely on white
+space being in the right place. This caused trouble with gcc 2.95 (at least
+on Linux), where the use of white space in .s files generated by gcc suddenly
+changed. To guarantee compatibility across different versions of gcc, make
+sure (at least on i386-.*-linux) that regexps tolerate varying amounts of white
+space between an assembler statement and its arguments as well as after a the
+comma separating multiple arguments.
+
+\emph{For the time being, I have corrected the regexps for i386-.*-linux. I
+didn't touch all the regexps for other i386 platforms, as I don't have
+a box to test these changes.}
+
HPPA specific notes:
\begin{itemize}
\item
%************************************************************************
%* *
+\subsection{Top-level code}
+%* *
+%************************************************************************
+
+\begin{code}
+$TargetPlatform = $TARGETPLATFORM;
+
+($Pgm = $0) =~ s|.*/||;
+$ifile = $ARGV[0];
+$ofile = $ARGV[1];
+
+if ( $TargetPlatform =~ /^i386-/ ) {
+ if ($ARGV[2] eq '') {
+ $StolenX86Regs = 4;
+ } else {
+ $StolenX86Regs = $ARGV[2];
+ }
+}
+
+&mangle_asm($ifile,$ofile);
+
+exit(0);
+\end{code}
+
+%************************************************************************
+%* *
\subsection{Constants for various architectures}
%* *
%************************************************************************
$T_STABBY = 0; # 1 iff .stab things (usually if a.out format)
$T_US = ''; # _ if symbols have an underscore on the front
- $T_DO_GC = 'PerformGC_wrapper';
$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_CONST_LBL = '^\$L?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_MOVE_DIRVS = '^(\s*(\$.*\.\.ng:|\.align\s+\d+|\.(globl|ent)\s+\S+|\#.*|\.(file|loc)\s+\S+\s+\S+|\.text|\.r?data)\n)';
+ $T_COPY_DIRVS = '^\s*(\$.*\.\.ng:|\#|\.(file|globl|ent|loc))';
- $T_hsc_cc_PAT = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
- $T_DOT_WORD = '\.quad';
+ $T_DOT_WORD = '\.(long|quad|byte|word)';
$T_DOT_GLOBAL = '^\t\.globl';
$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_rodata = "\.rdata\n\t\.align 3\n";
$T_HDR_closure = "\.data\n\t\.align 3\n";
$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_DO_GC = 'PerformGC_wrapper';
$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)';
- $T_hsc_cc_PAT = '\.STRING.*\)(hsc|cc) (.*)\\\\x09(.*)\\\\x00"';
- $T_DOT_WORD = '\.word';
+ $T_DOT_WORD = '\.(blockz|word|half|byte)';
$T_DOT_GLOBAL = '^\s+\.EXPORT';
$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_rodata = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
$T_HDR_closure = "\t.SPACE \$PRIVATE\$\n\t.SUBSPA \$DATA\$\n\t\.align 4\n";
$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";
#--------------------------------------------------------#
- } elsif ( $TargetPlatform =~ /^i386-.*-(linuxaout|freebsd|nextstep3|cygwin32)/ ) {
+ } elsif ( $TargetPlatform =~ /^i386-.*-(linuxaout|freebsd2|nextstep3|cygwin32|mingw32)$/ ) {
# NeXT added but not tested. CaS
$T_STABBY = 1; # 1 iff .stab things (usually if a.out format)
$T_US = '_'; # _ if symbols have an underscore on the front
- $T_DO_GC = '_PerformGC_wrapper';
$T_PRE_APP = '^#'; # regexp that says what comes before APP/NO_APP
$T_CONST_LBL = '^LC(\d+):$';
$T_POST_LBL = ':';
$T_X86_PRE_LLBL = 'L';
$T_X86_BADJMP = '^\tjmp [^L\*]';
- $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s+\d+(,0x90)?|\.globl\s+\S+|\.text|\.data|\.stab[^n].*|\.type\s+.*|\.size\s+.*)\n)';
- $T_COPY_DIRVS = '\.(globl|stab)';
- $T_hsc_cc_PAT = '\.ascii.*\)(hsc|cc) (.*)\\\\11"\n\t\.ascii\s+"(.*)\\\\0"';
- $T_DOT_WORD = '\.long';
+ $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s.*|\.globl\s+\S+|\.text|\.data|\.stab[^n].*|\.type\s+.*|\.size\s+.*|\.lcomm.*)\n)';
+ $T_COPY_DIRVS = '\.(globl|stab|lcomm)';
+ $T_DOT_WORD = '\.(long|word|value|byte|space)';
$T_DOT_GLOBAL = '\.globl';
$T_HDR_literal = "\.text\n\t\.align 2\n";
$T_HDR_misc = "\.text\n\t\.align 2,0x90\n";
$T_HDR_data = "\.data\n\t\.align 2\n";
- $T_HDR_consist = "\.text\n";
+ $T_HDR_rodata = "\.text\n\t\.align 2\n";
$T_HDR_closure = "\.data\n\t\.align 2\n";
$T_HDR_info = "\.text\n\t\.align 2\n"; # NB: requires padding
$T_HDR_entry = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
- $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";
#--------------------------------------------------------#
- } elsif ( $TargetPlatform =~ /^i386-.*-(solaris2|linux)$/ ) {
+ } elsif ( $TargetPlatform =~ /^i386-.*-(solaris2|linux|gnu|freebsd|netbsd|openbsd|kfreebsdgnu)$/ ) {
$T_STABBY = 0; # 1 iff .stab things (usually if a.out format)
$T_US = ''; # _ if symbols have an underscore on the front
- $T_DO_GC = 'PerformGC_wrapper';
$T_PRE_APP = # regexp that says what comes before APP/NO_APP
- ($TargetPlatform =~ /-linux$/) ? '#' : '/' ;
+ ($TargetPlatform =~ /-(linux|gnu|freebsd|netbsd|openbsd)$/) ? '#' : '/' ;
$T_CONST_LBL = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
$T_POST_LBL = ':';
$T_X86_PRE_LLBL_PAT = '\.L';
$T_X86_PRE_LLBL = '.L';
- $T_X86_BADJMP = '^\tjmp [^\.\*]';
+ $T_X86_BADJMP = '^\tjmp\s+[^\.\*]';
- $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)';
- $T_COPY_DIRVS = '\.(globl)';
+ $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s.*|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)';
+ $T_COPY_DIRVS = '^\s*\.(globl|type|size|local)';
- $T_hsc_cc_PAT = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"';
- $T_DOT_WORD = '\.long';
+ $T_DOT_WORD = '\.(long|value|word|byte|zero)';
$T_DOT_GLOBAL = '\.globl';
$T_HDR_literal = "\.section\t\.rodata\n"; # or just use .text??? (WDP 95/11)
- $T_HDR_misc = "\.text\n\t\.align 16\n";
- $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?
- $T_HDR_info = "\.text\n\t\.align 16\n"; # NB: requires padding
+ $T_HDR_misc = "\.text\n\t\.align 4\n";
+ $T_HDR_data = "\.data\n\t\.align 4\n";
+ $T_HDR_rodata = "\.section\t\.rodata\n\t\.align 4\n";
+ $T_HDR_closure = "\.data\n\t\.align 4\n";
+ $T_HDR_info = "\.text\n\t\.align 4\n";
$T_HDR_entry = "\.text\n"; # no .align so we're right next to _info (arguably wrong...?)
- $T_HDR_fast = "\.text\n\t\.align 16\n";
- $T_HDR_vector = "\.text\n\t\.align 16\n"; # NB: requires padding
- $T_HDR_direct = "\.text\n\t\.align 16\n";
+ $T_HDR_vector = "\.text\n\t\.align 4\n"; # NB: requires padding
+
+ #--------------------------------------------------------#
+ } elsif ( $TargetPlatform =~ /^ia64-.*-linux$/ ) {
+
+ $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 = '#';
+ $T_CONST_LBL = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
+ $T_POST_LBL = ':';
+
+ $T_MOVE_DIRVS = '^(\s*\.(global|proc|pred\.safe_across_calls|text|data|section|subsection|align|size|type|ident)\s+.*\n)';
+ $T_COPY_DIRVS = '\.(global|proc)';
+
+ $T_DOT_WORD = '\.(long|value|byte|zero)';
+ $T_DOT_GLOBAL = '\.global';
+ $T_HDR_literal = "\.section\t\.rodata\n";
+ $T_HDR_misc = "\.text\n\t\.align 8\n";
+ $T_HDR_data = "\.data\n\t\.align 8\n";
+ $T_HDR_rodata = "\.section\t\.rodata\n\t\.align 8\n";
+ $T_HDR_closure = "\.data\n\t\.align 8\n";
+ $T_HDR_info = "\.text\n\t\.align 8\n";
+ $T_HDR_entry = "\.text\n\t\.align 16\n";
+ $T_HDR_vector = "\.text\n\t\.align 8\n";
+
+ #--------------------------------------------------------#
+ } elsif ( $TargetPlatform =~ /^x86_64-.*-(linux|openbsd)$/ ) {
+
+ $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 = '#';
+ $T_CONST_LBL = '^\.LC(\d+):$'; # regexp for what such a lbl looks like
+ $T_POST_LBL = ':';
+
+ $T_MOVE_DIRVS = '^(\s*\.(globl|text|data|section|align|size|type|ident|local)\s+.*\n)';
+ $T_COPY_DIRVS = '\.(globl|local)';
+
+ $T_DOT_WORD = '\.(quad|long|value|byte|zero)';
+ $T_DOT_GLOBAL = '\.global';
+
+ $T_HDR_literal16 = "\.section\t\.rodata.cst16\n\t.align 16\n";
+ $T_HDR_literal = "\.section\t\.rodata\n";
+
+ $T_HDR_misc = "\.text\n\t\.align 8\n";
+ $T_HDR_data = "\.data\n\t\.align 8\n";
+ $T_HDR_rodata = "\.section\t\.rodata\n\t\.align 8\n";
+
+ # the assembler on x86_64/Linux refuses to generate code for
+ # .quad x - y
+ # where x is in the text section and y in the rodata section.
+ # It works if y is in the text section, though. This is probably
+ # going to cause difficulties for PIC, I imagine.
+ $T_HDR_relrodata= "\.text\n\t\.align 8\n";
+
+ $T_HDR_closure = "\.data\n\t\.align 8\n";
+ $T_HDR_info = "\.text\n\t\.align 8\n";
+ $T_HDR_entry = "\.text\n\t\.align 8\n";
+ $T_HDR_vector = "\.text\n\t\.align 8\n";
#--------------------------------------------------------#
} 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_DO_GC = '_PerformGC_wrapper';
$T_PRE_APP = '^# MAY NOT 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+|\.proc\s+\d+|\.const|\.cstring|\.globl\s+\S+|\.text|\.data|\.even|\.stab[^n].*)\n)';
$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_rodata = "\.text\n\t\.even\n";
$T_HDR_closure = "\.data\n\t\.even\n";
$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_DO_GC = 'PerformGC_wrapper';
$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 = ':';
$T_MOVE_DIRVS = '^(\s*(\.align\s+\d+|\.(globl|ent)\s+\S+|\.text|\.r?data)\n)';
$T_COPY_DIRVS = '\.(globl|ent)';
- $T_hsc_cc_PAT = 'I WAS TOO LAZY TO DO THIS BIT (WDP 95/05)';
$T_DOT_WORD = '\.word';
$T_DOT_GLOBAL = '^\t\.globl';
$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_rodata = "\t\.rdata\n\t\.align 2\n";
+ $T_HDR_closure = "\t\.data\n\t\.align 2\n";
+ $T_HDR_info = "\t\.text\n\t\.align 2\n";
+ $T_HDR_entry = "\t\.text\n\t\.align 2\n";
+ $T_HDR_vector = "\t\.text\n\t\.align 2\n";
+
+ #--------------------------------------------------------#
+ } elsif ( $TargetPlatform =~ /^powerpc-apple-darwin.*/ ) {
+ # Apple PowerPC Darwin/MacOS X.
+ $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 = 'DOESNT APPLY'; # 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 = ':';
+
+ $T_MOVE_DIRVS = '^(\s*(\.align \d+|\.text|\.data|\.const_data|\.cstring|\.non_lazy_symbol_pointer|\.const|\.static_const|\.literal4|\.literal8|\.static_data|\.globl \S+|\.section .*|\.lcomm.*)\n)';
+ $T_COPY_DIRVS = '\.(globl|lcomm)';
+
+ $T_DOT_WORD = '\.(long|short|byte|fill|space)';
+ $T_DOT_GLOBAL = '\.globl';
+ $T_HDR_toc = "\.toc\n";
+ $T_HDR_literal = "\t\.const\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_rodata = "\t\.const\n\t\.align 2\n";
+ $T_HDR_relrodata= "\t\.const_data\n\t\.align 2\n";
$T_HDR_closure = "\t\.data\n\t\.align 2\n";
$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";
#--------------------------------------------------------#
- } elsif ( $TargetPlatform =~ /^powerpc-.*|^rs6000-.*/ ) {
+ } elsif ( $TargetPlatform =~ /^i386-apple-darwin.*/ ) {
+ # Apple PowerPC Darwin/MacOS X.
+ $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 = 'DOESNT APPLY'; # 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 = ':';
+ $T_X86_PRE_LLBL_PAT = 'L';
+ $T_X86_PRE_LLBL = 'L';
+ $T_X86_BADJMP = '^\tjmp [^L\*]';
+
+ $T_MOVE_DIRVS = '^(\s*(\.align \d+|\.text|\.data|\.const_data|\.cstring|\.non_lazy_symbol_pointer|\.const|\.static_const|\.literal4|\.literal8|\.static_data|\.globl \S+|\.section .*|\.lcomm.*)\n)';
+ $T_COPY_DIRVS = '\.(globl|lcomm)';
+
+ $T_DOT_WORD = '\.(long|short|byte|fill|space)';
+ $T_DOT_GLOBAL = '\.globl';
+ $T_HDR_toc = "\.toc\n";
+ $T_HDR_literal16= "\t\.literal8\n\t\.align 4\n";
+ $T_HDR_literal = "\t\.const\n\t\.align 4\n";
+ $T_HDR_misc = "\t\.text\n\t\.align 2\n";
+ $T_HDR_data = "\t\.data\n\t\.align 2\n";
+ $T_HDR_rodata = "\t\.const\n\t\.align 2\n";
+ $T_HDR_relrodata= "\t\.const_data\n\t\.align 2\n";
+ $T_HDR_closure = "\t\.data\n\t\.align 2\n";
+ $T_HDR_info = "\t\.text\n\t\.align 2\n";
+ $T_HDR_entry = "\t\.text\n\t\.align 2\n";
+ $T_HDR_vector = "\t\.text\n\t\.align 2\n";
+ #--------------------------------------------------------#
+ } elsif ( $TargetPlatform =~ /^powerpc-.*-linux/ ) {
+ # PowerPC Linux
$T_STABBY = 0; # 1 iff .stab things (usually if a.out format)
$T_US = ''; # _ if symbols have an underscore on the front
- $T_DO_GC = '\.PerformGC_wrapper';
- $T_PRE_APP = 'NOT APPLICABLE'; # regexp that says what comes before APP/NO_APP
- $T_CONST_LBL = 'NOT APPLICABLE'; # regexp for what such a lbl looks like
+ $T_PRE_APP = '^#'; # 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 = ':';
- $T_MOVE_DIRVS = '^(\s*(\.toc|\.align \d+|\.csect \S+|\t\.?l?globl \S+)\n)';
- $T_COPY_DIRVS = '\.(l?globl)';
+ $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s+\d+(,\s*0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)';
+ $T_COPY_DIRVS = '^\s*\.(globl|type|size|local)';
- $T_hsc_cc_PAT = '\.byte.*\)(hsc|cc) (.*)"\n\t\.byte \d+\n\t\.byte "(.*)"\n\t\.byte \d+';
- $T_DOT_WORD = '\.long';
+ $T_DOT_WORD = '\.(long|short|byte|fill|space)';
+ $T_DOT_GLOBAL = '\.globl';
+ $T_HDR_toc = "\.toc\n";
+ $T_HDR_literal = "\t\.section\t.rodata\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_rodata = "\t\.section\t.rodata\n\t\.align 2\n";
+ $T_HDR_closure = "\t\.data\n\t\.align 2\n";
+ $T_HDR_info = "\t\.text\n\t\.align 2\n";
+ $T_HDR_entry = "\t\.text\n\t\.align 2\n";
+ $T_HDR_vector = "\t\.text\n\t\.align 2\n";
+
+ #--------------------------------------------------------#
+ } elsif ( $TargetPlatform =~ /^powerpc64-.*-linux/ ) {
+ # PowerPC 64 Linux
+ $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 = '^#'; # 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 = ':';
+
+ $T_MOVE_DIRVS = '^(\s*(\.(p2)?align\s+\d+(,\s*0x90)?|\.globl\s+\S+|\.text|\.data|\.section\s+.*|\.type\s+.*|\.size\s+\S+\s*,\s*\d+|\.ident.*|\.local.*)\n)';
+ $T_COPY_DIRVS = '^\s*\.(globl|type|size|local)';
+
+ $T_DOT_WORD = '\.(long|short|byte|fill|space)';
$T_DOT_GLOBAL = '\.globl';
$T_HDR_toc = "\.toc\n";
- $T_HDR_literal = "\.csect .data[RW]\n\t\.align 2\n"; #not RO!?
- $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";
- $T_HDR_info = "# info\n\.csect \.data[RW]\n\t\.align 2\n"; #not RO!?
- $T_HDR_entry = "# entry\n\.csect \.text[PR]\n\t\.align 2\n";
- $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";
+ $T_HDR_literal = "\t\.section\t\".toc\",\"aw\"\n";
+ $T_HDR_misc = "\t\.text\n\t\.align 2\n";
+ $T_HDR_data = "\t\.data\n\t\.align 2\n";
+ $T_HDR_rodata = "\t\.section\t.rodata\n\t\.align 2\n";
+ $T_HDR_closure = "\t\.data\n\t\.align 2\n";
+ $T_HDR_info = "\t\.text\n\t\.align 2\n";
+ $T_HDR_entry = "\t\.text\n\t\.align 2\n";
+ $T_HDR_vector = "\t\.text\n\t\.align 2\n";
#--------------------------------------------------------#
- } elsif ( $TargetPlatform =~ /^sparc-.*-solaris2/ ) {
+ } elsif ( $TargetPlatform =~ /^sparc-.*-(solaris2|openbsd)/ ) {
$T_STABBY = 0; # 1 iff .stab things (usually if a.out format)
$T_US = ''; # _ if symbols have an underscore on the front
- $T_DO_GC = 'PerformGC_wrapper';
$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_MOVE_DIRVS = '^((\s+\.align\s+\d+|\s+\.proc\s+\d+|\s+\.global\s+\S+|\s+\.local\s+\S+|\.text|\.data|\.stab.*|\s*\.section.*|\s+\.type.*|\s+\.size.*)\n)';
+ $T_COPY_DIRVS = '\.(global|local|proc|stab)';
- $T_hsc_cc_PAT = '\.asciz.*\)(hsc|cc) (.*)\\\\t(.*)"';
- $T_DOT_WORD = '\.word';
+ $T_DOT_WORD = '\.(long|word|byte|half|skip|uahalf|uaword)';
$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_rodata = "\.text\n\t\.align 4\n";
$T_HDR_closure = "\.data\n\t\.align 4\n";
- $T_HDR_info = "\.text\n\t\.align 4\n";
+ $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_DO_GC = '_PerformGC_wrapper';
$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_rodata = "\.text\n\t\.align 4\n";
$T_HDR_closure = "\.data\n\t\.align 4\n";
$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-.*-linux/ ) {
+ $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 = '#'; # regexp that says what comes before APP/NO_APP
+ # Probably doesn't apply anyway
+ $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|\.seg|\.stab.*|\s+?\.section.*|\s+\.type.*|\s+\.size.*)\n)';
+ $T_COPY_DIRVS = '\.(global|globl|proc|stab)';
+
+ $T_DOT_WORD = '\.(long|word|nword|xword|byte|half|short|skip|uahalf|uaword)';
+ $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_rodata = "\.text\n\t\.align 4\n";
+ $T_HDR_closure = "\.data\n\t\.align 4\n";
+ $T_HDR_info = "\.text\n\t\.align 4\n";
+ $T_HDR_entry = "\.text\n\t\.align 4\n";
+ $T_HDR_vector = "\.text\n\t\.align 4\n";
#--------------------------------------------------------#
} else {
exit 1;
}
+ if($T_HDR_relrodata eq "") {
+ # default values:
+ # relrodata defaults to rodata.
+ $T_HDR_relrodata = $T_HDR_rodata;
+ }
+
if ( 0 ) {
print STDERR "T_STABBY: $T_STABBY\n";
print STDERR "T_US: $T_US\n";
-print STDERR "T_DO_GC: $T_DO_GC\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";
}
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";
print STDERR "T_HDR_literal: $T_HDR_literal\n";
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_rodata: $T_HDR_rodata\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";
}
}
&init_TARGET_STUFF();
&init_FUNNY_THINGS();
- # 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};
-
open(INASM, "< $in_asmf")
|| &tidy_up_and_die(1,"$Pgm: failed to open `$in_asmf' (to read)\n");
open(OUTASM,"> $out_asmf")
$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
+ %entrychk = (); # ditto, its entry code
%closurechk = (); # ditto, the (static) closure
+ %srtchk = (); # ditto, its SRT (for top-level things)
%infochk = (); # given a symbol base, say what chunk its info tbl is in
%vectorchk = (); # ditto, return vector table
- %directchk = (); # ditto, direct return code
$EXTERN_DECLS = ''; # .globl <foo> .text (MIPS only)
$i = 0; $chkcat[0] = 'misc'; $chk[0] = '';
while (<INASM>) {
- next if $T_STABBY && /^\.stab.*$TUS[@]?__stg_split_marker/o;
+ tr/\r//d if $TargetPlatform =~ /-mingw32$/; # In case Perl doesn't convert line endings
+ next if $T_STABBY && /^\.stab.*${T_US}__stg_split_marker/o;
next if $T_STABBY && /^\.stab.*ghc.*c_ID/;
- next if /$TPREAPP(NO_)?APP/o;
+ next if /^\t\.def.*endef$/;
+ next if /${T_PRE_APP}(NO_)?APP/o;
next if /^;/ && $TargetPlatform =~ /^hppa/;
- next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|powerpc|rs6000)-/;
-
- last if /^_section_\.text:$/ && $TargetPlatform =~ /^powerpc-|^rs6000-/;
+ next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|ia64)-/;
if ( $TargetPlatform =~ /^mips-/
- && /^\t\.(globl \S+ \.text|comm\t)/ ) {
+ && /^\t\.(globl\S+\.text|comm\t)/ ) {
$EXTERN_DECLS .= $_ unless /(__DISCARD__|\b(PK_|ASSIGN_)(FLT|DBL)\b)/;
-
- # 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.
- } elsif ( /^\t\.comm\t__fexp_.*$/ ) {
+ # Treat .comm variables as data. These show up in two (known) places:
+ #
+ # - the module_registered variable used in the __stginit fragment.
+ # even though these are declared static and initialised, gcc 3.3
+ # likes to make them .comm, presumably to save space in the
+ # object file.
+ #
+ # - global variables used to pass arguments from C to STG in
+ # a foreign export. (is this still true? --SDM)
+ #
+ } elsif ( /^\t\.comm.*$/ ) {
$chk[++$i] = $_;
$chkcat[$i] = 'data';
$chksymb[$i] = '';
+ # Labels ending "_str": these are literal strings.
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_str${T_POST_LBL}$/ ) {
+ $chk[++$i] = $_;
+ $chkcat[$i] = 'rodata';
+ $chksymb[$i] = '';
+ } elsif ( $TargetPlatform =~ /-darwin/
+ && (/^\s*\.subsections_via_symbols/
+ ||/^\s*\.no_dead_strip.*/)) {
+ # Don't allow Apple's linker to do any dead-stripping of symbols
+ # in this file, because it will mess up info-tables in mangled
+ # code.
+ # The .no_dead_strip directives are actually put there by
+ # the gcc3 "used" attribute on entry points.
+
+ } elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/ && (
+ /^\s*\.picsymbol_stub/
+ || /^\s*\.section __TEXT,__picsymbol_stub\d,.*/
+ || /^\s*\.section __TEXT,__picsymbolstub\d,.*/
+ || /^\s*\.symbol_stub/
+ || /^\s*\.section __TEXT,__symbol_stub\d,.*/
+ || /^\s*\.section __TEXT,__symbolstub\d,.*/
+ || /^\s*\.lazy_symbol_pointer/
+ || /^\s*\.non_lazy_symbol_pointer/ ))
+ {
+ $chk[++$i] = $_;
+ $chkcat[$i] = 'dyld';
+ $chksymb[$i] = '';
+
+ } elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/ && $chkcat[$i] eq 'dyld' && /^\s*\.data/)
+ { # non_lazy_symbol_ptrs that point to local symbols
+ $chk[++$i] = $_;
+ $chkcat[$i] = 'dyld';
+ $chksymb[$i] = '';
+
} elsif ( /^\s+/ ) { # most common case first -- a simple line!
# duplicated from the bottom
} 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-/
$chkcat[$i] = 'literal';
$chksymb[$i] = $1;
- } elsif ( /^$TUS[@]?__stg_split_marker(\d+)$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}__stg_split_marker(\d*)${T_POST_LBL}$/o ) {
$chk[++$i] = $_;
$chkcat[$i] = 'splitmarker';
$chksymb[$i] = $1;
- } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_info$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_info${T_POST_LBL}$/o ) {
$symb = $1;
$chk[++$i] = $_;
$chkcat[$i] = 'infotbl';
$infochk{$symb} = $i;
- } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_entry$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_(entry|ret)${T_POST_LBL}$/o ) {
$chk[++$i] = $_;
- $chkcat[$i] = 'slow';
+ $chkcat[$i] = 'entry';
$chksymb[$i] = $1;
- $slowchk{$1} = $i;
+ $entrychk{$1} = $i;
- } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_fast\d+$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_closure${T_POST_LBL}$/o ) {
$chk[++$i] = $_;
- $chkcat[$i] = 'fast';
+ $chkcat[$i] = 'closure';
$chksymb[$i] = $1;
- $fastchk{$1} = $i;
+ $closurechk{$1} = $i;
- } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_closure$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_srt${T_POST_LBL}$/o ) {
$chk[++$i] = $_;
- $chkcat[$i] = 'closure';
+ $chkcat[$i] = 'srt';
$chksymb[$i] = $1;
- $closurechk{$1} = $i;
+ $srtchk{$1} = $i;
+
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_ct${T_POST_LBL}$/o ) {
+ $chk[++$i] = $_;
+ $chkcat[$i] = 'data';
+ $chksymb[$i] = '';
- } elsif ( /^$TUS[@]?ghc.*c_ID$TPOSTLBL/o ) {
- $chk[++$i] = $_;
- $chkcat[$i] = 'consist';
+ } elsif ( /^${T_US}(stg_ap_stack_entries|stg_stack_save_entries|stg_arg_bitmaps)${T_POST_LBL}$/o ) {
+ $chk[++$i] = $_;
+ $chkcat[$i] = 'data';
+ $chksymb[$i] = '';
- } elsif ( /^($TUS[@]?__gnu_compiled_c|gcc2_compiled\.)$TPOSTLBL/o ) {
+ } elsif ( /^(${T_US}__gnu_compiled_c|gcc2_compiled\.)${T_POST_LBL}/o ) {
; # toss it
- } elsif ( /^$TUS[@]?ErrorIO_call_count$TPOSTLBL[@]?$/o # HACK!!!!
- || /^$TUS[A-Za-z0-9_]+\.\d+$TPOSTLBL[@]?$/o
- || /^$TUS[@]?.*_CAT$TPOSTLBL[@]?$/o # PROF: _entryname_CAT
- || /^$TUS[@]?CC_.*_struct$TPOSTLBL[@]?$/o # PROF: _CC_ccident_struct
- || /^$TUS[@]?.*_done$TPOSTLBL[@]?$/o # PROF: _module_done
- || /^$TUS[@]?_module_registered$TPOSTLBL[@]?$/o # PROF: _module_registered
+ } elsif ( /^${T_US}[A-Za-z0-9_]+\.\d+${T_POST_LBL}$/o
+ || /^${T_US}.*_CAT${T_POST_LBL}$/o # PROF: _entryname_CAT
+ || /^${T_US}.*_done${T_POST_LBL}$/o # PROF: _module_done
+ || /^${T_US}_module_registered${T_POST_LBL}$/o # PROF: _module_registered
) {
$chk[++$i] = $_;
$chkcat[$i] = 'data';
$chkcat[$i] = 'bss';
$chksymb[$i] = '';
- } elsif ( $TargetPlatform =~ /^powerpc-|^rs6000-/ && /^LC\.\.([0-9]+)/ ) {
- $chk[++$i] = $_;
- $chkcat[$i] = 'toc';
- $chksymb[$i] = $1;
-
- } elsif ( $TargetPlatform =~ /^powerpc-|^rs6000-/ && /^CC_.*$/ ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_cc(s)?${T_POST_LBL}$/o ) {
# all CC_ symbols go in the data section...
$chk[++$i] = $_;
$chkcat[$i] = 'data';
$chksymb[$i] = '';
- } elsif ( /^($TUS[@]?(ret_|djn_)[A-Za-z0-9_]+)/o ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_(alt|dflt)${T_POST_LBL}$/o ) {
$chk[++$i] = $_;
$chkcat[$i] = 'misc';
$chksymb[$i] = '';
- $symbtmp = $1;
- $chksymb[$i] = $symbtmp if ($TargetPlatform =~ /^powerpc-|^rs6000-/) ; #rm andre
-
- } elsif ( /^$TUS[@]?vtbl_([A-Za-z0-9_]+)$TPOSTLBL[@]?$/o ) {
+ } elsif ( /^${T_US}([A-Za-z0-9_]+)_vtbl${T_POST_LBL}$/o ) {
$chk[++$i] = $_;
$chkcat[$i] = 'vector';
$chksymb[$i] = $1;
$vectorchk{$1} = $i;
- } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)DirectReturn$TPOSTLBL[@]?$/o ) {
- $chk[++$i] = $_;
- $chkcat[$i] = 'direct';
- $chksymb[$i] = $1;
-
- $directchk{$1} = $i;
-
- } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_upd$TPOSTLBL[@]?$/o ) {
- $chk[++$i] = $_;
- $chkcat[$i] = 'misc';
- print STDERR "_upd!!!!! I guess this code is dead!!!!\n";
- # I guess this is never entered, since all _upds are
- # either vtbl_'s or ret_'s, caught above. - andre
- $chksymb[$i] = '';
-
- # 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.
- } elsif ( /^[\t ]+\.comm[\t ]+__fexp_.*$/ ) {
- $chk[++$i] = $_;
- $chkcat[$i] = 'data';
- $chksymb[$i] = '';
-
} 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
+ && /^[A-Za-z0-9][A-Za-z0-9_]*:/ ) {
+ # Some Solaris system headers contain function definitions (as
+ # opposed to mere prototypes), which end up in the .hc file when
+ # a Haskell module foreign imports the corresponding system
+ # functions (most notably stat()). We put them into the text
+ # segment. Note that this currently does not extend to function
+ # names starting with an underscore.
+ # - chak 7/2001
$chk[++$i] = $_;
- $chkcat[$i] = 'toss';
+ $chkcat[$i] = 'misc';
$chksymb[$i] = $1;
- } elsif ( /^$TUS[@]?[A-Za-z0-9_]/o
+ } elsif ( $TargetPlatform =~ /^i386-apple-darwin/ && /^(___i686\.get_pc_thunk\.[abcd]x):/o) {
+ # To handle PIC on Darwin/x86, we need to appropriately pass through
+ # the get_pc_thunk functions. The need to be put into a special section
+ # marked as coalesced (otherwise the .weak_definition doesn't work
+ # on Darwin).
+ $chk[++$i] = $_;
+ $chkcat[$i] = 'get_pc_thunk';
+ $chksymb[$i] = $1;
+
+ } elsif ( /^${T_US}[A-Za-z0-9_]/o
&& ( $TargetPlatform !~ /^hppa/ # need to avoid local labels in this case
- || ! /^L\$\d+$/ )
- && ( $TargetPlatform !~ /^powerpc|^rs6000/ # ditto
- || ! /^(L\.\.\d+|LT\.\..*):$/ ) ) {
+ || ! /^L\$\d+$/ )
+ && ( $TargetPlatform !~ /^powerpc64/ # we need to avoid local labels in this case
+ || ! /^\.L\d+:$/ ) ) {
local($thing);
chop($thing = $_);
- print STDERR "Funny global thing?: $_"
- unless $KNOWN_FUNNY_THING{$thing}
- || /^$TUS[@]?_(PRIn|PRStart).*$TPOSTLBL[@]?$/o # pointer reversal GC routines
- || /^$TUS[@]?CC_.*$TPOSTLBL$/o # PROF: _CC_ccident ([@]? is a silly hack (see above))
- || /^$TUS__fexp_.*$TPOSTLBL$/o # foreign export droppings (temporary)
- || /^$TUS[@]?_reg.*$TPOSTLBL$/o; # PROF: __reg<module>
+ $thing =~ s/:$//;
$chk[++$i] = $_;
- $chkcat[$i] = 'misc';
- if ($TargetPlatform =~ /^powerpc-|^rs6000-/)
- { $chksymb[$i] = $thing; }
- else { $chksymb[$i] = ''; };
+ $chksymb[$i] = '';
+ if (
+ /^${T_US}stg_.*${T_POST_LBL}$/o # RTS internals
+ || /^${T_US}__stg_.*${T_POST_LBL}$/o # more RTS internals
+ || /^${T_US}__fexp_.*${T_POST_LBL}$/o # foreign export
+ || /^${T_US}.*_slow${T_POST_LBL}$/o # slow entry
+ || /^${T_US}__stginit.*${T_POST_LBL}$/o # __stginit<module>
+ || /^${T_US}.*_btm${T_POST_LBL}$/o # large bitmaps
+ || /^${T_US}.*_fast${T_POST_LBL}$/o # primops
+ || /^_uname:/o # x86/Solaris2
+ )
+ {
+ $chkcat[$i] = 'misc';
+ } elsif (
+ /^${T_US}.*_srtd${T_POST_LBL}$/o # large bitmaps
+ || /^${T_US}.*_closure_tbl${T_POST_LBL}$/o # closure tables
+ )
+ {
+ $chkcat[$i] = 'relrodata';
+ } else
+ {
+ print STDERR "Warning: retaining unknown function \`$thing' in output from C compiler\n";
+ $chkcat[$i] = 'unknown';
+ }
+ } elsif ( $TargetPlatform =~ /^powerpc-.*-linux/ && /^\.LCTOC1 = /o ) {
+ # PowerPC Linux's large-model PIC (-fPIC) generates a gobal offset
+ # table "by hand". Be sure to copy it over.
+ # Note that this label and all entries in the table should actually
+ # go into the .got2 section, but it isn't easy to distinguish them
+ # from other constant literals (.LC\d+), so we just put everything
+ # in .rodata.
+ $chk[++$i] = $_;
+ $chkcat[$i] = 'literal';
+ $chksymb[$i] = 'LCTOC1';
} else { # simple line (duplicated at the top)
$chk[$i] .= $_;
}
$numchks = $#chk + 1;
+ # open CHUNKS, ">/tmp/chunks1" or die "Cannot open /tmp/chunks1: $!\n";
+ # for (my $i = 0; $i < @chk; ++$i) { print CHUNKS "======= $i =======\n", $chk[$i] }
+ # close CHUNKS;
+
# the division into chunks is imperfect;
# we throw some things over the fence into the next
# chunk.
# output.
local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-)/) ? 1 : 0;
+ local($FIRST_TOSSABLE ) = ($TargetPlatform =~ /^(hppa|mips-)/) ? 1 : 0;
# 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
+ # spits a ".quad 0" in after the very first ".rdata"; we
# detect this special case (tossing the ".quad 0")!
local($magic_rdata_seen) = 0;
# HPPAs, MIPSen: also start medding at chunk 1
- if ($TargetPlatform =~ /^powerpc|^rs6000/) {
- print OUTASM $T_HDR_toc; # yes, we have to put a .toc
- # in the beginning of every file!
- %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;
-
- if ( $chkcat[$i] eq 'toc' && $chk[$i] !~ /\.byte/ )
-#ToDo: instead of all these changes, just fix mangle_powerpc_tailjump and delete/ignore these tocs?
- { $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/;
- $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(djn_\S+)/\t\.tc \1\[TC\],\.\2/;
- $chk[$i] =~ s/\t\.tc (\S+)\[TC\],(vtbl_\S+)/\t\.tc \1\[TC\],\.\2/;
- $chk[$i] =~ s/\t\.tc (\S+)\[TC\],ErrorIO_innards/\t\.tc \1\[TC\],\.ErrorIO_innards/;
- $chk[$i] =~ s/\t\.tc (\S+)\[TC\],startStgWorld/\t\.tc \1\[TC\],\.startStgWorld/;
- $chk[$i] =~ s/\.tc UpdatePAP\[TC\],UpdatePAP/\.tc UpdatePAP\[TC\],\.UpdatePAP/;
- $chk[$i] =~ s/\.tc _regMain\[TC\],_regMain/\.tc _regMain\[TC\],\._regMain/; #PROF
- $chk[$i] =~ s/\.tc resumeThread\[TC\],resumeThread/\.tc resumeThread\[TC\],\.resumeThread/; #CONC
- $chk[$i] =~ s/\.tc EnterNodeCode\[TC\],EnterNodeCode/\.tc EnterNodeCode\[TC\],\.EnterNodeCode/; #CONC
- $chk[$i] =~ s/\.tc StackUnderflowEnterNode\[TC\],StackUnderflowEnterNode/\.tc StackUnderflowEnterNode\[TC\],\.StackUnderflowEnterNode/; #CONC
- $chk[$i] =~ s/\.tc stopThreadDirectReturn\[TC\],stopThreadDirectReturn/\.tc stopThreadDirectReturn\[TC\],\.stopThreadDirectReturn/; #CONC
- $chk[$i] =~ s/\.tc CommonUnderflow\[TC\],CommonUnderflow/\.tc CommonUnderflow\[TC\],\.CommonUnderflow/; #PAR
- $chk[$i] =~ s/\.tc IndUpdRetDir\[TC\],IndUpdRetDir/\.tc IndUpdRetDir\[TC\],\.IndUpdRetDir/;
- $chk[$i] =~ s/\t\.tc (_PRStart_\S+)\[TC\],_PRStart_\S+/\t\.tc \1\[TC\],\.\1/;
-
- $tocnumber = $chksymb[$i];
- $tocsymb = $chk[$i];
- $tocsymb =~ s/^LC\.\.\d+:\n//;
- $tocsymb =~ s/^\t\.tc \S+,(\S+)\n/\1/;
- $tocequiv{$tocnumber} = $tocsymb;
-
- } elsif ( $chkcat[$i] eq 'toc' && $chk[$i] =~ /\.byte/ ) {
- $chkcat[$i] = 'literal';
- }
- }
- };
-
- for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) {
+ for ($i = $FIRST_TOSSABLE; $i < $numchks; $i++) {
$c = $chk[$i]; # convenience copy
# print STDERR "\nCHK $i (BEFORE) (",$chkcat[$i],"):\n", $c;
# toss all prologue stuff; HPPA is pretty weird
# (see elsewhere)
- $c = &mash_hppa_prologue($c) if $TargetPlatform =~ /^hppa/;
+ $c = &hppa_mash_prologue($c) if $TargetPlatform =~ /^hppa-/;
# be slightly paranoid to make sure there's
# nothing surprising in there
if ( $c =~ /--- BEGIN ---/ ) {
if (($p, $r) = split(/--- BEGIN ---/, $c)) {
+ # remove junk whitespace around the split point
+ $p =~ s/\t+$//;
+ $r =~ s/^\s*\n//;
+
if ($TargetPlatform =~ /^i386-/) {
- $p =~ s/^\tpushl \%edi\n//;
- $p =~ s/^\tpushl \%esi\n//;
- $p =~ s/^\tsubl \$\d+,\%esp\n//;
- $p =~ s/^\tmovl \$\d+,\%eax\n\tcall __alloca\n// if ($TargetPlatform =~ /^.*-cygwin32/);
+ if ($p =~ /^\tsubl\s+\$(\d+),\s*\%esp\n/) {
+ if ($1 >= 8192) {
+ die "Error: reserved stack space exceeded!\n Possible workarounds: compile with -fasm, or try another version of gcc.\n"
+ }
+ }
+
+ # gcc 3.4.3 puts this kind of stuff in the prologue, eg.
+ # when compiling PrimOps.cmm with -optc-O2:
+ # xorl %ecx, %ecx
+ # xorl %edx, %edx
+ # movl %ecx, 16(%esp)
+ # movl %edx, 20(%esp)
+ # but then the code of the function doesn't assume
+ # anything about the contnets of these stack locations.
+ # I think it's to do with the use of inline functions for
+ # PK_Word64() and friends, where gcc is initialising the
+ # contents of the struct to zero, and failing to optimise
+ # away the initialisation. Let's live dangerously and
+ # discard these initalisations.
+
+ $p =~ s/^\tpushl\s+\%e(di|si|bx)\n//g;
+ $p =~ s/^\txorl\s+\%e(ax|cx|dx),\s*\%e(ax|cx|dx)\n//g;
+ $p =~ s/^\tmovl\s+\%e(ax|cx|dx|si|di),\s*\d*\(\%esp\)\n//g;
+ $p =~ s/^\tmovl\s+\$\d+,\s*\d*\(\%esp\)\n//g;
+ $p =~ s/^\tsubl\s+\$\d+,\s*\%esp\n//;
+ $p =~ s/^\tmovl\s+\$\d+,\s*\%eax\n\tcall\s+__alloca\n// if ($TargetPlatform =~ /^.*-(cygwin32|mingw32)/);
+
+ if ($TargetPlatform =~ /^i386-apple-darwin/) {
+ $pcrel_label = $p;
+ $pcrel_label =~ s/(.|\n)*^(\"?L\d+\$pb\"?):\n(.|\n)*/$2/ or $pcrel_label = "";
+ $pcrel_reg = $p;
+ $pcrel_reg =~ s/(.|\n)*.*___i686\.get_pc_thunk\.([abcd]x)\n(.|\n)*/$2/ or $pcrel_reg = "";
+ $p =~ s/^\s+call\s+___i686\.get_pc_thunk\..x//;
+ $p =~ s/^\"?L\d+\$pb\"?:\n//;
+
+ if ($pcrel_reg eq "bx") {
+ # Bad gcc. Goes and uses %ebx, our BaseReg, for PIC. Bad gcc.
+ die "Darwin/x86: -fPIC -via-C doesn't work yet, use -fasm. Aborting."
+ }
+ }
+
+ } elsif ($TargetPlatform =~ /^x86_64-/) {
+ $p =~ s/^\tpushq\s+\%r(bx|bp|12|13|14)\n//g;
+ $p =~ s/^\tmovq\s+\%r(bx|bp|12|13|14),\s*\d*\(\%rsp\)\n//g;
+ $p =~ s/^\tsubq\s+\$\d+,\s*\%rsp\n//;
+
+ } elsif ($TargetPlatform =~ /^ia64-/) {
+ $p =~ s/^\t\.prologue .*\n//;
+ $p =~ s/^\t\.save ar\.pfs, r\d+\n\talloc r\d+ = ar\.pfs, 0, 3[12], \d+, 0\n//;
+ $p =~ s/^\t\.fframe \d+\n\tadds r12 = -\d+, r12\n//;
+ $p =~ s/^\t\.save rp, r\d+\n\tmov r\d+ = b0\n//;
+ $p =~ s/^\t\.(mii|mmi)\n//g; # bundling is no longer sensible
+ $p =~ s/^\t;;\n//g; # discard stops
+ $p =~ s/^\t\/\/.*\n//g; # gcc inserts timings in // comments
+
+ # GCC 3.3 saves r1 in the prologue, move this to the body
+ if ($p =~ /^\tmov r\d+ = r1\n/) {
+ $p = $` . $';
+ $r = $& . $r;
+ }
} elsif ($TargetPlatform =~ /^m68k-/) {
$p =~ s/^\tlink a6,#-?\d.*\n//;
$p =~ s/^\tpea a6@\n\tmovel sp,a6\n//;
$p =~ s/^\tsw\t\$fp,\d+\(\$sp\)\n//;
$p =~ s/^\tsw\t\$28,\d+\(\$sp\)\n//;
$p =~ s/__FRAME__/$FRAME/;
- } elsif ($TargetPlatform =~ /^powerpc-|^rs6000/) {
- $p =~ s/^\tmflr 0\n//;
- $p =~ s/^\tstm \d+,-\d+\(1\)\n//;
- $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
- $p =~ s/^\tstw?u 1,-\d+\(1\)\n//;
- $p =~ s/^\tstw? \d+,-\d+\(1\)\n//g;
- $p =~ s/^\tstfd \d+,-\d+\(1\)\n//g;
+ } elsif ($TargetPlatform =~ /^powerpc-apple-darwin.*/) {
+ $pcrel_label = $p;
+ $pcrel_label =~ s/(.|\n)*^(\"?L\d+\$pb\"?):\n(.|\n)*/$2/ or $pcrel_label = "";
+
+ $p =~ s/^\tmflr r0\n//;
+ $p =~ s/^\tbl saveFP # f\d+\n//;
+ $p =~ s/^\tbl saveFP ; save f\d+-f\d+\n//;
+ $p =~ s/^\"?L\d+\$pb\"?:\n//;
+ $p =~ s/^\tstmw r\d+,-\d+\(r1\)\n//;
+ $p =~ s/^\tstfd f\d+,-\d+\(r1\)\n//g;
+ $p =~ s/^\tstw r0,\d+\(r1\)\n//g;
+ $p =~ s/^\tstwu r1,-\d+\(r1\)\n//;
+ $p =~ s/^\tstw r\d+,-\d+\(r1\)\n//g;
+ $p =~ s/^\tbcl 20,31,L\d+\$pb\n//;
+ $p =~ s/^L\d+\$pb:\n//;
+ $p =~ s/^\tmflr r31\n//;
+
+ # This is bad: GCC 3 seems to zero-fill some local variables in the prologue
+ # under some circumstances, only when generating position dependent code.
+ # I have no idea why, and I don't think it is necessary, so let's toss it.
+ $p =~ s/^\tli r\d+,0\n//g;
+ $p =~ s/^\tstw r\d+,\d+\(r1\)\n//g;
+ } elsif ($TargetPlatform =~ /^powerpc-.*-linux/) {
+ $p =~ s/^\tmflr 0\n//;
+ $p =~ s/^\tstmw \d+,\d+\(1\)\n//;
+ $p =~ s/^\tstfd \d+,\d+\(1\)\n//g;
+ $p =~ s/^\tstw r0,8\(1\)\n//;
+ $p =~ s/^\tstwu 1,-\d+\(1\)\n//;
+ $p =~ s/^\tstw \d+,\d+\(1\)\n//g;
+
+ # GCC's "large-model" PIC (-fPIC)
+ $pcrel_label = $p;
+ $pcrel_label =~ s/(.|\n)*^.LCF(\d+):\n(.|\n)*/$2/ or $pcrel_label = "";
+
+ $p =~ s/^\tbcl 20,31,.LCF\d+\n//;
+ $p =~ s/^.LCF\d+:\n//;
+ $p =~ s/^\tmflr 30\n//;
+ $p =~ s/^\tlwz 0,\.LCL\d+-\.LCF\d+\(30\)\n//;
+ $p =~ s/^\tadd 30,0,30\n//;
+
+ # This is bad: GCC 3 seems to zero-fill some local variables in the prologue
+ # under some circumstances, only when generating position dependent code.
+ # I have no idea why, and I don't think it is necessary, so let's toss it.
+ $p =~ s/^\tli \d+,0\n//g;
+ $p =~ s/^\tstw \d+,\d+\(1\)\n//g;
+ } elsif ($TargetPlatform =~ /^powerpc64-.*-linux/) {
+ $p =~ s/^\tmr 31,1\n//;
+ $p =~ s/^\tmflr 0\n//;
+ $p =~ s/^\tstmw \d+,\d+\(1\)\n//;
+ $p =~ s/^\tstfd \d+,-?\d+\(1\)\n//g;
+ $p =~ s/^\tstd r0,8\(1\)\n//;
+ $p =~ s/^\tstdu 1,-\d+\(1\)\n//;
+ $p =~ s/^\tstd \d+,-?\d+\(1\)\n//g;
+
+ # GCC's "large-model" PIC (-fPIC)
+ $pcrel_label = $p;
+ $pcrel_label =~ s/(.|\n)*^.LCF(\d+):\n(.|\n)*/$2/ or $pcrel_label = "";
+
+ $p =~ s/^\tbcl 20,31,.LCF\d+\n//;
+ $p =~ s/^.LCF\d+:\n//;
+ $p =~ s/^\tmflr 30\n//;
+ $p =~ s/^\tlwz 0,\.LCL\d+-\.LCF\d+\(30\)\n//;
+ $p =~ s/^\tadd 30,0,30\n//;
+
+ # This is bad: GCC 3 seems to zero-fill some local variables in the prologue
+ # under some circumstances, only when generating position dependent code.
+ # I have no idea why, and I don't think it is necessary, so let's toss it.
+ $p =~ s/^\tli \d+,0\n//g;
+ $p =~ s/^\tstd \d+,\d+\(1\)\n//g;
} else {
print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n";
}
-
- die "Prologue junk?: $p\n" if $p =~ /^\t[^\.]/
- && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
-
+
+ # HWL HACK: dont die, just print a warning
+ #print stderr "HWL: this should die! Prologue junk?: $p\n" if $p =~ /^\t[^\.]/;
+ die "Prologue junk?: $p\n" if $p =~ /^\s+[^\s\.]/;
+
+ # For PIC, we want to keep part of the prologue
+ if ($TargetPlatform =~ /^powerpc-apple-darwin.*/ && $pcrel_label ne "") {
+ # Darwin: load the current instruction pointer into register r31
+ $p .= "bcl 20,31,$pcrel_label\n";
+ $p .= "$pcrel_label:\n";
+ $p .= "\tmflr r31\n";
+ } elsif ($TargetPlatform =~ /^powerpc-.*-linux/ && $pcrel_label ne "") {
+ # Linux: load the GOT pointer into register 30
+ $p .= "\tbcl 20,31,.LCF$pcrel_label\n";
+ $p .= ".LCF$pcrel_label:\n";
+ $p .= "\tmflr 30\n";
+ $p .= "\tlwz 0,.LCL$pcrel_label-.LCF$pcrel_label(30)\n";
+ $p .= "\tadd 30,0,30\n";
+ } elsif ($TargetPlatform =~ /^i386-apple-darwin.*/ && $pcrel_label ne "") {
+ $p .= "\tcall ___i686.get_pc_thunk.$pcrel_reg\n";
+ $p .= "$pcrel_label:\n";
+ }
+
# glue together what's left
$c = $p . $r;
- $c =~ s/\n\t\n/\n/; # junk blank line
}
}
if (($r, $e) = split(/--- END ---/, $c)) {
if ($TargetPlatform =~ /^i386-/) {
$e =~ s/^\tret\n//;
- $e =~ s/^\tpopl \%edi\n//;
- $e =~ s/^\tpopl \%esi\n//;
- $e =~ s/^\taddl \$\d+,\%esp\n//;
+ $e =~ s/^\tpopl\s+\%edi\n//;
+ $e =~ s/^\tpopl\s+\%esi\n//;
+ $e =~ s/^\tpopl\s+\%edx\n//;
+ $e =~ s/^\tpopl\s+\%ecx\n//;
+ $e =~ s/^\taddl\s+\$\d+,\s*\%esp\n//;
+ $e =~ s/^\tsubl\s+\$-\d+,\s*\%esp\n//;
+ } elsif ($TargetPlatform =~ /^ia64-/) {
+ $e =~ s/^\tmov ar\.pfs = r\d+\n//;
+ $e =~ s/^\tmov b0 = r\d+\n//;
+ $e =~ s/^\t\.restore sp\n\tadds r12 = \d+, r12\n//;
+ $e =~ s/^\tbr\.ret\.sptk\.many b0\n//;
+ $e =~ s/^\t\.(mii|mmi|mib)\n//g; # bundling is no longer sensible
+ $e =~ s/^\t;;\n//g; # discard stops - stop at end of body is sufficient
+ $e =~ s/^\t\/\/.*\n//g; # gcc inserts timings in // comments
} elsif ($TargetPlatform =~ /^m68k-/) {
$e =~ s/^\tunlk a6\n//;
$e =~ s/^\trts\n//;
$e =~ s/^\tlw\t\$fp,\d+\(\$sp\)\n//;
$e =~ s/^\taddu\t\$sp,\$sp,\d+\n//;
$e =~ s/^\tj\t\$31\n//;
- } 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//;
- $e =~ s/^\tmtlr 0\n//;
- $e =~ s/^\tbl?r\n//;
+ } elsif ($TargetPlatform =~ /^powerpc-apple-darwin.*/) {
+ $e =~ s/^\taddi r1,r1,\d+\n//;
+ $e =~ s/^\tlwz r\d+,\d+\(r1\)\n//;
+ $e =~ s/^\tlmw r\d+,-\d+\(r1\)\n//;
+ $e =~ s/^\tmtlr r0\n//;
+ $e =~ s/^\tblr\n//;
+ $e =~ s/^\tb restFP ;.*\n//;
+ } elsif ($TargetPlatform =~ /^powerpc64-.*-linux/) {
+ $e =~ s/^\tmr 3,0\n//;
+ $e =~ s/^\taddi 1,1,\d+\n//;
+ $e =~ s/^\tld 0,16\(1\)\n//;
+ $e =~ s/^\tmtlr 0\n//;
+
+ # callee-save registers
+ $e =~ s/^\tld \d+,-?\d+\(1\)\n//g;
+ $e =~ s/^\tlfd \d+,-?\d+\(1\)\n//g;
+
+ # get rid of the debug junk along with the blr
+ $e =~ s/^\tblr\n\t.long .*\n\t.byte .*\n//;
+
+ # incase we missed it with the last one get the blr alone
+ $e =~ s/^\tblr\n//;
} else {
print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n";
}
- die "Epilogue junk?: $e\n" if $e =~ /^\t[^\.]/
- && $TargetPlatform !~ /^powerpc-/; #ToDo: remove test
+
+ print STDERR "WARNING: Epilogue junk?: $e\n" if $e =~ /^\t\s*[^\.\s\n]/;
# glue together what's left
$c = $r . $e;
# On SPARCs, we don't do --- BEGIN/END ---, we just
# toss the register-windowing save/restore/ret* instructions
- # directly:
+ # directly unless they've been generated by function definitions in header
+ # files on Solaris:
if ( $TargetPlatform =~ /^sparc-/ ) {
- $c =~ s/^\t(save .*|restore|ret|retl)\n//g;
+ if ( ! ( $TargetPlatform =~ /solaris2$/ && $chkcat[$i] eq 'unknown' )) {
+ $c =~ s/^\t(save.*|restore.*|ret|retl)\n//g;
+ }
# 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)
# toss all calls to __DISCARD__
- $c =~ s/^\t(call|jbsr|jal)\s+$TUS[@]?__DISCARD__\n//go;
+ $c =~ s/^\t(call|jbsr|jal)\s+${T_US}__DISCARD__\n//go;
+ $c =~ s/^\tjsr\s+\$26\s*,\s*${T_US}__DISCARD__\n//go if $TargetPlatform =~ /^alpha-/;
+ $c =~ s/^\tbl\s+L___DISCARD__\$stub\n//go if $TargetPlatform =~ /^powerpc-apple-darwin.*/;
+ $c =~ s/^\tbl\s+__DISCARD__(\@plt)?\n//go if $TargetPlatform =~ /^powerpc-.*-linux/;
+ $c =~ s/^\tbl\s+\.__DISCARD__\n\s+nop\n//go if $TargetPlatform =~ /^powerpc64-.*-linux/;
+ $c =~ s/^\tcall\s+L___DISCARD__\$stub\n//go if $TargetPlatform =~ /i386-apple-darwin.*/;
+
+ # IA64: mangle tailcalls into jumps here
+ if ($TargetPlatform =~ /^ia64-/) {
+ while ($c =~ s/^\tbr\.call\.sptk\.many b0 = (.*)\n(?:^\.L([0-9]*):\n)?(?:\t;;\n)?(?:\tmov r1 = r\d+\n)?(?:\t;;\n)?\t--- TAILCALL ---\n(?:\t;;\n\tbr \.L\d+\n)?/\tbr\.few $1\n/) {
+ # Eek, the gcc optimiser is getting smarter... if we see a jump to the --- TAILCALL ---
+ # marker then we reapply the substitution at the source sites
+ $c =~ s/^\tbr \.L$2\n/\t--- TAILCALL ---\n/g if ($2);
+ }
+ }
# MIPS: that may leave some gratuitous asm macros around
# (no harm done; but we get rid of them to be tidier)
# pin a funny end-thing on (for easier matching):
$c .= 'FUNNY#END#THING';
- 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)
+ while ( $c =~ /${T_MOVE_DIRVS}FUNNY#END#THING/o ) {
$to_move = $1;
- if ( $i < ($numchks - 1)
- && ( $to_move =~ /$TCOPYDIRVS/
+
+ # 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|sparc|powerpc)/ && $to_move =~ /${T_COPY_DIRVS}/ ) {
+ $j = $i + 1;
+ while ( $j < $numchks && $chk[$j] =~ /$T_CONST_LBL/) {
+ $j++;
+ }
+ if ( $j < $numchks ) {
+ $chk[$j] = $to_move . $chk[$j];
+ }
+ }
+
+ elsif ( $i < ($numchks - 1)
+ && ( $to_move =~ /${T_COPY_DIRVS}/
|| ($TargetPlatform =~ /^hppa/ && $to_move =~ /align/ && $chkcat[$i+1] eq 'literal') )) {
$chk[$i + 1] = $to_move . $chk[$i + 1];
# otherwise they're tossed
}
- $c =~ s/$TMOVEDIRVS[@]?FUNNY#END#THING/FUNNY#END#THING/o; # [@]? is a hack (see above)
+ $c =~ s/${T_MOVE_DIRVS}FUNNY#END#THING/FUNNY#END#THING/o;
}
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;
+ unless ($c =~ /\.ent.*\n\$.*\.\.ng:/) {
+ if (($p, $r) = split(/^\t\.prologue/, $c)) {
+ if (($keep, $junk) = split(/\.\.ng:/, $p)) {
+ $keep =~ s/^\t\.frame.*\n/\t.frame \$30,0,\$26,0\n/;
+ $keep =~ s/^\t\.(mask|fmask).*\n//g;
+ $c = $keep . "..ng:\n";
+ } else {
+ print STDERR "malformed code block ($ent)?\n"
+ }
+ }
+ $c .= "\t.prologue" . $r;
+ }
}
$c =~ s/FUNNY#END#THING//;
$chk[$i] = $c; # update w/ convenience copy
}
+ # open CHUNKS, ">/tmp/chunks2" or die "Cannot open /tmp/chunks2: $!\n";
+ # for (my $i = 0; $i < @chk; ++$i) { print CHUNKS "======= $i =======\n", $chk[$i] }
+ # close CHUNKS;
+
if ( $TargetPlatform =~ /^alpha-/ ) {
# print out the header stuff first
$chk[0] =~ s/^(\t\.file.*)"(ghc\d+\.c)"/$1"$ifile_root.hc"/;
# print out all the literal strings next
for ($i = 0; $i < $numchks; $i++) {
if ( $chkcat[$i] eq 'literal' ) {
- print OUTASM $T_HDR_literal, $chk[$i];
+
+ # HACK: try to detect 16-byte constants and align them
+ # on a 16-byte boundary. x86_64 sometimes needs 128-bit
+ # aligned constants, and so does Darwin/x86.
+ if ( $TargetPlatform =~ /^x86_64/
+ || $TargetPlatform =~ /^i386-apple-darwin/ ) {
+ $z = $chk[$i];
+ if ($z =~ /(\.long.*\n.*\.long.*\n.*\.long.*\n.*\.long|\.quad.*\n.*\.quad)/) {
+ print OUTASM $T_HDR_literal16;
+ } else {
+ print OUTASM $T_HDR_literal;
+ }
+ } else {
+ print OUTASM $T_HDR_literal;
+ }
+
+ print OUTASM $chk[$i];
print OUTASM "; end literal\n" if $TargetPlatform =~ /^hppa/; # for the splitter
$chkcat[$i] = 'DONE ALREADY';
next if $chkcat[$i] eq 'DONE ALREADY';
- if ( $chkcat[$i] eq 'misc' ) {
+ if ( $chkcat[$i] eq 'misc' || $chkcat[$i] eq 'unknown' ) {
if ($chk[$i] ne '') {
print OUTASM $T_HDR_misc;
- if ($TargetPlatform =~ /^powerpc-|^rs6000/) {
- $chksymb[$i] =~ s/://;
-#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"; }
-# if ($chksymb[$i] ne '' && $chksymb[$i] !~ /ret_[a-z]/ && $chksymb[$i] !~ /djn_[a-z]/)
- if ($chksymb[$i] ne '')
- { print OUTASM "\t\.globl \.$chksymb[$i]\n"; };
- 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);
- if ($TargetPlatform =~ /^powerpc-|^rs6000-/ && $printDS) {
-#ok if ($chksymb[$i] !~ /\_regMain/) {
- print OUTASM "\.csect ${chksymb[$i]}[DS]\n";
- print OUTASM "${p}TOC[tc0], 0\n";
-#ok }
- }
}
} elsif ( $chkcat[$i] eq 'toss' ) {
print OUTASM $chk[$i];
}
- } 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?
- #
- # 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
- }
- print OUTASM $T_HDR_consist, "${consist}${T_POST_LBL}\n";
-
- } elsif ( $TargetPlatform !~ /^(mips)-/ ) { # we just don't try in those case (ToDo)
- # on mips: consistency string is just a v
- # horrible bunch of .bytes,
- # which I am too lazy to sort out (WDP 95/05)
-
- print STDERR "Couldn't grok consistency: ", $chk[$i];
- }
-
} elsif ( $chkcat[$i] eq 'splitmarker' ) {
# we can just re-constitute this one...
# NB: we emit _three_ underscores no matter what,
print OUTASM "___stg_split_marker",$chksymb[$i],"${T_POST_LBL}\n";
} elsif ( $chkcat[$i] eq 'closure'
+ || $chkcat[$i] eq 'srt'
|| $chkcat[$i] eq 'infotbl'
- || $chkcat[$i] eq 'slow'
- || $chkcat[$i] eq 'fast' ) { # do them in that order
+ || $chkcat[$i] eq 'entry') { # do them in that order
$symb = $chksymb[$i];
# CLOSURE
$chkcat[$closurechk{$symb}] = 'DONE ALREADY';
}
+ # SRT
+ if ( defined($srtchk{$symb}) ) {
+ print OUTASM $T_HDR_relrodata;
+ print OUTASM $chk[$srtchk{$symb}];
+ $chkcat[$srtchk{$symb}] = 'DONE ALREADY';
+ }
+
# INFO TABLE
if ( defined($infochk{$symb}) ) {
print OUTASM $T_HDR_info;
- if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
- 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/;
- }
- $chk[$infochk{$symb}] =~ s/\.long ([_A-Za-z]\S+_entry)/\.long \.\1/;
- $chk[$infochk{$symb}] =~ s/\.long ([A-Za-z]\S+_upd)/\.long \.\1/;
- $chk[$infochk{$symb}] =~ s/\.long (IndUpdRet\S+)/\.long \.\1/;
- $chk[$infochk{$symb}] =~ s/\.long StdErrorCode/\.long \.StdErrorCode/;
- $chk[$infochk{$symb}] =~ s/\.long UpdErr/\.long \.UpdErr/;
- print OUTASM $chk[$infochk{$symb}];
- } else {
- print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
- }
+ print OUTASM &rev_tbl($symb, $chk[$infochk{$symb}], 1);
+
# entry code will be put here!
- # paranoia
- if ( $chk[$infochk{$symb}] =~ /$TDOTWORD[@]?\s+([A-Za-z0-9_]+_entry)$/o
- && $1 ne "${T_US}${symb}_entry" ) {
- print STDERR "!!! entry point???\n",$chk[$infochk{$symb}];
- }
-
$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}];
-
- if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
- ($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";
- };
- $r =~ s/\.csect \.text\[PR\]\n//; # todo: properly - andre
- $c = &mangle_powerpc_tailjump($r);
- };
-
- if ( defined($fastchk{$symb}) ) {
- 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-/ ) {
- # Reg alloc depending, gcc generated code may jump to the fast entry point via
- # a number of registers.
- $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//;
- # The next two only apply if we're not stealing %esi or %edi.
- $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);
- } 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//;
- } elsif ( $TargetPlatform =~ /^powerpc-|^rs6000-/ ) {
- $c =~ s/^\tb \.${T_US}${symb}_fast\d+\n//;
- } elsif ( $TargetPlatform =~ /^sparc-/ ) {
- $c =~ s/^\tcall ${T_US}${symb}_fast\d+,.*\n\tnop\n//;
- $c =~ s/^\tcall ${T_US}${symb}_fast\d+,.*\n(\t[a-z].*\n)/$1/;
- } else {
- print STDERR "$Pgm: mystery slow-fast dropthrough: $TargetPlatform\n";
- }
- }
-
- 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"
- if $c =~ /$TUS[@]?$symb[@]?_fast/; # NB: paranoia
+ # ENTRY POINT
+ if ( defined($entrychk{$symb}) ) {
+
+ $c = $chk[$entrychk{$symb}];
+
+ # If this is an entry point with an info table,
+ # eliminate the entry symbol and all directives involving it.
+ if (defined($infochk{$symb}) && $TargetPlatform !~ /^ia64-/) {
+ @o = ();
+ foreach $l (split(/\n/,$c)) {
+ next if $l =~ /^.*$symb_(entry|ret)${T_POST_LBL}/;
+
+ # If we have .type/.size direrctives involving foo_entry,
+ # then make them refer to foo_info instead. The information
+ # in these directives is used by the cachegrind annotator,
+ # so it is worthwhile keeping.
+ if ($l =~ /^\s*\.(type|size).*$symb_(entry|ret)/) {
+ $l =~ s/$symb(_entry|_ret)/${symb}_info/g;
+ push(@o,$l);
+ next;
+ }
+ next if $l =~ /^\s*\..*$symb.*\n?/;
+ push(@o,$l);
+ }
+ $c = join("\n",@o) . "\n";
}
print OUTASM $T_HDR_entry;
&print_doctored($c, 1); # NB: the 1!!!
- $chkcat[$slowchk{$symb}] = 'DONE ALREADY';
+ $chkcat[$entrychk{$symb}] = 'DONE ALREADY';
}
- # FAST ENTRY POINT
- if ( defined($fastchk{$symb}) ) {
- $c = $chk[$fastchk{$symb}];
- if ( ! defined($slowchk{$symb})
- # ToDo: the || clause can go once we're no longer
- # concerned about producing exactly the same output as before
-#OLD: || $TargetPlatform =~ /^(m68k|sparc|i386)-/
- ) {
- print OUTASM $T_HDR_fast;
- }
- if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
- local(@lbls) = split(/:/, $c);
- $fullname = $lbls[0];
- $fullname =~ s/$T_MOVE_DIRVS//g;
- if ( $fullname =~ /^[A-Z]/)
- { print OUTASM "\t\.globl \.${fullname}\n";
- } else {
-# print OUTASM "\t\.lglobl \.${fullname}\n"; #todo: rm - andre
- };
- $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);
- $chkcat[$fastchk{$symb}] = 'DONE ALREADY';
- }
-
- } elsif ( $chkcat[$i] eq 'vector'
- || $chkcat[$i] eq 'direct' ) { # do them in that order
+ } elsif ( $chkcat[$i] eq 'vector' ) {
$symb = $chksymb[$i];
# VECTOR TABLE
if ( defined($vectorchk{$symb}) ) {
print OUTASM $T_HDR_vector;
- if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
- if ( $symb =~ /^[A-Z]/) {
- print OUTASM "\t\.globl \.vtbl_${symb}\n";
- print OUTASM "\t\.globl vtbl_${symb}\n";
- };
- $chk[$vectorchk{$symb}] =~ s/\.long (\S+)/\.long \.\1/g;
- print OUTASM ".vtbl_${symb}:\n";
- print OUTASM $chk[$vectorchk{$symb}];
- } else {
- print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
- }
+ print OUTASM &rev_tbl($symb, $chk[$vectorchk{$symb}], 0);
+
# direct return code will be put here!
$chkcat[$vectorchk{$symb}] = 'DONE ALREADY';
- }
-
- # DIRECT RETURN
- if ( defined($directchk{$symb}) ) {
- print OUTASM $T_HDR_direct;
- if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
- ($p, $r) = split(/TOC\[tc0\], 0\n/, $chk[$directchk{$symb}]);
- &print_doctored($r, 0);
- print OUTASM "\.csect ${symb}DirectReturn[DS]\n";
- print OUTASM "${p}TOC[tc0], 0\n";
- } else {
- &print_doctored($chk[$directchk{$symb}], 0);
- }
- $chkcat[$directchk{$symb}] = 'DONE ALREADY';
} elsif ( $TargetPlatform =~ /^alpha-/ ) {
# Alphas: the commented nop is for the splitter, to ensure
print OUTASM "\t# nop\n";
}
+ } elsif ( $chkcat[$i] eq 'rodata' ) {
+ print OUTASM $T_HDR_rodata;
+ print OUTASM $chk[$i];
+ $chkcat[$i] = 'DONE ALREADY';
+ } elsif ( $chkcat[$i] eq 'relrodata' ) {
+ print OUTASM $T_HDR_relrodata;
+ print OUTASM $chk[$i];
+ $chkcat[$i] = 'DONE ALREADY';
} elsif ( $chkcat[$i] eq 'toc' ) {
# silly optimisation to print tocs, since they come in groups...
print OUTASM $T_HDR_toc;
$j++;
}
+ } elsif ( $TargetPlatform =~ /^.*-apple-darwin.*/ && $chkcat[$i] eq 'dyld' ) {
+ # apple-darwin: dynamic linker stubs
+ if($chk[$i] !~ /\.indirect_symbol ___DISCARD__/)
+ { # print them out unchanged, but remove the stubs for __DISCARD__
+ print OUTASM $chk[$i];
+ }
+ } elsif ( $TargetPlatform =~ /^i386-apple-darwin.*/ && $chkcat[$i] eq 'get_pc_thunk' ) {
+ # i386-apple-darwin: __i686.get_pc_thunk.[abcd]x
+ print OUTASM ".section __TEXT,__textcoal_nt,coalesced,no_toc\n";
+ print OUTASM $chk[$i];
} else {
&tidy_up_and_die(1,"$Pgm: unknown chkcat (ghc-asm: $TargetPlatform)\n$chkcat[$i]\n$chk[$i]\n");
}
print OUTASM $EXTERN_DECLS if $TargetPlatform =~ /^mips-/;
- if ($TargetPlatform =~ /^powerpc-|^rs6000-/) {
- print OUTASM ".csect .text[PR]\n_section_.text:\n.csect .data[RW]\n\t.long _section_.text\n"
- };
-
# 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}
\begin{code}
-sub mash_hppa_prologue { # OK, epilogue, too
+sub hppa_mash_prologue { # OK, epilogue, too
local($_) = @_;
# toss all prologue stuff
sub print_doctored {
local($_, $need_fallthru_patch) = @_;
+ if ( $TargetPlatform =~ /^x86_64-/ ) {
+ # Catch things like
+ #
+ # movq -4(%ebp), %rax
+ # jmp *%rax
+ #
+ # and optimise:
+ #
+ s/^\tmovq\s+(-?\d*\(\%r(bx|bp|13)\)),\s*(\%r(ax|cx|dx|10|11))\n\tjmp\s+\*\3/\tjmp\t\*$1/g;
+ s/^\tmovl\s+\$${T_US}(.*),\s*(\%e(ax|cx|si|di))\n\tjmp\s+\*\%r\3/\tjmp\t$T_US$1/g;
+ }
+
if ( $TargetPlatform !~ /^i386-/
- || ! /^\t[a-z]/ ) { # no instructions in here, apparently
+ || ! /^\t[a-z]/ # no instructions in here, apparently
+ || /^${T_US}__stginit_[A-Za-z0-9_]+${T_POST_LBL}/) {
print OUTASM $_;
return;
}
+
# OK, must do some x86 **HACKING**
local($entry_patch) = '';
local($exit_patch) = '';
- local($call_entry_patch)= '';
- local($call_exit_patch) = '';
- local($gc_call_entry_patch)= ''; # Patches before and after calls to Perform_GC_wrapper
- local($gc_call_exit_patch) = '';
-
-#OLD: # first, convert calls to *very magic form*: (ToDo: document
- # for real!) from
- #
- # pushl $768
- # call _?PerformGC_wrapper
- # addl $4,%esp
- # to
- # movl $768, %eax
- # call _?PerformGC_wrapper
- #
- # The reason we do this now is to remove the apparent use of
- # %esp, which would throw off the "what patch code do we need"
- # decision.
- #
- # Special macros in ghc/includes/COptWraps.lh, used in
- # ghc/runtime/CallWrap_C.lc, are required for this to work!
- #
-
- s/^\tpushl \$(\d+)\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \$$1,\%eax\n\tcall ${T_DO_GC}\n/go;
- s/^\tpushl \%eax\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tcall ${T_DO_GC}\n/go;
- s/^\tpushl \%edx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%edx,\%eax\n\tcall ${T_DO_GC}\n/go;
-
-#= if ( $StolenX86Regs <= 4 ) { # %ecx is ordinary reg
-#= s/^\tpushl \%ecx\n\tcall ${T_DO_GC}\n\taddl \$4,\%esp\n/\tmovl \%ecx,\%eax\n\tcall ${T_DO_GC}\n/go;
-#= }
# gotta watch out for weird instructions that
# invisibly smash various regs:
# movl $_blah,<bad-reg>
# jmp *<bad-reg>
#
- # which is easily fixed as:
+ s/^\tmovl\s+\$${T_US}(.*),\s*(\%e[acd]x)\n\tjmp\s+\*\2/\tjmp $T_US$1/g;
+
+ # Catch things like
#
- # sigh! try to hack around it...
+ # movl -4(%ebx), %eax
+ # jmp *%eax
+ #
+ # and optimise:
#
+ s/^\tmovl\s+(-?\d*\(\%e(bx|si)\)),\s*(\%e[acd]x)\n\tjmp\s+\*\3/\tjmp\t\*$1/g;
if ($StolenX86Regs <= 2 ) { # YURGH! spurious uses of esi?
- s/^\tmovl (.*),\%esi\n\tjmp \*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
- s/^\tjmp \*(-?\d*)\((.*\%esi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
- s/^\tjmp \*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/g;
+ s/^\tmovl\s+(.*),\s*\%esi\n\tjmp\s+\*%esi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
+ s/^\tjmp\s+\*(.*\(.*\%esi.*\))\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
+ s/^\tjmp\s+\*\%esi\n/\tmovl \%esi,\%eax\n\tjmp \*\%eax\n/g;
die "$Pgm: (mangler) still have jump involving \%esi!\n$_"
- if /(jmp|call) .*\%esi/;
+ if /(jmp|call)\s+.*\%esi/;
}
if ($StolenX86Regs <= 3 ) { # spurious uses of edi?
- s/^\tmovl (.*),\%edi\n\tjmp \*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
- s/^\tjmp \*(-?\d*)\((.*\%edi.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
- s/^\tjmp \*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/g;
+ s/^\tmovl\s+(.*),\s*\%edi\n\tjmp\s+\*%edi\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
+ s/^\tjmp\s+\*(.*\(.*\%edi.*\))\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
+ s/^\tjmp\s+\*\%edi\n/\tmovl \%edi,\%eax\n\tjmp \*\%eax\n/g;
die "$Pgm: (mangler) still have jump involving \%edi!\n$_"
- if /(jmp|call) .*\%edi/;
+ if /(jmp|call)\s+.*\%edi/;
}
-#= if ($StolenX86Regs <= 4 ) { # spurious uses of ecx?
-#= s/^\tmovl (.*),\%ecx\n\tjmp \*%ecx\n/\tmovl $1,\%eax\n\tjmp \*\%eax\n/g;
-#= s/^\tjmp \*(-?\d*)\((.*\%ecx.*)\)\n/\tmovl $2,\%eax\n\tjmp \*$1\(\%eax\)\n/g;
-#= s/^\tjmp \*\%ecx\n/\tmovl \%ecx,\%eax\n\tjmp \*\%eax\n/g;
-#= die "$Pgm: (mangler) still have jump involving \%ecx!\n$_"
-#= if /(jmp|call) .*\%ecx/;
-#= }
# OK, now we can decide what our patch-up code is going to
# be:
# Offsets into register table - you'd better update these magic
# numbers should you change its contents!
- local($OFFSET_R1)=48;
- local($OFFSET_SpA)=80;
+ # local($OFFSET_R1)=0; No offset for R1 in new RTS.
+ local($OFFSET_Hp)=88;
# Note funky ".=" stuff; we're *adding* to these _patch guys
if ( $StolenX86Regs <= 2
- && ( /${OFFSET_R1}\(\%ebx\)/ || /\%esi/ || /^\tcmps/ ) ) { # R1 (esi)
- $entry_patch .= "\tmovl \%esi,${OFFSET_R1}(\%ebx)\n";
- $exit_patch .= "\tmovl ${OFFSET_R1}(\%ebx),\%esi\n";
-
- $gc_call_entry_patch .= "\tmovl \%esi,${OFFSET_R1}(\%ebx)\n";
- $gc_call_exit_patch .= "\tmovl ${OFFSET_R1}(\%ebx),\%esi\n";
+ && ( /[^0-9]\(\%ebx\)/ || /\%esi/ || /^\tcmps/ ) ) { # R1 (esi)
+ $entry_patch .= "\tmovl \%esi,(\%ebx)\n";
+ $exit_patch .= "\tmovl (\%ebx),\%esi\n";
# nothing for call_{entry,exit} because %esi is callee-save
}
if ( $StolenX86Regs <= 3
- && ( /${OFFSET_SpA}\(\%ebx\)/ || /\%edi/ || /^\t(scas|cmps)/ ) ) { # SpA (edi)
- $entry_patch .= "\tmovl \%edi,${OFFSET_SpA}(\%ebx)\n";
- $exit_patch .= "\tmovl ${OFFSET_SpA}(\%ebx),\%edi\n";
-
- $gc_call_entry_patch .= "\tmovl \%edi,${OFFSET_SpA}(\%ebx)\n";
- $gc_call_exit_patch .= "\tmovl ${OFFSET_SpA}(\%ebx),\%edi\n";
+ && ( /${OFFSET_Hp}\(\%ebx\)/ || /\%edi/ || /^\t(scas|cmps)/ ) ) { # Hp (edi)
+ $entry_patch .= "\tmovl \%edi,${OFFSET_Hp}(\%ebx)\n";
+ $exit_patch .= "\tmovl ${OFFSET_Hp}(\%ebx),\%edi\n";
# nothing for call_{entry,exit} because %edi is callee-save
}
- local ($OFFSET_Hp) = 96;
-
-#= local ($OFFSET_rSaveECX) = 124;
-#= if ( $StolenX86Regs <= 4
-#= && ( /${OFFSET_Hp}\(\%ebx\)/ || /\%ecx/ || /^\t(rep|loop)/ ) ) { # Hp (ecx)
-#= $entry_patch .= "\tmovl \%ecx,${OFFSET_Hp}(\%ebx)\n";
-#= $exit_patch .= "\tmovl ${OFFSET_Hp}(\%ebx),\%ecx\n";
-#=
-#= $call_exit_patch .= "\tmovl \%ecx,${OFFSET_rSaveECX}(\%ebx)\n";
-#= $call_entry_patch .= "\tmovl ${OFFSET_rSaveECX}(\%ebx),\%ecx\n";
-#= # I have a really bad feeling about this if we ever
-#= # have a nested call...
-#= # NB: should just hide it somewhere in the C stack.
-#= }
+
# --------------------------------------------------------
# next, here we go with non-%esp patching!
#
s/^(\t[a-z])/$entry_patch$1/; # before first instruction
-# Actually, call_entry_patch and call_exit_patch never get set,
-# so let's nuke this one
-# s/^(\tcall .*\n(\taddl \$\d+,\%esp\n)?)/$call_exit_patch$1$call_entry_patch/g; # _all_ calls
-
# Before calling GC we must set up the exit condition before the call
# and entry condition when we come back
- s/^(\tcall ${T_DO_GC}\n(\taddl \$\d+,\%esp\n)?)/$gc_call_exit_patch$1$gc_call_entry_patch/g; # _all_ calls
# fix _all_ non-local jumps:
- s/^\tjmp \*${T_X86_PRE_LLBL_PAT}/\tJMP___SL/go;
- s/^\tjmp ${T_X86_PRE_LLBL_PAT}/\tJMP___L/go;
+ if ( $TargetPlatform =~ /^.*-apple-darwin.*/ ) {
+ # On Darwin, we've got local-looking jumps that are
+ # actually global (i.e. jumps to Lfoo$stub or via
+ # Lfoo$non_lazy_ptr), so we fix those first.
+ # In fact, we just fix everything that contains a dollar
+ # because false positives don't hurt here.
- s/^(\tjmp .*\n)/$exit_patch$1/g; # here's the fix...
+ s/^(\tjmp\s+\*?L.*\$.*\n)/$exit_patch$1/g;
+ }
+
+ s/^\tjmp\s+\*${T_X86_PRE_LLBL_PAT}/\tJMP___SL/go;
+ s/^\tjmp\s+${T_X86_PRE_LLBL_PAT}/\tJMP___L/go;
+
+ s/^(\tjmp\s+.*\n)/$exit_patch$1/g; # here's the fix...
s/^\tJMP___SL/\tjmp \*${T_X86_PRE_LLBL}/go;
s/^\tJMP___L/\tjmp ${T_X86_PRE_LLBL}/go;
- # fix post-PerformGC wrapper (re-)entries ???
-
if ($StolenX86Regs == 2 ) {
die "ARGH! Jump uses \%esi or \%edi with -monly-2-regs:\n$_"
- if /^\t(jmp|call) .*\%e(si|di)/;
-#= die "ARGH! Jump uses \%esi, \%edi, or \%ecx with -monly-2-regs:\n$_"
-#= if /^\t(jmp|call) .*\%e(si|di|cx)/;
+ if /^\t(jmp|call)\s+.*\%e(si|di)/;
} elsif ($StolenX86Regs == 3 ) {
die "ARGH! Jump uses \%edi with -monly-3-regs:\n$_"
- if /^\t(jmp|call) .*\%edi/;
-#= die "ARGH! Jump uses \%edi or \%ecx with -monly-3-regs:\n$_"
-#= if /^\t(jmp|call) .*\%e(di|cx)/;
-#= } elsif ($StolenX86Regs == 4 ) {
-#= die "ARGH! Jump uses \%ecx with -monly-4-regs:\n$_"
-#= if /^\t(jmp|call) .*\%ecx/;
+ if /^\t(jmp|call)\s+.*\%edi/;
}
- # final peephole fixes
-
- local($OFFSET_R2)=52;
- s/^\tmovl \%eax,${OFFSET_R2}\(\%ebx\)\n\tjmp \*${OFFSET_R2}\(\%ebx\)\n/\tmovl \%eax,${OFFSET_R2}\(\%ebx\)\n\tjmp \*\%eax\n/;
-
-# the short form may tickle perl bug:
-# s/^\tmovl \$${T_US}(.*),(\%e[abcd]x)\n\tjmp \*$2/\tjmp $T_US$1/g;
- s/^\tmovl \$${T_US}(.*),\%eax\n\tjmp \*\%eax/\tjmp $T_US$1/g;
- s/^\tmovl \$${T_US}(.*),\%ebx\n\tjmp \*\%ebx/\tjmp $T_US$1/g;
- s/^\tmovl \$${T_US}(.*),\%ecx\n\tjmp \*\%ecx/\tjmp $T_US$1/g;
- s/^\tmovl \$${T_US}(.*),\%edx\n\tjmp \*\%edx/\tjmp $T_US$1/g;
-
- # Hacks to eliminate some reloads of Hp. Worth about 5% code size.
- # We could do much better than this, but at least it catches about
- # half of the unnecessary reloads.
- # Note that these will stop working if either:
- # (i) the offset of Hp from BaseReg changes from 80, or
- # (ii) the register assignment of BaseReg changes from %ebx
-
- s/^\tmovl ${OFFSET_Hp}\(\%ebx\),\%e.x\n\tmovl \$(.*),(-?[0-9]*)\(\%e.x\)\n\tmovl ${OFFSET_Hp}\(\%ebx\),\%e(.)x/\tmovl ${OFFSET_Hp}\(\%ebx\),\%e$3x\n\tmovl \$$1,$2\(\%e$3x\)/g;
-
- s/^\tmovl ${OFFSET_Hp}\(\%ebx\),\%e(.)x\n\tmovl (.*),\%e(.)x\n\tmovl \%e$3x,(-?[0-9]*\(\%e$1x\))\n\tmovl ${OFFSET_Hp}\(\%ebx\),\%e$1x/\tmovl ${OFFSET_Hp}\(\%ebx\),\%e$1x\n\tmovl $2,\%e$3x\n\tmovl \%e$3x,$4/g;
-
- s/^\tmovl ${OFFSET_Hp}\(\%ebx\),\%edx((\n\t(movl|addl) .*,((-?[0-9]*\(.*)|(\%e[abc]x)))+)\n\tmovl ${OFFSET_Hp}\(\%ebx\),\%edx/\tmovl ${OFFSET_Hp}\(\%ebx\),\%edx$1/g;
- s/^\tmovl ${OFFSET_Hp}\(\%ebx\),\%eax((\n\t(movl|addl) .*,((-?[0-9]*\(.*)|(\%e[bcd]x)))+)\n\tmovl ${OFFSET_Hp}\(\%ebx\),\%eax/\tmovl ${OFFSET_Hp}\(\%ebx\),\%eax$1/g;
-
# --------------------------------------------------------
# that's it -- print it
#
\begin{code}
sub init_FUNNY_THINGS {
%KNOWN_FUNNY_THING = (
- "${T_US}CheckHeapCode${T_POST_LBL}", 1,
- "${T_US}CommonUnderflow${T_POST_LBL}", 1,
- "${T_US}Continue${T_POST_LBL}", 1,
- "${T_US}EnterNodeCode${T_POST_LBL}", 1,
- "${T_US}ErrorIO_call_count${T_POST_LBL}", 1,
- "${T_US}ErrorIO_innards${T_POST_LBL}", 1,
- "${T_US}IndUpdRetDir${T_POST_LBL}", 1,
- "${T_US}IndUpdRetV0${T_POST_LBL}", 1,
- "${T_US}IndUpdRetV1${T_POST_LBL}", 1,
- "${T_US}IndUpdRetV2${T_POST_LBL}", 1,
- "${T_US}IndUpdRetV3${T_POST_LBL}", 1,
- "${T_US}IndUpdRetV4${T_POST_LBL}", 1,
- "${T_US}IndUpdRetV5${T_POST_LBL}", 1,
- "${T_US}IndUpdRetV6${T_POST_LBL}", 1,
- "${T_US}IndUpdRetV7${T_POST_LBL}", 1,
- "${T_US}PrimUnderflow${T_POST_LBL}", 1,
- "${T_US}StackUnderflowEnterNode${T_POST_LBL}", 1,
- "${T_US}StdErrorCode${T_POST_LBL}", 1,
- "${T_US}UnderflowVect0${T_POST_LBL}", 1,
- "${T_US}UnderflowVect1${T_POST_LBL}", 1,
- "${T_US}UnderflowVect2${T_POST_LBL}", 1,
- "${T_US}UnderflowVect3${T_POST_LBL}", 1,
- "${T_US}UnderflowVect4${T_POST_LBL}", 1,
- "${T_US}UnderflowVect5${T_POST_LBL}", 1,
- "${T_US}UnderflowVect6${T_POST_LBL}", 1,
- "${T_US}UnderflowVect7${T_POST_LBL}", 1,
- "${T_US}UpdErr${T_POST_LBL}", 1,
- "${T_US}UpdatePAP${T_POST_LBL}", 1,
- "${T_US}_Enter_Internal${T_POST_LBL}", 1,
- "${T_US}_PRMarking_MarkNextAStack${T_POST_LBL}", 1,
- "${T_US}_PRMarking_MarkNextBStack${T_POST_LBL}", 1,
- "${T_US}_PRMarking_MarkNextCAF${T_POST_LBL}", 1,
- "${T_US}_PRMarking_MarkNextGA${T_POST_LBL}", 1,
- "${T_US}_PRMarking_MarkNextRoot${T_POST_LBL}", 1,
- "${T_US}_PRMarking_MarkNextSpark${T_POST_LBL}", 1,
- "${T_US}_PRMarking_MarkNextEvent${T_POST_LBL}", 1,
- "${T_US}_PRMarking_MarkNextClosureInFetchBuffer${T_POST_LBL}", 1,
- "${T_US}_Scavenge_Forward_Ref${T_POST_LBL}", 1,
- "${T_US}__std_entry_error__${T_POST_LBL}", 1,
- "${T_US}_startMarkWorld${T_POST_LBL}", 1,
- "${T_US}resumeThread${T_POST_LBL}", 1,
- "${T_US}startCcRegisteringWorld${T_POST_LBL}", 1,
- "${T_US}startEnterFloat${T_POST_LBL}", 1,
- "${T_US}startEnterInt${T_POST_LBL}", 1,
- "${T_US}startPerformIO${T_POST_LBL}", 1,
- "${T_US}startStgWorld${T_POST_LBL}", 1,
- "${T_US}stopPerformIO${T_POST_LBL}", 1,
- "${T_US}ShouldCompile_Z36d1z5${T_POST_LBL}", 1
+ # example
+ # "${T_US}stg_.*{T_POST_LBL}", 1,
);
}
\end{code}
sub rev_tbl {
local($symb, $tbl, $discard1) = @_;
+ return ($tbl) if ($TargetPlatform =~ /^ia64-/);
+
local($before) = '';
local($label) = '';
local(@imports) = (); # hppa only
local(@words) = ();
local($after) = '';
local(@lines) = split(/\n/, $tbl);
- local($i, $j); #local ($i, $extra, $words_to_pad, $j);
-
- # see comment in mangleAsm as to why this silliness is needed.
- local($TDOTWORD) = ${T_DOT_WORD};
- local($TDOTGLOBAL) = ${T_DOT_GLOBAL};
- local($TUS) = ${T_US};
- local($TPOSTLBL) = ${T_POST_LBL};
-
- for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t$TDOTWORD\s+/o; $i++) {
+ local($i, $j);
+
+ # Deal with the header...
+ for ($i = 0; $i <= $#lines && $lines[$i] !~ /^\t?${T_DOT_WORD}\s+/o; $i++) {
$label .= $lines[$i] . "\n",
- next if $lines[$i] =~ /^[A-Za-z0-9_]+_info$TPOSTLBL[@]?$/o
- || $lines[$i] =~ /$TDOTGLOBAL/o
- || $lines[$i] =~ /^$TUS[@]?vtbl_\S+$TPOSTLBL[@]?$/o;
+ next if $lines[$i] =~ /^[A-Za-z0-9_]+_info${T_POST_LBL}$/o
+ || $lines[$i] =~ /${T_DOT_GLOBAL}/o
+ || $lines[$i] =~ /^${T_US}\S+_vtbl${T_POST_LBL}$/o;
$before .= $lines[$i] . "\n"; # otherwise...
}
+ $infoname = $label;
+ $infoname =~ s/(.|\n)*^([A-Za-z0-9_]+_info)${T_POST_LBL}$(.|\n)*/\2/;
+
+ # Grab the table data...
if ( $TargetPlatform !~ /^hppa/ ) {
- for ( ; $i <= $#lines && $lines[$i] =~ /^\t$TDOTWORD\s+/o; $i++) {
- push(@words, $lines[$i]);
+ for ( ; $i <= $#lines && $lines[$i] =~ /^\t?${T_DOT_WORD}\s+/o; $i++) {
+ $line = $lines[$i];
+ # Convert addresses of SRTs, slow entrypoints and large bitmaps
+ # to offsets (relative to the info label),
+ # in order to support position independent code.
+ $line =~ s/$infoname/0/
+ || $line =~ s/([A-Za-z0-9_]+_srtd)$/\1 - $infoname/
+ || $line =~ s/([A-Za-z0-9_]+_srt(\+\d+)?)$/\1 - $infoname/
+ || $line =~ s/([A-Za-z0-9_]+_slow)$/\1 - $infoname/
+ || $line =~ s/([A-Za-z0-9_]+_btm)$/\1 - $infoname/
+ || $line =~ s/([A-Za-z0-9_]+_alt)$/\1 - $infoname/
+ || $line =~ s/([A-Za-z0-9_]+_dflt)$/\1 - $infoname/
+ || $line =~ s/([A-Za-z0-9_]+_ret)$/\1 - $infoname/;
+ push(@words, $line);
}
} else { # hppa weirdness
- for ( ; $i <= $#lines && $lines[$i] =~ /^\s+\.(word|IMPORT)/; $i++) {
+ for ( ; $i <= $#lines && $lines[$i] =~ /^\s+(${T_DOT_WORD}|\.IMPORT)/; $i++) {
+ # FIXME: the RTS now expects offsets instead of addresses
+ # for all labels in info tables.
if ($lines[$i] =~ /^\s+\.IMPORT/) {
push(@imports, $lines[$i]);
} else {
}
}
- # now throw away the first word (entry code):
- shift(@words) if $discard1;
-
-# Padding removed to reduce code size and improve performance on Pentiums.
-# Simon M. 13/4/96
- # for 486-cache-friendliness, we want our tables aligned
- # on 16-byte boundaries (.align 4). Let's pad:
-# $extra = ($#words + 1) % 4;
-# $words_to_pad = ($extra == 0) ? 0 : 4 - $extra;
-# for ($j = 0; $j < $words_to_pad; $j++) { push(@words, "\t${T_DOT_WORD} 0"); }
+ # Now throw away any initial zero word from the table. This is a hack
+ # that lets us reduce the size of info tables when the SRT field is not
+ # needed: see comments StgFunInfoTable in InfoTables.h.
+ #
+ # The .zero business is for Linux/ELF.
+ # The .skip business is for Sparc/Solaris/ELF.
+ # The .blockz business is for HPPA.
+# if ($discard1) {
+# if ($words[0] =~ /^\t?(${T_DOT_WORD}\s+0|\.zero\s+4|\.skip\s+4|\.blockz\s+4)/) {
+# shift(@words);
+# }
+# }
for (; $i <= $#lines; $i++) {
$after .= $lines[$i] . "\n";
}
- # Alphas:If we have anonymous text (not part of a procedure), the
+ # Alphas: If we have anonymous text (not part of a procedure), the
# linker may complain about missing exception information. Bleh.
+ # To suppress this, we place a .ent/.end pair around the code.
+ # At the same time, we have to be careful and not enclose any leading
+ # .file/.loc directives.
if ( $TargetPlatform =~ /^alpha-/ && $label =~ /^([A-Za-z0-9_]+):$/) {
- $before = "\t.ent $1\n" . $before;
- $after .= "\t.end $1\n";
+ local ($ident) = $1;
+ $before =~ s/^((\s*\.(file|loc)\s+[^\n]*\n)*)/$1\t.ent $ident\n/;
+ $after .= "\t.end $ident\n";
+ }
+
+ # Alphas: The heroic Simon Marlow found a bug in the Digital UNIX
+ # assembler (!) wherein .quad constants inside .text sections are
+ # first narrowed to 32 bits then sign-extended back to 64 bits.
+ # This obviously screws up our 64-bit bitmaps, so we work around
+ # the bug by replacing .quad with .align 3 + .long + .long [ccshan]
+ if ( $TargetPlatform =~ /^alpha-/ ) {
+ foreach (@words) {
+ if (/^\s*\.quad\s+([-+0-9].*\S)\s*$/ && length $1 >= 10) {
+ local ($number) = $1;
+ if ($number =~ /^([-+])?(0x?)?([0-9]+)$/) {
+ local ($sign, $base, $digits) = ($1, $2, $3);
+ $base = (10, 8, 16)[length $base];
+ local ($hi, $lo) = (0, 0);
+ foreach $i (split(//, $digits)) {
+ $j = $lo * $base + $i;
+ $lo = $j % 4294967296;
+ $hi = $hi * $base + ($j - $lo) / 4294967296;
+ }
+ ($hi, $lo) = (4294967295 - $hi, 4294967296 - $lo)
+ if $sign eq "-";
+ $_ = "\t.align 3\n\t.long $lo\n\t.long $hi\n";
+ # printf STDERR "TURNING %s into 0x %08x %08x\n", $number, $hi, $lo;
+ } else {
+ print STDERR "Cannot handle \".quad $number\" in info table\n";
+ exit 1;
+ }
+ }
+ }
}
$tbl = $before
. (($TargetPlatform !~ /^hppa/) ? '' : join("\n", @imports) . "\n")
- . join("\n", (reverse @words)) . "\n"
+ . join("\n", @words) . "\n"
. $label . $after;
# print STDERR "before=$before\n";
}
\end{code}
-\begin{code}
-sub mini_mangle_asm_i386 {
- local($in_asmf, $out_asmf) = @_;
-
- &init_TARGET_STUFF();
-
- # see mangleAsm comment
- local($TUS) = ${T_US};
- local($TPOSTLBL)=${T_POST_LBL};
-
- 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");
-
- while (<INASM>) {
- print OUTASM;
-
- next unless
- /^$TUS[@]?(PerformGC|StackOverflow|Yield|PerformReschedule)_wrapper$TPOSTLBL\n/o;
- print OUTASM "\tmovl \%esp, ${T_US}__temp_esp\n";
- print OUTASM "\tmovl \%eax, ${T_US}__temp_eax\n";
- }
-
- # 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}
-
The HP is a major nuisance. The threaded code mangler moved info
tables from data space to code space, but unthreaded code in the RTS
still has references to info tables in data space. Since the HP
}
\end{code}
-
-\begin{code}
-sub mini_mangle_asm_powerpc {
- local($in_asmf, $out_asmf) = @_;
-
- 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");
-
- while (<INASM>) {
- s/long _PRStart/long ._PRStart/;
- s/long _PRIn_/long ._PRIn_/;
- s/long _Dummy_(\S+)_entry/long ._Dummy_\1_entry/;
- s/long _PRMarking_MarkNextRoot\[DS\]/long ._PRMarking_MarkNextRoot/;
- s/long _PRMarking_MarkNextCAF\[DS\]/long ._PRMarking_MarkNextCAF/;
- s/long _PRMarking_MarkNextAStack\[DS\]/long ._PRMarking_MarkNextAStack/;
- s/long _PRMarking_MarkNextBStack\[DS\]/long ._PRMarking_MarkNextBStack/;
- s/\.tc EnterNodeCode\[TC]\,EnterNodeCode\[DS\]/\.tc EnterNodeCode\[TC]\,.EnterNodeCode/; # CONC
- s/\.tc CheckHeapCode\[TC]\,CheckHeapCode\[DS\]/\.tc CheckHeapCode\[TC]\,.CheckHeapCode/; # CONC
- print OUTASM;
- }
- # 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");
-}
-
-sub mangle_powerpc_tailjump {
- local($c) = @_;
- local($maybe_more) = 1;
- while (($c =~ /\tlw?z? \d+,LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n/) && $maybe_more)
- { $maybe_more = 0;
- $lcsymb = $c;
- $lcsymb =~ s/(.*\n)*\tlw?z? \d+,LC\.\.(\d+)\(2\)\n\tmtctr \d+\n\tbctr\n(.*\n)*/\2/;
-# the checks for r1 and r2 are mostly paranoia...
- $r1 = $c;
- $r1 =~ s/(.*\n)*\tlw?z? (\d+),LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n(.*\n)*/\2/;
- $r2 = $c;
- $r2 =~ s/(.*\n)*\tlw?z? \d+,LC\.\.(\d+)\(2\)\n\tmtctr (\d+)\n\tbctr\n(.*\n)*/\3/;
- if (r1 == r2)
- { $maybe_more = 1;
- $c =~ s/((.*\n)*)\tlw?z? \d+,LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n((.*\n)*)/\1\tb $tocequiv{$lcsymb}\n\3/;
- }
- };
- $c;
+\begin{code}
+sub tidy_up_and_die {
+ local($return_val, $msg) = @_;
+ print STDERR $msg;
+ exit (($return_val == 0) ? 0 : 1);
}
-
-# make "require"r happy...
-1;
\end{code}
projects / ghc-hetmet.git / blobdiff