]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
cobol: Improve binary conversion from packed-decimal and numeric-display. master trunk
authorRobert Dubner <rdubner@symas.com>
Sat, 20 Jun 2026 01:21:48 +0000 (21:21 -0400)
committerRobert Dubner <rdubner@symas.com>
Sat, 20 Jun 2026 01:44:29 +0000 (21:44 -0400)
There are routines that create GENERIC conversion routines that convert
packed-decimal and numeric-display variables to binary.  Some are in
libgcobol, and some have direct GENERIC implementations.  All have been
updated to use faster divide-and-conquer algorithms.

The new routines are ten to twenty times faster than the prior versions.

gcc/cobol/ChangeLog:

* genapi.cc (parser_enter_file): Establish a var_decl for the
common packed-decimal to binary conversion table.
* genutil.cc (digit): Divide-and conquer numeric-display converter.
(num_disp_dive): Likewise.
(pd_dive): Divide-and-conqure packed-decimal converter.
(get_pd_value): Likewise.
(get_binary_value_tree): Use the new routines.
(binary_from_FldNumericBinary):  Divide-and conquer numeric-display
converter.
* genutil.h: Declaration for var_decl_dp2bin.
* move.cc (mh_little_endian): Allow FldPacked as a source.

libgcobol/ChangeLog:

* charmaps.cc: Eliminate rt_encoding_t.
* libgcobol.cc (console_init): Change how __gg__console_encoding is
established.
(initialize_program_state): Likewise.
(get_binary_value_local): Use new conversion algorithms.
(__gg__move): Likewise.
* stringbin.cc (__gg__numeric_display_to_binary):  Likewise.
(digit_rt): Likewise.
(num_disp_dive_rt): Likewise.
(pd_dive_rt): Likewise.
(__gg__packed_to_binary): Likewise.
* stringbin.h (STRINGBIN_H_): Declaration for __gg__dp2bin.
(__gg__numeric_display_to_binary): Use new algorithms.
(__gg__packed_to_binary): Likewise.

gcc/cobol/genapi.cc
gcc/cobol/genutil.cc
gcc/cobol/genutil.h
gcc/cobol/move.cc
libgcobol/charmaps.cc
libgcobol/libgcobol.cc
libgcobol/stringbin.cc
libgcobol/stringbin.h

index aed3d6942a4f9f0cd705ef09d8f89ef6e3661bd7..d0482c2f4d62aa3c2872109ca21ce076e6e79b11 100644 (file)
@@ -2785,6 +2785,7 @@ parser_enter_file(const char *filename)
     SET_VAR_DECL(var_decl_main_called             , INT                     , "__gg__main_called"     );
     SET_VAR_DECL(var_decl_entry_index             , SIZE_T                  , "__gg__entry_index"     );
     SET_VAR_DECL(var_decl_dialects                , INT                     , "__gg__dialects"        );
+    SET_VAR_DECL(var_decl_dp2bin                  , build_array_type(UCHAR, NULL), "__gg__dp2bin");
     }
   }
 
index 74a027bc229e08e174d24f3fd557dcfc5a07767c..799a17e1bb7458611fc09e9d8c47d61062bce817 100644 (file)
@@ -59,7 +59,6 @@
 #include "exceptg.h"
 #include "dumpfile.h"
 
-
 bool exception_location_active = true;
 bool skip_exception_processing = true;
 
@@ -95,6 +94,10 @@ tree var_decl_call_parameter_lengths;   // size_t *__gg__call_parameter_count
 // instruction, I instead gg_assign(var_decl_nop, integer_zero_node)
 tree var_decl_nop;                // int         __gg__nop;
 
+// This table is used to access the table of packed-decimal->binary pairs
+// of digits.
+tree var_decl_dp2bin;  // unsigned char __gg__dp2bin[256]'
+
 // Indicates which routine main() called
 tree var_decl_main_called;        // int         __gg__main_called;
 
@@ -782,6 +785,31 @@ digit(tree location, int offset, int stride)
                         build_int_cst_type(UCHAR, 0x0F));
   }
 
+static const unsigned long pots[20] =
+  {
+  1ULL,                       // 00
+  10ULL,                      // 01
+  100ULL,                     // 02
+  1000ULL,                    // 03
+  10000ULL,                   // 04
+  100000ULL,                  // 05
+  1000000ULL,                 // 06
+  10000000ULL,                // 07
+  100000000ULL,               // 08
+  1000000000ULL,              // 09
+  10000000000ULL,             // 10
+  100000000000ULL,            // 11
+  1000000000000ULL,           // 12
+  10000000000000ULL,          // 13
+  100000000000000ULL,         // 14
+  1000000000000000ULL,        // 15
+  10000000000000000ULL,       // 16
+  100000000000000000ULL,      // 17
+  1000000000000000000ULL,     // 18
+  10000000000000000000ULL,    // 19
+  };
+
+
 static tree
 num_disp_dive(tree location,  // UCHAR_P to first digit
               int  digits,    //
@@ -856,29 +884,7 @@ num_disp_dive(tree location,  // UCHAR_P to first digit
       int nright = digits/2;
       int nleft  = digits - nright;
 
-      int64_t right_factor = 0;
-      switch(nright)
-        {
-        // Look!  A ziggurat!
-        case  2: right_factor = 100ULL; break;
-        case  3: right_factor = 1000ULL; break;
-        case  4: right_factor = 10000ULL; break;
-        case  5: right_factor = 100000ULL; break;
-        case  6: right_factor = 1000000ULL; break;
-        case  7: right_factor = 10000000ULL; break;
-        case  8: right_factor = 100000000ULL; break;
-        case  9: right_factor = 1000000000ULL; break;
-        case 10: right_factor = 10000000000ULL; break;
-        case 11: right_factor = 100000000000ULL; break;
-        case 12: right_factor = 1000000000000ULL; break;
-        case 13: right_factor = 10000000000000ULL; break;
-        case 14: right_factor = 100000000000000ULL; break;
-        case 15: right_factor = 1000000000000000ULL; break;
-        case 16: right_factor = 10000000000000000ULL; break;
-        case 17: right_factor = 100000000000000000ULL; break;
-        case 18: right_factor = 1000000000000000000ULL; break;
-        case 19: right_factor = 10000000000000000000ULL; break;
-        }
+      int64_t right_factor = pots[nright];
       tree term_a = gg_multiply(num_disp_dive(location,
                                               nleft,
                                               signable,
@@ -898,6 +904,149 @@ num_disp_dive(tree location,  // UCHAR_P to first digit
   return retval;
   }
 
+static tree
+pd_dive(tree location, int nbytes, bool signable)
+  {
+  tree type;
+  int digits = nbytes * 2;
+  if( digits < 10 )
+    {
+    type = signable ? INT : UINT;
+    }
+  else if(digits < 20 )
+    {
+    type = signable ? LONG : ULONG;
+    }
+  else
+    {
+    type = signable ? INT128 : UINT128;
+    }
+  tree retval = gg_define_variable(type);
+
+  tree ten2 = build_int_cst_type(type, 100);
+  tree ten4 = build_int_cst_type(type, 10000);
+  tree ten6 = build_int_cst_type(type, 1000000);
+
+  tree t1 = integer_one_node;
+  tree t2 = build_int_cst_type(INT, 2);
+  tree t3 = build_int_cst_type(INT, 3);
+
+  switch(nbytes)
+    {
+    case 0:
+      retval =   integer_zero_node;
+      break;
+    case 1:
+      gg_assign(retval,
+                gg_cast(type,
+                        gg_array_value(var_decl_dp2bin,
+                                       gg_indirect(location))));
+      break;
+    case 2:
+      {
+      tree A = gg_multiply(gg_cast(type,
+                                   gg_array_value(var_decl_dp2bin,
+                                                  gg_indirect(location))),
+                           ten2);
+      tree B = gg_cast(type,
+                       gg_array_value(var_decl_dp2bin,
+                                      gg_indirect(location, t1)));
+      gg_assign(retval, gg_add(A, B));
+      break;
+      }
+    case 3:
+      {
+      tree A = gg_multiply(gg_cast(type,
+                           gg_array_value(var_decl_dp2bin,
+                                          gg_indirect(location))),
+                           ten4);
+      tree B = gg_multiply(gg_cast(type,
+                        gg_array_value(var_decl_dp2bin,
+                                       gg_indirect(location, t1))),
+                           ten2);
+      tree C = gg_cast(type,
+                       gg_array_value(var_decl_dp2bin,
+                                      gg_indirect(location, t2)));
+      gg_assign(retval, gg_add(A, gg_add(B, C)));
+      break;
+      }
+    case 4:
+      {
+      tree A = gg_multiply(gg_cast(type,
+                           gg_array_value(var_decl_dp2bin,
+                                          gg_indirect(location))),
+                           ten6);
+      tree B = gg_multiply(gg_cast(type,
+                        gg_array_value(var_decl_dp2bin,
+                                       gg_indirect(location, t1))),
+                           ten4);
+      tree C = gg_multiply(gg_cast(type,
+                        gg_array_value(var_decl_dp2bin,
+                                       gg_indirect(location, t2))),
+                           ten2);
+      tree D = gg_cast(type,
+                       gg_array_value(var_decl_dp2bin,
+                                      gg_indirect(location, t3)));
+      gg_assign(retval, gg_add(A, gg_add(B, gg_add(C, D))));
+      break;
+      }
+    default:
+      {
+      int nright = nbytes/2;
+      int nleft  = nbytes - nright;
+      tree A = gg_multiply( gg_cast(type, pd_dive(location, nleft, signable)),
+                            build_int_cst_type(type, pots[nright*2]));
+      tree B = gg_cast(type, pd_dive(gg_add(location,
+                                            build_int_cst_type(SIZE_T, nleft)),
+                                     nright,
+                                     signable));
+      gg_assign(retval, gg_add(A, B));
+      break;
+      }
+    }
+
+  return retval;
+  }
+
+static tree
+get_pd_value(tree return_type, cbl_field_t *field, tree location)
+  {
+  tree retval = gg_define_variable(return_type);
+  bool has_sign_nybble =  !(field->attr & separate_e);
+  bool signable        = !!(field->attr & signable_e);
+  int nbytes = field->data.capacity();
+
+  gg_assign(retval,
+            gg_cast(return_type,
+                    pd_dive(location,
+                            has_sign_nybble ? nbytes - 1 : nbytes,
+                            signable)));
+  if( has_sign_nybble )
+    {
+    gg_assign(retval,
+              gg_add(gg_multiply(retval,
+                                 build_int_cst_type(return_type, 10)),
+                     gg_cast(return_type,
+                             gg_rshift(gg_indirect(location,
+                                       build_int_cst_type(SIZE_T, nbytes-1)),
+                                       build_int_cst_type(SIZE_T, 4)))));
+
+    IF( gg_bitwise_and(gg_indirect(location, build_int_cst_type(SIZE_T, nbytes-1)),
+                                   build_int_cst_type(UCHAR, 0x0F)),
+        eq_op,
+        build_int_cst_type(UCHAR, 0x0D) )
+      {
+      gg_assign(retval, gg_negate(retval));
+      }
+    ELSE
+      {
+      }
+    ENDIF
+    }
+
+  return retval;
+  }
+
 tree
 get_binary_value_tree(tree return_type,
                       tree rdigits,
@@ -1185,16 +1334,10 @@ get_binary_value_tree(tree return_type,
                   build_int_cst_type( TREE_TYPE(rdigits),
                                       get_scaled_rdigits(field)));
         }
-      tree value = gg_define_variable(return_type);
-      gg_assign(value, gg_cast(return_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)));
-      retval = value;
+      gg_assign(retval,
+                get_pd_value(return_type,
+                             field,
+                             get_data_address( field, field_offset)));
       break;
       }
 
@@ -2413,27 +2556,6 @@ binary_from_FldNumericBinary(tree &value, const cbl_refer_t &refer, tree type)
   return retval;
   }
 
-static const unsigned long pots[17] =
-  {
-  1ULL,                       // 00
-  10ULL,                      // 01
-  100ULL,                     // 02
-  1000ULL,                    // 03
-  10000ULL,                   // 04
-  100000ULL,                  // 05
-  1000000ULL,                 // 06
-  10000000ULL,                // 07
-  100000000ULL,               // 08
-  1000000000ULL,              // 09
-  10000000000ULL,             // 10
-  100000000000ULL,            // 11
-  1000000000000ULL,           // 12
-  10000000000000ULL,          // 13
-  100000000000000ULL,         // 14
-  1000000000000000ULL,        // 15
-  10000000000000000ULL,       // 16
-  };
-
 static void
 d_and_q_num_disp( tree  &retval,   // We define this return value
                   tree   loc,     // This is a UCHAR_P
index dbcc10bec30b84985a0d7a75eb47884cd88f7cb3..e9ec2630718c78079e8e39e2926cbdd5eff183c0 100644 (file)
@@ -61,6 +61,7 @@ extern tree var_decl_nop;         // int __gg__nop
 extern tree var_decl_main_called; // int __gg__main_called
 extern tree var_decl_entry_index; // void* __gg__entry_index
 extern tree var_decl_dialects;    // void* __gg__dialects
+extern tree var_decl_dp2bin;      // unsigned char * ___gg__dp2bin
 
 int       get_scaled_rdigits(cbl_field_t *field);
 int       get_scaled_digits(cbl_field_t *field);
index 531b8b69a58e678101ef4936917481e56c952e44..4050c49e8d299eca1401957d8cfa5ce54279399e 100644 (file)
@@ -1350,7 +1350,6 @@ mh_little_endian( const cbl_refer_t &destref,
       &&  sourceref.field->type     != FldLiteralA
       &&  sourceref.field->type     != FldAlphanumeric
       &&  sourceref.field->type     != FldNumericEdited
-      &&  sourceref.field->type     != FldPacked
       &&  (     destref.field->type == FldNumericBin5
             ||  destref.field->type == FldNumericBinary
             ||  destref.field->type == FldPointer
index b6da4822d01a8430fb029b60fe2a4d1188490246..6bce28c211c0f633be52d5ca5e46ae79a3a1dc73 100644 (file)
@@ -1417,29 +1417,6 @@ static encodings_t encodings[] = {
   { false, iconv_YU_e, "YU" },
 };
 
-/*
- * Because this variable is static, the constructor runs before main and is
- * guaranteed to run.
- */
-static class rt_encoding_t
-  {
-  const char *ctype, *lc_ctype;
-  public:
-  rt_encoding_t() : ctype( setlocale(LC_CTYPE, "") )
-    {
-    lc_ctype =  nl_langinfo(CODESET);
-    // Let's learn what the computer is using for the console:
-    // We need to establish the codeset used by the system console:
-  __gg__console_encoding = use_locale();
-    }
-  cbl_encoding_t use_locale() const
-    {
-    auto encoding = strstr(ctype, "UTF-8") ?
-      iconv_UTF_8_e : __gg__encoding_iconv_type(lc_ctype);
-    return encoding;
-    }
-  } rt_encoding;
-
 static const encodings_t *
 encoding_descr( cbl_encoding_t encoding ) {
   static encodings_t *eoencodings = encodings + COUNT_OF(encodings);
index 8c9e94df528658901c6aa57d6fc83c374ce1c9dd..7619a2b8904604d529f3ac109732805458b96540 100644 (file)
@@ -545,10 +545,22 @@ __gg__get_default_currency_string()
   return currency_signs(__gg__default_currency_sign).c_str();
   }
 
+static void
+console_init() {
+  const char *ctype = setlocale(LC_CTYPE, "");
+  const char *lc_ctype =  nl_langinfo(CODESET);
+
+  // Establish the codeset used by the system console:
+  auto encoding = strstr(ctype, "UTF-8") ?
+    iconv_UTF_8_e : __gg__encoding_iconv_type(lc_ctype);
+  __gg__console_encoding = encoding;
+}
+
 static void
 initialize_program_state()
   {
   // This routine gets called exactly once for a COBOL executable
+  console_init();
   program_state initial_value = {};
   program_states.push_back(initial_value);
   __gg__currency_signs = program_states.back().rt_currency_signs;
@@ -883,7 +895,7 @@ get_binary_value_local(  int                 *rdigits,
         retval = __gg__numeric_display_to_binary(sign_byte_location,
                                                  digits,
                                                  ndigits,
-                                                 resolved_var->encoding);
+                                                 stride);
         }
       break;
       }
@@ -6405,14 +6417,13 @@ __gg__move( cblc_field_t        *fdest,
                                                             fsource,
                                                             source_offset,
                                                             source_size);
-            __gg__int128_to_qualified_field(
-                                       fdest,
-                                       dest_offset,
-                                       dest_size,
-                                       value,
-                                       rdigits,
-                                       rounded,
-                                       &size_error );
+           __gg__int128_to_qualified_field( fdest,
+                                            dest_offset,
+                                            dest_size,
+                                            value,
+                                            rdigits,
+                                            rounded,
+                                            &size_error );
             break;
             }
 
index e4584a47c8a09fdc2e8e989f89a322ebc7f6e07e..8597338c57d58b41e512f9945208e5cdc6585193 100644 (file)
@@ -504,351 +504,170 @@ __gg__binary_to_packed( unsigned char *result,
   memcpy(result, combined_string, length);
   }
 
-extern "C"
-__int128
-__gg__numeric_display_to_binary(unsigned char *signp,
-                          const unsigned char *pdigits,
-                                int            ndigits,
-                                cbl_encoding_t encoding)
-  {
-  /*  This is specific to numeric display values.
-
-      Such values can be unsigned, or they can have leading or trailing
-      internal sign information, or they can have leading or trailing external
-      sign information.
-
-      In ASCII, digits are 030; internal sign is has the zone 0x70.
-
-      In EBDIC, normal digits are 0xF0.  The sign byte in for a positive
-      signable number has the zone 0xC0; a negative value has the zone 0xD0.
-
-      A further complication is that it is legal for NumericDisplay values to
-      have non-digit characters.  This is because of REDEFINES, and whatnot.
-      Some COBOL implementations just look at the bottom four bits of
-      characters regardless of their legality.  I am choosing to have non-legal
-      characters come back as zero.  I do this with tables, so the cost is low.
-      */
-
-  /*  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.  */
-  size_t digit_index = 0;
-  cbl_char_t ch;
 
-  charmap_t *charmap = __gg__get_charmap(encoding);
-  cbl_char_t minus = charmap->mapped_character(ascii_minus);
-
-  bool is_ebcdic = charmap->is_like_ebcdic();
-
-  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,
-    };
-
-  static const uint8_t from_ebcdic[256] =
-    {
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x00
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x10
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x20
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x30
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x40
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x50
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x60
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x70
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x80
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x90
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xa0
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xb0
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xc0
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xd0
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xe0
-    0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0, // 0xf0
-    };
-
-  static const uint8_t from_ascii[256] =
-    {
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x00
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x10
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x20
-    0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0, // 0x30
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x40
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x50
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x60
-    0,1,2,3,4,5,6,7,8,9,0,0,0,0,0,0, // 0x70
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x80
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0x90
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xa0
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xb0
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xc0
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xd0
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xe0
-    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, // 0xf0
-    };
+#define digit_rt(loc, offset) (((loc)[(offset) * stride]) & 0x0F)
 
+static __int128
+num_disp_dive_rt(const unsigned char *pdigits,
+                    int            ndigits,
+                    int            stride)
+  {
   __int128 retval;
-
-  uint64_t top = 0;
-  uint64_t middle = 0;
-  uint64_t bottom = 0;
-
-  int count_bottom;
-  int count_middle;
-  int count_top;
-
-  bool is_negative = false;
-
-  // Pick up the original sign byte:
-  cbl_char_t sign_byte = charmap->getch(signp, (size_t)0);
-
-  const unsigned char *mapper;
-  if( is_ebcdic )
+  switch(ndigits)
     {
-    mapper = from_ebcdic;
-    if( sign_byte == minus )
-      {
-      is_negative = true;
-      }
-    else if( (sign_byte & 0xF0) == 0xD0 )
+    case 1:
+      retval =  digit_rt(pdigits, 0);
+      break;
+    case 2:
+      retval =  digit_rt(pdigits, 0)*10
+              + digit_rt(pdigits, 1);
+      break;
+    case 3:
+      retval =  digit_rt(pdigits, 0)*100
+              + digit_rt(pdigits, 1)*10
+              + digit_rt(pdigits, 2);
+      break;
+    case 4:
+      retval =  digit_rt(pdigits, 0)*1000
+              + digit_rt(pdigits, 1)*100
+              + digit_rt(pdigits, 2)*10
+              + digit_rt(pdigits, 3);
+      break;
+    default:
       {
-      is_negative = true;
+      int nright = ndigits/2;
+      int nleft  = ndigits - nright;
+      __int128 pot = __gg__power_of_ten(nright);
+      retval =   num_disp_dive_rt(pdigits,               nleft, stride) * pot
+               + num_disp_dive_rt(pdigits+nleft*stride, nright, stride);
+      break;
       }
-    // No matter what the digit, force it to be a valid positive digit by
-    // forcing the zone to 0xF0.  Note that this is harmless if redundant, and
-    // harmless as well if the data SIGN IS SEPARATE.  Whatever we do to this
-    // byte will be undone at the end of the routine.
-    charmap->putch(sign_byte|0xF0, signp, (size_t)0);
     }
-  else
-    {
-    mapper = from_ascii;
-    if( sign_byte == minus )
-      {
-      is_negative = true;
-      }
-    else if( (sign_byte & 0xF0) == 0x70 )
-      {
-      is_negative = true;
+  return retval;
+  }
 
-      // Make it a valid positive digit by turning the zone to 0x30
-      charmap->putch(sign_byte&0x3F, signp, (size_t)0);
-      }
-    }
+extern "C"
+__int128
+__gg__numeric_display_to_binary(const unsigned char *signp,
+                                const unsigned char *pdigits,
+                                      int            ndigits,
+                                      int            stride)
+  {
+  __int128 retval;
 
-  // Digits 1 through 18 come from the bottom:
-  if( ndigits <= 18 )
-    {
-    count_bottom = ndigits;
-    count_middle = 0;
-    count_top = 0;
-    }
-  else if( ndigits<= 36 )
+  retval = num_disp_dive_rt(pdigits, ndigits, stride);
+
+  // For speed, we assume this value is well-formed:
+  if( *signp == ascii_minus )
     {
-    count_bottom = 18;
-    count_middle = ndigits - 18;
-    count_top = 0;
+    retval = -retval;
     }
   else
     {
-    count_bottom = 18;
-    count_middle = 18;
-    count_top = ndigits - 36;
-    }
-
-  if( ndigits & 1 )
-    {
-    // We are dealing with an odd number of digits
-    if( count_top )
+    unsigned int sbyte = *signp & 0xF0;
+    switch(sbyte)
       {
-      ch = charmap->getch(pdigits, &digit_index);
-      top = mapper[ch];
-      count_top -= 1;
-      }
-    else if( count_middle )
-      {
-      ch = charmap->getch(pdigits, &digit_index);
-      middle = mapper[ch];
-      count_middle -= 1;
-      }
-    else
-      {
-      ch = charmap->getch(pdigits, &digit_index);
-      bottom = mapper[ch];
-      count_bottom -= 1;
+      case 0x60: // EBCDIC '-' is 0x60, and no other 0x6z characters matter.
+      case 0x70: // ASCII internal negative
+      case 0xD0: // EBDIC internal negative
+        retval = -retval;
+      break;
       }
     }
 
-  uint8_t add_me;
-
-  while( count_top )
-    {
-    ch = charmap->getch(pdigits, &digit_index);
-    add_me  = mapper[ch] << 4;
-    ch = charmap->getch(pdigits, &digit_index);
-    add_me += mapper[ch];
-    top *= 100 ;
-    top += lookup[add_me];
-    count_top -= 2;
-    }
-
-  while( count_middle )
-    {
-    ch = charmap->getch(pdigits, &digit_index);
-    add_me  = mapper[ch] << 4;
-    ch = charmap->getch(pdigits, &digit_index);
-    add_me += mapper[ch];
-    middle *= 100 ;
-    middle += lookup[add_me];
-    count_middle -= 2;
-    }
-
-  while( count_bottom )
-    {
-    ch = charmap->getch(pdigits, &digit_index);
-    add_me  = mapper[ch] << 4;
-    ch = charmap->getch(pdigits, &digit_index);
-    add_me += mapper[ch];
-    bottom *= 100 ;
-    bottom += lookup[add_me];
-    count_bottom -= 2;
-    }
-
-  retval = top;
-  retval *= 1000000000000000000ULL; // 10E18
-
-  retval += middle;
-  retval *= 1000000000000000000ULL;
+  return retval;
+  }
 
-  retval += bottom;
+const unsigned char __gg__dp2bin[256] =
+  {
+  // This table is used both by the compile-time and the run-time.  Given the
+  // packed decimal byte 0x23, it provides s the equivalent decimal value of
+  // 23.  This table is not used on the final byte of COMP-3 values; that
+  // digit has to be extracted specifically.
+
+// 0   1   2   3   4   5   6   7   8   9   A   B   C   D   E   F
+//--------------------------------------------------------------
+  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
+   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, // 0xA0
+   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, // 0xB0
+   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, // 0xC0
+   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, // 0xD0
+   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, // 0xE0
+   0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0, // 0xF0
+  };
 
-  if( is_negative )
+static
+__int128
+pd_dive_rt(const unsigned char *psz, int nplaces)
+  {
+  __int128 retval;
+  switch(nplaces)
     {
-    retval = -retval;
+    case 0:
+      retval =   0;
+      break;
+    case 1:
+      retval =   __gg__dp2bin[psz[0]];
+      break;
+    case 2:
+      retval =   __gg__dp2bin[psz[0]] * 100
+               + __gg__dp2bin[psz[1]];
+      break;
+    case 3:
+      retval =   __gg__dp2bin[psz[0]] * 10000
+               + __gg__dp2bin[psz[1]] * 100
+               + __gg__dp2bin[psz[2]];
+      break;
+    case 4:
+      retval =   __gg__dp2bin[psz[0]] * 1000000
+               + __gg__dp2bin[psz[1]] * 10000
+               + __gg__dp2bin[psz[2]] * 100
+               + __gg__dp2bin[psz[3]];
+      break;
+    default:
+      {
+      int nright = nplaces/2;
+      int nleft  = nplaces - nright;
+      __int128 pot = __gg__power_of_ten(nright*2);
+      retval =   pd_dive_rt(psz,       nleft) * pot
+               + pd_dive_rt(psz+nleft, nright);
+      break;
+      }
     }
 
-  // Replace the original sign byte:
-  charmap->putch(sign_byte, signp, (size_t)0);
   return retval;
   }
 
 extern "C"
 __int128
 __gg__packed_to_binary(const unsigned char *psz,
-                             int            nplaces )
+                             int            nplaces) // Number of bytes
   {
-  // 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;
+  __int128 retval;
+  // Check to see if the final nybble is a sign bit:
+  bool signable = (psz[nplaces-1] & 0x0F) >= 0x0C;
 
-  // Digits 1 through 18 come from the bottom:
-  if( n <= 18 )
-    {
-    count_bottom = n;
-    count_middle = 0;
-    count_top = 0;
-    }
-  else if( n<= 36 )
+  if( signable )
     {
-    count_bottom = 18;
-    count_middle = n - 18;
-    count_top = 0;
+    retval = pd_dive_rt(psz, nplaces-1) * 10 + (psz[nplaces-1] >> 4);
     }
   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 = pd_dive_rt(psz, nplaces);
     }
-
-  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;
-  enum{ PACKED_NYBBLE_MINUS= 0x0D};
-
-  if( sign_nybble > 9 )
+  if(     signable
+      && (psz[nplaces-1] & 0x0F) == 0x0D )
     {
-    // 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 ;
-      }
+    retval = -retval;
     }
-
   return retval;
   }
-
-
-
-
-
index b4b2238884f15ac4b9125bf7187f205f9cbf11e4..1ae7ca9f314474f7cf308e52f0e7e30101364b34 100644 (file)
@@ -30,6 +30,8 @@
 #ifndef STRINGBIN_H_
 #define STRINGBIN_H_
 
+extern const unsigned char __gg__dp2bin[256];
+
 extern "C"
 bool __gg__binary_to_string_ascii(char *result,
                                   int digits,
@@ -46,14 +48,14 @@ void __gg__binary_to_packed( unsigned char *result,
                              __int128 value);
 
 extern "C"
-__int128 __gg__numeric_display_to_binary( unsigned char *sign_byte,
-                                    const unsigned char *digits,
-                                          int ndigits,
-                                          cbl_encoding_t encoding);
+__int128 __gg__numeric_display_to_binary(const unsigned char *sign_byte,
+                                         const unsigned char *digits,
+                                               int ndigits,
+                                               int    stride);
 
 extern "C"
 __int128
 __gg__packed_to_binary(const unsigned char *psz,
-                             int            nplaces );
+                             int            nplaces);
 
 #endif