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