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