Global variables, and fix working with alloca

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;
 }