summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--codegen.hs83
-rw-r--r--simple.nl2
2 files changed, 61 insertions, 24 deletions
diff --git a/codegen.hs b/codegen.hs
index e7adf75..3f35d43 100644
--- a/codegen.hs
+++ b/codegen.hs
@@ -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
diff --git a/simple.nl b/simple.nl
index ff3ddff..050935b 100644
--- a/simple.nl
+++ b/simple.nl
@@ -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;
}