时间戳

首页 > 解决方案 > 无法跨 LLVM OrcJIT 中的模块访问符号

haskell - 无法跨 LLVM OrcJIT 中的模块访问符号

问题描述

我正在使用 haskell、LLVM-hs 和 OrcJIT 编写 JIT 编译器。这是我的主文件，它编译模块，将它们添加到 JIT 并获取并运行内部主要功能：

main :: IO ()
main =
    withContext $ \ctx ->
        withExecutionSession $ \es ->
            withHostTargetMachine Reloc.PIC CodeModel.Default CodeGenOpt.None $ \tm ->
                withSymbolResolver es myResolver $ \psr ->
                    withObjectLinkingLayer es (\_ -> return psr) $ \oll ->
                        withIRCompileLayer oll tm $ \ircl -> do
                            loadLibraryPermanently Nothing
                            repl ctx es tm ircl

    where
        myResolver :: SymbolResolver
        myResolver = SymbolResolver $ \mangled -> do
            ptr <- getSymbolAddressInProcess mangled
            return $ Right $ JITSymbol
                { jitSymbolAddress = ptr 
                , jitSymbolFlags   = defaultJITSymbolFlags { jitSymbolExported = True }
                }


repl :: Context -> ExecutionSession -> TargetMachine -> IRCompileLayer ObjectLinkingLayer ->  IO ()
repl ctx es tm cl = runInputT defaultSettings (loop C.initCmpState)
    where
        loop :: C.CmpState -> InputT IO ()
        loop state =
            getInputLine "% " >>= \minput -> case minput of
                Nothing    -> return ()
                Just "q"   -> return ()
                Just input -> liftIO (process state input) >>= loop

        process :: C.CmpState -> String -> IO C.CmpState
        process state source =
            case L.alexScanner source of
                Left  errStr -> putStrLn errStr >> return state
                Right tokens -> case (P.parseTokens tokens) 0 of
                    P.ParseOk ast ->
                        let (res, state') = C.codeGen state (head ast) in
                        case res of
                            Left err -> putStrLn (show err) >> return state
                            Right () -> runDefinition (state' { C.externs = C.externs state }) >> return state'
                                { C.globals      = Map.empty
                                , C.instructions = []
                                }

        runDefinition :: C.CmpState -> IO ()
        runDefinition state = do
            let globals = Map.elems (C.globals state)
            let externs = Map.elems (C.externs state)
            let instructions = reverse (C.instructions state)

            let mainName = mkBSS "main.0"
            let mainFn = GlobalDefinition $ functionDefaults
                { returnType  = void
                , name        = Name mainName
                , basicBlocks = [BasicBlock (mkName "entry") instructions (Do $ Ret Nothing [])]
                }

            case instructions of
                [] -> do
                    let astmod = defaultModule
                        { moduleDefinitions = externs ++ globals 
                        }
                    M.withModuleFromAST ctx astmod $ \mod -> do
                        BS.putStrLn =<< M.moduleLLVMAssembly mod
                        withModuleKey es $ \modKey ->
                            addModule cl modKey mod
                x -> do
                    let astmod = defaultModule
                        { moduleDefinitions = externs ++ globals ++ [mainFn]
                        }
                    M.withModuleFromAST ctx astmod $ \mod -> do
                        BS.putStrLn =<< M.moduleLLVMAssembly mod
                        withModuleKey es $ \modKey ->
                            withModule cl modKey mod $ do
                                res <- (\mangled -> findSymbol cl mangled False) =<< mangleSymbol cl mainName
                                case res of
                                    Left _ -> putStrLn ("Couldn't find: " ++ show mainName)
                                    Right (JITSymbol fn _)-> do
                                        run $ castPtrToFunPtr (wordPtrToPtr fn)

诸如此打印语句之类的独立模块可以正常运行。具有 main 功能的模块在执行后会从 JIT 中删除：

print(234);

; ModuleID = '<string>'
source_filename = "<string>"

@0 = constant [4 x i8] c"%d\0A\00"

declare i32 @printf(i8*, ...)

define void @main.0() {
entry:
  %0 = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([4 x i8], [4 x i8]* @0, i32 0, i32 0), i32 234)
  ret void
}

234

将 4 分配给符号“x”会生成一个具有全局变量的模块，该模块不会从 JIT 中删除：

x := 4;

; ModuleID = '<string>'
source_filename = "<string>"

@x = global i32 4

但尝试在下一条语句中打印“x”会导致 main 函数的查找失败：

print(x);

; ModuleID = '<string>'
source_filename = "<string>"

@x = external global i32
@0 = constant [4 x i8] c"%d\0A\00"

declare i32 @printf(i8*, ...)

define void @main.0() {
entry:
  %0 = load i32, i32* @x
  %1 = call i32 (i8*, ...) @printf(i8* getelementptr inbounds ([4 x i8], [4 x i8]* @0, i32 0, i32 0), i32 %0)
  ret void
}

Couldn't find: "main.0"

跨模块访问符号似乎存在问题。

我尝试过的事情：

我将非常感谢任何帮助！

标签： haskellcompiler-constructionllvmjitllvm-ir

解决方案

解决了！我对符号解析器感到困惑。它不用于在使用“findSymbol”时检索符号，而是在 JIT 的编译和链接阶段。'getSymbolAddressInProcess' 将只搜索宿主进程中的符号（例如 printf），而不是 JIT 中定义的符号（例如 x）。

为了在 JIT 中使用从另一个模块检索外部符号“x”和从主机进程检索“printf”的模块，必须添加一个符号解析器，它在 JIT 编译层和主机进程中搜索符号：

myResolver :: IRCompileLayer ObjectLinkingLayer -> SymbolResolver
myResolver ircl = SymbolResolver $ \mangled -> do
    symbol <- findSymbol ircl mangled False
    case symbol of
        Right _ -> return symbol
        Left _ -> do
            ptr <- getSymbolAddressInProcess mangled
            return $ Right $ JITSymbol
                { jitSymbolAddress = ptr 
                , jitSymbolFlags   = defaultJITSymbolFlags { jitSymbolExported = True }
                }

推荐阅读