diff --git a/fuzzing/Main.hs b/fuzzing/Main.hs
new file mode 100644
--- /dev/null
+++ b/fuzzing/Main.hs
@@ -0,0 +1,551 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+module Main where
+
+import Control.DeepSeq (($!!), NFData)
+import qualified Control.Exception as X
+import Control.Monad (forM, forM_, unless, void, when)
+import Control.Monad.IO.Class (liftIO)
+import Control.Monad.Par.Class (get, spawn)
+import Control.Monad.Par.IO (runParIO)
+import Data.List (isPrefixOf, partition, stripPrefix)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import Data.Maybe (fromMaybe)
+import Data.Monoid (mconcat, Endo(..))
+import Data.Time
+  (defaultTimeLocale, formatTime, getZonedTime, iso8601DateFormat)
+import Data.Typeable (Typeable)
+import Data.Word (Word64)
+import GHC.Generics (Generic)
+import System.Console.GetOpt
+  (ArgOrder(..), ArgDescr(..), OptDescr(..), getOpt, usageInfo)
+import System.Directory
+  (copyFile, createDirectoryIfMissing, findExecutable, getFileSize,
+   getPermissions, setPermissions, setOwnerExecutable)
+import System.Environment (getArgs, getProgName, lookupEnv)
+import System.Exit (ExitCode(..), exitFailure, exitSuccess)
+import System.FilePath ((</>), (<.>), dropExtension)
+import System.IO.Temp (withTempDirectory)
+import System.Process
+  (callProcess, readProcess, readProcessWithExitCode,
+   spawnProcess, waitForProcess)
+import System.Random (randomIO)
+import Text.Read (readMaybe)
+import Text.XML.Light (Attr(..), Element, ppTopElement, unode, unqual)
+
+-- Option Parsing --------------------------------------------------------------
+
+-- | The @clang@ executable and flags for a particular test
+-- configuration, e.g., @("clang-3.8", "-O -w -g")@
+type Clang = (FilePath, String)
+
+data Options = Options {
+    optNumTests :: Integer
+    -- ^ Number of Tests
+  , optSeeds :: Maybe [Word64]
+    -- ^ Specific seeds to use in fuzzing; overrides 'optNumTests'
+  , optSaveTests :: Maybe FilePath
+    -- ^ Location to save failed tests
+  , optClangs :: [FilePath]
+    -- ^ Clangs to use with the fuzzer
+  , optClangFlags :: [String]
+    -- ^ Sets of argument flags to use with each clang configuration
+  , optJUnitXml :: Maybe FilePath
+    -- ^ Write JUnit test report
+  , optCsmithPath :: Maybe FilePath
+    -- ^ Path to Csmith include files
+  , optCollapse :: Bool
+    -- ^ Whether to collapse failures with the same error message
+  , optReduceDisasm :: Bool
+    -- ^ Whether to try reducing failures at the disasm stage
+  , optReduceAs :: Bool
+    -- ^ Whether to try reducing failures at the assembly stage
+  , optReduceExec :: Bool
+    -- ^ Whether to try reducing failures at the execution stage
+  , optHelp :: Bool
+  } deriving (Show)
+
+defaultOptions :: Options
+defaultOptions  = Options {
+    optNumTests     = 100
+  , optSeeds        = Nothing
+  , optSaveTests    = Nothing
+  , optClangs       = ["clang"]
+  , optClangFlags   = ["-O -g -w"]
+  , optJUnitXml     = Nothing
+  , optCsmithPath   = Nothing
+  , optCollapse     = False
+  , optReduceDisasm = False
+  , optReduceAs     = False
+  , optReduceExec   = False
+  , optHelp         = False
+  }
+
+options :: [OptDescr (Endo Options)]
+options  =
+  [ Option "n" [] (ReqArg setNumTests "NUMBER")
+    "number of tests to run; default is 100"
+  , Option "s" ["seed"] (ReqArg addSeed "SEED")
+    "specific Csmith seed to use; overrides -n"
+  , Option "o" ["output"] (ReqArg setSaveTests "DIRECTORY")
+    "directory to save failed tests"
+  , Option "c" ["clang"] (ReqArg addClang "CLANG")
+    "specify clang executables to use, e.g., `-c clang-3.8 -c clang-3.9'"
+  , Option ""  ["clang-flags"] (ReqArg addClangFlags "ARGS") $
+    "specify a set of flags to use with each clang " ++
+    "e.g., `--clang-flags \"-O\" --clang-flags \"-O -g\"'"
+  , Option ""  ["junit-xml"] (ReqArg setJUnitXml "FILEPATH")
+    "output JUnit-style XML test report"
+  , Option ""  ["csmith-path"] (ReqArg setCsmithPath "DIRECTORY")
+    "path to Csmith include files; default is $CSMITH_PATH environment variable"
+  , Option ""  ["collapse"] (NoArg setCollapse)
+    "collapse failing test cases by error message and remove successes"
+  , Option ""  ["reduce-disasm"] (NoArg setReduceDisasm) $
+    "reduce test cases that fail disassembly with a best-guess Creduce " ++
+    "(requires `--output`)"
+  , Option ""  ["reduce-as"] (NoArg setReduceAs) $
+    "reduce test cases that fail reassembly with a best-guess Creduce " ++
+    "(requires `--output`)"
+  , Option ""  ["reduce-exec"] (NoArg setReduceExec) $
+    "reduce test cases that fail on test program execution with a " ++
+    "best-guess Creduce (requires `--output`)"
+  , Option "h" ["help"] (NoArg setHelp)
+    "display this message"
+  ]
+
+setNumTests :: String -> Endo Options
+setNumTests str = Endo $ \opt ->
+  case readMaybe str of
+    Nothing -> error "expected integer number of tests"
+    Just n -> opt { optNumTests = n }
+
+addSeed :: String -> Endo Options
+addSeed str = Endo $ \opt ->
+  case readMaybe str of
+    Nothing -> error "expected 64-bit integer seed"
+    Just n ->
+      case optSeeds opt of
+        Nothing    -> opt { optSeeds = Just [n] }
+        Just seeds -> opt { optSeeds = Just (n : seeds) }
+
+setSaveTests :: String -> Endo Options
+setSaveTests str = Endo (\opt -> opt { optSaveTests = Just str })
+
+addClang :: String -> Endo Options
+addClang str = Endo $ \opt ->
+  if optClangs opt == optClangs defaultOptions
+  then opt { optClangs = [str] }
+  else opt { optClangs = str : optClangs opt }
+
+addClangFlags :: String -> Endo Options
+addClangFlags str = Endo $ \opt ->
+  if optClangFlags opt == optClangFlags defaultOptions
+  then opt { optClangFlags = [str] }
+  else opt { optClangFlags = str : optClangFlags opt }
+
+setJUnitXml :: String -> Endo Options
+setJUnitXml str = Endo (\opt -> opt { optJUnitXml = Just str })
+
+setCsmithPath :: String -> Endo Options
+setCsmithPath str = Endo (\opt -> opt { optCsmithPath = Just str })
+
+setCollapse :: Endo Options
+setCollapse = Endo (\opt -> opt { optCollapse = True })
+
+setReduceDisasm :: Endo Options
+setReduceDisasm = Endo (\opt -> opt { optReduceDisasm = True })
+
+setReduceAs :: Endo Options
+setReduceAs = Endo (\opt -> opt { optReduceAs = True })
+
+setReduceExec :: Endo Options
+setReduceExec = Endo (\opt -> opt { optReduceExec = True })
+
+setHelp :: Endo Options
+setHelp = Endo (\opt -> opt { optHelp = True })
+
+getOptions :: IO Options
+getOptions =
+  do args <- getArgs
+     case getOpt RequireOrder options args of
+
+       (fs,[],[]) -> do let opts = appEndo (mconcat fs) defaultOptions
+
+                        when (optHelp opts) $ do printUsage []
+                                                 exitSuccess
+
+                        return opts
+
+       (_,_,errs) -> do printUsage errs
+                        exitFailure
+
+printUsage :: [String] -> IO ()
+printUsage errs =
+  do prog <- getProgName
+     let banner = "Usage: " ++ prog ++ " [OPTIONS]"
+     putStrLn (usageInfo (unlines (errs ++ [banner])) options)
+
+main :: IO ()
+main = withTempDirectory "." ".fuzz." $ \tmpDir -> do
+  opts <- getOptions
+  when (optSaveTests opts == Nothing &&
+        or [optReduceDisasm opts, optReduceAs opts, optReduceExec opts]) $
+    printUsage [ "--reduce options require --output to be set" ]
+  -- run the tests within each clang version in parallel. We could
+  -- parallelize the runs across clang versions as well, but it's
+  -- probably not worth the complexity at that level of granularity
+  resultMaps <-
+    forM (optClangs opts) $ \clangExe ->
+    forM (optClangFlags opts) $ \flags -> runParIO $ do
+      let clang = (clangExe, flags)
+      liftIO $ putStrLn $ "[" ++ clangExe ++ " " ++ flags ++ "]"
+      results' <-
+        case optSeeds opts of
+          Nothing ->
+            forM [1..optNumTests opts] $ \_ ->
+              spawn $ liftIO $ do
+              seed <- randomIO
+              runTest tmpDir clang seed opts
+          Just seeds ->
+            forM seeds $ \seed ->
+              spawn $ liftIO $ do
+              runTest tmpDir clang seed opts
+      results <- mapM get results'
+      return (Map.singleton clang results)
+  let allResults' = Map.unions (concat resultMaps)
+      allResults | optCollapse opts = collapseResults allResults'
+                 | otherwise        = allResults'
+  forM_ (Map.toList allResults) $ \((clangExe, flags), results) -> do
+    let (_passes, fails) = partition isPass results
+    when (not (null fails)) $ do
+      putStrLn $ "[" ++ clangExe ++ " " ++ flags ++ "] " ++
+        show (length fails) ++ " failing cases identified:"
+      forM_ fails $ \case
+        TestFail st s _ _ -> putStrLn ("[" ++ show st ++ "] " ++ show s)
+        _ -> error "non-fail cases in fails"
+  case optSaveTests opts of
+    Nothing -> return ()
+    Just root -> do
+      createDirectoryIfMissing False root
+      forM_ (Map.toList allResults) $ \((clangExe, flags), results) ->
+        when (not (null (filter isFail results))) $ do
+          let clangRoot = root </> (clangExe ++ "_" ++ toUnders " " flags)
+          createDirectoryIfMissing False clangRoot
+          forM_ results $ \result ->
+            case result of
+              TestPass _ -> return ()
+              -- errors arise from bugs in clang, not our code
+              TestClangError _ -> return ()
+              -- if the initial Csmith program doesn't terminate, don't bother
+              TestExecTimeout _ -> return ()
+              TestFail st _ TestSrc{..} err -> do
+                copyFile (tmpDir </> srcFile) (clangRoot </> srcFile)
+                writeFile (clangRoot </> srcFile <.> show st <.> "err") err
+                when (or [ st == DisasmStage && optReduceDisasm opts
+                         , st == AsStage     && optReduceAs opts
+                         , st == ExecStage   && optReduceExec opts ]) $
+                  reduce result (clangExe, flags) opts clangRoot
+  case optJUnitXml opts of
+    Nothing -> return ()
+    Just f -> do
+      xml <- mkJUnitXml allResults
+      writeFile f (ppTopElement xml)
+
+reduce :: TestResult -> Clang -> Options -> FilePath -> IO ()
+reduce (TestFail st _ TestSrc{..} err) (clangExe, flags) opts clangRoot = do
+  csmithPath <- getCsmithPath opts
+  -- copy a file for the reduction in place
+  let baseName   = dropExtension srcFile
+      srcReduced = clangRoot </> baseName ++ "-reduced.c"
+      scriptFile = clangRoot </> baseName ++ "-reduce.sh"
+      llvmVersion =
+        case stripPrefix "clang-" clangExe of
+          Nothing -> ""
+          Just ver -> "--llvm-version=" ++ ver
+  copyFile (clangRoot </> srcFile) srcReduced
+  let grepPat DisasmStage =
+        -- look for the first line of the error starting with a
+        -- tab; this should be the top of the llvm-disasm stack
+        -- trace
+        case dropWhile (not . isPrefixOf "\t") (lines err) of
+          -- if we don't have a stack trace, we probably shouldn't
+          -- waste our time
+          [] -> Nothing
+          -- drop the tab for the pattern
+          first:_ -> Just (tail first)
+      grepPat AsStage =
+        -- check the first line of the clang error for "error:"
+        case (lines err) of
+          [] -> Nothing
+          first:_ ->
+            case dropWhile (/= "error:") (words first) of
+              [] -> Nothing
+              msg -> Just (unwords msg)
+      grepPat ExecStage = error "no grep pattern for exec reduction"
+      scriptHeader = [
+          "#!/usr/bin/env bash"
+        , "# Consider this script a best guess template for reducing failing"
+        , "# test cases. Not every bug will manifest in the same way and give"
+        , "# the same error message, so modify the grep condition appropriately"
+        , "# if the shrink is unsatisfactory."
+        , ""
+        , "set -e"
+        , ""
+        ]
+      buildBc = unwords [
+          clangExe, "-I", csmithPath, flags, "-c"
+        , "-emit-llvm", baseName ++ "-reduced.c", "-o", baseName <.> "bc"
+        ]
+      buildLl = unwords [
+          "llvm-disasm", llvmVersion, baseName <.> "bc", ">", baseName <.> "ll"
+        ]
+      script DisasmStage = unlines $ scriptHeader ++ [
+          buildBc
+        , unwords [ "llvm-disasm", llvmVersion, baseName <.> "bc", "2>&1 |"
+                  , "grep", show (fromMaybe "" (grepPat st))
+                  ]
+        ]
+      script AsStage = unlines $ scriptHeader ++ [
+          buildBc
+        , buildLl
+        , unwords [ clangExe, "-I", csmithPath, flags, "-c"
+                  , baseName <.> "ll", "-o", baseName <.> "o", "2>&1 |"
+                  , "fgrep ", show (fromMaybe "" (grepPat st))
+                  ]
+        ]
+      script ExecStage = unlines $ scriptHeader ++ [
+          buildBc
+        , buildLl
+        , unwords [ clangExe, "-I", csmithPath, flags
+                  , baseName <.> "bc", "-o", "golden"
+                  ]
+        , unwords [ clangExe, "-I", csmithPath, flags
+                  , baseName <.> "ll", "-o", "ours"
+                  ]
+        , "GOLDEN=$(timeout 10 ./golden)"
+        , "[ \"$GOLDEN\" != \"$(./ours)\" ]"
+        ]
+  when (grepPat st /= Nothing) $ do
+    -- write out the shell script to drive Creduce and run it
+    writeFile scriptFile (script st)
+    p <- getPermissions scriptFile
+    setPermissions scriptFile (setOwnerExecutable True p)
+    h <- spawnProcess "creduce" [ scriptFile, srcReduced ]
+    void $ waitForProcess h
+
+reduce _ _ _ _ = error "can't reduce non-failing test"
+
+collapseResults :: Map Clang [TestResult] -> Map Clang [TestResult]
+collapseResults = Map.map (collapse Map.empty)
+  where
+    collapse seen [] = Map.elems seen
+    collapse seen (r:results) =
+      case r of
+        TestPass _ -> collapse seen results
+        -- errors arise from bugs in clang, not our code
+        TestClangError _ -> collapse seen results
+        TestExecTimeout _ -> collapse seen results
+        TestFail st _ _ err ->
+          collapse (Map.insertWith f (st, err) r seen) results
+    -- choose the smallest source file
+    f r1@(TestFail _ _ src1 _) r2@(TestFail _ _ src2 _) =
+      case compare (srcSize src1) (srcSize src2) of
+        LT -> r1
+        EQ -> r1 -- arbitrarily
+        GT -> r2
+    f _ _ = error "only test failures should go in this map"
+
+type Seed = Word64
+
+data TestResult
+  = TestPass Seed
+  | TestFail TestStage Seed TestSrc String
+  | TestClangError Seed
+  -- ^ For now, errors are treated the same as passes, since we're not
+  -- concerned with clang bugs
+  | TestExecTimeout Seed
+  -- ^ If the Csmith-generated program fails to terminate quickly
+  deriving (Eq, Show, Generic, NFData, Typeable)
+
+instance X.Exception TestResult
+
+data TestStage
+  = DisasmStage
+  | AsStage
+  | ExecStage
+  deriving (Eq, Ord, Show, Generic, NFData)
+
+data TestSrc = TestSrc { srcFile :: FilePath, srcSize :: Integer }
+  deriving (Eq, Show, Generic, NFData)
+
+isPass :: TestResult -> Bool
+isPass (TestPass _) = True
+isPass _            = False
+
+isFail :: TestResult -> Bool
+isFail = not . isPass
+
+runTest :: FilePath -> Clang -> Seed -> Options -> IO TestResult
+runTest tmpDir (clangExe, flags) seed opts = X.handle return $ do
+  let baseFile = show seed
+      srcFile  = baseFile <.> "c"
+      bcFile   = baseFile <.> "bc"
+      llFile   = baseFile <.> "ll"
+      llvmVersion =
+        case stripPrefix "clang-" clangExe of
+          Nothing -> ""
+          Just ver -> "--llvm-version=" ++ ver
+  csmithPath <- getCsmithPath opts
+  callProcess "csmith" [
+      "-o", tmpDir </> srcFile
+    , "-s", show seed
+    ]
+  srcSize <- getFileSize (tmpDir </> srcFile)
+  h <- spawnProcess clangExe (words flags ++ [
+      "-I" ++ csmithPath
+    , "-c", "-emit-llvm"
+    , tmpDir </> srcFile
+    , "-o", tmpDir </> bcFile
+    ])
+  clangErr <- waitForProcess h
+  unless (clangErr == ExitSuccess) $ X.throw $!! TestClangError seed
+  (ec, out, err) <-
+    readProcessWithExitCode "llvm-disasm" [ llvmVersion, tmpDir </> bcFile ] ""
+  case ec of
+    ExitFailure c -> do
+      putStrLn "[DISASM ERROR]"
+      putStrLn "[OUT]"
+      putStr out
+      putStrLn "[ERR]"
+      putStr err
+      putStrLn ("[ERROR CODE " ++ show c ++ "]")
+      X.throw $!! TestFail DisasmStage seed TestSrc{..} err
+    ExitSuccess -> return ()
+  writeFile (tmpDir </> llFile) out
+  (ec, out, err) <- readProcessWithExitCode clangExe (words flags ++ [
+      "-I" ++ csmithPath
+    , tmpDir </> llFile
+    , "-o", tmpDir </> "ours"
+    ]) ""
+  case ec of
+    ExitFailure c -> do
+      putStrLn "[AS ERROR]"
+      putStrLn "[OUT]"
+      putStr out
+      putStrLn "[ERR]"
+      putStr err
+      putStrLn ("[ERROR CODE " ++ show c ++ "]")
+      X.throw $!! TestFail AsStage seed TestSrc{..} err
+    ExitSuccess -> return ()
+  h <- spawnProcess clangExe (words flags ++ [
+      "-I" ++ csmithPath
+    , tmpDir </> bcFile
+    , "-o", tmpDir </> "golden"
+    ])
+  clangErr <- waitForProcess h
+  unless (clangErr == ExitSuccess) $ X.throw $!! TestClangError seed
+  timeout <- getTimeoutCmd
+  (ec1, out1, err1) <- do
+    readProcessWithExitCode timeout [ "10", (tmpDir </> "golden") ] ""
+  unless (ec1 == ExitFailure 124) $ X.throw $!! TestExecTimeout seed
+  (ec2, out2, err2) <-
+    readProcessWithExitCode timeout [ "10", (tmpDir </> "ours") ] ""
+  when (ec1 /= ec2 || out1 /= out2 || err1 /= err2) $
+    X.throw $!! TestFail ExecStage seed TestSrc{..} err2
+  putStrLn "[PASS]"
+  return (TestPass seed)
+
+getCsmithPath :: Options -> IO FilePath
+getCsmithPath opts =
+  case optCsmithPath opts of
+    Just p -> return p
+    Nothing -> do
+      mp <- lookupEnv "CSMITH_PATH"
+      case mp of
+        Just p -> return p
+        Nothing -> error "--csmith-path not given and CSMITH_PATH not set"
+
+getTimeoutCmd :: IO FilePath
+getTimeoutCmd = do
+  mf <- findExecutable "timeout"
+  case mf of
+    Just timeout -> return timeout
+    Nothing -> do
+      mf <- findExecutable "gtimeout"
+      case mf of
+        Just timeout -> return timeout
+        Nothing -> error "could not find `timeout' or `gtimeout' in PATH"
+
+mkJUnitXml :: Map Clang [TestResult] -> IO Element
+mkJUnitXml allResults = do
+  hostname <- readProcess "hostname" [] ""
+  now <- getZonedTime
+  let nowFmt = formatTime
+                 defaultTimeLocale
+                 (iso8601DateFormat (Just "%H:%M:%S"))
+                 now
+      testsuites = map (testsuite hostname nowFmt) (Map.toList allResults)
+  return $ unode "testsuites" testsuites
+  where
+    fmtClang (clangExe, flags) = toUnders ". " (clangExe ++ "_" ++ flags)
+    testsuite hostname nowFmt (clang, results) =
+      unode "testsuite" ([
+          uattr "name"      "llvm-disasm fuzzer"
+        , uattr "tests"     (show (length results))
+        , uattr "failures"  (show (length (filter isFail results)))
+        , uattr "errors"    "0"
+        , uattr "skipped"   "0"
+        , uattr "timestamp" nowFmt
+        , uattr "time"      "0.0" -- irrelevant due to random input
+        , uattr "id"        ""
+        , uattr "package"   (fmtClang clang)
+        , uattr "hostname"  hostname
+        ]
+        , flip map results $ \res ->
+            case res of
+              TestPass seed ->
+                unode "testcase" [
+                    uattr "name"      (show seed)
+                  , uattr "classname" (fmtClang clang)
+                  , uattr "time"      "0.0"
+                  ]
+              TestClangError seed ->
+                unode "testcase" ([
+                    uattr "name"      (show seed)
+                  , uattr "classname" (fmtClang clang)
+                  , uattr "time"      "0.0"
+                  ]
+                  , "clang error"
+                  )
+              TestExecTimeout seed ->
+                unode "testcase" ([
+                    uattr "name"      (show seed)
+                  , uattr "classname" (fmtClang clang)
+                  , uattr "time"      "0.0"
+                  ]
+                  , "Csmith-generated program did not terminate quickly"
+                  )
+              TestFail st seed _ err ->
+                unode "testcase" ([
+                    uattr "name"      (show seed ++ "_" ++ show st)
+                  , uattr "classname" (fmtClang clang)
+                  , uattr "time"      "0.0"
+                  ]
+                  , unode "failure" ([
+                        uattr "message" ""
+                      , uattr "type"    ""
+                      ]
+                      , err
+                      )
+                  )
+        )
+
+uattr :: String -> String -> Attr
+uattr k v = Attr (unqual k) v
+
+toUnders :: String -> String -> String
+toUnders cs = map (\c -> if c `elem` cs then '_' else c)
diff --git a/llvm-disasm/LLVMDis.hs b/llvm-disasm/LLVMDis.hs
--- a/llvm-disasm/LLVMDis.hs
+++ b/llvm-disasm/LLVMDis.hs
@@ -1,33 +1,79 @@
-
+{-# LANGUAGE ImplicitParams #-}
 import Data.LLVM.BitCode (parseBitCode, formatError)
 import Data.LLVM.CFG (buildCFG, CFG(..), blockId)
 import Text.LLVM.AST (defBody, modDefines)
-import Text.LLVM.PP (ppLLVM, ppModule)
+import Text.LLVM.PP (ppLLVM35, ppLLVM36, ppLLVM37, ppLLVM38, ppModule)
+import Text.PrettyPrint (Style(..), renderStyle, style)
 
 import Control.Monad (when)
 import Data.Graph.Inductive.Graph (nmap, emap)
 import Data.Graph.Inductive.Dot (fglToDotString, showDot)
-import Data.List (partition)
+import Data.Monoid (mconcat, Endo(..))
+import System.Console.GetOpt
+  (ArgOrder(..), ArgDescr(..), OptDescr(..), getOpt, usageInfo)
 import System.Environment (getArgs,getProgName)
-import System.Exit (exitFailure)
+import System.Exit (exitFailure, exitSuccess)
 import System.IO (stderr,hPutStrLn)
 import qualified Data.ByteString as S
 
+data Options = Options {
+    optLLVMVersion :: String
+  , optDoCFG       :: Bool
+  , optHelp        :: Bool
+  } deriving (Show)
+
+defaultOptions :: Options
+defaultOptions  = Options {
+    optLLVMVersion = "3.8"
+  , optDoCFG       = False
+  , optHelp        = False
+  }
+
+options :: [OptDescr (Endo Options)]
+options  =
+  [ Option "" ["llvm-version"] (ReqArg setLLVMVersion "VERSION")
+    "print assembly compatible with this LLVM version (e.g., 3.8)"
+  , Option "" ["cfg"] (NoArg setDoCFG)
+    "output CFG in graphviz format"
+  , Option "h" ["help"] (NoArg setHelp)
+    "display this message"
+  ]
+
+getOptions :: IO (Options, [FilePath])
+getOptions =
+  do args <- getArgs
+     case getOpt RequireOrder options args of
+       (fs,files@(_:_),[]) -> do
+         let opts = appEndo (mconcat fs) defaultOptions
+         when (optHelp opts) $
+           printUsage [] >> exitSuccess
+         return (opts,files)
+       (_,_,errs) -> do printUsage errs
+                        exitFailure
+
+printUsage :: [String] -> IO ()
+printUsage errs =
+  do prog <- getProgName
+     let banner = "Usage: " ++ prog ++ " [OPTIONS]"
+     putStrLn (usageInfo (unlines (errs ++ [banner])) options)
+
+setLLVMVersion :: String -> Endo Options
+setLLVMVersion str = Endo (\opt -> opt { optLLVMVersion = str })
+
+setDoCFG :: Endo Options
+setDoCFG = Endo (\opt -> opt { optDoCFG = True })
+
+setHelp :: Endo Options
+setHelp = Endo (\opt -> opt { optHelp = True })
+
 main :: IO ()
 main  = do
-  args <- getArgs
-  let (doCFG, files) = partition (== "-cfg") args
-  when (null files) (printUsage >> exitFailure)
-  mapM_ (disasm (not $ null doCFG)) files
-
-printUsage :: IO ()
-printUsage  = do
-  name <- getProgName
-  putStrLn ("Usage: " ++ name ++ " [-cfg] { file.bc }+")
+  (opts, files) <- getOptions
+  mapM_ (disasm opts) files
 
-disasm :: Bool -> FilePath -> IO ()
-disasm doCFG file = do
-  putStrLn (replicate 80 '=' ++ "\n")
+disasm :: Options -> [Char] -> IO ()
+disasm opts file = do
+  putStrLn (replicate 80 ';' ++ "\n")
   putStrLn ("; " ++ file)
   e <- parseBitCode =<< S.readFile file
   case e of
@@ -37,8 +83,20 @@
       exitFailure
 
     Right m  -> do
-      print (ppLLVM (ppModule m))
-      when doCFG $ do
+      let s = style { lineLength = maxBound, ribbonsPerLine = 1.0 }
+      case optLLVMVersion opts of
+        -- try the 3.5 style for 3.4
+        "3.4" -> putStrLn (renderStyle s (ppLLVM35 (ppModule m)))
+        "3.5" -> putStrLn (renderStyle s (ppLLVM35 (ppModule m)))
+        "3.6" -> putStrLn (renderStyle s (ppLLVM36 (ppModule m)))
+        "3.7" -> putStrLn (renderStyle s (ppLLVM37 (ppModule m)))
+        "3.8" -> putStrLn (renderStyle s (ppLLVM38 (ppModule m)))
+        -- try the 3.8 style for 3.9
+        "3.9" -> putStrLn (renderStyle s (ppLLVM38 (ppModule m)))
+        -- try the 3.8 style for 4.0
+        "4.0" -> putStrLn (renderStyle s (ppLLVM38 (ppModule m)))
+        v -> printUsage ["unsupported LLVM version: " ++ v] >> exitFailure
+      when (optDoCFG opts) $ do
         let cfgs  = map (buildCFG . defBody) $ modDefines m
             fixup = nmap (show . blockId) . emap (const "")
         mapM_ (putStrLn . showDot . fglToDotString . fixup . cfgGraph) cfgs
diff --git a/llvm-pretty-bc-parser.cabal b/llvm-pretty-bc-parser.cabal
--- a/llvm-pretty-bc-parser.cabal
+++ b/llvm-pretty-bc-parser.cabal
@@ -1,5 +1,5 @@
 Name:                llvm-pretty-bc-parser
-Version:             0.3.0.0
+Version:             0.3.0.1
 License:             BSD3
 License-file:        LICENSE
 Author:              Trevor Elliott <trevor@galois.com>
@@ -15,6 +15,10 @@
 
 Extra-source-files:  disasm-test/tests/*.ll
 
+Flag fuzz
+  Description:         Enable fuzzing harness
+  Default:             False
+
 Source-repository head
   type:                git
   location:            http://github.com/galoisinc/llvm-pretty-bc-parser
@@ -53,7 +57,7 @@
                        fgl        >= 5.5,
                        cereal     >= 0.3.5.2,
                        bytestring >= 0.9.1,
-                       llvm-pretty>= 0.5
+                       llvm-pretty>= 0.6
 
 Executable llvm-disasm
   Main-is:             LLVMDis.hs
@@ -85,3 +89,29 @@
                        filepath,
                        llvm-pretty>= 0.5,
                        llvm-pretty-bc-parser
+
+Executable fuzz-llvm-disasm
+  Main-is:             Main.hs
+  Default-language:    Haskell2010
+  hs-source-dirs:      fuzzing
+  Ghc-options:         -Wall -threaded -O2
+  build-depends:       base >= 4 && < 5,
+                       process,
+                       directory,
+                       bytestring,
+                       filepath,
+                       temporary,
+                       random,
+                       containers,
+                       xml,
+                       time,
+                       deepseq,
+                       abstract-par,
+                       monad-par,
+                       transformers,
+                       llvm-pretty>= 0.5,
+                       llvm-pretty-bc-parser
+  if flag(fuzz)
+      Buildable:       True
+  else
+      Buildable:       False
diff --git a/src/Data/LLVM/BitCode/Bitstream.hs b/src/Data/LLVM/BitCode/Bitstream.hs
--- a/src/Data/LLVM/BitCode/Bitstream.hs
+++ b/src/Data/LLVM/BitCode/Bitstream.hs
@@ -13,6 +13,7 @@
 
   , getBitstream, parseBitstream
   , getBitCodeBitstream, parseBitCodeBitstream, parseBitCodeBitstreamLazy
+  , parseMetadataStringLengths
   ) where
 
 import Data.LLVM.BitCode.BitString as BS
@@ -412,7 +413,7 @@
   | FieldVBR     !BitString
   | FieldArray    [Field]
   | FieldChar6   !Char
-  | FieldBlob    !BitString
+  | FieldBlob    !S.ByteString
     deriving Show
 
 getFields :: DefineAbbrev -> GetBits [Field]
@@ -436,7 +437,11 @@
 
   OpBlob -> do
     len   <- vbrNum 6
-    align32bits
-    bytes <- fixed (len * 8)
-    align32bits
+    bytes <- bytestring len
     return (FieldBlob bytes)
+
+
+-- Metadata String Lengths -----------------------------------------------------
+
+parseMetadataStringLengths :: Int -> S.ByteString -> Either String [Int]
+parseMetadataStringLengths n = C.runGet (runGetBits (replicateM n (vbrNum 6)))
diff --git a/src/Data/LLVM/BitCode/GetBits.hs b/src/Data/LLVM/BitCode/GetBits.hs
--- a/src/Data/LLVM/BitCode/GetBits.hs
+++ b/src/Data/LLVM/BitCode/GetBits.hs
@@ -2,6 +2,7 @@
     GetBits
   , runGetBits
   , fixed, align32bits
+  , bytestring
   , label
   , isolate
   , try
@@ -12,8 +13,9 @@
 
 import Control.Applicative (Applicative(..),Alternative(..),(<$>))
 import Control.Arrow (first)
-import Control.Monad (MonadPlus(..))
+import Control.Monad (MonadPlus(..),when,replicateM_)
 import Data.Bits (shiftR)
+import Data.ByteString (ByteString)
 import Data.Monoid (mempty,mappend)
 import Data.Word (Word32)
 import qualified Data.Serialize as C
@@ -99,7 +101,20 @@
     (rest,off) <- getBitString n'
     return (bs `mappend` rest, off)
 
+-- | Skip a byte of input, which must be zero.
+skipZeroByte :: C.Get ()
+skipZeroByte = do
+  x <- C.getWord8
+  when (x /= 0) $ fail "alignment padding was not zeros"
 
+-- | Get a @ByteString@ of @n@ bytes, and then align to 32 bits.
+getByteString :: Int -> C.Get (ByteString,SubWord)
+getByteString n = do
+  bs <- C.getByteString n
+  replicateM_ ((- n) `mod` 4) skipZeroByte
+  return (bs, Aligned)
+
+
 -- Basic Interface -------------------------------------------------------------
 
 -- | Read zeros up to an alignment of 32-bits.
@@ -114,6 +129,13 @@
 fixed n = GetBits $ \ off -> case off of
   Aligned     -> getBitString n
   SubWord l w -> getBitStringPartial n l w
+
+-- | Read out n bytes as a @ByteString@, aligning to a 32-bit boundary before and after.
+bytestring :: Int -> GetBits ByteString
+bytestring n = GetBits $ \ off -> case off of
+  Aligned     -> getByteString n
+  SubWord _ 0 -> getByteString n
+  SubWord _ _ -> fail "alignment padding was not zeros"
 
 -- | Add a label to the error tag stack.
 label :: String -> GetBits a -> GetBits a
diff --git a/src/Data/LLVM/BitCode/IR/Attrs.hs b/src/Data/LLVM/BitCode/IR/Attrs.hs
--- a/src/Data/LLVM/BitCode/IR/Attrs.hs
+++ b/src/Data/LLVM/BitCode/IR/Attrs.hs
@@ -30,4 +30,8 @@
     13 -> return LinkerPrivate
     14 -> return LinkerPrivateWeak
     15 -> return LinkerPrivateWeakDefAuto
+    16 -> return Weak
+    17 -> return WeakODR
+    18 -> return Linkonce
+    19 -> return LinkonceODR
     _  -> mzero
diff --git a/src/Data/LLVM/BitCode/IR/Constants.hs b/src/Data/LLVM/BitCode/IR/Constants.hs
--- a/src/Data/LLVM/BitCode/IR/Constants.hs
+++ b/src/Data/LLVM/BitCode/IR/Constants.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE CPP #-}
 
 module Data.LLVM.BitCode.IR.Constants where
@@ -30,8 +31,11 @@
 -- Instruction Field Parsing ---------------------------------------------------
 
 -- | Parse a binop from a field, returning its constructor in the AST.
-binop :: Match Field (Maybe Int -> Typed PValue -> PValue -> PInstr)
-binop  = choose <=< numeric
+binopGeneric :: forall a.
+                (ArithOp -> Typed PValue -> PValue -> a)
+             -> (BitOp -> Typed PValue -> PValue -> a)
+             -> Match Field (Maybe Int -> Typed PValue -> PValue -> a)
+binopGeneric aop bop = choose <=< numeric
   where
 
   constant k kf = return $ \_mb x y ->
@@ -62,67 +66,73 @@
           Nothing -> i (k  False)    x y
           Just w  -> i (k (exact w)) x y
 
-  choose :: Match Int (Maybe Int -> Typed PValue -> PValue -> PInstr)
-  choose 0  = wrapFlags Arith Add   FAdd
-  choose 1  = wrapFlags Arith Sub   FSub
-  choose 2  = wrapFlags Arith Mul   FMul
-  choose 3  = exactFlag Arith UDiv  FDiv
-  choose 4  = exactFlag Arith SDiv  FDiv
-  choose 5  = constant (Arith URem) (Arith FRem)
-  choose 6  = constant (Arith SRem) (Arith FRem)
-  choose 7  = wrapFlags Bit Shl  (error "invalid shl on floating point")
-  choose 8  = exactFlag Bit Lshr (error "invalid lshr on floating point")
-  choose 9  = exactFlag Bit Ashr (error "invalid ashr on floating point")
-  choose 10 = constant (Bit And) (error "invalid and on floating point")
-  choose 11 = constant (Bit Or)  (error "invalid or on floating point")
-  choose 12 = constant (Bit Xor) (error "invalid xor on floating point")
+  choose :: Match Int (Maybe Int -> Typed PValue -> PValue -> a)
+  choose 0  = wrapFlags aop Add   FAdd
+  choose 1  = wrapFlags aop Sub   FSub
+  choose 2  = wrapFlags aop Mul   FMul
+  choose 3  = exactFlag aop UDiv  FDiv
+  choose 4  = exactFlag aop SDiv  FDiv
+  choose 5  = constant (aop URem) (aop FRem)
+  choose 6  = constant (aop SRem) (aop FRem)
+  choose 7  = wrapFlags bop Shl  (error "invalid shl on floating point")
+  choose 8  = exactFlag bop Lshr (error "invalid lshr on floating point")
+  choose 9  = exactFlag bop Ashr (error "invalid ashr on floating point")
+  choose 10 = constant (bop And) (error "invalid and on floating point")
+  choose 11 = constant (bop Or)  (error "invalid or on floating point")
+  choose 12 = constant (bop Xor) (error "invalid xor on floating point")
   choose _  = mzero
 
-fcmpOp :: Match Field (Typed PValue -> PValue -> PInstr)
+binop :: Match Field (Maybe Int -> Typed PValue -> PValue -> PInstr)
+binop = binopGeneric Arith Bit
+
+binopCE :: Match Field (Maybe Int -> Typed PValue -> PValue -> PValue)
+binopCE = binopGeneric aop bop
+  where
+  aop op tv v = ValConstExpr (ConstArith op tv v)
+  bop op tv v = ValConstExpr (ConstBit op tv v)
+
+fcmpOp :: Match Field FCmpOp
 fcmpOp  = choose <=< numeric
   where
-  op        = return . FCmp
-  choose :: Match Int (Typed PValue -> PValue -> PInstr)
-  choose 0  = op Ffalse
-  choose 1  = op Foeq
-  choose 2  = op Fogt
-  choose 3  = op Foge
-  choose 4  = op Folt
-  choose 5  = op Fole
-  choose 6  = op Fone
-  choose 7  = op Ford
-  choose 8  = op Funo
-  choose 9  = op Fueq
-  choose 10 = op Fugt
-  choose 11 = op Fuge
-  choose 12 = op Fult
-  choose 13 = op Fule
-  choose 14 = op Fune
-  choose 15 = op Ftrue
+  choose :: Match Int FCmpOp
+  choose 0  = return Ffalse
+  choose 1  = return Foeq
+  choose 2  = return Fogt
+  choose 3  = return Foge
+  choose 4  = return Folt
+  choose 5  = return Fole
+  choose 6  = return Fone
+  choose 7  = return Ford
+  choose 8  = return Funo
+  choose 9  = return Fueq
+  choose 10 = return Fugt
+  choose 11 = return Fuge
+  choose 12 = return Fult
+  choose 13 = return Fule
+  choose 14 = return Fune
+  choose 15 = return Ftrue
   choose _  = mzero
 
-icmpOp :: Match Field (Typed PValue -> PValue -> PInstr)
+icmpOp :: Match Field ICmpOp
 icmpOp  = choose <=< numeric
   where
-  op        = return . ICmp
-  choose :: Match Int (Typed PValue -> PValue -> PInstr)
-  choose 32 = op Ieq
-  choose 33 = op Ine
-  choose 34 = op Iugt
-  choose 35 = op Iuge
-  choose 36 = op Iult
-  choose 37 = op Iule
-  choose 38 = op Isgt
-  choose 39 = op Isge
-  choose 40 = op Islt
-  choose 41 = op Isle
+  choose :: Match Int ICmpOp
+  choose 32 = return Ieq
+  choose 33 = return Ine
+  choose 34 = return Iugt
+  choose 35 = return Iuge
+  choose 36 = return Iult
+  choose 37 = return Iule
+  choose 38 = return Isgt
+  choose 39 = return Isge
+  choose 40 = return Islt
+  choose 41 = return Isle
   choose _  = mzero
 
-castOp :: Match Field (Typed PValue -> Type -> PInstr)
-castOp  = choose <=< numeric
+castOpGeneric :: forall c. (ConvOp -> Maybe c) -> Match Field c
+castOpGeneric op = choose <=< numeric
   where
-  op        = return . Conv
-  choose :: Match Int (Typed PValue -> Type -> PInstr)
+  choose :: Match Int c
   choose 0  = op Trunc
   choose 1  = op ZExt
   choose 2  = op SExt
@@ -137,24 +147,13 @@
   choose 11 = op BitCast
   choose _  = mzero
 
+castOp :: Match Field (Typed PValue -> Type -> PInstr)
+castOp = castOpGeneric (return . Conv)
+
 castOpCE :: Match Field (Typed PValue -> Type -> PValue)
-castOpCE  = choose <=< numeric
+castOpCE = castOpGeneric op
   where
-  op c      = return (\ tv t -> ValConstExpr (ConstConv c tv t))
-  choose :: Match Int (Typed PValue -> Type -> PValue)
-  choose 0  = op Trunc
-  choose 1  = op ZExt
-  choose 2  = op SExt
-  choose 3  = op FpToUi
-  choose 4  = op FpToSi
-  choose 5  = op UiToFp
-  choose 6  = op SiToFp
-  choose 7  = op FpTrunc
-  choose 8  = op FpExt
-  choose 9  = op PtrToInt
-  choose 10 = op IntToPtr
-  choose 11 = op BitCast
-  choose _  = mzero
+  op c = return (\ tv t -> ValConstExpr (ConstConv c tv t))
 
 -- Constants Block -------------------------------------------------------------
 
@@ -204,7 +203,7 @@
   4 -> label "CST_CODE_INTEGER" $ do
     let field = parseField r
     ty <- getTy
-    n  <- field 0 signed
+    n  <- field 0 signedWord64
     let val = fromMaybe (ValInteger (toInteger n)) $ do
                 Integer 0 <- elimPrimType ty
                 return (ValBool (n /= 0))
@@ -268,7 +267,16 @@
 
   -- [opcode,opval,opval]
   10 -> label "CST_CODE_CE_BINOP" $ do
-    notImplemented
+    let field = parseField r
+    ty      <- getTy
+    mkInstr <- field 0 binopCE
+    lopval  <- field 1 numeric
+    ropval  <- field 2 numeric
+    cxt     <- getContext
+    let lv = forwardRef cxt lopval t
+        rv = forwardRef cxt ropval t
+    let mbWord = numeric =<< fieldAt 3 r
+    return (getTy, Typed ty (mkInstr mbWord lv (typedValue rv)) : cs)
 
   -- [opcode, opty, opval]
   11 -> label "CST_CODE_CE_CAST" $ do
@@ -283,9 +291,9 @@
 
   -- [n x operands]
   12 -> label "CST_CODE_CE_GEP" $ do
-    ty   <- getTy
-    args <- parseCeGep t r
-    return (getTy,Typed ty (ValConstExpr (ConstGEP False args)):cs)
+    ty <- getTy
+    v <- parseCeGep False t r
+    return (getTy,Typed ty v:cs)
 
   -- [opval,opval,opval]
   13 -> label "CST_CODE_CE_SELECT" $ do
@@ -309,9 +317,23 @@
   16 -> label "CST_CODE_CE_SHUFFLEVEC" $ do
     notImplemented
 
+  -- [opty, opval, opval, pred]
   17 -> label "CST_CODE_CE_CMP" $ do
-    notImplemented
+    let field = parseField r
+    opty <- getType                  =<< field 0 numeric
+    op0  <- getConstantFwdRef t opty =<< field 1 numeric
+    op1  <- getConstantFwdRef t opty =<< field 2 numeric
 
+    let isFloat = isPrimTypeOf isFloatingPoint
+    cst <- if isFloat opty || isVectorOf isFloat opty
+              then do op <- field 3 fcmpOp
+                      return (ConstFCmp op op0 op1)
+
+              else do op <- field 3 icmpOp
+                      return (ConstICmp op op0 op1)
+
+    return (getTy, Typed (PrimType (Integer 1)) (ValConstExpr cst):cs)
+
   18 -> label "CST_CODE_INLINEASM_OLD" $ do
     let field = parseField r
     ty    <- getTy
@@ -332,9 +354,9 @@
 
   -- [n x operands]
   20 -> label "CST_CODE_CE_INBOUNDS_GEP" $ do
-    ty   <- getTy
-    args <- parseCeGep t r
-    return (getTy,Typed ty (ValConstExpr (ConstGEP True args)):cs)
+    ty <- getTy
+    v <- parseCeGep True t r
+    return (getTy,Typed ty v:cs)
 
   -- [funty,fnval,bb#]
   21 -> label "CST_CODE_BLOCKADDRESS" $ do
@@ -405,26 +427,27 @@
 parseConstantEntry _ _ e =
   fail ("constant block: unexpected: " ++ show e)
 
-parseCeGep :: ValueTable -> Record -> Parse [Typed PValue]
-parseCeGep t r = loop firstIdx
-  where
-
-  -- TODO: we should check the result type if it exists, but for now we
-  -- ignore it.
-  firstIdx = if odd (length (recordFields r)) then 1 else 0
-
-  field = parseField r
-
-  loop n = do
-    ty   <- getType =<< field  n    numeric
-    elt  <-             field (n+1) numeric
-    rest <- loop (n+2) `mplus` return []
-    cxt  <- getContext
-    return (Typed ty (typedValue (forwardRef cxt elt t)) : rest)
+parseCeGep :: Bool -> ValueTable -> Record -> Parse PValue
+parseCeGep isInbounds t r = do
+  let isExplicit = odd (length (recordFields r))
+      firstIdx = if isExplicit then 1 else 0
+      field = parseField r
+      loop n = do
+        ty   <- getType =<< field  n    numeric
+        elt  <-             field (n+1) numeric
+        rest <- loop (n+2) `mplus` return []
+        cxt  <- getContext
+        return (Typed ty (typedValue (forwardRef cxt elt t)) : rest)
+  mPointeeType <-
+    if isExplicit
+    then Just <$> (getType =<< field 0 numeric)
+    else pure Nothing
+  args <- loop firstIdx
+  return $! ValConstExpr (ConstGEP isInbounds mPointeeType args)
 
 parseWideInteger :: Record -> Parse Integer
 parseWideInteger r = do
-  limbs <- parseFields r 0 signed
+  limbs <- parseFields r 0 signedWord64
   return (foldr (\l acc -> acc `shiftL` 64 + (toInteger l)) 0 limbs)
 
 resolveNull :: Type -> Parse PValue
diff --git a/src/Data/LLVM/BitCode/IR/Function.hs b/src/Data/LLVM/BitCode/IR/Function.hs
--- a/src/Data/LLVM/BitCode/IR/Function.hs
+++ b/src/Data/LLVM/BitCode/IR/Function.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ViewPatterns #-}
 
@@ -25,9 +26,7 @@
 import qualified Data.Sequence as Seq
 import qualified Data.Traversable as T
 
-import Debug.Trace
 
-
 -- Function Aliases ------------------------------------------------------------
 
 type AliasList = Seq.Seq PartialAlias
@@ -86,16 +85,18 @@
 -- | A define with a list of statements for a body, instead of a list of basic
 -- bocks.
 data PartialDefine = PartialDefine
-  { partialAttrs   :: FunAttrs
-  , partialSection :: Maybe String
-  , partialRetType :: Type
-  , partialName    :: Symbol
-  , partialArgs    :: [Typed Ident]
-  , partialVarArgs :: Bool
-  , partialBody    :: BlockList
-  , partialBlock   :: StmtList
-  , partialBlockId :: !Int
-  , partialSymtab  :: ValueSymtab
+  { partialAttrs    :: FunAttrs
+  , partialSection  :: Maybe String
+  , partialRetType  :: Type
+  , partialName     :: Symbol
+  , partialArgs     :: [Typed Ident]
+  , partialVarArgs  :: Bool
+  , partialBody     :: BlockList
+  , partialBlock    :: StmtList
+  , partialBlockId  :: !Int
+  , partialSymtab   :: ValueSymtab
+  , partialMetadata :: Map.Map PKindMd PValMd
+  , partialGlobalMd :: [PartialUnnamedMd]
   } deriving (Show)
 
 -- | Generate a partial function definition from a function prototype.
@@ -108,16 +109,18 @@
   symtab <- initialPartialSymtab
 
   return PartialDefine
-    { partialAttrs     = protoAttrs proto
-    , partialSection   = protoSect proto
-    , partialRetType   = rty
-    , partialName      = Symbol (protoName proto)
-    , partialArgs      = zipWith Typed tys names
-    , partialVarArgs   = va
-    , partialBody      = Seq.empty
-    , partialBlock     = Seq.empty
-    , partialBlockId   = 0
-    , partialSymtab    = symtab
+    { partialAttrs    = protoAttrs proto
+    , partialSection  = protoSect proto
+    , partialRetType  = rty
+    , partialName     = Symbol (protoName proto)
+    , partialArgs     = zipWith Typed tys names
+    , partialVarArgs  = va
+    , partialBody     = Seq.empty
+    , partialBlock    = Seq.empty
+    , partialBlockId  = 0
+    , partialSymtab   = symtab
+    , partialMetadata = Map.empty
+    , partialGlobalMd = []
     }
 
 -- | Set the statement list in a partial define.
@@ -175,16 +178,22 @@
   -- generate basic blocks.
   withValueSymtab (partialSymtab pd) $ do
     body <- finalizeBody lkp (partialBody pd)
+    md <- finalizeMetadata (partialMetadata pd)
     return Define
-      { defAttrs   = partialAttrs pd
-      , defRetType = partialRetType pd
-      , defName    = partialName pd
-      , defArgs    = partialArgs pd
-      , defVarArgs = partialVarArgs pd
-      , defBody    = body
-      , defSection = partialSection pd
+      { defAttrs    = partialAttrs pd
+      , defRetType  = partialRetType pd
+      , defName     = partialName pd
+      , defArgs     = partialArgs pd
+      , defVarArgs  = partialVarArgs pd
+      , defBody     = body
+      , defSection  = partialSection pd
+      , defMetadata = md
       }
 
+finalizeMetadata :: PFnMdAttachments -> Parse FnMdAttachments
+finalizeMetadata patt = Map.fromList <$> mapM f (Map.toList patt)
+  where f (k,md) = (,) <$> getKind k <*> finalizePValMd md
+
 -- | Individual label resolution step.
 resolveBlockLabel :: BlockLookup -> Maybe Symbol -> Int -> Parse BlockLabel
 resolveBlockLabel lkp mbSym = case mbSym of
@@ -274,8 +283,11 @@
 -- Function Block Parsing ------------------------------------------------------
 
 -- | Parse the function block.
-parseFunctionBlock :: [Entry] -> Parse PartialDefine
-parseFunctionBlock ents = label "FUNCTION_BLOCK" $ enterFunctionDef $ do
+parseFunctionBlock ::
+  Int {- ^ unnamed globals so far -} ->
+  [Entry] -> Parse PartialDefine
+parseFunctionBlock unnamedGlobals ents =
+  label "FUNCTION_BLOCK" $ enterFunctionDef $ do
 
   -- parse the value symtab block first, so that names are present during the
   -- rest of the parse
@@ -292,22 +304,24 @@
 
     -- generate the initial partial definition
     pd  <- emptyPartialDefine proto
-    rec pd' <- foldM (parseFunctionBlockEntry vt) pd ents
+    rec pd' <- foldM (parseFunctionBlockEntry unnamedGlobals vt) pd ents
         vt  <- getValueTable
 
     -- merge the symbol table with the anonymous symbol table
     return pd' { partialSymtab = partialSymtab pd' `Map.union` symtab }
 
 -- | Parse the members of the function block
-parseFunctionBlockEntry :: ValueTable -> PartialDefine -> Entry
-                        -> Parse PartialDefine
+parseFunctionBlockEntry ::
+  Int {- ^ unnamed globals so far -} ->
+  ValueTable -> PartialDefine -> Entry ->
+  Parse PartialDefine
 
-parseFunctionBlockEntry _ d (constantsBlockId -> Just es) = do
+parseFunctionBlockEntry _ _ d (constantsBlockId -> Just es) = do
   -- CONSTANTS_BLOCK
   parseConstantsBlock es
   return d
 
-parseFunctionBlockEntry t d (fromEntry -> Just r) = case recordCode r of
+parseFunctionBlockEntry _ t d (fromEntry -> Just r) = case recordCode r of
 
   -- [n]
   1 -> label "FUNC_CODE_DECLARE_BLOCKS" (return d)
@@ -717,8 +731,12 @@
 
     let ty = typedType lhs
         parseOp | isPrimTypeOf isFloatingPoint ty ||
-                  isVectorOf (isPrimTypeOf isFloatingPoint) ty = fcmpOp
-                | otherwise                       = icmpOp
+                  isVectorOf (isPrimTypeOf isFloatingPoint) ty =
+                  return . FCmp <=< fcmpOp
+
+                | otherwise =
+                  return . ICmp <=< icmpOp
+
     op <- field (ix+1) parseOp
 
     let boolTy = Integer 1
@@ -730,31 +748,40 @@
   -- unknown
    | otherwise -> fail ("instruction code " ++ show code ++ " is unknown")
 
-parseFunctionBlockEntry _ d (valueSymtabBlockId -> Just _) = do
+parseFunctionBlockEntry _ _ d (valueSymtabBlockId -> Just _) = do
   -- this is parsed before any of the function block
   return d
 
-parseFunctionBlockEntry t d (metadataBlockId -> Just es) = do
-  _ <- parseMetadataBlock t es
-  return d
+parseFunctionBlockEntry globals t d (metadataBlockId -> Just es) = do
+  (_, (globalUnnamedMds, localUnnamedMds), _, _) <- parseMetadataBlock globals t es
+  unless (null localUnnamedMds)
+     (fail "parseFunctionBlockEntry PANIC: unexpected local unnamed metadata")
+  return d { partialGlobalMd = globalUnnamedMds ++ partialGlobalMd d }
 
-parseFunctionBlockEntry t d (metadataAttachmentBlockId -> Just es) = do
-  (_,_,md) <- parseMetadataBlock t es
-  return d { partialBody = addAttachments md (partialBody d) }
+parseFunctionBlockEntry globals t d (metadataAttachmentBlockId -> Just es) = do
+  (_,(globalUnnamedMds, localUnnamedMds),instrAtt,fnAtt)
+     <- parseMetadataBlock globals t es
+  unless (null localUnnamedMds)
+     (fail "parseFunctionBlockEntry PANIC: unexpected local unnamed metadata")
+  unless (null globalUnnamedMds)
+     (fail "parseFunctionBlockEntry PANIC: unexpected global unnamed metadata")
+  return d { partialBody     = addInstrAttachments instrAtt (partialBody d)
+           , partialMetadata = Map.union fnAtt (partialMetadata d)
+           }
 
-parseFunctionBlockEntry _ d (abbrevDef -> Just _) =
+parseFunctionBlockEntry _ _ d (abbrevDef -> Just _) =
   -- ignore any abbreviation definitions
   return d
 
-parseFunctionBlockEntry _ d (uselistBlockId -> Just _) = do
+parseFunctionBlockEntry _ _ d (uselistBlockId -> Just _) = do
   -- ignore the uselist block
   return d
 
-parseFunctionBlockEntry _ _ e = do
+parseFunctionBlockEntry _ _ _ e = do
   fail ("function block: unexpected: " ++ show e)
 
-addAttachments :: MetadataAttachments -> BlockList -> BlockList
-addAttachments atts blocks = go 0 (Map.toList atts) (Seq.viewl blocks)
+addInstrAttachments :: InstrMdAttachments -> BlockList -> BlockList
+addInstrAttachments atts blocks = go 0 (Map.toList atts) (Seq.viewl blocks)
   where
   go _   []  (b Seq.:< bs) = b Seq.<| bs
   go off mds (b Seq.:< bs) =
@@ -838,7 +865,7 @@
 
   getId n
     | relIds    = do
-      i   <- field n signed
+      i   <- field n signedWord64
       pos <- getNextId
       return (pos - fromIntegral i)
     | otherwise =
@@ -999,7 +1026,7 @@
 
       -- read the chunks of the number in.  each chunk represents one 64-bit
       -- limb of a big num.
-      chunks <- parseSlice r lowStart activeWords signed
+      chunks <- parseSlice r lowStart activeWords signedWord64
 
       -- decode limbs in big-endian order
       let low = foldr (\l acc -> acc `shiftL` 64 + toInteger l) 0 chunks
diff --git a/src/Data/LLVM/BitCode/IR/Metadata.hs b/src/Data/LLVM/BitCode/IR/Metadata.hs
--- a/src/Data/LLVM/BitCode/IR/Metadata.hs
+++ b/src/Data/LLVM/BitCode/IR/Metadata.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE RecursiveDo #-}
@@ -7,7 +8,10 @@
   , parseMetadataKindEntry
   , PartialUnnamedMd(..)
   , finalizePartialUnnamedMd
-  , MetadataAttachments
+  , finalizePValMd
+  , InstrMdAttachments
+  , PFnMdAttachments
+  , PKindMd
   ) where
 
 import Data.LLVM.BitCode.Bitstream
@@ -19,23 +23,29 @@
 
 import Control.Exception (throw)
 import Control.Monad (foldM,guard,mplus,unless,when)
+import Data.List (mapAccumL)
 import Data.Maybe (fromMaybe)
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as Char8 (unpack)
 import qualified Data.Map as Map
 import qualified Data.Traversable as T
 
-
 -- Parsing State ---------------------------------------------------------------
 
 data MetadataTable = MetadataTable
   { mtEntries   :: MdTable
   , mtNextNode  :: !Int
   , mtNodes     :: Map.Map Int (Bool,Bool,Int)
+                   -- ^ The entries in the map are: is the entry function local,
+                   -- is the entry distinct, and the implicit id for the node.
   } deriving (Show)
 
-emptyMetadataTable :: MdTable -> MetadataTable
-emptyMetadataTable es = MetadataTable
+emptyMetadataTable ::
+  Int {- ^ globals seen so far -} ->
+  MdTable -> MetadataTable
+emptyMetadataTable globals es = MetadataTable
   { mtEntries   = es
-  , mtNextNode  = 0
+  , mtNextNode  = globals
   , mtNodes     = Map.empty
   }
 
@@ -59,11 +69,23 @@
 addString :: String -> MetadataTable -> MetadataTable
 addString str = snd . addMetadata (ValMdString str)
 
+addStrings :: [String] -> MetadataTable -> MetadataTable
+addStrings strs mt = foldl (flip addString) mt strs
+
 addLoc :: Bool -> PDebugLoc -> MetadataTable -> MetadataTable
 addLoc isDistinct loc mt = nameNode False isDistinct ix mt'
   where
   (ix,mt') = addMetadata (ValMdLoc loc) mt
 
+addDebugInfo
+  :: Bool
+  -> DebugInfo' Int
+  -> MetadataTable
+  -> MetadataTable
+addDebugInfo isDistinct di mt = nameNode False isDistinct ix mt'
+  where
+  (ix,mt') = addMetadata (ValMdDebugInfo di) mt
+
 -- | Add a new node, that might be distinct.
 addNode :: Bool -> [Maybe PValMd] -> MetadataTable -> MetadataTable
 addNode isDistinct vals mt = nameNode False isDistinct ix mt'
@@ -94,6 +116,17 @@
   where
   prj (_,_,x) = x
 
+mdString :: [String] -> MetadataTable -> Int -> String
+mdString cxt mt ix =
+  fromMaybe (throw (BadValueRef cxt ix)) (mdStringOrNull cxt mt ix)
+
+mdStringOrNull :: [String] -> MetadataTable -> Int -> Maybe String
+mdStringOrNull cxt mt ix =
+  case mdForwardRefOrNull cxt mt ix of
+    Nothing -> Nothing
+    Just (ValMdString str) -> Just str
+    Just _ -> throw (BadTypeRef cxt ix)
+
 mkMdRefTable :: MetadataTable -> MdRefTable
 mkMdRefTable mt = Map.mapMaybe step (mtNodes mt)
   where
@@ -102,18 +135,22 @@
     return ix
 
 data PartialMetadata = PartialMetadata
-  { pmEntries       :: MetadataTable
-  , pmNamedEntries  :: Map.Map String [Int]
-  , pmNextName      :: Maybe String
-  , pmAttachments   :: MetadataAttachments
+  { pmEntries          :: MetadataTable
+  , pmNamedEntries     :: Map.Map String [Int]
+  , pmNextName         :: Maybe String
+  , pmInstrAttachments :: InstrMdAttachments
+  , pmFnAttachments    :: PFnMdAttachments
   } deriving (Show)
 
-emptyPartialMetadata :: MdTable -> PartialMetadata
-emptyPartialMetadata es = PartialMetadata
-  { pmEntries       = emptyMetadataTable es
-  , pmNamedEntries  = Map.empty
-  , pmNextName      = Nothing
-  , pmAttachments   = Map.empty
+emptyPartialMetadata ::
+  Int {- ^ globals seen so far -} ->
+  MdTable -> PartialMetadata
+emptyPartialMetadata globals es = PartialMetadata
+  { pmEntries          = emptyMetadataTable globals es
+  , pmNamedEntries     = Map.empty
+  , pmNextName         = Nothing
+  , pmInstrAttachments = Map.empty
+  , pmFnAttachments    = Map.empty
   }
 
 updateMetadataTable :: (MetadataTable -> MetadataTable)
@@ -123,10 +160,16 @@
 setNextName :: String -> PartialMetadata -> PartialMetadata
 setNextName name pm = pm { pmNextName = Just name }
 
-addAttachment :: Int -> [(String,PValMd)] -> PartialMetadata -> PartialMetadata
-addAttachment instr md pm =
-  pm { pmAttachments = Map.insert instr md (pmAttachments pm) }
+addFnAttachment :: PFnMdAttachments -> PartialMetadata -> PartialMetadata
+addFnAttachment att pm =
+  -- left-biased union, since the parser overwrites metadata as it encounters it
+  pm { pmFnAttachments = Map.union att (pmFnAttachments pm) }
 
+addInstrAttachment :: Int -> [(KindMd,PValMd)]
+                   -> PartialMetadata -> PartialMetadata
+addInstrAttachment instr md pm =
+  pm { pmInstrAttachments = Map.insert instr md (pmInstrAttachments pm) }
+
 nameMetadata :: [Int] -> PartialMetadata -> Parse PartialMetadata
 nameMetadata val pm = case pmNextName pm of
   Just name -> return $! pm
@@ -141,22 +184,24 @@
               . pmNamedEntries
 
 data PartialUnnamedMd = PartialUnnamedMd
-  { pumIndex  :: Int
-  , pumValues :: [Maybe PValMd]
+  { pumIndex    :: Int
+  , pumValues   :: PValMd
   , pumDistinct :: Bool
   } deriving (Show)
 
 finalizePartialUnnamedMd :: PartialUnnamedMd -> Parse UnnamedMd
-finalizePartialUnnamedMd pum = mkUnnamedMd `fmap` fixLabels (pumValues pum)
+finalizePartialUnnamedMd pum = mkUnnamedMd `fmap` finalizePValMd (pumValues pum)
   where
-  -- map through the list and typed PValue to change labels to textual ones
-  fixLabels      = T.mapM (T.mapM (relabel (const requireBbEntryName)))
-  mkUnnamedMd vs = UnnamedMd
+  mkUnnamedMd v = UnnamedMd
     { umIndex  = pumIndex pum
-    , umValues = vs
+    , umValues = v
     , umDistinct = pumDistinct pum
     }
 
+finalizePValMd :: PValMd -> Parse ValMd
+finalizePValMd = relabel (const requireBbEntryName)
+
+-- | Partition unnamed entries into global and function local unnamed entries.
 unnamedEntries :: PartialMetadata -> ([PartialUnnamedMd],[PartialUnnamedMd])
 unnamedEntries pm = foldl resolveNode ([],[]) (Map.toList (mtNodes mt))
   where
@@ -166,28 +211,47 @@
   resolveNode (gs,fs) (ref,(fnLocal,d,ix)) = case lookupNode ref d ix of
     Just pum | fnLocal   -> (gs,pum:fs)
              | otherwise -> (pum:gs,fs)
+
+    -- TODO: is this silently eating errors with metadata that's not in the
+    -- value table?
     Nothing              -> (gs,fs)
 
   lookupNode ref d ix = do
-    Typed { typedValue = ValMd (ValMdNode vs) } <- Map.lookup ref es
+    Typed { typedValue = ValMd v } <- Map.lookup ref es
     return PartialUnnamedMd
       { pumIndex  = ix
-      , pumValues = vs
+      , pumValues = v
       , pumDistinct = d
       }
 
-type MetadataAttachments = Map.Map Int [(String,PValMd)]
-type ParsedMetadata = ([NamedMd],([PartialUnnamedMd],[PartialUnnamedMd]),MetadataAttachments)
+type InstrMdAttachments = Map.Map Int [(KindMd,PValMd)]
 
+type PKindMd = Int
+type PFnMdAttachments = Map.Map PKindMd PValMd
+
+type ParsedMetadata =
+  ( [NamedMd]
+  , ([PartialUnnamedMd],[PartialUnnamedMd])
+  , InstrMdAttachments
+  , PFnMdAttachments
+  )
+
 parsedMetadata :: PartialMetadata -> ParsedMetadata
-parsedMetadata pm = (namedEntries pm, unnamedEntries pm, pmAttachments pm)
+parsedMetadata pm =
+  ( namedEntries pm
+  , unnamedEntries pm
+  , pmInstrAttachments pm
+  , pmFnAttachments pm
+  )
 
 -- Metadata Parsing ------------------------------------------------------------
 
-parseMetadataBlock :: ValueTable -> [Entry] -> Parse ParsedMetadata
-parseMetadataBlock vt es = label "METADATA_BLOCK" $ do
+parseMetadataBlock ::
+  Int {- ^ globals seen so far -} ->
+  ValueTable -> [Entry] -> Parse ParsedMetadata
+parseMetadataBlock globals vt es = label "METADATA_BLOCK" $ do
   ms <- getMdTable
-  let pm0 = emptyPartialMetadata ms
+  let pm0 = emptyPartialMetadata globals ms
   rec pm <- foldM (parseMetadataEntry vt (pmEntries pm)) pm0 es
   let entries = pmEntries pm
   setMdTable (mtEntries entries)
@@ -201,7 +265,8 @@
 -- to not have to rely on it.
 parseMetadataEntry :: ValueTable -> MetadataTable -> PartialMetadata -> Entry
                    -> Parse PartialMetadata
-parseMetadataEntry vt mt pm (fromEntry -> Just r) = case recordCode r of
+parseMetadataEntry vt mt pm (fromEntry -> Just r) =
+ case recordCode r of
   -- [values]
   1 -> label "METADATA_STRING" $ do
     str <- parseFields r 0 char `mplus` parseField r 0 string
@@ -242,8 +307,11 @@
     addKind kind name
     return pm
 
-  -- [distinct, line, col, scope, inlined-at?] 
+  -- [distinct, line, col, scope, inlined-at?]
   7 -> label "METADATA_LOCATION" $ do
+    -- TODO: broken in 3.7+; needs to be a DILocation rather than an
+    -- MDLocation, but there appears to be no difference in the
+    -- bitcode. /sigh/
     cxt       <- getContext
     let field = parseField r
     isDistinct <- field 0 nonzero
@@ -270,10 +338,19 @@
 
   -- [m x [value, [n x [id, mdnode]]]
   11 -> label "METADATA_ATTACHMENT" $ do
-    let field = parseField r
-    inst <- field 0 numeric
-    md   <- parseAttachment r
-    return $! addAttachment inst md pm
+    let recordSize = length (recordFields r)
+    when (recordSize == 0)
+      (fail "Invalid record")
+    ctx <- getContext
+    if (recordSize `mod` 2 == 0)
+      then label "function attachment" $ do
+        att <- Map.fromList <$> parseAttachment r 0
+        return $! addFnAttachment att pm
+      else label "instruction attachment" $ do
+        inst <- parseField r 0 numeric
+        patt <- parseAttachment r 1
+        att <- mapM (\(k,md) -> (,md) <$> getKind k) patt
+        return $! addInstrAttachment inst att pm
 
   12 -> label "METADATA_GENERIC_DEBUG" $ do
     isDistinct <- parseField r 0 numeric
@@ -282,65 +359,199 @@
     header <- parseField r 3 string
     -- TODO: parse all remaining fields
     fail "not yet implemented"
+
   13 -> label "METADATA_SUBRANGE" $ do
-    isDistinct <- parseField r 0 numeric
-    parseField r 1 numeric
-    parseField r 2 signed
-    -- TODO
-    fail "not yet implemented"
+    isDistinct <- parseField r 0 nonzero
+    disrCount <- parseField r 1 numeric
+    disrLowerBound <- parseField r 2 signedInt64
+    return $! updateMetadataTable
+      (addDebugInfo isDistinct (DebugInfoSubrange DISubrange{..})) pm
+
+  -- [distinct, value, name]
   14 -> label "METADATA_ENUMERATOR" $ do
-    isDistinct <- parseField r 0 numeric
-    parseField r 1 signed
-    parseField r 2 string
-    -- TODO
-    fail "not yet implemented"
+    ctx        <- getContext
+    isDistinct <- parseField r 0 nonzero
+    value      <- parseField r 1 signedInt64
+    name       <- mdString ctx mt <$> parseField r 2 numeric
+    return $! updateMetadataTable
+      (addDebugInfo isDistinct (DebugInfoEnumerator name value)) pm
+
   15 -> label "METADATA_BASIC_TYPE" $ do
-    isDistinct <- parseField r 0 numeric
-    parseField r 1 numeric
-    name <- parseField r 2 numeric
-    parseField r 3 numeric
-    parseField r 4 numeric
-    parseField r 5 numeric
-    -- TODO
-    fail "not yet implemented"
+    ctx <- getContext
+    isDistinct <- parseField r 0 nonzero
+    dibtTag <- parseField r 1 numeric
+    dibtName <- mdString ctx mt <$> parseField r 2 numeric
+    dibtSize <- parseField r 3 numeric
+    dibtAlign <- parseField r 4 numeric
+    dibtEncoding <- parseField r 5 numeric
+    return $! updateMetadataTable
+      (addDebugInfo isDistinct (DebugInfoBasicType DIBasicType{..})) pm
+
+  -- [distinct, filename, directory]
   16 -> label "METADATA_FILE" $ do
-    isDistinct <- parseField r 0 numeric
-    name <- parseField r 1 numeric
-    dir  <- parseField r 2 numeric
-    -- TODO
-    fail "not yet implemented"
+    ctx <- getContext
+    isDistinct <- parseField r 0 nonzero
+    difFilename <- mdString ctx mt <$> parseField r 1 numeric
+    difDirectory <- mdString ctx mt <$> parseField r 2 numeric
+    return $! updateMetadataTable
+      (addDebugInfo isDistinct (DebugInfoFile DIFile{..})) pm
+
   17 -> label "METADATA_DERIVED_TYPE" $ do
-    -- TODO
-    fail "not yet implemented"
+    ctx <- getContext
+    isDistinct    <- parseField r 0 nonzero
+    didtTag       <- parseField r 1 numeric
+    didtName      <- mdStringOrNull     ctx mt <$> parseField r 2 numeric
+    didtFile      <- mdForwardRefOrNull ctx mt <$> parseField r 3 numeric
+    didtLine      <- parseField r 4 numeric
+    didtScope     <- mdForwardRefOrNull ctx mt <$> parseField r 5 numeric
+    didtBaseType  <- mdForwardRefOrNull ctx mt <$> parseField r 6 numeric
+    didtSize      <- parseField r 7 numeric
+    didtAlign     <- parseField r 8 numeric
+    didtOffset    <- parseField r 9 numeric
+    didtFlags     <- parseField r 10 numeric
+    didtExtraData <- mdForwardRefOrNull ctx mt <$> parseField r 11 numeric
+    return $! updateMetadataTable
+      (addDebugInfo isDistinct (DebugInfoDerivedType DIDerivedType{..})) pm
+
   18 -> label "METADATA_COMPOSITE_TYPE" $ do
-    -- TODO
-    fail "not yet implemented"
+    ctx <- getContext
+    isDistinct         <- parseField r 0 nonzero
+    dictTag            <- parseField r 1 numeric
+    dictName           <- mdStringOrNull     ctx mt <$> parseField r 2 numeric
+    dictFile           <- mdForwardRefOrNull ctx mt <$> parseField r 3 numeric
+    dictLine           <- parseField r 4 numeric
+    dictScope          <- mdForwardRefOrNull ctx mt <$> parseField r 5 numeric
+    dictBaseType       <- mdForwardRefOrNull ctx mt <$> parseField r 6 numeric
+    dictSize           <- parseField r 7 numeric
+    dictAlign          <- parseField r 8 numeric
+    dictOffset         <- parseField r 9 numeric
+    dictFlags          <- parseField r 10 numeric
+    dictElements       <- mdForwardRefOrNull ctx mt <$> parseField r 11 numeric
+    dictRuntimeLang    <- parseField r 12 numeric
+    dictVTableHolder   <- mdForwardRefOrNull ctx mt <$> parseField r 13 numeric
+    dictTemplateParams <- mdForwardRefOrNull ctx mt <$> parseField r 14 numeric
+    dictIdentifier     <- mdStringOrNull     ctx mt <$> parseField r 15 numeric
+    return $! updateMetadataTable
+      (addDebugInfo isDistinct (DebugInfoCompositeType DICompositeType{..})) pm
+
   19 -> label "METADATA_SUBROUTINE_TYPE" $ do
-    -- TODO
-    fail "not yet implemented"
+    ctx <- getContext
+    isDistinct    <- parseField r 0 nonzero
+    distFlags     <- parseField r 1 numeric
+    distTypeArray <- mdForwardRefOrNull ctx mt <$> parseField r 2 numeric
+    return $! updateMetadataTable
+      (addDebugInfo
+         isDistinct
+         (DebugInfoSubroutineType DISubroutineType{..}))
+      pm
+
   20 -> label "METADATA_COMPILE_UNIT" $ do
-    -- TODO
-    fail "not yet implemented"
+    let recordSize = length (recordFields r)
+    when (recordSize < 14 || recordSize > 16)
+      (fail "Invalid record")
+
+    ctx <- getContext
+    isDistinct             <- parseField r 0 nonzero
+    dicuLanguage           <- parseField r 1 numeric
+    dicuFile               <-
+      mdForwardRefOrNull ctx mt <$> parseField r 2 numeric
+    dicuProducer           <- mdStringOrNull ctx mt <$> parseField r 3 numeric
+    dicuIsOptimized        <- parseField r 4 nonzero
+    dicuFlags              <- parseField r 5 numeric
+    dicuRuntimeVersion     <- parseField r 6 numeric
+    dicuSplitDebugFilename <- mdStringOrNull ctx mt <$> parseField r 7 numeric
+    dicuEmissionKind       <- parseField r 8 numeric
+    dicuEnums              <-
+      mdForwardRefOrNull ctx mt <$> parseField r 9 numeric
+    dicuRetainedTypes      <-
+      mdForwardRefOrNull ctx mt <$> parseField r 10 numeric
+    dicuSubprograms        <-
+      mdForwardRefOrNull ctx mt <$> parseField r 11 numeric
+    dicuGlobals            <-
+      mdForwardRefOrNull ctx mt <$> parseField r 12 numeric
+    dicuImports            <-
+      mdForwardRefOrNull ctx mt <$> parseField r 13 numeric
+    dicuMacros <-
+      if recordSize <= 15
+      then pure Nothing
+      else mdForwardRefOrNull ctx mt <$> parseField r 15 numeric
+    dicuDWOId <-
+      if recordSize <= 14
+      then pure 0
+      else parseField r 14 numeric
+    return $! updateMetadataTable
+      (addDebugInfo isDistinct (DebugInfoCompileUnit DICompileUnit {..})) pm
+
+
   21 -> label "METADATA_SUBPROGRAM" $ do
-    -- TODO
-    fail "not yet implemented"
+    -- this one is a bit funky:
+    -- https://github.com/llvm-mirror/llvm/blob/release_38/lib/Bitcode/Reader/BitcodeReader.cpp#L2186
+    let recordSize = length (recordFields r)
+        adj i | recordSize == 19 = i + 1
+              | otherwise        = i
+        hasThisAdjustment = recordSize >= 20
+    unless (18 <= recordSize && recordSize <= 20)
+      (fail "Invalid record")
+
+    ctx <- getContext
+    isDistinct         <- parseField r 0 nonzero
+    dispScope          <- mdForwardRefOrNull ctx mt <$> parseField r 1 numeric
+    dispName           <- mdStringOrNull ctx mt <$> parseField r 2 numeric
+    dispLinkageName    <- mdStringOrNull ctx mt <$> parseField r 3 numeric
+    dispFile           <- mdForwardRefOrNull ctx mt <$> parseField r 4 numeric
+    dispLine           <- parseField r 5 numeric
+    dispType           <- mdForwardRefOrNull ctx mt <$> parseField r 6 numeric
+    dispIsLocal        <- parseField r 7 nonzero
+    dispIsDefinition   <- parseField r 8 nonzero
+    dispScopeLine      <- parseField r 9 numeric
+    dispContainingType <- mdForwardRefOrNull ctx mt <$> parseField r 10 numeric
+    dispVirtuality     <- parseField r 11 numeric
+    dispVirtualIndex   <- parseField r 12 numeric
+    dispThisAdjustment <- if hasThisAdjustment
+                            then parseField r 19 numeric
+                            else return 0
+    dispFlags          <- parseField r 13 numeric
+    dispIsOptimized    <- parseField r 14 nonzero
+    dispTemplateParams <-
+      mdForwardRefOrNull ctx mt <$> parseField r (adj 15) numeric
+    dispDeclaration <-
+      mdForwardRefOrNull ctx mt <$> parseField r (adj 16) numeric
+    dispVariables <-
+      mdForwardRefOrNull ctx mt <$> parseField r (adj 17) numeric
+    -- TODO: in the LLVM parser, it then goes into the metadata table
+    -- and updates function entries to point to subprograms. Is that
+    -- neccessary for us?
+    return $! updateMetadataTable
+      (addDebugInfo isDistinct (DebugInfoSubprogram DISubprogram{..})) pm
+
   22 -> label "METADATA_LEXICAL_BLOCK" $ do
+    when (length (recordFields r) /= 5)
+      (fail "Invalid record")
     cxt <- getContext
-    isDistinct <- parseField r 0 numeric
-    mdForwardRefOrNull cxt mt <$> parseField r 1 numeric
-    mdForwardRefOrNull cxt mt <$> parseField r 2 numeric
-    parseField r 3 numeric
-    parseField r 4 numeric
-    -- TODO
-    fail "not yet implemented"
+    isDistinct <- parseField r 0 nonzero
+    dilbScope  <- mdForwardRefOrNull cxt mt <$> parseField r 1 numeric
+    dilbFile   <- mdForwardRefOrNull cxt mt <$> parseField r 2 numeric
+    dilbLine   <- parseField r 3 numeric
+    dilbColumn <- parseField r 4 numeric
+    return $! updateMetadataTable
+      (addDebugInfo isDistinct (DebugInfoLexicalBlock DILexicalBlock{..})) pm
+
   23 -> label "METADATA_LEXICAL_BLOCK_FILE" $ do
+    when (length (recordFields r) /= 4)
+      (fail "Invalid record")
     cxt <- getContext
-    isDistinct <- parseField r 0 numeric
-    mdForwardRefOrNull cxt mt <$> parseField r 1 numeric
-    mdForwardRefOrNull cxt mt <$> parseField r 2 numeric
-    parseField r 3 numeric
-    -- TODO
-    fail "not yet implemented"
+    isDistinct <- parseField r 0 nonzero
+    dilbfScope <- do
+      mScope <- mdForwardRefOrNull cxt mt <$> parseField r 1 numeric
+      maybe (fail "Invalid record: scope field not present") return mScope
+    dilbfFile <- mdForwardRefOrNull cxt mt <$> parseField r 2 numeric
+    dilbfDiscriminator <- parseField r 3 numeric
+    return $! updateMetadataTable
+      (addDebugInfo
+         isDistinct
+         (DebugInfoLexicalBlockFile DILexicalBlockFile{..}))
+      pm
+
   24 -> label "METADATA_NAMESPACE" $ do
     cxt <- getContext
     isDistinct <- parseField r 0 numeric
@@ -365,15 +576,58 @@
     mdForwardRefOrNull cxt mt <$> parseField r 4 numeric
     -- TODO
     fail "not yet implemented"
+
   27 -> label "METADATA_GLOBAL_VAR" $ do
-    -- TODO
-    fail "not yet implemented"
+    when (length (recordFields r) /= 11)
+      (fail "Invalid record")
+
+    ctx <- getContext
+    isDistinct <- parseField r 0 nonzero
+    digvScope  <- mdForwardRefOrNull ctx mt <$> parseField r 1 numeric
+    digvName   <- mdStringOrNull ctx mt <$> parseField r 2 numeric
+    digvLinkageName <- mdStringOrNull ctx mt <$> parseField r 3 numeric
+    digvFile   <- mdForwardRefOrNull ctx mt <$> parseField r 4 numeric
+    digvLine   <- parseField r 5 numeric
+    digvType   <- mdForwardRefOrNull ctx mt <$> parseField r 6 numeric
+    digvIsLocal <- parseField r 7 nonzero
+    digvIsDefinition <- parseField r 8 nonzero
+    digvVariable <- mdForwardRefOrNull ctx mt <$> parseField r 9 numeric
+    digvDeclaration <- mdForwardRefOrNull ctx mt <$> parseField r 10 numeric
+    return $! updateMetadataTable
+      (addDebugInfo
+         isDistinct
+         (DebugInfoGlobalVariable DIGlobalVariable{..})) pm
+
   28 -> label "METADATA_LOCAL_VAR" $ do
-    -- TODO
-    fail "not yet implemented"
+    -- this one is a bit funky:
+    -- https://github.com/llvm-mirror/llvm/blob/release_38/lib/Bitcode/Reader/BitcodeReader.cpp#L2308
+    let recordSize = length (recordFields r)
+        adj i | recordSize > 8 = i + 1
+              | otherwise      = i
+    when (recordSize < 8 || recordSize > 10)
+      (fail "Invalid record")
+
+    ctx <- getContext
+    isDistinct <- parseField r 0 nonzero
+    dilvScope  <- mdForwardRefOrNull ctx mt <$> parseField r (adj 1) numeric
+    dilvName   <- mdStringOrNull ctx mt <$> parseField r (adj 2) numeric
+    dilvFile   <- mdForwardRefOrNull ctx mt <$> parseField r (adj 3) numeric
+    dilvLine   <- parseField r (adj 4) numeric
+    dilvType   <- mdForwardRefOrNull ctx mt <$> parseField r (adj 5) numeric
+    dilvArg    <- parseField r (adj 6) numeric
+    dilvFlags  <- parseField r (adj 7) numeric
+    return $! updateMetadataTable
+      (addDebugInfo isDistinct (DebugInfoLocalVariable DILocalVariable{..})) pm
+
   29 -> label "METADATA_EXPRESSION" $ do
-    -- TODO
-    fail "not yet implemented"
+    let recordSize = length (recordFields r)
+    when (recordSize < 1)
+      (fail "Invalid record")
+    isDistinct <- parseField r 0 nonzero
+    dieElements <- parseFields r 1 numeric
+    return $! updateMetadataTable
+      (addDebugInfo isDistinct (DebugInfoExpression DIExpression{..})) pm
+
   30 -> label "METADATA_OBJC_PROPERTY" $ do
     -- TODO
     fail "not yet implemented"
@@ -414,13 +668,42 @@
     mdForwardRefOrNull cxt mt <$> parseField r 4 numeric
     -- TODO
     fail "not yet implemented"
+
   35 -> label "METADATA_STRINGS" $ do
+    when (length (recordFields r) /= 3)
+      (fail "Invalid record: metadata strings layout")
+    count  <- parseField r 0 numeric
+    offset <- parseField r 1 numeric
+    bs     <- parseField r 2 fieldBlob
+    when (count == 0)
+      (fail "Invalid record: metadata strings with no strings")
+    when (offset >= S.length bs)
+      (fail "Invalid record: metadata strings corrupt offset")
+    let (bsLengths, bsStrings) = S.splitAt offset bs
+    lengths <- either fail return $ parseMetadataStringLengths count bsLengths
+    when (sum lengths > S.length bsStrings)
+      (fail "Invalid record: metadata strings truncated")
+    let strings = snd (mapAccumL f bsStrings lengths)
+          where f s i = case S.splitAt i s of
+                          (str,rest) -> (rest, Char8.unpack str)
+    return $! updateMetadataTable (addStrings strings) pm
+
+  36 -> label "METADATA_GLOBAL_DECL_ATTACHMENT" $ do
     -- TODO
     fail "not yet implemented"
-  36 -> label "METADATA_GLOBAL_DECL_ATTACHMENT" $ do
+
+  37 -> label "METADATA_GLOBAL_VAR_EXPR" $ do
     -- TODO
     fail "not yet implemented"
 
+  38 -> label "METADATA_INDEX_OFFSET" $ do
+    -- TODO
+    fail "not yet implemented"
+
+  39 -> label "METADATA_INDEX" $ do
+    -- TODO
+    fail "not yet implemented"
+
   code -> fail ("unknown record code: " ++ show code)
 
 parseMetadataEntry _ _ pm (abbrevDef -> Just _) =
@@ -429,14 +712,13 @@
 parseMetadataEntry _ _ _ r =
   fail ("unexpected: " ++ show r)
 
-
-parseAttachment :: Record -> Parse [(String,PValMd)]
-parseAttachment r = loop (length (recordFields r) - 1) []
+parseAttachment :: Record -> Int -> Parse [(PKindMd,PValMd)]
+parseAttachment r l = loop (length (recordFields r) - 1) []
   where
-  loop 0 acc = return acc
-  loop n acc = do
-    kind <- getKind     =<< parseField r (n - 1) numeric
-    md   <- getMetadata =<< parseField r  n      numeric
+  loop n acc | n < l = return acc
+             | otherwise = do
+    kind <- parseField r (n - 1) numeric
+    md   <- getMetadata =<< parseField r n numeric
     loop (n - 2) ((kind,typedValue md) : acc)
 
 -- | Parse a metadata node.
diff --git a/src/Data/LLVM/BitCode/IR/Module.hs b/src/Data/LLVM/BitCode/IR/Module.hs
--- a/src/Data/LLVM/BitCode/IR/Module.hs
+++ b/src/Data/LLVM/BitCode/IR/Module.hs
@@ -39,6 +39,7 @@
   , partialNamedMd    :: [NamedMd]
   , partialUnnamedMd  :: [PartialUnnamedMd]
   , partialSections   :: Seq.Seq String
+  , partialSourceName :: !(Maybe String)
   }
 
 emptyPartialModule :: PartialModule
@@ -54,6 +55,7 @@
   , partialNamedMd    = mempty
   , partialUnnamedMd  = mempty
   , partialSections   = mempty
+  , partialSourceName = mempty
   }
 
 -- | Fixup the global variables and declarations, and return the completed
@@ -66,7 +68,7 @@
   unnamed  <- T.mapM finalizePartialUnnamedMd (partialUnnamedMd pm)
   types    <- resolveTypeDecls
   let lkp = lookupBlockName (partialDefines pm)
-  defines  <- T.mapM (finalizePartialDefine lkp) (partialDefines pm)
+  defines <- T.mapM (finalizePartialDefine lkp) (partialDefines pm)
   return emptyModule
     { modDataLayout = partialDataLayout pm
     , modNamedMd    = partialNamedMd pm
@@ -128,8 +130,12 @@
 
 parseModuleBlockEntry pm (functionBlockId -> Just es) = do
   -- FUNCTION_BLOCK_ID
-  def <- parseFunctionBlock es
-  return pm { partialDefines = partialDefines pm Seq.|> def }
+  let unnamedGlobalsCount = length (partialUnnamedMd pm)
+  def <- parseFunctionBlock unnamedGlobalsCount es
+  let def' = def { partialGlobalMd = [] }
+  return pm { partialDefines = partialDefines pm Seq.|> def'
+            , partialUnnamedMd = partialGlobalMd def ++ partialUnnamedMd pm
+            }
 
 parseModuleBlockEntry pm (paramattrBlockId -> Just _) = do
   -- PARAMATTR_BLOCK_ID
@@ -144,7 +150,8 @@
 parseModuleBlockEntry pm (metadataBlockId -> Just es) = do
   -- METADATA_BLOCK_ID
   vt <- getValueTable
-  (ns,(gs,_),_) <- parseMetadataBlock vt es
+  let globalsSoFar = length (partialUnnamedMd pm)
+  (ns,(gs,_),_,_) <- parseMetadataBlock globalsSoFar vt es
   return pm
     { partialNamedMd   = partialNamedMd   pm ++ ns
     , partialUnnamedMd = partialUnnamedMd pm ++ gs
@@ -224,9 +231,10 @@
   -- MODULE_CODE_METADATA_VALUES_UNUSED
   return pm
 
-parseModuleBlockEntry _ (moduleCodeSourceFilename -> Just _) = do
+parseModuleBlockEntry pm (moduleCodeSourceFilename -> Just r) = do
   -- MODULE_CODE_SOURCE_FILENAME
-  fail "MODULE_CODE_SOURCE_FILENAME"
+  do str <- parseField r 0 cstring
+     return pm { partialSourceName = Just str }
 
 parseModuleBlockEntry _ (moduleCodeHash -> Just _) = do
   -- MODULE_CODE_HASH
diff --git a/src/Data/LLVM/BitCode/IR/Values.hs b/src/Data/LLVM/BitCode/IR/Values.hs
--- a/src/Data/LLVM/BitCode/IR/Values.hs
+++ b/src/Data/LLVM/BitCode/IR/Values.hs
@@ -2,6 +2,7 @@
 
 module Data.LLVM.BitCode.IR.Values (
     getValueTypePair
+  , getConstantFwdRef
   , getValue
   , getFnValueById
   , parseValueSymbolTableBlock
@@ -21,6 +22,18 @@
 
 -- Value Table -----------------------------------------------------------------
 
+getConstantFwdRef :: ValueTable -> Type -> Int -> Parse (Typed PValue)
+getConstantFwdRef t ty n = label "getConstantFwdRef" $ do
+  mb <- lookupValue n
+  case mb of
+    Just tv -> return tv
+
+    -- forward reference
+    Nothing -> do
+      cxt <- getContext
+      let ref = forwardRef cxt n t
+      return (Typed ty (typedValue ref))
+
 -- | Get either a value from the value table, with its value, or parse a value
 -- and a type.
 getValueTypePair :: ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
@@ -67,7 +80,6 @@
 
   _ -> do
     mb <- lookupValueAbs (fromIntegral n)
-    -- TODO: lookup in the metadata table
     case mb of
 
       Just tv -> return tv
diff --git a/src/Data/LLVM/BitCode/Match.hs b/src/Data/LLVM/BitCode/Match.hs
--- a/src/Data/LLVM/BitCode/Match.hs
+++ b/src/Data/LLVM/BitCode/Match.hs
@@ -48,7 +48,7 @@
 -- | Get the nth element of a list.
 index :: Int -> Match [a] a
 index n as = do
-  guard (n < length as)
+  guard (n >= 0 && n < length as)
   return (as !! n)
 
 -- | Drop elements of a list until a predicate matches.
diff --git a/src/Data/LLVM/BitCode/Parse.hs b/src/Data/LLVM/BitCode/Parse.hs
--- a/src/Data/LLVM/BitCode/Parse.hs
+++ b/src/Data/LLVM/BitCode/Parse.hs
@@ -549,8 +549,12 @@
                Map.lookup (SymTabFNEntry n) symtab
   case mentry of
     Just i  -> return (renderName i)
-    Nothing -> fail ("entry " ++ show n ++ " is missing from the symbol table"
-             ++ "\n" ++ show symtab)
+    Nothing ->
+      do isRel <- getRelIds
+         fail $ unlines
+           [ "entry " ++ show n ++ (if isRel then " (relative)" else "")
+              ++ " is missing from the symbol table"
+           , show symtab ]
 
 -- | Lookup the name of a basic block.
 bbEntryName :: Int -> Parse (Maybe BlockLabel)
@@ -621,4 +625,4 @@
   let KindTable { .. } = psKinds ps
   case Map.lookup kind ktNames of
     Just name -> return name
-    Nothing   -> fail ("Unknown kind id: " ++ show kind)
+    Nothing   -> fail ("Unknown kind id: " ++ show kind ++ "\nKind table: " ++ show (psKinds ps))
diff --git a/src/Data/LLVM/BitCode/Record.hs b/src/Data/LLVM/BitCode/Record.hs
--- a/src/Data/LLVM/BitCode/Record.hs
+++ b/src/Data/LLVM/BitCode/Record.hs
@@ -5,9 +5,11 @@
 import Data.LLVM.BitCode.Match
 import Data.LLVM.BitCode.Parse
 
-import Data.Bits (testBit,shiftR,bit)
+import Data.Bits (Bits,testBit,shiftR,bit)
 import Data.Char (chr)
+import Data.Int  (Int64)
 import Data.Word (Word64)
+import Data.ByteString (ByteString)
 
 import Control.Monad ((<=<),MonadPlus(..),guard)
 
@@ -74,6 +76,11 @@
 fieldArray p (FieldArray fs) = mapM p fs
 fieldArray _ _               = mzero
 
+-- | Match a blob field.
+fieldBlob :: Match Field ByteString
+fieldBlob (FieldBlob bs) = return bs
+fieldBlob _              = mzero
+
 type LookupField a = Int -> Match Field a -> Parse a
 
 -- | Flatten arrays inside a record.
@@ -110,9 +117,8 @@
 numeric :: Num a => Match Field a
 numeric  = fmap fromBitString . (fieldLiteral ||| fieldFixed ||| fieldVbr)
 
--- | Parse a @Field@ as a sign-encoded number.
-signed :: Match Field Word64
-signed  = fmap decode . (fieldLiteral ||| fieldFixed ||| fieldVbr)
+signedImpl :: (Bits a, Num a) => Match Field a
+signedImpl = fmap decode . (fieldLiteral ||| fieldFixed ||| fieldVbr)
   where
   decode bs
     | not (testBit n 0) =         n `shiftR` 1
@@ -120,6 +126,14 @@
     | otherwise         = bit 63 -- not really right, but it's what llvm does
     where
     n = fromBitString bs
+
+-- | Parse a @Field@ as a sign-encoded number.
+signedWord64 :: Match Field Word64
+signedWord64 = signedImpl
+
+-- | Parse a @Field@ as a sign-encoded number.
+signedInt64 :: Match Field Int64
+signedInt64 = signedImpl
 
 boolean :: Match Field Bool
 boolean  = decode <=< (fieldFixed ||| fieldLiteral ||| fieldVbr)