The library functions are much faster.
Signed-off-by: David Cock <david.cock@inf.ethz.ch>
module ARM11MP where
import HakeTypes
-import Path
import qualified Config
import qualified ARMv5
import qualified ArchDefaults
module ARMv5 where
import HakeTypes
-import Path
import qualified Config
import qualified ArchDefaults
module ARMv7 where
import HakeTypes
-import Path
import qualified Config
import qualified ArchDefaults
module ARMv7_M where
--module names can not contain "-", so I went for an underscore instead
import HakeTypes
-import Path
import qualified Config
import qualified ArchDefaults
import Data.List
import HakeTypes
-import Path
+import System.FilePath
import qualified Config
commonFlags = [ Str s | s <- [ "-fno-builtin",
cStdIncs arch archFamily =
[ NoDep SrcTree "src" "/include",
- NoDep SrcTree "src" ("/include/arch" ./. archFamily),
+ NoDep SrcTree "src" ("/include/arch" </> archFamily),
NoDep SrcTree "src" Config.libcInc,
NoDep SrcTree "src" "/include/c",
- NoDep SrcTree "src" ("/include/target" ./. archFamily),
+ NoDep SrcTree "src" ("/include/target" </> archFamily),
NoDep SrcTree "src" Config.lwipxxxInc, -- XXX
NoDep SrcTree "src" Config.lwipInc,
NoDep InstallTree arch "/include",
module K1om where
import HakeTypes
-import Path
import qualified Config
import qualified ArchDefaults
where
module_paths = [ (opt_installdir o) </> "hake", ".",
(opt_bfsourcedir o) </> "hake" ]
- source_modules = [ "HakeTypes", "RuleDefs", "Path", "Args", "Config" ]
- modules = [ "Prelude", "HakeTypes", "RuleDefs", "Path", "Args" ]
+ source_modules = [ "HakeTypes", "RuleDefs", "Args", "Config" ]
+ modules = [ "Prelude", "System.FilePath", "HakeTypes", "RuleDefs",
+ "Args" ]
qualified_modules = [ "Config", "Data.List" ]
-- Evaluate one Hakefile, and emit its Makefile section. We collect
+++ /dev/null
-{-
- Path: functions for manipulating (POSIX) path names.
-
- Part of Hake: a makefile generator for Barrelfish
-
- Copyright (c) 2009, ETH Zurich.
- All rights reserved.
-
- This file is distributed under the terms in the attached LICENSE file.
- If you do not find this file, copies can be found by writing to:
- ETH Zurich D-INFK, Universitätstasse 6, CH-8092 Zurich. Attn: Systems Group.
--}
-
-module Path (dirname, basename,
- (.<.), isBelow, isInSameDirAs,
- normalise,
- (./.), relToDir, relToFile,
- makeRel, makeAbs,
- removePrefix,
- replaceSuffices, replaceSuffix, removeSuffix )
-where
-
-import Data.List
-
-data T = T { leading :: Bool,
- parts :: [String],
- trailing :: Bool }
- deriving (Show,Eq)
-
-make :: String -> T
-make "" = T { leading = False, parts = [], trailing = False }
-make s
- | (head s) == '/' =
- (make $ tail s) { leading = True }
- | (last s) == '/' =
- (make (reverse $ tail $ reverse s)) { trailing = True }
- | otherwise = T { leading = False, parts = make_parts s, trailing = False }
-
-make_parts :: String -> [String]
-make_parts "" = []
-make_parts s = let (l, s') = break (== '/') s
- in l : case s' of
- [] -> []
- (_:s'') -> make_parts s''
-
-toStr :: T -> String
-toStr n =
- (if leading n then "/" else "")
- ++
- (foldl (++) "" (intersperse "/" (parts n)))
- ++
- (if trailing n then "/" else "")
-
---
--- Strip non-directory suffix from a file name, designed to mimic Unix
--- dirname(1).
---
-dirname :: String -> String
-dirname n = toStr $ dirname' $ make n
-
-dirname' :: T -> T
-dirname' n
- | ((length $ parts n) < 2) && (not $ leading n) = make "."
- | otherwise = n { parts = (init $ parts n) }
-
---
--- Strip directory from filenames
--- Equivalent to the 1-argument form of Unix basename(1).
---
-basename :: String -> String
-basename n = toStr $ basename' $ make n
-
-basename' :: T -> T
-basename' n = make $ last $ parts n
-
---
--- Return whether the two paths are in the same directory
---
-isInSameDirAs :: String -> String -> Bool
-isInSameDirAs f1 f2 = (dirname f1) == (dirname f2)
-
---
--- Remove redundant '.' and '..' from a path name
---
-normalise :: String -> String
-normalise n = toStr $ normalise' $ make n
-
-normalise' :: T -> T
-normalise' n
- | parts n == [] = n
- | leading n = n { parts = walkAbsPath $ parts n }
- | otherwise = n { parts = walkPath [] (parts n) }
-
---
--- Normalise a path starting with '/'
---
-walkAbsPath :: [String] -> [String]
-walkAbsPath (".":p) = walkAbsPath p
-walkAbsPath ("..":p) = walkAbsPath p
-walkAbsPath p = walkPath [] p
-
-walkPath :: [String] -> [String] -> [String]
-walkPath acc [] = acc
-walkPath [] (".":p) = walkPath ["."] p
-walkPath [] ("..":p) = walkPath [".."] p
-walkPath acc (".":p) = walkPath acc p
-walkPath ["."] ("..":p) = walkPath [".."] p
-walkPath acc ("..":p)
- | ".." == (last acc) = walkPath (acc ++ [".."]) p
- | otherwise = walkPath (init acc) p
-walkPath acc (p:ps) = walkPath (acc ++ [p]) ps
-
-infix 4 ./.
-(./.) :: String -> String -> String
-root ./. path = relToDir path root
-
-relToDir :: String -> String -> String
-relToDir path root = toStr (relToDir' (make path) (make root))
-
-relToDir' :: T -> T -> T
-relToDir' path root
- | leading path = path
- | otherwise = normalise' root { parts = (parts root) ++ (parts path),
- trailing = (trailing path) }
-
-relToFile :: String -> String -> String
-relToFile path root = toStr (relToFile' (make path) (make root))
-
-relToFile' :: T -> T -> T
-relToFile' path root
- | leading path = path
- | trailing root = relToDir' path root
- | otherwise = normalise' root { parts = (init $ parts root) ++ (parts path),
- trailing = (trailing path) }
-
---
--- Turn a pathname into a relative one, or an absolute one
---
-makeRel :: String -> String
-makeRel n = toStr ((make n) { leading = False })
-makeAbs :: String -> String
-makeAbs n = toStr $ normalise' ((make n) { leading = True })
-
---
--- Return whether one path is below another path
---
-infix 9 .<.
-n .<. m = isBelow m n
-
-isBelow :: String -> String -> Bool
-isBelow n1 n2 =
- (parts $ make n2) `isPrefixOf` (parts $ make n1)
-
-isBelow' :: T -> T -> Bool
-isBelow' n1 n2 =
- parts n2 `isPrefixOf` parts n1
-
---
--- Remove a prefix
---
-removePrefix :: String -> String -> String
-removePrefix prefix f
- | prefix .<. f =
- let f' = make f
- len = length $ parts $ make prefix
- in
- toStr $ normalise' f' { parts = "." : drop len (parts f') }
- | otherwise = f
-
-
-
---
--- Replace one suffix with another.
---
-replaceSuffices :: [ String ] -> String -> String -> [ String ]
-replaceSuffices l s o = map (\x -> replaceSuffix x s o) l
-
-replaceSuffix :: String -> String -> String -> String
-replaceSuffix x s o =
- if isSuffixOf s x
- then (take ((length x) - (length s)) x) ++ o
- else x
-
-removeSuffix :: String -> String
-removeSuffix s =
- case (elemIndices '.' s) of
- [] -> s
- l -> take (last l) s
module RuleDefs where
import Data.List (intersect, isSuffixOf, union, (\\), nub, sortBy, elemIndex)
-import Path
+import System.FilePath
import qualified X86_64
import qualified K1om
import qualified X86_32
--
withSuffix :: [String] -> String -> String -> [String]
withSuffix af tf arg =
- [ basename f | f <- af, f `isInSameDirAs` tf, isSuffixOf arg f ]
+ [ takeFileName f | f <- af,
+ takeDirectory f == takeDirectory tf,
+ takeExtension f == arg ]
+
withSuffices :: [String] -> String -> [String] -> [String]
withSuffices af tf args =
concat [ withSuffix af tf arg | arg <- args ]
inDir :: [String] -> String -> String -> String -> [String]
inDir af tf dir suffix =
-- Dummy is here so that we can find files in the same dir :-/
- let subdir = (if head dir == '/' then absdir else reldir) ./. "dummy"
+ let subdir = (if head dir == '/' then absdir else reldir) </> "dummy"
absdir = if head tf == '/' then dir else '.':dir
- reldir = (dirname tf) ./. dir
+ reldir = (takeDirectory tf) </> dir
files = withSuffix af subdir suffix
in
- [ dir ./. f | f <- files ]
+ [ dir </> f | f <- files ]
cInDir :: [String] -> String -> String -> [String]
cInDir af tf dir = inDir af tf dir ".c"
"/include" ]]
++
[ NoDep SrcTree "src" f | f <- [
- "/kernel/include/arch" ./. arch,
- "/kernel/include/arch" ./. archFamily arch,
+ "/kernel/include/arch" </> arch,
+ "/kernel/include/arch" </> archFamily arch,
"/kernel/include",
"/include",
- "/include/arch" ./. archFamily arch,
+ "/include/arch" </> archFamily arch,
Config.libcInc,
"/include/c",
- "/include/target" ./. archFamily arch]]
+ "/include/target" </> archFamily arch]]
++ kernelOptIncludes arch
kernelOptions arch = Options {
dependFilePath obj = obj ++ ".depend"
objectFilePath :: Options -> String -> String
-objectFilePath opts src = (optSuffix opts) ./. ((removeSuffix src) ++ ".o")
+objectFilePath opts src = optSuffix opts </> replaceExtension src ".o"
generatedObjectFilePath :: Options -> String -> String
-generatedObjectFilePath opts src = (removeSuffix src) ++ ".o"
+generatedObjectFilePath opts src = replaceExtension src ".o"
preprocessedFilePath :: Options -> String -> String
-preprocessedFilePath opts src = (optSuffix opts) ./. ((removeSuffix src) ++ ".i")
+preprocessedFilePath opts src = optSuffix opts </> replaceExtension src ".i"
-- Standard convention is that human generated assembler is .S, machine generated is .s
assemblerFilePath :: Options -> String -> String
-assemblerFilePath opts src = (optSuffix opts) ./. ((removeSuffix src) ++ ".s")
+assemblerFilePath opts src = optSuffix opts </> replaceExtension src ".s"
-------------------------------------------------------------------------
-- Build a Mackerel header file from a definition.
--
mackerelProgLoc = In InstallTree "tools" "/bin/mackerel"
-mackerelDevFileLoc d = In SrcTree "src" ("/devices" ./. (d ++ ".dev"))
-mackerelDevHdrPath d = "/include/dev/" ./. (d ++ "_dev.h")
+mackerelDevFileLoc d = In SrcTree "src" ("/devices" </> (d ++ ".dev"))
+mackerelDevHdrPath d = "/include/dev/" </> (d ++ "_dev.h")
mackerel2 :: Options -> String -> HRule
mackerel2 opts dev = mackerel_generic opts dev "shift-driver"
--
flounderProgLoc = In InstallTree "tools" "/bin/flounder"
-flounderIfFileLoc ifn = In SrcTree "src" ("/if" ./. (ifn ++ ".if"))
+flounderIfFileLoc ifn = In SrcTree "src" ("/if" </> (ifn ++ ".if"))
-- new-style stubs: path for generic header
-flounderIfDefsPath ifn = "/include/if" ./. (ifn ++ "_defs.h")
+flounderIfDefsPath ifn = "/include/if" </> (ifn ++ "_defs.h")
-- new-style stubs: path for specific backend header
-flounderIfDrvDefsPath ifn drv = "/include/if" ./. (ifn ++ "_" ++ drv ++ "_defs.h")
+flounderIfDrvDefsPath ifn drv = "/include/if" </> (ifn ++ "_" ++ drv ++ "_defs.h")
-- new-style stubs: generated C code (for all default enabled backends)
flounderBindingPath opts ifn =
- (optSuffix opts) ./. (ifn ++ "_flounder_bindings.c")
+ (optSuffix opts) </> (ifn ++ "_flounder_bindings.c")
-- new-style stubs: generated C code (for extra backends enabled by the user)
flounderExtraBindingPath opts ifn =
- (optSuffix opts) ./. (ifn ++ "_flounder_extra_bindings.c")
+ (optSuffix opts) </> (ifn ++ "_flounder_extra_bindings.c")
-flounderTHCHdrPath ifn = "/include/if" ./. (ifn ++ "_thc.h")
+flounderTHCHdrPath ifn = "/include/if" </> (ifn ++ "_thc.h")
flounderTHCStubPath opts ifn =
- (optSuffix opts) ./. (ifn ++ "_thc.c")
+ (optSuffix opts) </> (ifn ++ "_thc.c")
-applicationPath name = "/sbin" ./. name
-libraryPath libname = "/lib" ./. ("lib" ++ libname ++ ".a")
+applicationPath name = "/sbin" </> name
+libraryPath libname = "/lib" </> ("lib" ++ libname ++ ".a")
kernelPath = "/sbin/cpu"
-- construct include arguments to flounder for common types
flounderIncludes :: Options -> [RuleToken]
flounderIncludes opts
= concat [ [Str "-i", flounderIfFileLoc ifn]
- | ifn <- [ "platform" ./. (optArch opts), -- XXX: optPlatform
- "arch" ./. (optArch opts),
+ | ifn <- [ "platform" </> (optArch opts), -- XXX: optPlatform
+ "arch" </> (optArch opts),
"types" ] ]
flounderRule :: Options -> [RuleToken] -> HRule
--
linkKernel :: Options -> String -> [String] -> [String] -> HRule
linkKernel opts name objs libs
- | optArch opts == "x86_64" = X86_64.linkKernel opts objs [libraryPath l | l <- libs ] ("/sbin" ./. name)
- | optArch opts == "k1om" = K1om.linkKernel opts objs [libraryPath l | l <- libs ] ("/sbin" ./. name)
- | optArch opts == "x86_32" = X86_32.linkKernel opts objs [libraryPath l | l <- libs ] ("/sbin" ./. name)
- | optArch opts == "armv5" = ARMv5.linkKernel opts objs [libraryPath l | l <- libs ] ("/sbin" ./. name)
- | optArch opts == "arm11mp" = ARM11MP.linkKernel opts objs [libraryPath l | l <- libs ] ("/sbin" ./. name)
- | optArch opts == "xscale" = XScale.linkKernel opts objs [libraryPath l | l <- libs ] ("/sbin" ./. name)
+ | optArch opts == "x86_64" = X86_64.linkKernel opts objs [libraryPath l | l <- libs ] ("/sbin" </> name)
+ | optArch opts == "k1om" = K1om.linkKernel opts objs [libraryPath l | l <- libs ] ("/sbin" </> name)
+ | optArch opts == "x86_32" = X86_32.linkKernel opts objs [libraryPath l | l <- libs ] ("/sbin" </> name)
+ | optArch opts == "armv5" = ARMv5.linkKernel opts objs [libraryPath l | l <- libs ] ("/sbin" </> name)
+ | optArch opts == "arm11mp" = ARM11MP.linkKernel opts objs [libraryPath l | l <- libs ] ("/sbin" </> name)
+ | optArch opts == "xscale" = XScale.linkKernel opts objs [libraryPath l | l <- libs ] ("/sbin" </> name)
| optArch opts == "armv7" = ARMv7.linkKernel opts objs [libraryPath l | l <- libs ] name
| optArch opts == "armv7-m" = ARMv7_M.linkKernel opts objs [libraryPath l | l <- libs ] name
| otherwise = Rule [ Str ("Error: Can't link kernel for '" ++ (optArch opts) ++ "'") ]
Str "--make ",
In SrcTree "src" main,
Str "-o ",
- Out "tools" ("/bin" ./. prog),
+ Out "tools" ("/bin" </> prog),
Str "$(LDFLAGS)" ]
++ concat [[ NStr "-i", NoDep SrcTree "src" d] | d <- dirs]
++ [ (Dep SrcTree "src" dep) | dep <- deps ]
compileNativeC prog cfiles cflags ldflags =
Rule ([ Str nativeCCompiler,
Str "-o",
- Out "tools" ("/bin" ./. prog),
+ Out "tools" ("/bin" </> prog),
Str "$(CFLAGS)",
Str "$(LDFLAGS)" ]
++ [ (Str flag) | flag <- cflags ]
in
Rule ( [ Dep SrcTree "src" (f ++ ".pdf") | f <- figs]
++
- [ Dep SrcTree "src" ("/doc/style" ./. f) | f <- style_files ]
+ [ Dep SrcTree "src" ("/doc/style" </> f) | f <- style_files ]
++
[ Str "mkdir", Str "-p", working_dir, NL ]
++
module X86_32 where
import HakeTypes
-import Path
import qualified Config
import qualified ArchDefaults
module X86_64 where
import HakeTypes
-import Path
import qualified Config
import qualified ArchDefaults
module XScale where
import HakeTypes
-import Path
import qualified Config
import qualified ArchDefaults
--
--------------------------------------------------------------------------
-[(let arch_dir = "arch" ./. archFamily arch
+[(let arch_dir = "arch" </> archFamily arch
common_srcs = [ "capabilities.c", "init.c", "dispatch.c", "threads.c",
"thread_once.c", "thread_sync.c", "slab.c", "domain.c", "idc.c",
"waitset.c", "event_queue.c", "event_mutex.c",
("spawn", ["rpcclient"]),
("arrakis", ["rpcclient"])],
addCFlags = [ "-DMORECORE_PAGESIZE="++(morecore_pagesize arch) ],
- addIncludes = [ "include", "include" ./. arch_dir, (arch_include arch) ],
+ addIncludes = [ "include", "include" </> arch_dir, (arch_include arch) ],
addGeneratedDependencies = [ "/include/asmoffsets.h" ]
}
) | arch <- allArchitectures ] ++
-[(let arch_dir = "arch" ./. archFamily arch
+[(let arch_dir = "arch" </> archFamily arch
common_srcs = [ "capabilities.c", "init.c", "dispatch.c", "threads.c",
"thread_sync.c", "slab.c", "domain.c", "idc.c",
"waitset.c", "event_queue.c", "event_mutex.c",
("octopus", ["rpcclient"]),
("spawn", ["rpcclient"]),
("arrakis", ["rpcclient"])],
- addIncludes = [ "include", "include" ./. arch_dir, (arch_include arch) ],
+ addIncludes = [ "include", "include" </> arch_dir, (arch_include arch) ],
addGeneratedDependencies = [ "/include/asmoffsets.h" ]
}
) | arch <- allArchitectures ]
extraDependencies = [ Dep BuildTree arch "/include/asmoffsets.h" ],
extraDefines = [ "-Wno-array-bounds" ]
}
- adir = "arch" ./. archFamily arch
+ adir = "arch" </> archFamily arch
in
- Rules [assembleSFile opts (adir ./. "crt0.S"),
- copy opts (adir ./. "crt0.o") "/lib/crt0.o",
+ Rules [assembleSFile opts (adir </> "crt0.S"),
+ copy opts (adir </> "crt0.o") "/lib/crt0.o",
compileCFile opts ("crtbegin.c"),
copy opts "crtbegin.o" "/lib/crtbegin.o",
compileCFile opts ("crtend.c"),
[(
let
-- architecture independent source files
- generic_src = [ "src" ./. f | f <- [
+ generic_src = [ "src" </> f | f <- [
"asctime.c", "fseek.c", "getchar.c", "strncpy.c",
"assert.c", "ftell.c", "getenv.c", "rewind.c", "strpbrk.c",
"calloc.c", "fwrite.c", "getopt.c", "scanf.c", "strrchr.c",
"locale/wctype.c", "string/strcasecmp.c" ]]
-- architecture-dependent source files (relative to arch family)
- archfam_src a = [ ("src/arch-" ++ a) ./. f | f <- archfam_files a ]
+ archfam_src a = [ ("src/arch-" ++ a) </> f | f <- archfam_files a ]
archfam_files "x86_64" = ["flt_rounds.c"]
archfam_files "x86_32" = ["flt_rounds.c"]
archfam_files _ = []
args = library { target = "oldc",
cFiles = generic_src ++ (archfam_src (archFamily a)),
architectures = [a],
- addIncludes = [ "src/gdtoa", "src/gdtoa" ./. archFamily a,
+ addIncludes = [ "src/gdtoa", "src/gdtoa" </> archFamily a,
"src/locale" ],
addCFlags = [ "-DNO_FENV_H", "-DNO_ERRNO", "-DHAVE_WCHAR" ],
- assemblyFiles = [ ("src/arch-" ++ archFamily a) ./. "jmp.S" ]
+ assemblyFiles = [ ("src/arch-" ++ archFamily a) </> "jmp.S" ]
}
defaultopts = libGetOptionsForArch a args
if Config.libc == "oldc" then
[(
let
- common_src = ["src" ./. f | f <- [
+ common_src = ["src" </> f | f <- [
"e_acos.c", "e_acosf.c", "e_acosh.c", "e_acoshf.c", "e_asin.c", "e_asinf.c",
"e_atan2.c", "e_atan2f.c", "e_atanh.c", "e_atanhf.c", "e_cosh.c", "e_coshf.c", "e_exp.c",
"e_expf.c", "e_fmod.c", "e_fmodf.c", "e_gamma.c", "e_gamma_r.c", "e_gammaf.c",
"s_fabs.c", "s_frexp.c", "s_isnan.c", "s_ldexp.c", "s_modf.c"]]
(longdouble_dir, arch_csrc, arch_asmsrc) = case a of
- "x86_64" -> ("ld80", ["amd64/fenv.c"], ["amd64" ./. f | f <- [
+ "x86_64" -> ("ld80", ["amd64/fenv.c"], ["amd64" </> f | f <- [
"e_remainderf.S", "e_sqrt.S", "s_llrintf.S",
"s_lrintf.S", "s_remquof.S", "s_scalbnf.S", "e_sqrtf.S",
"s_llrintl.S", "s_lrintl.S", "s_remquol.S",
_ -> ("", [], [])
longdouble_src = if longdouble_dir == "" then [] else (
- [longdouble_dir ./. f | f <- [
+ [longdouble_dir </> f | f <- [
"invtrig.c", "k_cosl.c", "k_sinl.c", "k_tanl.c",
"s_exp2l.c", "s_nanl.c"]]
++
- ["src" ./. f | f <- [
+ ["src" </> f | f <- [
"e_acosl.c", "e_asinl.c", "e_atan2l.c", "e_fmodl.c",
"e_hypotl.c", "e_remainderl.c", "e_sqrtl.c",
"s_atanl.c", "s_ceill.c", "s_cosl.c", "s_cprojl.c", "s_csqrtl.c",
build library { target = "spawndomain",
cFiles = common_srcs ++ arch_srcs (archFamily arch),
addIncludes = [ "/lib/barrelfish/include/arch"
- ./. archFamily arch ],
+ </> archFamily arch ],
flounderDefs = [ "monitor", "octopus" ],
flounderExtraDefs = [ ("octopus", ["rpcclient"]) ],
architectures = [ arch ],
--------------------------------------------------------------------------
[(let
- arch_dir = "arch" ./. archFamily arch
+ arch_dir = "arch" </> archFamily arch
arch_dirs "x86_32" = [ arch_dir, "arch/x86" ]
arch_dirs "x86_64" = [ arch_dir, "arch/x86" ]
("mem", ["rpcclient"]),
("octopus", ["rpcclient"]) ],
addLinkFlags = [ "-e _start_init" ],
- addIncludes = "include" : [ "include" ./. a | a <- arch_dirs arch ],
+ addIncludes = "include" : [ "include" </> a | a <- arch_dirs arch ],
addLibraries = (
[ "spawndomain", "bench", "trace", "elf" ]
++ idc_libraries)