+Some command-line arguments take an argument, e.g.,
+\tr{-Rmax-heapsize} expects a number to follow. This can either be
+given a part of the same argument (\tr{-Rmax-heapsize8M}) or as the
+next argument (\tr{-Rmax-heapsize 8M}). We allow both cases.
+
+Note: no error-checking; \tr{-Rmax-heapsize -Rgc-stats} will silently
+gobble the second argument (and probably set the heapsize to something
+nonsensical).
+\begin{code}
+sub grab_arg_arg {
+ local(*Args, $option, $rest_of_arg) = @_;
+
+ if ($rest_of_arg ne '') {
+ return($rest_of_arg);
+ } elsif ($#Args >= 0) {
+ local($temp) = $Args[0]; shift(@Args);
+ return($temp);
+ } else {
+ print STDERR "$Pgm: no argument following $option option\n";
+ $Status++;
+ }
+}
+\end{code}
+
+\begin{code}
+sub isntAntiFlag {
+ local($flag) = @_;
+ local($f);
+
+#Not in HsC_antiflag ## NO!: and not already in HsC_flags
+
+ foreach $f ( @HsC_antiflags ) {
+ return(0) if $flag eq $f;
+ }
+# foreach $f ( @HsC_flags ) {
+# return(0) if $flag eq $f;
+# }
+ return(1);
+}
+
+sub squashHscFlag { # pretty terrible
+ local($flag) = @_;
+ local($f);
+
+ foreach $f ( @HsC_flags ) {
+ if ($flag eq $f) { $f = ''; }
+ }
+}
+
+sub add_Hsc_flags {
+ local(@flags) = @_;
+ local($f);
+
+ foreach $f ( @flags ) {
+ push( @HsC_flags, $f ) if &isntAntiFlag($f);
+ }
+}
+\end{code}
+
+Source files may have {-# OPTIONS ... #-} pragmas at the top, containing
+command line options we want to append to collection of commands specified
+directly. @check_for_source_options@ looks at the top of a de-lit'ified Haskell
+file for any such pragmas:
+
+\begin{code}
+sub check_for_source_options {
+ local($file,$ifile) = @_;
+ local($comment_start,$comment_end);
+
+ if ($ifile =~ /\.hc$/ ||
+ $ifile =~ /_hc$/ ||
+ $ifile =~ /\.s$/ ||
+ $ifile =~ /_s$/ ) { # `Real' C intermediate
+ $comment_start = "/\\*";
+ $comment_end = "\\*/";
+ } else { # Assume it is a file containing Haskell source
+ $comment_start = "{-#";
+ $comment_end = "#-}";
+ }
+
+ open(FILE,$file) || return(1); # No big loss
+
+ while (<FILE>) {
+ if ( /^${comment_start} OPTIONS (.*)${comment_end}$/ ) {
+ # add the options found at the back of the command line.
+ local(@entries) = split(/\s+/,$1);
+ print STDERR "Found OPTIONS " . join(' ',@entries) . " in $file\n" if $Verbose;
+ push(@File_options, @entries);
+ }
+ elsif ( /^$/ ) { # ignore empty lines
+ ;
+ }
+ elsif ( /^#line.+$/ ) { # ignore comment lines (unused..ToDo: rm )
+ ;
+ }
+ elsif ( /^{-# LINE.+$/ ) { # ignore line pragmas
+ ;
+ }
+ else { # stop looking, something non-empty / not
+ # ${comment_start} OPTIONS .. ${comment_end} encountered.
+ close(FILE);return(0);
+ }
+ }
+ close(FILE);
+ return(0);
+}
+\end{code}
+
+
+We split the initial argv up into three arrays:
+
+ - @Cmd_opts
+ - @Link_file
+ - @Input_file
+
+the reason for doing so is to be able to deal
+with {-# OPTIONS #-} pragma in source files properly.
+
+\begin{code}
+sub splitCmdLine {
+ local(@args) = @_;
+
+arg: while($_ = $args[0]) {
+ shift(@args);
+ # sigh, we have to deal with these -option arg specially here.
+ /^-(tmpdir|odir|ohi|o|isuf|osuf|hisuf|hisuf-prelude|odump|syslib)$/ &&
+ do { push(@Cmd_opts, $_); push(@Cmd_opts,$args[0]); shift(@args); next arg; };
+ /^--?./ && do { push(@Cmd_opts, $_); next arg; };
+
+ if (/\.[oa]$/) {
+ push(@Link_file, $_);
+ } else {
+ push(@Input_file, $_);
+ }
+
+ # input files must exist:
+ if (! -f $_) {
+ print STDERR "$Pgm: input file doesn't exist: $_\n";
+ $Status++;
+ }
+ }
+}
+
+\end{code}
+
+When saving an intermediate file (.hc or .s) away, we
+have to prefix any OPTIONS found in the original source file.
+
+\begin{code}
+sub saveIntermediate {
+ local ($final,$suffix,$tmp)= @_ ;
+ local ($to_do);
+
+ # $final -- root of where to park ${final}.${suffix}
+ # $tmp -- temporary file where hsc put the intermediate file.
+
+ # Delete the old file
+ $to_do = "$Rm ${final}.${suffix}"; &run_something($to_do, "Removing old .${suffix} file");
+
+ if ( $#File_options >= 0 ) { # OPTIONS found in Haskell source unit
+ # Add OPTION comment to the top of the generated .${suffix} file
+ open(TEMP, "> ${final}.${suffix}") || &tidy_up_and_die(1,"Can't open ${final}.${suffix}\n");
+ print TEMP "/* OPTIONS " . join(' ',@File_options) . " */\n";
+ close(TEMP);
+ print STDERR "Prepending OPTIONS: " . join(' ',@File_options) . " to ${final}.${suffix}\n" if $Verbose;
+ }
+ $to_do = "$Cat $tmp >> ${final}.${suffix}";
+ &run_something($to_do, "Saving copy of .${suffix} file");
+
+}
+
+\end{code}
+
+
+Command-line processor
+
+\begin{code}
+sub processArgs {
+ local(@Args) = @_;
+
+# can't use getopt(s); what we want is too complicated
+
+arg: while($_ = $Args[0]) {
+ shift(@Args);
+
+ #---------- help -------------------------------------------------------
+ if (/^-\?$/ || /^--?help$/) { print $LongUsage; exit $Status; }
+
+ #-----------version ----------------------------------------------------
+ /^--version$/ && do { print STDERR "${PROJECTNAME}, version ${PROJECTVERSION}, patchlevel ${PROJECTPATCHLEVEL}\n"; exit $Status; };
+
+ #---------- verbosity and such -----------------------------------------
+ /^-v$/ && do { $Verbose = '-v'; $Time = 'time'; next arg; };
+
+ #---------- what phases are to be run ----------------------------------
+ /^-(no-)?recomp/ && do { $Do_recomp_chkr = ($1 ne '') ? 1 : 0; next arg; };
+
+ /^-cpp$/ && do { $Cpp_flag_set = 1; next arg; };
+ # change the global default:
+ # we won't run cat; we'll run the real thing
+
+ /^-C$/ && do { $Do_cc = 0; $Do_as = 0; $Do_lnkr = 0; $HscOut = '-C=';
+ next arg; };
+ # stop after generating C
+
+ /^-noC$/ && do { $HscOut = '-N='; $ProduceHi = '-nohifile=';
+ $Do_cc = 0; $Do_as = 0; $Do_lnkr = 0;
+ next arg; };
+ # leave out actual C generation (debugging) [also turns off interface gen]
+
+ /^-hi$/ && do { $HiOnStdout = 1; $ProduceHi = '-hifile='; next arg; };
+ # _do_ generate an interface; usually used as: -noC -hi
+
+ /^-nohi$/ && do { $ProduceHi = '-nohifile='; next arg; };
+ # don't generate an interface (even if generating C)
+
+ /^-hi-diffs$/ && do { $HiDiff_flag = 'normal'; next arg; };
+ /^-hi-diffs-with-usages$/ && do { $HiDiff_flag = 'usages'; next arg; };
+ /^-no-hi-diffs$/ && do { $HiDiff_flag = ''; next arg; };
+ /^-keep-hi-diffs$/ && do { $Keep_HiDiffs = 1; next arg; };
+
+ # show/disable diffs if the interface file changes
+
+ /^-E$/ && do { push(@CcBoth_flags, '-E');
+ $Only_preprocess_C = 1;
+ $Do_as = 0; $Do_lnkr = 0; next arg; };
+ # stop after preprocessing C
+ /^-M$/ && do { $Only_generate_deps = 1; $Do_as = 0; $Do_lnkr = 0; next arg; };
+ # only generate dependency information.
+ /^-S$/ && do { $Do_as = 0; $Do_lnkr = 0; next arg; };
+ # stop after generating assembler
+
+ /^-c$/ && do { $Do_lnkr = 0; next arg; };
+ # stop after generating .o files
+
+ /^-link-chk$/ && do { $LinkChk = 1; next arg; };
+ /^-no-link-chk$/ && do { $LinkChk = 0; next arg; };
+ # don't do consistency-checking after a link
+
+ /^-tmpdir$/ && do { $Tmp_prefix = &grab_arg_arg(*Args,'-tmpdir', '');
+ $Tmp_prefix = "$Tmp_prefix/ghc$$";
+ $ENV{'TMPDIR'} = $Tmp_prefix; # for those who use it...
+ next arg; };
+ # use an alternate directory for temp files
+
+ #---------- redirect output --------------------------------------------
+
+ # -o <file>; applies to the last phase, whatever it is
+ # "-o -" sends it to stdout
+ # if <file> has a directory component, that dir must already exist
+
+ /^-odir$/ && do { $Specific_output_dir = &grab_arg_arg(*Args,'-odir', '');
+ #
+ # Hack, of the worst sort: don't do validation of
+ # odir argument if you're using -M (dependency generation).
+ #
+ if ( ! $Only_generate_deps && ! -d $Specific_output_dir) {
+ print STDERR "$Pgm: -odir: no such directory: $Specific_output_dir\n";
+ $Status++;
+ }
+ next arg; };
+
+ /^-o$/ && do { $Specific_output_file = &grab_arg_arg(*Args,'-o', '');
+ if ($Specific_output_file ne '-'
+ && $Specific_output_file =~ /(.*)\/[^\/]*$/) {
+ local($dir_part) = $1;
+ if (! -d $dir_part) {
+ print STDERR "$Pgm: no such directory: $dir_part\n";
+ $Status++;
+ }
+ }
+ next arg; };
+
+ # NB: -isuf not documented yet (because it doesn't work yet)
+ /^-isuf$/ && do { $Isuffix = &grab_arg_arg(*Args,'-isuf', '');
+ if ($Isuffix =~ /\./ ) {
+ print STDERR "$Pgm: -isuf suffix shouldn't contain a .\n";
+ $Status++;
+ }
+ next arg; };
+
+ /^-osuf$/ && do { $Osuffix = &grab_arg_arg(*Args,'-osuf', '');
+ if ($Osuffix =~ /\./ ) {
+ print STDERR "$Pgm: -osuf suffix shouldn't contain a .\n";
+ $Status++;
+ }
+ next arg; };
+
+ # -ohi <file>; send the interface to <file>; "-ohi -" to send to stdout
+ /^-ohi$/ && do { $Specific_hi_file = &grab_arg_arg(*Args,'-ohi', '');
+ if ($Specific_hi_file ne '-'
+ && $Specific_hi_file =~ /(.*)\/[^\/]*$/) {
+ local($dir_part) = $1;
+ if (! -d $dir_part) {
+ print STDERR "$Pgm: no such directory: $dir_part\n";
+ $Status++;
+ }
+ }
+ next arg; };
+
+ # The suffix to use when looking for interface files
+ /^-hisuf$/ && do { $HiSuffix = &grab_arg_arg(*Args,'-hisuf', '');
+ if ($HiSuffix =~ /\./ ) {
+ print STDERR "$Pgm: -hisuf suffix shouldn't contain a .\n";
+ $Status++;
+ }
+ next arg; };
+ # ToDo: remove, not a `normal' user thing to do (should be automatic)
+ /^-hisuf-prelude$/ && do { $HiSuffix_prelude = &grab_arg_arg(*Args,'-hisuf-prelude', '');
+ if ($HiSuffix =~ /\./ ) {
+ print STDERR "$Pgm: -hisuf-prelude suffix shouldn't contain a .\n";
+ $Status++;
+ }
+ next arg; };
+ /^-odump$/ && do { $Specific_dump_file = &grab_arg_arg(*Args,'-odump', '');
+ if ($Specific_dump_file =~ /(.*)\/[^\/]*$/) {
+ local($dir_part) = $1;
+ if (! -d $dir_part) {
+ print STDERR "$Pgm: no such directory: $dir_part\n";
+ $Status++;
+ }
+ }
+ next arg; };
+
+ #-------------- scc & Profiling Stuff ----------------------------------
+
+ /^-prof$/ && do { $PROFing = 'p'; next arg; }; # profiling -- details later!
+
+ /^-auto/ && do {
+ # generate auto SCCs on top level bindings
+ # -auto-all = all top level bindings
+ # -auto = only top level exported bindings
+ $PROFauto = ( /-all/ )
+ ? '-fauto-sccs-on-all-toplevs'
+ : '-fauto-sccs-on-exported-toplevs';
+ next arg; };
+
+ /^-caf-all/ && do { # generate individual CAF SCC annotations
+ $PROFcaf = '-fauto-sccs-on-individual-cafs';
+ next arg; };
+
+ /^-ignore-scc$/ && do {
+ # forces ignore of scc annotations even if profiling
+ $PROFignore_scc = '-W';
+ next arg; };
+
+ /^-G(.*)$/ && do { push(@HsC_flags, "-G=$1"); # set group for cost centres
+ next arg; };
+
+ /^-unprof-scc-auto/ && do {
+ # generate auto SCCs on top level bindings when not profiling.
+ # Used to measure optimisation effects of presence of sccs.
+ $UNPROFscc_auto = ( /-all/ )
+ ? '-fauto-sccs-on-all-toplevs'
+ : '-fauto-sccs-on-exported-toplevs';
+ next arg; };
+
+ #--------- ticky/concurrent/parallel -----------------------------------
+ # we sort out the details a bit later on
+
+ /^-concurrent$/ && do { $CONCURing = 'c'; next arg; }; # concurrent Haskell
+ /^-gransim$/ && do { $GRANing = 'g'; next arg; }; # GranSim
+ /^-ticky$/ && do { $TICKYing = 't'; next arg; }; # ticky-ticky
+ /^-parallel$/ && do { $PARing = 'p'; next arg; }; # parallel Haskell
+
+ #-------------- "user ways" --------------------------------------------
+
+ (/^-user-setup-([a-oA-Z])$/ ) &&
+ do {
+ /^-user-setup-([a-oA-Z])$/ && do { $BuildTag = "_$1"; };
+
+ local($stuff) = $UserSetupOpts{$BuildTag};
+ local(@opts) = split(/\s+/, $stuff);
+
+ # feed relevant ops into the arg-processing loop (if any)
+ unshift(@Args, @opts) if $#opts >= 0;
+
+ next arg; };
projects / ghc-hetmet.git / blobdiff