1--------------------------------------------------------------------------
2-- Copyright (c) 2007-2010, 2012, 2013, 2015 ETH Zurich.
3-- Copyright (c) 2014, HP Labs.
4-- All rights reserved.
5--
6-- This file is distributed under the terms in the attached LICENSE file.
7-- If you do not find this file, copies can be found by writing to:
8-- ETH Zurich D-INFK, CAB F.78, Universitaetstr. 6, CH-8092 Zurich,
9-- Attn: Systems Group.
10--
11-- Configuration options for Hake
12--
13--------------------------------------------------------------------------
14
15module Config where
16
17import HakeTypes
18import Data.Char
19import qualified Args
20import Data.List
21import Data.Maybe
22import System.FilePath
23import Tools (findTool, ToolDetails, toolPath, toolPrefix)
24import qualified Tools
25
26-- Set by hake.sh
27toolroot         :: Maybe FilePath
28arm_toolspec     :: Maybe (Maybe FilePath -> ToolDetails)
29aarch64_toolspec :: Maybe (Maybe FilePath -> ToolDetails)
30thumb_toolspec   :: Maybe (Maybe FilePath -> ToolDetails)
31armeb_toolspec   :: Maybe (Maybe FilePath -> ToolDetails)
32x86_toolspec     :: Maybe (Maybe FilePath -> ToolDetails)
33k1om_toolspec    :: Maybe (Maybe FilePath -> ToolDetails)
34
35-- Default toolchains
36arm_tools     = fromMaybe Tools.arm_system
37                          arm_toolspec
38                toolroot
39aarch64_tools = fromMaybe Tools.aarch64_system
40                          aarch64_toolspec
41                toolroot
42thumb_tools   = fromMaybe Tools.arm_netos_arm_2015q2
43                          thumb_toolspec
44                toolroot
45armeb_tools   = fromMaybe Tools.arm_netos_linaro_be_2015_02
46                          armeb_toolspec
47                toolroot
48x86_tools     = fromMaybe Tools.x86_system
49                          x86_toolspec
50                toolroot
51k1om_tools    = fromMaybe Tools.k1om_netos_mpss_3_7_1
52                          k1om_toolspec
53                toolroot
54
55-- ARM toolchain
56arm_gnu_tool = findTool (toolPath arm_tools) (toolPrefix arm_tools)
57arm_cc       = arm_gnu_tool "gcc"
58arm_objcopy  = arm_gnu_tool "objcopy"
59arm_objdump  = arm_gnu_tool "objdump"
60arm_ar       = arm_gnu_tool "ar"
61arm_ranlib   = arm_gnu_tool "ranlib"
62arm_cxx      = arm_gnu_tool "g++"
63
64-- ARM AArch64
65aarch64_gnu_tool = findTool (toolPath aarch64_tools) (toolPrefix aarch64_tools)
66aarch64_cc       = aarch64_gnu_tool "gcc"
67aarch64_objcopy  = aarch64_gnu_tool "objcopy"
68aarch64_objdump  = aarch64_gnu_tool "objdump"
69aarch64_ar       = aarch64_gnu_tool "ar"
70aarch64_ranlib   = aarch64_gnu_tool "ranlib"
71aarch64_cxx      = aarch64_gnu_tool "g++"
72
73-- ARM thumb (e.g. -M profile) toolchain
74thumb_gnu_tool = findTool (toolPath thumb_tools) (toolPrefix thumb_tools)
75thumb_cc       = thumb_gnu_tool "gcc"
76thumb_objcopy  = thumb_gnu_tool "objcopy"
77thumb_objdump  = thumb_gnu_tool "objdump"
78thumb_ar       = thumb_gnu_tool "ar"
79thumb_ranlib   = thumb_gnu_tool "ranlib"
80thumb_cxx      = thumb_gnu_tool "g++"
81
82-- ARM big-endian (e.g. XScale) toolchain
83armeb_gnu_tool = findTool (toolPath armeb_tools) (toolPrefix armeb_tools)
84armeb_cc       = armeb_gnu_tool "gcc"
85armeb_objcopy  = armeb_gnu_tool "objcopy"
86armeb_objdump  = armeb_gnu_tool "objdump"
87armeb_ar       = armeb_gnu_tool "ar"
88armeb_ranlib   = armeb_gnu_tool "ranlib"
89armeb_cxx      = armeb_gnu_tool "g++"
90
91-- X86 (32/64) toolchain
92x86_gnu_tool = findTool (toolPath x86_tools) (toolPrefix x86_tools)
93x86_cc       = x86_gnu_tool "gcc"
94x86_objcopy  = x86_gnu_tool "objcopy"
95x86_objdump  = x86_gnu_tool "objdump"
96x86_ar       = x86_gnu_tool "ar"
97x86_ranlib   = x86_gnu_tool "ranlib"
98x86_cxx      = x86_gnu_tool "g++"
99
100-- Xeon Phi toolchain
101k1om_gnu_tool = findTool (toolPath k1om_tools) (toolPrefix k1om_tools)
102k1om_cc      = k1om_gnu_tool "gcc"
103k1om_objcopy = k1om_gnu_tool "objcopy"
104k1om_objdump = k1om_gnu_tool "objdump"
105k1om_ar      = k1om_gnu_tool "ar"
106k1om_ranlib  = k1om_gnu_tool "ranlib"
107k1om_cxx     = k1om_gnu_tool "g++"
108
109-- Miscellaneous tools
110gem5         = "gem5.fast"
111runghc       = "runghc"    -- run GHC interactively
112circo        = "circo"     -- from graphviz
113dot          = "dot"       --   "    "
114inkscape     = "inkscape"
115
116-- path to source and install directories; these are automatically set by
117-- hake.sh at setup time
118source_dir :: String
119-- source_dir = undefined -- (set by hake.sh, see end of file)
120
121install_dir :: String
122-- install_dir = undefined -- (set by hake.sh, see end of file)
123
124cache_dir :: String
125-- cache_dir = undefined -- (set by hake.sh, see end of file)
126
127-- Set of architectures for which to generate rules
128architectures :: [String]
129-- architectures = undefined -- (set by hake.sh, see end of file)
130
131-- Optimisation flags (-Ox -g etc.) passed to compiler
132cOptFlags :: [String]
133cOptFlags = ["-g", "-O2"]
134
135newlib_malloc :: String
136--newlib_malloc = "sbrk"     -- use sbrk and newlib's malloc()
137--newlib_malloc = "dlmalloc" -- use dlmalloc
138newlib_malloc = "oldmalloc"
139
140-- Configure pagesize for libbarrelfish's morecore implementation
141-- x86_64 accepts "small", "large", and "huge" for 4kB, 2MB and 1GB pages
142-- respectively. x86_32 accepts "small" and "large" for 4kB and 2MB/4MB pages
143-- respectively. All other architectures default to their default page size.
144morecore_pagesize :: String
145morecore_pagesize = "small"
146
147-- Use a frame pointer
148use_fp :: Bool
149use_fp = True
150
151-- Default timeslice duration in milliseconds
152timeslice :: Integer
153timeslice = 80
154
155-- Put kernel into microbenchmarks mode
156microbenchmarks :: Bool
157microbenchmarks = False
158
159-- Enable tracing
160trace :: Bool
161trace = False
162
163-- Enable QEMU networking. (ie. make network work in small memory)
164support_qemu_networking :: Bool
165support_qemu_networking  = False
166
167-- enable network tracing
168trace_network_subsystem :: Bool
169trace_network_subsystem = False
170
171-- May want to disable LRPC to improve trace visuals
172trace_disable_lrpc :: Bool
173trace_disable_lrpc = False
174
175-- use Kaluga
176use_kaluga_dvm :: Bool
177use_kaluga_dvm = True
178
179-- Domain and driver debugging
180global_debug :: Bool
181global_debug = False
182
183e1000n_debug :: Bool
184e1000n_debug = False
185
186eMAC_debug :: Bool
187eMAC_debug = False
188
189rtl8029_debug :: Bool
190rtl8029_debug = False
191
192ahcid_debug :: Bool
193ahcid_debug = False
194
195libahci_debug :: Bool
196libahci_debug = False
197
198vfs_debug :: Bool
199vfs_debug = False
200
201ethersrv_debug :: Bool
202ethersrv_debug = False
203
204netd_debug :: Bool
205netd_debug = False
206
207libacpi_debug :: Bool
208libacpi_debug = False
209
210acpi_interface_debug :: Bool
211acpi_interface_debug = False
212
213acpi_service_debug :: Bool
214acpi_service_debug = False
215
216acpi_server_debug :: Bool
217acpi_server_debug = False
218
219lpc_timer_debug :: Bool
220lpc_timer_debug = False
221
222lwip_debug :: Bool
223lwip_debug = False
224
225libpci_debug :: Bool
226libpci_debug = False
227
228usrpci_debug :: Bool
229usrpci_debug = False
230
231timer_debug :: Bool
232timer_debug = False
233
234eclipse_kernel_debug :: Bool
235eclipse_kernel_debug = False
236
237skb_debug :: Bool
238skb_debug = False
239
240skb_client_debug :: Bool
241skb_client_debug = False
242
243flounder_debug :: Bool
244flounder_debug = False
245
246flounder_failed_debug :: Bool
247flounder_failed_debug = False
248
249webserver_debug :: Bool
250webserver_debug = False
251
252sqlclient_debug :: Bool
253sqlclient_debug = False
254
255sqlite_debug :: Bool
256sqlite_debug = False
257
258sqlite_backend_debug :: Bool
259sqlite_backend_debug = False
260
261nfs_debug :: Bool
262nfs_debug = False
263
264rpc_debug :: Bool
265rpc_debug = False
266
267loopback_debug :: Bool
268loopback_debug = False
269
270octopus_debug :: Bool
271octopus_debug = False
272
273term_debug :: Bool
274term_debug = False
275
276serial_debug :: Bool
277serial_debug = False
278
279-- Deadlock debugging
280debug_deadlocks :: Bool
281debug_deadlocks = False
282
283-- Partitioned memory server
284memserv_percore :: Bool
285memserv_percore = False
286
287-- Lazy THC implementation (requires use_fp = True)
288lazy_thc :: Bool
289lazy_thc
290    | elem "armv7" architectures   = False
291    | elem "armv8" architectures   = False
292    | otherwise                    = True
293
294-- Enable capability tracing debug facility
295caps_trace :: Bool
296caps_trace = False
297
298-- Mapping Database configuration options (this affects lib/mdb/)
299-- enable extensive tracing of mapping db implementation
300mdb_trace :: Bool
301mdb_trace = False
302
303-- enable tracing of top level mdb_insert, mdb_remove calls
304mdb_trace_no_recursive :: Bool
305mdb_trace_no_recursive = False
306
307-- fail on invariant violations
308mdb_fail_invariants :: Bool
309mdb_fail_invariants = True
310
311-- check invariants before/after mdb_insert/mdb_remove.
312mdb_check_invariants :: Bool
313mdb_check_invariants = False
314
315-- recheck invariants at each tracing point
316mdb_recheck_invariants :: Bool
317mdb_recheck_invariants = False
318
319-- enable extensive tracing of mapping db implementation (userspace version)
320mdb_trace_user :: Bool
321mdb_trace_user = False
322
323-- fail on invariant violations
324mdb_fail_invariants_user :: Bool
325mdb_fail_invariants_user = True
326
327-- recheck invariants at each tracing point
328mdb_recheck_invariants_user :: Bool
329mdb_recheck_invariants_user = True
330
331-- check invariants before/after mdb_insert/mdb_remove.
332mdb_check_invariants_user :: Bool
333mdb_check_invariants_user = True
334
335-- Select scheduler
336data Scheduler = RBED | RR deriving (Show,Eq)
337scheduler :: Scheduler
338scheduler = RBED
339
340-- Physical Address Extensions (PAE)-enabled paging on x86-32
341pae_paging :: Bool
342pae_paging = False
343
344-- Page Size Extensions (PSE)-enabled paging on x86-32
345-- Always enabled when pae_paging == True, regardless of value
346pse_paging :: Bool
347pse_paging = False
348
349-- No Execute Extensions (NXE)-enabled paging on x86-32
350-- May not be True when pae_paging == False
351nxe_paging :: Bool
352nxe_paging = False
353
354oneshot_timer :: Bool
355oneshot_timer = False
356
357-- Enable hardware VM support for AMD's Secure Virtual Machine (SVM)
358-- If disabled, Intel's VMX hardware is supported instead
359config_svm :: Bool
360config_svm = True
361
362-- Enable the use of only Arrakis domains (with arrakismon)
363-- If disabled, use normal VM-guests (with vmkitmon)
364config_arrakismon :: Bool
365config_arrakismon = False
366
367defines :: [RuleToken]
368defines = [ Str ("-D" ++ d) | d <- [
369             if microbenchmarks then "CONFIG_MICROBENCHMARKS" else "",
370             if trace then "CONFIG_TRACE" else "",
371             if support_qemu_networking then "CONFIG_QEMU_NETWORK" else "",
372             if trace_network_subsystem then "NETWORK_STACK_TRACE" else "",
373             if trace_disable_lrpc then "TRACE_DISABLE_LRPC" else "",
374             if global_debug then "GLOBAL_DEBUG" else "",
375             if e1000n_debug then "E1000N_SERVICE_DEBUG" else "",
376             if ahcid_debug then "AHCI_SERVICE_DEBUG" else "",
377             if libahci_debug then "AHCI_LIB_DEBUG" else "",
378             if vfs_debug then "VFS_DEBUG" else "",
379             if eMAC_debug then "EMAC_SERVICE_DEBUG" else "",
380             if rtl8029_debug then "RTL8029_SERVICE_DEBUG" else "",
381             if ethersrv_debug then "ETHERSRV_SERVICE_DEBUG" else "",
382             if netd_debug then "NETD_SERVICE_DEBUG" else "",
383             if libacpi_debug then "ACPI_DEBUG_OUTPUT" else "",
384             if acpi_interface_debug then "ACPI_BF_DEBUG" else "",
385             if acpi_service_debug then "ACPI_SERVICE_DEBUG" else "",
386             if lpc_timer_debug then "LPC_TIMER_DEBUG" else "",
387             if lwip_debug then "LWIP_BARRELFISH_DEBUG" else "",
388             if libpci_debug then "PCI_LIB_DEBUG" else "",
389             if usrpci_debug then "PCI_SERVICE_DEBUG" else "",
390             if timer_debug then "TIMER_CLIENT_DEBUG" else "",
391             if eclipse_kernel_debug then "ECLIPSE_KERNEL_DEBUG" else "",
392             if skb_debug then "SKB_SERVICE_DEBUG" else "",
393             if skb_client_debug then "SKB_CLIENT_DEBUG" else "",
394             if flounder_debug then "FLOUNDER_DEBUG" else "",
395             if flounder_failed_debug then "FLOUNDER_FAILED_DEBUG" else "",
396             if webserver_debug then "WEBSERVER_DEBUG" else "",
397             if sqlclient_debug then "SQL_CLIENT_DEBUG" else "",
398             if sqlite_debug then "SQL_SERVICE_DEBUG" else "",
399             if sqlite_backend_debug then "SQL_BACKEND_DEBUG" else "",
400             if nfs_debug then "NFS_CLIENT_DEBUG" else "",
401             if rpc_debug then "RPC_DEBUG" else "",
402             if loopback_debug then "LOOPBACK_DEBUG" else "",
403             if octopus_debug then "DIST_SERVICE_DEBUG" else "",
404             if term_debug then "TERMINAL_LIBRARY_DEBUG" else "",
405             if serial_debug then "SERIAL_DRIVER_DEBUG" else "",
406             if debug_deadlocks then "CONFIG_DEBUG_DEADLOCKS" else "",
407             if memserv_percore then "CONFIG_MEMSERV_PERCORE" else "",
408             if lazy_thc then "CONFIG_LAZY_THC" else "",
409             if pae_paging then "CONFIG_PAE" else "",
410             if pse_paging then "CONFIG_PSE" else "",
411             if nxe_paging then "CONFIG_NXE" else "",
412             if oneshot_timer then "CONFIG_ONESHOT_TIMER" else "",
413             if config_svm then "CONFIG_SVM" else "",
414             if config_arrakismon then "CONFIG_ARRAKISMON" else "",
415             if use_kaluga_dvm then "USE_KALUGA_DVM" else "",
416             if caps_trace then "TRACE_PMEM_CAPS" else ""
417             ], d /= "" ]
418
419
420-- some defines depend on the architecture/compile options
421arch_defines :: Options -> [RuleToken]
422arch_defines opts
423    -- enable config flags for interconnect drivers in use for this arch
424    = [ Str ("-D" ++ d)
425       | d <- ["CONFIG_INTERCONNECT_DRIVER_" ++ (map toUpper n)
426               | n <- optInterconnectDrivers opts]
427      ]
428    -- enable config flags for flounder backends in use for this arch
429    ++ [ Str ("-D" ++ d)
430       | d <- ["CONFIG_FLOUNDER_BACKEND_" ++ (map toUpper n)
431               | n <- optFlounderBackends opts]
432      ]
433