diff options
| -rw-r--r-- | codegen.hs | 83 | ||||
| -rw-r--r-- | simple.nl | 2 |
2 files changed, 61 insertions, 24 deletions
@@ -28,8 +28,8 @@ data GenState ,allBlocks :: Map.Map LLName A.BasicBlock ,nextId :: Integer ,definitions :: [A.Definition] - ,variables :: Map.Map Name LLName - ,variableTypes :: Map.Map Name Type} + ,variables :: Map.Map Name (Type, LLName) + ,globalVariables :: Map.Map Name (Type, LLName)} deriving (Show) initialGenState :: GenState @@ -39,7 +39,7 @@ initialGenState ,nextId = 1 ,definitions = [] ,variables = Map.empty - ,variableTypes = Map.empty} + ,globalVariables = Map.empty} newtype CGMonad a = CGMonad {unMon :: ExceptT String (State GenState) a} deriving (Functor, Applicative, Monad, MonadState GenState, MonadError String) @@ -92,16 +92,44 @@ setTerminator term = do setVar :: Name -> LLName -> Type -> CGMonad () setVar name label t = do - state $ \s -> ((), s { - variables = Map.insert name label $ variables s, - variableTypes = Map.insert name t $ variableTypes s - }) + state $ \s -> ((), s {variables = Map.insert name (t, label) $ variables s}) + +setGlobalVar :: Name -> LLName -> Type -> CGMonad () +setGlobalVar name label t = do + state $ \s -> ((), s {globalVariables = Map.insert name (t, label) $ globalVariables s}) -lookupVar :: Name -> CGMonad LLName +lookupVar :: Name -> CGMonad (Type, LLName) lookupVar name = liftM (fromJust . Map.lookup name . variables) get -lookupVarType :: Name -> CGMonad Type -lookupVarType name = liftM (fromJust . Map.lookup name . variableTypes) get +lookupGlobalVar :: Name -> CGMonad (Type, LLName) +lookupGlobalVar name = liftM (fromJust . Map.lookup name . globalVariables) get + +variableStoreOperand :: Name -> CGMonad A.Operand +variableStoreOperand name = get >>= (maybe getGlobal getLocal . Map.lookup name . variables) + where + getLocal :: (Type, LLName) -> CGMonad A.Operand + getLocal (t, nm) = return $ A.LocalReference (toLLVMType t) (A.Name nm) + + getGlobal :: CGMonad A.Operand + getGlobal = do + (t, nm) <- lookupGlobalVar name + return $ A.ConstantOperand $ A.C.GlobalReference (toLLVMType t) (A.Name nm) + +variableOperand :: Name -> CGMonad A.Operand +variableOperand name = get >>= (maybe getGlobal getLocal . Map.lookup name . variables) + where + getLocal :: (Type, LLName) -> CGMonad A.Operand + getLocal (t, nm) = do + let loadoper = A.LocalReference (toLLVMType t) (A.Name nm) + label <- addInstr $ A.Load False loadoper Nothing 0 [] + return $ A.LocalReference (toLLVMType t) (A.Name label) + + getGlobal :: CGMonad A.Operand + getGlobal = do + (t, nm) <- lookupGlobalVar name + let loadoper = A.ConstantOperand $ A.C.GlobalReference (toLLVMType t) (A.Name nm) + label <- addInstr $ A.Load False loadoper Nothing 0 [] + return $ A.LocalReference (toLLVMType t) (A.Name label) -- namedName :: A.Named a -> LLName @@ -137,7 +165,9 @@ genGlobalVars :: Program -> CGMonad [A.Definition] genGlobalVars (Program decs) = mapM gen $ filter isDecVariable decs where gen :: Declaration -> CGMonad A.Definition - gen (DecVariable t n Nothing) = return $ A.GlobalDefinition $ + gen (DecVariable t n Nothing) = do + setGlobalVar n n t + return $ A.GlobalDefinition $ A.globalVariableDefaults { A.G.name = A.Name n, A.G.type' = toLLVMType t, @@ -206,21 +236,20 @@ genSingle (StAssignment name expr) following = do bb <- newBlockJump following label <- genExpression expr let oper = A.LocalReference (toLLVMType (fromJust (exTypeOf expr))) (A.Name label) - dstlabel <- lookupVar name - dsttype <- lookupVarType name + (dsttype, _) <- lookupVar name oper' <- castOperand oper dsttype - void $ addInstr $ A.Store False (A.LocalReference (toLLVMType dsttype) (A.Name dstlabel)) - oper' Nothing 0 [] + ref <- variableStoreOperand name + void $ addInstr $ A.Store False ref oper' Nothing 0 [] return bb genSingle _ _ = undefined genExpression :: Expression -> CGMonad LLName -genExpression (ExLit (LitInt i) (Just t@(TypeInt sz))) = do - aname <- getNewName "t" - void $ addNamedInstr $ A.Name aname A.:= A.Alloca (toLLVMType t) Nothing 0 [] - void $ addInstr $ A.Store False (A.LocalReference (toLLVMType t) (A.Name aname)) - (A.ConstantOperand (A.C.Int (fromIntegral sz) i)) Nothing 0 [] - return aname +-- genExpression (ExLit (LitInt i) (Just t@(TypeInt sz))) = do +-- aname <- getNewName "t" +-- void $ addNamedInstr $ A.Name aname A.:= A.Alloca (toLLVMType t) Nothing 0 [] +-- void $ addInstr $ A.Store False (A.LocalReference (toLLVMType t) (A.Name aname)) +-- (A.ConstantOperand (A.C.Int (fromIntegral sz) i)) Nothing 0 [] +-- return aname genExpression (ExBinOp bo e1 e2 (Just t)) = do e1op <- genExprArgument e1 e2op <- genExprArgument e2 @@ -258,8 +287,9 @@ genExprArgument expr = case expr of literalToOperand :: Literal -> Type -> CGMonad A.Operand literalToOperand (LitInt i) (TypeInt sz) = return $ A.ConstantOperand (A.C.Int (fromIntegral sz) i) literalToOperand (LitVar n) t = do - label <- lookupVar n - return $ A.LocalReference (toLLVMType t) (A.Name label) + oper <- variableOperand n + oper' <- castOperand oper t + return oper' literalToOperand _ _ = undefined castOperand :: A.Operand -> Type -> CGMonad A.Operand @@ -274,6 +304,13 @@ castOperand orig@(A.ConstantOperand (A.C.Int s1 val)) t2@(TypeInt s2) | fromIntegral s1 == s2 = return orig | fromIntegral s1 < s2 = return $ A.ConstantOperand (A.C.Int (fromIntegral s2) val) | fromIntegral s1 > s2 = throwError $ "Integer " ++ show val ++ " too large for type '" ++ pshow t2 ++ "'" +castOperand orig@(A.ConstantOperand (A.C.GlobalReference (A.IntegerType s1) _)) t2@(TypeInt s2) + | fromIntegral s1 == s2 = return orig + | fromIntegral s1 < s2 = do + label <- addInstr $ A.SExt orig (toLLVMType t2) [] + return $ A.LocalReference (toLLVMType t2) (A.Name label) + | fromIntegral s1 > s2 = throwError $ "Cannot implicitly cast '" ++ pshow (TypeInt (fromIntegral s1)) + ++ "' to '" ++ pshow t2 ++ "'" castOperand _ _ = undefined @@ -6,6 +6,6 @@ int g_var; int main(i32 argc, ptr(ptr(i8)) argv) { //int i = g_var; int i; - i = 1 + 2 + 3; + i = g_var + 2 + 3; int a = i + 2; } |