From 9e67d68574bf4b78451469d5e149cfd95b0ec9f6 Mon Sep 17 00:00:00 2001 From: tomsmeding Date: Thu, 2 Feb 2017 09:41:01 +0100 Subject: Pointer arithmetic now also for Minus string_index.nl now doesn't compile anymore because I need to implement casts from i32 to u64 --- check.hs | 2 ++ codegen.hs | 100 +++++++++++++++++++++++++++++------------------------ nl/string_index.nl | 7 ++-- 3 files changed, 62 insertions(+), 47 deletions(-) diff --git a/check.hs b/check.hs index 65c1470..b30ff25 100644 --- a/check.hs +++ b/check.hs @@ -215,7 +215,9 @@ 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 t@(TypePtr _) (TypeUInt _) | bo `elem` [Plus, Minus] = Just t resultTypeBO bo (TypeInt _) t@(TypePtr _) | bo `elem` [Plus, Minus] = Just t +resultTypeBO bo (TypeUInt _) t@(TypePtr _) | bo `elem` [Plus, Minus] = Just t resultTypeBO _ (TypePtr _) _ = Nothing resultTypeBO _ _ (TypePtr _) = Nothing diff --git a/codegen.hs b/codegen.hs index afa600c..93b8c1f 100644 --- a/codegen.hs +++ b/codegen.hs @@ -388,55 +388,65 @@ genSingle (StWhile cexpr st) following = do setTerminator $ A.CondBr coper' (A.Name stbb) (A.Name following) [] return cbb +pointerArith :: Expression -- Expression that produces the pointer + -> Expression -- Expression that produces the integer to add + -> (Int -> Type) -- TypeInt or TypeUInt, the type of the integer + -> CGMonad A.Operand -- The resulting pointer +pointerArith eptr eint inttypeconstr = do + let inttype = inttypeconstr 64 + ptrtype@(TypePtr subt) = fromJust (exTypeOf eptr) + ptrop <- genExprArgument eptr + intop <- genExprArgument eint >>= flip castOperand inttype + ptrlabel <- addInstr $ A.PtrToInt ptrop (toLLVMType (TypeUInt 64)) [] + intlabel <- addInstr $ A.Mul False False intop + (A.ConstantOperand (A.C.Int 64 (fromIntegral (sizeOf subt)))) [] + add <- addInstr $ A.Add False False (A.LocalReference (toLLVMType ptrtype) (A.Name ptrlabel)) + (A.LocalReference (toLLVMType inttype) (A.Name intlabel)) [] + res <- addInstr $ A.IntToPtr (A.LocalReference (toLLVMType (TypeUInt 64)) (A.Name add)) + (toLLVMType ptrtype) [] + return $ A.LocalReference (toLLVMType ptrtype) (A.Name res) + 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 -> - let pointerArith eptr eint inttypeconstr = do - let inttype = inttypeconstr 64 - ptrtype@(TypePtr subt) = fromJust (exTypeOf eptr) - ptrop <- genExprArgument eptr - intop <- genExprArgument eint >>= flip castOperand inttype - ptrlabel <- addInstr $ A.PtrToInt ptrop (toLLVMType (TypeUInt 64)) [] - intlabel <- addInstr $ A.Mul False False intop - (A.ConstantOperand (A.C.Int 64 (fromIntegral (sizeOf subt)))) [] - add <- addInstr $ A.Add False False (A.LocalReference (toLLVMType ptrtype) (A.Name ptrlabel)) - (A.LocalReference (toLLVMType inttype) (A.Name intlabel)) [] - res <- addInstr $ A.IntToPtr (A.LocalReference (toLLVMType (TypeUInt 64)) (A.Name add)) - (toLLVMType ptrtype) [] - return $ A.LocalReference (toLLVMType ptrtype) (A.Name res) - in case (fromJust (exTypeOf e1), fromJust (exTypeOf e2)) of - (TypePtr _, TypeInt _) -> pointerArith e1 e2 TypeInt - (TypePtr _, TypeUInt _) -> pointerArith e1 e2 TypeUInt - (TypeInt _, TypePtr _) -> pointerArith e2 e1 TypeInt - (TypeUInt _, TypePtr _) -> pointerArith e2 e1 TypeUInt - _ -> 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 - label <- case t of - (TypeInt _) -> addInstr $ A.Sub False False e1op e2op [] - (TypeUInt _) -> addInstr $ A.Sub False False e1op e2op [] - TypeFloat -> addInstr $ A.FSub A.NoFastMathFlags e1op e2op [] - TypeDouble -> addInstr $ A.FSub A.NoFastMathFlags e1op e2op [] - (TypePtr _) -> throwError $ "Minus '-' operator not defined on pointers" - (TypeFunc _ _) -> throwError $ "Minus '-' 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 + (TypePtr _, TypeInt _) -> pointerArith e1 e2 TypeInt + (TypePtr _, TypeUInt _) -> pointerArith e1 e2 TypeUInt + (TypeInt _, TypePtr _) -> pointerArith e2 e1 TypeInt + (TypeUInt _, TypePtr _) -> pointerArith e2 e1 TypeUInt + _ -> 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 _) -> undefined -- Handled above + (TypeFunc _ _) -> throwError $ "Plus '+' operator not defined on function pointers" + (TypeName _) -> undefined + TypeVoid -> undefined + return $ A.LocalReference (toLLVMType t) (A.Name label) + Minus -> let exneg e ty = ExUnOp Negate e (Just ty) + in case (fromJust (exTypeOf e1), fromJust (exTypeOf e2)) of + (TypePtr _, it@(TypeInt _)) -> pointerArith e1 (exneg e2 it) TypeInt + (TypePtr _, it@(TypeUInt _)) -> pointerArith e1 (exneg e2 it) TypeUInt + (it@(TypeInt _), TypePtr _) -> pointerArith (exneg e2 it) e1 TypeInt + (it@(TypeUInt _), TypePtr _) -> pointerArith (exneg e2 it) e1 TypeUInt + _ -> do + e1op <- genExprArgument e1 >>= flip castOperand t + e2op <- genExprArgument e2 >>= flip castOperand t + label <- case t of + (TypeInt _) -> addInstr $ A.Sub False False e1op e2op [] + (TypeUInt _) -> addInstr $ A.Sub False False e1op e2op [] + TypeFloat -> addInstr $ A.FSub A.NoFastMathFlags e1op e2op [] + TypeDouble -> addInstr $ A.FSub A.NoFastMathFlags e1op e2op [] + (TypePtr _) -> undefined -- Handled above + (TypeFunc _ _) -> throwError $ "Minus '-' operator not defined on function pointers" + (TypeName _) -> undefined + TypeVoid -> undefined + return $ A.LocalReference (toLLVMType t) (A.Name label) Times -> do e1op <- genExprArgument e1 >>= flip castOperand t e2op <- genExprArgument e2 >>= flip castOperand t diff --git a/nl/string_index.nl b/nl/string_index.nl index 27df14b..deb4188 100644 --- a/nl/string_index.nl +++ b/nl/string_index.nl @@ -1,10 +1,13 @@ extern func void(i32) putchar; +extern func u64(ptr(i8)) strlen; i32 main() { ptr(i8) s = "kaas"; + ptr(i8) orig = s; + s = s + strlen(s) - 1; i32 i = 0; - while (*(s+i) != '\x00') { - putchar(*(s + i)); + while (i < strlen(orig)) { + putchar(*(s - i)); i = i + 1; } putchar('\n'); -- cgit v1.2.3