diff options
author | Simon Marlow <simonmar@microsoft.com> | 2006-04-07 02:05:11 +0000 |
---|---|---|
committer | Simon Marlow <simonmar@microsoft.com> | 2006-04-07 02:05:11 +0000 |
commit | 0065d5ab628975892cea1ec7303f968c3338cbe1 (patch) | |
tree | 8e2afe0ab48ee33cf95009809d67c9649573ef92 /driver/split | |
parent | 28a464a75e14cece5db40f2765a29348273ff2d2 (diff) | |
download | haskell-0065d5ab628975892cea1ec7303f968c3338cbe1.tar.gz |
Reorganisation of the source tree
Most of the other users of the fptools build system have migrated to
Cabal, and with the move to darcs we can now flatten the source tree
without losing history, so here goes.
The main change is that the ghc/ subdir is gone, and most of what it
contained is now at the top level. The build system now makes no
pretense at being multi-project, it is just the GHC build system.
No doubt this will break many things, and there will be a period of
instability while we fix the dependencies. A straightforward build
should work, but I haven't yet fixed binary/source distributions.
Changes to the Building Guide will follow, too.
Diffstat (limited to 'driver/split')
-rw-r--r-- | driver/split/Makefile | 17 | ||||
-rw-r--r-- | driver/split/ghc-split.lprl | 618 |
2 files changed, 635 insertions, 0 deletions
diff --git a/driver/split/Makefile b/driver/split/Makefile new file mode 100644 index 0000000000..6b545de20f --- /dev/null +++ b/driver/split/Makefile @@ -0,0 +1,17 @@ +#----------------------------------------------------------------------------- +# $Id: Makefile,v 1.2 2000/11/03 16:54:52 simonmar Exp $ + +TOP=../.. +include $(TOP)/mk/boilerplate.mk + +SCRIPT_PROG = ghc-split + +INTERP=perl + +SCRIPT_SUBST_VARS := TARGETPLATFORM + +INSTALL_LIBEXEC_SCRIPTS += $(SCRIPT_PROG) + +CLEAN_FILES += $(SCRIPT_OBJS) + +include $(TOP)/mk/target.mk diff --git a/driver/split/ghc-split.lprl b/driver/split/ghc-split.lprl new file mode 100644 index 0000000000..4d159ec04f --- /dev/null +++ b/driver/split/ghc-split.lprl @@ -0,0 +1,618 @@ +%************************************************************************ +%* * +\section[Driver-obj-splitting]{Splitting into many \tr{.o} files (for libraries)} +%* * +%************************************************************************ + +\begin{code} +$TargetPlatform = $TARGETPLATFORM; + +($Pgm = $0) =~ s|.*/||; +$ifile = $ARGV[0]; +$Tmp_prefix = $ARGV[1]; +$Output = $ARGV[2]; + +&split_asm_file($ifile); + +open(OUTPUT, "> $Output") || &tidy_up_and_die(1,"$Pgm: failed to open `$Output' (to write)\n"); +print OUTPUT "$NoOfSplitFiles\n"; +close(OUTPUT); + +exit(0); +\end{code} + + +\begin{code} +sub split_asm_file { + local($asm_file) = @_; + + open(TMPI, "< $asm_file") || &tidy_up_and_die(1,"$Pgm: failed to open `$asm_file' (to read)\n"); + + &collectExports_hppa() if $TargetPlatform =~ /^hppa/; + &collectExports_mips() if $TargetPlatform =~ /^mips/; + &collectDyldStuff_darwin() if $TargetPlatform =~ /-apple-darwin/; + + $octr = 0; # output file counter + $* = 1; # multi-line matches are OK + + %LocalConstant = (); # we have to subvert C compiler's commoning-up of constants... + + $s_stuff = &ReadTMPIUpToAMarker( '', $octr ); + # that first stuff is a prologue for all .s outputs + $prologue_stuff = &process_asm_block ( $s_stuff ); + # $_ already has some of the next stuff in it... + +# &tidy_up_and_die(1,"$Pgm: no split markers in .s file!\n") +# if $prologue_stuff eq $s_stuff; + + # lie about where this stuff came from + # Note the \Q: this ignores regex meta-chars in $Tmp_prefix. + $prologue_stuff =~ s/\Q"$Tmp_prefix.c"/"$ifile_root.hc"/g; + + while ( $_ ne '' ) { # not EOF + $octr++; + + # grab and de-mangle a section of the .s file... + $s_stuff = &ReadTMPIUpToAMarker ( $_, $octr ); + $this_piece = &process_asm_block ( $s_stuff ); + + # output to a file of its own + # open a new output file... + $ofname = "${Tmp_prefix}__${octr}.s"; + open(OUTF, "> $ofname") || die "$Pgm: can't open output file: $ofname\n"; + + print OUTF $prologue_stuff; + print OUTF $this_piece; + + close(OUTF) + || &tidy_up_and_die(1,"$Pgm:Failed writing ${Tmp_prefix}__${octr}.s\n"); + } + + # Make sure that we still have some output when the input file is empty + if ( $octr == 0 ) { + $octr = 1; + $ofname = "${Tmp_prefix}__${octr}.s"; + open(OUTF, "> $ofname") || die "$Pgm: can't open output file: $ofname\n"; + + print OUTF $prologue_stuff; + + close(OUTF) + || &tidy_up_and_die(1,"$Pgm:Failed writing ${Tmp_prefix}__${octr}.s\n"); + } + + $NoOfSplitFiles = $octr; + + close(TMPI) || &tidy_up_and_die(1,"Failed reading $asm_file\n"); +} + +sub collectExports_hppa { # Note: HP-PA only + + %LocalExport = (); # NB: global table + + while(<TMPI>) { + if (/^\s+\.EXPORT\s+([^,]+),.*\n/) { + local($label) = $1; + local($body) = "\t.IMPORT $label"; + if (/,DATA/) { + $body .= ",DATA\n"; + } else { + $body .= ",CODE\n"; + } + $label =~ s/\$/\\\$/g; + $LocalExport{$label} = $body; + } + } + + seek(TMPI, 0, 0); +} + +sub collectExports_mips { # Note: MIPS only + # (not really sure this is necessary [WDP 95/05]) + + $UNDEFINED_FUNS = ''; # NB: global table + + while(<TMPI>) { + $UNDEFINED_FUNS .= $_ if /^\t\.globl\s+\S+ \.\S+\n/; + # just save 'em all + } + + seek(TMPI, 0, 0); +} + +sub collectDyldStuff_darwin { + local($chunk_label,$label,$cur_section,$section,$chunk,$alignment,$cur_alignment); + + %DyldChunks = (); # NB: global table + %DyldChunksDefined = (); # NB: global table + + $cur_section = ''; + $section = ''; + $label = ''; + $chunk = ''; + $alignment = ''; + $cur_alignment = ''; + + while ( 1 ) { + $_ = <TMPI>; + if ( $_ eq '' || /^L(_.+)\$.+:/ ) { + if ( $label ne '' ) { + $DyldChunksDefined{$label} .= $section . $alignment . $chunk_label . $ chunk; + if( $section =~ s/\.data/\.non_lazy_symbol_pointer/ ) { + $chunk = "\t.indirect_symbol $label\n\t.long 0\n"; + } + $DyldChunks{$label} .= $section . $alignment . $chunk_label . $chunk; + print STDERR "### dyld chunk: $label\n$section$alignment$chunk\n###\n" if $Dump_asm_splitting_info; + } + last if ($_ eq ''); + + $chunk = ''; + $chunk_label = $_; + $label = $1; + $section = $cur_section; + $alignment = $cur_alignment; + print STDERR "label: $label\n" if $Dump_asm_splitting_info; + } elsif ( /^\s*\.(symbol_stub|picsymbol_stub|lazy_symbol_pointer|non_lazy_symbol_pointer|data|section __IMPORT,.*)/ ) { + $cur_section = $_; + printf STDERR "section: $cur_section\n" if $Dump_asm_splitting_info; + $cur_alignment = '' + } elsif ( /^\s*\.section\s+__TEXT,__symbol_stub1,symbol_stubs,pure_instructions,\d+/ ) { + $cur_section = $_; + printf STDERR "section: $cur_section\n" if $Dump_asm_splitting_info; + # always make sure we align things + $cur_alignment = '\t.align 2' + } elsif ( /^\s*\.align.*/ ) { + $cur_alignment = $_; + printf STDERR "alignment: $cur_alignment\n" if $Dump_asm_splitting_info; + } else { + $chunk .= $_; + } + } + + seek(TMPI, 0, 0); +} + +sub ReadTMPIUpToAMarker { + local($str, $count) = @_; # already read bits + + + for ( $_ = <TMPI>; $_ ne '' && ! /_?__stg_split_marker/; $_ = <TMPI> ) { + $str .= $_; + } + # if not EOF, then creep forward until next "real" line + # (throwing everything away). + # that first "real" line will stay in $_. + + # This loop is intended to pick up the body of the split_marker function + # Note that the assembler mangler will already have eliminated this code + # if it's been invoked (which it probably has). + + while ($_ ne '' && (/_?__stg_split_marker/ + || /^L[^C].*:$/ + || /^\.stab/ + || /\t\.proc/ + || /\t\.stabd/ + || /\t\.even/ + || /\tunlk a6/ + || /^\t!#PROLOGUE/ + || /\t\.prologue/ + || /\t\.frame/ + # || /\t\.end/ NOT! Let the split_marker regexp catch it + # || /\t\.ent/ NOT! Let the split_marker regexp catch it + || /^\s+(save|retl?|restore|nop)/)) { + $_ = <TMPI>; + } + + print STDERR "### BLOCK:$count:\n$str" if $Dump_asm_splitting_info; + + # return str + $str =~ tr/\r//d if $TargetPlatform =~ /-mingw32$/; # in case Perl doesn't convert line endings + $str; +} +\end{code} + +We must (a)~strip the marker off the block, (b)~record any literal C +constants that are defined here, and (c)~inject copies of any C constants +that are used-but-not-defined here. + +\begin{code} +sub process_asm_block { + local($str) = @_; + + return(&process_asm_block_darwin($str)) + if $TargetPlatform =~ /-apple-darwin/; + return(&process_asm_block_m68k($str)) if $TargetPlatform =~ /^m68k-/; + return(&process_asm_block_sparc($str)) if $TargetPlatform =~ /^sparc-/; + return(&process_asm_block_iX86($str)) if $TargetPlatform =~ /^i[34]86-/; + return(&process_asm_block_x86_64($str)) if $TargetPlatform =~ /^x86_64-/; + 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_linux($str)) + if $TargetPlatform =~ /^powerpc-[^-]+-linux/; + + # otherwise... + &tidy_up_and_die(1,"$Pgm: no process_asm_block for $TargetPlatform\n"); +} + +sub process_asm_block_sparc { + local($str) = @_; + + # strip the marker + 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/; + } + + # 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\.?(L?LC\d+):\n(\t\.asci[iz].*\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/\t\.align .\n\.?LL?C\d+:\n(\t\.asci[iz].*\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 (sparc):\n$str" if $Dump_asm_splitting_info; + + $str; +} + +sub process_asm_block_m68k { + local($str) = @_; + + # 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/; + + # it seems prudent to stick on one of these: + $str = "\.text\n\t.even\n" . $str; + + # remove/record any literal constants defined here + while ( $str =~ /((LC\d+):\n\t\.ascii.*\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/LC\d+:\n\t\.ascii.*\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 (m68k):\n$str" if $Dump_asm_splitting_info; + + $str; +} + +sub process_asm_block_alpha { + local($str) = @_; + + # strip the marker + 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/; + } + + # remove/record any literal constants defined here + while ( $str =~ /(\.rdata\n\t\.align \d\n)?(\$(C\d+):\n\t\..*\n)/ ) { + local($label) = $3; + local($body) = $2; + + &tidy_up_and_die(1,"Local constant label $label already defined!\n") + if $LocalConstant{$label}; + + $LocalConstant{$label} = ".rdata\n\t.align 3\n" . $body . "\t.text\n"; + + $str =~ s/(\.rdata\n\t\.align \d\n)?\$C\d+:\n\t\..*\n//; + } + + # inject definitions for any local constants now used herein + foreach $k (keys %LocalConstant) { + if ( $str =~ /\$\b$k\b/ ) { + $str = $LocalConstant{$k} . $str; + } + } + + # 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; + + print STDERR "### STRIPPED BLOCK (alpha):\n$str" if $Dump_asm_splitting_info; + + $str; +} + +sub process_asm_block_iX86 { + local($str) = @_; + + # 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/; + + # it seems prudent to stick on one of these: + $str = "\.text\n\t.align 4\n" . $str; + + # remove/record any literal constants defined here + # [perl made uglier to work around the perl 5.7/5.8 bug documented at + # http://bugs6.perl.org/rt2/Ticket/Display.html?id=1760 and illustrated + # by the seg fault of perl -e '("x\n" x 5000) =~ /(.*\n)+/' + # -- ccshan 2002-09-05] + while ( ($str =~ /(\.?(LC\d+):\n(\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ )) { + local($label) = $2; + local($body) = $1; + local($prefix, $suffix, $*) = ($`, $', 0); + + &tidy_up_and_die(1,"Local constant label $label already defined!\n") + if $LocalConstant{$label}; + + while ( $suffix =~ /^((\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ ) { + $body .= $1; + $suffix = $'; + } + $LocalConstant{$label} = $body; + $str = $prefix . $suffix; + } + + # 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 (iX86):\n$str" if $Dump_asm_splitting_info; + + $str; +} +\end{code} + +\begin{code} +sub process_asm_block_x86_64 { + local($str) = @_; + + # remove/record any literal constants defined here + # [perl made uglier to work around the perl 5.7/5.8 bug documented at + # http://bugs6.perl.org/rt2/Ticket/Display.html?id=1760 and illustrated + # by the seg fault of perl -e '("x\n" x 5000) =~ /(.*\n)+/' + # -- ccshan 2002-09-05] + while ( ($str =~ /(\.?(LC\d+):\n(\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ )) { + local($label) = $2; + local($body) = $1; + local($prefix, $suffix, $*) = ($`, $', 0); + + &tidy_up_and_die(1,"Local constant label $label already defined!\n") + if $LocalConstant{$label}; + + while ( $suffix =~ /^((\t\.(ascii|string).*\n|\s*\.byte.*\n){1,100})/ ) { + $body .= $1; + $suffix = $'; + } + $LocalConstant{$label} = $body; + $str = $prefix . $suffix; + } + + # 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 (x86_64):\n$str" if $Dump_asm_splitting_info; + + $str; +} +\end{code} + +\begin{code} +sub process_asm_block_hppa { + local($str) = @_; + + # strip the marker + $str =~ s/___stg_split_marker.*\n//; + + # remove/record any imports defined here + while ( $str =~ /^(\s+\.IMPORT\s.*\n)/ ) { + $Imports .= $1; + + $str =~ s/^\s+\.IMPORT.*\n//; + } + + # remove/record any literal constants defined here + 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") + if $LocalConstant{$label}; + + $LocalConstant{$label} = "\t.SPACE \$TEXT\$\n\t.SUBSPA \$LIT\$\n\n" . $body; + + $str = $prefix . $suffix; + } + + # inject definitions for any local constants now used herein + foreach $k (keys %LocalConstant) { + if ( $str =~ /\b$k\b/ ) { + $str = $LocalConstant{$k} . $str; + } + } + + # inject required imports for local exports in other chunks + foreach $k (keys %LocalExport) { + if ( $str =~ /\b$k\b/ && ! /EXPORT\s+$k\b/ ) { + $str = $LocalExport{$k} . $str; + } + } + + # inject collected imports + + $str = $Imports . $str; + + print STDERR "### STRIPPED BLOCK (hppa):\n$str" if $Dump_asm_splitting_info; + + $str; +} +\end{code} + +\begin{code} +sub process_asm_block_mips { + local($str) = @_; + + # strip the marker + 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/; + } + + # remove/record any literal constants defined here + while ( $str =~ /(\t\.rdata\n\t\.align \d\n)?(\$(LC\d+):\n(\t\.byte\t.*\n)+)/ ) { + local($label) = $3; + local($body) = $2; + + &tidy_up_and_die(1,"Local constant label $label already defined!\n") + if $LocalConstant{$label}; + + $LocalConstant{$label} = "\t.rdata\n\t.align 2\n" . $body . "\t.text\n"; + + $str =~ s/(\t\.rdata\n\t\.align \d\n)?\$LC\d+:\n(\t\.byte\t.*\n)+//; + } + + # inject definitions for any local constants now used herein + foreach $k (keys %LocalConstant) { + if ( $str =~ /\$\b$k\b/ ) { + $str = $LocalConstant{$k} . $str; + } + } + + # 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 .= $UNDEFINED_FUNS; # pin on gratuitiously-large amount of info + + print STDERR "### STRIPPED BLOCK (mips):\n$str" if $Dump_asm_splitting_info; + + $str; +} +\end{code} + +\begin{code} +# The logic for both Darwin/PowerPC and Darwin/x86 ends up being the same. + +sub process_asm_block_darwin { + local($str) = @_; + local($dyld_stuff) = ''; + + # strip the marker + $str =~ s/___stg_split_marker.*\n//; + + $str =~ s/L_.*\$.*:\n(.|\n)*//; + + # remove/record any literal constants defined here + while ( $str =~ s/^(\s+.const.*\n\s+\.align.*\n(LC\d+):\n(\s\.(byte|short|long|fill|space|ascii).*\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; + } + + # inject definitions for any local constants now used herein + foreach $k (keys %LocalConstant) { + if ( $str =~ /\b$k(\b|\[)/ ) { + $str = $LocalConstant{$k} . $str; + } + } + + foreach $k (keys %DyldChunks) { + if ( $str =~ /\bL$k\$/ ) { + if ( $str =~ /^$k:$/ ) { + $dyld_stuff .= $DyldChunksDefined{$k}; + } else { + $dyld_stuff .= $DyldChunks{$k}; + } + } + } + + $str .= "\n" . $dyld_stuff; + + print STDERR "### STRIPPED BLOCK (darwin):\n$str" if $Dump_asm_splitting_info; + + $str; +} +\end{code} + +\begin{code} +sub process_asm_block_powerpc_linux { + local($str) = @_; + + # strip the marker + $str =~ s/__stg_split_marker.*\n//; + + # remove/record any literal constants defined here + while ( $str =~ s/^(\s+.section\s+\.rodata\n\s+\.align.*\n(\.LC\d+):\n(\s\.(byte|short|long|quad|2byte|4byte|8byte|fill|space|ascii|string).*\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; + } + + # inject definitions for any local constants now used herein + foreach $k (keys %LocalConstant) { + if ( $str =~ /[\s,]$k\b/ ) { + $str = $LocalConstant{$k} . $str; + } + } + + print STDERR "### STRIPPED BLOCK (powerpc linux):\n$str" if $Dump_asm_splitting_info; + + $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} |