git.iko.soy/Idris-dev
on master help sign in
Expand target information and use proper stdio symbols on OSX
3165cb2Benjamin Saunders
src/IRTS/CodegenLLVM.hs+28−15
compare with master
unifiedsplit
@@ -33,7 +33,7 @@ import Control.Monad.RWS
33import Control.Monad.Writer
33import Control.Monad.Writer
34import Control.Monad.State
34import Control.Monad.State
35
35
36−import System.Info (arch)
36+import qualified System.Info as SI (arch, os)
37import System.IO
37import System.IO
38import System.Directory (removeFile)
38import System.Directory (removeFile)
39import System.FilePath ((</>))
39import System.FilePath ((</>))
@@ -41,12 +41,15 @@ import System.Process (rawSystem)
41import System.Exit (ExitCode(..))
41import System.Exit (ExitCode(..))
42import Debug.Trace
42import Debug.Trace
43
43
44+data Target = Target { arch :: String, os :: String }
45+
44codegenLLVM :: [(TT.Name, SDecl)] ->
46codegenLLVM :: [(TT.Name, SDecl)] ->
45 FilePath -> -- output file name
47 FilePath -> -- output file name
46 OutputType ->
48 OutputType ->
47 IO ()
49 IO ()
48codegenLLVM defs file outty = withContext $ \context -> do
50codegenLLVM defs file outty = withContext $ \context -> do
51+ let target = Target { arch = SI.arch, os = SI.os }
49− let ast = codegen arch (map snd defs)
52+ let ast = codegen target (map snd defs)
50 result <- M.withModuleFromAST context ast (outputModule file outty)
53 result <- M.withModuleFromAST context ast (outputModule file outty)
51 case result of
54 case result of
52 Right _ -> return ()
55 Right _ -> return ()
@@ -101,7 +104,7 @@ mainDef =
101 (Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [])
104 (Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [])
102 ]}
105 ]}
103
106
104−initDefs :: String -> [Definition]
107+initDefs :: Target -> [Definition]
105initDefs tgt =
108initDefs tgt =
106 [ TypeDefinition (Name "valTy")
109 [ TypeDefinition (Name "valTy")
107 (Just $ StructureType False
110 (Just $ StructureType False
@@ -160,9 +163,9 @@ initDefs tgt =
160 , exfun "__idris_gmpRealloc" ptrI8 [ptrI8, intPtr, intPtr] False
163 , exfun "__idris_gmpRealloc" ptrI8 [ptrI8, intPtr, intPtr] False
161 , exfun "__idris_gmpFree" VoidType [ptrI8, intPtr] False
164 , exfun "__idris_gmpFree" VoidType [ptrI8, intPtr] False
162 , exfun "strtoll" (IntegerType 64) [ptrI8, PointerType ptrI8 (AddrSpace 0), IntegerType 32] False
165 , exfun "strtoll" (IntegerType 64) [ptrI8, PointerType ptrI8 (AddrSpace 0), IntegerType 32] False
163− , exVar "stdin" ptrI8
166+ , exVar (stdinName tgt) ptrI8
164− , exVar "stdout" ptrI8
167+ , exVar (stdoutName tgt) ptrI8
165− , exVar "stderr" ptrI8
168+ , exVar (stderrName tgt) ptrI8
166 , GlobalDefinition mainDef
169 , GlobalDefinition mainDef
167 ] ++ map mpzBinFun ["add", "sub", "mul", "fdiv_q", "fdiv_r", "and", "ior", "xor"]
170 ] ++ map mpzBinFun ["add", "sub", "mul", "fdiv_q", "fdiv_r", "and", "ior", "xor"]
168 where
171 where
@@ -192,10 +195,20 @@ initDefs tgt =
192 exVar :: String -> Type -> Definition
195 exVar :: String -> Type -> Definition
193 exVar name ty = GlobalDefinition $ globalVariableDefaults { G.name = Name name, G.type' = ty }
196 exVar name ty = GlobalDefinition $ globalVariableDefaults { G.name = Name name, G.type' = ty }
194
197
198+ stdinName :: Target -> String
199+ stdinName (Target { os = "darwin" }) = "__stdinp"
200+ stdinName _ = "stdin"
201+ stdoutName :: Target -> String
202+ stdoutName (Target { os = "darwin" }) = "__stdoutp"
203+ stdoutName _ = "stdout"
204+ stderrName :: Target -> String
205+ stderrName (Target { os = "darwin" }) = "__stderrp"
206+ stderrName _ = "stderr"
207+
195−codegen :: String -> [SDecl] -> Module
208+codegen :: Target -> [SDecl] -> Module
196codegen tgt defs = Module "idris" Nothing Nothing (initDefs tgt ++ globals ++ gendefs)
209codegen tgt defs = Module "idris" Nothing Nothing (initDefs tgt ++ globals ++ gendefs)
197 where
210 where
198− ((gendefs, globals), _) = (runState . runWriterT) (mapM cgDef defs) 0
211+ (gendefs, _, globals) = runRWS (mapM cgDef defs) tgt 0
199
212
200valueType :: Type
213valueType :: Type
201valueType = NamedTypeReference (Name "valTy")
214valueType = NamedTypeReference (Name "valTy")
@@ -215,17 +228,18 @@ conType nargs = StructureType False
215 , ArrayType nargs (PointerType valueType (AddrSpace 0))
228 , ArrayType nargs (PointerType valueType (AddrSpace 0))
216 ]
229 ]
217
230
218−type Modgen = WriterT [Definition] (State Word)
231+type Modgen = RWS Target [Definition] Word
219
232
220cgDef :: SDecl -> Modgen Definition
233cgDef :: SDecl -> Modgen Definition
221cgDef (SFun name argNames _ expr) = do
234cgDef (SFun name argNames _ expr) = do
222 nextGlobal <- get
235 nextGlobal <- get
236+ tgt <- ask
223 let (_, CGS { nextGlobalName = nextGlobal' }, (allocas, bbs, globals)) =
237 let (_, CGS { nextGlobalName = nextGlobal' }, (allocas, bbs, globals)) =
224 runRWS (do r <- cgExpr expr
238 runRWS (do r <- cgExpr expr
225 case r of
239 case r of
226 Nothing -> terminate $ Unreachable []
240 Nothing -> terminate $ Unreachable []
227 Just r' -> terminate $ Ret (Just r') [])
241 Just r' -> terminate $ Ret (Just r') [])
228− (CGR arch (show name))
242+ (CGR tgt (show name))
229 (CGS 0 nextGlobal (Name "begin") [] (map (Just . LocalReference . Name . show) argNames) S.empty)
243 (CGS 0 nextGlobal (Name "begin") [] (map (Just . LocalReference . Name . show) argNames) S.empty)
230 entryTerm = case bbs of
244 entryTerm = case bbs of
231 [] -> Do $ Ret Nothing []
245 [] -> Do $ Ret Nothing []
@@ -259,7 +273,7 @@ data CGS = CGS { nextName :: Word
259 , foreignSyms :: Set String
273 , foreignSyms :: Set String
260 }
274 }
261
275
262−data CGR = CGR { target :: String
276+data CGR = CGR { target :: Target
263 , funcName :: String }
277 , funcName :: String }
264
278
265type Codegen = RWS CGR CGW CGS
279type Codegen = RWS CGR CGW CGS
@@ -353,10 +367,9 @@ sizeOf ty = ConstantOperand . C.PtrToInt
353 (C.GetElementPtr True (C.Null (PointerType ty (AddrSpace 0))) [C.Int 32 1])
367 (C.GetElementPtr True (C.Null (PointerType ty (AddrSpace 0))) [C.Int 32 1])
354 . IntegerType . fromIntegral <$> getWordSize
368 . IntegerType . fromIntegral <$> getWordSize
355
369
356−tgtWordSize :: String -> Integer
370+tgtWordSize :: Target -> Integer
357−tgtWordSize tgt = case tgt of
371+tgtWordSize (Target { arch = "i386" }) = 32
358− "x86_64" -> 64
372+tgtWordSize (Target { arch = "x86_64" }) = 64
359− "i386" -> 32
360
373
361getWordSize :: Codegen Integer
374getWordSize :: Codegen Integer
362getWordSize = tgtWordSize <$> asks target
375getWordSize = tgtWordSize <$> asks target