ghc/driver/ghc.lprl

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