X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fdriver%2Fsplit%2Fghc-split.lprl;h=66f2be65b87017b25d702739e3d419f56c33010d;hb=35d7d23c6daf7088926a244771e86513079842d1;hp=00c116e314edbc98317a9897b3e2916b76e6b008;hpb=a17aa0baf3e31479e34744e42d2ed893d387063f;p=ghc-hetmet.git diff --git a/ghc/driver/split/ghc-split.lprl b/ghc/driver/split/ghc-split.lprl index 00c116e..66f2be6 100644 --- a/ghc/driver/split/ghc-split.lprl +++ b/ghc/driver/split/ghc-split.lprl @@ -5,45 +5,23 @@ %************************************************************************ \begin{code} -sub inject_split_markers { - local($hc_file) = @_; +$TargetPlatform = $TARGETPLATFORM; - unlink("$Tmp_prefix.unmkd"); - local($to_do) = "cp $hc_file $Tmp_prefix.unmkd"; - &run_something($to_do, 'Prepare to number split markers'); +($Pgm = $0) =~ s|.*/||; +$ifile = $ARGV[0]; +$Tmp_prefix = $ARGV[1]; +$Output = $ARGV[2]; - open(TMPI, "< $Tmp_prefix.unmkd") || &tidy_up_and_die(1,"$Pgm: failed to open `$Tmp_prefix.unmkd' (to read)\n"); - open(TMPO, "> $hc_file") || &tidy_up_and_die(1,"$Pgm: failed to open `$hc_file' (to write)\n"); +&split_asm_file($ifile); - local($marker_no) = 1; +open(OUTPUT, "> $Output") || &tidy_up_and_die(1,"$Pgm: failed to open `$Output' (to write)\n"); +print OUTPUT "$NoOfSplitFiles\n"; +close(OUTPUT); - # make sure there is a split marker before any "real" code - $_ = ; - while ( $_ ne '' && ( /^$/ || /^#/ ) ) { - print TMPO $_; - $_ = ; - } - print TMPO "__STG_SPLIT_MARKER(1)\n"; - print TMPO $_ if ! /^\s*\/\* SPLIT \*\/\s*$/; - - # Have to be a bit careful detecting /* SPLIT */ comments - # since a progam may use a string containing "/* SPLIT */" - # We check that there is nothing else on the line - - while () { - if (/^\s*\/\* SPLIT \*\/\s*$/) { - $marker_no++; - print TMPO "__STG_SPLIT_MARKER($marker_no)\n"; - next; - } - print TMPO $_; - } - - close(TMPI) || &tidy_up_and_die(1,"Failed reading $Tmp_prefix.unmkd\n"); - close(TMPO) || &tidy_up_and_die(1,"Failed writing $hc_file\n"); -} +exit(0); \end{code} + \begin{code} sub split_asm_file { local($asm_file) = @_; @@ -67,7 +45,7 @@ sub split_asm_file { # if $prologue_stuff eq $s_stuff; # lie about where this stuff came from - $prologue_stuff =~ s|"/tmp/ghc\d+\.c"|"$ifile_root\.hc"|g; + $prologue_stuff =~ s|"${Tmp_prefix}\.c"|"$ifile_root\.hc"|g; while ( $_ ne '' ) { # not EOF $octr++; @@ -161,6 +139,7 @@ sub ReadTMPIUpToAMarker { print STDERR "### BLOCK:$count:\n$str" if $Dump_asm_splitting_info; # return str + $str =~ tr/\r//d if $TargetPlatform =~ /-mingw32$/; $str; } \end{code} @@ -179,6 +158,7 @@ sub process_asm_block { return(&process_asm_block_alpha($str)) if $TargetPlatform =~ /^alpha-/; return(&process_asm_block_hppa($str)) if $TargetPlatform =~ /^hppa/; return(&process_asm_block_mips($str)) if $TargetPlatform =~ /^mips-/; + return(&process_asm_block_powerpc($str)) if $TargetPlatform =~ /^powerpc-|^rs6000-/; # otherwise... &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n"); @@ -191,15 +171,15 @@ sub process_asm_block_sparc { if ( $OptimiseC ) { $str =~ s/_?__stg_split_marker.*:\n//; } else { - $str =~ s/(\.text\n\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/\1/; - $str =~ s/(\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/\1/; + $str =~ s/(\.text\n\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/; + $str =~ s/(\t\.align .\n)\t\.global\s+.*_?__stg_split_marker.*\n\t\.proc.*\n/$1/; } # make sure the *.hc filename gets saved; not just ghc*.c (temp name) $str =~ s/^\.stabs "(ghc\d+\.c)"/.stabs "$ifile_root.hc"/g; # HACK HACK # remove/record any literal constants defined here - while ( $str =~ /(\t\.align .\n(LC\d+):\n(\t\.ascii.*\n)+)/ ) { + while ( $str =~ /(\t\.align .\n\.?(L?LC\d+):\n(\t\.asci[iz].*\n)+)/ ) { local($label) = $2; local($body) = $1; @@ -208,7 +188,7 @@ sub process_asm_block_sparc { $LocalConstant{$label} = $body; - $str =~ s/\t\.align .\nLC\d+:\n(\t\.ascii.*\n)+//; + $str =~ s/\t\.align .\n\.?LL?C\d+:\n(\t\.asci[iz].*\n)+//; } # inject definitions for any local constants now used herein @@ -226,10 +206,10 @@ sub process_asm_block_sparc { sub process_asm_block_m68k { local($str) = @_; - # strip the marker (ToDo: something special for unregisterized???) + # strip the marker - $str =~ s/(\.text\n\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/\1/; - $str =~ s/(\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/\1/; + $str =~ s/(\.text\n\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/; + $str =~ s/(\t\.even\n)\t\.globl\s+.*_?__stg_split_marker.*\n/$1/; # it seems prudent to stick on one of these: $str = "\.text\n\t.even\n" . $str; @@ -266,7 +246,7 @@ sub process_asm_block_alpha { if ( $OptimiseC ) { $str =~ s/_?__stg_split_marker.*:\n//; } else { - $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/\1/; + $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/; } # remove/record any literal constants defined here @@ -292,7 +272,7 @@ sub process_asm_block_alpha { # Slide the dummy direct return code into the vtbl .ent/.end block, # to keep the label fixed if it's the last thing in a module, and # to avoid having any anonymous text that the linker will complain about - $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n\1/g; + $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g; print STDERR "### STRIPPED BLOCK (alpha):\n$str" if $Dump_asm_splitting_info; @@ -302,16 +282,16 @@ sub process_asm_block_alpha { sub process_asm_block_iX86 { local($str) = @_; - # strip the marker (ToDo: something special for unregisterized???) + # strip the marker - $str =~ s/(\.text\n\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/\1/; - $str =~ s/(\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/\1/; + $str =~ s/(\.text\n\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/; + $str =~ s/(\t\.align .(,0x90)?\n)\.globl\s+.*_?__stg_split_marker.*\n/$1/; # it seems prudent to stick on one of these: $str = "\.text\n\t.align 4\n" . $str; # remove/record any literal constants defined here - while ( ($str =~ /((LC\d+):\n\t\.ascii.*\n)/ )) { + while ( ($str =~ /(\.?(LC\d+):\n(\t\.(ascii|string).*\n|\s*\.byte.*\n)+)/ )) { local($label) = $2; local($body) = $1; @@ -320,7 +300,7 @@ sub process_asm_block_iX86 { $LocalConstant{$label} = $body; - $str =~ s/LC\d+:\n\t\.ascii.*\n//; + $str =~ s/\.?LC\d+:\n(\t\.(ascii|string).*\n|\s*\.byte.*\n)+//; } # inject definitions for any local constants now used herein @@ -354,6 +334,8 @@ sub process_asm_block_hppa { while ( $str =~ /^(\s+\.align.*\n(L\$C\d+)\n(\s.*\n)+); end literal\n/ ) { local($label) = $2; local($body) = $1; + local($prefix) = $`; + local($suffix) = $'; $label =~ s/\$/\\\$/g; &tidy_up_and_die(1,"Local constant label $label already defined!\n") @@ -361,7 +343,7 @@ sub process_asm_block_hppa { $LocalConstant{$label} = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n\n" . $body; - $str =~ s/^\s+\.SPACE \$TEXT\$\n\s+\.SUBSPA \$LIT\$\s+\.align.*\nL\$C\d+\n(\s.*\n)+; end literal\n//; + $str = $prefix . $suffix; } # inject definitions for any local constants now used herein @@ -396,7 +378,7 @@ sub process_asm_block_mips { if ( $OptimiseC ) { $str =~ s/_?__stg_split_marker.*:\n//; } else { - $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/\1/; + $str =~ s/(\t\.align .\n)\t\.globl\s+.*_?__stg_split_marker.*\n\t\.ent.*\n/$1/; } # remove/record any literal constants defined here @@ -422,7 +404,7 @@ sub process_asm_block_mips { # Slide the dummy direct return code into the vtbl .ent/.end block, # to keep the label fixed if it's the last thing in a module, and # to avoid having any anonymous text that the linker will complain about - $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n\1/g; + $str =~ s/(\t\.end [A-Za-z0-9_]+)\n\t# nop/\tnop\n$1/g; $str .= $UNDEFINED_FUNS; # pin on gratuitiously-large amount of info @@ -433,7 +415,45 @@ sub process_asm_block_mips { \end{code} \begin{code} -# make "require"r happy... -1; +sub process_asm_block_powerpc { + local($str) = @_; + + # strip the marker + $str =~ s/___stg_split_marker.*\n//; + $str =~ s/___stg_split_marker.*\n//; # yes, twice. + + # remove/record any literal constants defined here + while ( $str =~ /^(.csect .data[RW]\n\s+\.align.*\n(LC\.\.\d+):\n(\s\.byte .*\n)+)/ ) { + local($label) = $2; + local($body) = $1; + + &tidy_up_and_die(1,"Local constant label $label already defined!\n") + if $LocalConstant{$label}; + + $LocalConstant{$label} = $body; + + $str =~ s/^.csect .data[RW]\n\s+\.align.*\nLC\.\.\d+:\n(\s\.byte .*\n)+//; + } + + # inject definitions for any local constants now used herein + foreach $k (keys %LocalConstant) { + if ( $str =~ /\b$k(\b|\[)/ ) { + $str = $LocalConstant{$k} . $str; + } + } + + print STDERR "### STRIPPED BLOCK (powerpc/rs6000):\n$str" if $Dump_asm_splitting_info; + + $str = ".toc\n" . $str; + + $str; +} \end{code} +\begin{code} +sub tidy_up_and_die { + local($return_val, $msg) = @_; + print STDERR $msg; + exit (($return_val == 0) ? 0 : 1); +} +\end{code}