ghc/driver/ghc.lprl

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 % *** MSUB does some substitutions here ***
   5 % *** grep for $( ***
   6 %
   7
   8 This is the driver script for the Glasgow Haskell compilation system.
   9 It is written in \tr{perl}.  The first section includes a long
  10 ``usage'' message that describes how the driver is supposed to work.
  11
  12 %************************************************************************
  13 %*                                                                      *
  14 \section[Driver-usage]{Usage message}
  15 %*                                                                      *
  16 %************************************************************************
  17
  18 \begin{code}
  19 ($Pgm = $0) =~ s|.*/||;
  20 $ShortUsage  =  "\nUsage: For basic information, try the `-help' option.\n";
  21 $LongUsage = "\n" . <<EOUSAGE;
  22 Use of the Glorious Haskell Compilation System driver:
  23
  24     $Pgm [command-line-options-and-input-files]
  25
  26 ------------------------------------------------------------------------
  27 This driver ($Pgm) guides each input file through (some of the)
  28 possible phases of a compilation:
  29
  30     - unlit:    extract code from a "literate program"
  31     - hscpp:    run code through the C pre-processor (if -cpp flag given)
  32     - hsc:      run the Haskell compiler proper
  33     - gcc:      run the C compiler (if compiling via C)
  34     - as:       run the Unix assembler
  35     - ld:       run the Unix linker
  36
  37 For each input file, the phase to START with is determined by the
  38 file's suffix:
  39     - .lhs      literate Haskell: lit2pgm
  40     - .hs       illiterate Haskell: hsp
  41     - .hc       C from the Haskell compiler: gcc
  42     - .c        C not from the Haskell compiler: gcc
  43     - .s        assembly language: as
  44     - other     passed directly to the linker: ld
  45
  46 If no files are given on the command line, input is taken from
  47 standard input, and processing is as for an .hs file.  (All output is
  48 to stdout or stderr, however).
  49
  50 The phase at which to STOP processing is determined by a command-line
  51 option:
  52     -C          stop after generating C (.hc output)
  53     -E          stop after generating preprocessed C (.i output)
  54     -S          stop after generating assembler (.s output)
  55     -c          stop after generating object files (.o output)
  56
  57 Other commonly-used options are:
  58
  59     -O          An `optimising' package of options, to produce faster code
  60
  61     -prof       Compile for cost-centre profiling
  62                 (add -auto for automagic cost-centres on top-level functions)
  63
  64     -fglasgow-exts  Allow Glasgow extensions (unboxed types, etc.)
  65
  66     -H14m       Increase compiler's heap size
  67
  68 The User's Guide has more information about GHC's *many* options.
  69
  70 Given the above, here are some TYPICAL invocations of $Pgm:
  71
  72     # compile a Haskell module to a .o file, optimising:
  73     % $Pgm -c -O Foo.hs
  74     # compile a Haskell module to C (a .hc file), using a bigger heap:
  75     % $Pgm -C -H16m Foo.hs
  76     # compile Haskell-produced C (.hc) to assembly language:
  77     % $Pgm -S Foo.hc
  78     # link three .o files into an executable called "test":
  79     % $Pgm -o test Foo.o Bar.o Baz.o
  80 ------------------------------------------------------------------------
  81 EOUSAGE
  82 \end{code}
  83
  84 %************************************************************************
  85 %*                                                                      *
  86 \section[Driver-init]{Initialisation}
  87 %*                                                                      *
  88 %************************************************************************
  89
  90 Establish what executables to run for the various phases (all the
  91 \tr{$(FOO)} make-variables are \tr{msub}bed for from the
  92 \tr{Makefile}), what the default options are for those phases, and
  93 other similar boring stuff.
  94 \begin{code}
  95 select(STDERR); $| = 1; select(STDOUT); # no STDERR buffering, please.
  96
  97 $HostPlatform   = '$(HOSTPLATFORM)';
  98 $TargetPlatform = '$(TARGETPLATFORM)';
  99
 100 #------------------------------------------------------------------------
 101 # If you are adjusting paths by hand for a binary GHC distribution,
 102 # de-commenting the line to set GLASGOW_HASKELL_ROOT should do.
 103 # Or you can leave it as is, and set the environment variable externally.
 104 #------------------------------------------------------------------------
 105 # $ENV{'GLASGOW_HASKELL_ROOT'} = '/some/absolute/path/name';
 106
 107 if (! $ENV{'GLASGOW_HASKELL_ROOT'}) { # good -- death to environment variables
 108     $TopPwd         = '$(TOP_PWD)';
 109     $InstLibDirGhc  = '$(INSTLIBDIR_GHC)';
 110     $InstDataDirGhc = '$(INSTDATADIR_GHC)';
 111 } else {
 112     $TopPwd = $ENV{'GLASGOW_HASKELL_ROOT'};
 113
 114     if ( '$(INSTLIBDIR_GHC)' =~ /^\/(local\/fp|usr\/local)(\/.*)/ ) {
 115         $InstLibDirGhc  = $ENV{'GLASGOW_HASKELL_ROOT'} . $2;
 116     } else {
 117         print STDERR "GLASGOW_HASKELL_ROOT environment variable is set;\nBut can't untangle $(INSTLIBDIR_GHC).\n(Installation error)\n";
 118         exit(1);
 119     }
 120
 121     if ( '$(INSTDATADIR_GHC)' =~ /\/(local\/fp|usr\/local)(\/.*)/ ) {
 122         $InstDataDirGhc = $ENV{'GLASGOW_HASKELL_ROOT'} . $2;
 123     } else {
 124         print STDERR "GLASGOW_HASKELL_ROOT environment variable is set;\nBut can't untangle $(INSTDATADIR_GHC).\n(Installation error)\n";
 125         exit(1);
 126     }
 127 }
 128
 129 $Status  = 0; # just used for exit() status
 130 $Verbose = '';
 131 $CoreLint = '';
 132 $Time = '';     # ToDo: mkworld-ize the timing command
 133
 134 # set up signal handler
 135 sub quit_upon_signal { &tidy_up_and_die(1, ''); }
 136 $SIG{'INT'}  = 'quit_upon_signal';
 137 $SIG{'QUIT'} = 'quit_upon_signal';
 138
 139 # where to get "require"d .prl files at runtime (poor man's dynamic loading)
 140 #   (use LIB, not DATA, because we can't be sure of arch-independence)
 141 @INC = ( ( $(INSTALLING) ) ? "$InstLibDirGhc"
 142                            : "$TopPwd/$(CURRENT_DIR)" );
 143
 144 if ( $ENV{'TMPDIR'} ) { # where to make tmp file names
 145     $Tmp_prefix = ($ENV{'TMPDIR'} . "/ghc$$");
 146 } else {
 147     $Tmp_prefix ="$(TMPDIR)/ghc$$";
 148     $ENV{'TMPDIR'} = '$(TMPDIR)'; # set the env var as well
 149 }
 150
 151 @Files_to_tidy = (); # files we nuke in the case of abnormal termination
 152
 153 $Unlit = ( $(INSTALLING) ) ? "$InstLibDirGhc/unlit"
 154                              : "$TopPwd/$(CURRENT_DIR)/$(GHC_UNLIT)";
 155 @Unlit_flags    = ();
 156
 157 $Cat     = "cat";
 158
 159 $HsCpp   = # but this is re-set to "cat" (after options) if -cpp not seen
 160            ( $(INSTALLING) ) ? "$InstLibDirGhc/hscpp"
 161                              : "$TopPwd/$(CURRENT_DIR)/$(GHC_HSCPP)";
 162 @HsCpp_flags    = ();
 163
 164 $HsP     = ( $(INSTALLING) ) ? "$InstLibDirGhc/hsp"
 165                              : "$TopPwd/$(CURRENT_DIR)/$(GHC_HSP)";
 166 @HsP_flags = ();
 167
 168 $HsC     = ( $(INSTALLING) ) ? "$InstLibDirGhc/hsc"
 169                              : "$TopPwd/$(CURRENT_DIR)/$(GHC_HSC)";
 170
 171 $SysMan  = ( $(INSTALLING) ) ? "$InstLibDirGhc/SysMan"
 172                              : "$TopPwd/$(CURRENT_DIR)/$(GHC_SYSMAN)";
 173
 174 # HsC_rts_flags: if we want to talk to the LML runtime system
 175 # NB: we don't use powers-of-2 sizes, because this may do
 176 #   terrible things to cache behavior.
 177 $Specific_heap_size = 6 * 1000 * 1000;
 178 $Specific_stk_size  = 1000 * 1000;
 179 $Scale_sizes_by = 1.0;
 180 $RTS_style = $(GHC_RTS_STYLE);
 181 @HsC_rts_flags = ();
 182
 183 @HsC_flags      = ();
 184 @HsC_antiflags  = ();
 185 \end{code}
 186
 187 The optimisations/etc to be done by the compiler are {\em normally}
 188 expressed with a \tr{-O} (or \tr{-O2}) flag, or by its absence.
 189
 190 \begin{code}
 191 $OptLevel = 0;      # no -O == 0; -O == 1; -O2 == 2; -Ofile == 3
 192 $MinusO2ForC = 0;   # set to 1 if -O2 should be given to C compiler
 193 $StolenX86Regs = 5; # **HACK*** of the very worst sort
 194 $SpX86Mangling = 1; # **EXTREME HACK*** of an even worse sort
 195 \end{code}
 196
 197 These variables represent parts of the -O/-O2/etc ``templates,''
 198 which are filled in later, using these.
 199 These are the default values, which may be changed by user flags.
 200 \begin{code}
 201 $Oopt_UnfoldingUseThreshold     = '-fsimpl-uf-use-threshold3';
 202 $Oopt_MaxSimplifierIterations   = '-fmax-simplifier-iterations4';
 203 $Oopt_PedanticBottoms           = '-fpedantic-bottoms'; # ON by default
 204 $Oopt_MonadEtaExpansion         = '';
 205 #OLD:$Oopt_LambdaLift           = '';
 206 $Oopt_AddAutoSccs               = '';
 207 $Oopt_FinalStgProfilingMassage  = '';
 208 $Oopt_SpecialiseUnboxed         = '';
 209 $Oopt_FoldrBuild                = 1; # On by default!
 210 $Oopt_FB_Support                = '-fdo-new-occur-anal -fdo-arity-expand';
 211 #$Oopt_FoldrBuildWW             = 0; # Off by default
 212 \end{code}
 213
 214 Things to do with C compilers/etc:
 215 \begin{code}
 216 $CcUnregd       = '$(GHC_DEBUG_HILEV_ASM)'; # our high-level assembler (non-optimising)
 217 $CcRegd         = '$(GHC_OPT_HILEV_ASM)';   # our high-level assembler (optimising)
 218 $GccAvailable   = $(GHC_GCC_IS_AVAILABLE);  # whether GCC avail or not for optimising
 219
 220 @CcBoth_flags   = ('-S');   # flags for *any* C compilation
 221 @CcInjects      = ();
 222
 223 # non-registerizing flags: those for all files, those only for .c files; those only for .hc files
 224 @CcUnregd_flags   = ( $GccAvailable ) ? ('-ansi', '-pedantic') : ();
 225 @CcUnregd_flags_c = ();
 226 @CcUnregd_flags_hc= ();
 227
 228 # ditto; but for registerizing (we must have GCC for this)
 229 @CcRegd_flags    = ('-ansi', '-D__STG_GCC_REGS__', '-D__STG_TAILJUMPS__');
 230 @CcRegd_flags_c = ();
 231 @CcRegd_flags_hc = ();
 232
 233 $As             = ''; # assembler is normally the same pgm as used for C compilation
 234 @As_flags       = ();
 235
 236 $Lnkr           = ''; # linker is normally the same pgm as used for C compilation
 237
 238 # 'nm' is used for consistency checking (ToDo: mk-world-ify)
 239 # ToDo: check the OS or something ("alpha" is surely not the crucial question)
 240 $Nm = ($TargetPlatform =~ /^alpha-/) ? 'nm -B' : 'nm';
 241 \end{code}
 242
 243 What options \tr{-user-setup-a} turn into (user-defined ``packages''
 244 of options).  Note that a particular user-setup implies a particular
 245 Prelude ({\em including} its interface file(s)).
 246 \begin{code}
 247 $BuildTag       = ''; # default is sequential build w/ Appel-style GC
 248
 249 %BuildAvail     = ('',      '$(GHC_BUILD_FLAG_normal)',
 250                    '_p',    '$(GHC_BUILD_FLAG_p)',
 251                    '_t',    '$(GHC_BUILD_FLAG_t)',
 252                    '_u',    '$(GHC_BUILD_FLAG_u)',
 253                    '_mc',   '$(GHC_BUILD_FLAG_mc)',
 254                    '_mr',   '$(GHC_BUILD_FLAG_mr)',
 255                    '_mt',   '$(GHC_BUILD_FLAG_mt)',
 256                    '_mp',   '$(GHC_BUILD_FLAG_mp)',
 257                    '_mg',   '$(GHC_BUILD_FLAG_mg)',
 258                    '_2s',   '$(GHC_BUILD_FLAG_2s)',
 259                    '_1s',   '$(GHC_BUILD_FLAG_1s)',
 260                    '_du',   '$(GHC_BUILD_FLAG_du)',
 261                    '_a',    '$(GHC_BUILD_FLAG_a)',
 262                    '_b',    '$(GHC_BUILD_FLAG_b)',
 263                    '_c',    '$(GHC_BUILD_FLAG_c)',
 264                    '_d',    '$(GHC_BUILD_FLAG_d)',
 265                    '_e',    '$(GHC_BUILD_FLAG_e)',
 266                    '_f',    '$(GHC_BUILD_FLAG_f)',
 267                    '_g',    '$(GHC_BUILD_FLAG_g)',
 268                    '_h',    '$(GHC_BUILD_FLAG_h)',
 269                    '_i',    '$(GHC_BUILD_FLAG_i)',
 270                    '_j',    '$(GHC_BUILD_FLAG_j)',
 271                    '_k',    '$(GHC_BUILD_FLAG_k)',
 272                    '_l',    '$(GHC_BUILD_FLAG_l)',
 273                    '_m',    '$(GHC_BUILD_FLAG_m)',
 274                    '_n',    '$(GHC_BUILD_FLAG_n)',
 275                    '_o',    '$(GHC_BUILD_FLAG_o)' );
 276
 277 %BuildDescr     = ('',      'normal sequential',
 278                    '_p',    'profiling',
 279                    '_t',    'ticky-ticky profiling',
 280                    '_t',    'unregisterized (using portable C only)',
 281                    '_mc',   'concurrent',
 282                    '_mr',   'profiled concurrent',
 283                    '_mt',   'ticky concurrent',
 284                    '_mp',   'parallel',
 285                    '_mg',   'GranSim',
 286                    '_2s',   '2-space GC',
 287                    '_1s',   '1-space GC',
 288                    '_du',   'dual-mode GC',
 289                    '_a',    'user way a',
 290                    '_b',    'user way b',
 291                    '_c',    'user way c',
 292                    '_d',    'user way d',
 293                    '_e',    'user way e',
 294                    '_f',    'user way f',
 295                    '_g',    'user way g',
 296                    '_h',    'user way h',
 297                    '_i',    'user way i',
 298                    '_j',    'user way j',
 299                    '_k',    'user way k',
 300                    '_l',    'user way l',
 301                    '_m',    'user way m',
 302                    '_n',    'user way n',
 303                    '_o',    'user way o' );
 304
 305 # these are options that are "fed back" through the option processing loop
 306 %UserSetupOpts  = ('_a', '$(GHC_BUILD_OPTS_a)',
 307                    '_b', '$(GHC_BUILD_OPTS_b)',
 308                    '_c', '$(GHC_BUILD_OPTS_c)',
 309                    '_d', '$(GHC_BUILD_OPTS_d)',
 310                    '_e', '$(GHC_BUILD_OPTS_e)',
 311                    '_f', '$(GHC_BUILD_OPTS_f)',
 312                    '_g', '$(GHC_BUILD_OPTS_g)',
 313                    '_h', '$(GHC_BUILD_OPTS_h)',
 314                    '_i', '$(GHC_BUILD_OPTS_i)',
 315                    '_j', '$(GHC_BUILD_OPTS_j)',
 316                    '_k', '$(GHC_BUILD_OPTS_k)',
 317                    '_l', '$(GHC_BUILD_OPTS_l)',
 318                    '_m', '$(GHC_BUILD_OPTS_m)',
 319                    '_n', '$(GHC_BUILD_OPTS_n)',
 320                    '_o', '$(GHC_BUILD_OPTS_o)',
 321
 322                    # the GC ones don't have any "fed back" options
 323                    '_2s', '',
 324                    '_1s', '',
 325                    '_du', '' );
 326
 327 # per-build code fragments which are eval'd
 328 %EvaldSetupOpts = ('',      '', # this one must *not* be set!
 329
 330                             # profiled sequential
 331                    '_p',    'push(@HsC_flags,  \'-fscc-profiling\');
 332                              push(@CcBoth_flags, \'-DUSE_COST_CENTRES\');',
 333
 334                             # ticky-ticky sequential
 335                    '_t',    'push(@HsC_flags, \'-fstg-reduction-counts\');
 336                              push(@CcBoth_flags, \'-DDO_REDN_COUNTING\');',
 337
 338                             # unregisterized (ToDo????)
 339                    '_u',    '',
 340
 341                             # concurrent
 342                    '_mc',   '$StkChkByPageFaultOK = 0;
 343                              push(@HsC_flags,  \'-fconcurrent\');
 344                              push(@HsCpp_flags,\'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\');
 345                              push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\');',
 346
 347                             # profiled concurrent
 348                    '_mr',   '$StkChkByPageFaultOK = 0;
 349                              push(@HsC_flags,  \'-fconcurrent\', \'-fscc-profiling\');
 350                              push(@HsCpp_flags,\'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\');
 351                              push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DUSE_COST_CENTRES\');',
 352
 353                             # ticky-ticky concurrent
 354                    '_mt',   '$StkChkByPageFaultOK = 0;
 355                              push(@HsC_flags,  \'-fconcurrent\', \'-fstg-reduction-counts\');
 356                              push(@HsCpp_flags,\'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\');
 357                              push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DDO_REDN_COUNTING\');',
 358
 359                             # parallel
 360                    '_mp',   '$StkChkByPageFaultOK = 0;
 361                              push(@HsC_flags,  \'-fconcurrent\');
 362                              push(@HsCpp_flags,\'-D__PARALLEL_HASKELL__\',   \'-DPAR\');
 363                              push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DPAR\', \'-DGUM\');',
 364
 365                             # GranSim
 366                    '_mg',   '$StkChkByPageFaultOK = 0;
 367                              push(@HsC_flags,  \'-fconcurrent\');
 368 #????????????                push(@HsCpp_flags,\'-D__PARALLEL_HASKELL__\',   \'-DPAR\');
 369                              push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DGRAN\');',
 370
 371                    '_2s',   'push (@CcBoth_flags, \'-DGC2s\');',
 372                    '_1s',   'push (@CcBoth_flags, \'-DGC1s\');',
 373                    '_du',   'push (@CcBoth_flags, \'-DGCdu\');',
 374
 375                    '_a',    '', # these user-way guys should not be set!
 376                    '_b',    '',
 377                    '_c',    '',
 378                    '_d',    '',
 379                    '_e',    '',
 380                    '_f',    '',
 381                    '_g',    '',
 382                    '_h',    '',
 383                    '_i',    '',
 384                    '_j',    '',
 385                    '_k',    '',
 386                    '_l',    '',
 387                    '_m',    '',
 388                    '_n',    '',
 389                    '_o',    '' );
 390 \end{code}
 391
 392 Import/include directories (\tr{-I} options) are sufficiently weird to
 393 require special handling.
 394 \begin{code}
 395 @Import_dir     = ('.'); #-i things
 396 @Include_dir    = ('.'); #-I things; other default(s) stuck on AFTER option processing
 397
 398 @SysImport_dir  = ( $(INSTALLING) )
 399                     ? ( "$InstDataDirGhc/imports" )
 400                     : ( "$TopPwd/$(CURRENT_DIR)/$(GHC_LIBSRC)/prelude"
 401                       );
 402
 403 $ghc_version_info = $(PROJECTVERSION) * 100;
 404 $haskell1_version = 2; # i.e., Haskell 1.2
 405 @Cpp_define     = ();
 406
 407 @UserLibrary_dir= ();   #-L things;...
 408 @UserLibrary    = ();   #-l things asked for by the user
 409
 410 @SysLibrary_dir = ( ( $(INSTALLING) )   #-syslib things supplied by the system
 411                     ? "$InstLibDirGhc"
 412                     : ("$TopPwd/$(CURRENT_DIR)/$(GHC_RUNTIMESRC)",
 413                        "$TopPwd/$(CURRENT_DIR)/$(GHC_RUNTIMESRC)/gmp",
 414                        "$TopPwd/$(CURRENT_DIR)/$(GHC_LIBSRC)")
 415                   );
 416 @SysLibrary = ( '-lHS' );       # basic I/O and prelude stuff
 417
 418 $TopClosureFile # defaults to 1.2 one; will be mangled later
 419         = ( $(INSTALLING) ) ? "$InstLibDirGhc/TopClosureXXXX.o"
 420                             : "$TopPwd/$(CURRENT_DIR)/$(GHC_RUNTIMESRC)/main/TopClosureXXXX.o";
 421 \end{code}
 422
 423 We are given a list of files with various presumably-known suffixes
 424 (unknown-suffix files go straight to the linker).  For each file, we
 425 begin by assuming that we'll run every phase over it.  However: (1)
 426 global flags (\tr{-c}, \tr{-S}, etc.) tell us not to run any phase
 427 past a certain point; and (2) the file's suffix tells us what phase to
 428 start with.  Linking is weird and kept track of separately.
 429
 430 Here are the initial defaults applied to all files:
 431 \begin{code}
 432 $Do_lit2pgm = 1;
 433 $Do_hscpp   = 1;        # but we run 'cat' by default (see after arg check)
 434 $Cpp_flag_set = 0;      # (hack)
 435 $Only_preprocess_C = 0; # pretty hackish
 436 $ProduceHi  = 1;        # but beware magical value "2"! (hack)
 437 $PostprocessCcOutput = 0;
 438 $HiDiff_flag= 0;
 439
 440 # native code-gen or via C?
 441 $HaveNativeCodeGen = $(GHC_WITH_NATIVE_CODEGEN);
 442 $ProduceS = '';
 443 if ($HaveNativeCodeGen) {
 444     if ($TargetPlatform =~ /^(alpha|sparc)-/) {
 445         $ProduceS = $TargetPlatform;
 446     }
 447 }
 448 $ProduceC = ($ProduceS) ? 0 : 1;
 449
 450 $CollectingGCstats = 0;
 451 $CollectGhcTimings = 0;
 452 $RegisteriseC  = '';    # set to 'o', if using optimised C code (only if avail)
 453                         #   or if generating equiv asm code
 454 $DEBUGging = '';        # -DDEBUG and all that it entails (um... not really)
 455 $PROFing = '';          # set to p or e if profiling
 456 $PROFaging = '';        # set to a if profiling with age -- only for cc consistency
 457 $PROFgroup = '';        # set to group if an explicit -Ggroup specified
 458 $PROFauto = '';         # set to relevant hsc flag if -auto or -auto-all
 459 $PROFcaf  = '';         # set to relevant hsc flag if -caf-all
 460 #UNUSED:$PROFdict  = '';        # set to relevant hsc flag if -dict-all
 461 $PROFignore_scc = '';   # set to relevant parser flag if explicit sccs ignored
 462 $TICKYing = '';         # set to t if compiling for ticky-ticky profiling
 463 $PARing = '';           # set to p if compiling for PAR (ie GUM)
 464 $CONCURing = '';        # set to c if compiling for CONCURRENT
 465 $GRANing = '';          # set to g if compiling for GRAN
 466 $StkChkByPageFaultOK = 1; # may be set to 0 (false) for some builds
 467 $Specific_output_dir = '';      # set by -odir <dir>
 468 $Specific_output_file = '';     # set by -o <file>; "-" for stdout
 469 $Specific_hi_file = '';         # set by -ohi <file>; "-" for stdout
 470 $Specific_dump_file = '';       # set by -odump <file>; "-" for stdout
 471 $Using_dump_file = 0;
 472 $Osuffix    = '.o';
 473 $HiSuffix   = '.hi';
 474 $Do_hsp     = 2;    # 1 for "old" parser; 2 for "new" parser (in hsc)
 475 $Do_hsc     = 1;
 476 $Do_cc      = -1;   # a MAGIC indeterminate value; will be set to 1 or 0.
 477 $Do_as      = 1;
 478 $Do_lnkr    = 1;
 479 $Keep_hc_file_too = 0;
 480 $Keep_s_file_too = 0;
 481 $CompilingPrelude = 0;
 482 $SplitObjFiles = 0;
 483 $NoOfSplitFiles = 0;
 484 $Dump_parser_output = 0;
 485 $Dump_raw_asm = 0;
 486 $Dump_asm_insn_counts = 0;
 487 $Dump_asm_globals_info = 0;
 488 $Dump_asm_splitting_info = 0;
 489
 490 # and the list of files
 491 @Input_file = ();
 492
 493 # and files to be linked...
 494 @Link_file  = ();
 495 \end{code}
 496
 497 We inject consistency-checking information into \tr{.hc} files (both
 498 when created by the Haskell compiler and when compiled by the C
 499 compiler), so that we can check that an executable is made from
 500 consistently-built pieces.  (The check is normally done just after
 501 linking.)  The checking is done by introducing/munging
 502 \tr{what(1)}-style strings.  Anyway, here are the relevant global
 503 variables and their defaults:
 504 \begin{code}
 505 $LinkChk = 1;   # set to 0 if the link check should *not* be done
 506
 507 # major & minor version numbers; major numbers must always agree;
 508 # minor disagreements yield a warning.
 509 $HsC_major_version = 29;
 510 $HsC_minor_version = 0;
 511 $Cc_major_version  = 33;
 512 $Cc_minor_version  = 0;
 513
 514 # options: these must always agree
 515 $HsC_consist_options = '';    # we record, in this order:
 516                               #     Build tag; debugging?
 517 $Cc_consist_options  = '';    # we record, in this order:
 518                               #     Build tag; debugging? registerised?
 519 \end{code}
 520
 521 %************************************************************************
 522 %*                                                                      *
 523 \section[Driver-parse-argv]{Munge the command-line options}
 524 %*                                                                      *
 525 %************************************************************************
 526
 527 Now slurp through the arguments.
 528 \begin{code}
 529 # can't use getopt(s); what we want is too complicated
 530 arg: while($_ = $ARGV[0]) {
 531     shift(@ARGV);
 532
 533     #---------- help -------------------------------------------------------
 534     if (/^-\?$/ || /^-help$/) { print $LongUsage; exit $Status; }
 535
 536     #---------- verbosity and such -----------------------------------------
 537     /^-v$/          && do { $Verbose = '-v'; $Time = 'time'; next arg; };
 538
 539     #---------- what phases are to be run ----------------------------------
 540     /^-cpp$/        && do { $Cpp_flag_set = 1; next arg; };
 541     # change the global default:
 542     # we won't run cat; we'll run the real thing
 543
 544     /^-C$/          && do { $Do_cc = 0; $Do_as = 0; $Do_lnkr = 0;
 545                             $ProduceC = 1; $ProduceS = '';
 546                             next arg; };
 547     # stop after generating C
 548
 549     /^-noC$/        && do { $ProduceC = 0; $ProduceS = ''; $ProduceHi = 0;
 550                             $Do_cc = 0; $Do_as = 0; $Do_lnkr = 0;
 551                             next arg; };
 552     # leave out actual C generation (debugging) [also turns off interface gen]
 553
 554     /^-hi$/         && do { $ProduceHi = 2; next arg; };
 555     # _do_ generate an interface; usually used as: -noC -hi
 556     # NB: magic value "2" for $ProduceHi (hack)
 557
 558     /^-nohi$/       && do { $ProduceHi = 0; next arg; };
 559     # don't generate an interface (even if generating C)
 560
 561     /^-hi-diffs$/   && do { $HiDiff_flag = 1; next arg; };
 562     # show diffs if the interface file changes
 563
 564     /^-E$/          && do { push(@CcBoth_flags, '-E');
 565                             $Only_preprocess_C = 1;
 566                             $Do_as = 0; $Do_lnkr = 0; next arg; };
 567     # stop after preprocessing C
 568
 569     /^-S$/          && do { $Do_as = 0; $Do_lnkr = 0; next arg; };
 570     # stop after generating assembler
 571
 572     /^-c$/          && do { $Do_lnkr = 0; next arg; };
 573     # stop after generating .o files
 574
 575     /^-link-chk$/    && do { $LinkChk = 1; next arg; };
 576     /^-no-link-chk$/ && do { $LinkChk = 0; next arg; };
 577     # don't do consistency-checking after a link
 578
 579     # generate code for a different target architecture; e.g., m68k
 580     # ToDo: de-Glasgow-ize & probably more...
 581 # OLD:
 582 #    /^-target$/ && do { $TargetPlatform = &grab_arg_arg('-target', '');
 583 #                        if ($TargetPlatform ne $HostPlatform) {
 584 #                           if ( $TargetPlatform =~ /^m68k-/ ) {
 585 #                               $CcUnregd = $CcRegd = 'gcc-m68k';
 586 #                           } else {
 587 #                               print STDERR "$Pgm: Can't handle -target $TargetPlatform\n";
 588 #                               $Status++;
 589 #                           }
 590 #                       }
 591 #                       next arg; };
 592
 593     /^-unregisteri[sz]ed$/ && do { $RegisteriseC = 'no';
 594                                    $ProduceC = 1; $ProduceS = ''; # via C, definitely
 595                                    next arg; };
 596
 597     /^-tmpdir$/ && do { $Tmp_prefix = &grab_arg_arg('-tmpdir', '');
 598                         $Tmp_prefix = "$Tmp_prefix/ghc$$";
 599                         $ENV{'TMPDIR'} = $Tmp_prefix; # for those who use it...
 600                         next arg; };
 601     # use an alternate directory for temp files
 602
 603     #---------- redirect output --------------------------------------------
 604
 605     # -o <file>; applies to the last phase, whatever it is
 606     # "-o -" sends it to stdout
 607     # if <file> has a directory component, that dir must already exist
 608
 609     /^-o$/          && do { $Specific_output_file = &grab_arg_arg('-o', '');
 610                             if ($Specific_output_file ne '-'
 611                              && $Specific_output_file =~ /(.*)\/[^\/]*$/) {
 612                                 local($dir_part) = $1;
 613                                 if (! -d $dir_part) {
 614                                     print STDERR "$Pgm: no such directory: $dir_part\n";
 615                                     $Status++;
 616                                 }
 617                             }
 618                             next arg; };
 619
 620     # -ohi <file>; send the interface to <file>; "-ohi -" to send to stdout
 621     /^-ohi$/        && do { $Specific_hi_file = &grab_arg_arg('-ohi', '');
 622                             if ($Specific_hi_file ne '-'
 623                              && $Specific_hi_file =~ /(.*)\/[^\/]*$/) {
 624                                 local($dir_part) = $1;
 625                                 if (! -d $dir_part) {
 626                                     print STDERR "$Pgm: no such directory: $dir_part\n";
 627                                     $Status++;
 628                                 }
 629                             }
 630                             next arg; };
 631
 632     /^-odump$/      && do { $Specific_dump_file = &grab_arg_arg('-odump', '');
 633                             if ($Specific_dump_file =~ /(.*)\/[^\/]*$/) {
 634                                 local($dir_part) = $1;
 635                                 if (! -d $dir_part) {
 636                                     print STDERR "$Pgm: no such directory: $dir_part\n";
 637                                     $Status++;
 638                                 }
 639                             }
 640                             next arg; };
 641
 642     /^-odir$/       && do { $Specific_output_dir = &grab_arg_arg('-odir', '');
 643                             if (! -d $Specific_output_dir) {
 644                                 print STDERR "$Pgm: -odir: no such directory: $Specific_output_dir\n";
 645                                 $Status++;
 646                             }
 647                             next arg; };
 648
 649     /^-osuf$/       && do { $Osuffix  = &grab_arg_arg('-osuf', ''); next arg; };
 650     /^-hisuf$/      && do { $HiSuffix = &grab_arg_arg('-hisuf', '');
 651                             push(@HsP_flags, "-h$HiSuffix");
 652                             next arg; };
 653
 654     /^-hisuf-prelude$/ && do { # as esoteric as they come...
 655                             local($suffix) = &grab_arg_arg('-hisuf-prelude', '');
 656                             push(@HsP_flags, "-g$suffix");
 657                             next arg; };
 658
 659     #-------------- scc & Profiling Stuff ----------------------------------
 660
 661     /^-prof$/ && do { $PROFing = 'p'; next arg; }; # profiling -- details later!
 662
 663     /^-fheap-profiling-with-age$/ && do {
 664                 $PROFaging = 'a';
 665                 push(@CcBoth_flags, '-DHEAP_PROF_WITH_AGE');
 666                 next arg; };
 667
 668     /^-auto/ && do {
 669                 # generate auto SCCs on top level bindings
 670                 # -auto-all = all top level bindings
 671                 # -auto     = only top level exported bindings
 672                 $PROFauto = ( /-all/ )
 673                             ? '-fauto-sccs-on-all-toplevs'
 674                             : '-fauto-sccs-on-exported-toplevs';
 675                 next arg; };
 676
 677     /^-caf-all/ && do { # generate individual CAF SCC annotations
 678                 $PROFcaf = '-fauto-sccs-on-individual-cafs';
 679                 next arg; };
 680
 681 # UNUSED:
 682 #    /^-dict-all/ && do { # generate individual SCC annotations on dictionaries
 683 #               $PROFdict = '-fauto-sccs-on-individual-dicts';
 684 #               next arg; };
 685
 686     /^-ignore-scc$/ && do {
 687                 # forces ignore of scc annotations even if profiling
 688                 $PROFignore_scc = '-W';
 689                 next arg; };
 690
 691     /^-G(.*)$/  && do { push(@HsC_flags, $_);   # set group for cost centres
 692                         next arg; };
 693
 694     #--------- ticky/concurrent/parallel -----------------------------------
 695     # we sort out the details a bit later on
 696
 697     /^-concurrent$/ && do { $CONCURing = 'c'; next arg; }; # concurrent Haskell
 698     /^-gransim$/    && do { $GRANing   = 'g'; next arg; }; # GranSim
 699     /^-ticky$/      && do { $TICKYing  = 't'; next arg; }; # ticky-ticky
 700     /^-parallel$/   && do { $PARing    = 'p'; next arg; } ; # parallel Haskell
 701
 702     #-------------- "user ways" --------------------------------------------
 703
 704     (/^-user-setup-([a-o])$/
 705     || /^$(GHC_BUILD_FLAG_a)$/
 706     || /^$(GHC_BUILD_FLAG_b)$/
 707     || /^$(GHC_BUILD_FLAG_c)$/
 708     || /^$(GHC_BUILD_FLAG_d)$/
 709     || /^$(GHC_BUILD_FLAG_e)$/
 710     || /^$(GHC_BUILD_FLAG_f)$/
 711     || /^$(GHC_BUILD_FLAG_g)$/
 712     || /^$(GHC_BUILD_FLAG_h)$/
 713     || /^$(GHC_BUILD_FLAG_i)$/
 714     || /^$(GHC_BUILD_FLAG_j)$/
 715     || /^$(GHC_BUILD_FLAG_k)$/
 716     || /^$(GHC_BUILD_FLAG_l)$/
 717     || /^$(GHC_BUILD_FLAG_m)$/
 718     || /^$(GHC_BUILD_FLAG_n)$/
 719     || /^$(GHC_BUILD_FLAG_o)$/
 720
 721     || /^$(GHC_BUILD_FLAG_2s)$/ # GC ones...
 722     || /^$(GHC_BUILD_FLAG_1s)$/
 723     || /^$(GHC_BUILD_FLAG_du)$/
 724     ) && do {
 725                 /^-user-setup-([a-o])$/  && do { $BuildTag = "_$1"; };
 726
 727                 /^$(GHC_BUILD_FLAG_a)$/  && do { $BuildTag = '_a';  };
 728                 /^$(GHC_BUILD_FLAG_b)$/  && do { $BuildTag = '_b';  };
 729                 /^$(GHC_BUILD_FLAG_c)$/  && do { $BuildTag = '_c';  };
 730                 /^$(GHC_BUILD_FLAG_d)$/  && do { $BuildTag = '_d';  };
 731                 /^$(GHC_BUILD_FLAG_e)$/  && do { $BuildTag = '_e';  };
 732                 /^$(GHC_BUILD_FLAG_f)$/  && do { $BuildTag = '_f';  };
 733                 /^$(GHC_BUILD_FLAG_g)$/  && do { $BuildTag = '_g';  };
 734                 /^$(GHC_BUILD_FLAG_h)$/  && do { $BuildTag = '_h';  };
 735                 /^$(GHC_BUILD_FLAG_i)$/  && do { $BuildTag = '_i';  };
 736                 /^$(GHC_BUILD_FLAG_j)$/  && do { $BuildTag = '_j';  };
 737                 /^$(GHC_BUILD_FLAG_k)$/  && do { $BuildTag = '_k';  };
 738                 /^$(GHC_BUILD_FLAG_l)$/  && do { $BuildTag = '_l';  };
 739                 /^$(GHC_BUILD_FLAG_m)$/  && do { $BuildTag = '_m';  };
 740                 /^$(GHC_BUILD_FLAG_n)$/  && do { $BuildTag = '_n';  };
 741                 /^$(GHC_BUILD_FLAG_o)$/  && do { $BuildTag = '_o';  };
 742
 743                 /^$(GHC_BUILD_FLAG_2s)$/ && do { $BuildTag = '_2s'; };
 744                 /^$(GHC_BUILD_FLAG_1s)$/ && do { $BuildTag = '_1s'; };
 745                 /^$(GHC_BUILD_FLAG_du)$/ && do { $BuildTag = '_du'; };
 746
 747                 local($stuff) = $UserSetupOpts{$BuildTag};
 748                 local(@opts)  = split(/\s+/, $stuff);
 749
 750                 # feed relevant ops into the arg-processing loop (if any)
 751                 unshift(@ARGV, @opts) if $#opts >= 0;
 752
 753                 next arg; };
 754
 755     #---------- set search paths for libraries and things ------------------
 756
 757     # we do -i just like HBC (-i clears the list; -i<colon-separated-items>
 758     # prepends the items to the list); -I is for including C .h files.
 759
 760     /^-i$/          && do { @Import_dir = ();  # import path cleared!
 761                             @SysImport_dir = ();
 762                             print STDERR "WARNING: import paths cleared by `-i'\n";
 763                             next arg; };
 764
 765     /^-i(.*)/       && do { local(@new_items)
 766                               = split( /:/, &grab_arg_arg('-i', $1));
 767                             unshift(@Import_dir, @new_items);
 768                             next arg; };
 769
 770     /^-I(.*)/       && do { push(@Include_dir,     &grab_arg_arg('-I', $1)); next arg; };
 771     /^-L(.*)/       && do { push(@UserLibrary_dir, &grab_arg_arg('-L', $1)); next arg; };
 772     /^-l(.*)/       && do { push(@UserLibrary,'-l'.&grab_arg_arg('-l', $1)); next arg; };
 773
 774     /^-syslib(.*)/  && do { local($syslib) = &grab_arg_arg('-syslib',$1);
 775                             print STDERR "$Pgm: no such system library (-syslib): $syslib\n",
 776                               $Status++ unless $syslib =~ /^(hbc|ghc|contrib)$/;
 777
 778                             unshift(@SysImport_dir,
 779                                 $(INSTALLING)
 780                                 ? "$InstDataDirGhc/imports/$syslib"
 781                                 : "$TopPwd/$(CURRENT_DIR)/$(GHC_LIBSRC)/$syslib");
 782
 783                             unshift(@SysLibrary, ('-lHS' . $syslib ));
 784
 785                             next arg; };
 786
 787     #=======================================================================
 788     # various flags that we can harmlessly send to one program or another
 789     # (we will later "reclaim" some of the compiler ones now sent to gcc)
 790     #=======================================================================
 791
 792     #---------- this driver itself (ghc) -----------------------------------
 793     # these change what executable is run for each phase:
 794     /^-pgmL(.*)$/   && do { $Unlit   = $1; next arg; };
 795     /^-pgmP(.*)$/   && do { $HsCpp   = $1; next arg; };
 796     /^-pgmp(.*)$/   && do { $HsP     = $1; next arg; };
 797     /^-pgmC(.*)$/   && do { $HsC     = $1; next arg; };
 798     /^-pgmcO(.*)$/  && do { $CcRegd   = $1; next arg; };
 799     /^-pgmc(.*)$/   && do { $CcUnregd  = $1; next arg; };
 800     /^-pgma(.*)$/   && do { $As      = $1; next arg; };
 801     /^-pgml(.*)$/   && do { $Lnkr    = $1; next arg; };
 802
 803     #---------- the get-anything-through opts (all pgms) -------------------
 804     # these allow arbitrary option-strings to go to any phase:
 805     /^-optL(.*)$/   && do { push(@Unlit_flags,   $1); next arg; };
 806     /^-optP(.*)$/   && do { push(@HsCpp_flags,   $1); next arg; };
 807     /^-optp(.*)$/   && do { push(@HsP_flags,     $1); next arg; };
 808     /^-optCrts(.*)$/&& do { push(@HsC_rts_flags, $1); next arg; };
 809     /^-optC(.*)$/   && do { push(@HsC_flags,     $1); next arg; };
 810     /^-optcNhc(.*)$/ && do { push(@CcUnregd_flags_hc,$1); next arg; };
 811     /^-optcNc(.*)$/  && do { push(@CcUnregd_flags_c,$1); next arg; };
 812     /^-optcN(.*)$/  && do { push(@CcUnregd_flags,   $1); next arg; };
 813     /^-optcOhc(.*)$/&& do { push(@CcRegd_flags_hc,$1); next arg; };
 814     /^-optcOc(.*)$/ && do { push(@CcRegd_flags_c, $1); next arg; };
 815     /^-optcO(.*)$/  && do { push(@CcRegd_flags,   $1); next arg; };
 816     /^-optc(.*)$/   && do { push(@CcBoth_flags,  $1); next arg; };
 817     /^-opta(.*)$/   && do { push(@As_flags,      $1); next arg; };
 818     /^-optl(.*)$/   && do { push(@Ld_flags,      $1); next arg; };
 819
 820     #---------- Haskell C pre-processor (hscpp) ----------------------------
 821     /^-D(.*)/       && do { push(@HsCpp_flags, "'-D".&grab_arg_arg('-D',$1)."'"); next arg; };
 822     /^-U(.*)/       && do { push(@HsCpp_flags, "'-U".&grab_arg_arg('-U',$1)."'"); next arg; };
 823
 824     #---------- Haskell parser (hsp) ---------------------------------------
 825     /^-ddump-parser$/ && do { $Dump_parser_output = 1; next arg; };
 826
 827     #---------- post-Haskell "assembler"------------------------------------
 828     /^-ddump-raw-asm$/          && do { $Dump_raw_asm          = 1; next arg; };
 829     /^-ddump-asm-insn-counts$/  && do { $Dump_asm_insn_counts  = 1; next arg; };
 830     /^-ddump-asm-globals-info$/ && do { $Dump_asm_globals_info = 1; next arg; };
 831
 832     /^-ddump-asm-splitting-info$/ && do { $Dump_asm_splitting_info = 1; next arg; };
 833
 834     #---------- Haskell compiler (hsc) -------------------------------------
 835
 836 # possibly resurrect LATER
 837 #   /^-fspat-profiling$/  && do { push(@HsC_flags, '-fstg-reduction-counts');
 838 #                           $ProduceS = ''; $ProduceC = 1; # must use C compiler
 839 #                           push(@CcBoth_flags, '-DDO_SPAT_PROFILING');
 840 #                           push(@CcBoth_flags, '-fno-schedule-insns'); # not essential
 841 #                           next arg; };
 842
 843     /^-keep-hc-files?-too$/     && do { $Keep_hc_file_too = 1; next arg; };
 844     /^-keep-s-files?-too$/      && do { $Keep_s_file_too = 1;  next arg; };
 845
 846     /^-fhaskell-1\.3$/          && do { $haskell1_version = 3;
 847                                         push(@HsP_flags, '-3');
 848                                         push(@HsC_flags, $_);
 849                                         $TopClosureFile =~ s/TopClosureXXXX/TopClosure13XXXX/;
 850                                         unshift(@SysImport_dir,
 851                                             $(INSTALLING)
 852                                             ? "$InstDataDirGhc/imports/haskell-1.3"
 853                                             : "$TopPwd/$(CURRENT_DIR)/$(GHC_LIBSRC)/haskell-1.3");
 854
 855                                         unshift(@SysLibrary, '-lHS13');
 856
 857                                         next arg; };
 858
 859     /^-fno-implicit-prelude$/      && do { push(@HsP_flags, '-P'); next arg; };
 860     /^-fignore-interface-pragmas$/ && do { push(@HsP_flags, '-p'); next arg; };
 861
 862     /^-prelude$/                && do { $CompilingPrelude = 1;
 863                                         push(@HsC_flags, $_); next arg; };
 864
 865     /^-split-objs(.*)/  && do {
 866                         local($sname) = &grab_arg_arg('-split-objs', $1);
 867                         $sname =~ s/ //g; # no spaces
 868
 869                         if ( $TargetPlatform =~ /^(sparc|alpha|m68k|mips|i[34]86|hppa1\.1)-/ ) {
 870                             $SplitObjFiles = 1;
 871                             push(@HsC_flags, "-fglobalise-toplev-names$sname");
 872                             push(@CcBoth_flags, '-DUSE_SPLIT_MARKERS');
 873
 874                             require('ghc-split.prl')
 875                              || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-split.prl!\n");
 876                         } else {
 877                             $SplitObjFiles = 0;
 878                             print STDERR "WARNING: don't know how to split objects on this platform: $TargetPlatform\n`-split-objs' option ignored\n";
 879                         }
 880                         next arg; };
 881
 882     /^-fglobalise-toplev-names$/&& do { push(@HsC_flags, $_); next arg; };
 883
 884     /^-f(hide-builtin-names|min-builtin-names)$/
 885                 && do { push(@HsC_flags, $_);
 886                         push(@HsP_flags, '-P'); # don't read Prelude.hi
 887                         push(@HsP_flags, '-N'); # allow foo# names
 888                         next arg; };
 889     /^-f(glasgow-exts|hide-builtin-instances)$/
 890                 && do { push(@HsC_flags, $_);
 891                         push(@HsP_flags, '-N');
 892
 893 #                       push(@HsC_flags, '-fshow-import-specs');
 894
 895                         if ( ! $(INSTALLING) ) {
 896                             unshift(@SysImport_dir,
 897                                 "$TopPwd/$(CURRENT_DIR)/$(GHC_LIBSRC)/glaExts");
 898                         }
 899                         next arg; };
 900
 901     /^-fspecialise-unboxed$/
 902                 && do { $Oopt_SpecialiseUnboxed = '-fspecialise-unboxed';
 903                         next arg; };
 904
 905 # Now the foldr/build options, which are *on* by default (for -O).
 906
 907     /^-fno-foldr-build$/
 908                     && do { $Oopt_FoldrBuild = 0;
 909                             $Oopt_FB_Support = '';
 910                             next arg; };
 911
 912     /^-fno-foldr-build-rule$/
 913                     && do { $Oopt_FoldrBuild = 0;
 914                                next arg; };
 915
 916     /^-fno-enable-tech$/
 917                     && do { $Oopt_FB_Support = '';
 918                             next arg; };
 919
 920 #    /^-ffoldr-build-ww$/
 921 #                   && do { $Oopt_FoldrBuildWW = 1; next arg; };
 922
 923
 924     /^-fasm-(.*)$/  && do { $ProduceS = $1; $ProduceC = 0; # force using nativeGen
 925                             push(@HsC_flags, $_); # if from the command line
 926                             next arg; };
 927
 928     /^-fvia-C$/     && do { $ProduceS = ''; $ProduceC = 1; # force using C compiler
 929                             next arg; };
 930
 931     /^-f(no-)?omit-frame-pointer$/ && do {
 932                             unshift(@CcBoth_flags, ( $_ ));
 933                             next arg; };
 934
 935     # ---------------
 936
 937     /^(-fsimpl-uf-use-threshold)(.*)$/
 938                     && do { $Oopt_UnfoldingUseThreshold = $1 . &grab_arg_arg($1, $2);
 939                             next arg; };
 940
 941     /^(-fmax-simplifier-iterations)(.*)$/
 942                     && do { $Oopt_MaxSimplifierIterations = $1 . &grab_arg_arg($1, $2);
 943                             next arg; };
 944
 945     /^-fno-pedantic-bottoms$/
 946                     && do { $Oopt_PedanticBottoms = ''; next arg; };
 947
 948     /^-fdo-monad-eta-expansion$/
 949                     && do { $Oopt_MonadEtaExpansion = $_; next arg; };
 950
 951 #    /^-flambda-lift$/ # so Simon can do some testing; ToDo:rm
 952 #                   && do { $Oopt_LambdaLift = $_; next arg; };
 953
 954     # ---------------
 955
 956     /^-fno-(.*)$/   && do { push(@HsC_antiflags, "-f$1");
 957                             &squashHscFlag("-f$1");
 958                             next arg; };
 959
 960     /^-f/           && do { push(@HsC_flags, $_); next arg; };
 961
 962     # ---------------
 963
 964     /^-mlong-calls/ && do { # for GCC for HP-PA boxes
 965                             unshift(@CcBoth_flags,  ('-mlong-calls'));
 966                             next arg; };
 967
 968     /^-monly-([432])-regs/ && do { # for iX86 boxes only; no effect otherwise
 969                             $StolenX86Regs = $1;
 970                             next arg; };
 971
 972     /^-mtoggle-sp-mangling/ && do { # for iX86 boxes only; for RTS only
 973                             $SpX86Mangling = 1 - $SpX86Mangling;
 974                             next arg; };
 975
 976     #*************** ... and lots of debugging ones (form: -d* )
 977
 978     /^-darity-checks$/  && do {
 979                             push(@HsC_flags, $_);
 980                             push(@CcBoth_flags, '-D__DO_ARITY_CHKS__');
 981                             next arg; };
 982     /^-darity-checks-C-only$/ && do {
 983                             # so we'll have arity-checkable .hc files
 984                             # should we decide we need them later...
 985                             push(@HsC_flags, '-darity-checks');
 986                             next arg; };
 987     /^-dno-stk-checks$/ && do {
 988                             push(@HsC_flags, '-dno-stk-chks');
 989                             push(@CcBoth_flags, '-D__OMIT_STK_CHKS__');
 990                             next arg; };
 991
 992     # -d(no-)core-lint is done this way so it is turn-off-able.
 993     /^-dcore-lint/       && do { $CoreLint = '-dcore-lint'; next arg; };
 994     /^-dno-core-lint/    && do { $CoreLint = '';            next arg; };
 995
 996     /^-d(dump|ppr)-/         && do { push(@HsC_flags, $_); next arg; };
 997     /^-dverbose-(simpl|stg)/ && do { push(@HsC_flags, $_); next arg; };
 998     /^-dsimplifier-stats/    && do { push(@HsC_flags, $_); next arg; };
 999
1000     #*************** ... and now all these -R* ones for its runtime system...
1001
1002     /^-Rhbc$/       && do { $RTS_style = 'hbc'; next arg; };
1003     /^-Rghc$/       && do { $RTS_style = 'ghc'; next arg; };
1004
1005     /^-Rscale-sizes?(.*)/ && do {
1006         $Scale_sizes_by = &grab_arg_arg('-Rscale-sizes', $1);
1007         next arg; };
1008
1009     /^(-H|-Rmax-heapsize)(.*)/ && do {
1010         local($heap_size) = &grab_arg_arg($1, $2);
1011         if ($heap_size =~ /(\d+)[Kk]$/) {
1012             $heap_size = $1 * 1000;
1013         } elsif ($heap_size =~ /(\d+)[Mm]$/) {
1014             $heap_size = $1 * 1000 * 1000;
1015         } elsif ($heap_size =~ /(\d+)[Gg]$/) {
1016             $heap_size = $1 * 1000 * 1000 * 1000;
1017         }
1018         if ($heap_size <= 0) {
1019             print STDERR "$Pgm: resetting heap-size to zero!!!\n";
1020             $Specific_heap_size = 0;
1021         }
1022         # if several heap sizes given, take the largest...
1023         if ($heap_size >= $Specific_heap_size) {
1024             $Specific_heap_size = $heap_size;
1025         } else {
1026             print STDERR "$Pgm: ignoring heap-size-setting option ($_)...not the largest seen\n";
1027         }
1028         next arg; };
1029
1030     /^-(K|Rmax-(stk|stack)size)(.*)/ && do {
1031         local($stk_size) = &grab_arg_arg('-Rmax-stksize', $3);
1032         if ($stk_size =~ /(\d+)[Kk]$/) {
1033             $stk_size = $1 * 1000;
1034         } elsif ($stk_size =~ /(\d+)[Mm]$/) {
1035             $stk_size = $1 * 1000 * 1000;
1036         } elsif ($stk_size =~ /(\d+)[Gg]$/) {
1037             $stk_size = $1 * 1000 * 1000 * 1000;
1038         }
1039         if ($stk_size <= 0) {
1040             print STDERR "$Pgm: resetting stack-size to zero!!!\n";
1041             $Specific_stk_size = 0;
1042         }
1043         # if several stack sizes given, take the largest...
1044         if ($stk_size >= $Specific_stk_size) {
1045             $Specific_stk_size = $stk_size;
1046         } else {
1047             print STDERR "$Pgm: ignoring stack-size-setting option (-Rmax-stksize $stk_size)...not the largest seen\n";
1048         }
1049         next arg; };
1050
1051     /^-Rgc-stats$/ && do {  $CollectingGCstats++;
1052                             # the two RTSs do this diff ways; we will try to compensate
1053                             next arg; };
1054
1055     /^-Rghc-timing/ && do { $CollectGhcTimings = 1; next arg; };
1056
1057     #---------- C high-level assembler (gcc) -------------------------------
1058 # OLD: and dangerous
1059 #    /^-g$/             && do { push(@CcBoth_flags, $_); next arg; };
1060 #    /^-(p|pg)$/                && do { push(@CcBoth_flags, $_); push(@Ld_flags, $_); next arg; };
1061 #    /^-(fpic|fPIC)$/   && do { push(@CcBoth_flags, $_); push(@As_flags, $_); next arg; };
1062
1063     /^-(Wall|ansi|pedantic)$/ && do { push(@CcBoth_flags, $_); next arg; };
1064
1065     # -dgcc-lint is a useful way of making GCC very fussy.
1066     # From alan@spri.levels.unisa.edu.au (Alan Modra).
1067     /^-dgcc-lint$/ && do { push(@CcBoth_flags, '-Wall -Wpointer-arith -Wbad-function-cast -Wcast-qual -Wstrict-prototypes -Wmissing-prototypes -Wmissing-declarations -Wnested-externs'); next arg; };
1068     # An alternate set, from mark@sgcs.com (Mark W. Snitily)
1069     # -Wall -Wstrict-prototypes -Wmissing-prototypes -Wcast-align -Wshadow
1070
1071     # inject "#include <wurble>" into the compiler's C output!
1072
1073     /^-#include(.*)/    && do {
1074         local($to_include) = &grab_arg_arg('-#include', $1);
1075         push(@CcInjects, "#include $to_include\n");
1076         next arg; };
1077
1078     #---------- Linker (gcc, really) ---------------------------------------
1079
1080     /^-static$/         && do { push(@Ld_flags, $_); next arg; };
1081
1082     #---------- mixed cc and linker magic ----------------------------------
1083     # this optimisation stuff is finally sorted out later on...
1084
1085 #    /^-O0$/    && do { # turn all optimisation *OFF*
1086 #               $OptLevel = -1;
1087 #               $ProduceS = ''; $ProduceC = 1; # force use of C compiler
1088 #               next arg; };
1089
1090     /^-O2-for-C$/ && do { $MinusO2ForC = 1; next arg; };
1091
1092     /^-O[1-2]?$/ && do {
1093                 local($opt_lev) = ( /^-O2$/ ) ? 2 : 1; # max 'em
1094                 $OptLevel = ( $opt_lev > $OptLevel ) ? $opt_lev : $OptLevel;
1095
1096                 if ( $OptLevel == 2 ) { # force use of C compiler
1097                     $ProduceS = ''; $ProduceC = 1;
1098                 }
1099                 next arg; };
1100
1101     /^-Onot$/   && do { $OptLevel = 0; next arg; }; # # set it to <no opt>
1102
1103     /^-Ofile(.*)/ && do {
1104                 $OptLevel = 3;
1105                 local($ofile) = &grab_arg_arg('-Ofile', $1);
1106                 @HsC_minusO3_flags = ();
1107
1108                 open(OFILE, "< $ofile") || die "Can't open $ofile!\n";
1109                 while (<OFILE>) {
1110                     chop;
1111                     s/\#.*//;       # death to comments
1112                     s/[ \t]+//g;    # death to whitespace
1113                     next if /^$/;   # ditto, blank lines
1114                     s/([()*{}])/\\$1/g;    # protect shell metacharacters
1115                     if ( /^C:(.*)/ ) {
1116                         push(@CcBoth_flags, $1);
1117                     } else {
1118                         push(@HsC_minusO3_flags, $_);
1119                     }
1120                 }
1121                 close(OFILE);
1122                 next arg; };
1123
1124     /^-debug$/      && do { # all this does is mark a .hc/.o as "debugging"
1125                             # in the consistency info
1126                             $DEBUGging = 'd';
1127                             next arg; };
1128 # OLD: do it another way
1129 #   /^-dgc-debug$/  && do { push(@CcBoth_flags, '-D_GC_DEBUG'); next arg; };
1130
1131     #---------- catch unrecognized flags -----------------------------------
1132
1133     /^-./ && do {
1134         print STDERR "$Pgm: unrecognised option: $_\n";
1135         $Status++;
1136         next arg; };
1137
1138     #---------- anything else is considered an input file ------------------
1139     # (well, .o files are immediately queued up as linker fodder..)
1140     if (/\.o$/) {
1141         push(@Link_file, $_);
1142     } else {
1143         push(@Input_file, $_);
1144     }
1145
1146     # input files must exist:
1147     if (! -f $_) {
1148         print STDERR "$Pgm: input file doesn't exist: $_\n";
1149         $Status++;
1150     }
1151 }
1152
1153 # if there are several input files,
1154 # we don't allow \tr{-o <file>} or \tr{-ohi <file>} options...
1155 # (except if linking, of course)
1156
1157 if ($#Input_file > 0 && ( ! $Do_lnkr )) {
1158     if ( ($Specific_output_file ne '' && $Specific_output_file ne '-')
1159       || ($Specific_hi_file ne ''     && $Specific_hi_file ne '-') ) {
1160         print STDERR "$Pgm: You can't use -o or -ohi options if you have multiple input files.\n";
1161         print STDERR "\tPerhaps the -odir option will do what you want.\n";
1162         $Status++;
1163     }
1164 }
1165
1166 # check for various pathological -o and -odir combinations...
1167 if ($Specific_output_dir ne '' && $Specific_output_file ne '') {
1168     if ($Specific_output_file eq '-') {
1169         print STDERR "$Pgm: can't set output directory with -ohi AND have output to stdout\n";
1170         $Status++;
1171     } else { # amalgamate...
1172         $Specific_output_file = "$Specific_output_dir/$Specific_output_file";
1173         # ToDo: check we haven't got a junk name now...
1174         $Specific_output_dir  = ''; # reset
1175     }
1176 }
1177
1178 # PROFILING stuff after argv mangling:
1179 if ( ! $PROFing ) {
1180     # warn about any scc exprs found (in case scc used as identifier)
1181     push(@HsP_flags, '-W');
1182 } else {
1183     $Oopt_AddAutoSccs = '-fadd-auto-sccs' if $PROFauto;
1184     $Oopt_FinalStgProfilingMassage = '-fmassage-stg-for-profiling';
1185
1186     push(@HsC_flags, $PROFauto) if $PROFauto;
1187     push(@HsC_flags, $PROFcaf)  if $PROFcaf;
1188 #UNUSED:    push(@HsC_flags, $PROFdict) if $PROFdict;
1189
1190     push(@HsP_flags, (($PROFignore_scc) ? $PROFignore_scc : '-S'));
1191
1192     if ($SplitObjFiles && ! $CompilingPrelude) {
1193         # can't split with cost centres -- would need global and externs
1194         print STDERR "$Pgm: WARNING: splitting objects when profiling will *BREAK* if any _scc_s are present!\n";
1195         # (but it's fine if there aren't any _scc_s around...)
1196 #       $SplitObjFiles = 0; # unset
1197         #not an error: for now: $Status++;
1198     }
1199 }
1200
1201 # crash and burn if there were errors
1202 if ( $Status > 0 ) {
1203     print STDERR $ShortUsage;
1204     exit $Status;
1205 }
1206 \end{code}
1207
1208 %************************************************************************
1209 %*                                                                      *
1210 \section[Driver-post-argv-mangling]{Setup after reading options}
1211 %*                                                                      *
1212 %************************************************************************
1213
1214 %************************************************************************
1215 %*                                                                      *
1216 \subsection{Set up for optimisation level (\tr{-O} or whatever)}
1217 %*                                                                      *
1218 %************************************************************************
1219
1220 We come now to the default ``wads of options'' that are turned on by
1221 \tr{-O0} (do min optimisation), \tr{-O} (ordinary optimisation),
1222 \tr{-O2} (aggressive optimisation), or no O-ish flag (compile speed is
1223 more important).
1224
1225 The user can also specify his/her own list of options in a file; in
1226 that case, the work is already done (see stuff about @minusO3@,
1227 earlier...).
1228
1229 GHC allows very precise control of what happens during a compilation.
1230 Core-to-Core and STG-to-STG passes can be run in any order, as many
1231 times as you like.  Individual transformations can be turned on or
1232 disabled.
1233
1234 Sadly, however, there are some interdependencies \& Things You Must
1235 Not Do.  Here is the list.
1236
1237 CORE-TO-CORE PASSES:
1238 \begin{description}
1239 \item[\tr{-fspecialise}:]
1240 The specialiser must have dependency-analysed input; but if you run
1241 the simplifier to do this, you must not let it toss away unused
1242 bindings!  (The typechecker conveys some specialisation info via
1243 ``unused'' bindings...)
1244
1245 \item[\tr{-ffloat-inwards}:]
1246 Floating inwards should be done before strictness analysis, because
1247 the latter will give better results.
1248
1249 \item[\tr{-fstatic-args}:]
1250 The static-arguments-transformation pass {\em must} have the
1251 simplifier run right after it.
1252
1253 \item[\tr{-fcalc-inlinings[12]}:]
1254 Not required, but there may be slight gains by re-simplifying after
1255 this is done.  (You could then \tr{-fcalc-inlinings} again, just for
1256 fun.)
1257
1258 \item[\tr{-ffull-laziness}:]
1259 The (outwards-)let-floater should be the {\em last} Core-to-Core pass
1260 that's run.  (Um, well, howzabout the simplifier just once more...)
1261 \end{description}
1262
1263 STG-TO-STG PASSES:
1264 \begin{description}
1265 \item[\tr{-fupdate-analysis}:]
1266 It really really wants to be the last STG-to-STG pass that is run.
1267 \end{description}
1268
1269 \begin{code}
1270 # OLD:
1271 #@HsC_minusO0_flags
1272 #  = (  $Oopt_AddAutoSccs,
1273 #       '-fsimplify', # would rather *not* run the simplifier (ToDo)
1274 #         '\(', '\)', # nothing special at all ????
1275 #
1276 #       $Oopt_FinalStgProfilingMassage
1277 #   );
1278
1279 @HsC_minusNoO_flags
1280   = (   '-fsimplify',
1281           '\(',
1282           "$Oopt_FB_Support",
1283           '-falways-float-lets-from-lets',
1284           '-ffloat-lets-exposing-whnf',
1285           '-ffloat-primops-ok',
1286           '-fcase-of-case',
1287 #         '-fdo-lambda-eta-expansion',  # too complicated
1288           '-freuse-con',
1289 #         '-flet-to-case',      # no strictness analysis, so...
1290           "$Oopt_PedanticBottoms",
1291 #         "$Oopt_MonadEtaExpansion",    # no thanks
1292           '-fsimpl-uf-use-threshold0',
1293           '-fessential-unfoldings-only',
1294 #         "$Oopt_UnfoldingUseThreshold",        # no thanks
1295           "$Oopt_MaxSimplifierIterations",
1296           '\)',
1297         $Oopt_AddAutoSccs,
1298 #       '-ffull-laziness',      # removed 95/04 WDP following Andr\'e's lead
1299         '-fuse-get-mentioned-vars', # for the renamer
1300
1301         $Oopt_FinalStgProfilingMassage
1302     );
1303
1304 @HsC_minusO_flags # NOTE: used for *both* -O and -O2 (some conditional bits)
1305   = (
1306       # core2core passes
1307         # initial simplify: mk specialiser happy: minimum effort please
1308         '-fsimplify',
1309           '\(',
1310           "$Oopt_FB_Support",
1311           '-fkeep-spec-pragma-ids',
1312           '-fsimpl-uf-use-threshold0',
1313           '-fessential-unfoldings-only',
1314           '-fmax-simplifier-iterations1',
1315           "$Oopt_PedanticBottoms",
1316           '\)',
1317
1318         $Oopt_AddAutoSccs, # dangerous to do with *no* simplification...
1319
1320         '-fspecialise-overloaded',
1321         $Oopt_SpecialiseUnboxed,
1322         '-fspecialise',
1323
1324         '-fsimplify', # need tossing before calc-i...
1325           '\(',
1326           "$Oopt_FB_Support",
1327           '-ffloat-lets-exposing-whnf',
1328           '-ffloat-primops-ok',
1329           '-fcase-of-case',
1330           '-fdo-case-elim',
1331           '-fdo-eta-reduction',
1332           '-fdo-lambda-eta-expansion',
1333           '-freuse-con',
1334 #         '-flet-to-case',      # no point, before strictness analysis
1335           "$Oopt_PedanticBottoms",
1336           "$Oopt_MonadEtaExpansion",
1337           "$Oopt_UnfoldingUseThreshold",
1338           "$Oopt_MaxSimplifierIterations",
1339           '\)',
1340
1341         '-fcalc-inlinings1',
1342
1343 #       ($Oopt_FoldrBuildWW) ? (
1344 #               '-ffoldr-build-ww-anal',
1345 #               '-ffoldr-build-worker-wrapper',
1346 #               '-fsimplify',
1347 #                 '\(',
1348 #                 "$Oopt_FB_Support",
1349 #                 '-ffloat-lets-exposing-whnf',
1350 #                 '-ffloat-primops-ok',
1351 #                 '-fcase-of-case',
1352 #                 '-fdo-case-elim',
1353 #                 '-fdo-eta-reduction',
1354 #                 '-fdo-lambda-eta-expansion',
1355 #                 '-freuse-con',
1356 ##                '-flet-to-case',      # no point, before strictness analysis
1357 #                 "$Oopt_PedanticBottoms",
1358 #                 "$Oopt_MonadEtaExpansion",
1359 #                 "$Oopt_UnfoldingUseThreshold",
1360 #                 "$Oopt_MaxSimplifierIterations",
1361 #                 '\)',
1362 #        ) : (),
1363
1364         # this pass-ordering sequence was agreed by Simon and Andr\'e
1365         # (WDP 94/07, 94/11).
1366         '-ffull-laziness',
1367
1368         ($Oopt_FoldrBuild) ? (
1369           '-fsimplify',
1370             '\(',
1371             '-fignore-inline-pragma',   # **** NB!
1372             '-fdo-foldr-build',         # NB
1373             "$Oopt_FB_Support",
1374             '-ffloat-lets-exposing-whnf',
1375             '-ffloat-primops-ok',
1376             '-fcase-of-case',
1377             '-fdo-case-elim',
1378             '-fdo-eta-reduction',
1379             '-fdo-lambda-eta-expansion',
1380             '-freuse-con',
1381   #       '-flet-to-case',      # no point, before strictness analysis
1382             "$Oopt_PedanticBottoms",
1383             "$Oopt_MonadEtaExpansion",
1384             "$Oopt_UnfoldingUseThreshold",
1385             "$Oopt_MaxSimplifierIterations",
1386             '\)',
1387         ) : (),
1388
1389         '-ffloat-inwards',
1390
1391         '-fsimplify',
1392           '\(',
1393           "$Oopt_FB_Support",
1394           '-ffloat-lets-exposing-whnf',
1395           '-ffloat-primops-ok',
1396           '-fcase-of-case',
1397           '-fdo-case-elim',
1398           '-fdo-eta-reduction',
1399           '-fdo-lambda-eta-expansion',
1400           '-freuse-con',
1401 #         '-flet-to-case',      # no point, before strictness analysis
1402           '-fdo-inline-foldr-build',
1403                                 # you need to inline foldr!
1404           "$Oopt_PedanticBottoms",
1405           "$Oopt_MonadEtaExpansion",
1406           "$Oopt_UnfoldingUseThreshold",
1407           "$Oopt_MaxSimplifierIterations",
1408           '\)',
1409
1410         '-fstrictness',
1411
1412         '-fsimplify',
1413           '\(',
1414           "$Oopt_FB_Support",
1415           '-ffloat-lets-exposing-whnf',
1416           '-ffloat-primops-ok',
1417           '-fcase-of-case',
1418           '-fdo-case-elim',
1419           '-fdo-eta-reduction',
1420           '-fdo-lambda-eta-expansion',
1421           '-freuse-con',
1422           '-flet-to-case',      # Aha!
1423           "$Oopt_PedanticBottoms",
1424           "$Oopt_MonadEtaExpansion",
1425           "$Oopt_UnfoldingUseThreshold",
1426           "$Oopt_MaxSimplifierIterations",
1427           '\)',
1428
1429         '-ffloat-inwards',
1430
1431 # Case-liberation for -O2.  This should be after
1432 # strictness analysis and the simplification which follows it.
1433
1434 #       ( ($OptLevel != 2)
1435 #        ? ''
1436 #       : "-fliberate-case -fsimplify \\( "$Oopt_FB_Support" -ffloat-lets-exposing-whnf -ffloat-primops-ok -fcase-of-case -fdo-case-elim -fdo-eta-reduction -fdo-lambda-eta-expansion -freuse-con -flet-to-case $Oopt_PedanticBottoms $Oopt_MonadEtaExpansion $Oopt_UnfoldingUseThreshold $Oopt_MaxSimplifierIterations \\)" ),
1437
1438 # Final clean-up simplification:
1439
1440         '-fsimplify',
1441           '\(',
1442           "$Oopt_FB_Support",
1443           '-ffloat-lets-exposing-whnf',
1444           '-ffloat-primops-ok',
1445           '-fcase-of-case',
1446           '-fdo-case-elim',
1447           '-fdo-eta-reduction',
1448           '-fdo-lambda-eta-expansion',
1449           '-freuse-con',
1450           '-flet-to-case',
1451           '-fignore-inline-pragma',     # **** NB!
1452           '-fdo-inline-foldr-build',    # NB
1453           "$Oopt_PedanticBottoms",
1454           "$Oopt_MonadEtaExpansion",
1455           "$Oopt_UnfoldingUseThreshold",
1456           "$Oopt_MaxSimplifierIterations",
1457           '\)',
1458
1459 #       '-fstatic-args',
1460         '-fcalc-inlinings2',
1461
1462       # stg2stg passes
1463         '-fupdate-analysis',
1464         '-flambda-lift',
1465         $Oopt_FinalStgProfilingMassage,
1466
1467       # flags for stg2stg
1468         '-flet-no-escape',
1469
1470       # how do we desugar list comprehensions ?
1471         (($Oopt_FoldrBuild) ? '-ffoldr-build-on' : '' ),
1472
1473       # SPECIAL FLAGS for -O2
1474         (($OptLevel == 2) ? '-fsemi-tagging' : '')
1475     );
1476 \end{code}
1477
1478 Sort out what we're going to do about optimising.  First, the @hsc@
1479 flags and regular @cc@ flags to worry about:
1480 \begin{code}
1481 #if     ( $OptLevel < 0 ) {
1482
1483 #   &add_Hsc_flags( @HsC_minusO0_flags );
1484
1485 if ( $OptLevel <= 0 ) {
1486
1487     # for this level, we tell the parser -fignore-interface-pragmas
1488     push(@HsP_flags, '-p');
1489     # and tell the compiler not to produce them
1490     push(@HsC_flags, '-fomit-interface-pragmas');
1491
1492     &add_Hsc_flags( @HsC_minusNoO_flags );
1493     push(@CcBoth_flags, ($MinusO2ForC) ? '-O2' : '-O'); # not optional!
1494
1495 } elsif ( $OptLevel == 1 || $OptLevel == 2 ) {
1496
1497     &add_Hsc_flags( @HsC_minusO_flags );
1498     push(@CcBoth_flags, ($MinusO2ForC || $OptLevel == 2) ? '-O2' : '-O'); # not optional!
1499     # -O? to GCC is not optional! -O2 probably isn't worth it generally,
1500     # but it *is* useful in compiling the garbage collectors (so said
1501     # Patrick many moons ago...).
1502
1503 } else { # -Ofile, then...
1504
1505     &add_Hsc_flags( @HsC_minusO3_flags );
1506     push(@CcBoth_flags, ($MinusO2ForC) ? '-O2' : '-O'); # possibly to be elaborated...
1507 }
1508 \end{code}
1509
1510 %************************************************************************
1511 %*                                                                      *
1512 \subsection{Check for registerising, consistency, etc.}
1513 %*                                                                      *
1514 %************************************************************************
1515
1516 Are we capable of generating ``registerisable'' C (either using
1517 C or via equivalent native code)?
1518
1519 \begin{code}
1520 $RegisteriseC = ( $GccAvailable
1521                 && $RegisteriseC ne 'no'    # not explicitly *un*set...
1522                 && ($TargetPlatform =~ /^(alpha|hppa1\.1|i[34]86|m68k|mips|sparc)-/)
1523                 ) ? 'o' : '';
1524 \end{code}
1525
1526 Sort out @$BuildTag@, @$PROFing@, @$CONCURing@, @$PARing@,
1527 @$GRANing@, @$TICKYing@:
1528 \begin{code}
1529 if ( $BuildTag ne '' ) {
1530     local($b) = $BuildDescr{$BuildTag};
1531     if ($PROFing   eq 'p') { print STDERR "$Pgm: Can't mix $b with profiling.\n"; exit 1; }
1532     if ($CONCURing eq 'c') { print STDERR "$Pgm: Can't mix $b with -concurrent.\n"; exit 1; }
1533     if ($PARing    eq 'p') { print STDERR "$Pgm: Can't mix $b with -parallel.\n"; exit 1; }
1534     if ($GRANing   eq 'g') { print STDERR "$Pgm: Can't mix $b with -gransim.\n"; exit 1; }
1535     if ($TICKYing  eq 't') { print STDERR "$Pgm: Can't mix $b with -ticky.\n"; exit 1; }
1536
1537 } elsif ( $PROFing eq 'p' ) {
1538     if ($PARing   eq 'p') { print STDERR "$Pgm: Can't do profiling with -parallel.\n"; exit 1; }
1539     if ($GRANing  eq 'g') { print STDERR "$Pgm: Can't do profiling with -gransim.\n"; exit 1; }
1540     if ($TICKYing eq 't') { print STDERR "$Pgm: Can't do profiling with -ticky.\n"; exit 1; }
1541     $BuildTag = ($CONCURing eq 'c') ? '_mr' : '_p' ; # possibly "profiled concurrent"...
1542
1543 } elsif ( $CONCURing eq 'c' ) {
1544     if ($PARing  eq 'p') { print STDERR "$Pgm: Can't mix -concurrent with -parallel.\n"; exit 1; }
1545     if ($GRANing eq 'g') { print STDERR "$Pgm: Can't mix -concurrent with -gransim.\n"; exit 1; }
1546     $BuildTag = ($TICKYing eq 't')  ? '_mt' : '_mc' ; # possibly "ticky concurrent"...
1547     # "profiled concurrent" already acct'd for...
1548
1549 } elsif ( $PARing eq 'p' ) {
1550     if ($GRANing  eq 'g') { print STDERR "$Pgm: Can't mix -parallel with -gransim.\n"; exit 1; }
1551     if ($TICKYing eq 't') { print STDERR "$Pgm: Can't mix -parallel with -ticky.\n"; exit 1; }
1552     $BuildTag = '_mp';
1553
1554     if ( $Do_lnkr && ( ! $ENV{'PVM_ROOT'} || ! $ENV{'PVM_ARCH'} )) {
1555         print STDERR "$Pgm: both your PVM_ROOT and PVM_ARCH environment variables must be set for linking under -parallel.\n";
1556         exit(1);
1557     }
1558
1559 } elsif ( $GRANing eq 'g' ) {
1560     if ($TICKYing eq 't') { print STDERR "$Pgm: Can't mix -gransim with -ticky.\n"; exit 1; }
1561     $BuildTag = '_mg';
1562
1563 } elsif ( $TICKYing eq 't' ) {
1564     $BuildTag = '_t';
1565 }
1566 \end{code}
1567
1568 \begin{code}
1569 if ( $BuildTag ne '' ) { # something other than normal sequential...
1570
1571     push(@HsP_flags, "-g$BuildTag.hi"); # use appropriate Prelude .hi files
1572
1573     $ProduceC = 1; $ProduceS = ''; # must go via C
1574
1575 #    print STDERR "eval...",$EvaldSetupOpts{$BuildTag},"\n";
1576
1577     eval($EvaldSetupOpts{$BuildTag});
1578 }
1579 \end{code}
1580
1581 Decide what the consistency-checking options are in force for this run:
1582 \begin{code}
1583 $HsC_consist_options = "${BuildTag},${DEBUGging}";
1584 $Cc_consist_options  = "${BuildTag},${DEBUGging},${RegisteriseC}";
1585 \end{code}
1586
1587 %************************************************************************
1588 %*                                                                      *
1589 \subsection{Add on machine-specific C-compiler flags}
1590 %*                                                                      *
1591 %************************************************************************
1592
1593 Shove on magical machine-specific options.  We use \tr{unshift} to
1594 stick them on the {\em front} of the arrays, so that ``later''
1595 user-specified flags can clobber them (e.g., \tr{-U__STG_REV_TBLS__}).
1596
1597 Note: a few ``always apply'' flags were set at the very beginning.
1598
1599 \begin{code}
1600 if ($TargetPlatform =~ /^m68k-/) {
1601     # we know how to *mangle* asm for m68k
1602     unshift (@CcRegd_flags, ('-D__STG_REV_TBLS__'));
1603     unshift (@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
1604
1605     # -fno-defer-pop : for the .hc files, we want all the pushing/
1606     #     popping of args to routines to be explicit; if we let things
1607     #     be deferred 'til after an STGJUMP, imminent death is certain!
1608     #
1609     # -fomit-frame-pointer : *don't*
1610     #     It's better to have a6 completely tied up being a frame pointer
1611     #     rather than let GCC pick random things to do with it.
1612     #     (If we want to steal a6, then we would try to do things
1613     #     as on iX86, where we *do* steal the frame pointer [%ebp].)
1614
1615     unshift(@CcRegd_flags_hc, '-fno-defer-pop');
1616     unshift(@CcRegd_flags,    '-fno-omit-frame-pointer');
1617         # maybe gives reg alloc a better time
1618         # also: -fno-defer-pop is not sufficiently well-behaved without it
1619
1620 } elsif ($TargetPlatform =~ /^i[34]86-/) {
1621     # we know how to *mangle* asm for X86
1622     unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
1623     unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
1624     unshift(@CcRegd_flags, ('-m486')); # not worth not doing
1625
1626     # -fno-defer-pop : basically the same game as for m68k
1627     #
1628     # -fomit-frame-pointer : *must* ; because we're stealing
1629     #   the fp (%ebp) for our register maps.  *All* register
1630     #   maps (in MachRegs.lh) must steal it.
1631
1632     unshift(@CcRegd_flags_hc, '-fno-defer-pop');
1633     unshift(@CcRegd_flags,    '-fomit-frame-pointer');
1634     unshift(@CcRegd_flags,    "-DSTOLEN_X86_REGS=$StolenX86Regs");
1635     unshift(@CcRegd_flags_hc, "-DMANGLING_X86_SP=$SpX86Mangling"); # only used for checking
1636         # the mangler will insert patch-up code if $StolenX86Regs != 5.
1637         # *** HACK *** of the worst sort.
1638     unshift(@CcBoth_flags,  ('-static')) if $GccAvailable; # maybe unnecessary???
1639
1640 } elsif ($TargetPlatform =~ /^sparc-/) {
1641     # we know how to *mangle* asm for SPARC
1642     unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
1643     unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
1644
1645 } elsif ($TargetPlatform =~ /^alpha-/) {
1646     # we know how to *mangle* asm for alpha
1647     unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
1648     unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
1649     unshift(@CcBoth_flags,  ('-static')) if $GccAvailable;
1650
1651 } elsif ($TargetPlatform =~ /^hppa/) {
1652     # we know how to *mangle* asm for hppa
1653     unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
1654     unshift(@CcBoth_flags,  ('-static')) if $GccAvailable;
1655     # We don't put in '-mlong-calls', because it's only
1656     # needed for very big modules (sigh), and we don't want
1657     # to hobble ourselves further on all the other modules
1658     # (most of them).
1659     unshift(@CcBoth_flags,  ('-D_HPUX_SOURCE')) if $GccAvailable;
1660         # ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
1661         # (very nice, but too bad the HP /usr/include files don't agree.)
1662
1663 } elsif ($TargetPlatform =~ /^mips-/) {
1664     # we (hope to) know how to *mangle* asm for MIPSen
1665     unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
1666     unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
1667     unshift(@CcBoth_flags,  ('-static')) if $GccAvailable;
1668 }
1669 \end{code}
1670
1671 Same unshifting magic, but for special linker flags.
1672
1673 Should really be whether or not we prepend underscores to global symbols,
1674 not an architecture test.  (JSM)
1675
1676 \begin{code}
1677 unshift(@Ld_flags,
1678     (   $TargetPlatform =~ /^alpha-/
1679      || $TargetPlatform =~ /^mips-sgi-irix/
1680      || $TargetPlatform =~ /^hppa/
1681      || $TargetPlatform =~ /-solaris/
1682     )
1683     ? ('-u', 'unsafePerformPrimIO_fast1',
1684        '-u', 'Nil_closure',
1685        '-u', 'IZh_static_info',
1686        '-u', 'False_inregs_info',
1687        '-u', 'True_inregs_info',
1688        '-u', 'CZh_static_info')
1689
1690     # non-Alphas:
1691     : ('-u', '_unsafePerformPrimIO_fast1',
1692        '-u', '_Nil_closure',
1693        '-u', '_IZh_static_info',
1694        '-u', '_False_inregs_info',
1695        '-u', '_True_inregs_info',
1696        '-u', '_CZh_static_info')
1697     );
1698 \end{code}
1699
1700 %************************************************************************
1701 %*                                                                      *
1702 \subsection{Set up include paths and system-library enslurpment}
1703 %*                                                                      *
1704 %************************************************************************
1705
1706 Now that we know what garbage-collector, etc., are required, we can
1707 finalise our list of libraries to slurp through, and generally Get
1708 Ready for Business.
1709
1710 \begin{code}
1711 # default includes must be added AFTER option processing
1712 if ( $(INSTALLING) ) {
1713     push (@Include_dir, "$InstLibDirGhc/includes");
1714     push (@Include_dir, "$InstDataDirGhc/includes");
1715
1716 } else {
1717     push (@Include_dir, "$TopPwd/$(CURRENT_DIR)/$(GHC_INCLUDESRC)");
1718 }
1719 \end{code}
1720
1721 \begin{code}
1722 local($f);
1723 foreach $f (@SysLibrary) {
1724     $f .= "${BuildTag}" if $f =~ /^-lHS/;
1725 }
1726
1727 # fiddle the TopClosure file name...
1728 $TopClosureFile =~ s/XXXX//;
1729
1730 # Push library HSrts, plus boring clib bit
1731 push(@SysLibrary, "-lHSrts${BuildTag}");
1732 push(@SysLibrary, '-lHSclib');
1733
1734 # Push the pvm libraries
1735 if ($BuildTag eq '_mp') {
1736     $pvmlib = "$ENV{'PVM_ROOT'}/lib/$ENV{'PVM_ARCH'}";
1737     push(@SysLibrary, "-L$pvmlib", '-lpvm3', '-lgpvm3');
1738     if ( $ENV{'PVM_ARCH'} eq 'SUNMP' ) {
1739         push(@SysLibrary, '-lthread', '-lsocket', '-lnsl');
1740     } elsif ( $ENV{'PVM_ARCH'} eq 'SUN4SOL2' ) {
1741         push(@SysLibrary, '-lsocket', '-lnsl');
1742     }
1743 }
1744
1745 # Push the GNU multi-precision arith lib; and the math library
1746 push(@SysLibrary, '-lgmp');
1747 push(@SysLibrary, '-lm');
1748 \end{code}
1749
1750 %************************************************************************
1751 %*                                                                      *
1752 \subsection{Check that this system was built to do what we are asking}
1753 %*                                                                      *
1754 %************************************************************************
1755
1756 Before continuing we check that the appropriate build is available.
1757
1758 \begin{code}
1759 die "$Pgm: no BuildAvail?? $BuildTag\n" if ! $BuildAvail{$BuildTag}; # sanity
1760
1761 if ( $BuildAvail{$BuildTag} =~ /^-build-.*-not-defined$/ ) {
1762     print STDERR "$Pgm: a `", $BuildDescr{$BuildTag},
1763         "' \"build\" is not available with your GHC setup.\n";
1764     print STDERR "(It was not configured for it at your site.)\n";
1765     print STDERR $ShortUsage;
1766     exit 1;
1767 }
1768 \end{code}
1769
1770 %************************************************************************
1771 %*                                                                      *
1772 \subsection{Final miscellaneous setup bits before we start going}
1773 %*                                                                      *
1774 %************************************************************************
1775
1776 Record largest specific heapsize, if any.
1777 \begin{code}
1778 $Specific_heap_size = $Specific_heap_size * $Scale_sizes_by;
1779 push(@HsC_rts_flags, '-H'.$Specific_heap_size);
1780 $Specific_stk_size = $Specific_stk_size * $Scale_sizes_by;
1781 push(@HsC_rts_flags, (($RTS_style eq 'ghc') ? '-K' : '-A').$Specific_stk_size);
1782
1783 # hack to avoid running hscpp
1784 $HsCpp = $Cat if ! $Cpp_flag_set;
1785 \end{code}
1786
1787 If no input or link files seen, then we let 'em feed in stdin; this is
1788 mainly for debugging.
1789 \begin{code}
1790 if ($#Input_file < 0 && $#Link_file < 0) {
1791     push(@Input_file, '-');
1792 }
1793 \end{code}
1794
1795 Tell the world who we are, if they asked.
1796 \begin{code}
1797 if ($Verbose) {
1798     print STDERR "$(PROJECTNAME), version $(PROJECTVERSION) $(PROJECTPATCHLEVEL)\n";
1799 }
1800 \end{code}
1801
1802 %************************************************************************
1803 %*                                                                      *
1804 \section[Driver-main-loop]{Main loop: Process input files, and link if required}
1805 %*                                                                      *
1806 %************************************************************************
1807
1808 Process the input files; don't continue with linking if there are
1809 problems (global variable @$Status@ non-zero).
1810 \begin{code}
1811 foreach $ifile (@Input_file) {
1812     &ProcessInputFile($ifile);
1813 }
1814
1815 if ( $Status > 0 ) { # don't link if there were errors...
1816     print STDERR $ShortUsage;
1817     &tidy_up();
1818     exit $Status;
1819 }
1820 \end{code}
1821
1822 Link if appropriate.
1823 \begin{code}
1824 if ($Do_lnkr) {
1825     local($libdirs);
1826     # glue them together:
1827     push(@UserLibrary_dir, @SysLibrary_dir);
1828     if ($#UserLibrary_dir < 0) {
1829         $libdirs = '';
1830     } else {
1831         $libdirs = '-L' . join(' -L',@UserLibrary_dir);
1832     }
1833     # for a linker, use an explicitly given one, or the going C compiler ...
1834     local($lnkr) = ( $Lnkr ) ? $Lnkr : ($RegisteriseC ? $CcRegd : $CcUnregd );
1835
1836     local($output)= ($Specific_output_file ne '') ? "-o $Specific_output_file" : '';
1837     @Files_to_tidy = ( ($Specific_output_file ne '') ? "$Specific_output_file" : 'a.out' );
1838
1839     local($to_do) = "$lnkr $Verbose @Ld_flags $output @Link_file $TopClosureFile $libdirs @UserLibrary @SysLibrary";
1840     &run_something($to_do, 'Linker');
1841
1842     # finally, check the consistency info in the binary
1843     local($executable) = $Files_to_tidy[0];
1844     @Files_to_tidy = (); # reset; we don't want to nuke it if it's inconsistent
1845
1846     if ( $LinkChk ) {
1847         # dynamically load consistency-chking code; then do it.
1848         require('ghc-consist.prl')
1849             || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-consist.prl!\n");
1850
1851         &chk_consistency_info ( $executable );
1852     }
1853
1854     # if PVM parallel stuff, we do truly weird things.
1855     # Essentially: (1) move the executable over to where PVM expects
1856     # to find it.  (2) create a script in place of the executable
1857     # which will cause the program to be run, via SysMan.
1858     if ( $PARing eq 'p' ) {
1859         local($pvm_executable) = $executable;
1860         local($pvm_executable_base);
1861
1862         if ( $pvm_executable !~ /^\// ) { # a relative path name: make absolute
1863             local($pwd) = `pwd`;
1864             chop($pwd);
1865             $pwd =~ s/^\/tmp_mnt//;
1866             $pvm_executable = "$pwd/$pvm_executable";
1867         }
1868
1869         $pvm_executable =~ s|/|=|g; # make /s into =s
1870         $pvm_executable_base = $pvm_executable;
1871
1872         $pvm_executable = $ENV{'PVM_ROOT'} . '/bin/' . $ENV{'PVM_ARCH'}
1873                         . "/$pvm_executable";
1874
1875         &run_something("rm -f $pvm_executable; cp -p $executable $pvm_executable && rm -f $executable", 'Moving binary to PVM land');
1876
1877         # OK, now create the magic script for "$executable"
1878         open(EXEC, "> $executable") || &tidy_up_and_die(1,"$Pgm: couldn't open $executable to write!\n");
1879         print EXEC <<EOSCRIPT1;
1880 #!$(PERL)
1881 # =!=!=!=!=!=!=!=!=!=!=!
1882 # This script is automatically generated: DO NOT EDIT!!!
1883 # Generated by Glasgow Haskell, version $(PROJECTVERSION) $(PROJECTPATCHLEVEL)
1884 #
1885 \$pvm_executable      = '$pvm_executable';
1886 \$pvm_executable_base = '$pvm_executable_base';
1887 \$SysMan = '$SysMan';
1888 EOSCRIPT1
1889
1890         print EXEC <<\EOSCRIPT2;
1891 # first, some magical shortcuts to run "commands" on the binary
1892 # (which is hidden)
1893 if ($#ARGV == 1 && $ARGV[0] eq '+RTS' && $ARGV[1] =~ /^--(size|file|strip|rm)/ ) {
1894     local($cmd) = $1;
1895     system("$cmd $pvm_executable");
1896     exit(0); # all done
1897 }
1898
1899 # OK, really run it; process the args first
1900 $ENV{'PE'} = $pvm_executable_base;
1901 $debug = '';
1902 $nprocessors = 2; # the default
1903 @nonPVM_args = ();
1904 $in_RTS_args = 0;
1905
1906 # ToDo: handle --RTS
1907 args: while ($a = shift(@ARGV)) {
1908     if ( $a eq '+RTS' ) {
1909         $in_RTS_args = 1;
1910     } elsif ( $a eq '-RTS' ) {
1911         $in_RTS_args = 0;
1912     }
1913     if ( $a eq '-d' && $in_RTS_args ) {
1914         $debug = '-';
1915     } elsif ( $a =~ /^-N(\d+)/ && $in_RTS_args ) {
1916         $nprocessors = $1;
1917     } else {
1918         push(@nonPVM_args, $a);
1919     }
1920 }
1921
1922 exec "$SysMan $debug $nprocessors @nonPVM_args";
1923 print STDERR "Exec failed!!!: $SysMan $debug $nprocessors @nonPVM_args\n";
1924 exit(1);
1925 EOSCRIPT2
1926         close(EXEC) || die "Failed closing $executable\n";
1927         chmod 0755, "$executable";
1928     }
1929 }
1930
1931 # that...  that's all, folks!
1932 &tidy_up();
1933 exit $Status; # will still be 0 if all went well
1934 \end{code}
1935
1936 %************************************************************************
1937 %*                                                                      *
1938 \section[Driver-do-one-file]{How to process a single input file}
1939 %*                                                                      *
1940 %************************************************************************
1941
1942 \begin{code}
1943 sub ProcessInputFile {
1944     local($ifile) = @_; # input file name
1945     local($ifile_root); # root of or basename of input file
1946     local($ifile_root_file); # non-directory part of $ifile_root
1947 \end{code}
1948
1949 Handle the weirdity of input from stdin.
1950 \begin{code}
1951     if ($ifile eq '-') {
1952         open(INF, "> $Tmp_prefix.hs") || &tidy_up_and_die(1,"Can't open $Tmp_prefix.hs\n");
1953         print STDERR "Enter your Haskell program, end with ^D (on a line of its own):\n";
1954         while (<>) { print INF $_; }
1955         close(INF) || &tidy_up_and_die(1,"Failed writing to $Tmp_prefix.hs\n");
1956         $ifile = "$Tmp_prefix.hs";
1957         $ifile_root = '_stdin';
1958         $ifile_root_file = $ifile_root;
1959     } else {
1960         ($ifile_root = $ifile) =~ s/\.[^\.\/]+$//;
1961         ($ifile_root_file = $ifile_root) =~ s|.*/||;
1962     }
1963 \end{code}
1964
1965 We now decide what phases of the compilation system we will run over
1966 this file.  The defaults are the ones established when processing flags.
1967 (That established what the last phase run for all files is.)
1968
1969 The lower-case names are the local ones (as is usual), just for this
1970 one file.
1971 \begin{code}
1972     local($do_lit2pgm)  = $Do_lit2pgm;
1973     local($do_hscpp)    = $Do_hscpp;
1974     local($do_hsp)      = $Do_hsp;
1975     local($do_hsc)      = $Do_hsc;
1976     local($do_as)       = $Do_as;
1977     local($do_cc)       = ( $Do_cc != -1) # i.e., it was set explicitly
1978                           ? $Do_cc
1979                           : ( ($ProduceC) ? 1 : 0 );
1980 \end{code}
1981
1982 Look at the suffix and decide what initial phases of compilation may
1983 be dropped off for this file.  Also the rather boring business of
1984 which files are coming-in/going-out.
1985 \begin{code}
1986     # names of the files to stuff between phases
1987     # defaults are temporaries
1988     local($in_lit2pgm)    = $ifile;
1989     local($lit2pgm_hscpp) = "$Tmp_prefix.lpp";
1990     local($hscpp_hsp)     = "$Tmp_prefix.cpp";
1991     local($hsp_hsc)       = "$Tmp_prefix.hsp";
1992     local($hsc_cc)        = "$Tmp_prefix.hc";
1993
1994     # to help C compilers grok .hc files [ToDo: de-hackify]
1995     local($cc_help)       = "ghc$$.c";
1996     local($cc_help_s)     = "ghc$$.s";
1997
1998     local($hsc_hi)        = "$Tmp_prefix$HiSuffix";
1999     local($cc_as_o)       = "${Tmp_prefix}_o.s"; # temporary for raw .s file if opt C
2000     local($cc_as)         = "$Tmp_prefix.s";
2001     local($as_out)        = ($Specific_output_file ne '' && ! $Do_lnkr)
2002                                 ? $Specific_output_file
2003                                 : &odir_ify("${ifile_root}${Osuffix}");
2004
2005     local($is_hc_file)    = 1; #Is the C code .hc or .c
2006
2007     if ($ifile =~ /\.lhs$/) {
2008         push(@Link_file, &odir_ify("${ifile_root}${Osuffix}"));
2009     } elsif ($ifile =~ /\.hs$/) {
2010         $do_lit2pgm = 0;
2011         $lit2pgm_hscpp = $ifile;
2012         push(@Link_file, &odir_ify("${ifile_root}${Osuffix}"));
2013     } elsif ($ifile =~ /\.hc$/) {
2014         $do_lit2pgm = 0; $do_hscpp = 0; $do_hsp = 0; $do_hsc = 0; $do_cc = 1;
2015         $hsc_cc = $ifile;
2016         push(@Link_file, &odir_ify("${ifile_root}${Osuffix}"));
2017     } elsif ($ifile =~ /\.c$/) {
2018         $do_lit2pgm = 0; $do_hscpp = 0; $do_hsp = 0; $do_hsc = 0; $do_cc = 1;
2019         $hsc_cc = $ifile; $is_hc_file = 0;
2020         push(@Link_file, &odir_ify("${ifile_root}${Osuffix}"));
2021     } elsif ($ifile =~ /\.s$/) {
2022         $do_lit2pgm = 0; $do_hscpp = 0; $do_hsp = 0; $do_hsc = 0; $do_cc = 0;
2023         $cc_as = $ifile;
2024         push(@Link_file, &odir_ify("${ifile_root}${Osuffix}"));
2025     } else {
2026         if ($ifile !~ /\.a$/) {
2027             print STDERR "$Pgm: don't recognise suffix on `$ifile'; passing it through to linker\n";
2028         }
2029         $do_lit2pgm = 0; $do_hscpp = 0; $do_hsp = 0; $do_hsc = 0; $do_cc = 0; $do_as = 0;
2030         push(@Link_file, $ifile);
2031     }
2032 \end{code}
2033
2034 To get the output file name right: for each phase that we are {\em
2035 not} going to run, set its input (i.e., the output of its preceding phase) to
2036 @"$ifile_root.<suffix>"@.
2037 \begin{code}
2038     # lit2pgm -- no preceding phase
2039     if (! $do_hscpp) {
2040         $lit2pgm_hscpp = "$ifile_root.lpp????"; # not done
2041     }
2042     if (! $do_hsp) {
2043         $hscpp_hsp = "$ifile_root.cpp????"; # not done
2044     }
2045     if (! $do_hsc) {
2046         $hsp_hsc = "$ifile_root.hsp????"; # not done
2047     }
2048     if (! $do_cc) {
2049         $hsc_cc = &odir_ify("$ifile_root.hc");
2050     }
2051     if (! $do_as) {
2052         if ($Specific_output_file ne '') {
2053             $cc_as  = $Specific_output_file;
2054         } else {
2055             $cc_as  = &odir_ify(( $Only_preprocess_C ) ? "$ifile_root.i" : "$ifile_root.s");
2056         }
2057     }
2058 \end{code}
2059
2060 OK, now do it!  Note that we don't come back from a @run_something@ if
2061 it fails.
2062 \begin{code}
2063     if ($do_lit2pgm) {
2064         local($to_do) = "echo '#line 1 \"$in_lit2pgm\"' > $lit2pgm_hscpp; ".
2065                         "$Unlit @Unlit_flags $in_lit2pgm -  >> $lit2pgm_hscpp";
2066         @Files_to_tidy = ( $lit2pgm_hscpp );
2067         &run_something($to_do, 'literate pre-processor');
2068     }
2069     if ($do_hscpp) {
2070         # ToDo: specific output?
2071         if ($HsCpp eq $Cat) {
2072             local($to_do) = "echo '#line 1 \"$in_lit2pgm\"' > $hscpp_hsp; ".
2073                             "$HsCpp $lit2pgm_hscpp >> $hscpp_hsp";
2074             @Files_to_tidy = ( $hscpp_hsp );
2075             &run_something($to_do, 'Ineffective C pre-processor');
2076         } else {
2077             local($includes) = '-I' . join(' -I',@Include_dir);
2078             local($to_do) = "echo '#line 1 \"$in_lit2pgm\"' > $hscpp_hsp; ".
2079                             "$HsCpp $Verbose @HsCpp_flags -D__HASKELL1__=$haskell1_version -D__GLASGOW_HASKELL__=$ghc_version_info $includes $lit2pgm_hscpp >> $hscpp_hsp";
2080             @Files_to_tidy = ( $hscpp_hsp );
2081             &run_something($to_do, 'Haskellised C pre-processor');
2082         }
2083     }
2084     if ($do_hsp) {
2085         # glue imports onto HsP_flags
2086         # if new parser, then put a comma on the front of all of them.
2087         local($hsprefix) = ($do_hsp == 2) ? ',' : '';
2088
2089         foreach $a   ( @HsP_flags  )    { $a = "$hsprefix$a" unless $a =~ /^,/; }
2090         foreach $dir ( @Import_dir )    { push(@HsP_flags, "$hsprefix-I$dir"); }
2091         foreach $dir ( @SysImport_dir ) { push(@HsP_flags, "$hsprefix-J$dir"); }
2092     }
2093
2094     if ($do_hsp == 1) { # "old" parser
2095         local($to_do) = "$HsP $Verbose @HsP_flags $hscpp_hsp > $hsp_hsc";
2096         @Files_to_tidy = ( $hsp_hsc );
2097         &run_something($to_do, 'Haskell parser');
2098         if ($Dump_parser_output) {
2099             print STDERR `$Cat $hsp_hsc`;
2100         }
2101         @HsP_flags = (); # reset!
2102     }
2103     if ($do_hsc) {
2104         # here, we may produce .hc and/or .hi files
2105         local($output)    = '';
2106         local($c_source)  = "$ifile_root.hc";
2107         local($c_output)  = $hsc_cc;         # defaults
2108         local($s_output)  = $cc_as;
2109         local($hi_output) = "$ifile_root$HiSuffix";
2110         local($going_interactive) = 0;
2111
2112         if ($Specific_output_file ne '' && ! $do_cc) {
2113             $c_source = $c_output = $Specific_output_file;
2114             @Files_to_tidy = ( $Specific_output_file ) if $Specific_output_file ne '-';
2115         }
2116         if ($Specific_hi_file ne '') {
2117             # we change the suffix (-hisuf) even if a specific -ohi file:
2118             $Specific_hi_file =~ s/\.hi$/$HiSuffix/;
2119             $hi_output = $Specific_hi_file;
2120             @Files_to_tidy = ( $Specific_hi_file ) if $Specific_hi_file ne '-';
2121         }
2122
2123         if ( ! ($ProduceC || $ProduceS)
2124             || $ifile_root eq '_stdin'  # going interactive...
2125             || ($c_output eq '-' && $hi_output eq '-')) {
2126             $going_interactive = 1;
2127 #OLD:       $output = '1>&2';   # interactive/debugging, to stderr
2128             @Files_to_tidy = ();
2129             # don't need .hi (unless magic value "2" says we wanted it anyway):
2130             if ( $ProduceHi == 2 ) {
2131                 $output .= " -hi$hsc_hi";
2132                 unlink($hsc_hi); # needs to be cleared; will be appended to
2133             } else {
2134                 $ProduceHi = 0;
2135             }
2136             $do_cc = 0; $do_as = 0; $Do_lnkr = 0; # and we won't go any further...
2137         }
2138
2139         if ( ! $going_interactive ) {
2140             if ( $ProduceHi ) {
2141                 # we always go to a temp file for these (for later diff'ing)
2142                 $output = "-hi$hsc_hi";
2143                 unlink($hsc_hi); # needs to be cleared; will be appended to
2144                 @Files_to_tidy = ( $hsc_hi );
2145             }
2146             if ( $ProduceC ) {
2147                 $output .= " -C$c_output";
2148                 push(@Files_to_tidy, $c_output);
2149
2150                 open(CFILE, "> $c_output") || &tidy_up_and_die(1,"$Pgm: failed to open `$c_output' (to write)\n");
2151                 print CFILE "#line 2 \"$c_source\"\n";
2152                 close(CFILE) || &tidy_up_and_die(1,"Failed writing to $c_output\n");
2153                 # the "real" C output will then be appended
2154             }
2155             if ( $ProduceS ) {
2156                 $output .= " -fasm-$ProduceS -S$s_output";
2157                 push(@Files_to_tidy, $s_output);
2158
2159                 # ToDo: ummm,... this isn't doing anything (WDP 94/11)
2160                 open(SFILE, "> $s_output") || &tidy_up_and_die(1,"$Pgm: failed to open `$s_output' (to write)\n");
2161                 close(SFILE) || &tidy_up_and_die(1,"Failed writing to $s_output\n");
2162                 # the "real" assembler output will then be appended
2163             }
2164         }
2165
2166         # if we're compiling foo.hs, we want the GC stats to end up in foo.stat
2167         if ( $CollectingGCstats ) {
2168             if ($RTS_style eq 'hbc') {
2169                 push(@HsC_rts_flags, '-S'); # puts it in "STAT"
2170             } else {
2171                 push(@HsC_rts_flags, "-S$ifile_root.stat");
2172                 push(@Files_to_tidy, "$ifile_root.stat");
2173             }
2174         }
2175
2176         if ( $CollectGhcTimings ) { # assume $RTS_style eq 'ghc'
2177             # emit nofibbish time/bytes-alloc stats to stderr;
2178             # see later .stat file post-processing
2179             push(@HsC_rts_flags, "-s$Tmp_prefix.stat");
2180             push(@Files_to_tidy, "$Tmp_prefix.stat");
2181         }
2182
2183         local($dump);
2184         if ($Specific_dump_file ne '') {
2185             $dump = "2>> $Specific_dump_file";
2186             $Using_dump_file = 1;
2187         } else {
2188             $dump = '';
2189         }
2190
2191         local($to_do);
2192         if ($RTS_style eq 'hbc') {
2193             # NB: no parser flags
2194             $to_do = "$HsC < $hsp_hsc $dump @HsC_rts_flags - @HsC_flags $CoreLint $Verbose $output";
2195         } elsif ($do_hsp == 1) { # old style parser -- no HsP_flags
2196             $to_do = "$HsC < $hsp_hsc $dump @HsC_flags $CoreLint $Verbose $output +RTS @HsC_rts_flags";
2197         } else { # new style
2198             $to_do = "$HsC ,-H @HsP_flags ,$hscpp_hsp $dump @HsC_flags $CoreLint $Verbose $output +RTS @HsC_rts_flags";
2199         }
2200         &run_something($to_do, 'Haskell compiler');
2201
2202         # compensate further for HBC's -S rts opt:
2203         if ($CollectingGCstats && $RTS_style eq 'hbc') {
2204             unlink("$ifile_root.stat");
2205             rename('STAT', "$ifile_root.stat");
2206         }
2207
2208         # finish business w/ nofibbish time/bytes-alloc stats
2209         &process_ghc_timings() if $CollectGhcTimings;
2210
2211         # if non-interactive, heave in the consistency info at the end
2212         # NB: pretty hackish (depends on how $output is set)
2213         if ( ! $going_interactive ) {
2214             if ( $ProduceC ) {
2215             $to_do = "echo 'static char ghc_hsc_ID[] = \"\@(#)hsc $ifile\t$HsC_major_version.$HsC_minor_version,$HsC_consist_options\";' >> $c_output";
2216             }
2217             if ( $ProduceS ) {
2218                 local($consist) = "hsc.$ifile.$HsC_major_version.$HsC_minor_version.$HsC_consist_options";
2219                 $consist =~ s/,/./g;
2220                 $consist =~ s/\//./g;
2221                 $consist =~ s/-/_/g;
2222                 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
2223                 $to_do = "echo '\n\t.text\n$consist:' >> $s_output";
2224             }
2225             &run_something($to_do, 'Pin on Haskell consistency info');
2226         }
2227
2228         # call the special mangler to produce the .hi/.h(h?) files...
2229         &diff_hi_file($hsc_hi, $hi_output)
2230                 if $ProduceHi == 1 && ! $going_interactive;
2231 #OLD:   &extract_c_and_hi_files("$Tmp_prefix.hsc", $c_output, $hi_output, $c_source)
2232
2233         # if we produced an interface file "no matter what",
2234         # print what we got on stderr (ToDo: honor -ohi flag)
2235         if ( $ProduceHi == 2 ) {
2236             print STDERR `$Cat $hsc_hi`;
2237         }
2238
2239         # save a copy of the .hc file, even if we are carrying on...
2240         if ($ProduceC && $do_cc && $Keep_hc_file_too) {
2241             local($to_do) = "$(RM) $ifile_root.hc; cp $c_output $ifile_root.hc";
2242             &run_something($to_do, 'Saving copy of .hc file');
2243         }
2244
2245         # save a copy of the .s file, even if we are carrying on...
2246         if ($ProduceS && $do_as && $Keep_s_file_too) {
2247             local($to_do) = "$(RM) $ifile_root.s; cp $cc_as $ifile_root.s";
2248             &run_something($to_do, 'Saving copy of .s file');
2249         }
2250
2251         # if we're going to split up object files,
2252         # we inject split markers into the .hc file now
2253         if ( $ProduceC && $SplitObjFiles ) {
2254             &inject_split_markers ( $c_output );
2255         }
2256     }
2257     if ($do_cc) {
2258         local($includes) = '-I' . join(' -I',@Include_dir);
2259         local($cc);
2260         local($s_output);
2261         local($c_flags) = "@CcBoth_flags";
2262         local($ddebug_flag) = ( $DEBUGging ) ? '-DDEBUG' : '';
2263         if ($RegisteriseC) {
2264             $cc       = $CcRegd;
2265             $s_output = ($is_hc_file || $TargetPlatform =~ /^hppa/) ? $cc_as_o : $cc_as;
2266             $c_flags .= " @CcRegd_flags";
2267             $c_flags .= ($is_hc_file) ? " @CcRegd_flags_hc"  : " @CcRegd_flags_c";
2268         } else {
2269             $cc       = $CcUnregd;
2270             $s_output = $cc_as;
2271             $c_flags .= " @CcUnregd_flags";
2272             $c_flags .= ($is_hc_file) ? " @CcUnregd_flags_hc" : " @CcUnregd_flags_c";
2273         }
2274
2275         # C compiler won't like the .hc extension.  So we create
2276         # a tmp .c file which #include's the needful.
2277         open(TMP, "> $cc_help") || &tidy_up_and_die(1,"$Pgm: failed to open `$cc_help' (to write)\n");
2278         if ( $is_hc_file ) {
2279             print TMP <<EOINCL;
2280 #ifdef __STG_GCC_REGS__
2281 # if ! (defined(MAIN_REG_MAP) || defined(MARK_REG_MAP) || defined(SCAN_REG_MAP) || defined(SCAV_REG_MAP) || defined(FLUSH_REG_MAP))
2282 #  define MAIN_REG_MAP
2283 # endif
2284 #endif
2285 #include "stgdefs.h"
2286 EOINCL
2287             # user may have asked for #includes to be injected...
2288             print TMP @CcInjects if $#CcInjects >= 0;
2289         }
2290         # heave in the consistency info
2291         print TMP "static char ghc_cc_ID[] = \"\@(#)cc $ifile\t$Cc_major_version.$Cc_minor_version,$Cc_consist_options\";\n";
2292
2293         # and #include the real source
2294         print TMP "#include \"$hsc_cc\"\n";
2295         close(TMP) || &tidy_up_and_die(1,"Failed writing to $cc_help\n");
2296
2297         local($to_do) = "$cc $Verbose $ddebug_flag $c_flags @Cpp_define -D__HASKELL1__=$haskell1_version $includes $cc_help > $Tmp_prefix.ccout 2>&1 && ( if [ $cc_help_s != $s_output ] ; then mv $cc_help_s $s_output ; else exit 0 ; fi )";
2298         # note: __GLASGOW_HASKELL__ is pointedly *not* #defined at the C level.
2299         if ( $Only_preprocess_C ) { # HACK ALERT!
2300             $to_do =~ s/ -S\b//g;
2301         }
2302         @Files_to_tidy = ( $cc_help, $cc_help_s, $s_output );
2303         $PostprocessCcOutput = 1;       # hack, dear hack...
2304         &run_something($to_do, 'C compiler');
2305         $PostprocessCcOutput = 0;
2306         unlink($cc_help, $cc_help_s);
2307
2308         if ( ($RegisteriseC && $is_hc_file)
2309           || $Dump_asm_insn_counts
2310           || $Dump_asm_globals_info ) {
2311             # dynamically load assembler-fiddling code, which we are about to use
2312             local($target) = '';
2313             $target = 'alpha'   if $TargetPlatform =~ /^alpha-/;
2314             $target = 'hppa'    if $TargetPlatform =~ /^hppa/;
2315             $target = 'iX86'    if $TargetPlatform =~ /^i[34]86-/;
2316             $target = 'm68k'    if $TargetPlatform =~ /^m68k-/;
2317             $target = 'mips'    if $TargetPlatform =~ /^mips-/;
2318             $target = 'solaris' if $TargetPlatform =~ /^sparc-sun-solaris2/;
2319             $target = 'sparc'   if $TargetPlatform =~ /^sparc-sun-sunos4/;
2320             $target ne ''
2321             || &tidy_up_and_die(1,"$Pgm: panic: can't decipher $TargetPlatform!\n");
2322             require("ghc-asm-$target.prl")
2323             || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm-$target.prl!\n");
2324         }
2325
2326         if ( $Dump_raw_asm ) { # to stderr, before mangling
2327             local($to_pr) = ($RegisteriseC) ? $cc_as_o : $cc_as ;
2328             print STDERR `cat $to_pr`;
2329         }
2330
2331         if ($RegisteriseC) {
2332             if ($is_hc_file) {
2333                 # post-process the assembler [.hc files only]
2334                 &mangle_asm($cc_as_o, $cc_as);
2335             } elsif ($TargetPlatform =~ /^hppa/) {
2336                 # minor mangling of non-threaded files for hp-pa only
2337                 require("ghc-asm-hppa.prl")
2338                 || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm-hppa.prl!\n");
2339                 &mini_mangle_asm($cc_as_o, $cc_as);
2340             }
2341         }
2342
2343         # collect interesting (static-use) info
2344         &dump_asm_insn_counts($cc_as)  if $Dump_asm_insn_counts;
2345         &dump_asm_globals_info($cc_as) if $Dump_asm_globals_info;
2346
2347         # save a copy of the .s file, even if we are carrying on...
2348         if ($do_as && $Keep_s_file_too) {
2349             local($to_do) = "$(RM) $ifile_root.s; cp $cc_as $ifile_root.s";
2350             &run_something($to_do, 'Saving copy of .s file');
2351         }
2352     }
2353
2354     if ($do_as) {
2355         # if we're splitting .o files...
2356         if ( $SplitObjFiles ) {
2357             &split_asm_file ( $cc_as );
2358         }
2359
2360         local($asmblr) = ( $As ) ? $As : ($RegisteriseC ? $CcRegd : $CcUnregd );
2361
2362         if ( ! $SplitObjFiles ) {
2363             local($to_do)  = "$asmblr -o $as_out -c @As_flags $cc_as";
2364             @Files_to_tidy = ( $as_out );
2365             &run_something($to_do, 'Unix assembler');
2366
2367         } else { # more complicated split-ification...
2368
2369             # must assemble files $Tmp_prefix__[1 .. $NoOfSplitFiles].s
2370
2371             for ($f = 1; $f <= $NoOfSplitFiles; $f++ ) {
2372                 local($split_out) = &odir_ify("${ifile_root}__${f}${Osuffix}");
2373                 local($to_do) = "$asmblr -o $split_out -c @As_flags ${Tmp_prefix}__${f}.s";
2374                 @Files_to_tidy = ( $split_out );
2375
2376                 &run_something($to_do, 'Unix assembler');
2377             }
2378         }
2379     }
2380 } # end of ProcessInputFile
2381 \end{code}
2382
2383 %************************************************************************
2384 %*                                                                      *
2385 \section[Driver-misc-utils]{Miscellaneous utilities}
2386 %*                                                                      *
2387 %************************************************************************
2388
2389 %************************************************************************
2390 %*                                                                      *
2391 \subsection[Driver-odir-ify]{@odir_ify@: Mangle filename if \tr{-odir} set}
2392 %*                                                                      *
2393 %************************************************************************
2394
2395 \begin{code}
2396 sub odir_ify {
2397     local($orig_file) = @_;
2398     if ($Specific_output_dir eq '') {   # do nothing
2399         return($orig_file);
2400     } else {
2401         local ($orig_file_only);
2402         ($orig_file_only = $orig_file) =~ s|.*/||;
2403         return("$Specific_output_dir/$orig_file_only");
2404     }
2405 }
2406 \end{code}
2407
2408 %************************************************************************
2409 %*                                                                      *
2410 \subsection[Driver-run-something]{@run_something@: Run a phase}
2411 %*                                                                      *
2412 %************************************************************************
2413
2414 \begin{code}
2415 sub run_something {
2416     local($str_to_do, $tidy_name) = @_;
2417
2418     print STDERR "\n$tidy_name:\n\t" if $Verbose;
2419     print STDERR "$str_to_do\n" if $Verbose;
2420
2421     if ($Using_dump_file) {
2422         open(DUMP, ">> $Specific_dump_file")
2423             || &tidy_up_and_die(1,"$Pgm: failed to open `$Specific_dump_file'\n");
2424         print DUMP "\nCompilation Dump for: $str_to_do\n\n";
2425         close(DUMP)
2426             || &tidy_up_and_die(1,"$Pgm: failed closing `$Specific_dump_file'\n");
2427     }
2428
2429     local($return_val) = 0;
2430     system("$Time $str_to_do");
2431     $return_val = $?;
2432
2433     if ( $PostprocessCcOutput ) { # hack, continued
2434         open(CCOUT, "< $Tmp_prefix.ccout")
2435             || &tidy_up_and_die(1,"$Pgm: failed to open `$Tmp_prefix.ccout'\n");
2436         while ( <CCOUT> ) {
2437             next if /attribute directive ignored/;
2438             next if /call-clobbered/;
2439             next if /In file included .*stgdefs/;
2440             next if /from .*rtsdefs.h:/;
2441             next if /from ghc\d+.c:\d+:/;
2442             next if /from .*\.lc/;
2443             next if /from .*SMinternal\.lh/;
2444             next if /ANSI C does not support \`long long\'/;
2445             next if /warning:.*was declared \`extern\' and later \`static\'/;
2446             next if /warning: assignment discards \`const\' from pointer target type/;
2447             next if /: At top level:$/;
2448             next if /: In function \`.*\':$/;
2449             next if /\`ghc_cc_ID\' defined but not used/;
2450             print STDERR $_;
2451         }
2452         close(CCOUT) || &tidy_up_and_die(1,"$Pgm: failed closing `$Tmp_prefix.ccout'\n");
2453     }
2454
2455     if ($return_val != 0) {
2456         if ($Using_dump_file) {
2457             print STDERR "Compilation Errors dumped in $Specific_dump_file\n";
2458         }
2459
2460         &tidy_up_and_die($return_val, '');
2461     }
2462     $Using_dump_file = 0;
2463 }
2464 \end{code}
2465
2466 %************************************************************************
2467 %*                                                                      *
2468 \subsection[Driver-demangle-C-and-hi]{@extract_c_and_hi_files@: Unscramble Haskell-compiler output}
2469 %*                                                                      *
2470 %************************************************************************
2471
2472 Update interface if the tmp one is newer...
2473 We first have to fish the module name out of the interface.
2474 \begin{code}
2475 sub diff_hi_file {
2476     local($tmp_hi_file, $hi_file) = @_;
2477     local($if_modulename) = '';
2478
2479     # extract the module name
2480
2481     open(TMP,   "< $tmp_hi_file")|| &tidy_up_and_die(1,"$Pgm: failed to open `$tmp_hi_file' (to read)\n");
2482     while (<TMP>) {
2483         if ( /^interface ([A-Za-z0-9'_]+) / ) {
2484             $if_modulename = $1;
2485         }
2486     }
2487     close(TMP) || &tidy_up_and_die(1,"Failed reading from $tmp_hi_file\n");
2488     &tidy_up_and_die(1,"No module name in $tmp_hi_file\n")
2489         if ! $if_modulename;
2490
2491     #compare/diff with old one
2492
2493     if ($hi_file eq '-') {
2494         &run_something("cat $tmp_hi_file", "copy interface to stdout");
2495
2496     } else {
2497         if ($Specific_hi_file eq '' && $if_modulename ne '') {
2498             if ( $hi_file =~ /\// ) {
2499                  $hi_file =~ s/\/[^\/]+$//;
2500                  $hi_file .= "/$if_modulename$HiSuffix";
2501             } else {
2502                 $hi_file = "$if_modulename$HiSuffix";
2503             }
2504             print STDERR "interface really going into: $hi_file\n" if $Verbose;
2505         }
2506
2507         if ($HiDiff_flag && -f $hi_file) {
2508             local($diffcmd) = '$(CONTEXT_DIFF)';
2509
2510             &run_something("cmp -s $tmp_hi_file $hi_file || $(CONTEXT_DIFF) $hi_file $tmp_hi_file 1>&2 || exit 0",
2511                 "Diff'ing old and new $HiSuffix files"); # NB: to stderr
2512         }
2513
2514         &run_something("cmp -s $tmp_hi_file $hi_file || ( $(RM) $hi_file && $(CP) $tmp_hi_file $hi_file )",
2515                        "Comparing old and new $HiSuffix files");
2516     }
2517 }
2518 \end{code}
2519
2520 %************************************************************************
2521 %*                                                                      *
2522 \subsection[Driver-ghctiming]{Emit nofibbish GHC timings}
2523 %*                                                                      *
2524 %************************************************************************
2525
2526 NB: nearly the same as in @runstdtest@ script.
2527
2528 \begin{code}
2529 sub process_ghc_timings {
2530     local($StatsFile) = "$Tmp_prefix.stat";
2531     local($SysSpecificTiming) = 'ghc';
2532
2533     open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n";
2534     while (<STATS>) {
2535         $BytesAlloc = $1 if /^\s*([0-9,]+) bytes allocated in the heap/;
2536
2537         if ( /^\s*([0-9,]+) bytes maximum residency .* (\d+) sample/ ) {
2538             $MaxResidency = $1; $ResidencySamples = $2;
2539         }
2540
2541         $GCs = $1 if /^\s*([0-9,]+) garbage collections? performed/;
2542
2543         if ( /^\s*INIT\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) {
2544             $InitTime = $1; $InitElapsed = $2;
2545         } elsif ( /^\s*MUT\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) {
2546             $MutTime = $1; $MutElapsed = $2;
2547         } elsif ( /^\s*GC\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) {
2548             $GcTime = $1; $GcElapsed = $2;
2549         }
2550     }
2551     close(STATS) || die "Failed when closing $StatsFile\n";
2552
2553     # warn about what we didn't find
2554     print STDERR "Warning: BytesAlloc not found in stats file\n" unless defined($BytesAlloc);
2555     print STDERR "Warning: GCs not found in stats file\n" unless defined($GCs);
2556     print STDERR "Warning: InitTime not found in stats file\n" unless defined($InitTime);
2557     print STDERR "Warning: InitElapsed not found in stats file\n" unless defined($InitElapsed);
2558     print STDERR "Warning: MutTime not found in stats file\n" unless defined($MutTime);
2559     print STDERR "Warning: MutElapsed not found in stats file\n" unless defined($MutElapsed);
2560     print STDERR "Warning: GcTime inot found in stats file\n" unless defined($GcTime);
2561     print STDERR "Warning: GcElapsed not found in stats file\n" unless defined($GcElapsed);
2562
2563     # things we didn't necessarily expect to find
2564     $MaxResidency     = 0 unless defined($MaxResidency);
2565     $ResidencySamples = 0 unless defined($ResidencySamples);
2566
2567     # a bit of tidying
2568     $BytesAlloc =~ s/,//g;
2569     $MaxResidency =~ s/,//g;
2570     $GCs =~ s/,//g;
2571     $InitTime =~ s/,//g;
2572     $InitElapsed =~ s/,//g;
2573     $MutTime =~ s/,//g;
2574     $MutElapsed =~ s/,//g;
2575     $GcTime =~ s/,//g;
2576     $GcElapsed =~ s/,//g;
2577
2578     # print out what we found
2579     print STDERR "<<$SysSpecificTiming: ",
2580         "$BytesAlloc bytes, $GCs GCs, $MaxResidency bytes residency ($ResidencySamples samples), $InitTime INIT ($InitElapsed elapsed), $MutTime MUT ($MutElapsed elapsed), $GcTime GC ($GcElapsed elapsed)",
2581         " :$SysSpecificTiming>>\n";
2582
2583     # OK, party over
2584     unlink $StatsFile;
2585 }
2586 \end{code}
2587
2588 %************************************************************************
2589 %*                                                                      *
2590 \subsection[Driver-dying]{@tidy_up@ and @tidy_up_and_die@: Dying gracefully}
2591 %*                                                                      *
2592 %************************************************************************
2593
2594 \begin{code}
2595 sub tidy_up {
2596     local($to_do) = "\n$(RM) $Tmp_prefix*";
2597     if ( $Tmp_prefix !~ /^\s*$/ ) {
2598         print STDERR "$to_do\n" if $Verbose;
2599         system($to_do);
2600     }
2601 }
2602
2603 sub tidy_up_and_die {
2604     local($return_val, $msg) = @_;
2605
2606     # delete any files to tidy
2607     print STDERR "deleting... @Files_to_tidy\n" if $Verbose && $#Files_to_tidy >= 0;
2608     unlink @Files_to_tidy if $#Files_to_tidy >= 0;
2609
2610     &tidy_up();
2611     print STDERR $msg;
2612     exit (($return_val == 0) ? 0 : 1);
2613 }
2614 \end{code}
2615
2616 %************************************************************************
2617 %*                                                                      *
2618 \subsection[Driver-arg-with-arg]{@grab_arg_arg@: Do an argument with an argument}
2619 %*                                                                      *
2620 %************************************************************************
2621
2622 Some command-line arguments take an argument, e.g.,
2623 \tr{-Rmax-heapsize} expects a number to follow.  This can either be
2624 given a part of the same argument (\tr{-Rmax-heapsize8M}) or as the
2625 next argument (\tr{-Rmax-heapsize 8M}).  We allow both cases.
2626
2627 Note: no error-checking; \tr{-Rmax-heapsize -Rgc-stats} will silently
2628 gobble the second argument (and probably set the heapsize to something
2629 nonsensical). (ToDo?)
2630 \begin{code}
2631 sub grab_arg_arg {
2632     local($option, $rest_of_arg) = @_;
2633
2634     if ($rest_of_arg) {
2635         return($rest_of_arg);
2636     } elsif ($#ARGV >= 0) {
2637         local($temp) = $ARGV[0]; shift(@ARGV);
2638         return($temp);
2639     } else {
2640         print STDERR "$Pgm: no argument following $option option\n";
2641         $Status++;
2642     }
2643 }
2644 \end{code}
2645
2646 \begin{code}
2647 sub isntAntiFlag {
2648     local($flag) = @_;
2649     local($f);
2650
2651 #Not in HsC_antiflag ## NO!: and not already in HsC_flags
2652
2653     foreach $f ( @HsC_antiflags ) {
2654         return(0) if $flag eq $f;
2655     }
2656 #    foreach $f ( @HsC_flags ) {
2657 #       return(0) if $flag eq $f;
2658 #    }
2659     return(1);
2660 }
2661
2662 sub squashHscFlag {  # pretty terrible
2663     local($flag) = @_;
2664     local($f);
2665
2666     foreach $f ( @HsC_flags ) {
2667         if ($flag eq $f) { $f = ''; }
2668     }
2669 }
2670
2671 sub add_Hsc_flags {
2672     local(@flags) = @_;
2673     local($f);
2674
2675     foreach $f ( @flags ) {
2676         push( @HsC_flags, $f ) if &isntAntiFlag($f);
2677     }
2678 }
2679 \end{code}