ghc/compiler/main/SysTools.lhs

   1 -----------------------------------------------------------------------------
   2 -- Access to system tools: gcc, cp, rm etc
   3 --
   4 -- (c) The University of Glasgow 2000
   5 --
   6 -----------------------------------------------------------------------------
   7
   8 \begin{code}
   9 module SysTools (
  10         -- Initialisation
  11         initSysTools,
  12         setPgm,                 -- String -> IO ()
  13                                 -- Command-line override
  14         setDryRun,
  15
  16         packageConfigPath,      -- IO String
  17                                 -- Where package.conf is
  18
  19         -- Interface to system tools
  20         runUnlit, runCpp, runCc, -- [String] -> IO ()
  21         runMangle, runSplit,     -- [String] -> IO ()
  22         runAs, runLink,          -- [String] -> IO ()
  23         runMkDLL,
  24
  25         touch,                  -- String -> String -> IO ()
  26         copy,                   -- String -> String -> String -> IO ()
  27
  28         -- Temporary-file management
  29         setTmpDir,
  30         newTempName,
  31         cleanTempFiles, cleanTempFilesExcept, removeTmpFiles,
  32         addFilesToClean,
  33
  34         -- System interface
  35         getProcessID,           -- IO Int
  36         System.system,          -- String -> IO Int     -- System.system
  37
  38         -- Misc
  39         showGhcUsage,           -- IO ()        Shows usage message and exits
  40         getSysMan,              -- IO String    Parallel system only
  41         dosifyPath,             -- String -> String
  42
  43         runSomething    -- ToDo: make private
  44  ) where
  45
  46 import DriverUtil
  47 import Config
  48 import Outputable
  49 import Panic            ( progName, GhcException(..) )
  50 import Util             ( global )
  51 import CmdLineOpts      ( dynFlag, verbosity )
  52
  53 import List             ( intersperse )
  54 import Exception        ( throwDyn, catchAllIO )
  55 import IO               ( hPutStr, hPutChar, hPutStrLn, hFlush, stderr )
  56 import Directory        ( doesFileExist, removeFile )
  57 import IOExts           ( IORef, readIORef, writeIORef )
  58 import Monad            ( when, unless )
  59 import qualified System
  60 import System           ( ExitCode(..) )
  61
  62 #include "../includes/config.h"
  63
  64 #if !defined(mingw32_TARGET_OS)
  65 import qualified Posix
  66 #else
  67 import Addr              ( nullAddr )
  68 #endif
  69
  70 #include "HsVersions.h"
  71
  72 {-# DEPRECATED runSomething "runSomething should be private to SysTools" #-}
  73
  74 \end{code}
  75
  76
  77                 The configuration story
  78                 ~~~~~~~~~~~~~~~~~~~~~~~
  79
  80 GHC needs various support files (library packages, RTS etc), plus
  81 various auxiliary programs (cp, gcc, etc).  It finds these in one
  82 of two places:
  83
  84 * When running as an *installed program*, GHC finds most of this support
  85   stuff in the installed library tree.  The path to this tree is passed
  86   to GHC via the -B flag, and given to initSysTools .
  87
  88 * When running *in-place* in a build tree, GHC finds most of this support
  89   stuff in the build tree.  The path to the build tree is, again passed
  90   to GHC via -B.
  91
  92 GHC tells which of the two is the case by seeing whether package.conf
  93 is in TopDir [installed] or in TopDir/ghc/driver [inplace] (what a hack).
  94
  95
  96 SysTools.initSysProgs figures out exactly where all the auxiliary programs
  97 are, and initialises mutable variables to make it easy to call them.
  98 To to this, it makes use of definitions in Config.hs, which is a Haskell
  99 file containing variables whose value is figured out by the build system.
 100
 101 Config.hs contains two sorts of things
 102
 103   cGCC,         The *names* of the programs
 104   cCPP            e.g.  cGCC = gcc
 105   cUNLIT                cCPP = gcc -E
 106   etc           They do *not* include paths
 107
 108
 109   cUNLIT_DIR    The *path* to the directory containing unlit, split etc
 110   cSPLIT_DIR    *relative* to the root of the build tree,
 111                 for use when running *in-place* in a build tree (only)
 112
 113
 114
 115 %************************************************************************
 116 %*                                                                      *
 117 \subsection{Global variables to contain system programs}
 118 %*                                                                      *
 119 %************************************************************************
 120
 121 \begin{code}
 122 GLOBAL_VAR(v_Pgm_L,     error "pgm_L",   String)        -- unlit
 123 GLOBAL_VAR(v_Pgm_P,     error "pgm_P",   String)        -- cpp
 124 GLOBAL_VAR(v_Pgm_c,     error "pgm_c",   String)        -- gcc
 125 GLOBAL_VAR(v_Pgm_m,     error "pgm_m",   String)        -- asm code mangler
 126 GLOBAL_VAR(v_Pgm_s,     error "pgm_s",   String)        -- asm code splitter
 127 GLOBAL_VAR(v_Pgm_a,     error "pgm_a",   String)        -- as
 128 GLOBAL_VAR(v_Pgm_l,     error "pgm_l",   String)        -- ld
 129 GLOBAL_VAR(v_Pgm_MkDLL, error "pgm_dll", String)        -- mkdll
 130
 131 GLOBAL_VAR(v_Pgm_T,    error "pgm_T",    String)        -- touch
 132 GLOBAL_VAR(v_Pgm_CP,   error "pgm_CP",   String)        -- cp
 133
 134 GLOBAL_VAR(v_Path_package_config, error "path_package_config", String)
 135 GLOBAL_VAR(v_Path_usage,          error "ghc_usage.txt",       String)
 136
 137 -- Parallel system only
 138 GLOBAL_VAR(v_Pgm_sysman, error "pgm_sysman", String)    -- system manager
 139 \end{code}
 140
 141
 142 %************************************************************************
 143 %*                                                                      *
 144 \subsection{Initialisation}
 145 %*                                                                      *
 146 %************************************************************************
 147
 148 \begin{code}
 149 initSysTools :: [String]        -- Command-line arguments starting "-B"
 150
 151              -> IO String       -- Set all the mutable variables above, holding
 152                                 --      (a) the system programs
 153                                 --      (b) the package-config file
 154                                 --      (c) the GHC usage message
 155                                 -- Return TopDir
 156
 157
 158 initSysTools minusB_args
 159   = do  { (am_installed, top_dir) <- getTopDir minusB_args
 160                 -- top_dir
 161                 --      for "installed" this is the root of GHC's support files
 162                 --      for "in-place" it is the root of the build tree
 163
 164         ; let installed_bin pgm   =  top_dir `slash` "bin" `slash` pgm
 165               installed     file  =  top_dir `slash` file
 166               inplace dir   pgm   =  top_dir `slash` dir `slash` pgm
 167
 168         ; let pkgconfig_path
 169                 | am_installed = installed "package.conf"
 170                 | otherwise    = inplace cGHC_DRIVER_DIR "package.conf.inplace"
 171
 172               ghc_usage_msg_path
 173                 | am_installed = installed "ghc-usage.txt"
 174                 | otherwise    = inplace cGHC_DRIVER_DIR "ghc-usage.txt"
 175
 176                 -- For all systems, unlit, split, mangle are GHC utilities
 177                 -- architecture-specific stuff is done when building Config.hs
 178               unlit_path
 179                 | am_installed = installed_bin cGHC_UNLIT
 180                 | otherwise    = inplace cGHC_UNLIT_DIR cGHC_UNLIT
 181
 182                 -- split and mangle are Perl scripts
 183               split_script
 184                 | am_installed = installed_bin cGHC_SPLIT
 185                 | otherwise    = inplace cGHC_SPLIT_DIR cGHC_SPLIT
 186
 187               mangle_script
 188                 | am_installed = installed_bin cGHC_MANGLER
 189                 | otherwise    = inplace cGHC_MANGLER_DIR cGHC_MANGLER
 190
 191         -- Check that the package config exists
 192         ; config_exists <- doesFileExist pkgconfig_path
 193         ; when (not config_exists) $
 194              throwDyn (InstallationError
 195                          ("Can't find package.conf in " ++ pkgconfig_path))
 196
 197 #if defined(mingw32_TARGET_OS)
 198         --              WINDOWS-SPECIFIC STUFF
 199         -- On Windows, gcc and friends are distributed with GHC,
 200         --      so when "installed" we look in TopDir/bin
 201         -- When "in-place" we look wherever the build-time configure
 202         --      script found them
 203         ; let cpp_path  | am_installed = installed cRAWCPP
 204                         | otherwise    = cRAWCPP
 205               gcc_path  | am_installed = installed cGCC
 206                         | otherwise    = cGCC
 207               perl_path | am_installed = installed cGHC_PERL
 208                         | otherwise    = cGHC_PERL
 209
 210         -- 'touch' is a GHC util for Windows, and similarly unlit, mangle
 211         ; let touch_path  | am_installed = installed cGHC_TOUCHY
 212                           | otherwise    = inplace cGHC_TOUCHY_DIR cGHC_TOUCHY
 213
 214         -- On Win32 we don't want to rely on #!/bin/perl, so we prepend
 215         -- a call to Perl to get the invocation of split and mangle
 216         ; let split_path  = perl_path ++ " " ++ split_script
 217               mangle_path = perl_path ++ " " ++ mangle_script
 218
 219         ; let mkdll_path = cMKDLL
 220 #else
 221         --              UNIX-SPECIFIC STUFF
 222         -- On Unix, the "standard" tools are assumed to be
 223         -- in the same place whether we are running "in-place" or "installed"
 224         -- That place is wherever the build-time configure script found them.
 225         ; let   cpp_path   = cRAWCPP
 226                 gcc_path   = cGCC
 227                 touch_path = cGHC_TOUCHY
 228                 mkdll_path = panic "Cant build DLLs on a non-Win32 system"
 229
 230         -- On Unix, scripts are invoked using the '#!' method.  Binary
 231         -- installations of GHC on Unix place the correct line on the front
 232         -- of the script at installation time, so we don't want to wire-in
 233         -- our knowledge of $(PERL) on the host system here.
 234         ; let split_path  = split_script
 235               mangle_path = mangle_script
 236
 237 #endif
 238
 239         -- For all systems, copy and remove are provided by the host
 240         -- system; architecture-specific stuff is done when building Config.hs
 241         ; let   cp_path = cGHC_CP
 242
 243         -- Other things being equal, as and ld are simply gcc
 244         ; let   as_path  = gcc_path
 245                 ld_path  = gcc_path
 246
 247
 248         -- Initialise the global vars
 249         ; writeIORef v_Path_package_config pkgconfig_path
 250         ; writeIORef v_Path_usage          ghc_usage_msg_path
 251
 252         ; writeIORef v_Pgm_sysman          (top_dir ++ "/ghc/rts/parallel/SysMan")
 253                 -- Hans: this isn't right in general, but you can
 254                 -- elaborate it in the same way as the others
 255
 256         ; writeIORef v_Pgm_L               unlit_path
 257         ; writeIORef v_Pgm_P               cpp_path
 258         ; writeIORef v_Pgm_c               gcc_path
 259         ; writeIORef v_Pgm_m               mangle_path
 260         ; writeIORef v_Pgm_s               split_path
 261         ; writeIORef v_Pgm_a               as_path
 262         ; writeIORef v_Pgm_l               ld_path
 263         ; writeIORef v_Pgm_MkDLL           mkdll_path
 264         ; writeIORef v_Pgm_T               touch_path
 265         ; writeIORef v_Pgm_CP              cp_path
 266
 267         ; return top_dir
 268         }
 269 \end{code}
 270
 271 setPgm is called when a command-line option like
 272         -pgmLld
 273 is used to override a particular program with a new onw
 274
 275 \begin{code}
 276 setPgm :: String -> IO ()
 277 -- The string is the flag, minus the '-pgm' prefix
 278 -- So the first character says which program to override
 279
 280 setPgm ('P' : pgm) = writeIORef v_Pgm_P pgm
 281 setPgm ('c' : pgm) = writeIORef v_Pgm_c pgm
 282 setPgm ('m' : pgm) = writeIORef v_Pgm_m pgm
 283 setPgm ('s' : pgm) = writeIORef v_Pgm_s pgm
 284 setPgm ('a' : pgm) = writeIORef v_Pgm_a pgm
 285 setPgm ('l' : pgm) = writeIORef v_Pgm_l pgm
 286 setPgm pgm         = unknownFlagErr ("-pgm" ++ pgm)
 287 \end{code}
 288
 289
 290 \begin{code}
 291 -- Find TopDir
 292 --      for "installed" this is the root of GHC's support files
 293 --      for "in-place" it is the root of the build tree
 294 --
 295 -- Plan of action:
 296 -- 1. Set proto_top_dir
 297 --      a) look for (the last) -B flag, and use it
 298 --      b) if there are no -B flags, get the directory
 299 --         where GHC is running
 300 --
 301 -- 2. If package.conf exists in proto_top_dir, we are running
 302 --      installed; and TopDir = proto_top_dir
 303 --
 304 -- 3. Otherwise we are running in-place, so
 305 --      proto_top_dir will be /...stuff.../ghc/compiler
 306 --      Set TopDir to /...stuff..., which is the root of the build tree
 307 --
 308 -- This is very gruesome indeed
 309
 310 getTopDir :: [String]
 311           -> IO (Bool,          -- True <=> am installed, False <=> in-place
 312                  String)        -- TopDir
 313
 314 getTopDir minusbs
 315   = do { proto_top_dir <- get_proto
 316
 317         -- Discover whether we're running in a build tree or in an installation,
 318         -- by looking for the package configuration file.
 319        ; am_installed <- doesFileExist (proto_top_dir `slash` "package.conf")
 320
 321        ; if am_installed then
 322             return (True, proto_top_dir)
 323          else
 324             return (False, remove_suffix proto_top_dir)
 325        }
 326   where
 327     get_proto | not (null minusbs)
 328               = return (dosifyPath (drop 2 (last minusbs)))
 329               | otherwise
 330               = do { maybe_exec_dir <- getExecDir -- Get directory of executable
 331                    ; case maybe_exec_dir of       -- (only works on Windows)
 332                         Nothing  -> throwDyn (InstallationError
 333                                                 "missing -B<dir> option")
 334                         Just dir -> return dir
 335                    }
 336
 337     remove_suffix dir   -- "/...stuff.../ghc/compiler" --> "/...stuff..."
 338         = ASSERT2( not (null p1) &&
 339                    not (null p2) &&
 340                    dosifyPath dir == dosifyPath (top_dir ++ "/ghc/compiler"),
 341                    text dir )
 342           top_dir
 343         where
 344          p1      = dropWhile (not . isSlash) (reverse dir)
 345          p2      = dropWhile (not . isSlash) (tail p1)  -- head is '/'
 346          top_dir = reverse (tail p2)                    -- head is '/'
 347 \end{code}
 348
 349
 350 %************************************************************************
 351 %*                                                                      *
 352 \subsection{Running an external program}
 353 n%*                                                                     *
 354 %************************************************************************
 355
 356
 357 \begin{code}
 358 runUnlit :: [String] -> IO ()
 359 runUnlit args = do p <- readIORef v_Pgm_L
 360                    runSomething "Literate pre-processor" p args
 361
 362 runCpp :: [String] -> IO ()
 363 runCpp args =   do p <- readIORef v_Pgm_P
 364                    runSomething "C pre-processor" p args
 365
 366 runCc :: [String] -> IO ()
 367 runCc args =   do p <- readIORef v_Pgm_c
 368                   runSomething "C Compiler" p args
 369
 370 runMangle :: [String] -> IO ()
 371 runMangle args = do p <- readIORef v_Pgm_m
 372                     runSomething "Mangler" p args
 373
 374 runSplit :: [String] -> IO ()
 375 runSplit args = do p <- readIORef v_Pgm_s
 376                    runSomething "Splitter" p args
 377
 378 runAs :: [String] -> IO ()
 379 runAs args = do p <- readIORef v_Pgm_a
 380                 runSomething "Assembler" p args
 381
 382 runLink :: [String] -> IO ()
 383 runLink args = do p <- readIORef v_Pgm_l
 384                   runSomething "Linker" p args
 385
 386 runMkDLL :: [String] -> IO ()
 387 runMkDLL args = do p <- readIORef v_Pgm_MkDLL
 388                    runSomething "Make DLL" p args
 389
 390 touch :: String -> String -> IO ()
 391 touch purpose arg =  do p <- readIORef v_Pgm_T
 392                         runSomething purpose p [arg]
 393
 394 copy :: String -> String -> String -> IO ()
 395 copy purpose from to = do p <- readIORef v_Pgm_CP
 396                           runSomething purpose p [from,to]
 397 \end{code}
 398
 399 \begin{code}
 400 getSysMan :: IO String  -- How to invoke the system manager
 401                         -- (parallel system only)
 402 getSysMan = readIORef v_Pgm_sysman
 403 \end{code}
 404
 405 %************************************************************************
 406 %*                                                                      *
 407 \subsection{GHC Usage message}
 408 %*                                                                      *
 409 %************************************************************************
 410
 411 Show the usage message and exit
 412
 413 \begin{code}
 414 showGhcUsage = do { usage_path <- readIORef v_Path_usage
 415                   ; usage      <- readFile usage_path
 416                   ; dump usage
 417                   ; System.exitWith System.ExitSuccess }
 418   where
 419      dump ""          = return ()
 420      dump ('$':'$':s) = hPutStr stderr progName >> dump s
 421      dump (c:s)       = hPutChar stderr c >> dump s
 422
 423 packageConfigPath = readIORef v_Path_package_config
 424 \end{code}
 425
 426
 427 %************************************************************************
 428 %*                                                                      *
 429 \subsection{Managing temporary files
 430 %*                                                                      *
 431 %************************************************************************
 432
 433 One reason this code is here is because SysTools.system needs to make
 434 a temporary file.
 435
 436 \begin{code}
 437 GLOBAL_VAR(v_FilesToClean, [],               [String] )
 438 GLOBAL_VAR(v_TmpDir,       cDEFAULT_TMPDIR,  String   )
 439         -- v_TmpDir has no closing '/'
 440 \end{code}
 441
 442 \begin{code}
 443 setTmpDir dir = writeIORef v_TmpDir dir
 444
 445 cleanTempFiles :: Int -> IO ()
 446 cleanTempFiles verb = do fs <- readIORef v_FilesToClean
 447                          removeTmpFiles verb fs
 448
 449 cleanTempFilesExcept :: Int -> [FilePath] -> IO ()
 450 cleanTempFilesExcept verb dont_delete
 451   = do fs <- readIORef v_FilesToClean
 452        let leftovers = filter (`notElem` dont_delete) fs
 453        removeTmpFiles verb leftovers
 454        writeIORef v_FilesToClean dont_delete
 455
 456
 457 -- find a temporary name that doesn't already exist.
 458 newTempName :: Suffix -> IO FilePath
 459 newTempName extn
 460   = do x <- getProcessID
 461        tmp_dir <- readIORef v_TmpDir
 462        findTempName tmp_dir x
 463   where
 464     findTempName tmp_dir x
 465       = do let filename = tmp_dir ++ "/ghc" ++ show x ++ '.':extn
 466            b  <- doesFileExist filename
 467            if b then findTempName tmp_dir (x+1)
 468                 else do add v_FilesToClean filename -- clean it up later
 469                         return filename
 470
 471 addFilesToClean :: [FilePath] -> IO ()
 472 -- May include wildcards [used by DriverPipeline.run_phase SplitMangle]
 473 addFilesToClean files = mapM_ (add v_FilesToClean) files
 474
 475 removeTmpFiles :: Int -> [FilePath] -> IO ()
 476 removeTmpFiles verb fs
 477   = traceCmd "Deleting temp files"
 478              ("Deleting: " ++ concat (intersperse " " fs))
 479              (mapM_ rm fs)
 480   where
 481     rm f = removeFile f `catchAllIO`
 482                 (\exn -> hPutStrLn stderr ("Warning: deleting non-existent " ++ f) >>
 483                          return ())
 484
 485 \end{code}
 486
 487
 488 %************************************************************************
 489 %*                                                                      *
 490 \subsection{Running a program}
 491 %*                                                                      *
 492 %************************************************************************
 493
 494 \begin{code}
 495 GLOBAL_VAR(v_Dry_run, False, Bool)
 496
 497 setDryRun :: IO ()
 498 setDryRun = writeIORef v_Dry_run True
 499
 500 -----------------------------------------------------------------------------
 501 -- Running an external program
 502
 503 runSomething :: String          -- For -v message
 504              -> String          -- Command name (possibly a full path)
 505                                 --      assumed already dos-ified
 506              -> [String]        -- Arguments
 507                                 --      runSomthing will dos-ify them
 508              -> IO ()
 509
 510 runSomething phase_name pgm args
 511  = traceCmd phase_name cmd_line $
 512    do   { exit_code <- System.system cmd_line
 513         ; if exit_code /= ExitSuccess
 514           then throwDyn (PhaseFailed phase_name exit_code)
 515           else return ()
 516         }
 517   where
 518     cmd_line = unwords (pgm : dosifyPaths args)
 519
 520 traceCmd :: String -> String -> IO () -> IO ()
 521 -- a) trace the command (at two levels of verbosity)
 522 -- b) don't do it at all if dry-run is set
 523 traceCmd phase_name cmd_line action
 524  = do   { verb <- dynFlag verbosity
 525         ; when (verb >= 2) $ hPutStrLn stderr ("*** " ++ phase_name)
 526         ; when (verb >= 3) $ hPutStrLn stderr cmd_line
 527         ; hFlush stderr
 528
 529            -- Test for -n flag
 530         ; n <- readIORef v_Dry_run
 531         ; unless n $ do {
 532
 533            -- And run it!
 534         ; action `catchAllIO` handle_exn verb
 535         }}
 536   where
 537     handle_exn verb exn = do { when (verb >= 2) (hPutStr   stderr "\n")
 538                              ; when (verb >= 3) (hPutStrLn stderr ("Failed: " ++ cmd_line))
 539                              ; throwDyn (PhaseFailed phase_name (ExitFailure 1)) }
 540 \end{code}
 541
 542
 543 %************************************************************************
 544 %*                                                                      *
 545 \subsection{Support code}
 546 %*                                                                      *
 547 %************************************************************************
 548
 549
 550 \begin{code}
 551 -----------------------------------------------------------------------------
 552 -- Convert filepath into MSDOS form.
 553
 554 dosifyPaths :: [String] -> [String]
 555 dosifyPath  :: String -> String
 556 -- dosifyPath does two things
 557 -- a) change '/' to '\'
 558 -- b) remove initial '/cygdrive/'
 559
 560 #if defined(mingw32_TARGET_OS)
 561 dosifyPaths xs = map dosifyPath xs
 562
 563 dosifyPath stuff
 564   = subst '/' '\\' real_stuff
 565  where
 566    -- fully convince myself that /cygdrive/ prefixes cannot
 567    -- really appear here.
 568   cygdrive_prefix = "/cygdrive/"
 569
 570   real_stuff
 571     | cygdrive_prefix `isPrefixOf` stuff = drop (length cygdrive_prefix) stuff
 572     | otherwise = stuff
 573
 574   subst a b ls = map (\ x -> if x == a then b else x) ls
 575 #else
 576 dosifyPaths xs = xs
 577 dosifyPath  xs = xs
 578 #endif
 579
 580 -----------------------------------------------------------------------------
 581 -- Path name construction
 582 --      At the moment, we always use '/' and rely on dosifyPath
 583 --      to switch to DOS pathnames when necessary
 584
 585 slash            :: String -> String -> String
 586 absPath, relPath :: [String] -> String
 587
 588 isSlash '/'   = True
 589 isSlash '\\'  = True
 590 isSlash other = False
 591
 592 relPath [] = ""
 593 relPath xs = foldr1 slash xs
 594
 595 absPath xs = "" `slash` relPath xs
 596
 597 #if defined(mingw32_TARGET_OS)
 598 slash s1 s2 = s1 ++ ('\\' : s2)
 599 #else
 600 slash s1 s2 = s1 ++ ('/' : s2)
 601 #endif
 602
 603 -----------------------------------------------------------------------------
 604 -- Define       myGetProcessId :: IO Int
 605 --              getExecDir     :: IO (Maybe String)
 606
 607 #ifdef mingw32_TARGET_OS
 608 foreign import "_getpid" getProcessID :: IO Int -- relies on Int == Int32 on Windows
 609
 610 getExecDir :: IO (Maybe String)
 611 getExecDir = return Nothing
 612 {-
 613 foreign import stdcall "GetCurrentDirectoryA" getCurrentDirectory :: Int32 -> CString -> IO Int32
 614 getExecDir = do len <- getCurrentDirectory 0 nullAddr
 615                 buf <- mallocArray (fromIntegral len)
 616                 ret <- getCurrentDirectory len buf
 617                 if ret == 0 then return Nothing
 618                             else do s <- peekCString buf
 619                                     destructArray (fromIntegral len) buf
 620                                     return (Just s)
 621 -}
 622 #else
 623 getProcessID :: IO Int
 624 getProcessID = Posix.getProcessID
 625 getExecDir :: IO (Maybe String) = do return Nothing
 626 #endif
 627 \end{code}