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 PERL 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 #!${PERL}
1448 # =!=!=!=!=!=!=!=!=!=!=!
1449 # This script is automatically generated: DO NOT EDIT!!!
1450 # Generated by Glasgow Haskell, version ${PROJECTVERSION} ${PROJECTPATCHLEVEL}
1451 #
1452 \$pvm_executable      = '$pvm_executable';
1453 \$pvm_executable_base = '$pvm_executable_base';
1454 \$SysMan = '$SysMan';
1455 EOSCRIPT1
1456
1457         print EXEC <<\EOSCRIPT2;
1458 # first, some magical shortcuts to run "commands" on the binary
1459 # (which is hidden)
1460 if ($#ARGV == 1 && $ARGV[0] eq '+RTS' && $ARGV[1] =~ /^--((size|file|strip|rm|nm).*)/ ) {
1461     local($cmd) = $1;
1462     system("$cmd $pvm_executable");
1463     exit(0); # all done
1464 }
1465
1466 # OK, really run it; process the args first
1467 $ENV{'PE'} = $pvm_executable_base;
1468 $debug = '';
1469 $nprocessors = 2; # the default
1470 @nonPVM_args = ();
1471 $in_RTS_args = 0;
1472
1473 # ToDo: handle --RTS
1474 args: while ($a = shift(@ARGV)) {
1475     if ( $a eq '+RTS' ) {
1476         $in_RTS_args = 1;
1477     } elsif ( $a eq '-RTS' ) {
1478         $in_RTS_args = 0;
1479     }
1480     if ( $a eq '-d' && $in_RTS_args ) {
1481         $debug = '-';
1482     } elsif ( $a =~ /^-N(\d+)/ && $in_RTS_args ) {
1483         $nprocessors = $1;
1484     } else {
1485         push(@nonPVM_args, $a);
1486     }
1487 }
1488
1489 local($return_val) = 0;
1490 system("$SysMan $debug $pvm_executable $nprocessors @nonPVM_args");
1491 $return_val = $?;
1492 system("mv $ENV{'HOME'}/$pvm_executable_base.???.gr .") if -f "$ENV{'HOME'}/$pvm_executable_base.001.gr";
1493 exit($return_val);
1494 EOSCRIPT2
1495         close(EXEC) || die "Failed closing $executable\n";
1496         chmod 0755, $executable;
1497     }
1498 }
1499
1500 # that...  that's all, folks!
1501 &tidy_up();
1502 exit $Status; # will still be 0 if all went well
1503 \end{code}
1504
1505 %************************************************************************
1506 %*                                                                      *
1507 \section[Driver-do-one-file]{How to process a single input file}
1508 %*                                                                      *
1509 %************************************************************************
1510
1511 \begin{code}
1512 sub ProcessInputFile {
1513     local($ifile) = @_;   # input file name
1514     local($ifile_root);   # root of or basename of input file
1515     local($ofile_target); # ultimate output file we hope to produce
1516                           # from input file (need to know for recomp
1517                           # checking purposes)
1518     local($hifile_target);# ditto (but .hi file)
1519 \end{code}
1520
1521 Handle the weirdity of input from stdin.
1522 \begin{code}
1523     if ($ifile ne '-') {
1524         ($ifile_root  = $ifile) =~ s/\.[^\.\/]+$//;
1525         $ofile_target = # may be reset later...
1526                         ($Specific_output_file ne '' && ! $Do_lnkr)
1527                         ? $Specific_output_file
1528                         : &odir_ify($ifile_root, 'o');
1529         $hifile_target= ($Specific_hi_file ne '')
1530                         ? $Specific_hi_file
1531                         : "$ifile_root.$HiSuffix"; # ToDo: odirify?
1532                         # NB: may change if $ifile_root isn't module name (??)
1533     } else {
1534         $ifile = "$Tmp_prefix.hs"; # we know that's where we put the input
1535         $ifile_root   = '_stdin';
1536         $ofile_target = '_stdout'; # gratuitous?
1537         $hifile_target= '_stdout'; # ditto?
1538     }
1539 \end{code}
1540
1541 We need to decide what phases of the compilation system we will run
1542 over this file.  The defaults are the ones established when processing
1543 flags.  (That established what the last phase run for all files is.)
1544
1545 We do the pre-recompilation-checker phases here; the rest later.
1546 \begin{code}
1547 \end{code}
1548
1549 Look at the suffix and decide what initial phases of compilation may
1550 be dropped off for this file.  Also the rather boring business of
1551 which files are coming-in/going-out.
1552
1553 Again, we'll do the post-recompilation-checker parts of this later.
1554 \begin{code}
1555     local($do_lit2pgm)  = ($ifile =~ /\.lhs$/) ? 1 : 0;
1556     local($do_hscpp)    = 1; # but "hscpp" might really be "cat"
1557     local($do_hsc)      = 1;
1558
1559     # names of the files to stuff between phases
1560     # defaults are temporaries
1561     local($in_lit2pgm)    = $ifile;
1562     local($lit2pgm_hscpp) = "$Tmp_prefix.lpp";
1563     local($hscpp_hsc)     = "$Tmp_prefix.cpp";
1564     local($hsc_hi)        = "$Tmp_prefix.hi";
1565     local($cc_as_o)       = "${Tmp_prefix}_o.s"; # temporary for raw .s file if opt C
1566     local($cc_as)         = "$Tmp_prefix.s";     # mangled or hsc-produced .s code
1567     local($as_out)        = $ofile_target;
1568
1569     local($is_hc_file) = 1; #Is the C code .hc or .c? Assume .hc for now
1570
1571     $lit2pgm_hscpp = $ifile if ($ifile =~ /\.hs$/);
1572
1573     # OK, let's strip off some literate junk:
1574     &runLit2pgm($in_lit2pgm, $lit2pgm_hscpp) if ($ifile =~ /\.lhs$/);
1575     #
1576     @File_options = ();
1577
1578     # Scan the top of the de-litted file for {-# OPTIONS #-} pragmas
1579     &check_for_source_options($lit2pgm_hscpp);
1580     # options found in the source file take a back seat, i.e., we scan
1581     # them first. Only process the command line again if source file
1582     # contained anything of interest *or* there's more than one
1583     # input file (we have to reset the options).
1584     #
1585     if ( $#Input_file >= 0 || $#File_options >= 0) {
1586         @File_options = (@File_options, @Cmd_opts);
1587
1588         # Now process the command line
1589         &initDriverGlobals();
1590         &processArgs(@File_options);
1591     }
1592     #
1593     # Having got the effective command line scanned, set up
1594     # the various options in prep for some real work.
1595     #
1596     # check the sanity of the BuildTag we're about to use,
1597     # and if needs be, add some more flags and setup to
1598     # the different phases.
1599     #
1600     &setupBuildFlags();
1601     &setupOptimiseFlags();
1602     &setupMachOpts();
1603     &setupIncPaths();
1604     &setupHeapStackSize();
1605
1606     #
1607     # These two variables need to be set after the
1608     # command-line has been processed and the build options
1609     # have be seen set up. This is because command-line options
1610     # can control whether to compile vias C or not.
1611     #
1612     local($do_cc)       = ( $Do_cc != -1) # i.e., it was set explicitly
1613                           ? $Do_cc
1614                           : ( ($HscOut eq '-C=') ? 1 : 0 );
1615     local($do_as)       = $Do_as;
1616     local($hsc_out)       = ( $HscOut eq '-C=' ) ? "$Tmp_prefix.hc" : "$Tmp_prefix.s" ;
1617
1618     if ($ifile =~ /.lhs$/ || $ifile =~ /.hs$/ ) {
1619        ;
1620     } elsif ($ifile =~ /\.hc$/ || $ifile =~ /_hc$/ ) { # || $ifile =~ /\.$Isuffix$/o) # ToDo: better
1621         $do_hscpp = 0; $do_hsc = 0; $do_cc = 1;
1622         $hsc_out = $ifile;
1623     } elsif ($ifile =~ /\.c$/) {
1624         $do_hscpp = 0; $do_hsc = 0; $do_cc = 1;
1625         $hsc_out = $ifile; $is_hc_file = 0;
1626     } elsif ($ifile =~ /\.s$/) {
1627         $do_hscpp = 0; $do_hsc = 0; $do_cc = 0;
1628         $cc_as = $ifile;
1629     } else { # don't know what it is, but nothing to do herein...
1630         $do_hscpp = 0; $do_hsc = 0; $do_cc = 0; $do_as = 0;
1631     }
1632
1633     # hack to avoid running hscpp
1634     $HsCpp = $Cat if ! $Cpp_flag_set;
1635
1636     &runHscpp($in_lit2pgm, $lit2pgm_hscpp, $hscpp_hsc)
1637         if $do_hscpp;
1638 \end{code}
1639
1640 We now think about whether to run hsc/cc or not (when hsc produces .s
1641 stuff, it effectively takes the place of both phases).
1642
1643 To get the output file name right: for each phase that we are {\em
1644 not} going to run, set its input (i.e., the output of its preceding
1645 phase) to @"$ifile_root.<suffix>"@.
1646 \begin{code}
1647     local($going_interactive) = $HscOut eq '-N=' || $ifile_root eq '_stdin';
1648
1649     #
1650     # Warning issued if -keep-hc-file-too is used without
1651     # -fvia-C (or the equivalent)
1652     #
1653     if ( $HscOut ne '-C=' && $Keep_hc_file_too ) {
1654         print STDERR "Warning: Native code generator to be used, -keep-hc-file-too will be ignored\n";
1655     }
1656
1657     if (! $do_cc && ! $do_as) { # stopping after hsc
1658         $hsc_out = ($Specific_output_file ne '')
1659                  ? $Specific_output_file
1660                  : &odir_ify($ifile_root, ($HscOut eq '-C=') ? 'hc' : 's');
1661
1662         $ofile_target = $hsc_out; # reset
1663     }
1664
1665     if (! $do_as) { # stopping after gcc (or hsc)
1666         $cc_as = ($Specific_output_file ne '')
1667                  ? $Specific_output_file
1668                  : &odir_ify($ifile_root, ( $Only_preprocess_C ) ? 'i' : 's');
1669
1670         $ofile_target = $cc_as; # reset
1671     }
1672
1673 \end{code}
1674
1675
1676 Now the Haskell compiler, C compiler, and assembler
1677
1678 \begin{code}
1679    if ($do_hsc) {
1680         &runHscAndProcessInterfaces( $ifile, $hscpp_hsc, $ifile_root,
1681                                      $ofile_target, $hifile_target);
1682     }
1683
1684     if ($do_cc) {
1685         &runGcc    ($is_hc_file, $hsc_out, $cc_as_o);
1686         &runMangler($is_hc_file, $cc_as_o, $cc_as, $ifile_root);
1687     }
1688
1689     &split_asm_file($cc_as)  if $do_as && $SplitObjFiles;
1690
1691     &runAs($as_out, $ifile_root) if $do_as;
1692 \end{code}
1693
1694 Finally, decide what to queue up for linker input.
1695 \begin{code}
1696     # tentatively assume we will eventually produce linker input:
1697     push(@Link_file, &odir_ify($ifile_root, 'o'));
1698
1699 #ToDo:    local($or_isuf) = ($Isuffix eq '') ? '' : "|$Isuffix";
1700
1701     if ( $ifile !~ /\.(lhs|hs|hc|c|s)$/ && $ifile !~ /_hc$/ ) {
1702         print STDERR "$Pgm: don't recognise suffix on `$ifile'; passing it through to linker\n"
1703             if $ifile !~ /\.a$/;
1704
1705         # oops; we tentatively pushed the wrong thing; fix & do the right thing
1706         pop(@Link_file); push(@Link_file, $ifile);
1707     }
1708
1709
1710 } # end of ProcessInputFile
1711 \end{code}
1712
1713 %************************************************************************
1714 %*                                                                      *
1715 \section[Driver-run-phases]{Routines to run the various phases}
1716 %*                                                                      *
1717 %************************************************************************
1718
1719 \begin{code}
1720 sub runLit2pgm {
1721     local($in_lit2pgm, $lit2pgm_hscpp) = @_;
1722
1723     local($to_do) = "echo '#line 1 \"$in_lit2pgm\"' > $lit2pgm_hscpp && ".
1724                     "$Unlit @Unlit_flags $in_lit2pgm -  >> $lit2pgm_hscpp";
1725     @Files_to_tidy = ( $lit2pgm_hscpp );
1726
1727     &run_something($to_do, 'literate pre-processor');
1728 }
1729 \end{code}
1730
1731 \begin{code}
1732 sub runHscpp {
1733     local($in_lit2pgm, $lit2pgm_hscpp, $hscpp_hsc) = @_;
1734
1735     local($to_do);
1736
1737     if ($HsCpp eq $Cat) {
1738         $to_do = "echo '#line 1 \"$in_lit2pgm\"' > $hscpp_hsc && ".
1739                         "$HsCpp $lit2pgm_hscpp >> $hscpp_hsc";
1740         @Files_to_tidy = ( $hscpp_hsc );
1741         &run_something($to_do, 'Ineffective C pre-processor');
1742     } else {
1743         local($includes) = '-I' . join(' -I',@Include_dir);
1744         $to_do = "echo '#line 1 \"$in_lit2pgm\"' > $hscpp_hsc && ".
1745                         "$HsCpp $Verbose $genSPECS_flag @HsCpp_flags -D__HASKELL1__=$Haskell1Version -D__GLASGOW_HASKELL__=$GhcVersionInfo $includes $lit2pgm_hscpp >> $hscpp_hsc";
1746         @Files_to_tidy = ( $hscpp_hsc );
1747         &run_something($to_do, 'Haskellised C pre-processor');
1748     }
1749 }
1750 \end{code}
1751
1752
1753 \begin{code}
1754 sub runHscAndProcessInterfaces {
1755     local($ifile, $hscpp_hsc, $ifile_root, $ofile_target, $hifile_target) = @_;
1756
1757         # $ifile                is the original input file
1758         # $hscpp_hsc            post-unlit, post-cpp, etc., input file
1759         # $ifile_root           input filename minus suffix
1760         # $ofile_target         the output file that we ultimately hope to produce
1761         # $hifile_target        the .hi file ... (ditto)
1762
1763     local($source_unchanged) = 1;
1764
1765 # Check if the source file is up to date relative to the target; in
1766 # that case we say "source is unchanged" and let the compiler bail out
1767 # early if the import usage information allows it.
1768
1769     ($i_dev,$i_ino,$i_mode,$i_nlink,$i_uid,$i_gid,$i_rdev,$i_size,
1770      $i_atime,$i_mtime,$i_ctime,$i_blksize,$i_blocks) = stat($ifile);
1771
1772     if ( ! -f $ofile_target ) {
1773 #       print STDERR "$Pgm:compile:Output file $ofile_target doesn't exist\n";
1774         $source_unchanged = 0;
1775     }
1776
1777     ($o_dev,$o_ino,$o_mode,$o_nlink,$o_uid,$o_gid,$o_rdev,$o_size,
1778      $o_atime,$o_mtime,$o_ctime,$o_blksize,$o_blocks) = stat(_); # stat info from -f test
1779
1780     if ( ! -f $hifile_target ) {
1781 #       print STDERR "$Pgm:compile:Interface file $hifile_target doesn't exist\n";
1782         $source_unchanged = 0;
1783     }
1784
1785     ($hi_dev,$hi_ino,$hi_mode,$hi_nlink,$hi_uid,$hi_gid,$hi_rdev,$hi_size,
1786      $hi_atime,$hi_mtime,$hi_ctime,$hi_blksize,$hi_blocks) = stat(_); # stat info from -f test
1787
1788     if ($i_mtime > $o_mtime) {
1789 #       print STDERR "$Pgm:recompile:Input file $ifile newer than $ofile_target\n";
1790         $source_unchanged = 0;
1791     }
1792
1793     # So if source_unchanged is still "1", we pass on the good news to the compiler
1794     # The -recomp flag can disable this, forcing recompilation
1795     if ($Do_recomp_chkr && $source_unchanged) {
1796         push(@HsC_flags, '-fsource-unchanged');
1797     }
1798
1799 # Run the compiler
1800
1801     &runHsc($ifile_root, $hsc_out, $hsc_hi, $going_interactive);
1802
1803 # See if it bailed out early, saying nothing needed doing.
1804 # We work this out by seeing if it created an output .hi file
1805
1806     if ( ! -f $hsc_hi ) {
1807         # Doesn't exist, so we bailed out early.
1808         # Tell the C compiler and assembler not to run
1809         $do_cc = 0; $do_as = 0;
1810
1811         # Update dependency info, touch both object file and
1812         # interface file, so that the following invariant is
1813         # maintained:
1814         #
1815         #   a dependent module's interface file should after recompilation
1816         #   checking be newer than the interface files of its imports.
1817         #
1818         # That is, if module A's interface file changes, then module B
1819         # (which import from A) needs to be checked.
1820         # If A's change does not affect B, which causes the compiler to bail
1821         # out early, we still need to touch the interface file of B. The reason
1822         # for this is that B may export A's interface.
1823         #
1824         &run_something("touch $ofile_target $hifile_target",
1825                        "Touch $ofile_target $hifile_target,  to propagate dependencies");
1826
1827     } else {
1828
1829      # Didn't bail out early (new .hi file) so we thunder on
1830
1831         # If non-interactive, heave in the consistency info at the end
1832         # NB: pretty hackish (depends on how $output is set)
1833         if ( ! $going_interactive ) {
1834             if ( $HscOut eq '-C=' ) {
1835             $to_do = "echo 'static char ghc_hsc_ID[] = \"\@(#)hsc $ifile\t$HsC_major_version.$HsC_minor_version,$HsC_consist_options\";' >> $hsc_out";
1836
1837             } elsif ( $HscOut eq '-S=' ) {
1838                 local($consist) = "hsc.$ifile.$HsC_major_version.$HsC_minor_version.$HsC_consist_options";
1839                 $consist =~ s/,/./g;
1840                 $consist =~ s/\//./g;
1841                 $consist =~ s/-/_/g;
1842                 $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly?
1843                 $to_do = "echo '\n\t.text\n$consist:' >> $hsc_out";
1844             }
1845             &run_something($to_do, 'Pin on Haskell consistency info');
1846         }
1847
1848
1849         # Interface-handling is important enough to live off by itself
1850         require('ghc-iface.prl')
1851             || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-iface.prl!\n");
1852
1853         &postprocessHiFile($hsc_hi, $hifile_target, $going_interactive);
1854
1855         # save a copy of the .hc file, even if we are carrying on...
1856         if ($HscOut eq '-C=' && $do_cc && $Keep_hc_file_too) {
1857             local($to_do) = "$Rm $ifile_root.hc; $Cp $hsc_out $ifile_root.hc";
1858             &run_something($to_do, 'Saving copy of .hc file');
1859         }
1860
1861         # save a copy of the .s file, even if we are carrying on...
1862         if ($HscOut eq '-S=' && $do_as && $Keep_s_file_too) {
1863             local($to_do) = "$Rm $ifile_root.s; $Cp $hsc_out $ifile_root.s";
1864             &run_something($to_do, 'Saving copy of .s file');
1865         }
1866
1867         # if we're going to split up object files,
1868         # we inject split markers into the .hc file now
1869         if ( $HscOut eq '-C=' && $SplitObjFiles ) {
1870             &inject_split_markers ( $hsc_out );
1871         }
1872     }
1873 }
1874 \end{code}
1875
1876
1877 \begin{code}
1878 sub runHsc {
1879     local($ifile_root, $hsc_out, $hsc_hi, $going_interactive) = @_;
1880
1881     # prepend comma to HsP flags (so hsc can tell them apart...)
1882     foreach $a ( @HsP_flags ) { $a = ",$a" unless $a =~ /^,/; }
1883
1884     &makeHiMap() unless $HiMapDone;
1885 #    print STDERR "HiIncludes: $HiIncludeString\n";
1886     push(@HsC_flags, "-himap=$HiIncludeString");
1887 #    push(@HsC_flags, "-himap=$HiMapFile");
1888
1889     # here, we may produce .hc/.s and/or .hi files
1890     local($output) = '';
1891     @Files_to_tidy = ();
1892
1893     if ( $going_interactive ) {
1894         # don't need .hi unless going to show it on stdout:
1895         $ProduceHi = '-nohifile=' if ! $HiOnStdout;
1896         $do_cc = 0; $do_as = 0; $Do_lnkr = 0; # and we won't go any further...
1897     }
1898
1899     # set up for producing output/.hi; note that flag twiddling
1900     # may mean that nothing will actually be produced:
1901     $output = "$ProduceHi$hsc_hi $HscOut$hsc_out";
1902     @Files_to_tidy = ( $hsc_hi, $hsc_out );
1903
1904     # if we're compiling foo.hs, we want the GC stats to end up in foo.stat
1905     if ( $CollectingGCstats ) {
1906         push(@HsC_rts_flags, "-S$ifile_root.stat");
1907         push(@Files_to_tidy, "$ifile_root.stat");
1908     }
1909
1910     if ( $CollectGhcTimings ) { # assume $RTS_style eq 'ghc'
1911         # emit nofibbish time/bytes-alloc stats to stderr;
1912         # see later .stat file post-processing
1913         push(@HsC_rts_flags, "-s$Tmp_prefix.stat");
1914         push(@Files_to_tidy, "$Tmp_prefix.stat");
1915     }
1916
1917     local($dump) = '';
1918     if ($Specific_dump_file ne '') {
1919         $dump = "2>> $Specific_dump_file";
1920         $Using_dump_file = 1;
1921     }
1922
1923     local($to_do);
1924     $to_do = "$HsC @HsP_flags ,$hscpp_hsc $dump @HsC_flags $CoreLint $StgLint $Verbose $output +RTS @HsC_rts_flags";
1925     &run_something($to_do, 'Haskell compiler');
1926
1927     # finish business w/ nofibbish time/bytes-alloc stats
1928     &process_ghc_timings() if $CollectGhcTimings;
1929 }
1930 \end{code}
1931
1932 Use \tr{@Import_dir} and \tr{@SysImport_dir} to make a tmp file
1933 of (module-name, pathname) pairs, one per line, separated by a space.
1934 \begin{code}
1935 #%HiMap     = ();
1936 $HiMapDone = 0;
1937 $HiMapFile = '';
1938 $HiIncludeString = ();          # dir1:dir2:dir3, to pass to GHC
1939
1940 sub makeHiMap {
1941
1942     # collect in %HiMap; write later; also used elsewhere in driver
1943
1944     local($mod, $path, $d, $e);
1945
1946     # reset the global variables:
1947     #%HiMap     = ();
1948     $HiMapDone = 0;
1949     $HiMapFile = '';
1950     $HiIncludeString = ();              # dir1:dir2:dir3, to pass to GHC
1951
1952     foreach $d ( @Import_dir ) {
1953         if ($HiIncludeString) { $HiIncludeString = "$HiIncludeString:$d";
1954         } else { $HiIncludeString = $d; }
1955
1956 # The compiler does the searching now
1957 #
1958 #       opendir(DIR, $d) || &tidy_up_and_die(1,"$Pgm: error when reading directory: $d\n");
1959 #       local(@entry) = readdir(DIR);
1960 #       foreach $e ( @entry ) {
1961 #           next unless $e =~ /\b([A-Z][A-Za-z0-9_]*)\.${HiSuffix_prelude}$/o;
1962 #           $mod  = $1;
1963 #           $path = "$d/$e";
1964 #           $path =~ s,^\./,,;
1965 #
1966 #           if ( ! defined($HiMap{$mod}) ) {
1967 #               $HiMap{$mod} = $path;
1968 #           } else {
1969 #               &already_mapped_err($mod, $HiMap{$mod}, $path);
1970 #           }
1971 #       }
1972 #       closedir(DIR); # || &tidy_up_and_die(1,"$Pgm: error when closing directory: $d\n");
1973     }
1974
1975     foreach $d ( @SysImport_dir ) {
1976         if ($HiIncludeString) { $HiIncludeString = "$HiIncludeString:$d";
1977         } else { $HiIncludeString = $d; }
1978
1979 #       opendir(DIR, $d) || &tidy_up_and_die(1,"$Pgm: error when reading directory: $d\n");
1980 #       local(@entry) = readdir(DIR);
1981 #       foreach $e ( @entry ) {
1982 #           next unless $e =~ /([A-Z][A-Za-z0-9_]*)\.$HiSuffix$/o;
1983 #           next if $NoImplicitPrelude && $e =~ /Prelude\.$HiSuffix$/o;
1984 #
1985 #           $mod  = $1;
1986 #           $path = "$d/$e";
1987 #           $path =~ s,^\./,,;
1988 #
1989 #           if ( ! defined($HiMap{$mod}) ) {
1990 #               $HiMap{$mod} = $path;
1991 #           } elsif ( $mod ne 'Main' )  { # saves useless warnings...
1992 #               &already_mapped_err($mod, $HiMap{$mod}, $path);
1993 #           }
1994 #       }
1995 #       closedir(DIR); # || &tidy_up_and_die(1,"$Pgm: error when closing directory: $d\n");
1996     }
1997
1998 #
1999 # Not currently used:
2000 #
2001 #    $HiMapFile = "$Tmp_prefix.himap";
2002 #    unlink($HiMapFile);
2003 #    open(HIMAP, "> $HiMapFile") || &tidy_up_and_die(1,"$Pgm: can't open $HiMapFile\n");
2004 #    foreach $d (keys %HiMap) {
2005 #       print HIMAP $d, ' ', $HiMap{$d}, "\n";
2006 #    }
2007 #    close(HIMAP) || &tidy_up_and_die(1,"$Pgm: error when closing $HiMapFile\n");
2008
2009     $HiMapDone = 1;
2010 }
2011
2012 sub already_mapped_err {
2013     local($mod, $mapped_to, $path) = @_;
2014
2015     # OK, it isn't really an error if $mapped_to and $path turn
2016     # out to be the same thing.
2017     ($m_dev,$m_ino,$m_mode,$m_nlink,$m_uid,$m_gid,$m_rdev,$m_size,
2018      $m_atime,$m_mtime,$m_ctime,$m_blksize,$m_blocks) = stat($mapped_to);
2019     ($p_dev,$p_ino,$p_mode,$p_nlink,$p_uid,$p_gid,$p_rdev,$p_size,
2020      $p_atime,$p_mtime,$p_ctime,$p_blksize,$p_blocks) = stat($path);
2021
2022     return if $m_ino == $p_ino; # same inode number
2023
2024     print STDERR "$Pgm: module $mod already mapped to $mapped_to";
2025     print STDERR ";\n\tignoring: $path\n";
2026 }
2027 \end{code}
2028
2029 %************************************************************************
2030 %*                                                                      *
2031 \section[Driver-misc-utils]{Miscellaneous utilities}
2032 %*                                                                      *
2033 %************************************************************************
2034
2035 %************************************************************************
2036 %*                                                                      *
2037 \subsection[Driver-odir-ify]{@odir_ify@: Mangle filename if \tr{-odir} set}
2038 %*                                                                      *
2039 %************************************************************************
2040
2041 \begin{code}
2042 sub osuf_ify {
2043     local($ofile,$def_suffix) = @_;
2044
2045     return(($Osuffix eq '') ? "$ofile.$def_suffix" : "$ofile.$Osuffix" );
2046 }
2047
2048 sub odir_ify {
2049     local($orig_file, $def_suffix) = @_;
2050     if ($Specific_output_dir eq '') {   # do nothing
2051         &osuf_ify($orig_file, $def_suffix);
2052     } else {
2053         local ($orig_file_only);
2054         ($orig_file_only = $orig_file) =~ s|.*/||;
2055         &osuf_ify("$Specific_output_dir/$orig_file_only",$def_suffix);
2056     }
2057 }
2058 \end{code}
2059
2060 \begin{code}
2061 sub runGcc {
2062     local($is_hc_file, $hsc_out, $cc_as_o) = @_;
2063
2064     local($includes) = '-I' . join(' -I', @Include_dir);
2065     local($cc);
2066     local($s_output);
2067     local($c_flags) = "@CcBoth_flags";
2068     local($ddebug_flag) = ( $DEBUGging ) ? '-DDEBUG' : '';
2069
2070     # "input" files to use that are not in some weird directory;
2071     # to help C compilers grok .hc files [ToDo: de-hackify]
2072     local($cc_help)   = "ghc$$.c";
2073     local($cc_help_s) = "ghc$$.s";
2074
2075     $cc       = $CcRegd;
2076     $s_output = ($is_hc_file || $TargetPlatform =~ /^(hppa|i386)/) ? $cc_as_o : $cc_as;
2077     $c_flags .= " @CcRegd_flags";
2078     $c_flags .= ($is_hc_file) ? " @CcRegd_flags_hc"  : " @CcRegd_flags_c";
2079
2080     # C compiler won't like the .hc extension.  So we create
2081     # a tmp .c file which #include's the needful.
2082     open(TMP, "> $cc_help") || &tidy_up_and_die(1,"$Pgm: failed to open `$cc_help' (to write)\n");
2083     if ( $is_hc_file ) {
2084         print TMP <<EOINCL;
2085 #ifdef __STG_GCC_REGS__
2086 # if ! (defined(MAIN_REG_MAP) || defined(MARK_REG_MAP) || defined(SCAN_REG_MAP) || defined(SCAV_REG_MAP) || defined(FLUSH_REG_MAP))
2087 #  define MAIN_REG_MAP
2088 # endif
2089 #endif
2090 #include "stgdefs.h"
2091 EOINCL
2092         # user may have asked for #includes to be injected...
2093         print TMP @CcInjects if $#CcInjects >= 0;
2094     }
2095     # heave in the consistency info
2096     print TMP "static char ghc_cc_ID[] = \"\@(#)cc $ifile\t$Cc_major_version.$Cc_minor_version,$Cc_consist_options\";\n";
2097
2098     # and #include the real source
2099     print TMP "#include \"$hsc_out\"\n";
2100     close(TMP) || &tidy_up_and_die(1,"Failed writing to $cc_help\n");
2101
2102     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 )";
2103     # note: __GLASGOW_HASKELL__ is pointedly *not* #defined at the C level.
2104     if ( $Only_preprocess_C ) { # HACK ALERT!
2105         $to_do =~ s/ -S\b//g;
2106     }
2107     @Files_to_tidy = ( $cc_help, $cc_help_s, $s_output );
2108     $PostprocessCcOutput = 1;   # hack, dear hack...
2109     &run_something($to_do, 'C compiler');
2110     $PostprocessCcOutput = 0;
2111     unlink($cc_help, $cc_help_s);
2112 }
2113 \end{code}
2114
2115 \begin{code}
2116 sub runMangler {
2117     local($is_hc_file, $cc_as_o, $cc_as, $ifile_root) = @_;
2118
2119     if ( $is_hc_file ) {
2120         # dynamically load assembler-fiddling code, which we are about to use:
2121         require('ghc-asm.prl')
2122         || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm.prl!\n");
2123     }
2124
2125     print STDERR `cat $cc_as_o` if $Dump_raw_asm; # to stderr, before mangling
2126
2127     if ($is_hc_file) {
2128         # post-process the assembler [.hc files only]
2129         &mangle_asm($cc_as_o, $cc_as);
2130
2131
2132 #OLD: for sanity:
2133 #OLD:   local($target) = 'oops';
2134 #OLD:   $target = '-alpha'      if $TargetPlatform =~ /^alpha-/;
2135 #OLD:   $target = '-hppa'       if $TargetPlatform =~ /^hppa/;
2136 #OLD:   $target = '-old-asm'    if $TargetPlatform =~ /^i386-/;
2137 #OLD:   $target = '-m68k'       if $TargetPlatform =~ /^m68k-/;
2138 #OLD:   $target = '-mips'       if $TargetPlatform =~ /^mips-/;
2139 #OLD:   $target = ''            if $TargetPlatform =~ /^powerpc-/;
2140 #OLD:   $target = '-solaris'    if $TargetPlatform =~ /^sparc-sun-solaris2/;
2141 #OLD:   $target = '-sparc'      if $TargetPlatform =~ /^sparc-sun-sunos4/;
2142 #OLD:
2143 #OLD:   if ( $target ne '' ) {
2144 #OLD:       require("ghc-asm$target.prl")
2145 #OLD:       || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm$target.prl!\n");
2146 #OLD:       &mangle_asm($cc_as_o, "$cc_as-2"); # the OLD one!
2147 #OLD:       &run_something("$Cmp -s $cc_as-2 $cc_as || $Diff $cc_as-2 $cc_as 1>&2 || exit 0",
2148 #OLD:           "Diff'ing old and new mangled .s files"); # NB: to stderr
2149 #OLD:   }
2150
2151     } elsif ($TargetPlatform =~ /^hppa/) {
2152         # minor mangling of non-threaded files for hp-pa only
2153         require('ghc-asm.prl')
2154         || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm-hppa.prl!\n");
2155         &mini_mangle_asm_hppa($cc_as_o, $cc_as);
2156
2157     } elsif ($TargetPlatform =~ /^i386/) {
2158         # extremely-minor OFFENSIVE mangling of non-threaded just one file
2159         require('ghc-asm.prl')
2160         || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm.prl!\n");
2161         &mini_mangle_asm_i386($cc_as_o, $cc_as);
2162     }
2163
2164     # save a copy of the .s file, even if we are carrying on...
2165     if ($do_as && $Keep_s_file_too) {
2166         local($to_do) = "$Rm $ifile_root.s; $Cp $cc_as $ifile_root.s";
2167         &run_something($to_do, 'Saving copy of .s file');
2168     }
2169 }
2170 \end{code}
2171
2172 \begin{code}
2173 sub runAs {
2174     local($as_out, $ifile_root) = @_;
2175
2176     local($asmblr) = ( $As ) ? $As : $CcRegd;
2177
2178     if ( ! $SplitObjFiles ) {
2179         local($to_do)  = "$asmblr -o $as_out -c @As_flags $cc_as";
2180         @Files_to_tidy = ( $as_out );
2181         &run_something($to_do, 'Unix assembler');
2182
2183     } else { # more complicated split-ification...
2184
2185         # must assemble files $Tmp_prefix__[1 .. $NoOfSplitFiles].s
2186
2187         # If -odir is used, great, just pin it in front of the
2188         # generated split file names. If it hasn't been set, we
2189         # snatch it from the ifile_root.
2190         #
2191         #
2192
2193         if ( $Specific_output_dir eq '' ) {
2194             $Specific_output_dir = ${ifile_root};
2195         }
2196
2197         for ($f = 1; $f <= $NoOfSplitFiles; $f++ ) {
2198             local($split_out) = &odir_ify("${ifile_root}__${f}",'o');
2199             local($to_do) = "$asmblr -o $split_out -c @As_flags ${Tmp_prefix}__${f}.s";
2200             @Files_to_tidy = ( $split_out );
2201
2202             &run_something($to_do, 'Unix assembler');
2203         }
2204     }
2205 }
2206 \end{code}
2207
2208 %************************************************************************
2209 %*                                                                      *
2210 \subsection[Driver-run-something]{@run_something@: Run a phase}
2211 %*                                                                      *
2212 %************************************************************************
2213
2214 \begin{code}
2215 sub run_something {
2216     local($str_to_do, $tidy_name) = @_;
2217
2218     print STDERR "\n$tidy_name:\n\t" if $Verbose;
2219     print STDERR "$str_to_do\n" if $Verbose;
2220
2221     if ($Using_dump_file) {
2222         open(DUMP, ">> $Specific_dump_file")
2223             || &tidy_up_and_die(1,"$Pgm: failed to open `$Specific_dump_file'\n");
2224         print DUMP "\nCompilation Dump for: $str_to_do\n\n";
2225         close(DUMP)
2226             || &tidy_up_and_die(1,"$Pgm: failed closing `$Specific_dump_file'\n");
2227     }
2228
2229     local($return_val) = 0;
2230     system("$Time $str_to_do");
2231     $return_val = $?;
2232
2233     if ( $PostprocessCcOutput ) { # hack, continued
2234         open(CCOUT, "< $Tmp_prefix.ccout")
2235             || &tidy_up_and_die(1,"$Pgm: failed to open `$Tmp_prefix.ccout'\n");
2236         while ( <CCOUT> ) {
2237             next if /attribute directive ignored/;
2238             next if /call-clobbered/;
2239             next if /from .*COptRegs\.lh/;
2240             next if /from .*(stg|rts)defs\.h:/;
2241             next if /from ghc\d+.c:\d+:/;
2242             next if /from .*\.lc/;
2243             next if /from .*SMinternal\.l?h/;
2244             next if /ANSI C does not support \`long long\'/;
2245             next if /warning:.*was declared \`extern\' and later \`static\'/;
2246             next if /warning: assignment discards \`const\' from pointer target type/;
2247             next if /: At top level:$/;
2248             next if /: In function \`.*\':$/;
2249             next if /\`ghc_cc_ID\' defined but not used/;
2250             print STDERR $_;
2251         }
2252         close(CCOUT) || &tidy_up_and_die(1,"$Pgm: failed closing `$Tmp_prefix.ccout'\n");
2253     }
2254
2255     if ($return_val != 0) {
2256         if ($Using_dump_file) {
2257             print STDERR "Compilation Errors dumped in $Specific_dump_file\n";
2258         }
2259
2260         &tidy_up_and_die($return_val, '');
2261     }
2262     $Using_dump_file = 0;
2263 }
2264 \end{code}
2265
2266 %************************************************************************
2267 %*                                                                      *
2268 \subsection[Driver-ghctiming]{Emit nofibbish GHC timings}
2269 %*                                                                      *
2270 %************************************************************************
2271
2272 NB: nearly the same as in @runstdtest@ script.
2273
2274 \begin{code}
2275 sub process_ghc_timings {
2276     local($StatsFile) = "$Tmp_prefix.stat";
2277     local($SysSpecificTiming) = 'ghc';
2278
2279     open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n";
2280     local($tot_live) = 0; # for calculating avg residency
2281
2282     while (<STATS>) {
2283         $tot_live += $1 if /^\s*\d+\s+\d+\s+\d+\.\d+\%\s+(\d+)\s+\d+\.\d+\%/;
2284
2285         $BytesAlloc = $1 if /^\s*([0-9,]+) bytes allocated in the heap/;
2286
2287         if ( /^\s*([0-9,]+) bytes maximum residency .* (\d+) sample/ ) {
2288             $MaxResidency = $1; $ResidencySamples = $2;
2289         }
2290
2291         $GCs = $1 if /^\s*([0-9,]+) garbage collections? performed/;
2292
2293         if ( /^\s*INIT\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) {
2294             $InitTime = $1; $InitElapsed = $2;
2295         } elsif ( /^\s*MUT\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) {
2296             $MutTime = $1; $MutElapsed = $2;
2297         } elsif ( /^\s*GC\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) {
2298             $GcTime = $1; $GcElapsed = $2;
2299         }
2300     }
2301     close(STATS) || die "Failed when closing $StatsFile\n";
2302     if ( defined($ResidencySamples) && $ResidencySamples > 0 ) {
2303         $AvgResidency = int ($tot_live / $ResidencySamples) ;
2304     }
2305
2306     # warn about what we didn't find
2307     print STDERR "Warning: BytesAlloc not found in stats file\n" unless defined($BytesAlloc);
2308     print STDERR "Warning: GCs not found in stats file\n" unless defined($GCs);
2309     print STDERR "Warning: InitTime not found in stats file\n" unless defined($InitTime);
2310     print STDERR "Warning: InitElapsed not found in stats file\n" unless defined($InitElapsed);
2311     print STDERR "Warning: MutTime not found in stats file\n" unless defined($MutTime);
2312     print STDERR "Warning: MutElapsed not found in stats file\n" unless defined($MutElapsed);
2313     print STDERR "Warning: GcTime inot found in stats file\n" unless defined($GcTime);
2314     print STDERR "Warning: GcElapsed not found in stats file\n" unless defined($GcElapsed);
2315
2316     # things we didn't necessarily expect to find
2317     $MaxResidency     = 0 unless defined($MaxResidency);
2318     $AvgResidency     = 0 unless defined($AvgResidency);
2319     $ResidencySamples = 0 unless defined($ResidencySamples);
2320
2321     # a bit of tidying
2322     $BytesAlloc =~ s/,//g;
2323     $MaxResidency =~ s/,//g;
2324     $GCs =~ s/,//g;
2325     $InitTime =~ s/,//g;
2326     $InitElapsed =~ s/,//g;
2327     $MutTime =~ s/,//g;
2328     $MutElapsed =~ s/,//g;
2329     $GcTime =~ s/,//g;
2330     $GcElapsed =~ s/,//g;
2331
2332     # print out what we found
2333     print STDERR "<<$SysSpecificTiming: ",
2334         "$BytesAlloc bytes, $GCs GCs, $AvgResidency/$MaxResidency avg/max bytes residency ($ResidencySamples samples), $InitTime INIT ($InitElapsed elapsed), $MutTime MUT ($MutElapsed elapsed), $GcTime GC ($GcElapsed elapsed)",
2335         " :$SysSpecificTiming>>\n";
2336
2337     # OK, party over
2338     unlink $StatsFile;
2339 }
2340 \end{code}
2341
2342 %************************************************************************
2343 %*                                                                      *
2344 \subsection[Driver-dying]{@tidy_up@ and @tidy_up_and_die@: Dying gracefully}
2345 %*                                                                      *
2346 %************************************************************************
2347
2348 \begin{code}
2349 sub tidy_up {
2350     local($to_do) = "\n$Rm $Tmp_prefix*";
2351     if ( $Tmp_prefix !~ /^\s*$/ ) {
2352         print STDERR "$to_do\n" if $Verbose;
2353         system($to_do);
2354     }
2355 }
2356
2357 sub tidy_up_and_die {
2358     local($return_val, $msg) = @_;
2359
2360     # delete any files to tidy
2361     print STDERR "deleting... @Files_to_tidy\n" if $Verbose && $#Files_to_tidy >= 0;
2362     unlink @Files_to_tidy if $#Files_to_tidy >= 0;
2363
2364     &tidy_up();
2365     print STDERR $msg;
2366     exit (($return_val == 0) ? 0 : 1);
2367 }
2368 \end{code}
2369
2370 %************************************************************************
2371 %*                                                                      *
2372 \subsection[Driver-arg-with-arg]{@grab_arg_arg@: Do an argument with an argument}
2373 %*                                                                      *
2374 %************************************************************************
2375
2376 Some command-line arguments take an argument, e.g.,
2377 \tr{-Rmax-heapsize} expects a number to follow.  This can either be
2378 given a part of the same argument (\tr{-Rmax-heapsize8M}) or as the
2379 next argument (\tr{-Rmax-heapsize 8M}).  We allow both cases.
2380
2381 Note: no error-checking; \tr{-Rmax-heapsize -Rgc-stats} will silently
2382 gobble the second argument (and probably set the heapsize to something
2383 nonsensical).
2384 \begin{code}
2385 sub grab_arg_arg {
2386     local(*Args, $option, $rest_of_arg) = @_;
2387
2388     if ($rest_of_arg) {
2389         return($rest_of_arg);
2390     } elsif ($#Args >= 0) {
2391         local($temp) = $Args[0]; shift(@Args);
2392         return($temp);
2393     } else {
2394         print STDERR "$Pgm: no argument following $option option\n";
2395         $Status++;
2396     }
2397 }
2398 \end{code}
2399
2400 \begin{code}
2401 sub isntAntiFlag {
2402     local($flag) = @_;
2403     local($f);
2404
2405 #Not in HsC_antiflag ## NO!: and not already in HsC_flags
2406
2407     foreach $f ( @HsC_antiflags ) {
2408         return(0) if $flag eq $f;
2409     }
2410 #    foreach $f ( @HsC_flags ) {
2411 #       return(0) if $flag eq $f;
2412 #    }
2413     return(1);
2414 }
2415
2416 sub squashHscFlag {  # pretty terrible
2417     local($flag) = @_;
2418     local($f);
2419
2420     foreach $f ( @HsC_flags ) {
2421         if ($flag eq $f) { $f = ''; }
2422     }
2423 }
2424
2425 sub add_Hsc_flags {
2426     local(@flags) = @_;
2427     local($f);
2428
2429     foreach $f ( @flags ) {
2430         push( @HsC_flags, $f ) if &isntAntiFlag($f);
2431     }
2432 }
2433 \end{code}
2434
2435 Source files may have {-# OPTIONS ... #-} pragmas at the top, containing
2436 command line options we want to append to collection of commands specified
2437 directly. @check_for_source_options@ looks at the top of a de-lit'ified Haskell
2438 file for any such pragmas:
2439
2440 \begin{code}
2441 sub check_for_source_options {
2442     local($file) = @_;
2443
2444     open(FILE,$file) || return(1); # No big loss
2445
2446     while (<FILE>) {
2447         if ( /^{-# OPTIONS (.*)#-}/ ) {
2448            # add the options found at the back of the command line.
2449            local(@entries) = split(/\s+/,$1);
2450            push(@File_options, @entries);
2451         }
2452         elsif ( /^$/ ) { # ignore empty lines
2453            ;
2454         }
2455         else { # stop looking, something non-empty / not
2456                # {-# OPTIONS .. #-} encountered.
2457             break;
2458         }
2459     }
2460     close(FILE);
2461     return(0);
2462 }
2463 \end{code}
2464
2465
2466 We split the initial argv up into three arrays:
2467
2468   - @Cmd_opts
2469   - @Link_file
2470   - @Input_file
2471
2472 the reason for doing so is to be able to deal
2473 with {-# OPTIONS #-} pragma in source files properly.
2474
2475 \begin{code}
2476 sub splitCmdLine {
2477     local(@args) = @_;
2478
2479 arg: while($_ = $args[0]) {
2480     shift(@args);
2481     # sigh, we have to deal with these -option arg specially here.
2482     /^-(tmpdir|odir|o|isuf|osuf|hisuf|hisuf-prelude|odump|syslib)$/ &&
2483        do { push(@Cmd_opts, $_); push(@Cmd_opts,$args[0]); shift(@args); next arg; };
2484     /^-./  && do { push(@Cmd_opts, $_); next arg; };
2485
2486     if (/\.[oa]$/) {
2487         push(@Link_file, $_);
2488     } else {
2489         push(@Input_file, $_);
2490     }
2491
2492     # input files must exist:
2493     if (! -f $_) {
2494         print STDERR "$Pgm: input file doesn't exist: $_\n";
2495         $Status++;
2496     }
2497   }
2498 }
2499
2500 \end{code}
2501
2502 Command-line processor
2503
2504 \begin{code}
2505 sub processArgs {
2506     local(@Args) = @_;
2507
2508 # can't use getopt(s); what we want is too complicated
2509
2510 arg: while($_ = $Args[0]) {
2511     shift(@Args);
2512
2513     #---------- help -------------------------------------------------------
2514     if (/^-\?$/ || /^--?help$/) { print $LongUsage; exit $Status; }
2515
2516     #-----------version ----------------------------------------------------
2517     /^--version$/   && do { print STDERR "${PROJECTNAME}, version ${PROJECTVERSION} ${PROJECTPATCHLEVEL}\n"; exit $Status; };
2518
2519     #---------- verbosity and such -----------------------------------------
2520     /^-v$/          && do { $Verbose = '-v'; $Time = 'time'; next arg; };
2521
2522     #---------- what phases are to be run ----------------------------------
2523     /^-recomp/      && do { $Do_recomp_chkr = 1; next arg; };
2524
2525     /^-cpp$/        && do { $Cpp_flag_set = 1; next arg; };
2526     # change the global default:
2527     # we won't run cat; we'll run the real thing
2528
2529     /^-C$/          && do { $Do_cc = 0; $Do_as = 0; $Do_lnkr = 0; $HscOut = '-C=';
2530                             next arg; };
2531     # stop after generating C
2532
2533     /^-noC$/        && do { $HscOut = '-N='; $ProduceHi = '-nohifile=';
2534                             $Do_cc = 0; $Do_as = 0; $Do_lnkr = 0;
2535                             next arg; };
2536     # leave out actual C generation (debugging) [also turns off interface gen]
2537
2538     /^-hi$/         && do { $HiOnStdout = 1; $ProduceHi = '-hifile='; next arg; };
2539     # _do_ generate an interface; usually used as: -noC -hi
2540
2541     /^-nohi$/       && do { $ProduceHi = '-nohifile='; next arg; };
2542     # don't generate an interface (even if generating C)
2543
2544     /^-hi-diffs$/             && do { $HiDiff_flag = 'normal'; next arg; };
2545     /^-hi-diffs-with-usages$/ && do { $HiDiff_flag = 'usages'; next arg; };
2546     /^-no-hi-diffs$/          && do { $HiDiff_flag = '';       next arg; };
2547     # show/disable diffs if the interface file changes
2548
2549     /^-E$/          && do { push(@CcBoth_flags, '-E');
2550                             $Only_preprocess_C = 1;
2551                             $Do_as = 0; $Do_lnkr = 0; next arg; };
2552     # stop after preprocessing C
2553     /^-M$/          && do { $Only_generate_deps = 1; $Do_as = 0; $Do_lnkr = 0; next arg; };
2554     # only generate dependency information.
2555     /^-S$/          && do { $Do_as = 0; $Do_lnkr = 0; next arg; };
2556     # stop after generating assembler
2557
2558     /^-c$/          && do { $Do_lnkr = 0; next arg; };
2559     # stop after generating .o files
2560
2561     /^-link-chk$/    && do { $LinkChk = 1; next arg; };
2562     /^-no-link-chk$/ && do { $LinkChk = 0; next arg; };
2563     # don't do consistency-checking after a link
2564
2565     /^-tmpdir$/ && do { $Tmp_prefix = &grab_arg_arg(*Args,'-tmpdir', '');
2566                         $Tmp_prefix = "$Tmp_prefix/ghc$$";
2567                         $ENV{'TMPDIR'} = $Tmp_prefix; # for those who use it...
2568                         next arg; };
2569     # use an alternate directory for temp files
2570
2571     #---------- redirect output --------------------------------------------
2572
2573     # -o <file>; applies to the last phase, whatever it is
2574     # "-o -" sends it to stdout
2575     # if <file> has a directory component, that dir must already exist
2576
2577     /^-odir$/       && do { $Specific_output_dir = &grab_arg_arg(*Args,'-odir', '');
2578                             #
2579                             # Hack, of the worst sort: don't do validation of
2580                             # odir argument if you're using -M (dependency generation).
2581                             #
2582                             if ( ! $Only_generate_deps && ! -d $Specific_output_dir) {
2583                                 print STDERR "$Pgm: -odir: no such directory: $Specific_output_dir\n";
2584                                 $Status++;
2585                             }
2586                             next arg; };
2587
2588     /^-o$/          && do { $Specific_output_file = &grab_arg_arg(*Args,'-o', '');
2589                             if ($Specific_output_file ne '-'
2590                              && $Specific_output_file =~ /(.*)\/[^\/]*$/) {
2591                                 local($dir_part) = $1;
2592                                 if (! -d $dir_part) {
2593                                     print STDERR "$Pgm: no such directory: $dir_part\n";
2594                                     $Status++;
2595                                 }
2596                             }
2597                             next arg; };
2598
2599     # NB: -isuf not documented yet (because it doesn't work yet)
2600     /^-isuf$/       && do { $Isuffix  = &grab_arg_arg(*Args,'-isuf', '');
2601                             if ($Isuffix =~ /\./ ) {
2602                                 print STDERR "$Pgm: -isuf suffix shouldn't contain a .\n";
2603                                 $Status++;
2604                             }
2605                             next arg; };
2606
2607     /^-osuf$/       && do { $Osuffix  = &grab_arg_arg(*Args,'-osuf', '');
2608                             if ($Osuffix =~ /\./ ) {
2609                                 print STDERR "$Pgm: -osuf suffix shouldn't contain a .\n";
2610                                 $Status++;
2611                             }
2612                             next arg; };
2613
2614     # -ohi <file>; send the interface to <file>; "-ohi -" to send to stdout
2615     /^-ohi$/        && do { $Specific_hi_file = &grab_arg_arg(*Args,'-ohi', '');
2616                             if ($Specific_hi_file ne '-'
2617                              && $Specific_hi_file =~ /(.*)\/[^\/]*$/) {
2618                                 local($dir_part) = $1;
2619                                 if (! -d $dir_part) {
2620                                     print STDERR "$Pgm: no such directory: $dir_part\n";
2621                                     $Status++;
2622                                 }
2623                             }
2624                             next arg; };
2625
2626     # The suffix to use when looking for interface files
2627     /^-hisuf$/      && do { $HiSuffix = &grab_arg_arg(*Args,'-hisuf', '');
2628                             if ($HiSuffix =~ /\./ ) {
2629                                 print STDERR "$Pgm: -hisuf suffix shouldn't contain a .\n";
2630                                 $Status++;
2631                             }
2632                             next arg; };
2633     # ToDo: remove, not a `normal' user thing to do (should be automatic)
2634     /^-hisuf-prelude$/      && do { $HiSuffix_prelude = &grab_arg_arg(*Args,'-hisuf-prelude', '');
2635                             if ($HiSuffix =~ /\./ ) {
2636                                 print STDERR "$Pgm: -hisuf-prelude suffix shouldn't contain a .\n";
2637                                 $Status++;
2638                             }
2639                             next arg; };
2640     /^-odump$/      && do { $Specific_dump_file = &grab_arg_arg(*Args,'-odump', '');
2641                             if ($Specific_dump_file =~ /(.*)\/[^\/]*$/) {
2642                                 local($dir_part) = $1;
2643                                 if (! -d $dir_part) {
2644                                     print STDERR "$Pgm: no such directory: $dir_part\n";
2645                                     $Status++;
2646                                 }
2647                             }
2648                             next arg; };
2649
2650     #-------------- scc & Profiling Stuff ----------------------------------
2651
2652     /^-prof$/ && do { $PROFing = 'p'; next arg; }; # profiling -- details later!
2653
2654     /^-auto/ && do {
2655                 # generate auto SCCs on top level bindings
2656                 # -auto-all = all top level bindings
2657                 # -auto     = only top level exported bindings
2658                 $PROFauto = ( /-all/ )
2659                             ? '-fauto-sccs-on-all-toplevs'
2660                             : '-fauto-sccs-on-exported-toplevs';
2661                 next arg; };
2662
2663     /^-caf-all/ && do { # generate individual CAF SCC annotations
2664                 $PROFcaf = '-fauto-sccs-on-individual-cafs';
2665                 next arg; };
2666
2667     /^-ignore-scc$/ && do {
2668                 # forces ignore of scc annotations even if profiling
2669                 $PROFignore_scc = '-W';
2670                 next arg; };
2671
2672     /^-G(.*)$/  && do { push(@HsC_flags, "-G=$1");   # set group for cost centres
2673                         next arg; };
2674
2675     /^-unprof-scc-auto/ && do {
2676                 # generate auto SCCs on top level bindings when not profiling.
2677                 # Used to measure optimisation effects of presence of sccs.
2678                 $UNPROFscc_auto = ( /-all/ )
2679                             ? '-fauto-sccs-on-all-toplevs'
2680                             : '-fauto-sccs-on-exported-toplevs';
2681                 next arg; };
2682
2683     #--------- ticky/concurrent/parallel -----------------------------------
2684     # we sort out the details a bit later on
2685
2686     /^-concurrent$/ && do { $CONCURing = 'c'; next arg; }; # concurrent Haskell
2687     /^-gransim$/    && do { $GRANing   = 'g'; next arg; }; # GranSim
2688     /^-ticky$/      && do { $TICKYing  = 't'; next arg; }; # ticky-ticky
2689     /^-parallel$/   && do { $PARing    = 'p'; next arg; }; # parallel Haskell
2690
2691     #-------------- "user ways" --------------------------------------------
2692
2693     (/^-user-setup-([a-oA-Z])$/ ) &&
2694            do {
2695                 /^-user-setup-([a-oA-Z])$/  && do { $BuildTag = "_$1"; };
2696
2697                 local($stuff) = $UserSetupOpts{$BuildTag};
2698                 local(@opts)  = split(/\s+/, $stuff);
2699
2700                 # feed relevant ops into the arg-processing loop (if any)
2701                 unshift(@Args, @opts) if $#opts >= 0;
2702
2703                 next arg; };
2704
2705     #---------- set search paths for libraries and things ------------------
2706
2707     # we do -i just like HBC (-i clears the list; -i<colon-separated-items>
2708     # prepends the items to the list); -I is for including C .h files.
2709
2710     /^-i$/          && do { @Import_dir = ();  # import path cleared!
2711                             @SysImport_dir = ();
2712                             print STDERR "WARNING: import paths cleared by `-i'\n";
2713                             next arg; };
2714
2715     /^-i(.*)/       && do { local(@new_items)
2716                               = split( /:/, &grab_arg_arg(*Args,'-i', $1));
2717                             unshift(@Import_dir, @new_items);
2718                             next arg; };
2719
2720     /^-I(.*)/       && do { push(@Include_dir,     &grab_arg_arg(*Args,'-I', $1)); next arg; };
2721     /^-L(.*)/       && do { push(@UserLibrary_dir, &grab_arg_arg(*Args,'-L', $1)); next arg; };
2722     /^-l(.*)/       && do { push(@UserLibrary,'-l'.&grab_arg_arg(*Args,'-l', $1)); next arg; };
2723
2724     /^-syslib(.*)/  && do { local($syslib) = &grab_arg_arg(*Args,'-syslib',$1);
2725                             print STDERR "$Pgm: no such system library (-syslib): $syslib\n",
2726                               $Status++ unless $syslib =~ /^(hbc|ghc|posix|contrib)$/;
2727
2728                             unshift(@SysImport_dir,
2729                                 ${INSTALLING}
2730                                 ? "$InstSysLibDir/$syslib/imports"
2731                                 : "$TopPwd/hslibs/$syslib/src");
2732
2733                             if ( ${INSTALLING} ) {
2734                                 push(@SysLibrary_dir,
2735                                         ("$InstSysLibDir/$TargetPlatform"));
2736                             } else {
2737                                 push(@SysLibrary_dir,
2738                                         ("$TopPwd/hslibs/$syslib"
2739                                         ,"$TopPwd/hslibs/$syslib/cbits"));
2740                             }
2741
2742                             push(@SysLibrary, "-lHS$syslib");
2743                             push(@SysLibrary, "-lHS${syslib}_cbits")
2744                               unless $syslib eq 'contrib'; #HACK! it has no cbits
2745
2746                             next arg; };
2747
2748     #=======================================================================
2749     # various flags that we can harmlessly send to one program or another
2750     # (we will later "reclaim" some of the compiler ones now sent to gcc)
2751     #=======================================================================
2752
2753     #---------- this driver itself (ghc) -----------------------------------
2754     # these change what executable is run for each phase:
2755     /^-pgmL(.*)$/   && do { $Unlit      = $1; next arg; };
2756     /^-pgmP(.*)$/   && do { $HsCpp      = $1; next arg; };
2757     /^-pgmC(.*)$/   && do { $HsC        = $1; next arg; };
2758     /^-pgmcO?(.*)$/ && do { $CcRegd     = $1; next arg; }; # the O? for back compat
2759     /^-pgma(.*)$/   && do { $As         = $1; next arg; };
2760     /^-pgml(.*)$/   && do { $Lnkr       = $1; next arg; };
2761     /^-pgmdep(.*)$/ && do { $MkDependHS = $1; next arg; };
2762
2763     #---------- the get-anything-through opts (all pgms) -------------------
2764     # these allow arbitrary option-strings to go to any phase:
2765     /^-optL(.*)$/   && do { push(@Unlit_flags,      $1); next arg; };
2766     /^-optP(.*)$/   && do { push(@HsCpp_flags,      $1); next arg; };
2767     /^-optCrts(.*)$/&& do { push(@HsC_rts_flags,    $1); next arg; };
2768     /^-optC(.*)$/   && do { push(@HsC_flags,        $1); next arg; };
2769     /^-optcpp(.*)$/ && do { push(@Cpp_define,       $1); next arg; };
2770     /^-optc(.*)$/   && do { push(@CcBoth_flags,     $1); next arg; };
2771     /^-opta(.*)$/   && do { push(@As_flags,         $1); next arg; };
2772     /^-optl(.*)$/   && do { push(@Ld_flags,         $1); next arg; };
2773     /^-optdep(.*)$/ && do { push(@MkDependHS_flags, $1); next arg; };
2774
2775     #---------- Haskell C pre-processor (hscpp) ----------------------------
2776     /^-D(.*)/       && do { push(@HsCpp_flags, "'-D".&grab_arg_arg(*Args,'-D',$1)."'"); next arg; };
2777     /^-U(.*)/       && do { push(@HsCpp_flags, "'-U".&grab_arg_arg(*Args,'-U',$1)."'"); next arg; };
2778
2779     /^-genSPECS/   && do { $Cpp_flag_set = 1;
2780                            $genSPECS_flag = $_;
2781                             next arg; };
2782
2783     #---------- post-Haskell "assembler"------------------------------------
2784     /^-ddump-raw-asm$/            && do { $Dump_raw_asm        = 1; next arg; };
2785     /^-ddump-asm-splitting-info$/ && do { $Dump_asm_splitting_info = 1; next arg; };
2786
2787     #---------- Haskell compiler (hsc) -------------------------------------
2788
2789     /^-keep-hc-files?-too$/     && do { $Keep_hc_file_too = 1; next arg; };
2790     /^-keep-s-files?-too$/      && do { $Keep_s_file_too = 1;  next arg; };
2791
2792     /^-fhaskell-1\.3$/          && do { next arg; }; # a no-op right now
2793
2794     /^-fignore-interface-pragmas$/ && do { push(@HsC_flags, $_); next arg; };
2795
2796     /^-fno-implicit-prelude$/      && do { $NoImplicitPrelude= 1; push(@HsC_flags, $_); next arg; };
2797      # don't do stack checking using page fault `trick'.
2798      # (esoteric).
2799     /^-fstack-check$/              && do { $StkChkByPageFaultOK = 0; next arg; };
2800      #
2801      # have the compiler proper generate concurrent code,
2802      # really only used when you want to configure your own
2803      # special user compilation way. (Use -concurrent when
2804      # compiling `Concurrent Haskell' programs).
2805      #
2806      # (ditto for -fgransim, fscc-profiling and -fticky-ticky)
2807      #
2808     /^-fconcurrent$/      && do { push(@HsC_flags,$_); next arg; };
2809     /^-fscc-profiling$/   && do { push(@HsC_flags,$_); next arg; };
2810     /^-fticky-ticky$/     && do { push(@HsC_flags,$_); next arg; };
2811     /^-fgransim$/         && do { push(@HsC_flags,$_); next arg; };
2812
2813     /^-user-prelude-force/      && do { # ignore if not -user-prelude
2814                                         next arg; };
2815
2816     /^-split-objs/      && do {
2817                         if ( $TargetPlatform !~ /^(alpha|hppa1\.1|i386|m68k|mips|powerpc|sparc)-/ ) {
2818                             $SplitObjFiles = 0;
2819                             print STDERR "WARNING: don't know how to split objects on this platform: $TargetPlatform\n`-split-objs' option ignored\n";
2820                         } else {
2821                             $SplitObjFiles = 1;
2822                             $HscOut = '-C=';
2823
2824                             push(@HsC_flags, "-fglobalise-toplev-names");
2825                             push(@CcBoth_flags, '-DUSE_SPLIT_MARKERS');
2826
2827                             require('ghc-split.prl')
2828                              || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-split.prl!\n");
2829                         }
2830                         next arg; };
2831
2832     /^-fglasgow-exts$/
2833                 && do { push(@HsC_flags, $_);
2834                         push(@HsP_flags, '-N');
2835
2836 #                       push(@HsC_flags, '-fshow-import-specs');
2837
2838                         next arg; };
2839
2840     /^-fspeciali[sz]e-unboxed$/
2841                 && do { $Oopt_DoSpecialise      = '-fspecialise';
2842                         $Oopt_SpecialiseUnboxed = '-fspecialise-unboxed';
2843                         next arg; };
2844     /^-fspeciali[sz]e$/
2845                 && do { $Oopt_DoSpecialise = '-fspecialise'; next arg; };
2846     /^-fno-speciali[sz]e$/
2847                 && do { $Oopt_DoSpecialise = ''; next arg; };
2848
2849
2850 # Now the foldr/build options, which are *on* by default (for -O).
2851
2852     /^-ffoldr-build$/
2853                     && do { $Oopt_FoldrBuild = 1;
2854                             $Oopt_FB_Support = '-fdo-arity-expand';
2855                             #print "Yes F/B\n";
2856                             next arg; };
2857
2858     /^-fno-foldr-build$/
2859                     && do { $Oopt_FoldrBuild = 0;
2860                             $Oopt_FB_Support = '';
2861                             next arg; };
2862
2863     /^-fno-foldr-build-rule$/
2864                     && do { $Oopt_FoldrBuild = 0;
2865                             next arg; };
2866
2867     /^-fno-enable-tech$/
2868                     && do { $Oopt_FB_Support = '';
2869                             next arg; };
2870
2871     /^-fno-snapback-to-append$/
2872                     && do { $Oopt_FoldrBuildInline .= ' -fdo-not-fold-back-append ';
2873                             next arg; };
2874
2875     # ---------------
2876
2877     /^-fasm-(.*)$/  && do { $HscOut = '-S='; next arg; }; # force using nativeGen
2878     /^-fvia-C$/     && do { $HscOut = '-C='; next arg; }; # force using C compiler
2879
2880     # ---------------
2881
2882     /^(-funfolding-use-threshold)(.*)$/
2883                     && do { $Oopt_UnfoldingUseThreshold = $1 . &grab_arg_arg(*Args,$1, $2);
2884                             next arg; };
2885
2886     /^(-fmax-simplifier-iterations)(.*)$/
2887                     && do { $Oopt_MaxSimplifierIterations = $1 . &grab_arg_arg(*Args,$1, $2);
2888                             next arg; };
2889
2890     /^-fno-pedantic-bottoms$/
2891                     && do { $Oopt_PedanticBottoms = ''; next arg; };
2892
2893     /^-fdo-monad-eta-expansion$/
2894                     && do { $Oopt_MonadEtaExpansion = $_; next arg; };
2895
2896     /^-fno-let-from-(case|app|strict-let)$/ # experimental, really (WDP 95/10)
2897                     && do { push(@HsC_flags, $_); next arg; };
2898
2899     /^(-freturn-in-regs-threshold)(.*)$/
2900                     && do { local($what) = $1;
2901                             local($num)  = &grab_arg_arg(*Args,$what, $2);
2902                             if ($num < 2 || $num > 8) {
2903                                 die "Bad experimental flag: $_\n";
2904                             } else {
2905                                 $HscOut = '-C='; # force using C compiler
2906                                 push(@HsC_flags, "$what$num");
2907                                 push(@CcRegd_flags, "-D__STG_REGS_AVAIL__=$num");
2908                             }
2909                             next arg; };
2910
2911     # --------------- Warnings etc. ------
2912
2913     /^-f(show-import-specs)/
2914                     && do { push(@HsC_flags, $_); next arg; };
2915
2916     # for now, just -fwarn-name-shadowing
2917     /^-fwarn-(.*)$/   && do { push(@HsC_flags, $_); next arg; };
2918     /^-fno-(.*)$/   && do { push(@HsC_antiflags, "-f$1");
2919                             &squashHscFlag("-f$1");
2920                             next arg; };
2921
2922     # --------------- platform specific flags (for gcc mostly) ----------------
2923
2924     /^-mlong-calls$/ && do { # for GCC for HP-PA boxes,
2925                              # for 2.6.x..?, does not apply for 2.7.2
2926                              # any longer.
2927                             unshift(@CcBoth_flags, ( $_ ));
2928                             next arg; };
2929
2930     /^-m(v8|sparclite|cypress|supersparc|cpu=(cypress|supersparc))$/
2931                      && do { # for GCC for SPARCs
2932                             unshift(@CcBoth_flags, ( $_ ));
2933                             next arg; };
2934
2935     /^-monly-([432])-regs/ && do { # for iX86 boxes only; no effect otherwise
2936                             $StolenX86Regs = $1;
2937                             next arg; };
2938
2939     #*************** ... and lots of debugging ones (form: -d* )
2940
2941     # -d(no-)core-lint is done this way so it is turn-off-able.
2942     /^-dcore-lint/       && do { $CoreLint = '-dcore-lint'; next arg; };
2943     /^-dno-core-lint/    && do { $CoreLint = '';            next arg; };
2944     # Ditto for STG lint
2945     /^-dstg-lint/       && do { $StgLint = '-dstg-lint'; next arg; };
2946     /^-dno-stg-lint/    && do { $StgLint = '';           next arg; };
2947
2948     /^-d(dump|ppr)-/         && do { push(@HsC_flags, $_); next arg; };
2949     /^-dverbose-(simpl|stg)/ && do { push(@HsC_flags, $_); next arg; };
2950     /^-dshow-passes/         && do { push(@HsC_flags, $_); next arg; };
2951     /^-dshow-rn-trace/       && do { push(@HsC_flags, $_); next arg; };
2952     /^-dsource-stats/        && do { push(@HsC_flags, $_); next arg; };
2953     /^-dsimplifier-stats/    && do { push(@HsC_flags, $_); next arg; };
2954     /^-dstg-stats/           && do { $Oopt_StgStats = $_; next arg; };
2955
2956     #*************** ... and now all these -R* ones for its runtime system...
2957
2958     /^-Rscale-sizes?(.*)/ && do {
2959         $Scale_sizes_by = &grab_arg_arg(*Args,'-Rscale-sizes', $1);
2960         next arg; };
2961
2962     /^(-H|-Rmax-heapsize)(.*)/ && do {
2963         local($heap_size) = &grab_arg_arg(*Args,$1, $2);
2964         if ($heap_size =~ /(\d+)[Kk]$/) {
2965             $heap_size = $1 * 1000;
2966         } elsif ($heap_size =~ /(\d+)[Mm]$/) {
2967             $heap_size = $1 * 1000 * 1000;
2968         } elsif ($heap_size =~ /(\d+)[Gg]$/) {
2969             $heap_size = $1 * 1000 * 1000 * 1000;
2970         }
2971         if ($heap_size <= 0) {
2972             print STDERR "$Pgm: resetting heap-size to zero!!! $heap_size\n";
2973             $Specific_heap_size = 0;
2974
2975         # if several heap sizes given, take the largest...
2976         } elsif ($heap_size >= $Specific_heap_size) {
2977             $Specific_heap_size = $heap_size;
2978         } else {
2979             print STDERR "$Pgm: ignoring heap-size-setting option ($_)...not the largest seen\n";
2980         }
2981         next arg; };
2982
2983     /^-(K|Rmax-(stk|stack)size)(.*)/ && do {
2984         local($flag) = $1;
2985         local($stk_size) = &grab_arg_arg(*Args,'-Rmax-stksize', $3);
2986         if ($stk_size =~ /(\d+)[Kk]$/) {
2987             $stk_size = $1 * 1000;
2988         } elsif ($stk_size =~ /(\d+)[Mm]$/) {
2989             $stk_size = $1 * 1000 * 1000;
2990         } elsif ($stk_size =~ /(\d+)[Gg]$/) {
2991             $stk_size = $1 * 1000 * 1000 * 1000;
2992         }
2993         if ($stk_size <= 0) {
2994             print STDERR "$Pgm: resetting stack-size to zero!!! $stk_size\n";
2995             $Specific_stk_size = 0;
2996
2997         # if several stack sizes given, take the largest...
2998         } elsif ($stk_size >= $Specific_stk_size) {
2999             $Specific_stk_size = $stk_size;
3000         } else {
3001             print STDERR "$Pgm: ignoring stack-size-setting option ($flag $stk_size)...not the largest seen\n";
3002         }
3003         next arg; };
3004
3005     /^-Rgc-stats$/ && do {  $CollectingGCstats++;
3006                             # the two RTSs do this diff ways; we will try to compensate
3007                             next arg; };
3008
3009     /^-Rghc-timing/ && do { $CollectGhcTimings = 1; next arg; };
3010
3011     #---------- C high-level assembler (gcc) -------------------------------
3012     /^-(Wall|ansi|pedantic)$/ && do { push(@CcBoth_flags, $_); next arg; };
3013
3014     # -dgcc-lint is a useful way of making GCC very fussy.
3015     # From alan@spri.levels.unisa.edu.au (Alan Modra).
3016     /^-dgcc-lint$/ && do { push(@CcBoth_flags, '-Wall -Wpointer-arith -Wbad-function-cast -Wcast-qual -Wstrict-prototypes -Wmissing-prototypes -Wmissing-declarations -Wnested-externs'); next arg; };
3017     # An alternate set, from mark@sgcs.com (Mark W. Snitily)
3018     # -Wall -Wstrict-prototypes -Wmissing-prototypes -Wcast-align -Wshadow
3019
3020     # inject "#include <wurble>" into the compiler's C output!
3021
3022     /^-#include(.*)/    && do {
3023         local($to_include) = &grab_arg_arg(*Args,'-#include', $1);
3024         push(@CcInjects, "#include $to_include\n");
3025         next arg; };
3026
3027     #---------- Linker (gcc, really) ---------------------------------------
3028
3029     /^-static$/         && do { push(@Ld_flags, $_); next arg; };
3030
3031     #---------- mixed cc and linker magic ----------------------------------
3032     # this optimisation stuff is finally sorted out later on...
3033
3034     /^-O2-for-C$/ && do { $MinusO2ForC = 1; next arg; };
3035
3036     /^-O[1-2]?$/ && do {
3037                 local($opt_lev) = ( /^-O2$/ ) ? 2 : 1; # max 'em
3038                 $OptLevel = ( $opt_lev > $OptLevel ) ? $opt_lev : $OptLevel;
3039
3040                 $HscOut = '-C=' if $OptLevel == 2; # force use of C compiler
3041                 next arg; };
3042
3043     /^-Onot$/   && do { $OptLevel = 0; next arg; }; # # set it to <no opt>
3044
3045     /^-Ofile(.*)/ && do {
3046                 $OptLevel = 3;
3047                 local($ofile) = &grab_arg_arg(*Args,'-Ofile', $1);
3048                 @HsC_minusO3_flags = ();
3049
3050                 open(OFILE, "< $ofile") || die "Can't open $ofile!\n";
3051                 while (<OFILE>) {
3052                     chop;
3053                     s/\#.*//;       # death to comments
3054                     s/[ \t]+//g;    # death to whitespace
3055                     next if /^$/;   # ditto, blank lines
3056                     s/([()*{}])/\\$1/g;    # protect shell metacharacters
3057                     if ( /^C:(.*)/ ) {
3058                         push(@CcBoth_flags, $1);
3059                     } else {
3060                         push(@HsC_minusO3_flags, $_);
3061                     }
3062                 }
3063                 close(OFILE);
3064                 next arg; };
3065
3066     /^-debug$/  && do { # all this does is mark a .hc/.o as "debugging"
3067                         # in the consistency info
3068                         $DEBUGging = 'd';
3069                         next arg; };
3070
3071     #---------- linking .a file --------------------------------------------
3072
3073     /^-Main(.*)/ && do {
3074                 # specifies main or mainPrimIO to be linked
3075                 $Ld_main = $1;
3076                 next arg; };
3077
3078     #---------- catch unrecognized flags -----------------------------------
3079
3080     /^-./ && do {
3081         print STDERR "$Pgm: unrecognised option: $_\n";
3082         $Status++;
3083         next arg; };
3084
3085 }
3086
3087 } # end of processArgs
3088
3089 \end{code}