ghc/driver/ghc.lprl

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1997
   3 %
   4
   5 This is the driver script for the Glasgow Haskell compilation system.
   6 It is written in \tr{perl}.  The first section includes a long
   7 ``usage'' message that describes how the driver is supposed to work.
   8
   9 %************************************************************************
  10 %*                                                                      *
  11 \section[Driver-usage]{Usage message}
  12 %*                                                                      *
  13 %************************************************************************
  14
  15 \begin{code}
  16 ($Pgm = $0) =~ s|.*/||;
  17 $ShortUsage  =  "\nUsage: For basic information, try the `-help' option.\n";
  18 $LongUsage = "\n" . <<EOUSAGE;
  19 Use of the Glorious Haskell Compilation System driver:
  20
  21     $Pgm [command-line-options-and-input-files]
  22
  23 ------------------------------------------------------------------------
  24 This driver ($Pgm) guides each input file through (some of the)
  25 possible phases of a compilation:
  26
  27     - unlit:    extract code from a "literate program"
  28     - hscpp:    run code through the C pre-processor (if -cpp flag given)
  29     - hsc:      run the Haskell compiler proper
  30     - gcc:      run the C compiler (if compiling via C)
  31     - as:       run the assembler
  32     - ld:       run the linker
  33
  34 For each input file, the phase to START with is determined by the
  35 file's suffix:
  36     - .lhs      literate Haskell: unlit
  37     - .hs       illiterate Haskell: hsc
  38     - .hc       C from the Haskell compiler: gcc
  39     - .c        C not from the Haskell compiler: gcc
  40     - .s        assembly language: as
  41     - other     passed directly to the linker: ld
  42
  43 If no files are given on the command line, input is taken from
  44 standard input, and processing is as for an .hs file.  (All output is
  45 to stdout or stderr, however).
  46
  47 The phase at which to STOP processing is determined by a command-line
  48 option:
  49     -C          stop after generating C (.hc output)
  50     -E          stop after generating preprocessed C (.i output)
  51     -S          stop after generating assembler (.s output)
  52     -c          stop after generating object files (.o output)
  53
  54 Other commonly-used options are:
  55
  56     -O          An `optimising' package of compiler flags, for faster code
  57
  58     -prof       Compile for cost-centre profiling
  59                 (add -auto for automagic cost-centres on top-level functions)
  60
  61     -fglasgow-exts  Allow Glasgow extensions (unboxed types, etc.)
  62
  63     -H14m       Increase compiler's heap size
  64
  65     -M          Output the Makefile rules recording the
  66                 dependencies of a list of Haskell files.
  67                 (ghc driver just calls upon the help of a
  68                  compatible mkdependHS script to do the
  69                  actual processing)
  70
  71 The User's Guide has more information about GHC's *many* options.
  72
  73 Given the above, here are some TYPICAL invocations of $Pgm:
  74
  75     # compile a Haskell module to a .o file, optimising:
  76     % $Pgm -c -O Foo.hs
  77     # link three .o files into an executable called "test":
  78     % $Pgm -o test Foo.o Bar.o Baz.o
  79     # compile a Haskell module to C (a .hc file), using a bigger heap:
  80     % $Pgm -C -H16m Foo.hs
  81     # compile Haskell-produced C (.hc) to assembly language:
  82     % $Pgm -S Foo.hc
  83 ------------------------------------------------------------------------
  84 EOUSAGE
  85 \end{code}
  86
  87 %************************************************************************
  88 %*                                                                      *
  89 \section[Driver-init]{Initialisation}
  90 %*                                                                      *
  91 %************************************************************************
  92
  93 The driver script need to be told where to find these executables, so
  94 in the course of building the driver `executable', make-variables holding
  95 these are prepended to the de-litted version of this file. The variables are:
  96
  97 \begin{verbatim}
  98 INSTALLING
  99
 100 HOSTPLATFORM TARGETPLATFORM
 101
 102 PROJECTNAME PROJECTVERSION PROJECTPATCHLEVEL
 103
 104 TOP_PWD
 105
 106 bindir libdir datadir
 107
 108 CURRENT_DIR TMPDIR
 109
 110 GHC_LIB_DIR GHC_RUNTIME_DIR GHC_UTILS_DIR GHC_INCLUDE_DIR
 111
 112 GHC_OPT_HILEV_ASM GhcWithNativeCodeGen
 113
 114 GHC_UNLIT GHC_HSCPP GHC_HSC GHC_SYSMAN
 115
 116 CP RM CONTEXT_DIFF
 117
 118 WAY_*_NAME WAY_*_HC_OPTS
 119
 120 LeadingUnderscore
 121
 122 \end{verbatim}
 123
 124 Establish what executables to run for the various phases, what the
 125 default options are for those phases, and other similar boring stuff.
 126
 127 \begin{code}
 128 select(STDERR); $| = 1; select(STDOUT); # no STDERR buffering, please.
 129
 130 $TargetPlatform = $TARGETPLATFORM;
 131
 132 $TopPwd            = "${TOP_PWD}";
 133 $InstBinDirGhc     = "${bindir}";
 134 $InstLibDirGhc     = "${libdir}";
 135 $InstLibexecDirGhc = "${libexecdir}";
 136 $InstDataDirGhc    = "${datadir}";
 137 $InstSysLibDir     = ( $INSTALLING ) ? "${InstLibDirGhc}/hslibs" :
 138                         "$TopPwd/hslibs";
 139
 140 $Status  = 0; # just used for exit() status
 141 $Verbose = '';
 142
 143 # set up signal handler
 144 sub quit_upon_signal { &tidy_up_and_die(1, ''); }
 145 $SIG{'INT'}  = 'quit_upon_signal';
 146 $SIG{'QUIT'} = 'quit_upon_signal';
 147
 148 # where to get "require"d .prl files at runtime (poor man's dynamic loading)
 149 #   (use LIB, not DATA, because we can't be sure of arch-independence)
 150 @INC = ( ( $INSTALLING ) ? $InstLibDirGhc
 151                            : "$TopPwd/${CURRENT_DIR}" );
 152
 153 if ( $ENV{'TMPDIR'} ) { # where to make tmp file names
 154     $Tmp_prefix = ($ENV{'TMPDIR'} . "/ghc$$");
 155 } else {
 156     print STDERR "TMPDIR has not been set to anything useful!\n" if (${TMPDIR} eq '');
 157     $Tmp_prefix ="${TMPDIR}/ghc$$"; # TMPDIR set via Makefile when booting..
 158     $ENV{'TMPDIR'} = ${TMPDIR}; # set the env var as well
 159 }
 160
 161 @Files_to_tidy = (); # files we nuke in the case of abnormal termination
 162
 163 $Unlit = ( $INSTALLING ) ? "$InstLibexecDirGhc/unlit"
 164                          : "$TopPwd/${CURRENT_DIR}/${GHC_UNLIT}";
 165
 166 $Cp   = $CP;
 167 $Rm   = $RM;
 168 $Diff = $CONTEXT_DIFF;
 169 $Cat  = 'cat';
 170 $Cmp  = 'cmp';
 171 $Time = '';
 172
 173 $HsCpp   = # but this is re-set to "cat" (after options) if -cpp not seen
 174            ( $INSTALLING ) ? "$InstLibexecDirGhc/hscpp"
 175                            : "$TopPwd/${CURRENT_DIR}/${GHC_HSCPP}";
 176
 177 @HsCpp_flags    = ();
 178 $genSPECS_flag  = '';           # See ../utils/hscpp/hscpp.prl
 179 $HsC     = ( $INSTALLING ) ? "$InstLibexecDirGhc/hsc"
 180                            : "$TopPwd/${CURRENT_DIR}/${GHC_HSC}";
 181
 182 # For PVM fiends only
 183 $SysMan  = ( $INSTALLING ) ? "$InstLibexecDirGhc/SysMan"
 184                            : "$TopPwd/${CURRENT_DIR}/${GHC_SYSMAN}";
 185
 186 @Unlit_flags    = ();
 187
 188 #
 189 # HsC_rts_flags: if we want to talk to the LML runtime system
 190 # NB: we don't use powers-of-2 sizes, because this may do
 191 #   terrible things to cache behavior.
 192 #
 193 $Specific_heap_size = 6 * 1000 * 1000;
 194 $Specific_stk_size  = 1000 * 1000;
 195 $Scale_sizes_by     = 1.0;
 196
 197 \end{code}
 198
 199 The variables set by @setupOptFlags@ represent parts of the
 200 -O/-O2/etc ``templates,'' which are filled in later, using these.
 201 These are the default values, which may be changed by user flags.
 202
 203 \begin{code}
 204 sub setupOptFlags {
 205    $Oopt_UnfoldingUseThreshold    = '-fsimpl-uf-use-threshold3';
 206    $Oopt_MaxSimplifierIterations  = '-fmax-simplifier-iterations4';
 207    $Oopt_PedanticBottoms          = '-fpedantic-bottoms'; # ON by default
 208    $Oopt_MonadEtaExpansion        = '';
 209    $Oopt_FinalStgProfilingMassage = '';
 210    $Oopt_StgStats                 = '';
 211    $Oopt_SpecialiseUnboxed        = '';
 212    $Oopt_DoSpecialise             = ''; # ToDo:LATER: '-fspecialise';
 213    $Oopt_FoldrBuild               = 0; # *Off* by default!
 214    $Oopt_FB_Support               = ''; # was '-fdo-arity-expand';
 215 #  $Oopt_FoldrBuildWW             = 0; # Off by default
 216    $Oopt_FoldrBuildInline         = ''; # was '-fdo-inline-foldr-build';
 217 } # end of setupOptFlags
 218
 219 # Assign defaults to these right away.
 220 &setupOptFlags();
 221 \end{code}
 222
 223 Things to do with C compilers/etc:
 224 \begin{code}
 225 $CcRegd         = $GHC_OPT_HILEV_ASM;
 226 @CcBoth_flags   = ('-S');   # flags for *any* C compilation
 227 @CcInjects      = ();
 228
 229 # GCC flags:
 230 #    those for all files,
 231 #    those only for .c files;
 232 #    those only for .hc files
 233
 234 @CcRegd_flags    = ('-ansi', '-D__STG_GCC_REGS__', '-D__STG_TAILJUMPS__');
 235 @CcRegd_flags_c = ();
 236 @CcRegd_flags_hc = ();
 237
 238 $As             = ''; # "assembler" is normally GCC
 239 @As_flags       = ();
 240
 241 $Lnkr           = ''; # "linker" is normally GCC
 242 @Ld_flags       = ();
 243
 244 # 'nm' is used for consistency checking (ToDo: mk-world-ify)
 245 # ToDo: check the OS or something ("alpha" is surely not the crucial question)
 246 $Nm = ($TargetPlatform =~ /^alpha-/) ? 'nm -B' : 'nm';
 247 \end{code}
 248
 249 What options \tr{-user-setup-a} turn into (user-defined ``packages''
 250 of options).  Note that a particular user-setup implies a particular
 251 Prelude ({\em including} its interface file(s)).
 252 \begin{code}
 253 $BuildTag       = ''; # default is sequential build w/ Appel-style GC
 254
 255 %BuildDescr     = (# system ways begin
 256                    '',      'normal sequential',
 257                    '_p',    "$WAY_p_NAME",
 258                    '_t',    "$WAY_t_NAME",
 259                    '_u',    "$WAY_u_NAME",
 260                    '_mc',   "$WAY_mc_NAME",
 261                    '_mr',   "$WAY_mr_NAME",
 262                    '_mt',   "$WAY_mt_NAME",
 263                    '_mp',   "$WAY_mp_NAME",
 264                    '_mg',   "$WAY_mg_NAME",
 265                    '_2s',   "$WAY_2s_NAME",
 266                    '_1s',   "$WAY_1s_NAME",
 267                    '_du',   "$WAY_du_NAME",
 268                    # system ways end
 269                    '_a',    "$WAY_a_NAME",
 270                    '_b',    "$WAY_b_NAME",
 271                    '_c',    "$WAY_c_NAME",
 272                    '_d',    "$WAY_d_NAME",
 273                    '_e',    "$WAY_e_NAME",
 274                    '_f',    "$WAY_f_NAME",
 275                    '_g',    "$WAY_g_NAME",
 276                    '_h',    "$WAY_h_NAME",
 277                    '_i',    "$WAY_i_NAME",
 278                    '_j',    "$WAY_j_NAME",
 279                    '_k',    "$WAY_k_NAME",
 280                    '_l',    "$WAY_l_NAME",
 281                    '_m',    "$WAY_m_NAME",
 282                    '_n',    "$WAY_n_NAME",
 283                    '_o',    "$WAY_o_NAME",
 284                    '_A',    "$WAY_A_NAME",
 285                    '_B',    "$WAY_B_NAME" );
 286
 287 # these are options that are "fed back" through the option processing loop
 288 #
 289 %SetupOpts =
 290        (
 291         '_a', "$WAY_a_HC_OPTS",
 292         '_b', "$WAY_b_HC_OPTS",
 293         '_c', "$WAY_c_HC_OPTS",
 294         '_d', "$WAY_d_HC_OPTS",
 295         '_e', "$WAY_e_HC_OPTS",
 296         '_f', "$WAY_f_HC_OPTS",
 297         '_g', "$WAY_g_HC_OPTS",
 298         '_h', "$WAY_h_HC_OPTS",
 299         '_i', "$WAY_i_HC_OPTS",
 300         '_j', "$WAY_j_HC_OPTS",
 301         '_k', "$WAY_k_HC_OPTS",
 302         '_l', "$WAY_l_HC_OPTS",
 303         '_m', "$WAY_m_HC_OPTS",
 304         '_n', "$WAY_n_HC_OPTS",
 305         '_o', "$WAY_o_HC_OPTS",
 306         '_A', "$WAY_A_HC_OPTS",
 307         '_B', "$WAY_B_HC_OPTS",
 308
 309         # system ways
 310         '_p',  "$WAY_p_HC_OPTS",
 311         '_t',  "$WAY_t_HC_OPTS",
 312         '_u',  "$WAY_u_HC_OPTS",
 313         '_mc', "$WAY_mc_HC_OPTS",
 314         '_mr', "$WAY_mr_HC_OPTS",
 315         '_mt', "$WAY_mt_HC_OPTS",
 316         '_mp', "$WAY_mp_HC_OPTS",
 317         '_mg', "$WAY_mg_HC_OPTS",
 318         '_2s', "$WAY_2s_HC_OPTS",
 319         '_1s', "$WAY_1s_HC_OPTS",
 320         '_du', "$WAY_B_HC_OPTS" );
 321
 322 # per-build code fragments which are eval'd
 323 #%EvaldSetupOpts        = ('',      '', # this one must *not* be set!
 324
 325 #                           # profiled sequential
 326 #                  '_p',    'push(@HsC_flags,  \'-fscc-profiling\');
 327 #                            push(@CcBoth_flags, \'-DPROFILING\');',
 328
 329 #                           #and maybe ...
 330 #                           #push(@CcBoth_flags, '-DPROFILING_DETAIL_COUNTS');
 331
 332 #                           # ticky-ticky sequential
 333 #                  '_t',    'push(@HsC_flags, \'-fticky-ticky\');
 334 #                            push(@CcBoth_flags, \'-DTICKY_TICKY\');',
 335
 336 ##OLD:                      # unregisterized (ToDo????)
 337 ##                 '_u',    '',
 338
 339 #                           # concurrent
 340 #                  '_mc',   '$StkChkByPageFaultOK = 0;
 341 #                            push(@HsC_flags,  \'-fconcurrent\');
 342 #                            push(@HsCpp_flags,\'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\');
 343 #                            push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\');',
 344
 345 #                           # profiled concurrent
 346 #                  '_mr',   '$StkChkByPageFaultOK = 0;
 347 #                            push(@HsC_flags,  \'-fconcurrent\', \'-fscc-profiling\');
 348 #                            push(@HsCpp_flags,\'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\');
 349 #                            push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DPROFILING\');',
 350
 351 #                           # ticky-ticky concurrent
 352 #                  '_mt',   '$StkChkByPageFaultOK = 0;
 353 #                            push(@HsC_flags,  \'-fconcurrent\', \'-fticky-ticky\');
 354 #                            push(@HsCpp_flags,\'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\');
 355 #                            push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DTICKY_TICKY\');',
 356
 357 #                           # parallel
 358 #                  '_mp',   '$StkChkByPageFaultOK = 0;
 359 #                            push(@HsC_flags,  \'-fconcurrent\');
 360 #                            push(@HsCpp_flags,\'-D__PARALLEL_HASKELL__\',   \'-DPAR\');
 361 #                            push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DPAR\');',
 362
 363 #                           # GranSim
 364 #                  '_mg',   '$StkChkByPageFaultOK = 0;
 365 #                            push(@HsC_flags,  \'-fconcurrent\', \'-fgransim\');
 366 #                            push(@HsCpp_flags,\'-D__GRANSIM__\',   \'-DGRAN\');
 367 #                            push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DGRAN\');',
 368
 369 #                  '_2s',   'push (@CcBoth_flags, \'-DGC2s\');',
 370 #                  '_1s',   'push (@CcBoth_flags, \'-DGC1s\');',
 371 #                  '_du',   'push (@CcBoth_flags, \'-DGCdu\');',
 372
 373 #                  '_a',    '', # these user-way guys should not be set!
 374 #                  '_b',    '',
 375 #                  '_c',    '',
 376 #                  '_d',    '',
 377 #                  '_e',    '',
 378 #                  '_f',    '',
 379 #                  '_g',    '',
 380 #                  '_h',    '',
 381 #                  '_i',    '',
 382 #                  '_j',    '',
 383 #                  '_k',    '',
 384 #                  '_l',    '',
 385 #                  '_m',    '',
 386 #                  '_n',    '',
 387 #                  '_o',    '',
 388 #                  '_A',    '',
 389 #                  '_B',    '' );
 390
 391 \end{code}
 392
 393 Import/include directories (\tr{-I} options) are sufficiently weird to
 394 require special handling.
 395
 396 \begin{code}
 397 @Import_dir     = ('.'); #-i things
 398 @Include_dir    = ('.'); #-I things; other default(s) stuck on AFTER option processing
 399
 400 # where to look for interface files (system hi's, i.e., prelude and hslibs)
 401 @SysImport_dir  = ( $INSTALLING )
 402                     ? ( "$InstLibDirGhc/imports" )
 403                     : ( "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/required"
 404                       , "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/ghc"
 405                       , "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/glaExts"
 406                       , "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/concurrent" );
 407
 408 # We need to look in ghc/ and glaExts/ when searching for implicitly needed .hi files, but
 409 # we should really *not* look there for explicitly imported modules.
 410
 411 $GhcVersionInfo  = int ($PROJECTVERSION * 100);
 412 $Haskell1Version = 4; # i.e., Haskell 1.4
 413 @Cpp_define      = ();
 414
 415 @UserLibrary_dir= ();   #-L things;...
 416 @UserLibrary    = ();   #-l things asked for by the user
 417
 418 @SysLibrary_dir = ( ( $INSTALLING )     #-syslib things supplied by the system
 419                     ? $InstLibDirGhc
 420                     : ( "$TopPwd/$CURRENT_DIR/$GHC_RUNTIME_DIR"
 421                       , "$TopPwd/$CURRENT_DIR/$GHC_RUNTIME_DIR/gmp"
 422                       , "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR"
 423                       , "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/cbits"
 424                       )
 425                   );
 426 @SysLibrary = (); # will be built up as we go along
 427
 428 $TopClosureFile # defaults to 1.2 one; will be mangled later
 429         = ( $INSTALLING)  ? "$InstLibDirGhc/TopClosureXXXX.o"
 430                           : "$TopPwd/$CURRENT_DIR/$GHC_RUNTIME_DIR/main/TopClosureXXXX.o";
 431
 432 # make depend for Haskell
 433 $MkDependHS
 434         = ( $INSTALLING ) ? "$InstBinDirGhc/mkdependHS"
 435                           : "$TopPwd/$CURRENT_DIR/$GHC_UTILS_DIR/mkdependHS/mkdependHS";
 436 # Fill in later
 437 @MkDependHS_flags = ( );
 438
 439 # do_link flag should not be reset while rescanning the cmd-line.
 440 $Do_lnkr    = 1;
 441 $Specific_output_dir = '';      # set by -odir <dir>
 442 $Specific_output_file = '';     # set by -o <file>; "-" for stdout
 443 \end{code}
 444
 445 Function to initialise the per-compilation-unit globals that
 446 are used to guide and control the invocation of the different phases.
 447
 448 \begin{code}
 449 sub initDriverGlobals {
 450
 451 # reset the following options:
 452 # RTS flags to use while compiling
 453 @HsC_rts_flags      = ();
 454 @HsP_flags      = (); # these are the flags destined solely for
 455                       # the flex/yacc parser
 456 @HsC_flags      = ();
 457 @HsC_antiflags  = ();
 458 \end{code}
 459
 460 The optimisations/etc to be done by the compiler are {\em normally}
 461 expressed with a \tr{-O} (or \tr{-O2}) flag, or by its absence.
 462
 463 \begin{code}
 464 $OptLevel      = 0; # no -O == 0; -O == 1; -O2 == 2; -Ofile == 3
 465 $MinusO2ForC   = 0; # set to 1 if -O2 should be given to C compiler
 466 $StolenX86Regs = 4; # **HACK*** of the very worst sort
 467 $CoreLint      = '';
 468 $StgLint       = '';
 469
 470 @CcBoth_flags   = ('-S');   # flags for *any* C compilation
 471 @CcInjects      = ();
 472
 473 # GCC flags: those for all files, those only for .c files; those only for .hc files
 474 @CcRegd_flags    = ('-ansi', '-D__STG_GCC_REGS__', '-D__STG_TAILJUMPS__');
 475 @CcRegd_flags_c = ();
 476 @CcRegd_flags_hc = ();
 477
 478 @Import_dir     = ('.'); #-i things
 479 @Include_dir    = ('.'); #-I things; other default(s) stuck on AFTER option processing
 480
 481
 482 \end{code}
 483
 484 We are given a list of files with various presumably-known suffixes
 485 (unknown-suffix files go straight to the linker).  For each file, we
 486 begin by assuming that we'll run every phase over it.  However: (1)
 487 global flags (\tr{-c}, \tr{-S}, etc.) tell us not to run any phase
 488 past a certain point; and (2) the file's suffix tells us what phase to
 489 start with.  Linking is weird and kept track of separately.
 490
 491 Here are the initial defaults applied to all files:
 492 \begin{code}
 493 $Cpp_flag_set = 0;        # (hack)
 494 $Only_preprocess_C = 0;   # pretty hackish
 495 $Only_generate_deps = 0;  #
 496 $PostprocessCcOutput = 0;
 497
 498 # native code-gen or via C?
 499 $HaveNativeCodeGen = $GhcWithNativeCodeGen;
 500 $HscOut = '-C='; # '-C=' ==> .hc output; '-S=' ==> .s output; '-N=' ==> neither
 501 $HscOut = '-S='
 502     if $HaveNativeCodeGen && $TargetPlatform =~ /^(alpha|sparc)-/;
 503 # TEMP: disable x86  if $HaveNativeCodeGen && $TargetPlatform =~ /^(i386|alpha|sparc)-/;
 504 $ProduceHi   = '-hifile=';
 505 $HiOnStdout  = 0;
 506 $HiDiff_flag = '';
 507
 508 $CollectingGCstats = 0;
 509 $CollectGhcTimings = 0;
 510 $DEBUGging = '';        # -DDEBUG and all that it entails (um... not really)
 511 $PROFing = '';          # set to p or e if profiling
 512 $PROFgroup = '';        # set to group if an explicit -Ggroup specified
 513 $PROFauto = '';         # set to relevant hsc flag if -auto or -auto-all
 514 $PROFcaf  = '';         # set to relevant hsc flag if -caf-all
 515 $PROFignore_scc = '';   # set to relevant parser flag if explicit sccs ignored
 516 $UNPROFscc_auto = '';   # set to relevant hsc flag if forcing auto sccs without profiling
 517 $TICKYing = '';         # set to t if compiling for ticky-ticky profiling
 518 $PARing = '';           # set to p if compiling for PAR
 519 $CONCURing = '';        # set to c if compiling for CONCURRENT
 520 $GRANing = '';          # set to g if compiling for GRAN
 521 $StkChkByPageFaultOK = 1; # may be set to 0 (false) for some builds
 522 $Specific_hi_file = '';         # set by -ohi <file>; "-" for stdout
 523 $Specific_dump_file = '';       # set by -odump <file>; "-" for stdout
 524 $Using_dump_file = 0;
 525 $Isuffix    = '';
 526 $Osuffix    = '';       # default: use the normal suffix for that kind of output
 527 $HiSuffix   = 'hi';
 528 $HiSuffix_prelude = '';
 529 $Do_recomp_chkr = 0;    # don't use the recompilatio checker unless asked
 530 $Do_cc      = -1;   # a MAGIC indeterminate value; will be set to 1 or 0.
 531 $Do_as      = 1;
 532
 533 $Keep_hc_file_too = 0;
 534 $Keep_s_file_too = 0;
 535 $UseGhcInternals = 0; # if 1, may use GHC* modules
 536 $SplitObjFiles = 0;
 537 $NoOfSplitFiles = 0;
 538 $Dump_parser_output = 0;
 539 $Dump_raw_asm = 0;
 540 $Dump_asm_splitting_info = 0;
 541 $NoImplicitPrelude = 0;
 542
 543
 544 } # end of initDriverGlobals (Sigh)
 545
 546 # we split the argv passed to the driver into three:
 547
 548 # the list of files
 549 @Input_file = ();
 550
 551 # and files to be linked...
 552 @Link_file  = ();
 553
 554 # and whatever else
 555 @Cmd_opts  = ();
 556
 557 \end{code}
 558
 559 We inject consistency-checking information into \tr{.hc} files (both
 560 when created by the Haskell compiler and when compiled by the C
 561 compiler), so that we can check that an executable is made from
 562 consistently-built pieces.  (The check is normally done just after
 563 linking.)  The checking is done by introducing/munging
 564 \tr{what(1)}-style strings.  Anyway, here are the relevant global
 565 variables and their defaults:
 566 \begin{code}
 567 $LinkChk = 1;   # set to 0 if the link check should *not* be done
 568
 569 # major & minor version numbers; major numbers must always agree;
 570 # minor disagreements yield a warning.
 571 $HsC_major_version = 31;
 572 $HsC_minor_version = 0;
 573 $Cc_major_version  = 36;
 574 $Cc_minor_version  = 0;
 575
 576 # options: these must always agree
 577 $HsC_consist_options = '';    # we record, in this order:
 578                               #     Build tag; debugging?
 579 $Cc_consist_options  = '';    # we record, in this order:
 580                               #     Build tag; debugging?
 581 \end{code}
 582
 583 %************************************************************************
 584 %*                                                                      *
 585 \section[Driver-parse-argv]{Munge the command-line options}
 586 %*                                                                      *
 587 %************************************************************************
 588
 589 Now slurp through the arguments.
 590 \begin{code}
 591
 592 #---------- user defined prelude ---------------------------------------
 593
 594 if (grep(/^-user-prelude$/, @ARGV)) {
 595
 596     # If ARGV contains -user-prelude we are compiling a piece of
 597     # prelude for the user, probably with additional specialise pragmas
 598
 599     # We strip out the -O -f and -user-prelude flags provided on
 600     # the command line and add the ones used to compile the prelude
 601     # ToDo: get these options from a common definition in mkworld
 602
 603     # We also enable any options forced through with -user-prelude-force
 604
 605     # Hey, Check out this grep statement ;-)  (PS)
 606
 607     @ARGV = grep((!/^-O/ && !/^-f/ && !/^-user-prelude$/) || s/^-user-prelude-force//,
 608                  @ARGV);
 609
 610     unshift(@ARGV,
 611         '-fcompiling-ghc-internals=???', # ToDo!!!!
 612         '-O',
 613         '-fshow-pragma-name-errs',
 614         '-fshow-import-specs',
 615         '-fglasgow-exts',
 616         '-genSPECS',
 617         '-DUSE_FOLDR_BUILD',
 618         '-dcore-lint');
 619
 620     print STDERR "ghc: -user-prelude options:\n", "@ARGV", "\n";
 621 }
 622
 623 &initDriverGlobals();
 624 &splitCmdLine(@ARGV);
 625 # Run through the cmd-line first time.
 626 &processArgs(@Cmd_opts);
 627
 628 # Check to see if driver is only in the business
 629 # to generate dependencies
 630 if (  $Status == 0 && $Only_generate_deps ) {
 631
 632     push (@MkDependHS_flags, "-o$Osuffix") if $Osuffix;
 633     push (@MkDependHS_flags, "-s$BuildTag") if $BuildTag;
 634     local($to_do) = "$MkDependHS @MkDependHS_flags -- @Cmd_opts -- @Input_file" ;
 635     &run_something($to_do, 'Haskell dependencies');
 636     exit $Status;
 637 }
 638
 639 # if there are several input files,
 640 # we don't allow \tr{-o <file>} or \tr{-ohi <file>} options...
 641 # (except if linking, of course)
 642
 643 if ($#Input_file > 0 && ( ! $Do_lnkr )) {
 644     if ( ($Specific_output_file ne '' && $Specific_output_file ne '-')
 645       || ($Specific_hi_file ne ''     && $Specific_hi_file ne '-') ) {
 646         print STDERR "$Pgm: You can't use -o or -ohi options if you have multiple input files.\n";
 647         print STDERR "\tPerhaps the -odir option will do what you want.\n";
 648         $Status++;
 649     }
 650 }
 651
 652 # check for various pathological -o and -odir combinations...
 653 if ($Specific_output_dir ne '' && $Specific_output_file ne '') {
 654     if ($Specific_output_file eq '-') {
 655         print STDERR "$Pgm: can't set output directory with -ohi AND have output to stdout\n";
 656         $Status++;
 657     } else { # amalgamate...
 658         $Specific_output_file = "$Specific_output_dir/$Specific_output_file";
 659         # ToDo: check we haven't got a junk name now...
 660         $Specific_output_dir  = ''; # reset
 661     }
 662 }
 663
 664 # crash and burn if there were errors
 665 if ( $Status > 0 ) {
 666     print STDERR $ShortUsage;
 667     exit $Status;
 668 }
 669 \end{code}
 670
 671 %************************************************************************
 672 %*                                                                      *
 673 \section[Driver-post-argv-mangling]{Setup after reading options}
 674 %*                                                                      *
 675 %************************************************************************
 676
 677 %************************************************************************
 678 %*                                                                      *
 679 \subsection{Set up for optimisation level (\tr{-O} or whatever)}
 680 %*                                                                      *
 681 %************************************************************************
 682
 683 We come now to the default ``wads of options'' that are turned on by
 684 \tr{-O0} (do min optimisation), \tr{-O} (ordinary optimisation),
 685 \tr{-O2} (aggressive optimisation), or no O-ish flag (compile speed is
 686 more important).
 687
 688 The user can also specify his/her own list of options in a file; in
 689 that case, the work is already done (see stuff about @minusO3@,
 690 earlier...).
 691
 692 GHC allows very precise control of what happens during a compilation.
 693 Core-to-Core and STG-to-STG passes can be run in any order, as many
 694 times as you like.  Individual transformations can be turned on or
 695 disabled.
 696
 697 Sadly, however, there are some interdependencies \& Things You Must
 698 Not Do.  Here is the list.
 699
 700 CORE-TO-CORE PASSES:
 701 \begin{description}
 702 \item[\tr{-fspecialise}:]
 703 The specialiser must have dependency-analysed input; but if you run
 704 the simplifier to do this, you must not let it toss away unused
 705 bindings!  (The typechecker conveys some specialisation info via
 706 ``unused'' bindings...)
 707
 708 \item[\tr{-ffloat-inwards}:]
 709 Floating inwards should be done before strictness analysis, because
 710 the latter will give better results.
 711
 712 \item[\tr{-fstatic-args}:]
 713 The static-arguments-transformation pass {\em must} have the
 714 simplifier run right after it.
 715
 716 \item[\tr{-fcalc-inlinings[12]}:]
 717 Not required, but there may be slight gains by re-simplifying after
 718 this is done.  (You could then \tr{-fcalc-inlinings} again, just for
 719 fun.)
 720
 721 \item[\tr{-ffull-laziness}:]
 722 The (outwards-)let-floater should be the {\em last} Core-to-Core pass
 723 that's run.  (Um, well, howzabout the simplifier just once more...)
 724 \end{description}
 725
 726 STG-TO-STG PASSES:
 727 \begin{description}
 728 \item[\tr{-fupdate-analysis}:]
 729 It really really wants to be the last STG-to-STG pass that is run.
 730 \end{description}
 731
 732 \begin{code}
 733
 734 sub setupOptimiseFlags {
 735
 736    @HsC_minusNoO_flags
 737     = ( '-fsimplify',
 738           '\(',
 739           $Oopt_FB_Support,
 740 #         '-falways-float-lets-from-lets',      # no idea why this was here (WDP 95/09)
 741           '-ffloat-lets-exposing-whnf',
 742           '-ffloat-primops-ok',
 743           '-fcase-of-case',
 744 #         '-fdo-lambda-eta-expansion',  # too complicated
 745           '-freuse-con',
 746 #         '-flet-to-case',      # no strictness analysis, so...
 747           $Oopt_PedanticBottoms,
 748 #         $Oopt_MonadEtaExpansion,      # no thanks
 749           '-fsimpl-uf-use-threshold0',
 750           '-fessential-unfoldings-only',
 751 #         $Oopt_UnfoldingUseThreshold,  # no thanks
 752           $Oopt_MaxSimplifierIterations,
 753           '\)',
 754         $Oopt_AddAutoSccs,
 755 #       '-ffull-laziness',      # removed 95/04 WDP following Andr\'e's lead
 756
 757         $Oopt_FinalStgProfilingMassage
 758       );
 759
 760    @HsC_minusO_flags # NOTE: used for *both* -O and -O2 (some conditional bits)
 761     = (
 762         '-fdo-eta-reduction',
 763
 764         # initial simplify: mk specialiser happy: minimum effort please
 765         '-fsimplify',
 766           '\(',
 767           $Oopt_FB_Support,
 768           '-fkeep-spec-pragma-ids',     # required before specialisation
 769           '-fsimpl-uf-use-threshold0',
 770           '-fessential-unfoldings-only',
 771           '-fmax-simplifier-iterations1',
 772           $Oopt_PedanticBottoms,
 773           '\)',
 774
 775         ($Oopt_DoSpecialise) ? (
 776           '-fspecialise-overloaded',
 777           $Oopt_SpecialiseUnboxed,
 778           $Oopt_DoSpecialise,
 779         ) : (),
 780
 781         '-fsimplify',                   # need dependency anal after specialiser ...
 782           '\(',                         # need tossing before calc-inlinings ...
 783           $Oopt_FB_Support,
 784           '-ffloat-lets-exposing-whnf',
 785           '-ffloat-primops-ok',
 786           '-fcase-of-case',
 787           '-fdo-case-elim',
 788           '-fcase-merge',
 789 #         '-fdo-eta-reduction',
 790           '-fdo-lambda-eta-expansion',
 791           '-freuse-con',
 792           $Oopt_PedanticBottoms,
 793           $Oopt_MonadEtaExpansion,
 794           $Oopt_UnfoldingUseThreshold,
 795           $Oopt_MaxSimplifierIterations,
 796           '\)',
 797
 798 #LATER: '-fcalc-inlinings1', -- pointless for 2.01
 799
 800 #       ($Oopt_FoldrBuildWW) ? (
 801 #               '-ffoldr-build-ww-anal',
 802 #               '-ffoldr-build-worker-wrapper',
 803 #               '-fsimplify',
 804 #                 '\(',
 805 #                 $Oopt_FB_Support,
 806 #                 '-ffloat-lets-exposing-whnf',
 807 #                 '-ffloat-primops-ok',
 808 #                 '-fcase-of-case',
 809 #                 '-fdo-case-elim',
 810 #                 '-fcase-merge',
 811 #                 '-fdo-eta-reduction',
 812 #                 '-fdo-lambda-eta-expansion',
 813 #                 '-freuse-con',
 814 #                 $Oopt_PedanticBottoms,
 815 #                 $Oopt_MonadEtaExpansion,
 816 #                 $Oopt_UnfoldingUseThreshold,
 817 #                 $Oopt_MaxSimplifierIterations,
 818 #                 '\)',
 819 #        ) : (),
 820
 821         # this pass-ordering sequence was agreed by Simon and Andr\'e
 822         # (WDP 94/07, 94/11).
 823         '-ffull-laziness',
 824
 825         ($Oopt_FoldrBuild) ? (
 826           '-ffoldr-build-on',           # desugar list comprehensions for foldr/build
 827
 828           '-fsimplify',
 829             '\(',
 830             '-fignore-inline-pragma',   # **** NB!
 831             '-fdo-foldr-build',         # NB
 832             $Oopt_FB_Support,
 833             '-ffloat-lets-exposing-whnf',
 834             '-ffloat-primops-ok',
 835             '-fcase-of-case',
 836             '-fdo-case-elim',
 837             '-fcase-merge',
 838 #           '-fdo-eta-reduction',
 839             '-fdo-lambda-eta-expansion',        # After full laziness
 840             '-freuse-con',
 841             $Oopt_PedanticBottoms,
 842             $Oopt_MonadEtaExpansion,
 843             $Oopt_UnfoldingUseThreshold,
 844             $Oopt_MaxSimplifierIterations,
 845             '\)',
 846         ) : (),
 847
 848         '-ffloat-inwards',
 849
 850         '-fsimplify',
 851           '\(',
 852           $Oopt_FB_Support,
 853           '-ffloat-lets-exposing-whnf',
 854           '-ffloat-primops-ok',
 855           '-fcase-of-case',
 856           '-fdo-case-elim',
 857           '-fcase-merge',
 858           '-fdo-eta-reduction',
 859           '-fdo-lambda-eta-expansion',
 860           '-freuse-con',
 861           ($Oopt_FoldrBuildInline),
 862                         # you need to inline foldr and build
 863           ($Oopt_FoldrBuild) ? ('-fdo-foldr-build') : (),
 864                         # but do reductions if you see them!
 865           $Oopt_PedanticBottoms,
 866           $Oopt_MonadEtaExpansion,
 867           $Oopt_UnfoldingUseThreshold,
 868           $Oopt_MaxSimplifierIterations,
 869           '\)',
 870
 871         '-fstrictness',
 872
 873         '-fsimplify',
 874           '\(',
 875           $Oopt_FB_Support,
 876           '-ffloat-lets-exposing-whnf',
 877           '-ffloat-primops-ok',
 878           '-fcase-of-case',
 879           '-fdo-case-elim',
 880           '-fcase-merge',
 881 #         '-fdo-eta-reduction',
 882           '-fdo-lambda-eta-expansion',
 883           '-freuse-con',
 884           '-flet-to-case',              # Aha! Only done after strictness analysis
 885           $Oopt_PedanticBottoms,
 886           $Oopt_MonadEtaExpansion,
 887           $Oopt_UnfoldingUseThreshold,
 888           $Oopt_MaxSimplifierIterations,
 889           '\)',
 890
 891         '-ffloat-inwards',
 892
 893 # Case-liberation for -O2.  This should be after
 894 # strictness analysis and the simplification which follows it.
 895
 896 #       ( ($OptLevel != 2)
 897 #        ? ''
 898 #       : "-fliberate-case -fsimplify \\( $Oopt_FB_Support -ffloat-lets-exposing-whnf -ffloat-primops-ok -fcase-of-case -fdo-case-elim -fcase-merge -fdo-eta-reduction -fdo-lambda-eta-expansion -freuse-con -flet-to-case $Oopt_PedanticBottoms $Oopt_MonadEtaExpansion $Oopt_UnfoldingUseThreshold $Oopt_MaxSimplifierIterations \\)" ),
 899
 900 # Final clean-up simplification:
 901
 902         '-fsimplify',
 903           '\(',
 904           $Oopt_FB_Support,
 905           '-ffloat-lets-exposing-whnf',
 906           '-ffloat-primops-ok',
 907           '-fcase-of-case',
 908           '-fdo-case-elim',
 909           '-fcase-merge',
 910 #         '-fdo-eta-reduction',
 911           '-fdo-lambda-eta-expansion',
 912           '-freuse-con',
 913           '-flet-to-case',
 914           '-fignore-inline-pragma',     # **** NB!
 915           $Oopt_FoldrBuildInline,
 916           ($Oopt_FoldrBuild) ? ('-fdo-foldr-build') : (),
 917                         # but still do reductions if you see them!
 918           $Oopt_PedanticBottoms,
 919           $Oopt_MonadEtaExpansion,
 920           $Oopt_UnfoldingUseThreshold,
 921           $Oopt_MaxSimplifierIterations,
 922           '\)',
 923
 924       # '-fstatic-args',
 925
 926 #LATER: '-fcalc-inlinings2', -- pointless for 2.01
 927
 928       # stg2stg passes
 929         '-fupdate-analysis',
 930         '-flambda-lift',
 931         $Oopt_FinalStgProfilingMassage,
 932         $Oopt_StgStats,
 933
 934       # flags for stg2stg
 935         '-flet-no-escape',
 936
 937       # SPECIAL FLAGS for -O2
 938         ($OptLevel == 2) ? (
 939           '-fsemi-tagging',
 940         ) : (),
 941       );
 942
 943 \end{code}
 944
 945 Sort out what we're going to do about optimising.  First, the @hsc@
 946 flags and regular @cc@ flags to worry about:
 947 \begin{code}
 948 if ( $OptLevel <= 0 ) {
 949
 950     # for this level, we tell the parser -fignore-interface-pragmas
 951     push(@HsC_flags, '-fignore-interface-pragmas');
 952     # and tell the compiler not to produce them
 953     push(@HsC_flags, '-fomit-interface-pragmas');
 954
 955     &add_Hsc_flags( @HsC_minusNoO_flags );
 956     push(@CcBoth_flags, ($MinusO2ForC) ? '-O2' : '-O'); # not optional!
 957
 958 } elsif ( $OptLevel == 1 || $OptLevel == 2 ) {
 959
 960     &add_Hsc_flags( @HsC_minusO_flags );
 961     push(@CcBoth_flags, ($MinusO2ForC || $OptLevel == 2) ? '-O2' : '-O'); # not optional!
 962     # -O? to GCC is not optional! -O2 probably isn't worth it generally,
 963     # but it *is* useful in compiling the garbage collectors (so said
 964     # Patrick many moons ago...).
 965
 966 } else { # -Ofile, then...
 967
 968     &add_Hsc_flags( @HsC_minusO3_flags );
 969     push(@CcBoth_flags, ($MinusO2ForC) ? '-O2' : '-O'); # possibly to be elaborated...
 970 }
 971
 972 } # setupOptimiseFlags
 973
 974 \end{code}
 975
 976 %************************************************************************
 977 %*                                                                      *
 978 \subsection{Check for consistency, etc.}
 979 %*                                                                      *
 980 %************************************************************************
 981
 982 Sort out @$BuildTag@, @$PROFing@, @$CONCURing@, @$PARing@,
 983 @$GRANing@, @$TICKYing@:
 984 \begin{code}
 985 sub setupBuildFlags {
 986
 987
 988    # PROFILING stuff after argv mangling:
 989    if ( ! $PROFing ) {
 990      # warn about any scc exprs found (in case scc used as identifier)
 991      push(@HsP_flags, '-W');
 992
 993      # add -auto sccs even if not profiling !
 994      push(@HsC_flags, $UNPROFscc_auto) if $UNPROFscc_auto;
 995
 996    } else {
 997       push(@HsC_flags, $PROFauto) if $PROFauto;
 998       push(@HsC_flags, $PROFcaf)  if $PROFcaf;
 999       #push(@HsC_flags, $PROFdict) if $PROFdict;
1000
1001       $Oopt_FinalStgProfilingMassage = '-fmassage-stg-for-profiling';
1002
1003       push(@HsP_flags, (($PROFignore_scc) ? $PROFignore_scc : '-S'));
1004
1005       if ( $SplitObjFiles ) {
1006          # can't split with cost centres -- would need global and externs
1007          print STDERR "$Pgm: WARNING: splitting objects when profiling will *BREAK* if any _scc_s are present!\n";
1008          # (but it's fine if there aren't any _scc_s around...)
1009 #        $SplitObjFiles = 0; # unset
1010          #not an error: for now: $Status++;
1011       }
1012   }
1013   #if ( $BuildTag ne '' ) {
1014   #    local($b) = $BuildDescr{$BuildTag};
1015   #    if ($CONCURing eq 'c') { print STDERR "$Pgm: Can't mix $b with -concurrent.\n"; exit 1; }
1016   #    if ($PARing    eq 'p') { print STDERR "$Pgm: Can't mix $b with -parallel.\n"; exit 1; }
1017   #    if ($GRANing   eq 'g') { print STDERR "$Pgm: Can't mix $b with -gransim.\n"; exit 1; }
1018   #    if ($TICKYing  eq 't') { print STDERR "$Pgm: Can't mix $b with -ticky.\n"; exit 1; }
1019
1020   #    # ok to have a user-way profiling build
1021   #    # eval the profiling opts ... but leave user-way BuildTag
1022   #    if ($PROFing   eq 'p') { &processArgs(split(' ', $SetupOpts{'_p'})); } # eval($EvaldSetupOpts{'_p'}); }
1023
1024   if ( $PROFing eq 'p' ) {
1025       if ($PARing   eq 'p') { print STDERR "$Pgm: Can't do profiling with -parallel.\n"; exit 1; }
1026       if ($GRANing  eq 'g') { print STDERR "$Pgm: Can't do profiling with -gransim.\n"; exit 1; }
1027       if ($TICKYing eq 't') { print STDERR "$Pgm: Can't do profiling with -ticky.\n"; exit 1; }
1028       $BuildTag = ($CONCURing eq 'c') ? '_mr' : '_p' ; # possibly "profiled concurrent"...
1029
1030   } elsif ( $CONCURing eq 'c' ) {
1031       if ($PARing  eq 'p') { print STDERR "$Pgm: Can't mix -concurrent with -parallel.\n"; exit 1; }
1032       if ($GRANing eq 'g') { print STDERR "$Pgm: Can't mix -concurrent with -gransim.\n"; exit 1; }
1033       $BuildTag = ($TICKYing eq 't')  ? '_mt' : '_mc' ; # possibly "ticky concurrent"...
1034       # "profiled concurrent" already acct'd for...
1035
1036   } elsif ( $PARing eq 'p' ) {
1037       if ($GRANing  eq 'g') { print STDERR "$Pgm: Can't mix -parallel with -gransim.\n"; exit 1; }
1038       if ($TICKYing eq 't') { print STDERR "$Pgm: Can't mix -parallel with -ticky.\n"; exit 1; }
1039       $BuildTag = '_mp';
1040
1041       if ( $Do_lnkr && ( ! $ENV{'PVM_ROOT'} || ! $ENV{'PVM_ARCH'} )) {
1042           print STDERR "$Pgm: both your PVM_ROOT and PVM_ARCH environment variables must be set for linking under -parallel.\n";
1043           exit(1);
1044       }
1045
1046   } elsif ( $GRANing eq 'g' ) {
1047       if ($TICKYing eq 't') { print STDERR "$Pgm: Can't mix -gransim with -ticky.\n"; exit 1; }
1048       $BuildTag = '_mg';
1049
1050   } elsif ( $TICKYing eq 't' ) {
1051       $BuildTag = '_t';
1052   }
1053
1054 \end{code}
1055
1056 After the sanity checks, add flags to the necessary parts of the driver pipeline:
1057
1058 \begin{code}
1059   if ( $BuildTag ne '' ) { # something other than normal sequential...
1060
1061       local($Tag) = "${BuildTag}";
1062       $Tag =~ s/_//;  # move the underscore to the back
1063
1064       $HscOut = '-C='; # must go via C
1065       &processArgs(split(' ', $SetupOpts{$BuildTag}));
1066 #      eval($EvaldSetupOpts{$BuildTag});
1067   }
1068 \end{code}
1069
1070 Decide what the consistency-checking options are in force for this run:
1071 \begin{code}
1072
1073   $HsC_consist_options = "${BuildTag},${DEBUGging}";
1074   $Cc_consist_options  = "${BuildTag},${DEBUGging}";
1075
1076   #
1077   # Funny place to put it, but why not.
1078   #
1079   if ( $HiSuffix_prelude eq '' ) {
1080        local($Tag) = "${BuildTag}";
1081        $Tag =~ s/_//;
1082        $Tag = "${Tag}_" if $Tag ne '';
1083        $HiSuffix_prelude="${Tag}hi";
1084   }
1085   push(@HsC_flags, "-hisuf-prelude=.${HiSuffix_prelude}"); # use appropriate Prelude .hi files
1086   push(@HsC_flags, "-hisuf=.${HiSuffix}");
1087
1088 } # setupBuildFlags
1089 \end{code}
1090
1091 %************************************************************************
1092 %*                                                                      *
1093 \subsection{Add on machine-specific C-compiler flags}
1094 %*                                                                      *
1095 %************************************************************************
1096
1097 Shove on magical machine-specific options.  We use \tr{unshift} to
1098 stick them on the {\em front} of the arrays, so that ``later''
1099 user-specified flags can clobber them (e.g., \tr{-U__STG_REV_TBLS__}).
1100
1101 Note: a few ``always apply'' flags were set at the very beginning.
1102
1103 \begin{code}
1104 sub setupMachOpts {
1105
1106   if ($TargetPlatform =~ /^alpha-/) {
1107       # we know how to *mangle* asm for alpha
1108       unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
1109       unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
1110       unshift(@CcBoth_flags,  ('-static'));
1111
1112   } elsif ($TargetPlatform =~ /^hppa/) {
1113       # we know how to *mangle* asm for hppa
1114       unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
1115       unshift(@CcBoth_flags,  ('-static'));
1116       #
1117       # We don't put in '-mlong-calls', because it's only
1118       # needed for very big modules (sigh), and we don't want
1119       # to hobble ourselves further on all the other modules
1120       # (most of them).
1121       #
1122       # [Dated comment (gcc-2.6.x?), -mlong-calls is no longer
1123       #  a supported gcc HPPA flag]
1124       unshift(@CcBoth_flags,  ('-D_HPUX_SOURCE'));
1125         # ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi!
1126         # (very nice, but too bad the HP /usr/include files don't agree.)
1127
1128   } elsif ($TargetPlatform =~ /^i386-/) {
1129       # we know how to *mangle* asm for X86
1130       unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
1131       unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1'))
1132                         if $StkChkByPageFaultOK
1133                            && $TargetPlatform !~ /nextstep/;
1134       # I do not know how to do STACK_CHECK_BY_PAGE_FAULT
1135       # on NeXTs (my fault, not theirs), so I don't.
1136       # CaS
1137
1138       # -fno-defer-pop : basically the same game as for m68k
1139       #
1140       # -fomit-frame-pointer : *must* ; because we're stealing
1141       #  the fp (%ebp) for our register maps.  *All* register
1142       #  maps (in MachRegs.lh) must steal it.
1143
1144       unshift(@CcRegd_flags_hc, '-fno-defer-pop');
1145       unshift(@CcRegd_flags,    '-fomit-frame-pointer');
1146       unshift(@CcRegd_flags,    "-DSTOLEN_X86_REGS=$StolenX86Regs");
1147
1148   } elsif ($TargetPlatform =~ /^m68k-/) {
1149       # we know how to *mangle* asm for m68k
1150       unshift (@CcRegd_flags, ('-D__STG_REV_TBLS__'));
1151       unshift (@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1'))
1152                         if $StkChkByPageFaultOK
1153                            && $TargetPlatform !~ /nextstep/;
1154       # I do not know how to do STACK_CHECK_BY_PAGE_FAULT
1155       # on NeXTs (my fault, not theirs), so I don't.
1156       # CaS
1157
1158       # -fno-defer-pop : for the .hc files, we want all the pushing/
1159       #    popping of args to routines to be explicit; if we let things
1160       #    be deferred 'til after an STGJUMP, imminent death is certain!
1161       #
1162       # -fomit-frame-pointer : *don't*
1163       #    It's better to have a6 completely tied up being a frame pointer
1164       #    rather than let GCC pick random things to do with it.
1165       #    (If we want to steal a6, then we would try to do things
1166       #    as on iX86, where we *do* steal the frame pointer [%ebp].)
1167
1168       unshift(@CcRegd_flags_hc, '-fno-defer-pop');
1169       unshift(@CcRegd_flags,    '-fno-omit-frame-pointer');
1170         # maybe gives reg alloc a better time
1171         # also: -fno-defer-pop is not sufficiently well-behaved without it
1172
1173   } elsif ($TargetPlatform =~ /^mips-/) {
1174       # we (hope to) know how to *mangle* asm for MIPSen
1175       unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
1176       unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
1177       unshift(@CcBoth_flags,  ('-static'));
1178
1179   } elsif ($TargetPlatform =~ /^powerpc-/) {
1180       # we know how to *mangle* asm for PowerPC
1181       unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
1182       unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
1183       unshift(@CcBoth_flags,  ('-static')); # always easier to start with
1184       unshift(@CcRegd_flags, ('-finhibit-size-directive')); # avoids traceback tables
1185
1186   } elsif ($TargetPlatform =~ /^sparc-/) {
1187       # we know how to *mangle* asm for SPARC
1188       unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__'));
1189       unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK;
1190
1191   }
1192 } # end of setupMachOpts
1193 \end{code}
1194
1195 Same unshifting magic, but for special linker flags.
1196
1197 The configure script determines whether the object file symbol tables
1198 have a leading underscore, and sets @LeadingUnderscore@ accordingly.
1199 (The driver script `sees' the setting of the @LeadingUnderscore@
1200 by having the Makefile prepend it).
1201
1202 \begin{code}
1203 sub setupLinkOpts {
1204   local($uscore) = ( ${LeadingUnderscore} eq 'YES' ) ? '_' : '';
1205
1206   unshift(@Ld_flags,
1207         (($Ld_main) ? (
1208           '-u', "${uscore}Main_" . $Ld_main . '_closure',
1209         ) : ()
1210 # What are these? -- SOF
1211 #         , '-u', "${uscore}STbase_unsafePerformPrimIO_fast1"
1212 #         , '-u', "${uscore}Prelude_Z91Z93_closure"      # i.e., []
1213 #         , '-u', "${uscore}Prelude_IZh_static_info"
1214 #         , '-u', "${uscore}Prelude_False_inregs_info"
1215 #         , '-u', "${uscore}Prelude_True_inregs_info"
1216 #         , '-u', "${uscore}Prelude_CZh_static_info"
1217 #         , '-u', "${uscore}DEBUG_REGS"
1218         ))
1219          ; # just for fun, now...
1220
1221 } # end of setupLinkOpts
1222
1223 \end{code}
1224
1225 %************************************************************************
1226 %*                                                                      *
1227 \subsection{Set up include paths and system-library enslurpment}
1228 %*                                                                      *
1229 %************************************************************************
1230
1231 Now that we know what garbage-collector, etc., are required, we can
1232 finalise our list of libraries to slurp through, and generally Get
1233 Ready for Business.
1234
1235 \begin{code}
1236 sub setupIncPaths {
1237   # default includes must be added AFTER option processing
1238   if ( ! $INSTALLING ) {
1239       push (@Include_dir, "$TopPwd/${CURRENT_DIR}/${GHC_INCLUDE_DIR}");
1240   } else {
1241       push (@Include_dir, "$InstLibDirGhc/includes");
1242       push (@Include_dir, "$InstLibDirGhc/includes");
1243   }
1244 } # end of setupIncPaths
1245 \end{code}
1246
1247 \begin{code}
1248 sub setupSyslibs {
1249   push(@SysLibrary, ( '-lHS', '-lHS_cbits' )); # basic I/O and prelude stuff
1250
1251   local($f);
1252   foreach $f (@SysLibrary) {
1253       next if $f =~ /_cbits/;
1254       $f .= $BuildTag if $f =~ /^-lHS/;
1255   }
1256
1257   # fiddle the TopClosure file name...
1258   $TopClosureFile =~ s/XXXX//;
1259
1260   # Push library HSrts, plus boring clib bit
1261   push(@SysLibrary, "-lHSrts${BuildTag}");
1262   push(@SysLibrary, '-lHSclib');
1263   #
1264   # RTS compiled with cygwin32, uses the WinMM API
1265   # to implement the itimers, since cygwin.dll does not
1266   # support it. Only reqd. for `ways' that use itimers.
1267   #
1268   push(@SysLibrary, '-lwinmm') if $BuildTag ne '' && $TargetPlatform eq 'i386-unknown-cygwin32';
1269
1270   # Push the pvm libraries
1271   if ($BuildTag eq '_mp') {
1272       $pvmlib = "$ENV{'PVM_ROOT'}/lib/$ENV{'PVM_ARCH'}";
1273       push(@SysLibrary, "-L$pvmlib", '-lpvm3', '-lgpvm3');
1274       if ( $ENV{'PVM_ARCH'} eq 'SUNMP' ) {
1275           push(@SysLibrary, '-lthread', '-lsocket', '-lnsl');
1276       } elsif ( $ENV{'PVM_ARCH'} eq 'SUN4SOL2' ) {
1277           push(@SysLibrary, '-lsocket', '-lnsl');
1278       }
1279   }
1280
1281 # Push the GNU multi-precision arith lib; and the math library
1282 push(@SysLibrary, '-lgmp');
1283 push(@SysLibrary, '-lm');
1284 \end{code}
1285
1286 %************************************************************************
1287 %*                                                                      *
1288 \subsection{Check that this system was built to do what we are asking}
1289 %*                                                                      *
1290 %************************************************************************
1291
1292 Before continuing we check that the appropriate build is available.
1293
1294 \begin{code}
1295 #die "$Pgm: no BuildAvail?? $BuildTag\n" if $BuildDescr{$BuildTag} eq '' ; # sanity
1296
1297 if ( $BuildDescr{$BuildTag} eq '' ) {
1298     print STDERR "$Pgm: a `", $BuildDescr{$BuildTag},
1299         "' \"build\" is not available with your GHC setup.\n";
1300     print STDERR "(It was not configured for it at your site.)\n";
1301     print STDERR $ShortUsage;
1302     exit 1;
1303 }
1304
1305 } # end of setupSyslibs
1306
1307 \end{code}
1308
1309 %************************************************************************
1310 %*                                                                      *
1311 \subsection{Final miscellaneous setup bits before we start going}
1312 %*                                                                      *
1313 %************************************************************************
1314
1315 Record largest specific heapsize, if any.
1316 \begin{code}
1317 sub setupHeapStackSize {
1318    $Specific_heap_size = $Specific_heap_size * $Scale_sizes_by;
1319    push(@HsC_rts_flags, '-H'.$Specific_heap_size);
1320    $Specific_stk_size = $Specific_stk_size * $Scale_sizes_by;
1321    push(@HsC_rts_flags, "-K$Specific_stk_size");
1322 }
1323 \end{code}
1324
1325 If no input or link files seen, then we let 'em feed in stdin; this is
1326 mainly for debugging.
1327
1328 \begin{code}
1329
1330 if ($#Input_file < 0 && $#Link_file < 0) {
1331     @Input_file = ( '-' );
1332
1333     open(INF, "> $Tmp_prefix.hs") || &tidy_up_and_die(1,"Can't open $Tmp_prefix.hs\n");
1334     print STDERR "Enter your Haskell program, end with ^D (on a line of its own):\n";
1335     while (<>) { print INF $_; }
1336     close(INF) || &tidy_up_and_die(1,"Failed writing to $Tmp_prefix.hs\n");
1337 }
1338
1339 \end{code}
1340
1341 Tell the world who we are, if they asked.
1342 \begin{code}
1343 print STDERR "${PROJECTNAME}, version ${PROJECTVERSION}, patchlevel ${PROJECTPATCHLEVEL}\n"
1344     if $Verbose;
1345 \end{code}
1346
1347 %************************************************************************
1348 %*                                                                      *
1349 \section[Driver-main-loop]{Main loop: Process input files, and link if required}
1350 %*                                                                      *
1351 %************************************************************************
1352
1353 Process the input files; don't continue with linking if there are
1354 problems (global variable @$Status@ non-zero).
1355 \begin{code}
1356 foreach $ifile (@Input_file) {
1357     &ProcessInputFile($ifile);
1358 }
1359
1360 if ( $Status > 0 ) { # don't link if there were errors...
1361     print STDERR $ShortUsage;
1362     &tidy_up();
1363     exit $Status;
1364 }
1365
1366 # append last minute flags linker and consistency flags
1367 &setupBuildFlags();
1368 &setupSyslibs();
1369 &setupLinkOpts();
1370
1371 \end{code}
1372
1373 Link if appropriate.
1374 \begin{code}
1375 if ($Do_lnkr) {
1376     local($libdirs) = '';
1377
1378     # glue them together:
1379     push(@UserLibrary_dir, @SysLibrary_dir);
1380
1381     $libdirs = '-L' . join(' -L',@UserLibrary_dir) if $#UserLibrary_dir >= 0;
1382
1383     # for a linker, use an explicitly given one, or the going C compiler ...
1384     local($lnkr) = ( $Lnkr ) ? $Lnkr : $CcRegd;
1385
1386     local($output) = ($Specific_output_file ne '') ? "-o $Specific_output_file" : '';
1387     @Files_to_tidy = ($Specific_output_file ne '') ? $Specific_output_file : 'a.out';
1388
1389     local($to_do) = "$lnkr $Verbose @Ld_flags $output @Link_file $TopClosureFile $libdirs @UserLibrary @SysLibrary";
1390     &run_something($to_do, 'Linker');
1391
1392     # finally, check the consistency info in the binary
1393     local($executable) = $Files_to_tidy[0];
1394     @Files_to_tidy = (); # reset; we don't want to nuke it if it's inconsistent
1395
1396     if ( $LinkChk ) {
1397         # dynamically load consistency-chking code; then do it.
1398         require('ghc-consist.prl')
1399             || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-consist.prl!\n");
1400
1401         &chk_consistency_info ( $executable );
1402     }
1403
1404     # if PVM parallel stuff, we do truly weird things.
1405     # Essentially: (1) move the executable over to where PVM expects
1406     # to find it.  (2) create a script in place of the executable
1407     # which will cause the program to be run, via SysMan.
1408     if ( $PARing eq 'p' ) {
1409         local($pvm_executable) = $executable;
1410         local($pvm_executable_base);
1411
1412         if ( $pvm_executable !~ /^\// ) { # a relative path name: make absolute
1413             local($pwd) = `pwd`;
1414             chop($pwd);
1415             $pwd =~ s/^\/tmp_mnt//;
1416             $pvm_executable = "$pwd/$pvm_executable";
1417         }
1418
1419         $pvm_executable =~ s|/|=|g; # make /s into =s
1420         $pvm_executable_base = $pvm_executable;
1421
1422         $pvm_executable = $ENV{'PVM_ROOT'} . '/bin/' . $ENV{'PVM_ARCH'}
1423                         . "/$pvm_executable";
1424
1425         &run_something("$Rm -f $pvm_executable; $Cp -p $executable $pvm_executable && $Rm -f $executable", 'Moving binary to PVM land');
1426
1427         # OK, now create the magic script for "$executable"
1428         open(EXEC, "> $executable") || &tidy_up_and_die(1,"$Pgm: couldn't open $executable to write!\n");
1429         print EXEC <<EOSCRIPT1;
1430 eval 'exec perl -S \$0 \${1+"\$@"}'
1431   if \$running_under_some_shell;
1432 # =!=!=!=!=!=!=!=!=!=!=!
1433 # This script is automatically generated: DO NOT EDIT!!!
1434 # Generated by Glasgow Haskell, version ${PROJECTVERSION} ${PROJECTPATCHLEVEL}
1435 #
1436 \$pvm_executable      = '$pvm_executable';
1437 \$pvm_executable_base = '$pvm_executable_base';
1438 \$SysMan = '$SysMan';
1439 EOSCRIPT1
1440
1441         print EXEC <<\EOSCRIPT2;
1442 # first, some magical shortcuts to run "commands" on the binary
1443 # (which is hidden)
1444 if ($#ARGV == 1 && $ARGV[0] eq '+RTS' && $ARGV[1] =~ /^--((size|file|strip|rm|nm).*)/ ) {
1445     local($cmd) = $1;
1446     system("$cmd $pvm_executable");
1447     exit(0); # all done
1448 }
1449
1450 # OK, really run it; process the args first
1451 $ENV{'PE'} = $pvm_executable_base;
1452 $debug = '';
1453 $nprocessors = 2; # the default
1454 @nonPVM_args = ();
1455 $in_RTS_args = 0;
1456
1457 # ToDo: handle --RTS
1458 args: while ($a = shift(@ARGV)) {
1459     if ( $a eq '+RTS' ) {
1460         $in_RTS_args = 1;
1461     } elsif ( $a eq '-RTS' ) {
1462         $in_RTS_args = 0;
1463     }
1464     if ( $a eq '-d' && $in_RTS_args ) {
1465         $debug = '-';
1466     } elsif ( $a =~ /^-N(\d+)/ && $in_RTS_args ) {
1467         $nprocessors = $1;
1468     } else {
1469         push(@nonPVM_args, $a);
1470     }
1471 }
1472
1473 local($return_val) = 0;
1474 system("$SysMan $debug $pvm_executable $nprocessors @nonPVM_args");
1475 $return_val = $?;
1476 system("mv $ENV{'HOME'}/$pvm_executable_base.???.gr .") if -f "$ENV{'HOME'}/$pvm_executable_base.001.gr";
1477 exit($return_val);
1478 EOSCRIPT2
1479         close(EXEC) || die "Failed closing $executable\n";
1480         chmod 0755, $executable;
1481     }
1482 }
1483
1484 # that...  that's all, folks!
1485 &tidy_up();
1486 exit $Status; # will still be 0 if all went well
1487 \end{code}
1488
1489 %************************************************************************
1490 %*                                                                      *
1491 \section[Driver-do-one-file]{How to process a single input file}
1492 %*                                                                      *
1493 %************************************************************************
1494
1495 \begin{code}
1496 sub ProcessInputFile {
1497     local($ifile) = @_;   # input file name
1498     local($ifile_root);   # root of or basename of input file
1499     local($ofile_target); # ultimate output file we hope to produce
1500                           # from input file (need to know for recomp
1501                           # checking purposes)
1502     local($hifile_target);# ditto (but .hi file)
1503 \end{code}
1504
1505 Handle the weirdity of input from stdin.
1506 \begin{code}
1507     if ($ifile ne '-') {
1508         ($ifile_root  = $ifile) =~ s/\.[^\.\/]+$//;
1509         $ofile_target = # may be reset later...
1510                         ($Specific_output_file ne '' && ! $Do_lnkr)
1511                         ? $Specific_output_file
1512                         : &odir_ify($ifile_root, 'o');
1513         $hifile_target= ($Specific_hi_file ne '')
1514                         ? $Specific_hi_file
1515                         : "$ifile_root.$HiSuffix"; # ToDo: odirify?
1516                         # NB: may change if $ifile_root isn't module name (??)
1517     } else {
1518         $ifile = "$Tmp_prefix.hs"; # we know that's where we put the input
1519         $ifile_root   = '_stdin';
1520         $ofile_target = '_stdout'; # gratuitous?
1521         $hifile_target= '_stdout'; # ditto?
1522     }
1523 \end{code}
1524
1525 We need to decide what phases of the compilation system we will run
1526 over this file.  The defaults are the ones established when processing
1527 flags.  (That established what the last phase run for all files is.)
1528
1529 We do the pre-recompilation-checker phases here; the rest later.
1530 \begin{code}
1531 \end{code}
1532
1533 Look at the suffix and decide what initial phases of compilation may
1534 be dropped off for this file.  Also the rather boring business of
1535 which files are coming-in/going-out.
1536
1537 Again, we'll do the post-recompilation-checker parts of this later.
1538 \begin{code}
1539     local($do_lit2pgm)  = ($ifile =~ /\.lhs$/) ? 1 : 0;
1540     local($do_hscpp)    = 1; # but "hscpp" might really be "cat"
1541     local($do_hsc)      = 1;
1542
1543     # names of the files to stuff between phases
1544     # defaults are temporaries
1545     local($in_lit2pgm)    = $ifile;
1546     local($lit2pgm_hscpp) = "$Tmp_prefix.lpp";
1547     local($hscpp_hsc)     = "$Tmp_prefix.cpp";
1548     local($hsc_hi)        = "$Tmp_prefix.hi";
1549     local($cc_as_o)       = "${Tmp_prefix}_o.s"; # temporary for raw .s file if opt C
1550     local($cc_as)         = "$Tmp_prefix.s";     # mangled or hsc-produced .s code
1551     local($as_out)        = $ofile_target;
1552
1553     local($is_hc_file) = 1; #Is the C code .hc or .c? Assume .hc for now
1554
1555     $lit2pgm_hscpp = $ifile if ($ifile =~ /\.hs$/);
1556
1557     # OK, let's strip off some literate junk:
1558     &runLit2pgm($in_lit2pgm, $lit2pgm_hscpp) if ($ifile =~ /\.lhs$/);
1559     #
1560     @File_options = ();
1561
1562     # Scan the top of the de-litted file for {-# OPTIONS #-} pragmas
1563     &check_for_source_options($lit2pgm_hscpp);
1564     # options found in the source file take a back seat, i.e., we scan
1565     # them first. Only process the command line again if source file
1566     # contained anything of interest *or* there's more than one
1567     # input file (we have to reset the options).
1568     #
1569     if ( $#Input_file >= 0 || $#File_options >= 0) {
1570         @File_options = (@File_options, @Cmd_opts);
1571
1572         # Now process the command line
1573         &initDriverGlobals();
1574         &processArgs(@File_options);
1575     }
1576     #
1577     # Having got the effective command line scanned, set up
1578     # the various options in prep for some real work.
1579     #
1580     # check the sanity of the BuildTag we're about to use,
1581     # and if needs be, add some more flags and setup to
1582     # the different phases.
1583     #
1584     &setupBuildFlags();
1585     &setupOptimiseFlags();
1586     &setupMachOpts();
1587     &setupIncPaths();
1588     &setupHeapStackSize();
1589
1590     #
1591     # These two variables need to be set after the
1592     # command-line has been processed and the build options
1593     # have be seen set up. This is because command-line options
1594     # can control whether to compile vias C or not.
1595     #
1596     local($do_cc)       = ( $Do_cc != -1) # i.e., it was set explicitly
1597                           ? $Do_cc
1598                           : ( ($HscOut eq '-C=') ? 1 : 0 );
1599     local($do_as)       = $Do_as;
1600     local($hsc_out)       = ( $HscOut eq '-C=' ) ? "$Tmp_prefix.hc" : "$Tmp_prefix.s" ;
1601
1602     if ($ifile =~ /.lhs$/ || $ifile =~ /.hs$/ ) {
1603        ;
1604     } elsif ($ifile =~ /\.hc$/ || $ifile =~ /_hc$/ ) { # || $ifile =~ /\.$Isuffix$/o) # ToDo: better
1605         $do_hscpp = 0; $do_hsc = 0; $do_cc = 1;
1606         $hsc_out = $ifile;
1607     } elsif ($ifile =~ /\.c$/) {
1608         $do_hscpp = 0; $do_hsc = 0; $do_cc = 1;
1609         $hsc_out = $ifile; $is_hc_file = 0;
1610     } elsif ($ifile =~ /\.s$/) {
1611         $do_hscpp = 0; $do_hsc = 0; $do_cc = 0;
1612         $cc_as = $ifile;
1613     } else { # don't know what it is, but nothing to do herein...
1614         $do_hscpp = 0; $do_hsc = 0; $do_cc = 0; $do_as = 0;
1615     }
1616
1617     # hack to avoid running hscpp
1618     $HsCpp = $Cat if ! $Cpp_flag_set;
1619
1620     &runHscpp($in_lit2pgm, $lit2pgm_hscpp, $hscpp_hsc)
1621         if $do_hscpp;
1622 \end{code}
1623
1624 We now think about whether to run hsc/cc or not (when hsc produces .s
1625 stuff, it effectively takes the place of both phases).
1626
1627 To get the output file name right: for each phase that we are {\em
1628 not} going to run, set its input (i.e., the output of its preceding
1629 phase) to @"$ifile_root.<suffix>"@.
1630 \begin{code}
1631     local($going_interactive) = $HscOut eq '-N=' || $ifile_root eq '_stdin';
1632
1633     #
1634     # Warning issued if -keep-hc-file-too is used without
1635     # -fvia-C (or the equivalent)
1636     #
1637     if ( $HscOut ne '-C=' && $Keep_hc_file_too ) {
1638         print STDERR "Warning: Native code generator to be used, -keep-hc-file-too will be ignored\n";
1639     }
1640
1641     if (! $do_cc && ! $do_as) { # stopping after hsc
1642         $hsc_out = ($Specific_output_file ne '')
1643                  ? $Specific_output_file
1644                  : &odir_ify($ifile_root, ($HscOut eq '-C=') ? 'hc' : 's');
1645
1646         $ofile_target = $hsc_out; # reset
1647     }
1648
1649     if (! $do_as) { # stopping after gcc (or hsc)
1650         $cc_as = ($Specific_output_file ne '')
1651                  ? $Specific_output_file
1652                  : &odir_ify($ifile_root, ( $Only_preprocess_C ) ? 'i' : 's');
1653
1654         $ofile_target = $cc_as; # reset
1655     }
1656
1657 \end{code}
1658
1659
1660 Now the Haskell compiler, C compiler, and assembler
1661
1662 \begin{code}
1663    if ($do_hsc) {
1664         &runHscAndProcessInterfaces( $ifile, $hscpp_hsc, $ifile_root,
1665                                      $ofile_target, $hifile_target);
1666     }
1667
1668     if ($do_cc) {
1669         &runGcc    ($is_hc_file, $hsc_out, $cc_as_o);
1670         &runMangler($is_hc_file, $cc_as_o, $cc_as, $ifile_root);
1671     }
1672
1673     &split_asm_file($cc_as)  if $do_as && $SplitObjFiles;
1674
1675     &runAs($as_out, $ifile_root) if $do_as;
1676 \end{code}
1677
1678 Finally, decide what to queue up for linker input.
1679 \begin{code}
1680     # tentatively assume we will eventually produce linker input:
1681     push(@Link_file, &odir_ify($ifile_root, 'o'));
1682
1683 #ToDo:    local($or_isuf) = ($Isuffix eq '') ? '' : "|$Isuffix";
1684
1685     if ( $ifile !~ /\.(lhs|hs|hc|c|s)$/ && $ifile !~ /_hc$/ ) {
1686         print STDERR "$Pgm: don't recognise suffix on `$ifile'; passing it through to linker\n"
1687             if $ifile !~ /\.a$/;
1688
1689         # oops; we tentatively pushed the wrong thing; fix & do the right thing
1690         pop(@Link_file); push(@Link_file, $ifile);
1691     }
1692
1693
1694 } # end of ProcessInputFile
1695 \end{code}
1696
1697 %************************************************************************
1698 %*                                                                      *
1699 \section[Driver-run-phases]{Routines to run the various phases}
1700 %*                                                                      *
1701 %************************************************************************
1702
1703 \begin{code}
1704 sub runLit2pgm {
1705     local($in_lit2pgm, $lit2pgm_hscpp) = @_;
1706
1707     local($to_do) = "echo '#line 1 \"$in_lit2pgm\"' > $lit2pgm_hscpp && ".
1708                     "$Unlit @Unlit_flags $in_lit2pgm -  >> $lit2pgm_hscpp";
1709     @Files_to_tidy = ( $lit2pgm_hscpp );
1710
1711     &run_something($to_do, 'literate pre-processor');
1712 }
1713 \end{code}
1714
1715 \begin{code}
1716 sub runHscpp {
1717     local($in_lit2pgm, $lit2pgm_hscpp, $hscpp_hsc) = @_;
1718
1719     local($to_do);
1720
1721     if ($HsCpp eq $Cat) {
1722         $to_do = "echo '#line 1 \"$in_lit2pgm\"' > $hscpp_hsc && ".
1723                         "$HsCpp $lit2pgm_hscpp >> $hscpp_hsc";
1724         @Files_to_tidy = ( $hscpp_hsc );
1725         &run_something($to_do, 'Ineffective C pre-processor');
1726     } else {
1727         local($includes) = '-I' . join(' -I',@Include_dir);
1728         $to_do = "echo '#line 1 \"$in_lit2pgm\"' > $hscpp_hsc && ".
1729                         "$HsCpp $Verbose $genSPECS_flag @HsCpp_flags -D__HASKELL1__=$Haskell1Version -D__GLASGOW_HASKELL__=$GhcVersionInfo $includes $lit2pgm_hscpp >> $hscpp_hsc";
1730         @Files_to_tidy = ( $hscpp_hsc );
1731         &run_something($to_do, 'Haskellised C pre-processor');
1732     }
1733 }
1734 \end{code}
1735
1736
1737 \begin{code}
1738 sub runHscAndProcessInterfaces {
1739     local($ifile, $hscpp_hsc, $ifile_root, $ofile_target, $hifile_target) = @_;
1740
1741         # $ifile                is the original input file
1742         # $hscpp_hsc            post-unlit, post-cpp, etc., input file
1743         # $ifile_root           input filename minus suffix
1744         # $ofile_target         the output file that we ultimately hope to produce
1745         # $hifile_target        the .hi file ... (ditto)
1746
1747     local($source_unchanged) = 1;
1748
1749 # Check if the source file is up to date relative to the target; in
1750 # that case we say "source is unchanged" and let the compiler bail out
1751 # early if the import usage information allows it.
1752
1753     ($i_dev,$i_ino,$i_mode,$i_nlink,$i_uid,$i_gid,$i_rdev,$i_size,
1754      $i_atime,$i_mtime,$i_ctime,$i_blksize,$i_blocks) = stat($ifile);
1755
1756     if ( ! -f $ofile_target ) {
1757 #       print STDERR "$Pgm:compile:Output file $ofile_target doesn't exist\n";
1758         $source_unchanged = 0;
1759     }
1760
1761     ($o_dev,$o_ino,$o_mode,$o_nlink,$o_uid,$o_gid,$o_rdev,$o_size,
1762      $o_atime,$o_mtime,$o_ctime,$o_blksize,$o_blocks) = stat(_); # stat info from -f test
1763
1764     if ( ! -f $hifile_target ) {
1765 #       print STDERR "$Pgm:compile:Interface file $hifile_target doesn't exist\n";
1766         $source_unchanged = 0;
1767     }
1768
1769     ($hi_dev,$hi_ino,$hi_mode,$hi_nlink,$hi_uid,$hi_gid,$hi_rdev,$hi_size,
1770      $hi_atime,$hi_mtime,$hi_ctime,$hi_blksize,$hi_blocks) = stat(_); # stat info from -f test
1771
1772     if ($i_mtime > $o_mtime) {
1773 #       print STDERR "$Pgm:recompile:Input file $ifile newer than $ofile_target\n";
1774         $source_unchanged = 0;
1775     }
1776
1777     # So if source_unchanged is still "1", we pass on the good news to the compiler
1778     # The -recomp flag can disable this, forcing recompilation
1779     if ($Do_recomp_chkr && $source_unchanged) {
1780         push(@HsC_flags, '-fsource-unchanged');
1781     }
1782
1783 # Run the compiler
1784
1785     &runHsc($ifile_root, $hsc_out, $hsc_hi, $going_interactive);
1786
1787 # See if it bailed out early, saying nothing needed doing.
1788 # We work this out by seeing if it created an output .hi file
1789
1790     if ( ! -f $hsc_hi ) {
1791         # Doesn't exist, so we bailed out early.
1792         # Tell the C compiler and assembler not to run
1793         $do_cc = 0; $do_as = 0;
1794
1795         # Update dependency info, touch both object file and
1796         # interface file, so that the following invariant is
1797         # maintained:
1798         #
1799         #   a dependent module's interface file should after recompilation
1800         #   checking be newer than the interface files of its imports.
1801         #
1802         # That is, if module A's interface file changes, then module B
1803         # (which import from A) needs to be checked.
1804         # If A's change does not affect B, which causes the compiler to bail
1805         # out early, we still need to touch the interface file of B. The reason
1806         # for this is that B may export A's interface.
1807         #
1808         &run_something("touch $ofile_target $hifile_target",
1809                        "Touch $ofile_target $hifile_target,  to propagate dependencies");
1810
1811     } else {
1812
1813      # Didn't bail out early (new .hi file) so we thunder on
1814
1815         # If non-interactive, heave in the consistency info at the end
1816         # NB: pretty hackish (depends on how $output is set)
1817         if ( ! $going_interactive ) {
1818             if ( $HscOut eq '-C=' ) {
1819             $to_do = "echo 'static char ghc_hsc_ID[] = \"\@(#)hsc $ifile\t$HsC_major_version.$HsC_minor_version,$HsC_consist_options\";' >> $hsc_out";
1820
1821             } elsif ( $HscOut eq '-S=' ) {
1822                 local($consist) = "hsc.$ifile.$HsC_major_version.$HsC_minor_version.$HsC_consist_options";
1823                 $consist =~ s/,/./g;
1824                 $consist =~ s/\//./g;
1825                 $consist =~ s/-/_/g;
1826                 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
1827                 $to_do = "echo '\n\t.text\n$consist:' >> $hsc_out";
1828             }
1829             &run_something($to_do, 'Pin on Haskell consistency info');
1830         }
1831
1832
1833         # Interface-handling is important enough to live off by itself
1834         require('ghc-iface.prl')
1835             || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-iface.prl!\n");
1836
1837         &postprocessHiFile($hsc_hi, $hifile_target, $going_interactive);
1838
1839         # save a copy of the .hc file, even if we are carrying on...
1840         if ($HscOut eq '-C=' && $do_cc && $Keep_hc_file_too) {
1841             local($to_do) = "$Rm $ifile_root.hc; $Cp $hsc_out $ifile_root.hc";
1842             &run_something($to_do, 'Saving copy of .hc file');
1843         }
1844
1845         # save a copy of the .s file, even if we are carrying on...
1846         if ($HscOut eq '-S=' && $do_as && $Keep_s_file_too) {
1847             local($to_do) = "$Rm $ifile_root.s; $Cp $hsc_out $ifile_root.s";
1848             &run_something($to_do, 'Saving copy of .s file');
1849         }
1850
1851         # if we're going to split up object files,
1852         # we inject split markers into the .hc file now
1853         if ( $HscOut eq '-C=' && $SplitObjFiles ) {
1854             &inject_split_markers ( $hsc_out );
1855         }
1856     }
1857 }
1858 \end{code}
1859
1860
1861 \begin{code}
1862 sub runHsc {
1863     local($ifile_root, $hsc_out, $hsc_hi, $going_interactive) = @_;
1864
1865     # prepend comma to HsP flags (so hsc can tell them apart...)
1866     foreach $a ( @HsP_flags ) { $a = ",$a" unless $a =~ /^,/; }
1867
1868     &makeHiMap() unless $HiMapDone;
1869 #    print STDERR "HiIncludes: $HiIncludeString\n";
1870     push(@HsC_flags, "-himap=$HiIncludeString");
1871 #    push(@HsC_flags, "-himap=$HiMapFile");
1872
1873     # here, we may produce .hc/.s and/or .hi files
1874     local($output) = '';
1875     @Files_to_tidy = ();
1876
1877     if ( $going_interactive ) {
1878         # don't need .hi unless going to show it on stdout:
1879         $ProduceHi = '-nohifile=' if ! $HiOnStdout;
1880         $do_cc = 0; $do_as = 0; $Do_lnkr = 0; # and we won't go any further...
1881     }
1882
1883     # set up for producing output/.hi; note that flag twiddling
1884     # may mean that nothing will actually be produced:
1885     $output = "$ProduceHi$hsc_hi $HscOut$hsc_out";
1886     @Files_to_tidy = ( $hsc_hi, $hsc_out );
1887
1888     # if we're compiling foo.hs, we want the GC stats to end up in foo.stat
1889     if ( $CollectingGCstats ) {
1890         push(@HsC_rts_flags, "-S$ifile_root.stat");
1891         push(@Files_to_tidy, "$ifile_root.stat");
1892     }
1893
1894     if ( $CollectGhcTimings ) { # assume $RTS_style eq 'ghc'
1895         # emit nofibbish time/bytes-alloc stats to stderr;
1896         # see later .stat file post-processing
1897         push(@HsC_rts_flags, "-s$Tmp_prefix.stat");
1898         push(@Files_to_tidy, "$Tmp_prefix.stat");
1899     }
1900
1901     local($dump) = '';
1902     if ($Specific_dump_file ne '') {
1903         $dump = "2>> $Specific_dump_file";
1904         $Using_dump_file = 1;
1905     }
1906
1907     local($to_do);
1908     $to_do = "$HsC @HsP_flags ,$hscpp_hsc $dump @HsC_flags $CoreLint $StgLint $Verbose $output +RTS @HsC_rts_flags";
1909     &run_something($to_do, 'Haskell compiler');
1910
1911     # finish business w/ nofibbish time/bytes-alloc stats
1912     &process_ghc_timings() if $CollectGhcTimings;
1913 }
1914 \end{code}
1915
1916 Use \tr{@Import_dir} and \tr{@SysImport_dir} to make a tmp file
1917 of (module-name, pathname) pairs, one per line, separated by a space.
1918 \begin{code}
1919 #%HiMap     = ();
1920 $HiMapDone = 0;
1921 $HiMapFile = '';
1922 $HiIncludeString = ();          # dir1:dir2:dir3, to pass to GHC
1923
1924 sub makeHiMap {
1925
1926     # collect in %HiMap; write later; also used elsewhere in driver
1927
1928     local($mod, $path, $d, $e);
1929
1930     # reset the global variables:
1931     #%HiMap     = ();
1932     $HiMapDone = 0;
1933     $HiMapFile = '';
1934     $HiIncludeString = ();              # dir1:dir2:dir3, to pass to GHC
1935
1936     foreach $d ( @Import_dir ) {
1937         if ($HiIncludeString) { $HiIncludeString = "$HiIncludeString:$d";
1938         } else { $HiIncludeString = $d; }
1939
1940 # The compiler does the searching now
1941 #
1942 #       opendir(DIR, $d) || &tidy_up_and_die(1,"$Pgm: error when reading directory: $d\n");
1943 #       local(@entry) = readdir(DIR);
1944 #       foreach $e ( @entry ) {
1945 #           next unless $e =~ /\b([A-Z][A-Za-z0-9_]*)\.${HiSuffix_prelude}$/o;
1946 #           $mod  = $1;
1947 #           $path = "$d/$e";
1948 #           $path =~ s,^\./,,;
1949 #
1950 #           if ( ! defined($HiMap{$mod}) ) {
1951 #               $HiMap{$mod} = $path;
1952 #           } else {
1953 #               &already_mapped_err($mod, $HiMap{$mod}, $path);
1954 #           }
1955 #       }
1956 #       closedir(DIR); # || &tidy_up_and_die(1,"$Pgm: error when closing directory: $d\n");
1957     }
1958
1959     foreach $d ( @SysImport_dir ) {
1960         if ($HiIncludeString) { $HiIncludeString = "$HiIncludeString:$d";
1961         } else { $HiIncludeString = $d; }
1962
1963 #       opendir(DIR, $d) || &tidy_up_and_die(1,"$Pgm: error when reading directory: $d\n");
1964 #       local(@entry) = readdir(DIR);
1965 #       foreach $e ( @entry ) {
1966 #           next unless $e =~ /([A-Z][A-Za-z0-9_]*)\.$HiSuffix$/o;
1967 #           next if $NoImplicitPrelude && $e =~ /Prelude\.$HiSuffix$/o;
1968 #
1969 #           $mod  = $1;
1970 #           $path = "$d/$e";
1971 #           $path =~ s,^\./,,;
1972 #
1973 #           if ( ! defined($HiMap{$mod}) ) {
1974 #               $HiMap{$mod} = $path;
1975 #           } elsif ( $mod ne 'Main' )  { # saves useless warnings...
1976 #               &already_mapped_err($mod, $HiMap{$mod}, $path);
1977 #           }
1978 #       }
1979 #       closedir(DIR); # || &tidy_up_and_die(1,"$Pgm: error when closing directory: $d\n");
1980     }
1981
1982 #
1983 # Not currently used:
1984 #
1985 #    $HiMapFile = "$Tmp_prefix.himap";
1986 #    unlink($HiMapFile);
1987 #    open(HIMAP, "> $HiMapFile") || &tidy_up_and_die(1,"$Pgm: can't open $HiMapFile\n");
1988 #    foreach $d (keys %HiMap) {
1989 #       print HIMAP $d, ' ', $HiMap{$d}, "\n";
1990 #    }
1991 #    close(HIMAP) || &tidy_up_and_die(1,"$Pgm: error when closing $HiMapFile\n");
1992
1993     $HiMapDone = 1;
1994 }
1995
1996 sub already_mapped_err {
1997     local($mod, $mapped_to, $path) = @_;
1998
1999     # OK, it isn't really an error if $mapped_to and $path turn
2000     # out to be the same thing.
2001     ($m_dev,$m_ino,$m_mode,$m_nlink,$m_uid,$m_gid,$m_rdev,$m_size,
2002      $m_atime,$m_mtime,$m_ctime,$m_blksize,$m_blocks) = stat($mapped_to);
2003     ($p_dev,$p_ino,$p_mode,$p_nlink,$p_uid,$p_gid,$p_rdev,$p_size,
2004      $p_atime,$p_mtime,$p_ctime,$p_blksize,$p_blocks) = stat($path);
2005
2006     return if $m_ino == $p_ino; # same inode number
2007
2008     print STDERR "$Pgm: module $mod already mapped to $mapped_to";
2009     print STDERR ";\n\tignoring: $path\n";
2010 }
2011 \end{code}
2012
2013 %************************************************************************
2014 %*                                                                      *
2015 \section[Driver-misc-utils]{Miscellaneous utilities}
2016 %*                                                                      *
2017 %************************************************************************
2018
2019 %************************************************************************
2020 %*                                                                      *
2021 \subsection[Driver-odir-ify]{@odir_ify@: Mangle filename if \tr{-odir} set}
2022 %*                                                                      *
2023 %************************************************************************
2024
2025 \begin{code}
2026 sub osuf_ify {
2027     local($ofile,$def_suffix) = @_;
2028
2029     return(($Osuffix eq '') ? "$ofile.$def_suffix" : "$ofile.$Osuffix" );
2030 }
2031
2032 sub odir_ify {
2033     local($orig_file, $def_suffix) = @_;
2034     if ($Specific_output_dir eq '') {   # do nothing
2035         &osuf_ify($orig_file, $def_suffix);
2036     } else {
2037         local ($orig_file_only);
2038         ($orig_file_only = $orig_file) =~ s|.*/||;
2039         &osuf_ify("$Specific_output_dir/$orig_file_only",$def_suffix);
2040     }
2041 }
2042 \end{code}
2043
2044 \begin{code}
2045 sub runGcc {
2046     local($is_hc_file, $hsc_out, $cc_as_o) = @_;
2047
2048     local($includes) = '-I' . join(' -I', @Include_dir);
2049     local($cc);
2050     local($s_output);
2051     local($c_flags) = "@CcBoth_flags";
2052     local($ddebug_flag) = ( $DEBUGging ) ? '-DDEBUG' : '';
2053
2054     # "input" files to use that are not in some weird directory;
2055     # to help C compilers grok .hc files [ToDo: de-hackify]
2056     local($cc_help)   = "ghc$$.c";
2057     local($cc_help_s) = "ghc$$.s";
2058
2059     $cc       = $CcRegd;
2060     $s_output = ($is_hc_file || $TargetPlatform =~ /^(hppa|i386)/) ? $cc_as_o : $cc_as;
2061     $c_flags .= " @CcRegd_flags";
2062     $c_flags .= ($is_hc_file) ? " @CcRegd_flags_hc"  : " @CcRegd_flags_c";
2063
2064     # C compiler won't like the .hc extension.  So we create
2065     # a tmp .c file which #include's the needful.
2066     open(TMP, "> $cc_help") || &tidy_up_and_die(1,"$Pgm: failed to open `$cc_help' (to write)\n");
2067     if ( $is_hc_file ) {
2068         print TMP <<EOINCL;
2069 #ifdef __STG_GCC_REGS__
2070 # if ! (defined(MAIN_REG_MAP) || defined(MARK_REG_MAP) || defined(SCAN_REG_MAP) || defined(SCAV_REG_MAP) || defined(FLUSH_REG_MAP))
2071 #  define MAIN_REG_MAP
2072 # endif
2073 #endif
2074 #include "stgdefs.h"
2075 EOINCL
2076         # user may have asked for #includes to be injected...
2077         print TMP @CcInjects if $#CcInjects >= 0;
2078     }
2079     # heave in the consistency info
2080     print TMP "static char ghc_cc_ID[] = \"\@(#)cc $ifile\t$Cc_major_version.$Cc_minor_version,$Cc_consist_options\";\n";
2081
2082     # and #include the real source
2083     print TMP "#include \"$hsc_out\"\n";
2084     close(TMP) || &tidy_up_and_die(1,"Failed writing to $cc_help\n");
2085
2086     local($to_do) = "$cc $Verbose $ddebug_flag $c_flags @Cpp_define -D__HASKELL1__=$Haskell1Version $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 )";
2087     # note: __GLASGOW_HASKELL__ is pointedly *not* #defined at the C level.
2088     if ( $Only_preprocess_C ) { # HACK ALERT!
2089         $to_do =~ s/ -S\b//g;
2090     }
2091     @Files_to_tidy = ( $cc_help, $cc_help_s, $s_output );
2092     $PostprocessCcOutput = 1;   # hack, dear hack...
2093     &run_something($to_do, 'C compiler');
2094     $PostprocessCcOutput = 0;
2095     unlink($cc_help, $cc_help_s);
2096 }
2097 \end{code}
2098
2099 \begin{code}
2100 sub runMangler {
2101     local($is_hc_file, $cc_as_o, $cc_as, $ifile_root) = @_;
2102
2103     if ( $is_hc_file ) {
2104         # dynamically load assembler-fiddling code, which we are about to use:
2105         require('ghc-asm.prl')
2106         || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm.prl!\n");
2107     }
2108
2109     print STDERR `cat $cc_as_o` if $Dump_raw_asm; # to stderr, before mangling
2110
2111     if ($is_hc_file) {
2112         # post-process the assembler [.hc files only]
2113         &mangle_asm($cc_as_o, $cc_as);
2114
2115
2116 #OLD: for sanity:
2117 #OLD:   local($target) = 'oops';
2118 #OLD:   $target = '-alpha'      if $TargetPlatform =~ /^alpha-/;
2119 #OLD:   $target = '-hppa'       if $TargetPlatform =~ /^hppa/;
2120 #OLD:   $target = '-old-asm'    if $TargetPlatform =~ /^i386-/;
2121 #OLD:   $target = '-m68k'       if $TargetPlatform =~ /^m68k-/;
2122 #OLD:   $target = '-mips'       if $TargetPlatform =~ /^mips-/;
2123 #OLD:   $target = ''            if $TargetPlatform =~ /^powerpc-/;
2124 #OLD:   $target = '-solaris'    if $TargetPlatform =~ /^sparc-sun-solaris2/;
2125 #OLD:   $target = '-sparc'      if $TargetPlatform =~ /^sparc-sun-sunos4/;
2126 #OLD:
2127 #OLD:   if ( $target ne '' ) {
2128 #OLD:       require("ghc-asm$target.prl")
2129 #OLD:       || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm$target.prl!\n");
2130 #OLD:       &mangle_asm($cc_as_o, "$cc_as-2"); # the OLD one!
2131 #OLD:       &run_something("$Cmp -s $cc_as-2 $cc_as || $Diff $cc_as-2 $cc_as 1>&2 || exit 0",
2132 #OLD:           "Diff'ing old and new mangled .s files"); # NB: to stderr
2133 #OLD:   }
2134
2135     } elsif ($TargetPlatform =~ /^hppa/) {
2136         # minor mangling of non-threaded files for hp-pa only
2137         require('ghc-asm.prl')
2138         || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm-hppa.prl!\n");
2139         &mini_mangle_asm_hppa($cc_as_o, $cc_as);
2140
2141     } elsif ($TargetPlatform =~ /^i386/) {
2142         # extremely-minor OFFENSIVE mangling of non-threaded just one file
2143         require('ghc-asm.prl')
2144         || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm.prl!\n");
2145         &mini_mangle_asm_i386($cc_as_o, $cc_as);
2146     }
2147
2148     # save a copy of the .s file, even if we are carrying on...
2149     if ($do_as && $Keep_s_file_too) {
2150         local($to_do) = "$Rm $ifile_root.s; $Cp $cc_as $ifile_root.s";
2151         &run_something($to_do, 'Saving copy of .s file');
2152     }
2153 }
2154 \end{code}
2155
2156 \begin{code}
2157 sub runAs {
2158     local($as_out, $ifile_root) = @_;
2159
2160     local($asmblr) = ( $As ) ? $As : $CcRegd;
2161
2162     if ( ! $SplitObjFiles ) {
2163         local($to_do)  = "$asmblr -o $as_out -c @As_flags $cc_as";
2164         @Files_to_tidy = ( $as_out );
2165         &run_something($to_do, 'Unix assembler');
2166
2167     } else { # more complicated split-ification...
2168
2169         # must assemble files $Tmp_prefix__[1 .. $NoOfSplitFiles].s
2170
2171         # If -odir is used, great, just pin it in front of the
2172         # generated split file names. If it hasn't been set, we
2173         # snatch it from the ifile_root.
2174         #
2175         #
2176
2177         if ( $Specific_output_dir eq '' ) {
2178             $Specific_output_dir = ${ifile_root};
2179         }
2180
2181         for ($f = 1; $f <= $NoOfSplitFiles; $f++ ) {
2182             local($split_out) = &odir_ify("${ifile_root}__${f}",'o');
2183             local($to_do) = "$asmblr -o $split_out -c @As_flags ${Tmp_prefix}__${f}.s";
2184             @Files_to_tidy = ( $split_out );
2185
2186             &run_something($to_do, 'Unix assembler');
2187         }
2188     }
2189 }
2190 \end{code}
2191
2192 %************************************************************************
2193 %*                                                                      *
2194 \subsection[Driver-run-something]{@run_something@: Run a phase}
2195 %*                                                                      *
2196 %************************************************************************
2197
2198 \begin{code}
2199 sub run_something {
2200     local($str_to_do, $tidy_name) = @_;
2201
2202     print STDERR "\n$tidy_name:\n\t" if $Verbose;
2203     print STDERR "$str_to_do\n" if $Verbose;
2204
2205     if ($Using_dump_file) {
2206         open(DUMP, ">> $Specific_dump_file")
2207             || &tidy_up_and_die(1,"$Pgm: failed to open `$Specific_dump_file'\n");
2208         print DUMP "\nCompilation Dump for: $str_to_do\n\n";
2209         close(DUMP)
2210             || &tidy_up_and_die(1,"$Pgm: failed closing `$Specific_dump_file'\n");
2211     }
2212
2213     local($return_val) = 0;
2214     system("$Time $str_to_do");
2215     $return_val = $?;
2216
2217     if ( $PostprocessCcOutput ) { # hack, continued
2218         open(CCOUT, "< $Tmp_prefix.ccout")
2219             || &tidy_up_and_die(1,"$Pgm: failed to open `$Tmp_prefix.ccout'\n");
2220         while ( <CCOUT> ) {
2221             next if /attribute directive ignored/;
2222             next if /call-clobbered/;
2223             next if /from .*COptRegs\.lh/;
2224             next if /from .*(stg|rts)defs\.h:/;
2225             next if /from ghc\d+.c:\d+:/;
2226             next if /from .*\.lc/;
2227             next if /from .*SMinternal\.l?h/;
2228             next if /ANSI C does not support \`long long\'/;
2229             next if /warning:.*was declared \`extern\' and later \`static\'/;
2230             next if /warning: assignment discards \`const\' from pointer target type/;
2231             next if /: At top level:$/;
2232             next if /: In function \`.*\':$/;
2233             next if /\`ghc_cc_ID\' defined but not used/;
2234             print STDERR $_;
2235         }
2236         close(CCOUT) || &tidy_up_and_die(1,"$Pgm: failed closing `$Tmp_prefix.ccout'\n");
2237     }
2238
2239     if ($return_val != 0) {
2240         if ($Using_dump_file) {
2241             print STDERR "Compilation Errors dumped in $Specific_dump_file\n";
2242         }
2243
2244         &tidy_up_and_die($return_val, '');
2245     }
2246     $Using_dump_file = 0;
2247 }
2248 \end{code}
2249
2250 %************************************************************************
2251 %*                                                                      *
2252 \subsection[Driver-ghctiming]{Emit nofibbish GHC timings}
2253 %*                                                                      *
2254 %************************************************************************
2255
2256 NB: nearly the same as in @runstdtest@ script.
2257
2258 \begin{code}
2259 sub process_ghc_timings {
2260     local($StatsFile) = "$Tmp_prefix.stat";
2261     local($SysSpecificTiming) = 'ghc';
2262
2263     open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n";
2264     local($tot_live) = 0; # for calculating avg residency
2265
2266     while (<STATS>) {
2267         $tot_live += $1 if /^\s*\d+\s+\d+\s+\d+\.\d+\%\s+(\d+)\s+\d+\.\d+\%/;
2268
2269         $BytesAlloc = $1 if /^\s*([0-9,]+) bytes allocated in the heap/;
2270
2271         if ( /^\s*([0-9,]+) bytes maximum residency .* (\d+) sample/ ) {
2272             $MaxResidency = $1; $ResidencySamples = $2;
2273         }
2274
2275         $GCs = $1 if /^\s*([0-9,]+) garbage collections? performed/;
2276
2277         if ( /^\s*INIT\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) {
2278             $InitTime = $1; $InitElapsed = $2;
2279         } elsif ( /^\s*MUT\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) {
2280             $MutTime = $1; $MutElapsed = $2;
2281         } elsif ( /^\s*GC\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) {
2282             $GcTime = $1; $GcElapsed = $2;
2283         }
2284     }
2285     close(STATS) || die "Failed when closing $StatsFile\n";
2286     if ( defined($ResidencySamples) && $ResidencySamples > 0 ) {
2287         $AvgResidency = int ($tot_live / $ResidencySamples) ;
2288     }
2289
2290     # warn about what we didn't find
2291     print STDERR "Warning: BytesAlloc not found in stats file\n" unless defined($BytesAlloc);
2292     print STDERR "Warning: GCs not found in stats file\n" unless defined($GCs);
2293     print STDERR "Warning: InitTime not found in stats file\n" unless defined($InitTime);
2294     print STDERR "Warning: InitElapsed not found in stats file\n" unless defined($InitElapsed);
2295     print STDERR "Warning: MutTime not found in stats file\n" unless defined($MutTime);
2296     print STDERR "Warning: MutElapsed not found in stats file\n" unless defined($MutElapsed);
2297     print STDERR "Warning: GcTime inot found in stats file\n" unless defined($GcTime);
2298     print STDERR "Warning: GcElapsed not found in stats file\n" unless defined($GcElapsed);
2299
2300     # things we didn't necessarily expect to find
2301     $MaxResidency     = 0 unless defined($MaxResidency);
2302     $AvgResidency     = 0 unless defined($AvgResidency);
2303     $ResidencySamples = 0 unless defined($ResidencySamples);
2304
2305     # a bit of tidying
2306     $BytesAlloc =~ s/,//g;
2307     $MaxResidency =~ s/,//g;
2308     $GCs =~ s/,//g;
2309     $InitTime =~ s/,//g;
2310     $InitElapsed =~ s/,//g;
2311     $MutTime =~ s/,//g;
2312     $MutElapsed =~ s/,//g;
2313     $GcTime =~ s/,//g;
2314     $GcElapsed =~ s/,//g;
2315
2316     # print out what we found
2317     print STDERR "<<$SysSpecificTiming: ",
2318         "$BytesAlloc bytes, $GCs GCs, $AvgResidency/$MaxResidency avg/max bytes residency ($ResidencySamples samples), $InitTime INIT ($InitElapsed elapsed), $MutTime MUT ($MutElapsed elapsed), $GcTime GC ($GcElapsed elapsed)",
2319         " :$SysSpecificTiming>>\n";
2320
2321     # OK, party over
2322     unlink $StatsFile;
2323 }
2324 \end{code}
2325
2326 %************************************************************************
2327 %*                                                                      *
2328 \subsection[Driver-dying]{@tidy_up@ and @tidy_up_and_die@: Dying gracefully}
2329 %*                                                                      *
2330 %************************************************************************
2331
2332 \begin{code}
2333 sub tidy_up {
2334     local($to_do) = "\n$Rm $Tmp_prefix*";
2335     if ( $Tmp_prefix !~ /^\s*$/ ) {
2336         print STDERR "$to_do\n" if $Verbose;
2337         system($to_do);
2338     }
2339 }
2340
2341 sub tidy_up_and_die {
2342     local($return_val, $msg) = @_;
2343
2344     # delete any files to tidy
2345     print STDERR "deleting... @Files_to_tidy\n" if $Verbose && $#Files_to_tidy >= 0;
2346     unlink @Files_to_tidy if $#Files_to_tidy >= 0;
2347
2348     &tidy_up();
2349     print STDERR $msg;
2350     exit (($return_val == 0) ? 0 : 1);
2351 }
2352 \end{code}
2353
2354 %************************************************************************
2355 %*                                                                      *
2356 \subsection[Driver-arg-with-arg]{@grab_arg_arg@: Do an argument with an argument}
2357 %*                                                                      *
2358 %************************************************************************
2359
2360 Some command-line arguments take an argument, e.g.,
2361 \tr{-Rmax-heapsize} expects a number to follow.  This can either be
2362 given a part of the same argument (\tr{-Rmax-heapsize8M}) or as the
2363 next argument (\tr{-Rmax-heapsize 8M}).  We allow both cases.
2364
2365 Note: no error-checking; \tr{-Rmax-heapsize -Rgc-stats} will silently
2366 gobble the second argument (and probably set the heapsize to something
2367 nonsensical).
2368 \begin{code}
2369 sub grab_arg_arg {
2370     local(*Args, $option, $rest_of_arg) = @_;
2371
2372     if ($rest_of_arg) {
2373         return($rest_of_arg);
2374     } elsif ($#Args >= 0) {
2375         local($temp) = $Args[0]; shift(@Args);
2376         return($temp);
2377     } else {
2378         print STDERR "$Pgm: no argument following $option option\n";
2379         $Status++;
2380     }
2381 }
2382 \end{code}
2383
2384 \begin{code}
2385 sub isntAntiFlag {
2386     local($flag) = @_;
2387     local($f);
2388
2389 #Not in HsC_antiflag ## NO!: and not already in HsC_flags
2390
2391     foreach $f ( @HsC_antiflags ) {
2392         return(0) if $flag eq $f;
2393     }
2394 #    foreach $f ( @HsC_flags ) {
2395 #       return(0) if $flag eq $f;
2396 #    }
2397     return(1);
2398 }
2399
2400 sub squashHscFlag {  # pretty terrible
2401     local($flag) = @_;
2402     local($f);
2403
2404     foreach $f ( @HsC_flags ) {
2405         if ($flag eq $f) { $f = ''; }
2406     }
2407 }
2408
2409 sub add_Hsc_flags {
2410     local(@flags) = @_;
2411     local($f);
2412
2413     foreach $f ( @flags ) {
2414         push( @HsC_flags, $f ) if &isntAntiFlag($f);
2415     }
2416 }
2417 \end{code}
2418
2419 Source files may have {-# OPTIONS ... #-} pragmas at the top, containing
2420 command line options we want to append to collection of commands specified
2421 directly. @check_for_source_options@ looks at the top of a de-lit'ified Haskell
2422 file for any such pragmas:
2423
2424 \begin{code}
2425 sub check_for_source_options {
2426     local($file) = @_;
2427
2428     open(FILE,$file) || return(1); # No big loss
2429
2430     while (<FILE>) {
2431         if ( /^{-# OPTIONS (.*)#-}/ ) {
2432            # add the options found at the back of the command line.
2433            local(@entries) = split(/\s+/,$1);
2434            push(@File_options, @entries);
2435         }
2436         elsif ( /^$/ ) { # ignore empty lines
2437            ;
2438         }
2439         else { # stop looking, something non-empty / not
2440                # {-# OPTIONS .. #-} encountered.
2441             break;
2442         }
2443     }
2444     close(FILE);
2445     return(0);
2446 }
2447 \end{code}
2448
2449
2450 We split the initial argv up into three arrays:
2451
2452   - @Cmd_opts
2453   - @Link_file
2454   - @Input_file
2455
2456 the reason for doing so is to be able to deal
2457 with {-# OPTIONS #-} pragma in source files properly.
2458
2459 \begin{code}
2460 sub splitCmdLine {
2461     local(@args) = @_;
2462
2463 arg: while($_ = $args[0]) {
2464     shift(@args);
2465     # sigh, we have to deal with these -option arg specially here.
2466     /^-(tmpdir|odir|o|isuf|osuf|hisuf|hisuf-prelude|odump|syslib)$/ &&
2467        do { push(@Cmd_opts, $_); push(@Cmd_opts,$args[0]); shift(@args); next arg; };
2468     /^-./  && do { push(@Cmd_opts, $_); next arg; };
2469
2470     if (/\.[oa]$/) {
2471         push(@Link_file, $_);
2472     } else {
2473         push(@Input_file, $_);
2474     }
2475
2476     # input files must exist:
2477     if (! -f $_) {
2478         print STDERR "$Pgm: input file doesn't exist: $_\n";
2479         $Status++;
2480     }
2481   }
2482 }
2483
2484 \end{code}
2485
2486 Command-line processor
2487
2488 \begin{code}
2489 sub processArgs {
2490     local(@Args) = @_;
2491
2492 # can't use getopt(s); what we want is too complicated
2493
2494 arg: while($_ = $Args[0]) {
2495     shift(@Args);
2496
2497     #---------- help -------------------------------------------------------
2498     if (/^-\?$/ || /^--?help$/) { print $LongUsage; exit $Status; }
2499
2500     #-----------version ----------------------------------------------------
2501     /^--version$/   && do { print STDERR "${PROJECTNAME}, version ${PROJECTVERSION}, patchlevel ${PROJECTPATCHLEVEL}\n"; exit $Status; };
2502
2503     #---------- verbosity and such -----------------------------------------
2504     /^-v$/          && do { $Verbose = '-v'; $Time = 'time'; next arg; };
2505
2506     #---------- what phases are to be run ----------------------------------
2507     /^-recomp/      && do { $Do_recomp_chkr = 1; next arg; };
2508
2509     /^-cpp$/        && do { $Cpp_flag_set = 1; next arg; };
2510     # change the global default:
2511     # we won't run cat; we'll run the real thing
2512
2513     /^-C$/          && do { $Do_cc = 0; $Do_as = 0; $Do_lnkr = 0; $HscOut = '-C=';
2514                             next arg; };
2515     # stop after generating C
2516
2517     /^-noC$/        && do { $HscOut = '-N='; $ProduceHi = '-nohifile=';
2518                             $Do_cc = 0; $Do_as = 0; $Do_lnkr = 0;
2519                             next arg; };
2520     # leave out actual C generation (debugging) [also turns off interface gen]
2521
2522     /^-hi$/         && do { $HiOnStdout = 1; $ProduceHi = '-hifile='; next arg; };
2523     # _do_ generate an interface; usually used as: -noC -hi
2524
2525     /^-nohi$/       && do { $ProduceHi = '-nohifile='; next arg; };
2526     # don't generate an interface (even if generating C)
2527
2528     /^-hi-diffs$/             && do { $HiDiff_flag = 'normal'; next arg; };
2529     /^-hi-diffs-with-usages$/ && do { $HiDiff_flag = 'usages'; next arg; };
2530     /^-no-hi-diffs$/          && do { $HiDiff_flag = '';       next arg; };
2531     # show/disable diffs if the interface file changes
2532
2533     /^-E$/          && do { push(@CcBoth_flags, '-E');
2534                             $Only_preprocess_C = 1;
2535                             $Do_as = 0; $Do_lnkr = 0; next arg; };
2536     # stop after preprocessing C
2537     /^-M$/          && do { $Only_generate_deps = 1; $Do_as = 0; $Do_lnkr = 0; next arg; };
2538     # only generate dependency information.
2539     /^-S$/          && do { $Do_as = 0; $Do_lnkr = 0; next arg; };
2540     # stop after generating assembler
2541
2542     /^-c$/          && do { $Do_lnkr = 0; next arg; };
2543     # stop after generating .o files
2544
2545     /^-link-chk$/    && do { $LinkChk = 1; next arg; };
2546     /^-no-link-chk$/ && do { $LinkChk = 0; next arg; };
2547     # don't do consistency-checking after a link
2548
2549     /^-tmpdir$/ && do { $Tmp_prefix = &grab_arg_arg(*Args,'-tmpdir', '');
2550                         $Tmp_prefix = "$Tmp_prefix/ghc$$";
2551                         $ENV{'TMPDIR'} = $Tmp_prefix; # for those who use it...
2552                         next arg; };
2553     # use an alternate directory for temp files
2554
2555     #---------- redirect output --------------------------------------------
2556
2557     # -o <file>; applies to the last phase, whatever it is
2558     # "-o -" sends it to stdout
2559     # if <file> has a directory component, that dir must already exist
2560
2561     /^-odir$/       && do { $Specific_output_dir = &grab_arg_arg(*Args,'-odir', '');
2562                             #
2563                             # Hack, of the worst sort: don't do validation of
2564                             # odir argument if you're using -M (dependency generation).
2565                             #
2566                             if ( ! $Only_generate_deps && ! -d $Specific_output_dir) {
2567                                 print STDERR "$Pgm: -odir: no such directory: $Specific_output_dir\n";
2568                                 $Status++;
2569                             }
2570                             next arg; };
2571
2572     /^-o$/          && do { $Specific_output_file = &grab_arg_arg(*Args,'-o', '');
2573                             if ($Specific_output_file ne '-'
2574                              && $Specific_output_file =~ /(.*)\/[^\/]*$/) {
2575                                 local($dir_part) = $1;
2576                                 if (! -d $dir_part) {
2577                                     print STDERR "$Pgm: no such directory: $dir_part\n";
2578                                     $Status++;
2579                                 }
2580                             }
2581                             next arg; };
2582
2583     # NB: -isuf not documented yet (because it doesn't work yet)
2584     /^-isuf$/       && do { $Isuffix  = &grab_arg_arg(*Args,'-isuf', '');
2585                             if ($Isuffix =~ /\./ ) {
2586                                 print STDERR "$Pgm: -isuf suffix shouldn't contain a .\n";
2587                                 $Status++;
2588                             }
2589                             next arg; };
2590
2591     /^-osuf$/       && do { $Osuffix  = &grab_arg_arg(*Args,'-osuf', '');
2592                             if ($Osuffix =~ /\./ ) {
2593                                 print STDERR "$Pgm: -osuf suffix shouldn't contain a .\n";
2594                                 $Status++;
2595                             }
2596                             next arg; };
2597
2598     # -ohi <file>; send the interface to <file>; "-ohi -" to send to stdout
2599     /^-ohi$/        && do { $Specific_hi_file = &grab_arg_arg(*Args,'-ohi', '');
2600                             if ($Specific_hi_file ne '-'
2601                              && $Specific_hi_file =~ /(.*)\/[^\/]*$/) {
2602                                 local($dir_part) = $1;
2603                                 if (! -d $dir_part) {
2604                                     print STDERR "$Pgm: no such directory: $dir_part\n";
2605                                     $Status++;
2606                                 }
2607                             }
2608                             next arg; };
2609
2610     # The suffix to use when looking for interface files
2611     /^-hisuf$/      && do { $HiSuffix = &grab_arg_arg(*Args,'-hisuf', '');
2612                             if ($HiSuffix =~ /\./ ) {
2613                                 print STDERR "$Pgm: -hisuf suffix shouldn't contain a .\n";
2614                                 $Status++;
2615                             }
2616                             next arg; };
2617     # ToDo: remove, not a `normal' user thing to do (should be automatic)
2618     /^-hisuf-prelude$/      && do { $HiSuffix_prelude = &grab_arg_arg(*Args,'-hisuf-prelude', '');
2619                             if ($HiSuffix =~ /\./ ) {
2620                                 print STDERR "$Pgm: -hisuf-prelude suffix shouldn't contain a .\n";
2621                                 $Status++;
2622                             }
2623                             next arg; };
2624     /^-odump$/      && do { $Specific_dump_file = &grab_arg_arg(*Args,'-odump', '');
2625                             if ($Specific_dump_file =~ /(.*)\/[^\/]*$/) {
2626                                 local($dir_part) = $1;
2627                                 if (! -d $dir_part) {
2628                                     print STDERR "$Pgm: no such directory: $dir_part\n";
2629                                     $Status++;
2630                                 }
2631                             }
2632                             next arg; };
2633
2634     #-------------- scc & Profiling Stuff ----------------------------------
2635
2636     /^-prof$/ && do { $PROFing = 'p'; next arg; }; # profiling -- details later!
2637
2638     /^-auto/ && do {
2639                 # generate auto SCCs on top level bindings
2640                 # -auto-all = all top level bindings
2641                 # -auto     = only top level exported bindings
2642                 $PROFauto = ( /-all/ )
2643                             ? '-fauto-sccs-on-all-toplevs'
2644                             : '-fauto-sccs-on-exported-toplevs';
2645                 next arg; };
2646
2647     /^-caf-all/ && do { # generate individual CAF SCC annotations
2648                 $PROFcaf = '-fauto-sccs-on-individual-cafs';
2649                 next arg; };
2650
2651     /^-ignore-scc$/ && do {
2652                 # forces ignore of scc annotations even if profiling
2653                 $PROFignore_scc = '-W';
2654                 next arg; };
2655
2656     /^-G(.*)$/  && do { push(@HsC_flags, "-G=$1");   # set group for cost centres
2657                         next arg; };
2658
2659     /^-unprof-scc-auto/ && do {
2660                 # generate auto SCCs on top level bindings when not profiling.
2661                 # Used to measure optimisation effects of presence of sccs.
2662                 $UNPROFscc_auto = ( /-all/ )
2663                             ? '-fauto-sccs-on-all-toplevs'
2664                             : '-fauto-sccs-on-exported-toplevs';
2665                 next arg; };
2666
2667     #--------- ticky/concurrent/parallel -----------------------------------
2668     # we sort out the details a bit later on
2669
2670     /^-concurrent$/ && do { $CONCURing = 'c'; next arg; }; # concurrent Haskell
2671     /^-gransim$/    && do { $GRANing   = 'g'; next arg; }; # GranSim
2672     /^-ticky$/      && do { $TICKYing  = 't'; next arg; }; # ticky-ticky
2673     /^-parallel$/   && do { $PARing    = 'p'; next arg; }; # parallel Haskell
2674
2675     #-------------- "user ways" --------------------------------------------
2676
2677     (/^-user-setup-([a-oA-Z])$/ ) &&
2678            do {
2679                 /^-user-setup-([a-oA-Z])$/  && do { $BuildTag = "_$1"; };
2680
2681                 local($stuff) = $UserSetupOpts{$BuildTag};
2682                 local(@opts)  = split(/\s+/, $stuff);
2683
2684                 # feed relevant ops into the arg-processing loop (if any)
2685                 unshift(@Args, @opts) if $#opts >= 0;
2686
2687                 next arg; };
2688
2689     #---------- set search paths for libraries and things ------------------
2690
2691     # we do -i just like HBC (-i clears the list; -i<colon-separated-items>
2692     # prepends the items to the list); -I is for including C .h files.
2693
2694     /^-i$/          && do { @Import_dir = ();  # import path cleared!
2695                             @SysImport_dir = ();
2696                             print STDERR "WARNING: import paths cleared by `-i'\n";
2697                             next arg; };
2698
2699     /^-i(.*)/       && do { local(@new_items)
2700                               = split( /:/, &grab_arg_arg(*Args,'-i', $1));
2701                             unshift(@Import_dir, @new_items);
2702                             next arg; };
2703
2704     /^-I(.*)/       && do { push(@Include_dir,     &grab_arg_arg(*Args,'-I', $1)); next arg; };
2705     /^-L(.*)/       && do { push(@UserLibrary_dir, &grab_arg_arg(*Args,'-L', $1)); next arg; };
2706     /^-l(.*)/       && do { push(@UserLibrary,'-l'.&grab_arg_arg(*Args,'-l', $1)); next arg; };
2707
2708     /^-syslib(.*)/  && do { local($syslib) = &grab_arg_arg(*Args,'-syslib',$1);
2709                             print STDERR "$Pgm: no such system library (-syslib): $syslib\n",
2710                               $Status++ unless $syslib =~ /^(hbc|ghc|posix|contrib)$/;
2711
2712                             unshift(@SysImport_dir,
2713                                 ${INSTALLING}
2714                                 ? "$InstSysLibDir/$syslib/imports"
2715                                 : "$TopPwd/hslibs/$syslib/src");
2716
2717                             if ( ${INSTALLING} ) {
2718                                 push(@SysLibrary_dir,
2719                                         ("$InstSysLibDir"));
2720                             } else {
2721                                 push(@SysLibrary_dir,
2722                                         ("$TopPwd/hslibs/$syslib"
2723                                         ,"$TopPwd/hslibs/$syslib/cbits"));
2724                             }
2725
2726                             push(@SysLibrary, "-lHS$syslib");
2727                             push(@SysLibrary, "-lHS${syslib}_cbits")
2728                               unless $syslib eq 'contrib'; #HACK! it has no cbits
2729
2730                             next arg; };
2731
2732     #=======================================================================
2733     # various flags that we can harmlessly send to one program or another
2734     # (we will later "reclaim" some of the compiler ones now sent to gcc)
2735     #=======================================================================
2736
2737     #---------- this driver itself (ghc) -----------------------------------
2738     # these change what executable is run for each phase:
2739     /^-pgmL(.*)$/   && do { $Unlit      = $1; next arg; };
2740     /^-pgmP(.*)$/   && do { $HsCpp      = $1; next arg; };
2741     /^-pgmC(.*)$/   && do { $HsC        = $1; next arg; };
2742     /^-pgmcO?(.*)$/ && do { $CcRegd     = $1; next arg; }; # the O? for back compat
2743     /^-pgma(.*)$/   && do { $As         = $1; next arg; };
2744     /^-pgml(.*)$/   && do { $Lnkr       = $1; next arg; };
2745     /^-pgmdep(.*)$/ && do { $MkDependHS = $1; next arg; };
2746
2747     #---------- the get-anything-through opts (all pgms) -------------------
2748     # these allow arbitrary option-strings to go to any phase:
2749     /^-optL(.*)$/   && do { push(@Unlit_flags,      $1); next arg; };
2750     /^-optP(.*)$/   && do { push(@HsCpp_flags,      $1); next arg; };
2751     /^-optCrts(.*)$/&& do { push(@HsC_rts_flags,    $1); next arg; };
2752     /^-optC(.*)$/   && do { push(@HsC_flags,        $1); next arg; };
2753     /^-optcpp(.*)$/ && do { push(@Cpp_define,       $1); next arg; };
2754     /^-optc(.*)$/   && do { push(@CcBoth_flags,     $1); next arg; };
2755     /^-opta(.*)$/   && do { push(@As_flags,         $1); next arg; };
2756     /^-optl(.*)$/   && do { push(@Ld_flags,         $1); next arg; };
2757     /^-optdep(.*)$/ && do { push(@MkDependHS_flags, $1); next arg; };
2758
2759     #---------- Haskell C pre-processor (hscpp) ----------------------------
2760     /^-D(.*)/       && do { push(@HsCpp_flags, "'-D".&grab_arg_arg(*Args,'-D',$1)."'"); next arg; };
2761     /^-U(.*)/       && do { push(@HsCpp_flags, "'-U".&grab_arg_arg(*Args,'-U',$1)."'"); next arg; };
2762
2763     /^-genSPECS/   && do { $Cpp_flag_set = 1;
2764                            $genSPECS_flag = $_;
2765                             next arg; };
2766
2767     #---------- post-Haskell "assembler"------------------------------------
2768     /^-ddump-raw-asm$/            && do { $Dump_raw_asm        = 1; next arg; };
2769     /^-ddump-asm-splitting-info$/ && do { $Dump_asm_splitting_info = 1; next arg; };
2770
2771     #---------- Haskell compiler (hsc) -------------------------------------
2772
2773     /^-keep-hc-files?-too$/     && do { $Keep_hc_file_too = 1; next arg; };
2774     /^-keep-s-files?-too$/      && do { $Keep_s_file_too = 1;  next arg; };
2775
2776     /^-fhaskell-1\.3$/          && do { next arg; }; # a no-op right now
2777
2778     /^-fignore-interface-pragmas$/ && do { push(@HsC_flags, $_); next arg; };
2779
2780     /^-fno-implicit-prelude$/      && do { $NoImplicitPrelude= 1; push(@HsC_flags, $_); next arg; };
2781      # don't do stack checking using page fault `trick'.
2782      # (esoteric).
2783     /^-fstack-check$/              && do { $StkChkByPageFaultOK = 0; next arg; };
2784      #
2785      # have the compiler proper generate concurrent code,
2786      # really only used when you want to configure your own
2787      # special user compilation way. (Use -concurrent when
2788      # compiling `Concurrent Haskell' programs).
2789      #
2790      # (ditto for -fgransim, fscc-profiling and -fticky-ticky)
2791      #
2792     /^-fconcurrent$/      && do { push(@HsC_flags,$_); next arg; };
2793     /^-fscc-profiling$/   && do { push(@HsC_flags,$_); next arg; };
2794     /^-fticky-ticky$/     && do { push(@HsC_flags,$_); next arg; };
2795     /^-fgransim$/         && do { push(@HsC_flags,$_); next arg; };
2796
2797     /^-user-prelude-force/      && do { # ignore if not -user-prelude
2798                                         next arg; };
2799
2800     /^-split-objs/      && do {
2801                         if ( $TargetPlatform !~ /^(alpha|hppa1\.1|i386|m68k|mips|powerpc|sparc)-/ ) {
2802                             $SplitObjFiles = 0;
2803                             print STDERR "WARNING: don't know how to split objects on this platform: $TargetPlatform\n`-split-objs' option ignored\n";
2804                         } else {
2805                             $SplitObjFiles = 1;
2806                             $HscOut = '-C=';
2807
2808                             push(@HsC_flags, "-fglobalise-toplev-names");
2809                             push(@CcBoth_flags, '-DUSE_SPLIT_MARKERS');
2810
2811                             require('ghc-split.prl')
2812                              || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-split.prl!\n");
2813                         }
2814                         next arg; };
2815
2816     /^-fglasgow-exts$/
2817                 && do { push(@HsC_flags, $_);
2818                         push(@HsP_flags, '-N');
2819
2820 #                       push(@HsC_flags, '-fshow-import-specs');
2821
2822                         next arg; };
2823
2824     /^-fspeciali[sz]e-unboxed$/
2825                 && do { $Oopt_DoSpecialise      = '-fspecialise';
2826                         $Oopt_SpecialiseUnboxed = '-fspecialise-unboxed';
2827                         next arg; };
2828     /^-fspeciali[sz]e$/
2829                 && do { $Oopt_DoSpecialise = '-fspecialise'; next arg; };
2830     /^-fno-speciali[sz]e$/
2831                 && do { $Oopt_DoSpecialise = ''; next arg; };
2832
2833
2834 # Now the foldr/build options, which are *on* by default (for -O).
2835
2836     /^-ffoldr-build$/
2837                     && do { $Oopt_FoldrBuild = 1;
2838                             $Oopt_FB_Support = '-fdo-arity-expand';
2839                             #print "Yes F/B\n";
2840                             next arg; };
2841
2842     /^-fno-foldr-build$/
2843                     && do { $Oopt_FoldrBuild = 0;
2844                             $Oopt_FB_Support = '';
2845                             next arg; };
2846
2847     /^-fno-foldr-build-rule$/
2848                     && do { $Oopt_FoldrBuild = 0;
2849                             next arg; };
2850
2851     /^-fno-enable-tech$/
2852                     && do { $Oopt_FB_Support = '';
2853                             next arg; };
2854
2855     /^-fno-snapback-to-append$/
2856                     && do { $Oopt_FoldrBuildInline .= ' -fdo-not-fold-back-append ';
2857                             next arg; };
2858
2859     # ---------------
2860
2861     /^-fasm-(.*)$/  && do { $HscOut = '-S='; next arg; }; # force using nativeGen
2862     /^-fvia-C$/     && do { $HscOut = '-C='; next arg; }; # force using C compiler
2863
2864     # ---------------
2865
2866     /^(-funfolding-use-threshold)(.*)$/
2867                     && do { $Oopt_UnfoldingUseThreshold = $1 . &grab_arg_arg(*Args,$1, $2);
2868                             next arg; };
2869
2870     /^(-fmax-simplifier-iterations)(.*)$/
2871                     && do { $Oopt_MaxSimplifierIterations = $1 . &grab_arg_arg(*Args,$1, $2);
2872                             next arg; };
2873
2874     /^-fno-pedantic-bottoms$/
2875                     && do { $Oopt_PedanticBottoms = ''; next arg; };
2876
2877     /^-fdo-monad-eta-expansion$/
2878                     && do { $Oopt_MonadEtaExpansion = $_; next arg; };
2879
2880     /^-fno-let-from-(case|app|strict-let)$/ # experimental, really (WDP 95/10)
2881                     && do { push(@HsC_flags, $_); next arg; };
2882
2883     /^(-freturn-in-regs-threshold)(.*)$/
2884                     && do { local($what) = $1;
2885                             local($num)  = &grab_arg_arg(*Args,$what, $2);
2886                             if ($num < 2 || $num > 8) {
2887                                 die "Bad experimental flag: $_\n";
2888                             } else {
2889                                 $HscOut = '-C='; # force using C compiler
2890                                 push(@HsC_flags, "$what$num");
2891                                 push(@CcRegd_flags, "-D__STG_REGS_AVAIL__=$num");
2892                             }
2893                             next arg; };
2894
2895     # --------------- Warnings etc. ------
2896
2897     /^-f(show-import-specs)/
2898                     && do { push(@HsC_flags, $_); next arg; };
2899
2900     # for now, just -fwarn-name-shadowing
2901     /^-fwarn-(.*)$/   && do { push(@HsC_flags, $_); next arg; };
2902     /^-fno-(.*)$/   && do { push(@HsC_antiflags, "-f$1");
2903                             &squashHscFlag("-f$1");
2904                             next arg; };
2905
2906     # --------------- platform specific flags (for gcc mostly) ----------------
2907
2908     /^-mlong-calls$/ && do { # for GCC for HP-PA boxes,
2909                              # for 2.6.x..?, does not apply for 2.7.2
2910                              # any longer.
2911                             unshift(@CcBoth_flags, ( $_ ));
2912                             next arg; };
2913
2914     /^-m(v8|sparclite|cypress|supersparc|cpu=(cypress|supersparc))$/
2915                      && do { # for GCC for SPARCs
2916                             unshift(@CcBoth_flags, ( $_ ));
2917                             next arg; };
2918
2919     /^-monly-([432])-regs/ && do { # for iX86 boxes only; no effect otherwise
2920                             $StolenX86Regs = $1;
2921                             next arg; };
2922
2923     #*************** ... and lots of debugging ones (form: -d* )
2924
2925     # -d(no-)core-lint is done this way so it is turn-off-able.
2926     /^-dcore-lint/       && do { $CoreLint = '-dcore-lint'; next arg; };
2927     /^-dno-core-lint/    && do { $CoreLint = '';            next arg; };
2928     # Ditto for STG lint
2929     /^-dstg-lint/       && do { $StgLint = '-dstg-lint'; next arg; };
2930     /^-dno-stg-lint/    && do { $StgLint = '';           next arg; };
2931
2932     /^-d(dump|ppr)-/         && do { push(@HsC_flags, $_); next arg; };
2933     /^-dverbose-(simpl|stg)/ && do { push(@HsC_flags, $_); next arg; };
2934     /^-dshow-passes/         && do { push(@HsC_flags, $_); next arg; };
2935     /^-dshow-rn-trace/       && do { push(@HsC_flags, $_); next arg; };
2936     /^-dsource-stats/        && do { push(@HsC_flags, $_); next arg; };
2937     /^-dsimplifier-stats/    && do { push(@HsC_flags, $_); next arg; };
2938     /^-dstg-stats/           && do { $Oopt_StgStats = $_; next arg; };
2939
2940     #*************** ... and now all these -R* ones for its runtime system...
2941
2942     /^-Rscale-sizes?(.*)/ && do {
2943         $Scale_sizes_by = &grab_arg_arg(*Args,'-Rscale-sizes', $1);
2944         next arg; };
2945
2946     /^(-H|-Rmax-heapsize)(.*)/ && do {
2947         local($heap_size) = &grab_arg_arg(*Args,$1, $2);
2948         if ($heap_size =~ /(\d+)[Kk]$/) {
2949             $heap_size = $1 * 1000;
2950         } elsif ($heap_size =~ /(\d+)[Mm]$/) {
2951             $heap_size = $1 * 1000 * 1000;
2952         } elsif ($heap_size =~ /(\d+)[Gg]$/) {
2953             $heap_size = $1 * 1000 * 1000 * 1000;
2954         }
2955         if ($heap_size <= 0) {
2956             print STDERR "$Pgm: resetting heap-size to zero!!! $heap_size\n";
2957             $Specific_heap_size = 0;
2958
2959         # if several heap sizes given, take the largest...
2960         } elsif ($heap_size >= $Specific_heap_size) {
2961             $Specific_heap_size = $heap_size;
2962         } else {
2963             print STDERR "$Pgm: ignoring heap-size-setting option ($_)...not the largest seen\n";
2964         }
2965         next arg; };
2966
2967     /^-(K|Rmax-(stk|stack)size)(.*)/ && do {
2968         local($flag) = $1;
2969         local($stk_size) = &grab_arg_arg(*Args,'-Rmax-stksize', $3);
2970         if ($stk_size =~ /(\d+)[Kk]$/) {
2971             $stk_size = $1 * 1000;
2972         } elsif ($stk_size =~ /(\d+)[Mm]$/) {
2973             $stk_size = $1 * 1000 * 1000;
2974         } elsif ($stk_size =~ /(\d+)[Gg]$/) {
2975             $stk_size = $1 * 1000 * 1000 * 1000;
2976         }
2977         if ($stk_size <= 0) {
2978             print STDERR "$Pgm: resetting stack-size to zero!!! $stk_size\n";
2979             $Specific_stk_size = 0;
2980
2981         # if several stack sizes given, take the largest...
2982         } elsif ($stk_size >= $Specific_stk_size) {
2983             $Specific_stk_size = $stk_size;
2984         } else {
2985             print STDERR "$Pgm: ignoring stack-size-setting option ($flag $stk_size)...not the largest seen\n";
2986         }
2987         next arg; };
2988
2989     /^-Rgc-stats$/ && do {  $CollectingGCstats++;
2990                             # the two RTSs do this diff ways; we will try to compensate
2991                             next arg; };
2992
2993     /^-Rghc-timing/ && do { $CollectGhcTimings = 1; next arg; };
2994
2995     #---------- C high-level assembler (gcc) -------------------------------
2996     /^-(Wall|ansi|pedantic)$/ && do { push(@CcBoth_flags, $_); next arg; };
2997
2998     # -dgcc-lint is a useful way of making GCC very fussy.
2999     # From alan@spri.levels.unisa.edu.au (Alan Modra).
3000     /^-dgcc-lint$/ && do { push(@CcBoth_flags, '-Wall -Wpointer-arith -Wbad-function-cast -Wcast-qual -Wstrict-prototypes -Wmissing-prototypes -Wmissing-declarations -Wnested-externs'); next arg; };
3001     # An alternate set, from mark@sgcs.com (Mark W. Snitily)
3002     # -Wall -Wstrict-prototypes -Wmissing-prototypes -Wcast-align -Wshadow
3003
3004     # inject "#include <wurble>" into the compiler's C output!
3005
3006     /^-#include(.*)/    && do {
3007         local($to_include) = &grab_arg_arg(*Args,'-#include', $1);
3008         push(@CcInjects, "#include $to_include\n");
3009         next arg; };
3010
3011     #---------- Linker (gcc, really) ---------------------------------------
3012
3013     /^-static$/         && do { push(@Ld_flags, $_); next arg; };
3014
3015     #---------- mixed cc and linker magic ----------------------------------
3016     # this optimisation stuff is finally sorted out later on...
3017
3018     /^-O2-for-C$/ && do { $MinusO2ForC = 1; next arg; };
3019
3020     /^-O[1-2]?$/ && do {
3021                 local($opt_lev) = ( /^-O2$/ ) ? 2 : 1; # max 'em
3022                 $OptLevel = ( $opt_lev > $OptLevel ) ? $opt_lev : $OptLevel;
3023
3024                 $HscOut = '-C=' if $OptLevel == 2; # force use of C compiler
3025                 next arg; };
3026
3027     /^-Onot$/   && do { $OptLevel = 0; next arg; }; # # set it to <no opt>
3028
3029     /^-Ofile(.*)/ && do {
3030                 $OptLevel = 3;
3031                 local($ofile) = &grab_arg_arg(*Args,'-Ofile', $1);
3032                 @HsC_minusO3_flags = ();
3033
3034                 open(OFILE, "< $ofile") || die "Can't open $ofile!\n";
3035                 while (<OFILE>) {
3036                     chop;
3037                     s/\#.*//;       # death to comments
3038                     s/[ \t]+//g;    # death to whitespace
3039                     next if /^$/;   # ditto, blank lines
3040                     s/([()*{}])/\\$1/g;    # protect shell metacharacters
3041                     if ( /^C:(.*)/ ) {
3042                         push(@CcBoth_flags, $1);
3043                     } else {
3044                         push(@HsC_minusO3_flags, $_);
3045                     }
3046                 }
3047                 close(OFILE);
3048                 next arg; };
3049
3050     /^-debug$/  && do { # all this does is mark a .hc/.o as "debugging"
3051                         # in the consistency info
3052                         $DEBUGging = 'd';
3053                         next arg; };
3054
3055     #---------- linking .a file --------------------------------------------
3056
3057     /^-Main(.*)/ && do {
3058                 # specifies main or mainPrimIO to be linked
3059                 $Ld_main = $1;
3060                 next arg; };
3061
3062     #---------- catch unrecognized flags -----------------------------------
3063
3064     /^-./ && do {
3065         print STDERR "$Pgm: unrecognised option: $_\n";
3066         $Status++;
3067         next arg; };
3068
3069 }
3070
3071 } # end of processArgs
3072
3073 \end{code}