cobol: Implement and use faster __gg__packed_to_binary() routine.

The new routine uses table lookups more effectively, and avoids __int128
arithmetic until necessary.

gcc/cobol/ChangeLog:

	* genutil.cc (get_binary_value): Use the new routine.

libgcobol/ChangeLog:

	* libgcobol.cc (get_binary_value_local): Use the new routine.
	* stringbin.cc (int_from_string): Removed.
	(__gg__packed_to_binary): Implement new routine.
	* stringbin.h (__gg__packed_to_binary): Likewise.

4 files changed, 134 insertions, 203 deletions

diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc
index e131d15..3682b10 100644
--- a/gcc/cobol/genutil.cc
+++ b/gcc/cobol/genutil.cc
@@ -755,10 +755,6 @@ get_binary_value( tree value,
   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);
-
   switch(field->type)
     {
     case FldLiteralN:
@@ -945,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));
             }
@@ -1028,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;
       }
 
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index f41434f..4276253 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -2149,52 +2149,9 @@ get_binary_value_local(  int                 *rdigits,
 
     case FldPacked:
       {
-      static const unsigned char dp2bin[160] =
-        {
-        // This may not be the weirdest table I've ever created, but it is
-        // certainly a contender.  Given the packed decimal byte 0x23, it
-        // returns the equivalent decimal value of 23.
-        00, 01, 02, 03, 04, 05, 06, 07,  8,  9, 0, 0, 0, 0, 0, 0, // 0x00
-        10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 0, 0, 0, 0, 0, 0, // 0x10
-        20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 0, 0, 0, 0, 0, 0, // 0x20
-        30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 0, 0, 0, 0, 0, 0, // 0x30
-        40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 0, 0, 0, 0, 0, 0, // 0x40
-        50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 0, 0, 0, 0, 0, 0, // 0x50
-        60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 0, 0, 0, 0, 0, 0, // 0x60
-        70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 0, 0, 0, 0, 0, 0, // 0x70
-        80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 0, 0, 0, 0, 0, 0, // 0x80
-        90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 0, 0, 0, 0, 0, 0, // 0x90
-        };
-
-      if( resolved_var->attr & packed_no_sign_e )
-        {
-        // This is packed decimal without a sign nybble
-        retval = 0;
-        for(size_t i=0; i<resolved_var->capacity; i++)
-          {
-          retval *= 100;
-          retval += dp2bin[resolved_location[i]];
-          }
-        }
-      else
-        {
-        // This is packed decimal with a final sign nybble
-        retval = 0;
-        size_t imputed_length = (resolved_var->digits + 2)/2;
-        for(size_t i=0; i<imputed_length-1; i++)
-          {
-          retval *= 100;
-          retval += dp2bin[resolved_location[i]];
-          }
-        retval *= 10;
-        retval += resolved_location[imputed_length-1]>>4;
-        if(    (resolved_location[imputed_length-1]&0x0F) == 0x0D
-            || (resolved_location[imputed_length-1]&0x0F) == 0x0B )
-          {
-          retval = -retval;
-          }
-        }
-     *rdigits = resolved_var->rdigits;
+      *rdigits = resolved_var->rdigits;
+      retval = __gg__packed_to_binary(resolved_location,
+                                      resolved_length);
       break;
       }
     }
diff --git a/libgcobol/stringbin.cc b/libgcobol/stringbin.cc
index 2e88cdf..63976cf 100644
--- a/libgcobol/stringbin.cc
+++ b/libgcobol/stringbin.cc
@@ -476,121 +476,6 @@ __gg__binary_to_packed( unsigned char *result,
   memcpy(result, combined_string, length);
   }
 
-
-unsigned __int128
-int_from_string(const char *psz, int n)
-  {
-  /* This is a generalized converter */
-
-
-  /*  We are assuming that 64-bit arithmetic is faster than 128-bit arithmetic,
-      and so we build up a 128-bit result in three 64-bit pieces, and assemble
-      them at the end.  */
-
-  static const uint8_t lookup[] =
-    {
-     0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0,0,0,0,0,0,
-    10,11,12,13,14,15,16,17,18,19, 0,0,0,0,0,0,
-    20,21,22,23,24,25,26,27,28,29, 0,0,0,0,0,0,
-    30,31,32,33,34,35,36,37,38,39, 0,0,0,0,0,0,
-    40,41,42,43,44,45,46,47,48,49, 0,0,0,0,0,0,
-    50,51,52,53,54,55,56,57,58,59, 0,0,0,0,0,0,
-    60,61,62,63,64,65,66,67,68,69, 0,0,0,0,0,0,
-    70,71,72,73,74,75,76,77,78,79, 0,0,0,0,0,0,
-    80,81,82,83,84,85,86,87,88,89, 0,0,0,0,0,0,
-    90,91,92,93,94,95,96,97,98,99, 0,0,0,0,0,0,
-    };
-
-  unsigned __int128 retval;
-
-  uint64_t top = 0;
-  uint64_t middle = 0;
-  uint64_t bottom = 0;
-
-  int count_bottom;
-  int count_middle;
-  int count_top;
-
-  // Digits 1 through 18 come from the bottom:
-  if( n <= 18 )
-    {
-    count_bottom = n;
-    count_middle = 0;
-    count_top = 0;
-    }
-  else if( n<= 36 )
-    {
-    count_bottom = 18;
-    count_middle = n - 18;
-    count_top = 0;
-    }
-  else
-    {
-    count_bottom = 18;
-    count_middle = 18;
-    count_top = n - 36;
-    }
-
-  if( n & 1 )
-    {
-    // We are dealing with an odd number of digits
-    if( count_top )
-      {
-      top = *psz++ & 0x0f;
-      count_top -= 1;
-      }
-    else if( count_middle )
-      {
-      middle = *psz++ & 0x0f;
-      count_middle -= 1;
-      }
-    else
-      {
-      bottom = *psz++ & 0x0f;
-      count_bottom -= 1;
-      }
-    }
-
-  uint8_t add_me;
-
-  while( count_top )
-    {
-    add_me  = *psz++ << 4;
-    add_me += *psz++ &  0xF;
-    top *= 100 ;
-    top += lookup[add_me];
-    count_top -= 2;
-    }
-
-  while( count_middle )
-    {
-    add_me  = *psz++ << 4;
-    add_me += *psz++ &  0xF;
-    middle *= 100 ;
-    middle += lookup[add_me];
-    count_middle -= 2;
-    }
-
-  while( count_bottom )
-    {
-    add_me  = *psz++ << 4;
-    add_me += *psz++ &  0xF;
-    bottom *= 100 ;
-    bottom += lookup[add_me];
-    count_bottom -= 2;
-    }
-
-  retval = top;
-  retval *= 1000000000000000000ULL; // 10E18
-
-  retval += middle;
-  retval *= 1000000000000000000ULL;
-
-  retval += bottom;
-
-  return retval;
-  }
-
 extern "C"
 __int128
 __gg__numeric_display_to_binary(unsigned char *signp,
@@ -811,6 +696,114 @@ __gg__numeric_display_to_binary(unsigned char *signp,
   return retval;
   }
 
+extern "C"
+__int128
+__gg__packed_to_binary(const unsigned char *psz,
+                             int            nplaces )
+  {
+  // See the comments in __gg__numeric_display_to_binary() above.
+
+  __int128 retval = 0;
+
+  static const unsigned char dp2bin[160] =
+    {
+    // This may not be the weirdest table I've ever created, but it is
+    // certainly a contender.  Given the packed decimal byte 0x23, it
+    // returns the equivalent decimal value of 23.  Note that the final
+    // entries in each line are intended to handle the final place of
+    // signed values.  0x2D, for example, gets picked up as 20.
+    00, 01, 02, 03, 04, 05, 06, 07,  8,  9,  0,  0,  0,  0,  0,  0, // 0x00
+    10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 10, 10, 10, 10, 10, 10, // 0x10
+    20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 20, 20, 20, 20, 20, 20, // 0x20
+    30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 30, 30, 30, 30, 30, 30, // 0x30
+    40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 40, 40, 40, 40, 40, 40, // 0x40
+    50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 50, 50, 50, 50, 50, 50, // 0x50
+    60, 61, 62, 63, 64, 65, 66, 67, 68, 69, 60, 60, 60, 60, 60, 60, // 0x60
+    70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 70, 70, 70, 70, 70, 70, // 0x70
+    80, 81, 82, 83, 84, 85, 86, 87, 88, 89, 80, 80, 80, 80, 80, 80, // 0x80
+    90, 91, 92, 93, 94, 95, 96, 97, 98, 99, 90, 90, 90, 90, 90, 90, // 0x90
+    };
+
+  uint64_t top = 0;
+  uint64_t middle = 0;
+  uint64_t bottom = 0;
+
+  int count_bottom;
+  int count_middle;
+  int count_top;
+
+  // Turn places into n digits
+  int n = nplaces * 2;
+
+  // Digits 1 through 18 come from the bottom:
+  if( n <= 18 )
+    {
+    count_bottom = n;
+    count_middle = 0;
+    count_top = 0;
+    }
+  else if( n<= 36 )
+    {
+    count_bottom = 18;
+    count_middle = n - 18;
+    count_top = 0;
+    }
+  else
+    {
+    count_bottom = 18;
+    count_middle = 18;
+    count_top = n - 36;
+    }
+
+  while( count_top )
+    {
+    top *= 100 ;
+    top += dp2bin[*psz++];
+    count_top -= 2;
+    }
+
+  while( count_middle )
+    {
+    middle *= 100 ;
+    middle += dp2bin[*psz++];
+    count_middle -= 2;
+    }
+
+  while( count_bottom )
+    {
+    bottom *= 100 ;
+    bottom += dp2bin[*psz++];
+    count_bottom -= 2;
+    }
+
+  retval = top;
+  retval *= 1000000000000000000ULL; // 10E18
+
+  retval += middle;
+  retval *= 1000000000000000000ULL;
+
+  retval += bottom;
+
+  // retval is now the binary value of the packed decimal number.
+
+  // back up one byte to fetch the sign nybble.
+  uint8_t sign_nybble = *(psz-1) & 0x0F;
+
+  if( sign_nybble > 9 )
+    {
+    // There is a sign nybble.  We have to divide the result by ten to offset
+    // left shift due place taken up by the sign nybble.
+    retval /= 10;
+
+    if( sign_nybble == PACKED_NYBBLE_MINUS )
+      {
+      retval = -retval ;
+      }
+    }
+
+  return retval;
+  }
+
 
 
 
diff --git a/libgcobol/stringbin.h b/libgcobol/stringbin.h
index db1ec9dd..de003e7 100644
--- a/libgcobol/stringbin.h
+++ b/libgcobol/stringbin.h
@@ -49,4 +49,9 @@ __int128 __gg__numeric_display_to_binary( unsigned char *sign_byte,
                                     const unsigned char *digits,
                                           int ndigits );
 
+extern "C"
+__int128
+__gg__packed_to_binary(const unsigned char *psz,
+                             int            nplaces );
+
 #endif