warning police

parent a7f409e8
-- | Types for the general graph colorer.
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
module GraphBase (
Triv,
......@@ -52,6 +46,7 @@ data Graph k cls color
graphMap :: UniqFM (Node k cls color) }
-- | An empty graph.
initGraph :: Graph k cls color
initGraph
= Graph
{ graphMap = emptyUFM }
......
......@@ -3,13 +3,7 @@
-- This is a generic graph coloring library, abstracted over the type of
-- the node keys, nodes and colors.
--
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
{-# OPTIONS -fno-warn-missing-signatures #-}
module GraphColor (
module GraphBase,
......@@ -121,7 +115,7 @@ assignColors
assignColors colors graph ks
= assignColors' colors graph [] ks
where assignColors' colors graph prob []
where assignColors' _ graph prob []
= (graph, prob)
assignColors' colors graph prob (k:ks)
......@@ -189,12 +183,12 @@ selectColor colors graph u
-- we got one of our preferences, score!
| not $ isEmptyUniqSet colors_ok_pref
, c : rest <- uniqSetToList colors_ok_pref
, c : _ <- uniqSetToList colors_ok_pref
= Just c
-- it wasn't a preference, but it was still ok
| not $ isEmptyUniqSet colors_ok
, c : rest <- uniqSetToList colors_ok
, c : _ <- uniqSetToList colors_ok
= Just c
-- leave this node uncolored
......
-- | Basic operations on graphs.
--
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
{-# OPTIONS -fno-warn-missing-signatures #-}
module GraphOps (
addNode, delNode, getNode, lookupNode, modNode,
......@@ -432,7 +425,7 @@ slurpNodeConflictCount
slurpNodeConflictCount graph
= addListToUFM_C
(\(c1, n1) (c2, n2) -> (c1, n1 + n2))
(\(c1, n1) (_, n2) -> (c1, n1 + n2))
emptyUFM
$ map (\node
-> let count = sizeUniqSet $ nodeConflicts node
......@@ -461,7 +454,7 @@ adjustWithDefaultUFM
adjustWithDefaultUFM f def k map
= addToUFM_C
(\old new -> f old)
(\old _ -> f old)
map
k def
......
-- | Pretty printing of graphs.
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
module GraphPpr (
dumpGraph,
dotGraph
......@@ -34,6 +27,10 @@ dumpGraph graph
= text "Graph"
$$ (vcat $ map dumpNode $ eltsUFM $ graphMap graph)
dumpNode
:: (Outputable k, Outputable cls, Outputable color)
=> Node k cls color -> SDoc
dumpNode node
= text "Node " <> ppr (nodeId node)
$$ text "conflicts "
......@@ -76,6 +73,13 @@ dotGraph colorMap triv graph
++ [ text "}"
, space ])
dotNode :: ( Uniquable k
, Outputable k, Outputable cls, Outputable color)
=> (color -> SDoc)
-> Triv k cls color
-> Node k cls color -> SDoc
dotNode colorMap triv node
= let name = ppr $ nodeId node
cls = ppr $ nodeClass node
......@@ -126,6 +130,13 @@ dotNode colorMap triv node
-- conflict if the graphviz graph. Traverse over the graph, but make sure
-- to only print the edges for each node once.
dotNodeEdges
:: ( Uniquable k
, Outputable k, Outputable cls, Outputable color)
=> UniqSet k
-> Node k cls color
-> (UniqSet k, Maybe SDoc)
dotNodeEdges visited node
| elementOfUniqSet (nodeId node) visited
= ( visited
......@@ -148,9 +159,11 @@ dotNodeEdges visited node
in ( addOneToUniqSet visited (nodeId node)
, Just out)
dotEdgeConflict u1 u2
= doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2) <> text ";"
where dotEdgeConflict u1 u2
= doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2)
<> text ";"
dotEdgeCoalesce u1 u2
= doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2) <> space <> text "[ style = dashed ];"
dotEdgeCoalesce u1 u2
= doubleQuotes (ppr u1) <> text " -- " <> doubleQuotes (ppr u2)
<> space <> text "[ style = dashed ];"
......@@ -12,13 +12,7 @@
--
-- Colors in graphviz graphs could be nicer.
--
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
{-# OPTIONS -fno-warn-missing-signatures #-}
module RegAllocColor (
regAlloc,
......@@ -67,7 +61,7 @@ regAlloc
regAlloc dump regsFree slotsFree code
= do
(code_final, debug_codeGraphs, graph_final)
(code_final, debug_codeGraphs, _)
<- regAlloc_spin dump 0 trivColorable regsFree slotsFree [] code
return ( code_final
......@@ -89,7 +83,7 @@ regAlloc_spin dump (spinCount :: Int) triv regsFree slotsFree debug_codeGraphs c
-- build a map of how many instructions each reg lives for.
-- this is lazy, it won't be computed unless we need to spill
let fmLife = plusUFMs_C (\(r1, l1) (r2, l2) -> (r1, l1 + l2))
let fmLife = plusUFMs_C (\(r1, l1) (_, l2) -> (r1, l1 + l2))
$ map lifetimeCount code
-- record startup state
......@@ -270,10 +264,10 @@ graphAddCoalesce
-> Color.Graph Reg RegClass Reg
graphAddCoalesce (r1, r2) graph
| RealReg regno <- r1
| RealReg _ <- r1
= Color.addPreference (regWithClass r2) r1 graph
| RealReg regno <- r2
| RealReg _ <- r2
= Color.addPreference (regWithClass r1) r2 graph
| otherwise
......@@ -306,7 +300,7 @@ patchRegsFromGraph graph code
= pprPanic "patchRegsFromGraph: register mapping failed."
( text "There is no node in the graph for register " <> ppr reg
$$ ppr code
$$ Color.dotGraph (\x -> text "white") trivColorable graph)
$$ Color.dotGraph (\_ -> text "white") trivColorable graph)
in patchEraseLive patchF code
......
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
-----------------------------------------------------------------------------
--
-- The register allocator
......@@ -12,6 +5,7 @@
-- (c) The University of Glasgow 2004
--
-----------------------------------------------------------------------------
{-# OPTIONS -fno-warn-missing-signatures #-}
{-
The algorithm is roughly:
......@@ -111,7 +105,7 @@ import State
#ifndef DEBUG
import Data.Maybe ( fromJust )
#endif
import Data.List ( nub, partition, mapAccumL, foldl')
import Data.List ( nub, partition, foldl')
import Control.Monad ( when )
import Data.Word
import Data.Bits
......@@ -195,7 +189,7 @@ initFreeRegs = foldr releaseReg noFreeRegs allocatableRegs
getFreeRegs :: RegClass -> FreeRegs -> [RegNo] -- lazilly
getFreeRegs cls f = go f 0
where go 0 m = []
where go 0 _ = []
go n m
| n .&. 1 /= 0 && regClass (RealReg m) == cls
= m : (go (n `shiftR` 1) $! (m+1))
......@@ -228,7 +222,7 @@ emptyStackMap :: StackMap
emptyStackMap = StackMap [0..maxSpillSlots] emptyUFM
getStackSlotFor :: StackMap -> Unique -> (StackMap,Int)
getStackSlotFor fs@(StackMap [] reserved) reg
getStackSlotFor (StackMap [] _) _
= panic "RegAllocLinear.getStackSlotFor: out of stack slots"
getStackSlotFor fs@(StackMap (freeSlot:stack') reserved) reg =
case lookupUFM reserved reg of
......@@ -243,25 +237,25 @@ regAlloc
:: LiveCmmTop
-> UniqSM (NatCmmTop, Maybe RegAllocStats)
regAlloc cmm@(CmmData sec d)
regAlloc (CmmData sec d)
= return
( CmmData sec d
, Nothing )
regAlloc cmm@(CmmProc (LiveInfo info _ _) lbl params [])
regAlloc (CmmProc (LiveInfo info _ _) lbl params [])
= return
( CmmProc info lbl params []
, Nothing )
regAlloc cmm@(CmmProc static lbl params comps)
regAlloc (CmmProc static lbl params comps)
| LiveInfo info (Just first_id) block_live <- static
= do
-- do register allocation on each component.
(final_blocks, stats)
<- linearRegAlloc block_live
$ map (\b -> case b of
BasicBlock i [b] -> AcyclicSCC b
BasicBlock i bs -> CyclicSCC bs)
BasicBlock _ [b] -> AcyclicSCC b
BasicBlock _ bs -> CyclicSCC bs)
$ comps
-- make sure the block that was first in the input list
......@@ -272,6 +266,9 @@ regAlloc cmm@(CmmProc static lbl params comps)
return ( CmmProc info lbl params (first' : rest')
, Just stats)
-- bogus. to make non-exhaustive match warning go away.
regAlloc (CmmProc _ _ _ _)
= panic "RegAllocLinear.regAlloc: no match"
-- -----------------------------------------------------------------------------
......@@ -310,13 +307,13 @@ linearRegAlloc
linearRegAlloc block_live sccs
= do us <- getUs
let (block_assig', stackMap', stats, blocks) =
let (_, _, stats, blocks) =
runR emptyBlockMap initFreeRegs emptyRegMap emptyStackMap us
$ linearRA_SCCs block_live [] sccs
return (blocks, stats)
linearRA_SCCs block_live blocksAcc []
linearRA_SCCs _ blocksAcc []
= return $ reverse blocksAcc
linearRA_SCCs block_live blocksAcc (AcyclicSCC block : sccs)
......@@ -370,7 +367,7 @@ linearRA
-> [Instr] -> [NatBasicBlock] -> [LiveInstr]
-> RegM ([Instr], [NatBasicBlock])
linearRA block_live instr_acc fixups []
linearRA _ instr_acc fixups []
= return (reverse instr_acc, fixups)
linearRA block_live instr_acc fixups (instr:instrs)
......@@ -390,10 +387,10 @@ raInsn :: BlockMap RegSet -- Live temporaries at each basic block
[NatBasicBlock] -- extra fixup blocks
)
raInsn block_live new_instrs (Instr instr@(COMMENT _) Nothing)
raInsn _ new_instrs (Instr (COMMENT _) Nothing)
= return (new_instrs, [])
raInsn block_live new_instrs (Instr instr@(DELTA n) Nothing)
raInsn _ new_instrs (Instr (DELTA n) Nothing)
= do
setDeltaR n
return (new_instrs, [])
......@@ -432,12 +429,12 @@ raInsn block_live new_instrs (Instr instr (Just live))
-}
return (new_instrs, [])
other -> genRaInsn block_live new_instrs instr
_ -> genRaInsn block_live new_instrs instr
(uniqSetToList $ liveDieRead live)
(uniqSetToList $ liveDieWrite live)
raInsn block_live new_instrs li
raInsn _ _ li
= pprPanic "raInsn" (text "no match for:" <> ppr li)
......@@ -527,7 +524,7 @@ releaseRegs regs = do
free <- getFreeRegsR
loop assig free regs
where
loop assig free _ | free `seq` False = undefined
loop _ free _ | free `seq` False = undefined
loop assig free [] = do setAssigR assig; setFreeRegsR free; return ()
loop assig free (RealReg r : rs) = loop assig (releaseReg r free) rs
loop assig free (r:rs) =
......@@ -597,7 +594,7 @@ clobberRegs clobbered = do
clobber assig ((temp, InBoth reg slot) : rest)
| reg `elem` clobbered
= clobber (addToUFM assig temp (InMem slot)) rest
clobber assig (entry:rest)
clobber assig (_:rest)
= clobber assig rest
-- -----------------------------------------------------------------------------
......@@ -618,7 +615,7 @@ allocateRegsAndSpill
-> [Reg] -- temps to allocate
-> RegM ([Instr], [RegNo])
allocateRegsAndSpill reading keep spills alloc []
allocateRegsAndSpill _ _ spills alloc []
= return (spills,reverse alloc)
allocateRegsAndSpill reading keep spills alloc (r:rs) = do
......@@ -633,7 +630,7 @@ allocateRegsAndSpill reading keep spills alloc (r:rs) = do
-- InReg, because the memory value is no longer valid.
-- NB2. This is why we must process written registers here, even if they
-- are also read by the same instruction.
Just (InBoth my_reg mem) -> do
Just (InBoth my_reg _) -> do
when (not reading) (setAssigR (addToUFM assig r (InReg my_reg)))
allocateRegsAndSpill reading keep spills (my_reg:alloc) rs
......@@ -734,7 +731,7 @@ loadTemp _ _ _ _ spills =
myHead s [] = panic s
myHead s (x:xs) = x
myHead _ (x:_) = x
-- -----------------------------------------------------------------------------
-- Joining a jump instruction to its targets
......@@ -753,7 +750,7 @@ joinToTargets
-> [BlockId]
-> RegM ([NatBasicBlock], Instr)
joinToTargets block_live new_blocks instr []
joinToTargets _ new_blocks instr []
= return (new_blocks, instr)
joinToTargets block_live new_blocks instr (dest:dests) = do
......@@ -787,7 +784,7 @@ joinToTargets block_live new_blocks instr (dest:dests) = do
(freeregs',adjusted_assig))
joinToTargets block_live new_blocks instr dests
Just (freeregs,dest_assig)
Just (_, dest_assig)
-- the assignments match
| ufmToList dest_assig == ufmToList adjusted_assig
......@@ -852,13 +849,13 @@ expandNode vreg loc@(InMem src) (InBoth dst mem)
| src == mem = [(vreg, loc, [InReg dst])]
| otherwise = [(vreg, loc, [InReg dst, InMem mem])]
expandNode vreg loc@(InBoth _ src) (InMem dst)
expandNode _ (InBoth _ src) (InMem dst)
| src == dst = [] -- guaranteed to be true
expandNode vreg loc@(InBoth src _) (InReg dst)
expandNode _ (InBoth src _) (InReg dst)
| src == dst = []
expandNode vreg loc@(InBoth src _) dst
expandNode vreg (InBoth src _) dst
= expandNode vreg (InReg src) dst
expandNode vreg src dst
......@@ -870,7 +867,7 @@ expandNode vreg src dst
-- can join together allocations for different basic blocks.
--
makeMove :: Int -> Unique -> Loc -> Loc -> RegM Instr
makeMove delta vreg (InReg src) (InReg dst)
makeMove _ vreg (InReg src) (InReg dst)
= do recordSpill (SpillJoinRR vreg)
return $ mkRegRegMoveInstr (RealReg src) (RealReg dst)
......@@ -882,7 +879,7 @@ makeMove delta vreg (InReg src) (InMem dst)
= do recordSpill (SpillJoinRM vreg)
return $ mkSpillInstr (RealReg src) delta dst
makeMove delta vreg src dst
makeMove _ vreg src dst
= panic $ "makeMove " ++ show vreg ++ " (" ++ show src ++ ") ("
++ show dst ++ ")"
++ " (workaround: use -fviaC)"
......@@ -891,7 +888,7 @@ makeMove delta vreg src dst
-- we have eliminated any possibility of single-node cylces
-- in expandNode above.
handleComponent :: Int -> Instr -> SCC (Unique, Loc, [Loc]) -> RegM [Instr]
handleComponent delta instr (AcyclicSCC (vreg,src,dsts))
handleComponent delta _ (AcyclicSCC (vreg,src,dsts))
= mapM (makeMove delta vreg src) dsts
-- we can not have cycles that involve memory
......@@ -899,10 +896,10 @@ handleComponent delta instr (AcyclicSCC (vreg,src,dsts))
-- because memory locations (stack slots) are
-- allocated exclusively for a virtual register and
-- therefore can not require a fixup
handleComponent delta instr (CyclicSCC ((vreg,src@(InReg sreg),dsts):rest))
handleComponent delta instr (CyclicSCC ((vreg, (InReg sreg),dsts):rest))
= do
spill_id <- getUniqueR
(saveInstr,slot) <- spillR (RealReg sreg) spill_id
(_, slot) <- spillR (RealReg sreg) spill_id
remainingFixUps <- mapM (handleComponent delta instr) (stronglyConnCompR rest)
restoreAndFixInstr <- getRestoreMoves dsts slot
return ([instr] ++ concat remainingFixUps ++ restoreAndFixInstr)
......@@ -921,7 +918,7 @@ handleComponent delta instr (CyclicSCC ((vreg,src@(InReg sreg),dsts):rest))
getRestoreMoves _ _ = panic "getRestoreMoves unknown case"
handleComponent delta instr (CyclicSCC _)
handleComponent _ _ (CyclicSCC _)
= panic "Register Allocator: handleComponent cyclic"
......@@ -963,7 +960,7 @@ runR block_assig freeregs assig stack us thing =
case unReg thing (RA_State{ ra_blockassig=block_assig, ra_freeregs=freeregs,
ra_assig=assig, ra_delta=0{-???-}, ra_stack=stack,
ra_us = us, ra_spills = [] }) of
(# state'@RA_State{ ra_blockassig=block_assig, ra_stack=stack', ra_spills=spills' }, returned_thing #)
(# state'@RA_State{ ra_blockassig=block_assig, ra_stack=stack' }, returned_thing #)
-> (block_assig, stack', makeRAStats state', returned_thing)
spillR :: Reg -> Unique -> RegM (Instr, Int)
......@@ -1067,8 +1064,8 @@ countRegRegMovesNat :: NatCmmTop -> Int
countRegRegMovesNat cmm
= execState (mapGenBlockTopM countBlock cmm) 0
where
countBlock b@(BasicBlock i instrs)
= do instrs' <- mapM countInstr instrs
countBlock b@(BasicBlock _ instrs)
= do mapM_ countInstr instrs
return b
countInstr instr
......
-- Carries interesting info for debugging / profiling of the
-- graph coloring register allocator.
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
--
{-# OPTIONS -fno-warn-missing-signatures #-}
module RegAllocStats (
RegAllocStats (..),
......@@ -178,7 +172,7 @@ binLifetimeCount fm
$ eltsUFM fm
in addListToUFM_C
(\(l1, c1) (l2, c2) -> (l1, c1 + c2))
(\(l1, c1) (_, c2) -> (l1, c1 + c2))
emptyUFM
lifes
......@@ -188,7 +182,7 @@ pprStatsConflict
:: [RegAllocStats] -> SDoc
pprStatsConflict stats
= let confMap = foldl' (plusUFM_C (\(c1, n1) (c2, n2) -> (c1, n1 + n2)))
= let confMap = foldl' (plusUFM_C (\(c1, n1) (_, n2) -> (c1, n1 + n2)))
emptyUFM
$ map Color.slurpNodeConflictCount
[ raGraph s | s@RegAllocStatsStart{} <- stats ]
......@@ -239,12 +233,12 @@ countSRM_block (BasicBlock i instrs)
= do instrs' <- mapM countSRM_instr instrs
return $ BasicBlock i instrs'
countSRM_instr li@(Instr instr live)
| SPILL reg slot <- instr
countSRM_instr li@(Instr instr _)
| SPILL _ _ <- instr
= do modify $ \(s, r, m) -> (s + 1, r, m)
return li
| RELOAD slot reg <- instr
| RELOAD _ _ <- instr
= do modify $ \(s, r, m) -> (s, r + 1, m)
return li
......
......@@ -12,13 +12,6 @@
-- This code is here because we can test the architecture specific code against it.
--
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
module RegArchBase (
RegClass(..),
Reg(..),
......@@ -71,7 +64,7 @@ instance Uniquable Reg where
= mkUnique 'S'
$ fromEnum s * 10000 + fromEnum c * 1000 + i
getUnique (RegSub s (RegSub c _))
getUnique (RegSub _ (RegSub _ _))
= error "RegArchBase.getUnique: can't have a sub-reg of a sub-reg."
-- | A subcomponent of another register
......
......@@ -6,13 +6,6 @@
-- See MachRegs.hs for the actual trivColorable function used in GHC.
--
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
module RegArchX86 (
classOfReg,
regsOfClass,
......@@ -30,11 +23,11 @@ import UniqSet
classOfReg :: Reg -> RegClass
classOfReg reg
= case reg of
Reg c i -> c
Reg c _ -> c
RegSub SubL16 r -> ClassG16
RegSub SubL8 r -> ClassG8
RegSub SubL8H r -> ClassG8
RegSub SubL16 _ -> ClassG16
RegSub SubL8 _ -> ClassG8
RegSub SubL8H _ -> ClassG8
-- | Determine all the regs that make up a certain class.
......@@ -96,18 +89,18 @@ regAlias reg
-- 16 bit subregs alias the whole reg
RegSub SubL16 r@(Reg ClassG32 i)
RegSub SubL16 r@(Reg ClassG32 _)
-> regAlias r
-- 8 bit subregs alias the 32 and 16, but not the other 8 bit subreg
RegSub SubL8 r@(Reg ClassG32 i)
RegSub SubL8 r@(Reg ClassG32 _)
-> mkUniqSet $ [ r, RegSub SubL16 r, RegSub SubL8 r ]
RegSub SubL8H r@(Reg ClassG32 i)
RegSub SubL8H r@(Reg ClassG32 _)
-> mkUniqSet $ [ r, RegSub SubL16 r, RegSub SubL8H r ]
-- fp
Reg ClassF64 i
Reg ClassF64 _
-> unitUniqSet reg
_ -> error "regAlias: invalid register"
......
-- | Register coalescing.
--
{-# OPTIONS -w #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
-- for details
module RegCoalesce (
regCoalesce,
slurpJoinMovs
......@@ -71,8 +63,8 @@ slurpJoinMovs live
where
slurpCmm rs CmmData{} = rs
slurpCmm rs (CmmProc _ _ _ blocks) = foldl' slurpComp rs blocks
slurpComp rs (BasicBlock i blocks) = foldl' slurpBlock rs blocks
slurpBlock rs (BasicBlock i instrs) = foldl' slurpLI rs instrs
slurpComp rs (BasicBlock _ blocks) = foldl' slurpBlock rs blocks
slurpBlock rs (BasicBlock _ instrs) = foldl' slurpLI rs instrs
slurpLI rs (Instr _ Nothing) = rs
slurpLI rs (Instr instr (Just live))
......
......@@ -5,13 +5,7 @@
-- (c) The University of Glasgow 2004
--