started sema for bit ops intrinsics

7 files changed, 137 insertions, 0 deletions

diff --git a/include/flang/AST/IntrinsicFunctions.def b/include/flang/AST/IntrinsicFunctions.def
index 3438aa6ae7..111545287c 100644
--- a/include/flang/AST/IntrinsicFunctions.def
+++ b/include/flang/AST/IntrinsicFunctions.def
@@ -19,6 +19,10 @@
 #define NUM_ARGS_2
 #endif
 
+#ifndef NUM_ARGS_3
+#define NUM_ARGS_3
+#endif
+
 #ifndef NUM_ARGS_1_OR_2
 #define NUM_ARGS_1_OR_2
 #endif
@@ -260,6 +264,23 @@ INTRINSIC_FUNCTION(BIT_SIZE, BIT_SIZE, NUM_ARGS_1, FUNNOTF77)
 
 INTRINSIC_GROUP(INQUIRY, KIND, BIT_SIZE)
 
+//
+// Bit operations group
+//
+
+INTRINSIC_FUNCTION(BTEST, BTEST, NUM_ARGS_2, FUNNOTF77)
+INTRINSIC_FUNCTION(IAND, IAND, NUM_ARGS_2, FUNNOTF77)
+INTRINSIC_FUNCTION(IBCLR, IBCLR, NUM_ARGS_2, FUNNOTF77)
+INTRINSIC_FUNCTION(IBITS, IBITS, NUM_ARGS_3, FUNNOTF77)
+INTRINSIC_FUNCTION(IBSET, IBSET, NUM_ARGS_2, FUNNOTF77)
+INTRINSIC_FUNCTION(IEOR, IEOR, NUM_ARGS_2, FUNNOTF77)
+INTRINSIC_FUNCTION(IOR, IOR, NUM_ARGS_2, FUNNOTF77)
+INTRINSIC_FUNCTION(ISHFT, ISHFT, NUM_ARGS_2, FUNNOTF77)
+INTRINSIC_FUNCTION(ISHFTC, ISHFTC, NUM_ARGS_2, FUNNOTF77)
+INTRINSIC_FUNCTION(NOT, NOT, NUM_ARGS_1, FUNNOTF77)
+
+INTRINSIC_GROUP(BITOPS, BTEST, NOT)
+
 #undef INTRINSIC_GROUP
 
 #undef INTRINSIC_FUNCTION_ADD_D_PREFIX
diff --git a/include/flang/AST/IntrinsicFunctions.h b/include/flang/AST/IntrinsicFunctions.h
index 885a862135..018f5fbb38 100644
--- a/include/flang/AST/IntrinsicFunctions.h
+++ b/include/flang/AST/IntrinsicFunctions.h
@@ -24,6 +24,7 @@ namespace intrinsic {
 enum FunctionArgumentCountKind {
   ArgumentCount1,
   ArgumentCount2,
+  ArgumentCount3,
   ArgumentCount1or2,
   ArgumentCount2orMore
 };
diff --git a/include/flang/Sema/Sema.h b/include/flang/Sema/Sema.h
index 4d664cc52a..0eed11c5c4 100644
--- a/include/flang/Sema/Sema.h
+++ b/include/flang/Sema/Sema.h
@@ -833,6 +833,12 @@ public:
                                  ArrayRef<Expr*> Args,
                                  QualType &ReturnType);
 
+  /// Returns false if the call to a function from the
+  /// bit operations group is valid.
+  bool CheckIntrinsicBitFunc(intrinsic::FunctionKind Function,
+                             ArrayRef<Expr*> Args,
+                             QualType &ReturnType);
+
   /// Reports an incompatible argument error and returns true.
   bool DiagnoseIncompatiblePassing(const Expr *E, QualType T,
                                    bool AllowArrays,
diff --git a/lib/AST/IntrinsicFunctions.cpp b/lib/AST/IntrinsicFunctions.cpp
index 5dff81654d..836ea1c0db 100644
--- a/lib/AST/IntrinsicFunctions.cpp
+++ b/lib/AST/IntrinsicFunctions.cpp
@@ -63,6 +63,7 @@ static void InitFunctionGroups() {
 static FunctionArgumentCountKind FunctionArgCounts[] = {
   #define NUM_ARGS_1 ArgumentCount1
   #define NUM_ARGS_2 ArgumentCount2
+  #define NUM_ARGS_3 ArgumentCount3
   #define NUM_ARGS_1_OR_2 ArgumentCount1or2
   #define NUM_ARGS_2_OR_MORE ArgumentCount2orMore
   #define INTRINSIC_FUNCTION(NAME, GENERICNAME, NUMARGS, VERSION) NUMARGS,
diff --git a/lib/Sema/SemaExpr.cpp b/lib/Sema/SemaExpr.cpp
index 84a322d17a..b7b6a80ea2 100644
--- a/lib/Sema/SemaExpr.cpp
+++ b/lib/Sema/SemaExpr.cpp
@@ -841,6 +841,10 @@ ExprResult Sema::ActOnIntrinsicFunctionCallExpr(ASTContext &C, SourceLocation Lo
     CheckIntrinsicInquiryFunc(Function, Arguments, ReturnType);
     break;
 
+  case GROUP_BITOPS:
+    CheckIntrinsicBitFunc(Function, Arguments, ReturnType);
+    break;
+
   default:
     llvm_unreachable("invalid intrinsic function");
   }
diff --git a/lib/Sema/SemaIntrinsic.cpp b/lib/Sema/SemaIntrinsic.cpp
index 71245decb4..c46612457e 100644
--- a/lib/Sema/SemaIntrinsic.cpp
+++ b/lib/Sema/SemaIntrinsic.cpp
@@ -42,6 +42,13 @@ bool Sema::CheckIntrinsicCallArgumentCount(intrinsic::FunctionKind Function,
     else if(Args.size() > 2)
       ArgCountDiag = diag::err_typecheck_call_too_many_args;
     break;
+  case ArgumentCount3:
+    ExpectedCount = 3;
+    if(Args.size() < 3)
+      ArgCountDiag = diag::err_typecheck_call_too_few_args;
+    else if(Args.size() > 3)
+      ArgCountDiag = diag::err_typecheck_call_too_many_args;
+    break;
   case ArgumentCount1or2:
     ExpectedString = "1 or 2";
     if(Args.size() < 1)
@@ -520,4 +527,60 @@ bool Sema::CheckIntrinsicInquiryFunc(intrinsic::FunctionKind Function,
   return false;
 }
 
+// FIXME: apply constant arguments constraints (e.g. 0 .. BIT_SIZE range)
+bool Sema::CheckIntrinsicBitFunc(intrinsic::FunctionKind Function,
+                                 ArrayRef<Expr*> Args,
+                                 QualType &ReturnType) {
+  if(Function == NOT) {
+    CheckIntegerArgument(Args[0], true);
+    ReturnType = Args[0]->getType();
+    return false;
+  }
+
+  auto FirstArg = Args[0];
+  auto SecondArg = Args[1];
+  if(CheckIntegerArgument(FirstArg,true)) {
+    ReturnType = Context.IntegerTy;
+    return true;
+  }
+
+  switch(Function) {
+  case BTEST:
+    CheckIntegerArgument(SecondArg,true);
+    CheckArrayArgumentsDimensionCompability(FirstArg, SecondArg, "i", "pos");
+    ReturnType = GetBinaryReturnType(FirstArg, SecondArg, Context.LogicalTy);
+    break;
+  case IBCLR:
+  case IBSET:
+    CheckIntegerArgument(SecondArg,true);
+    CheckArrayArgumentsDimensionCompability(FirstArg, SecondArg, "i", "pos");
+    ReturnType = FirstArg->getType();
+    break;
+  case IBITS: {
+    auto ThirdArg = Args[2];
+    CheckIntegerArgument(SecondArg, true);
+    CheckArrayArgumentsDimensionCompability(FirstArg, SecondArg, "i", "pos");
+    CheckIntegerArgument(ThirdArg, true);
+    CheckArrayArgumentsDimensionCompability(FirstArg, ThirdArg, "i", "len");
+    ReturnType = FirstArg->getType();
+    break;
+  }
+  case ISHFT:
+  case ISHFTC: // FIXME: optional size
+    CheckIntegerArgument(SecondArg, true);
+    CheckArrayArgumentsDimensionCompability(FirstArg, SecondArg, "i", "shift");
+    ReturnType = FirstArg->getType();
+    break;
+  case IAND:
+  case IEOR:
+  case IOR:
+    CheckArgumentsTypeCompability(FirstArg, SecondArg, "i", "j", true);
+    CheckArrayArgumentsDimensionCompability(FirstArg, SecondArg, "i", "j");
+    ReturnType = FirstArg->getType();
+    break;
+  }
+
+  return false;
+}
+
 } // end namespace flang
diff --git a/test/Sema/Intrinsics/bitops.f95 b/test/Sema/Intrinsics/bitops.f95
new file mode 100644
index 0000000000..43fd36ae81
--- /dev/null
+++ b/test/Sema/Intrinsics/bitops.f95
@@ -0,0 +1,41 @@
+! RUN: %flang -fsyntax-only -verify < %s
+! RUN: %flang -fsyntax-only -verify -ast-print %s 2>&1 | %file_check %s
+
+PROGRAM test
+  intrinsic iand, ieor, ior
+  intrinsic not
+  intrinsic btest, ibclr, ibset, ibits, ishft, ishftc
+
+  integer i, i_arr(10), i_mat(4,4)
+  integer(8) i64, i64_arr(10)
+  logical l, l_arr(10)
+
+  ! FIXME:
+  !i = not(i)
+  !i = not(2.0)
+  !i = not(i64)
+
+  i = iand(i,1)
+  i = ior(i,i) ! CHECK: i = ior(i, i)
+  i = ieor(2,i)
+  i = iand(i64,i) ! expected-error {{conflicting types in arguments 'i' and 'j' ('integer (Kind=8)' and 'integer')}}
+  i = iand(i,2.0) ! expected-error {{conflicting types in arguments 'i' and 'j' ('integer' and 'real')}}
+  i_arr = iand(i_arr,7)
+  i64 = ior(i64,int(4,8))
+  i = ieor(2.0,2.0) ! expected-error {{passing 'real' to parameter of incompatible type 'integer'}}
+
+  l = btest(1,2)
+  i = ibclr(i,2)
+  i = ibset(i,2)
+  i = ibits(i,2,2)
+  l = btest(i64,2)
+  i64 = ibset(i64,2)
+  i64 = ibclr(i64,i)
+  i = ibset(3,2.0) ! expected-error {{passing 'real' to parameter of incompatible type 'integer'}}
+  l_arr = btest(i_arr, i_mat) ! expected-error {{conflicting shapes in arguments 'i' and 'pos' (1 dimension and 2 dimensions)}}
+
+  i = ishft(i,-2)
+  i = ishft(i,4)
+  i = ishftc(i,i)
+
+end