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