From: Robert Dubner <rdubner@symas.com>
Date: Tue, 12 May 2026 17:52:28 +0000 (-0400)
Subject: cobol: Improved GENERIC for conditionals and comparisons.
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=aeb28fa47dce988c01855b7bc2c1b86660423576;p=thirdparty%2Fgcc.git

cobol: Improved GENERIC for conditionals and comparisons.

After several years, I am finally developing some understanding of
GENERIC and how the middle-end processes it.  These wide-ranging changes
improve the execution speed of conditional logic and numeric-numeric,
numeric-alpha, and alpha-alpha comparisons.

I started with refining the way GENERIC for "IF <conditional statement>"
is created, and then I moved on to numerous individual cases.  Some
all-purpose routines in libgcobol.so have been broken out into special-
purpose routines implemented in GENERIC.

gcc/cobol/ChangeLog:

	* Make-lang.in: Incorporate new gcc/cobol/compare.cc file.
	* cobol1.cc (ATTR_CONST_NOTHROW_LEAF): Incorporate __builtin_swap16,
	__builtin_swap32, __builtin_swap64, and __builtin_swap128.
	(cobol_langhook_init): Likewise.
	* genapi.cc (treeplet_fill_source): Improve speed.
	(get_binary_value_from_float): Spelling.
	(normal_normal_compare): Eliminate.
	(compare_binary_binary): Eliminate.
	(DEBUG_COMPARE): Eliminate.
	(cobol_compare): Eliminate.
	(parser_enter_file): Eliminate obsolete variables.
	(data_decl_type_for): New function.
	(parser_alphabet_use): Flag altered alphabets for speed.
	(parser_display): Environment switch for putting comments into
	the assembly language.
	(program_end_stuff): Change "hijack" to "hijack_h".
	(parser_division): Repair RETURN-CODE logic.
	(parser_logop): Improve GENERIC for logical operations.
	(parser_relop): Use new cobol_compare_relop() routine.
	(parser_relop_long): Elminate unnecessary static variable.
	(inspect_tally): Improve parameter passing to library routine.
	(inspect_replacing): Likewise.
	(parser_intrinsic_subst): Likewise.
	(parser_intrinsic_callv): Likewise.
	(parser_intrinsic_call_1): Likewise.
	(parser_bsearch_start): Likewise.
	(parser_bsearch_when): Use new comparison routine; simplify logic.
	(parser_unstring): Improve parameter passing to library routine.
	(parser_string): Likewise.
	(create_and_call): Repair RETURN-CODE logic.
	(parser_call): Adjust exception processing when the target cannot be
	found.
	(build_temporaryN): Constructor for cblc_field_t::data.
	(hijack_for_development): Change hijacking name to "dubner_h".
	(hijacker): Change hijacking name to "hijack_h".
	(get_reference_to_data): New function.
	(mh_identical): Improve speed when sender and receiver have the same
	structure.
	(mh_source_is_literalN): Eliminate leading plus/minus when moving a
	numeric to an alphanumeric.
	(move_helper): Adjust logic for mh_identical and mh_source_is_group.
	(actually_create_the_static_field): Use constructor for data member.
	(psa_new_var_decl): Typo in comment.
	(parser_symbol_add): Make the generated data type more consistent
	with the COBOL variable type.
	* genapi.h (parser_bsearch_when): Change declaration.
	(parser_bsearch_start): Formatting.
	(parser_sort): Formatting.
	* gengen.cc (gg_show_type): Expand for ARRAY_TYPE and ARRAY_REF.
	(gg_define_from_declaration): Use void type for DECL_EXPR.
	(gg_define_volatile_variable): New function.
	(gg_get_address): New function.
	(gg_array_value): Use fold_convert().
	(gg_bswap): New function.
	(gg_memcmp): New function.
	* gengen.h (SCHAR_P): New and changed declarations.
	(struct gg_function_t): Add alphabet_in_use flag.
	(gg_define_volatile_variable): New declaration.
	(gg_get_address_of): Comment.
	(gg_pointer_to_array): Comment.
	(gg_get_address): New declaration.
	(gg_bswap): New declaration.
	(gg_memcmp):  New declaration.
	(gg_insert_into_assemblerf): Formatting.
	* genmath.cc (arithmetic_operation): Improved handling of
	parameters.
	(fast_add): Improved handling of locations.
	(parser_add): Formatting.
	* genutil.cc (tree_type_from_digits): Correct parameter.
	(get_data_offset): Correct exception handling.
	(get_binary_value_tree): Improve location handling.
	(tree_type_from_field): Correct logic.
	(tree_type_from_size): Correct signs for returned type.
	(build_array_of_treeplets): Eliminated.
	(build_array_of_referlets): New function.
	(build_array_of_fourplets): Eliminated.
	(build_array_of_refers): New function.
	(refer_is_clean): Improved logic.
	(refer_is_super_clean): New function.
	(refer_is_working_storage): New function.
	(refer_offset): Formatting.
	(binary_from_FldNumericBin5): New function.
	(binary_from_FldNumericBinary): New function.
	(d_and_q_num_disp): New function.
	(binary_from_FldNumericDisplay): New function.
	(make_dp2bin_decl): New function.
	(d_and_q_packed): New function.
	(binary_from_comp_3): New function.
	(binary_from_comp_6): New function.
	(binary_from_FldPacked): New function.
	(binary_from_FldFloat): New function.
	(get_binary_value): New function.
	(get_location): New function.
	(get_length): New function.
	* genutil.h (tree_type_from_digits): New declaration.
	(tree_type_from_size): Changed declaration.
	(refer_is_super_clean): New declaration.
	(refer_is_working_storage): New declaration.
	(refer_offset): Changed declaration.
	(build_array_of_treeplets): Remove declaration.
	(build_array_of_referlets): New declaration.
	(build_array_of_fourplets): Remove declaration.
	(build_array_of_refers): New declaration.
	(tree_type_from_field): New declaration.
	(get_binary_value): New declaration.
	(get_location): New declaration.
	(get_length): New declaration.
	* parse.y: Mysterious changes. All changes to YACC rules are
	mysterious.
	* parse_ante.h (class log_expr_t): Changes to logop() invocation.
	* scan_post.h (yylex): Remove unnecessary trailing semicolon.
	* structs.cc (create_cblc_file_t): Change cblc_file_t declaration.
	(create_referlet_t): New function.
	(create_refer_t): New function.
	(create_our_type_nodes): Add cblc_referlet_type_node and
	cblc_refer_type_node.
	* structs.h (member2): New declaration.
	(GTY): Type for cblc_referlet_type_node and cblc_refer_type_node.
	* symbols.cc (temporaries_t::add): Remove unnecessary trailing
	semicolon.
	* symbols.h (struct cbl_bsearch_t): Remove obsolete member.
	(ENABLE_HIJACKING): Compilation switch for enabling dubner_h and
	hijack_h code-generation hijacking.
	* util.cc (symbol_field_type_update): Comment.
	* compare.cc: New file.
	* compare.h: New file.

libgcobol/ChangeLog:

	* charmaps.h (class charmap_t): Remove an abort().
	* common-defs.h (SUPERTYPE): Pairs integers for complex switch().
	(cbl_file_mode_str): Remove unnecessary trailing semicolon.
	* gcobolio.h: New cblc_referlet_t and cblc_refer_t structures;
	eliminate obsolete structures.
	* gmath.cc (__gg__pow): Improved parameter handling.
	(__gg__add_fixed_phase1): Likewise.
	(__gg__addf1_fixed_phase2): Likewise.
	(__gg__fixed_phase2_assign_to_c): Likewise.
	(__gg__add_float_phase1): Likewise.
	(__gg__addf1_float_phase2): Likewise.
	(__gg__float_phase2_assign_to_c): Likewise.
	(__gg__addf3): Likewise.
	(__gg__subtractf1_fixed_phase2): Likewise.
	(__gg__subtractf2_fixed_phase1): Likewise.
	(__gg__subtractf1_float_phase2): Likewise.
	(__gg__subtractf2_float_phase1): Likewise.
	(__gg__subtractf3): Likewise.
	(__gg__multiplyf1_phase1): Likewise.
	(__gg__multiplyf1_phase2): Likewise.
	(__gg__multiplyf2): Likewise.
	(__gg__dividef1_phase2): Likewise.
	(__gg__dividef23): Likewise.
	(__gg__dividef45): Likewise.
	* inspect.cc (inspect_backward_format_1): Likewise.
	(__gg__inspect_format_1): Likewise.
	(inspect_backward_format_2): Likewise.
	(__gg__inspect_format_2): Likewise.
	(__gg__inspect_format_1_sbc): Likewise.
	* intrinsic.cc (kahan_summation): Likewise.
	(variance): Likewise.
	(__gg__concat): Likewise.
	(__gg__max): Likewise.
	(__gg__mean): Likewise.
	(__gg__median): Likewise.
	(__gg__midrange): Likewise.
	(__gg__min): Likewise.
	(__gg__ord_min): Likewise.
	(__gg__ord_max): Likewise.
	(__gg__present_value): Likewise.
	(__gg__range): Likewise.
	(__gg__standard_deviation): Likewise.
	(__gg__sum): Likewise.
	(__gg__variance): Likewise.
	(__gg__substitute): Likewise.
	* libgcobol.cc (__gg__resize_int_p): Eliminate.
	(__gg__resize_treeplet): Eliminate.
	(initialize_program_state): Eliminate the use of obsolete variables.
	(format_for_display_internal): Handle FldLiteralN; display up to
	38 digits for __int128.
	(compare_field_class): Rename to __gg__compare_field_class.
	(__gg__compare_field_class): Likewise.
	(interconvert): Correct codeset correction logic.
	(__gg__compare_2): Use __gg__compare_field_class.
	(__gg__move): Handle FldNumericBin5 correction.
	(__gg__string): Improved parameter handling.
	(display_both): Cope with missing codeset parameter.
	(__gg__literaln_alpha_compare): Eliminate.
	(__gg__unstring): Improved parameter handling.
	(__gg__just_mangle_name): Improved codeset handling.
	(__gg__convert): Formatting.
	(__gg__set_data_member): Eliminate.
	(__gg__show_int128): New function.
	(__gg__compare_string_all): New function.
	(__gg__compare_string_1): New function.
	(ASCII_16): Abuse of the preprocessor to create a 1024-byte string
	of ASCII spaces.
	(ASCII_64): Likewise.
	(ASCII_256): Likewise.
	(ASCII_1024): Likewise.
	(EBCDIC_16): Abuse of the preprocessor to create a 1024-byte string
	of EBCDIC spaces.
	(EBCDIC_64): Likewise.
	(EBCDIC_256): Likewise.
	(EBCDIC_1024): Likewise.
	(__gg__compare_string_1a): New function.
	(__gg__compare_string_1e): New function.
	(__gg__compare_string_2): New function.
	(__gg__compare_string_2a): New function.
	(__gg__compare_string_4): New function.
	(__gg__compare_string_4a): New function.
	(__gg_compare_string_different): New function.
	(__gg__compare_numeric_all): New function.
	(__gg__compare_binary_to_string): New function.
	* stringbin.cc (__gg__binary_to_string_ascii): Improved algorithm.

gcc/testsuite/ChangeLog:

	* cobol.dg/group2/Check_for_equality_of_COMP-1___COMP-2.cob:
	Corrected logic.
	* cobol.dg/group2/ENTRY_statement.cob: Expanded test.
	* cobol.dg/group2/ENTRY_statement.out: Likewise.
	* cobol.dg/group2/FUNCTION_DATE___TIME_OMNIBUS.cob: Automated
	generation of run-time environment variable.
	* cobol.dg/group2/Intrinsic_Function_ABS.cob: Corrected.
	* cobol.dg/group2/RETURN-CODE_moving.cob: Requires "dialect ibm".
	* cobol.dg/group2/FUNCTION_TRIM_with_NATIONAL_characters.cob: New test.
	* cobol.dg/group2/FUNCTION_TRIM_with_NATIONAL_characters.out: New test.
	* cobol.dg/group2/Large_PIC_10000000_.cob: New test.
	* cobol.dg/group2/Large_PIC_10000000_.out: New test.
	* cobol.dg/group2/Nested_PERFORM.cob: New test.
	* cobol.dg/group2/Nested_PERFORM.out: New test.
	* cobol.dg/group2/Overlapping_MOVE.cob: New test.
	* cobol.dg/group2/Overlapping_MOVE.out: New test.
	* cobol.dg/group2/PERFORM_TIMES_subscripted.cob: New test.
	* cobol.dg/group2/PERFORM_TIMES_subscripted.out: New test.
	* cobol.dg/group2/PERFORM_VARYING_BY_-0.2.cob: New test.
	* cobol.dg/group2/PERFORM_VARYING_BY_-0.2.out: New test.
	* cobol.dg/group2/REDEFINES__chained.cob: New test.
	* cobol.dg/group2/REDEFINES__chained.out: New test.
	* cobol.dg/group2/RETURN-CODE_with_INITIAL_and_RECURSIVE.cob: New test.
	* cobol.dg/group2/RETURN-CODE_with_INITIAL_and_RECURSIVE.out: New test.
	* cobol.dg/group2/Sanity_check_for_ENTRY.cob: New test.
	* cobol.dg/group2/Sanity_check_for_ENTRY.out: New test.
	* cobol.dg/group2/Simple_COMP-X.cob: New test.
	* cobol.dg/group2/Simple_COMP-X.out: New test.
	* cobol.dg/group2/compare_alpha_to_all__literal_.cob: New test.
	* cobol.dg/group2/compare_alpha_to_all__literal_.out: New test.
	* cobol.dg/group2/compare_national_to_display.cob: New test.
	* cobol.dg/group2/compare_national_to_display.out: New test.
	* cobol.dg/group2/comprensive_compare_comp-1_comp-5.cob: New test.
	* cobol.dg/group2/comprensive_compare_comp-1_comp-5.out: New test.
	* cobol.dg/group2/refmod_with_nested_parentheses.cob: New test.
	* cobol.dg/group2/refmod_with_nested_parentheses.out: New test.
	* cobol.dg/group2/signed_unsigned_compare.cob: New test.
	* cobol.dg/group2/signed_unsigned_compare.out: New test.
---

diff --git a/gcc/cobol/Make-lang.in b/gcc/cobol/Make-lang.in
index 0c316959dd4..f890ea1075a 100644
--- a/gcc/cobol/Make-lang.in
+++ b/gcc/cobol/Make-lang.in
@@ -64,6 +64,7 @@ cobol1_OBJS =    \
  cobol/cdf.o        \
  cobol/cdf-copy.o   \
  cobol/cobol1.o     \
+ cobol/compare.o    \
  cobol/convert.o    \
  cobol/except.o     \
  cobol/genutil.o    \
diff --git a/gcc/cobol/cobol1.cc b/gcc/cobol/cobol1.cc
index 0a5c71d85bd..3bdda333d01 100644
--- a/gcc/cobol/cobol1.cc
+++ b/gcc/cobol/cobol1.cc
@@ -127,6 +127,7 @@ struct GTY (()) language_function
 #define ATTR_TMPURE_NORETURN_NOTHROW_LEAF_COLD_LIST (ECF_TM_PURE|ECF_NORETURN|ECF_NOTHROW|ECF_LEAF|ECF_COLD)
 #define ATTR_NORETURN_NOTHROW_LIST (ECF_NORETURN|ECF_NOTHROW)
 #define ATTR_NOTHROW_NONNULL_LEAF (ECF_NOTHROW|ECF_LEAF)
+#define ATTR_CONST_NOTHROW_LEAF (ECF_CONST | ECF_NOTHROW | ECF_LEAF)
 
 static void
 gfc_define_builtin (const char *name, tree type, enum built_in_function code,
@@ -266,6 +267,44 @@ cobol_langhook_init (void)
     gfc_define_builtin ("__builtin_strcpy", ftype, BUILT_IN_STRCPY,
             "strcpy", ATTR_NOTHROW_NONNULL_LEAF);
 
+
+    ftype = build_function_type_list (uint16_type_node,
+                                      uint16_type_node,
+                                      NULL_TREE);
+    gfc_define_builtin ("__builtin_bswap16",
+                        ftype,
+                        BUILT_IN_BSWAP16,
+                        NULL,
+                        ATTR_CONST_NOTHROW_LEAF);
+
+    ftype = build_function_type_list (uint32_type_node,
+                                      uint32_type_node,
+                                      NULL_TREE);
+    gfc_define_builtin ("__builtin_bswap32",
+                        ftype,
+                        BUILT_IN_BSWAP32,
+                        NULL,
+                        ATTR_CONST_NOTHROW_LEAF);
+
+    ftype = build_function_type_list (uint64_type_node,
+                                      uint64_type_node,
+                                      NULL_TREE);
+    gfc_define_builtin ("__builtin_bswap64",
+                        ftype,
+                        BUILT_IN_BSWAP64,
+                        NULL,
+                        ATTR_CONST_NOTHROW_LEAF);
+
+    ftype = build_function_type_list (unsigned_intTI_type_node,
+                                      unsigned_intTI_type_node,
+                                      NULL_TREE);
+    gfc_define_builtin ("__builtin_bswap128",
+                        ftype,
+                        BUILT_IN_BSWAP128,
+                        NULL,
+                        ATTR_CONST_NOTHROW_LEAF);
+
+
     build_common_builtin_nodes ();
 
     // Make sure this is a supported configuration.
diff --git a/gcc/cobol/compare.cc b/gcc/cobol/compare.cc
new file mode 100644
index 00000000000..77dcbb11347
--- /dev/null
+++ b/gcc/cobol/compare.cc
@@ -0,0 +1,1465 @@
+/*
+ * Copyright (c) 2021-2026 Symas Corporation
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ *   notice, this list of conditions and the following disclaimer.
+ * * Redistributions in binary form must reproduce the above
+ *   copyright notice, this list of conditions and the following disclaimer
+ *   in the documentation and/or other materials provided with the
+ *   distribution.
+ * * Neither the name of the Symas Corporation nor the names of its
+ *   contributors may be used to endorse or promote products derived from
+ *   this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#include "cobol-system.h"
+
+#include "coretypes.h"
+#include "tree.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "diagnostic-core.h"
+#include "target.h"
+
+#include "../../libgcobol/ec.h"
+#include "../../libgcobol/common-defs.h"
+#include "util.h"
+#include "cbldiag.h"
+#include "symbols.h"
+#include "gengen.h"
+#include "inspect.h"
+#include "../../libgcobol/io.h"
+#include "genapi.h"
+#include "genutil.h"
+#include "genmath.h"
+#include "structs.h"
+#include "../../libgcobol/gcobolio.h"
+#include "../../libgcobol/charmaps.h"
+#include "../../libgcobol/valconv.h"
+#include "show_parse.h"
+#include "fold-const.h"
+#include "realmpfr.h"
+#include "compare.h"
+
+static bool
+comparably_numeric(const cbl_refer_t &refer)
+  {
+  // This routine returns TRUE for refers that can be treated as binary
+  // integers for the purpose of comparisons.  We handle CHAR through INT128;
+  // floats are broken out separately.
+  bool retval;
+
+  if( refer.refmod.from )
+    {
+    // Anything with a refmod is treated like an alphanumeric, not a number.
+    retval = false;
+    }
+  else
+    {
+    switch(refer.field->type)
+      {
+      case FldNumericBinary:
+      case FldNumericDisplay:
+      case FldPacked:
+      case FldNumericBin5:
+      case FldLiteralN:
+      case FldIndex:
+      case FldPointer:
+        retval = true;
+        break;
+
+      case FldAlphanumeric:
+        {
+        // An FldAlphanumeric flagged as ZERO is a number.
+        retval = (cbl_figconst_t)(refer.field->attr & FIGCONST_MASK) ==
+                                                                zero_value_e;
+        }
+      break;
+
+      default:
+        retval = false;
+        break;
+      }
+    }
+
+  return retval;
+  }
+
+static bool
+comparably_alpha(const cbl_refer_t &refer)
+  {
+  // This routine returns TRUE for refers that can be treated as alphanumeric
+  // strings the purpose of comparisons.
+
+  bool retval;
+
+  switch(refer.field->type)
+    {
+    case FldGroup:
+    case FldAlphanumeric:
+    case FldLiteralA:
+    case FldNumericEdited:
+    case FldAlphaEdited:
+      retval = true;
+      break;
+
+    default:
+      if( refer.refmod.from )
+        {
+        retval = true;
+        }
+     else
+        {
+        retval = false;
+        }
+      break;
+    }
+  return retval;
+  }
+
+enum {MAX_INT128_DIGITS = 38};
+
+static void
+digiter(int &digits, int &rdigits, const cbl_refer_t &refer)
+  {
+  digits  = refer.field->data.digits;
+  rdigits = refer.field->data.rdigits;
+
+  if( digits == 0 )
+    {
+    // We are dealing with a pure binary type:
+    switch(refer.field->data.capacity())
+      {
+      case 1:
+        digits = 2;
+        break;
+      case 2:
+        digits = 4;
+        break;
+      case 4:
+        digits = 9;
+        break;
+      case 8:
+        digits = 19;
+        break;
+      case 16:
+        digits = 38;
+        break;
+      default:
+        gcc_unreachable();
+        break;
+      }
+    }
+  if( refer.field->attr & scaled_e )
+    {
+    if( rdigits < 0 )
+      {
+      // This is like 999PPPP with rdigits = -4
+      // So, digits becomes 7, and rdigits becomes 0
+      // Our caller will have to multiply by 10^4 to get the 999 digits into
+      // the right place.
+      digits += rdigits;
+      rdigits = 0;
+      }
+    else
+      {
+      // This is like PPP9999.  Digits stays 3, and rdigits becomes 7
+      rdigits += digits;
+      }
+    }
+  }
+
+static int
+total_digits(int &left_rdigits,
+             int &right_rdigits,
+             const cbl_refer_t &left_side,
+             const cbl_refer_t &right_side)
+  {
+  // This routine is called when neither parameter is intermediate_e, and thus
+  // we can use the compile-time values:
+  int left_digits=0;
+  int right_digits=0;
+  digiter(left_digits,  left_rdigits,  left_side);
+  digiter(right_digits, right_rdigits, right_side);
+
+  if( (left_side.field->attr & scaled_e) && left_side.field->data.rdigits < 0)
+    {
+    right_rdigits -= left_side.field->data.rdigits;
+    }
+  if( (right_side.field->attr & scaled_e) && right_side.field->data.rdigits < 0)
+    {
+    left_rdigits -= right_side.field->data.rdigits;
+    }
+
+  // We can reduce the two rdigits values by the common portion of both:
+  int excess_digits = std::min(left_rdigits, right_rdigits);
+
+  left_rdigits  -= excess_digits;
+  right_rdigits -= excess_digits;
+
+  // And now we can scale up both left_digits and right_digits by the rdigits
+  // of the other side.  Keep in mind that at this point, one of them is
+  // zero:
+
+  left_digits  += right_rdigits;
+  right_digits += left_rdigits;
+
+  // Our return value is the larger of those two numbers:
+  int retval = std::max(left_digits, right_digits);
+  return retval;
+  }
+
+static void
+total_digits_tree( tree &left_rdigits,
+                   tree &right_rdigits,
+                   const cbl_refer_t &left_side,
+                   const cbl_refer_t &right_side)
+  {
+  // This routine is used when we might have to use the run-time values:
+  left_rdigits = gg_define_int();
+  right_rdigits = gg_define_int();
+
+  if( left_side.field->attr & intermediate_e )
+    {
+    gg_assign( left_rdigits,
+               gg_cast(INT,
+                       member(left_side.field->var_decl_node,
+                              "rdigits")));
+    }
+  else
+    {
+    gg_assign(left_rdigits,
+              build_int_cst_type(INT,
+                                 left_side.field->data.rdigits));
+    }
+
+  if( right_side.field->attr & intermediate_e )
+    {
+    gg_assign(right_rdigits,
+              gg_cast(INT,
+                      member(right_side.field->var_decl_node,
+                             "rdigits")));
+    }
+  else
+    {
+    gg_assign(right_rdigits,
+              build_int_cst_type(INT,
+                                 right_side.field->data.rdigits));
+    }
+
+  if( (left_side.field->attr & scaled_e) && left_side.field->data.rdigits < 0)
+    {
+    // Left rdigits becomes zero; right_rdigits is augmented to the negative of
+    // left rdigits
+    gg_assign(left_rdigits, integer_zero_node);
+    gg_assign(right_rdigits,
+              gg_add(right_rdigits,
+                     build_int_cst_type(INT,
+                                        -left_side.field->data.rdigits)));
+    }
+  if( (left_side.field->attr & scaled_e) && left_side.field->data.rdigits > 0)
+    {
+    // left_rdigits is augmented by left_digits
+    gg_assign(left_rdigits,
+              gg_add(left_rdigits,
+                     build_int_cst_type(INT,
+                                        left_side.field->data.digits)));
+    }
+
+  if( (right_side.field->attr & scaled_e) && right_side.field->data.rdigits < 0)
+    {
+    // Right rdigits becomes zero; left_rdigits is augmented by the negative of
+    // right_rdigits
+    gg_assign(right_rdigits, integer_zero_node);
+    gg_assign(left_rdigits,
+              gg_add(left_rdigits,
+                     build_int_cst_type(INT,
+                                        -right_side.field->data.rdigits)));
+    }
+  if( (right_side.field->attr & scaled_e) && right_side.field->data.rdigits > 0)
+    {
+    // right_rdigits is augmented by right_digits
+    gg_assign(right_rdigits,
+              gg_add(right_rdigits,
+                     build_int_cst_type(INT,
+                                        right_side.field->data.digits)));
+    }
+
+  // gg_printf("KILROY  LEFT %d\n", left_rdigits, NULL_TREE);
+  // gg_printf("KILROY RIGHT %d\n", right_rdigits, NULL_TREE);
+
+  // We can reduce the two rdigits values by the common portion of both.  This
+  // will leave one of them at zero
+  IF( left_rdigits, gt_op, right_rdigits )
+    {
+    gg_assign(left_rdigits, gg_subtract(left_rdigits, right_rdigits));
+    gg_assign(right_rdigits, integer_zero_node);
+    }
+  ELSE
+    {
+    gg_assign(right_rdigits, gg_subtract(right_rdigits, left_rdigits));
+    gg_assign(left_rdigits, integer_zero_node);
+    }
+  ENDIF
+  }
+
+static tree
+type_based_on_digits(int digits, bool signable)
+  {
+  tree retval;
+  if( signable )
+    {
+    // if(digits <= 2)
+      // {
+      // retval = SCHAR;
+      // }
+    // else
+    if(digits <= 4)
+      {
+      retval = SHORT;
+      }
+    else if(digits <= 9)
+      {
+      retval = INT;
+      }
+    else if(digits <= 19)
+      {
+      retval = LONG;
+      }
+    else
+      {
+      retval = INT128;
+      }
+    }
+  else
+    {
+    if(digits <= 2)
+      {
+      retval = UCHAR;
+      }
+    else if(digits <= 4)
+      {
+      retval = USHORT;
+      }
+    else if(digits <= 9)
+      {
+      retval = UINT;
+      }
+    else if(digits <= 19)
+      {
+      retval = ULONG;
+      }
+    else
+      {
+      retval = UINT128;
+      }
+    }
+
+  return retval;
+  }
+
+static bool
+numeric_compare(tree        &left,
+                tree        &right,
+          const cbl_refer_t &left_side,
+          const cbl_refer_t &right_side)
+  {
+  /* This routine handles binary integer values that can fit into one, two,
+     four, eight, or sixteen bytes.
+
+     In order to do that, we have to make sure that the normalized comparable
+     values both fit.
+
+     Nomenclature: for short, I will treat a 9(8)v9(3) as 8.3.
+
+     So consider comparing a 32.0 to a 1.9.  To normalize them, I would have to
+     multiply the 32.0 by 10^9, which would mean I would be comparing a
+     32.9 to a 1.9 .  This is mathematically correct; the problem is that an
+     int128 can hold only only 38 digits, and thus can't handle the 41 digits
+     of a 32.9.
+
+     So, in this routine I make sure the two values can be normalized into no
+     more than INT128.  Values that are too large fall through to a library
+     routine that can handle them, albeit in a slower fashion than we aspire to
+     here.     */
+
+  bool compared = false;
+
+  if( refer_is_super_clean(left_side) && refer_is_super_clean(right_side) )
+    {
+    int left_rdigits;
+    int right_rdigits;
+    int ntotal_digits = total_digits( left_rdigits,
+                                      right_rdigits,
+                                      left_side,
+                                      right_side);
+    if( ntotal_digits <= MAX_INT128_DIGITS )
+      {
+      // Our interest is comparison, so we need both left and right to be
+      // big enough to hold ntotal_digits, and we need both to be the same
+      // class of signable.  If signables don't match, we use unsigned, and
+      // we check later for a high-order bit to be on.
+      bool mismatched =    (left_side.field->attr  & signable_e)
+                        != (right_side.field->attr & signable_e) ;
+
+      bool are_signed = mismatched || (left_side.field->attr  & signable_e) ;
+      tree type = type_based_on_digits(ntotal_digits, are_signed);
+
+      get_binary_value(left, left_side, type);
+      get_binary_value(right, right_side, type);
+      // We have two good binary values, and they are the same size.
+
+      // If they were mismatched in signable, they were both assigned to
+      // signed types.  We need to check to see if the one that is
+      // signable was negative.  If so, we return 0 and 1 so that the
+      // test comes out right.
+
+      if(     (left_side.field->attr  & signable_e)
+          && !(right_side.field->attr & signable_e) )
+        {
+        tree signable_type = type_based_on_digits(ntotal_digits, true);
+        IF( gg_cast(signable_type, left),
+            lt_op,
+            gg_cast(signable_type, integer_zero_node) )
+          {
+          gg_assign(left,  gg_cast(type, integer_zero_node));
+          gg_assign(right, gg_cast(type, integer_one_node));
+          }
+        ELSE
+          {
+          }
+        ENDIF
+        }
+      else if(   !(left_side.field->attr  & signable_e)
+              &&  (right_side.field->attr & signable_e) )
+        {
+        tree signable_type = type_based_on_digits(ntotal_digits, true);
+        IF( gg_cast(signable_type, right),
+            lt_op,
+            gg_cast(signable_type, integer_zero_node) )
+          {
+          gg_assign(left,  gg_cast(type, integer_one_node));
+          gg_assign(right, gg_cast(type, integer_zero_node));
+          }
+        ELSE
+          {
+          }
+        ENDIF
+        }
+      // If left_rdigits and right_rdigits are different, then one of the
+      // values needs to be scaled by the other's rdigits:
+
+      static uint64_t powt[] =
+        {
+        1UL,                       // 00
+        10UL,                      // 01
+        100UL,                     // 02
+        1000UL,                    // 03
+        10000UL,                   // 04
+        100000UL,                  // 05
+        1000000UL,                 // 06
+        10000000UL,                // 07
+        100000000UL,               // 08
+        1000000000UL,              // 09
+        10000000000UL,             // 10
+        100000000000UL,            // 11
+        1000000000000UL,           // 12
+        10000000000000UL,          // 13
+        100000000000000UL,         // 14
+        1000000000000000UL,        // 15
+        10000000000000000UL,       // 16
+        };
+
+      while(left_rdigits)
+        {
+        // We need to multiply right by 10^left_rdigits
+        int next = std::min(left_rdigits, 16);
+        left_rdigits -= next;
+        gg_assign(right,
+                  gg_multiply(right,
+                              gg_cast(type,
+                                      build_int_cst_type(ULONG,
+                                                         powt[next]))));
+        }
+      while(right_rdigits)
+        {
+        // We need to multiply left by 10^right_rdigits
+        int next = std::min(right_rdigits, 9);
+        right_rdigits -= next;
+        gg_assign(left,
+                  gg_multiply(left,
+                              gg_cast(type,
+                                      build_int_cst_type(ULONG,
+                                                         powt[next]))));
+        }
+      }
+    compared = true;
+    }
+  else
+    {
+    // One or both are not in working-storage, so we have to use run-time
+    // capacities and rdigits.
+
+    // We will be needing the run-time left_rdigits and right_rdigits
+    tree left_rdigits;
+    tree right_rdigits;
+    total_digits_tree(left_rdigits,
+                      right_rdigits,
+                      left_side,
+                      right_side);
+
+    // Our interest is comparison.
+    tree type = INT128;
+
+    get_binary_value(left, left_side, type);
+    get_binary_value(right, right_side, type);
+
+    // We have two good binary values, and they are the same size.
+
+    // If they were mismatched in signable, they were both assigned to
+    // signed types.  We need to check to see if the one that is
+    // signable was negative.  If so, we return 0 and 1 so that the
+    // test comes out right.
+
+    if(     (left_side.field->attr  & signable_e)
+        && !(right_side.field->attr & signable_e) )
+      {
+      tree signable_type = INT128;
+      IF( gg_cast(signable_type, left),
+          lt_op,
+          gg_cast(signable_type, integer_zero_node) )
+        {
+        gg_assign(left,  gg_cast(type, integer_zero_node));
+        gg_assign(right, gg_cast(type, integer_one_node));
+        }
+      ELSE
+        {
+        }
+      ENDIF
+      }
+    else if(    !(left_side.field->attr  & signable_e)
+              && (right_side.field->attr & signable_e) )
+      {
+      tree signable_type = INT128;
+      IF( gg_cast(signable_type, right),
+          lt_op,
+          gg_cast(signable_type, integer_zero_node) )
+        {
+        gg_assign(left,  gg_cast(type, integer_one_node));
+        gg_assign(right, gg_cast(type, integer_zero_node));
+        }
+      ELSE
+        {
+        }
+      ENDIF
+      }
+
+    // To normalize the positions of decimal points, each number has to be
+    // multiplied by the rdigits of the other
+    gg_assign(right,
+              gg_multiply(right,
+                          gg_call_expr(INT128,
+                                       "__gg__power_of_ten",
+                                       left_rdigits,
+                                       NULL_TREE)));
+    gg_assign(left,
+              gg_multiply(left,
+                          gg_call_expr(INT128,
+                                       "__gg__power_of_ten",
+                                       right_rdigits,
+                                       NULL_TREE)));
+    // The left and right values are ready to be compared
+    compared = true;
+    }
+
+  return compared;
+  }
+
+static void
+alpha_compare_figconst( tree        &left,
+                        tree        &right,
+                  const cbl_refer_t &left_side,
+                  const cbl_refer_t &right_side)
+  {
+  // Call this when you know the right side is a figconst or refer.all
+  cbl_figconst_t figconst_right
+                   = (cbl_figconst_t)(right_side.field->attr & FIGCONST_MASK);
+
+  tree location_left;
+  tree length_left;
+
+  get_location(location_left, left_side);
+  get_length(length_left, left_side);
+
+  const charmap_t *charmap_left =
+                       __gg__get_charmap(left_side.field->codeset.encoding);
+  charmap_t *charmap_right =
+                       __gg__get_charmap(right_side.field->codeset.encoding);
+  cbl_char_t char_right = charmap_right->figconst_character(figconst_right);
+
+  size_t nbytes;
+  char *converted;
+  if( figconst_right )
+    {
+    // Comparing an alphanumeric to a figconst
+    // We need to convert the char_right to the left's encoding:
+    converted = __gg__iconverter(right_side.field->codeset.encoding,
+                                 left_side.field->codeset.encoding,
+                                 &char_right,
+                                 1,
+                                 &nbytes);
+    }
+  else
+    {
+    // Comparing an alphanumeric to ALL <literal>
+    converted = __gg__iconverter(right_side.field->codeset.encoding,
+                                 left_side.field->codeset.encoding,
+                                 right_side.field->data.initial,
+                                 right_side.field->data.capacity(),
+                                 &nbytes);
+    }
+  left  = gg_define_int();
+  right = gg_define_int(0);
+  gg_call(VOID,
+          "__gg__compare_string_all",
+          gg_get_address_of(left),
+          location_left,
+          length_left,
+          build_int_cst_type(INT, charmap_left->stride()),
+          build_string_literal(nbytes, converted),
+          build_int_cst_type(SIZE_T, nbytes),
+          NULL_TREE);
+  }
+
+static bool
+alpha_compare(tree        &left,
+              tree        &right,
+        const cbl_refer_t &left_side,
+        const cbl_refer_t &right_side)
+  {
+  /* This routine handles these cases:
+
+        alpha1 op alpha2
+        national1 op display2
+        display1 op national2  ***
+        alpha op literal
+        literal op alpha       ***
+        alpha op all literal
+        all literal op alpha   ***
+        alpha op figconst
+        figconst op alpha      ***
+        figconst op figconst
+
+     The four cases marked *** are handled by this routine being called a
+     second time with the parameters swapped.  */
+
+  bool retval = false;
+
+  charmap_t *charmap_left  = __gg__get_charmap(left_side.field->codeset.encoding);
+  cbl_figconst_t figconst_left
+                   = (cbl_figconst_t)(left_side.field->attr & FIGCONST_MASK);
+  cbl_char_t char_left  = charmap_left->figconst_character(figconst_left);
+
+  charmap_t *charmap_right = __gg__get_charmap(right_side.field->codeset.encoding);
+  cbl_figconst_t figconst_right
+                   = (cbl_figconst_t)(right_side.field->attr & FIGCONST_MASK);
+  cbl_char_t char_right = charmap_right->figconst_character(figconst_right);
+
+  tree location_left;
+  tree location_right;
+  tree length_left;
+  tree length_right;
+
+  if( figconst_left && figconst_right )
+    {
+    // This is a degenerate case.  Technically it isn't allowed; ISO says that
+    // comparing two literals is a syntax error.  But that's not my department.
+    if( char_left < char_right )
+      {
+      left = integer_minus_one_node;
+      }
+    else if( char_left > char_right)
+      {
+      left = integer_one_node;
+      }
+    else
+      {
+      left = integer_zero_node;
+      }
+    right = integer_zero_node;
+    retval = true;
+    goto done;
+    }
+  else if( figconst_right || right_side.all )
+    {
+    alpha_compare_figconst(left, right, left_side, right_side);
+    retval = true;
+    goto done;
+    }
+  else if(    !figconst_left
+          &&  !figconst_right
+          &&   left_side.field->codeset.encoding
+             != right_side.field->codeset.encoding )
+    {
+    /* We have two different encodings.  The logic chain is:
+       If they have different strides, we convert to the larger one, else
+       If one is national, we convert to it, else
+       If one is display, we convert to it, else
+       We pick one at random.
+
+       In this chain, the winner has to be on the left.  If the winner is on
+       the right, we don't do it now.  It will get caught during the second
+       call to this routine, with the parameters flipped left-for-right.  */
+    bool do_it = false;
+    if( charmap_left->stride() != charmap_right->stride() )
+      {
+      // The strides are different.  Convert when the bigger one is on the
+      // left.
+      do_it = charmap_left->stride() > charmap_right->stride();
+      }
+    else if(   left_side.field->codeset.encoding  == __gg__national_encoding
+            || right_side.field->codeset.encoding == __gg__national_encoding )
+      {
+      // One or the other is national.  We convert when the left one is
+      // national.
+      do_it = left_side.field->codeset.encoding  == __gg__national_encoding;
+      }
+    else if(   left_side.field->codeset.encoding  == __gg__display_encoding
+            || right_side.field->codeset.encoding == __gg__display_encoding )
+      {
+      // One or the other is display.  We convert when the left one is
+      // display.
+      do_it = left_side.field->codeset.encoding  == __gg__display_encoding;
+      }
+    else
+      {
+      // They are the same size, and neither is national or display.  This is
+      // highly weird.  The only thing I can think causing it would be two
+      // files with different speci fied encodings.  Just have the left side
+      // win.
+      do_it = true;
+      }
+    if( do_it )
+      {
+      // Call the library routine that converts the right side to the left
+      // encoding.
+      get_location(location_left, left_side);
+      get_length(length_left, left_side);
+      get_location(location_right, right_side);
+      get_length(length_right, right_side);
+      left  = gg_define_int();
+      right = gg_define_int(0);
+      gg_call(VOID,
+              "__gg_compare_string_different",
+              gg_get_address_of(left),
+              location_left,
+              length_left,
+              build_int_cst_type(INT, left_side.field->codeset.encoding),
+              location_right,
+              length_right,
+              build_int_cst_type(INT, right_side.field->codeset.encoding),
+              NULL_TREE);
+      retval = true;
+      goto done;
+      }
+    }
+  else if(    !figconst_left
+          &&  !figconst_right
+          &&   left_side.field->codeset.encoding
+             == right_side.field->codeset.encoding )
+    {
+    /* The two encodings are the same. */
+
+    // When the difference in lengths of the two strings is bigger than the
+    // magic number, we call the library routine.  The library routine uses
+    // a const string of spaces and memcmp to handle the inferred trailing
+    // spaces of the shorter string.  So, the magic number represents the
+    // crossover of the time for a loop here versus the time for a call to
+    // the library.  I haven't made any effort to find the best value.
+    // R.J.Dubner; 2026-05-08
+    static const long MAGIC_NUMBER = 16;
+
+    // We are going to need the space character in this encoding space:
+    cbl_char_t space_char = charmap_left->mapped_character(ascii_space);
+    const char *the_routine;
+    switch( charmap_left->stride() )
+      {
+      case 1:
+        {
+        // We are single-byte-coded.
+        if( current_function->alphabet_in_use  )
+          {
+          // Call the routine that uses the collation table.
+          the_routine = "__gg__compare_string_1";
+          }
+        else
+          {
+          size_t length_l = left_side.field->data.capacity();
+          size_t length_r = right_side.field->data.capacity();
+          if(    refer_is_super_clean(left_side)
+              && refer_is_super_clean(right_side)
+              && std::abs(   static_cast<long>(length_l)
+                           - static_cast<long>(length_r)) <= MAGIC_NUMBER )
+            {
+            // There is no collation table in use, we are single-byte encoded,
+            // and both variables are in working storage at known locations and
+            // with known lengths.  We can build code that is extremely
+            // efficient.
+            get_location(location_left, left_side);
+            get_location(location_right, right_side);
+            left  = gg_define_int();
+            right = gg_define_int(0);
+            size_t length = std::min(length_l, length_r);
+            gg_assign(left,
+                      gg_memcmp(location_left,
+                                location_right,
+                                build_int_cst_type(SIZE_T,
+                                                   length)));
+            if( length_l > length_r )
+              {
+              // We have a LEFT excess that needs to be compared to the space
+              // char.
+              IF( left, eq_op, integer_zero_node )
+                {
+                tree count = gg_define_int();
+                gg_assign(count, build_int_cst_type(INT,
+                                                   length));
+                WHILE( count, lt_op, build_int_cst_type(INT,
+                                                        length_l) )
+                  {
+                  IF( gg_indirect(location_left, count),
+                      ne_op,
+                      build_int_cst_type(UCHAR, space_char) )
+                    {
+                    // We have a difference.  We need to calculate +1/-1
+                    IF( gg_indirect(location_left, count),
+                        gt_op,
+                        build_int_cst_type(UCHAR, space_char) )
+                      {
+                      gg_assign(left, integer_one_node);
+                      }
+                    ELSE
+                      {
+                      gg_assign(left, integer_minus_one_node);
+                      }
+                    ENDIF
+                    // Force the end of the loop:
+                    gg_assign(count, build_int_cst_type(INT,
+                                                        length_l));
+                    }
+                  ELSE
+                    {
+                    // The *left is a space; keep going
+                    }
+                  ENDIF
+                  gg_increment(count);
+                  }
+                WEND
+                }
+              ELSE
+                {
+                }
+              ENDIF
+              }
+
+            if( length_l < length_r )
+              {
+              // We have a RIGHT excess that needs to be compared to the space
+              // char.
+              IF( left, eq_op, integer_zero_node )
+                {
+                tree count = gg_define_int();
+                gg_assign(count, build_int_cst_type(INT,
+                                                   length));
+                WHILE( count, lt_op, build_int_cst_type(INT,
+                                                        length_r) )
+                  {
+                  IF( gg_indirect(location_right, count),
+                      ne_op,
+                      build_int_cst_type(UCHAR, space_char) )
+                    {
+                    // We have a difference.  We need to calculate +1/-1
+                    IF( gg_indirect(location_right, count),
+                        lt_op,
+                        build_int_cst_type(UCHAR, space_char) )
+                      {
+                      gg_assign(left, integer_one_node);
+                      }
+                    ELSE
+                      {
+                      gg_assign(left, integer_minus_one_node);
+                      }
+                    ENDIF
+                    // Force the end of the loop:
+                    gg_assign(count, build_int_cst_type(INT,
+                                                        length_r));
+                    }
+                  ELSE
+                    {
+                    // The *right is a space; keep going
+                    }
+                  ENDIF
+                  gg_increment(count);
+                  }
+                WEND
+                }
+              ELSE
+                {
+                }
+              ENDIF
+              }
+
+            retval = true;
+            goto done;
+            }
+          // Call the routine that uses does straight byte comparison
+          if( charmap_left->is_like_ebcdic() )
+            {
+            the_routine = "__gg__compare_string_1e";
+            }
+          else
+            {
+            the_routine = "__gg__compare_string_1a";
+            }
+          }
+        break;
+        }
+      case 2:
+        {
+        if( current_function->alphabet_in_use  )
+          {
+          // Call the routine that uses the collation table.
+          the_routine = "__gg__compare_string_2";
+          }
+        else
+          {
+          // Call the routine that uses does straight short comparison
+          the_routine = "__gg__compare_string_2a";
+          }
+        break;
+        }
+      case 4:
+        {
+        if( current_function->alphabet_in_use  )
+          {
+          // Call the routine that uses the collation table.
+          the_routine = "__gg__compare_string_4";
+          }
+        else
+          {
+          // Call the routine that uses does straight short comparison
+          the_routine = "__gg__compare_string_4a";
+          }
+        break;
+        }
+      default:
+        {
+        the_routine = nullptr;
+        gcc_unreachable();
+        break;
+        }
+      }
+    get_location(location_left, left_side);
+    get_length(length_left, left_side);
+    get_location(location_right, right_side);
+    get_length(length_right, right_side);
+    left  = gg_define_int();
+    right = gg_define_int(0);
+    gg_call(VOID,
+            the_routine,
+            gg_get_address_of(left),
+            location_left,
+            length_left,
+            location_right,
+            length_right,
+            build_int_cst_type(INT, space_char),
+            NULL_TREE);
+    retval = true;
+    goto done;
+    }
+
+  done:
+  return retval;
+  }
+
+static bool
+numeric_alpha_compare(tree        &left,
+                      tree        &right,
+                const cbl_refer_t &left_side,
+                const cbl_refer_t &right_side)
+  {
+  /* The ISO specification says
+
+    The integer operand is treated as though it were moved, according to the
+    rules of the MOVE statement, to an elementary data item of the same length
+    in terms of character positions as the number of digits in the integer and
+    after that it is compared to the string.   */
+
+  bool compared = false;
+
+  const charmap_t *charmap_left =
+                          __gg__get_charmap(left_side.field->codeset.encoding);
+
+  charmap_t *charmap_right =
+                         __gg__get_charmap(right_side.field->codeset.encoding);
+  cbl_figconst_t figconst_right
+                   = (cbl_figconst_t)(right_side.field->attr & FIGCONST_MASK);
+  cbl_char_t char_right = charmap_right->figconst_character(figconst_right);
+
+  if( left_side.field->type == FldLiteralN )
+    {
+    // On the left side, we have data.original.  On the right side, we have
+    // some kind of string.
+
+    const char *left_data = left_side.field->data.original();
+    if( *left_data == ascii_minus || *left_data == ascii_plus )
+      {
+      // The rule for moving a numeric to an alphanumeric is that sign
+      // information is discarded.
+      left_data += 1;
+      }
+
+    tree location_left = gg_string_literal(left_data);
+    tree length_left   = build_int_cst_type(
+                                   SIZE_T,
+                                   strlen(left_data));
+
+    if( figconst_right || right_side.all )
+      {
+      size_t nbytes;
+      char *converted;
+      if( figconst_right )
+        {
+        // Comparing an alphanumeric to a figconst
+        // We need to convert the char_right to the left's encoding:
+        converted = __gg__iconverter(right_side.field->codeset.encoding,
+                                     left_side.field->codeset.encoding,
+                                     &char_right,
+                                     1,
+                                     &nbytes);
+        }
+      else
+        {
+        // Comparing an alphanumeric to ALL <literal>
+        converted = __gg__iconverter(right_side.field->codeset.encoding,
+                                     left_side.field->codeset.encoding,
+                                     right_side.field->data.initial,
+                                     right_side.field->data.capacity(),
+                                     &nbytes);
+        }
+      left  = gg_define_int();
+      right = gg_define_int(0);
+      gg_call(VOID,
+              "__gg__compare_string_all",
+              gg_get_address_of(left),
+              location_left,
+              length_left,
+              build_int_cst_type(INT, charmap_left->stride()),
+              build_string_literal(nbytes, converted),
+              build_int_cst_type(SIZE_T, nbytes),
+              NULL_TREE);
+      compared = true;
+      }
+    else if( right_side.field->type == FldLiteralA )
+      {
+      // Corner cases.  One grows to dislike them.  Here we are comparing a
+      // FieldLiteraN to a FldLiteralA
+      left  = gg_define_int();
+      right = gg_define_int(0);
+      tree str = gg_string_literal(right_side.field->data.original());
+      tree length = build_int_cst_type(SIZE_T,
+                                    strlen(right_side.field->data.original()));
+      gg_call( VOID,
+               "__gg__compare_string_1a",
+                gg_get_address_of(left),
+                location_left,
+                length_left,
+                str,
+                length,
+                integer_zero_node,
+                NULL_TREE);
+      compared = true;
+      }
+    }
+  if( !compared )
+    {
+    // The left side is a fixed-point numeric of some kind.  First, we pick
+    // up the actual numeric value.
+
+    // The type of the variable should be straightforward.  It is not.  There
+    // are various considerations in determining the type.
+    tree type;
+    size_t digits = left_side.field->data.digits;
+    tree value;
+    if( digits == 0 )
+      {
+      // This is a pure binary type.
+      type = tree_type_from_size(left_side.field->data.capacity(),
+                                 left_side.field->attr & signable_e);
+      }
+    else
+      {
+      // There is some specified number of digits in the variable:
+      // But if the variable is scaled, we have to multiply by 10^N, where
+      // N is the number of zeroed P digits:
+      if( left_side.field->data.rdigits < 0 )
+        {
+        digits += -left_side.field->data.rdigits;
+        }
+      type = tree_type_from_digits(digits, left_side.field->attr&signable_e);
+      }
+
+    // We have what we need to get the value:
+    get_binary_value(value, left_side, type);
+
+    // We have corner case to deal with here.  When comparing a numeric to a
+    // alphanumeric that is a figconst zero_value_e, we treat the right side
+    // as a numeric zero.
+
+    if( figconst_right == zero_value_e )
+      {
+      left  = gg_define_int();
+      right = gg_define_int(0);
+      gg_assign(left, integer_zero_node);
+      IF( value, lt_op, gg_cast(type, integer_zero_node) )
+        {
+        gg_assign(left, integer_minus_one_node);
+        }
+      ELSE
+        {
+        IF( value, gt_op, gg_cast(type, integer_zero_node) )
+          {
+          gg_assign(left, integer_one_node);
+          }
+        ELSE
+          {
+          }
+        ENDIF
+        }
+      ENDIF
+      compared = true;
+      }
+    else
+      {
+      if( left_side.field->data.rdigits < 0 )
+        {
+        // We need to multiply value by 10^-rdigits
+        gg_assign(value, scale_by_power_of_ten(value,
+                                               build_int_cst_type(INT,
+                                               -left_side.field->data.rdigits)));
+        }
+
+      if( left_side.field->attr&signable_e )
+        {
+        // For numeric-alphabetic comparisons, there are no negative values:
+        gg_assign(value, gg_abs(value));
+        }
+
+      left  = gg_define_int();
+      right = gg_define_int(0);
+
+      if( figconst_right || right_side.all )
+        {
+        size_t nbytes;
+        char *converted;
+        if( figconst_right )
+          {
+          converted = __gg__iconverter(right_side.field->codeset.encoding,
+                                       left_side.field->codeset.encoding,
+                                       &char_right,
+                                       1,
+                                       &nbytes);
+          }
+        else
+          {
+          converted = __gg__iconverter(right_side.field->codeset.encoding,
+                                       left_side.field->codeset.encoding,
+                                       right_side.field->data.original(),
+                                       right_side.field->data.capacity(),
+                                       &nbytes);
+          }
+        left  = gg_define_int();
+        right = gg_define_int(0);
+        gg_call(VOID,
+                "__gg__compare_numeric_all",
+                gg_get_address_of(left),
+                gg_cast(UINT128, value),
+                build_int_cst_type(SIZE_T, digits),
+                build_string_literal(nbytes, converted),
+                build_int_cst_type(SIZE_T, nbytes),
+                build_int_cst_type(INT, left_side.field->codeset.encoding),
+                NULL_TREE);
+        }
+      else
+        {
+        tree location_right;
+        tree length_right;
+        get_location(location_right, right_side);
+        get_length(length_right, right_side);
+
+        gg_call(VOID,
+                "__gg__compare_binary_to_string",
+                gg_get_address_of(left),
+                gg_cast(UINT128, value),
+                build_int_cst_type(SIZE_T, digits),
+                location_right,
+                length_right,
+                build_int_cst_type(INT, right_side.field->codeset.encoding),
+                NULL_TREE);
+        }
+      compared = true;
+      }
+    }
+
+  return compared;
+  }
+
+static bool
+addr_of_compare(tree        &left,
+                tree        &right,
+          const cbl_refer_t &left_side,
+          const cbl_refer_t &right_side)
+  {
+  // One or the other is addr_of
+  tree type = SIZE_T;
+  tree l;
+  tree r;
+  if( left_side.addr_of && !right_side.addr_of )
+    {
+    get_location(l, left_side);
+    get_binary_value(r, right_side, type);
+    }
+  else if( !left_side.addr_of && right_side.addr_of )
+    {
+    get_binary_value(l, left_side, type);
+    get_location(r, right_side);
+    }
+  else
+    {
+    // They are both addr_of.
+    get_location(l, left_side);
+    get_location(r, right_side);
+    }
+  left  = gg_define_int();
+  right = gg_define_int(0);
+
+  gg_assign(left, integer_zero_node);
+  IF( gg_cast(type, l), lt_op, gg_cast(type, r) )
+    {
+    gg_assign(left, integer_minus_one_node);
+    }
+  ELSE
+    {
+    IF( gg_cast(type, l), gt_op, gg_cast(type, r) )
+      {
+      gg_assign(left, integer_one_node);
+      }
+    ELSE
+      {
+      }
+    ENDIF
+    }
+  ENDIF
+
+  return true;
+  }
+
+static bool
+float_compare(tree        &left,
+              tree        &right,
+        const cbl_refer_t &left_side,
+        const cbl_refer_t &right_side)
+  {
+  // left is a float, and if right is also a float it is smaller than left
+  get_binary_value(left, left_side);
+  tree type = TREE_TYPE(left);
+  tree rightv;
+  get_binary_value(rightv, right_side, type);
+  right = gg_define_variable(type);
+  gg_assign(right, gg_cast(type, rightv));
+
+//  gg_printf("KILROY %f %f\n",
+//            gg_cast(DOUBLE, left),
+//            gg_cast(DOUBLE, right),
+//            NULL_TREE);
+
+  if( right_side.field->attr & intermediate_e )
+    {
+    tree rdigits = gg_define_variable(INT);
+    gg_assign(rdigits,
+              gg_cast(INT,
+                      member(right_side.field->var_decl_node, "rdigits")));
+    gg_assign(right,
+              gg_real_divide(right,
+                             gg_cast(type,
+                                     gg_call_expr(INT128,
+                                                  "__gg__power_of_ten",
+                                                  rdigits,
+                                                  NULL_TREE))));
+    }
+  else
+    {
+    int rdigits = right_side.field->data.rdigits;
+    if( right_side.field->attr & scaled_e )
+      {
+      if( rdigits < 0 )
+        {
+        rdigits = -rdigits;
+        }
+      else
+        {
+        rdigits += right_side.field->data.digits ;
+        gg_assign(right,
+                  gg_multiply(right,
+                              gg_cast(type,
+                                      gg_call_expr(INT128,
+                                           "__gg__power_of_ten",
+                                           build_int_cst_type(INT, rdigits),
+                                           NULL_TREE))));
+        rdigits = 0;
+        }
+      }
+    if( rdigits )
+      {
+      gg_assign(right,
+                gg_real_divide(right,
+                               gg_cast(type,
+                                       gg_call_expr(
+                                            INT128,
+                                            "__gg__power_of_ten",
+                                            build_int_cst_type(INT, rdigits),
+                                            NULL_TREE))));
+      }
+    }
+
+  return true;
+  }
+
+static bool
+compare_class( tree        &left,
+               tree        &right,
+         const cbl_refer_t &left_side,
+         const cbl_refer_t &right_side)
+  {
+  // Left side is FldClass
+  left  = gg_define_int();
+  right = gg_define_int(0);
+  tree right_loc;
+  tree right_length;
+  get_location(right_loc, right_side);
+  get_length(right_length, right_side);
+  gg_assign(left,
+            gg_call_expr(INT,
+                         "__gg__compare_field_class",
+                         gg_get_address_of(right_side.field->var_decl_node),
+                         right_loc,
+                         right_length,
+                         gg_get_address_of(left_side.field->var_decl_node),
+                         NULL_TREE));
+  return true;
+  }
+
+void
+cobol_compare_relop(tree        &left,
+                    tree        &right,
+              const cbl_refer_t &left_side,
+              const cbl_refer_t &right_side)
+  {
+  // This routine figures out how to compare left_side to right_side, and
+  // returns the trees 'left' and 'right' in numeric form that can be turned
+  // into a conditional expression.
+
+  bool compared = false;
+
+  if( left_side.field->type == FldClass )
+    {
+    compared = compare_class(left, right, left_side, right_side);
+    }
+
+  if( !compared && right_side.field->type == FldClass )
+    {
+    compared = compare_class(right, left, right_side, left_side);
+    }
+
+  if(!compared && (left_side.addr_of || right_side.addr_of) )
+    {
+    compared = addr_of_compare(left, right, left_side, right_side);
+    }
+
+  if(    !compared
+      && comparably_numeric(left_side) && comparably_numeric(right_side) )
+    {
+    compared = numeric_compare(left, right, left_side, right_side);
+    }
+
+  if(    !compared
+      && comparably_alpha(left_side) && comparably_alpha(right_side) )
+    {
+    compared = alpha_compare(left, right, left_side, right_side);
+    if( !compared )
+      {
+      compared = alpha_compare(right, left, right_side, left_side);
+      }
+    }
+
+  if(  !compared
+     && comparably_numeric(left_side) && comparably_alpha(right_side) )
+    {
+    compared = numeric_alpha_compare(left, right, left_side, right_side);
+    }
+
+  if(  !compared
+     && comparably_numeric(right_side) && comparably_alpha(left_side) )
+    {
+    compared = numeric_alpha_compare(right, left, right_side, left_side);
+    }
+
+  if(   !compared
+     && left_side.field->type == FldFloat
+     && right_side.field->type == FldFloat)
+    {
+    if( left_side.field->data.capacity() >= right_side.field->data.capacity() )
+      {
+      compared = float_compare(left, right, left_side, right_side);
+      }
+    else
+      {
+      compared = float_compare(right, left, right_side, left_side);
+      }
+    }
+
+  if(   !compared
+     &&    (left_side.field->type == FldFloat
+        || right_side.field->type == FldFloat) )
+    {
+    if( left_side.field->type == FldFloat )
+      {
+      compared = float_compare(left, right, left_side, right_side);
+      }
+    else
+      {
+      compared = float_compare(right, left, right_side, left_side);
+      }
+    }
+
+  if( !compared )
+    {
+    gcc_unreachable();
+    }
+  }
diff --git a/gcc/cobol/compare.h b/gcc/cobol/compare.h
new file mode 100644
index 00000000000..d20ac94c32d
--- /dev/null
+++ b/gcc/cobol/compare.h
@@ -0,0 +1,42 @@
+/*
+ * Copyright (c) 2021-2026 Symas Corporation
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ *   notice, this list of conditions and the following disclaimer.
+ * * Redistributions in binary form must reproduce the above`
+ *   copyright notice, this list of conditions and the following disclaimer
+ *   in the documentation and/or other materials provided with the
+ *   distribution.
+ * * Neither the name of the Symas Corporation nor the names of its
+ *   contributors may be used to endorse or promote products derived from
+ *   this software without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+ * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+ * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+ * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+ * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+ * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+ * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+ * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+ * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ */
+#ifndef _COMPARE_H_
+#define _COMPARE_H_
+
+/*  The following routine looks at the two_refers. It creates and returns the
+    "left" and "right" var_decl trees, which can be fed directly into one of
+    the six relational expressions like EQ_EXPR, LT_EXPR, and so on. */
+
+void cobol_compare_relop( tree        &left,
+                          tree        &right,
+                    const cbl_refer_t &left_side,
+                    const cbl_refer_t &right_side);
+
+#endif
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index b83e76815a4..ea28bdaf776 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -55,6 +55,7 @@
 #include "show_parse.h"
 #include "fold-const.h"
 #include "realmpfr.h"
+#include "compare.h"
 
 extern int yylineno;
 
@@ -70,7 +71,7 @@ static tree label_list_back_goto;
 static tree label_list_back_label;
 
 #ifdef ENABLE_HIJACKING
-#pragma message "HIJACKING IS ENABLED - It should be disabled for release"
+//#pragma message "HIJACKING IS ENABLED - It should be disabled for release"
 static bool hijacked = false;  // Indicates a DUBNER hijacking is in progress.
 static void hijack_for_development(const char *funcname);
 static void hijacker();
@@ -128,9 +129,18 @@ static
 void
 treeplet_fill_source(TREEPLET &treeplet, const cbl_refer_t &refer)
   {
-  treeplet.pfield = gg_get_address_of(refer.field->var_decl_node);
-  treeplet.offset = refer_offset(refer);
-  treeplet.length = refer_size_source(refer);
+  if( refer_is_clean(refer) )
+    {
+    treeplet.pfield = gg_get_address_of(refer.field->var_decl_node);
+    treeplet.offset = size_t_zero_node;
+    treeplet.length = refer_size_source(refer);
+    }
+  else
+    {
+    treeplet.pfield = gg_get_address_of(refer.field->var_decl_node);
+    treeplet.offset = refer_offset(refer);
+    treeplet.length = refer_size_source(refer);
+    }
   }
 
 tree file_static_variable(tree type, const char *v)
@@ -1674,7 +1684,7 @@ get_binary_value_from_float(tree         value,
                                                   get_power_of_ten(rdigits)))));
 
   // And we need to throw away any digits to the left of the leftmost digits:
-  // At least, we need to do so in principl.  I am deferring this problem until
+  // At least, we need to do so in principle.  I am deferring this problem until
   // I understand it better.
 
   // We now have a floating point value that has been multiplied by 10**rdigits
@@ -1843,254 +1853,7 @@ get_bytes_needed(cbl_field_t *field)
   return retval;
   }
 
-static void
-normal_normal_compare(bool debugging,
-                      tree return_int,
-                      cbl_refer_t *left_side_ref,
-                      cbl_refer_t *right_side_ref,
-                      tree left_side,
-                      tree right_side )
-  {
-  Analyze();
-
-  // If a value is intermediate_e, then the rdigits can vary at run-time, so
-  // we can't rely on the compile-time rdigits.
-
-  bool left_intermediate  = (left_side_ref->field->attr & intermediate_e);
-  bool right_intermediate = (right_side_ref->field->attr & intermediate_e);
-
-  if( debugging )
-    {
-    gg_printf("normal_normal_compare(): left_intermediate/right_intermediate %d/%d\n",
-              left_intermediate ? integer_one_node : integer_zero_node ,
-              right_intermediate ? integer_one_node : integer_zero_node ,
-              NULL_TREE);
-    }
-
-  if( !left_intermediate && !right_intermediate )
-    {
-    // Yay!  Both sides have fixed rdigit values.
-
-    int adjust =   get_scaled_rdigits(left_side_ref->field)
-                 - get_scaled_rdigits(right_side_ref->field);
-    if( adjust > 0 )
-      {
-      // We need to make right_side bigger to match the scale of left_side
-      scale_by_power_of_ten_N(right_side, adjust);
-      }
-    else if( adjust < 0 )
-      {
-      // We need to make left_side bigger to match the scale of right_side
-      scale_by_power_of_ten_N(left_side, -adjust);
-      }
-    }
-  else
-    {
-    // At least one side is right_intermediate
-    bool needs_adjusting;
-
-    tree adjust;
-    if( !left_intermediate && right_intermediate )
-      {
-      // left is fixed, right is intermediate
-      adjust = gg_define_int();
-      gg_assign(adjust,
-                build_int_cst_type( INT,
-                                    get_scaled_rdigits(left_side_ref->field)));
-
-      gg_assign(adjust,
-                gg_subtract(adjust,
-                            gg_cast(INT,
-                                    member(right_side_ref->field->var_decl_node,
-                                           "rdigits"))));
-      needs_adjusting = true;
-      }
-    else if( left_intermediate && !right_intermediate )
-      {
-      // left is intermediate, right is fixed
-      adjust = gg_define_int();
-      gg_assign(adjust, gg_cast(INT, member(left_side_ref->field, "rdigits")));
-      gg_assign(adjust,
-                gg_subtract(adjust,
-                            build_int_cst_type( INT,
-                                   get_scaled_rdigits(right_side_ref->field))));
-      needs_adjusting = true;
-      }
-    else // if( left_intermediate && right_intermediate )
-      {
-      // Both sides are intermediate_e
-      adjust = gg_define_int();
-      gg_assign(adjust, gg_cast(INT, member(left_side_ref->field, "rdigits")));
-      gg_assign(adjust,
-                gg_subtract(adjust,
-                            gg_cast(INT,
-                                    member(right_side_ref->field, "rdigits"))));
-      needs_adjusting = true;
-      }
-
-    if( needs_adjusting )
-      {
-      if( debugging )
-        {
-        gg_printf("normal_normal_compare(): The value of adjust is %d\n",
-                  adjust,
-                  NULL_TREE);
-        }
-      IF( adjust, gt_op, integer_zero_node )
-        {
-        // The right side needs to be scaled up
-        scale_by_power_of_ten(right_side, adjust);
-        }
-      ELSE
-        {
-        IF( adjust, lt_op, integer_zero_node )
-          {
-          // The left side needs to be scaled up
-          scale_by_power_of_ten(left_side, gg_negate(adjust));
-          }
-        ELSE
-          ENDIF
-        }
-        ENDIF
-      }
-    }
-
-  if( TREE_TYPE(left_side) != TREE_TYPE(right_side) )
-    {
-    // One is signed, the other isn't:
-    if( left_side_ref->field->attr & signable_e )
-      {
-      // The left side can be negative.  If it is, the return value has to be
-      // -1 for left < right
-      IF( left_side, lt_op, gg_cast(TREE_TYPE(left_side), integer_zero_node) )
-        {
-        if( debugging )
-          {
-          gg_printf("normal_normal_compare(): different types returning -1\n",
-                    NULL_TREE);
-          }
-        gg_assign( return_int, integer_minusone_node);
-        }
-      ELSE
-        {
-        // Both sides are positive, allowing a direct comparison.
-        IF( gg_cast(TREE_TYPE(right_side), left_side), lt_op, right_side )
-          {
-          if( debugging )
-            {
-            gg_printf("normal_normal_compare(): returning -1\n", NULL_TREE);
-            }
-          gg_assign( return_int, integer_minusone_node);
-          }
-        ELSE
-          {
-          IF( gg_cast(TREE_TYPE(right_side), left_side), gt_op, right_side)
-            {
-            if( debugging )
-              {
-              gg_printf("normal_normal_compare(): returning +1\n", NULL_TREE);
-              }
-            gg_assign( return_int, integer_one_node);
-            }
-          ELSE
-            {
-            if( debugging )
-              {
-              gg_printf("normal_normal_compare(): returning zero\n", NULL_TREE);
-              }
-            gg_assign( return_int, integer_zero_node);
-            }
-            ENDIF
-          }
-          ENDIF
-        }
-        ENDIF
-      }
-    else
-      {
-      // The right side can be negative.  If it is, the return value has to be
-      // +1 for left > right
-      IF( right_side, lt_op, gg_cast(TREE_TYPE(right_side), integer_zero_node) )
-        {
-        if( debugging )
-          {
-          gg_printf("normal_normal_compare(): different types returning +1\n", NULL_TREE);
-          }
-        gg_assign( return_int, integer_one_node);
-        }
-      ELSE
-        {
-        // Both sides are positive, allowing a direct comparison.
-        IF( left_side, lt_op, gg_cast(TREE_TYPE(left_side), right_side) )
-          {
-          if( debugging )
-            {
-            gg_printf("normal_normal_compare(): returning -1\n", NULL_TREE);
-            }
-          gg_assign( return_int, integer_minusone_node);
-          }
-        ELSE
-          {
-          IF( left_side, gt_op, gg_cast(TREE_TYPE(left_side), right_side) )
-            {
-            if( debugging )
-              {
-              gg_printf("normal_normal_compare(): returning +1\n", NULL_TREE);
-              }
-            gg_assign( return_int, integer_one_node);
-            }
-          ELSE
-            {
-            if( debugging )
-              {
-              gg_printf("normal_normal_compare(): returning zero\n", NULL_TREE);
-              }
-            gg_assign( return_int, integer_zero_node);
-            }
-            ENDIF
-          }
-          ENDIF
-        }
-        ENDIF
-      }
-    }
-  else
-    {
-    // Both sides are the same type, allowing a direct comparison.
-    IF( left_side, lt_op, right_side )
-      {
-      if( debugging )
-        {
-        gg_printf("normal_normal_compare(): returning -1\n", NULL_TREE);
-        }
-      gg_assign( return_int, integer_minusone_node);
-      }
-    ELSE
-      {
-      IF( left_side, gt_op, right_side )
-        {
-        if( debugging )
-          {
-          gg_printf("normal_normal_compare(): returning +1\n", NULL_TREE);
-          }
-        gg_assign( return_int, integer_one_node);
-        }
-      ELSE
-        {
-        if( debugging )
-          {
-          gg_printf("normal_normal_compare(): returning zero\n", NULL_TREE);
-          }
-        gg_assign( return_int, integer_zero_node);
-        }
-        ENDIF
-      }
-      ENDIF
-    }
-  }
-
-static
-tree
+static tree
 tree_type_from_field_type(cbl_field_t *field, size_t &nbytes)
   {
   /*  This routine is used to determine what action is taken with type of a
@@ -2185,382 +1948,6 @@ tree_type_from_field_type(cbl_field_t *field, size_t &nbytes)
   return retval;
   }
 
-static void
-compare_binary_binary(tree return_int,
-                      cbl_refer_t *left_side_ref,
-                      cbl_refer_t *right_side_ref )
-  {
-  Analyze();
-  static const bool debugging = false;
-
-  // We know the two sides have binary values that can be extracted.
-  tree left_side;
-  tree right_side;
-
-  // Let's check for the simplified case where both left and right sides are
-  // little-endian binary values:
-
-  if(   is_pure_integer(left_side_ref->field)
-     && is_pure_integer(right_side_ref->field) )
-    {
-    size_t left_bytes;
-    tree left_type = tree_type_from_field_type(left_side_ref->field,
-                                               left_bytes);
-    size_t right_bytes;
-    tree right_type = tree_type_from_field_type(right_side_ref->field,
-                                                right_bytes);
-    tree larger;
-    if(    TREE_INT_CST_LOW(TYPE_SIZE(left_type))
-         > TREE_INT_CST_LOW(TYPE_SIZE(right_type)) )
-      {
-      larger = left_type;
-      }
-    else
-      {
-      larger = right_type;
-      }
-    left_side  = get_binary_value_tree(larger,
-                                       NULL,
-                                       *left_side_ref);
-    right_side = get_binary_value_tree(larger,
-                                       NULL,
-                                       *right_side_ref);
-    IF( left_side, eq_op, right_side )
-      {
-      gg_assign(return_int, integer_zero_node);
-      }
-    ELSE
-      {
-      IF( left_side, lt_op, right_side )
-        {
-        gg_assign(return_int, integer_minusone_node);
-        }
-      ELSE
-        {
-        gg_assign(return_int, integer_one_node);
-        }
-      ENDIF
-      }
-    ENDIF
-    return;
-    }
-
-  // Use SIZE128 when we need two 64-bit registers to hold the value.  All
-  // others fit into 64-bit LONG with pretty much the same efficiency.
-
-  size_t left_bytes_needed  = get_bytes_needed(left_side_ref->field);
-  size_t right_bytes_needed = get_bytes_needed(right_side_ref->field);
-
-  if(     left_bytes_needed >= SIZE128
-      || right_bytes_needed >= SIZE128 )
-    {
-    if( debugging )
-      {
-      gg_printf("compare_binary_binary(): using int128\n", NULL_TREE);
-      }
-
-    left_side  = gg_define_int128();
-    right_side = gg_define_int128();
-    }
-  else
-    {
-    if( debugging )
-      {
-      gg_printf("compare_binary_binary(): using int64\n", NULL_TREE);
-      }
-    left_side  = gg_define_variable( left_side_ref->field->has_attr(signable_e) ? LONG : ULONG );
-    right_side = gg_define_variable(right_side_ref->field->has_attr(signable_e) ? LONG : ULONG );
-    }
-
-  //tree dummy = gg_define_int();
-  static tree hilo_left  = gg_define_variable(INT, "..cbb_hilo_left",  vs_file_static);
-  static tree hilo_right = gg_define_variable(INT, "..cbb_hilo_right", vs_file_static);
-
-  get_binary_value(left_side,
-                   NULL,
-                   left_side_ref->field,
-                   refer_offset(*left_side_ref),
-                   hilo_left);
-  get_binary_value(right_side,
-                   NULL,
-                   right_side_ref->field,
-                   refer_offset(*right_side_ref),
-                   hilo_right);
-
-  IF( hilo_left, eq_op, integer_one_node )
-    {
-    // left side is hi-value
-    IF( hilo_right, eq_op, integer_one_node )
-      {
-      if( debugging )
-        {
-        gg_printf("compare_binary_binary(): left and right are HIGH-VALUE\n", NULL_TREE);
-        }
-      gg_assign(return_int, integer_zero_node);
-      }
-    ELSE
-      {
-      if( debugging )
-        {
-        gg_printf("compare_binary_binary(): left is HIGH-VALUE\n", NULL_TREE);
-        }
-      gg_assign(return_int, integer_one_node);
-      }
-      ENDIF
-    }
-  ELSE
-    {
-    // left is not HIGH-VALUE:
-    IF( hilo_left, eq_op, integer_minus_one_node )
-      {
-      // left side is LOW-VALUE
-      IF( hilo_right, eq_op, integer_minus_one_node )
-        {
-        if( debugging )
-          {
-          gg_printf("compare_binary_binary(): left and right are LOW-VALUE\n", NULL_TREE);
-          }
-        gg_assign(return_int, integer_zero_node);
-        }
-      ELSE
-        {
-        // Right side is not low-value
-        if( debugging )
-          {
-          gg_printf("compare_binary_binary(): left is LOW-VALUE\n", NULL_TREE);
-          }
-        gg_assign(return_int, integer_one_node);
-        }
-        ENDIF
-      }
-    ELSE
-      {
-      // Left side is normal
-      IF( hilo_right, eq_op, integer_one_node )
-        {
-        if( debugging )
-          {
-          gg_printf("compare_binary_binary(): right is HIGH-VALUE\n", NULL_TREE);
-          }
-        gg_assign(return_int, integer_minus_one_node);
-        }
-      ELSE
-        {
-        IF( hilo_right, eq_op, integer_minus_one_node )
-          {
-          if( debugging )
-            {
-            gg_printf("compare_binary_binary(): right is LOW-VALUE\n", NULL_TREE);
-            }
-          gg_assign(return_int, integer_one_node);
-          }
-        ELSE
-          {
-          if( debugging )
-            {
-            gg_printf("compare_binary_binary(): left and right are normal\n", NULL_TREE);
-            }
-          normal_normal_compare(debugging,
-                                return_int,
-                                left_side_ref,
-                                right_side_ref,
-                                left_side,
-                                right_side
-                                );
-          }
-          ENDIF
-        }
-        ENDIF
-      }
-      ENDIF
-    }
-    ENDIF
-  }
-
-#define DEBUG_COMPARE
-
-static void
-cobol_compare(  tree return_int,
-                cbl_refer_t &left_side_ref,
-                cbl_refer_t &right_side_ref )
-  {
-  Analyze();
-// gg_printf("cobol_compare %s %s \"%s\" \"%s\"\n",
-          // gg_string_literal(left_side_ref.field->name),
-          // gg_string_literal(right_side_ref.field->name),
-          // member(left_side_ref.field, "data"),
-          // gg_string_literal(right_side_ref.field->data.original()),
-          // NULL_TREE);
-
-  CHECK_FIELD(left_side_ref.field);
-  CHECK_FIELD(right_side_ref.field);
-  // This routine is in support of conditionals in the COBOL program.
-  // It takes two arbitrary COBOL variables from the parser and compares them
-  // according to a nightmarish set of rules.
-
-  // See ISO/IEC 1989:2014(E) section 8.8.4.1.1 (page 153)
-
-  // The return_int value is -1 when left_side  < right_side
-  //                          0      left_side == right_side
-  //                          1      left_side  > right_side
-
-  bool compared = false;
-
-  // In the effort to convert to in-line GIMPLE comparisons, I became flummoxed
-  // by comparisons involving REFMODs.  This will have to be revisited, but for
-  // now I decided to keep using the libgcobol code, which according to NIST
-  // works properly.
-
-  if(    !left_side_ref.refmod.from
-      && !left_side_ref.refmod.len
-      && !right_side_ref.refmod.from
-      && !right_side_ref.refmod.len )
-    {
-    cbl_refer_t *lefty = &left_side_ref;
-    cbl_refer_t *righty = &right_side_ref;
-
-    int ntries = 1;
-    while( ntries <= 2 )
-      {
-      switch( lefty->field->type )
-        {
-        case FldLiteralN:
-          {
-          switch( righty->field->type )
-            {
-            case FldLiteralN:
-            case FldNumericBinary:
-            case FldNumericBin5:
-            case FldPacked:
-            case FldNumericDisplay:
-            case FldIndex:
-              compare_binary_binary(return_int, lefty, righty);
-              compared = true;
-              break;
-
-            case FldGroup:
-            case FldAlphanumeric:
-              {
-              // Comparing a FldLiteralN to an alphanumeric.  The alphanumeric
-              // is encoded in its codeset.encoding, but the FldLiteralN is,
-              // in accordance with the rules in cbl_field_t::internalize,
-              // encoded in the source-code encoding.  The routine we are about
-              // to call assumes that the literal string is encoded the same
-              // as the alphanumeric, so we have to make it match.
-              size_t outlength;
-              cbl_encoding_t enc_right = righty->field->codeset.encoding;
-              char *converted = __gg__iconverter(
-                                         DEFAULT_SOURCE_ENCODING,
-                                         enc_right,
-                                         lefty->field->data.original(),
-                                         strlen(lefty->field->data.original()),
-                                         &outlength );
-              gg_assign(  return_int, gg_call_expr(
-                          INT,
-                          "__gg__literaln_alpha_compare",
-                          gg_string_literal(converted),
-                          gg_get_address_of(righty->field->var_decl_node),
-                          refer_offset(*righty),
-                          refer_size_source(  *righty),
-                          build_int_cst_type(INT,
-                                        (righty->all ? REFER_T_MOVE_ALL : 0)),
-                          NULL_TREE));
-              compared = true;
-              break;
-              }
-
-            case FldLiteralA:
-              {
-              // Comparing a FldLiteralN to an FldLiteralA.
-              // lefty->field->data.original() is the numeric string in ASCII.
-              // righty->field->data.original() is original alphanumeric
-              // string in ASCII.
-              int icmp = strcmp(lefty->field->data.original(),
-                                righty->field->data.original());
-              gg_assign(return_int, build_int_cst_type(INT, icmp));
-              compared = true;
-              break;
-              }
-
-
-            default:
-              break;
-            }
-          break;
-          }
-
-        case FldNumericBin5:
-        case FldNumericBinary:
-        case FldPacked:
-        case FldNumericDisplay:
-          {
-          switch( righty->field->type )
-            {
-            case FldNumericBin5:
-            case FldNumericBinary:
-            case FldPacked:
-            case FldNumericDisplay:
-              {
-              compare_binary_binary(return_int, lefty, righty);
-              compared = true;
-              break;
-              }
-
-            default:
-              break;
-            }
-          break;
-          }
-
-        default:
-          break;
-        }
-      if( compared )
-        {
-        break;
-        }
-      // We weren't able to compare left/right.  Let's see if we understand
-      // right/left
-      std::swap(lefty, righty);
-      ntries += 1;
-      }
-
-    if( compared && ntries == 2 )
-      {
-      // We have a successful comparision, but we managed it on the second try,
-      // which means our result has the wrong sign.  Fix it:
-      gg_assign(return_int, gg_negate(return_int));
-      }
-    }
-
-  if( !compared )
-    {
-    // None of our explicit comparisons up above worked, so we revert to the
-    // general case:
-    int leftflags  =   (left_side_ref.all          ? REFER_T_MOVE_ALL   : 0)
-                    +  (left_side_ref.addr_of      ? REFER_T_ADDRESS_OF : 0)
-                    +  (left_side_ref.refmod.from  ? REFER_T_REFMOD     : 0);
-    int rightflags =   (right_side_ref.all         ? REFER_T_MOVE_ALL   : 0)
-                    +  (right_side_ref.addr_of     ? REFER_T_ADDRESS_OF : 0)
-                    +  (right_side_ref.refmod.from ? REFER_T_REFMOD     : 0);
-
-    gg_assign(  return_int, gg_call_expr(
-                INT,
-                "__gg__compare",
-                gg_get_address_of(left_side_ref.field->var_decl_node),
-                refer_offset(left_side_ref),
-                refer_size_source(  left_side_ref),
-                build_int_cst_type(INT, leftflags),
-                gg_get_address_of(right_side_ref.field->var_decl_node),
-                refer_offset(right_side_ref),
-                refer_size_source(  right_side_ref),
-                build_int_cst_type(INT, rightflags),
-                integer_zero_node,
-                NULL_TREE));
-    // compared = true;  // Commented out to quiet cppcheck
-    }
-  }
-
 static char *
 combined_name(const cbl_label_t *label)
   {
@@ -3604,23 +2991,6 @@ parser_enter_file(const char *filename)
     SET_VAR_DECL(var_decl_call_parameter_lengths   , build_array_type(SIZE_T, NULL),
                                                             "__gg__call_parameter_lengths");
 
-    SET_VAR_DECL(var_decl_arithmetic_rounds_size  , SIZE_T , "__gg__arithmetic_rounds_size");
-    SET_VAR_DECL(var_decl_arithmetic_rounds       , INT_P  , "__gg__arithmetic_rounds");
-    SET_VAR_DECL(var_decl_fourplet_flags_size     , SIZE_T , "__gg__fourplet_flags_size");
-    SET_VAR_DECL(var_decl_fourplet_flags          , INT_P  , "__gg__fourplet_flags");
-
-    SET_VAR_DECL(var_decl_treeplet_1f             , cblc_field_pp_type_node , "__gg__treeplet_1f"     );
-    SET_VAR_DECL(var_decl_treeplet_1o             , SIZE_T_P                , "__gg__treeplet_1o"     );
-    SET_VAR_DECL(var_decl_treeplet_1s             , SIZE_T_P                , "__gg__treeplet_1s"     );
-    SET_VAR_DECL(var_decl_treeplet_2f             , cblc_field_pp_type_node , "__gg__treeplet_2f"     );
-    SET_VAR_DECL(var_decl_treeplet_2o             , SIZE_T_P                , "__gg__treeplet_2o"     );
-    SET_VAR_DECL(var_decl_treeplet_2s             , SIZE_T_P                , "__gg__treeplet_2s"     );
-    SET_VAR_DECL(var_decl_treeplet_3f             , cblc_field_pp_type_node , "__gg__treeplet_3f"     );
-    SET_VAR_DECL(var_decl_treeplet_3o             , SIZE_T_P                , "__gg__treeplet_3o"     );
-    SET_VAR_DECL(var_decl_treeplet_3s             , SIZE_T_P                , "__gg__treeplet_3s"     );
-    SET_VAR_DECL(var_decl_treeplet_4f             , cblc_field_pp_type_node , "__gg__treeplet_4f"     );
-    SET_VAR_DECL(var_decl_treeplet_4o             , SIZE_T_P                , "__gg__treeplet_4o"     );
-    SET_VAR_DECL(var_decl_treeplet_4s             , SIZE_T_P                , "__gg__treeplet_4s"     );
     SET_VAR_DECL(var_decl_nop                     , INT                     , "__gg__nop"             );
     SET_VAR_DECL(var_decl_main_called             , INT                     , "__gg__main_called"     );
     SET_VAR_DECL(var_decl_entry_index             , SIZE_T                  , "__gg__entry_index"     );
@@ -3850,7 +3220,7 @@ parser_enter_program( const char *funcname_,
     }
 
 #ifdef ENABLE_HIJACKING
-  if( strcmp(funcname, "dubner") == 0)
+  if( strcmp(funcname, "dubner_h") == 0)
     {
     fprintf(stderr, "This is a DUBNER hijacking\n");
     hijack_for_development(funcname);
@@ -4463,30 +3833,160 @@ dirty_to_binary(const char  *instring,
     capacity = 1;
     }
 
-  value *= sign;
-
-  // One last adjustment.  The number is signable, so the binary value
-  // is going to be treated as twos complement.  That means that the highest
-  // bit has to be 1 for negative signable numbers, and 0 for positive.  If
-  // necessary, adjust capacity up by one byte so that the variable fits:
-
-  if( capacity < 16 && (attr & signable_e) )
+  value *= sign;
+
+  // One last adjustment.  The number is signable, so the binary value
+  // is going to be treated as twos complement.  That means that the highest
+  // bit has to be 1 for negative signable numbers, and 0 for positive.  If
+  // necessary, adjust capacity up by one byte so that the variable fits:
+
+  if( capacity < 16 && (attr & signable_e) )
+    {
+    FIXED_WIDE_INT(128) mask
+      = wi::set_bit_in_zero<FIXED_WIDE_INT(128)>(capacity * 8 - 1);
+    if( wi::neg_p (value) && (value & mask) == 0 )
+      {
+      capacity *= 2;
+      }
+    else if( !wi::neg_p (value) && (value & mask) != 0 )
+      {
+      capacity *= 2;
+      }
+    }
+
+  return value;
+  }
+
+static tree
+data_decl_type_for(cbl_field_t *field)
+  {
+  // The idea behind this function is to provide a useful data_type for the
+  // the data_decl_node for the field.  Where we can get it right, we do, like
+  // for little-endian FldNumericBin3.  For other types of 1, 2, 4, 8, or 16
+  // bytes, we alias it to uint8_t, uint16_t, and so on.  The idea there is to
+  // be able to create efficient GENERIC for doing moves between identical
+  // types.  Otherwise we generate a type for an array of uint8_t.
+  tree retval = NULL_TREE;
+  switch(field->type)
+    {
+    case FldGroup:
+      break;
+    case FldAlphanumeric:
+      break;
+    case FldNumericBinary:
+      break;
+    case FldFloat:
+      if( field->attr & ieeedec_e )
+        {
+        cbl_internal_error("%s: called with the unimplemented %s flag for %s",
+                            __func__,
+                            "IEEE",
+                            field->name);
+        }
+      switch(field->data.capacity())
+        {
+        case 4:
+          retval = FLOAT;
+          break;
+        case 8:
+          retval = DOUBLE;
+          break;
+        case 16:
+          retval = FLOAT128;
+          break;
+        }
+      break;
+    case FldPacked:
+      break;
+    case FldNumericBin5:
+      if( field->attr & signable_e )
+        {
+        // Because it is signable, we handle it here.  Unsigned fall through
+        // to the default handler
+        switch(field->data.capacity())
+          {
+          case 1:
+            retval = CHAR;
+            break;
+          case 2:
+            retval = SHORT;
+            break;
+          case 4:
+            retval = INT;
+            break;
+          case 8:
+            retval = LONG;
+            break;
+          case 16:
+            retval = INT128;
+            break;
+          default:
+            cbl_internal_error("%s: called with type %s but strange byte count for %s",
+                                __func__,
+                                cbl_field_type_str(field->type),
+                                field->name);
+            retval = NULL_TREE;
+            break;
+          }
+        }
+      break;
+    case FldNumericDisplay:
+      break;
+    case FldNumericEdited:
+      break;
+    case FldAlphaEdited:
+      break;
+    case FldClass:
+      // Doesn't actually need storage, but we give it one character to avoid
+      // having a NULL data pointer.
+      retval = UCHAR;
+      break;
+    case FldIndex:
+      break;
+    case FldPointer:
+      break;
+    default:
+      cbl_internal_error("%s: called with type %s for %s",
+                          __func__,
+                          cbl_field_type_str(field->type),
+                          field->name);
+      retval = NULL_TREE;
+      break;
+    }
+  // At this point, if there isn't already an assigned type, we specify an
+  // unsigned integer scalar if we can, and otherwise an array of uint8_t.
+
+  if( !retval )
     {
-    FIXED_WIDE_INT(128) mask
-      = wi::set_bit_in_zero<FIXED_WIDE_INT(128)>(capacity * 8 - 1);
-    if( wi::neg_p (value) && (value & mask) == 0 )
+    size_t bytes_needed = std::max(field->data.memsize,
+                                                 field->data.capacity());
+    switch(bytes_needed)
       {
-      capacity *= 2;
-      }
-    else if( !wi::neg_p (value) && (value & mask) != 0 )
-      {
-      capacity *= 2;
+      case 1:
+        retval = UCHAR;
+        break;
+      case 2:
+        retval = USHORT;
+        break;
+      case 4:
+        retval = UINT;
+        break;
+      case 8:
+        retval = ULONG;
+        break;
+      case 16:
+        retval = UINT128;
+        break;
+      default:
+        retval = build_array_type_nelts(UCHAR, bytes_needed);
+        break;
       }
     }
 
-  return value;
+  return retval;
   }
 
+
 static void
 psa_FldLiteralN(struct cbl_field_t *field )
   {
@@ -5350,6 +4850,8 @@ parser_alphabet_use( cbl_alphabet_t& alphabet )
 
   uint64_t alphabet_index = symbol_unique_index(symbol_elem_of(&alphabet));
 
+  current_function->alphabet_in_use = true;
+
   switch(alphabet.encoding)
     {
     default:
@@ -5775,9 +5277,26 @@ parser_display( const struct cbl_special_name_t *upon,
     parser_display_internal(file_descriptor, refs[i], DISPLAY_NO_ADVANCE);
     }
   CHECK_FIELD(refs[n-1].field);
-  parser_display_internal(file_descriptor,
-                          refs[n-1],
-                          advance ? DISPLAY_ADVANCE : DISPLAY_NO_ADVANCE);
+
+  if(    upon
+      && upon->id == SYSPUNCH_e
+      && getenv("ASSEMBLER")
+      && refs[n-1].field
+      && refs[n-1].field->type == FldLiteralA )
+    {
+    // That combination means we want to put the text into the assembly
+    // language.  This is a compile-time operation, so the field has to be
+    // a FldLiteralA.
+    gg_insert_into_assemblerf( "%s %s",
+                              ASM_COMMENT_START,
+                              refs[n-1].field->data.original());
+    }
+  else
+    {
+    parser_display_internal(file_descriptor,
+                            refs[n-1],
+                            advance ? DISPLAY_ADVANCE : DISPLAY_NO_ADVANCE);
+    }
   if( needs_closing )
     {
     gg_close(file_descriptor);
@@ -6613,14 +6132,13 @@ program_end_stuff(cbl_refer_t refer,
   // We need the just_once state because this routine can be called more than
   // once.  Usually the parser handles it, but we have a "just-in-case" call
   // in parser_end_program() that sometimes is necessary.
-  if(just_once && strcmp(current_function->our_name, "hijack") == 0)
+  if(just_once && strcmp(current_function->our_name, "hijack_h") == 0)
     {
     just_once = false;
     fprintf(stderr, "This is a HIJACK BEFORE EXIT scenario.\n");
     hijacker();
     }
 #endif
-
   // This is the moral equivalent of a C "return xyz;".
 
   // There cannot be both a non-zero exit status and an exception condition.
@@ -7876,10 +7394,10 @@ parser_division(cbl_division_t division,
     // Stash the returning variables for use during parser_return()
     current_function->returning = returning;
 
+    cbl_field_t *return_code = cbl_field_of(symbol_at(return_code_register()));
     current_function->var_decl_return =
-    gg_indirect(gg_cast(SHORT_P,
-        member(cbl_field_of(symbol_at(return_code_register()))->var_decl_node,
-               "data")));
+            gg_indirect(gg_cast(SHORT_P,
+                                member(return_code->var_decl_node, "data")));
 
     if( gg_trans_unit.function_stack.size() == 1 )
       {
@@ -7963,7 +7481,6 @@ parser_division(cbl_division_t division,
       {
       }
     ENDIF
-
     current_function->pseudo_return_index =
                 gg_define_variable(SIZE_T, "_pseudo_return_index", vs_static);
 
@@ -8049,18 +7566,6 @@ parser_logop( struct cbl_field_t *tgt,
       }
     }
 
-  switch(logop)
-    {
-    case and_op:
-    case or_op:
-    case xor_op:
-    case xnor_op:
-      CHECK_FIELD(a);
-      break;
-    default:
-      break;
-    }
-
   // This routine takes two conditionals and a logical operator.  From those,
   // it creates and returns another conditional:
 
@@ -8086,55 +7591,55 @@ parser_logop( struct cbl_field_t *tgt,
   switch( logop )
     {
     case and_op:
-      gg_assign(tgt->var_decl_node, gg_build_logical_expression(
-                  a->var_decl_node,
-                  and_op,
-                  b->var_decl_node));
+      tgt->var_decl_node = gg_build_logical_expression(
+                        a->var_decl_node,
+                        and_op,
+                        b->var_decl_node);
       break;
 
     case or_op:
-      gg_assign(tgt->var_decl_node, gg_build_logical_expression(
+      tgt->var_decl_node = gg_build_logical_expression(
                   a->var_decl_node,
                   or_op,
-                  b->var_decl_node));
+                  b->var_decl_node);
       break;
 
     case not_op:
-      gg_assign(tgt->var_decl_node, gg_build_logical_expression(
+      tgt->var_decl_node = gg_build_logical_expression(
                   NULL,
                   not_op,
-                  b->var_decl_node));
+                  b->var_decl_node);
       break;
 
     case xor_op:
-      gg_assign(tgt->var_decl_node, gg_build_logical_expression(
+      tgt->var_decl_node = gg_build_logical_expression(
                   a->var_decl_node,
                   xor_op,
-                  b->var_decl_node));
+                  b->var_decl_node);
       break;
 
     case xnor_op:
       {
-      gg_assign(  tgt->var_decl_node,
+      tgt->var_decl_node =
                   gg_build_logical_expression(a->var_decl_node,
                                               xor_op,
-                                              b->var_decl_node));
+                                              b->var_decl_node);
 
       // I need to negate the result.
 
-      gg_assign(tgt->var_decl_node, gg_build_logical_expression(
+      tgt->var_decl_node = gg_build_logical_expression(
                   NULL,
                   not_op,
-                  tgt->var_decl_node));
+                  tgt->var_decl_node);
       }
     break;
 
     case true_op:
-      gg_assign(tgt->var_decl_node, boolean_true_node);
+      tgt->var_decl_node = boolean_true_node;
       break;
 
     case false_op:
-      gg_assign(tgt->var_decl_node, boolean_false_node);
+      tgt->var_decl_node = boolean_false_node;
       break;
     }
 
@@ -8190,17 +7695,12 @@ parser_relop(   cbl_field_t *tgt,
                        tgt->name);
     }
 
-  static tree comp_res = gg_define_variable(INT, "..pr_comp_res", vs_file_static);
-  cobol_compare(comp_res, aref, bref);
-
-  // comp_res is negative, zero, position for less-than, equal-to, greater-than
-
-  // So, we simply compare the result of the comparison to zero using the relop
-  // we were given to turn it into a TRUE/FALSE
-  gg_assign(  tgt->var_decl_node,
-              gg_build_relational_expression( comp_res,
-                  relop,
-                  integer_zero_node));
+  tree left;
+  tree right;
+  cobol_compare_relop(left, right, aref, bref);
+  tgt->var_decl_node = gg_build_relational_expression(left,
+                                                      relop,
+                                                      right);
   TRACE1
     {
     TRACE1_INDENT
@@ -8246,7 +7746,6 @@ parser_relop_long(cbl_field_t *tgt,
 
   // This routine builds the relational expression and returns the TREE as
   // a conditional:
-
   if( tgt->type != FldConditional )
     {
     cbl_internal_error("%<parser_relop()%> was called with variable %s, "
@@ -8255,12 +7754,12 @@ parser_relop_long(cbl_field_t *tgt,
     }
 
   tree tree_a  = build_int_cst_type(LONG, avalue);
-  static tree tree_b  = gg_define_variable(LONG, "..prl_tree_b", vs_file_static);
+  tree tree_b  = gg_define_variable(LONG);
   get_binary_value( tree_b,
                     NULL,
                     bref.field,
                     refer_offset(bref) );
-  static tree comp_res = gg_define_variable(LONG, "..prl_comp_res", vs_file_static);
+  tree comp_res = gg_define_variable(LONG);
   gg_assign(comp_res, gg_subtract(tree_a, tree_b));
 
   // comp_res is negative, zero, position for less-than, equal-to, greater-than
@@ -11075,7 +10574,7 @@ inspect_tally(bool backward,
   gcc_assert(pcbl_index == n_resolveds);
 
   // We have built up an array of integers, and an array of cbl_refer_t.
-  build_array_of_treeplets(1, pcbl_index, pcbl_refers.data());
+  tree params = build_array_of_referlets(pcbl_index, pcbl_refers.data());
 
   // Do the actual call:
   charmap_t *charmap = __gg__get_charmap(identifier_1.field->codeset.encoding);
@@ -11086,6 +10585,7 @@ inspect_tally(bool backward,
             "__gg__inspect_format_1_sbc",
             backward ? integer_one_node : integer_zero_node,
             integers,
+            params,
             NULL_TREE);
     }
   else
@@ -11094,6 +10594,7 @@ inspect_tally(bool backward,
             "__gg__inspect_format_1",
             backward ? integer_one_node : integer_zero_node,
             integers,
+            params,
             NULL_TREE);
     }
   }
@@ -11290,13 +10791,14 @@ inspect_replacing(int backward,
       }
     }
 
-  build_array_of_treeplets(1, pcbl_index, pcbl_refers.data());
+  tree params = build_array_of_referlets(pcbl_index, pcbl_refers.data());
 
   // Do the actual call:
   gg_call(VOID,
           "__gg__inspect_format_2",
           backward ? integer_one_node : integer_zero_node,
           integers,
+          params,
           NULL_TREE);
   }
 
@@ -11540,11 +11042,13 @@ parser_intrinsic_subst( cbl_field_t *f,
 
   tree control = gg_array_of_bytes(argc, control_bytes);
 
-  build_array_of_treeplets(1, argc, arg1.data());
-  build_array_of_treeplets(2, argc, arg2.data());
+  tree ref_arg1 = build_array_of_referlets(argc, arg1.data());
+  tree ref_arg2 = build_array_of_referlets(argc, arg2.data());
 
   gg_call(VOID,
           "__gg__substitute",
+          ref_arg1,
+          ref_arg2,
           gg_get_address_of(f->var_decl_node),
           gg_get_address_of(ref1.field->var_decl_node),
           refer_offset(ref1),
@@ -11599,12 +11103,13 @@ parser_intrinsic_callv( cbl_field_t *tgt,
   store_location_stuff(function_name);
   tree ncount = build_int_cst_type(SIZE_T, nrefs);
 
-  build_array_of_fourplets(1, nrefs, refs);
+  tree refers = build_array_of_refers(nrefs, refs);
 
   gg_call(VOID,
           function_name,
           gg_get_address_of(tgt->var_decl_node),
           ncount,
+          refers,
           NULL_TREE);
 
   TRACE1
@@ -11815,10 +11320,6 @@ parser_intrinsic_call_1( cbl_field_t *tgt,
       TRACE1_INDENT
       TRACE1_REFER("parameter: ", ref1, "")
       }
-            gg_get_address_of(tgt->var_decl_node);
-            gg_get_address_of(ref1.field->var_decl_node);
-            refer_offset(ref1);
-            refer_size_source(ref1);
 
     gg_call(VOID,
             function_name,
@@ -12325,9 +11826,6 @@ parser_bsearch_start(   cbl_label_t* name,
   gg_assign(bsearch->left, build_int_cst_type(LONG, 1));
   depending_on_value(bsearch->right, current);
 
-  // Create the variable that will take the compare result.
-  bsearch->compare_result = gg_define_int();
-
   // We now jump to the top of the binary testing loop, which comes right
   // after the labels where we handle non-equal cases:
   gg_append_statement(bsearch->top.go_to);
@@ -12452,8 +11950,8 @@ done:
 
 void
 parser_bsearch_when(cbl_label_t* name,
-                    cbl_refer_t key,
-                    cbl_refer_t sarg,
+              const cbl_refer_t &key,
+              const cbl_refer_t &sarg,
                     bool ascending)
   {
   Analyze();
@@ -12469,28 +11967,32 @@ parser_bsearch_when(cbl_label_t* name,
     }
   cbl_bsearch_t *bsearch = name->structs.bsearch;
 
+  tree left;
+  tree right;
   if( ascending )
     {
-    cobol_compare(  bsearch->compare_result,
-                    key,
-                    sarg );
+    cobol_compare_relop(left, right, key, sarg);
     }
   else
     {
-    cobol_compare(  bsearch->compare_result,
-                    sarg,
-                    key );
+    cobol_compare_relop(left, right, sarg, key);
     }
 
-  IF( bsearch->compare_result, lt_op, integer_zero_node )
-  // The key is smaller than sarg:
-  gg_append_statement(bsearch->too_small.go_to);
-  ELSE
-  ENDIF
-  IF( bsearch->compare_result, gt_op, integer_zero_node )
-  // The key is larger than sarg:
-  gg_append_statement(bsearch->too_big.go_to);
+  IF( left, lt_op, right )
+    {
+    gg_append_statement(bsearch->too_small.go_to);
+    }
   ELSE
+    {
+    IF( left, gt_op, right )
+      {
+      gg_append_statement(bsearch->too_big.go_to);
+      }
+    ELSE
+      {
+      }
+    ENDIF
+    }
   ENDIF
 
   // We are at the Goldilocks point.  The clause has been satisfied with
@@ -13358,15 +12860,19 @@ parser_unstring(cbl_refer_t src,
 
   tree t_alls         = build_string_literal(ndelimited+1, alls);
 
-  build_array_of_treeplets(1, ndelimited, delims.data());
-  build_array_of_treeplets(2, noutputs,   outputs);
-  build_array_of_treeplets(3, noutputs,   delimiters);
-  build_array_of_treeplets(4, noutputs,   counts);
+  tree ref_data       = build_array_of_referlets(ndelimited, delims.data());
+  tree ref_outputs    = build_array_of_referlets(noutputs,   outputs);
+  tree ref_delimiters = build_array_of_referlets(noutputs,   delimiters);
+  tree ref_counts     = build_array_of_referlets(noutputs,   counts);
 
   tree t_overflow = gg_define_int();
   gg_assign(t_overflow,
             gg_call_expr( INT,
                           "__gg__unstring",
+                          ref_data,
+                          ref_outputs,
+                          ref_delimiters,
+                          ref_counts,
                           gg_get_address_of(src.field->var_decl_node),
                           refer_offset(src),
                           refer_size_source(src),
@@ -13442,7 +12948,7 @@ parser_string(const cbl_refer_t& tgt,
   size_t *integers = static_cast<size_t *>(xmalloc((nsource+1)*sizeof(size_t)));
   gcc_assert(integers);
 
-  // Count up how many treeplets we are going to need:
+  // Count up how many referlets we are going to need:
   size_t cblc_count = 2;  // tgt and pointer
   for(size_t i=0; i<nsource; i++)
     {
@@ -13473,13 +12979,13 @@ parser_string(const cbl_refer_t& tgt,
   gcc_assert(index_cblc == cblc_count);
 
   tree pintegers = build_array_of_size_t( index_int, integers);
-
-  build_array_of_treeplets(1, index_cblc, refers.data());
+  tree referlets = build_array_of_referlets(index_cblc, refers.data());
 
   tree t_overflow = gg_define_int();
   gg_assign(t_overflow, gg_call_expr( INT,
                                       "__gg__string",
                                       pintegers,
+                                      referlets,
                                       NULL_TREE));
   gg_free(pintegers);
 
@@ -13948,10 +13454,20 @@ create_and_call(size_t narg,
     }
   else
     {
-    // Because no explicit returning value is expected, we call the designated
-    // function and assign the return value to our RETURN-CODE
+    // There is no explicit location to assign the returned value.
     push_program_state();
-    gg_assign(current_function->var_decl_return, gg_cast(SHORT, call_expr));
+    if( dialect_ibm() )
+      {
+      // Because no explicit returning value is expected, we call the
+      // designated function and assign the return value to our RETURN-CODE.
+      gg_assign(current_function->var_decl_return, gg_cast(SHORT, call_expr));
+      }
+    else
+      {
+      // Because it is not IBM, we execute the called function and ignore the
+      // any returned value.
+      gg_append_statement(call_expr);
+      }
     pop_program_state();
     }
 
@@ -14118,23 +13634,29 @@ parser_call(   cbl_refer_t name,
         }
       else
         {
-        tree mangled_name = gg_define_variable(CHAR_P);
-
-        gg_call(VOID,
-                "__gg__just_mangle_name",
-                (name.field->var_decl_node
-                                ? gg_get_address_of(name.field->var_decl_node)
-                                : null_pointer_node),
-                gg_get_address_of(  mangled_name),
-                NULL_TREE);
-
-        gg_printf("WARNING: %s:%d \"CALL %s\" not found"
-                  " with no \"CALL ON EXCEPTION\" phrase.\n"
-                  "(You might need -rdynamic or --export-dynamic for symbols in the executable.)\n",
-                  gg_string_literal(current_filename.back().c_str()),
-                  build_int_cst_type(INT, CURRENT_LINE_NUMBER),
-                  mangled_name,
+        // When EC-PROGRAM-NOT-FOUND is not enabled, we issue a warning.
+        const cbl_enabled_exceptions_t&
+                                enabled_exceptions( cdf_enabled_exceptions() );
+        if( !enabled_exceptions.match(ec_program_not_found_e) )
+          {
+          tree mangled_name = gg_define_variable(CHAR_P);
+
+          gg_call(VOID,
+                  "__gg__just_mangle_name",
+                  (name.field->var_decl_node
+                                  ? gg_get_address_of(name.field->var_decl_node)
+                                  : null_pointer_node),
+                  gg_get_address_of(  mangled_name),
                   NULL_TREE);
+
+          gg_printf("WARNING: %s:%d \"CALL %s\" not found"
+                    " with no \"CALL ON EXCEPTION\" phrase.\n"
+                    "(You might need -rdynamic or --export-dynamic for symbols in the executable.)\n",
+                    gg_string_literal(current_filename.back().c_str()),
+                    build_int_cst_type(INT, CURRENT_LINE_NUMBER),
+                    mangled_name,
+                    NULL_TREE);
+          }
         }
       }
     ENDIF
@@ -14972,7 +14494,6 @@ build_temporaryN(int N)
                       array_type,
                       pszdata,
                       vs_scope);
-////  data_decl_node = null_pointer_node;
   free(pszdata);
 
   // This is the holy grail.  With the initializer set to gg_pointer_to_array,
@@ -14987,7 +14508,7 @@ build_temporaryN(int N)
   tree cobfield = gg_define_variable(cblc_field_type_node, psz, vs_stack);
   free(psz);
 
-  tree data = null_pointer_node;        //  UCHAR_P, "data",
+  tree data = data_area;        //  UCHAR_P, "data",
   tree capacity = build_int_cst_type(SIZE_T, 16);     //  SIZE_T,  "capacity",
   tree allocated = build_int_cst_type(SIZE_T, 16);    //  SIZE_T,  "allocated",
   tree offset = build_int_cst_type(SIZE_T, 0);       //  SIZE_T,  "offset",
@@ -15025,15 +14546,6 @@ build_temporaryN(int N)
       tencoding,    //  INT,     "encoding",
       alphabet);    //  INT,     "alphabet",
 
-  if( data_decl_node != null_pointer_node )
-    {
-    gg_call(VOID,
-            "__gg__set_data_member",
-            gg_get_address_of(cobfield),
-            data_area,
-            NULL_TREE);
-    }
-
   return cobfield;
   }
 #pragma GCC diagnostic pop
@@ -15057,7 +14569,7 @@ hijack_for_development(const char *funcname)
                      funcname,
                      NULL_TREE);
 
-  parser_display_literal("You have been hijacked by a program named \"dubner\"");
+  parser_display_literal("You have been hijacked by a program named \"dubner_h\"");
   gg_insert_into_assemblerf("%s HIJACKED CODE START", ASM_COMMENT_START);
 
 
@@ -15090,11 +14602,27 @@ hijacker()
      down.  The code here is injected just prior to the parser_exit() stuff
      in the COBOL source code. */
 
-  parser_display_literal("You have been hijacked by a program named \"hijack\"");
+  parser_display_literal("You have been hijacked by a program named \"hijack_h\"");
   gg_insert_into_assemblerf("%s HIJACKED CODE START", ASM_COMMENT_START);
 
-#if 0
+  tree foo = gg_define_variable(INT);
+  IF( integer_one_node, eq_op, integer_one_node )
+    {
+    gg_printf("1 is indeed equal to 1\n", NULL_TREE);
+    gg_assign(foo, build_int_cst_type(INT, 123));
+    }
+  ELSE
+    {
+    gg_printf("1 is NOT equal to 1!\n", NULL_TREE);
+    gg_abort();
+    gg_assign(foo, build_int_cst_type(INT, 999));
+    }
+  ENDIF
+  gg_printf("\"foo\" is %d\n", foo, NULL_TREE);
 
+#if 0
+  // Leave this around for reference; it's how you find variables set up
+  // in WORKING-STORAGE when involved in a hijack.
   cbl_field_t *faaa = register_find("aaa");
   cbl_field_t *fbbb = register_find("bbb");
   cbl_field_t *fddd = register_find("ddd");
@@ -15132,46 +14660,255 @@ conditional_abs(tree source, const cbl_field_t *field)
     }
   }
 
+static tree
+get_reference_to_data(cbl_field_t *field)
+  {
+  // Given a field, we can derive the type of data the field needs to provide.
+  // That field has a field->data_decl_node, which is the starting point for
+  // the reference to the data we calculate.
+  tree retval = NULL_TREE;
+  tree field_type = data_decl_type_for(field);
+  tree data_type  = TREE_TYPE(field->data_decl_node);
+  bool field_is_array = TREE_CODE(field_type) == ARRAY_TYPE;
+  bool data_is_array  = TREE_CODE(data_type) == ARRAY_TYPE;
+
+  int field_code = TREE_CODE(field_type);
+  int data_code  = TREE_CODE(data_type);
+  size_t field_size = TREE_INT_CST_LOW(TYPE_SIZE_UNIT(field_type));
+  size_t data_size  = TREE_INT_CST_LOW(TYPE_SIZE_UNIT(data_type));
+
+  if( field_code == data_code && field_size == data_size )
+    {
+    if( !field_is_array )
+      {
+      // The two types are the same and are not ARRAY_TYPE
+      if( field->offset == 0 )
+        {
+        // This is an "ah, that feels good" moment.  Getting here means the
+        // field is something like "77 foo pic 9999" and that means the
+        // data_decl_node is exactly what is needed.
+        retval = field->data_decl_node;
+        }
+      else
+        {
+        // We have an offset.
+        if( (field->offset % field_size) == 0 )
+          {
+          // The offset is an integer number of bytes from data_decl_node:
+          size_t index = field->offset % field_size;
+          retval = gg_indirect( gg_cast(build_pointer_type(data_type),
+                                     gg_get_address_of(field->data_decl_node)),
+                               build_int_cst_type(SIZE_T, index));
+          }
+        else
+          {
+          // The offset is some random number of bytes.  We need to do a
+          // retval = *(data_type *)((char *)&data_decl_node + offset)
+          tree base = gg_get_address_of(field->data_decl_node);
+          base = gg_cast(UCHAR_P, base);
+          base = gg_add(base, build_int_cst_type(SIZE_T, field->offset));
+          retval = gg_cast(field_type, gg_indirect(base));
+          }
+        }
+      }
+    else
+      {
+      // The two types are the same ARRAY_TYPE
+      retval = gg_cast(UCHAR_P, gg_pointer_to_array(field->data_decl_node));
+      if( field->offset )
+        {
+        retval = gg_add(retval, build_int_cst_type(SIZE_T, field->offset));
+        }
+      }
+    }
+  else if( field_is_array && data_is_array )
+    {
+    // We have two different array types
+    retval = gg_cast(UCHAR_P, gg_pointer_to_array(field->data_decl_node));
+    if( field->offset )
+      {
+      retval = gg_add(retval, build_int_cst_type(SIZE_T, field->offset));
+      }
+    }
+  else if( !field_is_array && !data_is_array )
+    {
+    // The two data types are different, and neither is an array
+    if( field->offset == 0 )
+      {
+      if( field_size == data_size )
+        {
+        // The offset is zero, and the sizes are the same.
+        // This must be something like REDEFINES or the like:
+        retval = gg_cast(field_type, field->data_decl_node);
+        }
+      else
+        {
+        // The sizes are different:
+        // retval = *(data_type *)((char *)&data_decl_node)
+        tree base = gg_get_address_of(field->data_decl_node);
+        retval = gg_indirect(gg_cast(build_pointer_type(field_type), base));
+        }
+      }
+    else
+      {
+      // There is an offset
+      tree base = gg_get_address_of(field->data_decl_node);
+      base = gg_cast(UCHAR_P, base);
+      base = gg_add(base, build_int_cst_type(SIZE_T, field->offset));
+      retval = gg_indirect(gg_cast(build_pointer_type(field_type), base));
+      }
+    }
+  else if( !field_is_array && data_is_array )
+    {
+    // The return is a scalar, but we start from an array.
+    tree base = gg_pointer_to_array(field->data_decl_node);
+    base = gg_cast(UCHAR_P, base);
+    if( field->offset )
+      {
+      base = gg_add(base, build_int_cst_type(SIZE_T, field->offset));
+      }
+    base = gg_cast(build_pointer_type(field_type), base);
+    retval = gg_indirect(base);
+    }
+  else // if( field_is_array !data_is_array )
+    {
+    // The return is an array, but we start from a scalar
+    tree base = gg_get_address_of(field->data_decl_node);
+    base = gg_cast(UCHAR_P, base);
+    if( field->offset )
+      {
+      base = gg_add(base, build_int_cst_type(SIZE_T, field->offset));
+      }
+    retval = base;
+    }
+
+  return retval;
+
+#if 0
+  tree retval;
+  // Our job is to return a reference to the field's data decl node:
+  tree cobol_type = data_decl_type_for(field);
+  if( TREE_CODE(cobol_type) != ARRAY_TYPE )
+    {
+    // This COBOL variable is a scalar type
+    tree data_decl_type = TREE_TYPE(field->data_decl_node);
+    if( cobol_type == data_decl_type )
+      {
+      // Life is relatively easy; the data_decl_node is the type we want to
+      // end up with
+
+      if( field->offset == 0 )
+        {
+        // This is the ideal situation:  This is a reference to the 01 or 07
+        // member of a simple elementary variable.
+        retval = field->data_decl_node;
+        }
+      else
+        {
+        // This is slightly less desirable.
+        // Get the base address as a pointer to UCHAR
+        tree base = gg_cast(build_pointer_type(UCHAR),
+                            gg_get_address_of(field->var_decl_node));
+        // Add the offset to get a new pointer to UCHAR
+        tree base_addr = gg_add(base,
+                        build_int_cst_type(SIZE_T, field->offset));
+
+        // Do the equivalent of *( type *)base_addr;
+        retval =  gg_cast(cobol_type,
+                          gg_indirect(gg_cast(build_pointer_type(cobol_type),
+                                              base_addr)));
+        }
+      }
+    else
+      {
+      tree base;
+      if( TREE_CODE(data_decl_type) == ARRAY_TYPE )
+        {
+        // Our source data_decl_node is an array:
+        base = gg_pointer_to_array(field->data_decl_node);
+        }
+      else
+        {
+        // Our source data_decl_node is a scalar:
+        base = gg_get_address_of(field->data_decl_node);
+        }
+      base = gg_cast(build_pointer_type(UCHAR), base);
+      if( field->offset )
+        {
+        // Add the offset to get a new pointer to UCHAR
+        base = gg_add(base,
+                      build_int_cst_type(SIZE_T, field->offset));
+        }
+
+      // Do the equivalent of *( type *)base;
+      retval =  gg_cast(cobol_type,
+                        gg_indirect(gg_cast(build_pointer_type(cobol_type),
+                                            base)));
+      }
+    }
+  else
+    {
+    // This field is an array type.
+    tree base = gg_pointer_to_array(field->data_decl_node);
+    if( field->offset )
+      {
+      retval = gg_add(base, build_int_cst_type(SIZE_T, field->offset));
+      }
+    else
+      {
+      retval = base;
+      }
+    }
+  return retval;
+#endif
+  }
+
 static bool
 mh_identical(const cbl_refer_t &destref,
-             const cbl_refer_t &sourceref,
-             const TREEPLET    &tsource)
+             const cbl_refer_t &sourceref)
   {
   // Check to see if the two variables are identical types, thus allowing
   // for a simple byte-for-byte copy of the data areas:
   bool moved = false;
-  if(     destref.field->type          == sourceref.field->type
+  if(     destref.field->type            == sourceref.field->type
       &&  destref.field->data.capacity() == sourceref.field->data.capacity()
-      &&  destref.field->data.digits   == sourceref.field->data.digits
-      &&  destref.field->data.rdigits  == sourceref.field->data.rdigits
+      &&  destref.field->data.digits     == sourceref.field->data.digits
+      &&  destref.field->data.rdigits    == sourceref.field->data.rdigits
       &&       (destref.field->attr   & (signable_e|separate_e|leading_e))
             == (sourceref.field->attr & (signable_e|separate_e|leading_e))
       &&  destref.field->codeset.encoding == sourceref.field->codeset.encoding
-      &&  !destref.field->occurs.depending_on
-      &&  !sourceref.field->occurs.depending_on
-      &&  !destref.refmod.from
-      &&  !sourceref.refmod.len
-      &&  !(destref.field->attr   & intermediate_e) // variables with variable
-      &&  !(sourceref.field->attr & intermediate_e) // capacities have to be
-      &&  !(destref.field->attr   & any_length_e)   // handled elsewhere
-      &&  !(sourceref.field->attr & any_length_e)
       )
     {
-    // The source and destination are identical in type
-    if( !symbol_find_odo(sourceref.field) )
+    // The source and destination are identical in type and the
+    // Source doesn't have a depending_on clause
+    SHOW_PARSE1
+      {
+      SHOW_PARSE_INDENT
+      SHOW_PARSE_TEXT("mh_identical()");
+      }
+    if(    refer_is_super_clean(destref)
+        && refer_is_super_clean(sourceref) )
       {
-      Analyze();
-      // Source doesn't have a depending_on clause
-      SHOW_PARSE1
+      // They are identical, and they have no subscripts
+
+      tree source = get_reference_to_data(sourceref.field);
+      tree dest   = get_reference_to_data(destref.field);
+
+      tree type = data_decl_type_for(destref.field);
+      if( TREE_CODE(type) == ARRAY_TYPE )
         {
-        SHOW_PARSE_INDENT
-        SHOW_PARSE_TEXT("mh_identical()");
+        // We are dealing with pointers to UCHAR.
+        // The move has to be done with a copy:
+        gg_memcpy(dest,
+                  source,
+                  build_int_cst_type(SIZE_T,
+                                     destref.field->data.capacity()));
+        }
+      else
+        {
+        // We are dealing with scalars
+        gg_assign(dest, source);
         }
-      gg_memcpy(gg_add(member(destref.field->var_decl_node,   "data"),
-                       refer_offset(destref)),
-                gg_add(member(sourceref.field->var_decl_node, "data"),
-                       tsource.offset),
-                build_int_cst_type(SIZE_T, sourceref.field->data.capacity()));
       moved = true;
       }
     }
@@ -15200,6 +14937,16 @@ mh_source_is_literalN(cbl_refer_t &destref,
           SHOW_PARSE_TEXT("mh_source_is_literalN: __gg__psz_to_alpha_move")
           }
 
+        // In accordance with the rules of moving a numeric to an alphabetic,
+        // we need to eliminate any leading sign character from the text
+        // string:
+
+        const char *original = sourceref.field->data.original();
+        if( *original == ascii_plus || *original == ascii_minus )
+          {
+          original += 1;
+          }
+
         // We need the data sent to __gg__psz_to_alpha_move to be in the
         // encoding of the destination.  In accordance with the rules of
         // cbl_field_t::internalize, the FldLiteralN is in source-code
@@ -15209,8 +14956,8 @@ mh_source_is_literalN(cbl_refer_t &destref,
         const char *converted = __gg__iconverter(
                                          DEFAULT_SOURCE_ENCODING,
                                          destref.field->codeset.encoding,
-                                         sourceref.field->data.original(),
-                                         strlen(sourceref.field->data.original()),
+                                         original,
+                                         strlen(original),
                                          &charsout);
         gg_call(VOID,
                 "__gg__psz_to_alpha_move",
@@ -16754,8 +16501,6 @@ move_helper(tree size_error,        // This is an INT
     SHOW_PARSE_TEXT("move_helper()");
     }
 
-  bool moved = false;
-
   if( size_error )
     {
     gg_assign(size_error, integer_zero_node);
@@ -16788,14 +16533,11 @@ move_helper(tree size_error,        // This is an INT
               st_size);
     }
 
-  // if( !moved ) // commented out to quiet cppcheck
-    {
-    moved = mh_source_is_group(destref, sourceref, tsource);
-    }
+  bool moved = mh_source_is_group(destref, sourceref, tsource);
 
   if( !moved )
     {
-    moved = mh_identical(destref, sourceref, tsource);
+    moved = mh_identical(destref, sourceref);
     }
 
   if( !moved )
@@ -17031,34 +16773,6 @@ actually_create_the_static_field( cbl_field_t *new_var,
                                   tree immediate_parent,
                                   tree new_var_decl)
   {
-  // There is a bug in the GCC compiler. For some optimizations and some
-  // settings of -fpie, pathological N-squared time in the middle end can
-  // happen when a structure on the stack has an initialized member pointing
-  // to another memory area on the stack.  In those cases, we are going to
-  // initialize the pointer to zero, and then call a function to initialize
-  // the data member.  That hides things from the compiler's optimization
-  // phases.
-
-  bool read_only = !!TREE_READONLY(new_var_decl);
-  if( new_var->type == FldLiteralN )
-    {
-    // For a FldLiteralN the new_var_decl is a number, not a
-    // a cblc_field_t.
-    read_only = true;
-    }
-
-  if( new_var->type == FldAlphanumeric && new_var->attr & intermediate_e )
-    {
-    // We need not to mess with the intermediate malloc() logic.
-    read_only = true;
-    }
-
-  if( new_var->attr & external_e )
-    {
-    // We need not to mess with the intermediate malloc() logic.
-    read_only = true;
-    }
-
   //  For FldLiteralN we force the encoding to be ASCII.
   //  See initial_from_initial() for an explanation.
   //  For FldClass, we force the encoding to be UTF32; see
@@ -17111,11 +16825,6 @@ actually_create_the_static_field( cbl_field_t *new_var,
   tree tencoding = build_int_cst_type(INT, encoding);
   tree alphabet = build_int_cst_type(INT, new_var->codeset.alphabet);
 
-  if( !read_only )
-    {
-    data = null_pointer_node;
-    }
-
   gg_structure_type_constructor(
       new_var_decl,
       data ,        //  UCHAR_P, "data",
@@ -17135,16 +16844,6 @@ actually_create_the_static_field( cbl_field_t *new_var,
       rdigits,      //  SCHAR,   "rdigits",
       tencoding,    //  INT,     "encoding",
       alphabet);    //  INT,     "alphabet",
-
-
-  if( !read_only && data_area != null_pointer_node )
-    {
-    gg_call(VOID,
-            "__gg__set_data_member",
-            gg_get_address_of(new_var_decl),
-            data_area,
-            NULL_TREE);
-    }
   }
 
 static void
@@ -17321,7 +17020,7 @@ psa_new_var_decl(cbl_field_t *new_var, const char *external_record_base)
         // This has to be static, because we are putting the actual memory
         // on the heap.  But if we put the cblc_field_t on the stack inside
         // of a condition, or in a loop, we just keep recreating the field
-        // without getting freeing the memory.  Eventually, with perhaps a
+        // without freeing the memory.  Eventually, with perhaps a
         // two-pass compiler, we'll be able to create the stack cblc_field_t
         // once per program-id.
         scope = vs_static;
@@ -17790,42 +17489,11 @@ parser_symbol_add(struct cbl_field_t *new_var )
       length_of_initial_string = 0;
       }
 
-    // GDB needs to know the data hierarchy.  We do that by including our_index
-    // and parent index in the variable name:
-
-    size_t our_index = new_var->our_index;
-
-    if(   !our_index
-          && new_var->type != FldLiteralN
-          && !(new_var->attr & intermediate_e))
-      {
-      if( ! (new_var->type == FldFloat && new_var->has_attr(constant_e)) )
-        {
-        // N.B. If level is 0 then we're not participating in a hierarchy.
-        // During the early stages of implementing cbl_field_t::our_index, there
-        // were execution paths in parse.y and parser.cc that resulted in
-        // our_index not being set.  Those should be gone.
-        cbl_errx("%<our_index%> is NULL under unanticipated circumstances");
-        }
-      }
-
-    // When we create the cblc_field_t structure, we need a data pointer
-    // for "data".  In the case of a variable that has no parent, we
-    // have to allocate storage.  In the case of a variable that has a parent,
-    // we calculate data as the pointer to our parent's data plus our
-    // offset.
-
-    // Declare and define the structure.  This code *must* match
-    // the C structure declared in libgcobol.c.  Towards that end, the
-    // variables are declared in descending order of size in order to
-    // make the packing match up.
-
-    // This uses a single structure type_decl template for creating each structure
-
     char external_record_base[2*sizeof(cbl_name_t)] = "";
 
     if( new_var->parent > 0 )
       {
+      // new_var has a parent.
       symbol_elem_t *parent = symbol_at(new_var->parent);
       gcc_assert(parent);
       if( parent->type == SymField )
@@ -17839,7 +17507,8 @@ parser_symbol_add(struct cbl_field_t *new_var )
           {
           // The parent of new_var is a SymFile with the external_e attribute
           // Therefore, we have to establish new_var as an external with a
-          // predictable name
+          // predictable name, which we derive from the source file the parent
+          // came from.
           strcpy(external_record_base, parent->elem.file.name);
           }
         }
@@ -17922,7 +17591,7 @@ parser_symbol_add(struct cbl_field_t *new_var )
       goto actual_allocate;
       }
 
-    if( ancestor && new_var->level != 0 )
+    if( ancestor && new_var->level != 00 )
       {
       // This variable has an ancestor, so we share its already-allocated data
       // area
@@ -17951,8 +17620,7 @@ parser_symbol_add(struct cbl_field_t *new_var )
         // A FldClass actually doesn't need any bytes, because the only important
         // thing about it is the .initial field.  We will allocate a single byte,
         // just to keep run-time pointers from being NULL
-        if(    (new_var->type == FldClass    && bytes_to_allocate == 0)
-            || (new_var->type == FldLiteralA && bytes_to_allocate == 0)  )
+        if(    (new_var->type == FldClass    && bytes_to_allocate == 0)  )
           {
           bytes_to_allocate = 1;
           }
@@ -17983,7 +17651,7 @@ parser_symbol_add(struct cbl_field_t *new_var )
             }
           }
 
-        if(   new_var->attr & intermediate_e
+        if(   (new_var->attr & intermediate_e)
            && new_var->type == FldAlphanumeric )
           {
           // We don't allocate here for intermediates.  We instead use
@@ -18029,13 +17697,20 @@ parser_symbol_add(struct cbl_field_t *new_var )
             else
               {
               gg_variable_scope_t vs_scope = (new_var->attr & intermediate_e)
-                                              ? vs_stack : vs_static ;
-              tree array_type = build_array_type_nelts(UCHAR, bytes_to_allocate);
-              new_var->data_decl_node = gg_define_variable(
-                                  array_type,
-                                  achDataName,
-                                  vs_scope);
-              data_area = gg_pointer_to_array(new_var->data_decl_node);
+                                           ? vs_stack
+                                           : vs_static ;
+              tree data_decl_type = data_decl_type_for(new_var);
+              new_var->data_decl_node = gg_define_variable( data_decl_type,
+                                                            achDataName,
+                                                            vs_scope);
+              if( TREE_CODE(data_decl_type) == ARRAY_TYPE )
+                {
+                data_area = gg_pointer_to_array(new_var->data_decl_node);
+                }
+              else
+                {
+                data_area = gg_get_address_of(new_var->data_decl_node);
+                }
               }
             }
           }
@@ -18084,3 +17759,4 @@ parser_symbol_add(struct cbl_field_t *new_var )
   done:
   return;
   }
+
diff --git a/gcc/cobol/genapi.h b/gcc/cobol/genapi.h
index 6bba662f206..b4761c3bf98 100644
--- a/gcc/cobol/genapi.h
+++ b/gcc/cobol/genapi.h
@@ -424,25 +424,19 @@ parser_lsearch_start(   cbl_label_t *name,
 
 void parser_lsearch_conditional(cbl_label_t * name);
 void parser_bsearch_conditional(cbl_label_t * name);
-
 void parser_lsearch_when( cbl_label_t *name, cbl_field_t *conditional );
-void
-parser_bsearch_when(cbl_label_t *name,
-                    cbl_refer_t key,
-                    cbl_refer_t sarg,
-                    bool ascending);
-
+void parser_bsearch_when( cbl_label_t *name,
+                          const cbl_refer_t &key,
+                          const cbl_refer_t &sarg,
+                                bool ascending);
 void parser_lsearch_end( cbl_label_t *name );
 void parser_bsearch_end( cbl_label_t *name );
+void parser_bsearch_start( cbl_label_t *name, cbl_field_t *tgt );
 
-void
-parser_bsearch_start( cbl_label_t *name, cbl_field_t *tgt );
-
-void
-parser_sort(cbl_refer_t table,
-            bool duplicates,
-            cbl_alphabet_t *alphabet,
-            const std::vector<cbl_key_t>& keys );
+void parser_sort( cbl_refer_t table,
+                  bool duplicates,
+                  cbl_alphabet_t *alphabet,
+                  const std::vector<cbl_key_t>& keys );
 void
 parser_file_sort(   cbl_file_t *file,
                     bool duplicates,
diff --git a/gcc/cobol/gengen.cc b/gcc/cobol/gengen.cc
index c6936725f68..6a19ac6a2e1 100644
--- a/gcc/cobol/gengen.cc
+++ b/gcc/cobol/gengen.cc
@@ -370,25 +370,36 @@ gg_show_type(tree type)
     cbl_internal_error("The given type is NULL, and that is just not fair");
     }
 
+  int code = TREE_CODE(type);
+
   if( DECL_P(type) )
     {
     type = TREE_TYPE(type);
     }
-  if( !TYPE_P(type) )
+  if( !TYPE_P(type) && code != ARRAY_REF)
     {
-    cbl_internal_error("The given type is not a declaration or a TYPE");
+    cbl_internal_error("%s", "The given type is not a declaration or a TYPE or an ARRAY_REF");
     }
 
   static char ach[1100];
   static char ach2[1024];
   static char ach3[1024];
-  switch( TREE_CODE(type) )
+  switch( code )
     {
     case POINTER_TYPE:
       strcpy(ach2, gg_show_type(TREE_TYPE(type)));
       sprintf(ach, "POINTER to %s", ach2);
       break;
 
+    case ARRAY_TYPE:
+      strcpy(ach2, gg_show_type(TREE_TYPE(type)));
+      sprintf(ach, "ARRAY");
+      break;
+
+    case ARRAY_REF:
+      sprintf(ach, "ARRAY_REF");
+      break;
+
     case VOID_TYPE:
       sprintf(ach, "VOID");
       break;
@@ -433,6 +444,11 @@ gg_show_type(tree type)
     strcat(ach, " readonly");
     }
 
+  if( DECL_P(original_type) && TYPE_VOLATILE(original_type) )
+    {
+    strcat(ach, " volatile");
+    }
+
   return ach;
   }
 
@@ -852,7 +868,7 @@ gg_define_from_declaration(tree var_decl)
     // it's time to actually define the storage with a decl_expression:
     tree stmt = build1_loc (gg_token_location(),
                             DECL_EXPR,
-                            TREE_TYPE(var_decl),
+                            void_type_node,
                             var_decl);
     gg_append_statement(stmt);
     }
@@ -911,6 +927,34 @@ gg_define_variable(tree type_decl, const char *name, gg_variable_scope_t vs_scop
   return var_decl;
   }
 
+tree
+gg_define_volatile_variable(tree type_decl,
+                            const char *name,
+                            gg_variable_scope_t vs_scope)
+  {
+  bool already_defined = false;
+
+  tree volatile_type = build_qualified_type(type_decl, TYPE_QUAL_VOLATILE);
+
+  tree var_decl = gg_declare_variable(volatile_type,
+                                      name,
+                                      NULL_TREE,
+                                      vs_scope,
+                                      &already_defined);
+
+  /* Helpful, especially while debugging the front end.  The volatile-qualified
+     type is the important part; these flags should agree with it. */
+  TREE_THIS_VOLATILE(var_decl) = 1;
+  TREE_SIDE_EFFECTS(var_decl) = 1;
+
+  if (!already_defined)
+    {
+    gg_define_from_declaration(var_decl);
+    }
+
+  return var_decl;
+  }
+
 tree
 gg_define_bool()
   {
@@ -1316,6 +1360,23 @@ gg_pointer_to_array(tree expr)
   return build_fold_addr_expr (elem_ref);
   }
 
+tree
+gg_get_address(const tree var_decl)
+  {
+  /* This takes care of the problem of finding the address of a scalar, or of
+     an ARRAY_TYPE.  I recommend using it carefully; there is something to be
+     said for knowing whether you are working with an array, or a scalar. */
+  tree type = TREE_TYPE (var_decl);
+  if( TREE_CODE (type) == ARRAY_TYPE )
+    {
+    return gg_pointer_to_array(var_decl);
+    }
+
+  TREE_ADDRESSABLE(var_decl) = 1;
+  TREE_USED(var_decl) = 1;
+  return build_fold_addr_expr(var_decl);
+  }
+
 tree
 gg_get_indirect_reference(tree pointer, tree offset)
   {
@@ -1400,12 +1461,13 @@ gg_array_value(tree pointer, tree offset)
     }
   else
     {
-    return build4(ARRAY_REF,
+    tree retval =  build4(ARRAY_REF,
                   element_type,
                   pointer,
-                  offset,
+                  fold_convert(SIZE_T, offset),
                   NULL_TREE,
                   NULL_TREE);
+    return retval;
     }
   }
 
@@ -1594,6 +1656,62 @@ gg_bitwise_and(tree A, tree B)
   return build2( BIT_AND_EXPR, larger_type, gg_cast(larger_type,A), gg_cast(larger_type,B));
   }
 
+tree
+gg_bswap (tree var)
+  {
+  location_t loc = UNKNOWN_LOCATION;
+  tree type = TREE_TYPE (var);
+  tree size = TYPE_SIZE_UNIT (type);
+
+  gcc_assert (tree_fits_uhwi_p (size));
+
+  unsigned HOST_WIDE_INT size_in_bytes = tree_to_uhwi (size);
+
+  enum built_in_function fncode;
+  tree unsigned_type;
+
+  switch (size_in_bytes)
+    {
+    case 1:
+      return var;
+
+    case 2:
+      fncode = BUILT_IN_BSWAP16;
+      unsigned_type = uint16_type_node;
+      break;
+
+    case 4:
+      {
+      fncode = BUILT_IN_BSWAP32;
+      unsigned_type = uint32_type_node;
+      break;
+      }
+
+    case 8:
+      fncode = BUILT_IN_BSWAP64;
+      unsigned_type = uint64_type_node;
+      break;
+
+    case 16:
+      fncode = BUILT_IN_BSWAP128;
+      unsigned_type = unsigned_intTI_type_node;  /* or your UINT128 type */
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+
+  tree arg = fold_convert_loc (loc, unsigned_type, var);
+
+  tree swapped =
+    build_call_expr_loc (loc,
+                         builtin_decl_explicit (fncode),
+                         1,
+                         arg);
+
+  return fold_convert_loc (loc, type, swapped);
+  }
+
 tree
 gg_build_relational_expression(tree operand_a,
                                enum relop_t op,
@@ -3126,6 +3244,19 @@ gg_free(tree pointer)
   gg_append_statement(the_call);
   }
 
+tree
+gg_memcmp(const tree s1, const tree s2, tree n)
+  {
+  tree the_call =
+      build_call_expr_loc(gg_token_location(),
+                          builtin_decl_explicit (BUILT_IN_MEMCMP),
+                          3,
+                          s1,
+                          s2,
+                          n);
+  return the_call;
+  }
+
 void
 gg_record_statement_list_start()
   {
diff --git a/gcc/cobol/gengen.h b/gcc/cobol/gengen.h
index e961b27a82b..336bf2ef1d9 100644
--- a/gcc/cobol/gengen.h
+++ b/gcc/cobol/gengen.h
@@ -48,6 +48,7 @@
 #define BOOL       boolean_type_node
 #define CHAR       char_type_node
 #define SCHAR      signed_char_type_node
+#define SCHAR_P    build_pointer_type(SCHAR)
 #define UCHAR      unsigned_char_type_node
 #define SHORT      short_integer_type_node
 #define SHORT_P    build_pointer_type(short_integer_type_node)
@@ -266,6 +267,7 @@ struct gg_function_t
     tree entry_switch_goto;
     tree entry_switch_label;
     std::vector<tree> entry_goto_expressions;
+    bool alphabet_in_use;
     };
 
 struct cbl_translation_unit_t
@@ -363,6 +365,9 @@ extern tree gg_define_variable(tree type_decl,
                                const char *name,
                                gg_variable_scope_t vs_scope,
                                tree initial_value);
+extern tree gg_define_volatile_variable(tree type_decl,
+                                        const char *name,
+                                        gg_variable_scope_t vs_scope);
 // Utility definers:
 extern tree gg_define_bool();
 extern tree gg_define_char();
@@ -414,9 +419,10 @@ extern tree gg_define_uchar_star(tree var);
 extern tree gg_define_uchar_star(const char *variable_name, tree var);
 
 // address_of operator; equivalent of C "&var_decl"
-extern tree gg_get_address_of(const tree var_decl);
+extern tree gg_get_address_of(const tree var_decl); // For scalars
 // equivalent of C "&array[0]"
-extern tree gg_pointer_to_array(tree array);
+extern tree gg_pointer_to_array(tree array);        // For arrays
+extern tree gg_get_address(const tree var_decl);
 
 
 // Array creation and access:
@@ -434,6 +440,7 @@ extern void gg_decrement(tree var);
 extern tree gg_negate(tree var);        // Two's complement negation
 extern tree gg_bitwise_not(tree var);   // Bitwise inversion
 extern tree gg_abs(tree var);           // Absolute value
+extern tree gg_bswap(tree var);         // end-for-end byte swap
 
 // And some binary operations:
 
@@ -477,6 +484,7 @@ extern tree gg_read(tree fd, tree buf, tree count);
 extern void gg_write(tree fd, tree buf, tree count);
 extern void gg_memset(tree dest, const tree value, tree size);
 extern tree gg_memchr(tree s, tree c, tree n);
+extern tree gg_memcmp(const tree dest, const tree src, tree size);
 extern void gg_memcpy(tree dest, const tree src, tree size);
 extern void gg_memmove(tree dest, const tree src, tree size);
 extern tree gg_memdup(tree data, tree length);
@@ -580,4 +588,5 @@ extern void gg_insert_into_assemblerf(const char *format, ...) ATTRIBUTE_PRINTF_
 
 extern char *gg_show_type(tree type);
 extern void gg_leaving_the_source_code_file();
+
 #endif
diff --git a/gcc/cobol/genmath.cc b/gcc/cobol/genmath.cc
index 6eb87544ac0..7a39f87ab7a 100644
--- a/gcc/cobol/genmath.cc
+++ b/gcc/cobol/genmath.cc
@@ -93,7 +93,7 @@ set_up_arithmetic_error_handler(cbl_label_t *error,
   }
 
 static void
-arithmetic_operation(size_t nC, cbl_num_result_t *C,
+arithmetic_operation( size_t nC, cbl_num_result_t *C,
                       size_t nA, cbl_refer_t *A,
                       size_t nB, cbl_refer_t *B,
                       cbl_arith_format_t format,
@@ -140,21 +140,6 @@ arithmetic_operation(size_t nC, cbl_num_result_t *C,
   std::vector<cbl_refer_t> results(nC + 1);
   int ncount = 0;
 
-  if( nC+1 <= MIN_FIELD_BLOCK_SIZE )
-    {
-    // We know there is room in our existing buffer
-    }
-  else
-    {
-    // We might have to allocate more space:
-    gg_call(VOID,
-            "__gg__resize_int_p",
-            gg_get_address_of(var_decl_arithmetic_rounds_size),
-            gg_get_address_of(var_decl_arithmetic_rounds),
-            build_int_cst_type(SIZE_T, nC+1),
-            NULL_TREE);
-    }
-
   // We have to take into account the possibility the quotient of the division
   // can affect the disposition of the remainder.  In particular, some of the
   // NIST tests have the construction
@@ -182,10 +167,12 @@ arithmetic_operation(size_t nC, cbl_num_result_t *C,
     // list
     results[ncount++] = temp_remainder;
     }
+  tree array_of_int_type = build_array_type_nelts(INT, nC+1);
+  tree arithmetic_rounds = gg_define_variable(array_of_int_type);
   for(size_t i=0; i<nC; i++)
     {
     results[ncount] = C[i].refer;
-    gg_assign(  gg_array_value(var_decl_arithmetic_rounds, ncount),
+    gg_assign(  gg_array_value(arithmetic_rounds, ncount),
                 build_int_cst_type(INT, C[i].rounded));
     ncount += 1;
     }
@@ -201,17 +188,19 @@ arithmetic_operation(size_t nC, cbl_num_result_t *C,
   // Having done all that work, we now need to break out the various different
   // arithmetic routines that implement the various possibilities,
 
-  build_array_of_treeplets(1, nA, A);
-  build_array_of_treeplets(2, nB, B);
-  build_array_of_treeplets(3, ncount, results.data());
-
+  tree referlets_A = build_array_of_referlets(nA, A);
+  tree referlets_B = build_array_of_referlets(nB, B);
+  tree referlets_C = build_array_of_referlets(ncount, results.data());
   gg_call(VOID,
           operation,
           build_int_cst_type(INT, format),
           build_int_cst_type(SIZE_T, nA),
+          referlets_A,
           build_int_cst_type(SIZE_T, nB),
+          referlets_B,
           build_int_cst_type(SIZE_T, ncount),
-          var_decl_arithmetic_rounds,
+          referlets_C,
+          gg_pointer_to_array(arithmetic_rounds),
           build_int_cst_type(INT, call_flags),
           compute_error,
           NULL_TREE);
@@ -418,9 +407,11 @@ fast_add( size_t nC, cbl_num_result_t *C,
     tree term_type = largest_binary_term(nA, A);
     if( term_type )
       {
-      tree dest_type = tree_type_from_size(
-                                        C[0].refer.field->data.capacity(),
-                                        0);
+      tree dest_type = tree_type_from_size(C[0].refer.field->data.capacity(),
+                                           0);
+//      tree dest_type2 = TREE_TYPE(C[0].refer.field->data_decl_node);
+//      gcc_assert(dest_type2 == dest_type);
+
       // All the numbers are integers without rdigits
       if(    nC == 1
           && nA == 1
@@ -449,13 +440,23 @@ fast_add( size_t nC, cbl_num_result_t *C,
           }
         if( refer_is_clean(C[0].refer) )
           {
-          tree dest_addr = member(C[0].refer.field->var_decl_node,
-                                  "data");
-          tree ptr = gg_cast(build_pointer_type(dest_type), dest_addr);
           // We are accumulating into memory
-          gg_assign(  gg_indirect(ptr),
-                      gg_add( gg_indirect(ptr),
-                              A_value));
+
+          if(false &&    refer_is_working_storage(C[0].refer)
+             && C[0].refer.field->offset == 0 )
+            {
+            gg_assign(  C[0].refer.field->data_decl_node,
+                        gg_cast(TREE_TYPE(C[0].refer.field->data_decl_node), gg_add( C[0].refer.field->data_decl_node, A_value)));
+            }
+          else
+            {
+            tree dest_addr = member(C[0].refer.field->var_decl_node,
+                                    "data");
+            tree ptr = gg_cast(build_pointer_type(dest_type), dest_addr);
+            gg_assign(  gg_indirect(ptr),
+                        gg_add( gg_indirect(ptr),
+                                A_value));
+            }
           }
         else
           {
@@ -1154,7 +1155,7 @@ parser_add( size_t nC, cbl_num_result_t *C,
           // Do phase 2, which puts the subtotal into each target location in turn
           for(size_t i=0; i<nC; i++)
             {
-            arithmetic_operation(1, &C[i],
+            arithmetic_operation( 1, &C[i],
                                   0, NULL,
                                   0, NULL,
                                   format,
diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc
index b441063abe6..2cd470c6f70 100644
--- a/gcc/cobol/genutil.cc
+++ b/gcc/cobol/genutil.cc
@@ -33,6 +33,14 @@
 #include "cobol-system.h"
 #include "coretypes.h"
 #include "tree.h"
+#include "langhooks.h"
+#include "tree-iterator.h"
+#include "stringpool.h"
+#include "cgraph.h"
+#include "stor-layout.h"
+#include "toplev.h"
+#include "function.h"
+#include "fold-const.h"
 #include "../../libgcobol/ec.h"
 #include "../../libgcobol/common-defs.h"
 #include "util.h"
@@ -49,6 +57,8 @@
 #include "show_parse.h"
 #include "../../libgcobol/exceptl.h"
 #include "exceptg.h"
+#include "dumpfile.h"
+
 
 bool exception_location_active = true;
 bool skip_exception_processing = true;
@@ -77,24 +87,6 @@ tree var_decl_call_parameter_signature; // char   *__gg__call_parameter_signatur
 tree var_decl_call_parameter_count;     // int __gg__call_parameter_count
 tree var_decl_call_parameter_lengths;   // size_t *__gg__call_parameter_count
 
-tree var_decl_arithmetic_rounds_size;  // size_t __gg__arithmetic_rounds_size;
-tree var_decl_arithmetic_rounds;       // int*   __gg__arithmetic_rounds;
-tree var_decl_fourplet_flags_size;     // size_t __gg__fourplet_flags_size;
-tree var_decl_fourplet_flags;          // int*   __gg__fourplet_flags;
-
-tree var_decl_treeplet_1f; // cblc_field_pp_type_node , "__gg__treeplet_1f"
-tree var_decl_treeplet_1o; // SIZE_T_P                , "__gg__treeplet_1o"
-tree var_decl_treeplet_1s; // SIZE_T_P                , "__gg__treeplet_1s"
-tree var_decl_treeplet_2f; // cblc_field_pp_type_node , "__gg__treeplet_2f"
-tree var_decl_treeplet_2o; // SIZE_T_P                , "__gg__treeplet_2o"
-tree var_decl_treeplet_2s; // SIZE_T_P                , "__gg__treeplet_2s"
-tree var_decl_treeplet_3f; // cblc_field_pp_type_node , "__gg__treeplet_3f"
-tree var_decl_treeplet_3o; // SIZE_T_P                , "__gg__treeplet_3o"
-tree var_decl_treeplet_3s; // SIZE_T_P                , "__gg__treeplet_3s"
-tree var_decl_treeplet_4f; // cblc_field_pp_type_node , "__gg__treeplet_4f"
-tree var_decl_treeplet_4o; // SIZE_T_P                , "__gg__treeplet_4o"
-tree var_decl_treeplet_4s; // SIZE_T_P                , "__gg__treeplet_4s"
-
 // There are times when I need to insert a NOP into the code, mainly to force
 // a .loc directive into the assembly language so that the GDB-COBOL debugger
 // can show the COBOL source code.  This is true, for example, the CONTINUE
@@ -181,7 +173,7 @@ get_scaled_digits(cbl_field_t *field)
   }
 
 tree
-tree_type_from_digits(size_t digits, int signable)
+tree_type_from_digits(size_t digits, uint64_t signable)
   {
   tree retval = NULL_TREE;
 
@@ -564,8 +556,7 @@ get_depending_on_value(tree retval, const cbl_refer_t &refer)
 
 static
 tree
-get_data_offset(const cbl_refer_t &refer,
-                      int *pflags = NULL)
+get_data_offset(const cbl_refer_t &refer, int *pflags = NULL)
   {
   // This routine returns a tree which is the size_t offset to the data in the
   // refer/field
@@ -574,7 +565,7 @@ get_data_offset(const cbl_refer_t &refer,
      be handled efficiently.  */
 
   const cbl_enabled_exceptions_t &enabled_exceptions(cdf_enabled_exceptions());
-  if(    !enabled_exceptions.match(ec_bound_subscript_e) 
+  if(    !enabled_exceptions.match(ec_bound_subscript_e)
       && !enabled_exceptions.match(ec_bound_odo_e)
       && !enabled_exceptions.match(ec_bound_ref_mod_e) )
     {
@@ -757,7 +748,7 @@ get_data_offset(const cbl_refer_t &refer,
             ELSE
               {
               IF( subscript,
-                  ge_op,
+                  gt_op,
                   build_int_cst_type( TREE_TYPE(subscript),
                                       parent->occurs.ntimes()) )
                 {
@@ -825,8 +816,6 @@ get_data_offset(const cbl_refer_t &refer,
   return retval;
   }
 
-//static tree tree_type_from_field(const cbl_field_t *field);
-
 tree
 get_binary_value_tree(tree return_type,
                       tree rdigits,
@@ -856,9 +845,7 @@ get_binary_value_tree(tree return_type,
     return retval;
     }
 
-  static tree pointer = gg_define_variable( UCHAR_P,
-                                            "..gbv_pointer",
-                                            vs_file_static);
+  tree pointer = gg_define_variable(UCHAR_P);
   switch(field->type)
     {
     case FldLiteralN:
@@ -874,10 +861,6 @@ get_binary_value_tree(tree return_type,
           gg_assign(rdigits, build_int_cst_type(TREE_TYPE(rdigits),
                                                 field->data.rdigits));
           }
-        // tree source_type = tree_type_from_field(field);
-        // retval = gg_cast(return_type,
-                         // gg_indirect( gg_cast(build_pointer_type(source_type),
-                                   // gg_get_address_of(field->data_decl_node))));
         retval = gg_cast(return_type, field->data_decl_node);
         }
       break;
@@ -995,7 +978,7 @@ get_binary_value_tree(tree return_type,
                               build_int_cst_type(INT, field->codeset.encoding),
                               NULL_TREE));
           // Assign the value we got from the string to our "return" value:
-          
+
           // Note that cppcheck can't understand the run-time IF()
           // cppcheck-suppress redundantAssignment
           retval = gg_cast(return_type, val128);
@@ -1244,14 +1227,169 @@ get_binary_value( tree value,
                                           hilo ));
   }
 
-#if 0
-static tree
+tree
 tree_type_from_field(const cbl_field_t *field)
   {
-  gcc_assert(field);
-  return tree_type_from_size(field->data.capacity(), field->attr & signable_e);
+  /*  This routine is used to determine what action is taken with type of a
+      CALL ... USING <var> and the matching PROCEDURE DIVISION USING <var> of
+      a PROGRAM-ID or FUNCTION-ID
+      */
+  tree retval;
+
+  switch(field->type)
+    {
+    case FldGroup:
+    case FldAlphanumeric:
+    case FldAlphaEdited:
+    case FldNumericEdited:
+    case FldLiteralA:
+      {
+      retval = CHAR_P;
+      break;
+      }
+
+    case FldNumericDisplay:
+    case FldPacked:
+      {
+      if( field->attr & signable_e )
+        {
+        if( field->data.digits > 18 )
+          {
+          retval = INT128;
+          }
+        else if( field->data.digits > 9)
+          {
+          retval = LONG;
+          }
+        else if( field->data.digits > 4)
+          {
+          retval = INT;
+          }
+        else if( field->data.digits > 2)
+          {
+          retval = SHORT;
+          }
+        else
+          {
+          retval = SCHAR;
+          }
+        }
+      else
+        {
+        if( field->data.digits > 18 )
+          {
+          retval = UINT128;
+          }
+        else if( field->data.digits > 9)
+          {
+          retval = ULONG;
+          }
+        else if( field->data.digits > 4)
+          {
+          retval = UINT;
+          }
+        else if( field->data.digits > 2)
+          {
+          retval = USHORT;
+          }
+        else
+          {
+          retval = UCHAR;
+          }
+        }
+      break;
+      }
+
+    case FldLiteralN:
+    case FldNumericBinary:
+    case FldNumericBin5:
+    case FldIndex:
+    case FldPointer:
+      {
+      if( field->attr & signable_e )
+        {
+        if( field->data.capacity() == 16 )
+          {
+          retval = INT128;
+          }
+        else if( field->data.capacity() == 8 )
+          {
+          retval = LONG;
+          }
+        else if( field->data.capacity() == 4 )
+          {
+          retval = INT;
+          }
+        else if( field->data.capacity() == 2 )
+          {
+          retval = SHORT;
+          }
+        else if( field->data.capacity() == 1 )
+          {
+          retval = SCHAR;
+          }
+        else
+          {
+          gcc_unreachable();
+          }
+        }
+      else
+        {
+        if( field->data.capacity() == 16 )
+          {
+          retval = UINT128;
+          }
+        else if( field->data.capacity() == 8 )
+          {
+          retval = ULONG;
+          }
+        else if( field->data.capacity() == 4 )
+          {
+          retval = UINT;
+          }
+        else if( field->data.capacity() == 2 )
+          {
+          retval = USHORT;
+          }
+        else if( field->data.capacity() == 1 )
+          {
+          retval = UCHAR;
+          }
+        else
+          {
+          gcc_unreachable();
+          }
+        }
+      break;
+      }
+
+    case FldFloat:
+      {
+      if( field->data.capacity() == 8 )
+        {
+        retval = DOUBLE;
+        }
+      else if( field->data.capacity() == 4 )
+        {
+        retval = FLOAT;
+        }
+      else
+        {
+        retval = FLOAT128;
+        }
+      break;
+      }
+
+    default:
+      {
+      cbl_internal_error(  "%s: Invalid field type %s:",
+              __func__,
+              cbl_field_type_str(field->type));
+      break;
+      }
+    }
+  return retval;
   }
-#endif
 
 tree
 get_data_address( cbl_field_t *field,
@@ -1483,7 +1621,7 @@ hex_dump(tree data, size_t bytes)
   }
 
 tree
-tree_type_from_size(size_t bytes, int signable)
+tree_type_from_size(size_t bytes, uint64_t signable)
   {
   tree retval = NULL_TREE;
 
@@ -1492,7 +1630,7 @@ tree_type_from_size(size_t bytes, int signable)
     switch( bytes )
       {
       case 1:
-        retval = CHAR;
+        retval = SCHAR;
         break;
       case 2:
         retval = SHORT;
@@ -1501,7 +1639,7 @@ tree_type_from_size(size_t bytes, int signable)
         retval = INT;
         break;
       case 8:
-        retval = LONGLONG;
+        retval = LONG;
         break;
       case 16:
         retval = INT128;
@@ -1525,7 +1663,7 @@ tree_type_from_size(size_t bytes, int signable)
         retval = UINT;
         break;
       case 8:
-        retval = ULONGLONG;
+        retval = ULONG;
         break;
       case 16:
         retval = UINT128;
@@ -1728,126 +1866,68 @@ copy_little_endian_into_place(cbl_field_t *dest,
             gg_cast(dest_type, value));
   }
 
-void
-build_array_of_treeplets( int ngroup,
-                          size_t N,
+tree
+build_array_of_referlets( size_t N,
                           cbl_refer_t *refers)
   {
-  if( N )
+  tree retval = null_pointer_node;
+  if(N)
     {
-    // At the present time the most this routine is called is four times, for
-    // the implementation of the UNSTRING verb.
+    // Create the array of referlets.
+    tree table_type = build_array_type_nelts(cblc_referlet_type_node, N);
+    tree reflets    = gg_define_variable(table_type);
 
-    if( N > MIN_FIELD_BLOCK_SIZE )
-      {
-      gg_call(VOID,
-              "__gg__resize_treeplet",
-              build_int_cst_type(INT,    ngroup),
-              build_int_cst_type(SIZE_T, N),
-              NULL_TREE
-              );
-      }
-    switch(ngroup)
+    // Initialize the array of referlets from the list of refers:
+    for(size_t i=0; i<N; i++)
       {
-      case 1:
-        for(size_t i=0; i<N; i++)
-          {
-          gg_assign(gg_array_value(var_decl_treeplet_1f, i),
-                    refers[i].field ? gg_get_address_of(refers[i].field->var_decl_node)
-                                    : gg_cast(cblc_field_p_type_node, null_pointer_node));
-          gg_assign(gg_array_value(var_decl_treeplet_1o, i),
-                    refer_offset(refers[i]));
-          gg_assign(gg_array_value(var_decl_treeplet_1s, i),
-                    refer_size_source(refers[i]));
-          }
-        break;
-      case 2:
-        for(size_t i=0; i<N; i++)
-          {
-          gg_assign(gg_array_value(var_decl_treeplet_2f, i),
-                    refers[i].field ? gg_get_address_of(refers[i].field->var_decl_node)
-                                    : gg_cast(cblc_field_p_type_node, null_pointer_node));
-          gg_assign(gg_array_value(var_decl_treeplet_2o, i),
-                    refer_offset(refers[i]));
-          gg_assign(gg_array_value(var_decl_treeplet_2s, i),
-                    refer_size_source(refers[i]));
-          }
-        break;
-      case 3:
-        for(size_t i=0; i<N; i++)
-          {
-          gg_assign(gg_array_value(var_decl_treeplet_3f, i),
-                    refers[i].field ? gg_get_address_of(refers[i].field->var_decl_node)
-                                    : gg_cast(cblc_field_p_type_node, null_pointer_node));
-          gg_assign(gg_array_value(var_decl_treeplet_3o, i),
-                    refer_offset(refers[i]));
-          gg_assign(gg_array_value(var_decl_treeplet_3s, i),
-                    refer_size_source(refers[i]));
-          }
-        break;
-      case 4:
-        for(size_t i=0; i<N; i++)
-          {
-          gg_assign(gg_array_value(var_decl_treeplet_4f, i),
-                    refers[i].field ? gg_get_address_of(refers[i].field->var_decl_node)
-                                    : gg_cast(cblc_field_p_type_node, null_pointer_node));
-          gg_assign(gg_array_value(var_decl_treeplet_4o, i),
-                    refer_offset(refers[i]));
-          gg_assign(gg_array_value(var_decl_treeplet_4s, i),
-                    refer_size_source(refers[i]));
-          }
-        break;
-      default:
-        abort();
-        break;
+      gg_assign(gg_struct_field_ref(gg_array_value(reflets, i), "field"),
+            refers[i].field ? gg_get_address_of(refers[i].field->var_decl_node)
+                            : gg_cast(cblc_field_p_type_node,
+                                      null_pointer_node));
+      gg_assign(gg_struct_field_ref(gg_array_value(reflets, i), "offset"),
+                refer_offset(refers[i]));
+      gg_assign(gg_struct_field_ref(gg_array_value(reflets, i), "size"),
+                refer_size_source(refers[i]));
       }
+
+    // And just return a pointer to the first element of the array:
+    retval = gg_pointer_to_array(reflets);
     }
-  else
-    {
-    // Just do nothing
-    }
+
+  return retval;
   }
 
-void
-build_array_of_fourplets( int ngroup,
-                          size_t N,
-                          cbl_refer_t *refers)
+tree
+build_array_of_refers(size_t N,
+                      cbl_refer_t *refers)
   {
-  int flag_bits = 0;
+  tree retval;
   if( N )
     {
-    if( N > MIN_FIELD_BLOCK_SIZE )
-      {
-      gg_call(VOID,
-              "__gg__resize_treeplet",
-              build_int_cst_type(INT, ngroup),
-              build_int_cst_type(SIZE_T, N),
-              NULL_TREE);
-
-      gg_call(VOID,
-              "__gg__resize_int_p",
-              gg_get_address_of(var_decl_fourplet_flags_size),
-              gg_get_address_of(var_decl_fourplet_flags),
-              build_int_cst_type(SIZE_T, N),
-              NULL_TREE);
-      }
-
+    int flag_bits = 0;
+    tree table_type = build_array_type_nelts(cblc_refer_type_node, N);
+    tree table      = gg_define_variable(table_type);
     for(size_t i=0; i<N; i++)
       {
-      gg_assign(gg_array_value(var_decl_treeplet_1f, i),
-                gg_get_address_of(refers[i].field->var_decl_node));
-      gg_assign(gg_array_value(var_decl_treeplet_1o, i),
+      gg_assign(gg_struct_field_ref(gg_array_value(table, i), "field"),
+            refers[i].field ? gg_get_address_of(refers[i].field->var_decl_node)
+                            : gg_cast(cblc_field_p_type_node,
+                                      null_pointer_node));
+      gg_assign(gg_struct_field_ref(gg_array_value(table, i), "offset"),
                 refer_offset(refers[i], &flag_bits));
-      gg_assign(gg_array_value(var_decl_treeplet_1s, i),
+      gg_assign(gg_struct_field_ref(gg_array_value(table, i), "size"),
                 refer_size_source(refers[i]));
-      gg_assign(gg_array_value(var_decl_fourplet_flags, i),
+      gg_assign(gg_struct_field_ref(gg_array_value(table, i), "flags"),
                 build_int_cst_type(INT, flag_bits));
       }
+    // And just return a pointer to the first element of the array:
+    retval = gg_pointer_to_array(table);
     }
   else
     {
     abort();
     }
+  return retval;
   }
 
 tree
@@ -1910,7 +1990,7 @@ get_literal_string(cbl_field_t *field)
 bool
 refer_is_clean(const cbl_refer_t &refer)
   {
-    if( !refer.field || refer.field->is_numeric_constant() )
+  if( !refer.field || refer.field->is_numeric_constant() )
     {
     // It is routine for a refer to have no field.  It happens when the parser
     // passes us a refer for an optional parameter that has been omitted, for
@@ -1930,6 +2010,35 @@ refer_is_clean(const cbl_refer_t &refer)
           ;
   }
 
+bool
+refer_is_super_clean(const cbl_refer_t &refer)
+  {
+  // By super-clean, we mean that in addition to refer_is_clean, the value
+  // is also in working-storage with fixed offset and capacity, and is
+  // otherwise in condition so that we can use refer.field->var_data_node for
+  // GENERIC, thus getting rid the additional level of indirection through
+  // the refer.field->var_decl_node::data pointer
+  return   refer_is_clean(refer)
+        && !(refer.field->attr & (  based_e
+                                  | linkage_e
+                                  | local_e
+                                  | intermediate_e
+                                  | any_length_e
+                                  | external_e)) ;
+  }
+
+bool
+refer_is_working_storage(const cbl_refer_t &refer)
+  {
+  // This returns TRUE in cases where the refer.field->data_decl_node is
+  // stored in .bss or .data, and is thus directly addressable.
+  bool retval = !( refer.field->attr & (  based_e
+                                        | linkage_e
+                                        | local_e
+                                        | intermediate_e) )
+                || (refer.field->type == FldLiteralN);
+  return retval;
+  }
 
 /*  This routine returns the length portion of a refmod(start:length) reference.
     It extracts both the start and the length so that it can add them together
@@ -1983,8 +2092,7 @@ refer_fill_depends(const cbl_refer_t &refer)
   }
 
 tree  // size_t
-refer_offset(const cbl_refer_t &refer,
-                   int *pflags)
+refer_offset(const cbl_refer_t &refer, int *pflags)
   {
   // This routine calculates the effect of a refer offset on the
   // refer.field->data location.  When there are subscripts, the data location
@@ -2201,3 +2309,890 @@ is_pure_integer(const cbl_field_t *field)
     }
   return retval;
   }
+
+bool
+binary_from_FldNumericBin5(tree &value, const cbl_refer_t &refer, tree type)
+  {
+  bool retval = false;
+
+  tree source_type = tree_type_from_field(refer.field);
+
+  if( refer_is_working_storage(refer) )
+    {
+    if( !type )
+      {
+      type = source_type;
+      }
+
+    value = gg_define_variable(type);
+
+    if(  refer.field->offset == 0
+      && TREE_CODE(TREE_TYPE(refer.field->data_decl_node)) == INTEGER_TYPE)
+      {
+      // This is the cleanest method: We can just pick up the original base
+      // data.
+
+//#define FOUND_THE_ALIASING_PROBLEM
+#ifdef FOUND_THE_ALIASING_PROBLEM
+      // At the present writing, we can't just pick up the data_decl_node data,
+      // because the contents can be altered by pointer operations that the
+      // compiler doesn't know about.  And we get errors, first noted with the
+      // results of fast_add (which uses *(data *) to change the data.) Using
+      // -fno-strict-aliasing makes the problem go away.  Until we get that
+      // sorted out, we use the slightly less efficient method on the other
+      // side of the #else.
+      gg_assign(value, gg_cast(type, refer.field->data_decl_node));
+#else
+      tree base;
+      base = gg_cast(build_pointer_type(TREE_TYPE(refer.field->data_decl_node)),
+                                member(refer.field->var_decl_node, "data"));
+      gg_assign(value,
+                gg_cast(type,
+                        gg_indirect(gg_cast(build_pointer_type(source_type),
+                                            base))));
+#endif
+      }
+    else
+      {
+      // We can't just pick up the stuff at data_decl_node.  Either there is
+      // an offset from the 01 grandfather, or else there is a type mismatch,
+      // probably because of a REDEFINES.  So, we do the equivalent of
+      // *(type *)&thing;
+      tree base;
+      base = gg_cast(UCHAR_P, gg_get_address(refer.field->data_decl_node));
+      if( refer_is_clean(refer) )
+        {
+        if( refer.field->offset )
+          {
+          base = gg_add(base, build_int_cst_type(SIZE_T, refer.field->offset));
+          }
+        }
+      else
+        {
+        base = gg_add(base, refer_offset(refer));
+        }
+      gg_assign(value,
+                gg_cast(type,
+                        gg_indirect(gg_cast(build_pointer_type(source_type),
+                                            base))));
+      }
+    retval = true;
+    }
+  else
+    {
+    if( !type )
+      {
+      type = tree_type_from_field(refer.field);
+      }
+
+    tree base;
+    get_location(base, refer);
+    value = gg_define_variable(type);
+    gg_assign(value,
+              gg_cast(type,
+                      gg_indirect(gg_cast(build_pointer_type(source_type),
+                                          base))));
+    retval = true;
+    }
+  return retval;
+  }
+
+bool
+binary_from_FldNumericBinary(tree &value, const cbl_refer_t &refer, tree type)
+  {
+  bool retval = false;
+
+  // get the value as its own type.
+  tree unflipped;
+  retval = binary_from_FldNumericBin5(unflipped, refer, NULL_TREE);
+  if( retval )
+    {
+    // The actual return value gets the flipped bytes:
+    value = gg_define_variable(type);
+    gg_assign(value, gg_cast(type, gg_bswap(unflipped)));
+    }
+
+  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
+                  size_t digits,
+                  size_t stride)
+  {
+  switch( digits )
+    {
+    case 1:
+      {
+      retval = gg_define_variable(UCHAR);
+      gg_assign(retval,
+                gg_bitwise_and(gg_indirect(loc),
+                               build_int_cst_type(UCHAR, 0x0F)));
+      break;
+      }
+
+    case 2:
+      {
+      retval = gg_define_variable(UCHAR);
+      tree ldigit = gg_bitwise_and(gg_indirect(loc),
+                                   build_int_cst_type(UCHAR, 0x0F));
+      tree rdigit = gg_bitwise_and(gg_indirect(loc,
+                                               build_int_cst_type(SIZE_T,
+                                                                  stride)),
+                                   build_int_cst_type(UCHAR, 0x0F));
+      gg_assign(retval,
+                gg_add(gg_multiply(ldigit,
+                                   build_int_cst_type(UCHAR, 10)),
+                       rdigit));
+      break;
+      }
+
+    case 3:
+    case 4:
+      {
+      tree type = USHORT;
+      int rsize = 2;
+      retval = gg_define_variable(type);
+      tree left_half;
+      tree right_half;
+      d_and_q_num_disp(left_half,
+                       loc,
+                       digits - rsize,
+                       stride);
+      d_and_q_num_disp(right_half,
+                       gg_add(loc,
+                              build_int_cst_type(SIZE_T,
+                                                 stride*(digits - rsize))),
+                       rsize,
+                       stride);
+      gg_assign(retval,
+                gg_add(gg_cast(type,
+                               gg_multiply(left_half,
+                                          build_int_cst_type(type, 100))),
+                       gg_cast(type, right_half)));
+      break;
+      }
+    case 5:
+    case 6:
+    case 7:
+    case 8:
+      {
+      tree type = UINT;
+      int rsize = 4;
+      retval = gg_define_variable(type);
+      tree left_half;
+      tree right_half;
+      d_and_q_num_disp(left_half,
+                       loc,
+                       digits - rsize,
+                       stride);
+      d_and_q_num_disp(right_half,
+                       gg_add(loc,
+                              build_int_cst_type(SIZE_T,
+                                                 stride*(digits - rsize))),
+                       rsize,
+                       stride);
+      gg_assign(retval,
+                gg_add(gg_cast(type,
+                               gg_multiply(left_half,
+                                           build_int_cst_type(type, 10000))),
+                       gg_cast(type, right_half)));
+      break;
+      }
+
+    case  9:
+    case 10:
+    case 11:
+    case 12:
+    case 13:
+    case 14:
+    case 15:
+    case 16:
+      {
+      tree type = ULONG;
+      int rsize = 8;
+      retval = gg_define_variable(type);
+      tree left_half;
+      tree right_half;
+      d_and_q_num_disp(left_half,
+                       loc,
+                       digits - rsize,
+                       stride);
+      d_and_q_num_disp(right_half,
+                       gg_add(loc,
+                              build_int_cst_type(SIZE_T,
+                                                 stride*(digits - rsize))),
+                       rsize,
+                       stride);
+      gg_assign(retval,
+                gg_add(gg_cast(type,
+                               gg_multiply(left_half,
+                                     build_int_cst_type(type, 100000000UL))),
+                       gg_cast(type, right_half)));
+      break;
+      }
+
+    default:
+      {
+      // 'digits' is greater than 16.  We will peel off sixteen digits at a
+      // time, and multiply-and-accumulate into our return value:
+
+      tree type = UINT128;
+      retval = gg_define_variable(type);
+
+      size_t digits_this_time = std::min(digits, 16UL);
+      digits -= digits_this_time;
+      tree value;
+      d_and_q_num_disp(value,
+                       loc,
+                       digits_this_time,
+                       stride);
+      gg_assign(retval, gg_cast(type, value));
+      gg_assign(loc,
+                gg_add(loc,
+                       build_int_cst_type(SIZE_T,
+                                          stride*digits_this_time)));
+      while(digits > 0)
+        {
+        digits_this_time = std::min(digits, 16UL);
+        size_t pot = pots[digits_this_time];
+        gg_assign(retval, gg_multiply(retval,
+                                      build_int_cst_type(type, pot)));
+        d_and_q_num_disp(value,
+                         loc,
+                         digits_this_time,
+                         stride);
+        gg_assign(retval, gg_add(retval, gg_cast(type, value)));
+        gg_assign(loc,
+                  gg_add(loc,
+                         build_int_cst_type(SIZE_T,
+                                            stride*digits_this_time)));
+        digits -= digits_this_time;
+        }
+      break;
+      }
+    }
+  }
+
+bool
+binary_from_FldNumericDisplay(tree &value,
+                              const cbl_refer_t &refer,
+                              tree return_type)
+  {
+  // A return of false means we couldn't convert this value
+  bool retval = false;
+
+  tree source_type = tree_type_from_field(refer.field);
+  if( !return_type )
+    {
+    return_type = source_type;
+    }
+
+  // This is where we build the actual numeric value of the digits of the
+  // COBOL numeric display variable.  It is up to the caller to interpret
+  // scaledness and rdigits and so forth.
+  value = gg_define_variable(return_type);
+
+  // This is our address pointer, used for walking the digits.
+  tree base          = gg_define_variable(UCHAR_P);
+
+  // This is the location of the byte holding the sign (if any)
+  tree sign_location = gg_define_variable(UCHAR_P);
+  // This is the operational counter
+  tree digit_count = gg_define_variable(SIZE_T);
+
+  // The stride of the numerical value is the distance, in bytes, between
+  // characters of the zoned decimal value.  It can be 1 (ascii or ebcdic),
+  // or 2 or 4 for utf16 and utf32.
+  tree stride;
+
+  // This works for all forms of storage:
+  gg_assign(base,
+            gg_cast(build_pointer_type(UCHAR_P),
+                    member(refer.field->var_decl_node,"data")));
+  if( !refer_is_clean(refer) )
+    {
+    gg_assign(base, gg_add(base, refer_offset(refer)));
+    }
+
+  gg_assign(digit_count, build_int_cst_type(SIZE_T, refer.field->data.digits));
+
+  charmap_t *charmap = __gg__get_charmap(refer.field->codeset.encoding);
+  size_t fstride = charmap->stride();
+  stride = build_int_cst_type(SIZE_T, fstride);
+
+  if( refer.field->attr & signable_e )
+    {
+    // The value is signable.
+    if( refer.field->attr & separate_e )
+      {
+      // The sign byte is separate from the digits
+      if( refer.field->attr & leading_e )
+        {
+        // separate & leading.  sign_location is the first character.
+        gg_assign(sign_location, base);
+        gg_assign(base, gg_add(base, stride));
+        }
+      else
+        {
+        // separate & trailing.  The sign byte is after the last character:
+        gg_assign(sign_location,
+                  gg_add(base,
+                         build_int_cst_type(SIZE_T,
+                                        refer.field->data.digits * fstride)));
+        }
+      }
+    else
+      {
+      // sign is internal:
+      if( refer.field->attr & leading_e )
+        {
+        // internal & leading
+        gg_assign(sign_location, base);
+        }
+      else
+        {
+        // internal & trailing
+        gg_assign(sign_location,
+                  gg_add(base,
+                         build_int_cst_type(SIZE_T,
+                                            fstride *
+                                              (refer.field->data.digits-1))));
+        }
+      }
+    }
+
+  size_t digits = refer.field->data.digits;
+  // At this point, we have 'digits', which is the number of characters at
+  // 'base',  The obvious thing is a multiply-and-accumulate loop, but faster
+  // code can result from allowing the middle-end to create overlapping.
+
+  // This divide-and-conquer algorithm gives the middle-end that flexibility.
+  // It runs about three times faster than a multiply-accumulate when compiled
+  // with -O0, and about 2.8 times faster when compiled with -O2.
+
+  tree d_and_q;
+  d_and_q_num_disp(d_and_q, base, digits, fstride);
+
+  // d_and_q contains our value.  We need to know if negativeness is involved.
+  if( refer.field->attr & signable_e )
+    {
+    if( refer.field->attr & separate_e )
+      {
+      // If the sign location is a minus sign, we have to negate the value.
+      IF( gg_indirect(sign_location),
+          eq_op,
+          build_int_cst_type(UCHAR, charmap->mapped_character(ascii_minus)) )
+        {
+        gg_assign(value, gg_negate(gg_cast(return_type, d_and_q)));
+        }
+      ELSE
+        {
+        gg_assign(value, gg_cast(return_type, d_and_q));
+        }
+      ENDIF
+      }
+    else
+      {
+      // The sign indicator is inside the sign_location digit.
+      if( charmap->is_like_ebcdic() )
+        {
+        // In EBCDIC, the value is negative when the sign_indicator is less
+        // than ebcdic zero:
+        IF( gg_indirect(sign_location),
+            lt_op,
+            build_int_cst_type(UCHAR, charmap->mapped_character(ascii_zero)) )
+          {
+          gg_assign(value, gg_negate(gg_cast(return_type, d_and_q)));
+          }
+        ELSE
+          {
+          gg_assign(value, gg_cast(return_type, d_and_q));
+          }
+        ENDIF
+        }
+      else
+        {
+        // In ASCII, the value is negative when the sign_indicator is greater
+        // than ascii nine:
+        IF( gg_indirect(sign_location),
+            gt_op,
+            build_int_cst_type(UCHAR, ascii_9) )
+          {
+          gg_assign(value, gg_negate(gg_cast(return_type, d_and_q)));
+          }
+        ELSE
+          {
+          gg_assign(value, gg_cast(return_type, d_and_q));
+          }
+        ENDIF
+        }
+      }
+    }
+  else
+    {
+    gg_assign(value, gg_cast(return_type, d_and_q));
+    }
+
+  retval = true;
+  return retval;
+  }
+
+  /* This is the GENERIC that creates
+  static const unsigned char dp2bin[160] =
+    {
+    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
+    };
+  */
+
+static tree
+make_dp2bin_decl()
+  {
+  static const unsigned char dp2bin[160] =
+    {
+    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
+    };
+
+  tree array_type = build_array_type_nelts(UCHAR, 160);
+  tree decl = gg_define_variable( array_type,
+                                          "_dp2bin",
+                                          vs_file_static);
+  tree ctor = make_node(CONSTRUCTOR);
+  TREE_TYPE(ctor) = array_type;
+  TREE_STATIC(ctor)    = 1;
+  TREE_CONSTANT(ctor)  = 1;
+
+  for(int i=0; i<160; i++)
+    {
+    CONSTRUCTOR_APPEND_ELT( CONSTRUCTOR_ELTS(ctor),
+                            build_int_cst_type(SIZE_T, i),
+                            build_int_cst_type(UCHAR, dp2bin[i]) );
+    }
+  DECL_INITIAL(decl) = ctor;
+
+  TREE_STATIC (decl) = 1;
+  TREE_PUBLIC (decl) = 0;
+  DECL_EXTERNAL (decl) = 0;
+  TREE_READONLY (decl) = 1;
+  DECL_ARTIFICIAL (decl) = 1;
+  DECL_IGNORED_P (decl) = 1;
+  TREE_USED (decl) = 1;
+
+  DECL_INITIAL (decl) = ctor;
+
+  return decl;
+  }
+
+static void
+d_and_q_packed(tree &value, tree base, size_t places)
+  {
+  static tree dp2bin = make_dp2bin_decl();
+
+  switch(places)
+    {
+    case 0:
+      {
+      // This is what happens for a single-digit comp-3
+      tree type = UCHAR;
+      value = gg_define_variable(type);
+      gg_assign(value, gg_cast(type, integer_zero_node));
+      break;
+      }
+    case 1:
+      {
+      // One place is two digits:
+      tree type = UCHAR;
+      value = gg_define_variable(type);
+      gg_assign(value, gg_array_value(dp2bin, gg_indirect(base)));
+      break;
+      }
+    case 2:
+      {
+      // Four digits:
+      tree type = USHORT;
+      value = gg_define_variable(type);
+      tree lhalf;
+      tree rhalf;
+      size_t rplaces = 1;
+      size_t lplaces = places - rplaces;
+      size_t pot = pots[rplaces*2];
+      d_and_q_packed(lhalf, base, lplaces);
+      d_and_q_packed(rhalf,
+                     gg_add(base, build_int_cst_type(SIZE_T, lplaces)),
+                     rplaces);
+      gg_assign(value,
+                gg_add(gg_cast(type, gg_multiply(gg_cast(type, lhalf),
+                                               build_int_cst_type(type, pot))),
+                       gg_cast(type, rhalf)));
+      break;
+      }
+    case 3: // six digits
+    case 4: // eight digits
+      {
+      tree type = UINT;
+      value = gg_define_variable(type);
+      tree lhalf;
+      tree rhalf;
+      size_t rplaces = 2;
+      size_t lplaces = places - rplaces;
+      size_t pot = pots[rplaces*2];
+      d_and_q_packed(lhalf, base, lplaces);
+      d_and_q_packed(rhalf,
+                     gg_add(base, build_int_cst_type(SIZE_T, lplaces)),
+                     rplaces);
+      gg_assign(value,
+                gg_add(gg_cast(type, gg_multiply(gg_cast(type, lhalf), build_int_cst_type(type, pot))),
+                       gg_cast(type, rhalf)));
+      break;
+      }
+    case 5: // ten digits
+    case 6: // twelve digits
+    case 7: // fourteen digits
+    case 8: // sixteen digits
+      {
+      tree type = ULONG;
+      value = gg_define_variable(type);
+      tree lhalf;
+      tree rhalf;
+      size_t rplaces = 4;
+      size_t lplaces = places - rplaces;
+      size_t pot = pots[rplaces*2];
+      d_and_q_packed(lhalf, base, lplaces);
+      d_and_q_packed(rhalf,
+                     gg_add(base, build_int_cst_type(SIZE_T, lplaces)),
+                     rplaces);
+      gg_assign(value,
+                gg_add(gg_cast(type, gg_multiply(gg_cast(type, lhalf), build_int_cst_type(type, pot))),
+                       gg_cast(type, rhalf)));
+      break;
+      }
+    default:
+      {
+      // This is nine places (eighteen digits) and up,  We are going to peel
+      // off eight places (sixteen digits) at a time:
+      tree type = UINT128;
+      value = gg_define_variable(type);
+      tree lhalf;
+      size_t lplaces = places % 8;
+      if( lplaces != 0 )
+        {
+        d_and_q_packed(lhalf, base, lplaces);
+        gg_assign(value, gg_cast(type, lhalf));
+        places -= lplaces;
+        gg_assign(base, gg_add(base, build_int_cst_type(SIZE_T, lplaces)));
+        }
+      else
+        {
+        gg_assign(value, gg_cast(type, integer_zero_node));
+        }
+      // The remaining places is a multiple of eight:
+      size_t pot = pots[8 * 2];
+      while( places )
+        {
+        gg_assign(value, gg_multiply(value, build_int_cst_type(type, pot)));
+        tree rhalf;
+        d_and_q_packed(rhalf, base, 8);
+        gg_assign(value, gg_add(value, gg_cast(type, rhalf)));
+        gg_assign(base,  gg_add(base, build_int_cst_type(SIZE_T, 8)));
+        places -= 8;
+        }
+      }
+    }
+  }
+
+static bool
+binary_from_comp_3(tree &value, const cbl_refer_t &refer, tree type)
+  {
+  bool retval = false;
+
+  // This is where we build the actual numeric value of the digits of the
+  // COBOL packed-decimal variable.  It is up to the caller to interpret
+  // scaledness and rdigits and so forth.
+
+  tree source_type = tree_type_from_field(refer.field);
+
+  if( !type )
+    {
+    type = source_type;
+    }
+
+  tree working = gg_define_variable(source_type);
+
+  tree base = gg_define_variable(UCHAR_P);
+  gg_assign(base,
+            gg_cast(build_pointer_type(UCHAR_P),
+                    member(refer.field->var_decl_node,"data")));
+  if( !refer_is_clean(refer) )
+    {
+    gg_assign(base, gg_add(base, refer_offset(refer)));
+    }
+
+  // This is the location of the byte holding the sign nybble
+  tree sign_location = gg_define_variable(UCHAR_P);
+
+  // The sign nybble is in the last byte:
+  gg_assign(sign_location,
+            gg_add(base,
+                   build_int_cst_type(SIZE_T,
+                                      refer.field->data.capacity()-1)));
+  tree d_and_q;
+  // Pick up the binary value of the first capacity-1 places
+  d_and_q_packed(d_and_q,
+                 base,
+                 refer.field->data.capacity()-1);
+  // Multiply that by 10
+  tree d_and_q_10 = gg_multiply(gg_cast(source_type, d_and_q),
+                                build_int_cst_type(source_type, 10));
+  // Pick up the final digit
+  tree final_digit = gg_rshift(gg_indirect(sign_location),
+                               build_int_cst_type(SIZE_T, 4));
+  // Add the results together.
+  tree x0f = build_int_cst_type(UCHAR, 0x0F);
+  tree x0d = build_int_cst_type(UCHAR, 0x0D);
+  IF( gg_bitwise_and( gg_indirect(sign_location), x0f), eq_op, x0d )
+    {
+    gg_assign(working,
+              gg_cast(source_type, gg_negate(gg_add(d_and_q_10, final_digit))));
+    }
+  ELSE
+    {
+    gg_assign(working, gg_cast(source_type, gg_add(d_and_q_10, final_digit)));
+    }
+  ENDIF
+
+  value = gg_define_variable(type);
+  gg_assign(value, gg_cast(type, working));
+
+  retval = true;
+  return retval;
+  }
+
+static bool
+binary_from_comp_6(tree &value, const cbl_refer_t &refer, tree type)
+  {
+  bool retval = false;
+
+  // This is where we build the actual numeric value of the digits of the
+  // COBOL packed-decimal variable.  It is up to the caller to interpret
+  // scaledness and rdigits and so forth.
+  value = gg_define_variable(type);
+
+  tree base = gg_define_variable(UCHAR_P);
+  gg_assign(base,
+            gg_cast(build_pointer_type(UCHAR_P),
+                    member(refer.field->var_decl_node,"data")));
+  if( !refer_is_clean(refer) )
+    {
+    gg_assign(base, gg_add(base, refer_offset(refer)));
+    }
+
+  tree d_and_q;
+  d_and_q_packed(d_and_q,
+                 base,
+                 refer.field->data.capacity());
+  gg_assign(value, gg_cast(type, d_and_q));
+
+  retval = true;
+  return retval;
+  }
+
+bool
+binary_from_FldPacked(tree &value, const cbl_refer_t &refer, tree type)
+  {
+  bool retval;
+  if( refer.field->attr & packed_no_sign_e )
+    {
+    retval = binary_from_comp_6(value, refer, type);
+    }
+  else
+    {
+    retval = binary_from_comp_3(value, refer, type);
+    }
+  return retval;
+  }
+
+static
+bool binary_from_FldFloat(tree &value, const cbl_refer_t &refer, tree type)
+  {
+  tree source_type = tree_type_from_field(refer.field);
+
+  if( !type )
+    {
+    type = source_type;
+    }
+
+  value = gg_define_variable(type);
+
+  tree base;
+  get_location(base, refer);
+
+  gg_assign(value,
+            gg_cast(type,
+                    gg_indirect(gg_cast(build_pointer_type(source_type),
+                                                                   base))));
+
+  return true;
+  }
+
+bool
+get_binary_value(tree &value, const cbl_refer_t &refer, tree type)
+  {
+  bool retval = false;
+  /* There are other get binary value routines.  This one is intended to be the
+     "best in class" version, incorporating everything that's been learned
+     about the process, and incorporating compiler SSA guidelines. */
+
+  if( (refer.field->attr & FIGCONST_MASK) == zero_value_e )
+    {
+    // The ZERO figurative constant is not flagged as signed:
+    if( !type )
+      {
+      type = UINT;
+      }
+    value = gg_define_variable(type);
+    gg_assign(value, gg_cast(type, integer_zero_node));
+    retval = true;
+    }
+  else if( refer.addr_of )
+    {
+    // The case of ADDRESS OF
+    value = gg_define_variable(type);
+    tree base = gg_define_variable(UCHAR_P);
+    gg_assign(base, member(refer.field->var_decl_node, "data"));
+    if( !refer_is_clean(refer) )
+      {
+      gg_assign(base, gg_add(base, refer_offset(refer)));
+      }
+    gg_assign(value, gg_cast(type, base));
+    }
+  else
+    {
+    // We know that the refer is a type that involves an integer binary value.
+    switch(refer.field->type)
+      {
+      case FldNumericBin5:
+      case FldLiteralN:
+      case FldIndex:
+      case FldPointer:
+        retval = binary_from_FldNumericBin5(value, refer, type);
+        break;
+
+      case FldNumericBinary:
+        retval = binary_from_FldNumericBinary(value, refer, type);
+        break;
+
+      case FldNumericDisplay:
+        retval = binary_from_FldNumericDisplay(value, refer, type);
+        break;
+
+      case FldPacked:
+        retval = binary_from_FldPacked(value, refer, type);
+        break;
+
+      case FldFloat:
+        retval = binary_from_FldFloat(value, refer, type);
+        break;
+
+      default:
+        gcc_unreachable();
+        break;
+      }
+    }
+  return retval;
+  }
+
+void
+get_location(tree &retval, const cbl_refer_t &refer)
+  {
+  // This routine looks at a refer and returns a UCHAR_P pointer to the data
+  // of the object.
+  retval = gg_define_variable(UCHAR_P);
+  if( refer_is_super_clean(refer) )
+    {
+    // Working storage, not external, no refmods or subscripts:
+    // gg_assign(retval, member(refer.field->var_decl_node,"data"));
+    tree base   = gg_cast(UCHAR_P,
+                          gg_get_address(refer.field->data_decl_node));
+    if( refer.field->offset )
+      {
+      tree offset = build_int_cst_type(SIZE_T, refer.field->offset);
+      gg_assign(retval, gg_cast(UCHAR_P, gg_add(base, offset)));
+      }
+    else
+      {
+      gg_assign(retval, base);
+      }
+    }
+  else
+    {
+    // The variable is external, or intermediate_e, or there are subscripts, or
+    // there are refmods. We use the run-time "data", and add the run-time
+    // offset to it.
+    gg_assign(retval,
+              gg_add(member(refer.field->var_decl_node,"data"),
+                     refer_offset(refer)));
+    }
+  }
+
+void
+get_length(tree &retval, const cbl_refer_t &refer)
+  {
+  if(refer_is_clean(refer))
+    {
+    if(   refer.field->attr & any_length_e
+       || refer.field->attr & intermediate_e )
+      {
+      // We need the run-time capacity.
+      retval = member(refer.field->var_decl_node, "capacity");
+      }
+    else
+      {
+      // We can use the compile-time capacity.
+      retval = build_int_cst_type(SIZE_T, refer.field->data.capacity());
+      }
+    }
+  else
+    {
+    retval = refer_size_source(refer);
+    }
+  }
diff --git a/gcc/cobol/genutil.h b/gcc/cobol/genutil.h
index 002a524d00d..aeb99c23882 100644
--- a/gcc/cobol/genutil.h
+++ b/gcc/cobol/genutil.h
@@ -57,31 +57,14 @@ extern tree var_decl_call_parameter_signature; // char   *__gg__call_parameter_s
 extern tree var_decl_call_parameter_count;     // int __gg__call_parameter_count
 extern tree var_decl_call_parameter_lengths;   // size_t *var_decl_call_parameter_lengths
 
-extern tree var_decl_arithmetic_rounds_size;  // size_t __gg__arithmetic_rounds_size;
-extern tree var_decl_arithmetic_rounds;       // int*   __gg__arithmetic_rounds;
-extern tree var_decl_fourplet_flags_size;     // size_t __gg__fourplet_flags_size;
-extern tree var_decl_fourplet_flags;          // int*   __gg__fourplet_flags;
-
-extern tree var_decl_treeplet_1f; // cblc_field_pp_type_node , "__gg__treeplet_1f"
-extern tree var_decl_treeplet_1o; // SIZE_T_P                , "__gg__treeplet_1o"
-extern tree var_decl_treeplet_1s; // SIZE_T_P                , "__gg__treeplet_1s"
-extern tree var_decl_treeplet_2f; // cblc_field_pp_type_node , "__gg__treeplet_2f"
-extern tree var_decl_treeplet_2o; // SIZE_T_P                , "__gg__treeplet_2o"
-extern tree var_decl_treeplet_2s; // SIZE_T_P                , "__gg__treeplet_2s"
-extern tree var_decl_treeplet_3f; // cblc_field_pp_type_node , "__gg__treeplet_3f"
-extern tree var_decl_treeplet_3o; // SIZE_T_P                , "__gg__treeplet_3o"
-extern tree var_decl_treeplet_3s; // SIZE_T_P                , "__gg__treeplet_3s"
-extern tree var_decl_treeplet_4f; // cblc_field_pp_type_node , "__gg__treeplet_4f"
-extern tree var_decl_treeplet_4o; // SIZE_T_P                , "__gg__treeplet_4o"
-extern tree var_decl_treeplet_4s; // SIZE_T_P                , "__gg__treeplet_4s"
 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
 
 int       get_scaled_rdigits(cbl_field_t *field);
 int       get_scaled_digits(cbl_field_t *field);
-tree      tree_type_from_digits(size_t digits, int signable);
-tree      tree_type_from_size(size_t bytes, int signable);
+tree      tree_type_from_digits(size_t digits, uint64_t signable);
+tree      tree_type_from_size(size_t bytes, uint64_t signable);
 
 void      get_binary_value( tree value,
                             tree rdigits,
@@ -138,24 +121,31 @@ void      parser_display_internal_field(tree file_descriptor,
 char     *get_literal_string(cbl_field_t *field);
 
 bool      refer_is_clean(const cbl_refer_t &refer);
+bool      refer_is_super_clean(const cbl_refer_t &refer);
+bool      refer_is_working_storage(const cbl_refer_t &refer);
 
-tree      refer_offset(const cbl_refer_t &refer,
-                       int *pflags=NULL);
+tree      refer_offset(const cbl_refer_t &refer, int *pflags=NULL);
 tree      refer_size_source(const cbl_refer_t &refer);
 tree      refer_size_dest(const cbl_refer_t &refer);
 
 tree      qualified_data_location(const cbl_refer_t &refer);
 
-void      build_array_of_treeplets( int ngroup,
-                                    size_t N,
+tree      build_array_of_referlets( size_t N,
                                     cbl_refer_t *refers);
 
-void      build_array_of_fourplets( int ngroup,
-                                    size_t N,
-                                    cbl_refer_t *refers);
+tree      build_array_of_refers(size_t N,
+                                cbl_refer_t *refers);
 void      get_depending_on_value_from_odo(tree retval, cbl_field_t *odo);
 uint64_t  get_time_nanoseconds();
 
 bool      is_pure_integer(const cbl_field_t *field);
 
+tree      tree_type_from_field(const cbl_field_t *field);
+
+bool      get_binary_value(tree &value, 
+                     const cbl_refer_t &refer,
+                           tree type = NULL_TREE);
+void      get_location(tree &retval, const cbl_refer_t &refer);
+void      get_length(tree &retval, const cbl_refer_t &refer);
+
 #endif
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index c474f094803..dc2ac9765cd 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -1046,6 +1046,7 @@ class locale_tgt_t {
 %printer { fprintf(yyo, "%c %s",
                         $$.invert? '!' : ' ',
 		        $$.term? name_of($$.term->field) : "<none>"); } <rel_term_t>
+%printer { fprintf(yyo, "%s", $$->dbgstr()); } <log_expr_t>
 
 %printer { fprintf(yyo, "%s (token %d)", keyword_str($$), $$ ); } relop
 %printer { fprintf(yyo, "'%s'", $$? $$ : "" ); } NAME <string>
@@ -6282,11 +6283,6 @@ exit_with:      %empty
 		   *  as specified in the rules."
 		   */
                   $$ = cbl_refer_t::empty();
-		  if( dialect_ibm() ) {
-		    static auto rt = cbl_field_of(symbol_at(return_code_register()));
-		    static cbl_refer_t status(rt);
-		    $$ = &status;
-		  }
 		  const auto prog = cbl_label_of(symbol_at(current_program_index()));
 		  if( prog->returning ) {
 		    $$ = new cbl_refer_t( cbl_field_of(symbol_at(prog->returning)) );
diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h
index 6d33e557686..fd924e6938a 100644
--- a/gcc/cobol/parse_ante.h
+++ b/gcc/cobol/parse_ante.h
@@ -1591,7 +1591,9 @@ class log_expr_t {
       dbgmsg("%s:%d: logic error: %s is not a truth value",
                __func__, __LINE__, name_of(rhs));
     } else {
-      parser_logop( andable, andable, and_op, rhs );
+      auto cond = new_temporary(FldConditional);
+      parser_logop( cond, andable, and_op, rhs );
+      andable = cond;
     }
     return this;
   }
@@ -1604,7 +1606,9 @@ class log_expr_t {
     if( ! orable ) {
       orable = andable;
     } else {
-      parser_logop( orable, orable, or_op, andable );
+      auto cond = new_temporary(FldConditional);
+      parser_logop( cond, orable, or_op, andable );
+      orable = cond;
     }
     andable = rhs;
     return this;
@@ -1612,7 +1616,9 @@ class log_expr_t {
   cbl_field_t * resolve() {
     assert(andable);
     if( orable ) {
-      parser_logop( andable, orable, or_op, andable );
+      auto cond = new_temporary(FldConditional);
+      parser_logop( cond, orable, or_op, andable );
+      andable = cond;
       orable = NULL;
     }
     assert(!orable);
@@ -1621,6 +1627,19 @@ class log_expr_t {
   bool unresolved() const {
     return orable != NULL;
   }
+
+  const char * dbgstr() const {
+    static char msg[64 * 2 + 16];
+    int pos = 0;
+    if( andable ) {
+      pos = sprintf(msg, "%s", andable->name);
+      assert(0 < pos);
+    }
+    if( orable ) {
+      pos = sprintf(msg + pos, " or %s", orable->name);
+    }
+    return msg;
+  }
 };
 
 static void ast_enter_section( cbl_label_t * );
diff --git a/gcc/cobol/scan_post.h b/gcc/cobol/scan_post.h
index 71025a220e5..4806332bc55 100644
--- a/gcc/cobol/scan_post.h
+++ b/gcc/cobol/scan_post.h
@@ -410,4 +410,4 @@ yylex(void) {
 // tokens.h is generated as needed from parse.h with tokens.h.gen
 current_tokens_t::tokenset_t::tokenset_t() {
 #include "token_names.h"
-};
+}
diff --git a/gcc/cobol/structs.cc b/gcc/cobol/structs.cc
index 16bd4e4df53..8f613da28d3 100644
--- a/gcc/cobol/structs.cc
+++ b/gcc/cobol/structs.cc
@@ -157,6 +157,8 @@ tree cblc_field_pp_type_node;
 tree cblc_file_type_node;
 tree cblc_file_p_type_node;
 tree cblc_goto_type_node;
+tree cblc_referlet_type_node;
+tree cblc_refer_type_node;
 
 // The following functions return type_decl nodes for the various structures
 
@@ -213,7 +215,7 @@ create_cblc_file_t()
     // When doing FILE I/O, you need the cblc_file_t structure
 
     /*
-typedef struct cblc_file_t*
+typedef struct cblc_file_t
     {
     char                *name;             // This is the name of the structure; might be the name of an environment variable
     uint64_t             symbol_index;     // The symbol table index of the related cbl_file_t structure
@@ -289,6 +291,46 @@ typedef struct cblc_file_t*
     return retval;
     }
 
+static tree
+create_referlet_t()
+    {
+    /*
+      typedef struct cblc_referlet_t
+          {
+          cblc_field_t        *field;
+          size_t               offset;
+          size_t               size;
+          } cblc_referlet_t;
+    */
+    tree retval = gg_get_structure_type_decl("cblc_referlet_t",
+                                              cblc_field_p_type_node, "field",
+                                              SIZE_T,               "offset",
+                                              SIZE_T,               "size",
+                                              NULL_TREE);
+    return retval;
+    }
+
+static tree
+create_refer_t()
+    {
+    /*
+      typedef struct cblc_refer_t
+          {
+          cblc_field_t        *field;
+          size_t               offset;
+          size_t               size;
+          int                  flags;
+          } cblc_refer_t;
+    */
+    tree retval = gg_get_structure_type_decl("cblc_refer_t",
+                                              cblc_field_p_type_node, "field",
+                                              SIZE_T,               "offset",
+                                              SIZE_T,               "size",
+                                              INT,                  "flags",
+                                              NULL_TREE);
+    return retval;
+    }
+
 void
 create_our_type_nodes()
     {
@@ -301,6 +343,8 @@ create_our_type_nodes()
         cblc_field_pp_type_node           = build_pointer_type(cblc_field_p_type_node);
         cblc_file_type_node               = create_cblc_file_t();
         cblc_file_p_type_node             = build_pointer_type(cblc_file_type_node);
+        cblc_referlet_type_node           = create_referlet_t();
+        cblc_refer_type_node              = create_refer_t();
         }
     }
 
diff --git a/gcc/cobol/structs.h b/gcc/cobol/structs.h
index d26f13f7e1d..aefea7f26d6 100644
--- a/gcc/cobol/structs.h
+++ b/gcc/cobol/structs.h
@@ -45,6 +45,7 @@ extern void member(tree var, const char *member_name, int value);
 extern void member(tree var, const char *member_name, tree value);
 extern void member(cbl_field_t *var, const char *member_name, tree value);
 
+extern void member2(tree var, const char *member_name, const char *submember, int value);
 extern void member2(tree var, const char *member_name, const char *submember, int value);
 extern void member2(tree var, const char *member_name, const char *submember, tree value);
 extern void member3(tree var, const char *mem, const char *sub1, const char *sub2, tree value);
@@ -55,6 +56,8 @@ extern GTY(()) tree cblc_field_pp_type_node;
 extern GTY(()) tree cblc_file_type_node;
 extern GTY(()) tree cblc_file_p_type_node;
 extern GTY(()) tree cblc_goto_type_node;
+extern GTY(()) tree cblc_referlet_type_node;
+extern GTY(()) tree cblc_refer_type_node;
 
 extern void create_our_type_nodes();
 
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index 46beb97f990..ade38eb227e 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -3782,7 +3782,7 @@ temporaries_t::add( cbl_field_t *field ) {
   bool yn(p.second);
   assert(yn);
   return *p.first;
-};
+}
 
 cbl_field_t *
 temporaries_t::reuse( cbl_field_type_t type ) {
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index d63d9a11149..f7fbc5ceccc 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -1364,7 +1364,6 @@ struct cbl_bsearch_t {
     tree right; // This is a long
     tree middle; // This is our copy of the index, so we only need to write
                  // it and never read it.
-    tree compare_result; // This is an int, and avoids
     struct cbl_field_t *index;
     bool first_when;
 };
@@ -3114,15 +3113,9 @@ bool validate_numeric_edited(cbl_field_t *field);
 cbl_field_t *new_alphanumeric(const cbl_name_t name=nullptr,
                               cbl_encoding_t encoding=no_encoding_e );
 
-
 // ENABLE_HIJACKING allows for code generation to be "hijacked" when the
-// program-id is "dubner" or "hijack".  See the mainline code in genapi.cc.
-
-// To enable hijacking, use
-// 
-//     make ... CPPFLAGS=-DENABLE_HIJACKING
-//
-// taking care to recaptulate whatever CPPFLAGS were set when configure was
-// run.
+// program-id is "dubner_h" or "hijack_h".  See the mainline code in genapi.cc.
+
+#define ENABLE_HIJACKING
 
 #endif
diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc
index c6bffdfb68b..554c4fc5702 100644
--- a/gcc/cobol/util.cc
+++ b/gcc/cobol/util.cc
@@ -957,11 +957,9 @@ symbol_field_type_update( cbl_field_t *field,
     case FldSwitch:
       gcc_unreachable();
     case FldAlphanumeric:
-      // MF allows PIC X(n) to have USAGE COMP-[5x]
+      // MF and GNU allow pic x usage comp-5.
+      // Dialect enforcement in that case is in field_binary_usage.
       if( candidate != FldNumericBin5 ) return false;
-      if( ! (dialect_mf() && field->has_attr(all_x_e)) ) {
-        return false;
-      }
       __attribute__((fallthrough));
     case FldFloat:
     case FldNumericBin5:
diff --git a/gcc/testsuite/cobol.dg/group2/Check_for_equality_of_COMP-1___COMP-2.cob b/gcc/testsuite/cobol.dg/group2/Check_for_equality_of_COMP-1___COMP-2.cob
index 76bafa4b527..d4857134cfa 100644
--- a/gcc/testsuite/cobol.dg/group2/Check_for_equality_of_COMP-1___COMP-2.cob
+++ b/gcc/testsuite/cobol.dg/group2/Check_for_equality_of_COMP-1___COMP-2.cob
@@ -17,7 +17,7 @@
            END-IF.
 
            MOVE SRC1 TO DST2.
-           IF DST1 not = 11.55
+           IF DST2 not = 11.55
                DISPLAY 'error: move/compare FLOAT-LONG to FLOAT-LONG failed ' DST2
                END-DISPLAY
            END-IF.
diff --git a/gcc/testsuite/cobol.dg/group2/ENTRY_statement.cob b/gcc/testsuite/cobol.dg/group2/ENTRY_statement.cob
index f6186f6bdc7..24b73506069 100644
--- a/gcc/testsuite/cobol.dg/group2/ENTRY_statement.cob
+++ b/gcc/testsuite/cobol.dg/group2/ENTRY_statement.cob
@@ -6,27 +6,43 @@
         working-storage         section.
         01 msg pic x(32).
         procedure               division.
-            move "This is foo" to msg
+            move "This is FOO" to msg
             display "About to call FOO"
-            call    "foo" using msg
-            move "This is bar" to msg
+            call    "FOO" using msg
+            move "This is BAR" to msg
             display "About to call BAR"
-            call    "bar" using msg
-            move "This is foo2" to msg
+            call    "BAR" using msg
+            move "This is FOO2" to msg
             display "About to call FOO again"
-            call    "foo" using msg
+            call    "FOO" using msg
+
+            move "This is BAZZ" to msg
+            display "About to call BAZZ"
+            call    "BAZZ" using msg
+            move "This is FAZZ" to msg
+            display "About to call FAZZ"
+            call    "FAZZ" using msg
+            move "This is baz2" to msg
+            display "About to call BAZZ again"
+            call    "BAZZ" using msg
+
             goback.
             end program         prog.
 
         identification          division.
-        program-id.             foo.
+        program-id.             FOO.
         data                    division.
         linkage                 section.
         01 msg pic x(32).
         procedure               division using msg.
-            display "  entry point foo: " function trim (msg)
-            entry   "bar"
-            display "  entry point bar: " function trim (msg)
+            display "  entry point FOO: " function trim (msg)
+            entry   "BAR"
+            display "  entry point BAR: " function trim (msg)
+            goback.
+            entry   "BAZZ"
+            display "  entry point BAZZ: " function trim (msg)
+            entry   "FAZZ"
+            display "  entry point FAZZ: " function trim (msg)
             goback.
-            end program         foo.
+            end program         FOO.
 
diff --git a/gcc/testsuite/cobol.dg/group2/ENTRY_statement.out b/gcc/testsuite/cobol.dg/group2/ENTRY_statement.out
index 18ba91fa5fc..b3a8053ee52 100644
--- a/gcc/testsuite/cobol.dg/group2/ENTRY_statement.out
+++ b/gcc/testsuite/cobol.dg/group2/ENTRY_statement.out
@@ -1,9 +1,17 @@
 About to call FOO
-  entry point foo: This is foo
-  entry point bar: This is foo
+  entry point FOO: This is FOO
+  entry point BAR: This is FOO
 About to call BAR
-  entry point bar: This is bar
+  entry point BAR: This is BAR
 About to call FOO again
-  entry point foo: This is foo2
-  entry point bar: This is foo2
+  entry point FOO: This is FOO2
+  entry point BAR: This is FOO2
+About to call BAZZ
+  entry point BAZZ: This is BAZZ
+  entry point FAZZ: This is BAZZ
+About to call FAZZ
+  entry point FAZZ: This is FAZZ
+About to call BAZZ again
+  entry point BAZZ: This is baz2
+  entry point FAZZ: This is baz2
 
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE___TIME_OMNIBUS.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE___TIME_OMNIBUS.cob
index 536d39bb942..f23e31e8bff 100644
--- a/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE___TIME_OMNIBUS.cob
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_DATE___TIME_OMNIBUS.cob
@@ -1,5 +1,5 @@
        *> { dg-do run }
-       *> { dg-set-target-env-var TZ UTC0 }
+       *> { dg-set-target-env-var TZ "UTC0" }
 
         identification division.
         program-id. testy.
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_NATIONAL_characters.cob b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_NATIONAL_characters.cob
new file mode 100644
index 00000000000..27b7f5d4992
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_NATIONAL_characters.cob
@@ -0,0 +1,55 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/FUNCTION_TRIM_with_NATIONAL_characters.out" }
+        identification          division.
+        program-id.             prog.
+        environment             division.
+        configuration           section.
+        special-names.
+            locale cp1252   is "cp1252"
+            locale utf16le  is "utf16le".
+         Object-Computer.
+             linux
+             Character Classification
+                 for Alphanumeric is cp1252
+                 for National     is utf16le.
+        data                    division.
+        working-storage         section.
+        01 from-8   pic x(10) value  "   8888   ".
+        01 from-16  pic n(10) value N"   1616   ".
+        01 to-8     pic x(10).
+        01 to-16    pic n(10).
+        procedure               division.
+            display "Alphanumeric literal " function byte-length(from-8)
+            display """" from-8  """"
+            display """" function trim(from-8 leading )              """"
+            display """" function trim(from-8 trailing )             """"
+            display """" function trim(from-8)                       """"
+
+            display "National literal " function byte-length(from-16)
+            display """" from-16 """"
+            display """" function trim(from-16 leading )""""
+            display """" function trim(from-16 trailing )""""
+            display """" function trim(from-16)""""
+
+            display "Alphanumeric data item " function byte-length(from-8)
+            move from-8                to to-8
+            display """" to-8 """"
+            move function trim(from-8 leading)  to to-8 
+            display """" to-8 """"
+            move function trim(from-8 trailing) to to-8 
+            display """" to-8 """"
+            move function trim(from-8)          to to-8 
+            display """" to-8 """"
+
+            display "National data item " function byte-length(from-16)
+            move from-16                to to-16
+            display """" to-16 """"
+            move function trim(from-16 leading)  to to-16 
+            display """" to-16 """"
+            move function trim(from-16 trailing) to to-16 
+            display """" to-16 """"
+            move function trim(from-16)          to to-16 
+            display """" to-16 """"
+            goback.
+        end program             prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_NATIONAL_characters.out b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_NATIONAL_characters.out
new file mode 100644
index 00000000000..1d68884fb4d
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/FUNCTION_TRIM_with_NATIONAL_characters.out
@@ -0,0 +1,21 @@
+Alphanumeric literal 10
+"   8888   "
+"8888   "
+"   8888"
+"8888"
+National literal 20
+"   1616   "
+"1616   "
+"   1616"
+"1616"
+Alphanumeric data item 10
+"   8888   "
+"8888      "
+"   8888   "
+"8888      "
+National data item 20
+"   1616   "
+"1616      "
+"   1616   "
+"1616      "
+
diff --git a/gcc/testsuite/cobol.dg/group2/Intrinsic_Function_ABS.cob b/gcc/testsuite/cobol.dg/group2/Intrinsic_Function_ABS.cob
index a4b971f8cbe..b4d8b2187ce 100644
--- a/gcc/testsuite/cobol.dg/group2/Intrinsic_Function_ABS.cob
+++ b/gcc/testsuite/cobol.dg/group2/Intrinsic_Function_ABS.cob
@@ -16,6 +16,6 @@
                    END-IF.
            IF FUNCTION ABS(000.0) NOT EQUAL TO ZERO
                    MOVE 1 TO RETURN-CODE
-                   DISPLAY "FUNCTION ABS(-000.0) FAILS."
+                   DISPLAY "FUNCTION ABS(000.0) FAILS."
                    END-IF.
 
diff --git a/gcc/testsuite/cobol.dg/group2/Large_PIC_10000000_.cob b/gcc/testsuite/cobol.dg/group2/Large_PIC_10000000_.cob
new file mode 100644
index 00000000000..1cd78ed1a33
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Large_PIC_10000000_.cob
@@ -0,0 +1,17 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Large_PIC_10000000_.out" }
+        identification   division.
+        program-id.      prog.
+        data             division.
+        working-storage  section.
+        01 uppered       pic x(10000000) value all "A".
+        01 lowered       pic x(10000000).
+        procedure        division.
+            move function lower-case(uppered) to lowered
+            move 'X' to lowered(1:1)
+            move 'Z' to lowered(10000000:1)
+            display lowered(1:10)
+            display lowered(9999991:10)
+            goback.
+        end program     prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Large_PIC_10000000_.out b/gcc/testsuite/cobol.dg/group2/Large_PIC_10000000_.out
new file mode 100644
index 00000000000..dad84c7016d
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Large_PIC_10000000_.out
@@ -0,0 +1,3 @@
+Xaaaaaaaaa
+aaaaaaaaaZ
+
diff --git a/gcc/testsuite/cobol.dg/group2/Nested_PERFORM.cob b/gcc/testsuite/cobol.dg/group2/Nested_PERFORM.cob
new file mode 100644
index 00000000000..e69e74b0e83
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Nested_PERFORM.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Nested_PERFORM.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       PROCEDURE        DIVISION.
+           PERFORM 2 TIMES
+             DISPLAY "X" NO ADVANCING
+             END-DISPLAY
+             PERFORM 2 TIMES
+               DISPLAY "Y" NO ADVANCING
+               END-DISPLAY
+             END-PERFORM
+           END-PERFORM.
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Nested_PERFORM.out b/gcc/testsuite/cobol.dg/group2/Nested_PERFORM.out
new file mode 100644
index 00000000000..3c3d159fa1a
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Nested_PERFORM.out
@@ -0,0 +1 @@
+XYYXYY
diff --git a/gcc/testsuite/cobol.dg/group2/Overlapping_MOVE.cob b/gcc/testsuite/cobol.dg/group2/Overlapping_MOVE.cob
new file mode 100644
index 00000000000..fd3cc8341ee
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Overlapping_MOVE.cob
@@ -0,0 +1,28 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Overlapping_MOVE.out" }
+        identification division.
+        program-id. prog.
+        data division.
+        working-storage section.
+        01 structure.
+            05 field1 pic x(5).
+            05 field2 pic x(10).
+        procedure division.
+            move "Hallo" to field1.
+            move "1234567890" to field2.
+            *> The ISO specification says specifically that when an overlapping
+            *> move takes place in a single data descriptor, that it behaves
+            *> like a memmove(3), and not a memcopy(3):
+            move field2 to structure.
+            display """" structure """"
+            if field1 not = "12345"
+              display "error:1: " field1
+              end-display
+            end-if
+            if field2 not = "67890     "
+              display "error:2: " field2
+              end-display
+            end-if
+            goback.
+        end program prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Overlapping_MOVE.out b/gcc/testsuite/cobol.dg/group2/Overlapping_MOVE.out
new file mode 100644
index 00000000000..9a638557820
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Overlapping_MOVE.out
@@ -0,0 +1,2 @@
+"1234567890     "
+
diff --git a/gcc/testsuite/cobol.dg/group2/PERFORM_TIMES_subscripted.cob b/gcc/testsuite/cobol.dg/group2/PERFORM_TIMES_subscripted.cob
new file mode 100644
index 00000000000..2c1a0f34e8f
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/PERFORM_TIMES_subscripted.cob
@@ -0,0 +1,21 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/PERFORM_TIMES_subscripted.out" }
+        identification      division.
+        program-id.         prog.
+        data                division.
+        working-storage section.
+        01  idx                       pic 9.
+        01  cnt-tab.
+            05 cnt-val occurs 3 times pic 9.
+        procedure division.
+            move 1 to cnt-val (1)
+            move 2 to cnt-val (2)
+            move 3 to cnt-val (3)
+            perform varying idx from 1 by 1 until idx > 3
+                perform cnt-val (idx) times
+                    display idx
+                    end-perform
+                end-perform
+            goback.
+        end program         prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/PERFORM_TIMES_subscripted.out b/gcc/testsuite/cobol.dg/group2/PERFORM_TIMES_subscripted.out
new file mode 100644
index 00000000000..8f19cda69a9
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/PERFORM_TIMES_subscripted.out
@@ -0,0 +1,7 @@
+1
+2
+2
+3
+3
+3
+
diff --git a/gcc/testsuite/cobol.dg/group2/PERFORM_VARYING_BY_-0.2.cob b/gcc/testsuite/cobol.dg/group2/PERFORM_VARYING_BY_-0.2.cob
new file mode 100644
index 00000000000..3168d50b6dc
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/PERFORM_VARYING_BY_-0.2.cob
@@ -0,0 +1,19 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/PERFORM_VARYING_BY_-0.2.out" }
+
+       IDENTIFICATION   DIVISION.
+       PROGRAM-ID.      prog.
+       DATA             DIVISION.
+       WORKING-STORAGE  SECTION.
+          77 X             PIC 9v9.
+       PROCEDURE        DIVISION.
+           PERFORM VARYING X FROM 0.8 BY -0.2
+                   UNTIL   X < 0.4
+             DISPLAY "X" NO ADVANCING
+             END-DISPLAY
+           END-PERFORM.
+       IF X NOT = 0.2
+         DISPLAY "WRONG X: " X END-DISPLAY
+       END-IF
+           STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/PERFORM_VARYING_BY_-0.2.out b/gcc/testsuite/cobol.dg/group2/PERFORM_VARYING_BY_-0.2.out
new file mode 100644
index 00000000000..dd6d86a43dc
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/PERFORM_VARYING_BY_-0.2.out
@@ -0,0 +1 @@
+XXX
diff --git a/gcc/testsuite/cobol.dg/group2/REDEFINES__chained.cob b/gcc/testsuite/cobol.dg/group2/REDEFINES__chained.cob
new file mode 100644
index 00000000000..16a761b28e7
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/REDEFINES__chained.cob
@@ -0,0 +1,36 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/REDEFINES__chained.out" }
+        IDENTIFICATION   DIVISION.
+        PROGRAM-ID.      chained_REDEFINES.
+        DATA             DIVISION.
+        WORKING-STORAGE  SECTION.
+        01 REC.
+        10 ZIP-9                    PIC 9(9).
+        10 ZIP-RED REDEFINES ZIP-9.
+            12 ZIP-5                 PIC 9(5).
+            12 ZIP-PLUS-4            PIC 9(4).
+        10 POSTAL-CORRECT-IND REDEFINES ZIP-9.
+            12 FILLER                PIC X(8).
+            12 POST-CORRT-IND        PIC X(1).
+        PROCEDURE        DIVISION.
+            MOVE 123456789 TO ZIP-9
+            DISPLAY """" ZIP-9 """"
+            IF ZIP-5 NOT = 12345
+            DISPLAY "ZIP-5 wrong: " ZIP-5
+            END-DISPLAY
+            END-IF
+            DISPLAY """" ZIP-PLUS-4 """"
+            IF ZIP-PLUS-4 NOT = 6789
+            DISPLAY "ZIP-PLUS-4 wrong: " ZIP-PLUS-4
+            END-DISPLAY
+            END-IF
+            MOVE "X" TO POST-CORRT-IND
+            DISPLAY """" ZIP-9 """"
+            DISPLAY """" POSTAL-CORRECT-IND  """"
+            DISPLAY """" POST-CORRT-IND """"
+            IF POST-CORRT-IND NOT = "X"
+            DISPLAY "POST-CORRT-IND wrong: " POST-CORRT-IND
+            END-DISPLAY
+            END-IF
+            STOP RUN.
+
diff --git a/gcc/testsuite/cobol.dg/group2/REDEFINES__chained.out b/gcc/testsuite/cobol.dg/group2/REDEFINES__chained.out
new file mode 100644
index 00000000000..56f7d295638
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/REDEFINES__chained.out
@@ -0,0 +1,6 @@
+"123456789"
+"6789"
+"123456780"
+"12345678X"
+"X"
+
diff --git a/gcc/testsuite/cobol.dg/group2/RETURN-CODE_moving.cob b/gcc/testsuite/cobol.dg/group2/RETURN-CODE_moving.cob
index 7d3c9956de3..a79e43b4110 100644
--- a/gcc/testsuite/cobol.dg/group2/RETURN-CODE_moving.cob
+++ b/gcc/testsuite/cobol.dg/group2/RETURN-CODE_moving.cob
@@ -1,5 +1,6 @@
        *> { dg-do run }
        *> { dg-xfail-run-if "" { *-*-* }  }
+       *> { dg-options "-dialect ibm" }
 
        IDENTIFICATION   DIVISION.
        PROGRAM-ID.      prog.
diff --git a/gcc/testsuite/cobol.dg/group2/RETURN-CODE_with_INITIAL_and_RECURSIVE.cob b/gcc/testsuite/cobol.dg/group2/RETURN-CODE_with_INITIAL_and_RECURSIVE.cob
new file mode 100644
index 00000000000..904743ecbf3
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/RETURN-CODE_with_INITIAL_and_RECURSIVE.cob
@@ -0,0 +1,47 @@
+       *> { dg-do run }
+       *> { dg-options "-dialect ibm" }
+       *> { dg-output-file "group2/RETURN-CODE_with_INITIAL_and_RECURSIVE.out" }
+        identification      division.
+        program-id.         prog.
+        procedure           division.
+            display "prog starting return code should be +0000:           " return-code
+            call "prog-a"
+            display "prog first return code from prog-a  should be +0123: " return-code
+            call "prog-a"
+            display "prog second return code from prog-a should be +0246: " return-code
+
+            call "prog-i"
+            display "prog first return code from prog-i  should be +0321: " return-code
+            call "prog-i"
+            display "prog second return code from prog-i should be +0321: " return-code
+
+            call "prog-r"
+            display "prog first return code from prog-r  should be -0123: " return-code
+            call "prog-r"
+            display "prog second return code from prog-r should be -0123: " return-code
+
+            move zero to return-code
+            goback.
+        end program         prog.
+
+        identification      division.
+        program-id.         prog-a.
+        procedure           division.
+            add 123 to return-code
+            goback.
+        end program         prog-a.
+
+        identification      division.
+        program-id.         prog-i INITIAL.
+        procedure           division.
+            add 321 to return-code
+            goback.
+        end program         prog-i.
+
+        identification      division.
+        program-id.         prog-r RECURSIVE.
+        procedure           division.
+            add -123 to return-code
+            goback.
+        end program         prog-r.
+
diff --git a/gcc/testsuite/cobol.dg/group2/RETURN-CODE_with_INITIAL_and_RECURSIVE.out b/gcc/testsuite/cobol.dg/group2/RETURN-CODE_with_INITIAL_and_RECURSIVE.out
new file mode 100644
index 00000000000..0331bd354ce
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/RETURN-CODE_with_INITIAL_and_RECURSIVE.out
@@ -0,0 +1,8 @@
+prog starting return code should be +0000:           +0000
+prog first return code from prog-a  should be +0123: +0123
+prog second return code from prog-a should be +0246: +0246
+prog first return code from prog-i  should be +0321: +0321
+prog second return code from prog-i should be +0321: +0321
+prog first return code from prog-r  should be -0123: -0123
+prog second return code from prog-r should be -0123: -0123
+
diff --git a/gcc/testsuite/cobol.dg/group2/Sanity_check_for_ENTRY.cob b/gcc/testsuite/cobol.dg/group2/Sanity_check_for_ENTRY.cob
new file mode 100644
index 00000000000..eb20f3d5224
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Sanity_check_for_ENTRY.cob
@@ -0,0 +1,25 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/Sanity_check_for_ENTRY.out" }
+        identification   division.
+        program-id.      prog.
+        data             division.
+        working-storage  section.
+        01 foo pic x(12).
+        procedure        division.
+        loop.
+            go to dispatch.
+        dispatch.
+            go to pass_1.
+        pass_1.
+            display "I am the first pass"
+            alter dispatch to pass_2.
+            go to loop.
+        pass_2.
+            display "I am the second pass"
+            alter dispatch to pass_3.
+            go to loop.
+        pass_3.
+            display "I am the third and final pass"
+            goback.
+        end program     prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Sanity_check_for_ENTRY.out b/gcc/testsuite/cobol.dg/group2/Sanity_check_for_ENTRY.out
new file mode 100644
index 00000000000..97fc5a0b450
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Sanity_check_for_ENTRY.out
@@ -0,0 +1,4 @@
+I am the first pass
+I am the second pass
+I am the third and final pass
+
diff --git a/gcc/testsuite/cobol.dg/group2/Simple_COMP-X.cob b/gcc/testsuite/cobol.dg/group2/Simple_COMP-X.cob
new file mode 100644
index 00000000000..c26a4da0b36
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Simple_COMP-X.cob
@@ -0,0 +1,32 @@
+       *> { dg-do run }
+       *> { dg-options "-dialect mf" }
+       *> { dg-output-file "group2/Simple_COMP-X.out" }
+        identification          division.
+        program-id.             compx.
+        data                    division.
+        working-storage         section.
+        01 byte.
+          02 byte-val           pic x(1) comp-x.
+        01 short.               
+          02 short-val          pic x(2) comp-x.
+        01 long.                
+          02 long-val           pic x(4) comp-x.
+        01 longlong.            
+          02 longlong-val       pic x(8) comp-x.
+        01 sixteenbytes.        
+          02 sixteenbytes-val   pic x(16) comp-x.
+        procedure               division.
+            move high-values to byte short long longlong sixteenbytes
+            display function hex-of(byte)
+            display function hex-of(short)
+            display function hex-of(long)
+            display function hex-of(longlong)
+            display function hex-of(sixteenbytes)
+            display "byte-val is: " byte-val.
+            display "short-val is: " short-val.
+            display "long-val is: " long-val.
+            display "longlong-val is: " longlong-val.
+            display "sixteenbytes-val is: " sixteenbytes-val.
+            goback.
+        end  program            compx.
+
diff --git a/gcc/testsuite/cobol.dg/group2/Simple_COMP-X.out b/gcc/testsuite/cobol.dg/group2/Simple_COMP-X.out
new file mode 100644
index 00000000000..f88e182cb5b
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/Simple_COMP-X.out
@@ -0,0 +1,11 @@
+FF
+FFFF
+FFFFFFFF
+FFFFFFFFFFFFFFFF
+FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF
+byte-val is: 255
+short-val is: 65535
+long-val is: 4294967295
+longlong-val is: 8446744073709551615
+sixteenbytes-val is: 340282366920938463463374607431768211455
+
diff --git a/gcc/testsuite/cobol.dg/group2/compare_alpha_to_all__literal_.cob b/gcc/testsuite/cobol.dg/group2/compare_alpha_to_all__literal_.cob
new file mode 100644
index 00000000000..1687585e724
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/compare_alpha_to_all__literal_.cob
@@ -0,0 +1,16 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/compare_alpha_to_all__literal_.out" }
+        identification      division.
+        program-id.         prog.
+        data                division.
+        working-storage     section.
+        01 var1 pic x(64) value all "Bob".
+        procedure           division.
+            if var1 equal all "Bob"
+                display "It's all Bob."
+            else
+                display "It's not Bob."
+                end-if
+            goback.
+        end program         prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/compare_alpha_to_all__literal_.out b/gcc/testsuite/cobol.dg/group2/compare_alpha_to_all__literal_.out
new file mode 100644
index 00000000000..e5cebef4065
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/compare_alpha_to_all__literal_.out
@@ -0,0 +1,2 @@
+It's all Bob.
+
diff --git a/gcc/testsuite/cobol.dg/group2/compare_national_to_display.cob b/gcc/testsuite/cobol.dg/group2/compare_national_to_display.cob
new file mode 100644
index 00000000000..d34cd8b4f64
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/compare_national_to_display.cob
@@ -0,0 +1,58 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/compare_national_to_display.out" }
+        identification      division.
+        program-id.         prog.
+        environment division.
+        configuration section.
+        special-names.
+            locale greek is "cyrillic"
+            locale unicode is "utf16le".
+        object-computer.
+            xerox-parc-star 
+            character classification
+                for alphanumeric is greek
+                for national is unicode.
+        data                division.
+        working-storage     section.
+        01 aaa pic x(16).
+        01 bbb pic n(16).
+        procedure           division.
+            move  "aaa" to aaa
+            move n"aaa" to bbb
+            if aaa equal bbb
+                display "1 - correct"
+            else
+                display "1 -- bad"
+                end-if
+            if bbb equal aaa
+                display "2 - correct"
+            else
+                display "2 -- bad"
+                end-if
+            move  "aaa" to aaa
+            move n"bbb" to bbb
+            if aaa < bbb
+                display "3 - correct"
+            else
+                display "3 -- bad"
+                end-if
+            if bbb > aaa
+                display "4 - correct"
+            else
+                display "4 -- bad"
+                end-if
+            move  "bbb" to aaa
+            move n"aaa" to bbb
+            if aaa > bbb
+                display "5 - correct"
+            else
+                display "5 -- bad"
+                end-if
+            if bbb < aaa
+                display "6 - correct"
+            else
+                display "6 -- bad"
+                end-if
+            goback.
+        end program         prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/compare_national_to_display.out b/gcc/testsuite/cobol.dg/group2/compare_national_to_display.out
new file mode 100644
index 00000000000..05de6222e51
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/compare_national_to_display.out
@@ -0,0 +1,7 @@
+1 - correct
+2 - correct
+3 - correct
+4 - correct
+5 - correct
+6 - correct
+
diff --git a/gcc/testsuite/cobol.dg/group2/comprensive_compare_comp-1_comp-5.cob b/gcc/testsuite/cobol.dg/group2/comprensive_compare_comp-1_comp-5.cob
new file mode 100644
index 00000000000..7f9d4517c50
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/comprensive_compare_comp-1_comp-5.cob
@@ -0,0 +1,107 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/comprensive_compare_comp-1_comp-5.out" }
+        identification          division.
+        program-id.             prog.
+        data                    division.
+        working-storage         section.
+        01 aaa comp-1.
+        01 bbb pic S999 comp-5.
+        01 known pic xxxx.
+        01 result pic xxxx.
+        procedure               division.
+            move -1 to aaa move 1 to bbb move ".lt." to known
+            perform checker.
+            move  1 to aaa move 1 to bbb move ".eq." to known
+            perform checker.
+            move  1 to aaa move -1 to bbb move ".gt." to known
+            perform checker.
+            goback.
+        checker.
+            display "checking " space aaa space known space bbb
+            perform lt
+            perform le
+            perform eq
+            perform ge
+            perform gt
+            perform ne
+            continue.
+        lt.
+            display "  .lt. " with no advancing
+            move "xxxx" to result
+            evaluate true
+              when known equal ".lt." if aaa < bbb move "Good" to result
+                                       else move "BAD!" to result end-if
+              when known equal ".eq." if aaa < bbb move "BAD!" to result
+                                      else move "Good" to result end-if
+              when known equal ".gt." if aaa < bbb move "BAD!" to result
+                                      else move "Good" to result end-if
+            end-evaluate
+            display space result
+            continue.
+        le.
+            display "  .le. " with no advancing
+            move "xxxx" to result
+            evaluate true
+              when known equal ".lt." if aaa <= bbb 
+                 move "Good" to result else move "BAD!" to result end-if
+              when known equal ".eq." if aaa <= bbb 
+                 move "Good" to result else move "BAD!" to result end-if
+              when known equal ".gt." if aaa <= bbb 
+                 move "BAD!" to result else move "Good" to result end-if
+            end-evaluate
+            display space result
+            continue.
+        eq.
+            display "  .eq. " with no advancing
+            move "xxxx" to result
+            evaluate true
+              when known equal ".lt." if aaa = bbb 
+                 move "BAD!" to result else move "Good" to result end-if
+              when known equal ".eq." if aaa = bbb 
+                 move "Good" to result else move "BAD!" to result end-if
+              when known equal ".gt." if aaa = bbb 
+                 move "BAD!" to result else move "Good" to result end-if
+            end-evaluate
+            display space result
+            continue.
+        ge.
+            display "  .ge. " with no advancing
+            move "xxxx" to result
+            evaluate true
+              when known equal ".lt." if aaa >= bbb 
+                move "BAD!" to result else move "Good" to result end-if
+              when known equal ".eq." if aaa >= bbb
+                move "Good" to result else move "BAD!" to result end-if
+              when known equal ".gt." if aaa >= bbb
+                move "Good" to result else move "BAD!" to result end-if
+            end-evaluate
+            display space result
+            continue.
+        gt.
+            display "  .gt. " with no advancing
+            move "xxxx" to result
+            evaluate true
+              when known equal ".lt." if aaa > bbb
+                move "BAD!" to result else move "Good" to result end-if
+              when known equal ".eq." if aaa > bbb
+                move "BAD!" to result else move "Good" to result end-if
+              when known equal ".gt." if aaa > bbb
+                move "Good" to result else move "BAD!" to result end-if
+            end-evaluate
+            display space result
+            continue.
+        ne.
+            display "  .ne. " with no advancing
+            move "xxxx" to result
+            evaluate true
+              when known equal ".lt." if aaa <> bbb 
+                move "Good" to result else move "BAD!" to result end-if
+              when known equal ".eq." if aaa <> bbb
+                move "BAD!" to result else move "Good" to result end-if
+              when known equal ".gt." if aaa <> bbb
+                move "Good" to result else move "BAD!" to result end-if
+            end-evaluate
+            display space result
+            continue.
+        end program             prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/comprensive_compare_comp-1_comp-5.out b/gcc/testsuite/cobol.dg/group2/comprensive_compare_comp-1_comp-5.out
new file mode 100644
index 00000000000..bef4cbbf92d
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/comprensive_compare_comp-1_comp-5.out
@@ -0,0 +1,22 @@
+checking  -1 .lt. +001
+  .lt.  Good
+  .le.  Good
+  .eq.  Good
+  .ge.  Good
+  .gt.  Good
+  .ne.  Good
+checking  1 .eq. +001
+  .lt.  Good
+  .le.  Good
+  .eq.  Good
+  .ge.  Good
+  .gt.  Good
+  .ne.  Good
+checking  1 .gt. -001
+  .lt.  Good
+  .le.  Good
+  .eq.  Good
+  .ge.  Good
+  .gt.  Good
+  .ne.  Good
+
diff --git a/gcc/testsuite/cobol.dg/group2/refmod_with_nested_parentheses.cob b/gcc/testsuite/cobol.dg/group2/refmod_with_nested_parentheses.cob
new file mode 100644
index 00000000000..02ab56d0cfd
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/refmod_with_nested_parentheses.cob
@@ -0,0 +1,20 @@
+       *> { dg-do run }
+       *> { dg-options "-dialect ibm" }
+       *> { dg-output-file "group2/refmod_with_nested_parentheses.out" }
+        IDENTIFICATION DIVISION.
+        PROGRAM-ID. refmod_nested_paren_expr.
+        DATA DIVISION.
+        WORKING-STORAGE SECTION.
+        01  TXT                        PIC X(10) VALUE 'ABCDEFGHIJ'.
+        01  N                          PIC 9      VALUE 2.
+        01  OUT-CH                     PIC X.
+        01  stride                     PIC 9.
+        PROCEDURE DIVISION.
+      *> LENGTH OF is bytes, so we need stride to handle UTF-16
+            move length of out-ch to stride
+            display TXT(((LENGTH OF TXT / (2*stride)) - (N / 2)):1)
+            MOVE TXT(((LENGTH OF TXT / (2*stride)) - (N / 2)):1) 
+                                                              TO OUT-CH
+            display OUT-CH
+            GOBACK.
+
diff --git a/gcc/testsuite/cobol.dg/group2/refmod_with_nested_parentheses.out b/gcc/testsuite/cobol.dg/group2/refmod_with_nested_parentheses.out
new file mode 100644
index 00000000000..1fc2ca8e9de
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/refmod_with_nested_parentheses.out
@@ -0,0 +1,3 @@
+D
+D
+
diff --git a/gcc/testsuite/cobol.dg/group2/signed_unsigned_compare.cob b/gcc/testsuite/cobol.dg/group2/signed_unsigned_compare.cob
new file mode 100644
index 00000000000..bc66e7362dd
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/signed_unsigned_compare.cob
@@ -0,0 +1,17 @@
+       *> { dg-do run }
+       *> { dg-output-file "group2/signed_unsigned_compare.out" }
+        identification          division.
+        program-id.             prog.
+        data                    division.
+        working-storage         section.
+        01 aaa binary-long   signed value -1.
+        01 bbb binary-long unsigned value  1.
+        procedure               division.
+        if aaa < bbb
+            display "-1 is properly .LT. than +1"
+        else
+            display "-1 is IMPROPERLY .GE. than +1"
+            end-if
+        goback.
+        end program             prog.
+
diff --git a/gcc/testsuite/cobol.dg/group2/signed_unsigned_compare.out b/gcc/testsuite/cobol.dg/group2/signed_unsigned_compare.out
new file mode 100644
index 00000000000..b2d25c4482f
--- /dev/null
+++ b/gcc/testsuite/cobol.dg/group2/signed_unsigned_compare.out
@@ -0,0 +1,2 @@
+-1 is properly .LT. than +1
+
diff --git a/libgcobol/charmaps.h b/libgcobol/charmaps.h
index 477553cd370..5c0af01f921 100644
--- a/libgcobol/charmaps.h
+++ b/libgcobol/charmaps.h
@@ -536,7 +536,7 @@ class charmap_t
       switch(figconst)
         {
         case normal_value_e :
-          abort();
+          // Just leave it at zero
           break;
         case low_value_e    :
           const_char = low_value_character();
diff --git a/libgcobol/common-defs.h b/libgcobol/common-defs.h
index 5cc341c4669..fe3ec7b3265 100644
--- a/libgcobol/common-defs.h
+++ b/libgcobol/common-defs.h
@@ -160,6 +160,11 @@ enum cbl_field_type_t {
   FldPointer,
 };
 
+/* In some places, I use SUPERTYPE for things like MOVES and COMPARES to
+   avoid lots of conditionals or complex multi-level switch() statements. */
+
+#define SUPERTYPE(a, b) ((static_cast<int>(a)<<5)+(static_cast<int>(b)))
+
 
 /*  BINARY, COMP, COMPUTATIONAL, COMP-4, COMPUTATIONAL-4 are the same:
  *      Storage, by default, is big-endian.
@@ -427,7 +432,7 @@ cbl_file_mode_str( cbl_file_mode_t mode ) {
   case file_mode_any_e:    return "file_mode_any_e";
   }
   return "???";
-};
+}
 
 enum module_type_t {
   module_activating_e,
diff --git a/libgcobol/gcobolio.h b/libgcobol/gcobolio.h
index e97803ee50b..13e3160c958 100644
--- a/libgcobol/gcobolio.h
+++ b/libgcobol/gcobolio.h
@@ -65,6 +65,21 @@ typedef struct cblc_field_t
     int            alphabet;    // Same as cbl_field_t::codeset::language
     } cblc_field_t;
 
+typedef struct cblc_referlet_t
+    {
+    cblc_field_t        *field;
+    size_t               offset;
+    size_t               size;
+    } cblc_referlet_t;
+
+typedef struct cblc_refer_t
+    {
+    cblc_field_t        *field;
+    size_t               offset;
+    size_t               size;
+    int                  flags;
+    } cblc_refer_t;
+
 /*
  * Implementation details
  */
@@ -133,26 +148,4 @@ typedef struct cblc_file_t
     int                  alphabet;         // Actually cbl_encoding_t
     } cblc_file_t;
 
-
-/*  In various arithmetic routines implemented in libgcobol, it is oftent the
-    case that complicates lists of variables need to be conveyed.  For example,
-    "ADD A B C D GIVING E" and "ADD A TO B C D" are valid instructions.
-    
-    These treeplets (triplets of trees) were created to handle that.  */
-
-extern cblc_field_t ** __gg__treeplet_1f;
-extern size_t       *  __gg__treeplet_1o;
-extern size_t       *  __gg__treeplet_1s;
-extern cblc_field_t ** __gg__treeplet_2f;
-extern size_t       *  __gg__treeplet_2o;
-extern size_t       *  __gg__treeplet_2s;
-extern cblc_field_t ** __gg__treeplet_3f;
-extern size_t       *  __gg__treeplet_3o;
-extern size_t       *  __gg__treeplet_3s;
-extern cblc_field_t ** __gg__treeplet_4f;
-extern size_t       *  __gg__treeplet_4o;
-extern size_t       *  __gg__treeplet_4s;
-
-extern int *        __gg__fourplet_flags;
-
 #endif
diff --git a/libgcobol/gmath.cc b/libgcobol/gmath.cc
index 9419986d9be..105d79e030e 100644
--- a/libgcobol/gmath.cc
+++ b/libgcobol/gmath.cc
@@ -257,25 +257,18 @@ extern "C"
 void
 __gg__pow(  cbl_arith_format_t,
             size_t,
+      const cblc_referlet_t *A,
             size_t,
+      const cblc_referlet_t *B,
             size_t,
+      const cblc_referlet_t *C,
       const cbl_round_t  *rounded,
             int           on_error_flag,
             int          *compute_error
             )
   {
-        cblc_field_t **A  = __gg__treeplet_1f;
-  const size_t       *A_o = __gg__treeplet_1o;
-  const size_t       *A_s = __gg__treeplet_1s;
-        cblc_field_t **B  = __gg__treeplet_2f;
-  const size_t       *B_o = __gg__treeplet_2o;
-  const size_t       *B_s = __gg__treeplet_2s;
-        cblc_field_t **C  = __gg__treeplet_3f;
-  const size_t       *C_o = __gg__treeplet_3o;
-  const size_t       *C_s = __gg__treeplet_3s;
-
-  GCOB_FP128 avalue = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
-  GCOB_FP128 bvalue = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
+  GCOB_FP128 avalue = __gg__float128_from_qualified_field(A[0].field, A[0].offset, A[0].size);
+  GCOB_FP128 bvalue = __gg__float128_from_qualified_field(B[0].field, B[0].offset, B[0].size);
   GCOB_FP128 tgt_value;
 
   if( avalue == 0 && bvalue == 0 )
@@ -310,9 +303,9 @@ __gg__pow(  cbl_arith_format_t,
     }
   if( !(*compute_error & compute_error_exp_minus_by_frac) )
     {
-    *compute_error |= conditional_stash(C[0],
-                                        C_o[0],
-                                        C_s[0],
+    *compute_error |= conditional_stash(C[0].field,
+                                        C[0].offset,
+                                        C[0].size,
                                         (on_error_flag & ON_SIZE_ERROR),
                                         tgt_value,
                                         *rounded);
@@ -584,8 +577,11 @@ extern "C"
 void
 __gg__add_fixed_phase1( cbl_arith_format_t ,
                         size_t nA,
+                  const cblc_referlet_t *AA,
                         size_t ,
+                        cblc_referlet_t *,
                         size_t ,
+                        cblc_referlet_t *,
                   const cbl_round_t  *,
                         int           ,
                         int          *compute_error
@@ -595,12 +591,8 @@ __gg__add_fixed_phase1( cbl_arith_format_t ,
 
   // The result goes into the temporary phase1_result.
 
-        cblc_field_t **A  = __gg__treeplet_1f;
-  const size_t       *A_o = __gg__treeplet_1o;
-  const size_t       *A_s = __gg__treeplet_1s;
-
   // Let us prime the pump with the first value of A[]
-  get_int256_from_qualified_field(phase1_result, phase1_rdigits, A[0], A_o[0], A_s[0]);
+  get_int256_from_qualified_field(phase1_result, phase1_rdigits, AA[0].field, AA[0].offset, AA[0].size);
 
   // We now go into a loop adding each of the A[] values to phase1_result:
 
@@ -608,7 +600,7 @@ __gg__add_fixed_phase1( cbl_arith_format_t ,
     {
     int temp_rdigits;
     int256 temp = {};
-    get_int256_from_qualified_field(temp, temp_rdigits, A[i], A_o[i], A_s[i]);
+    get_int256_from_qualified_field(temp, temp_rdigits, AA[i].field, AA[i].offset, AA[i].size);
 
     // We have to scale the one with fewer rdigits to match the one with greater
     // rdigits:
@@ -640,23 +632,22 @@ extern "C"
 void
 __gg__addf1_fixed_phase2( cbl_arith_format_t ,
                           size_t ,
+                          cblc_referlet_t *,
                           size_t ,
+                          cblc_referlet_t *,
                           size_t ,
+                    const cblc_referlet_t *C,
                     const cbl_round_t  *rounded,
                           int           on_error_flag,
                           int          *compute_error
                           )
   {
-        cblc_field_t **C  = __gg__treeplet_3f;
-  const size_t       *C_o = __gg__treeplet_3o;
-  const size_t       *C_s = __gg__treeplet_3s;
-
   // This is the assignment phase of an ADD Format 1
 
   // We take phase1_result and accumulate it into C
   bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
 
-  if( C[0]->type == FldFloat)
+  if( C[0].field->type == FldFloat)
     {
     // The target we need to accumulate into is a floating-point number, so we
     // need to convert our fixed-point intermediate into floating point and
@@ -667,12 +658,16 @@ __gg__addf1_fixed_phase2( cbl_arith_format_t ,
     value_a /= __gg__power_of_ten(phase1_rdigits);
 
     // Pick up the target
-    GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
+    GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[0].field,
+                                                             C[0].offset,
+                                                             C[0].size);
 
     value_a += value_b;
 
     // At this point, we assign running_sum to *C.
-    *compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
+    *compute_error |= conditional_stash(C[0].field,
+                                        C[0].offset,
+                                        C[0].size,
                                         on_size_error,
                                         value_a,
                                         *rounded++);
@@ -687,10 +682,14 @@ __gg__addf1_fixed_phase2( cbl_arith_format_t ,
     int256 value_b = {};
     int rdigits_b;
 
-    get_int256_from_qualified_field(value_b, rdigits_b, C[0], C_o[0], C_s[0]);
+    get_int256_from_qualified_field(value_b,
+                                    rdigits_b,
+                                    C[0].field,
+                                    C[0].offset,
+                                    C[0].size);
 
-    // We have to scale the one with fewer rdigits to match the one with greater
-    // rdigits:
+    // We have to scale the one with fewer rdigits to match the one with
+    // greater rdigits:
     if( rdigits_a > rdigits_b )
       {
       scale_int256_by_digits(value_b, rdigits_a - rdigits_b);
@@ -712,7 +711,9 @@ __gg__addf1_fixed_phase2( cbl_arith_format_t ,
       }
 
       // At this point, we assign running_sum to *C.
-    *compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
+    *compute_error |= conditional_stash(C[0].field,
+                                        C[0].offset,
+                                        C[0].size,
                                         on_size_error,
                                         value_a.i128[0],
                                         rdigits_a,
@@ -724,8 +725,11 @@ extern "C"
 void
 __gg__fixed_phase2_assign_to_c( cbl_arith_format_t ,
                                 size_t ,
+                                cblc_referlet_t *,
                                 size_t ,
+                                cblc_referlet_t *,
                                 size_t ,
+                          const cblc_referlet_t *CC,
                           const cbl_round_t  *rounded,
                                 int           on_error_flag,
                                 int          *compute_error
@@ -733,15 +737,10 @@ __gg__fixed_phase2_assign_to_c( cbl_arith_format_t ,
   {
   // This is the assignment phase of an ADD or SUBTRACT Format 2
 
-        cblc_field_t **C  = __gg__treeplet_3f;
-  const size_t       *C_o = __gg__treeplet_3o;
-  const size_t       *C_s = __gg__treeplet_3s;
-
-
   // We take phase1_result and put it into C
   bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
 
-  if( C[0]->type == FldFloat)
+  if( CC[0].field->type == FldFloat)
     {
     // The target we need to accumulate into is a floating-point number, so we
     // need to convert our fixed-point intermediate into floating point and
@@ -751,7 +750,7 @@ __gg__fixed_phase2_assign_to_c( cbl_arith_format_t ,
     GCOB_FP128 value_a = (GCOB_FP128)phase1_result.i128[0];
     value_a /= __gg__power_of_ten(phase1_rdigits);
 
-    *compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
+    *compute_error |= conditional_stash(CC[0].field, CC[0].offset, CC[0].size,
                                         on_size_error,
                                         value_a,
                                        *rounded++);
@@ -769,7 +768,7 @@ __gg__fixed_phase2_assign_to_c( cbl_arith_format_t ,
       *compute_error |= compute_error_overflow;
       }
 
-    if( C[0]->type == FldPointer )
+    if( CC[0].field->type == FldPointer )
       {
       // In case somebody does pointer arithmetic that goes negative, we need
       // to make the top 64 bits positive.  Otherwise, the conditional stash
@@ -779,7 +778,7 @@ __gg__fixed_phase2_assign_to_c( cbl_arith_format_t ,
       }
 
       // At this point, we assign that value to *C.
-    *compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
+    *compute_error |= conditional_stash(CC[0].field, CC[0].offset, CC[0].size,
                                         on_size_error,
                                         value_a.i128[0],
                                         rdigits_a,
@@ -791,8 +790,11 @@ extern "C"
 void
 __gg__add_float_phase1( cbl_arith_format_t ,
                         size_t nA,
+                  const cblc_referlet_t *A,
                         size_t ,
+                        cblc_referlet_t *,
                         size_t ,
+                        cblc_referlet_t *,
                   const cbl_round_t  *,
                         int           ,
                         int          *compute_error
@@ -802,18 +804,14 @@ __gg__add_float_phase1( cbl_arith_format_t ,
 
   // The result goes into the temporary phase1_result_ffloat.
 
-        cblc_field_t **A  = __gg__treeplet_1f;
-  const size_t       *A_o = __gg__treeplet_1o;
-  const size_t       *A_s = __gg__treeplet_1s;
-
   // Let us prime the pump with the first value of A[]
-  phase1_result_float = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
+  phase1_result_float = __gg__float128_from_qualified_field(A[0].field, A[0].offset, A[0].size);
 
   // We now go into a loop adding each of the A[] values to phase1_result_flt:
 
   for( size_t i=1; i<nA; i++ )
     {
-    GCOB_FP128 temp = __gg__float128_from_qualified_field(A[i], A_o[i], A_s[i]);
+    GCOB_FP128 temp = __gg__float128_from_qualified_field(A[i].field, A[i].offset, A[i].size);
     phase1_result_float = addition_helper_float(phase1_result_float,
                                                 temp,
                                                 compute_error);
@@ -824,24 +822,23 @@ extern "C"
 void
 __gg__addf1_float_phase2( cbl_arith_format_t ,
                           size_t ,
+                          cblc_referlet_t *,
                           size_t ,
+                          cblc_referlet_t *,
                           size_t ,
+                    const cblc_referlet_t *C,
                     const cbl_round_t  *rounded,
                           int           on_error_flag,
                           int          *compute_error
                           )
   {
-        cblc_field_t **C  = __gg__treeplet_3f;
-  const size_t       *C_o = __gg__treeplet_3o;
-  const size_t       *C_s = __gg__treeplet_3s;
-
   bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
   // This is the assignment phase of an ADD Format 2
   // We take phase1_result and accumulate it into C
 
-  GCOB_FP128 temp = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
+  GCOB_FP128 temp = __gg__float128_from_qualified_field(C[0].field, C[0].offset, C[0].size);
   temp = addition_helper_float(temp, phase1_result_float, compute_error);
-  *compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
+  *compute_error |= conditional_stash(C[0].field, C[0].offset, C[0].size,
                                       on_size_error,
                                       temp,
                                      *rounded++);
@@ -851,22 +848,21 @@ extern "C"
 void
 __gg__float_phase2_assign_to_c( cbl_arith_format_t ,
                           size_t ,
+                          cblc_referlet_t *,
                           size_t ,
+                          cblc_referlet_t *,
                           size_t ,
+                    const cblc_referlet_t *C,
                     const cbl_round_t  *rounded,
                           int           on_error_flag,
                           int          *compute_error
                           )
   {
-        cblc_field_t **C  = __gg__treeplet_3f;
-  const size_t       *C_o = __gg__treeplet_3o;
-  const size_t       *C_s = __gg__treeplet_3s;
-
   bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
   // This is the assignment phase of an ADD Format 2
     // We take phase1_result and put it into C
 
-  *compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
+  *compute_error |= conditional_stash(C[0].field, C[0].offset, C[0].size,
                                       on_size_error,
                                       phase1_result_float,
                                      *rounded++);
@@ -876,8 +872,11 @@ extern "C"
 void
 __gg__addf3(cbl_arith_format_t ,
             size_t nA,
+       const cblc_referlet_t *A,
             size_t ,
+            cblc_referlet_t *,
             size_t ,
+       const cblc_referlet_t *C,
       const cbl_round_t  *rounded,
             int           on_error_flag,
             int          *compute_error
@@ -886,27 +885,19 @@ __gg__addf3(cbl_arith_format_t ,
   // This is an ADD Format 3.  Each A[i] gets accumulated into each C[i].  When
   // both are fixed, we do fixed arithmetic.  When either is a FldFloat, we
   // do floating-point arithmetic.
-        cblc_field_t **A  = __gg__treeplet_1f;
-  const size_t       *A_o = __gg__treeplet_1o;
-  const size_t       *A_s = __gg__treeplet_1s;
-
-        cblc_field_t **C  = __gg__treeplet_3f;
-  const size_t       *C_o = __gg__treeplet_3o;
-  const size_t       *C_s = __gg__treeplet_3s;
-
   bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
 
   for(size_t i=0; i<nA; i++)
     {
-    if( A[i]->type == FldFloat || C[i]->type == FldFloat )
+    if( A[i].field->type == FldFloat || C[i].field->type == FldFloat )
       {
-      GCOB_FP128 value_a = __gg__float128_from_qualified_field(A[i], A_o[i], A_s[i]);
-      GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[i], C_o[i], C_s[i]);
+      GCOB_FP128 value_a = __gg__float128_from_qualified_field(A[i].field, A[i].offset, A[i].size);
+      GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[i].field, C[i].offset, C[i].size);
 
       value_a = addition_helper_float(value_a, value_b, compute_error);
 
         // At this point, we assign the sum to *C.
-      *compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
+      *compute_error |= conditional_stash(C[i].field, C[i].offset, C[i].size,
                                           on_size_error,
                                           value_a,
                                           *rounded++);
@@ -920,8 +911,8 @@ __gg__addf3(cbl_arith_format_t ,
       int256 value_b;
       int rdigits_b;
 
-      get_int256_from_qualified_field(value_a, rdigits_a, A[i], A_o[i], A_s[i]);
-      get_int256_from_qualified_field(value_b, rdigits_b, C[i], C_o[i], C_s[i]);
+      get_int256_from_qualified_field(value_a, rdigits_a, A[i].field, A[i].offset, A[i].size);
+      get_int256_from_qualified_field(value_b, rdigits_b, C[i].field, C[i].offset, C[i].size);
 
       // We have to scale the one with fewer rdigits to match the one with greater
       // rdigits:
@@ -946,7 +937,7 @@ __gg__addf3(cbl_arith_format_t ,
         }
 
         // At this point, we assign the sum to *C.
-      *compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
+      *compute_error |= conditional_stash(C[i].field, C[i].offset, C[i].size,
                                           on_size_error,
                                           value_a.i128[0],
                                           rdigits_a,
@@ -959,23 +950,22 @@ extern "C"
 void
 __gg__subtractf1_fixed_phase2(cbl_arith_format_t ,
                               size_t ,
+                              cblc_referlet_t *,
                               size_t ,
+                              cblc_referlet_t *,
                               size_t ,
+                        const cblc_referlet_t *C,
                         const cbl_round_t  *rounded,
                               int           on_error_flag,
                               int          *compute_error
                               )
   {
-        cblc_field_t **C  = __gg__treeplet_3f;
-  const size_t       *C_o = __gg__treeplet_3o;
-  const size_t       *C_s = __gg__treeplet_3s;
-
   // This is the assignment phase of an ADD Format 1
 
   // We take phase1_result and subtrace it from C
   bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
 
-  if( C[0]->type == FldFloat)
+  if( C[0].field->type == FldFloat)
     {
     // The target we need to accumulate into is a floating-point number, so we
     // need to convert our fixed-point intermediate into floating point and
@@ -986,12 +976,12 @@ __gg__subtractf1_fixed_phase2(cbl_arith_format_t ,
     value_a /= __gg__power_of_ten(phase1_rdigits);
 
     // Pick up the target
-    GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
+    GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[0].field, C[0].offset, C[0].size);
 
     value_b -= value_a;
 
     // At this point, we assign the difference to *C.
-    *compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
+    *compute_error |= conditional_stash(C[0].field, C[0].offset, C[0].size,
                                         on_size_error,
                                         value_b,
                                         *rounded++);
@@ -1006,7 +996,7 @@ __gg__subtractf1_fixed_phase2(cbl_arith_format_t ,
     int256 value_b = {};
     int rdigits_b;
 
-    get_int256_from_qualified_field(value_b, rdigits_b, C[0], C_o[0], C_s[0]);
+    get_int256_from_qualified_field(value_b, rdigits_b, C[0].field, C[0].offset, C[0].size);
 
     // We have to scale the one with fewer rdigits to match the one with greater
     // rdigits:
@@ -1031,7 +1021,7 @@ __gg__subtractf1_fixed_phase2(cbl_arith_format_t ,
       }
 
       // At this point, we assign running_sum to *C.
-    *compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
+    *compute_error |= conditional_stash(C[0].field, C[0].offset, C[0].size,
                                         on_size_error,
                                         value_b.i128[0],
                                         rdigits_b,
@@ -1043,8 +1033,11 @@ extern "C"
 void
 __gg__subtractf2_fixed_phase1(cbl_arith_format_t ,
                               size_t nA,
+                        const cblc_referlet_t *AA,
                               size_t ,
+                        const cblc_referlet_t *BB,
                               size_t ,
+                              cblc_referlet_t *,
                         const cbl_round_t  *rounded,
                               int           on_error_flag,
                               int          *compute_error
@@ -1052,15 +1045,14 @@ __gg__subtractf2_fixed_phase1(cbl_arith_format_t ,
   {
   // This is the calculation phase of a fixed-point SUBTRACT Format 2
 
-        cblc_field_t **B  = __gg__treeplet_2f;
-  const size_t       *B_o = __gg__treeplet_2o;
-  const size_t       *B_s = __gg__treeplet_2s;
-
   // Add up all the A values
   __gg__add_fixed_phase1( not_expected_e ,
                           nA,
+                          AA,
                           0,
+                          NULL,
                           0,
+                          NULL,
                           rounded,
                           on_error_flag,
                           compute_error);
@@ -1073,7 +1065,7 @@ __gg__subtractf2_fixed_phase1(cbl_arith_format_t ,
   int256 value_b = {};
   int rdigits_b;
 
-  get_int256_from_qualified_field(value_b, rdigits_b, B[0], B_o[0], B_s[0]);
+  get_int256_from_qualified_field(value_b, rdigits_b, BB[0].field, BB[0].offset, BB[0].size);
 
   // We have to scale the one with fewer rdigits to match the one with greater
   // rdigits:
@@ -1104,24 +1096,23 @@ extern "C"
 void
 __gg__subtractf1_float_phase2(cbl_arith_format_t ,
                               size_t ,
+                              cblc_referlet_t *,
                               size_t ,
+                              cblc_referlet_t *,
                               size_t ,
+                        const cblc_referlet_t *C,
                         const cbl_round_t  *rounded,
                               int           on_error_flag,
                               int          *compute_error
                               )
   {
-        cblc_field_t **C  = __gg__treeplet_3f;
-  const size_t       *C_o = __gg__treeplet_3o;
-  const size_t       *C_s = __gg__treeplet_3s;
-
   bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
   // This is the assignment phase of an SUBTRACT Format 2
   // We take phase1_result and subtract it from C
 
-  GCOB_FP128 temp = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
+  GCOB_FP128 temp = __gg__float128_from_qualified_field(C[0].field, C[0].offset, C[0].size);
   temp = subtraction_helper_float(temp, phase1_result_float, compute_error);
-  *compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
+  *compute_error |= conditional_stash(C[0].field, C[0].offset, C[0].size,
                                       on_size_error,
                                       temp,
                                      *rounded++);
@@ -1131,8 +1122,11 @@ extern "C"
 void
 __gg__subtractf2_float_phase1(cbl_arith_format_t ,
                               size_t nA,
+                        const cblc_referlet_t *A,
                               size_t ,
+                        const cblc_referlet_t *B,
                               size_t ,
+                              cblc_referlet_t *,
                         const cbl_round_t  *rounded,
                               int           on_error_flag,
                               int          *compute_error
@@ -1140,24 +1134,21 @@ __gg__subtractf2_float_phase1(cbl_arith_format_t ,
   {
   // This is the calculation phase of a fixed-point SUBTRACT Format 2
 
-        cblc_field_t **B  = __gg__treeplet_2f;
-  const size_t       *B_o = __gg__treeplet_2o;
-  const size_t       *B_s = __gg__treeplet_2s;
-
   // Add up all the A values
   __gg__add_float_phase1( not_expected_e ,
                           nA,
+                          A,
                           0,
+                          NULL,
                           0,
+                          NULL,
                           rounded,
                           on_error_flag,
                           compute_error
                           );
 
   // Subtract that subtotal from the B value:
-  GCOB_FP128 value_b = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
-
-
+  GCOB_FP128 value_b = __gg__float128_from_qualified_field(B[0].field, B[0].offset, B[0].size);
   phase1_result_float = subtraction_helper_float(value_b, phase1_result_float, compute_error);
   }
 
@@ -1165,8 +1156,11 @@ extern "C"
 void
 __gg__subtractf3( cbl_arith_format_t ,
                   size_t nA,
+            const cblc_referlet_t *A,
                   size_t ,
+                  cblc_referlet_t *,
                   size_t ,
+            const cblc_referlet_t *C,
             const cbl_round_t  *rounded,
                   int           on_error_flag,
                   int          *compute_error
@@ -1175,26 +1169,19 @@ __gg__subtractf3( cbl_arith_format_t ,
   // This is an ADD Format 3.  Each A[i] gets accumulated into each C[i].  Each
   // SUBTRACTION is treated separately.
 
-        cblc_field_t **A  = __gg__treeplet_1f;
-  const size_t       *A_o = __gg__treeplet_1o;
-  const size_t       *A_s = __gg__treeplet_1s;
-        cblc_field_t **C  = __gg__treeplet_3f;
-  const size_t       *C_o = __gg__treeplet_3o;
-  const size_t       *C_s = __gg__treeplet_3s;
-
   bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
 
   for(size_t i=0; i<nA; i++)
     {
-    if( A[i]->type == FldFloat || C[i]->type == FldFloat)
+    if( A[i].field->type == FldFloat || C[i].field->type == FldFloat)
       {
-      GCOB_FP128 value_a = __gg__float128_from_qualified_field(A[i], A_o[i], A_s[i]);
-      GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[i], C_o[i], C_s[i]);
+      GCOB_FP128 value_a = __gg__float128_from_qualified_field(A[i].field, A[i].offset, A[i].size);
+      GCOB_FP128 value_b = __gg__float128_from_qualified_field(C[i].field, C[i].offset, C[i].size);
 
       value_b = subtraction_helper_float(value_b, value_a, compute_error);
 
         // At this point, we assign the sum to *C.
-      *compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
+      *compute_error |= conditional_stash(C[i].field, C[i].offset, C[i].size,
                                           on_size_error,
                                           value_b,
                                           *rounded++);
@@ -1208,8 +1195,8 @@ __gg__subtractf3( cbl_arith_format_t ,
       int256 value_b;
       int rdigits_b;
 
-      get_int256_from_qualified_field(value_a, rdigits_a, A[i], A_o[i], A_s[i]);
-      get_int256_from_qualified_field(value_b, rdigits_b, C[i], C_o[i], C_s[i]);
+      get_int256_from_qualified_field(value_a, rdigits_a, A[i].field, A[i].offset, A[i].size);
+      get_int256_from_qualified_field(value_b, rdigits_b, C[i].field, C[i].offset, C[i].size);
 
       // We have to scale the one with fewer rdigits to match the one with greater
       // rdigits:
@@ -1235,7 +1222,7 @@ __gg__subtractf3( cbl_arith_format_t ,
         }
 
         // At this point, we assign the sum to *C.
-      *compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
+      *compute_error |= conditional_stash(C[i].field, C[i].offset, C[i].size,
                                           on_size_error,
                                           value_b.i128[0],
                                           rdigits_b,
@@ -1253,8 +1240,11 @@ extern "C"
 void
 __gg__multiplyf1_phase1(cbl_arith_format_t ,
                         size_t ,
+                  const cblc_referlet_t *A,
                         size_t ,
+                        cblc_referlet_t *,
                         size_t ,
+                        cblc_referlet_t *,
                   const cbl_round_t  *,
                         int           ,
                         int          *)
@@ -1262,25 +1252,21 @@ __gg__multiplyf1_phase1(cbl_arith_format_t ,
   // We are getting just the one value, which we are converting to the necessary
   // intermediate form
 
-        cblc_field_t **A  = __gg__treeplet_1f;
-  const size_t       *A_o = __gg__treeplet_1o;
-  const size_t       *A_s = __gg__treeplet_1s;
-
-  if( A[0]->type == FldFloat )
+  if( A[0].field->type == FldFloat )
     {
     multiply_intermediate_is_float = true;
-    multiply_intermediate_float = __gg__float128_from_qualified_field(A[0],
-                                                                      A_o[0],
-                                                                      A_s[0]);
+    multiply_intermediate_float = __gg__float128_from_qualified_field(A[0].field,
+                                                                      A[0].offset,
+                                                                      A[0].size);
     }
   else
     {
     multiply_intermediate_is_float = false;
     multiply_intermediate_int128 =
          __gg__binary_value_from_qualified_field(&multiply_intermediate_rdigits,
-                                                 A[0],
-                                                 A_o[0],
-                                                 A_s[0]);
+                                                 A[0].field,
+                                                 A[0].offset,
+                                                 A[0].size);
     }
   }
 
@@ -1348,17 +1334,16 @@ extern "C"
 void
 __gg__multiplyf1_phase2(cbl_arith_format_t ,
                         size_t ,
+                        cblc_referlet_t *,
                         size_t ,
+                        cblc_referlet_t *,
                         size_t ,
+                  const cblc_referlet_t *C,
                   const cbl_round_t  *rounded,
                         int           on_error_flag,
                         int          *compute_error
                         )
   {
-        cblc_field_t **C  = __gg__treeplet_3f;
-  const size_t       *C_o = __gg__treeplet_3o;
-  const size_t       *C_s = __gg__treeplet_3s;
-
   bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
   int error_this_time=0;
 
@@ -1368,21 +1353,21 @@ __gg__multiplyf1_phase2(cbl_arith_format_t ,
   if( multiply_intermediate_is_float )
     {
     a_value = multiply_intermediate_float;
-    if( C[0]->type == FldFloat )
+    if( C[0].field->type == FldFloat )
       {
-      b_value = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
+      b_value = __gg__float128_from_qualified_field(C[0].field, C[0].offset, C[0].size);
       goto float_float;
       }
     else
       {
       // float times fixed
-      b_value = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
+      b_value = __gg__float128_from_qualified_field(C[0].field, C[0].offset, C[0].size);
       goto float_float;
       }
     }
   else
     {
-    if( C[0]->type == FldFloat )
+    if( C[0].field->type == FldFloat )
       {
       // fixed * float
       a_value = (GCOB_FP128) multiply_intermediate_int128;
@@ -1390,7 +1375,7 @@ __gg__multiplyf1_phase2(cbl_arith_format_t ,
         {
         a_value /= (GCOB_FP128)__gg__power_of_ten(multiply_intermediate_rdigits);
         }
-      b_value = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
+      b_value = __gg__float128_from_qualified_field(C[0].field, C[0].offset, C[0].size);
       goto float_float;
       }
     else
@@ -1402,7 +1387,7 @@ __gg__multiplyf1_phase2(cbl_arith_format_t ,
 
       int cd_rdigits;
       __int128 ab_value = multiply_intermediate_int128;
-      __int128 cd_value = __gg__binary_value_from_qualified_field(&cd_rdigits, C[0], C_o[0], C_s[0]);
+      __int128 cd_value = __gg__binary_value_from_qualified_field(&cd_rdigits, C[0].field, C[0].offset, C[0].size);
 
       int256 ABCD;
       int rdigits = multiply_intermediate_rdigits + cd_rdigits;
@@ -1415,7 +1400,7 @@ __gg__multiplyf1_phase2(cbl_arith_format_t ,
         *compute_error |= compute_error_overflow;
         }
         // At this point, we assign running_sum to *C.
-      *compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
+      *compute_error |= conditional_stash(C[0].field, C[0].offset, C[0].size,
                                           on_size_error,
                                           ABCD.i128[0],
                                           rdigits,
@@ -1434,7 +1419,7 @@ __gg__multiplyf1_phase2(cbl_arith_format_t ,
     }
   else
     {
-    *compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
+    *compute_error |= conditional_stash(C[0].field, C[0].offset, C[0].size,
                                         on_size_error,
                                         a_value,
                                         *rounded);
@@ -1447,23 +1432,16 @@ extern "C"
 void
 __gg__multiplyf2( cbl_arith_format_t ,
                   size_t ,
+            const cblc_referlet_t *A,
                   size_t ,
+            const cblc_referlet_t *B,
                   size_t nC,
+            const cblc_referlet_t *C,
             const cbl_round_t  *rounded,
                   int           on_error_flag,
                   int          *compute_error
                   )
   {
-        cblc_field_t **A  = __gg__treeplet_1f;
-  const size_t       *A_o = __gg__treeplet_1o;
-  const size_t       *A_s = __gg__treeplet_1s;
-        cblc_field_t **B  = __gg__treeplet_2f;
-  const size_t       *B_o = __gg__treeplet_2o;
-  const size_t       *B_s = __gg__treeplet_2s;
-        cblc_field_t **C  = __gg__treeplet_3f;
-  const size_t       *C_o = __gg__treeplet_3o;
-  const size_t       *C_s = __gg__treeplet_3s;
-
   bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
 
   bool      got_float = false;
@@ -1471,10 +1449,10 @@ __gg__multiplyf2( cbl_arith_format_t ,
   int256    product_fix;
   int       product_fix_digits;
 
-  if( A[0]->type == FldFloat || B[0]->type == FldFloat )
+  if( A[0].field->type == FldFloat || B[0].field->type == FldFloat )
     {
-    GCOB_FP128 a_value = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
-    GCOB_FP128 b_value = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
+    GCOB_FP128 a_value = __gg__float128_from_qualified_field(A[0].field, A[0].offset, A[0].size);
+    GCOB_FP128 b_value = __gg__float128_from_qualified_field(B[0].field, B[0].offset, B[0].size);
     product_float = multiply_helper_float(a_value, b_value, compute_error);
     got_float = true;
     }
@@ -1482,8 +1460,8 @@ __gg__multiplyf2( cbl_arith_format_t ,
     {
     int a_rdigits;
     int b_rdigits;
-    __int128 a_value = __gg__binary_value_from_qualified_field(&a_rdigits, A[0], A_o[0], A_s[0]);
-    __int128 b_value = __gg__binary_value_from_qualified_field(&b_rdigits, B[0], B_o[0], B_s[0]);
+    __int128 a_value = __gg__binary_value_from_qualified_field(&a_rdigits, A[0].field, A[0].offset, A[0].size);
+    __int128 b_value = __gg__binary_value_from_qualified_field(&b_rdigits, B[0].field, B[0].offset, B[0].size);
     product_fix_digits = a_rdigits + b_rdigits;
     multiply_int128_by_int128(product_fix, a_value, b_value);
     int overflow = squeeze_int256(product_fix, product_fix_digits);
@@ -1497,14 +1475,14 @@ __gg__multiplyf2( cbl_arith_format_t ,
     {
     if( got_float )
       {
-      *compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
+      *compute_error |= conditional_stash(C[i].field, C[i].offset, C[i].size,
                                           on_size_error,
                                           product_float,
                                           *rounded++);
       }
     else
       {
-      *compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
+      *compute_error |= conditional_stash(C[i].field, C[i].offset, C[i].size,
                                           on_size_error,
                                           product_fix.i128[0],
                                           product_fix_digits,
@@ -1829,17 +1807,16 @@ extern "C"
 void
 __gg__dividef1_phase2(cbl_arith_format_t ,
                       size_t ,
+                      cblc_referlet_t *,
                       size_t ,
+                      cblc_referlet_t *,
                       size_t ,
+                const cblc_referlet_t *C,
                 const cbl_round_t  *rounded,
                       int           on_error_flag,
                       int          *compute_error
                       )
   {
-        cblc_field_t **C  = __gg__treeplet_3f;
-  const size_t       *C_o = __gg__treeplet_3o;
-  const size_t       *C_s = __gg__treeplet_3s;
-
   bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
   int error_this_time=0;
 
@@ -1849,21 +1826,25 @@ __gg__dividef1_phase2(cbl_arith_format_t ,
   if( multiply_intermediate_is_float )
     {
     a_value = multiply_intermediate_float;
-    if( C[0]->type == FldFloat )
+    if( C[0].field->type == FldFloat )
       {
-      b_value = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
+      b_value = __gg__float128_from_qualified_field(C[0].field,
+                                                    C[0].offset,
+                                                    C[0].size);
       goto float_float;
       }
     else
       {
       // float times fixed
-      b_value = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
+      b_value = __gg__float128_from_qualified_field(C[0].field,
+                                                    C[0].offset,
+                                                    C[0].size);
       goto float_float;
       }
     }
   else
     {
-    if( C[0]->type == FldFloat )
+    if( C[0].field->type == FldFloat )
       {
       // gixed * float
       a_value = (GCOB_FP128) multiply_intermediate_int128;
@@ -1871,7 +1852,9 @@ __gg__dividef1_phase2(cbl_arith_format_t ,
         {
         a_value /= (GCOB_FP128)__gg__power_of_ten(multiply_intermediate_rdigits);
         }
-      b_value = __gg__float128_from_qualified_field(C[0], C_o[0], C_s[0]);
+      b_value = __gg__float128_from_qualified_field(C[0].field,
+                                                    C[0].offset,
+                                                    C[0].size);
       goto float_float;
       }
     else
@@ -1882,7 +1865,11 @@ __gg__dividef1_phase2(cbl_arith_format_t ,
       // 64-bit "digits".  We need to multiply them to create a 256-bit result
 
       int dividend_rdigits;
-      __int128 dividend = __gg__binary_value_from_qualified_field(&dividend_rdigits, C[0], C_o[0], C_s[0]);
+      __int128 dividend = __gg__binary_value_from_qualified_field(
+                                                  &dividend_rdigits,
+                                                  C[0].field,
+                                                  C[0].offset,
+                                                  C[0].size);
 
       int quotient_rdigits;
       int256 quotient;
@@ -1901,7 +1888,7 @@ __gg__dividef1_phase2(cbl_arith_format_t ,
         *compute_error |= compute_error_overflow;
         }
         // At this point, we assign the quotient to *C.
-      *compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
+      *compute_error |= conditional_stash(C[0].field, C[0].offset, C[0].size,
                                           on_size_error,
                                           quotient.i128[0],
                                           quotient_rdigits,
@@ -1921,7 +1908,7 @@ __gg__dividef1_phase2(cbl_arith_format_t ,
     }
   else
     {
-    *compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
+    *compute_error |= conditional_stash(C[0].field, C[0].offset, C[0].size,
                                         on_size_error,
                                         b_value,
                                         *rounded);
@@ -1934,33 +1921,30 @@ extern "C"
 void
 __gg__dividef23(cbl_arith_format_t ,
                 size_t ,
+          const cblc_referlet_t *A,
                 size_t ,
+          const cblc_referlet_t *B,
                 size_t nC,
+          const cblc_referlet_t *C,
           const cbl_round_t  *rounded,
                 int           on_error_flag,
                 int          *compute_error
                 )
   {
-        cblc_field_t **A  = __gg__treeplet_1f;
-  const size_t       *A_o = __gg__treeplet_1o;
-  const size_t       *A_s = __gg__treeplet_1s;
-        cblc_field_t **B  = __gg__treeplet_2f;
-  const size_t       *B_o = __gg__treeplet_2o;
-  const size_t       *B_s = __gg__treeplet_2s;
-        cblc_field_t **C  = __gg__treeplet_3f;
-  const size_t       *C_o = __gg__treeplet_3o;
-  const size_t       *C_s = __gg__treeplet_3s;
-
   bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
   int error_this_time=0;
 
-  if( A[0]->type == FldFloat ||  B[0]->type == FldFloat  )
+  if( A[0].field->type == FldFloat ||  B[0].field->type == FldFloat  )
     {
     GCOB_FP128 a_value;
     GCOB_FP128 b_value;
     GCOB_FP128 c_value;
-    a_value = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
-    b_value = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
+    a_value = __gg__float128_from_qualified_field(A[0].field,
+                                                  A[0].offset,
+                                                  A[0].size);
+    b_value = __gg__float128_from_qualified_field(B[0].field,
+                                                  B[0].offset,
+                                                  B[0].size);
     c_value = divide_helper_float(a_value, b_value, &error_this_time);
 
     *compute_error |= error_this_time;
@@ -1968,7 +1952,7 @@ __gg__dividef23(cbl_arith_format_t ,
       {
       for(size_t i=0; i<nC; i++)
         {
-        *compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
+        *compute_error |= conditional_stash(C[i].field, C[i].offset, C[i].size,
                                             on_size_error,
                                             c_value,
                                             *rounded++);
@@ -1979,11 +1963,18 @@ __gg__dividef23(cbl_arith_format_t ,
     {
     // fixed divided by fixed
     int dividend_rdigits;
-    __int128 dividend = __gg__binary_value_from_qualified_field(&dividend_rdigits, A[0], A_o[0], A_s[0]);
+    __int128 dividend = __gg__binary_value_from_qualified_field(
+                                                    &dividend_rdigits,
+                                                    A[0].field,
+                                                    A[0].offset,
+                                                    A[0].size);
 
     int divisor_rdigits;
-    __int128 divisor = __gg__binary_value_from_qualified_field(&divisor_rdigits, B[0], B_o[0], B_s[0]);
-
+    __int128 divisor = __gg__binary_value_from_qualified_field(
+                                                    &divisor_rdigits,
+                                                    B[0].field,
+                                                    B[0].offset,
+                                                    B[0].size);
     int quotient_rdigits;
     int256 quotient;
 
@@ -2001,7 +1992,7 @@ __gg__dividef23(cbl_arith_format_t ,
         // At this point, we assign the quotient to *C.
       for(size_t i=0; i<nC; i++)
         {
-        *compute_error |= conditional_stash(C[i], C_o[i], C_s[i],
+        *compute_error |= conditional_stash(C[i].field, C[i].offset, C[i].size,
                                             on_size_error,
                                             quotient.i128[0],
                                             quotient_rdigits,
@@ -2015,40 +2006,37 @@ extern "C"
 void
 __gg__dividef45(cbl_arith_format_t ,
                 size_t ,
+          const cblc_referlet_t *A,
                 size_t ,
+          const cblc_referlet_t *B,
                 size_t ,
+          const cblc_referlet_t *C,
                 cbl_round_t  *rounded_p,
                 int           on_error_flag,
                 int          *compute_error
                 )
   {
-        cblc_field_t **A  = __gg__treeplet_1f;  // Numerator
-  const size_t       *A_o = __gg__treeplet_1o;
-  const size_t       *A_s = __gg__treeplet_1s;
-        cblc_field_t **B  = __gg__treeplet_2f;  // Denominator
-  const size_t       *B_o = __gg__treeplet_2o;
-  const size_t       *B_s = __gg__treeplet_2s;
-        cblc_field_t **C  = __gg__treeplet_3f;  // Has remainder, then quotient
-  const size_t       *C_o = __gg__treeplet_3o;
-  const size_t       *C_s = __gg__treeplet_3s;
-
   bool on_size_error = !!(on_error_flag & ON_SIZE_ERROR);
   int error_this_time=0;
 
-  if( A[0]->type == FldFloat ||  B[0]->type == FldFloat  )
+  if( A[0].field->type == FldFloat ||  B[0].field->type == FldFloat  )
     {
     GCOB_FP128 a_value;
     GCOB_FP128 b_value;
     GCOB_FP128 c_value;
-    a_value = __gg__float128_from_qualified_field(A[0], A_o[0], A_s[0]);
-    b_value = __gg__float128_from_qualified_field(B[0], B_o[0], B_s[0]);
+    a_value = __gg__float128_from_qualified_field(A[0].field,
+                                                  A[0].offset,
+                                                  A[0].size);
+    b_value = __gg__float128_from_qualified_field(B[0].field,
+                                                  B[0].offset,
+                                                  B[0].size);
     c_value = divide_helper_float(a_value, b_value, &error_this_time);
 
     *compute_error |= error_this_time;
 
     if( !error_this_time )
       {
-      *compute_error |= conditional_stash(C[1], C_o[1], C_s[1],
+      *compute_error |= conditional_stash(C[1].field, C[1].offset, C[1].size,
                                           on_size_error,
                                           c_value,
                                           *rounded_p++);
@@ -2057,7 +2045,7 @@ __gg__dividef45(cbl_arith_format_t ,
       if( !*compute_error )
         {
         c_value = 0;
-        *compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
+        *compute_error |= conditional_stash(C[0].field, C[0].offset, C[0].size,
                                             on_size_error,
                                             c_value,
                                             *rounded_p++);
@@ -2068,10 +2056,18 @@ __gg__dividef45(cbl_arith_format_t ,
     {
     // fixed divided by fixed
     int dividend_rdigits;
-    __int128 dividend = __gg__binary_value_from_qualified_field(&dividend_rdigits, A[0], A_o[0], A_s[0]);
+    __int128 dividend = __gg__binary_value_from_qualified_field(
+                                              &dividend_rdigits,
+                                              A[0].field,
+                                              A[0].offset,
+                                              A[0].size);
 
     int divisor_rdigits;
-    __int128 divisor = __gg__binary_value_from_qualified_field(&divisor_rdigits, B[0], B_o[0], B_s[0]);
+    __int128 divisor = __gg__binary_value_from_qualified_field(
+                                              &divisor_rdigits,
+                                              B[0].field,
+                                              B[0].offset,
+                                              B[0].size);
 
     int quotient_rdigits;
     int256 quotient;
@@ -2096,28 +2092,36 @@ __gg__dividef45(cbl_arith_format_t ,
         {
         case truncation_e:
           {
-          *compute_error |= conditional_stash(C[1], C_o[1], C_s[1],
+          *compute_error |= conditional_stash(C[1].field,
+                                              C[1].offset,
+                                              C[1].size,
                                               on_size_error,
                                               quotient.i128[0],
                                               quotient_rdigits,
                                               *rounded_p++);
           unrounded_quotient = __gg__binary_value_from_qualified_field(
-                                                        &unrounded_quotient_digits,
-                                                        C[1], C_o[1], C_s[1]);
+                                                  &unrounded_quotient_digits,
+                                                  C[1].field,
+                                                  C[1].offset,
+                                                  C[1].size);
           break;
           }
         default:
           {
-          conditional_stash(C[1], C_o[1], C_s[1],
+          conditional_stash(C[1].field, C[1].offset, C[1].size,
                             false,
                             quotient.i128[0],
                             quotient_rdigits,
                             truncation_e);
           unrounded_quotient = __gg__binary_value_from_qualified_field(
-                                                        &unrounded_quotient_digits,
-                                                        C[1], C_o[1], C_s[1]);
+                                                  &unrounded_quotient_digits,
+                                                  C[1].field,
+                                                  C[1].offset,
+                                                  C[1].size);
           // At this point, we assign the rounded quotient to *C.
-          *compute_error |= conditional_stash(C[1], C_o[1], C_s[1],
+          *compute_error |= conditional_stash(C[1].field,
+                                              C[1].offset,
+                                              C[1].size,
                                               on_size_error,
                                               quotient.i128[0],
                                               quotient_rdigits,
@@ -2171,7 +2175,9 @@ __gg__dividef45(cbl_arith_format_t ,
 
         if( !*compute_error )
           {
-          *compute_error |= conditional_stash(C[0], C_o[0], C_s[0],
+          *compute_error |= conditional_stash(C[0].field,
+                                              C[0].offset,
+                                              C[0].size,
                                               on_size_error,
                                               odividend.i128[0],
                                               temp_rdigits,
diff --git a/libgcobol/inspect.cc b/libgcobol/inspect.cc
index 7e6d1648e72..e333e4b1345 100644
--- a/libgcobol/inspect.cc
+++ b/libgcobol/inspect.cc
@@ -820,7 +820,8 @@ the_alpha_and_omega_backward( const normalized_operand &id_before,
 
 static
 void
-inspect_backward_format_1(const size_t integers[])
+inspect_backward_format_1(const size_t integers[],
+                          const cblc_referlet_t *params)
   {
   size_t int_index = 0;
   size_t cblc_index = 0;
@@ -833,9 +834,9 @@ inspect_backward_format_1(const size_t integers[])
   std::vector<id_2_result> id_2_results(n_identifier_2);
 
   // Pick up identifier_1, which is the string being inspected
-  const cblc_field_t *id1   = __gg__treeplet_1f[cblc_index];
-  size_t              id1_o = __gg__treeplet_1o[cblc_index];
-  size_t              id1_s = __gg__treeplet_1s[cblc_index];
+  const cblc_field_t *id1   = params[cblc_index].field ;
+  size_t              id1_o = params[cblc_index].offset;
+  size_t              id1_s = params[cblc_index].size  ;
   cblc_index += 1;
   // normalize it, according to the language specification.
   normalized_operand normalized_id_1 = normalize_id(id1, id1_o, id1_s, id1->encoding);
@@ -846,9 +847,9 @@ inspect_backward_format_1(const size_t integers[])
     {
     // For each identifier_2, we pick up its value:
 
-    id_2_results[i].id2   = __gg__treeplet_1f  [cblc_index];
-    id_2_results[i].id2_o = __gg__treeplet_1o[cblc_index];
-    id_2_results[i].id2_s = __gg__treeplet_1s[cblc_index];
+    id_2_results[i].id2   = params[cblc_index].field ;
+    id_2_results[i].id2_o = params[cblc_index].offset;
+    id_2_results[i].id2_s = params[cblc_index].size  ;
 
     cblc_index += 1;
     id_2_results[i].result = 0;
@@ -873,14 +874,14 @@ inspect_backward_format_1(const size_t integers[])
           next_comparand.operation = operation;
           next_comparand.identifier_3.length = 1;
 
-          const cblc_field_t *id4_before   = __gg__treeplet_1f  [cblc_index];
-          size_t              id4_before_o = __gg__treeplet_1o[cblc_index];
-          size_t              id4_before_s = __gg__treeplet_1s[cblc_index];
+          const cblc_field_t *id4_before   = params[cblc_index].field ;
+          size_t              id4_before_o = params[cblc_index].offset;
+          size_t              id4_before_s = params[cblc_index].size  ;
           cblc_index += 1;
 
-          const cblc_field_t *id4_after   = __gg__treeplet_1f  [cblc_index];
-          size_t              id4_after_o = __gg__treeplet_1o[cblc_index];
-          size_t              id4_after_s = __gg__treeplet_1s[cblc_index];
+          const cblc_field_t *id4_after   = params[cblc_index].field ;
+          size_t              id4_after_o = params[cblc_index].offset;
+          size_t              id4_after_s = params[cblc_index].size  ;
           cblc_index += 1;
 
           normalized_operand normalized_id_4_before
@@ -923,19 +924,19 @@ inspect_backward_format_1(const size_t integers[])
             next_comparand.id_2_index = i;
             next_comparand.operation = operation;
 
-            const cblc_field_t *id3   = __gg__treeplet_1f[cblc_index];
-            size_t              id3_o = __gg__treeplet_1o[cblc_index];
-            size_t              id3_s = __gg__treeplet_1s[cblc_index];
+            const cblc_field_t *id3   = params[cblc_index].field ;
+            size_t              id3_o = params[cblc_index].offset;
+            size_t              id3_s = params[cblc_index].size  ;
             cblc_index += 1;
 
-            const cblc_field_t *id4_before   = __gg__treeplet_1f[cblc_index];
-            size_t              id4_before_o = __gg__treeplet_1o[cblc_index];
-            size_t              id4_before_s = __gg__treeplet_1s[cblc_index];
+            const cblc_field_t *id4_before   = params[cblc_index].field ;
+            size_t              id4_before_o = params[cblc_index].offset;
+            size_t              id4_before_s = params[cblc_index].size  ;
             cblc_index += 1;
 
-            const cblc_field_t *id4_after   = __gg__treeplet_1f[cblc_index];
-            size_t              id4_after_o = __gg__treeplet_1o[cblc_index];
-            size_t              id4_after_s = __gg__treeplet_1s[cblc_index];
+            const cblc_field_t *id4_after   = params[cblc_index].field ;
+            size_t              id4_after_o = params[cblc_index].offset;
+            size_t              id4_after_s = params[cblc_index].size  ;
             cblc_index += 1;
 
             next_comparand.identifier_3
@@ -1173,11 +1174,13 @@ inspect_backward_format_1(const size_t integers[])
 
 extern "C"
 void
-__gg__inspect_format_1(int backward, size_t integers[])
+__gg__inspect_format_1( int backward,
+                        size_t integers[],
+                        const cblc_referlet_t *params)
   {
   if( backward )
     {
-    return inspect_backward_format_1(integers);
+    return inspect_backward_format_1(integers, params);
     }
 
   size_t int_index = 0;
@@ -1191,9 +1194,9 @@ __gg__inspect_format_1(int backward, size_t integers[])
   std::vector<id_2_result> id_2_results(n_identifier_2);
 
   // Pick up identifier_1, which is the string being inspected
-  const cblc_field_t *id1   = __gg__treeplet_1f[cblc_index];
-  size_t              id1_o = __gg__treeplet_1o[cblc_index];
-  size_t              id1_s = __gg__treeplet_1s[cblc_index];
+  const cblc_field_t *id1   = params[cblc_index].field ;
+  size_t              id1_o = params[cblc_index].offset;
+  size_t              id1_s = params[cblc_index].size  ;
   cblc_index += 1;
   // normalize it, according to the language specification.
   normalized_operand normalized_id_1
@@ -1205,9 +1208,9 @@ __gg__inspect_format_1(int backward, size_t integers[])
     {
     // For each identifier_2, we pick up its value:
 
-    id_2_results[i].id2   = __gg__treeplet_1f  [cblc_index];
-    id_2_results[i].id2_o = __gg__treeplet_1o[cblc_index];
-    id_2_results[i].id2_s = __gg__treeplet_1s[cblc_index];
+    id_2_results[i].id2   = params[cblc_index].field ;
+    id_2_results[i].id2_o = params[cblc_index].offset;
+    id_2_results[i].id2_s = params[cblc_index].size  ;
 
     cblc_index += 1;
     id_2_results[i].result = 0;
@@ -1232,14 +1235,14 @@ __gg__inspect_format_1(int backward, size_t integers[])
           next_comparand.operation = operation;
           next_comparand.identifier_3.length = 1;
 
-          const cblc_field_t *id4_before   = __gg__treeplet_1f  [cblc_index];
-          size_t              id4_before_o = __gg__treeplet_1o[cblc_index];
-          size_t              id4_before_s = __gg__treeplet_1s[cblc_index];
+          const cblc_field_t *id4_before   = params[cblc_index].field ;
+          size_t              id4_before_o = params[cblc_index].offset;
+          size_t              id4_before_s = params[cblc_index].size  ;
           cblc_index += 1;
 
-          const cblc_field_t *id4_after   = __gg__treeplet_1f  [cblc_index];
-          size_t              id4_after_o = __gg__treeplet_1o[cblc_index];
-          size_t              id4_after_s = __gg__treeplet_1s[cblc_index];
+          const cblc_field_t *id4_after   = params[cblc_index].field ;
+          size_t              id4_after_o = params[cblc_index].offset;
+          size_t              id4_after_s = params[cblc_index].size  ;
           cblc_index += 1;
 
           normalized_operand normalized_id_4_before
@@ -1282,19 +1285,19 @@ __gg__inspect_format_1(int backward, size_t integers[])
             next_comparand.id_2_index = i;
             next_comparand.operation = operation;
 
-            const cblc_field_t *id3   = __gg__treeplet_1f[cblc_index];
-            size_t              id3_o = __gg__treeplet_1o[cblc_index];
-            size_t              id3_s = __gg__treeplet_1s[cblc_index];
+            const cblc_field_t *id3   = params[cblc_index].field ;
+            size_t              id3_o = params[cblc_index].offset;
+            size_t              id3_s = params[cblc_index].size  ;
             cblc_index += 1;
 
-            const cblc_field_t *id4_before   = __gg__treeplet_1f[cblc_index];
-            size_t              id4_before_o = __gg__treeplet_1o[cblc_index];
-            size_t              id4_before_s = __gg__treeplet_1s[cblc_index];
+            const cblc_field_t *id4_before   = params[cblc_index].field ;
+            size_t              id4_before_o = params[cblc_index].offset;
+            size_t              id4_before_s = params[cblc_index].size  ;
             cblc_index += 1;
 
-            const cblc_field_t *id4_after   = __gg__treeplet_1f[cblc_index];
-            size_t              id4_after_o = __gg__treeplet_1o[cblc_index];
-            size_t              id4_after_s = __gg__treeplet_1s[cblc_index];
+            const cblc_field_t *id4_after   = params[cblc_index].field ;
+            size_t              id4_after_o = params[cblc_index].offset;
+            size_t              id4_after_s = params[cblc_index].size  ;
             cblc_index += 1;
 
             next_comparand.identifier_3
@@ -1531,7 +1534,8 @@ __gg__inspect_format_1(int backward, size_t integers[])
 
 static
 void
-inspect_backward_format_2(const size_t integers[])
+inspect_backward_format_2(const size_t integers[],
+                          const cblc_referlet_t *params)
   {
   size_t int_index = 0;
   size_t cblc_index = 0;
@@ -1539,9 +1543,9 @@ inspect_backward_format_2(const size_t integers[])
   // Reference the language specification for the meanings of identifier_X
 
   // Pick up identifier_1, which is the string being inspected
-  cblc_field_t *id1   = __gg__treeplet_1f[cblc_index];
-  size_t        id1_o = __gg__treeplet_1o[cblc_index];
-  size_t        id1_s = __gg__treeplet_1s[cblc_index];
+  cblc_field_t *id1   = params[cblc_index].field ;
+  size_t        id1_o = params[cblc_index].offset;
+  size_t        id1_s = params[cblc_index].size  ;
   cblc_index += 1;
 
   // normalize it, according to the language specification.
@@ -1564,19 +1568,19 @@ inspect_backward_format_2(const size_t integers[])
         comparand next_comparand = {};
         next_comparand.operation = operation;
 
-        const cblc_field_t *id5   = __gg__treeplet_1f[cblc_index];
-        size_t              id5_o = __gg__treeplet_1o[cblc_index];
-        size_t              id5_s = __gg__treeplet_1s[cblc_index];
+        const cblc_field_t *id5   = params[cblc_index].field ;
+        size_t              id5_o = params[cblc_index].offset;
+        size_t              id5_s = params[cblc_index].size  ;
         cblc_index += 1;
 
-        const cblc_field_t *id4_before   = __gg__treeplet_1f[cblc_index];
-        size_t              id4_before_o = __gg__treeplet_1o[cblc_index];
-        size_t              id4_before_s = __gg__treeplet_1s[cblc_index];
+        const cblc_field_t *id4_before   = params[cblc_index].field ;
+        size_t              id4_before_o = params[cblc_index].offset;
+        size_t              id4_before_s = params[cblc_index].size  ;
         cblc_index += 1;
 
-        const cblc_field_t *id4_after   = __gg__treeplet_1f  [cblc_index];
-        size_t              id4_after_o = __gg__treeplet_1o[cblc_index];
-        size_t              id4_after_s = __gg__treeplet_1s[cblc_index];
+        const cblc_field_t *id4_after   = params[cblc_index].field ;
+        size_t              id4_after_o = params[cblc_index].offset;
+        size_t              id4_after_s = params[cblc_index].size  ;
         cblc_index += 1;
 
         next_comparand.identifier_5
@@ -1623,24 +1627,24 @@ inspect_backward_format_2(const size_t integers[])
           comparand next_comparand = {};
           next_comparand.operation = operation;
 
-          const cblc_field_t *id3   = __gg__treeplet_1f[cblc_index];
-          size_t              id3_o = __gg__treeplet_1o[cblc_index];
-          size_t              id3_s = __gg__treeplet_1s[cblc_index];
+          const cblc_field_t *id3   = params[cblc_index].field ;
+          size_t              id3_o = params[cblc_index].offset;
+          size_t              id3_s = params[cblc_index].size  ;
           cblc_index += 1;
 
-          const cblc_field_t *id5   = __gg__treeplet_1f[cblc_index];
-          size_t              id5_o = __gg__treeplet_1o[cblc_index];
-          size_t              id5_s = __gg__treeplet_1s[cblc_index];
+          const cblc_field_t *id5   = params[cblc_index].field ;
+          size_t              id5_o = params[cblc_index].offset;
+          size_t              id5_s = params[cblc_index].size  ;
           cblc_index += 1;
 
-          const cblc_field_t *id4_before   = __gg__treeplet_1f[cblc_index];
-          size_t              id4_before_o = __gg__treeplet_1o[cblc_index];
-          size_t              id4_before_s = __gg__treeplet_1s[cblc_index];
+          const cblc_field_t *id4_before   = params[cblc_index].field ;
+          size_t              id4_before_o = params[cblc_index].offset;
+          size_t              id4_before_s = params[cblc_index].size  ;
           cblc_index += 1;
 
-          const cblc_field_t *id4_after   = __gg__treeplet_1f[cblc_index];
-          size_t              id4_after_o = __gg__treeplet_1o[cblc_index];
-          size_t              id4_after_s = __gg__treeplet_1s[cblc_index];
+          const cblc_field_t *id4_after   = params[cblc_index].field ;
+          size_t              id4_after_o = params[cblc_index].offset;
+          size_t              id4_after_s = params[cblc_index].size  ;
           cblc_index += 1;
 
           next_comparand.identifier_3 = normalize_id(id3, id3_o, id3_s, id1->encoding);
@@ -1889,21 +1893,23 @@ inspect_backward_format_2(const size_t integers[])
 
 extern "C"
 void
-__gg__inspect_format_2(int backward, size_t integers[])
+__gg__inspect_format_2( int backward,
+                        size_t integers[],
+                        const cblc_referlet_t *params)
   {
   if( backward )
     {
-    return inspect_backward_format_2(integers);
+    return inspect_backward_format_2(integers, params);
     }
   size_t int_index = 0;
   size_t cblc_index = 0;
 
   // Reference the language specification for the meanings of identifier_X
 
-  // Pick up identifier_1, which is the string being inspected
-  cblc_field_t *id1   = __gg__treeplet_1f[cblc_index];
-  size_t        id1_o = __gg__treeplet_1o[cblc_index];
-  size_t        id1_s = __gg__treeplet_1s[cblc_index];
+  // id1 is the string being inspected
+  cblc_field_t *id1   = params[cblc_index].field;
+  size_t        id1_o = params[cblc_index].offset;
+  size_t        id1_s = params[cblc_index].size;
   cblc_index += 1;
 
   // normalize it, according to the language specification.
@@ -1927,19 +1933,19 @@ __gg__inspect_format_2(int backward, size_t integers[])
         comparand next_comparand = {} ;
         next_comparand.operation = operation;
 
-        const cblc_field_t *id5   = __gg__treeplet_1f[cblc_index];
-        size_t              id5_o = __gg__treeplet_1o[cblc_index];
-        size_t              id5_s = __gg__treeplet_1s[cblc_index];
+        const cblc_field_t *id5   = params[cblc_index].field;
+        size_t              id5_o = params[cblc_index].offset;
+        size_t              id5_s = params[cblc_index].size;
         cblc_index += 1;
 
-        const cblc_field_t *id4_before   = __gg__treeplet_1f[cblc_index];
-        size_t              id4_before_o = __gg__treeplet_1o[cblc_index];
-        size_t              id4_before_s = __gg__treeplet_1s[cblc_index];
+        const cblc_field_t *id4_before   = params[cblc_index].field;
+        size_t              id4_before_o = params[cblc_index].offset;
+        size_t              id4_before_s = params[cblc_index].size;
         cblc_index += 1;
 
-        const cblc_field_t *id4_after   = __gg__treeplet_1f  [cblc_index];
-        size_t              id4_after_o = __gg__treeplet_1o[cblc_index];
-        size_t              id4_after_s = __gg__treeplet_1s[cblc_index];
+        const cblc_field_t *id4_after   = params[cblc_index].field;
+        size_t              id4_after_o = params[cblc_index].offset;
+        size_t              id4_after_s = params[cblc_index].size;
         cblc_index += 1;
 
         next_comparand.identifier_5
@@ -1984,24 +1990,24 @@ __gg__inspect_format_2(int backward, size_t integers[])
           comparand next_comparand = {};
           next_comparand.operation = operation;
 
-          const cblc_field_t *id3   = __gg__treeplet_1f[cblc_index];
-          size_t              id3_o = __gg__treeplet_1o[cblc_index];
-          size_t              id3_s = __gg__treeplet_1s[cblc_index];
+          const cblc_field_t *id3   = params[cblc_index].field;
+          size_t              id3_o = params[cblc_index].offset;
+          size_t              id3_s = params[cblc_index].size;
           cblc_index += 1;
 
-          const cblc_field_t *id5   = __gg__treeplet_1f[cblc_index];
-          size_t              id5_o = __gg__treeplet_1o[cblc_index];
-          size_t              id5_s = __gg__treeplet_1s[cblc_index];
+          const cblc_field_t *id5   = params[cblc_index].field;
+          size_t              id5_o = params[cblc_index].offset;
+          size_t              id5_s = params[cblc_index].size;
           cblc_index += 1;
 
-          const cblc_field_t *id4_before   = __gg__treeplet_1f[cblc_index];
-          size_t              id4_before_o = __gg__treeplet_1o[cblc_index];
-          size_t              id4_before_s = __gg__treeplet_1s[cblc_index];
+          const cblc_field_t *id4_before   = params[cblc_index].field;
+          size_t              id4_before_o = params[cblc_index].offset;
+          size_t              id4_before_s = params[cblc_index].size;
           cblc_index += 1;
 
-          const cblc_field_t *id4_after   = __gg__treeplet_1f[cblc_index];
-          size_t              id4_after_o = __gg__treeplet_1o[cblc_index];
-          size_t              id4_after_s = __gg__treeplet_1s[cblc_index];
+          const cblc_field_t *id4_after   = params[cblc_index].field;
+          size_t              id4_after_o = params[cblc_index].offset;
+          size_t              id4_after_s = params[cblc_index].size;
           cblc_index += 1;
 
           next_comparand.identifier_3 = normalize_id(id3,
@@ -2608,13 +2614,15 @@ __gg__inspect_format_4( int backward,
 
 extern "C"
 void
-__gg__inspect_format_1_sbc(int backward, size_t integers[])
+__gg__inspect_format_1_sbc( int backward,
+                            size_t integers[],
+                            const cblc_referlet_t *params)
   {
   // When this routine is called, we know we are working in a single-byte-coded
   // codeset like ASCII or EBCDIC.
   if( backward )
     {
-    return inspect_backward_format_1(integers);
+    return inspect_backward_format_1(integers, params);
     }
 
   size_t int_index = 0;
@@ -2628,9 +2636,9 @@ __gg__inspect_format_1_sbc(int backward, size_t integers[])
   std::vector<id_2_result> id_2_results(n_identifier_2);
 
   // Pick up identifier_1, which is the string being inspected
-  const cblc_field_t *id1   = __gg__treeplet_1f[cblc_index];
-  size_t              id1_o = __gg__treeplet_1o[cblc_index];
-  size_t              id1_s = __gg__treeplet_1s[cblc_index];
+  const cblc_field_t *id1   = params[cblc_index].field ;
+  size_t              id1_o = params[cblc_index].offset;
+  size_t              id1_s = params[cblc_index].size  ;
   cblc_index += 1;
   // normalize it, according to the language specification.
   std::string normalized_id_1
@@ -2642,9 +2650,9 @@ __gg__inspect_format_1_sbc(int backward, size_t integers[])
     {
     // For each identifier_2, we pick up its value:
 
-    id_2_results[i].id2   = __gg__treeplet_1f  [cblc_index];
-    id_2_results[i].id2_o = __gg__treeplet_1o[cblc_index];
-    id_2_results[i].id2_s = __gg__treeplet_1s[cblc_index];
+    id_2_results[i].id2   = params[cblc_index].field ;
+    id_2_results[i].id2_o = params[cblc_index].offset;
+    id_2_results[i].id2_s = params[cblc_index].size  ;
 
     cblc_index += 1;
     id_2_results[i].result = 0;
@@ -2668,14 +2676,14 @@ __gg__inspect_format_1_sbc(int backward, size_t integers[])
           next_comparand.operation = operation;
           next_comparand.identifier_3 = " ";
 
-          const cblc_field_t *id4_before   = __gg__treeplet_1f  [cblc_index];
-          size_t              id4_before_o = __gg__treeplet_1o[cblc_index];
-          size_t              id4_before_s = __gg__treeplet_1s[cblc_index];
+          const cblc_field_t *id4_before   = params[cblc_index].field ;
+          size_t              id4_before_o = params[cblc_index].offset;
+          size_t              id4_before_s = params[cblc_index].size  ;
           cblc_index += 1;
 
-          const cblc_field_t *id4_after   = __gg__treeplet_1f  [cblc_index];
-          size_t              id4_after_o = __gg__treeplet_1o[cblc_index];
-          size_t              id4_after_s = __gg__treeplet_1s[cblc_index];
+          const cblc_field_t *id4_after   = params[cblc_index].field ;
+          size_t              id4_after_o = params[cblc_index].offset;
+          size_t              id4_after_s = params[cblc_index].size  ;
           cblc_index += 1;
 
           std::string normalized_id_4_before
@@ -2712,19 +2720,19 @@ __gg__inspect_format_1_sbc(int backward, size_t integers[])
             next_comparand.id_2_index = i;
             next_comparand.operation = operation;
 
-            const cblc_field_t *id3   = __gg__treeplet_1f[cblc_index];
-            size_t              id3_o = __gg__treeplet_1o[cblc_index];
-            size_t              id3_s = __gg__treeplet_1s[cblc_index];
+            const cblc_field_t *id3   = params[cblc_index].field ;
+            size_t              id3_o = params[cblc_index].offset;
+            size_t              id3_s = params[cblc_index].size  ;
             cblc_index += 1;
 
-            const cblc_field_t *id4_before   = __gg__treeplet_1f[cblc_index];
-            size_t              id4_before_o = __gg__treeplet_1o[cblc_index];
-            size_t              id4_before_s = __gg__treeplet_1s[cblc_index];
+            const cblc_field_t *id4_before   = params[cblc_index].field ;
+            size_t              id4_before_o = params[cblc_index].offset;
+            size_t              id4_before_s = params[cblc_index].size  ;
             cblc_index += 1;
 
-            const cblc_field_t *id4_after   = __gg__treeplet_1f[cblc_index];
-            size_t              id4_after_o = __gg__treeplet_1o[cblc_index];
-            size_t              id4_after_s = __gg__treeplet_1s[cblc_index];
+            const cblc_field_t *id4_after   = params[cblc_index].field ;
+            size_t              id4_after_o = params[cblc_index].offset;
+            size_t              id4_after_s = params[cblc_index].size  ;
             cblc_index += 1;
 
             next_comparand.identifier_3 = normalize_id_sbc(id3,
diff --git a/libgcobol/intrinsic.cc b/libgcobol/intrinsic.cc
index 8c1119e1dee..2ff4c2f0f7c 100644
--- a/libgcobol/intrinsic.cc
+++ b/libgcobol/intrinsic.cc
@@ -424,10 +424,7 @@ get_value_as_double_from_qualified_field( const cblc_field_t *input,
 
 static
 GCOB_FP128 kahan_summation(size_t ncount,
-                          cblc_field_t **source,
-                    const size_t        *source_o,
-                    const size_t        *source_s,
-                    const int           *flags,
+                     const cblc_refer_t *refers,
                           size_t        *k_count)
   {
   // We use compensated addition.  Look up Kahan summation.
@@ -446,19 +443,19 @@ GCOB_FP128 kahan_summation(size_t ncount,
   for(size_t i=0; i<ncount; i++)
     {
     refer_state_for_all state;
-    build_refer_state_for_all(state, source[i], flags[i]);
+    build_refer_state_for_all(state, refers[i].field, refers[i].flags);
 
     for(;;)
       {
-      input = __gg__float128_from_qualified_field(source[i],
-                                                  source_o[i],
-                                                  source_s[i]);
+      input = __gg__float128_from_qualified_field(refers[i].field,
+                                                  refers[i].offset,
+                                                  refers[i].size);
       y = input - kahan_c;
       t = sum + y;
       kahan_c = (t - sum) - y ;
       sum = t;
       *k_count += 1;
-      if( !update_refer_state_for_all(state, source[i]) )
+      if( !update_refer_state_for_all(state, refers[i].field) )
         {
         // There is nothing left to do.
         break;
@@ -471,10 +468,7 @@ GCOB_FP128 kahan_summation(size_t ncount,
 static
 GCOB_FP128
 variance( size_t         ncount,
-          cblc_field_t **source,
-    const size_t        *source_o,
-    const size_t        *source_s,
-    const int           *flags)
+     const cblc_refer_t *refers)
   {
   // In order to avoid catastrophic cancellation, we are going to use an
   // algorithm that is a bit wasteful of time, but is described as particularly
@@ -487,10 +481,7 @@ variance( size_t         ncount,
     // as an offset in the second stage:
     size_t k_count;
     GCOB_FP128 offset = kahan_summation( ncount,
-                                        source,
-                                        source_o,
-                                        source_s,
-                                        flags,
+                                         refers,
                                         &k_count);
     offset /= k_count;
 
@@ -506,13 +497,13 @@ variance( size_t         ncount,
     for(size_t i=0; i<ncount; i++)
       {
       refer_state_for_all state;
-      build_refer_state_for_all(state, source[i], flags[i]);
+      build_refer_state_for_all(state, refers[i].field, refers[i].flags);
 
       for(;;)
         {
-        newValue  = __gg__float128_from_qualified_field(source[i],
-                                                        source_o[i],
-                                                        source_s[i]);
+        newValue  = __gg__float128_from_qualified_field(refers[i].field,
+                                                        refers[i].offset,
+                                                        refers[i].size);
         newValue -= offset;
 
         count += 1;
@@ -520,7 +511,7 @@ variance( size_t         ncount,
         mean += delta / count;
         delta2 = newValue - mean;
         M2 += delta * delta2;
-        if( !update_refer_state_for_all(state, source[i]) )
+        if( !update_refer_state_for_all(state, refers[i].field) )
           {
           // There is nothing left to do.
           break;
@@ -1258,21 +1249,22 @@ __gg__combined_datetime(cblc_field_t *dest,
 extern "C"
 void
 __gg__concat( cblc_field_t *dest,
-              size_t ncount)
+              size_t ncount,
+        const cblc_refer_t *refers)
   {
   size_t bytes = 0;
   size_t offset = 0;
   for(size_t i=0; i<ncount; i++)
     {
-    bytes += __gg__treeplet_1s[i];
+    bytes += refers[i].size;
     }
   __gg__adjust_dest_size(dest, bytes);
   for(size_t i=0; i<ncount; i++)
     {
     memcpy( dest->data + offset,
-            __gg__treeplet_1f[i]->data + __gg__treeplet_1o[i],
-            __gg__treeplet_1s[i]);
-    offset += __gg__treeplet_1s[i];
+            refers[i].field->data + refers[i].offset,
+            refers[i].size);
+    offset += refers[i].size;
     }
   }
 
@@ -1998,12 +1990,13 @@ __gg__log10(cblc_field_t *dest,
 extern "C"
 void
 __gg__max(cblc_field_t *dest,
-          size_t ncount)
+          size_t ncount,
+    const cblc_refer_t *refers)
   {
   // FUNCTION MAX
 
-  if( (    __gg__treeplet_1f[0]->type == FldAlphanumeric
-        || __gg__treeplet_1f[0]->type == FldLiteralA) )
+  if( (    refers[0].field->type == FldAlphanumeric
+        || refers[0].field->type == FldLiteralA) )
     {
     cblc_field_t  *best_field      ;
     unsigned char *best_location = nullptr  ;
@@ -2017,26 +2010,26 @@ __gg__max(cblc_field_t *dest,
       {
       refer_state_for_all state;
 
-      build_refer_state_for_all(state, __gg__treeplet_1f[i], __gg__fourplet_flags[i]);
+      build_refer_state_for_all(state, refers[i].field, refers[i].flags);
 
       for(;;)
         {
         if( first_time )
           {
           first_time      = false;
-          best_field      = __gg__treeplet_1f[i];
-          best_location   = __gg__treeplet_1f[i]->data + __gg__treeplet_1o[i];
-          best_length     = __gg__treeplet_1s[i];
-          best_attr       = __gg__treeplet_1f[i]->attr;
-          best_flags      = __gg__fourplet_flags[i];
+          best_field      = refers[i].field;
+          best_location   = refers[i].field->data + refers[i].offset;
+          best_length     = refers[i].size;
+          best_attr       = refers[i].field->attr;
+          best_flags      = refers[i].flags;
           }
         else
           {
-          cblc_field_t  *candidate_field      = __gg__treeplet_1f[i];
-          unsigned char *candidate_location   = __gg__treeplet_1f[i]->data + __gg__treeplet_1o[i];
-          size_t         candidate_length     = __gg__treeplet_1s[i];
-          int            candidate_attr       = __gg__treeplet_1f[i]->attr;
-          int            candidate_flags      = __gg__fourplet_flags[i];
+          cblc_field_t  *candidate_field      = refers[i].field;
+          unsigned char *candidate_location   = refers[i].field->data + refers[i].offset;
+          size_t         candidate_length     = refers[i].size;
+          int            candidate_attr       = refers[i].field->attr;
+          int            candidate_flags      = refers[i].flags;
 
           int compare_result = __gg__compare_2(
                                  candidate_field,
@@ -2059,7 +2052,7 @@ __gg__max(cblc_field_t *dest,
             best_flags      = candidate_flags      ;
             }
           }
-        if( !update_refer_state_for_all(state, __gg__treeplet_1f[i]) )
+        if( !update_refer_state_for_all(state, refers[i].field) )
           {
           // There is nothing left to do.
           break;
@@ -2080,24 +2073,24 @@ __gg__max(cblc_field_t *dest,
     for(size_t i=0; i<ncount; i++)
       {
       refer_state_for_all state;
-      build_refer_state_for_all(state, __gg__treeplet_1f[i], __gg__fourplet_flags[i]);
+      build_refer_state_for_all(state, refers[i].field, refers[i].flags);
 
       for(;;)
         {
         if( first_time )
           {
           first_time = false;
-          retval = __gg__float128_from_qualified_field(__gg__treeplet_1f[i], __gg__treeplet_1o[i], __gg__treeplet_1s[i]);
+          retval = __gg__float128_from_qualified_field(refers[i].field, refers[i].offset, refers[i].size);
           }
         else
           {
-          GCOB_FP128 candidate = __gg__float128_from_qualified_field(__gg__treeplet_1f[i], __gg__treeplet_1o[i], __gg__treeplet_1s[i]);
+          GCOB_FP128 candidate = __gg__float128_from_qualified_field(refers[i].field, refers[i].offset, refers[i].size);
           if( candidate >= retval )
             {
             retval = candidate;
             }
           }
-        if( !update_refer_state_for_all(state, __gg__treeplet_1f[i]) )
+        if( !update_refer_state_for_all(state, refers[i].field) )
           {
           // There is nothing left to do for that input.
           break;
@@ -2182,15 +2175,13 @@ __gg__upper_case( cblc_field_t *dest,
 extern "C"
 void
 __gg__mean( cblc_field_t *dest,
-            size_t ninputs)
+            size_t ninputs,
+      const cblc_refer_t *refers)
   {
   // FUNCTION MEAN
   size_t k_count;
   GCOB_FP128 sum = kahan_summation(ninputs,
-                                  __gg__treeplet_1f,
-                                  __gg__treeplet_1o,
-                                  __gg__treeplet_1s,
-                                  __gg__fourplet_flags,
+                                   refers,
                                   &k_count);
   sum /= k_count;
   __gg__float128_to_field(dest,
@@ -2202,7 +2193,8 @@ __gg__mean( cblc_field_t *dest,
 extern "C"
 void
 __gg__median( cblc_field_t *dest,
-              size_t        ncount)
+              size_t        ncount,
+        const cblc_refer_t *refers)
   {
   // FUNCTION MEDIAN
 
@@ -2222,7 +2214,7 @@ __gg__median( cblc_field_t *dest,
   for(size_t i=0; i<ncount; i++)
     {
     refer_state_for_all state;
-    build_refer_state_for_all(state, __gg__treeplet_1f[i], __gg__fourplet_flags[i]);
+    build_refer_state_for_all(state, refers[i].field, refers[i].flags);
 
     for(;;)
       {
@@ -2234,11 +2226,11 @@ __gg__median( cblc_field_t *dest,
         }
 
       assert(the_list);
-      the_list[k_count] = __gg__float128_from_qualified_field(__gg__treeplet_1f[i],
-                                                              __gg__treeplet_1o[i],
-                                                              __gg__treeplet_1s[i]);
+      the_list[k_count] = __gg__float128_from_qualified_field(refers[i].field,
+                                                              refers[i].offset,
+                                                              refers[i].size);
       k_count += 1;
-      if( !update_refer_state_for_all(state, __gg__treeplet_1f[i]) )
+      if( !update_refer_state_for_all(state, refers[i].field) )
         {
         // There is nothing left to do.
         break;
@@ -2267,7 +2259,8 @@ __gg__median( cblc_field_t *dest,
 extern "C"
 void
 __gg__midrange( cblc_field_t *dest,
-                size_t        ncount)
+                size_t        ncount,
+          const cblc_refer_t *refers)
   {
   // FUNCTION MIDRANGE
   GCOB_FP128 val;
@@ -2278,12 +2271,12 @@ __gg__midrange( cblc_field_t *dest,
   for(size_t i=0; i<ncount; i++)
     {
     refer_state_for_all state;
-    build_refer_state_for_all(state, __gg__treeplet_1f[i], __gg__fourplet_flags[i]);
+    build_refer_state_for_all(state, refers[i].field, refers[i].flags);
     for(;;)
       {
-      val = __gg__float128_from_qualified_field(__gg__treeplet_1f[i],
-                                                __gg__treeplet_1o[i],
-                                                __gg__treeplet_1s[i]);
+      val = __gg__float128_from_qualified_field(refers[i].field,
+                                                refers[i].offset,
+                                                refers[i].size);
       if( first_time )
         {
         first_time = false;
@@ -2292,7 +2285,7 @@ __gg__midrange( cblc_field_t *dest,
         }
       min = std::min(min, val);
       max = std::max(max, val);
-      if( !update_refer_state_for_all(state, __gg__treeplet_1f[i]) )
+      if( !update_refer_state_for_all(state, refers[i].field) )
         {
         // There is nothing left to do for that input.
         break;
@@ -2309,12 +2302,13 @@ __gg__midrange( cblc_field_t *dest,
 extern "C"
 void
 __gg__min(cblc_field_t *dest,
-          size_t ncount)
+          size_t ncount,
+    const cblc_refer_t *refers)
   {
   // FUNCTION MIN
 
-  if( (    __gg__treeplet_1f[0]->type == FldAlphanumeric
-        || __gg__treeplet_1f[0]->type == FldLiteralA) )
+  if( (    refers[0].field->type == FldAlphanumeric
+        || refers[0].field->type == FldLiteralA) )
     {
     cblc_field_t  *best_field               ;
     unsigned char *best_location = nullptr  ;
@@ -2328,26 +2322,26 @@ __gg__min(cblc_field_t *dest,
       {
       refer_state_for_all state;
 
-      build_refer_state_for_all(state, __gg__treeplet_1f[i], __gg__fourplet_flags[i]);
+      build_refer_state_for_all(state, refers[i].field, refers[i].flags);
 
       for(;;)
         {
         if( first_time )
           {
           first_time      = false;
-          best_field      = __gg__treeplet_1f[i];
-          best_location   = __gg__treeplet_1f[i]->data + __gg__treeplet_1o[i];
-          best_length     = __gg__treeplet_1s[i];
-          best_attr       = __gg__treeplet_1f[i]->attr;
-          best_flags      = __gg__fourplet_flags[i];
+          best_field      = refers[i].field;
+          best_location   = refers[i].field->data + refers[i].offset;
+          best_length     = refers[i].size;
+          best_attr       = refers[i].field->attr;
+          best_flags      = refers[i].flags;
           }
         else
           {
-          cblc_field_t  *candidate_field      = __gg__treeplet_1f[i];
-          unsigned char *candidate_location   = __gg__treeplet_1f[i]->data + __gg__treeplet_1o[i];
-          size_t         candidate_length     = __gg__treeplet_1s[i];
-          int            candidate_attr       = __gg__treeplet_1f[i]->attr;
-          int            candidate_flags      = __gg__fourplet_flags[i];
+          cblc_field_t  *candidate_field      = refers[i].field;
+          unsigned char *candidate_location   = refers[i].field->data + refers[i].offset;
+          size_t         candidate_length     = refers[i].size;
+          int            candidate_attr       = refers[i].field->attr;
+          int            candidate_flags      = refers[i].flags;
 
           int compare_result = __gg__compare_2(
                                  candidate_field,
@@ -2370,7 +2364,7 @@ __gg__min(cblc_field_t *dest,
             best_flags      = candidate_flags      ;
             }
           }
-        if( !update_refer_state_for_all(state, __gg__treeplet_1f[i]) )
+        if( !update_refer_state_for_all(state, refers[i].field) )
           {
           // There is nothing left to do.
           break;
@@ -2391,24 +2385,24 @@ __gg__min(cblc_field_t *dest,
     for(size_t i=0; i<ncount; i++)
       {
       refer_state_for_all state;
-      build_refer_state_for_all(state, __gg__treeplet_1f[i], __gg__fourplet_flags[i]);
+      build_refer_state_for_all(state, refers[i].field, refers[i].flags);
 
       for(;;)
         {
         if( first_time )
           {
           first_time = false;
-          retval = __gg__float128_from_qualified_field(__gg__treeplet_1f[i], __gg__treeplet_1o[i], __gg__treeplet_1s[i]);
+          retval = __gg__float128_from_qualified_field(refers[i].field, refers[i].offset, refers[i].size);
           }
         else
           {
-          GCOB_FP128 candidate = __gg__float128_from_qualified_field(__gg__treeplet_1f[i], __gg__treeplet_1o[i], __gg__treeplet_1s[i]);
+          GCOB_FP128 candidate = __gg__float128_from_qualified_field(refers[i].field, refers[i].offset, refers[i].size);
           if( candidate < retval )
             {
             retval = candidate;
             }
           }
-        if( !update_refer_state_for_all(state, __gg__treeplet_1f[i]) )
+        if( !update_refer_state_for_all(state, refers[i].field) )
           {
           // There is nothing left to do for that input.
           break;
@@ -3193,7 +3187,8 @@ __gg__ord(cblc_field_t *dest,
 extern "C"
 void
 __gg__ord_min(cblc_field_t *dest,
-              size_t ninputs)
+              size_t ninputs,
+    const cblc_refer_t *refers)
   {
   // Sets dest to the one-based ordinal position of the first occurrence
   // of the biggest element in the list of refs[]
@@ -3216,7 +3211,7 @@ __gg__ord_min(cblc_field_t *dest,
     {
     refer_state_for_all state;
 
-    build_refer_state_for_all(state, __gg__treeplet_1f[i], __gg__fourplet_flags[i]);
+    build_refer_state_for_all(state, refers[i].field, refers[i].flags);
     for(;;)
       {
       running_position += 1;
@@ -3224,24 +3219,24 @@ __gg__ord_min(cblc_field_t *dest,
         {
         // We have to initialize the comparisons:
         retval          = running_position;
-        best            = __gg__treeplet_1f[i];
-        best_location   = __gg__treeplet_1f[i]->data + __gg__treeplet_1o[i];
-        best_length     = __gg__treeplet_1s[i];
-        best_attr       = __gg__treeplet_1f[i]->attr;
-        best_flags      = __gg__fourplet_flags[i];
+        best            = refers[i].field;
+        best_location   = refers[i].field->data + refers[i].offset;
+        best_length     = refers[i].size;
+        best_attr       = refers[i].field->attr;
+        best_flags      = refers[i].flags;
         }
       else
         {
         // We need to save the current adjustments, because __gg__compare
         // is free to modify .location
-        candidate_location   = __gg__treeplet_1f[i]->data + __gg__treeplet_1o[i];
-        candidate_length     = __gg__treeplet_1s[i];
-        candidate_attr       = __gg__treeplet_1f[i]->attr;
-        candidate_flags      = __gg__fourplet_flags[i];
+        candidate_location   = refers[i].field->data + refers[i].offset;
+        candidate_length     = refers[i].size;
+        candidate_attr       = refers[i].field->attr;
+        candidate_flags      = refers[i].flags;
 
         int compare_result =
           __gg__compare_2(
-            __gg__treeplet_1f[i],
+            refers[i].field,
             candidate_location,
             candidate_length,
             candidate_attr,
@@ -3255,14 +3250,14 @@ __gg__ord_min(cblc_field_t *dest,
         if( compare_result < 0 )
           {
           retval          = running_position;
-          best            = __gg__treeplet_1f[i];
+          best            = refers[i].field;
           best_location   = candidate_location;
           best_length     = candidate_length;
           best_attr       = candidate_attr;
           best_flags      = candidate_flags;
           }
         }
-      if( !update_refer_state_for_all(state, __gg__treeplet_1f[i]) )
+      if( !update_refer_state_for_all(state, refers[i].field) )
         {
         // There is nothing left to do for that input.
         break;
@@ -3281,7 +3276,8 @@ __gg__ord_min(cblc_field_t *dest,
 extern "C"
 void
 __gg__ord_max(cblc_field_t *dest,
-              size_t ninputs)
+              size_t ninputs,
+    const cblc_refer_t *refers)
   {
   // Sets dest to the one-based ordinal position of the first occurrence
   // of the biggest element in the list of refs[]
@@ -3304,7 +3300,7 @@ __gg__ord_max(cblc_field_t *dest,
     {
     refer_state_for_all state;
 
-    build_refer_state_for_all(state, __gg__treeplet_1f[i], __gg__fourplet_flags[i]);
+    build_refer_state_for_all(state, refers[i].field, refers[i].flags);
     for(;;)
       {
       running_position += 1;
@@ -3312,24 +3308,24 @@ __gg__ord_max(cblc_field_t *dest,
         {
         // We have to initialize the comparisons:
         retval          = running_position;
-        best            = __gg__treeplet_1f[i];
-        best_location   = __gg__treeplet_1f[i]->data + __gg__treeplet_1o[i];
-        best_length     = __gg__treeplet_1s[i];
-        best_attr       = __gg__treeplet_1f[i]->attr;
-        best_flags      = __gg__fourplet_flags[i];
+        best            = refers[i].field;
+        best_location   = refers[i].field->data + refers[i].offset;
+        best_length     = refers[i].size;
+        best_attr       = refers[i].field->attr;
+        best_flags      = refers[i].flags;
         }
       else
         {
         // We need to save the current adjustments, because __gg__compare
         // is free to modify .location
-        candidate_location   = __gg__treeplet_1f[i]->data + __gg__treeplet_1o[i];
-        candidate_length     = __gg__treeplet_1s[i];
-        candidate_attr       = __gg__treeplet_1f[i]->attr;
-        candidate_flags      = __gg__fourplet_flags[i];
+        candidate_location   = refers[i].field->data + refers[i].offset;
+        candidate_length     = refers[i].size;
+        candidate_attr       = refers[i].field->attr;
+        candidate_flags      = refers[i].flags;
 
         int compare_result =
           __gg__compare_2(
-            __gg__treeplet_1f[i],
+            refers[i].field,
             candidate_location,
             candidate_length,
             candidate_attr,
@@ -3343,14 +3339,14 @@ __gg__ord_max(cblc_field_t *dest,
         if( compare_result > 0 )
           {
           retval          = running_position;
-          best            = __gg__treeplet_1f[i];
+          best            = refers[i].field;
           best_location   = candidate_location;
           best_length     = candidate_length;
           best_attr       = candidate_attr;
           best_flags      = candidate_flags;
           }
         }
-      if( !update_refer_state_for_all(state, __gg__treeplet_1f[i]) )
+      if( !update_refer_state_for_all(state, refers[i].field) )
         {
         // There is nothing left to do for that input.
         break;
@@ -3383,7 +3379,8 @@ __gg__pi(cblc_field_t *dest)
 extern "C"
 void
 __gg__present_value(cblc_field_t *dest,
-                    size_t        ncount)
+                    size_t        ncount,
+              const cblc_refer_t *refers)
   {
   GCOB_FP128 discount = 0;;
   GCOB_FP128 denom = 1;
@@ -3393,15 +3390,15 @@ __gg__present_value(cblc_field_t *dest,
   for(size_t i=0; i<ncount; i++)
     {
     refer_state_for_all state;
-    build_refer_state_for_all(state, __gg__treeplet_1f[i], __gg__fourplet_flags[i]);
+    build_refer_state_for_all(state, refers[i].field, refers[i].flags);
     for(;;)
       {
       if(first_time)
         {
         first_time = false;
-        GCOB_FP128 arg1 = __gg__float128_from_qualified_field(__gg__treeplet_1f[i],
-                                                             __gg__treeplet_1o[i],
-                                                             __gg__treeplet_1s[i]);
+        GCOB_FP128 arg1 = __gg__float128_from_qualified_field(refers[i].field,
+                                                             refers[i].offset,
+                                                             refers[i].size);
         if( arg1 <= GCOB_FP128_LITERAL(-1.0) )
           {
           exception_raise(ec_argument_function_e);
@@ -3411,13 +3408,13 @@ __gg__present_value(cblc_field_t *dest,
         }
       else
         {
-        GCOB_FP128 arg = __gg__float128_from_qualified_field(__gg__treeplet_1f[i],
-                                                            __gg__treeplet_1o[i],
-                                                            __gg__treeplet_1s[i]);
+        GCOB_FP128 arg = __gg__float128_from_qualified_field(refers[i].field,
+                                                            refers[i].offset,
+                                                            refers[i].size);
         denom *= discount;
         retval += arg * denom;
         }
-      if( !update_refer_state_for_all(state, __gg__treeplet_1f[i]) )
+      if( !update_refer_state_for_all(state, refers[i].field) )
         {
         // There is nothing left to do for that input.
         break;
@@ -3433,7 +3430,8 @@ __gg__present_value(cblc_field_t *dest,
 extern "C"
 void
 __gg__range(cblc_field_t *dest,
-            size_t        ncount)
+            size_t        ncount,
+      const cblc_refer_t *refers)
   {
   // FUNCTION RANGE
   bool first_time = true;
@@ -3445,12 +3443,12 @@ __gg__range(cblc_field_t *dest,
   for(size_t i=0; i<ncount; i++)
     {
     refer_state_for_all state;
-    build_refer_state_for_all(state, __gg__treeplet_1f[i], __gg__fourplet_flags[i]);
+    build_refer_state_for_all(state, refers[i].field, refers[i].flags);
     for(;;)
       {
-      val = __gg__float128_from_qualified_field(__gg__treeplet_1f[i],
-                                                __gg__treeplet_1o[i],
-                                                __gg__treeplet_1s[i]);
+      val = __gg__float128_from_qualified_field(refers[i].field,
+                                                refers[i].offset,
+                                                refers[i].size);
       if( first_time )
         {
         first_time = false;
@@ -3459,7 +3457,7 @@ __gg__range(cblc_field_t *dest,
         }
       min = std::min(min, val);
       max = std::max(max, val);
-      if( !update_refer_state_for_all(state, __gg__treeplet_1f[i]) )
+      if( !update_refer_state_for_all(state, refers[i].field) )
         {
         // There is nothing left to do.
         break;
@@ -3803,14 +3801,12 @@ __gg__sqrt( cblc_field_t *dest,
 extern "C"
 void
 __gg__standard_deviation( cblc_field_t *dest,
-                          size_t        ninputs)
+                          size_t        ninputs,
+                    const cblc_refer_t *refers)
   {
   // FUNCTION STANDARD-DEVIATION
   GCOB_FP128 retval = variance(ninputs,
-                              __gg__treeplet_1f,
-                              __gg__treeplet_1o,
-                              __gg__treeplet_1s,
-                              __gg__fourplet_flags);
+                               refers);
   retval = FP128_FUNC(sqrt)(retval);
 
   __gg__float128_to_field(dest,
@@ -3822,15 +3818,13 @@ __gg__standard_deviation( cblc_field_t *dest,
 extern "C"
 void
 __gg__sum(cblc_field_t *dest,
-          size_t        ninputs)
+          size_t        ninputs,
+    const cblc_refer_t *refers)
   {
   // FUNCTION SUM
   size_t k_count;
   GCOB_FP128 sum = kahan_summation(ninputs,
-                                  __gg__treeplet_1f,
-                                  __gg__treeplet_1o,
-                                  __gg__treeplet_1s,
-                                  __gg__fourplet_flags,
+                                   refers,
                                   &k_count);
   __gg__float128_to_field(dest,
                           sum,
@@ -3951,14 +3945,12 @@ __gg__test_day_yyyyddd( cblc_field_t *dest,
 extern "C"
 void
 __gg__variance( cblc_field_t *dest,
-                size_t        ncount)
+              size_t ncount,
+        const cblc_refer_t *refers)
   {
   // FUNCTION VARIANCE
   GCOB_FP128 retval = variance(ncount,
-                              __gg__treeplet_1f,
-                              __gg__treeplet_1o,
-                              __gg__treeplet_1s,
-                              __gg__fourplet_flags);
+                               refers);
   __gg__float128_to_field(dest,
                           retval,
                           truncation_e,
@@ -5493,22 +5485,17 @@ strcaselaststr( const char *haystack,
 
 extern "C"
 void
-__gg__substitute( cblc_field_t *dest,
-            const cblc_field_t *arg1_f,
-                  size_t        arg1_o,
-                  size_t        arg1_s,
-                  size_t        N,
-            const uint8_t      *control)
+__gg__substitute( const cblc_referlet_t *arg2,
+                  const cblc_referlet_t *arg3,
+                        cblc_field_t    *dest,
+                  const cblc_field_t    *arg1_f,
+                        size_t           arg1_o,
+                        size_t           arg1_s,
+                        size_t           N,
+                  const uint8_t         *control)
   {
   // arg2 is the Group 1 triplet.
   // arg3 is the Group 2 triplet
-  cblc_field_t **arg2_f = __gg__treeplet_1f;
-  size_t        *arg2_o = __gg__treeplet_1o;
-  size_t        *arg2_s = __gg__treeplet_1s;
-  cblc_field_t **arg3_f = __gg__treeplet_2f;
-  const size_t  *arg3_o = __gg__treeplet_2o;
-  const size_t  *arg3_s = __gg__treeplet_2s;
-
   ssize_t retval_size;
   retval_size = 256;
   char  *retval = static_cast<char *>(malloc(retval_size));
@@ -5534,7 +5521,7 @@ __gg__substitute( cblc_field_t *dest,
 
   for( size_t i=0; i<N; i++ )
     {
-    if( arg2_s[i] == 0 )
+    if( arg2[i].size == 0 )
       {
       exception_raise(ec_argument_function_e);
       goto bugout;
@@ -5545,16 +5532,16 @@ __gg__substitute( cblc_field_t *dest,
         {
         pflasts[i] = strcasestr(haystack,
                                 haystack_e,
-                                PTRCAST(char, (arg2_f[i]->data+arg2_o[i])),
-                                PTRCAST(char, (arg2_f[i]->data+arg2_o[i])) + arg2_s[i],
+                                PTRCAST(char, (arg2[i].field->data+arg2[i].offset)),
+                                PTRCAST(char, (arg2[i].field->data+arg2[i].offset)) + arg2[i].size,
                                 is_ebcdic);
         }
       else if( control[i] & substitute_last_e)
         {
         pflasts[i] = strcaselaststr(haystack,
                                 haystack_e,
-                                PTRCAST(char, (arg2_f[i]->data+arg2_o[i])),
-                                PTRCAST(char, (arg2_f[i]->data+arg2_o[i])) + arg2_s[i],
+                                PTRCAST(char, (arg2[i].field->data+arg2[i].offset)),
+                                PTRCAST(char, (arg2[i].field->data+arg2[i].offset)) + arg2[i].size,
                                 is_ebcdic);
         }
       else
@@ -5568,15 +5555,15 @@ __gg__substitute( cblc_field_t *dest,
         {
         pflasts[i] = strstr(haystack,
                             haystack_e,
-                            PTRCAST(char, (arg2_f[i]->data+arg2_o[i])),
-                            PTRCAST(char, (arg2_f[i]->data+arg2_o[i])) + arg2_s[i]);
+                            PTRCAST(char, (arg2[i].field->data+arg2[i].offset)),
+                            PTRCAST(char, (arg2[i].field->data+arg2[i].offset)) + arg2[i].size);
         }
       else if( control[i] & substitute_last_e)
         {
         pflasts[i] = strlaststr(haystack,
                                 haystack_e,
-                                PTRCAST(char, (arg2_f[i]->data+arg2_o[i])),
-                                PTRCAST(char, (arg2_f[i]->data+arg2_o[i])) + arg2_s[i]);
+                                PTRCAST(char, (arg2[i].field->data+arg2[i].offset)),
+                                PTRCAST(char, (arg2[i].field->data+arg2[i].offset)) + arg2[i].size);
         }
       else
         {
@@ -5592,7 +5579,7 @@ __gg__substitute( cblc_field_t *dest,
       {
       // Let's make sure that there is enough room in the case that we add this
       // arg
-      while( outdex - (ssize_t)arg2_s[i] + (ssize_t)arg3_s[i]
+      while( outdex - (ssize_t)arg2[i].size + (ssize_t)arg3[i].size
                                                                  > retval_size )
         {
         retval_size *= 2;
@@ -5612,8 +5599,8 @@ __gg__substitute( cblc_field_t *dest,
           continue;
           }
 
-        const char *needle   = PTRCAST(char, arg2_f[i]->data+arg2_o[i]);
-        const char *needle_e = PTRCAST(char, arg2_f[i]->data+arg2_o[i]) + arg2_s[i];
+        const char *needle   = PTRCAST(char, arg2[i].field->data+arg2[i].offset);
+        const char *needle_e = PTRCAST(char, arg2[i].field->data+arg2[i].offset) + arg2[i].size;
         matched = (control[i] & substitute_anycase_e) && iscasematch(
                                                                  haystack,
                                                                  haystack_e,
@@ -5630,9 +5617,9 @@ __gg__substitute( cblc_field_t *dest,
         }
       if( matched )
         {
-        haystack += arg2_s[i];
-        memcpy(retval + outdex, arg3_f[i]->data + arg3_o[i], arg3_s[i]);
-        outdex += arg3_s[i];
+        haystack += arg2[i].size;
+        memcpy(retval + outdex, arg3[i].field->data + arg3[i].offset, arg3[i].size);
+        outdex += arg3[i].size;
         did_something = true;
         break;
         }
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index 9e3d8a4db11..2f61dacdfef 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -162,50 +162,6 @@ size_t      __gg__entry_index                 = 0    ;
 // Setting this variable to 'true' suppresses the error condition.
 static bool sv_suppress_eof_ec = false;
 
-// What follows are arrays that are used by features like INSPECT, STRING,
-// UNSTRING, and, particularly, arithmetic_operation.  These features are
-// characterized by having unknown, and essentially unlimited, numbers of
-// variables. Consider, for example, ADD A B C D ... TO L M N O ...
-
-// Although originally implemented with malloc/free, that's terribly inefficient
-// on its face; arithmetic is done frequently.  The next step was to malloc
-// buffers just once, and have them grow as needed, but that resulted in a lot
-// of code being laid down, because it meant checking each buffer size at
-// run-time, and laying down the code to be executed if the size was inadequate.
-//
-// The current solution is to make the pointers to the arrays of values global,
-// and initialize them with space for MIN_FIELD_BLOCK_SIZE values.  Thus, at
-// compile time, we can ignore all tests for fewer than MIN_FIELD_BLOCK_SIZE
-// (which is generally the case).  Only when N is greater than the MIN do we
-// have to check the current run-time size and, if necessary, expand the buffer
-// with realloc.
-size_t       __gg__arithmetic_rounds_size      = 0     ;
-int *        __gg__arithmetic_rounds           = NULL  ;
-
-size_t       __gg__fourplet_flags_size         = 0     ;
-int *        __gg__fourplet_flags              = NULL  ;
-
-static size_t         treeplet_1_size          = 0     ;
-cblc_field_t ** __gg__treeplet_1f              = NULL  ;
-size_t       *  __gg__treeplet_1o              = NULL  ;
-size_t       *  __gg__treeplet_1s              = NULL  ;
-
-static size_t         treeplet_2_size          = 0     ;
-cblc_field_t ** __gg__treeplet_2f              = NULL  ;
-size_t       *  __gg__treeplet_2o              = NULL  ;
-size_t       *  __gg__treeplet_2s              = NULL  ;
-
-static size_t         treeplet_3_size          = 0     ;
-cblc_field_t ** __gg__treeplet_3f              = NULL  ;
-size_t       *  __gg__treeplet_3o              = NULL  ;
-size_t       *  __gg__treeplet_3s              = NULL  ;
-
-static size_t         treeplet_4_size          = 0     ;
-cblc_field_t ** __gg__treeplet_4f              = NULL  ;
-size_t       *  __gg__treeplet_4o              = NULL  ;
-size_t       *  __gg__treeplet_4s              = NULL  ;
-
-
 // This value is increased every time PROCEDURE DIVISION is processed.  It is
 // used to keep track of local variables.
 size_t      __gg__unique_prog_id              = 0    ;
@@ -588,65 +544,6 @@ __gg__get_default_currency_string()
   return currency_signs(__gg__default_currency_sign).c_str();
   }
 
-extern "C"
-void
-__gg__resize_int_p( size_t *size,
-                    int    **block,
-                    size_t  new_size)
-  {
-  if( new_size > *size )
-    {
-    *size = new_size;
-    *block = static_cast<int *>(realloc(*block, new_size * sizeof(int)));
-    }
-  }
-
-extern "C"
-void
-__gg__resize_treeplet(int     ngroup,
-                      size_t  new_size)
-  {
-  switch( ngroup )
-    {
-    case 1:
-      if( new_size > treeplet_1_size )
-        {
-        treeplet_1_size = new_size;
-        __gg__treeplet_1f = static_cast<cblc_field_t **>(realloc(__gg__treeplet_1f, new_size * sizeof(cblc_field_t *)));
-        __gg__treeplet_1o = static_cast<size_t *>(realloc(__gg__treeplet_1o, new_size * sizeof(size_t)));
-        __gg__treeplet_1s = static_cast<size_t *>(realloc(__gg__treeplet_1s, new_size * sizeof(size_t)));
-        }
-    break;
-    case 2:
-      if( new_size > treeplet_2_size )
-        {
-        treeplet_2_size = new_size;
-        __gg__treeplet_2f = static_cast<cblc_field_t **>(realloc(__gg__treeplet_2f, new_size * sizeof(cblc_field_t *)));
-        __gg__treeplet_2o = static_cast<size_t *>(realloc(__gg__treeplet_2o, new_size * sizeof(size_t)));
-        __gg__treeplet_2s = static_cast<size_t *>(realloc(__gg__treeplet_2s, new_size * sizeof(size_t)));
-        }
-    break;
-    case 3:
-      if( new_size > treeplet_3_size )
-        {
-        treeplet_3_size = new_size;
-        __gg__treeplet_3f = static_cast<cblc_field_t **>(realloc(__gg__treeplet_3f, new_size * sizeof(cblc_field_t *)));
-        __gg__treeplet_3o = static_cast<size_t *>(realloc(__gg__treeplet_3o, new_size * sizeof(size_t)));
-        __gg__treeplet_3s = static_cast<size_t *>(realloc(__gg__treeplet_3s, new_size * sizeof(size_t)));
-        }
-    break;
-    case 4:
-      if( new_size > treeplet_4_size )
-        {
-        treeplet_4_size = new_size;
-        __gg__treeplet_4f = static_cast<cblc_field_t **>(realloc(__gg__treeplet_4f, new_size * sizeof(cblc_field_t *)));
-        __gg__treeplet_4o = static_cast<size_t *>(realloc(__gg__treeplet_4o, new_size * sizeof(size_t)));
-        __gg__treeplet_4s = static_cast<size_t *>(realloc(__gg__treeplet_4s, new_size * sizeof(size_t)));
-        }
-    break;
-    }
-  }
-
 static void
 initialize_program_state()
   {
@@ -654,20 +551,6 @@ initialize_program_state()
   program_state initial_value = {};
   program_states.push_back(initial_value);
   __gg__currency_signs = program_states.back().rt_currency_signs;
-
-  // This is where we initialize the various tables that have
-  // MIN_FIELD_BLOCK_SIZE elements:
-
-  __gg__resize_int_p(&__gg__arithmetic_rounds_size,
-                     &__gg__arithmetic_rounds,
-                      MIN_FIELD_BLOCK_SIZE );
-  __gg__resize_int_p(&__gg__fourplet_flags_size,
-                     &__gg__fourplet_flags,
-                      MIN_FIELD_BLOCK_SIZE );
-  __gg__resize_treeplet(1, MIN_FIELD_BLOCK_SIZE);
-  __gg__resize_treeplet(2, MIN_FIELD_BLOCK_SIZE);
-  __gg__resize_treeplet(3, MIN_FIELD_BLOCK_SIZE);
-  __gg__resize_treeplet(4, MIN_FIELD_BLOCK_SIZE);
   }
 
 extern "C"
@@ -3399,6 +3282,7 @@ format_for_display_internal(char **dest,
     case FldNumericBinary:
     case FldPacked:
     case FldNumericBin5:
+    case FldLiteralN:
       {
       int dummy;
       int digits;
@@ -3441,7 +3325,15 @@ format_for_display_internal(char **dest,
             digits = 19;
             break;
           case 16:
-            digits = MAX_FIXED_POINT_DIGITS;
+            // digits = MAX_FIXED_POINT_DIGITS;
+            /* This requires some context.  Although we generally operate on
+               the basis of MAX_FIXED_POINT_DIGITS (currently 37, which gives
+               one digit of headroom for rounding and such), a PIC X(16) COMP-X
+               provides for an honest 128-bits of binary value.  If that is set
+               to HIGH-VALUE, the decimal representation requires 39 decimal
+               digits.  So, we do that here so that the DISPLAY of that value
+               is accurate. */
+            digits = 39;
             break;
           default:
             warnx("%s(): %s has capacity %ld\n",
@@ -4010,9 +3902,9 @@ get_float128( const cblc_field_t *field,
   return retval;
   }
 
-static
+extern "C"
 int
-compare_field_class(const cblc_field_t  *conditional,
+__gg__compare_field_class(const cblc_field_t  *conditional,
                     unsigned char       *conditional_location,
                     int                  conditional_length,
                     cblc_field_t        *list)
@@ -4346,77 +4238,91 @@ interconvert( char **allocated_left,
   *allocated_left  = nullptr;
   *allocated_right = nullptr;
 
-  bool convert_left_to_right = false;
-  bool convert_right_to_left = false;
-
-  size_t converted_length;
-  const char *converted;
   if( *encoding_left == *encoding_right )
     {
     // This is both the most-seen situation, and, happily, the easiest to
     // handle.  We just do nothing.
     }
-  else if(   *encoding_left  == __gg__national_encoding
-          || *encoding_right == __gg__national_encoding )
-    {
-    // The encodings are different, but at least one is the national encoding.
-    // Convert the other one to be national as well:
-    if( *encoding_left != __gg__national_encoding )
-      {
-      convert_left_to_right = true;
-      }
-    else
-      {
-      convert_right_to_left = true;
-      }
-    }
   else
     {
-    // We have two different encodings, and neither of them are national.  This
-    // can happen when a file descriptor has a specific codeset that doesn't
-    // match the national codeset.  We will convert the narrower to the wider;
-    // if they are both the same width we will pick one arbitrarily.
+    bool convert_left_to_right = false;
+    bool convert_right_to_left = false;
+    size_t converted_length;
+    const char *converted;
+
+    // We are dealing with two different encodings
     const charmap_t *charmap_left  = __gg__get_charmap(*encoding_left);
     const charmap_t *charmap_right = __gg__get_charmap(*encoding_right);
-    if( charmap_right->stride() >= charmap_left->stride() )
+    if( charmap_left->stride() == charmap_right->stride() )
       {
-      convert_left_to_right = true;
+      // The strides are the same.  If one is display, convert the other to
+      // display.  If one is national, convert the other to national
+      if( *encoding_left  == __gg__display_encoding )
+        {
+        convert_right_to_left = true;
+        }
+      else if(*encoding_right  == __gg__display_encoding )
+        {
+        convert_left_to_right = true;
+        }
+      else if(*encoding_left  == __gg__national_encoding )
+        {
+        convert_right_to_left = true;
+        }
+      else if(*encoding_right  == __gg__national_encoding )
+        {
+        convert_left_to_right = true;
+        }
+      else
+        {
+        // The strides are the same, but we don't know anything about the
+        // encodings.  Toss a coin:
+        convert_right_to_left = true;
+        }
       }
     else
       {
-      convert_right_to_left = true;
+      // The two strides are different.  Convert the narrow to the wider:
+      if( charmap_left->stride() > charmap_right->stride() )
+        {
+        convert_right_to_left = true;
+        }
+      else
+        {
+        convert_left_to_right = true;
+        }
       }
-    }
 
-  if( convert_left_to_right )
-    {
-    // Convert the left side to the right encoding
-    converted = __gg__iconverter(*encoding_left,
-                                 *encoding_right,
-                                 *left_string,
-                                 *left_length,
-                                 &converted_length);
-    *encoding_left = *encoding_right ;
-    *allocated_left = static_cast<char *>(malloc(converted_length));
-    massert(*allocated_left);
-    *left_string = *allocated_left;
-    *left_length = converted_length;
-    memcpy(*left_string, converted, *left_length);
-    }
-  if( convert_right_to_left )
-    {
-    // Convert the right side to the left_encoding
-    converted = __gg__iconverter(*encoding_right,
-                                 *encoding_left,
-                                 *right_string,
-                                 *right_length,
-                                 &converted_length);
-    *encoding_right = *encoding_left ;
-    *allocated_right = static_cast<char *>(malloc(converted_length));
-    massert(*allocated_right);
-    *right_string = *allocated_right;
-    *right_length = converted_length;
-    memcpy(right_string, converted, *right_length);
+    if( convert_left_to_right )
+      {
+      // Convert the left side to the right encoding
+      converted = __gg__iconverter(*encoding_left,
+                                   *encoding_right,
+                                   *left_string,
+                                   *left_length,
+                                   &converted_length);
+      *encoding_left = *encoding_right ;
+      *allocated_left = static_cast<char *>(malloc(converted_length));
+      massert(*allocated_left);
+      *left_string = *allocated_left;
+      *left_length = converted_length;
+      memcpy(*left_string, converted, *left_length);
+      }
+    if( convert_right_to_left )
+      {
+      // Convert the right side to the left_encoding
+      converted = __gg__iconverter(*encoding_right,
+                                   *encoding_left,
+                                   *right_string,
+                                   *right_length,
+                                   &converted_length);
+      *encoding_right = *encoding_left ;
+      *allocated_right = static_cast<char *>(malloc(converted_length));
+      massert(*allocated_right);
+      *right_string = *allocated_right;
+      *right_length = converted_length;
+      memcpy(*right_string, converted, *right_length);
+      }
     }
   }
 
@@ -4544,7 +4450,7 @@ __gg__compare_2(cblc_field_t  *left_side,
 
   if( right_side->type == FldClass )
     {
-    return compare_field_class( left_side,
+    return __gg__compare_field_class( left_side,
                                 left_location,
                                 left_length,
                                 right_side);
@@ -6093,6 +5999,35 @@ __gg__move( cblc_field_t        *fdest,
 
               source_size   = fsource->digits;
 
+              // We have to deal with the special case of moving a pure binary
+              // value to an alphanumeric, which starts with a source_size
+              // of zero.
+              if( source_size == 0 )
+                {
+                switch(fsource->capacity)
+                  {
+                  case 1:
+                    source_size = 3;
+                    break;
+                  case 2:
+                    source_size = 5;
+                    break;
+                  case 3:
+                  case 4:
+                    source_size = 10;
+                    break;
+                  case 5:
+                  case 6:
+                  case 7:
+                  case 8:
+                    source_size = 20;
+                    break;
+                  default:
+                    source_size = 39;
+                    break;
+                  }
+                }
+
               // Turn the integer value into a string:
               __gg__binary_to_string_encoded(ach,
                                              source_size,
@@ -6109,7 +6044,7 @@ __gg__move( cblc_field_t        *fdest,
               // Specifically, we'll move pach to point to the first
               // character that isn't zero.
 
-              if( fsource->attr & intermediate_e )
+              if( fsource->attr & intermediate_e || fsource->digits == 0)
                 {
                 while(source_size > 1)  // This ensures we leave one '0'
                   {
@@ -7363,7 +7298,7 @@ normalize_for_inspect_format_4(const cblc_field_t  *var,
 
 extern "C"
 int
-__gg__string(const size_t integers[])
+__gg__string(const size_t integers[], const cblc_referlet_t *ref)
   {
   // The first integer is the count of identifier-2 values.  Call it N
   // The following N integers are the counts of each of the identifier-1 values,
@@ -7376,16 +7311,12 @@ __gg__string(const size_t integers[])
   // That's followed by identifier2 for N2
   // And so on
 
-  cblc_field_t **ref   = __gg__treeplet_1f;
-  const size_t  *ref_o = __gg__treeplet_1o;
-  const size_t  *ref_s = __gg__treeplet_1s;
-
   static const int INDEX_OF_POINTER = 1;
 
   size_t index_cblc = 0 ;
 
   // Pick up the target
-  const cblc_field_t *tgt = ref[index_cblc];
+  const cblc_field_t *tgt = ref[index_cblc].field;
 
   // Pick up the target encoding, which according to the ISO specification
   // controls all the parameters.
@@ -7394,8 +7325,8 @@ __gg__string(const size_t integers[])
   int stride = charmap->stride();
 
   // Pick up the rest of the parameters
-  size_t tgt_o              = ref_o[index_cblc];
-  size_t tgt_s              = ref_s[index_cblc];
+  size_t tgt_o = ref[index_cblc].offset;
+  size_t tgt_s = ref[index_cblc].size;
   index_cblc += 1;
 
   char  *dest         = reinterpret_cast<char *>(tgt->data + tgt_o);
@@ -7407,14 +7338,14 @@ __gg__string(const size_t integers[])
   // Pick up the pointer, if any
   size_t pointer = 0;
   int overflow = 0;
-  if( ref[INDEX_OF_POINTER] )
+  if( ref[INDEX_OF_POINTER].field )
     {
     int rdigits;
     int p  = (size_t)__gg__binary_value_from_qualified_field(
                                                     &rdigits,
-                                                    ref  [INDEX_OF_POINTER],
-                                                    ref_o[INDEX_OF_POINTER],
-                                                    ref_s[INDEX_OF_POINTER]
+                                                    ref[INDEX_OF_POINTER].field,
+                                                    ref[INDEX_OF_POINTER].offset,
+                                                    ref[INDEX_OF_POINTER].size
                                                     );
     if( p<0 )
       {
@@ -7441,9 +7372,9 @@ __gg__string(const size_t integers[])
 
       // Pick up the identifier_2 DELIMITED BY value
       std::u32string str_id2 = normalize_for_inspect_format_4(
-                                                        ref[index_cblc],
-                                                        ref_o[index_cblc],
-                                                        ref_s[index_cblc],
+                                                        ref[index_cblc].field,
+                                                        ref[index_cblc].offset,
+                                                        ref[index_cblc].size,
                                                         tgt_encoding);
       index_cblc += 1;
 
@@ -7451,9 +7382,9 @@ __gg__string(const size_t integers[])
         {
         // Pick up the next id-1 source string for the current id-2 delimiter
         std::u32string str_id1 = normalize_for_inspect_format_4(
-                                                        ref[index_cblc],
-                                                        ref_o[index_cblc],
-                                                        ref_s[index_cblc],
+                                                        ref[index_cblc].field,
+                                                        ref[index_cblc].offset,
+                                                        ref[index_cblc].size,
                                                         tgt_encoding);
         index_cblc += 1;
 
@@ -7507,11 +7438,11 @@ __gg__string(const size_t integers[])
       }
 
     // Update the pointer, if there is one
-    if( ref[INDEX_OF_POINTER] )
+    if( ref[INDEX_OF_POINTER].field )
       {
-      __gg__int128_to_qualified_field(ref  [INDEX_OF_POINTER],
-                                      ref_o[INDEX_OF_POINTER],
-                                      ref_s[INDEX_OF_POINTER],
+      __gg__int128_to_qualified_field(ref[INDEX_OF_POINTER].field,
+                                      ref[INDEX_OF_POINTER].offset,
+                                      ref[INDEX_OF_POINTER].size,
                                       (__int128)(pointer+1),
                                       0,
                                       truncation_e,
@@ -7539,6 +7470,12 @@ display_both(cblc_field_t  *field,
   static size_t display_string_size = MINIMUM_ALLOCATION_SIZE;
   static char *display_string = static_cast<char *>(malloc(display_string_size));
 
+  if( field->type == FldLiteralA && field->encoding == custom_encoding_e )
+    {
+    field->encoding = DEFAULT_SOURCE_ENCODING;
+    }
+
+
   cbl_encoding_t encoding = format_for_display_internal(
                                             &display_string,
                                             &display_string_size,
@@ -9399,37 +9336,11 @@ __gg__assign_value_from_stack(cblc_field_t *dest, __int128 parameter)
 
 extern "C"
 int
-__gg__literaln_alpha_compare(      char         *left_side,
-                             const cblc_field_t *right,
-                             size_t              offset,
-                             size_t              length,
-                             int                 flags)
-  {
-  int retval;
-  if( length == 0 )
-    {
-    length = right->capacity;
-    }
-
-  cbl_encoding_t right_encoding = right->encoding;
-  if( right->attr & hex_encoded_e )
-    {
-    right_encoding = iconv_CP1252_e;
-    }
-  retval = compare_strings(   left_side,
-                              strlen(left_side),
-                              false,
-                              reinterpret_cast<char *>((right->data + offset)),
-                              length,
-                              !!(flags & REFER_T_MOVE_ALL),
-                              right_encoding,
-                              right_encoding);
-  return retval;
-  }
-
-extern "C"
-int
-__gg__unstring( const cblc_field_t *id1,        // The string being unstring
+__gg__unstring( const cblc_referlet_t *id2,
+                const cblc_referlet_t *id4,
+                const cblc_referlet_t *id5,
+                const cblc_referlet_t *id6,
+                const cblc_field_t *id1,        // The string being unstring
                 size_t              id1_o,
                 size_t              id1_s,
                 size_t ndelimiteds,       // The number of DELIMITED entries
@@ -9452,23 +9363,6 @@ __gg__unstring( const cblc_field_t *id1,        // The string being unstring
   // resolved.  Each might have an identifier-5 delimiter, and each might have
   // an identifier-6 count.
 
-  // The delimiting strings; one per ndelimiteds
-  cblc_field_t **id2         = __gg__treeplet_1f;
-  const size_t        *id2_o = __gg__treeplet_1o;
-  const size_t        *id2_s = __gg__treeplet_1s;
-  // The delimited string; one per nreceiver
-  cblc_field_t **id4         = __gg__treeplet_2f;
-  const size_t        *id4_o = __gg__treeplet_2o;
-  const size_t        *id4_s = __gg__treeplet_2s;
-  // The delimiting string; one per receiver
-  cblc_field_t **id5         = __gg__treeplet_3f;
-  const size_t        *id5_o = __gg__treeplet_3o;
-  const size_t        *id5_s = __gg__treeplet_3s;
-  // The count of characters examined;  one per receiver
-  cblc_field_t **id6         = __gg__treeplet_4f;
-  const size_t        *id6_o = __gg__treeplet_4o;
-  const size_t        *id6_s = __gg__treeplet_4s;
-
   // Initialize the state variables
   int overflow = 0;
   int tally = 0;
@@ -9546,12 +9440,12 @@ __gg__unstring( const cblc_field_t *id1,        // The string being unstring
         break;
         }
       // We will peel off enough characters to fit the receiving id4:
-      size_t id_4_size = id4_s[receiver]/stride_id1;
-      if( id4[receiver]->attr & separate_e )
+      size_t id_4_size = id4[receiver].size/stride_id1;
+      if( id4[receiver].field->attr & separate_e )
         {
         // The receiver is NumericDisplay with a separate sign, so, as per
         // the spec, we reduce the size by one character.
-        id_4_size = id4_s[receiver] - 1;
+        id_4_size = id4[receiver].size - 1;
         }
 
       // Make sure id_4_size doesn't take us past the end of the universe
@@ -9569,9 +9463,9 @@ __gg__unstring( const cblc_field_t *id1,        // The string being unstring
                                                &bytes_converted );
       char *duped = static_cast<char *>(__gg__memdup(converted, bytes_converted));
       // Put the converted string into place:
-      __gg__field_from_string(id4[receiver],
-                        id4_o[receiver],
-                        id4_s[receiver],
+      __gg__field_from_string(id4[receiver].field,
+                        id4[receiver].offset,
+                        id4[receiver].size,
                         duped,
                         bytes_converted);
       free(duped);
@@ -9589,9 +9483,9 @@ __gg__unstring( const cblc_field_t *id1,        // The string being unstring
   for( size_t i=0; i<ndelimiteds; i++ )
     {
     std::u32string delimiter
-        = normalize_for_inspect_format_4(id2[i],
-                                         id2_o[i],
-                                         id2_s[i],
+        = normalize_for_inspect_format_4(id2[i].field,
+                                         id2[i].offset,
+                                         id2[i].size,
                                          id1->encoding);
     delimiters.push_back(delimiter);
     }
@@ -9667,9 +9561,9 @@ __gg__unstring( const cblc_field_t *id1,        // The string being unstring
                            &bytes_converted );
     char *duped = static_cast<char *>(__gg__memdup(converted, bytes_converted));
     // Put the converted string into place:
-    __gg__field_from_string(id4[nreceiver],
-                      id4_o[nreceiver],
-                      id4_s[nreceiver],
+    __gg__field_from_string(id4[nreceiver].field,
+                      id4[nreceiver].offset,
+                      id4[nreceiver].size,
                       duped,
                       bytes_converted);
     free(duped);
@@ -9677,7 +9571,7 @@ __gg__unstring( const cblc_field_t *id1,        // The string being unstring
     left = best_location + (best_delimiter > -1
                             ? delimiters[best_delimiter].size()
                             : 0) ;
-    if( id5[nreceiver] )
+    if( id5[nreceiver].field )
       {
       // The caller wants to know what the delimiter was:
       if( best_delimiter > -1 )
@@ -9689,9 +9583,9 @@ __gg__unstring( const cblc_field_t *id1,        // The string being unstring
                              delimiters[best_delimiter].size()*width_of_utf32,
                              &bytes_converted );
         duped = static_cast<char *>(__gg__memdup(converted, bytes_converted));
-        __gg__field_from_string(id5[nreceiver],
-                          id5_o[nreceiver],
-                          id5_s[nreceiver],
+        __gg__field_from_string(id5[nreceiver].field,
+                          id5[nreceiver].offset,
+                          id5[nreceiver].size,
                           duped,
                           bytes_converted);
         free(duped);
@@ -9699,19 +9593,19 @@ __gg__unstring( const cblc_field_t *id1,        // The string being unstring
       else
         {
         // We didn't find a delimiter
-        __gg__field_from_string(id5[nreceiver],
-                          id5_o[nreceiver],
-                          id5_s[nreceiver],
+        __gg__field_from_string(id5[nreceiver].field,
+                          id5[nreceiver].offset,
+                          id5[nreceiver].size,
                           "",
                           0);
         }
       }
 
-    if( id6[nreceiver] )
+    if( id6[nreceiver].field )
       {
-      __gg__int128_to_qualified_field(id6[nreceiver],
-                                      id6_o[nreceiver],
-                                      id6_s[nreceiver],
+      __gg__int128_to_qualified_field(id6[nreceiver].field,
+                                      id6[nreceiver].offset,
+                                      id6[nreceiver].size,
                                       (__int128)examined,
                                       0,
                                       truncation_e,
@@ -11019,15 +10913,26 @@ __gg__just_mangle_name( const cblc_field_t  *field,
   static char ach_unmangled[1024];
   static char ach_mangled[1024];
 
+
   assert(field);
   assert(field->data);
 
   size_t         length;
   length = field->capacity;
 
+  cbl_encoding_t encoding = field->encoding;
+  if( field->type == FldLiteralA )
+    {
+    // This is a little complicated.  FldLiteralA means somebody said
+    // CALL "LiteralName"m and we know that such things are in the
+    // display_encoding.  The parser assumes this, and so it doesn't set the
+    // encoding in the field, although it probably should.
+    encoding = DEFAULT_SOURCE_ENCODING;
+    }
+
   // We need ach_name to be in ASCII:
   size_t charsout;
-  const char *converted = __gg__iconverter(field->encoding,
+  const char *converted = __gg__iconverter(encoding,
                                            __gg__console_encoding,
                                            PTRCAST(char, field->data),
                                            length,
@@ -12254,7 +12159,7 @@ __gg__convert(cblc_field_t *dest,
               int           /*source_format*/,
               int           dest_format)
   {
-  /* convert formulations: 
+  /* convert formulations:
    *  1. ANY to ALNUM HEX, or NAT HEX
    *  2. HEX to BYTE
    *  3. ALNUM to NAT, ALNUM HEX, or NAT HEX
@@ -12267,18 +12172,18 @@ __gg__convert(cblc_field_t *dest,
    *convert_any_e        = 0x03, // i.e., both
    *convert_byte_e       = 0x04,
    *convert_hex_e        = 0x08, // may be combined with alpha or national
-   *convert_just_bit_e   = 0x10, 
+   *convert_just_bit_e   = 0x10,
    *convert_just_e       = 0x18, // combined with HEX
-   *convert_rjust_bit_e  = 0x20, 
+   *convert_rjust_bit_e  = 0x20,
    *convert_rjust_e      = 0x38, // combined with JUSTIFY
    */
-  cbl_encoding_t tgt_enc = (dest_format & convert_nat_e) 
+  cbl_encoding_t tgt_enc = (dest_format & convert_nat_e)
                          ? __gg__national_encoding
                          : __gg__display_encoding;
   const charmap_t *charmap_tgt = __gg__get_charmap(tgt_enc);
 
   charmap_t *charmap_dest = __gg__get_charmap(dest->encoding);
-  
+
   if( dest_format & convert_hex_e )
     {
     size_t nbytes;
@@ -12369,6 +12274,14 @@ __gg__convert(cblc_field_t *dest,
     }
   }
 
+/*
+   gg_printf("Message: \n", NULL_TREE);
+   gg_call(VOID,
+          "__gg__show_int128",
+          value,
+          NULL_TREE);
+   gg_printf("\n", NULL_TREE);
+*/
 
 extern "C"
 __int128
@@ -12395,10 +12308,698 @@ __gg__look_at_pointer(void *ptr)
 
 extern "C"
 void
-__gg__set_data_member(cblc_field_t *field, unsigned char *data)
+__gg__show_int128(__int128 val)
   {
-  // This function is used to hide the initialization of the ->data member
-  // from the compiler.  This avoids the bug that causes n-squared time in the
-  // middle end for a -O0 compiler when doing a -fpie compilation.
-  field->data = data;
+  if( val < 0 )
+    {
+    fprintf(stderr, "-");
+    val = -val;
+    }
+  char ach[128];
+  if(val == 0)
+    {
+    fprintf(stderr, "0");
+    return;
+    }
+  int index = 0;
+  while(val)
+    {
+    ach[index++] = '0' + val % 10;
+    val /= 10;
+    }
+  ach[index++] = '\0';
+  while( index > 0 )
+    {
+    fprintf(stderr, "%c", ach[--index]);
+    }
+  }
+
+extern "C"
+void
+__gg__compare_string_all(int            *result,
+                   const unsigned char  *left,
+                         size_t          length_left,
+                         int             stride,
+                   const unsigned char  *right,
+                         size_t          length_right)
+  {
+  // "all" in the name is in the confusing COBOL sense, as in VALUE ALL "A".
+
+  // We are comparing the left data to the right data, where the right
+  // data is repeated as necessary to match the length of the left.
+
+  /* There are unanswered questions about display, versus national, and
+     how to handle different user-defined alphabets for display and national
+     and so on.  So, for now if the stride is one, we use the display
+     alphabet. */
+
+  *result = 0;
+  size_t index = 0;
+  if( stride == 1 )
+    {
+    while( index < length_left )
+      {
+      unsigned char ch_l = collated(left[index]);
+      unsigned char ch_r = collated(right[index % length_right]);
+
+      if( ch_l != ch_r )
+        {
+        *result =  ch_l < ch_r ? -1 : +1 ;
+        break;
+        }
+      index += 1;
+      }
+    }
+  else if ( stride == 2 )
+    {
+    length_left /= 2;
+    length_right /= 2;
+    const unsigned short *l = reinterpret_cast<const unsigned short *>(left);
+    const unsigned short *r = reinterpret_cast<const unsigned short *>(right);
+    while( index < length_left )
+     {
+      unsigned short ch_l = l[index];
+      unsigned short ch_r = r[index % length_right];
+      if( ch_l != ch_r )
+        {
+        *result =  ch_l < ch_r ? -1 : +1 ;
+        break;
+        }
+      index += 1;
+      }
+    }
+  else
+    {
+    length_left /= 4;
+    length_right /= 4;
+    const unsigned long *l = reinterpret_cast<const unsigned long *>(left);
+    const unsigned long *r = reinterpret_cast<const unsigned long *>(right);
+    while( index < length_left )
+      {
+      unsigned long ch_l = l[index];
+      unsigned long ch_r = r[index % length_right];
+      if( ch_l != ch_r )
+        {
+        *result =  ch_l < ch_r ? -1 : +1 ;
+        break;
+        }
+      index += 1;
+      }
+    }
   }
+
+extern "C"
+void
+__gg__compare_string_1( int            *result,
+                  const unsigned char  *left,
+                        size_t          length_left,
+                  const unsigned char  *right,
+                        size_t          length_right,
+                        cbl_char_t      char_space_)
+  {
+  // This is the the routine that will probably do all of the real-world work,
+  // the following routines not withstanding.  It does single-byte comparisons
+  // through the collation table.
+  *result = 0;
+  unsigned char char_space = char_space_;
+
+  size_t length = std::min(length_left, length_right);
+  size_t index = 0;
+  while( index < length )
+    {
+    unsigned char ch_l = collated(left[index]);
+    unsigned char ch_r = collated(right[index]);
+    if( ch_l != ch_r )
+      {
+      *result =  ch_l < ch_r ? -1 : +1 ;
+      goto done;
+      }
+    index += 1;
+    }
+  if( *result == 0 )
+    {
+    while( index < length_left )
+      {
+      unsigned char ch_l = collated(left[index]);
+      if( ch_l != char_space )
+        {
+        *result =  ch_l < char_space ? -1 : +1 ;
+        goto done;
+        }
+      index += 1;
+      }
+    while( index < length_right )
+      {
+      unsigned char ch_r = collated(right[index]);
+      if( char_space != ch_r )
+        {
+        *result =  char_space < ch_r ? -1 : +1 ;
+        goto done;
+        }
+      index += 1;
+      }
+    }
+  done:
+  return;
+  }
+
+#define ASCII_16 "                "
+#define ASCII_64    ASCII_16  ASCII_16  ASCII_16  ASCII_16
+#define ASCII_256   ASCII_64  ASCII_64  ASCII_64  ASCII_64
+#define ASCII_1024  ASCII_256 ASCII_256 ASCII_256 ASCII_256
+
+#define EBCDIC_16 "@@@@@@@@@@@@@@@@"
+#define EBCDIC_64    EBCDIC_16  EBCDIC_16  EBCDIC_16  EBCDIC_16
+#define EBCDIC_256   EBCDIC_64  EBCDIC_64  EBCDIC_64  EBCDIC_64
+#define EBCDIC_1024  EBCDIC_256 EBCDIC_256 EBCDIC_256 EBCDIC_256
+
+static const unsigned char  ascii_1024[1025] =  ASCII_1024;
+static const unsigned char ebcdic_1024[1025] = EBCDIC_1024;
+
+extern "C"
+void
+__gg__compare_string_1a( int            *result,
+                   const unsigned char  *left,
+                         size_t          length_left,
+                   const unsigned char  *right,
+                         size_t          length_right,
+                         cbl_char_t      )
+  {
+  // This is the rarely-seen, but simplest routine of all, comparing
+  // single-byte ASCII characters in the same encoding without fear or favor.
+  *result = 0;
+
+  size_t length = std::min(length_left, length_right);
+  *result = memcmp(left, right, length);
+  if( *result == 0 )
+    {
+    if( length < length_left ) // Right is shorter than Left
+      {
+      // We need to compare the trailing characters of left to inferred spaces
+      // on the right.
+      left += length;
+      length_left -= length;
+      while( length_left )
+        {
+        size_t this_time = std::min(1024UL, length_left);
+        *result = memcmp(left, ascii_1024, this_time);
+        if( *result )
+          {
+          break;
+          }
+        left += this_time;
+        length_left -= this_time;
+        }
+      }
+    else if( length < length_right ) // Left is shorter than Right
+      {
+      // We need to compare the trailing characters of left to inferred spaces
+      // on the right.
+      right += length;
+      length_right -= length;
+      while( length_right )
+        {
+        size_t this_time = std::min(1024UL, length_right);
+        *result = memcmp(ascii_1024, right, this_time);
+        if( *result )
+          {
+          break;
+          }
+        right += this_time;
+        length_right -= this_time;
+        }
+      }
+    }
+  return;
+  }
+
+extern "C"
+void
+__gg__compare_string_1e( int            *result,
+                   const unsigned char  *left,
+                         size_t          length_left,
+                   const unsigned char  *right,
+                         size_t          length_right,
+                         cbl_char_t      )
+  {
+  // This is the rarely-seen, but simplest routine of all, comparing
+  // single-byte EBCDIC characters in the same encoding without fear or favor.
+  *result = 0;
+
+  size_t length = std::min(length_left, length_right);
+  *result = memcmp(left, right, length);
+  if( *result == 0 )
+    {
+    if( length < length_left ) // Right is shorter than Left
+      {
+      // We need to compare the trailing characters of left to inferred spaces
+      // on the right.
+      left += length;
+      length_left -= length;
+      while( length_left )
+        {
+        size_t this_time = std::min(1024UL, length_left);
+        *result = memcmp(left, ebcdic_1024, this_time);
+        if( *result )
+          {
+          break;
+          }
+        left += this_time;
+        length_left -= this_time;
+        }
+      }
+    else if( length < length_right ) // Left is shorter than Right
+      {
+      // We need to compare the trailing characters of left to inferred spaces
+      // on the right.
+      right += length;
+      length_right -= length;
+      while( length_right )
+        {
+        size_t this_time = std::min(1024UL, length_right);
+        *result = memcmp(ebcdic_1024, right, this_time);
+        if( *result )
+          {
+          break;
+          }
+        right += this_time;
+        length_right -= this_time;
+        }
+      }
+    }
+  return;
+  }
+
+extern "C"
+void
+__gg__compare_string_2( int            *result,
+                   const unsigned short  *left,
+                         size_t          length_left,
+                   const unsigned short  *right,
+                         size_t          length_right,
+                         cbl_char_t      char_space_)
+  {
+  // This compares USHORT character strings:
+  *result = 0;
+  unsigned short char_space = char_space_;
+
+  length_left  /= 2;
+  length_right /= 2;
+  size_t length = std::min(length_left, length_right);
+  size_t index = 0;
+  while( index < length )
+    {
+    unsigned short ch_l = collated(left[index]);
+    unsigned short ch_r = collated(right[index]);
+    if( ch_l != ch_r )
+      {
+      *result =  ch_l < ch_r ? -1 : +1 ;
+      goto done;
+      }
+    index += 1;
+    }
+  if( *result == 0 )
+    {
+    while( index < length_left )
+      {
+      unsigned short ch_l = collated(left[index]);
+      if( ch_l != char_space )
+        {
+        *result =  ch_l < char_space ? -1 : +1 ;
+        goto done;
+        }
+      index += 1;
+      }
+    while( index < length_right )
+      {
+      unsigned short ch_r = collated(right[index]);
+      if( char_space != ch_r )
+        {
+        *result =  char_space < ch_r ? -1 : +1 ;
+        goto done;
+        }
+      index += 1;
+      }
+    }
+  done:
+  return;
+  }
+
+extern "C"
+void
+__gg__compare_string_2a( int            *result,
+                   const unsigned short  *left,
+                         size_t          length_left,
+                   const unsigned short  *right,
+                         size_t          length_right,
+                         cbl_char_t      char_space_)
+  {
+  // This compares USHORT character strings:
+  *result = 0;
+  unsigned short char_space = char_space_;
+
+  length_left  /= 2;
+  length_right /= 2;
+  size_t length = std::min(length_left, length_right);
+  size_t index = 0;
+  while( index < length )
+    {
+    unsigned short ch_l = left[index];
+    unsigned short ch_r = right[index];
+    if( ch_l != ch_r )
+      {
+      *result =  ch_l < ch_r ? -1 : +1 ;
+      goto done;
+      }
+    index += 1;
+    }
+  if( *result == 0 )
+    {
+    while( index < length_left )
+      {
+      unsigned short ch_l = left[index];
+      if( ch_l != char_space )
+        {
+        *result =  ch_l < char_space ? -1 : +1 ;
+        goto done;
+        }
+      index += 1;
+      }
+    while( index < length_right )
+      {
+      unsigned short ch_r = right[index];
+      if( char_space != ch_r )
+        {
+        *result =  char_space < ch_r ? -1 : +1 ;
+        goto done;
+        }
+      index += 1;
+      }
+    }
+  done:
+  return;
+  }
+
+extern "C"
+void
+__gg__compare_string_4( int             *result,
+                   const unsigned long  *left,
+                         size_t          length_left,
+                   const unsigned long  *right,
+                         size_t          length_right,
+                         cbl_char_t      char_space_)
+  {
+  // This compares ULONG character strings:
+  *result = 0;
+  unsigned long char_space = char_space_;
+
+  length_left  /= 4;
+  length_right /= 4;
+  size_t length = std::min(length_left, length_right);
+  size_t index = 0;
+  while( index < length )
+    {
+    unsigned long ch_l = collated(left[index]);
+    unsigned long ch_r = collated(right[index]);
+    if( ch_l != ch_r )
+      {
+      *result =  ch_l < ch_r ? -1 : +1 ;
+      goto done;
+      }
+    index += 1;
+    }
+  if( *result == 0 )
+    {
+    while( index < length_left )
+      {
+      unsigned long ch_l = collated(left[index]);
+      if( ch_l != char_space )
+        {
+        *result =  ch_l < char_space ? -1 : +1 ;
+        goto done;
+        }
+      index += 1;
+      }
+    while( index < length_right )
+      {
+      unsigned long ch_r = collated(right[index]);
+      if( char_space != ch_r )
+        {
+        *result =  char_space < ch_r ? -1 : +1 ;
+        goto done;
+        }
+      index += 1;
+      }
+    }
+  done:
+  return;
+  }
+
+extern "C"
+void
+__gg__compare_string_4a( int             *result,
+                   const unsigned long  *left,
+                         size_t          length_left,
+                   const unsigned long  *right,
+                         size_t          length_right,
+                         cbl_char_t      char_space_)
+  {
+  // This compares ULONG character strings:
+  *result = 0;
+  unsigned long char_space = char_space_;
+
+  length_left  /= 4;
+  length_right /= 4;
+  size_t length = std::min(length_left, length_right);
+  size_t index = 0;
+  while( index < length )
+    {
+    unsigned long ch_l = left[index];
+    unsigned long ch_r = right[index];
+    if( ch_l != ch_r )
+      {
+      *result =  ch_l < ch_r ? -1 : +1 ;
+      goto done;
+      }
+    index += 1;
+    }
+  if( *result == 0 )
+    {
+    while( index < length_left )
+      {
+      unsigned long ch_l = left[index];
+      if( ch_l != char_space )
+        {
+        *result =  ch_l < char_space ? -1 : +1 ;
+        goto done;
+        }
+      index += 1;
+      }
+    while( index < length_right )
+      {
+      unsigned long ch_r = right[index];
+      if( char_space != ch_r )
+        {
+        *result =  char_space < ch_r ? -1 : +1 ;
+        goto done;
+        }
+      index += 1;
+      }
+    }
+  done:
+  return;
+  }
+
+extern "C"
+void
+__gg_compare_string_different(int            *result,
+                        const unsigned char  *left,
+                              size_t          length_left,
+                              cbl_encoding_t  encoding_left,
+                        const unsigned char  *right,
+                              size_t          length_right,
+                              cbl_encoding_t  encoding_right)
+  {
+  /*  This routine converts the right string to the left encoding, and then
+      compares the results.  In the case where the left side is the
+      __gg__display_encoding, the `collated` table is used. */
+  charmap_t *charmap = __gg__get_charmap(encoding_left);
+  int stride = charmap->stride();
+  cbl_char_t space = charmap->mapped_character(ascii_space);
+  size_t nbytes;
+  const unsigned char *converted = reinterpret_cast<unsigned char *>(
+                                    __gg__iconverter(encoding_right,
+                                                     encoding_left,
+                                                     right,
+                                                     length_right,
+                                                     &nbytes));
+  switch(stride)
+    {
+    case 1:
+      {
+      __gg__compare_string_1a( result,
+                               left,
+                               length_left,
+                               converted,
+                               nbytes,
+                               space);
+      break;
+      }
+
+    case 2:
+      {
+      __gg__compare_string_2(result,
+                             reinterpret_cast<const unsigned short *>(left),
+                             length_left,
+                             reinterpret_cast<const unsigned short *>(converted),
+                             nbytes,
+                             space);
+      break;
+      }
+
+    case 4:
+      {
+      __gg__compare_string_4(result,
+                             reinterpret_cast<const unsigned long *>(left),
+                             length_left,
+                             reinterpret_cast<const unsigned long *>(converted),
+                             nbytes,
+                             space);
+      break;
+      }
+    }
+  return;
+  }
+
+extern "C"
+void
+__gg__compare_numeric_all(int *result,
+                          __int128 value,
+                          size_t digits,
+                          const unsigned char *string,
+                          size_t length,
+                          cbl_encoding_t encoding )
+  {
+  char ach[128];
+  unsigned char *pach = reinterpret_cast<unsigned char *>(ach);
+  if( digits == 0 )
+    {
+    // Go for maximum length:
+    __gg__binary_to_string_ascii(ach, 38, value);
+    // Find the first non-zero digit:
+    while(digits > 1)
+      {
+      if( *pach != ascii_zero )
+        {
+        break;
+        }
+      digits -= 1;
+      pach += 1;
+      }
+    }
+  else
+    {
+    __gg__binary_to_string_ascii(ach, digits, value);
+    }
+
+  // we need to convert the ascii numeric string to the same encoding as the
+  // string:
+  const charmap_t *charmap = __gg__get_charmap(encoding);
+  size_t nbytes;
+  const char *converted = __gg__iconverter( DEFAULT_SOURCE_ENCODING,
+                                            encoding ,
+                                            ach,
+                                            digits,
+                                            &nbytes);
+  *result = 0;
+  for(size_t i=0; i<digits; i++)
+    {
+    cbl_char_t chl = charmap->getch(converted, i);
+    cbl_char_t chr = charmap->getch(string, i % length);
+
+    chl = collated(chl);
+    chr = collated(chr);
+    if( chl > chr )
+      {
+      *result = 1;
+      break;
+      }
+    else if( chl < chr )
+      {
+      *result = -1;
+      break;
+      }
+    }
+  return;
+  }
+
+extern "C"
+void
+__gg__compare_binary_to_string( int *result,
+                                __int128 value,
+                                size_t digits,
+                                char *right,
+                                size_t length,
+                                cbl_encoding_t encoding)
+  {
+  char ach[128];
+  unsigned char *pach = reinterpret_cast<unsigned char *>(ach);
+  if( digits == 0 )
+    {
+    // Go for maximum length:
+    __gg__binary_to_string_ascii(ach, 38, value);
+    // Find the first non-zero digit:
+    while(digits > 1)
+      {
+      if( *pach != ascii_zero )
+        {
+        break;
+        }
+      digits -= 1;
+      pach += 1;
+      }
+    }
+  else
+    {
+    __gg__binary_to_string_ascii(ach, digits, value);
+    }
+  // ach is digits characters in DEFAULT_SOURCE_ENCODING.
+  // we need to convert the ascii numeric string to the right-side encoding
+  charmap_t *charmap = __gg__get_charmap(encoding);
+  cbl_char_t space = charmap->mapped_character(ascii_space);
+  size_t nbytes;
+  char *converted = __gg__iconverter( DEFAULT_SOURCE_ENCODING,
+                                      encoding ,
+                                      ach,
+                                      digits,
+                                      &nbytes);
+  switch( charmap->stride() )
+    {
+    case 1:
+      __gg__compare_string_1(result,
+                             reinterpret_cast<unsigned char *>(converted),
+                             nbytes,
+                             reinterpret_cast<unsigned char *>(right),
+                             length,
+                             space);
+      break;
+    case 2:
+      __gg__compare_string_2(result,
+                             reinterpret_cast<unsigned short *>(converted),
+                             nbytes,
+                             reinterpret_cast<unsigned short *>(right),
+                             length,
+                             space);
+      break;
+    case 4:
+      __gg__compare_string_4(result,
+                             reinterpret_cast<unsigned long *>(converted),
+                             nbytes,
+                             reinterpret_cast<unsigned long *>(right),
+                             length,
+                             space);
+      break;
+    }
+  return;
+  }
+
diff --git a/libgcobol/stringbin.cc b/libgcobol/stringbin.cc
index ed762507a65..e4584a47c8a 100644
--- a/libgcobol/stringbin.cc
+++ b/libgcobol/stringbin.cc
@@ -270,30 +270,49 @@ bool
 __gg__binary_to_string_ascii(char *result, int digits, __int128 value)
   {
   zero_char = ascii_zero;
-
-  // Note that this routine does not terminate the generated string with a
-  // NUL.  This routine is sometimes used to generate a NumericDisplay string
-  // of digits in place, with no terminator.
-  __int128 mask = __gg__power_of_ten(digits);
-
-  COMBINED combined;
-  if( value < 0 )
+  bool retval; // True means the value was too big to fit into digits
+  if( digits < 39 )
     {
-    value = -value;
-    }
+    // Note that this routine does not terminate the generated string with a
+    // NUL.  This routine is sometimes used to generate a NumericDisplay string
+    // of digits in place, with no terminator.
+    __int128 mask = __gg__power_of_ten(digits);
 
-  // A non-zero retval means the number was too big to fit into the desired
-  // number of digits:
-  bool retval = !!(value / mask);
+    COMBINED combined;
+    if( value < 0 )
+      {
+      value = -value;
+      }
 
-  // mask off the bottom digits to avoid garbage when value is too large
-  value %= mask;
+    // A non-zero retval means the number was too big to fit into the desired
+    // number of digits:
+    retval = !!(value / mask);
 
-  combined.start = 0;
-  combined.run = digits;
-  combined.val128 = value;
-  string_from_combined(combined);
-  memcpy(result, combined_string, digits);
+    // mask off the bottom digits to avoid garbage when value is too large
+    value %= mask;
+
+    combined.start = 0;
+    combined.run = digits;
+    combined.val128 = value;
+    string_from_combined(combined);
+    memcpy(result, combined_string, digits);
+    return retval;
+    }
+  else
+    {
+    // We assume that this is a PIC X(16) COMP-X, so the value is always
+    // positive.
+    COMBINED combined;
+    // A non-zero retval means the number was too big to fit into the desired
+    // number of digits:
+    retval = false;
+
+    combined.start = 0;
+    combined.run = digits;
+    combined.val128 = value;
+    string_from_combined(combined);
+    memcpy(result, combined_string, digits);
+    }
   return retval;
   }