Merge pull request lfortran#4491 from parth121101/ishftc_opt

feat: add optional argument for ishftc intrinsic
KGB99 · Jul 19, 2024 · 6b3021a · 6b3021a
2 parents 8995adf + 8ff6f5f
commit 6b3021a
Show file tree

Hide file tree

Showing 8 changed files with 85 additions and 10 deletions.
diff --git a/integration_tests/intrinsics_163.f90 b/integration_tests/intrinsics_163.f90
@@ -132,6 +132,38 @@ program intrinsics_163
     res_8 = ishftc(-9223372036854775807_8, -63_8)
     print *, res_8
     if (res_8 /= 3) error stop
+
+    res_1 = ishftc(10_1, 2_1, 4_1)
+    print *, res_1
+    if (res_1 /= 10) error stop
+
+    res_1 = ishftc(10_1, -2_1, 7_1)
+    print *, res_1
+    if (res_1 /= 66) error stop
 
+    res_2 = ishftc(10_2, 2_2, 6_2)
+    print *, res_2
+    if (res_2 /= 40) error stop
 
+    res_2 = ishftc(10_2, -2_2, 11_2)
+    print *, res_2
+    if (res_2 /= 1026) error stop
+
+    res_4 = ishftc(10_4, 2_4, 13_4)
+    print *, res_4
+    if (res_4 /= 40) error stop
+
+    res_4 = ishftc(10_4, -2_4, 31_4)
+    print *, res_4
+    if (res_4 /= 1073741826) error stop
+
+
+    res_8 = ishftc(10_8, 2_8, 62_8)
+    print *, res_8
+    if (res_8 /= 40_8) error stop
+
+    res_8 = ishftc(10_8, -2_8, 59_8)
+    print *, res_8
+    if (res_8 /= 288230376151711746_8) error stop
+
  end program
diff --git a/src/lfortran/semantics/ast_common_visitor.h b/src/lfortran/semantics/ast_common_visitor.h
@@ -840,7 +840,7 @@ class CommonVisitor : public AST::BaseVisitor<Derived> {
         {"selected_real_kind", {IntrinsicSignature({"p", "r", "radix"}, 0, 3)}},
         {"nearest", {IntrinsicSignature({"x", "s"}, 2, 2)}},
         {"compiler_version", {IntrinsicSignature({}, 0, 0)}},
-        {"ishftc", {IntrinsicSignature({"i", "shift"}, 2, 2)}},
+        {"ishftc", {IntrinsicSignature({"i", "shift", "size"}, 2, 3)}},
         {"ichar", {IntrinsicSignature({"C", "kind"}, 1, 2)}},
         {"char", {IntrinsicSignature({"I", "kind"}, 1, 2)}},
         {"achar", {IntrinsicSignature({"I", "kind"}, 1, 2)}},
@@ -5350,9 +5350,9 @@ class CommonVisitor : public AST::BaseVisitor<Derived> {
     }
 
     void fill_optional_args(std::string intrinsic_name, Vec<ASR::expr_t*> &args, const Location &loc) {
+        ASR::ttype_t *int_type = ASRUtils::TYPE(
+                    ASR::make_Integer_t(al, loc, 4));
         if (intrinsic_name == "selected_real_kind") {
-            ASR::ttype_t *int_type = ASRUtils::TYPE(
-                    ASR::make_Integer_t(al, loc, compiler_options.po.default_integer_kind));
             ASR::expr_t* zero = ASRUtils::EXPR(
                 ASR::make_IntegerConstant_t(al, loc, 0,
                                                 int_type));
@@ -5371,8 +5371,6 @@ class CommonVisitor : public AST::BaseVisitor<Derived> {
         } else if (intrinsic_name == "verify" || intrinsic_name == "index" || intrinsic_name == "scan") {
             ASR::ttype_t *bool_type = ASRUtils::TYPE(
                     ASR::make_Logical_t(al, loc, 4));
-            ASR::ttype_t *int_type = ASRUtils::TYPE(
-                    ASR::make_Integer_t(al, loc, 4));
             ASR::expr_t* f = ASRUtils::EXPR(
                 ASR::make_LogicalConstant_t(al, loc, false, bool_type));
             ASR::expr_t* four = ASRUtils::EXPR(
@@ -5392,6 +5390,15 @@ class CommonVisitor : public AST::BaseVisitor<Derived> {
                     args.p[1] = val;
                 }   
             }
+        } else if (intrinsic_name == "ishftc"){
+            if(args[2] == nullptr){
+                int value;
+                int kind = ASRUtils::extract_kind_from_ttype_t(ASRUtils::expr_type(args[0]));
+                value = kind*8;
+                ASR::expr_t* val = ASRUtils::EXPR(
+                    ASR::make_IntegerConstant_t(al, loc, value, int_type));
+                args.p[2] = val;
+            }
         }
     }
 

diff --git a/src/libasr/intrinsic_func_registry_util_gen.py b/src/libasr/intrinsic_func_registry_util_gen.py
@@ -720,7 +720,7 @@
     ], 
     "Ishftc": [
         {
-            "args": [("int", "int")],
+            "args": [("int", "int", "int")],
             "ret_type_arg_idx": 0
         },
     ],

diff --git a/src/libasr/pass/intrinsic_functions.h b/src/libasr/pass/intrinsic_functions.h
@@ -3613,14 +3613,24 @@ namespace Ishftc {
         uint64_t val = (uint64_t)ASR::down_cast<ASR::IntegerConstant_t>(args[0])->m_n;
         int64_t shift_signed = ASR::down_cast<ASR::IntegerConstant_t>(args[1])->m_n;
         int kind = ASRUtils::extract_kind_from_ttype_t(ASR::down_cast<ASR::IntegerConstant_t>(args[0])->m_type);
+        uint32_t bits_size = (uint32_t)ASR::down_cast<ASR::IntegerConstant_t>(args[2])->m_n;
+        uint32_t max_bits_size = 64;
+        if (bits_size > (uint32_t)(8 * kind)) {
+            append_error(diag, "The SIZE argument must be greater than zero and less than or equal to BIT_SIZE('I')", loc);
+            return nullptr;
+        }
+        if(std::abs(shift_signed) > bits_size){
+            append_error(diag, "The SHIFT argument must be less than or equal to the of SIZE argument", loc);
+            return nullptr;
+        }
         bool negative_shift = (shift_signed < 0);
         uint32_t shift = abs(shift_signed);
-        uint32_t bits_size = 8u * (uint32_t)kind;
-        uint32_t max_bits_size = 64;
-        if (bits_size < shift) {
-            append_error(diag, "The absolute value of SHIFT argument must be less than or equal to BIT_SIZE('I')", loc);
+
+        if (shift > max_bits_size) {
+            append_error(diag, "The absolute value of SHIFT argument must be less than SIZE", loc);
             return nullptr;
         }
+
         val = cutoff_extra_bits(val, bits_size, max_bits_size);
         uint64_t result;
         if (negative_shift) {
@@ -3636,6 +3646,7 @@ namespace Ishftc {
             Vec<ASR::call_arg_t>& /*new_args*/, int64_t /*overload_id*/) {
         // TO DO: Implement the runtime function for ISHFTC
         throw LCompilersException("Runtime implementation for `ishftc` is not yet implemented.");
+        return nullptr;
     }
 
 } // namespace Ishftc

diff --git a/tests/errors/ishftc_size.f90 b/tests/errors/ishftc_size.f90
@@ -0,0 +1,3 @@
+program ishftc_size
+    print *, ishftc(10, 6, 4)
+end program 
diff --git a/tests/reference/asr-ishftc_size-1254b50.json b/tests/reference/asr-ishftc_size-1254b50.json
@@ -0,0 +1,13 @@
+{
+    "basename": "asr-ishftc_size-1254b50",
+    "cmd": "lfortran --show-asr --no-color {infile} -o {outfile}",
+    "infile": "tests/errors/ishftc_size.f90",
+    "infile_hash": "5765a2202b476e6d0522df41163ba488707e3b506dd4870c1b0eb7b4",
+    "outfile": null,
+    "outfile_hash": null,
+    "stdout": null,
+    "stdout_hash": null,
+    "stderr": "asr-ishftc_size-1254b50.stderr",
+    "stderr_hash": "9ce5eb1db3c8a9c92204d2bd13f6466f06e862c1b75c29dfe981a7d2",
+    "returncode": 2
+}
diff --git a/tests/reference/asr-ishftc_size-1254b50.stderr b/tests/reference/asr-ishftc_size-1254b50.stderr
@@ -0,0 +1,5 @@
+semantic error: The SHIFT argument must be less than or equal to the of SIZE argument
+ --> tests/errors/ishftc_size.f90:2:14
+  |
+2 |     print *, ishftc(10, 6, 4)
+  |              ^^^^^^^^^^^^^^^^ 
diff --git a/tests/tests.toml b/tests/tests.toml
@@ -3986,6 +3986,10 @@ asr = true
 filename = "errors/sqrt_neg.f90"
 asr = true
 
+[[test]]
+filename = "errors/ishftc_size.f90"
+asr = true
+
 [[test]]
 filename = "errors/merge_bits_comp.f90"
 asr = true