X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fdriver%2Fghc.lprl;h=745f9688124537aa11393c64e923f33eba430f54;hb=88e65770ac9e96a68959edb2284a700425cdb1f7;hp=3777be9a5b4e6ca6a7fcbb94206af8349afb3159;hpb=5eb1c77c795f92ed0f4c8023847e9d4be1a4fd0d;p=ghc-hetmet.git diff --git a/ghc/driver/ghc.lprl b/ghc/driver/ghc.lprl index 3777be9..745f968 100644 --- a/ghc/driver/ghc.lprl +++ b/ghc/driver/ghc.lprl @@ -1,8 +1,4 @@ -% -% (c) The GRASP/AQUA Project, Glasgow University, 1992-1996 -% -% *** MSUB does some substitutions here *** -% *** grep for $( *** +% (c) The GRASP/AQUA Project, Glasgow University, 1992-1997 % This is the driver script for the Glasgow Haskell compilation system. @@ -49,8 +45,8 @@ to stdout or stderr, however). The phase at which to STOP processing is determined by a command-line option: + -E stop after generating preprocessed, de-litted Haskell (used in conjunction with -cpp) -C stop after generating C (.hc output) - -E stop after generating preprocessed C (.i output) -S stop after generating assembler (.s output) -c stop after generating object files (.o output) @@ -65,18 +61,24 @@ Other commonly-used options are: -H14m Increase compiler's heap size + -M Output the Makefile rules recording the + dependencies of a list of Haskell files. + (ghc driver script calls upon the help of a + compatible mkdependHS script to do the actual + processing) + The User's Guide has more information about GHC's *many* options. Given the above, here are some TYPICAL invocations of $Pgm: # compile a Haskell module to a .o file, optimising: % $Pgm -c -O Foo.hs + # link three .o files into an executable called "test": + % $Pgm -o test Foo.o Bar.o Baz.o # compile a Haskell module to C (a .hc file), using a bigger heap: % $Pgm -C -H16m Foo.hs # compile Haskell-produced C (.hc) to assembly language: % $Pgm -S Foo.hc - # link three .o files into an executable called "test": - % $Pgm -o test Foo.o Bar.o Baz.o ------------------------------------------------------------------------ EOUSAGE \end{code} @@ -87,46 +89,58 @@ EOUSAGE %* * %************************************************************************ -Establish what executables to run for the various phases (all the -\tr{$(FOO)} make-variables are \tr{msub}bed for from the -\tr{Makefile}), what the default options are for those phases, and -other similar boring stuff. +The driver script need to be told where to find these executables, so +in the course of building the driver `executable', make-variables holding +these are prepended to the de-litted version of this file. The variables are: + +\begin{verbatim} +INSTALLING + +HOSTPLATFORM TARGETPLATFORM + +ProjectName ProjectVersion ProjectVersionInt ProjectPatchLevel + +HscMajorVersion HscMinorVersion CcMajorVersion CcMinorVersion + +TOP_PWD + +bindir libdir libexecdir datadir + +CURRENT_DIR TMPDIR + +GHC_LIB_DIR GHC_RUNTIME_DIR GHC_UTILS_DIR GHC_INCLUDE_DIR + +GHC_OPT_HILEV_ASM GhcWithNativeCodeGen + +GHC_UNLIT GHC_HSCPP GHC_HSC GHC_SYSMAN + +CP RM CONTEXT_DIFF + +WAY_*_NAME WAY_*_REAL_OPTS + +LeadingUnderscore + +GhcWithRegisterised + +\end{verbatim} + +Establish what executables to run for the various phases, what the +default options are for those phases, and other similar boring stuff. + \begin{code} select(STDERR); $| = 1; select(STDOUT); # no STDERR buffering, please. -$HostPlatform = '$(HOSTPLATFORM)'; -$TargetPlatform = '$(TARGETPLATFORM)'; - -#------------------------------------------------------------------------ -# If you are adjusting paths by hand for a binary GHC distribution, -# de-commenting the line to set GLASGOW_HASKELL_ROOT should do. -# Or you can leave it as is, and set the environment variable externally. -#------------------------------------------------------------------------ -# $ENV{'GLASGOW_HASKELL_ROOT'} = '/some/absolute/path/name'; - -if (! $ENV{'GLASGOW_HASKELL_ROOT'}) { # good -- death to environment variables - $TopPwd = '$(TOP_PWD)'; - $InstLibDirGhc = '$(INSTLIBDIR_GHC)'; - $InstDataDirGhc = '$(INSTDATADIR_GHC)'; -# $InstSysLibDir = '$(INSTLIBDIR_HSLIBS)'; ToDo ToDo - $InstSysLibDir = '$(TOP_PWD)/hslibs'; -} else { - $TopPwd = $ENV{'GLASGOW_HASKELL_ROOT'}; - - if ('$(INSTLIBDIR_GHC)' =~ /.*(\/lib\/ghc\/\d\.\d\d\/[^-]-[^-]-[^-]\/.*)/) { - $InstLibDirGhc = $ENV{'GLASGOW_HASKELL_ROOT'} . $1; - } else { - print STDERR "GLASGOW_HASKELL_ROOT environment variable is set;\nBut can't untangle $(INSTLIBDIR_GHC).\n(Installation error)\n"; - exit(1); - } +$TargetPlatform = $TARGETPLATFORM; - if ('$(INSTDATADIR_GHC)' =~ /.*(\/lib\/ghc\/\d\.\d\d\/.*)/) { - $InstDataDirGhc = $ENV{'GLASGOW_HASKELL_ROOT'} . $2; - } else { - print STDERR "GLASGOW_HASKELL_ROOT environment variable is set;\nBut can't untangle $(INSTDATADIR_GHC).\n(Installation error)\n"; - exit(1); - } -} +$TopPwd = "${TOP_PWD}"; +$InstBinDirGhc = "${bindir}"; +$InstLibDirGhc = "${libdir}"; +# +# Normally the same as InstLibDirGhc, but we accommodate +# for it being separate. +# +$InstLibExecDirGhc = "${libexecdir}"; +$InstDataDirGhc = "${datadir}"; $Status = 0; # just used for exit() status $Verbose = ''; @@ -138,297 +152,286 @@ $SIG{'QUIT'} = 'quit_upon_signal'; # where to get "require"d .prl files at runtime (poor man's dynamic loading) # (use LIB, not DATA, because we can't be sure of arch-independence) -@INC = ( ( $(INSTALLING) ) ? $InstLibDirGhc - : "$TopPwd/$(CURRENT_DIR)" ); +@INC = ( ( $INSTALLING ) ? $InstLibDirGhc + : "$TopPwd/${CURRENT_DIR}" ); if ( $ENV{'TMPDIR'} ) { # where to make tmp file names $Tmp_prefix = ($ENV{'TMPDIR'} . "/ghc$$"); } else { - $Tmp_prefix ="$(TMPDIR)/ghc$$"; - $ENV{'TMPDIR'} = '$(TMPDIR)'; # set the env var as well + print STDERR "TMPDIR has not been set to anything useful!\n" if (${TMPDIR} eq ''); + $Tmp_prefix ="${TMPDIR}/ghc$$"; # TMPDIR set via Makefile when booting.. + $ENV{'TMPDIR'} = ${TMPDIR}; # set the env var as well +} + +# Some shells run into real trouble when command line and environment +# gets big (e.g., cmd lines of >4K to /bin/sh causes havoc on our +# Solaris-2.5.1 boxes - even though sysconf(_SC_ARG_MAX) reports 1M ...). +# To work around any such */bin/sh* problems, we will scribble such +# awfully long command lines into a temp file and exec that temp file +# with $(REAL_SHELL) (don't use the SHELL variable directly as this +# will normally get you the wrong thing when the driver is invoked +# from within `make'). If the REAL_SHELL variable isn't set, you'll +# get SHELL. This is all a terrible hack. (in case you hadn't reached +# the same conclusion by now :-) +# +# TBC.. +# +if ( ! $ENV{'REAL_SHELL'} ) { + $ENV{'REAL_SHELL'} = $ENV{'SHELL'}; } @Files_to_tidy = (); # files we nuke in the case of abnormal termination -$Unlit = ( $(INSTALLING) ) ? "$InstLibDirGhc/unlit" - : "$TopPwd/$(CURRENT_DIR)/$(GHC_UNLIT)"; -@Unlit_flags = (); +$Unlit = ( $INSTALLING ) ? "$InstLibExecDirGhc/unlit" + : "$TopPwd/${CURRENT_DIR}/${GHC_UNLIT}"; -$Cp = '$(CP)'; -$Rm = '$(RM)'; -$Diff = '$(CONTEXT_DIFF)'; +$Cp = $CP; +$Rm = $RM; +$Diff = $CONTEXT_DIFF; $Cat = 'cat'; $Cmp = 'cmp'; $Time = ''; $HsCpp = # but this is re-set to "cat" (after options) if -cpp not seen - ( $(INSTALLING) ) ? "$InstLibDirGhc/hscpp" - : "$TopPwd/$(CURRENT_DIR)/$(GHC_HSCPP)"; + ( $INSTALLING ) ? "$InstLibExecDirGhc/hscpp" + : "$TopPwd/${CURRENT_DIR}/${GHC_HSCPP}"; + @HsCpp_flags = (); -$genSPECS_flag = ''; # See ../utils/hscpp/hscpp.prl +$HsC = ( $INSTALLING ) ? "$InstLibExecDirGhc/hsc" + : "$TopPwd/${CURRENT_DIR}/${GHC_HSC}"; -$HsC = ( $(INSTALLING) ) ? "$InstLibDirGhc/hsc" - : "$TopPwd/$(CURRENT_DIR)/$(GHC_HSC)"; +# For PVM fiends only +$SysMan = ( $INSTALLING ) ? "$InstLibExecDirGhc/SysMan" + : "$TopPwd/${CURRENT_DIR}/${GHC_SYSMAN}"; -$SysMan = ( $(INSTALLING) ) ? "$InstLibDirGhc/SysMan" - : "$TopPwd/$(CURRENT_DIR)/$(GHC_SYSMAN)"; +@Unlit_flags = (); +# # HsC_rts_flags: if we want to talk to the LML runtime system # NB: we don't use powers-of-2 sizes, because this may do # terrible things to cache behavior. +# $Specific_heap_size = 6 * 1000 * 1000; $Specific_stk_size = 1000 * 1000; $Scale_sizes_by = 1.0; -@HsC_rts_flags = (); - -@HsP_flags = (); # these are the flags destined solely for - # the flex/yacc parser -@HsC_flags = (); -@HsC_antiflags = (); -\end{code} - -The optimisations/etc to be done by the compiler are {\em normally} -expressed with a \tr{-O} (or \tr{-O2}) flag, or by its absence. -\begin{code} -$OptLevel = 0; # no -O == 0; -O == 1; -O2 == 2; -Ofile == 3 -$MinusO2ForC = 0; # set to 1 if -O2 should be given to C compiler -$StolenX86Regs = 4; # **HACK*** of the very worst sort -$CoreLint = ''; \end{code} -These variables represent parts of the -O/-O2/etc ``templates,'' -which are filled in later, using these. +The variables set by @setupOptFlags@ represent parts of the +-O/-O2/etc ``templates,'' which are filled in later, using these. These are the default values, which may be changed by user flags. + \begin{code} -$Oopt_UnfoldingUseThreshold = '-fsimpl-uf-use-threshold3'; -$Oopt_MaxSimplifierIterations = '-fmax-simplifier-iterations4'; -$Oopt_PedanticBottoms = '-fpedantic-bottoms'; # ON by default -$Oopt_MonadEtaExpansion = ''; -$Oopt_FinalStgProfilingMassage = ''; -$Oopt_StgStats = ''; -$Oopt_SpecialiseUnboxed = ''; -$Oopt_DoSpecialise = ''; # ToDo:LATER: '-fspecialise'; -$Oopt_FoldrBuild = 0; # *Off* by default! -$Oopt_FB_Support = ''; # was '-fdo-arity-expand'; -#$Oopt_FoldrBuildWW = 0; # Off by default -$Oopt_FoldrBuildInline = ''; # was '-fdo-inline-foldr-build'; +sub setupOptFlags { + $Oopt_MaxSimplifierIterations = '-fmax-simplifier-iterations4'; + $Oopt_PedanticBottoms = '-fpedantic-bottoms'; # ON by default + $Oopt_FinalStgProfilingMassage = ''; + $Oopt_StgStats = ''; + $Oopt_DoSpecialise = '-fspecialise'; + $Oopt_FoldrBuild = 0; # *Off* by default! + $Oopt_UsageSPInf = ''; # Off by default +} # end of setupOptFlags + +# Assign defaults to these right away. +&setupOptFlags(); \end{code} Things to do with C compilers/etc: + +(added -Wimplicit: implicit prototypes cause very hard-to-find +problems, so I'm turing on the warnings -- SDM 4/5/98) + \begin{code} -$CcRegd = 'gcc'; -@CcBoth_flags = ('-S'); # flags for *any* C compilation +$CcRegd = $GHC_OPT_HILEV_ASM; +@CcBoth_flags = ('-S','-Wimplicit'); # flags for *any* C compilation @CcInjects = (); -# GCC flags: those for all files, those only for .c files; those only for .hc files -@CcRegd_flags = ('-ansi', '-D__STG_GCC_REGS__', '-D__STG_TAILJUMPS__'); -@CcRegd_flags_c = (); +# GCC flags: +# those for all files, +# those only for .c files; +# those only for .hc files + +@CcRegd_flags = (); +@CcRegd_flags_c = (); @CcRegd_flags_hc = (); -$As = ''; # "assembler" is normally GCC -@As_flags = (); +$As = ''; # "assembler" is normally GCC +@As_flags = (); -$Lnkr = ''; # "linker" is normally GCC -@Ld_flags = (); +$Lnkr = ''; # "linker" is normally GCC +@Ld_flags = (); +@Dll_flags = (); # 'nm' is used for consistency checking (ToDo: mk-world-ify) # ToDo: check the OS or something ("alpha" is surely not the crucial question) $Nm = ($TargetPlatform =~ /^alpha-/) ? 'nm -B' : 'nm'; \end{code} +Warning packages that are controlled by -W and -Wall. The 'standard' +warnings that you get all the time are + + -fwarn-overlapping-patterns + -fwarn-missing-methods + -fwarn-duplicate-exports + +these are turned off by -Wnot. + +\begin{code} +@StandardWarnings = ('-fwarn-overlapping-patterns', + '-fwarn-missing-methods', + '-fwarn-duplicate-exports'); +@MinusWOpts = (@StandardWarnings, + '-fwarn-incomplete-patterns', + '-fwarn-unused-binds', + '-fwarn-unused-imports'); +@MinusWallOpts = (@MinusWOpts, + '-fwarn-unused-matches', + '-fwarn-type-defaults', + '-fwarn-name-shadowing', + '-fwarn-missing-signatures'); +\end{code} + What options \tr{-user-setup-a} turn into (user-defined ``packages'' + of options). Note that a particular user-setup implies a particular Prelude ({\em including} its interface file(s)). \begin{code} $BuildTag = ''; # default is sequential build w/ Appel-style GC -%BuildAvail = ('', '$(GHC_BUILD_FLAG_normal)', - '_p', '$(GHC_BUILD_FLAG_p)', - '_t', '$(GHC_BUILD_FLAG_t)', - '_u', '$(GHC_BUILD_FLAG_u)', - '_mc', '$(GHC_BUILD_FLAG_mc)', - '_mr', '$(GHC_BUILD_FLAG_mr)', - '_mt', '$(GHC_BUILD_FLAG_mt)', - '_mp', '$(GHC_BUILD_FLAG_mp)', - '_mg', '$(GHC_BUILD_FLAG_mg)', - '_2s', '$(GHC_BUILD_FLAG_2s)', - '_1s', '$(GHC_BUILD_FLAG_1s)', - '_du', '$(GHC_BUILD_FLAG_du)', - '_a', '$(GHC_BUILD_FLAG_a)', - '_b', '$(GHC_BUILD_FLAG_b)', - '_c', '$(GHC_BUILD_FLAG_c)', - '_d', '$(GHC_BUILD_FLAG_d)', - '_e', '$(GHC_BUILD_FLAG_e)', - '_f', '$(GHC_BUILD_FLAG_f)', - '_g', '$(GHC_BUILD_FLAG_g)', - '_h', '$(GHC_BUILD_FLAG_h)', - '_i', '$(GHC_BUILD_FLAG_i)', - '_j', '$(GHC_BUILD_FLAG_j)', - '_k', '$(GHC_BUILD_FLAG_k)', - '_l', '$(GHC_BUILD_FLAG_l)', - '_m', '$(GHC_BUILD_FLAG_m)', - '_n', '$(GHC_BUILD_FLAG_n)', - '_o', '$(GHC_BUILD_FLAG_o)', - '_A', '$(GHC_BUILD_FLAG_A)', - '_B', '$(GHC_BUILD_FLAG_B)' ); - -%BuildDescr = ('', 'normal sequential', - '_p', 'profiling', - '_t', 'ticky-ticky profiling', -#OLD: '_u', 'unregisterized (using portable C only)', - '_mc', 'concurrent', - '_mr', 'profiled concurrent', - '_mt', 'ticky concurrent', - '_mp', 'parallel', - '_mg', 'GranSim', - '_2s', '2-space GC', - '_1s', '1-space GC', - '_du', 'dual-mode GC', - '_a', 'user way a', - '_b', 'user way b', - '_c', 'user way c', - '_d', 'user way d', - '_e', 'user way e', - '_f', 'user way f', - '_g', 'user way g', - '_h', 'user way h', - '_i', 'user way i', - '_j', 'user way j', - '_k', 'user way k', - '_l', 'user way l', - '_m', 'user way m', - '_n', 'user way n', - '_o', 'user way o', - '_A', 'user way A', - '_B', 'user way B' ); +%BuildDescr = (# system ways begin + '', 'Normal Sequential', + '_p', "Profiling", + '_t', "Ticky-ticky Profiling", + '_u', "Unregisterised", + '_mp', "Parallel", + '_mg', "Gransim", + # system ways end + '_a', "$WAY_a_NAME", + '_b', "$WAY_b_NAME", + '_c', "$WAY_c_NAME", + '_d', "$WAY_d_NAME", + '_e', "$WAY_e_NAME", + '_f', "$WAY_f_NAME", + '_g', "$WAY_g_NAME", + '_h', "$WAY_h_NAME", + '_i', "$WAY_i_NAME", + '_j', "$WAY_j_NAME", + '_k', "$WAY_k_NAME", + '_l', "$WAY_l_NAME", + '_m', "$WAY_m_NAME", + '_n', "$WAY_n_NAME", + '_o', "$WAY_o_NAME", + '_A', "$WAY_A_NAME", + '_B', "$WAY_B_NAME" ); # these are options that are "fed back" through the option processing loop -%UserSetupOpts = ('_a', '$(GHC_BUILD_OPTS_a)', - '_b', '$(GHC_BUILD_OPTS_b)', - '_c', '$(GHC_BUILD_OPTS_c)', - '_d', '$(GHC_BUILD_OPTS_d)', - '_e', '$(GHC_BUILD_OPTS_e)', - '_f', '$(GHC_BUILD_OPTS_f)', - '_g', '$(GHC_BUILD_OPTS_g)', - '_h', '$(GHC_BUILD_OPTS_h)', - '_i', '$(GHC_BUILD_OPTS_i)', - '_j', '$(GHC_BUILD_OPTS_j)', - '_k', '$(GHC_BUILD_OPTS_k)', - '_l', '$(GHC_BUILD_OPTS_l)', - '_m', '$(GHC_BUILD_OPTS_m)', - '_n', '$(GHC_BUILD_OPTS_n)', - '_o', '$(GHC_BUILD_OPTS_o)', - '_A', '$(GHC_BUILD_OPTS_A)', - '_B', '$(GHC_BUILD_OPTS_B)', - - # the GC ones don't have any "fed back" options - '_2s', '', - '_1s', '', - '_du', '' ); - -# per-build code fragments which are eval'd -%EvaldSetupOpts = ('', '', # this one must *not* be set! - - # profiled sequential - '_p', 'push(@HsC_flags, \'-fscc-profiling\'); - push(@CcBoth_flags, \'-DPROFILING\');', - - #and maybe ... - #push(@CcBoth_flags, '-DPROFILING_DETAIL_COUNTS'); - - # ticky-ticky sequential - '_t', 'push(@HsC_flags, \'-fticky-ticky\'); - push(@CcBoth_flags, \'-DTICKY_TICKY\');', - -#OLD: # unregisterized (ToDo????) -# '_u', '', - - # concurrent - '_mc', '$StkChkByPageFaultOK = 0; - push(@HsC_flags, \'-fconcurrent\'); - push(@HsCpp_flags,\'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\'); - push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\');', - - # profiled concurrent - '_mr', '$StkChkByPageFaultOK = 0; - push(@HsC_flags, \'-fconcurrent\', \'-fscc-profiling\'); - push(@HsCpp_flags,\'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\'); - push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DPROFILING\');', - - # ticky-ticky concurrent - '_mt', '$StkChkByPageFaultOK = 0; - push(@HsC_flags, \'-fconcurrent\', \'-fticky-ticky\'); - push(@HsCpp_flags,\'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\'); - push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DTICKY_TICKY\');', - - # parallel - '_mp', '$StkChkByPageFaultOK = 0; - push(@HsC_flags, \'-fconcurrent\'); - push(@HsCpp_flags,\'-D__PARALLEL_HASKELL__\', \'-DPAR\'); - push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DPAR\');', - - # GranSim - '_mg', '$StkChkByPageFaultOK = 0; - push(@HsC_flags, \'-fconcurrent\', \'-fgransim\'); - push(@HsCpp_flags,\'-D__GRANSIM__\', \'-DGRAN\'); - push(@Cpp_define, \'-D__CONCURRENT_HASKELL__\', \'-DCONCURRENT\', \'-DGRAN\');', - - '_2s', 'push (@CcBoth_flags, \'-DGC2s\');', - '_1s', 'push (@CcBoth_flags, \'-DGC1s\');', - '_du', 'push (@CcBoth_flags, \'-DGCdu\');', - - '_a', '', # these user-way guys should not be set! - '_b', '', - '_c', '', - '_d', '', - '_e', '', - '_f', '', - '_g', '', - '_h', '', - '_i', '', - '_j', '', - '_k', '', - '_l', '', - '_m', '', - '_n', '', - '_o', '', - '_A', '', - '_B', '' ); +# +%SetupOpts = + ( + '_a', "$WAY_a_REAL_OPTS", + '_b', "$WAY_b_REAL_OPTS", + '_c', "$WAY_c_REAL_OPTS", + '_d', "$WAY_d_REAL_OPTS", + '_e', "$WAY_e_REAL_OPTS", + '_f', "$WAY_f_REAL_OPTS", + '_g', "$WAY_g_REAL_OPTS", + '_h', "$WAY_h_REAL_OPTS", + '_i', "$WAY_i_REAL_OPTS", + '_j', "$WAY_j_REAL_OPTS", + '_k', "$WAY_k_REAL_OPTS", + '_l', "$WAY_l_REAL_OPTS", + '_m', "$WAY_m_REAL_OPTS", + '_n', "$WAY_n_REAL_OPTS", + '_o', "$WAY_o_REAL_OPTS", + '_A', "$WAY_A_REAL_OPTS", + '_B', "$WAY_B_REAL_OPTS", + + # system ways + '_p', "-fscc-profiling -DPROFILING -optc-DPROFILING", + '_t', "-fticky-ticky -DTICKY_TICKY -optc-DTICKY_TICKY", + '_u', "-optc-DNO_REGS -optc-DUSE_MINIINTERPRETER -fno-asm-mangling -funregisterised", + '_mp', "-fstack-check -fparallel -D__PARALLEL_HASKELL__ -optc-DPAR", + '_mg', "-fstack-check -fconcurrent -fgransim -D__GRANSIM__ -D__CONCURRENT_HASKELL__ -optc-DCONCURRENT -optc-DGRAN"); + +# where to look for interface files (system hi's, i.e., prelude and syslibs) +@SysImport_dir = ( $INSTALLING ) + ? ( "$InstLibDirGhc/imports/std" ) + : ( "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/std" ); + +# We need to look in ghc/ and glaExts/ when searching for implicitly needed .hi files, but +# we should really *not* look there for explicitly imported modules. + +$Haskell1Version = 5; # i.e., Haskell 1.4 +@Cpp_define = (); + +# Cpp symbols defined when we're processing Haskell source. + +@HsSourceCppOpts = + ( "-D__HASKELL1__=$Haskell1Version" + , "-D__GLASGOW_HASKELL__=$ProjectVersionInt" + , "-D__HASKELL98__" + , "-D__CONCURRENT_HASKELL__" + ); + + +@SysLibrary_dir = ( ( $INSTALLING ) #-syslib things supplied by the system + ? $InstLibDirGhc + : ( "$TopPwd/$CURRENT_DIR/$GHC_RUNTIME_DIR" + , "$TopPwd/$CURRENT_DIR/$GHC_RUNTIME_DIR/gmp" + , "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/std" + , "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/std/cbits" + ) + ); + +$TopClosureFile # defaults to 1.2 one; will be mangled later + = ''; +# ( $INSTALLING) ? "$InstLibDirGhc/TopClosureXXXX.o" +# : "$TopPwd/$CURRENT_DIR/$GHC_RUNTIME_DIR/main/TopClosureXXXX.o"; + +# make depend for Haskell +$MkDependHS + = ( $INSTALLING ) ? "$InstLibExecDirGhc/mkdependHS" + : "$TopPwd/$CURRENT_DIR/$GHC_UTILS_DIR/mkdependHS/mkdependHS"; +# Fill in later +@MkDependHS_flags = (); + +# do_link flag should not be reset while rescanning the cmd-line. +$Do_lnkr = 1; +$Specific_output_dir = ''; # set by -odir +$Specific_output_file = ''; # set by -o ; "-" for stdout \end{code} -Import/include directories (\tr{-I} options) are sufficiently weird to -require special handling. +Function to initialise the per-compilation-unit globals that +are used to guide and control the invocation of the different phases. + +\begin{code} +sub initDriverGlobals { + +# reset the following options: +# RTS flags to use while compiling +@HsC_rts_flags = (); +@HsC_flags = (); +@HsC_antiflags = (); +\end{code} + +The optimisations/etc to be done by the compiler are {\em normally} +expressed with a \tr{-O} (or \tr{-O2}) flag, or by its absence. + \begin{code} +$OptLevel = 0; # no -O == 0; -O == 1; -O2 == 2; -Ofile == 3 +$MinusO2ForC = 0; # set to 1 if -O2 should be given to C compiler +$StolenX86Regs = 4; # **HACK*** of the very worst sort +$CoreLint = ''; +$USPLint = ''; +$StgLint = ''; + @Import_dir = ('.'); #-i things @Include_dir = ('.'); #-I things; other default(s) stuck on AFTER option processing -@SysImport_dir = ( $(INSTALLING) ) - ? ( "$InstDataDirGhc/imports" ) - : ( "$TopPwd/$(CURRENT_DIR)/$(GHC_LIBSRC)/prelude" - , "$TopPwd/$(CURRENT_DIR)/$(GHC_LIBSRC)/required" - , "$TopPwd/$(CURRENT_DIR)/$(GHC_LIBSRC)/concurrent" ); - -$GhcVersionInfo = int ($(PROJECTVERSION) * 100); -$Haskell1Version = 3; # i.e., Haskell 1.3 -@Cpp_define = (); - @UserLibrary_dir= (); #-L things;... @UserLibrary = (); #-l things asked for by the user -@SysLibrary_dir = ( ( $(INSTALLING) ) #-syslib things supplied by the system - ? $InstLibDirGhc - : ( "$TopPwd/$(CURRENT_DIR)/$(GHC_RUNTIMESRC)" - , "$TopPwd/$(CURRENT_DIR)/$(GHC_RUNTIMESRC)/gmp" - , "$TopPwd/$(CURRENT_DIR)/$(GHC_LIBSRC)" - , "$TopPwd/$(CURRENT_DIR)/$(GHC_LIBSRC)/cbits" - ) - ); @SysLibrary = (); # will be built up as we go along - -$TopClosureFile # defaults to 1.2 one; will be mangled later - = ( $(INSTALLING) ) ? "$InstLibDirGhc/TopClosureXXXX.o" - : "$TopPwd/$(CURRENT_DIR)/$(GHC_RUNTIMESRC)/main/TopClosureXXXX.o"; \end{code} We are given a list of files with various presumably-known suffixes @@ -440,18 +443,29 @@ start with. Linking is weird and kept track of separately. Here are the initial defaults applied to all files: \begin{code} -$Cpp_flag_set = 0; # (hack) -$Only_preprocess_C = 0; # pretty hackish +$Cpp_flag_set = 0; # (hack) +$Only_preprocess_C = 0; # pretty hackish +$Only_preprocess_hc = 0; # ditto +$Only_generate_deps = 0; # "" +$Only_generate_dll = 0; $PostprocessCcOutput = 0; +# Win32 only: +# static = 0 => produce code for DLLs (when compiling & linking.) +$Static = 1; +$Static = 0 if ($EnableWin32DLLs eq 'YES'); + # native code-gen or via C? -$HaveNativeCodeGen = $(GHC_WITH_NATIVE_CODEGEN); +$HaveNativeCodeGen = $GhcWithNativeCodeGen; $HscOut = '-C='; # '-C=' ==> .hc output; '-S=' ==> .s output; '-N=' ==> neither $HscOut = '-S=' - if $HaveNativeCodeGen && $TargetPlatform =~ /^(alpha|sparc)-/; #ToDo: add |i386 ! -$ProduceHi = '-hifile='; -$HiOnStdout = 0; -$HiDiff_flag = ''; + if ($HaveNativeCodeGen ne 'YES') && $TargetPlatform =~ /^(alpha)-/; +# TEMP: disable x86 & Sparc if $HaveNativeCodeGen && $TargetPlatform =~ /^(i386|alpha|sparc)-/; +$ProduceHi = '-hifile='; +$HiOnStdout = 0; +$HiWith = ''; +$HiDiff_flag = ''; +$Keep_HiDiffs = 0; $CollectingGCstats = 0; $CollectGhcTimings = 0; @@ -460,41 +474,55 @@ $PROFing = ''; # set to p or e if profiling $PROFgroup = ''; # set to group if an explicit -Ggroup specified $PROFauto = ''; # set to relevant hsc flag if -auto or -auto-all $PROFcaf = ''; # set to relevant hsc flag if -caf-all +$PROFdict = ''; # set to relevant hsc flag if -auto-dicts $PROFignore_scc = ''; # set to relevant parser flag if explicit sccs ignored $UNPROFscc_auto = ''; # set to relevant hsc flag if forcing auto sccs without profiling $TICKYing = ''; # set to t if compiling for ticky-ticky profiling $PARing = ''; # set to p if compiling for PAR -$CONCURing = ''; # set to c if compiling for CONCURRENT $GRANing = ''; # set to g if compiling for GRAN -$StkChkByPageFaultOK = 1; # may be set to 0 (false) for some builds -$Specific_output_dir = ''; # set by -odir -$Specific_output_file = ''; # set by -o ; "-" for stdout +$UNREGing = ($GhcWithRegisterised eq 'YES') ? '' : 'u'; $Specific_hi_file = ''; # set by -ohi ; "-" for stdout $Specific_dump_file = ''; # set by -odump ; "-" for stdout $Using_dump_file = 0; $Isuffix = ''; $Osuffix = ''; # default: use the normal suffix for that kind of output $HiSuffix = 'hi'; -$SysHiSuffix= 'hi'; +$HiSuffix_prelude = ''; +$CompilingPrelude=0; $Do_recomp_chkr = 0; # don't use the recompilatio checker unless asked $Do_cc = -1; # a MAGIC indeterminate value; will be set to 1 or 0. $Do_as = 1; -$Do_lnkr = 1; + $Keep_hc_file_too = 0; $Keep_s_file_too = 0; $UseGhcInternals = 0; # if 1, may use GHC* modules $SplitObjFiles = 0; +$DoAsmMangling = 1; # on by default, off by -fno-asm-mangling $NoOfSplitFiles = 0; $Dump_parser_output = 0; $Dump_raw_asm = 0; $Dump_asm_splitting_info = 0; $NoImplicitPrelude = 0; +# 1 => don't tell the linker to hoist in PrelMain.Main, as an +# external main is provided instead. +$NoHaskellMain=0; -# and the list of files +} # end of initDriverGlobals (Sigh) + +# we split the argv passed to the driver into three: + +# the list of files @Input_file = (); # and files to be linked... @Link_file = (); + +# and whatever else +@Cmd_opts = (); + +# cmd line options prefixing the unit we're compiling +@File_options = (); + \end{code} We inject consistency-checking information into \tr{.hc} files (both @@ -505,14 +533,14 @@ linking.) The checking is done by introducing/munging \tr{what(1)}-style strings. Anyway, here are the relevant global variables and their defaults: \begin{code} -$LinkChk = 1; # set to 0 if the link check should *not* be done +$LinkChk = 0; # set to 0 if the link check should *not* be done # major & minor version numbers; major numbers must always agree; # minor disagreements yield a warning. -$HsC_major_version = 30; -$HsC_minor_version = 0; -$Cc_major_version = 35; -$Cc_minor_version = 0; +$HsC_major_version = $HscMajorVersion; +$HsC_minor_version = $HscMinorVersion; +$Cc_major_version = $CcMajorVersion; +$Cc_minor_version = $CcMinorVersion; # options: these must always agree $HsC_consist_options = ''; # we record, in this order: @@ -530,2212 +558,2759 @@ $Cc_consist_options = ''; # we record, in this order: Now slurp through the arguments. \begin{code} -#---------- user defined prelude --------------------------------------- +&initDriverGlobals(); +&splitCmdLine(@ARGV); +# Run through the cmd-line first time. +&processArgs(@Cmd_opts); + +# Check to see if driver is only in the business +# to generate dependencies +if ( $Status == 0 && $Only_generate_deps ) { + + push (@MkDependHS_flags, "-o$Osuffix") if $Osuffix; + push (@MkDependHS_flags, "-s$BuildTag") if $BuildTag; + # They're not (currently) needed, but we need to quote any -#include options + foreach (@Cmd_opts) { + s/-#include.*$/'$&'/g; + }; + local($to_do) = "$MkDependHS @MkDependHS_flags @HsSourceCppOpts -- @Cmd_opts -- @Input_file" ; + &run_something($to_do, 'Haskell dependencies'); + exit $Status; +} -if (grep(/^-user-prelude$/, @ARGV)) { +# ..or just to construct a (Haskell) DLL. +if ( $Status == 0 && $Only_generate_dll && $EnableWin32DLLs ) { - # If ARGV contains -user-prelude we are compiling a piece of - # prelude for the user, probably with additional specialise pragmas + &createWin32DLL(); + exit $Status; +} - # We strip out the -O -f and -user-prelude flags provided on - # the command line and add the ones used to compile the prelude - # ToDo: get these options from a common definition in mkworld +# if there are several input files, +# we don't allow \tr{-o } or \tr{-ohi } options... +# (except if linking, of course) - # We also enable any options forced through with -user-prelude-force +if ($#Input_file > 0 && ( ! $Do_lnkr )) { + if ( ($Specific_output_file ne '' && $Specific_output_file ne '-') + || ($Specific_hi_file ne '' && $Specific_hi_file ne '-') ) { + print STDERR "$Pgm: You can't use -o or -ohi options if you have multiple input files.\n"; + print STDERR "\tPerhaps the -odir option will do what you want.\n"; + $Status++; + } +} - # Hey, Check out this grep statement ;-) (PS) +# check for various pathological -o and -odir combinations... +if ($Specific_output_dir ne '' && $Specific_output_file ne '') { + if ($Specific_output_file eq '-') { + print STDERR "$Pgm: can't set output directory with -ohi AND have output to stdout\n"; + $Status++; + } else { # amalgamate... + $Specific_output_file = "$Specific_output_dir/$Specific_output_file"; + # ToDo: check we haven't got a junk name now... + $Specific_output_dir = ''; # reset + } +} - @ARGV = grep((!/^-O/ && !/^-f/ && !/^-user-prelude$/) || s/^-user-prelude-force//, - @ARGV); +# crash and burn if there were errors +if ( $Status > 0 ) { + print STDERR $ShortUsage; + exit $Status; +} +\end{code} - unshift(@ARGV, - '-fcompiling-ghc-internals=???', # ToDo!!!! - '-O', - '-fshow-pragma-name-errs', - '-fshow-import-specs', - '-fglasgow-exts', - '-genSPECS', - '-DUSE_FOLDR_BUILD', - '-dcore-lint'); +%************************************************************************ +%* * +\section[Driver-post-argv-mangling]{Setup after reading options} +%* * +%************************************************************************ - print STDERR "ghc: -user-prelude options:\n", "@ARGV", "\n"; -} +%************************************************************************ +%* * +\subsection{Set up for optimisation level (\tr{-O} or whatever)} +%* * +%************************************************************************ -# can't use getopt(s); what we want is too complicated -arg: while($_ = $ARGV[0]) { - shift(@ARGV); +We come now to the default ``wads of options'' that are turned on by +\tr{-O0} (do min optimisation), \tr{-O} (ordinary optimisation), +\tr{-O2} (aggressive optimisation), or no O-ish flag (compile speed is +more important). - #---------- help ------------------------------------------------------- - if (/^-\?$/ || /^-help$/) { print $LongUsage; exit $Status; } +The user can also specify his/her own list of options in a file; in +that case, the work is already done (see stuff about @minusO3@, +earlier...). - #---------- verbosity and such ----------------------------------------- - /^-v$/ && do { $Verbose = '-v'; $Time = 'time'; next arg; }; +GHC allows very precise control of what happens during a compilation. +Core-to-Core and STG-to-STG passes can be run in any order, as many +times as you like. Individual transformations can be turned on or +disabled. - #---------- what phases are to be run ---------------------------------- - /^-recomp/ && do { $Do_recomp_chkr = 1; next arg; }; +Sadly, however, there are some interdependencies \& Things You Must +Not Do. Here is the list. - /^-cpp$/ && do { $Cpp_flag_set = 1; next arg; }; - # change the global default: - # we won't run cat; we'll run the real thing - - /^-C$/ && do { $Do_cc = 0; $Do_as = 0; $Do_lnkr = 0; $HscOut = '-C='; - next arg; }; - # stop after generating C - - /^-noC$/ && do { $HscOut = '-N='; $ProduceHi = '-nohifile='; - $Do_cc = 0; $Do_as = 0; $Do_lnkr = 0; - next arg; }; - # leave out actual C generation (debugging) [also turns off interface gen] +CORE-TO-CORE PASSES: +\begin{description} +\item[\tr{-fspecialise}:] +The specialiser must have dependency-analysed input; but if you run +the simplifier to do this, you must not let it toss away unused +bindings! (The typechecker conveys some specialisation info via +``unused'' bindings...) - /^-hi$/ && do { $HiOnStdout = 1; $ProduceHi = '-hifile='; next arg; }; - # _do_ generate an interface; usually used as: -noC -hi +\item[\tr{-ffloat-inwards}:] +Floating inwards should be done before strictness analysis, because +the latter will give better results. - /^-nohi$/ && do { $ProduceHi = '-nohifile='; next arg; }; - # don't generate an interface (even if generating C) +\item[\tr{-fstatic-args}:] +The static-arguments-transformation pass {\em must} have the +simplifier run right after it. - /^-hi-diffs$/ && do { $HiDiff_flag = 'normal'; next arg; }; - /^-hi-diffs-with-usages$/ && do { $HiDiff_flag = 'usages'; next arg; }; - /^-no-hi-diffs$/ && do { $HiDiff_flag = ''; next arg; }; - # show/disable diffs if the interface file changes +\item[\tr{-fcalc-inlinings[12]}:] +Not required, but there may be slight gains by re-simplifying after +this is done. (You could then \tr{-fcalc-inlinings} again, just for +fun.) - /^-E$/ && do { push(@CcBoth_flags, '-E'); - $Only_preprocess_C = 1; - $Do_as = 0; $Do_lnkr = 0; next arg; }; - # stop after preprocessing C +\item[\tr{-ffull-laziness}:] +The (outwards-)let-floater should be the {\em last} Core-to-Core pass +that's run. (Um, well, howzabout the simplifier just once more...) +\end{description} - /^-S$/ && do { $Do_as = 0; $Do_lnkr = 0; next arg; }; - # stop after generating assembler - - /^-c$/ && do { $Do_lnkr = 0; next arg; }; - # stop after generating .o files - - /^-link-chk$/ && do { $LinkChk = 1; next arg; }; - /^-no-link-chk$/ && do { $LinkChk = 0; next arg; }; - # don't do consistency-checking after a link +STG-TO-STG PASSES: +\begin{description} +\item[\tr{-fupdate-analysis}:] +It really really wants to be the last STG-to-STG pass that is run. +\end{description} - /^-tmpdir$/ && do { $Tmp_prefix = &grab_arg_arg('-tmpdir', ''); - $Tmp_prefix = "$Tmp_prefix/ghc$$"; - $ENV{'TMPDIR'} = $Tmp_prefix; # for those who use it... - next arg; }; - # use an alternate directory for temp files +\begin{code} - #---------- redirect output -------------------------------------------- +sub setupOptimiseFlags { - # -o ; applies to the last phase, whatever it is - # "-o -" sends it to stdout - # if has a directory component, that dir must already exist + # this pass-ordering sequence was agreed by Simon and Andr\'e + # (WDP 94/07, 94/11). - /^-odir$/ && do { $Specific_output_dir = &grab_arg_arg('-odir', ''); - if (! -d $Specific_output_dir) { - print STDERR "$Pgm: -odir: no such directory: $Specific_output_dir\n"; - $Status++; - } - next arg; }; + @HsC_minusNoO_flags + = ( + '-fsimplify', + '[', + '-finline-phase2', + $Oopt_MaxSimplifierIterations, + ']', - /^-o$/ && do { $Specific_output_file = &grab_arg_arg('-o', ''); - if ($Specific_output_file ne '-' - && $Specific_output_file =~ /(.*)\/[^\/]*$/) { - local($dir_part) = $1; - if (! -d $dir_part) { - print STDERR "$Pgm: no such directory: $dir_part\n"; - $Status++; - } - } - next arg; }; + $Oopt_AddAutoSccs, + $Oopt_FinalStgProfilingMassage + ); - # NB: -isuf not documented yet (because it doesn't work yet) - /^-isuf$/ && do { $Isuffix = &grab_arg_arg('-isuf', ''); - if ($Isuffix =~ /\./ ) { - print STDERR "$Pgm: -isuf suffix shouldn't contain a .\n"; - $Status++; - } - next arg; }; + @HsC_minusO_flags # NOTE: used for *both* -O and -O2 (some conditional bits) + = ( + '-ffoldr-build-on', - /^-osuf$/ && do { $Osuffix = &grab_arg_arg('-osuf', ''); - if ($Osuffix =~ /\./ ) { - print STDERR "$Pgm: -osuf suffix shouldn't contain a .\n"; - $Status++; - } - next arg; }; + '-fdo-eta-reduction', + '-fdo-case-elim', + '-fdo-lambda-eta-expansion', + '-fcase-of-case', + '-fcase-merge', + '-flet-to-case', + $Oopt_PedanticBottoms, - # -ohi ; send the interface to ; "-ohi -" to send to stdout - /^-ohi$/ && do { $Specific_hi_file = &grab_arg_arg('-ohi', ''); - if ($Specific_hi_file ne '-' - && $Specific_hi_file =~ /(.*)\/[^\/]*$/) { - local($dir_part) = $1; - if (! -d $dir_part) { - print STDERR "$Pgm: no such directory: $dir_part\n"; - $Status++; - } - } - next arg; }; + # initial simplify: mk specialiser happy: minimum effort please - /^-hisuf$/ && do { $HiSuffix = &grab_arg_arg('-hisuf', ''); - if ($HiSuffix =~ /\./ ) { - print STDERR "$Pgm: -hisuf suffix shouldn't contain a .\n"; - $Status++; - } - next arg; }; - /^-hisuf-prelude$/ && do { # as esoteric as they come... - $SysHiSuffix = &grab_arg_arg('-hisuf-prelude', ''); - if ($SysHiSuffix =~ /\./ ) { - print STDERR "$Pgm: -hisuf-prelude suffix shouldn't contain a .\n"; - $Status++; - } - next arg; }; + '-fsimplify', + '[', + '-finline-phase1', # Don't inline rule Ids till specialisation has bitten - /^-odump$/ && do { $Specific_dump_file = &grab_arg_arg('-odump', ''); - if ($Specific_dump_file =~ /(.*)\/[^\/]*$/) { - local($dir_part) = $1; - if (! -d $dir_part) { - print STDERR "$Pgm: no such directory: $dir_part\n"; - $Status++; - } - } - next arg; }; +# APR 99: the stuff in this comment is now +# handled by -finline-phase1 +# +# I don't understand why we want -fessential-unfoldings-only here +# If we have it, the following nasty thing happens: +# f = E +# g* = f +# ...g... +# where "*" means exported. +# In the essential-unfoldings pass we still substitute f for g +# but we don't substitute E for f first. So we get +# f = E +# g* = f +# ...f... +# The g=f will get reverse-substituted later, but it's untidy. --SLPJ +# +# SDM: Here's why it's necessary. +# +# If we unfold in the first pass before the specialiser is run +# we miss opportunities for specialisation because eg. wrappers +# have been inlined for specialisable functions. +# +# This shows up in PrelArr.lhs - the specialised instance for newArray +# calls the generic rangeSize, because rangeSize is strict and is +# replaced by its wrapper by the simplifier. +# '-fessential-unfoldings-only', +# '-fsimpl-uf-use-threshold0', - #-------------- scc & Profiling Stuff ---------------------------------- + '-fmax-simplifier-iterations2', + ']', - /^-prof$/ && do { $PROFing = 'p'; next arg; }; # profiling -- details later! + ($Oopt_DoSpecialise) ? ( $Oopt_DoSpecialise, ) : (), - /^-auto/ && do { - # generate auto SCCs on top level bindings - # -auto-all = all top level bindings - # -auto = only top level exported bindings - $PROFauto = ( /-all/ ) - ? '-fauto-sccs-on-all-toplevs' - : '-fauto-sccs-on-exported-toplevs'; - next arg; }; + $Oopt_UsageSPInf, # infer usage information here in case we need it later. + # (add more of these where you need them --KSW 1999-04) - /^-caf-all/ && do { # generate individual CAF SCC annotations - $PROFcaf = '-fauto-sccs-on-individual-cafs'; - next arg; }; + '-fsimplify', + '[', + $Oopt_MaxSimplifierIterations, - /^-ignore-scc$/ && do { - # forces ignore of scc annotations even if profiling - $PROFignore_scc = '-W'; - next arg; }; + # Still don't inline transformation rule Ids, to give the + # rules a good chance to fire + '-finline-phase1', + ']', - /^-G(.*)$/ && do { push(@HsC_flags, "-G=$1"); # set group for cost centres - next arg; }; + '-ffull-laziness', - /^-unprof-scc-auto/ && do { - # generate auto SCCs on top level bindings when not profiling - # used to measure optimisation effects of presence of sccs - $UNPROFscc_auto = ( /-all/ ) - ? '-fauto-sccs-on-all-toplevs' - : '-fauto-sccs-on-exported-toplevs'; - next arg; }; + '-ffloat-inwards', - #--------- ticky/concurrent/parallel ----------------------------------- - # we sort out the details a bit later on + '-fsimplify', + '[', + '-finline-phase2', + $Oopt_MaxSimplifierIterations, + ']', - /^-concurrent$/ && do { $CONCURing = 'c'; next arg; }; # concurrent Haskell - /^-gransim$/ && do { $GRANing = 'g'; next arg; }; # GranSim - /^-ticky$/ && do { $TICKYing = 't'; next arg; }; # ticky-ticky - /^-parallel$/ && do { $PARing = 'p'; next arg; } ; # parallel Haskell + '-fstrictness', + # '-fcpr-analyse', + '-fworker-wrapper', - #-------------- "user ways" -------------------------------------------- + '-fsimplify', + '[', + $Oopt_MaxSimplifierIterations, + # No -finline-phase: allow all Ids to be inlined now + ']', - (/^-user-setup-([a-oA-Z])$/ - || /^$(GHC_BUILD_FLAG_a)$/ - || /^$(GHC_BUILD_FLAG_b)$/ - || /^$(GHC_BUILD_FLAG_c)$/ - || /^$(GHC_BUILD_FLAG_d)$/ - || /^$(GHC_BUILD_FLAG_e)$/ - || /^$(GHC_BUILD_FLAG_f)$/ - || /^$(GHC_BUILD_FLAG_g)$/ - || /^$(GHC_BUILD_FLAG_h)$/ - || /^$(GHC_BUILD_FLAG_i)$/ - || /^$(GHC_BUILD_FLAG_j)$/ - || /^$(GHC_BUILD_FLAG_k)$/ - || /^$(GHC_BUILD_FLAG_l)$/ - || /^$(GHC_BUILD_FLAG_m)$/ - || /^$(GHC_BUILD_FLAG_n)$/ - || /^$(GHC_BUILD_FLAG_o)$/ - || /^$(GHC_BUILD_FLAG_A)$/ - || /^$(GHC_BUILD_FLAG_B)$/ - - || /^$(GHC_BUILD_FLAG_2s)$/ # GC ones... - || /^$(GHC_BUILD_FLAG_1s)$/ - || /^$(GHC_BUILD_FLAG_du)$/ - ) && do { - /^-user-setup-([a-oA-Z])$/ && do { $BuildTag = "_$1"; }; + '-ffloat-inwards', - /^$(GHC_BUILD_FLAG_a)$/ && do { $BuildTag = '_a'; }; - /^$(GHC_BUILD_FLAG_b)$/ && do { $BuildTag = '_b'; }; - /^$(GHC_BUILD_FLAG_c)$/ && do { $BuildTag = '_c'; }; - /^$(GHC_BUILD_FLAG_d)$/ && do { $BuildTag = '_d'; }; - /^$(GHC_BUILD_FLAG_e)$/ && do { $BuildTag = '_e'; }; - /^$(GHC_BUILD_FLAG_f)$/ && do { $BuildTag = '_f'; }; - /^$(GHC_BUILD_FLAG_g)$/ && do { $BuildTag = '_g'; }; - /^$(GHC_BUILD_FLAG_h)$/ && do { $BuildTag = '_h'; }; - /^$(GHC_BUILD_FLAG_i)$/ && do { $BuildTag = '_i'; }; - /^$(GHC_BUILD_FLAG_j)$/ && do { $BuildTag = '_j'; }; - /^$(GHC_BUILD_FLAG_k)$/ && do { $BuildTag = '_k'; }; - /^$(GHC_BUILD_FLAG_l)$/ && do { $BuildTag = '_l'; }; - /^$(GHC_BUILD_FLAG_m)$/ && do { $BuildTag = '_m'; }; - /^$(GHC_BUILD_FLAG_n)$/ && do { $BuildTag = '_n'; }; - /^$(GHC_BUILD_FLAG_o)$/ && do { $BuildTag = '_o'; }; - /^$(GHC_BUILD_FLAG_A)$/ && do { $BuildTag = '_A'; }; - /^$(GHC_BUILD_FLAG_B)$/ && do { $BuildTag = '_B'; }; - - /^$(GHC_BUILD_FLAG_2s)$/ && do { $BuildTag = '_2s'; }; - /^$(GHC_BUILD_FLAG_1s)$/ && do { $BuildTag = '_1s'; }; - /^$(GHC_BUILD_FLAG_du)$/ && do { $BuildTag = '_du'; }; +# Case-liberation for -O2. This should be after +# strictness analysis and the simplification which follows it. - local($stuff) = $UserSetupOpts{$BuildTag}; - local(@opts) = split(/\s+/, $stuff); - - # feed relevant ops into the arg-processing loop (if any) - unshift(@ARGV, @opts) if $#opts >= 0; +# ( ($OptLevel != 2) +# ? '' +# : "-fliberate-case -fsimplify [ $Oopt_FB_Support -ffloat-lets-exposing-whnf -ffloat-primops-ok -fcase-of-case -fdo-case-elim -fcase-merge -fdo-lambda-eta-expansion -freuse-con -flet-to-case $Oopt_PedanticBottoms $Oopt_MaxSimplifierIterations $Oopt_ShowSimplifierProgress ]" ), - next arg; }; +# Final clean-up simplification: - #---------- set search paths for libraries and things ------------------ + '-fsimplify', + '[', + $Oopt_MaxSimplifierIterations, + ']', - # we do -i just like HBC (-i clears the list; -i - # prepends the items to the list); -I is for including C .h files. + # '-fstatic-args', - /^-i$/ && do { @Import_dir = (); # import path cleared! - @SysImport_dir = (); - print STDERR "WARNING: import paths cleared by `-i'\n"; - next arg; }; + # stg2stg passes +# '-flambda-lift', + $Oopt_FinalStgProfilingMassage, + $Oopt_StgStats, - /^-i(.*)/ && do { local(@new_items) - = split( /:/, &grab_arg_arg('-i', $1)); - unshift(@Import_dir, @new_items); - next arg; }; + # flags for stg2stg + '-flet-no-escape', - /^-I(.*)/ && do { push(@Include_dir, &grab_arg_arg('-I', $1)); next arg; }; - /^-L(.*)/ && do { push(@UserLibrary_dir, &grab_arg_arg('-L', $1)); next arg; }; - /^-l(.*)/ && do { push(@UserLibrary,'-l'.&grab_arg_arg('-l', $1)); next arg; }; + # SPECIAL FLAGS for -O2 + ($OptLevel == 2) ? ( + '-fupdate-analysis', # virtually useless; relegated to -O2 + '-fsemi-tagging', + ) : (), + ); - /^-syslib(.*)/ && do { local($syslib) = &grab_arg_arg('-syslib',$1); - print STDERR "$Pgm: no such system library (-syslib): $syslib\n", - $Status++ unless $syslib =~ /^(hbc|ghc|posix|contrib)$/; +\end{code} - unshift(@SysImport_dir, - $(INSTALLING) - ? "$InstSysLibDir/$syslib/imports" - : "$TopPwd/hslibs/$syslib/src"); +Sort out what we're going to do about optimising. First, the @hsc@ +flags and regular @cc@ flags to worry about: +\begin{code} +if ( $OptLevel <= 0 ) { - if (! $(INSTALLING)) { - push(@SysLibrary_dir, - ("$TopPwd/hslibs/$syslib" - ,"$TopPwd/hslibs/$syslib/cbits")); - } + # for this level, we tell the parser -fignore-interface-pragmas + push(@HsC_flags, '-fignore-interface-pragmas'); + # and tell the compiler not to produce them + push(@HsC_flags, '-fomit-interface-pragmas'); - push(@SysLibrary, ("-lHS$syslib" - ,"-lHS${syslib}_cbits")); + &add_Hsc_flags( @HsC_minusNoO_flags ); + push(@CcBoth_flags, ($MinusO2ForC) ? '-O2' : '-O'); # not optional! - next arg; }; +} elsif ( $OptLevel == 1 || $OptLevel == 2 ) { - #======================================================================= - # various flags that we can harmlessly send to one program or another - # (we will later "reclaim" some of the compiler ones now sent to gcc) - #======================================================================= + &add_Hsc_flags( @HsC_minusO_flags ); + push(@CcBoth_flags, ($MinusO2ForC || $OptLevel == 2) ? '-O2' : '-O'); # not optional! + # -O? to GCC is not optional! -O2 probably isn't worth it generally, + # but it *is* useful in compiling the garbage collector. - #---------- this driver itself (ghc) ----------------------------------- - # these change what executable is run for each phase: - /^-pgmL(.*)$/ && do { $Unlit = $1; next arg; }; - /^-pgmP(.*)$/ && do { $HsCpp = $1; next arg; }; - /^-pgmC(.*)$/ && do { $HsC = $1; next arg; }; - /^-pgmcO?(.*)$/ && do { $CcRegd = $1; next arg; }; # the O? for back compat - /^-pgma(.*)$/ && do { $As = $1; next arg; }; - /^-pgml(.*)$/ && do { $Lnkr = $1; next arg; }; +} else { # -Ofile, then... - #---------- the get-anything-through opts (all pgms) ------------------- - # these allow arbitrary option-strings to go to any phase: - /^-optL(.*)$/ && do { push(@Unlit_flags, $1); next arg; }; - /^-optP(.*)$/ && do { push(@HsCpp_flags, $1); next arg; }; - /^-optCrts(.*)$/&& do { push(@HsC_rts_flags, $1); next arg; }; - /^-optC(.*)$/ && do { push(@HsC_flags, $1); next arg; }; - /^-optc(.*)$/ && do { push(@CcBoth_flags, $1); next arg; }; - /^-opta(.*)$/ && do { push(@As_flags, $1); next arg; }; - /^-optl(.*)$/ && do { push(@Ld_flags, $1); next arg; }; + &add_Hsc_flags( @HsC_minusO3_flags ); + push(@HsC_flags, $Oopt_FinalStgProfilingMassage) if $Oopt_FinalStgProfilingMassage; - #---------- Haskell C pre-processor (hscpp) ---------------------------- - /^-D(.*)/ && do { push(@HsCpp_flags, "'-D".&grab_arg_arg('-D',$1)."'"); next arg; }; - /^-U(.*)/ && do { push(@HsCpp_flags, "'-U".&grab_arg_arg('-U',$1)."'"); next arg; }; + push(@CcBoth_flags, ($MinusO2ForC) ? '-O2' : '-O'); # possibly to be elaborated... +} - /^-genSPECS/ && do { $Cpp_flag_set = 1; - $genSPECS_flag = $_; - next arg; }; +} # setupOptimiseFlags - #---------- post-Haskell "assembler"------------------------------------ - /^-ddump-raw-asm$/ && do { $Dump_raw_asm = 1; next arg; }; - /^-ddump-asm-splitting-info$/ && do { $Dump_asm_splitting_info = 1; next arg; }; +\end{code} - #---------- Haskell compiler (hsc) ------------------------------------- +%************************************************************************ +%* * +\subsection{Check for consistency, etc.} +%* * +%************************************************************************ - /^-keep-hc-files?-too$/ && do { $Keep_hc_file_too = 1; next arg; }; - /^-keep-s-files?-too$/ && do { $Keep_s_file_too = 1; next arg; }; +Sort out @$BuildTag@, @$PROFing@, @$PARing@, +@$GRANing@, @$TICKYing@, @UNREGing@: +\begin{code} +sub setupBuildFlags { + + + # PROFILING stuff after argv mangling: + if ( ! $PROFing ) { + # add -auto sccs even if not profiling ! + push(@HsC_flags, $UNPROFscc_auto) if $UNPROFscc_auto; + + } else { + push(@HsC_flags, $PROFauto) if $PROFauto; + push(@HsC_flags, $PROFcaf) if $PROFcaf; + push(@HsC_flags, $PROFdict) if $PROFdict; + + $Oopt_FinalStgProfilingMassage = '-fmassage-stg-for-profiling'; + + # Ignore user sccs when auto annotating, but warn when doing so. + $PROFignore_scc = '-W' if $PROFauto; + } + #if ( $BuildTag ne '' ) { + # local($b) = $BuildDescr{$BuildTag}; + # if ($PARing eq 'p') { print STDERR "$Pgm: Can't mix $b with -parallel.\n"; exit 1; } + # if ($GRANing eq 'g') { print STDERR "$Pgm: Can't mix $b with -gransim.\n"; exit 1; } + # if ($TICKYing eq 't') { print STDERR "$Pgm: Can't mix $b with -ticky.\n"; exit 1; } + + # # ok to have a user-way profiling build + # # eval the profiling opts ... but leave user-way BuildTag + # if ($PROFing eq 'p') { &processArgs(split(' ', $SetupOpts{'_p'})); } # eval($EvaldSetupOpts{'_p'}); } + + if ( $PROFing eq 'p' ) { + if ($PARing eq 'p') { print STDERR "$Pgm: Can't do profiling with -parallel.\n"; exit 1; } + if ($GRANing eq 'g') { print STDERR "$Pgm: Can't do profiling with -gransim.\n"; exit 1; } + if ($TICKYing eq 't') { print STDERR "$Pgm: Can't do profiling with -ticky.\n"; exit 1; } + $BuildTag = '_p' ; + + } elsif ( $PARing eq 'p' ) { + if ($GRANing eq 'g') { print STDERR "$Pgm: Can't mix -parallel with -gransim.\n"; exit 1; } + if ($TICKYing eq 't') { print STDERR "$Pgm: Can't mix -parallel with -ticky.\n"; exit 1; } + $BuildTag = '_mp'; + + if ( $Do_lnkr && ( ! $ENV{'PVM_ROOT'} || ! $ENV{'PVM_ARCH'} )) { + print STDERR "$Pgm: both your PVM_ROOT and PVM_ARCH environment variables must be set for linking under -parallel.\n"; + exit(1); + } + + } elsif ( $GRANing eq 'g' ) { + if ($TICKYing eq 't') { print STDERR "$Pgm: Can't mix -gransim with -ticky.\n"; exit 1; } + $BuildTag = '_mg'; + + } elsif ( $TICKYing eq 't' ) { + $BuildTag = '_t'; + + } elsif ( $UNREGing eq 'u' ) { + $BuildTag = '_u'; + } +\end{code} - /^-fhaskell-1\.3$/ && do { next arg; }; # a no-op right now +After the sanity checks, add flags to the necessary parts of the driver pipeline: - /^-fignore-interface-pragmas$/ && do { push(@HsC_flags, $_); next arg; }; +\begin{code} + if ( $BuildTag ne '' ) { # something other than normal sequential... - /^-fno-implicit-prelude$/ && do { $NoImplicitPrelude= 1; push(@HsC_flags, $_); next arg; }; + local($Tag) = "${BuildTag}"; + $Tag =~ s/_//; # move the underscore to the back - # ToDo: rename to -fcompiling-ghc-internals= - # NB: not documented - /^-fcompiling-ghc-internals(.*)/ && do { local($m) = &grab_arg_arg('-fcompiling-ghc-internals',$1); - push(@HsC_flags, "-fcompiling-ghc-internals=$m"); - next arg; }; + $HscOut = '-C='; # must go via C + &processArgs(split(' ', $SetupOpts{$BuildTag})); +# eval($EvaldSetupOpts{$BuildTag}); + } +\end{code} - # NB: not really put to use and not documented - /^-fusing-ghc-internals$/ && do { $UsingGhcInternals = 1; next arg; }; +Decide what the consistency-checking options are in force for this run: +\begin{code} - /^-user-prelude-force/ && do { # ignore if not -user-prelude - next arg; }; + $HsC_consist_options = "${BuildTag},${DEBUGging}"; + $Cc_consist_options = "${BuildTag},${DEBUGging}"; + + # + # Funny place to put it, but why not. + # + if ( $HiSuffix_prelude eq '' ) { + + if ($CompilingPrelude) { + $HiSuffix_prelude = "$HiSuffix" if $CompilingPrelude; + } else { + local($Tag) = "${BuildTag}"; + + $Tag =~ s/_//; + $Tag = "${Tag}_" if $Tag ne ''; + $HiSuffix_prelude="${Tag}hi"; + } + } +} # setupBuildFlags +\end{code} - /^-split-objs(.*)/ && do { - local($sname) = &grab_arg_arg('-split-objs', $1); - $sname =~ s/ //g; # no spaces +%************************************************************************ +%* * +\subsection{Add on machine-specific C-compiler flags} +%* * +%************************************************************************ - if ( $TargetPlatform !~ /^(alpha|hppa1\.1|i386|m68k|mips|powerpc|sparc)-/ ) { - $SplitObjFiles = 0; - print STDERR "WARNING: don't know how to split objects on this platform: $TargetPlatform\n`-split-objs' option ignored\n"; - } else { - $SplitObjFiles = 1; - $HscOut = '-C='; +Shove on magical machine-specific options. We use \tr{unshift} to +stick them on the {\em front} of the arrays, so that ``later'' +user-specified flags can clobber them (e.g., \tr{-U__STG_REV_TBLS__}). - push(@HsC_flags, "-fglobalise-toplev-names=$sname"); - push(@CcBoth_flags, '-DUSE_SPLIT_MARKERS'); +Note: a few ``always apply'' flags were set at the very beginning. - require('ghc-split.prl') - || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-split.prl!\n"); - } - next arg; }; +\begin{code} +sub setupMachOpts { + + if ($TargetPlatform =~ /^alpha-/) { + unshift(@CcBoth_flags, ('-static')); + + } elsif ($TargetPlatform =~ /^hppa/) { + unshift(@CcBoth_flags, ('-static')); + # + # We don't put in '-mlong-calls', because it's only + # needed for very big modules (sigh), and we don't want + # to hobble ourselves further on all the other modules + # (most of them). + # + # [Dated comment (gcc-2.6.x?), -mlong-calls is no longer + # a supported gcc HPPA flag] + unshift(@CcBoth_flags, ('-D_HPUX_SOURCE')); + # ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi! + # (very nice, but too bad the HP /usr/include files don't agree.) - /^-fglasgow-exts$/ - && do { push(@HsC_flags, $_); - push(@HsP_flags, '-N'); + } elsif ($TargetPlatform =~ /^i386-/) { + # -fno-defer-pop : basically the same game as for m68k + # + # -fomit-frame-pointer : *must* in .hc files; because we're stealing + # the fp (%ebp) for our register maps. + + unshift(@CcRegd_flags_hc, '-fno-defer-pop'); + unshift(@CcRegd_flags_hc, '-fomit-frame-pointer'); + unshift(@CcRegd_flags, "-DSTOLEN_X86_REGS=$StolenX86Regs"); + + unshift(@CcBoth_flags, ('-DDONT_WANT_WIN32_DLL_SUPPORT')) if ($Static); + + } elsif ($TargetPlatform =~ /^m68k-/) { + # -fno-defer-pop : for the .hc files, we want all the pushing/ + # popping of args to routines to be explicit; if we let things + # be deferred 'til after an STGJUMP, imminent death is certain! + # + # -fomit-frame-pointer : *don't* + # It's better to have a6 completely tied up being a frame pointer + # rather than let GCC pick random things to do with it. + # (If we want to steal a6, then we would try to do things + # as on iX86, where we *do* steal the frame pointer [%ebp].) + + unshift(@CcRegd_flags_hc, '-fno-defer-pop'); + unshift(@CcRegd_flags, '-fno-omit-frame-pointer'); + # maybe gives reg alloc a better time + # also: -fno-defer-pop is not sufficiently well-behaved without it -# push(@HsC_flags, '-fshow-import-specs'); + } elsif ($TargetPlatform =~ /^mips-/) { + unshift(@CcBoth_flags, ('-static')); - next arg; }; + } elsif ($TargetPlatform =~ /^powerpc-|^rs6000-/) { + unshift(@CcBoth_flags, ('-static')); # always easier to start with + unshift(@CcRegd_flags, ('-finhibit-size-directive')); # avoids traceback tables + } elsif ($TargetPlatform =~ /^sparc-/) { + } +} # end of setupMachOpts +\end{code} - /^-fspeciali[sz]e-unboxed$/ - && do { $Oopt_DoSpecialise = '-fspecialise'; - $Oopt_SpecialiseUnboxed = '-fspecialise-unboxed'; - next arg; }; - /^-fspeciali[sz]e$/ - && do { $Oopt_DoSpecialise = '-fspecialise'; next arg; }; - /^-fno-speciali[sz]e$/ - && do { $Oopt_DoSpecialise = ''; next arg; }; +%************************************************************************ +%* * +\subsection{Set up for warnings} +%* * +%************************************************************************ +Several warnings are turned on by default. These are supposed to be +the 'I'm pretty sure you've made a mistake here' kind of warnings. +The rest are turned on by the -W and -Wall options, or individually +via their -fwarn and -fno-warn flags. -# Now the foldr/build options, which are *on* by default (for -O). +\begin{code} +sub setupWarningFlags { +&add_Hsc_flags( @StandardWarnings ); +} +\end{code} - /^-ffoldr-build$/ - && do { $Oopt_FoldrBuild = 1; - $Oopt_FB_Support = '-fdo-arity-expand'; - #print "Yes F/B\n"; - next arg; }; +Same unshifting magic, but for special linker flags. - /^-fno-foldr-build$/ - && do { $Oopt_FoldrBuild = 0; - $Oopt_FB_Support = ''; - next arg; }; +The configure script determines whether the object file symbol tables +have a leading underscore, and sets @LeadingUnderscore@ accordingly. +(The driver script `sees' the setting of the @LeadingUnderscore@ +by having the Makefile prepend it). - /^-fno-foldr-build-rule$/ - && do { $Oopt_FoldrBuild = 0; - next arg; }; +\begin{code} +sub setupLinkOpts { + local($uscore) = ( ${LeadingUnderscore} eq 'YES' ) ? '_' : ''; + + unshift(@Ld_flags, + (($Ld_main) ? ( '-u', "${uscore}Main_" . $Ld_main . '_closure' ) : ())); + + # things that are referenced by the RTS - make sure that we pull 'em in + unshift(@Ld_flags, + ( '-u', "${uscore}PrelBase_Izh_static_info" + ,'-u', "${uscore}PrelBase_Czh_static_info" + ,'-u', "${uscore}PrelBase_Fzh_static_info" + ,'-u', "${uscore}PrelBase_Dzh_static_info" + ,'-u', "${uscore}PrelAddr_Azh_static_info" + ,'-u', "${uscore}PrelAddr_Wzh_static_info" + ,'-u', "${uscore}PrelAddr_I64zh_static_info" + ,'-u', "${uscore}PrelAddr_W64zh_static_info" + ,'-u', "${uscore}PrelStable_StablePtr_static_info" + ,'-u', "${uscore}PrelBase_Izh_con_info" + ,'-u', "${uscore}PrelBase_Czh_con_info" + ,'-u', "${uscore}PrelBase_Fzh_con_info" + ,'-u', "${uscore}PrelBase_Dzh_con_info" + ,'-u', "${uscore}PrelAddr_Azh_con_info" + ,'-u', "${uscore}PrelAddr_Wzh_con_info" + ,'-u', "${uscore}PrelAddr_I64zh_con_info" + ,'-u', "${uscore}PrelAddr_W64zh_con_info" + ,'-u', "${uscore}PrelStable_StablePtr_con_info" + ,'-u', "${uscore}PrelBase_False_static_closure" + ,'-u', "${uscore}PrelBase_True_static_closure" + ,'-u', "${uscore}PrelPack_unpackCString_closure" + ,'-u', "${uscore}PrelException_stackOverflow_closure" + ,'-u', "${uscore}PrelException_heapOverflow_closure" + )); + if (!$NoHaskellMain) { + unshift (@Ld_flags,'-u', "${uscore}PrelMain_mainIO_closure"); + } + if ($TargetPlatform =~ /^powerpc-|^rs6000-/) { + # sometimes we have lots of toc entries... + # unshift(@Ld_flags, ('-Xlinker -bbigtoc -Xlinker -bnoquiet')); + unshift(@Ld_flags, ('-Xlinker -bbigtoc')); + } + + +} # end of setupLinkOpts - /^-fno-enable-tech$/ - && do { $Oopt_FB_Support = ''; - next arg; }; +\end{code} - /^-fno-snapback-to-append$/ - && do { $Oopt_FoldrBuildInline .= ' -fdo-not-fold-back-append '; - #print "No Foldback of append\n"; - next arg; }; +%************************************************************************ +%* * +\subsection{Set up include paths and system-library enslurpment} +%* * +%************************************************************************ - # --------------- +Now that we know what garbage-collector, etc., are required, we can +finalise our list of libraries to slurp through, and generally Get +Ready for Business. - /^-fasm-(.*)$/ && do { $HscOut = '-S='; next arg; }; # force using nativeGen - /^-fvia-C$/ && do { $HscOut = '-C='; next arg; }; # force using C compiler +\begin{code} +sub setupIncPaths { + # default includes must be added AFTER option processing + if ( ! $INSTALLING ) { + push (@Include_dir, "$TopPwd/${CURRENT_DIR}/${GHC_INCLUDE_DIR}"); + } else { + push (@Include_dir, "$InstLibDirGhc/includes"); + push (@Include_dir, "$InstLibDirGhc/includes"); + } +} # end of setupIncPaths +\end{code} - # --------------- +\begin{code} +sub setupSyslibs { + push(@SysLibrary, ( '-lHS', '-lHS_cbits' )); # basic I/O and prelude stuff + + local($f); + foreach $f (@SysLibrary) { + next if $f =~ /_cbits/; + $f .= $BuildTag if $f =~ /^-lHS/; + } + + # Push library HSrts, plus boring clib bit + push(@SysLibrary, "-lHSrts${BuildTag}"); + + # + # RTS compiled with cygwin32, uses the WinMM API + # to implement the itimers, since cygwin.dll does not + # support it. Only reqd. for `ways' that use itimers. + # + push(@SysLibrary, '-lwinmm') if $TargetPlatform eq 'i386-unknown-cygwin32'; + # Note: currently only tested with mingw, may cause conflicts when linking + # with libcygwin.a + push(@SysLibrary, '-lwsock32') if ($TargetPlatform =~ /-(mingw32|cygwin32)$/); + + # Push the pvm libraries + if ($BuildTag eq '_mp') { + $pvmlib = "$ENV{'PVM_ROOT'}/lib/$ENV{'PVM_ARCH'}"; + push(@SysLibrary, "-L$pvmlib", '-lgpvm3', '-lpvm3'); + if ( $ENV{'PVM_ARCH'} eq 'SUNMP' ) { + push(@SysLibrary, '-lthread', '-lsocket', '-lnsl'); + } elsif ( $ENV{'PVM_ARCH'} eq 'SUN4SOL2' ) { + push(@SysLibrary, '-lsocket', '-lnsl'); + } + } - /^(-fsimpl-uf-use-threshold)(.*)$/ - && do { $Oopt_UnfoldingUseThreshold = $1 . &grab_arg_arg($1, $2); - next arg; }; +# Push the GNU multi-precision arith lib; and the math library - /^(-fmax-simplifier-iterations)(.*)$/ - && do { $Oopt_MaxSimplifierIterations = $1 . &grab_arg_arg($1, $2); - next arg; }; +# If this machine has GMP already installed, then we'll get the installed +# lib here, because presumably the one in the tree won't have been built. - /^-fno-pedantic-bottoms$/ - && do { $Oopt_PedanticBottoms = ''; next arg; }; +if ($LibGmp eq 'not-installed') { + push(@SysLibrary, "-lgmp"); +} else { + push(@SysLibrary, "-l$LibGmp"); +} - /^-fdo-monad-eta-expansion$/ - && do { $Oopt_MonadEtaExpansion = $_; next arg; }; +push(@SysLibrary, '-lm') if !( $TargetPlatform =~ /^.*(cygwin32|mingw32)$/ ); +\end{code} - /^-fno-let-from-(case|app|strict-let)$/ # experimental, really (WDP 95/10) - && do { push(@HsC_flags, $_); next arg; }; +%************************************************************************ +%* * +\subsection{Check that this system was built to do what we are asking} +%* * +%************************************************************************ - /^(-freturn-in-regs-threshold)(.*)$/ - && do { local($what) = $1; - local($num) = &grab_arg_arg($what, $2); - if ($num < 2 || $num > 8) { - die "Bad experimental flag: $_\n"; - } else { - $HscOut = '-C='; # force using C compiler - push(@HsC_flags, "$what$num"); - push(@CcRegd_flags, "-D__STG_REGS_AVAIL__=$num"); - } - next arg; }; +Before continuing we check that the appropriate build is available. - # --------------- +\begin{code} +#die "$Pgm: no BuildAvail?? $BuildTag\n" if $BuildDescr{$BuildTag} eq '' ; # sanity - /^-fno-(.*)$/ && do { push(@HsC_antiflags, "-f$1"); - &squashHscFlag("-f$1"); - next arg; }; +if ( $BuildDescr{$BuildTag} eq '' ) { + print STDERR "$Pgm: a `", $BuildDescr{$BuildTag}, + "' \"build\" is not available with your GHC setup.\n"; + print STDERR "(It was not configured for it at your site.)\n"; + print STDERR $ShortUsage; + exit 1; +} - /^-f(show-import-specs)/ - && do { push(@HsC_flags, $_); next arg; }; +} # end of setupSyslibs - # --------------- +\end{code} - /^-mlong-calls$/ && do { # for GCC for HP-PA boxes - unshift(@CcBoth_flags, ( $_ )); - next arg; }; +%************************************************************************ +%* * +\subsection{Final miscellaneous setup bits before we start going} +%* * +%************************************************************************ - /^-m(v8|sparclite|cypress|supersparc|cpu=(cypress|supersparc))$/ - && do { # for GCC for SPARCs - unshift(@CcBoth_flags, ( $_ )); - next arg; }; +Record largest specific heapsize, if any. +\begin{code} +sub setupHeapStackSize { + $Specific_heap_size = $Specific_heap_size * $Scale_sizes_by; + push(@HsC_rts_flags, '-H'.$Specific_heap_size); + $Specific_stk_size = $Specific_stk_size * $Scale_sizes_by; + push(@HsC_rts_flags, "-K$Specific_stk_size"); +} +\end{code} - /^-monly-([432])-regs/ && do { # for iX86 boxes only; no effect otherwise - $StolenX86Regs = $1; - next arg; }; +If no input or link files seen, then we let 'em feed in stdin; this is +mainly for debugging. - #*************** ... and lots of debugging ones (form: -d* ) +\begin{code} - # -d(no-)core-lint is done this way so it is turn-off-able. - /^-dcore-lint/ && do { $CoreLint = '-dcore-lint'; next arg; }; - /^-dno-core-lint/ && do { $CoreLint = ''; next arg; }; +if ($#Input_file < 0 && $#Link_file < 0) { + @Input_file = ( '-' ); - /^-d(dump|ppr)-/ && do { push(@HsC_flags, $_); next arg; }; - /^-dverbose-(simpl|stg)/ && do { push(@HsC_flags, $_); next arg; }; - /^-dshow-passes/ && do { push(@HsC_flags, $_); next arg; }; - /^-dsource-stats/ && do { push(@HsC_flags, $_); next arg; }; - /^-dsimplifier-stats/ && do { push(@HsC_flags, $_); next arg; }; - /^-dstg-stats/ && do { $Oopt_StgStats = $_; next arg; }; + open(INF, "> $Tmp_prefix.hs") || &tidy_up_and_die(1,"Can't open $Tmp_prefix.hs\n"); + print STDERR "Enter your Haskell program, end with ^D (on a line of its own):\n" if -t; + while () { print INF $_; } + close(INF) || &tidy_up_and_die(1,"Failed writing to $Tmp_prefix.hs\n"); +} - #*************** ... and now all these -R* ones for its runtime system... +\end{code} - /^-Rscale-sizes?(.*)/ && do { - $Scale_sizes_by = &grab_arg_arg('-Rscale-sizes', $1); - next arg; }; +Tell the world who we are, if they asked. +\begin{code} +print STDERR "${ProjectName}, version ${ProjectVersion}, patchlevel ${ProjectPatchLevel}\n" + if $Verbose; +\end{code} - /^(-H|-Rmax-heapsize)(.*)/ && do { - local($heap_size) = &grab_arg_arg($1, $2); - if ($heap_size =~ /(\d+)[Kk]$/) { - $heap_size = $1 * 1000; - } elsif ($heap_size =~ /(\d+)[Mm]$/) { - $heap_size = $1 * 1000 * 1000; - } elsif ($heap_size =~ /(\d+)[Gg]$/) { - $heap_size = $1 * 1000 * 1000 * 1000; - } - if ($heap_size <= 0) { - print STDERR "$Pgm: resetting heap-size to zero!!!\n"; - $Specific_heap_size = 0; +%************************************************************************ +%* * +\section[Driver-main-loop]{Main loop: Process input files, and link if required} +%* * +%************************************************************************ + +Process the input files; don't continue with linking if there are +problems (global variable @$Status@ non-zero). +\begin{code} +foreach $ifile (@Input_file) { + &ProcessInputFile($ifile); +} + +# don't link if there were errors... +if ( $Status > 0 ) { + print STDERR $ShortUsage; + &tidy_up(); + exit $Status; +} + +# Link if appropriate. +&runLinker() if $Do_lnkr; + +# that... that's all, folks! +&tidy_up(); +exit $Status; # will still be 0 if all went well +\end{code} + +%************************************************************************ +%* * +\section[Driver-do-one-file]{How to process a single input file} +%* * +%************************************************************************ + +\begin{code} +sub ProcessInputFile { + local($ifile) = @_; # input file name + local($ifile_root); # root of or basename of input file + local($ofile_target); # ultimate output file we hope to produce + # from input file (need to know for recomp + # checking purposes) + local($hifile_target);# ditto (but .hi file) + local($ofile_c_stub_target); + local($ofile_h_stub_target); +\end{code} + +Handle the weirdity of input from stdin. +\begin{code} + if ($ifile ne '-') { + ($ifile_root = $ifile) =~ s/\.[^\.\/]+$//; + $ofile_target = # may be reset later... + ($Specific_output_file ne '' && ! $Do_lnkr) + ? $Specific_output_file + : &odir_ify($ifile_root, 'o'); + $hifile_target= ($Specific_hi_file ne '') + ? $Specific_hi_file + : "$ifile_root.$HiSuffix"; # ToDo: odirify? + # NB: may change if $ifile_root isn't module name (??) + ($ofile_c_stub_target = $ifile) =~s/\.[^\.\/]+$/_stub.c/; + ($ofile_h_stub_target = $ifile) =~s/\.[^\.\/]+$/_stub.h/; + } else { + $ifile = "$Tmp_prefix.hs"; # we know that's where we put the input + $ifile_root = '_stdin'; + $ofile_target = '_stdout'; # gratuitous? + $hifile_target= '_stdout'; # ditto? + } +\end{code} + +We need to decide what phases of the compilation system we will run +over this file. The defaults are the ones established when processing +flags. (That established what the last phase run for all files is.) + +We do the pre-recompilation-checker phases here; the rest later. +\begin{code} +\end{code} + +Look at the suffix and decide what initial phases of compilation may +be dropped off for this file. Also the rather boring business of +which files are coming-in/going-out. + +Again, we'll do the post-recompilation-checker parts of this later. +\begin{code} + local($do_lit2pgm) = ($ifile =~ /\.lhs$/) ? 1 : 0; + local($do_hscpp) = 1; # but "hscpp" might really be "cat" + local($do_hsc) = 1; + + # names of the files to stuff between phases + # defaults are temporaries + local($in_lit2pgm) = $ifile; + local($lit2pgm_hscpp) = "$Tmp_prefix.lpp"; + local($hscpp_hsc) = "$Tmp_prefix.cpp"; + local($hsc_hi) = "$Tmp_prefix.hi"; + local($cc_as_o) = "${Tmp_prefix}_o.s"; # temporary for raw .s file if opt C + local($cc_as) = "$Tmp_prefix.s"; # mangled or hsc-produced .s code + local($as_out) = $ofile_target; + + local($is_hc_file) = 1; #Is the C code .hc or .c? Assume .hc for now + + # OK, let's strip off some literate junk.. + if ($do_lit2pgm) { + &runLit2pgm($in_lit2pgm, $lit2pgm_hscpp) + } else { + $lit2pgm_hscpp = $ifile; + } + + # + @File_options = (); + + # Scan the top of the de-litted file for {-# OPTIONS #-} pragmas + &check_for_source_options($lit2pgm_hscpp,$ifile); + + # Options found in the source file take a back seat, i.e., we scan + # them first. Only process the command line again if source file + # contained anything of interest *or* there's more than one + # input file (we have to reset the options). + # + if ( $#Input_file >= 0 || $#File_options >= 0) { + #@File_options = (@File_options, @Cmd_opts); + + # Now process the command line + &initDriverGlobals(); + &processArgs((@File_options,@Cmd_opts)); + print STDERR "\nEffective command line: " . + join(' ',(@File_options,@Cmd_opts)) . "\n" if $Verbose; + } + # + # Having got the effective command line scanned, set up + # the various options in prep for some real work. + # + # check the sanity of the BuildTag we're about to use, + # and if needs be, add some more flags and setup to + # the different phases. + # + &setupBuildFlags(); + &setupOptimiseFlags(); + &setupMachOpts(); + &setupIncPaths(); + &setupWarningFlags(); + &setupHeapStackSize(); + + # + # These two variables need to be set after the + # command-line has been processed and the build options + # have be seen set up. This is because command-line options + # can control whether to compile vias C or not. + # + local($do_cc) = ( $Do_cc != -1) # i.e., it was set explicitly + ? $Do_cc + : ( ($HscOut eq '-C=') ? 1 : 0 ); + local($do_as) = $Do_as; + local($hsc_out) = ( $HscOut eq '-C=' ) ? "$Tmp_prefix.hc" : "$Tmp_prefix.s" ; + local($hsc_out_c_stub) = ( $HscOut eq '-C=' ) ? "${Tmp_prefix}_stb.c" : ""; + local($hsc_out_h_stub) = ( $HscOut eq '-C=' ) ? "${Tmp_prefix}_stb.h" : ""; + + if ($Only_preprocess_hc) { # stop after having run $Cc -E + $do_as=0; + } + if ($Only_preprocess_C) { # stop after having run $hscpp + $do_hsc=0; $do_cc = 0; $do_as=0; + } elsif ($ifile =~ /.lhs$/ || $ifile =~ /.hs$/ ) { + ; + } elsif ($ifile =~ /\.hc$/ || $ifile =~ /_hc$/ ) { # || $ifile =~ /\.$Isuffix$/o) # ToDo: better + $do_hscpp = 0; $do_hsc = 0; $do_cc = 1; + $hsc_out = $ifile; + $hsc_out_c_stub = ''; + $hsc_out_h_stub = ''; + } elsif ($ifile =~ /\.c$/) { + $do_hscpp = 0; $do_hsc = 0; $do_cc = 1; + $hsc_out = $ifile; $is_hc_file = 0; + $hsc_out_c_stub = ''; + $hsc_out_h_stub = ''; + } elsif ($ifile =~ /\.[sS]$/) { + $do_hscpp = 0; $do_hsc = 0; $do_cc = 0; + $cc_as = $ifile; + } else { # don't know what it is, but nothing to do herein... + $do_hscpp = 0; $do_hsc = 0; $do_cc = 0; $do_as = 0; + } + + # hack to avoid running hscpp + $HsCpp = $Cat if ! $Cpp_flag_set; + + &runHscpp($in_lit2pgm, $lit2pgm_hscpp, $hscpp_hsc) if $do_hscpp; + +\end{code} + +We now think about whether to run hsc/cc or not (when hsc produces .s +stuff, it effectively takes the place of both phases). +To get the output file name right: for each phase that we are {\em +not} going to run, set its input (i.e., the output of its preceding +phase) to @"$ifile_root."@. + +\begin{code} + local($going_interactive) = $HscOut eq '-N=' || $ifile_root eq '_stdin'; + + # + # Warning issued if -keep-hc-file-too is used without + # -fvia-C (or the equivalent) + # + if ( $HscOut ne '-C=' && $Keep_hc_file_too ) { + print STDERR "$Pgm: warning: Native code generator to be used, -keep-hc-file-too will be ignored\n"; + } + + if (! $do_cc && ! $do_as) { # stopping after hsc + $hsc_out = ($Specific_output_file ne '') + ? $Specific_output_file + : &odir_ify($ifile_root, ($HscOut eq '-C=') ? 'hc' : 's'); + + $ofile_target = $hsc_out; # reset + } + + if (! $do_as) { # stopping after gcc (or hsc) + $cc_as = ($Specific_output_file ne '') + ? $Specific_output_file + : &odir_ify($ifile_root, ( $Only_preprocess_hc ) ? 'i' : 's'); + + $ofile_target = $cc_as; # reset + } + +\end{code} + + +Now the Haskell compiler, C compiler, and assembler + +\begin{code} + if ($do_hsc) { + &runHscAndProcessInterfaces( $ifile, $hscpp_hsc, $ifile_root, + $ofile_target, $hifile_target, + $going_interactive); + } + + if (-f $hsc_out_h_stub) { + &run_something("cp $hsc_out_h_stub $ofile_h_stub_target", 'Copy foreign export header file'); + } + + if (-f $hsc_out_c_stub) { + &run_something("cp $hsc_out_c_stub $ofile_c_stub_target", 'Copy foreign export C stubs'); + local ($hsc_out_s_stub); + local ($hsc_out_o_stub); + ($ofile_s_stub_target = $ofile_c_stub_target) =~ s/\.(.*)$/\.s/; + ($ofile_o_stub_target = $ofile_c_stub_target) =~ s/\.(.*)$/\.o/; + &runGcc (0, $ofile_c_stub_target, $ofile_s_stub_target); + &runAs ($ofile_o_stub_target, $ofile_s_stub_target); + # + # Bring the C stub protos into scope when compiling the .hc file. + # + push (@CcInjects, "#include \"${hsc_out_h_stub}\"\n"); + # Hack - ensure that the stub .h file is included in the OPTIONS section + # if the .hc file is saved. + push (@File_options, "-#include \"${ofile_h_stub_target}\"\n"); - # if several heap sizes given, take the largest... - } elsif ($heap_size >= $Specific_heap_size) { - $Specific_heap_size = $heap_size; - } else { - print STDERR "$Pgm: ignoring heap-size-setting option ($_)...not the largest seen\n"; - } - next arg; }; + } - /^-(K|Rmax-(stk|stack)size)(.*)/ && do { - local($stk_size) = &grab_arg_arg('-Rmax-stksize', $3); - if ($stk_size =~ /(\d+)[Kk]$/) { - $stk_size = $1 * 1000; - } elsif ($stk_size =~ /(\d+)[Mm]$/) { - $stk_size = $1 * 1000 * 1000; - } elsif ($stk_size =~ /(\d+)[Gg]$/) { - $stk_size = $1 * 1000 * 1000 * 1000; - } - if ($stk_size <= 0) { - print STDERR "$Pgm: resetting stack-size to zero!!!\n"; - $Specific_stk_size = 0; + if ($do_cc) { + &runGcc ($is_hc_file, $hsc_out, $cc_as_o); + &runMangler($is_hc_file, $cc_as_o, $cc_as, $ifile_root) if ! $Only_preprocess_hc; + } - # if several stack sizes given, take the largest... - } elsif ($stk_size >= $Specific_stk_size) { - $Specific_stk_size = $stk_size; - } else { - print STDERR "$Pgm: ignoring stack-size-setting option (-Rmax-stksize $stk_size)...not the largest seen\n"; - } - next arg; }; + &split_asm_file($cc_as) if $do_as && $SplitObjFiles; - /^-Rgc-stats$/ && do { $CollectingGCstats++; - # the two RTSs do this diff ways; we will try to compensate - next arg; }; + # save a copy of the .s file.. + &saveIntermediate($ifile_root , "s" , $cc_as) if ($do_as && $Keep_s_file_too); + &runAs($as_out, $ifile_root) if $do_as; +\end{code} - /^-Rghc-timing/ && do { $CollectGhcTimings = 1; next arg; }; +Finally, decide what to queue up for linker input. +\begin{code} + # tentatively assume we will eventually produce linker input: + push(@Link_file, &odir_ify($ifile_root, 'o')); - #---------- C high-level assembler (gcc) ------------------------------- - /^-(Wall|ansi|pedantic)$/ && do { push(@CcBoth_flags, $_); next arg; }; +#ToDo: local($or_isuf) = ($Isuffix eq '') ? '' : "|$Isuffix"; + + if ( $ifile !~ /\.(lhs|hs|hc|c|s|a|S)$/ && $ifile !~ /_hc$/ ) { + # There's sometimes confusion regarding .hi files; users + # supplying them on the command line. + if ( $ifile =~ /\.hi$/ ) { + print STDERR "$Pgm: warning: found `$ifile' on command line; interface files should not be supplied here - ignoring it.\n"; + } else { + print STDERR "$Pgm: don't recognise suffix on `$ifile'; passing it through to linker\n"; + } + # oops; we tentatively pushed the wrong thing; fix & do the right thing + pop(@Link_file); push(@Link_file, $ifile); + } + + +} # end of ProcessInputFile +\end{code} + +%************************************************************************ +%* * +\section[Driver-run-phases]{Routines to run the various phases} +%* * +%************************************************************************ + +\begin{code} +sub runLit2pgm { + local($in_lit2pgm, $lit2pgm_hscpp) = @_; + + local($to_do) = ""; + + # Only add #line pragma if we're going to need it. + $to_do = "echo '#line 1 \"$in_lit2pgm\"' > $lit2pgm_hscpp && " if ($Cpp_flag_set); + $to_do .= "$Unlit @Unlit_flags $in_lit2pgm - >> $lit2pgm_hscpp"; + + push(@Files_to_tidy, $lit2pgm_hscpp ); + + &run_something($to_do, 'literate pre-processor'); +} +\end{code} + +\begin{code} +sub runHscpp { + local($in_lit2pgm, $lit2pgm_hscpp, $hscpp_hsc) = @_; + + local($to_do) = ""; + + # Strictly speaking, echoing of the following line pragma is only required + # on non-delit'ed input, as we've already added it during de-lit. However, + # hscpp will then add a {-# LINE 1 "$lit2pgm_hsc" -} to the top of the file, + # which is not very informative (but harmless). Hence, we uniformly have + # {-# LINE 1 "$in_lit2pgm" #-} as the first line to all cpp'ed hsc input. + # + $to_do = "echo '{-# LINE 1 \"$in_lit2pgm\" -}' > $hscpp_hsc && "; + + if ($HsCpp eq $Cat) { + $to_do .= "$HsCpp $lit2pgm_hscpp >> $hscpp_hsc"; + push(@Files_to_tidy, $hscpp_hsc ); + &run_something($to_do, 'Ineffective C pre-processor'); + } else { + local($includes) = '-I' . join(' -I',@Include_dir); + $to_do .= "$HsCpp $Verbose @HsCpp_flags @HsSourceCppOpts $includes $lit2pgm_hscpp >> $hscpp_hsc"; + push(@Files_to_tidy, $hscpp_hsc ); + &run_something($to_do, 'Haskellised C pre-processor'); + } + + if ( $Only_preprocess_C ) { + $to_do = "$Cat $hscpp_hsc"; + &run_something($to_do, ''); + } + +} +\end{code} - # -dgcc-lint is a useful way of making GCC very fussy. - # From alan@spri.levels.unisa.edu.au (Alan Modra). - /^-dgcc-lint$/ && do { push(@CcBoth_flags, '-Wall -Wpointer-arith -Wbad-function-cast -Wcast-qual -Wstrict-prototypes -Wmissing-prototypes -Wmissing-declarations -Wnested-externs'); next arg; }; - # An alternate set, from mark@sgcs.com (Mark W. Snitily) - # -Wall -Wstrict-prototypes -Wmissing-prototypes -Wcast-align -Wshadow - # inject "#include " into the compiler's C output! +\begin{code} +sub runHscAndProcessInterfaces { + local($ifile, $hscpp_hsc, $ifile_root, + $ofile_target, $hifile_target, + $going_interactive) = @_; + + # $ifile is the original input file + # $hscpp_hsc post-unlit, post-cpp, etc., input file + # $ifile_root input filename minus suffix + # $ofile_target the output file that we ultimately hope to produce + # $hifile_target the .hi file ... (ditto) + + local($source_unchanged) = 1; - /^-#include(.*)/ && do { - local($to_include) = &grab_arg_arg('-#include', $1); - push(@CcInjects, "#include $to_include\n"); - next arg; }; + # Check if the source file is up to date relative to the target; in + # that case we say "source is unchanged" and let the compiler bail out + # early if the import usage information allows it. - #---------- Linker (gcc, really) --------------------------------------- + ($i_dev,$i_ino,$i_mode,$i_nlink,$i_uid,$i_gid,$i_rdev,$i_size, + $i_atime,$i_mtime,$i_ctime,$i_blksize,$i_blocks) = stat($ifile); - /^-static$/ && do { push(@Ld_flags, $_); next arg; }; + # The informational messages below are now conditional on -v being set -- SOF + if ( $ofile_target ne "_stdin.s" && ! -f $ofile_target ) { + print STDERR "$Pgm:compile:Output file $ofile_target doesn't exist\n" if $Verbose; + $source_unchanged = 0; + } - #---------- mixed cc and linker magic ---------------------------------- - # this optimisation stuff is finally sorted out later on... + ($o_dev,$o_ino,$o_mode,$o_nlink,$o_uid,$o_gid,$o_rdev,$o_size, + $o_atime,$o_mtime,$o_ctime,$o_blksize,$o_blocks) = stat(_); # stat info from -f test - /^-O2-for-C$/ && do { $MinusO2ForC = 1; next arg; }; + if ( $hifile_target ne "_stdout" && ! -f $hifile_target ) { + print STDERR "$Pgm:compile:Interface file $hifile_target doesn't exist\n" if $Verbose; + $source_unchanged = 0; + } - /^-O[1-2]?$/ && do { -# print STDERR "$Pgm: NOTE: this version of GHC doesn't support -O or -O2\n"; - local($opt_lev) = ( /^-O2$/ ) ? 2 : 1; # max 'em - $OptLevel = ( $opt_lev > $OptLevel ) ? $opt_lev : $OptLevel; + ($hi_dev,$hi_ino,$hi_mode,$hi_nlink,$hi_uid,$hi_gid,$hi_rdev,$hi_size, + $hi_atime,$hi_mtime,$hi_ctime,$hi_blksize,$hi_blocks) = stat(_); # stat info from -f test - $HscOut = '-C=' if $OptLevel == 2; # force use of C compiler - next arg; }; + if ( $ofile_target ne "_stdin.s" && $i_mtime > $o_mtime) { + print STDERR "$Pgm:recompile:Input file $ifile newer than $ofile_target\n" if $Verbose; + $source_unchanged = 0; + } - /^-Onot$/ && do { $OptLevel = 0; next arg; }; # # set it to + # Tell the compiler which version we're using + push(@HsC_flags, "-fhi-version=${ProjectVersionInt}"); + + # So if source_unchanged is still "1", we pass on the good news to the compiler + # The -recomp flag can disable this, forcing recompilation + if ($Do_recomp_chkr && $source_unchanged) { + push(@HsC_flags, '-fsource-unchanged'); + } + + # Indicate whether we're static or not. + # This will only ever + push(@HsC_flags, '-static') if $Static; + + # Run the compiler + + &runHsc($ifile_root, $hsc_out, $hsc_hi, $hsc_out_c_stub, $hsc_out_h_stub, $going_interactive); + + # See if it bailed out early, saying nothing needed doing. + # We work this out by seeing if it created an output .hi file + + if ( ! -f $hsc_hi && $ProduceHi !~ /-nohifile=/ ) { + # Doesn't exist, so we bailed out early. + # Tell the C compiler and assembler not to run + $do_cc = 0; $do_as = 0; + + # Update dependency info, touch both object file and + # interface file, so that the following invariant is + # maintained: + # + # a dependent module's interface file should after recompilation + # checking be newer than the interface files of its imports. + # + # That is, if module A's interface file changes, then module B + # (which import from A) needs to be checked. + # If A's change does not affect B, which causes the compiler to bail + # out early, we still need to touch the interface file of B. The reason + # for this is that B may export A's interface. + # + &run_something("touch $ofile_target", + "Touch $ofile_target, to propagate dependencies") if $HscOut ne '-N='; + &run_something("touch $hifile_target", + "Touch $hifile_target, to propagate dependencies") if $ProduceHi =~ /-nohifile=/ ; + + } else { + + # Didn't bail out early (new .hi file) so we thunder on + + # If non-interactive, heave in the consistency info at the end + # NB: pretty hackish (depends on how $output is set) + if ( ! $going_interactive ) { + if ( $HscOut eq '-C=' ) { + $to_do = "echo 'static char ghc_hsc_ID[] = \"\@(#)hsc $ifile\t$HsC_major_version.$HsC_minor_version,$HsC_consist_options\";' >> $hsc_out"; + + } elsif ( $HscOut eq '-S=' ) { + local($consist) = "hsc.$ifile.$HsC_major_version.$HsC_minor_version.$HsC_consist_options"; + $consist =~ s/,/./g; + $consist =~ s/\//./g; + $consist =~ s/-/_/g; + $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly? + $to_do = "echo '\n\t.text\n$consist:' >> $hsc_out"; + } + &run_something($to_do, 'Pin on Haskell consistency info'); + } - /^-Ofile(.*)/ && do { - $OptLevel = 3; - local($ofile) = &grab_arg_arg('-Ofile', $1); - @HsC_minusO3_flags = (); - open(OFILE, "< $ofile") || die "Can't open $ofile!\n"; - while () { - chop; - s/\#.*//; # death to comments - s/[ \t]+//g; # death to whitespace - next if /^$/; # ditto, blank lines - s/([()*{}])/\\$1/g; # protect shell metacharacters - if ( /^C:(.*)/ ) { - push(@CcBoth_flags, $1); - } else { - push(@HsC_minusO3_flags, $_); - } - } - close(OFILE); - next arg; }; + # Interface-handling is important enough to live off by itself + if ( $ProduceHi !~ /-nohifile=/ ) { # If we've produced one, process it. + require('ghc-iface.prl') || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-iface.prl!\n"); + &postprocessHiFile($hsc_hi, $hifile_target, $going_interactive); + } + # if we're going to split up object files, + # we inject split markers into the .hc file now + if ( $HscOut eq '-C=' && $SplitObjFiles ) { + &inject_split_markers ( $hsc_out ); + } - /^-debug$/ && do { # all this does is mark a .hc/.o as "debugging" - # in the consistency info - $DEBUGging = 'd'; - next arg; }; + # save a copy of the .hc file, even if we are carrying on... + if ($HscOut eq '-C=' && $do_cc && $Keep_hc_file_too) { + &saveIntermediate($ifile_root , "hc" , $hsc_out); + } - #---------- linking .a file -------------------------------------------- + } +} +\end{code} - /^-Main(.*)/ && do { - # specifies main or mainPrimIO to be linked - $Ld_main = $1; - next arg; }; - #---------- catch unrecognized flags ----------------------------------- +\begin{code} +sub runHsc { + local($ifile_root, $hsc_out, $hsc_hi, $hsc_out_c_stub, $hsc_out_h_stub, $going_interactive) = @_; - /^-./ && do { - print STDERR "$Pgm: unrecognised option: $_\n"; - $Status++; - next arg; }; + &makeHiMap() unless $HiMapDone; + push(@HsC_flags, "-himap=$HiIncludeString"); - #---------- anything else is considered an input file ------------------ - # (well, .o and .a files are immediately queued up as linker fodder..) - if (/\.[oa]$/) { - push(@Link_file, $_); - } else { - push(@Input_file, $_); + # here, we may produce .hc/.s and/or .hi files + local($output) = ''; + #@Files_to_tidy = (); + + if ( $going_interactive ) { + # don't need .hi unless we're going to show it on stdout: + $ProduceHi = '-nohifile=' if ! ($HiOnStdout || $Specific_hi_file ne '' ); + $do_cc = 0; $do_as = 0; $Do_lnkr = 0; # and we won't go any further... } - # input files must exist: - if (! -f $_) { - print STDERR "$Pgm: input file doesn't exist: $_\n"; - $Status++; + # set up for producing output/.hi; note that flag twiddling + # may mean that nothing will actually be produced: + $output = "$ProduceHi$hsc_hi $HscOut$hsc_out -F=$hsc_out_c_stub -FH=$hsc_out_h_stub"; + push(@Files_to_tidy, $hsc_hi, $hsc_out, $hsc_out_c_stub, $hsc_out_h_stub ); + + # if we're compiling foo.hs, we want the GC stats to end up in foo.stat + if ( $CollectingGCstats ) { + push(@HsC_rts_flags, "-S$ifile_root.stat"); + push(@Files_to_tidy, "$ifile_root.stat"); } -} -# if there are several input files, -# we don't allow \tr{-o } or \tr{-ohi } options... -# (except if linking, of course) + if ( $CollectGhcTimings ) { # assume $RTS_style eq 'ghc' + # emit nofibbish time/bytes-alloc stats to stderr; + # see later .stat file post-processing + print STDERR "warning: both -Rgc-stats and -Rghc-timing used, -Rghc-timing wins." if $CollectingGCstats; + push(@HsC_rts_flags, "-s$Tmp_prefix.stat"); + push(@Files_to_tidy, "$Tmp_prefix.stat"); + } -if ($#Input_file > 0 && ( ! $Do_lnkr )) { - if ( ($Specific_output_file ne '' && $Specific_output_file ne '-') - || ($Specific_hi_file ne '' && $Specific_hi_file ne '-') ) { - print STDERR "$Pgm: You can't use -o or -ohi options if you have multiple input files.\n"; - print STDERR "\tPerhaps the -odir option will do what you want.\n"; - $Status++; + local($dump) = ''; + if ($Specific_dump_file ne '') { + $dump = "2>> $Specific_dump_file"; + $Using_dump_file = 1; } -} -# check for various pathological -o and -odir combinations... -if ($Specific_output_dir ne '' && $Specific_output_file ne '') { - if ($Specific_output_file eq '-') { - print STDERR "$Pgm: can't set output directory with -ohi AND have output to stdout\n"; - $Status++; - } else { # amalgamate... - $Specific_output_file = "$Specific_output_dir/$Specific_output_file"; - # ToDo: check we haven't got a junk name now... - $Specific_output_dir = ''; # reset + local($to_do); + # Win32 only: If the command processor used by system() + # exec()s the application as an ordinary Win32 executable, + # we're in trouble here, since the command line is likely + # to be > 255 chars long. To work around this situation, + # $HsC also understands `at-files', i.e., `@file' on the + # command line will cause $HsC to add the contents of `file' + # to the command line. + # + # [ Note: support for `at-files' is not compiled in by default ] + $cmd_line_opts_via_at_file=0; + if ($cmd_line_opts_via_at_file) { + + local($to_do_opts) = "$Tmp_prefix.opts"; + open(OPTS, "> $Tmp_prefix.opts") || &tidy_up_and_die(1,"Can't open $Tmp_prefix.opts\n"); + print OPTS "$dump @HsC_flags $CoreLint $USPLint $StgLint $Verbose"; + close(OPTS); + $to_do = "$HsC $hscpp_hsc \@$Tmp_prefix.opts $output +RTS @HsC_rts_flags"; + + } else { + + $to_do = "$HsC $hscpp_hsc $dump @HsC_flags $CoreLint $USPLint $StgLint $Verbose $output +RTS @HsC_rts_flags"; } + &run_something($to_do, 'Haskell compiler'); + + # finish business w/ nofibbish time/bytes-alloc stats + &process_ghc_timings() if $CollectGhcTimings; } +\end{code} -# PROFILING stuff after argv mangling: -if ( ! $PROFing ) { - # warn about any scc exprs found (in case scc used as identifier) - push(@HsP_flags, '-W'); +Use \tr{@Import_dir} and \tr{@SysImport_dir} to make a tmp file +of (module-name, pathname) pairs, one per line, separated by a space. +\begin{code} +$HiMapDone = 0; +$HiIncludeString = (); # dir1:dir2:dir3, to pass to GHC - # add -auto sccs even if not profiling ! - push(@HsC_flags, $UNPROFscc_auto) if $UNPROFscc_auto; +sub makeHiMap { -} else { - push(@HsC_flags, $PROFauto) if $PROFauto; - push(@HsC_flags, $PROFcaf) if $PROFcaf; - #push(@HsC_flags, $PROFdict) if $PROFdict; + # collect in %HiMap; write later; also used elsewhere in driver - $Oopt_FinalStgProfilingMassage = '-fmassage-stg-for-profiling'; + local($mod, $path, $d, $e); - push(@HsP_flags, (($PROFignore_scc) ? $PROFignore_scc : '-S')); + # reset the global variables: + $HiMapDone = 0; + $HiIncludeString = (); # dir1:dir2:dir3, to pass to GHC + + foreach $d ( @Import_dir ) { + if ($HiIncludeString) { + $HiIncludeString = "$HiIncludeString:${d}%.${HiSuffix}"; + } else { + $HiIncludeString = "$d%.${HiSuffix}"; + } - if ( $SplitObjFiles ) { - # can't split with cost centres -- would need global and externs - print STDERR "$Pgm: WARNING: splitting objects when profiling will *BREAK* if any _scc_s are present!\n"; - # (but it's fine if there aren't any _scc_s around...) -# $SplitObjFiles = 0; # unset - #not an error: for now: $Status++; } -} -# crash and burn if there were errors -if ( $Status > 0 ) { - print STDERR $ShortUsage; - exit $Status; -} -\end{code} + foreach $d ( @SysImport_dir ) { + if ($HiIncludeString) { + $HiIncludeString = "$HiIncludeString:${d}%.${HiSuffix_prelude}"; + } else { + $HiIncludeString = "${d}%.${HiSuffix_prelude}"; + } + } -%************************************************************************ -%* * -\section[Driver-post-argv-mangling]{Setup after reading options} -%* * -%************************************************************************ + $HiMapDone = 1; +} -%************************************************************************ -%* * -\subsection{Set up for optimisation level (\tr{-O} or whatever)} -%* * -%************************************************************************ +\end{code} -We come now to the default ``wads of options'' that are turned on by -\tr{-O0} (do min optimisation), \tr{-O} (ordinary optimisation), -\tr{-O2} (aggressive optimisation), or no O-ish flag (compile speed is -more important). +Invoke the 'linker' - either the standard linker or the one used to build +a (Win32) DLL. -The user can also specify his/her own list of options in a file; in -that case, the work is already done (see stuff about @minusO3@, -earlier...). +\begin{code} +sub runLinker() +{ + local($libdirs) = ''; -GHC allows very precise control of what happens during a compilation. -Core-to-Core and STG-to-STG passes can be run in any order, as many -times as you like. Individual transformations can be turned on or -disabled. + # append last minute flags linker and consistency flags + &setupBuildFlags(); + &setupSyslibs(); + &setupLinkOpts(); -Sadly, however, there are some interdependencies \& Things You Must -Not Do. Here is the list. + # glue them together: + push(@UserLibrary_dir, @SysLibrary_dir); -CORE-TO-CORE PASSES: -\begin{description} -\item[\tr{-fspecialise}:] -The specialiser must have dependency-analysed input; but if you run -the simplifier to do this, you must not let it toss away unused -bindings! (The typechecker conveys some specialisation info via -``unused'' bindings...) + $libdirs = '-L' . join(' -L',@UserLibrary_dir) if $#UserLibrary_dir >= 0; -\item[\tr{-ffloat-inwards}:] -Floating inwards should be done before strictness analysis, because -the latter will give better results. + # for a linker, use an explicitly given one, or the going C compiler ... + local($lnkr) = ( $Lnkr ) ? $Lnkr : $CcRegd; -\item[\tr{-fstatic-args}:] -The static-arguments-transformation pass {\em must} have the -simplifier run right after it. + if ( ($Specific_output_file eq '') && + ($TargetPlatform eq 'i386-unknown-cygwin32') ) { + $Specific_output_file = 'main.exe'; + print STDERR "Output file not specified, defaulting to \"main.exe\"\n"; + } -\item[\tr{-fcalc-inlinings[12]}:] -Not required, but there may be slight gains by re-simplifying after -this is done. (You could then \tr{-fcalc-inlinings} again, just for -fun.) + local($output) = ($Specific_output_file ne '') ? "-o $Specific_output_file" : ''; + @Files_to_tidy = ($Specific_output_file ne '') ? $Specific_output_file : 'a.out'; -\item[\tr{-ffull-laziness}:] -The (outwards-)let-floater should be the {\em last} Core-to-Core pass -that's run. (Um, well, howzabout the simplifier just once more...) -\end{description} + &prepareWin32DllLink(1); -STG-TO-STG PASSES: -\begin{description} -\item[\tr{-fupdate-analysis}:] -It really really wants to be the last STG-to-STG pass that is run. -\end{description} + local($to_do) = "$lnkr $Verbose @Ld_flags $output @Link_file $TopClosureFile $libdirs @UserLibrary @SysLibrary"; + &run_something($to_do, 'Linker'); -\begin{code} -@HsC_minusNoO_flags - = ( '-fsimplify', - '\(', - $Oopt_FB_Support, -# '-falways-float-lets-from-lets', # no idea why this was here (WDP 95/09) - '-ffloat-lets-exposing-whnf', - '-ffloat-primops-ok', - '-fcase-of-case', -# '-fdo-lambda-eta-expansion', # too complicated - '-freuse-con', -# '-flet-to-case', # no strictness analysis, so... - $Oopt_PedanticBottoms, -# $Oopt_MonadEtaExpansion, # no thanks - '-fsimpl-uf-use-threshold0', - '-fessential-unfoldings-only', -# $Oopt_UnfoldingUseThreshold, # no thanks - $Oopt_MaxSimplifierIterations, - '\)', - $Oopt_AddAutoSccs, -# '-ffull-laziness', # removed 95/04 WDP following Andr\'e's lead - - $Oopt_FinalStgProfilingMassage - ); + # finally, check the consistency info in the binary + local($executable) = $Files_to_tidy[0]; + @Files_to_tidy = (); # reset; we don't want to nuke it if it's inconsistent -@HsC_minusO_flags # NOTE: used for *both* -O and -O2 (some conditional bits) - = ( - # initial simplify: mk specialiser happy: minimum effort please - '-fsimplify', - '\(', - $Oopt_FB_Support, - '-fkeep-spec-pragma-ids', # required before specialisation - '-fsimpl-uf-use-threshold0', - '-fessential-unfoldings-only', - '-fmax-simplifier-iterations1', - $Oopt_PedanticBottoms, - '\)', - - ($Oopt_DoSpecialise) ? ( - '-fspecialise-overloaded', - $Oopt_SpecialiseUnboxed, - $Oopt_DoSpecialise, - ) : (), + if ( $LinkChk ) { + # dynamically load consistency-chking code; then do it. + require('ghc-consist.prl') + || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-consist.prl!\n"); - '-fsimplify', # need dependency anal after specialiser ... - '\(', # need tossing before calc-inlinings ... - $Oopt_FB_Support, - '-ffloat-lets-exposing-whnf', - '-ffloat-primops-ok', - '-fcase-of-case', - '-fdo-case-elim', - '-fcase-merge', - '-fdo-eta-reduction', - '-fdo-lambda-eta-expansion', - '-freuse-con', - $Oopt_PedanticBottoms, - $Oopt_MonadEtaExpansion, - $Oopt_UnfoldingUseThreshold, - $Oopt_MaxSimplifierIterations, - '\)', - -#LATER: '-fcalc-inlinings1', -- pointless for 2.01 - -# ($Oopt_FoldrBuildWW) ? ( -# '-ffoldr-build-ww-anal', -# '-ffoldr-build-worker-wrapper', -# '-fsimplify', -# '\(', -# $Oopt_FB_Support, -# '-ffloat-lets-exposing-whnf', -# '-ffloat-primops-ok', -# '-fcase-of-case', -# '-fdo-case-elim', -# '-fcase-merge', -# '-fdo-eta-reduction', -# '-fdo-lambda-eta-expansion', -# '-freuse-con', -# $Oopt_PedanticBottoms, -# $Oopt_MonadEtaExpansion, -# $Oopt_UnfoldingUseThreshold, -# $Oopt_MaxSimplifierIterations, -# '\)', -# ) : (), + &chk_consistency_info ( $executable ); + } - # this pass-ordering sequence was agreed by Simon and Andr\'e - # (WDP 94/07, 94/11). - '-ffull-laziness', + # if PVM parallel stuff, we do truly weird things. + # Essentially: (1) move the executable over to where PVM expects + # to find it. (2) create a script in place of the executable + # which will cause the program to be run, via SysMan. + if ( $PARing eq 'p' ) { + local($pvm_executable) = $executable; + local($pvm_executable_base); - ($Oopt_FoldrBuild) ? ( - '-ffoldr-build-on', # desugar list comprehensions for foldr/build - - '-fsimplify', - '\(', - '-fignore-inline-pragma', # **** NB! - '-fdo-foldr-build', # NB - $Oopt_FB_Support, - '-ffloat-lets-exposing-whnf', - '-ffloat-primops-ok', - '-fcase-of-case', - '-fdo-case-elim', - '-fcase-merge', - '-fdo-eta-reduction', - '-fdo-lambda-eta-expansion', - '-freuse-con', - $Oopt_PedanticBottoms, - $Oopt_MonadEtaExpansion, - $Oopt_UnfoldingUseThreshold, - $Oopt_MaxSimplifierIterations, - '\)', - ) : (), + if ( $pvm_executable !~ /^\// ) { # a relative path name: make absolute + local($pwd) = `pwd`; + chop($pwd); + $pwd =~ s/^\/tmp_mnt//; + $pvm_executable = "$pwd/$pvm_executable"; + } - '-ffloat-inwards', + $pvm_executable =~ s|/|=|g; # make /s into =s + $pvm_executable_base = $pvm_executable; - '-fsimplify', - '\(', - $Oopt_FB_Support, - '-ffloat-lets-exposing-whnf', - '-ffloat-primops-ok', - '-fcase-of-case', - '-fdo-case-elim', - '-fcase-merge', - '-fdo-eta-reduction', - '-fdo-lambda-eta-expansion', - '-freuse-con', - ($Oopt_FoldrBuildInline), - # you need to inline foldr and build - ($Oopt_FoldrBuild) ? ('-fdo-foldr-build') : (), - # but do reductions if you see them! - $Oopt_PedanticBottoms, - $Oopt_MonadEtaExpansion, - $Oopt_UnfoldingUseThreshold, - $Oopt_MaxSimplifierIterations, - '\)', + $pvm_executable = $ENV{'PVM_ROOT'} . '/bin/' . $ENV{'PVM_ARCH'} + . "/$pvm_executable"; - '-fstrictness', + &run_something("$Rm -f $pvm_executable; $Cp -p $executable $pvm_executable && $Rm -f $executable", 'Moving binary to PVM land'); - '-fsimplify', - '\(', - $Oopt_FB_Support, - '-ffloat-lets-exposing-whnf', - '-ffloat-primops-ok', - '-fcase-of-case', - '-fdo-case-elim', - '-fcase-merge', - '-fdo-eta-reduction', - '-fdo-lambda-eta-expansion', - '-freuse-con', - '-flet-to-case', # Aha! Only done after strictness analysis - $Oopt_PedanticBottoms, - $Oopt_MonadEtaExpansion, - $Oopt_UnfoldingUseThreshold, - $Oopt_MaxSimplifierIterations, - '\)', + # OK, now create the magic script for "$executable" + open(EXEC, "> $executable") || &tidy_up_and_die(1,"$Pgm: couldn't open $executable to write!\n"); + print EXEC <= 0; - # flags for stg2stg - '-flet-no-escape', + &prepareWin32DllLink(0); - # SPECIAL FLAGS for -O2 - ($OptLevel == 2) ? ( - '-fsemi-tagging', - ) : (), - ); -\end{code} + local ($bld_dll) = "dllwrap"; -Sort out what we're going to do about optimising. First, the @hsc@ -flags and regular @cc@ flags to worry about: -\begin{code} -if ( $OptLevel <= 0 ) { + local ($output) = ($Specific_output_file ne '') ? "$Specific_output_file" : 'HSdll.dll'; + local ($output_dir); + local ($output_file); + local ($output_lib, $output_def); - # for this level, we tell the parser -fignore-interface-pragmas - push(@HsC_flags, '-fignore-interface-pragmas'); - # and tell the compiler not to produce them - push(@HsC_flags, '-fomit-interface-pragmas'); + ($output_dir = $output) =~ s|(.*/)[^/]+$|$1|; + $output_dir = "" if ($output_dir eq $output); + ($output_file = $output) =~ s|.*/([^/]+)$|$1|; - &add_Hsc_flags( @HsC_minusNoO_flags ); - push(@CcBoth_flags, ($MinusO2ForC) ? '-O2' : '-O'); # not optional! + ($output_lib = $output_file) =~ s|(.+)\.[^\.]*$|${output_dir}lib$1_imp.a|; + ($output_def = $output_file) =~ s|(.+)\.[^\.]*$|${output_dir}$1.def|; -} elsif ( $OptLevel == 1 || $OptLevel == 2 ) { + push (@Dll_flags, "-mno-cygwin --target=i386-mingw32") if ($TargetPlatform =~ /^.*mingw32$/); + push (@Dll_flags, "--output-lib $output_lib"); + # If the "--def " option hasn't been supplied, assume everything + # is going to be exported via the DLL.." + if (!grep(/--def/, @Dll_flags)) { + push (@Dll_flags, "--export-all --output-def $output_def"); + } - &add_Hsc_flags( @HsC_minusO_flags ); - push(@CcBoth_flags, ($MinusO2ForC || $OptLevel == 2) ? '-O2' : '-O'); # not optional! - # -O? to GCC is not optional! -O2 probably isn't worth it generally, - # but it *is* useful in compiling the garbage collectors (so said - # Patrick many moons ago...). + local($to_do) = "$bld_dll @Dll_flags -o $output @Link_file $libdirs @UserLibrary @SysLibrary"; + # Make sure the user sees this piece of magic. + print STDERR "$to_do\n" if (!$Verbose); + &run_something($to_do, 'DLL creator'); +} -} else { # -Ofile, then... +sub prepareWin32DllLink () +{ + local($linking_main) = @_; - &add_Hsc_flags( @HsC_minusO3_flags ); - push(@CcBoth_flags, ($MinusO2ForC) ? '-O2' : '-O'); # possibly to be elaborated... + # + # Win32 DLLs - link with import libraries, not the real archives. + # + if ( $TargetPlatform =~ /-mingw32$/ ) { + if (!$Static) { + # + # If the libraries have the form libHSfoo.a, we + # transform that into libHSfoo_imp.a - the import + # library of the DLL. + # + foreach $a ( @SysLibrary ) { + $a = "${a}_imp" if ($a =~ /^-lHS/); + } + foreach $a ( @UserLibrary ) { + $a = "${a}_imp" if ($a =~ /^-lHS/); + } + push(@Link_file, ( $INSTALLING ) ? "$InstLibDirGhc/Main.o" + : "$TopPwd/$CURRENT_DIR/$GHC_RUNTIME_DIR/Main.o") if $linking_main; + push(@Link_file, ( $INSTALLING ) ? "$InstLibDirGhc/PrelMain.o" + : "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/PrelMain.o") if $linking_main; + } + push(@Ld_flags, "-mno-cygwin"); + } } \end{code} + %************************************************************************ %* * -\subsection{Check for consistency, etc.} +\section[Driver-misc-utils]{Miscellaneous utilities} %* * %************************************************************************ -Sort out @$BuildTag@, @$PROFing@, @$CONCURing@, @$PARing@, -@$GRANing@, @$TICKYing@: -\begin{code} -if ( $BuildTag ne '' ) { - local($b) = $BuildDescr{$BuildTag}; - if ($CONCURing eq 'c') { print STDERR "$Pgm: Can't mix $b with -concurrent.\n"; exit 1; } - if ($PARing eq 'p') { print STDERR "$Pgm: Can't mix $b with -parallel.\n"; exit 1; } - if ($GRANing eq 'g') { print STDERR "$Pgm: Can't mix $b with -gransim.\n"; exit 1; } - if ($TICKYing eq 't') { print STDERR "$Pgm: Can't mix $b with -ticky.\n"; exit 1; } - - # ok to have a user-way profiling build - # eval the profiling opts ... but leave user-way BuildTag - if ($PROFing eq 'p') { eval($EvaldSetupOpts{'_p'}); } - -} elsif ( $PROFing eq 'p' ) { - if ($PARing eq 'p') { print STDERR "$Pgm: Can't do profiling with -parallel.\n"; exit 1; } - if ($GRANing eq 'g') { print STDERR "$Pgm: Can't do profiling with -gransim.\n"; exit 1; } - if ($TICKYing eq 't') { print STDERR "$Pgm: Can't do profiling with -ticky.\n"; exit 1; } - $BuildTag = ($CONCURing eq 'c') ? '_mr' : '_p' ; # possibly "profiled concurrent"... - -} elsif ( $CONCURing eq 'c' ) { - if ($PARing eq 'p') { print STDERR "$Pgm: Can't mix -concurrent with -parallel.\n"; exit 1; } - if ($GRANing eq 'g') { print STDERR "$Pgm: Can't mix -concurrent with -gransim.\n"; exit 1; } - $BuildTag = ($TICKYing eq 't') ? '_mt' : '_mc' ; # possibly "ticky concurrent"... - # "profiled concurrent" already acct'd for... - -} elsif ( $PARing eq 'p' ) { - if ($GRANing eq 'g') { print STDERR "$Pgm: Can't mix -parallel with -gransim.\n"; exit 1; } - if ($TICKYing eq 't') { print STDERR "$Pgm: Can't mix -parallel with -ticky.\n"; exit 1; } - $BuildTag = '_mp'; - - if ( $Do_lnkr && ( ! $ENV{'PVM_ROOT'} || ! $ENV{'PVM_ARCH'} )) { - print STDERR "$Pgm: both your PVM_ROOT and PVM_ARCH environment variables must be set for linking under -parallel.\n"; - exit(1); - } - -} elsif ( $GRANing eq 'g' ) { - if ($TICKYing eq 't') { print STDERR "$Pgm: Can't mix -gransim with -ticky.\n"; exit 1; } - $BuildTag = '_mg'; - -} elsif ( $TICKYing eq 't' ) { - $BuildTag = '_t'; -} -\end{code} +%************************************************************************ +%* * +\subsection[Driver-odir-ify]{@odir_ify@: Mangle filename if \tr{-odir} set} +%* * +%************************************************************************ \begin{code} -if ( $BuildTag ne '' ) { # something other than normal sequential... - - push(@HsP_flags, "-syshisuffix=$BuildTag.hi"); # use appropriate Prelude .hi files +sub osuf_ify { + local($ofile,$def_suffix) = @_; - $HscOut = '-C='; # must go via C + return(($Osuffix eq '') ? "$ofile.$def_suffix" : "$ofile.$Osuffix" ); +} - eval($EvaldSetupOpts{$BuildTag}); +sub odir_ify { + local($orig_file, $def_suffix) = @_; + if ($Specific_output_dir eq '') { # do nothing + &osuf_ify($orig_file, $def_suffix); + } else { + local ($orig_file_only); + ($orig_file_only = $orig_file) =~ s|.*/||; + &osuf_ify("$Specific_output_dir/$orig_file_only",$def_suffix); + } } \end{code} -Decide what the consistency-checking options are in force for this run: \begin{code} -$HsC_consist_options = "${BuildTag},${DEBUGging}"; -$Cc_consist_options = "${BuildTag},${DEBUGging}"; -\end{code} - -%************************************************************************ -%* * -\subsection{Add on machine-specific C-compiler flags} -%* * -%************************************************************************ - -Shove on magical machine-specific options. We use \tr{unshift} to -stick them on the {\em front} of the arrays, so that ``later'' -user-specified flags can clobber them (e.g., \tr{-U__STG_REV_TBLS__}). +sub runGcc { + local($is_hc_file, $hsc_out, $cc_as_o) = @_; -Note: a few ``always apply'' flags were set at the very beginning. + local($includes) = '-I' . join(' -I', @Include_dir); + local($cc); + local($s_output); + local($c_flags) = "@CcBoth_flags"; + local($ddebug_flag) = ( $DEBUGging ) ? '-DDEBUG' : ''; -\begin{code} -if ($TargetPlatform =~ /^alpha-/) { - # we know how to *mangle* asm for alpha - unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__')); - unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK; - unshift(@CcBoth_flags, ('-static')); - -} elsif ($TargetPlatform =~ /^hppa/) { - # we know how to *mangle* asm for hppa - unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__')); - unshift(@CcBoth_flags, ('-static')); - # We don't put in '-mlong-calls', because it's only - # needed for very big modules (sigh), and we don't want - # to hobble ourselves further on all the other modules - # (most of them). - unshift(@CcBoth_flags, ('-D_HPUX_SOURCE')); - # ___HPUX_SOURCE, not _HPUX_SOURCE, is #defined if -ansi! - # (very nice, but too bad the HP /usr/include files don't agree.) + $c_flags .= " -mno-cygwin" if ( $TargetPlatform =~ /-mingw32$/ ); -} elsif ($TargetPlatform =~ /^i386-/) { - # we know how to *mangle* asm for X86 - unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__')); - unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK; + # "input" files to use that are not in some weird directory; + # to help C compilers grok .hc files [ToDo: de-hackify] + local($cc_help) = "ghc$$.c"; + local($cc_help_s) = "ghc$$.s"; - # -fno-defer-pop : basically the same game as for m68k - # - # -fomit-frame-pointer : *must* ; because we're stealing - # the fp (%ebp) for our register maps. *All* register - # maps (in MachRegs.lh) must steal it. - - unshift(@CcRegd_flags_hc, '-fno-defer-pop'); - unshift(@CcRegd_flags, '-fomit-frame-pointer'); - unshift(@CcRegd_flags, "-DSTOLEN_X86_REGS=$StolenX86Regs"); - -} elsif ($TargetPlatform =~ /^m68k-/) { - # we know how to *mangle* asm for m68k - unshift (@CcRegd_flags, ('-D__STG_REV_TBLS__')); - unshift (@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK; - - # -fno-defer-pop : for the .hc files, we want all the pushing/ - # popping of args to routines to be explicit; if we let things - # be deferred 'til after an STGJUMP, imminent death is certain! - # - # -fomit-frame-pointer : *don't* - # It's better to have a6 completely tied up being a frame pointer - # rather than let GCC pick random things to do with it. - # (If we want to steal a6, then we would try to do things - # as on iX86, where we *do* steal the frame pointer [%ebp].) - - unshift(@CcRegd_flags_hc, '-fno-defer-pop'); - unshift(@CcRegd_flags, '-fno-omit-frame-pointer'); - # maybe gives reg alloc a better time - # also: -fno-defer-pop is not sufficiently well-behaved without it + $cc = $CcRegd; + $s_output = (($is_hc_file && $DoAsmMangling) || $TargetPlatform =~ /^(powerpc|rs6000|hppa)/) ? $cc_as_o : $cc_as; + $c_flags .= " @CcRegd_flags"; + $c_flags .= ($is_hc_file) ? " @CcRegd_flags_hc" : " @CcRegd_flags_c"; -} elsif ($TargetPlatform =~ /^mips-/) { - # we (hope to) know how to *mangle* asm for MIPSen - unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__')); - unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK; - unshift(@CcBoth_flags, ('-static')); + # C compiler won't like the .hc extension. So we create + # a tmp .c file which #include's the needful. + open(TMP, "> $cc_help") || &tidy_up_and_die(1,"$Pgm: failed to open `$cc_help' (to write)\n"); + if ( $is_hc_file ) { + print TMP <= 0; + } else { + # Straight .c files may want to know that they're being used + # with a particular version of GHC, so we define __GLASGOW_HASKELL__ for their benefit. + print TMP "#define __GLASGOW_HASKELL__ ${ProjectVersionInt}\n"; + } + # heave in the consistency info + print TMP "static char ghc_cc_ID[] = \"\@(#)cc $ifile\t$Cc_major_version.$Cc_minor_version,$Cc_consist_options\";\n"; -} elsif ($TargetPlatform =~ /^powerpc-/) { - # we know how to *mangle* asm for PowerPC - unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__')); - unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK; - unshift(@CcBoth_flags, ('-static')); # always easier to start with - unshift(@CcRegd_flags, ('-finhibit-size-directive')); # avoids traceback tables + print TMP "#include \"$hsc_out\"\n"; + close(TMP) || &tidy_up_and_die(1,"Failed writing to $cc_help\n"); -} elsif ($TargetPlatform =~ /^sparc-/) { - # we know how to *mangle* asm for SPARC - unshift(@CcRegd_flags, ('-D__STG_REV_TBLS__')); - unshift(@CcRegd_flags, ('-DSTACK_CHECK_BY_PAGE_FAULT=1')) if $StkChkByPageFaultOK; + # Don't redirect stderr into intermediate file if slamming output onto stdout (e.g., with -E) + local($fuse_stderr) = "2>&1" if ! $Only_preprocess_hc; + local($to_do) = "$cc $Verbose $ddebug_flag $c_flags @Cpp_define $includes $cc_help > $Tmp_prefix.ccout $fuse_stderr && ( if [ $cc_help_s != $s_output ] ; then mv $cc_help_s $s_output ; else exit 0 ; fi )"; + if ( $Only_preprocess_hc ) { # HACK ALERT! + $to_do =~ s/ -S\b//g; + } + push(@Files_to_tidy, $cc_help, $cc_help_s, $s_output ); + $PostprocessCcOutput = 1 if ! $Only_preprocess_hc; # hack, dear hack... + &run_something($to_do, 'C compiler'); + $PostprocessCcOutput = 0; + if ( $Only_preprocess_hc ) { + system("$Cat $Tmp_prefix.ccout"); + } + unlink($cc_help, $cc_help_s); } \end{code} -Same unshifting magic, but for special linker flags. +\begin{code} +sub runMangler { + local($is_hc_file, $cc_as_o, $cc_as, $ifile_root) = @_; -Should really be whether or not we prepend underscores to global symbols, -not an architecture test. (JSM) + print STDERR `cat $cc_as_o` if $Dump_raw_asm; # to stderr, before mangling -\begin{code} -$Under = ( $TargetPlatform =~ /^alpha-/ - || $TargetPlatform =~ /^hppa/ - || $TargetPlatform =~ /^mips-sgi-irix/ - || $TargetPlatform =~ /^powerpc-/ - || $TargetPlatform =~ /-solaris/ - || $TargetPlatform =~ /-linux$/ - ) - ? '' : '_'; - -unshift(@Ld_flags, - (($Ld_main) ? ( - '-u', "${Under}Main_" . $Ld_main . '_closure', - ) : (), - '-u', "${Under}GHCbase_unsafePerformPrimIO_fast1", - '-u', "${Under}Prelude_Z91Z93_closure", # i.e., [] - '-u', "${Under}Prelude_IZh_static_info", - '-u', "${Under}Prelude_False_inregs_info", - '-u', "${Under}Prelude_True_inregs_info", - '-u', "${Under}Prelude_CZh_static_info", - '-u', "${Under}DEBUG_REGS")) - ; # just for fun, now... -\end{code} + if ($is_hc_file && $DoAsmMangling) { + # dynamically load assembler-fiddling code, which we are about to use: + require('ghc-asm.prl') + || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm.prl!\n"); + # post-process the assembler [.hc files only] + &mangle_asm($cc_as_o, $cc_as); -%************************************************************************ -%* * -\subsection{Set up include paths and system-library enslurpment} -%* * -%************************************************************************ + } elsif ($TargetPlatform =~ /^hppa/) { + # minor mangling of non-threaded files for hp-pa only + require('ghc-asm.prl') + || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm-hppa.prl!\n"); + &mini_mangle_asm_hppa($cc_as_o, $cc_as); -Now that we know what garbage-collector, etc., are required, we can -finalise our list of libraries to slurp through, and generally Get -Ready for Business. + } elsif ($TargetPlatform =~ /^powerpc|^rs6000/) { + # minor mangling of non-threaded files for powerpcs and rs6000s + require('ghc-asm.prl') + || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm-powerpc.prl!\n"); + &mini_mangle_asm_powerpc($cc_as_o, $cc_as); + } -\begin{code} -# default includes must be added AFTER option processing -if ( ! $(INSTALLING) ) { - push (@Include_dir, "$TopPwd/$(CURRENT_DIR)/$(GHC_INCLUDESRC)"); -} else { - push (@Include_dir, "$InstLibDirGhc/includes"); - push (@Include_dir, "$InstDataDirGhc/includes"); + # save a copy of the .s file, even if we are carrying on... + #if ($do_as && $Keep_s_file_too) { + # &saveIntermediate($ifile_root , "s" , $cc_as); + #} } \end{code} \begin{code} -push(@SysLibrary, ( '-lHS', '-lHS_cbits' )); # basic I/O and prelude stuff +sub runAs { + local($as_out, $ifile_root) = @_; -local($f); -foreach $f (@SysLibrary) { - next if $f =~ /_cbits/; - $f .= $BuildTag if $f =~ /^-lHS/; -} + local($asmblr) = ( $As ) ? $As : $CcRegd; -# fiddle the TopClosure file name... -$TopClosureFile =~ s/XXXX//; - -# Push library HSrts, plus boring clib bit -push(@SysLibrary, "-lHSrts${BuildTag}"); -push(@SysLibrary, '-lHSclib'); - -# Push the pvm libraries -if ($BuildTag eq '_mp') { - $pvmlib = "$ENV{'PVM_ROOT'}/lib/$ENV{'PVM_ARCH'}"; - push(@SysLibrary, "-L$pvmlib", '-lpvm3', '-lgpvm3'); - if ( $ENV{'PVM_ARCH'} eq 'SUNMP' ) { - push(@SysLibrary, '-lthread', '-lsocket', '-lnsl'); - } elsif ( $ENV{'PVM_ARCH'} eq 'SUN4SOL2' ) { - push(@SysLibrary, '-lsocket', '-lnsl'); - } -} + # need to add the -I flags in case the file is going through cpp (.S files) + local($includes) = '-I' . join(' -I', @Include_dir); -# Push the GNU multi-precision arith lib; and the math library -push(@SysLibrary, '-lgmp'); -push(@SysLibrary, '-lm'); -\end{code} + if ( ! $SplitObjFiles ) { + local($to_do) = "$asmblr -o $as_out -c @As_flags $includes $cc_as"; + push(@Files_to_tidy, $as_out ); + &run_something($to_do, 'Unix assembler'); -%************************************************************************ -%* * -\subsection{Check that this system was built to do what we are asking} -%* * -%************************************************************************ + } else { # more complicated split-ification... -Before continuing we check that the appropriate build is available. + # must assemble files $Tmp_prefix__[1 .. $NoOfSplitFiles].s -\begin{code} -die "$Pgm: no BuildAvail?? $BuildTag\n" if ! $BuildAvail{$BuildTag}; # sanity + # If -odir is used, great, just pin it in front of the + # generated split file names. If it hasn't been set, we + # snatch it from the ifile_root. + # + # -if ( $BuildAvail{$BuildTag} =~ /^-build-.*-not-defined$/ ) { - print STDERR "$Pgm: a `", $BuildDescr{$BuildTag}, - "' \"build\" is not available with your GHC setup.\n"; - print STDERR "(It was not configured for it at your site.)\n"; - print STDERR $ShortUsage; - exit 1; + if ( $Specific_output_dir eq '' ) { + $Specific_output_dir = ${ifile_root}; + } + + for ($f = 1; $f <= $NoOfSplitFiles; $f++ ) { + local($split_out) = &odir_ify("${ifile_root}__${f}",'o'); + local($to_do) = "$asmblr -o $split_out -c @As_flags ${Tmp_prefix}__${f}.s"; + push(@Files_to_tidy, $split_out ); + + &run_something($to_do, 'Unix assembler'); + } + } } \end{code} %************************************************************************ %* * -\subsection{Final miscellaneous setup bits before we start going} +\subsection[Driver-run-something]{@run_something@: Run a phase} %* * %************************************************************************ -Record largest specific heapsize, if any. \begin{code} -$Specific_heap_size = $Specific_heap_size * $Scale_sizes_by; -push(@HsC_rts_flags, '-H'.$Specific_heap_size); -$Specific_stk_size = $Specific_stk_size * $Scale_sizes_by; -push(@HsC_rts_flags, "-K$Specific_stk_size"); +sub run_something { + local($str_to_do, $tidy_name) = @_; -# hack to avoid running hscpp -$HsCpp = $Cat if ! $Cpp_flag_set; -\end{code} + print STDERR "\n$tidy_name:\n\t" if $Verbose; + print STDERR "$str_to_do\n" if $Verbose; -If no input or link files seen, then we let 'em feed in stdin; this is -mainly for debugging. -\begin{code} -if ($#Input_file < 0 && $#Link_file < 0) { - @Input_file = ( '-' ); + if ($Using_dump_file) { + open(DUMP, ">> $Specific_dump_file") + || &tidy_up_and_die(1,"$Pgm: failed to open `$Specific_dump_file'\n"); + print DUMP "\nCompilation Dump for: $str_to_do\n\n"; + close(DUMP) + || &tidy_up_and_die(1,"$Pgm: failed closing `$Specific_dump_file'\n"); + } + + local($return_val) = 0; - open(INF, "> $Tmp_prefix.hs") || &tidy_up_and_die(1,"Can't open $Tmp_prefix.hs\n"); - print STDERR "Enter your Haskell program, end with ^D (on a line of its own):\n"; - while (<>) { print INF $_; } - close(INF) || &tidy_up_and_die(1,"Failed writing to $Tmp_prefix.hs\n"); -} -\end{code} + if ( length($str_to_do) > 4000) { + # 4000 - on the random side, just like the *real* ARG_MAX + # for some shells. + + # With some shells, command lines of this length may + # very well cause trouble. To safeguard against this, we squirrel the + # command into a file and exec that. + local ($sh) = $ENV{'REAL_SHELL'}; + print STDERR "Backup plan A: saving cmd line in ${Tmp_prefix}.sh and executing that with $sh\n" if $Verbose; + open (TEMP, "> ${Tmp_prefix}.sh") || + &tidy_up_and_die(1,"$Pgm: failed to open `$Tmp_prefix.sh'\n"); + print TEMP "$Time $str_to_do\n"; + close (TEMP) || + &tidy_up_and_die(1,"$Pgm: failed closing `$Tmp_prefix.sh'\n"); + system("$sh $Tmp_prefix.sh"); + $return_val = $?; + + unlink "${Tmp_prefix}.sh"; + } else { + system("$Time $str_to_do"); + $return_val = $?; + } -Tell the world who we are, if they asked. -\begin{code} -print STDERR "$(PROJECTNAME), version $(PROJECTVERSION) $(PROJECTPATCHLEVEL)\n" - if $Verbose; + if ( $PostprocessCcOutput ) { # hack, continued + open(CCOUT, "< $Tmp_prefix.ccout") + || &tidy_up_and_die(1,"$Pgm: failed to open `$Tmp_prefix.ccout'\n"); + while ( ) { + next if /call-clobbered/; + next if /control reaches end/; + next if /from .*Stg\.h:/; + next if /from ghc\d+.c:\d+:/; + next if /: At top level:$/; + next if /: In function \`.*\':$/; + next if /\`ghc_cc_ID\' defined but not used/; + print STDERR $_; + } + close(CCOUT) || &tidy_up_and_die(1,"$Pgm: failed closing `$Tmp_prefix.ccout'\n"); + } + + if ($return_val != 0) { + if ($Using_dump_file) { + print STDERR "Compilation Errors dumped in $Specific_dump_file\n"; + } + &tidy_up_and_die($return_val, ''); + } + $Using_dump_file = 0; +} \end{code} %************************************************************************ %* * -\section[Driver-main-loop]{Main loop: Process input files, and link if required} +\subsection[Driver-ghc-timing]{Emit nofibbish GHC timings} %* * %************************************************************************ -Process the input files; don't continue with linking if there are -problems (global variable @$Status@ non-zero). -\begin{code} -foreach $ifile (@Input_file) { - &ProcessInputFile($ifile); -} - -if ( $Status > 0 ) { # don't link if there were errors... - print STDERR $ShortUsage; - &tidy_up(); - exit $Status; -} -\end{code} +NB: nearly the same as in @runstdtest@ script. -Link if appropriate. \begin{code} -if ($Do_lnkr) { - local($libdirs) = ''; - - # glue them together: - push(@UserLibrary_dir, @SysLibrary_dir); - - $libdirs = '-L' . join(' -L',@UserLibrary_dir) if $#UserLibrary_dir >= 0; - - # for a linker, use an explicitly given one, or the going C compiler ... - local($lnkr) = ( $Lnkr ) ? $Lnkr : $CcRegd; - - local($output) = ($Specific_output_file ne '') ? "-o $Specific_output_file" : ''; - @Files_to_tidy = ($Specific_output_file ne '') ? $Specific_output_file : 'a.out'; +sub process_ghc_timings { + local($StatsFile) = "$Tmp_prefix.stat"; + local($SysSpecificTiming) = 'ghc'; - local($to_do) = "$lnkr $Verbose @Ld_flags $output @Link_file $TopClosureFile $libdirs @UserLibrary @SysLibrary"; - &run_something($to_do, 'Linker'); + open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n"; + local($max_live) = 0; + local($tot_live) = 0; # for calculating residency stuff + local($tot_samples) = 0; - # finally, check the consistency info in the binary - local($executable) = $Files_to_tidy[0]; - @Files_to_tidy = (); # reset; we don't want to nuke it if it's inconsistent + while () { + if (! /Gen:\s+0/ && ! /Minor/ && /^\s*\d+\s+\d+\s+(\d+)\s+\d+\.\d+/ ) { + $max_live = $1 if $max_live < $1; + $tot_live += $1; + $tot_samples += 1; + } + $BytesAlloc = $1 if /^\s*([0-9,]+) bytes allocated in the heap/; - if ( $LinkChk ) { - # dynamically load consistency-chking code; then do it. - require('ghc-consist.prl') - || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-consist.prl!\n"); + if ( /^\s*([0-9,]+) bytes maximum residency .* (\d+) sample/ ) { + $MaxResidency = $1; $ResidencySamples = $2; + } - &chk_consistency_info ( $executable ); - } + $GCs = $1 if /^\s*([0-9,]+) (collections? in generation 0|garbage collections? performed)/; - # if PVM parallel stuff, we do truly weird things. - # Essentially: (1) move the executable over to where PVM expects - # to find it. (2) create a script in place of the executable - # which will cause the program to be run, via SysMan. - if ( $PARing eq 'p' ) { - local($pvm_executable) = $executable; - local($pvm_executable_base); + if ( /^\s+([0-9]+)\s+Mb total memory/ ) { + $TotMem = $1; + } - if ( $pvm_executable !~ /^\// ) { # a relative path name: make absolute - local($pwd) = `pwd`; - chop($pwd); - $pwd =~ s/^\/tmp_mnt//; - $pvm_executable = "$pwd/$pvm_executable"; + # The presence of -? in the following pattern is only there to + # accommodate 0.29 && <= 2.05 RTS' + if ( /^\s*INIT\s+time\s*(\d+\.\d\d)s\s*\(\s*-?(\d+\.\d\d)s elapsed\)/ ) { + $InitTime = $1; $InitElapsed = $2; + } elsif ( /^\s*MUT\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) { + $MutTime = $1; $MutElapsed = $2; + } elsif ( /^\s*GC\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) { + $GcTime = $1; $GcElapsed = $2; } + } + close(STATS) || die "Failed when closing $StatsFile\n"; + if ( $tot_samples > 0 ) { + $ResidencySamples = $tot_samples; + $MaxResidency = $max_live; + $AvgResidency = int ($tot_live / $tot_samples) ; + } - $pvm_executable =~ s|/|=|g; # make /s into =s - $pvm_executable_base = $pvm_executable; + # warn about what we didn't find + print STDERR "Warning: BytesAlloc not found in stats file\n" unless defined($BytesAlloc); + print STDERR "Warning: GCs not found in stats file\n" unless defined($GCs); + print STDERR "Warning: InitTime not found in stats file\n" unless defined($InitTime); + print STDERR "Warning: InitElapsed not found in stats file\n" unless defined($InitElapsed); + print STDERR "Warning: MutTime not found in stats file\n" unless defined($MutTime); + print STDERR "Warning: MutElapsed not found in stats file\n" unless defined($MutElapsed); + print STDERR "Warning: GcTime inot found in stats file\n" unless defined($GcTime); + print STDERR "Warning: GcElapsed not found in stats file\n" unless defined($GcElapsed); - $pvm_executable = $ENV{'PVM_ROOT'} . '/bin/' . $ENV{'PVM_ARCH'} - . "/$pvm_executable"; + # things we didn't necessarily expect to find + $MaxResidency = 0 unless defined($MaxResidency); + $AvgResidency = 0 unless defined($AvgResidency); + $ResidencySamples = 0 unless defined($ResidencySamples); - &run_something("$Rm -f $pvm_executable; $Cp -p $executable $pvm_executable && $Rm -f $executable", 'Moving binary to PVM land'); + # a bit of tidying + $BytesAlloc =~ s/,//g; + $MaxResidency =~ s/,//g; + $GCs =~ s/,//g; + $InitTime =~ s/,//g; + $InitElapsed =~ s/,//g; + $MutTime =~ s/,//g; + $MutElapsed =~ s/,//g; + $GcTime =~ s/,//g; + $GcElapsed =~ s/,//g; - # OK, now create the magic script for "$executable" - open(EXEC, "> $executable") || &tidy_up_and_die(1,"$Pgm: couldn't open $executable to write!\n"); - print EXEC <>\n"; - print EXEC <<\EOSCRIPT2; -# first, some magical shortcuts to run "commands" on the binary -# (which is hidden) -if ($#ARGV == 1 && $ARGV[0] eq '+RTS' && $ARGV[1] =~ /^--((size|file|strip|rm|nm).*)/ ) { - local($cmd) = $1; - system("$cmd $pvm_executable"); - exit(0); # all done + # OK, party over + unlink $StatsFile; } +\end{code} -# OK, really run it; process the args first -$ENV{'PE'} = $pvm_executable_base; -$debug = ''; -$nprocessors = 2; # the default -@nonPVM_args = (); -$in_RTS_args = 0; +%************************************************************************ +%* * +\subsection[Driver-dying]{@tidy_up@ and @tidy_up_and_die@: Dying gracefully} +%* * +%************************************************************************ -# ToDo: handle --RTS -args: while ($a = shift(@ARGV)) { - if ( $a eq '+RTS' ) { - $in_RTS_args = 1; - } elsif ( $a eq '-RTS' ) { - $in_RTS_args = 0; - } - if ( $a eq '-d' && $in_RTS_args ) { - $debug = '-'; - } elsif ( $a =~ /^-N(\d+)/ && $in_RTS_args ) { - $nprocessors = $1; - } else { - push(@nonPVM_args, $a); +\begin{code} +sub tidy_up { + local($to_do) = "\n$Rm $Tmp_prefix*"; + if ( $Tmp_prefix !~ /^\s*$/ ) { + print STDERR "$to_do\n" if $Verbose; + system($to_do); } } -local($return_val) = 0; -system("$SysMan $debug $pvm_executable $nprocessors @nonPVM_args"); -$return_val = $?; -system("mv $ENV{'HOME'}/$pvm_executable_base.???.gr .") if -f "$ENV{'HOME'}/$pvm_executable_base.001.gr"; -exit($return_val); -EOSCRIPT2 - close(EXEC) || die "Failed closing $executable\n"; - chmod 0755, $executable; - } -} +sub tidy_up_and_die { + local($return_val, $msg) = @_; -# that... that's all, folks! -&tidy_up(); -exit $Status; # will still be 0 if all went well + # delete any files to tidy + print STDERR "deleting... @Files_to_tidy\n" if $Verbose && $#Files_to_tidy >= 0; + unlink @Files_to_tidy if $#Files_to_tidy >= 0; + + &tidy_up(); + print STDERR $msg; + exit (($return_val == 0) ? 0 : 1); +} \end{code} %************************************************************************ %* * -\section[Driver-do-one-file]{How to process a single input file} +\subsection[Driver-arg-with-arg]{@grab_arg_arg@: Do an argument with an argument} %* * %************************************************************************ +Some command-line arguments take an argument, e.g., +\tr{-Rmax-heapsize} expects a number to follow. This can either be +given a part of the same argument (\tr{-Rmax-heapsize8M}) or as the +next argument (\tr{-Rmax-heapsize 8M}). We allow both cases. + +Note: no error-checking; \tr{-Rmax-heapsize -Rgc-stats} will silently +gobble the second argument (and probably set the heapsize to something +nonsensical). \begin{code} -sub ProcessInputFile { - local($ifile) = @_; # input file name - local($ifile_root); # root of or basename of input file - local($ofile_target); # ultimate output file we hope to produce - # from input file (need to know for recomp - # checking purposes) - local($hifile_target);# ditto (but .hi file) +sub grab_arg_arg { + local(*Args, $option, $rest_of_arg) = @_; + + if ($rest_of_arg ne '') { + return($rest_of_arg); + } elsif ($#Args >= 0) { + local($temp) = $Args[0]; shift(@Args); + return($temp); + } else { + print STDERR "$Pgm: no argument following $option option\n"; + $Status++; + } +} \end{code} -Handle the weirdity of input from stdin. \begin{code} - if ($ifile ne '-') { - ($ifile_root = $ifile) =~ s/\.[^\.\/]+$//; - $ofile_target = # may be reset later... - ($Specific_output_file ne '' && ! $Do_lnkr) - ? $Specific_output_file - : &odir_ify($ifile_root, 'o'); - $hifile_target= ($Specific_hi_file ne '') - ? $Specific_hi_file - : "$ifile_root.$HiSuffix"; # ToDo: odirify? - # NB: may change if $ifile_root isn't module name (??) - } else { - $ifile = "$Tmp_prefix.hs"; # we know that's where we put the input - $ifile_root = '_stdin'; - $ofile_target = '_stdout'; # gratuitous? - $hifile_target= '_stdout'; # ditto? +sub isntAntiFlag { + local($flag) = @_; + local($f); + +#Not in HsC_antiflag ## NO!: and not already in HsC_flags + + foreach $f ( @HsC_antiflags ) { + return(0) if $flag eq $f; + } +# foreach $f ( @HsC_flags ) { +# return(0) if $flag eq $f; +# } + return(1); +} + +sub squashHscFlag { # pretty terrible + local($flag) = @_; + local($f); + + foreach $f ( @HsC_flags ) { + if ($flag eq $f) { $f = ''; } } -\end{code} +} -We need to decide what phases of the compilation system we will run -over this file. The defaults are the ones established when processing -flags. (That established what the last phase run for all files is.) +sub add_Hsc_flags { + local(@flags) = @_; + local($f); -We do the pre-recompilation-checker phases here; the rest later. -\begin{code} + foreach $f ( @flags ) { + push( @HsC_flags, $f ) if &isntAntiFlag($f); + } +} \end{code} -Look at the suffix and decide what initial phases of compilation may -be dropped off for this file. Also the rather boring business of -which files are coming-in/going-out. +To add another system library, you'll need to augment the +Supported_syslibs variable with name and info on your addition +to the syslib family. The info bit consist of the following: -Again, we'll do the post-recompilation-checker parts of this later. -\begin{code} - local($do_lit2pgm) = ($ifile =~ /\.lhs$/) ? 1 : 0; - local($do_hscpp) = 1; # but "hscpp" might really be "cat" - local($do_hsc) = 1; - local($do_cc) = ( $Do_cc != -1) # i.e., it was set explicitly - ? $Do_cc - : ( ($HscOut eq '-C=') ? 1 : 0 ); - local($do_as) = $Do_as; + - interface file directory + see the misc or posix entry for how to distinguish + between using installed and build tree directories. + + - directory location of archives + + - location of (way-independent) C support libs. + not all libraries need this - if you don't, just + give the empty string. + - list of syslibs you depend on. - # names of the files to stuff between phases - # defaults are temporaries - local($in_lit2pgm) = $ifile; - local($lit2pgm_hscpp) = "$Tmp_prefix.lpp"; - local($hscpp_hsc) = "$Tmp_prefix.cpp"; - local($hsc_out) = ( $HscOut eq '-C=' ) ? "$Tmp_prefix.hc" : "$Tmp_prefix.s" ; - local($hsc_hi) = "$Tmp_prefix.hi"; - local($cc_as_o) = "${Tmp_prefix}_o.s"; # temporary for raw .s file if opt C - local($cc_as) = "$Tmp_prefix.s"; # mangled or hsc-produced .s code - local($as_out) = $ofile_target; + - additional ghc command line flags that should be used. + - additional C compiler command line flags that should be used. + - link - local($is_hc_file) = 1; #Is the C code .hc or .c? Assume .hc for now - if ($ifile =~ /\.lhs$/) { - ; # nothing to change - } elsif ($ifile =~ /\.hs$/) { - $do_lit2pgm = 0; - $lit2pgm_hscpp = $ifile; - } elsif ($ifile =~ /\.hc$/ || $ifile =~ /_hc$/ ) { # || $ifile =~ /\.$Isuffix$/o) # ToDo: better - $do_lit2pgm = 0; $do_hscpp = 0; $do_hsc = 0; $do_cc = 1; - $hsc_out = $ifile; - } elsif ($ifile =~ /\.c$/) { - $do_lit2pgm = 0; $do_hscpp = 0; $do_hsc = 0; $do_cc = 1; - $hsc_out = $ifile; $is_hc_file = 0; - } elsif ($ifile =~ /\.s$/) { - $do_lit2pgm = 0; $do_hscpp = 0; $do_hsc = 0; $do_cc = 0; - $cc_as = $ifile; - } else { # don't know what it is, but nothing to do herein... - $do_lit2pgm = 0; $do_hscpp = 0; $do_hsc = 0; $do_cc = 0; $do_as = 0; +\begin{code} + +# Hash to keep track of +%Syslibs_added = (); + +sub add_syslib { + local($syslib) = @_; + + # Lifting this out of this sub brings it out of scope - why?? + %Supported_syslibs = + ( exts, + [ # where to slurp interface files from + ( $INSTALLING + ? "$InstLibDirGhc/imports/exts" + : "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/exts" + ) + , # where to find the archive to use when linking + ( $INSTALLING + ? "$InstLibDirGhc" + : "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/exts" + ) + , '' # no cbits + , '' # Syslib dependencies + , '' # extra ghc opts + , '' # extra cc opts + , '' # extra ld opts + ], + + misc, + [ # where to slurp interface files from + ( $INSTALLING + ? "$InstLibDirGhc/imports/misc" + : "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/misc" + ) + , # where to find the archive to use when linking + ( $INSTALLING + ? "$InstLibDirGhc" + : "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/misc" + ) + , # where to find the cbits archive to use when linking + ( $INSTALLING + ? "$InstLibDirGhc" + : "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/misc/cbits" + ) + , 'exts' # Syslib dependencies + , '' # extra ghc opts + , '' # extra cc opts + , ( $TargetPlatform =~ /-solaris2$/ ? '-lnsl -lsocket' : '') + ], + hbc, + [ # where to slurp interface files from + ( $INSTALLING + ? "$InstLibDirGhc/imports/hbc" + : "$TopPwd/CONTRIB/libraries/hbc/src" + ) + , # where to find the archive to use when linking + ( $INSTALLING + ? "$InstLibDirGhc" + : "$TopPwd/CONTRIB/libraries/src/hbc" + ) + , # where to find the cbits archive to use when linking + ( $INSTALLING + ? "$InstLibDirGhc" + : "$TopPwd/CONTRIB/libraries/hbc/cbits" + ) + , 'exts' # Syslib dependencies + , '' # extra ghc opts + , '' # extra cc opts + , '' + ], + posix, + [ # where to slurp interface files from + ( $INSTALLING + ? "$InstLibDirGhc/imports/posix" + : "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/posix" + ) + , # where to find the archive to use when linking + ( $INSTALLING + ? "$InstLibDirGhc" + : "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/posix" + ) + , # where to find the cbits archive to use when linking + ( $INSTALLING + ? "$InstLibDirGhc" + : "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/posix/cbits" + ) + , 'misc' # Syslib dependencies + , '' # extra ghc opts + , '' # extra cc opts + , '' # extra ld opts + ], + concurrent, + [ # where to slurp interface files from + ( $INSTALLING + ? "$InstLibDirGhc/imports/concurrent" + : "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/concurrent" + ) + , # where to find the archive to use when linking + ( $INSTALLING + ? "$InstLibDirGhc" + : "$TopPwd/$CURRENT_DIR/$GHC_LIB_DIR/concurrent" + ) + , '' # where to find the cbits archive to use when linking + , '' # Syslib dependencies + , '' # extra ghc opts + , '' # extra cc opts + , '' # extra ld opts + ], + win32, + [ # where to slurp interface files from + ( $INSTALLING + ? "$InstLibDirGhc/imports/win32" + : "$TopPwd/hslibs/win32/src" + ) + , # where to find the archive to use when linking + ( $INSTALLING + ? "$InstLibDirGhc" + : "$TopPwd/hslibs/win32/src" + ) + , '' + , 'exts' # Syslib dependencies + , '' # extra ghc opts + , '' # extra cc opts + , '-luser32 -lgdi32' # extra ld opts + ], + com, + [ # where to slurp interface files from + ( $INSTALLING + ? "$InstLibDirGhc/imports/com" + : "$TopPwd/hdirect/lib" + ) + , # where to find the archive to use when linking + ( $INSTALLING + ? "$InstLibDirGhc" + : "$TopPwd/hdirect/lib" + ) + , '' + , 'exts' # Syslib dependencies + , '' # extra ghc opts + , '' # extra cc opts + , '-luser32 -lole32 -loleaut32 -ladvapi32' + # extra ld opts + ] + ); + + # check if it's supported.. + + if ( !exists $Supported_syslibs{$syslib} ) { + print STDERR "$Pgm: no such system library (-syslib): $syslib\n"; + $Status++; + return; } - # OK, have a bash on the first two phases: - &runLit2pgm($in_lit2pgm, $lit2pgm_hscpp) - if $do_lit2pgm; + # This check is here to avoid syslib loops from + # spoiling the party. A side-effect of it is that + # it disallows multiple mentions of a syslib on a command-line, + # explicit *and* implicit ones (i.e., "-syslib exts -syslib misc" + # is not equal to "-syslib exts -syslib misc -syslib exts", + # which it needs to be) + # + # Since our current collection of syslibs don't have any + # loops, this test is disabled. + # + # ToDo: loop avoidance scheme when the need arises + # + #return if ( exists $Syslibs_added{$syslib} ); + + $Syslibs_added{$syslib} = 1; - &runHscpp($in_lit2pgm, $lit2pgm_hscpp, $hscpp_hsc) - if $do_hscpp; -\end{code} + local ($hi_dir, $lib_dir, $lib_cbits_dir, + $syslib_deps, $syslib_ghc_opts, + $syslib_cc_opts, $syslib_ld_opts) = @{ $Supported_syslibs{$syslib} }; -We now think about whether to run hsc/cc or not (when hsc produces .s -stuff, it effectively takes the place of both phases). -To get the output file name right: for each phase that we are {\em -not} going to run, set its input (i.e., the output of its preceding -phase) to @"$ifile_root."@. -\begin{code} - local($going_interactive) = $HscOut eq '-N=' || $ifile_root eq '_stdin'; + unshift(@SysImport_dir, $hi_dir); + push(@SysLibrary_dir, $lib_dir); + push(@SysLibrary_dir, $lib_cbits_dir) if ( $lib_cbits_dir ne ''); - if (! $do_cc && ! $do_as) { # stopping after hsc - $hsc_out = ($Specific_output_file ne '') - ? $Specific_output_file - : &odir_ify($ifile_root, ($HscOut eq '-C=') ? 'hc' : 's'); + push(@SysLibrary, "-lHS$syslib"); + push(@SysLibrary, "-lHS${syslib}_cbits") if ( $lib_cbits_dir ne ''); + push(@SysLibrary, $syslib_ld_opts) if ($syslib_ld_opts ne ''); - $ofile_target = $hsc_out; # reset + # Add on any extra dependencies. + foreach $lib (split(' ',$syslib_deps)) { + &add_syslib($lib); } +} +\end{code} - if (! $do_as) { # stopping after gcc (or hsc) - $cc_as = ($Specific_output_file ne '') - ? $Specific_output_file - : &odir_ify($ifile_root, ( $Only_preprocess_C ) ? 'i' : 's'); +Source files may have {-# OPTIONS ... #-} pragmas at the top, containing +command line options we want to append to collection of commands specified +directly. @check_for_source_options@ looks at the top of a de-lit'ified Haskell +file for any such pragmas: - $ofile_target = $cc_as; # reset +\begin{code} +sub check_for_source_options { + local($file,$ifile) = @_; + local($comment_start,$comment_end); + + if ($ifile =~ /\.hc$/ || + $ifile =~ /_hc$/ || + $ifile =~ /\.s$/ || + $ifile =~ /_s$/ ) { # `Real' C intermediate + $comment_start = "/\\*"; + $comment_end = "\\*/"; + } else { # Assume it is a file containing Haskell source + $comment_start = "{-#"; + $comment_end = "#-}"; } + open(FILE,$file) || return(1); # No big loss + + while () { + if ( /^${comment_start} OPTIONS (.*)${comment_end}$/ ) { + # add the options found at the back of the command line. + local(@entries) = split(/\s+/,$1); + print STDERR "Found OPTIONS " . join(' ',@entries) . " in $file\n" if $Verbose; + push(@File_options, @entries); + } + elsif ( /^$/ ) { # ignore empty lines + ; + } + elsif ( /^#line.+$/ ) { # ignore comment lines (unused..ToDo: rm ) + ; + } + elsif ( /^{-# LINE.+$/ ) { # ignore line pragmas + ; + } + else { # stop looking, something non-empty / not + # ${comment_start} OPTIONS .. ${comment_end} encountered. + close(FILE);return(0); + } + } + close(FILE); + return(0); +} \end{code} -Check if hsc needs to be run at all. + +We split the initial argv up into three arrays: + + - @Cmd_opts + - @Link_file + - @Input_file + +the reason for doing so is to be able to deal +with {-# OPTIONS #-} pragma in source files properly. \begin{code} - local($more_processing_required) = 1; +sub splitCmdLine { + local(@args) = @_; - if ( $Do_recomp_chkr && $do_hsc && ! $going_interactive ) { - # recompilation-checking is important enough to live off by itself - require('ghc-recomp.prl') - || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-recomp.prl!\n"); +arg: while($_ = $args[0]) { + shift(@args); + # sigh, we have to deal with these -option arg specially here. + /^-(tmpdir|odir|ohi|o|isuf|osuf|hisuf|odump|syslib)$/ && + do { push(@Cmd_opts, $_); push(@Cmd_opts,$args[0]); shift(@args); next arg; }; + /^--?./ && do { push(@Cmd_opts, $_); next arg; }; - $more_processing_required - = &runRecompChkr($ifile, $hscpp_hsc, $ifile_root, $ofile_target, $hifile_target); + if (/\.([^_]+_)?[oa]$/) { + push(@Link_file, $_); + } else { + push(@Input_file, $_); + } - if ( ! $more_processing_required ) { - print STDERR "$Pgm:recompile: NOT NEEDED!\n"; # Yay! - # propagate dependency: - &run_something("touch $ofile_target", "Touch $ofile_target, to propagate dependencies"); - } + # input files must exist: + if (! -f $_) { + print STDERR "$Pgm: input file doesn't exist: $_\n"; + $Status++; } + } +} - $do_hsc = 0, $do_cc = 0, $do_as = 0 if ! $more_processing_required; \end{code} +When saving an intermediate file (.hc or .s) away, we +have to prefix any OPTIONS found in the original source file. + \begin{code} - if ( $do_hsc ) { +sub saveIntermediate { + local ($final,$suffix,$tmp)= @_ ; + local ($to_do); + + # $final -- root of where to park ${final}.${suffix} + # $tmp -- temporary file where hsc put the intermediate file. + + # Delete the old file + $to_do = "$Rm ${final}.${suffix}"; &run_something($to_do, "Removing old .${suffix} file"); + + if ( $#File_options >= 0 ) { # OPTIONS found in Haskell source unit + # Add OPTION comment to the top of the generated .${suffix} file + open(TEMP, "> ${final}.${suffix}") || &tidy_up_and_die(1,"Can't open ${final}.${suffix}\n"); + print TEMP "/* OPTIONS " . join(' ',@File_options) . " */\n"; + close(TEMP); + print STDERR "Prepending OPTIONS: " . join(' ',@File_options) . " to ${final}.${suffix}\n" if $Verbose; + } + $to_do = "$Cat $tmp >> ${final}.${suffix}"; + &run_something($to_do, "Saving copy of .${suffix} file"); - &runHsc($ifile_root, $hsc_out, $hsc_hi, $going_interactive); +} - # interface-handling is important enough to live off by itself - require('ghc-iface.prl') - || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-iface.prl!\n"); +\end{code} - &postprocessHiFile($hsc_hi, $hifile_target, $going_interactive); - # save a copy of the .hc file, even if we are carrying on... - if ($HscOut eq '-C=' && $do_cc && $Keep_hc_file_too) { - local($to_do) = "$Rm $ifile_root.hc; $Cp $hsc_out $ifile_root.hc"; - &run_something($to_do, 'Saving copy of .hc file'); - } +Command-line processor - # save a copy of the .s file, even if we are carrying on... - if ($HscOut eq '-S=' && $do_as && $Keep_s_file_too) { - local($to_do) = "$Rm $ifile_root.s; $Cp $hsc_out $ifile_root.s"; - &run_something($to_do, 'Saving copy of .s file'); - } +\begin{code} +sub processArgs { + local(@Args) = @_; - # if we're going to split up object files, - # we inject split markers into the .hc file now - if ( $HscOut eq '-C=' && $SplitObjFiles ) { - &inject_split_markers ( $hsc_out ); - } - } +# can't use getopt(s); what we want is too complicated - if ($do_cc) { - &runGcc ($is_hc_file, $hsc_out, $cc_as_o); - &runMangler($is_hc_file, $cc_as_o, $cc_as, $ifile_root); - } +arg: while($_ = $Args[0]) { + shift(@Args); - &split_asm_file($cc_as) if $do_as && $SplitObjFiles; + #---------- help ------------------------------------------------------- + if (/^-\?$/ || /^--?help$/) { print $LongUsage; exit $Status; } - &runAs($as_out, $ifile_root) if $do_as; -\end{code} + #-----------version ---------------------------------------------------- + /^--version$/ && do { print STDERR "${ProjectName}, version ${ProjectVersion}, patchlevel ${ProjectPatchLevel}\n"; exit $Status; }; -Finally, decide what to queue up for linker input. -\begin{code} - # tentatively assume we will eventually produce linker input: - push(@Link_file, &odir_ify($ifile_root, 'o')); + #---------- verbosity and such ----------------------------------------- + /^-v$/ && do { $Verbose = '-v'; $Time = 'time'; next arg; }; -#ToDo: local($or_isuf) = ($Isuffix eq '') ? '' : "|$Isuffix"; + #---------- what phases are to be run ---------------------------------- + /^-(no-)?recomp/ && do { $Do_recomp_chkr = ($1 eq '') ? 1 : 0; next arg; }; + + /^-cpp$/ && do { $Cpp_flag_set = 1; next arg; }; + # change the global default: + # we won't run cat; we'll run the real thing + + /^-C$/ && do { $Do_cc = 0; $Do_as = 0; $Do_lnkr = 0; $HscOut = '-C='; + next arg; }; + # stop after generating C + + /^-noC$/ && do { $HscOut = '-N='; $ProduceHi = '-nohifile='; + $Do_cc = 0; $Do_as = 0; $Do_lnkr = 0; + next arg; }; + # leave out actual C generation (debugging) [also turns off interface gen] - if ( $ifile !~ /\.(lhs|hs|hc|c|s)$/ && $ifile !~ /_hc$/ ) { - print STDERR "$Pgm: don't recognise suffix on `$ifile'; passing it through to linker\n" - if $ifile !~ /\.a$/; - # oops; we tentatively pushed the wrong thing; fix & do the right thing - pop(@Link_file); push(@Link_file, $ifile); - } + /^-hi$/ && do { $HiOnStdout = 1; $ProduceHi = '-hifile='; next arg; }; + # _do_ generate an interface; usually used as: -noC -hi + /^-hi-with-(.*)$/ && do { $HiOnStdout = 1; $HiWith .= " $1" ; $ProduceHi = '-hifile='; next arg; }; + # limit ourselves to outputting a particular section. -} # end of ProcessInputFile -\end{code} + /^-nohi$/ && do { $ProduceHi = '-nohifile='; next arg; }; + # don't generate an interface (even if generating C) -%************************************************************************ -%* * -\section[Driver-run-phases]{Routines to run the various phases} -%* * -%************************************************************************ + /^-hi-diffs$/ && do { $HiDiff_flag = 'normal'; next arg; }; + /^-hi-diffs-with-usages$/ && do { $HiDiff_flag = 'usages'; next arg; }; + /^-no-hi-diffs$/ && do { $HiDiff_flag = ''; next arg; }; + /^-keep-hi-diffs$/ && do { $Keep_HiDiffs = 1; next arg; }; -\begin{code} -sub runLit2pgm { - local($in_lit2pgm, $lit2pgm_hscpp) = @_; + # show/disable diffs if the interface file changes - local($to_do) = "echo '#line 1 \"$in_lit2pgm\"' > $lit2pgm_hscpp && ". - "$Unlit @Unlit_flags $in_lit2pgm - >> $lit2pgm_hscpp"; - @Files_to_tidy = ( $lit2pgm_hscpp ); + /^-E$/ && do { push(@CcBoth_flags, '-E'); + $Only_preprocess_C = 1; + $Do_as = 0; $Do_lnkr = 0; next arg; }; + # stop after preprocessing C + /^-M$/ && do { $Only_generate_deps = 1; $Do_as = 0; $Do_lnkr = 0; next arg; }; + # only generate dependency information. + /^--mk-dll$/ && do { $Only_generate_dll = 1; $Do_as = 0; $Do_lnkr = 0; next arg; }; + # Build a Win32 DLL (where supported). + /^-S$/ && do { $Do_as = 0; $Do_lnkr = 0; next arg; }; + # stop after generating assembler + + /^-c$/ && do { $Do_lnkr = 0; next arg; }; + # stop after generating .o files - &run_something($to_do, 'literate pre-processor'); -} -\end{code} + /^-link-chk$/ && do { $LinkChk = 1; next arg; }; + # don't do consistency-checking after a link + /^-no-link-chk$/ && do { $LinkChk = 0; next arg; }; -\begin{code} -sub runHscpp { - local($in_lit2pgm, $lit2pgm_hscpp, $hscpp_hsc) = @_; + /^-tmpdir$/ && do { $Tmp_prefix = &grab_arg_arg(*Args,'-tmpdir', ''); + $Tmp_prefix = "$Tmp_prefix/ghc$$"; + $ENV{'TMPDIR'} = $Tmp_prefix; # for those who use it... + next arg; }; + # use an alternate directory for temp files - local($to_do); + #---------- redirect output -------------------------------------------- - if ($HsCpp eq $Cat) { - $to_do = "echo '#line 1 \"$in_lit2pgm\"' > $hscpp_hsc && ". - "$HsCpp $lit2pgm_hscpp >> $hscpp_hsc"; - @Files_to_tidy = ( $hscpp_hsc ); - &run_something($to_do, 'Ineffective C pre-processor'); - } else { - local($includes) = '-I' . join(' -I',@Include_dir); - $to_do = "echo '#line 1 \"$in_lit2pgm\"' > $hscpp_hsc && ". - "$HsCpp $Verbose $genSPECS_flag @HsCpp_flags -D__HASKELL1__=$Haskell1Version -D__GLASGOW_HASKELL__=$GhcVersionInfo $includes $lit2pgm_hscpp >> $hscpp_hsc"; - @Files_to_tidy = ( $hscpp_hsc ); - &run_something($to_do, 'Haskellised C pre-processor'); - } -} -\end{code} + # -o ; applies to the last phase, whatever it is + # "-o -" sends it to stdout + # if has a directory component, that dir must already exist -\begin{code} -sub runHsc { - local($ifile_root, $hsc_out, $hsc_hi, $going_interactive) = @_; + /^-odir$/ && do { $Specific_output_dir = &grab_arg_arg(*Args,'-odir', ''); + # + # Hack, of the worst sort: don't do validation of + # odir argument if you're using -M (dependency generation). + # + if ( ! $Only_generate_deps && ! -d $Specific_output_dir) { + print STDERR "$Pgm: -odir: no such directory: $Specific_output_dir\n"; + $Status++; + } + next arg; }; - # prepend comma to HsP flags (so hsc can tell them apart...) - foreach $a ( @HsP_flags ) { $a = ",$a" unless $a =~ /^,/; } + /^-o$/ && do { $Specific_output_file = &grab_arg_arg(*Args,'-o', ''); + if ($Specific_output_file ne '-' + && $Specific_output_file =~ /(.*)\/[^\/]*$/) { + local($dir_part) = $1; + if (! -d $dir_part) { + print STDERR "$Pgm: no such directory: $dir_part\n"; + $Status++; + } + } + next arg; }; - &makeHiMap() unless $HiMapDone; - push(@HsC_flags, "-himap=$HiMapFile"); + # NB: -isuf not documented yet (because it doesn't work yet) + /^-isuf$/ && do { $Isuffix = &grab_arg_arg(*Args,'-isuf', ''); + if ($Isuffix =~ /\./ ) { + print STDERR "$Pgm: -isuf suffix shouldn't contain a .\n"; + $Status++; + } + next arg; }; - # here, we may produce .hc/.s and/or .hi files - local($output) = ''; - @Files_to_tidy = (); + /^-osuf$/ && do { $Osuffix = &grab_arg_arg(*Args,'-osuf', ''); + if ($Osuffix =~ /\./ ) { + print STDERR "$Pgm: -osuf suffix shouldn't contain a .\n"; + $Status++; + } + next arg; }; - if ( $going_interactive ) { - # don't need .hi unless going to show it on stdout: - $ProduceHi = '-nohifile=' if ! $HiOnStdout; - $do_cc = 0; $do_as = 0; $Do_lnkr = 0; # and we won't go any further... - } + # -ohi ; send the interface to ; "-ohi -" to send to stdout + /^-ohi$/ && do { $Specific_hi_file = &grab_arg_arg(*Args,'-ohi', ''); + if ($Specific_hi_file ne '-' + && $Specific_hi_file =~ /(.*)\/[^\/]*$/) { + local($dir_part) = $1; + if (! -d $dir_part) { + print STDERR "$Pgm: no such directory: $dir_part\n"; + $Status++; + } + } + $ProduceHi='-hifile='; + next arg; }; - # set up for producing output/.hi; note that flag twiddling - # may mean that nothing will actually be produced: - $output = "$ProduceHi$hsc_hi $HscOut$hsc_out"; - @Files_to_tidy = ( $hsc_hi, $hsc_out ); + # The suffix to use when looking for interface files + /^-hisuf$/ && do { $HiSuffix = &grab_arg_arg(*Args,'-hisuf', ''); + if ($HiSuffix =~ /\./ ) { + print STDERR "$Pgm: -hisuf suffix shouldn't contain a .\n"; + $Status++; + } + next arg; }; + /^-odump$/ && do { $Specific_dump_file = &grab_arg_arg(*Args,'-odump', ''); + if ($Specific_dump_file =~ /(.*)\/[^\/]*$/) { + local($dir_part) = $1; + if (! -d $dir_part) { + print STDERR "$Pgm: no such directory: $dir_part\n"; + $Status++; + } + } + next arg; }; + + #-------------- scc & Profiling Stuff ---------------------------------- + + /^-prof$/ && do { $PROFing = 'p'; next arg; }; # profiling -- details later! + + /^-auto-dicts$/ && do { + $PROFdicts = '-fauto-sccs-on-dicts'; + next arg; }; + /^-auto-all$/ && do { + $PROFauto = '-fauto-sccs-on-all-toplevs'; + next arg; }; + /^-auto$/ && do { + $PROFauto = '-fauto-sccs-on-exported-toplevs'; + next arg; }; + + /^-caf-all/ && do { # generate individual CAF SCC annotations + $PROFcaf = '-fauto-sccs-on-individual-cafs'; + next arg; }; + + /^-ignore-scc$/ && do { + # forces ignore of scc annotations even if profiling + $PROFignore_scc = '-W'; + next arg; }; - # if we're compiling foo.hs, we want the GC stats to end up in foo.stat - if ( $CollectingGCstats ) { - push(@HsC_rts_flags, "-S$ifile_root.stat"); - push(@Files_to_tidy, "$ifile_root.stat"); - } + /^-G(.*)$/ && do { push(@HsC_flags, "-G=$1"); # set group for cost centres + next arg; }; - if ( $CollectGhcTimings ) { # assume $RTS_style eq 'ghc' - # emit nofibbish time/bytes-alloc stats to stderr; - # see later .stat file post-processing - push(@HsC_rts_flags, "-s$Tmp_prefix.stat"); - push(@Files_to_tidy, "$Tmp_prefix.stat"); - } + /^-unprof-scc-auto/ && do { + # generate auto SCCs on top level bindings when not profiling. + # Used to measure optimisation effects of presence of sccs. + $UNPROFscc_auto = ( /-all/ ) + ? '-fauto-sccs-on-all-toplevs' + : '-fauto-sccs-on-exported-toplevs'; + next arg; }; - local($dump) = ''; - if ($Specific_dump_file ne '') { - $dump = "2>> $Specific_dump_file"; - $Using_dump_file = 1; - } + #--------- ticky/parallel ---------------------------------------------- + # we sort out the details a bit later on - local($to_do); - $to_do = "$HsC @HsP_flags ,$hscpp_hsc $dump @HsC_flags $CoreLint $Verbose $output +RTS @HsC_rts_flags"; - &run_something($to_do, 'Haskell compiler'); + /^-gransim$/ && do { $GRANing = 'g'; &add_syslib('concurrent'); next arg; }; # GranSim + /^-ticky$/ && do { $TICKYing = 't'; next arg; }; # ticky-ticky + /^-parallel$/ && do { $PARing = 'p'; &add_syslib('concurrent'); next arg; }; # parallel Haskell - # finish business w/ nofibbish time/bytes-alloc stats - &process_ghc_timings() if $CollectGhcTimings; + #-------------- "user ways" -------------------------------------------- - # if non-interactive, heave in the consistency info at the end - # NB: pretty hackish (depends on how $output is set) - if ( ! $going_interactive ) { - if ( $HscOut eq '-C=' ) { - $to_do = "echo 'static char ghc_hsc_ID[] = \"\@(#)hsc $ifile\t$HsC_major_version.$HsC_minor_version,$HsC_consist_options\";' >> $hsc_out"; - - } elsif ( $HscOut eq '-S=' ) { - local($consist) = "hsc.$ifile.$HsC_major_version.$HsC_minor_version.$HsC_consist_options"; - $consist =~ s/,/./g; - $consist =~ s/\//./g; - $consist =~ s/-/_/g; - $consist =~ s/[^A-Za-z0-9_.]/ZZ/g; # ToDo: properly? - $to_do = "echo '\n\t.text\n$consist:' >> $hsc_out"; - } - &run_something($to_do, 'Pin on Haskell consistency info'); - } -} -\end{code} + (/^-user-setup-([a-oA-Z])$/ ) && + do { + /^-user-setup-([a-oA-Z])$/ && do { $BuildTag = "_$1"; }; -Use \tr{@Import_dir} and \tr{@SysImport_dir} to make a tmp file -of (module-name, pathname) pairs, one per line, separated by a space. -\begin{code} -%HiMap = (); -$HiMapDone = 0; -$HiMapFile = ''; + local($stuff) = $UserSetupOpts{$BuildTag}; + local(@opts) = split(/\s+/, $stuff); + + # feed relevant ops into the arg-processing loop (if any) + unshift(@Args, @opts) if $#opts >= 0; -sub makeHiMap { + next arg; }; - # collect in %HiMap; write later; also used elsewhere in driver + #---------- set search paths for libraries and things ------------------ - local($mod, $path, $d, $e); - - foreach $d ( @Import_dir ) { - opendir(DIR, $d) || &tidy_up_and_die(1,"$Pgm: error when reading directory: $d\n"); - local(@entry) = readdir(DIR); - foreach $e ( @entry ) { - next unless $e =~ /([A-Z][A-Za-z0-9_]*)\.$HiSuffix$/o; - $mod = $1; - $path = "$d/$e"; - $path =~ s,^\./,,; - - if ( ! defined($HiMap{$mod}) ) { - $HiMap{$mod} = $path; - } else { - &already_mapped_err($mod, $HiMap{$mod}, $path); - } - } - closedir(DIR); # || &tidy_up_and_die(1,"$Pgm: error when closing directory: $d\n"); - } + # we do -i just like HBC (-i clears the list; -i + # prepends the items to the list); -I is for including C .h files. - foreach $d ( @SysImport_dir ) { - opendir(DIR, $d) || &tidy_up_and_die(1,"$Pgm: error when reading directory: $d\n"); - local(@entry) = readdir(DIR); - foreach $e ( @entry ) { - next unless $e =~ /([A-Z][A-Za-z0-9_]*)\.$SysHiSuffix$/o; - next if $NoImplicitPrelude && $e =~ /Prelude\.$SysHiSuffix$/o; - - $mod = $1; - $path = "$d/$e"; - $path =~ s,^\./,,; - - if ( ! defined($HiMap{$mod}) ) { - $HiMap{$mod} = $path; - } elsif ( $mod ne 'Main' ) { # saves useless warnings... - &already_mapped_err($mod, $HiMap{$mod}, $path); - } - } - closedir(DIR); # || &tidy_up_and_die(1,"$Pgm: error when closing directory: $d\n"); - } + /^-i$/ && do { @Import_dir = (); # import path cleared! + @SysImport_dir = (); + print STDERR "WARNING: import paths cleared by `-i'\n"; + next arg; }; - $HiMapFile = "$Tmp_prefix.himap"; - unlink($HiMapFile); - open(HIMAP, "> $HiMapFile") || &tidy_up_and_die(1,"$Pgm: can't open $HiMapFile\n"); - foreach $d (keys %HiMap) { - print HIMAP $d, ' ', $HiMap{$d}, "\n"; - } - close(HIMAP) || &tidy_up_and_die(1,"$Pgm: error when closing $HiMapFile\n"); + /^-i(.*)/ && do { local(@new_items) + = split( /:/, &grab_arg_arg(*Args,'-i', $1)); + unshift(@Import_dir, @new_items); + next arg; }; - $HiMapDone = 1; -} + /^-I(.*)/ && do { push(@Include_dir, &grab_arg_arg(*Args,'-I', $1)); next arg; }; + /^-L(.*)/ && do { push(@UserLibrary_dir, &grab_arg_arg(*Args,'-L', $1)); next arg; }; + /^-l(.*)/ && do { push(@UserLibrary,'-l'.&grab_arg_arg(*Args,'-l', $1)); next arg; }; -sub already_mapped_err { - local($mod, $mapped_to, $path) = @_; + /^-syslib(.*)/ && do { local($syslib) = &grab_arg_arg(*Args,'-syslib',$1); + &add_syslib($syslib); + next arg; }; - # OK, it isn't really an error if $mapped_to and $path turn - # out to be the same thing. - ($m_dev,$m_ino,$m_mode,$m_nlink,$m_uid,$m_gid,$m_rdev,$m_size, - $m_atime,$m_mtime,$m_ctime,$m_blksize,$m_blocks) = stat($mapped_to); - ($p_dev,$p_ino,$p_mode,$p_nlink,$p_uid,$p_gid,$p_rdev,$p_size, - $p_atime,$p_mtime,$p_ctime,$p_blksize,$p_blocks) = stat($path); + #======================================================================= + # various flags that we can harmlessly send to one program or another + # (we will later "reclaim" some of the compiler ones now sent to gcc) + #======================================================================= - return if $m_ino == $p_ino; # same inode number + #---------- this driver itself (ghc) ----------------------------------- + # these change what executable is run for each phase: + /^-pgmL(.*)$/ && do { $Unlit = $1; next arg; }; + /^-pgmP(.*)$/ && do { $HsCpp = $1; next arg; }; + /^-pgmC(.*)$/ && do { $HsC = $1; next arg; }; + /^-pgmcO?(.*)$/ && do { $CcRegd = $1; next arg; }; # the O? for back compat + /^-pgma(.*)$/ && do { $As = $1; next arg; }; + /^-pgml(.*)$/ && do { $Lnkr = $1; next arg; }; + /^-pgmdep(.*)$/ && do { $MkDependHS = $1; next arg; }; - print STDERR "$Pgm: module $mod already mapped to $mapped_to"; - print STDERR ";\n\tignoring: $path\n"; -} -\end{code} + #---------- the get-anything-through opts (all pgms) ------------------- + # these allow arbitrary option-strings to go to any phase: + /^-optL(.*)$/ && do { push(@Unlit_flags, $1); next arg; }; + /^-optP(.*)$/ && do { push(@HsCpp_flags, $1); next arg; }; + /^-optCrts(.*)$/&& do { push(@HsC_rts_flags, $1); next arg; }; + /^-optC(.*)$/ && do { push(@HsC_flags, $1); next arg; }; + /^-optcpp(.*)$/ && do { push(@Cpp_define, $1); $Only_preprocess_hc = ($1 eq "-E"); next arg; }; + /^-optc(.*)$/ && do { push(@CcBoth_flags, $1); next arg; }; + /^-opta(.*)$/ && do { push(@As_flags, $1); next arg; }; + /^-optl(.*)$/ && do { push(@Ld_flags, $1); next arg; }; + /^-optdll(.*)$/ && do { push(@Dll_flags, $1); next arg; }; + /^-optdep(.*)$/ && do { push(@MkDependHS_flags, $1); next arg; }; -%************************************************************************ -%* * -\section[Driver-misc-utils]{Miscellaneous utilities} -%* * -%************************************************************************ + #---------- Haskell C pre-processor (hscpp) ---------------------------- + /^-D(.*)/ && do { push(@HsCpp_flags, "'-D".&grab_arg_arg(*Args,'-D',$1)."'"); next arg; }; + /^-U(.*)/ && do { push(@HsCpp_flags, "'-U".&grab_arg_arg(*Args,'-U',$1)."'"); next arg; }; -%************************************************************************ -%* * -\subsection[Driver-odir-ify]{@odir_ify@: Mangle filename if \tr{-odir} set} -%* * -%************************************************************************ + #---------- post-Haskell "assembler"------------------------------------ + /^-ddump-raw-asm$/ && do { $Dump_raw_asm = 1; next arg; }; + /^-ddump-asm-splitting-info$/ && do { $Dump_asm_splitting_info = 1; next arg; }; -\begin{code} -sub osuf_ify { - local($ofile,$def_suffix) = @_; + #---------- Haskell compiler (hsc) ------------------------------------- - return(($Osuffix eq '') ? "$ofile.$def_suffix" : "$ofile.$Osuffix" ); -} + /^-keep-hc-files?-too$/ && do { $Keep_hc_file_too = 1; next arg; }; + /^-keep-s-files?-too$/ && do { $Keep_s_file_too = 1; next arg; }; -sub odir_ify { - local($orig_file, $def_suffix) = @_; - if ($Specific_output_dir eq '') { # do nothing - &osuf_ify($orig_file, $def_suffix); - } else { - local ($orig_file_only); - ($orig_file_only = $orig_file) =~ s|.*/||; - &osuf_ify("$Specific_output_dir/$orig_file_only",$def_suffix); - } -} -\end{code} + /^-fignore-interface-pragmas$/ && do { push(@HsC_flags, $_); next arg; }; + /^-fignore-asserts$/ && do { push(@HsC_flags, $_); next arg; }; -\begin{code} -sub runGcc { - local($is_hc_file, $hsc_out, $cc_as_o) = @_; + /^-fno-implicit-prelude$/ && do { $NoImplicitPrelude= 1; push(@HsC_flags, $_); next arg; }; - local($includes) = '-I' . join(' -I', @Include_dir); - local($cc); - local($s_output); - local($c_flags) = "@CcBoth_flags"; - local($ddebug_flag) = ( $DEBUGging ) ? '-DDEBUG' : ''; + # + # have the compiler proper generate concurrent code, + # really only used when you want to configure your own + # special user compilation way. + # + # (ditto for -fgransim, fscc-profiling, -fparallel and -fticky-ticky) + # + /^-fscc-profiling$/ && do { push(@HsC_flags,$_); next arg; }; + /^-fticky-ticky$/ && do { push(@HsC_flags,$_); next arg; }; + /^-fgransim$/ && do { push(@HsC_flags,$_); next arg; }; + /^-fparallel$/ && do { push(@HsC_flags,$_); next arg; }; + + /^-split-objs$/ && do { + if ( $TargetPlatform !~ /^(alpha|hppa1\.1|i386|m68k|mips|powerpc|rs6000|sparc)-/ ) { + $SplitObjFiles = 0; + print STDERR "WARNING: don't know how to split objects on this platform: $TargetPlatform\n`-split-objs' option ignored\n"; + } else { + $SplitObjFiles = 1; + $HscOut = '-C='; - # "input" files to use that are not in some weird directory; - # to help C compilers grok .hc files [ToDo: de-hackify] - local($cc_help) = "ghc$$.c"; - local($cc_help_s) = "ghc$$.s"; + push(@HsC_flags, "-fglobalise-toplev-names"); + push(@CcBoth_flags, '-DUSE_SPLIT_MARKERS'); - $cc = $CcRegd; - $s_output = ($is_hc_file || $TargetPlatform =~ /^(hppa|i386)/) ? $cc_as_o : $cc_as; - $c_flags .= " @CcRegd_flags"; - $c_flags .= ($is_hc_file) ? " @CcRegd_flags_hc" : " @CcRegd_flags_c"; + require('ghc-split.prl') + || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-split.prl!\n"); + } + next arg; }; - # C compiler won't like the .hc extension. So we create - # a tmp .c file which #include's the needful. - open(TMP, "> $cc_help") || &tidy_up_and_die(1,"$Pgm: failed to open `$cc_help' (to write)\n"); - if ( $is_hc_file ) { - print TMP <= 0; - } - # heave in the consistency info - print TMP "static char ghc_cc_ID[] = \"\@(#)cc $ifile\t$Cc_major_version.$Cc_minor_version,$Cc_consist_options\";\n"; + /^-unreg$/ && do { $UNREGing = 'u'; next arg; }; + /^-funregisterised$/ && do { push(@HsC_flags, $_); next arg; }; + /^-fno-asm-mangling$/ && do { $DoAsmMangling = 0; next arg; }; - # and #include the real source - print TMP "#include \"$hsc_out\"\n"; - close(TMP) || &tidy_up_and_die(1,"Failed writing to $cc_help\n"); + /^-fallow-overlapping-instances$/ && do { push(@HsC_flags, $_); next arg; }; + /^-fallow-undecidable-instances$/ && do { push(@HsC_flags, $_); next arg; }; + /^-fhistory-size.*$/ && do { push(@HsC_flags, $_); next arg; }; + /^-fglasgow-exts$/ + && do { push(@HsC_flags, $_); - local($to_do) = "$cc $Verbose $ddebug_flag $c_flags @Cpp_define -D__HASKELL1__=$Haskell1Version $includes $cc_help > $Tmp_prefix.ccout 2>&1 && ( if [ $cc_help_s != $s_output ] ; then mv $cc_help_s $s_output ; else exit 0 ; fi )"; - # note: __GLASGOW_HASKELL__ is pointedly *not* #defined at the C level. - if ( $Only_preprocess_C ) { # HACK ALERT! - $to_do =~ s/ -S\b//g; - } - @Files_to_tidy = ( $cc_help, $cc_help_s, $s_output ); - $PostprocessCcOutput = 1; # hack, dear hack... - &run_something($to_do, 'C compiler'); - $PostprocessCcOutput = 0; - unlink($cc_help, $cc_help_s); -} -\end{code} + # -fglasgow-exts implies -syslib exts + &add_syslib('exts'); -\begin{code} -sub runMangler { - local($is_hc_file, $cc_as_o, $cc_as, $ifile_root) = @_; + next arg; }; - if ( $is_hc_file ) { - # dynamically load assembler-fiddling code, which we are about to use: - require('ghc-asm.prl') - || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm.prl!\n"); - } + /^-fspeciali[sz]e$/ + && do { $Oopt_DoSpecialise = '-fspecialise'; next arg; }; + /^-fno-speciali[sz]e$/ + && do { $Oopt_DoSpecialise = ''; next arg; }; - print STDERR `cat $cc_as_o` if $Dump_raw_asm; # to stderr, before mangling + /^-fusagesp$/ + && do { $Oopt_UsageSPInf = '-fusagesp'; + push (@HsC_flags, '-fusagesp-on'); next arg; }; - if ($is_hc_file) { - # post-process the assembler [.hc files only] - &mangle_asm($cc_as_o, $cc_as); + /^-fcompiling-prelude$/ && do { $CompilingPrelude=1; push(@HsC_flags, $_); next arg; }; -#OLD: for sanity: -#OLD: local($target) = 'oops'; -#OLD: $target = '-alpha' if $TargetPlatform =~ /^alpha-/; -#OLD: $target = '-hppa' if $TargetPlatform =~ /^hppa/; -#OLD: $target = '-old-asm' if $TargetPlatform =~ /^i386-/; -#OLD: $target = '-m68k' if $TargetPlatform =~ /^m68k-/; -#OLD: $target = '-mips' if $TargetPlatform =~ /^mips-/; -#OLD: $target = '' if $TargetPlatform =~ /^powerpc-/; -#OLD: $target = '-solaris' if $TargetPlatform =~ /^sparc-sun-solaris2/; -#OLD: $target = '-sparc' if $TargetPlatform =~ /^sparc-sun-sunos4/; -#OLD: -#OLD: if ( $target ne '' ) { -#OLD: require("ghc-asm$target.prl") -#OLD: || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm$target.prl!\n"); -#OLD: &mangle_asm($cc_as_o, "$cc_as-2"); # the OLD one! -#OLD: &run_something("$Cmp -s $cc_as-2 $cc_as || $Diff $cc_as-2 $cc_as 1>&2 || exit 0", -#OLD: "Diff'ing old and new mangled .s files"); # NB: to stderr -#OLD: } +# Now the foldr/build options, which are *on* by default (for -O). - } elsif ($TargetPlatform =~ /^hppa/) { - # minor mangling of non-threaded files for hp-pa only - require('ghc-asm.prl') - || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm-hppa.prl!\n"); - &mini_mangle_asm_hppa($cc_as_o, $cc_as); + /^-ffoldr-build$/ + && do { $Oopt_FoldrBuild = 1; + #print "Yes F/B\n"; + next arg; }; - } elsif ($TargetPlatform =~ /^i386/) { - # extremely-minor OFFENSIVE mangling of non-threaded just one file - require('ghc-asm.prl') - || &tidy_up_and_die(1,"$Pgm: panic: can't load ghc-asm.prl!\n"); - &mini_mangle_asm_i386($cc_as_o, $cc_as); - } + /^-fno-foldr-build$/ + && do { $Oopt_FoldrBuild = 0; + next arg; }; - # save a copy of the .s file, even if we are carrying on... - if ($do_as && $Keep_s_file_too) { - local($to_do) = "$Rm $ifile_root.s; $Cp $cc_as $ifile_root.s"; - &run_something($to_do, 'Saving copy of .s file'); - } -} -\end{code} + # --------------- Renamer ------------- -\begin{code} -sub runAs { - local($as_out, $ifile_root) = @_; - local($asmblr) = ( $As ) ? $As : $CcRegd; + /^-fno-prune-tydecls$/ && do { push(@HsC_flags, $_); next arg; }; + /^-fno-prune-instdecls$/ && do { push(@HsC_flags, $_); next arg; }; - if ( ! $SplitObjFiles ) { - local($to_do) = "$asmblr -o $as_out -c @As_flags $cc_as"; - @Files_to_tidy = ( $as_out ); - &run_something($to_do, 'Unix assembler'); + # --------------- - } else { # more complicated split-ification... + /^-fasm-(.*)$/ && do { $HscOut = '-S='; next arg; }; # force using nativeGen + /^-fvia-[cC]$/ && do { $HscOut = '-C='; next arg; }; # force using C compiler - # must assemble files $Tmp_prefix__[1 .. $NoOfSplitFiles].s + # --------------- - for ($f = 1; $f <= $NoOfSplitFiles; $f++ ) { - local($split_out) = &odir_ify("${ifile_root}__${f}",'o'); - local($to_do) = "$asmblr -o $split_out -c @As_flags ${Tmp_prefix}__${f}.s"; - @Files_to_tidy = ( $split_out ); + /^-funfolding-.*$/ + && do { push(@HsC_flags, $_); next arg }; - &run_something($to_do, 'Unix assembler'); - } - } -} -\end{code} + /^-funfold-casms-in-hi-file$/ + && do { push(@HsC_flags, $_); next arg }; -%************************************************************************ -%* * -\subsection[Driver-run-something]{@run_something@: Run a phase} -%* * -%************************************************************************ + /^(-fmax-simplifier-iterations)(.*)$/ + && do { $Oopt_MaxSimplifierIterations = $1 . &grab_arg_arg(*Args,$1, $2); + next arg; }; -\begin{code} -sub run_something { - local($str_to_do, $tidy_name) = @_; + /^-fno-pedantic-bottoms$/ + && do { $Oopt_PedanticBottoms = ''; next arg; }; - print STDERR "\n$tidy_name:\n\t" if $Verbose; - print STDERR "$str_to_do\n" if $Verbose; + /^-fno-pre-inlining$/ + && do { push(@HsC_flags, $_); next arg }; - if ($Using_dump_file) { - open(DUMP, ">> $Specific_dump_file") - || &tidy_up_and_die(1,"$Pgm: failed to open `$Specific_dump_file'\n"); - print DUMP "\nCompilation Dump for: $str_to_do\n\n"; - close(DUMP) - || &tidy_up_and_die(1,"$Pgm: failed closing `$Specific_dump_file'\n"); - } + /^-fno-let-from-(case|app|strict-let)$/ # experimental, really (WDP 95/10) + && do { push(@HsC_flags, $_); next arg; }; - local($return_val) = 0; - system("$Time $str_to_do"); - $return_val = $?; + /^-funbox-strict-fields$/ + && do { push(@HsC_flags, $_); next arg; }; - if ( $PostprocessCcOutput ) { # hack, continued - open(CCOUT, "< $Tmp_prefix.ccout") - || &tidy_up_and_die(1,"$Pgm: failed to open `$Tmp_prefix.ccout'\n"); - while ( ) { - next if /attribute directive ignored/; - next if /call-clobbered/; - next if /from .*COptRegs\.lh/; - next if /from .*(stg|rts)defs\.h:/; - next if /from ghc\d+.c:\d+:/; - next if /from .*\.lc/; - next if /from .*SMinternal\.l?h/; - next if /ANSI C does not support \`long long\'/; - next if /warning:.*was declared \`extern\' and later \`static\'/; - next if /warning: assignment discards \`const\' from pointer target type/; - next if /: At top level:$/; - next if /: In function \`.*\':$/; - next if /\`ghc_cc_ID\' defined but not used/; - print STDERR $_; - } - close(CCOUT) || &tidy_up_and_die(1,"$Pgm: failed closing `$Tmp_prefix.ccout'\n"); - } + # --------------- Warnings etc. ------ - if ($return_val != 0) { - if ($Using_dump_file) { - print STDERR "Compilation Errors dumped in $Specific_dump_file\n"; - } + /^-fwarn-(.*)$/ && do { push(@HsC_flags, $_); next arg; }; - &tidy_up_and_die($return_val, ''); - } - $Using_dump_file = 0; -} -\end{code} + /^-fno-(.*)$/ && do { push(@HsC_antiflags, "-f$1"); + &squashHscFlag("-f$1"); + next arg; }; -%************************************************************************ -%* * -\subsection[Driver-ghctiming]{Emit nofibbish GHC timings} -%* * -%************************************************************************ + /^-W$/ && do { push(@HsC_flags, @MinusWOpts); next arg; }; + /^-Wall$/ && do { push(@HsC_flags, @MinusWallOpts); next arg; }; + /^(-Wnot|w)$/ && do { foreach (@Hsc_flags) { + /^-fwarn-(.*)$/ && do { $_=''; }; + }; + push(@HsC_antiflags, @StandardWarnings); + next arg; }; -NB: nearly the same as in @runstdtest@ script. + # --------------- fun stuff ---------------- -\begin{code} -sub process_ghc_timings { - local($StatsFile) = "$Tmp_prefix.stat"; - local($SysSpecificTiming) = 'ghc'; + /^-freport-compile$/ && do { push(@HsC_flags, $_); next arg; }; - open(STATS, $StatsFile) || die "Failed when opening $StatsFile\n"; - local($tot_live) = 0; # for calculating avg residency + # --------------- platform specific flags (for gcc mostly) ---------------- - while () { - $tot_live += $1 if /^\s*\d+\s+\d+\s+\d+\.\d+\%\s+(\d+)\s+\d+\.\d+\%/; + /^-mlong-calls$/ && do { # for GCC for HP-PA boxes, + # for 2.6.x..?, does not apply for 2.7.2 + # any longer. + unshift(@CcBoth_flags, ( $_ )); + next arg; }; - $BytesAlloc = $1 if /^\s*([0-9,]+) bytes allocated in the heap/; + /^-m(v8|sparclite|cypress|supersparc|cpu=(cypress|supersparc))$/ + && do { # for GCC for SPARCs + unshift(@CcBoth_flags, ( $_ )); + next arg; }; - if ( /^\s*([0-9,]+) bytes maximum residency .* (\d+) sample/ ) { - $MaxResidency = $1; $ResidencySamples = $2; + /^-monly-([432])-regs/ && do { # for iX86 boxes only; no effect otherwise + $StolenX86Regs = $1; + next arg; }; + + #*************** ... and lots of debugging ones (form: -d* ) + + # -d(no-)core-lint is done this way so it is turn-off-able. + /^-dcore-lint/ && do { $CoreLint = '-dcore-lint'; next arg; }; + /^-dno-core-lint/ && do { $CoreLint = ''; next arg; }; + # Ditto for USP lint + /^-dusagesp-lint/ && do { $USPLint = '-dusagesp-lint'; next arg; }; + /^-dno-usagesp-lint/ && do { $USPLint = ''; next arg; }; + # Ditto for STG lint + /^-dstg-lint/ && do { $StgLint = '-dstg-lint'; next arg; }; + /^-dno-stg-lint/ && do { $StgLint = ''; next arg; }; + + /^-d(dump|ppr)-/ && do { push(@HsC_flags, $_); next arg; }; + /^-dverbose-(simpl|stg)/ && do { push(@HsC_flags, $_); next arg; }; + /^-dshow-passes/ && do { push(@HsC_flags, $_); next arg; }; + /^-dshow-rn-stats/ && do { push(@HsC_flags, $_); next arg; }; + /^-dshow-rn-trace/ && do { push(@HsC_flags, $_); next arg; }; + /^-dsource-stats/ && do { push(@HsC_flags, $_); next arg; }; + /^-dsimplifier-stats/ && do { push(@HsC_flags, $_); next arg; }; + /^-dstg-stats/ && do { $Oopt_StgStats = $_; next arg; }; + + #*************** ... and now all these -R* ones for its runtime system... + + /^-Rscale-sizes?(.*)/ && do { + $Scale_sizes_by = &grab_arg_arg(*Args,'-Rscale-sizes', $1); + next arg; }; + + /^(-H|-Rmax-heapsize)(.*)/ && do { + local($heap_size) = &grab_arg_arg(*Args,$1, $2); + if ($heap_size =~ /(\d+)[Kk]$/) { + $heap_size = $1 * 1000; + } elsif ($heap_size =~ /(\d+)[Mm]$/) { + $heap_size = $1 * 1000 * 1000; + } elsif ($heap_size =~ /(\d+)[Gg]$/) { + $heap_size = $1 * 1000 * 1000 * 1000; + } + if ($heap_size <= 0) { + print STDERR "$Pgm: resetting heap-size to zero!!! $heap_size\n"; + $Specific_heap_size = 0; + + # if several heap sizes given, take the largest... + } elsif ($heap_size >= $Specific_heap_size) { + $Specific_heap_size = $heap_size; + } else { + print STDERR "$Pgm: ignoring heap-size-setting option ($_)...not the largest seen\n"; } + next arg; }; - $GCs = $1 if /^\s*([0-9,]+) garbage collections? performed/; + /^(-K|Rmax-(stk|stack)size)(.*)/ && do { + local($flag) = $1; + local($stk_size) = &grab_arg_arg(*Args,'-Rmax-stksize', $3); + if ($stk_size =~ /(\d+)[Kk]$/) { + $stk_size = $1 * 1000; + } elsif ($stk_size =~ /(\d+)[Mm]$/) { + $stk_size = $1 * 1000 * 1000; + } elsif ($stk_size =~ /(\d+)[Gg]$/) { + $stk_size = $1 * 1000 * 1000 * 1000; + } + if ($stk_size <= 0) { + print STDERR "$Pgm: resetting stack-size to zero!!! $stk_size\n"; + $Specific_stk_size = 0; - if ( /^\s*INIT\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) { - $InitTime = $1; $InitElapsed = $2; - } elsif ( /^\s*MUT\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) { - $MutTime = $1; $MutElapsed = $2; - } elsif ( /^\s*GC\s+time\s*(\d+\.\d\d)s\s*\(\s*(\d+\.\d\d)s elapsed\)/ ) { - $GcTime = $1; $GcElapsed = $2; + # if several stack sizes given, take the largest... + } elsif ($stk_size >= $Specific_stk_size) { + $Specific_stk_size = $stk_size; + } else { + print STDERR "$Pgm: ignoring stack-size-setting option ($flag $stk_size)...not the largest seen\n"; } - } - close(STATS) || die "Failed when closing $StatsFile\n"; - if ( defined($ResidencySamples) && $ResidencySamples > 0 ) { - $AvgResidency = int ($tot_live / $ResidencySamples) ; - } + next arg; }; - # warn about what we didn't find - print STDERR "Warning: BytesAlloc not found in stats file\n" unless defined($BytesAlloc); - print STDERR "Warning: GCs not found in stats file\n" unless defined($GCs); - print STDERR "Warning: InitTime not found in stats file\n" unless defined($InitTime); - print STDERR "Warning: InitElapsed not found in stats file\n" unless defined($InitElapsed); - print STDERR "Warning: MutTime not found in stats file\n" unless defined($MutTime); - print STDERR "Warning: MutElapsed not found in stats file\n" unless defined($MutElapsed); - print STDERR "Warning: GcTime inot found in stats file\n" unless defined($GcTime); - print STDERR "Warning: GcElapsed not found in stats file\n" unless defined($GcElapsed); + /^-Rgc-stats$/ && do { $CollectingGCstats++; + # the two RTSs do this diff ways; we will try to compensate + next arg; }; - # things we didn't necessarily expect to find - $MaxResidency = 0 unless defined($MaxResidency); - $AvgResidency = 0 unless defined($AvgResidency); - $ResidencySamples = 0 unless defined($ResidencySamples); + /^-Rghc-timing/ && do { $CollectGhcTimings = 1; next arg; }; - # a bit of tidying - $BytesAlloc =~ s/,//g; - $MaxResidency =~ s/,//g; - $GCs =~ s/,//g; - $InitTime =~ s/,//g; - $InitElapsed =~ s/,//g; - $MutTime =~ s/,//g; - $MutElapsed =~ s/,//g; - $GcTime =~ s/,//g; - $GcElapsed =~ s/,//g; + #---------- C high-level assembler (gcc) ------------------------------- + /^-(Wall|ansi|pedantic)$/ && do { push(@CcBoth_flags, $_); next arg; }; - # print out what we found - print STDERR "<<$SysSpecificTiming: ", - "$BytesAlloc bytes, $GCs GCs, $AvgResidency/$MaxResidency avg/max bytes residency ($ResidencySamples samples), $InitTime INIT ($InitElapsed elapsed), $MutTime MUT ($MutElapsed elapsed), $GcTime GC ($GcElapsed elapsed)", - " :$SysSpecificTiming>>\n"; + # -dgcc-lint is a useful way of making GCC very fussy. + # From alan@spri.levels.unisa.edu.au (Alan Modra). + /^-dgcc-lint$/ && do { push(@CcBoth_flags, '-Wall -Wpointer-arith -Wbad-function-cast -Wcast-qual -Wstrict-prototypes -Wmissing-prototypes -Wmissing-declarations -Wnested-externs'); next arg; }; + # An alternate set, from mark@sgcs.com (Mark W. Snitily) + # -Wall -Wstrict-prototypes -Wmissing-prototypes -Wcast-align -Wshadow - # OK, party over - unlink $StatsFile; -} -\end{code} + # inject "#include " into the compiler's C output! -%************************************************************************ -%* * -\subsection[Driver-dying]{@tidy_up@ and @tidy_up_and_die@: Dying gracefully} -%* * -%************************************************************************ + /^-#include(.*)/ && do { + local($to_include) = &grab_arg_arg(*Args,'-#include', $1); + push(@CcInjects, "#include $to_include\n"); + next arg; }; -\begin{code} -sub tidy_up { - local($to_do) = "\n$Rm $Tmp_prefix*"; - if ( $Tmp_prefix !~ /^\s*$/ ) { - print STDERR "$to_do\n" if $Verbose; - system($to_do); - } -} + #---------- Linker (gcc, really) --------------------------------------- -sub tidy_up_and_die { - local($return_val, $msg) = @_; + /^-static$/ && do { $Static=1; push(@Ld_flags, $_); next arg; }; + /^-no-hs-main$/ && do { $NoHaskellMain=1; next arg; }; - # delete any files to tidy - print STDERR "deleting... @Files_to_tidy\n" if $Verbose && $#Files_to_tidy >= 0; - unlink @Files_to_tidy if $#Files_to_tidy >= 0; + #---------- mixed cc and linker magic ---------------------------------- + # this optimisation stuff is finally sorted out later on... - &tidy_up(); - print STDERR $msg; - exit (($return_val == 0) ? 0 : 1); -} -\end{code} + /^-O2-for-C$/ && do { $MinusO2ForC = 1; next arg; }; -%************************************************************************ -%* * -\subsection[Driver-arg-with-arg]{@grab_arg_arg@: Do an argument with an argument} -%* * -%************************************************************************ + /^-O[1-2]?$/ && do { + local($opt_lev) = ( /^-O2$/ ) ? 2 : 1; # max 'em + $OptLevel = ( $opt_lev > $OptLevel ) ? $opt_lev : $OptLevel; -Some command-line arguments take an argument, e.g., -\tr{-Rmax-heapsize} expects a number to follow. This can either be -given a part of the same argument (\tr{-Rmax-heapsize8M}) or as the -next argument (\tr{-Rmax-heapsize 8M}). We allow both cases. + $HscOut = '-C=' if $OptLevel == 2; # force use of C compiler + next arg; }; -Note: no error-checking; \tr{-Rmax-heapsize -Rgc-stats} will silently -gobble the second argument (and probably set the heapsize to something -nonsensical). -\begin{code} -sub grab_arg_arg { - local($option, $rest_of_arg) = @_; - - if ($rest_of_arg) { - return($rest_of_arg); - } elsif ($#ARGV >= 0) { - local($temp) = $ARGV[0]; shift(@ARGV); - return($temp); - } else { - print STDERR "$Pgm: no argument following $option option\n"; - $Status++; - } -} -\end{code} + /^-Onot$/ && do { $OptLevel = 0; next arg; }; # # set it to -\begin{code} -sub isntAntiFlag { - local($flag) = @_; - local($f); + /^-Ofile(.*)/ && do { + $OptLevel = 3; + local($ofile) = &grab_arg_arg(*Args,'-Ofile', $1); + @HsC_minusO3_flags = (); -#Not in HsC_antiflag ## NO!: and not already in HsC_flags + open(OFILE, "< $ofile") || die "Can't open $ofile!\n"; + while () { + chop; + s/\#.*//; # death to comments + s/[ \t]+//g; # death to whitespace + next if /^$/; # ditto, blank lines + s/([()*{}])/\\$1/g; # protect shell metacharacters + if ( /^C:(.*)/ ) { + push(@CcBoth_flags, $1); + } else { + push(@HsC_minusO3_flags, $_); + } + } + close(OFILE); + next arg; }; - foreach $f ( @HsC_antiflags ) { - return(0) if $flag eq $f; - } -# foreach $f ( @HsC_flags ) { -# return(0) if $flag eq $f; -# } - return(1); -} + /^-debug$/ && do { # all this does is mark a .hc/.o as "debugging" + # in the consistency info + $DEBUGging = 'd'; + next arg; }; -sub squashHscFlag { # pretty terrible - local($flag) = @_; - local($f); + #---------- linking .a file -------------------------------------------- - foreach $f ( @HsC_flags ) { - if ($flag eq $f) { $f = ''; } - } -} + /^-Main(.*)/ && do { + # specifies main or mainPrimIO to be linked + $Ld_main = $1; + next arg; }; -sub add_Hsc_flags { - local(@flags) = @_; - local($f); + #---------- catch unrecognized flags ----------------------------------- + + /^-./ && do { + print STDERR "$Pgm: unrecognised option: $_\n"; + $Status++; + next arg; }; - foreach $f ( @flags ) { - push( @HsC_flags, $f ) if &isntAntiFlag($f); - } } -\end{code} +} # end of processArgs + +\end{code}