packages feed

alpha 1.0.7 → 1.0.8

raw patch · 11 files changed

+141/−161 lines, 11 files

Files

alpha.cabal view
@@ -1,5 +1,5 @@ name:           alpha-version:        1.0.7+version:        1.0.8 synopsis:       A compiler for the Alpha language description:    Alpha is a programming language that aims at being very simple and                  low-level, so as to be efficient, while at the same time
src/Alpha.hs view
@@ -10,6 +10,7 @@ import Data.IORef import Data.List import Data.Maybe+import Data.Monoid import Data.Ord import Data.Version import Foreign hiding (unsafePerformIO,unsafeForeignPtrToPtr,void)@@ -39,6 +40,9 @@ import qualified Data.Map as M import qualified Data.Serialize as Ser +-- The mprotect function in System.Posix.Mman doesn't have the right type signature, so we reimport it here+foreign import ccall "mprotect" mprotect :: Ptr () -> CSize -> CInt -> IO CInt+ newtype Str = Str String instance Show Str where show (Str s) = s @@ -64,15 +68,14 @@ languageFile language = languageDir ?settings</>language<.>"l" findSource language = findM doesFileExist [dir</>language<.>"a" | dir <- sourceDirs ?settings] -interactive = withDefaultContext $ do+interactive = withInitialContext $ do   putStrLn $ "Alpha, version "++showVersion version++". Type alpha/help() for help on Alpha invocation. ^D to exit."   str <- getContents-  let sTree = concat $ parseAlpha "/dev/stdin" str-  mapM_ (\e -> compileExpr e >> putStr "> " >> hFlush stdout) (Group []:sTree)+  putStr "> " >> hFlush stdout+  mapM_ (\e -> compileExpr e >> putStr "> " >> hFlush stdout) (parseAlpha "/dev/stdin" str)   putStrLn "\rGoodbye !"-compileProgram (language,entryName) = withDefaultContext $ do+compileProgram (language,entryName) = withInitialContext $ do   importLanguage compileLanguage (const $ return ()) language-  l <- getting language_   entrySym <- viewState language_ $ internSym entryName   _ <- getAddressComp (outputArch ?settings) entrySym   (addrs,ptrs) <- unzip $< sortBy (comparing fst) $< M.elems $< gets compAddresses@@ -92,25 +95,22 @@          B.writeFile langFile (Ser.encode lang)          return lang   return (not skip,l)-    where compileFile src = withDefaultContext $ (>> gets language) $ do+    where compileFile src = withInitialContext $ do             str <- readFile src-            let sTree = concat $ parseAlpha src str-            init <- mapM compileExpr sTree-            languageState $ modify $ \e -> exportLanguage $ e { initializeL = init }+            inits <- mapM compileExpr (parseAlpha src str)+            getting (language_ >>> f_ (purgeLanguage >>> (,inits))) compileExpr expr = do-  symExpr <- languageState $ envCast expr-  trExpr <- doTransform symExpr-  (code,imports) <- languageState $ compile [] Nothing trExpr-  mapM_ (importLanguage compileLanguage (mapM_ execCode)) imports-  execCode code-  return code+  expr <- doTransform =<< viewing language_ (envCast expr)+  code <- viewing language_ $ compile [] Nothing expr+  internCode code >>= \s -> runSym s >> return s -foreign import ccall "mprotect" mprotect :: Ptr () -> CSize -> CInt -> IO CInt+internCode code = viewing language_ $ state createSym >>= \s -> modify (exportSymVal s (Verb code)) >> return s -foreign import ccall "dynamic" mkProc :: FunPtr (Ptr() -> IO ()) -> Ptr() -> IO ()-foreign import ccall "dynamic" mkFunSize :: FunPtr (Ptr() -> IO Int) -> Ptr() -> IO Int-foreign import ccall "dynamic" mkFunInit :: FunPtr (Ptr () -> Ptr() -> IO ()) -> Ptr() -> Ptr () -> IO ()-foreign import ccall "dynamic" mkFunTransform :: FunPtr (Ptr () -> Ptr() -> IO (Ptr ())) -> Ptr() -> Ptr () -> IO (Ptr ())+#define DYNAMIC(name,type) foreign import ccall "dynamic" name :: FunPtr (type) -> type+DYNAMIC(mkProc,Ptr() -> IO ())+DYNAMIC(mkFunSize,Ptr() -> IO Int)+DYNAMIC(mkFunInit,Ptr() -> Ptr() -> IO ())+DYNAMIC(mkFunTransform,Ptr() -> Ptr() -> IO (Ptr()))  funPtrToInteger f = fromIntegral $ ptrToIntPtr $ castFunPtrToPtr f exportAlpha stub ptr = unsafePerformIO $ do@@ -127,7 +127,6 @@   ("->"     ,Left $ Axiom XReturn),   ("do"     ,Left $ Axiom XDo), -  ("lang"   ,Left $ Axiom XLang),   ("verb"   ,Left $ Axiom XVerb),   ("noun"   ,Left $ Axiom XNoun), @@ -142,14 +141,17 @@   ("alpha/name-symbol"   , Right $ exportAlpha callStub1 alpha_nameSym),    ("alpha/set-transform" , Right $ exportAlpha callStub1 alpha_setTransform),    +  ("alpha/import"        , Right $ exportAlpha callStub1 alpha_import),   ("alpha/reload"        , Right $ exportAlpha callStub0 alpha_reload),          ("alpha/allocate"      , Right $ exportAlpha callStub1 alpha_allocate),    ("alpha/free"          , Right $ exportAlpha callStub1 alpha_free),    +  ("alpha/help"          , Right $ exportAlpha callStub0 alpha_printHelp),++  -- debugging functions   ("alpha/list"          , Right $ exportAlpha callStub0 alpha_printList),   ("alpha/lang"          , Right $ exportAlpha callStub0 alpha_printLang),-  ("alpha/help"          , Right $ exportAlpha callStub0 alpha_printHelp),   ("alpha/print-OK"      , Right $ exportAlpha callStub0 alpha_printOK),       ("alpha/print-num"     , Right $ exportAlpha callStub1 alpha_printNum)   ]@@ -180,10 +182,15 @@   putStrLn $ intercalate " " (map fst $ BM.toList syms) ALPHA_EXPORT(printLang,IO()) = getting language_ >>= print +ALPHA_EXPORT(import,ID -> IO()) sym = withSettings $ do+  name <- getting (language_ >>> f_ (lookupSymName sym))+  void $ case name of+    Just name -> importLanguage compileLanguage (mapM_ runSym) name+    Nothing -> error $ "Symbol "++show sym++" has no name." ALPHA_EXPORT(reload,IO()) = withSettings $ do   imports <- getting (language_ >>> f_ (languagesL >>> BM.toList >>> map fst))    put initialContext-  mapM_ (importLanguage compileLanguage (mapM_ execCode)) imports+  mapM_ (importLanguage compileLanguage (mapM_ runSym)) imports  compAddrRef = unsafePerformIO $ newIORef (undefined :: ID -> IO Int) contextRef = unsafePerformIO $ newIORef (error "Undefined context" :: Context)@@ -191,30 +198,26 @@   get = readIORef contextRef   put = writeIORef contextRef +withInitialContext = withState initialContext initialContext = C ?settings lang jitA M.empty (fromIntegral entry) Nothing-  where (lang,jitA) = execState (mapM_ st initialBindings) (C.emptyLanguage,M.empty)+  where (lang,jitA) = execState (mapM_ st initialBindings) (mempty,M.empty)           where st (s,v) = do                   i <- viewState fst_ (internSym s)                   case v of                     Left v -> modifying fst_ (setSymVal i v)                     Right p -> modifying snd_ (M.insert i p) -withDefaultContext = withState initialContext-contextState sta = (runState sta $< readIORef contextRef) >>= \(a,s') -> writeIORef contextRef s' >> return a-languageState = contextState . viewing language_  pageSize = fromIntegral $ unsafePerformIO $ c'sysconf c'_SC_PAGESIZE enableExec p size = do   let p' = alignPtr (p`plusPtr`(1-pageSize)) pageSize   mprotect (castPtr p') (fromIntegral $ size+ p`minusPtr`p') (c'PROT_READ .|. c'PROT_WRITE .|. c'PROT_EXEC)   -evalCode :: (FunPtr (Ptr() -> a) -> Ptr() -> a) -> ByteString -> Code -> (a -> IO b) -> IO b-evalCode wrap stub code f = do-  sym <- languageState $ state createSym >>= \s -> modify (setSymVal s (Verb code)) >> return s+callSym :: (FunPtr (Ptr() -> a) -> Ptr() -> a) -> ByteString -> ID -> (a -> IO b) -> IO b+callSym wrap stub sym f = unsafeUseAsCString stub $ \stub -> do   p <- getAddressJIT sym-  unsafeUseAsCString stub $ \stub -> f $ wrap (castPtrToFunPtr stub) (intPtrToPtr $ fromIntegral p)-  -execCode c = evalCode mkProc execStub c id+  f $ wrap (castPtrToFunPtr stub) (intPtrToPtr $ fromIntegral p)+runSym sym = callSym mkProc execStub sym id  withRef ref val x = readIORef ref >>= \v -> writeIORef ref val >> x >>= \x -> writeIORef ref v >> return x getAddress arch lookup register = withRef compAddrRef getAddr . getAddr@@ -230,11 +233,12 @@           withForeignPtr ptr $ \p -> do             unsafeUseAsCStringLen code $ \(p',n) -> copyBytes p (castPtr p') n             enableExec p size-        Noun size init -> do-          size <- evalCode mkFunSize execStub size id+        Noun sizeCode initCode -> do+          [sizeSym,initSym] <- mapM internCode [sizeCode,initCode]+          size <- callSym mkFunSize execStub sizeSym id           ptr <- mallocForeignPtrBytes size           register sym ptr size-          withForeignPtr ptr $ \p -> evalCode mkFunInit initStub init ($castPtr p)+          withForeignPtr ptr $ \p -> callSym mkFunInit initStub initSym ($castPtr p)         _ -> fail $ "Couldn't find definition of symbol "++fromMaybe (show sym) (lookupSymName sym lang)  getAddressJIT = getAddress arch_host lookup register
src/Compile.hs view
@@ -15,7 +15,7 @@ import PCode import Syntax -compile args ret expr = runStateT st defaultState >§ \(code,cs) -> (code,imports cs)+compile args ret expr = evalStateT st defaultState   where st = do           (_,(start,_)) <- compile' (fmap bindSym ret) expr           c <- simplify start >>= linearize >>= lift . uniquify args ret@@ -111,10 +111,6 @@   lift $ modify $ exportSymVal sym $ Noun codeSz codeInit   compile' dest (Symbol sym) -compileAxiom XLang _ [Symbol s] = do-  getSymName s >>= maybe (return()) (modify . (\n e -> e { imports = n:imports e }))-  nullCode- compileAxiom XID dest [Symbol s] = compileValue dest (SymVal SymID s) compileAxiom XAddr dest [Symbol s] = compileValue dest (SymVal Address s) compileAxiom XSize dest [Symbol s] = compileValue dest (SymVal Size s)@@ -123,8 +119,7 @@  compileExpr args ret expr = do   args <- mapM bindFromSyntax args-  (code,imps) <- lift $ compile args ret expr-  modifying imports_ (imps++)+  code <- lift $ compile args ret expr   return code compileValue dest val = do   c <- singleCode $< case dest of
src/Compile/State.hs view
@@ -2,7 +2,7 @@ module Compile.State(   module My.Data.Graph,   CompileState(..),BranchType(..),EdgeData(..),NodeData(..),CaseInfo(..),-  depGraph_,infoStack_,imports_,+  depGraph_,infoStack_,   newVar,   pushInfo,popInfo,topInfo,withInfo,withTopInfo,   defaultState,@@ -45,16 +45,14 @@  data CompileState = CS {   infoStack :: [CaseInfo],-  imports   :: [String],   depGraph  :: Graph EdgeData NodeData   }                   deriving Show  depGraph_ = View (depGraph,(\g cs -> cs { depGraph = g })) infoStack_ = View (infoStack,(\l cs -> cs { infoStack = l }))-imports_ = View (imports,(\l cs -> cs { imports = l })) -defaultState = CS [] [] G.empty+defaultState = CS [] G.empty singleCode n = ([n],[n]) isBackEdge (_,BranchAlt Backward _) = True isBackEdge _ = False
src/Context/Language.hs view
@@ -2,23 +2,21 @@  module Context.Language where -import My.Prelude-+import Context.Types as C+import Control.Monad.Trans import Data.Maybe-import My.Data.List-import qualified Data.Map as M-import qualified Data.Set as S-import qualified Data.Bimap as BM-+import Data.Monoid+import ID import My.Control.Monad import My.Control.Monad.State-import Control.Monad.Trans-import qualified Data.Traversable as T--import ID+import My.Data.List+import My.Prelude import PCode-import Context.Types as C import Translate+import qualified Data.Bimap as BM+import qualified Data.Map as M+import qualified Data.Set as S+import qualified Data.Traversable as T  showTable name showLine contents = (name++":"):map ("  "++) (concatMap showLine contents) instance Show Language where@@ -29,22 +27,44 @@     showTable "Equivs" (\(i,i') -> [show i++" -> "++show i']) $ M.toList (equivsL e),     showTable "Modules" (\(s,Range r) -> [s++" -> "++show r]) $ BM.toList (languagesL e),     showTable "Values" (\(i,v) -> [show i++" -> "++show v]) $ M.toList (valuesL e),-    ["Exports: "++show (exportsL e)],-    ["Load code: "++show (initializeL e)]]+    ["Exports: "++show (exportsL e)]] -emptyLanguage = Language (toEnum 0) BM.empty M.empty M.empty BM.empty M.empty S.empty []+translateFromTo l' l = \s' -> fromMaybe (tr s') $ M.lookup (tr s') (aliasesL l)+  where tr s' = fromMaybe (s' + mi) $ do+          m <- lookupSymMod s' l'+          Range (r,_) <- BM.lookup m (languagesL l)+          Range (r',_) <- BM.lookup m (languagesL l')+          return $ s'-r'+r+        Range (mi,_) = fromJust $ BM.lookup (nameL l') (languagesL l)+instance Monoid Language where+  mempty = Language "" (toEnum 0) BM.empty M.empty M.empty BM.empty M.empty S.empty+  mappend l l' = flip execState l $ do+    mapM_ (state . internSym) $ BM.keys (symbolsL l')+    modify $ \l ->+      let aliases = [(i'+mi,fromJust $ BM.lookup s' (symbolsL l)) +                    | (s',i') <- BM.toList (symbolsL l')]+          mi = maxIDL l ; nmi = mi + maxIDL l'+      in l { maxIDL = nmi,+             aliasesL = aliasesL l `M.union` M.fromList aliases,+             equivsL = equivsL l `M.union` M.fromList (map swap aliases),+             languagesL = BM.insert (nameL l') (Range (mi,nmi)) (languagesL l) }+    modify $ \l ->+      let newVals = M.mapKeys tr $ M.map (translate tr) $ valuesL l'+          tr = translateFromTo l' l+      in l { valuesL    = M.unionWith (\_ a -> a) (valuesL l) newVals,+             exportsL   = exportsL l S.\\ M.keysSet newVals } -createSym e@(Language { maxIDL = m }) = (m,e { maxIDL = succ m })-setSymVal id v e = e { valuesL = M.insert id v (valuesL e) }-lookupSymName id e = BM.lookupR id (symbolsL e)-lookupSymVal id e = fromMaybe NoValue $ M.lookup id (valuesL e) -lookupSymMod id e = BM.lookupR (singleRange id) (languagesL e) -addExport id e = e { exportsL = S.insert id (exportsL e) }-getImports e = map fst $ BM.toList $ languagesL e-isImport im e = BM.member im (languagesL e)-exportSymVal id v = setSymVal id v . addExport id+createSym l@(Language { maxIDL = m }) = (m,l { maxIDL = succ m })+setSymVal sym v l = l { valuesL = M.insert sym v (valuesL l) }+lookupSymName sym l = BM.lookupR sym (symbolsL l)+lookupSymVal sym l = fromMaybe NoValue $ M.lookup sym (valuesL l) +lookupSymMod sym l = BM.lookupR (singleRange sym) (languagesL l) +addExport sym l = l { exportsL = S.insert sym (exportsL l) }+getImports l = map fst $ BM.toList $ languagesL l+isImport im l = BM.member im (languagesL l)+exportSymVal sym v = setSymVal sym v . addExport sym -internSym s e = runState (st $ BM.lookup s (symbolsL e)) e +internSym s l = runState (st $ BM.lookup s (symbolsL l)) l    where st (Just id) = return id         st _ = do           i <- state createSym @@ -54,63 +74,31 @@ envCast t = T.mapM (state . intern) t   where intern "?" = createSym         intern str = internSym str-              + importLanguage getImport loadImport imp = merge imp   where      merge imp = gets language >>= \l -> ifThenElse (imp`isImport`l) (return False) $ do-      (comp,l') <- getImport False imp-      comps <- mapM merge [imp | (imp,_) <- BM.toList (languagesL l')]-      let recomp = or comps-      l' <- if not comp && recomp then do-        (_,l') <- getImport True imp-        mapM merge [imp | (imp,_) <- BM.toList (languagesL l')]-        return l'-                else return l'-      init <- mergeLanguage imp l'-      loadImport init+      (l',(comp,recomp)) <- tryCompile False imp+      (l',init) <- if not comp && recomp then fst $< tryCompile True imp else return l'+      loadImport =<< mergeLanguage imp (l'{ nameL = imp },init)       return $ comp || recomp-    mergeLanguage imp l' = viewing language_ $ do-      let Language { symbolsL = syms' , languagesL = mods' , maxIDL = mi' } = l'-      mapM_ (state . internSym) $ BM.keys syms'-      Language { maxIDL = mi, symbolsL = syms } <- get-      let aliases = [(i'+mi,fromJust $ BM.lookup s' syms) -                    | (s',i') <- BM.toList syms']-      modify $ \l -> l {-        maxIDL = mi+mi',-        aliasesL = aliasesL l `M.union` M.fromList aliases,-        equivsL = equivsL l `M.union` M.fromList (map swap aliases)-        }-      Language { aliasesL = al , languagesL = mods, initializeL = init } <- get-      let tr s = fromMaybe (tr' s) $ M.lookup (tr' s) al-          tr' s' = fromMaybe (s' + mi) $ do-            m <- lookupSymMod s' l'-            Range (r,_) <- BM.lookup m mods-            Range (r',_) <- BM.lookup m mods'-            return $ s'-r'+r-          newVals = M.mapKeys tr $ M.map (translate tr) $ valuesL l'-      modify $ \l -> l {-        languagesL = BM.insert imp (Range (mi,mi+mi')) mods,-        valuesL    = M.unionWith (\_ a -> a) (valuesL l) newVals,-        exportsL   = exportsL l S.\\ M.keysSet newVals -        }-      return (translate tr init)-          -exportLanguage l = l {-  symbolsL    = BM.filter exportNameP (symbolsL l),-  valuesL     = vals',-  aliasesL    = M.empty,-  equivsL     = M.empty,-  exportsL    = S.empty,-  initializeL = translate trans (initializeL l)+    mergeLanguage imp (l',init) = viewing language_ $ do+      modify (<>l')+      gets $ \l -> translate (translateFromTo l' l) init+    tryCompile force imp = do+      (comp,l') <- getImport force imp+      comps <- mapM merge (getImports $ fst l')+      return (l',(comp,or comps))++set2Map s = M.fromAscList (zip (S.toAscList s) (repeat undefined))+purgeLanguage l = mempty {+  maxIDL = maxIDL l,+  symbolsL = BM.filter exportNameP (symbolsL l),+  languagesL = languagesL l,+  valuesL = vals'   }-  where set2Map s = M.fromAscList (zip (S.toAscList s) (repeat undefined))-        Language { exportsL = ex, equivsL = eqs } = l-        vals' = M.map (translate trans) $ M.intersection (valuesL l) (set2Map ex)-        trans s = fromMaybe s $ M.lookup s eqs-        refs = S.fromList $ concatMap references $ M.elems vals'-        exportNameP _ s = (S.member s ex || S.member s refs)-                          && not (M.member s eqs)-        references (Verb code) = codeRefs code -        references (Noun size init) = codeRefs size ++ codeRefs init-        references _ = []+  where Language { exportsL = ex, equivsL = eqs } = l+        vals' = M.map (translate $ mapTranslate eqs) $ M.intersection (valuesL l) (set2Map ex)+        refs = S.fromList $ concatMap references (M.elems vals')+        exportNameP _ s = (S.member s ex || S.member s refs) && not (M.member s eqs)
src/Context/Types.hs view
@@ -14,8 +14,8 @@  data Axiom = XAlter | XBind            | XReturn | XRestart | XChoose | XDo-           | XLang | XVerb | XNoun-           | XID | XAddr | XSize+           | XAddr | XSize+           | XVerb | XNoun | XID            deriving Show  data Value = Axiom Axiom@@ -25,15 +25,19 @@            | NoValue            deriving Show +references (Verb code) = codeRefs code +references (Noun size init) = codeRefs size ++ codeRefs init+references _ = []+ data Language = Language {+  nameL       :: String,   maxIDL      :: ID,   symbolsL    :: Bimap String ID,   aliasesL    :: Map ID ID,   equivsL     :: Map ID ID,   languagesL  :: Bimap String (Range ID),   valuesL     :: Map ID Context.Types.Value,-  exportsL    :: Set ID,-  initializeL :: [Code]+  exportsL    :: Set ID   } syms_ = View (symbolsL,\s ce -> ce { symbolsL = s }) vals_ = View (valuesL,\v ce -> ce { valuesL = v })
src/My/Data/List.hs view
@@ -1,5 +1,5 @@ {-# LANGUAGE ParallelListComp #-}-module My.Data.List(module Data.List,classesBy,nubOrd,sums,zipRest,wrap) where+module My.Data.List(module Data.List,classesBy,nubOrd,sums,zipRest,wrap,count) where  import Data.List @@ -24,3 +24,4 @@  zipRest l l' = (zip l l',drop (length l) l') +count p = length . filter p
src/Serialize.hs view
@@ -2,14 +2,18 @@  module Serialize where -import GHC.Generics-import Data.Serialize--import My.Control.Monad+import Context as C import Data.Bimap as BM+import Data.Maybe+import Data.Monoid+import Data.Serialize+import GHC.Generics import ID+import My.Control.Monad import PCode-import Context.Types as C+import Translate+import qualified Data.Map as M+import qualified Data.Set as S  deriving instance Generic ValType deriving instance Generic PCode.Value@@ -37,5 +41,5 @@   get = BM.fromList $< get    put = put . BM.toList   -instance Serialize Language+instance Serialize Language
src/Syntax/Parse.hs view
@@ -5,22 +5,17 @@ import My.Control.Monad import Data.Maybe -parseAlpha file s = lazyMany axiom file s+parseAlpha file s = concat $ lazyMany axiom file s  -- Utilities lazyMany p file contents = lm state0-      where-        Right state0 = parse getParserState file contents-+  where Right state0 = parse getParserState file contents         lm state = case parse p' "" "" of           Left err -> error (show err)           Right x -> x-          where-            p' = do-              setParserState state-              choice [-                try (oWhite >> eof >> return []),-                liftM2 (:) (p >>= \p -> optional (oneOf ",;") >> return p) $ lm $< getParserState]+          where p' = setParserState state >>+                     (try (oWhite >> eof >> return [])+                      <|> liftM2 (:) (p >>= \p -> optional (oneOf ",;") >> return p) (lm $< getParserState)) wrParen e@(_:_:_) = mkNode e wrParen e = concat e mkNode = return . Group . concat
src/Translate.hs view
@@ -1,6 +1,8 @@ module Translate where  import My.Control.Monad+import qualified Data.Map as M+import Data.Maybe import Data.Bimap as BM import ID import PCode@@ -8,6 +10,8 @@  class Translatable t where   translate :: (ID -> ID) -> t -> t++mapTranslate m = \s -> fromMaybe s $ M.lookup s m  instance Translatable ID where   translate = ($)
src/formats.c view
@@ -123,16 +123,3 @@     .reloc_table_offset = 0,     .overlay_number = 0 })--/* -Copyright (c) 2012, Coiffier Marc <marc.coiffier@gmail.com>-All rights reserved.--Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:--    Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.-    Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.--    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -*/-