summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authortomsmeding <tom.smeding@gmail.com>2017-02-02 09:41:01 +0100
committertomsmeding <tom.smeding@gmail.com>2017-02-02 09:41:01 +0100
commit9e67d68574bf4b78451469d5e149cfd95b0ec9f6 (patch)
tree5a3a8d6f33297a6ade37b58cc79d6df499de8b8d
parent6416151b73b28db208c02b133b058e51b28ff2c8 (diff)
Pointer arithmetic now also for Minus
string_index.nl now doesn't compile anymore because I need to implement casts from i32 to u64
-rw-r--r--check.hs2
-rw-r--r--codegen.hs100
-rw-r--r--nl/string_index.nl7
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');