From 8ef57b89f0868d09c88a3a005e4a75ae4247f90b Mon Sep 17 00:00:00 2001 From: sof Date: Tue, 13 Jun 2000 15:35:29 +0000 Subject: [PATCH] [project @ 2000-06-13 15:35:29 by sof] Tweaked __fexp regexps --- ghc/driver/mangler/ghc-asm.lprl | 324 ++++++++++++++++++++++++--------------- 1 file changed, 203 insertions(+), 121 deletions(-) diff --git a/ghc/driver/mangler/ghc-asm.lprl b/ghc/driver/mangler/ghc-asm.lprl index b52dd72..8475e62 100644 --- a/ghc/driver/mangler/ghc-asm.lprl +++ b/ghc/driver/mangler/ghc-asm.lprl @@ -89,7 +89,7 @@ sub init_TARGET_STUFF { $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_hsc_cc_PAT = '\.STRING.*\)(hsc|cc) (.*)\\\\x09(.*)\\\\x00"'; $T_DOT_WORD = '\.word'; $T_DOT_GLOBAL = '^\s+\.EXPORT'; $T_HDR_literal = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n"; @@ -117,7 +117,7 @@ sub init_TARGET_STUFF { $T_X86_PRE_LLBL = 'L'; $T_X86_BADJMP = '^\tjmp [^L\*]'; - $T_MOVE_DIRVS = '^(\s*(\.align\s+\d+(,0x90)?|\.globl\s+\S+|\.text|\.data|\.stab[^n].*|\.type\s+.*|\.size\s+.*)\n)'; + $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'; @@ -219,46 +219,33 @@ sub init_TARGET_STUFF { $T_HDR_direct = "\t\.text\n\t\.align 2\n"; #--------------------------------------------------------# - } elsif ( $TargetPlatform =~ /^powerpc-.*/ ) { + } elsif ( $TargetPlatform =~ /^powerpc-.*|^rs6000-.*/ ) { $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_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_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_MOVE_DIRVS = '^(\s*(\.toc|.csect \S+|\.l?globl \S+|\.align \d+)\n)'; $T_COPY_DIRVS = '\.(l?globl)'; - $T_hsc_cc_PAT = '\.string.*\)(hsc|cc) (.*)\\\\t(.*)"'; + $T_hsc_cc_PAT = '\.byte.*\)(hsc|cc) (.*)"\n\t\.byte \d+\n\t\.byte "(.*)"\n\t\.byte \d+'; $T_DOT_WORD = '\.long'; $T_DOT_GLOBAL = '\.globl'; $T_HDR_toc = "\.toc\n"; - $T_HDR_literal = "# literal\n\.csect .data[RW]\n\t\.align 2\n"; #not RO!? + $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"; + $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 = "\.section\t\.rodata\n"; -# $T_HDR_misc = "\.text\n\t\.align 2\n"; -# $T_HDR_data = "\.data\n\t\.align 2\n"; -# $T_HDR_consist = "\.text\n"; -# $T_HDR_closure = "\.data\n\t\.align 2\n"; -# $T_HDR_info = "\.text\n\t\.align 2\n"; -# $T_HDR_entry = "\.text\n"; -# $T_HDR_fast = "\.text\n\t\.align 2\n"; -# $T_HDR_vector = "\.text\n\t\.align 2\n"; -# $T_HDR_direct = "\.text\n\t\.align 2\n"; - #--------------------------------------------------------# } elsif ( $TargetPlatform =~ /^sparc-.*-solaris2/ ) { @@ -405,14 +392,23 @@ sub mangle_asm { next if /$TPREAPP(NO_)?APP/o; next if /^;/ && $TargetPlatform =~ /^hppa/; - next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|powerpc)-/; + next if /(^$|^\t\.file\t|^ # )/ && $TargetPlatform =~ /^(mips|powerpc|rs6000)-/; - last if /^_section_\.text:$/ && $TargetPlatform =~ /^powerpc-/; + last if /^_section_\.text:$/ && $TargetPlatform =~ /^powerpc-|^rs6000-/; if ( $TargetPlatform =~ /^mips-/ && /^\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 ]+${TUS}__fexp_.*$/ ) { + $chk[++$i] = $_; + $chkcat[$i] = 'data'; + $chksymb[$i] = ''; + } elsif ( /^\s+/ ) { # most common case first -- a simple line! # duplicated from the bottom @@ -490,23 +486,25 @@ sub mangle_asm { } elsif ( /^([A-Za-z0-9_]+)\s+\.comm/ && $TargetPlatform =~ /^hppa/ ) { $chk[++$i] = $_; $chkcat[$i] = 'bss'; - $chksymb[$i] = $1; # useless, $1 is always '', since we end up using the second - # pattern /^hppa/. Change $1 to ''. Or reverse the pattern. - # Anyway, it is never used. - andre - $chksymb[$i] = $1; + $chksymb[$i] = ''; - } elsif ( $TargetPlatform =~ /^powerpc-/ && /^LC\.\.([0-9]+)/ ) { -# } elsif ( /^LC\.\.([0-9]+)/ && $TargetPlatform =~ /^powerpc-/ ) { + } elsif ( $TargetPlatform =~ /^powerpc-|^rs6000-/ && /^LC\.\.([0-9]+)/ ) { $chk[++$i] = $_; $chkcat[$i] = 'toc'; $chksymb[$i] = $1; - - } elsif ( /^$TUS[@]?(ret_|djn_)/o ) { + + } elsif ( $TargetPlatform =~ /^powerpc-|^rs6000-/ && /^CC_.*$/ ) { + # all CC_ symbols go in the data section... + $chk[++$i] = $_; + $chkcat[$i] = 'data'; + $chksymb[$i] = ''; + + } elsif ( /^($TUS[@]?(ret_|djn_)[A-Za-z0-9_]+)/o ) { $chk[++$i] = $_; $chkcat[$i] = 'misc'; $chksymb[$i] = ''; $symbtmp = $1; - $chksymb[$i] = $symbtmp if ($TargetPlatform =~ /^powerpc-/) ; + $chksymb[$i] = $symbtmp if ($TargetPlatform =~ /^powerpc-|^rs6000-/) ; #rm andre } elsif ( /^$TUS[@]?vtbl_([A-Za-z0-9_]+)$TPOSTLBL[@]?$/o ) { $chk[++$i] = $_; @@ -525,10 +523,19 @@ sub mangle_asm { } elsif ( /^$TUS[@]?([A-Za-z0-9_]+)_upd$TPOSTLBL[@]?$/o ) { $chk[++$i] = $_; $chkcat[$i] = 'misc'; - if ($TargetPlatform =~ /^powerpc-/) - { $chksymb[$i] = $symbtmp;} - else { $chksymb[$i] = ''; }; - + 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 ]+${TUS}__fexp_.*$/ ) { + $chk[++$i] = $_; + $chkcat[$i] = 'data'; + $chksymb[$i] = ''; } elsif ( $TargetPlatform =~ /^i386-.*-solaris2/ && /^(_uname|uname|stat|fstat):/ ) { @@ -548,7 +555,7 @@ sub mangle_asm { } elsif ( /^$TUS[@]?[A-Za-z0-9_]/o && ( $TargetPlatform !~ /^hppa/ # need to avoid local labels in this case || ! /^L\$\d+$/ ) - && ( $TargetPlatform !~ /^powerpc/ # ditto + && ( $TargetPlatform !~ /^powerpc|^rs6000/ # ditto || ! /^(L\.\.\d+|LT\.\..*):$/ ) ) { local($thing); chop($thing = $_); @@ -556,10 +563,11 @@ sub mangle_asm { 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 $chk[++$i] = $_; $chkcat[$i] = 'misc'; - if ($TargetPlatform =~ /^powerpc-/) + if ($TargetPlatform =~ /^powerpc-|^rs6000-/) { $chksymb[$i] = $thing; } else { $chksymb[$i] = ''; }; @@ -578,7 +586,7 @@ sub mangle_asm { # about the whole module before we start spitting # output. - local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-|power)/) ? 1 : 0; + local($FIRST_MANGLABLE) = ($TargetPlatform =~ /^(alpha-|hppa|mips-)/) ? 1 : 0; # print STDERR "first chunk to mangle: $FIRST_MANGLABLE\n"; @@ -590,18 +598,18 @@ sub mangle_asm { # HPPAs, MIPSen: also start medding at chunk 1 -# AIX hack for the moment, to join up multiple identical tocs - if ($TargetPlatform =~ /^powerpc/) { - print OUTASM ".toc\n.csect .text[PR]\ngcc2_compiled.:\n__gnu_compiled_c:\n"; -# print OUTASM ".csect _ghc88142.rw_c[RW]\n\t.align 2\nghc_cc_ID:\n\t.byte \"@(#)cc prelude/Prelude.hc\"\n\t.byte 9\n\t.byte "35.0,,"\n\t.byte 0" - print OUTASM $T_HDR_toc; + 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/; @@ -611,6 +619,12 @@ sub mangle_asm { $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/; @@ -620,26 +634,11 @@ sub mangle_asm { $tocsymb =~ s/^\t\.tc \S+,(\S+)\n/\1/; $tocequiv{$tocnumber} = $tocsymb; - # limit is the limit of the scope of the current toc (either eof or find a new toc) - $limit = $i; - while ($chkcat[$limit] eq 'toc') {$limit++;}; - while (($limit < $numchks) && ($chkcat[$limit] ne 'toc')) {$limit++;}; - - if ( $revtocequiv{$tocsymb} eq '') { - $revtocequiv{$tocsymb} = $tocnumber; - if ( $chk[$i] !~ /\.tc \S+_fast\d+\[TC\],\.\S+_fast\d+/ # no need to print these - || $chk[$i] !~ /\.tc UpdatePAP\[TC\],\.UpdatePAP/ - || $chk[$i] !~ /\.tc \S+\[TC\],\.\S+_entry\n/ ) - { print OUTASM $chk[$i]; }; - } else { - for ($j = $i; $j <= $limit; $j++) { - $chk[$j] =~ s/LC\.\.$tocnumber\(/LC\.\.${revtocequiv{$tocsymb}}\(/g; - }; - }; - $chkcat[$i] = 'DONE ALREADY'; - } - } - }; + } elsif ( $chkcat[$i] eq 'toc' && $chk[$i] =~ /\.byte/ ) { + $chkcat[$i] = 'literal'; + } + } + }; for ($i = $FIRST_MANGLABLE; $i < $numchks; $i++) { $c = $chk[$i]; # convenience copy @@ -683,11 +682,15 @@ sub mangle_asm { $p =~ s/^\tsw\t\$fp,\d+\(\$sp\)\n//; $p =~ s/^\tsw\t\$28,\d+\(\$sp\)\n//; $p =~ s/__FRAME__/$FRAME/; - } elsif ($TargetPlatform =~ /^powerpc-/) { + } elsif ($TargetPlatform =~ /^powerpc-|^rs6000/) { $p =~ s/^\tmflr 0\n//; $p =~ s/^\tstm \d+,-\d+\(1\)\n//; - $p =~ s/^\tst 0,\d+\(1\)\n//; - $p =~ s/^\tstu 1,-\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; } else { print STDERR "$Pgm: unknown prologue mangling? $TargetPlatform\n"; } @@ -722,11 +725,12 @@ sub mangle_asm { $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-/) { - $e =~ s/^\cal 1,\d+\(1\)\n//; - $e =~ s/^\tl \d+,\d+\(1\)\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/^\tbr\n//; + $e =~ s/^\tbl?r\n//; } else { print STDERR "$Pgm: unknown epilogue mangling? $TargetPlatform\n"; } @@ -869,21 +873,25 @@ sub mangle_asm { if ( $chkcat[$i] eq 'misc' ) { if ($chk[$i] ne '') { print OUTASM $T_HDR_misc; - if ($TargetPlatform =~ /^powerpc-/) { + if ($TargetPlatform =~ /^powerpc-|^rs6000/) { $chksymb[$i] =~ s/://; - if ($chksymb[$i] =~ /ret.*upd/ || $KNOWN_FUNNY_THING{$chksymb[$i]} - || $chksymb[$i] =~ /^${T_US}_(PRIn|PRStart).*${T_POST_LBL}$/o ) - { print OUTASM "\t\.globl $chksymb[$i]\n\t\.globl \.$chksymb[$i]\n"; - } else { print OUTASM "\t\.lglobl \.$chksymb[$i]\n"; }; +#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-/ && $printDS) { - print OUTASM "\.csect ${chksymb[$i]}[DS]\n"; - print OUTASM "${p}TOC[tc0], 0\n"; + 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 } } } @@ -903,9 +911,28 @@ sub mangle_asm { $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|powerpc)-/ ) { # we just don't try in those case (ToDo) + } 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) @@ -936,7 +963,21 @@ sub mangle_asm { 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); + } # entry code will be put here! # paranoia @@ -954,17 +995,16 @@ sub mangle_asm { # teach it to drop through to the fast entry point: $c = $chk[$slowchk{$symb}]; - if ($TargetPlatform =~ /^powerpc-/) { + 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 "\t\.globl \.${chksymb[$i]}_entry\n"; print OUTASM "\.csect ${symb}_entry[DS]\n"; print OUTASM "${p}TOC[tc0], 0\n"; - } - else { print OUTASM "\t\.lglobl \.${symb}_entry\n"; }; - $c = &mangle_powerpc_tailjump($r); + }; + $r =~ s/\.csect \.text\[PR\]\n//; # todo: properly - andre + $c = &mangle_powerpc_tailjump($r); }; if ( defined($fastchk{$symb}) ) { @@ -973,14 +1013,20 @@ sub mangle_asm { } 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-/ ) { + } 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//; @@ -1015,14 +1061,14 @@ sub mangle_asm { ) { print OUTASM $T_HDR_fast; } - if ($TargetPlatform =~ /^powerpc-/) { + 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"; +# 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); @@ -1038,7 +1084,7 @@ sub mangle_asm { # VECTOR TABLE if ( defined($vectorchk{$symb}) ) { print OUTASM $T_HDR_vector; - if ($TargetPlatform =~ /^powerpc-/) { + if ($TargetPlatform =~ /^powerpc-|^rs6000-/) { if ( $symb =~ /^[A-Z]/) { print OUTASM "\t\.globl \.vtbl_${symb}\n"; print OUTASM "\t\.globl vtbl_${symb}\n"; @@ -1056,7 +1102,7 @@ sub mangle_asm { # DIRECT RETURN if ( defined($directchk{$symb}) ) { print OUTASM $T_HDR_direct; - if ($TargetPlatform =~ /^powerpc-/) { + 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"; @@ -1077,9 +1123,17 @@ sub mangle_asm { } } elsif ( $chkcat[$i] eq 'toc' ) { - if ($chk[$i] ne '') { - print OUTASM $T_HDR_literal; - print OUTASM $chk[$i]; + # silly optimisation to print tocs, since they come in groups... + print OUTASM $T_HDR_toc; + local($j) = $i; + while ($chkcat[$j] eq 'toc') + { if ( $chk[$j] !~ /\.tc UpdatePAP\[TC\]/ # not needed: always turned into a jump. + ) + { + print OUTASM $chk[$j]; + } + $chkcat[$j] = 'DONE ALREADY'; + $j++; } } else { @@ -1089,13 +1143,10 @@ sub mangle_asm { print OUTASM $EXTERN_DECLS if $TargetPlatform =~ /^mips-/; - if ($TargetPlatform =~ /^powerpc-/) { + if ($TargetPlatform =~ /^powerpc-|^rs6000-/) { print OUTASM ".csect .text[PR]\n_section_.text:\n.csect .data[RW]\n\t.long _section_.text\n" }; -# print OUTASM ".csect .text[PR]\n_section_.text:\n.csect .data[RW]\n\t.long _section_.text\n" -# if $TargetPlatform =~ /^powerpc-/; - # 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"); @@ -1142,6 +1193,8 @@ sub print_doctored { 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 @@ -1231,25 +1284,43 @@ sub print_doctored { # 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; + + # Note funky ".=" stuff; we're *adding* to these _patch guys if ( $StolenX86Regs <= 2 - && ( /32\(\%ebx\)/ || /\%esi/ || /^\tcmps/ ) ) { # R1 (esi) - $entry_patch .= "\tmovl \%esi,32(\%ebx)\n"; - $exit_patch .= "\tmovl 32(\%ebx),\%esi\n"; + && ( /${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"; + # nothing for call_{entry,exit} because %esi is callee-save } if ( $StolenX86Regs <= 3 - && ( /64\(\%ebx\)/ || /\%edi/ || /^\t(scas|cmps)/ ) ) { # SpA (edi) - $entry_patch .= "\tmovl \%edi,64(\%ebx)\n"; - $exit_patch .= "\tmovl 64(\%ebx),\%edi\n"; + && ( /${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"; + # nothing for call_{entry,exit} because %edi is callee-save } + local ($OFFSET_Hp) = 96; + +#= local ($OFFSET_rSaveECX) = 124; #= if ( $StolenX86Regs <= 4 -#= && ( /80\(\%ebx\)/ || /\%ecx/ || /^\t(rep|loop)/ ) ) { # Hp (ecx) -#= $entry_patch .= "\tmovl \%ecx,80(\%ebx)\n"; -#= $exit_patch .= "\tmovl 80(\%ebx),\%ecx\n"; +#= && ( /${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,108(\%ebx)\n"; -#= $call_entry_patch .= "\tmovl 108(\%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. @@ -1258,7 +1329,14 @@ sub print_doctored { # next, here we go with non-%esp patching! # s/^(\t[a-z])/$entry_patch$1/; # before first instruction - s/^(\tcall .*\n(\taddl \$\d+,\%esp\n)?)/$call_exit_patch$1$call_entry_patch/g; # _all_ calls + +# 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: @@ -1289,7 +1367,9 @@ sub print_doctored { # final peephole fixes - s/^\tmovl \%eax,36\(\%ebx\)\n\tjmp \*36\(\%ebx\)\n/\tmovl \%eax,36\(\%ebx\)\n\tjmp \*\%eax\n/; + 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; @@ -1304,12 +1384,12 @@ sub print_doctored { # (i) the offset of Hp from BaseReg changes from 80, or # (ii) the register assignment of BaseReg changes from %ebx - s/^\tmovl 80\(\%ebx\),\%e.x\n\tmovl \$(.*),(-?[0-9]*)\(\%e.x\)\n\tmovl 80\(\%ebx\),\%e(.)x/\tmovl 80\(\%ebx\),\%e$3x\n\tmovl \$$1,$2\(\%e$3x\)/g; + 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 80\(\%ebx\),\%e(.)x\n\tmovl (.*),\%e(.)x\n\tmovl \%e$3x,(-?[0-9]*\(\%e$1x\))\n\tmovl 80\(\%ebx\),\%e$1x/\tmovl 80\(\%ebx\),\%e$1x\n\tmovl $2,\%e$3x\n\tmovl \%e$3x,$4/g; + 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 80\(\%ebx\),\%edx((\n\t(movl|addl) .*,((-?[0-9]*\(.*)|(\%e[abc]x)))+)\n\tmovl 80\(\%ebx\),\%edx/\tmovl 80\(\%ebx\),\%edx$1/g; - s/^\tmovl 80\(\%ebx\),\%eax((\n\t(movl|addl) .*,((-?[0-9]*\(.*)|(\%e[bcd]x)))+)\n\tmovl 80\(\%ebx\),\%eax/\tmovl 80\(\%ebx\),\%eax$1/g; + 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 @@ -1356,7 +1436,6 @@ sub init_FUNNY_THINGS { "${T_US}UnderflowVect7${T_POST_LBL}", 1, "${T_US}UpdErr${T_POST_LBL}", 1, "${T_US}UpdatePAP${T_POST_LBL}", 1, - "${T_US}WorldStateToken${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, @@ -1375,7 +1454,8 @@ sub init_FUNNY_THINGS { "${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}stopPerformIO${T_POST_LBL}", 1, + "${T_US}ShouldCompile_Z36d1z5${T_POST_LBL}", 1 ); } \end{code} @@ -1541,6 +1621,8 @@ sub mini_mangle_asm_powerpc { 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; } @@ -1552,18 +1634,18 @@ sub mini_mangle_asm_powerpc { sub mangle_powerpc_tailjump { local($c) = @_; local($maybe_more) = 1; - while (($c =~ /\tl \d+,LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n/) && $maybe_more) + while (($c =~ /\tlw?z? \d+,LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n/) && $maybe_more) { $maybe_more = 0; $lcsymb = $c; - $lcsymb =~ s/(.*\n)*\tl \d+,LC\.\.(\d+)\(2\)\n\tmtctr \d+\n\tbctr\n(.*\n)*/\2/; + $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)*\tl (\d+),LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n(.*\n)*/\2/; + $r1 =~ s/(.*\n)*\tlw?z? (\d+),LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n(.*\n)*/\2/; $r2 = $c; - $r2 =~ s/(.*\n)*\tl \d+,LC\.\.(\d+)\(2\)\n\tmtctr (\d+)\n\tbctr\n(.*\n)*/\3/; - if (r1 eq r2) + $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)*)\tl \d+,LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n((.*\n)*)/\1\tb $tocequiv{$lcsymb}\n\3/; + $c =~ s/((.*\n)*)\tlw?z? \d+,LC\.\.\d+\(2\)\n\tmtctr \d+\n\tbctr\n((.*\n)*)/\1\tb $tocequiv{$lcsymb}\n\3/; } }; $c; -- 1.7.10.4