Merge branch 'master' into gfortran-testdevel/gfortran-test

1 files changed, 70 insertions, 265 deletions

diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc
index 7895ea8..4b296e4 100644
--- a/gcc/cobol/genutil.cc
+++ b/gcc/cobol/genutil.cc
@@ -27,6 +27,9 @@
  * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  */
+
+// cppcheck-suppress-file duplicateBreak
+
 #include "cobol-system.h"
 #include "coretypes.h"
 #include "tree.h"
@@ -749,9 +752,9 @@ get_binary_value( tree value,
     return;
     }
 
-  static tree pointer = gg_define_variable(UCHAR_P, "..gbv_pointer", vs_file_static);
-  static tree pend = gg_define_variable(UCHAR_P, "..gbv_pend", vs_file_static);
-
+  static tree pointer = gg_define_variable( UCHAR_P,
+                                            "..gbv_pointer",
+                                            vs_file_static);
   switch(field->type)
     {
     case FldLiteralN:
@@ -788,8 +791,9 @@ get_binary_value( tree value,
       // We need to check early on for HIGH-VALUE and LOW-VALUE
       // Pick up the byte
       tree digit = gg_get_indirect_reference(source_address, NULL_TREE);
-      IF( digit, eq_op, build_int_cst(UCHAR, 0xFF) )
+      IF( digit, eq_op, build_int_cst(UCHAR, DEGENERATE_HIGH_VALUE) )
         {
+        // We are dealing with HIGH-VALUE
         if( hilo )
           {
           gg_assign(hilo, integer_one_node);
@@ -800,12 +804,14 @@ get_binary_value( tree value,
                     build_int_cst_type( TREE_TYPE(rdigits),
                                         get_scaled_rdigits(field)));
           }
-        gg_assign(value, build_int_cst_type(TREE_TYPE(value), 0xFFFFFFFFFFFFFFFUL));
+        gg_assign(value, build_int_cst_type(TREE_TYPE(value),
+                                            0x7FFFFFFFFFFFFFFFUL));
         }
       ELSE
         {
-        IF( digit, eq_op, build_int_cst(UCHAR, 0x00) )
+        IF( digit, eq_op, build_int_cst(UCHAR, DEGENERATE_LOW_VALUE) )
           {
+          // We are dealing with LOW-VALUE 
           if( hilo )
             {
             gg_assign(hilo, integer_minus_one_node);
@@ -813,26 +819,25 @@ get_binary_value( tree value,
           }
         ELSE
           {
-          // Establish rdigits:
+          // We are dealing with an ordinary NumericDisplay value
+          gg_assign(pointer, source_address);
+
           if( rdigits )
             {
             gg_assign(rdigits,
-                    build_int_cst_type( TREE_TYPE(rdigits),
-                                        get_scaled_rdigits(field)));
+                      build_int_cst_type(TREE_TYPE(rdigits),
+                                         get_scaled_rdigits(field)));
             }
-          // Zero out the destination
-          gg_assign(value, gg_cast(TREE_TYPE(value), integer_zero_node));
-          // Pick up a pointer to the source bytes:
-
-          gg_assign(pointer, source_address);
-
-          // This is the we-are-done pointer
-          gg_assign(pend, gg_add( pointer,
-                                  get_any_capacity(field)));
-
-          static tree signbyte = gg_define_variable(UCHAR, "..gbv_signbyte", vs_file_static);
-
-          // The big decision is whether or not the variable is signed:
+          // This will be the 128-bit value of the character sequence
+          static tree val128 = gg_define_variable(INT128,
+                                                  "..gbv_val128",
+                                                  vs_file_static);
+          // This is a pointer to the sign byte
+          static tree signp = gg_define_variable(UCHAR_P,
+                                                  "..gbv_signp",
+                                                  vs_file_static);
+          // We need to figure out where the sign information, if any is to be
+          // found:
           if( field->attr & signable_e )
             {
             // The variable is signed
@@ -842,12 +847,17 @@ get_binary_value( tree value,
               if( field->attr & leading_e)
                 {
                 // The first byte is '+' or '-'
+                gg_assign(signp, source_address);
+                // Increment pointer to point to the first actual digit
                 gg_increment(pointer);
                 }
               else
                 {
                 // The final byte is '+' or '-'
-                gg_decrement(pend);
+                gg_assign(signp,
+                          gg_add(source_address,
+                                build_int_cst_type( SIZE_T,
+                                                    field->data.digits)));
                 }
               }
             else
@@ -855,219 +865,34 @@ get_binary_value( tree value,
               // The sign byte is internal
               if( field->attr & leading_e)
                 {
-                // The first byte has the sign bit:
-                gg_assign(signbyte,
-                          gg_get_indirect_reference(source_address, NULL_TREE));
-                if( internal_codeset_is_ebcdic() )
-                  {
-                  // We need to make sure the EBCDIC sign bit is ON, for positive
-                  gg_assign(gg_get_indirect_reference(source_address, NULL_TREE),
-                            gg_bitwise_or(signbyte,
-                                          build_int_cst_type( UCHAR,
-                                                              NUMERIC_DISPLAY_SIGN_BIT)));
-                  }
-                else
-                  {
-                  // We need to make sure the ascii sign bit is Off, for positive
-                  gg_assign(gg_get_indirect_reference(source_address, NULL_TREE),
-                            gg_bitwise_and( signbyte,
-                                            build_int_cst_type( UCHAR,
-                                                                ~NUMERIC_DISPLAY_SIGN_BIT)));
-                  }
+                // The first byte has the sign bit.
+                gg_assign(signp, source_address);
                 }
               else
                 {
-                // The final byte has the sign bit:
-                gg_assign(signbyte,
-                          gg_get_indirect_reference(source_address,
-                                                    build_int_cst_type(SIZE_T,
-                                                    field->data.capacity-1)));
-                if( internal_codeset_is_ebcdic() )
-                  {
-                  // We need to make sure the EBCDIC sign bit is ON, for positive
-                  gg_assign(gg_get_indirect_reference(source_address,
-                                                      build_int_cst_type( SIZE_T,
-                                                                          field->data.capacity-1)),
-                            gg_bitwise_or(signbyte,
-                                          build_int_cst_type( UCHAR,
-                                                              NUMERIC_DISPLAY_SIGN_BIT)));
-                  }
-                else
-                  {
-                  // We need to make sure the ASCII sign bit is Off, for positive
-                  gg_assign(gg_get_indirect_reference(source_address,
-                                                      build_int_cst_type( SIZE_T,
-                                                                          field->data.capacity-1)),
-                            gg_bitwise_and( signbyte,
-                                            build_int_cst_type( UCHAR,
-                                                                ~NUMERIC_DISPLAY_SIGN_BIT)));
-                  }
-                }
-              }
-            }
-          // We can now set up the byte-by-byte processing loop:
-          if( internal_codeset_is_ebcdic() )
-            {
-            // We are working in EBCDIC
-            WHILE( pointer, lt_op, pend )
-              {
-              // Pick up the byte
-              digit = gg_get_indirect_reference(pointer, NULL_TREE);
-              IF( digit, lt_op, build_int_cst_type(UCHAR, EBCDIC_ZERO) )
-                {
-                // break on a non-digit
-                gg_assign(pointer, pend);
+                // The final byte has the sign bit.
+                gg_assign(signp,
+                          gg_add(source_address,
+                                build_int_cst_type( SIZE_T,
+                                                    field->data.digits-1)));
                 }
-              ELSE
-                {
-                IF( digit, gt_op, build_int_cst_type(UCHAR, EBCDIC_NINE) )
-                  {
-                  // break on a non-digit
-                  gg_assign(pointer, pend);
-                  }
-                ELSE
-                  {
-                  // Whether ASCII or EBCDIC, the bottom four bits tell the tale:
-                  // Multiply our accumulator by ten:
-                  gg_assign(value, gg_multiply(value, build_int_cst_type(TREE_TYPE(value), 10)));
-                  // And add in the current digit
-                  gg_assign(value,
-                            gg_add(value, gg_cast(TREE_TYPE(value), gg_bitwise_and( digit,
-                                                                                    build_int_cst_type(UCHAR, 0x0F) ))));
-                  gg_increment(pointer);
-                  }
-                  ENDIF
-                }
-                ENDIF
               }
-              WEND
             }
           else
             {
-            // We are working in ASCII:
-            WHILE( pointer, lt_op, pend )
-              {
-              // Pick up the byte
-              digit = gg_get_indirect_reference(pointer, NULL_TREE);
-              // Whether ASCII or EBCDIC, the bottom four bits tell the tale:
-              // Multiply our accumulator by ten:
-              gg_assign(value, gg_multiply(value, build_int_cst_type(TREE_TYPE(value), 10)));
-              // And add in the current digit
-              gg_assign(value, gg_add(value, gg_cast(TREE_TYPE(value), gg_bitwise_and(digit, build_int_cst_type(UCHAR, 0x0F)))));
-              gg_increment(pointer);
-              }
-              WEND
+            // This value is unsigned, so just use the first location:
+            gg_assign(signp, source_address);
             }
 
-          // Value contains the binary value.  The last thing is to apply -- and
-          // undo -- the signable logic:
-
-          if( field->attr & signable_e )
-            {
-            // The variable is signed
-            if( field->attr & separate_e )
-              {
-              // The sign byte is separate
-              if( field->attr & leading_e)
-                {
-                // The first byte is '+' or '-'
-                if( internal_codeset_is_ebcdic() )
-                  {
-                  // We are operating in EBCDIC, so we look for a 96 (is minus sign)
-                  IF( gg_get_indirect_reference(source_address, NULL_TREE),
-                                                eq_op,
-                                                build_int_cst_type(UCHAR, 96) )
-                    {
-                    gg_assign(value, gg_negate(value));
-                    }
-                  ELSE
-                    ENDIF
-                  }
-                else
-                  {
-                  // We are operating in ASCII
-                  IF( gg_get_indirect_reference(source_address, NULL_TREE),
-                                                eq_op,
-                                                build_int_cst_type(UCHAR, '-') )
-                    {
-                    gg_assign(value, gg_negate(value));
-                    }
-                  ELSE
-                    ENDIF
-                  }
-                }
-              else
-                {
-                // The final byte is '+' or '-'
-                if( internal_codeset_is_ebcdic() )
-                  {
-                  // We are operating in EBCDIC, so we look for a 96 (is minus sign)
-                  IF( gg_get_indirect_reference(source_address, build_int_cst_type(SIZE_T, field->data.capacity-1)),
-                                                eq_op,
-                                                build_int_cst_type(UCHAR, 96) )
-                    {
-                    gg_assign(value, gg_negate(value));
-                    }
-                  ELSE
-                    ENDIF
-                  }
-                else
-                  {
-                  // We are operating in ASCII
-                  IF( gg_get_indirect_reference(source_address, build_int_cst_type(SIZE_T, field->data.capacity-1)),
-                                                eq_op,
-                                                build_int_cst_type(UCHAR, '-') )
-                    {
-                    gg_assign(value, gg_negate(value));
-                    }
-                  ELSE
-                    ENDIF
-                  }
-                }
-              }
-            else
-              {
-              // The sign byte is internal.  Check the sign bit
-              if(internal_codeset_is_ebcdic())
-                {
-                IF( gg_bitwise_and( signbyte,
-                                          build_int_cst_type( UCHAR,
-                                                              NUMERIC_DISPLAY_SIGN_BIT)), eq_op, build_int_cst_type(UCHAR, 0) )
-                  {
-                  // The EBCDIC sign bit was OFF, so negate the result
-                  gg_assign(value, gg_negate(value));
-                  }
-                ELSE
-                  ENDIF
-                }
-              else
-                {
-                IF( gg_bitwise_and( signbyte,
-                                          build_int_cst_type( UCHAR,
-                                                              NUMERIC_DISPLAY_SIGN_BIT)), ne_op, build_int_cst_type(UCHAR, 0) )
-                  {
-                  // The ASCII sign bit was on, so negate the result
-                  gg_assign(value, gg_negate(value));
-                  }
-                ELSE
-                  ENDIF
-                }
-              // It's time to put back the original data:
-              if( field->attr & leading_e)
-                {
-                // The first byte has the sign bit:
-                gg_assign(gg_get_indirect_reference(source_address, NULL_TREE),
-                          signbyte);
-                }
-              else
-                {
-                // The final byte has the sign bit:
-                gg_assign(gg_get_indirect_reference(source_address,
-                                                    build_int_cst_type(SIZE_T, field->data.capacity-1)),
-                          signbyte);
-                }
-              }
-            }
+          gg_assign(val128,
+                    gg_call_expr( INT128,
+                                  "__gg__numeric_display_to_binary",
+                                  signp,
+                                  pointer,
+                                  build_int_cst_type(INT, field->data.digits),
+                                  NULL_TREE));
+          // Assign the value we got from the string to our "return" value:
+          gg_assign(value, gg_cast(TREE_TYPE(value), val128));
           }
         ENDIF
         }
@@ -1116,7 +941,9 @@ get_binary_value( tree value,
                                                     vs_file_static);
         if( field->attr & signable_e )
           {
-          IF( gg_array_value(gg_cast(build_pointer_type(SCHAR), source)), lt_op, gg_cast(SCHAR, integer_zero_node) )
+          IF( gg_array_value(gg_cast(build_pointer_type(SCHAR), source)),
+              lt_op, 
+              gg_cast(SCHAR, integer_zero_node) )
             {
             gg_assign(extension, build_int_cst_type(UCHAR, 0xFF));
             }
@@ -1199,45 +1026,23 @@ get_binary_value( tree value,
 
     case FldPacked:
       {
-      // Zero out the destination:
-      gg_assign(value, gg_cast(TREE_TYPE(value), integer_zero_node));
-      gg_assign(pointer, get_data_address(field, field_offset));
-      gg_assign(pend,
-                gg_add(pointer,
-                       build_int_cst_type(SIZE_T, field->data.capacity-1)));
-
-      // Convert all but the last byte of the packed decimal sequence
-      WHILE( pointer, lt_op, pend )
-        {
-        // Convert the first nybble
-        gg_assign(value, gg_multiply(value, build_int_cst_type(TREE_TYPE(value), 10)));
-        gg_assign(value, gg_add(value, gg_cast(TREE_TYPE(value), gg_rshift(gg_get_indirect_reference(pointer, NULL_TREE), build_int_cst(UINT, 4)))));
-
-        // Convert the second nybble
-        gg_assign(value, gg_multiply(value, build_int_cst_type(TREE_TYPE(value), 10)));
-        gg_assign(value, gg_add(value, gg_cast(TREE_TYPE(value), gg_bitwise_and(gg_get_indirect_reference(pointer, NULL_TREE), build_int_cst_type(UCHAR, 0xF)))));
-        gg_increment(pointer);
-        }
-        WEND
-
-      // This is the final byte:
-      gg_assign(value, gg_multiply(value, build_int_cst_type(TREE_TYPE(value), 10)));
-      gg_assign(value, gg_add(value, gg_cast(TREE_TYPE(value), gg_rshift(gg_get_indirect_reference(pointer, NULL_TREE), build_int_cst(UINT, 4)))));
-
-      IF( gg_bitwise_and(gg_get_indirect_reference(pointer, NULL_TREE), build_int_cst_type(UCHAR, 0xF)), eq_op, build_int_cst_type(UCHAR, 0x0D) )
-        {
-        gg_assign(value, gg_negate(value));
-        }
-      ELSE
+      if( rdigits )
         {
-        IF( gg_bitwise_and(gg_get_indirect_reference(pointer, NULL_TREE), build_int_cst_type(UCHAR, 0xF)), eq_op, build_int_cst_type(UCHAR, 0x0B) )
-          {
-          gg_assign(value, gg_negate(value));
-          }
-        ELSE
-          ENDIF
+        gg_assign(rdigits,
+                  build_int_cst_type( TREE_TYPE(rdigits),
+                                      get_scaled_rdigits(field)));
         }
-        ENDIF
+      tree dest_type = TREE_TYPE(value);
+        
+      gg_assign(value, 
+                gg_cast(dest_type,
+                        gg_call_expr(INT128,
+                                    "__gg__packed_to_binary",
+                                    get_data_address( field,
+                                                      field_offset),
+                                    build_int_cst_type(INT,
+                                                      field->data.capacity),
+                                    NULL_TREE)));
       break;
       }
 
@@ -1267,7 +1072,7 @@ get_binary_value( tree value,
                             cbl_field_type_str(field->type) );
       cbl_internal_error("%s", err);
       abort();
-      // break; // break not needed after abort();
+      break;
       }
     }