on master help sign in
Expand target information and use proper stdio symbols on OSX
commit3165cb2f49e87b10e08fffbaff1b6dc786340417 authorBenjamin Saunders <besaunde@sfu.ca> dateThu 27 Jun 2013, 18:06 (13 years ago) parentacce7da
1 file changed+28−15
src/IRTS/CodegenLLVM.hs+28−15
src/IRTS/CodegenLLVM.hs+28−15
@@ -33,7 +33,7 @@ import Control.Monad.RWS
3333import Control.Monad.Writer
3434import Control.Monad.State
3535
36−import System.Info (arch)
36+import qualified System.Info as SI (arch, os)
3737import System.IO
3838import System.Directory (removeFile)
3939import System.FilePath ((</>))
@@ -41,12 +41,15 @@ import System.Process (rawSystem)
4141import System.Exit (ExitCode(..))
4242import Debug.Trace
4343
44+data Target = Target { arch :: String, os :: String }
45+
4446codegenLLVM :: [(TT.Name, SDecl)] ->
4547 FilePath -> -- output file name
4648 OutputType ->
4749 IO ()
4850codegenLLVM defs file outty = withContext $ \context -> do
49− let ast = codegen arch (map snd defs)
51+ let target = Target { arch = SI.arch, os = SI.os }
52+ let ast = codegen target (map snd defs)
5053 result <- M.withModuleFromAST context ast (outputModule file outty)
5154 case result of
5255 Right _ -> return ()
@@ -101,7 +104,7 @@ mainDef =
101104 (Do $ Ret (Just (ConstantOperand (C.Int 32 0))) [])
102105 ]}
103106
104−initDefs :: String -> [Definition]
107+initDefs :: Target -> [Definition]
105108initDefs tgt =
106109 [ TypeDefinition (Name "valTy")
107110 (Just $ StructureType False
@@ -160,9 +163,9 @@ initDefs tgt =
160163 , exfun "__idris_gmpRealloc" ptrI8 [ptrI8, intPtr, intPtr] False
161164 , exfun "__idris_gmpFree" VoidType [ptrI8, intPtr] False
162165 , exfun "strtoll" (IntegerType 64) [ptrI8, PointerType ptrI8 (AddrSpace 0), IntegerType 32] False
163− , exVar "stdin" ptrI8
164− , exVar "stdout" ptrI8
165− , exVar "stderr" ptrI8
166+ , exVar (stdinName tgt) ptrI8
167+ , exVar (stdoutName tgt) ptrI8
168+ , exVar (stderrName tgt) ptrI8
166169 , GlobalDefinition mainDef
167170 ] ++ map mpzBinFun ["add", "sub", "mul", "fdiv_q", "fdiv_r", "and", "ior", "xor"]
168171 where
@@ -192,10 +195,20 @@ initDefs tgt =
192195 exVar :: String -> Type -> Definition
193196 exVar name ty = GlobalDefinition $ globalVariableDefaults { G.name = Name name, G.type' = ty }
194197
195−codegen :: String -> [SDecl] -> Module
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+
208+codegen :: Target -> [SDecl] -> Module
196209codegen tgt defs = Module "idris" Nothing Nothing (initDefs tgt ++ globals ++ gendefs)
197210 where
198− ((gendefs, globals), _) = (runState . runWriterT) (mapM cgDef defs) 0
211+ (gendefs, _, globals) = runRWS (mapM cgDef defs) tgt 0
199212
200213valueType :: Type
201214valueType = NamedTypeReference (Name "valTy")
@@ -215,17 +228,18 @@ conType nargs = StructureType False
215228 , ArrayType nargs (PointerType valueType (AddrSpace 0))
216229 ]
217230
218−type Modgen = WriterT [Definition] (State Word)
231+type Modgen = RWS Target [Definition] Word
219232
220233cgDef :: SDecl -> Modgen Definition
221234cgDef (SFun name argNames _ expr) = do
222235 nextGlobal <- get
236+ tgt <- ask
223237 let (_, CGS { nextGlobalName = nextGlobal' }, (allocas, bbs, globals)) =
224238 runRWS (do r <- cgExpr expr
225239 case r of
226240 Nothing -> terminate $ Unreachable []
227241 Just r' -> terminate $ Ret (Just r') [])
228− (CGR arch (show name))
242+ (CGR tgt (show name))
229243 (CGS 0 nextGlobal (Name "begin") [] (map (Just . LocalReference . Name . show) argNames) S.empty)
230244 entryTerm = case bbs of
231245 [] -> Do $ Ret Nothing []
@@ -259,7 +273,7 @@ data CGS = CGS { nextName :: Word
259273 , foreignSyms :: Set String
260274 }
261275
262−data CGR = CGR { target :: String
276+data CGR = CGR { target :: Target
263277 , funcName :: String }
264278
265279type Codegen = RWS CGR CGW CGS
@@ -353,10 +367,9 @@ sizeOf ty = ConstantOperand . C.PtrToInt
353367 (C.GetElementPtr True (C.Null (PointerType ty (AddrSpace 0))) [C.Int 32 1])
354368 . IntegerType . fromIntegral <$> getWordSize
355369
356−tgtWordSize :: String -> Integer
357−tgtWordSize tgt = case tgt of
358− "x86_64" -> 64
359− "i386" -> 32
370+tgtWordSize :: Target -> Integer
371+tgtWordSize (Target { arch = "i386" }) = 32
372+tgtWordSize (Target { arch = "x86_64" }) = 64
360373
361374getWordSize :: Codegen Integer
362375getWordSize = tgtWordSize <$> asks target