From b9b2ccd5155f8ce14cc9b4b04fffe56b988a3bdd Mon Sep 17 00:00:00 2001 From: tomsmeding Date: Wed, 1 Feb 2017 23:12:40 +0100 Subject: Pointer arithmetic! --- check.hs | 4 ++- codegen.hs | 104 ++++++++++++++++++++++++++++++++++++++++++----------- nl/string_index.nl | 12 +++++++ 3 files changed, 99 insertions(+), 21 deletions(-) create mode 100644 nl/string_index.nl diff --git a/check.hs b/check.hs index 22d8196..65c1470 100644 --- a/check.hs +++ b/check.hs @@ -214,6 +214,8 @@ complogBO = compareBO ++ logicBO resultTypeBO :: BinaryOperator -> Type -> Type -> Maybe Type resultTypeBO Minus (TypePtr t1) (TypePtr t2) | t1 == t2 = Just $ TypeUInt 1 resultTypeBO bo (TypePtr t1) (TypePtr t2) | t1 == t2 && bo `elem` complogBO = Just $ TypeUInt 1 +resultTypeBO bo t@(TypePtr _) (TypeInt _) | bo `elem` [Plus, Minus] = Just t +resultTypeBO bo (TypeInt _) t@(TypePtr _) | bo `elem` [Plus, Minus] = Just t resultTypeBO _ (TypePtr _) _ = Nothing resultTypeBO _ _ (TypePtr _) = Nothing @@ -243,7 +245,7 @@ resultTypeUO uo t@(TypeInt _) | uo `elem` [Negate, Invert] = Just t resultTypeUO uo t@(TypeUInt _) | uo `elem` [Negate, Invert] = Just t resultTypeUO Negate TypeFloat = Just TypeFloat resultTypeUO Negate TypeDouble = Just TypeDouble -resultTypeUO Dereference t@(TypePtr _) = Just t +resultTypeUO Dereference (TypePtr t) = Just t resultTypeUO _ _ = Nothing smallestFloatType :: Double -> Type diff --git a/codegen.hs b/codegen.hs index e56caa4..507feb6 100644 --- a/codegen.hs +++ b/codegen.hs @@ -392,19 +392,52 @@ genExpression :: Expression -> CGMonad A.Operand genExpression (ExLit lit (Just t)) = literalToOperand lit t genExpression (ExBinOp bo e1 e2 (Just t)) = do case bo of - Plus -> do - e1op <- genExprArgument e1 >>= flip castOperand t - e2op <- genExprArgument e2 >>= flip castOperand t - label <- case t of - (TypeInt _) -> addInstr $ A.Add False False e1op e2op [] - (TypeUInt _) -> addInstr $ A.Add False False e1op e2op [] - TypeFloat -> addInstr $ A.FAdd A.NoFastMathFlags e1op e2op [] - TypeDouble -> addInstr $ A.FAdd A.NoFastMathFlags e1op e2op [] - (TypePtr _) -> throwError $ "Plus '+' operator not defined on pointers" - (TypeFunc _ _) -> throwError $ "Plus '+' operator not defined on function pointers" - (TypeName _) -> undefined - TypeVoid -> undefined - return $ A.LocalReference (toLLVMType t) (A.Name label) + Plus -> case (fromJust (exTypeOf e1), fromJust (exTypeOf e2)) of + (ptrtype@(TypePtr _), TypeInt _) -> do + ptrop <- genExprArgument e1 + intop <- genExprArgument e2 >>= flip castOperand (TypeInt 64) + ptrlabel <- addInstr $ A.PtrToInt ptrop (toLLVMType (TypeUInt 64)) [] + add <- addInstr $ A.Add False False (A.LocalReference (toLLVMType ptrtype) (A.Name ptrlabel)) intop [] + res <- addInstr $ A.IntToPtr (A.LocalReference (toLLVMType (TypeUInt 64)) (A.Name add)) + (toLLVMType t) [] + return $ A.LocalReference (toLLVMType ptrtype) (A.Name res) + (ptrtype@(TypePtr _), TypeUInt _) -> do + ptrop <- genExprArgument e1 + intop <- genExprArgument e2 >>= flip castOperand (TypeUInt 64) + ptrlabel <- addInstr $ A.PtrToInt ptrop (toLLVMType (TypeUInt 64)) [] + add <- addInstr $ A.Add False False (A.LocalReference (toLLVMType ptrtype) (A.Name ptrlabel)) intop [] + res <- addInstr $ A.IntToPtr (A.LocalReference (toLLVMType (TypeUInt 64)) (A.Name add)) + (toLLVMType t) [] + return $ A.LocalReference (toLLVMType ptrtype) (A.Name res) + (TypeInt _, ptrtype@(TypePtr _)) -> do + ptrop <- genExprArgument e2 + intop <- genExprArgument e1 >>= flip castOperand (TypeInt 64) + ptrlabel <- addInstr $ A.PtrToInt ptrop (toLLVMType (TypeUInt 64)) [] + add <- addInstr $ A.Add False False (A.LocalReference (toLLVMType ptrtype) (A.Name ptrlabel)) intop [] + res <- addInstr $ A.IntToPtr (A.LocalReference (toLLVMType (TypeUInt 64)) (A.Name add)) + (toLLVMType t) [] + return $ A.LocalReference (toLLVMType ptrtype) (A.Name res) + (TypeUInt _, ptrtype@(TypePtr _)) -> do + ptrop <- genExprArgument e2 + intop <- genExprArgument e1 >>= flip castOperand (TypeUInt 64) + ptrlabel <- addInstr $ A.PtrToInt ptrop (toLLVMType (TypeUInt 64)) [] + add <- addInstr $ A.Add False False (A.LocalReference (toLLVMType ptrtype) (A.Name ptrlabel)) intop [] + res <- addInstr $ A.IntToPtr (A.LocalReference (toLLVMType (TypeUInt 64)) (A.Name add)) + (toLLVMType t) [] + return $ A.LocalReference (toLLVMType t) (A.Name res) + _ -> do + e1op <- genExprArgument e1 >>= flip castOperand t + e2op <- genExprArgument e2 >>= flip castOperand t + label <- case t of + (TypeInt _) -> addInstr $ A.Add False False e1op e2op [] + (TypeUInt _) -> addInstr $ A.Add False False e1op e2op [] + TypeFloat -> addInstr $ A.FAdd A.NoFastMathFlags e1op e2op [] + TypeDouble -> addInstr $ A.FAdd A.NoFastMathFlags e1op e2op [] + (TypePtr _) -> throwError $ "Plus '+' operator not defined on pointers" + (TypeFunc _ _) -> throwError $ "Plus '+' operator not defined on function pointers" + (TypeName _) -> undefined + TypeVoid -> undefined + return $ A.LocalReference (toLLVMType t) (A.Name label) Minus -> do e1op <- genExprArgument e1 >>= flip castOperand t e2op <- genExprArgument e2 >>= flip castOperand t @@ -471,6 +504,20 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do (TypeName _) -> undefined TypeVoid -> undefined return $ A.LocalReference (A.IntegerType 1) (A.Name label) + Unequal -> do + sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2)) + e1op <- genExprArgument e1 >>= flip castOperand sharedType + e2op <- genExprArgument e2 >>= flip castOperand sharedType + label <- case sharedType of + (TypeInt _) -> addInstr $ A.ICmp A.IP.NE e1op e2op [] + (TypeUInt _) -> addInstr $ A.ICmp A.IP.NE e1op e2op [] + TypeFloat -> addInstr $ A.FCmp A.FPP.ONE e1op e2op [] + TypeDouble -> addInstr $ A.FCmp A.FPP.ONE e1op e2op [] + (TypePtr _) -> addInstr $ A.ICmp A.IP.NE e1op e2op [] + (TypeFunc _ _) -> addInstr $ A.ICmp A.IP.NE e1op e2op [] + (TypeName _) -> undefined + TypeVoid -> undefined + return $ A.LocalReference (A.IntegerType 1) (A.Name label) Greater -> do sharedType <- commonTypeM (fromJust (exTypeOf e1)) (fromJust (exTypeOf e2)) e1op <- genExprArgument e1 >>= flip castOperand sharedType @@ -548,11 +595,27 @@ genExpression (ExBinOp bo e1 e2 (Just t)) = do reslabel <- addInstr $ A.Phi A.i1 [(A.ConstantOperand (A.C.Int 1 0), A.Name firstbb), (A.LocalReference A.i1 (A.Name label2), A.Name bb2)] [] return $ A.LocalReference A.i1 (A.Name reslabel) - -- BoolOr -> do - -- e1op' <- castToBool e1op - -- e2op' <- castToBool e2op - -- label <- addInstr $ A.Or e1op' e2op' [] - -- return $ A.LocalReference (A.IntegerType 1) (A.Name label) + BoolOr -> do + firstbb <- liftM (fromJust . currentBlock) get + (A.LocalReference (A.IntegerType 1) (A.Name label1)) <- genExprArgument e1 >>= castToBool + (A.Do origterm) <- getTerminator + + bb2 <- newBlock + (A.LocalReference (A.IntegerType 1) (A.Name label2)) <- genExprArgument e2 >>= castToBool + + bb3 <- newBlock + + changeBlock firstbb + setTerminator $ A.CondBr (A.LocalReference A.i1 (A.Name label1)) (A.Name bb3) (A.Name bb2) [] + + changeBlock bb2 + setTerminator $ A.Br (A.Name bb3) [] + + changeBlock bb3 + setTerminator origterm + reslabel <- addInstr $ A.Phi A.i1 [(A.ConstantOperand (A.C.Int 1 1), A.Name firstbb), + (A.LocalReference A.i1 (A.Name label2), A.Name bb2)] [] + return $ A.LocalReference A.i1 (A.Name reslabel) _ -> throwError $ "Binary operator " ++ pshow bo ++ " not implemented" genExpression (ExUnOp uo e1 (Just t)) = do e1op <- genExprArgument e1 @@ -580,8 +643,9 @@ genExpression (ExUnOp uo e1 (Just t)) = do TypeVoid -> undefined return $ A.LocalReference (toLLVMType t) (A.Name label) Dereference -> do - label <- case t of - (TypePtr _) -> addInstr $ A.Load False e1op Nothing 0 [] + let (A.LocalReference optype _) = e1op + label <- case optype of + (A.PointerType _ _) -> addInstr $ A.Load False e1op Nothing 0 [] _ -> throwError $ "Dereference '*' operator only defined on pointers" return $ A.LocalReference (toLLVMType t) (A.Name label) _ -> throwError $ "Unary operator " ++ pshow uo ++ " not implemented" diff --git a/nl/string_index.nl b/nl/string_index.nl new file mode 100644 index 0000000..27df14b --- /dev/null +++ b/nl/string_index.nl @@ -0,0 +1,12 @@ +extern func void(i32) putchar; + +i32 main() { + ptr(i8) s = "kaas"; + i32 i = 0; + while (*(s+i) != '\x00') { + putchar(*(s + i)); + i = i + 1; + } + putchar('\n'); + return 0; +} -- cgit v1.2.3