cobol: Rewrite exception handling. Partially refactor subscript/refmod calculations.

This commit includes changes to exception handling, and changes to the
calculations for offsets and lengths when processing subscripted table entries
and variables with (from:length) reference modifications.

Exception handling in COBOL requires significant amounts of information to be
built at compile time and sent to libgcobol.so at run time.  The changes here
reduce some problems caused by creating structures by the host that are
processed by the target, mainly by creating arrays of simple integers rather
than by turning a structure into a stream of bytes.

Significant changes to the logic of exception handling brings the run-time
performance more in line with the ISO specification.

The handling of COBOL variables that include tables defined with DEPENDING ON
clauses is subtly different when used as sending variables versus when they are
receiving variables.  This commit folds the very similar refer_offset_source
and refer_offset_dest routines into a single refer_offset routine.  It also
streamlines the refer_length_source and refer_length_dest routines by moving
common code into a static refer_length() routine, and having
refer_length_source() and refer_length_dest() each call refer_length() with a
a type flag.

Co-Authored by: James K. Lowden <jklowden@cobolworx.com>
Co-Authored by: Robert Dubner <rdubner@symas.com>

gcc/cobol/ChangeLog:

	* cdf.y: Exceptions.
	* except.cc (cbl_enabled_exception_t::dump): Likewise.
	(cbl_enabled_exceptions_t::dump): Likewise.
	(cbl_enabled_exceptions_t::status): Likewise.
	(cbl_enabled_exceptions_t::encode): Likewise.
	(cbl_enabled_exceptions_t::turn_on_off): Likewise.
	(cbl_enabled_exceptions_t::match): Likewise.
	(declarative_runtime_match): Likewise. Likewise.
	* exceptg.h (struct cbl_exception_files_t): Likewise.
	(class exception_turn_t): Likewise.
	(apply_cdf_turn): Likewise.
	* genapi.cc (treeplet_fill_source): Use refer_offset().
	(function_handle_from_name): Likewise.
	(parser_initialize_programs): Likewise.
	(parser_statement_begin): Likewise.
	(array_of_long_long): Exceptions.
	(parser_compile_ecs): Exceptions.
	(parser_compile_dcls): Exceptions.
	(store_location_stuff): Exceptions.
	(initialize_variable_internal): Use refer_offset().
	(compare_binary_binary): Use refer_offset().
	(cobol_compare): Use refer_offset().
	(paragraph_label): Formatting.
	(parser_goto): Use refer_offset().
	(parser_perform_times): Likewise.
	(internal_perform_through_times): Likewise.
	(parser_enter_file): Exceptions.
	(psa_FldLiteralN): Add comment.
	(parser_accept): Use refer_offset().
	(parser_accept_command_line): Likewise.
	(parser_accept_command_line_count): Likewise.
	(parser_accept_envar): Likewise.
	(parser_set_envar): Likewise.
	(parser_display_internal): Likewise.
	(parser_initialize_table): Likewise.
	(parser_sleep): Likewise.
	(parser_allocate): Likewise.
	(parser_free): Likewise.
	(parser_division): Likewise.
	(parser_relop_long): Likewise.
	(parser_see_stop_run): Likewise.
	(parser_classify): Likewise.
	(parser_file_add): Include symbol_table_index in __gg__file_init().
	(parser_file_open): Use refer_offset().
	(parser_file_write): Move forward declaration of store_location_stuff().
	(parser_file_start): Use refer_offset().
	(parser_inspect_conv): Likewise:
	(parser_intrinsic_numval_c): Likewise:
	(parser_intrinsic_subst): Likewise:
	(parser_intrinsic_call_1): Likewise:
	(parser_intrinsic_call_2): Likewise:
	(parser_intrinsic_call_3): Likewise:
	(parser_intrinsic_call_4): Likewise:
	(parser_sort): Likewise:
	(parser_return_start): Exceptions.
	(parser_unstring): Use refer_offset().
	(create_and_call): Likewise.
	(parser_set_pointers): Use refer_offset().
	(parser_program_hierarchy): Comment.
	(parser_set_handled): Exceptions; removed.
	(parser_set_file_number): Exceptions; removed.
	(stash_exceptions): Exceptions; removed.
	(parser_exception_prepare): Exceptions; removed.
	(parser_match_exception): Exceptions; eliminate blob.
	(parser_check_fatal_exception): Exceptions.
	(parser_push_exception): Create.
	(parser_pop_exception): Create.
	(mh_identical): Use refer_offset().
	(mh_source_is_literalN): Likewise.
	(mh_dest_is_float): Likewise.
	(mh_numeric_display): Likewise.
	(mh_little_endian): Likewise.
	(mh_source_is_group): Likewise.
	(move_helper): Likewise.
	(binary_initial_from_float128): Formatting; change error message.
	(initial_from_float128): Change name to "initial_from_initial"
	(initial_from_initial): Add one byte to allocation for figconsts.
	(parser_symbol_add): Use initial_from_initial().
	(parser_symbol_add): Eliminate unneeded logic around actually_create...
	* genapi.h: Exceptions.
	* genmath.cc (fast_add): Use refer_offset().
	(fast_subtract): Likewise.
	(fast_multiply): Likewise.
	(fast_divide): Likewise.
	* genutil.cc: Exceptions; various global definitions.
	(get_integer_value): Comment.
	(get_data_offset_dest): Eliminate.
	(get_data_offset_source): Rename to get_data_offset().
	(get_data_offset): Use refer_offset().
	(get_binary_value): Likewise; eliminate use of literal_decl_node.
	(build_array_of_treeplets): Likewise.
	(build_array_of_fourplets): Likewise.
	(REFER_CHECK): Comment:
	(refer_refmod_length): Use get_any_capacity(); use refer_offset;
	set reflen to integer_one_node.
	(refer_offset_dest): Change name to refer_offset.
	(refer_offset): Use get_data_offset().
	(refer_size_dest): Change name to refer_size().
	(refer_size): Use get_any_capacity().
	(refer_offset_source): Use refer_offset().
	(refer_size_source): Likewise.
	(qualified_data_source): Likewise.
	(qualified_data_dest): Likewise.
	(qualified_data_location): Likewise.
	* genutil.h: Exceptions; changes to global declarations.
	* lexio.cc (likely_nist_file): Added to detect NIST file format.
	(cdftext::free_form_reference_format): Handle NIST file format.
	* parse.y: (strip_trailing_zeroes): Added.
	Changes for exceptions.
	* parse_ante.h (parse_error_inc): Likewise.
	(YYLLOC_DEFAULT): Likewise.
	(static_cast): Likewise.
	(is_cobol_word): Change to is_cobol_charset.
	(is_cobol_charset): Refine allowed characters.
	(require_numeric): Change to require integer.
	(require_integer): Likewise.
	(current_enabled_ecs): Exceptions.
	(is_integer_literal): Change interpretation.
	(procedure_division_ready): Exceptions.
	(statement_epilog): Likewise.
	(statement_begin): Likewise.
	* show_parse.h: Changes to GCOBOL_SHOW handling.
	* structs.cc: Add symbol_index to cblc_file_t structure.
	* symbols.cc (field_str): Repair .initial handling in FldLiteralN.
	* symbols.h (struct cbl_field_t): Eliminate literal_decl_node.
	(current_enabled_ecs): Exceptions.
	* util.cc (cbl_message): Add final newline to error message.
	(ftoupper): Added.
	(iso_cobol_word): Add list of ISO reserved words.
	* util.h (ftoupper): Added.

libgcobol/ChangeLog:

	* charmaps.cc: Add #include <vector>.
	* common-defs.h (COMMON_DEFS_H_): Add #include <stdio.h>.
	(enum cbl_file_mode_t): Add file_mode_any_e.
	(enum file_stmt_t): Created.
	(cbl_file_mode_str): Add case for file_mode_any_e.
	(ec_cmp): Exceptions.
	(struct cbl_enabled_exception_t): Likewise.
	(struct cbl_declarative_t): Likewise.
	(class cbl_enabled_exceptions_array_t): Likewise.
	(class cbl_enabled_exceptions_t): Likewise.
	(struct cbl_enabled_exceptions_array_t): Likewise.
	(enabled_exception_match): Likewise.
	* constants.cc: Add #include <vector>.
	* exceptl.h (struct cbl_exception_t): Removed.
	(struct cbl_declarative_t): Removed.
	(class ec_status_t): Removed.
	* gcobolio.h: Add symbol_table_index to cblc_file_t.
	* gfileio.cc: Add #include <vector>
	(establish_status): Comment.
	(__io__file_init): Handle symbol_table_index.
	(__io__file_delete): Set file->prior_op.
	(__io__file_rewrite): Likewise.
	(__io__file_read): Likewise.
	(__io__file_open): Likewise.
	(__io__file_close): Likewise.
	* gmath.cc: Include #include <vector>.
	* intrinsic.cc: Include #include <vector>.
	* libgcobol.cc: Multiple modifications for exceptions.
	* valconv.cc: #include <vector>.

17 files changed, 1518 insertions, 1064 deletions

diff --git a/gcc/cobol/cdf.y b/gcc/cobol/cdf.y
index c775737..994bf6a 100644
--- a/gcc/cobol/cdf.y
+++ b/gcc/cobol/cdf.y
@@ -155,75 +155,14 @@ void input_file_status_notify();
 static char *display_msg;
 const char * keyword_str( int token );
 
-static class exception_turns_t {
-  typedef std::list<size_t> filelist_t;
-  typedef std::map<ec_type_t, filelist_t> ec_filemap_t;
-  ec_filemap_t exceptions;
- public:
-  bool enabled, location;
-
-  exception_turns_t() : enabled(false), location(false) {};
-
-  const ec_filemap_t& exception_files() const { return exceptions; }
-
-  struct args_t {
-    size_t nexception;
-    cbl_exception_files_t *exceptions;
-  };
-
-  bool add_exception( ec_type_t type, const filelist_t files = filelist_t() ) {
-    ec_disposition_t disposition = ec_type_disposition(type);
-    if( disposition != ec_implemented(disposition) ) {
-	cbl_unimplementedw("CDF: exception '%s'", ec_type_str(type));
-    }
-    auto elem = exceptions.find(type);
-    if( elem != exceptions.end() ) return false; // cannot add twice
-
-    exceptions[type] = files;
-    return true;
-  }
-
-  args_t args() const {
-    args_t args;
-    args.nexception = exceptions.size();
-    args.exceptions = NULL;
-    if( args.nexception ) {
-      args.exceptions = new cbl_exception_files_t[args.nexception];
-    }
-    std::transform( exceptions.begin(), exceptions.end(), args.exceptions,
-                    []( auto& input ) {
-                      cbl_exception_files_t output;
-                      output.type = input.first;
-                      output.nfile = input.second.size();
-                      output.files = NULL;
-                      if( output.nfile ) {
-                        output.files = new size_t[output.nfile];
-                        std::copy(input.second.begin(),
-                                       input.second.end(),
-                                       output.files );
-                      }
-                      return output;
-                    } );
-    return args;
-  }
-
-  void clear() {
-    for( auto& ex : exceptions ) {
-      ex.second.clear();
-    }
-    exceptions.clear();
-    enabled = location = false;
-  }
-
-} exception_turns;
-
-
-static bool
-apply_cdf_turn( exception_turns_t& turns ) {
-  for( auto elem : turns.exception_files() ) {
+exception_turn_t exception_turn;
+			
+bool
+apply_cdf_turn( const exception_turn_t& turn ) {
+  for( auto elem : turn.exception_files() ) {
     std::set<size_t> files(elem.second.begin(), elem.second.end());
-    enabled_exceptions.turn_on_off(turns.enabled,
-                                   turns.location,
+    enabled_exceptions.turn_on_off(turn.enabled,
+                                   turn.location,
                                    elem.first, files);
   }
   if( getenv("GCOBOL_SHOW") ) enabled_exceptions.dump();
@@ -241,6 +180,7 @@ apply_cdf_turn( exception_turns_t& turns ) {
     std::set<size_t> *files;
 }
 
+%printer { fprintf(yyo, "'%s'", $$? "true" : "false" ); } <boolean>
 %printer { fprintf(yyo, "'%s'", $$ ); } <string>
 %printer { fprintf(yyo, "%s '%s'",
 		   keyword_str($$.token),
@@ -258,7 +198,7 @@ apply_cdf_turn( exception_turns_t& turns ) {
 %type	<cdfval>	cdf_expr
 %type	<cdfval>	cdf_relexpr cdf_reloper cdf_and cdf_bool_expr
 %type	<cdfval>	cdf_factor
-%type	<boolean>	cdf_cond_expr override
+%type	<boolean>	cdf_cond_expr override except_check
 
 %type   <file>		filename
 %type   <files>         filenames
@@ -443,8 +383,8 @@ override:	%empty   { $$ = false; }
 
 cdf_turn:	TURN except_names except_check
 		{
-		  apply_cdf_turn(exception_turns);
-		  exception_turns.clear();
+		  apply_cdf_turn(exception_turn);
+		  exception_turn.clear();
 		}
 		;
 
@@ -463,22 +403,20 @@ except_names: 	except_name
 		;
 except_name:	EXCEPTION_NAME[ec] {
 		  assert($ec != ec_none_e);
-		  exception_turns.add_exception(ec_type_t($ec));
+		  exception_turn.add_exception(ec_type_t($ec));
 		}
 	|	EXCEPTION_NAME[ec] filenames {
 		  assert($ec != ec_none_e);
-		  std::list<size_t> files;
-		  std::copy( $filenames->begin(), $filenames->end(),
-		                  std::back_inserter(files) );
-		  exception_turns.add_exception(ec_type_t($ec), files);
+		  std::list<size_t> files($filenames->begin(), $filenames->end());
+		  exception_turn.add_exception(ec_type_t($ec), files);
 		}
 		;
 
-except_check:	CHECKING on  { exception_turns.enabled = true; }
-	|	CHECKING OFF { exception_turns.enabled = false; }
+except_check:	CHECKING on  { $$ = exception_turn.enable(true); }
+	|	CHECKING OFF { $$ = exception_turn.enable(false); }
 	|	CHECKING on with LOCATION
 		{
-		  exception_turns.enabled = exception_turns.location = true;
+		  $$ = exception_turn.enable(true, true);
 		}
 		;
 
diff --git a/gcc/cobol/except.cc b/gcc/cobol/except.cc
index 7a6a922..2118233 100644
--- a/gcc/cobol/except.cc
+++ b/gcc/cobol/except.cc
@@ -43,6 +43,7 @@
 #include "gengen.h"
 #include "../../libgcobol/exceptl.h"
 #include "util.h"
+#include "genutil.h"
 
 #pragma GCC diagnostic ignored "-Wmissing-field-initializers"
 
@@ -74,103 +75,139 @@ ec_level( ec_type_t ec ) {
   return 3;
 }
 
+void
+cbl_enabled_exception_t::dump( int i ) const {
+  cbl_message(2, "cbl_enabled_exception_t: %2d  {%s, %s, %s, %zu}",
+	      i,
+	      location? "location" : "    none",
+	      ec_type_str(ec),
+	      file );
+}
+
 cbl_enabled_exceptions_t enabled_exceptions;
 
 void
 cbl_enabled_exceptions_t::dump() const {
+  extern int yydebug;
+  int debug = 1;
+  std::swap(debug, yydebug); // dbgmsg needs yydebug
+
   if( empty() ) {
-    cbl_message(2,  "cbl_enabled_exceptions_t:  no exceptions" );
+    dbgmsg("cbl_enabled_exceptions_t:  no exceptions" );
+    std::swap(debug, yydebug);
     return;
   }
   int i = 1;
   for( auto& elem : *this ) {
-    cbl_message(2, "cbl_enabled_exceptions_t: %2d  {%s, %s, %s, %zu}",
+    dbgmsg("cbl_enabled_exceptions_t: %2d  {%s, %s, %zu}",
            i++,
-           elem.enabled?  " enabled" : "disabled",
-           elem.location? "location" : "    none",
+           elem.location? "with location" : "  no location", 
            ec_type_str(elem.ec),
            elem.file );
   }
+  std::swap(debug, yydebug);
 }
 
+uint32_t 
+cbl_enabled_exceptions_t::status() const {
+  uint32_t status_word = 0;
+  for( const auto& ena : *this ) {
+    status_word |= (EC_ALL_E & ena.ec );
+  }
+  return status_word;
+}
 
-bool
+std::vector<uint64_t>
+cbl_enabled_exceptions_t::encode() const {
+  std::vector<uint64_t> encoded;
+  auto p = std::back_inserter(encoded);
+  for( const auto& ec : *this ) {
+    *p++ = ec.location;
+    *p++ = ec.ec;
+    *p++ = ec.file;
+  }
+  return encoded;
+}
+
+void
 cbl_enabled_exceptions_t::turn_on_off( bool enabled,
                                        bool location,
                                        ec_type_t type,
                                        std::set<size_t> files )
 {
-  // A Level 3 EC is added unilaterally; it can't knock out a lower level.
+  // Update current enabled ECs tree on leaving this function. 
+  class update_parser_t {
+    const cbl_enabled_exceptions_t& ecs;
+  public:
+    update_parser_t(const cbl_enabled_exceptions_t& ecs) : ecs(ecs) {}
+    ~update_parser_t() {
+      tree ena = parser_compile_ecs(ecs.encode());
+      current_enabled_ecs(ena);
+    }
+  } update_parser(*this);
+  
+  // A Level 3 EC is added unilaterally; it can't affect a higher level.
   if( ec_level(type) == 3 ) {
     if( files.empty() ) {
-      auto elem = cbl_enabled_exception_t(enabled, location, type);
-      apply(elem);
-      return true;
+      auto elem = cbl_enabled_exception_t(location, type);
+      apply(enabled, elem);
+      return;
     }
 
     for( size_t file : files ) {
-      auto elem = cbl_enabled_exception_t(enabled, location, type, file);
-      apply(elem);
+      auto elem = cbl_enabled_exception_t(location, type, file);
+      apply(enabled, elem);
     }
-    return true;
+    return;
   }
 
-  // std::set::erase_if became available only in C++20.
-  if( enabled ) { // remove any disabled
+  // A new Level 1 or Level 2 EC is likewise simply added. 
+  if( enabled ) {
     if( files.empty() ) {
-      auto p = begin();
-      while( p != end() ) {
-	if( !p->enabled && ec_cmp(type, p->ec) ) {
-	  p = erase(p);
-	} else {
-	  ++p;
-	}
-      }
-    } else {
-      for( size_t file: files ) {
-        auto p = begin();
-        while( p != end() ) {
-	  if( !p->enabled && file == p->file && ec_cmp(type, p->ec) ) {
-	    p = erase(p);
-	  } else {
-	    ++p;
-	  }
-	}
-      }
+      auto elem = cbl_enabled_exception_t(location, type);
+      apply(enabled, elem);
+      return;
     }
-    auto elem = cbl_enabled_exception_t(enabled, location, type);
-    apply(elem);
-    return true;
+    for( size_t file: files ) {
+      auto elem = cbl_enabled_exception_t(location, type, file);
+      apply(enabled, elem);
+    }
+    return;
   }
+
   assert(!enabled);
   assert(ec_level(type) < 3);
 
+  /*
+   * >> TURN EC [files] CHECKING OFF
+   */
+  
   if( files.empty() ) {
+    // A Level 1 EC with no files disables all ECs
     if( type == ec_all_e ) {
       clear();
-      return true;
+      return;
     }
-    // Remove any matching Level-2 or Level-3 ECs, regardless of their files.
+    // Because TURN CHECKING OFF mentioned no files, Remove any matching
+    // Level-2 or Level-3 ECs, regardless of their files.
     auto p = begin();
     while( end() != (p = std::find_if( begin(), end(),
                                        [ec = type]( const auto& elem ) {
                                          return
-                                           elem.enabled &&
                                            elem.ec != ec_all_e &&
                                            ec_cmp(ec, elem.ec); } )) ) {
       erase(p);
     }
-    // Keep the EC as an exception if a higher-level would othewise apply.
+    // Keep the EC as an override if a higher-level would othewise apply.
     p = std::find_if( begin(), end(),
                       [ec = type]( const auto& elem ) {
                         return
-                          elem.enabled &&
                           (elem.ec == ec_all_e || elem.ec < ec) &&
                           elem.file == 0 &&
                           ec_cmp(ec, elem.ec); } );
     if( p != end() ) {
-      auto elem = cbl_enabled_exception_t(enabled, location, type);
-      apply(elem);
+      auto elem = cbl_enabled_exception_t(location, type);
+      apply(enabled, elem);
     }
   } else {
     // Remove any matching or lower-level EC for the same file.
@@ -179,33 +216,30 @@ cbl_enabled_exceptions_t::turn_on_off( bool enabled,
       while( end() != (p = std::find_if( begin(), end(),
                                          [ec = type, file]( const auto& elem ) {
                                            return
-                                             elem.enabled &&
                                              // ec is higher level and matches
                                              (ec == ec_all_e || ec <= elem.ec) &&
                                              file == elem.file &&
                                              ec_cmp(ec, elem.ec); } )) ) {
         erase(p);
       }
-      // Keep the EC as an exception if a higher-level would othewise apply.
+      // Keep the EC as an override if a higher-level would othewise apply.
       p = std::find_if( begin(), end(),
                         [ec = type, file]( const auto& elem ) {
                           return
-                            elem.enabled &&
                             (elem.ec == ec_all_e || elem.ec < ec) &&
                             file == elem.file &&
                             ec_cmp(ec, elem.ec); } );
       if( p != end() ) {
-        auto elem = cbl_enabled_exception_t(enabled, location, type, file);
-        apply(elem);
+        auto elem = cbl_enabled_exception_t(location, type, file);
+        apply(enabled, elem);
       }
     }
   }
-
-  return true;
+  return;
 }
 
 const cbl_enabled_exception_t *
-cbl_enabled_exceptions_t::match( ec_type_t type, size_t file ) {
+cbl_enabled_exceptions_t::match( ec_type_t type, size_t file ) const {
   auto output = enabled_exception_match( begin(), end(), type, file );
   return output != end()? &*output : NULL;
 }
@@ -328,31 +362,40 @@ declarative_runtime_match( cbl_field_t *declaratives, cbl_label_t *lave ) {
   static auto yes = new_temporary(FldConditional);
   static auto psection = new_temporary(FldNumericBin5);
 
-  // Send blob, get declarative section index.
-  auto index = new_temporary(FldNumericBin5);
-  parser_match_exception(index, declaratives);
-
-  auto p = declaratives->data.initial;
-  const auto dcls = reinterpret_cast<const cbl_declarative_t *>(p);
-  size_t ndcl = dcls[0].section; // overloaded
-
-  // Compare returned index to each section index.
-  for( auto p = dcls + 1; p < dcls + 1 + ndcl; p++ ) {
-    parser_set_numeric( psection, p->section );
-    parser_relop( yes, index, eq_op, psection );
-    parser_if( yes );
-    auto section = cbl_label_of(symbol_at(p->section));
-    parser_perform(section);
-    parser_label_goto(lave);
-    parser_else();
-    parser_fi();
+  IF( var_decl_exception_code, ne_op, integer_zero_node ) {
+    // Send blob, get declarative section index.
+    auto index = new_temporary(FldNumericBin5);
+    parser_match_exception(index);
+    auto p = declaratives->data.initial;
+    const auto dcls = reinterpret_cast<const cbl_declarative_t *>(p);
+    size_t ndcl = dcls[0].section; // overloaded
+
+    // Compare returned index to each section index.
+    for( auto p = dcls + 1; p < dcls + 1 + ndcl; p++ ) {
+      parser_set_numeric( psection, p->section );
+      parser_relop( yes, index, eq_op, psection );
+      parser_if( yes );
+      auto section = cbl_label_of(symbol_at(p->section));
+      parser_push_exception();
+      parser_perform(section);
+      parser_pop_exception();
+      parser_label_goto(lave);
+      parser_else();
+      parser_fi();
+    }
   }
+  ELSE {
+    if( getenv("TRACE1") )
+      {
+	gg_printf(">>>>>>( %d )(%s) __gg__exception_code is zero\n",
+		  build_int_cst_type(INT, cobol_location().first_line),
+		  gg_string_literal(__func__),
+		  NULL_TREE);
+      }
+  }
+  ENDIF
 
   parser_label_label(lave);
-
-  // A performed declarative may clear the raised exception with RESUME.
-  // If not cleared and fatal, the default handler will exit.
-  parser_check_fatal_exception();
 }
 
 ec_type_t
diff --git a/gcc/cobol/exceptg.h b/gcc/cobol/exceptg.h
index 4500c0f..1cfb8df 100644
--- a/gcc/cobol/exceptg.h
+++ b/gcc/cobol/exceptg.h
@@ -44,18 +44,62 @@ ec_implemented( ec_disposition_t disposition ) {
   return ec_disposition_t( size_t(disposition) & ~0x80 );
 }
 
-
 // >>TURN arguments
-struct cbl_exception_files_t {
-  ec_type_t type;
-  size_t nfile;
-  size_t *files;
-  bool operator<( const cbl_exception_files_t& that ) {
-    return type < that.type;
+class exception_turn_t;
+bool apply_cdf_turn( const exception_turn_t& turn );
+
+class exception_turn_t {
+  friend bool apply_cdf_turn( const exception_turn_t& turn );
+  typedef std::list<size_t> filelist_t;
+  typedef std::map<ec_type_t, filelist_t> ec_filemap_t;
+  ec_filemap_t exceptions;
+  bool enabled, location;
+ public:
+
+  exception_turn_t() : enabled(false), location(false) {};
+
+  exception_turn_t( ec_type_t ec, bool enabled = true )
+    : enabled(enabled)
+  {
+    add_exception(ec);
+  } 
+
+  bool enable( bool enabled ) {
+    return this->enabled = enabled;
+  } 
+  bool enable( bool enabled, bool location ) {
+    this->location = location;
+    return this->enabled = enabled;
+  } 
+
+  const ec_filemap_t& exception_files() const { return exceptions; }
+
+  bool add_exception( ec_type_t type, const filelist_t files = filelist_t() ) {
+    ec_disposition_t disposition = ec_type_disposition(type);
+    if( disposition != ec_implemented(disposition) ) {
+	cbl_unimplementedw("CDF: exception '%s'", ec_type_str(type));
+    }
+    auto elem = exceptions.find(type);
+    if( elem != exceptions.end() ) return false; // cannot add twice
+
+    exceptions[type] = files;
+    return true;
+  }
+
+  void clear() {
+    for( auto& ex : exceptions ) {
+      ex.second.clear();
+    }
+    exceptions.clear();
+    enabled = location = false;
   }
+
 };
 
 size_t symbol_declaratives_add( size_t program,
                                 const std::list<cbl_declarative_t>& dcls );
 
 #endif
+
+
+
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index dca52ce..204b1ae 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -117,7 +117,7 @@ void
 treeplet_fill_source(TREEPLET &treeplet, cbl_refer_t &refer)
   {
   treeplet.pfield = gg_get_address_of(refer.field->var_decl_node);
-  treeplet.offset = refer_offset_source(refer);
+  treeplet.offset = refer_offset(refer);
   treeplet.length = refer_size_source(refer);
   }
 
@@ -796,7 +796,7 @@ function_handle_from_name(cbl_refer_t &name,
     else
       {
       gg_memcpy(gg_get_address_of(function_handle),
-                qualified_data_source(name),
+                qualified_data_location(name),
                 sizeof_pointer);
       }
     return function_handle;
@@ -837,7 +837,7 @@ function_handle_from_name(cbl_refer_t &name,
                                       "__gg__function_handle_from_name",
                                       build_int_cst_type(INT, current_function->our_symbol_table_index),
                                       gg_get_address_of(name.field->var_decl_node),
-                                      refer_offset_source(name),
+                                      refer_offset(name),
                                       refer_size_source(  name),
                                       NULL_TREE)));
       }
@@ -878,7 +878,7 @@ parser_initialize_programs(size_t nprogs, struct cbl_refer_t *progs)
   for( size_t i=0; i<nprogs; i++ )
     {
     tree function_handle = function_handle_from_name( progs[i],
-                                                      COBOL_FUNCTION_RETURN_TYPE);
+                                                    COBOL_FUNCTION_RETURN_TYPE);
     gg_call(VOID,
             "__gg__to_be_canceled",
             gg_cast(SIZE_T, function_handle),
@@ -886,31 +886,166 @@ parser_initialize_programs(size_t nprogs, struct cbl_refer_t *progs)
     }
   }
 
-void parser_statement_begin()
+static
+tree
+array_of_long_long(const char *name, const std::vector<uint64_t>& vals)
+  {
+  // We need to create a file-static static array of 64-bit integers:
+  tree array_of_ulonglong_type = build_array_type_nelts(ULONGLONG, vals.size()+1);
+  tree array_of_ulonglong = gg_define_variable( array_of_ulonglong_type,
+                                                name,
+                                                vs_file_static);
+  // We have the array.  Now we need to build the constructor for it
+  tree constr = make_node(CONSTRUCTOR);
+  TREE_TYPE(constr) = array_of_ulonglong_type;
+  TREE_STATIC(constr)    = 1;
+  TREE_CONSTANT(constr)  = 1;
+
+  // The first element of the array contains the number of elements to follow
+  CONSTRUCTOR_APPEND_ELT( CONSTRUCTOR_ELTS(constr),
+                          build_int_cst_type(SIZE_T, 0),
+                          build_int_cst_type(ULONGLONG, vals.size()) );
+  for(size_t i=0; i<vals.size(); i++)
+    {
+    CONSTRUCTOR_APPEND_ELT( CONSTRUCTOR_ELTS(constr),
+                            build_int_cst_type(SIZE_T, i+1),
+                            build_int_cst_type(ULONGLONG, vals[i]) );
+    }
+  DECL_INITIAL(array_of_ulonglong) = constr;
+  return array_of_ulonglong;
+  }
+
+/*
+ * As ECs are enabled and disabled with >>TURN, the compiler updates its list
+ * of enabled ECs (and any files they apply to). It encodes this list as an
+ * array of integers.  parser_compile_ecs converts that array as a static
+ * compile-time vector, which it returns to the compiler.
+ *
+ * Before each statement, the compiler determines what possible EC handling the
+ * program can do.  If there's an overlap between potential ECs and
+ * Declaratives, it passes the current pair of static arrays to
+ * parser_statement_begin(), which installs them, for that statement, in the
+ * library.
+ *
+ * After each statement, to effect EC handling, the statement epilog calls uses
+ * parser_match_exception to invoke __gg_match_exception(), which returns the
+ * symbol table index of the matched Declarative, if any.  That "ladder"
+ * Performs the matched declarative, and execution continues with the next
+ * statement.
+ */
+tree parser_compile_ecs( const std::vector<uint64_t>& ecs )
+  {
+  char ach[32];
+  static int counter = 1;
+  sprintf(ach, "_ecs_table_%d", counter++);
+  tree retval =  array_of_long_long(ach, ecs);
+  SHOW_IF_PARSE(nullptr)
+    {
+    SHOW_PARSE_HEADER
+    char ach[64];
+    snprintf(ach, sizeof(ach), " Size is %ld; retval is %p", ecs.size(), retval);
+    SHOW_PARSE_TEXT(ach)
+    SHOW_PARSE_END
+    }
+  TRACE1
+    {
+    TRACE1_HEADER
+    char ach[64];
+    snprintf(ach, sizeof(ach), " Size is %ld; retval is %p", ecs.size(), retval);
+    TRACE1_TEXT_ABC("", ach, "");
+    TRACE1_END
+    }
+  return retval;
+  }
+
+/*
+ * At the beginning of Procedure Division, we may encounter DECLARATIVES
+ * SECTION.  If so, the compiler composes a list of zero or more Declaratives
+ * as cbl_declarative_t, representing the USE statement of each
+ * Declarative. These are encoded as an array of integers, which are returned
+ * to the compiler for use by parser_statement_begin(). Although the list of
+ * declaratives never changes for a program, CALL may change which program is
+ * invoked, and thus the set of active Declaratives.  By passing them for each
+ * statement, code generation is relieved of referring to global variable.
+ */
+tree parser_compile_dcls( const std::vector<uint64_t>& dcls )
+  {
+  char ach[32];
+  static int counter = 1;
+  sprintf(ach, "_dcls_table_%d", counter++);
+
+  tree retval =  array_of_long_long(ach, dcls);
+  SHOW_IF_PARSE(nullptr)
+    {
+    SHOW_PARSE_HEADER
+    char ach[64];
+    snprintf(ach, sizeof(ach), " Size is %ld; retval is %p", dcls.size(), retval);
+    SHOW_PARSE_TEXT(ach);
+    SHOW_PARSE_END
+    }
+
+  TRACE1
+    {
+    TRACE1_HEADER
+    char ach[64];
+    snprintf(ach, sizeof(ach), " Size is %ld; retval is %p", dcls.size(), retval);
+    TRACE1_TEXT_ABC("", ach, "");
+    TRACE1_END
+    }
+  return retval;
+  }
+
+static void store_location_stuff(const cbl_name_t statement_name);
+
+void
+parser_statement_begin( const cbl_name_t statement_name, tree ecs, tree dcls )
   {
   SHOW_PARSE
     {
     SHOW_PARSE_HEADER
     char ach[64];
-    snprintf  (ach, sizeof(ach),
+    snprintf( ach, sizeof(ach),
               " yylineno %d first/last %d/%d",
               yylineno,
               cobol_location().first_line,
               cobol_location().last_line );
     SHOW_PARSE_TEXT(ach);
+    if( true || ecs || dcls )
+      {
+      SHOW_PARSE_INDENT
+      snprintf( ach, sizeof(ach),
+                "Sending ecs/dcls %p / %p", ecs, dcls);
+      SHOW_PARSE_TEXT(ach);
+      }
     SHOW_PARSE_END
     }
-
+  TRACE1
+    {
+    TRACE1_HEADER
+    char ach[64];
+    snprintf(ach, sizeof(ach), " ecs/dcls %p / %p", ecs, dcls);
+    TRACE1_TEXT_ABC("", ach, "");
+    TRACE1_END
+    }
 
   if( gg_get_current_line_number() == DEFAULT_LINE_NUMBER )
     {
-    // This code is prevents anomolies when the first line of a program is
-    // a PERFORM <proc> ... TEST AFTER ... UNTIL ...
+    // This code is intended to prevert GDB anomalies when the first line of a
+    // program is a PERFORM <proc> ... TEST AFTER ... UNTIL ...
     gg_set_current_line_number(CURRENT_LINE_NUMBER-1);
     gg_assign(var_decl_nop, build_int_cst_type(INT, 106));
     }
 
+  store_location_stuff(statement_name);
   gg_set_current_line_number(CURRENT_LINE_NUMBER);
+
+  gg_call(VOID,
+          "__gg__set_exception_environment",
+          ecs  ? gg_get_address_of(ecs) : null_pointer_node,
+          dcls ? gg_get_address_of(dcls) : null_pointer_node,
+          NULL_TREE);
+  
+  gcc_assert( gg_trans_unit.function_stack.size() );
   }
 
 static void
@@ -1130,7 +1265,7 @@ initialize_variable_internal( cbl_refer_t refer,
     gg_call(VOID,
             "__gg__initialize_variable",
             gg_get_address_of(refer.field->var_decl_node),
-            refer_offset_dest(refer),
+            refer_offset(refer),
             build_int_cst_type(INT, flag_bits),
             NULL_TREE);
     }
@@ -1823,12 +1958,12 @@ compare_binary_binary(tree return_int,
   get_binary_value(left_side,
                    NULL,
                    left_side_ref->field,
-                   refer_offset_source(*left_side_ref),
+                   refer_offset(*left_side_ref),
                    hilo_left);
   get_binary_value(right_side,
                    NULL,
                    right_side_ref->field,
-                   refer_offset_source(*right_side_ref),
+                   refer_offset(*right_side_ref),
                    hilo_right);
   IF( hilo_left, eq_op, integer_one_node )
     {
@@ -2002,7 +2137,7 @@ cobol_compare(  tree return_int,
                           "__gg__literaln_alpha_compare",
                           gg_string_literal(buffer),
                           gg_get_address_of(righty->field->var_decl_node),
-                          refer_offset_source(*righty),
+                          refer_offset(*righty),
                           refer_size_source(  *righty),
                           build_int_cst_type(INT,
                                         (righty->all ? REFER_T_MOVE_ALL : 0)),
@@ -2075,11 +2210,11 @@ cobol_compare(  tree return_int,
                 INT,
                 "__gg__compare",
                 gg_get_address_of(left_side_ref.field->var_decl_node),
-                refer_offset_source(left_side_ref),
+                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_source(right_side_ref),
+                refer_offset(right_side_ref),
                 refer_size_source(  right_side_ref),
                 build_int_cst_type(INT, rightflags),
                 integer_zero_node,
@@ -2445,8 +2580,8 @@ paragraph_label(struct cbl_proc_t *procedure)
   char *section_name = section ? section->name : nullptr;
 
   size_t deconflictor = symbol_label_id(procedure->label);
-  
-  char *psz1 = 
+
+  char *psz1 =
   xasprintf(
           "%s PARAGRAPH %s of %s in %s (" HOST_SIZE_T_PRINT_DEC ")",
           ASM_COMMENT_START,
@@ -2454,7 +2589,6 @@ paragraph_label(struct cbl_proc_t *procedure)
           section_name ? section_name: "(null)" ,
           current_function->our_unmangled_name ? current_function->our_unmangled_name: "" ,
           (fmt_size_t)deconflictor );
-  
   gg_insert_into_assembler(psz1);
 
   SHOW_PARSE
@@ -2940,7 +3074,7 @@ parser_goto( cbl_refer_t value_ref, size_t narg, cbl_label_t * const labels[] )
     get_binary_value( value,
                       NULL,
                       value_ref.field,
-                      refer_offset_source(value_ref));
+                      refer_offset(value_ref));
     // Convert it from one-based to zero-based:
     gg_decrement(value);
     // Check to see if the value is in the range 0...narg-1:
@@ -3130,7 +3264,7 @@ parser_perform_times( cbl_label_t *proc_1, cbl_refer_t count )
   get_binary_value( counter,
                     NULL,
                     count.field,
-                    refer_offset_source(count));
+                    refer_offset(count));
 
   // Make sure the initial count is valid:
   WHILE( counter, gt_op, gg_cast(LONG, integer_zero_node) )
@@ -3278,7 +3412,7 @@ internal_perform_through_times(   cbl_label_t *proc_1,
   get_binary_value( counter,
                     NULL,
                     count.field,
-                    refer_offset_source(count));
+                    refer_offset(count));
   WHILE( counter, gt_op, gg_cast(LONG, integer_zero_node) )
     {
     internal_perform_through(proc_1, proc_2, true); // true means suppress_nexting
@@ -3419,8 +3553,6 @@ parser_enter_file(const char *filename)
   A = gg_declare_variable(B, C, NULL_TREE, vs_external_reference)
 
     SET_VAR_DECL(var_decl_exception_code         , INT    , "__gg__exception_code");
-    SET_VAR_DECL(var_decl_exception_handled      , INT    , "__gg__exception_handled");
-    SET_VAR_DECL(var_decl_exception_file_number  , INT    , "__gg__exception_file_number");
     SET_VAR_DECL(var_decl_exception_file_status  , INT    , "__gg__exception_file_status");
     SET_VAR_DECL(var_decl_exception_file_name    , CHAR_P , "__gg__exception_file_name");
     SET_VAR_DECL(var_decl_exception_statement    , CHAR_P , "__gg__exception_statement");
@@ -4002,6 +4134,11 @@ psa_FldLiteralN(struct cbl_field_t *field )
                                           vs_static);
   DECL_INITIAL(new_var_decl) = wide_int_to_tree(var_type, value);
   field->data_decl_node = new_var_decl;
+
+  // Note that during compilation, the integer value, assuming it can be
+  // contained in 128-bit integers, can be accessed with
+  //
+  //  wi::to_wide( DECL_INITIAL(new_var_decl) )
   }
 
 static void
@@ -4110,7 +4247,7 @@ parser_accept(  struct cbl_refer_t refer,
           "__gg__accept",
           environment,
           gg_get_address_of(refer.field->var_decl_node),
-          refer_offset_dest(refer),
+          refer_offset(refer),
           refer_size_dest(refer),
           NULL_TREE);
   }
@@ -4201,7 +4338,7 @@ parser_accept_command_line( cbl_refer_t tgt,
               gg_call_expr( INT,
                             "__gg__get_command_line",
                             gg_get_address_of(tgt.field->var_decl_node),
-                            refer_offset_dest(tgt),
+                            refer_offset(tgt),
                             refer_size_dest(tgt),
                             NULL_TREE));
     if( error )
@@ -4248,10 +4385,10 @@ parser_accept_command_line( cbl_refer_t tgt,
               gg_call_expr(  INT,
                             "__gg__get_argv",
                             gg_get_address_of(tgt.field->var_decl_node),
-                            refer_offset_dest(tgt),
+                            refer_offset(tgt),
                             refer_size_dest(tgt),
                             gg_get_address_of(source.field->var_decl_node),
-                            refer_offset_dest(source),
+                            refer_offset(source),
                             refer_size_dest(source),
                             NULL_TREE));
     if( error )
@@ -4331,7 +4468,7 @@ parser_accept_command_line_count( cbl_refer_t tgt )
   gg_call(  VOID,
             "__gg__get_argc",
             gg_get_address_of(tgt.field->var_decl_node),
-            refer_offset_dest(tgt),
+            refer_offset(tgt),
             refer_size_dest(tgt),
             NULL_TREE);
   }
@@ -4369,10 +4506,10 @@ parser_accept_envar(struct cbl_refer_t tgt,
             gg_call_expr( INT,
                           "__gg__accept_envar",
                           gg_get_address_of(tgt.field->var_decl_node),
-                          refer_offset_dest(tgt),
+                          refer_offset(tgt),
                           refer_size_dest(tgt),
                           gg_get_address_of(envar.field->var_decl_node),
-                          refer_offset_source(envar),
+                          refer_offset(envar),
                           refer_size_source(envar),
                           NULL_TREE));
   if( error )
@@ -4441,10 +4578,10 @@ parser_set_envar( struct cbl_refer_t name, struct cbl_refer_t value )
   gg_call(BOOL,
           "__gg__set_envar",
           gg_get_address_of(name.field->var_decl_node),
-          refer_offset_source(name),
+          refer_offset(name),
           refer_size_source(name),
           gg_get_address_of(value.field->var_decl_node),
-          refer_offset_source(value),
+          refer_offset(value),
           refer_size_source(value),
           NULL_TREE);
   }
@@ -4941,7 +5078,7 @@ parser_display_internal(tree file_descriptor,
       gg_call(VOID,
               "__gg__display",
               gg_get_address_of(refer.field->var_decl_node),
-              refer_offset_source(refer),
+              refer_offset(refer),
               refer_size_source(  refer),
               file_descriptor,
               advance ? integer_one_node : integer_zero_node,
@@ -5675,7 +5812,7 @@ parser_initialize_table(size_t nelem,
           "__gg__mirror_range",
           build_int_cst_type(SIZE_T, nelem),
           gg_get_address_of(src.field->var_decl_node),
-          refer_offset_source(src),
+          refer_offset(src),
           build_int_cst_type(SIZE_T, nspan),
           tspans,
           build_int_cst_type(SIZE_T, table),
@@ -5831,13 +5968,13 @@ void parser_sleep(cbl_refer_t seconds)
   if( seconds.field )
     {
     gg_get_address_of(seconds.field->var_decl_node);
-    //refer_offset_source(seconds);
+    //refer_offset(seconds);
     //refer_size_source(seconds);
 
     gg_call(VOID,
             "__gg__sleep",
             gg_get_address_of(seconds.field->var_decl_node),
-            refer_offset_source(seconds),
+            refer_offset(seconds),
             refer_size_source(seconds),
             NULL_TREE);
     }
@@ -6145,14 +6282,14 @@ parser_allocate(cbl_refer_t size_or_based,
   gg_call(VOID,
           "__gg__allocate",
           gg_get_address_of(size_or_based.field->var_decl_node),
-          refer_offset_source(size_or_based) ,
+          refer_offset(size_or_based) ,
           initialized ? integer_one_node : integer_zero_node,
           build_int_cst_type(INT, default_byte),
           f_working ? gg_get_address_of(f_working->var_decl_node) : null_pointer_node,
           f_local   ? gg_get_address_of(f_local->  var_decl_node) : null_pointer_node,
           returning.field ? gg_get_address_of(returning.field->var_decl_node)
                           : null_pointer_node,
-          returning.field ? refer_offset_source(returning)
+          returning.field ? refer_offset(returning)
                           : size_t_zero_node,
           NULL_TREE);
   walk_initialization(size_or_based.field, initialized, false);
@@ -6178,7 +6315,7 @@ parser_free( size_t n, cbl_refer_t refers[] )
     gg_call(VOID,
             "__gg__deallocate",
             gg_get_address_of(p->field->var_decl_node),
-            refer_offset_source(*p),
+            refer_offset(*p),
             p->addr_of ? integer_one_node : integer_zero_node,
             NULL_TREE);
     walk_initialization(p->field, false, true);
@@ -6681,9 +6818,9 @@ parser_division(cbl_division_t division,
 
           if( args[i].refer.field->attr & any_length_e )
             {
-            // gg_printf("side channel: Length of \"%s\" is %ld\n", 
+            // gg_printf("side channel: Length of \"%s\" is %ld\n",
                       // member(args[i].refer.field->var_decl_node, "name"),
-                      // gg_array_value(var_decl_call_parameter_lengths, rt_i), 
+                      // gg_array_value(var_decl_call_parameter_lengths, rt_i),
                       // NULL_TREE);
 
             // Get the length from the global lengths[] side channel.  Don't
@@ -7161,7 +7298,7 @@ parser_relop_long(cbl_field_t *tgt,
   get_binary_value( tree_b,
                     NULL,
                     bref.field,
-                    refer_offset_source(bref) );
+                    refer_offset(bref) );
 
   static tree comp_res = gg_define_variable(LONG, "..prl_comp_res", vs_file_static);
   gg_assign(comp_res, gg_subtract(tree_a, tree_b));
@@ -7283,7 +7420,7 @@ parser_see_stop_run(struct cbl_refer_t exit_status,
     get_binary_value( returned_value,
                       NULL,
                       exit_status.field,
-                      refer_offset_source(exit_status));
+                      refer_offset(exit_status));
     TRACE1
       {
       TRACE1_REFER(" exit_status ", exit_status, "")
@@ -7498,7 +7635,7 @@ parser_classify(    cbl_field_t *tgt,
                            "__gg__classify",
                            build_int_cst_type(INT, type),
                            gg_get_address_of(candidate.field->var_decl_node),
-                           refer_offset_dest(candidate),
+                           refer_offset(candidate),
                            refer_size_dest(candidate),
                            NULL_TREE),
               ne_op,
@@ -9022,10 +9159,13 @@ parser_file_add(struct cbl_file_t *file)
           __func__);
     }
 
+  size_t symbol_table_index = symbol_index(symbol_elem_of(file));
+
   gg_call(VOID,
           "__gg__file_init",
           gg_get_address_of(new_var_decl),
           gg_string_literal(file->name),
+          build_int_cst_type(SIZE_T, symbol_table_index),
           array_of_keys,
           key_numbers,
           unique_flags,
@@ -9046,8 +9186,6 @@ parser_file_add(struct cbl_file_t *file)
   file->var_decl_node = new_var_decl;
   }
 
-static void store_location_stuff(const cbl_name_t statement_name);
-
 void
 parser_file_open( size_t nfiles, struct cbl_file_t *files[], int mode_char )
   {
@@ -9378,7 +9516,7 @@ parser_file_write( cbl_file_t *file,
     get_binary_value( value,
                       NULL,
                       advance.field,
-                      refer_offset_source(advance));
+                      refer_offset(advance));
     gg_assign(t_advance, gg_cast(INT, value));
     }
   else
@@ -9635,7 +9773,7 @@ parser_file_start(struct cbl_file_t *file,
     get_binary_value( length,
                       NULL,
                       length_ref.field,
-                      refer_offset_dest(length_ref));
+                      refer_offset(length_ref));
     }
 
   store_location_stuff("START");
@@ -10054,27 +10192,27 @@ parser_inspect_conv(cbl_refer_t input,
           backward ? integer_one_node : integer_zero_node,
           input.field ? gg_get_address_of(input.field->var_decl_node)
                       : null_pointer_node,
-          refer_offset_source(input),
+          refer_offset(input),
           refer_size_source(input),
           original.field ? gg_get_address_of(original.field->var_decl_node)
                          : null_pointer_node,
-          refer_offset_dest(original),
+          refer_offset(original),
           refer_size_dest(original),
           replacement.field ? gg_get_address_of(
                               replacement.field->var_decl_node)
                             : null_pointer_node,
-          refer_offset_source(replacement),
+          refer_offset(replacement),
           replacement.all ? build_int_cst_type(SIZE_T, -1LL)
                           : refer_size_source(replacement),
           after.identifier_4.field ? gg_get_address_of(
                                         after.identifier_4.field->var_decl_node)
                                    : null_pointer_node,
-          refer_offset_source(after.identifier_4),
+          refer_offset(after.identifier_4),
           refer_size_source(after.identifier_4),
           before.identifier_4.field ? gg_get_address_of(
                                        before.identifier_4.field->var_decl_node)
                                     : null_pointer_node,
-          refer_offset_source(before.identifier_4),
+          refer_offset(before.identifier_4),
           refer_size_source(before.identifier_4),
           NULL_TREE
           );
@@ -10124,10 +10262,10 @@ parser_intrinsic_numval_c( cbl_field_t *f,
             "__gg__test_numval_c",
             gg_get_address_of(f->var_decl_node),
             gg_get_address_of(input.field->var_decl_node),
-            refer_offset_source(input),
+            refer_offset(input),
             refer_size_source(input),
             currency.field ? gg_get_address_of(currency.field->var_decl_node) : null_pointer_node,
-            refer_offset_source(currency),
+            refer_offset(currency),
             refer_size_source(currency),
             NULL_TREE
             );
@@ -10138,10 +10276,10 @@ parser_intrinsic_numval_c( cbl_field_t *f,
             "__gg__numval_c",
             gg_get_address_of(f->var_decl_node),
             gg_get_address_of(input.field->var_decl_node),
-            refer_offset_source(input),
+            refer_offset(input),
             refer_size_source(input),
             currency.field ? gg_get_address_of(currency.field->var_decl_node) : null_pointer_node,
-            refer_offset_source(currency),
+            refer_offset(currency),
             refer_size_source(currency),
             NULL_TREE
             );
@@ -10199,7 +10337,7 @@ parser_intrinsic_subst( cbl_field_t *f,
           "__gg__substitute",
           gg_get_address_of(f->var_decl_node),
           gg_get_address_of(ref1.field->var_decl_node),
-          refer_offset_source(ref1),
+          refer_offset(ref1),
           refer_size_source(ref1),
           build_int_cst_type(SIZE_T, argc),
           control,
@@ -10421,7 +10559,7 @@ parser_intrinsic_call_1( cbl_field_t *tgt,
             function_name,
             gg_get_address_of(tgt->var_decl_node),
             gg_get_address_of(ref1.field->var_decl_node),
-            refer_offset_source(ref1),
+            refer_offset(ref1),
             refer_size_source(ref1),
             NULL_TREE);
     }
@@ -10464,10 +10602,10 @@ parser_intrinsic_call_2( cbl_field_t *tgt,
           function_name,
           gg_get_address_of(tgt->var_decl_node),
           gg_get_address_of(ref1.field->var_decl_node),
-          refer_offset_source(ref1),
+          refer_offset(ref1),
           refer_size_source(ref1),
           ref2.field ? gg_get_address_of(ref2.field->var_decl_node) : null_pointer_node,
-          refer_offset_source(ref2),
+          refer_offset(ref2),
           refer_size_source(ref2),
           NULL_TREE);
   TRACE1
@@ -10514,13 +10652,13 @@ parser_intrinsic_call_3( cbl_field_t *tgt,
           function_name,
           gg_get_address_of(tgt->var_decl_node),
           ref1.field ? gg_get_address_of(ref1.field->var_decl_node) : null_pointer_node,
-          refer_offset_source(ref1),
+          refer_offset(ref1),
           refer_size_source(ref1),
           ref2.field ? gg_get_address_of(ref2.field->var_decl_node) : null_pointer_node,
-          refer_offset_source(ref2),
+          refer_offset(ref2),
           refer_size_source(ref2),
           ref3.field ? gg_get_address_of(ref3.field->var_decl_node) : null_pointer_node,
-          refer_offset_source(ref3),
+          refer_offset(ref3),
           refer_size_source(ref3),
           NULL_TREE);
   TRACE1
@@ -10569,16 +10707,16 @@ parser_intrinsic_call_4( cbl_field_t *tgt,
           function_name,
           gg_get_address_of(tgt->var_decl_node),
           ref1.field ? gg_get_address_of(ref1.field->var_decl_node) : null_pointer_node,
-          refer_offset_source(ref1),
+          refer_offset(ref1),
           refer_size_source(ref1),
           ref2.field ? gg_get_address_of(ref2.field->var_decl_node) : null_pointer_node,
-          refer_offset_source(ref2),
+          refer_offset(ref2),
           refer_size_source(ref2),
           ref3.field ? gg_get_address_of(ref3.field->var_decl_node) : null_pointer_node,
-          refer_offset_source(ref3),
+          refer_offset(ref3),
           refer_size_source(ref3),
           ref4.field ? gg_get_address_of(ref4.field->var_decl_node) : null_pointer_node,
-          refer_offset_source(ref4),
+          refer_offset(ref4),
           refer_size_source(ref4),
           NULL_TREE);
   TRACE1
@@ -11207,7 +11345,7 @@ parser_sort(cbl_refer_t tableref,
   gg_call(VOID,
           "__gg__sort_table",
           gg_get_address_of(tableref.field->var_decl_node),
-          refer_offset_source(tableref),
+          refer_offset(tableref),
           gg_cast(SIZE_T, depending_on),
           build_int_cst_type(SIZE_T, key_index),
           all_keys,
@@ -11503,7 +11641,13 @@ parser_return_start( cbl_file_t *workfile, cbl_refer_t into )
 
   IF( member(workfile, "io_status"), lt_op, build_int_cst(INT, FsKeySeq) )
     {
-    // The read didn't succeed because of an end-of-file condition
+    // The read didn't succeed because of an end-of-file condition.
+
+    // Because there is an AT END clause, we suppress the error condition that
+    // was raised.
+    gg_assign(var_decl_exception_code, integer_zero_node);
+
+    // And then we jump to the at_end code:
     gg_append_statement(workfile->addresses->at_end.go_to);
     }
   ELSE
@@ -11931,16 +12075,16 @@ parser_unstring(cbl_refer_t src,
             gg_call_expr( INT,
                           "__gg__unstring",
                           gg_get_address_of(src.field->var_decl_node),
-                          refer_offset_source(src),
+                          refer_offset(src),
                           refer_size_source(src),
                           build_int_cst_type(SIZE_T, ndelimited),
                           t_alls,
                           build_int_cst_type(SIZE_T, noutputs),
                           pointer.field ? gg_get_address_of(pointer.field->var_decl_node) : null_pointer_node,
-                          refer_offset_dest(pointer),
+                          refer_offset(pointer),
                           refer_size_dest(pointer),
                           tally.field ? gg_get_address_of(tally.field->var_decl_node) : null_pointer_node,
-                          refer_offset_dest(tally),
+                          refer_offset(tally),
                           refer_size_dest(tally),
                           NULL_TREE)
                           );
@@ -12207,7 +12351,7 @@ create_and_call(size_t narg,
     else
       {
       gg_assign(location,
-                qualified_data_source(args[i].refer)),
+                qualified_data_location(args[i].refer)),
       gg_assign(length,
                 refer_size_source(args[i].refer));
       }
@@ -12336,7 +12480,7 @@ create_and_call(size_t narg,
                                 INT128,
                                 "__gg__fetch_call_by_value_value",
                                 gg_get_address_of(args[i].refer.field->var_decl_node),
-                                refer_offset_source(args[i].refer),
+                                refer_offset(args[i].refer),
                                 refer_size_source(args[i].refer),
                                 NULL_TREE)));
               }
@@ -12349,7 +12493,7 @@ create_and_call(size_t narg,
                                 INT128,
                                 "__gg__fetch_call_by_value_value",
                                 gg_get_address_of(args[i].refer.field->var_decl_node),
-                                refer_offset_source(args[i].refer),
+                                refer_offset(args[i].refer),
                                 refer_size_source(args[i].refer),
                                 NULL_TREE)));
               }
@@ -12398,7 +12542,7 @@ create_and_call(size_t narg,
       // we were given a returned::field, so find its location and length:
       gg_assign(returned_location,
                 gg_add( member(returned.field->var_decl_node, "data"),
-                        refer_offset_dest(returned)));
+                        refer_offset(returned)));
       gg_assign(returned_length,
                 gg_cast(TREE_TYPE(returned_length), refer_size_dest(returned)));
 
@@ -12418,7 +12562,7 @@ create_and_call(size_t narg,
         {
         // There is a valid pointer.  Do the assignment.
         move_tree(returned.field,
-                  refer_offset_dest(returned),
+                  refer_offset(returned),
                   returned_value,
                   integer_one_node);
         }
@@ -12442,7 +12586,7 @@ create_and_call(size_t narg,
       gg_call(VOID,
               "__gg__int128_to_qualified_field",
               gg_get_address_of(returned.field->var_decl_node),
-              refer_offset_dest(returned),
+              refer_offset(returned),
               refer_size_dest(returned),
               gg_cast(INT128, returned_value),
               gg_cast(INT, member(returned.field->var_decl_node, "rdigits")),
@@ -12464,7 +12608,7 @@ create_and_call(size_t narg,
       tree returned_length   = gg_define_size_t();
       // we were given a returned::field, so find its location and length:
       gg_assign(returned_location,
-                qualified_data_source(returned));
+                qualified_data_location(returned));
       gg_assign(returned_length,
                 refer_size_source(returned));
 
@@ -12879,7 +13023,7 @@ parser_set_pointers( size_t ntgt, cbl_refer_t *tgts, cbl_refer_t source )
       // This is something like SET varp TO ENTRY "ref".
       tree function_handle = function_handle_from_name(source,
                                                    COBOL_FUNCTION_RETURN_TYPE);
-      gg_memcpy(qualified_data_dest(tgts[i]),
+      gg_memcpy(qualified_data_location(tgts[i]),
                 gg_get_address_of(function_handle),
                 sizeof_pointer);
       }
@@ -12899,10 +13043,10 @@ parser_set_pointers( size_t ntgt, cbl_refer_t *tgts, cbl_refer_t source )
       gg_call(  VOID,
                 "__gg__set_pointer",
                 gg_get_address_of(tgts[i].field->var_decl_node),
-                refer_offset_dest(tgts[i]),
+                refer_offset(tgts[i]),
                 build_int_cst_type(INT, tgts[i].addr_of  ? REFER_T_ADDRESS_OF : 0),
                 source.field ? gg_get_address_of(source.field->var_decl_node) : null_pointer_node,
-                refer_offset_source(source),
+                refer_offset(source),
                 build_int_cst_type(INT, source.addr_of  ? REFER_T_ADDRESS_OF : 0),
                 NULL_TREE
                 );
@@ -12976,11 +13120,11 @@ void
 parser_program_hierarchy( const struct cbl_prog_hier_t& hier )
   {
   Analyze();
-  /*  The complication in this routine is that it gets called near the end
-      of every program-id.  And it keeps growing.  The reason is because the
-      parser doesn't know when it is working on the last program of a list of
-      nested programs.  So, we just do what we need to do, and we keep track
-      of what we've already built so that we don't build it more than once.
+  /*  This routine gets called near the end of every program-id.  It keeps
+      growing because the parser doesn't know when it is working on the last
+      program of a list of nested programs.  So, we just do what we need to do,
+      and we keep track of what we've already built so that we don't build it
+      more than once.
       */
   SHOW_PARSE
     {
@@ -13205,73 +13349,6 @@ parser_program_hierarchy( const struct cbl_prog_hier_t& hier )
   }
 
 void
-parser_set_handled(ec_type_t ec_handled)
-  {
-  if( mode_syntax_only() ) return;
-  SHOW_PARSE
-    {
-    SHOW_PARSE_HEADER
-    char ach[64];
-    sprintf(ach, "ec_type_t: 0x" HOST_SIZE_T_PRINT_HEX_PURE,
-            (fmt_size_t)ec_handled);
-    SHOW_PARSE_TEXT(ach);
-    SHOW_PARSE_END
-    }
-
-  TRACE1
-    {
-    TRACE1_HEADER
-    TRACE1_END
-    }
-
-  if( gg_trans_unit.function_stack.size() )
-    {
-    if( ec_handled )
-      {
-      // We assume that exception_handled is zero, always.  We only make it
-      // non-zero when something needs to be done.  __gg__match_exception is
-      // in charge of setting it back to zero.
-      gg_assign(var_decl_exception_handled,
-                build_int_cst_type(INT, (int)ec_handled));
-      }
-    }
-  else
-    {
-    yywarn("parser_set_handled() called between programs");
-    }
-  }
-
-void
-parser_set_file_number(int file_number)
-  {
-  if( mode_syntax_only() ) return;
-  SHOW_PARSE
-    {
-    SHOW_PARSE_HEADER
-    char ach[32];
-    sprintf(ach, "file number: %d", file_number);
-    SHOW_PARSE_TEXT(ach);
-    SHOW_PARSE_END
-    }
-
-  TRACE1
-    {
-    TRACE1_HEADER
-    TRACE1_END
-    }
-
-  if( gg_trans_unit.function_stack.size() )
-    {
-    gg_assign(var_decl_exception_file_number,
-              build_int_cst_type(INT, file_number));
-    }
-  else
-    {
-    yywarn("parser_set_file_number() called between programs");
-    }
-  }
-
-void
 parser_set_numeric(struct cbl_field_t *tgt, ssize_t value)
   {
   Analyze();
@@ -13298,110 +13375,6 @@ parser_set_numeric(struct cbl_field_t *tgt, ssize_t value)
   }
 
 static void
-stash_exceptions( const cbl_enabled_exceptions_array_t *enabled )
-  {
-  // We need to create a static array of bytes
-  size_t nec = enabled->nec;
-  size_t sz = int_size_in_bytes(cbl_enabled_exception_type_node);
-  size_t narg = nec * sz;
-  cbl_enabled_exception_t *p = enabled->ecs;
-
-  static size_t prior_nec = 0;
-  static size_t max_nec   = 0;
-  static cbl_enabled_exception_t *prior_p;
-
-  bool we_got_new_data = false;
-  if( prior_nec != nec )
-    {
-    we_got_new_data = true;
-    }
-  else
-    {
-    // The nec counts are the same.
-    for(size_t i=0; i<nec; i++)
-      {
-      if( p[i].enabled != prior_p[i].enabled
-          || p[i].location != prior_p[i].location
-          || p[i].ec != prior_p[i].ec
-          || p[i].file != prior_p[i].file )
-        {
-        we_got_new_data = true;
-        break;
-        }
-      }
-    }
-
-  if( !we_got_new_data )
-    {
-    return;
-    }
-
-  if( nec > max_nec )
-    {
-    max_nec = nec;
-    prior_p = (cbl_enabled_exception_t *)
-              xrealloc(prior_p, max_nec * sizeof(cbl_enabled_exception_t));
-    }
-
-  memcpy((unsigned char *)prior_p, (unsigned char *)p,
-         nec * sizeof(cbl_enabled_exception_t));
-
-  static int count = 1;
-
-  tree array_of_chars_type;
-  tree array_of_chars;
-
-  if( narg )
-    {
-    char ach[32];
-    sprintf(ach, "_ec_array_%d", count++);
-    array_of_chars_type = build_array_type_nelts(UCHAR, narg);
-
-    // We have the array.  Now we need to build the constructor for it
-    tree constr = make_node(CONSTRUCTOR);
-    TREE_TYPE(constr) = array_of_chars_type;
-    TREE_STATIC(constr)    = 1;
-    TREE_CONSTANT(constr)  = 1;
-    unsigned char *q = XALLOCAVEC(unsigned char, sz);
-
-    for(size_t i=0; i<nec; i++)
-      {
-      memset(q, '\0', sz);
-      tree enabled = constant_boolean_node(p[i].enabled, BOOL);
-      tree location = constant_boolean_node(p[i].location, BOOL);
-      tree ec = build_int_cst(UINT, p[i].ec);
-      tree file = build_int_cst(SIZE_T, p[i].file);
-      tree fld = TYPE_FIELDS(cbl_enabled_exception_type_node);
-      native_encode_expr(enabled, q + tree_to_uhwi(byte_position(fld)),
-                         int_size_in_bytes(BOOL));
-      fld = TREE_CHAIN(fld);
-      native_encode_expr(location, q + tree_to_uhwi(byte_position(fld)),
-                         int_size_in_bytes(BOOL));
-      fld = TREE_CHAIN(fld);
-      native_encode_expr(ec, q + tree_to_uhwi(byte_position(fld)),
-                         int_size_in_bytes(UINT));
-      fld = TREE_CHAIN(fld);
-      native_encode_expr(file, q + tree_to_uhwi(byte_position(fld)),
-                         int_size_in_bytes(SIZE_T));
-      for(size_t j=0; j<sz; j++)
-        {
-        CONSTRUCTOR_APPEND_ELT( CONSTRUCTOR_ELTS(constr),
-                                build_int_cst_type(SIZE_T, i*sz + j),
-                                build_int_cst_type(UCHAR, q[j]));
-        }
-      }
-    array_of_chars = gg_define_variable(array_of_chars_type, ach, vs_static);
-    DECL_INITIAL(array_of_chars) = constr;
-
-    gg_call(VOID,
-            "__gg__stash_exceptions",
-            build_int_cst_type(SIZE_T, enabled->nec),
-            narg ? gg_get_address_of(array_of_chars) : null_pointer_node,
-            NULL_TREE);
-    }
-  }
-
-static void
 store_location_stuff(const cbl_name_t statement_name)
   {
   if( exception_location_active && !current_declarative_section_name() )
@@ -13446,39 +13419,6 @@ store_location_stuff(const cbl_name_t statement_name)
   }
 
 void
-parser_exception_prepare( const cbl_name_t statement_name,
-                          const cbl_enabled_exceptions_array_t *enabled )
-  {
-  Analyze();
-  SHOW_PARSE
-    {
-    SHOW_PARSE_HEADER
-    SHOW_PARSE_TEXT(enabled->nec? " stashing " : " skipping ")
-    SHOW_PARSE_TEXT(statement_name)
-    SHOW_PARSE_END
-    }
-
-  TRACE1
-    {
-    TRACE1_HEADER
-    TRACE1_END
-    }
-
-  if( enabled->nec )
-    {
-    if( gg_trans_unit.function_stack.size() )
-      {
-      stash_exceptions(enabled);
-      store_location_stuff(statement_name);
-      }
-    else
-      {
-      yywarn("parser_exception_prepare() called between programs");
-      }
-    }
-  }
-
-void
 parser_exception_clear()
   {
   if( mode_syntax_only() ) return;
@@ -13506,8 +13446,7 @@ parser_exception_raise(ec_type_t ec)
   }
 
 void
-parser_match_exception(cbl_field_t *index,
-                       cbl_field_t *blob )
+parser_match_exception(cbl_field_t *index)
   {
   Analyze();
   SHOW_PARSE
@@ -13515,14 +13454,6 @@ parser_match_exception(cbl_field_t *index,
     SHOW_PARSE_HEADER
     SHOW_PARSE_FIELD(" index   ", index)
     SHOW_PARSE_INDENT
-    if( blob )
-      {
-      SHOW_PARSE_FIELD("blob    ", blob)
-      }
-    else
-      {
-      SHOW_PARSE_TEXT("blob    is NULL")
-      }
     SHOW_PARSE_END
     }
 
@@ -13531,22 +13462,12 @@ parser_match_exception(cbl_field_t *index,
     TRACE1_HEADER
     TRACE1_FIELD("index   ", index, "")
     TRACE1_INDENT
-    TRACE1_TEXT("blob    ")
-    if( blob )
-      {
-      TRACE1_TEXT(blob->name)
-      }
-    else
-      {
-      TRACE1_TEXT("is NULL")
-      }
     TRACE1_END
     }
 
   gg_call(VOID,
           "__gg__match_exception",
           gg_get_address_of(index->var_decl_node),
-          blob ? blob->var_decl_node : null_pointer_node,
           NULL_TREE);
 
   TRACE1
@@ -13569,12 +13490,31 @@ parser_check_fatal_exception()
     SHOW_PARSE_TEXT(" Check for fatal EC...")
     SHOW_PARSE_END
     }
-  gg_call(VOID,
-          "__gg__check_fatal_exception",
-          NULL_TREE);
+  TRACE1
+    {
+    TRACE1_HEADER
+    TRACE1_TEXT(" Check for fatal EC...")
+    TRACE1_END
+    }
+
+    gg_call(VOID,
+            "__gg__check_fatal_exception",
+            NULL_TREE);
   }
 
 void
+parser_push_exception()
+  {
+  gg_call(VOID, "__gg__exception_push", NULL_TREE);
+  }
+
+void
+parser_pop_exception()
+  {
+  gg_call(VOID, "__gg__exception_pop", NULL_TREE);
+  }
+  
+void
 parser_clear_exception()
   {
   Analyze();
@@ -13736,7 +13676,7 @@ mh_identical(cbl_refer_t &destref,
         SHOW_PARSE_TEXT("mh_identical()");
         }
       gg_memcpy(gg_add(member(destref.field->var_decl_node,   "data"),
-                       refer_offset_dest(destref)),
+                       refer_offset(destref)),
                 gg_add(member(sourceref.field->var_decl_node, "data"),
                        tsource.offset),
                 build_int_cst_type(SIZE_T, sourceref.field->data.capacity));
@@ -13777,7 +13717,7 @@ mh_source_is_literalN(cbl_refer_t &destref,
         gg_call(VOID,
                 "__gg__psz_to_alpha_move",
                 gg_get_address_of(destref.field->var_decl_node),
-                refer_offset_dest(destref),
+                refer_offset(destref),
                 refer_size_dest(destref),
                 gg_string_literal(buffer),
                 build_int_cst_type(SIZE_T, strlen(sourceref.field->data.initial)),
@@ -13815,13 +13755,13 @@ mh_source_is_literalN(cbl_refer_t &destref,
               {
               // We are dealing with a negative number
               gg_memset(gg_add(member(destref.field->var_decl_node, "data"),
-                               refer_offset_dest(destref)),
+                               refer_offset(destref)),
                                 build_int_cst_type(UCHAR, 0xFF),
                                 build_int_cst_type(SIZE_T, 8));
               }
             ELSE
               gg_memset(gg_add(member(destref.field->var_decl_node, "data"),
-                               refer_offset_dest(destref)),
+                               refer_offset(destref)),
                                 build_int_cst_type(UCHAR, 0x00),
                                 build_int_cst_type(SIZE_T, 8));
               ENDIF
@@ -13830,7 +13770,7 @@ mh_source_is_literalN(cbl_refer_t &destref,
             {
             // The too-short source is positive.
               gg_memset(gg_add(member(destref.field->var_decl_node, "data"),
-                               refer_offset_dest(destref)),
+                               refer_offset(destref)),
                               build_int_cst_type(UCHAR, 0x00),
                               build_int_cst_type(SIZE_T, 8));
             }
@@ -13839,7 +13779,7 @@ mh_source_is_literalN(cbl_refer_t &destref,
         tree literalN_value = get_literalN_value(sourceref.field);
         scale_by_power_of_ten_N(literalN_value, -sourceref.field->data.rdigits);
         gg_memcpy(gg_add(member(destref.field->var_decl_node, "data"),
-                               refer_offset_dest(destref)),
+                               refer_offset(destref)),
                   gg_get_address_of(literalN_value),
                   build_int_cst_type(SIZE_T, sourceref.field->data.capacity));
         moved = true;
@@ -13900,7 +13840,7 @@ mh_source_is_literalN(cbl_refer_t &destref,
         tree dest_location = gg_indirect(
                     gg_cast(build_pointer_type(dest_type),
                             gg_add(member(destref.field->var_decl_node, "data"),
-                                   refer_offset_dest(destref))));
+                                   refer_offset(destref))));
         gg_assign(dest_location, gg_cast(dest_type, source));
         moved = true;
         break;
@@ -13929,7 +13869,7 @@ mh_source_is_literalN(cbl_refer_t &destref,
         gg_call(INT,
                 "__gg__int128_to_qualified_field",
                 gg_get_address_of(destref.field->var_decl_node),
-                refer_offset_dest(destref),
+                refer_offset(destref),
                 refer_size_dest(destref),
                 gg_cast(INT128, literalN_value),
                 build_int_cst_type(INT, sourceref.field->data.rdigits),
@@ -13960,7 +13900,7 @@ mh_source_is_literalN(cbl_refer_t &destref,
         gg_call(VOID,
                 "__gg__string_to_alpha_edited_ascii",
                 gg_add( member(destref.field->var_decl_node, "data"),
-                        refer_offset_dest(destref) ),
+                        refer_offset(destref) ),
                 gg_string_literal(sourceref.field->data.initial),
                 build_int_cst_type(INT, strlen(sourceref.field->data.initial)),
                 gg_string_literal(destref.field->data.picture),
@@ -13972,7 +13912,7 @@ mh_source_is_literalN(cbl_refer_t &destref,
       case FldFloat:
         {
         tree tdest = gg_add(member(destref.field->var_decl_node, "data"),
-                            refer_offset_dest(destref) );
+                            refer_offset(destref) );
         switch( destref.field->data.capacity )
           {
           // For some reason, using FLOAT128 in the build_pointer_type causes
@@ -14076,7 +14016,7 @@ mh_dest_is_float( cbl_refer_t &destref,
             gg_call(VOID,
                     "__gg__float32_from_int128",
                     gg_get_address_of(destref.field->var_decl_node),
-                    refer_offset_dest(destref),
+                    refer_offset(destref),
                     tsource.pfield,
                     tsource.offset,
                     build_int_cst_type(INT, rounded),
@@ -14087,7 +14027,7 @@ mh_dest_is_float( cbl_refer_t &destref,
             gg_call(VOID,
                     "__gg__float64_from_int128",
                     gg_get_address_of(destref.field->var_decl_node),
-                    refer_offset_dest(destref),
+                    refer_offset(destref),
                     tsource.pfield,
                     tsource.offset,
                     build_int_cst_type(INT, rounded),
@@ -14098,7 +14038,7 @@ mh_dest_is_float( cbl_refer_t &destref,
             gg_call(VOID,
                     "__gg__float128_from_int128",
                     gg_get_address_of(destref.field->var_decl_node),
-                    refer_offset_dest(destref),
+                    refer_offset(destref),
                     tsource.pfield,
                     tsource.offset,
                     build_int_cst_type(INT, rounded),
@@ -14140,9 +14080,9 @@ mh_dest_is_float( cbl_refer_t &destref,
             tree stype = float_type_of(&sourceref);
 
             tree tdest = gg_add(member(destref.field->var_decl_node, "data"),
-                               refer_offset_dest(destref));
+                               refer_offset(destref));
             tree source = gg_add(member(sourceref.field->var_decl_node, "data"),
-                                refer_offset_source(sourceref));
+                                refer_offset(sourceref));
             gg_assign(gg_indirect(gg_cast(build_pointer_type(dtype), tdest)),
                       gg_cast(dtype,
                               gg_indirect(gg_cast(build_pointer_type(stype),
@@ -14159,7 +14099,7 @@ mh_dest_is_float( cbl_refer_t &destref,
                           gg_call_expr( INT,
                                 "__gg__float64_from_128",
                                 gg_get_address_of(destref.field->var_decl_node),
-                                refer_offset_dest(destref),
+                                refer_offset(destref),
                                 tsource.pfield,
                                 tsource.offset,
                                 NULL_TREE));
@@ -14169,7 +14109,7 @@ mh_dest_is_float( cbl_refer_t &destref,
                           gg_call( INT,
                                 "__gg__float64_from_128",
                                 gg_get_address_of(destref.field->var_decl_node),
-                                refer_offset_dest(destref),
+                                refer_offset(destref),
                                 tsource.pfield,
                                 tsource.offset,
                                 NULL_TREE);
@@ -14186,7 +14126,7 @@ mh_dest_is_float( cbl_refer_t &destref,
                             gg_call_expr( INT,
                                 "__gg__float32_from_64",
                                 gg_get_address_of(destref.field->var_decl_node),
-                                refer_offset_dest(destref),
+                                refer_offset(destref),
                                 tsource.pfield,
                                 tsource.offset,
                                 NULL_TREE));
@@ -14196,7 +14136,7 @@ mh_dest_is_float( cbl_refer_t &destref,
                             gg_call( INT,
                                 "__gg__float32_from_64",
                                 gg_get_address_of(destref.field->var_decl_node),
-                                refer_offset_dest(destref),
+                                refer_offset(destref),
                                 tsource.pfield,
                                 tsource.offset,
                                 NULL_TREE);
@@ -14211,7 +14151,7 @@ mh_dest_is_float( cbl_refer_t &destref,
                             gg_call_expr( INT,
                                 "__gg__float32_from_128",
                                 gg_get_address_of(destref.field->var_decl_node),
-                                refer_offset_dest(destref),
+                                refer_offset(destref),
                                 tsource.pfield,
                                 tsource.offset,
                                 NULL_TREE));
@@ -14221,7 +14161,7 @@ mh_dest_is_float( cbl_refer_t &destref,
                             gg_call( INT,
                                 "__gg__float32_from_128",
                                 gg_get_address_of(destref.field->var_decl_node),
-                                refer_offset_dest(destref),
+                                refer_offset(destref),
                                 tsource.pfield,
                                 tsource.offset,
                                 NULL_TREE);
@@ -14328,7 +14268,7 @@ mh_numeric_display( cbl_refer_t &destref,
     static tree source_p  = gg_define_variable(UCHAR_P, "..mhnd_source", vs_file_static); // The source data pointer
     static tree source_ep = gg_define_variable(UCHAR_P, "..mhnd_source_e", vs_file_static); // When we need an end pointer
 
-    gg_assign(dest_p,   qualified_data_dest(destref));
+    gg_assign(dest_p,   qualified_data_location(destref));
     gg_assign(source_p, gg_add(member(sourceref.field, "data"),
                                tsource.offset));
 
@@ -14668,7 +14608,7 @@ mh_numeric_display( cbl_refer_t &destref,
         if( destref.field->attr & leading_e )
           {
           // The sign bit goes into the first byte:
-          gg_assign(dest_p, qualified_data_dest(destref));
+          gg_assign(dest_p, qualified_data_location(destref));
           }
         else
           {
@@ -14830,7 +14770,7 @@ mh_little_endian( cbl_refer_t &destref,
       // Get binary value from float actually scales the source value to the
       // dest:: rdigits
       copy_little_endian_into_place(destref.field,
-                                    refer_offset_dest(destref),
+                                    refer_offset(destref),
                                     source,
                                     destref.field->data.rdigits,
                                     check_for_error,
@@ -14844,7 +14784,7 @@ mh_little_endian( cbl_refer_t &destref,
                         sourceref.field,
                         tsource.offset);
       copy_little_endian_into_place(destref.field,
-                                    refer_offset_dest(destref),
+                                    refer_offset(destref),
                                     source,
                                     sourceref.field->data.rdigits,
                                     check_for_error,
@@ -14867,7 +14807,7 @@ mh_source_is_group( cbl_refer_t &destref,
     // We are moving a group to a something.  The rule here is just move as
     // many bytes as you can, and, if necessary, fill with spaces
     tree tdest   = gg_add( member(destref.field->var_decl_node, "data"),
-                           refer_offset_dest(destref));
+                           refer_offset(destref));
     tree tsource = gg_add( member(sourceref.field->var_decl_node, "data"),
                            tsrc.offset);
     tree dbytes  = refer_size_dest(destref);
@@ -14935,7 +14875,7 @@ move_helper(tree size_error,        // This is an INT
       stash_size = destref.field->data.capacity;
       gg_assign(stash, gg_cast(UCHAR_P, gg_realloc(stash, stash_size)));
       }
-    st_data = qualified_data_dest(destref);
+    st_data = qualified_data_location(destref);
     st_size = refer_size_dest(destref);
     gg_memcpy(stash,
               st_data,
@@ -15072,7 +15012,7 @@ move_helper(tree size_error,        // This is an INT
                 gg_call_expr( INT,
                               "__gg__move_literala",
                               gg_get_address_of(destref.field->var_decl_node),
-                              refer_offset_dest(destref),
+                              refer_offset(destref),
                               refer_size_dest(destref),
                               build_int_cst_type(INT, rounded_parameter),
                               build_string_literal(source_length,
@@ -15085,7 +15025,7 @@ move_helper(tree size_error,        // This is an INT
                 gg_call     ( INT,
                               "__gg__move_literala",
                               gg_get_address_of(destref.field->var_decl_node),
-                              refer_offset_dest(destref),
+                              refer_offset(destref),
                               refer_size_dest(destref),
                               build_int_cst_type(INT, rounded_parameter),
                               build_string_literal(source_length,
@@ -15128,7 +15068,7 @@ move_helper(tree size_error,        // This is an INT
                 gg_call_expr( INT,
                               "__gg__move",
                               gg_get_address_of(destref.field->var_decl_node),
-                              refer_offset_dest(destref),
+                              refer_offset(destref),
                               refer_size_dest(destref),
                               tsource.pfield,
                               tsource.offset,
@@ -15142,7 +15082,7 @@ move_helper(tree size_error,        // This is an INT
                 gg_call     ( INT,
                               "__gg__move",
                               gg_get_address_of(destref.field->var_decl_node),
-                              refer_offset_dest(destref),
+                              refer_offset(destref),
                               refer_size_dest(destref),
                               tsource.pfield,
                               tsource.offset,
@@ -15301,14 +15241,14 @@ binary_initial_from_float128(cbl_field_t *field, int rdigits,
     case 4:
     case 8:
     case 16:
-      type = build_nonstandard_integer_type (field->data.capacity
-					     * BITS_PER_UNIT, 0);
+      type = build_nonstandard_integer_type ( field->data.capacity
+                                              * BITS_PER_UNIT, 0);
       native_encode_wide_int (type, i, (unsigned char *)retval,
-			      field->data.capacity);
+                              field->data.capacity);
       break;
     default:
       fprintf(stderr,
-              "Trouble in initial_from_float128 at %s() %s:%d\n",
+              "Trouble in binary_initial_from_float128 at %s() %s:%d\n",
               __func__,
               __FILE__,
               __LINE__);
@@ -15367,13 +15307,13 @@ digits_from_float128(char *retval, cbl_field_t *field, size_t width, int rdigits
   }
 
 static char *
-initial_from_float128(cbl_field_t *field)
+initial_from_initial(cbl_field_t *field)
   {
   Analyze();
   // This routine returns an xmalloced buffer that is intended to replace the
   // data.initial member of the incoming field.
 
-  //fprintf(stderr, "initial_from_float128 %s\n", field->name);
+  //fprintf(stderr, "initial_from_initial %s\n", field->name);
 
   char *retval = NULL;
   int rdigits;
@@ -15433,8 +15373,9 @@ initial_from_float128(cbl_field_t *field)
       }
     if( set_return )
       {
-      retval = (char *)xmalloc(field->data.capacity);
+      retval = (char *)xmalloc(field->data.capacity+1);
       memset(retval, const_char, field->data.capacity);
+      retval[field->data.capacity] = '\0';
       return retval;
       }
     }
@@ -15739,17 +15680,17 @@ initial_from_float128(cbl_field_t *field)
         case 4:
           value = real_value_truncate (TYPE_MODE (FLOAT), value);
           native_encode_real (SCALAR_FLOAT_TYPE_MODE (FLOAT), &value,
-			      (unsigned char *)retval, 4, 0);
+                              (unsigned char *)retval, 4, 0);
           break;
         case 8:
           value = real_value_truncate (TYPE_MODE (DOUBLE), value);
           native_encode_real (SCALAR_FLOAT_TYPE_MODE (DOUBLE), &value,
-			      (unsigned char *)retval, 8, 0);
+                              (unsigned char *)retval, 8, 0);
           break;
         case 16:
           value = real_value_truncate (TYPE_MODE (FLOAT128), value);
           native_encode_real (SCALAR_FLOAT_TYPE_MODE (FLOAT128), &value,
-			      (unsigned char *)retval, 16, 0);
+                              (unsigned char *)retval, 16, 0);
           break;
         }
       break;
@@ -16838,7 +16779,7 @@ parser_symbol_add(struct cbl_field_t *new_var )
 
     if( new_var->data.initial )
       {
-      new_initial = initial_from_float128(new_var);
+      new_initial = initial_from_initial(new_var);
       }
     if( new_initial )
       {
@@ -16858,49 +16799,15 @@ parser_symbol_add(struct cbl_field_t *new_var )
     else
       {
       new_initial = new_var->data.initial;
-      if( !new_initial )
-        {
-        if( length_of_initial_string )
-          {
-          gcc_unreachable();
-          }
-        }
-      else
-        {
-        if( new_var->type == FldLiteralN )
-          {
-          // We need to convert this string to the internal character set
-          // char *buffer = NULL;
-          // size_t buffer_size = 0;
-          // raw_to_internal(&buffer,
-                          // &buffer_size,
-                          // new_var->data.initial,
-                          // strlen(new_var->data.initial));
-          // new_initial = bufer;
-          // length_of_initial_string = strlen(new_var->data.initial)+1;
-          }
-        }
       }
 
     actual_allocate:
-    // if( level_88_string )
-      // {
-      // actually_create_the_static_field( new_var,
-                                        // data_area,
-                                        // level_88_string_size,
-                                        // level_88_string,
-                                        // immediate_parent,
-                                        // new_var_decl);
-      // }
-    // else
-      {
-      actually_create_the_static_field( new_var,
-                                        data_area,
-                                        length_of_initial_string,
-                                        new_initial,
-                                        immediate_parent,
-                                        new_var_decl);
-      }
+    actually_create_the_static_field( new_var,
+                                      data_area,
+                                      length_of_initial_string,
+                                      new_initial,
+                                      immediate_parent,
+                                      new_var_decl);
 
     if( level_88_string )
       {
diff --git a/gcc/cobol/genapi.h b/gcc/cobol/genapi.h
index 447b62e..2694457 100644
--- a/gcc/cobol/genapi.h
+++ b/gcc/cobol/genapi.h
@@ -518,13 +518,7 @@ void parser_return_atend( cbl_file_t *file );
 void parser_return_notatend( cbl_file_t *file );
 void parser_return_finish( cbl_file_t *file );
 
-void parser_exception_prepare( const cbl_name_t statement_name,
-                               const cbl_enabled_exceptions_array_t *enabled );
-
-//void parser_exception_condition( cbl_field_t *ec );
-
 struct cbl_exception_file;
-struct cbl_exception_files_t;
 
 void parser_exception_raise(ec_type_t ec);
 
@@ -533,10 +527,11 @@ void parser_call_exception_end( cbl_label_t *name );
 
 //void parser_stash_exceptions(const cbl_enabled_exceptions_array_t *enabled);
 
-void parser_match_exception(cbl_field_t *index,
-                            cbl_field_t *blob);
+void parser_match_exception(cbl_field_t *index);
 void parser_check_fatal_exception();
 void parser_clear_exception();
+void parser_push_exception();
+void parser_pop_exception();
 
 void parser_call_targets_dump();
 size_t parser_call_target_update( size_t caller,
@@ -569,8 +564,6 @@ void parser_print_long(const char *fmt, long N); // fmt needs to have a %ls in i
 void parser_print_string(const char *ach);
 void parser_print_string(const char *fmt, const char *ach); // fmt needs to have a %s in it
 void parser_set_statement(const char *statement);
-void parser_set_handled(ec_type_t ec_handled);
-void parser_set_file_number(int file_number);
 void parser_exception_clear();
 
 void parser_init_list_size(int count_of_variables);
@@ -579,6 +572,9 @@ void parser_init_list();
 
 tree file_static_variable(tree type, const char *name);
 
-void parser_statement_begin();
+void parser_statement_begin( const cbl_name_t name, tree ecs, tree dcls );
+
+tree parser_compile_ecs( const std::vector<uint64_t>& ecs );
+tree parser_compile_dcls( const std::vector<uint64_t>& dcls );
 
 #endif
diff --git a/gcc/cobol/genmath.cc b/gcc/cobol/genmath.cc
index f686313..721aafb 100644
--- a/gcc/cobol/genmath.cc
+++ b/gcc/cobol/genmath.cc
@@ -413,7 +413,7 @@ fast_add( size_t nC, cbl_num_result_t *C,
       get_binary_value( sum,
                         NULL,
                         A[0].field,
-                        refer_offset_source(A[0]));
+                        refer_offset(A[0]));
 
       // Add in the rest of them:
       for(size_t i=1; i<nA; i++)
@@ -421,7 +421,7 @@ fast_add( size_t nC, cbl_num_result_t *C,
         get_binary_value( addend,
                           NULL,
                           A[i].field,
-                          refer_offset_source(A[i]));
+                          refer_offset(A[i]));
         gg_assign(sum, gg_add(sum, addend));
         }
       //gg_printf("The intermediate sum is %ld\n", gg_cast(LONG, sum), NULL_TREE);
@@ -431,7 +431,7 @@ fast_add( size_t nC, cbl_num_result_t *C,
         {
         tree dest_type = tree_type_from_size(C[i].refer.field->data.capacity, 0);
         tree dest_addr = gg_add(member(C[i].refer.field->var_decl_node, "data"),
-                                refer_offset_dest(C[i].refer));
+                                refer_offset(C[i].refer));
         tree ptr = gg_cast(build_pointer_type(dest_type), dest_addr);
         if( format == giving_e )
           {
@@ -495,12 +495,12 @@ fast_subtract(size_t nC, cbl_num_result_t *C,
 
       tree sum     = gg_define_variable(term_type);
       tree addend  = gg_define_variable(term_type);
-      get_binary_value(sum, NULL, A[0].field, refer_offset_dest(A[0]));
+      get_binary_value(sum, NULL, A[0].field, refer_offset(A[0]));
 
       // Add in the rest of them:
       for(size_t i=1; i<nA; i++)
         {
-        get_binary_value(sum, NULL, A[i].field, refer_offset_dest(A[i]));
+        get_binary_value(sum, NULL, A[i].field, refer_offset(A[i]));
         gg_assign(sum, gg_add(sum, addend));
         }
       //gg_printf("The intermediate sum is %ld\n", gg_cast(LONG, sum), NULL_TREE);
@@ -508,7 +508,7 @@ fast_subtract(size_t nC, cbl_num_result_t *C,
       if( format == giving_e )
         {
         // We now subtract the sum from B[0]
-        get_binary_value(addend, NULL, B[0].field, refer_offset_dest(B[0]));
+        get_binary_value(addend, NULL, B[0].field, refer_offset(B[0]));
         gg_assign(sum, gg_subtract(addend, sum));
         }
 
@@ -517,7 +517,7 @@ fast_subtract(size_t nC, cbl_num_result_t *C,
         {
         tree dest_type = tree_type_from_size(C[i].refer.field->data.capacity, 0);
         tree dest_addr = gg_add(member(C[i].refer.field->var_decl_node, "data"),
-                                refer_offset_dest(C[i].refer));
+                                refer_offset(C[i].refer));
         tree ptr = gg_cast(build_pointer_type(dest_type), dest_addr);
         if( format == giving_e )
           {
@@ -575,12 +575,12 @@ fast_multiply(size_t nC, cbl_num_result_t *C,
 
       tree valA    = gg_define_variable(term_type);
       tree valB    = gg_define_variable(term_type);
-      get_binary_value(valA, NULL, A[0].field, refer_offset_dest(A[0]));
+      get_binary_value(valA, NULL, A[0].field, refer_offset(A[0]));
 
       if( nB )
         {
         // This is a MULTIPLY Format 2
-        get_binary_value(valB, NULL, B[0].field, refer_offset_dest(B[0]));
+        get_binary_value(valB, NULL, B[0].field, refer_offset(B[0]));
         }
 
       if(nB)
@@ -593,7 +593,7 @@ fast_multiply(size_t nC, cbl_num_result_t *C,
         {
         tree dest_type = tree_type_from_size(C[i].refer.field->data.capacity, 0);
         tree dest_addr = gg_add(member(C[i].refer.field->var_decl_node, "data"),
-                                refer_offset_dest(C[i].refer));
+                                refer_offset(C[i].refer));
         tree ptr = gg_cast(build_pointer_type(dest_type), dest_addr);
         if( nB )
           {
@@ -653,13 +653,13 @@ fast_divide(size_t nC, cbl_num_result_t *C,
       tree divisor  = gg_define_variable(term_type);
       tree dividend = gg_define_variable(term_type);
       tree quotient = NULL_TREE;
-      get_binary_value(divisor, NULL, A[0].field, refer_offset_dest(A[0]));
+      get_binary_value(divisor, NULL, A[0].field, refer_offset(A[0]));
 
       if( nB )
         {
         // This is a MULTIPLY Format 2, where we are dividing A into B and
         // assigning that to C
-        get_binary_value(dividend, NULL, B[0].field, refer_offset_dest(B[0]));
+        get_binary_value(dividend, NULL, B[0].field, refer_offset(B[0]));
 
         quotient = gg_define_variable(term_type);
         // Yes, in this case the divisor and dividend are switched.  Things are
@@ -672,7 +672,7 @@ fast_divide(size_t nC, cbl_num_result_t *C,
         {
         tree dest_type = tree_type_from_size(C[i].refer.field->data.capacity, 0);
         tree dest_addr = gg_add(member(C[i].refer.field->var_decl_node, "data"),
-                                refer_offset_dest(C[i].refer));
+                                refer_offset(C[i].refer));
         tree ptr = gg_cast(build_pointer_type(dest_type), dest_addr);
         if( nB )
           {
@@ -696,7 +696,7 @@ fast_divide(size_t nC, cbl_num_result_t *C,
         if( remainder.field )
           {
           tree dest_addr = gg_add(member(remainder.field->var_decl_node, "data"),
-                                  refer_offset_dest(remainder));
+                                  refer_offset(remainder));
           dest_type = tree_type_from_size(remainder.field->data.capacity, 0);
           ptr = gg_cast(build_pointer_type(dest_type), dest_addr);
 
diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc
index 0322833..94e57f4 100644
--- a/gcc/cobol/genutil.cc
+++ b/gcc/cobol/genutil.cc
@@ -57,8 +57,6 @@ bool suppress_dest_depends = false;
 std::vector<std::string>current_filename;
 
 tree var_decl_exception_code;         // int         __gg__exception_code;
-tree var_decl_exception_handled;      // int         __gg__exception_handled;
-tree var_decl_exception_file_number;  // int         __gg__exception_file_number;
 tree var_decl_exception_file_status;  // int         __gg__exception_file_status;
 tree var_decl_exception_file_name;    // const char *__gg__exception_file_name;
 tree var_decl_exception_statement;    // const char *__gg__exception_statement;
@@ -228,6 +226,13 @@ get_integer_value(tree value,
                   tree         offset,
                   bool check_for_fractional_digits)
   {
+  if(field->type == FldLiteralN)
+    {
+    }
+
+
+
+
   Analyze();
   // Call this routine when you know the result has to be an integer with no
   // rdigits.  This routine became necessary the first time I saw an
@@ -265,7 +270,7 @@ get_integer_value(tree value,
   }
 
 static
-tree
+tree  // This is a SIZE_T
 get_any_capacity(cbl_field_t *field)
   {
   if( field->attr & (any_length_e | intermediate_e) )
@@ -274,209 +279,12 @@ get_any_capacity(cbl_field_t *field)
     }
   else
     {
-    return build_int_cst_type(LONG, field->data.capacity);
-    }
-  }
-
-static tree
-get_data_offset_dest(cbl_refer_t &refer,
-                int *pflags = NULL)
-  {
-  Analyze();
-  // This routine returns a tree which is the size_t offset to the data in the
-  // refer/field
-
-  // Because this is for destination/receiving variables, OCCURS DEPENDING ON
-  // is not checked.
-
-  tree retval = gg_define_variable(SIZE_T);
-  gg_assign(retval, size_t_zero_node);
-
-  // We have a refer.
-  // At the very least, we have an constant offset
-  int all_flags = 0;
-  int all_flag_bit = 1;
-
-  static tree value64 = gg_define_variable(LONG, ".._gdod_value64", vs_file_static);
-
-  if( refer.nsubscript )
-    {
-    // We have at least one subscript:
-
-    // Figure we have three subscripts, so nsubscript is 3
-    // Figure that the subscripts are {5, 4, 3}
-
-    // We expect that starting from refer.field, that three of our ancestors --
-    // call them A1, A2, and A3 -- have occurs clauses.
-
-    // We need to start with the rightmost subscript, and work our way up through
-    // our parents.  As we find each parent with an OCCURS, we increment qual_data
-    // by (subscript-1)*An->data.capacity
-
-    // Establish the field_t pointer for walking up through our ancestors:
-    cbl_field_t *parent = refer.field;
-
-    // Note the backwards test, because refer->nsubscript is an unsigned value
-    for(size_t i=refer.nsubscript-1; i<refer.nsubscript; i-- )
-      {
-      // We need to search upward for an ancestor with occurs_max:
-      while(parent)
-        {
-        if( parent->occurs.ntimes() )
-          {
-          break;
-          }
-        parent = parent_of(parent);
-        }
-      // we might have an error condition at this point:
-      if( !parent )
-        {
-        cbl_internal_error("Too many subscripts");
-        }
-      // Pick up the integer value of the subscript:
-      static tree subscript  = gg_define_variable(LONG, "..gdod_subscript", vs_file_static);
-
-      get_integer_value(subscript,
-                        refer.subscripts[i].field,
-                        refer_offset_dest(refer.subscripts[i]),
-                        CHECK_FOR_FRACTIONAL_DIGITS);
-      IF( var_decl_rdigits,
-          ne_op,
-          integer_zero_node )
-        {
-        // The subscript isn't an integer
-        set_exception_code(ec_bound_subscript_e);
-        }
-      ELSE
-        {
-        }
-      ENDIF
-
-//      gg_printf("%s(): We have a subscript of %d from %s\n",
-//                  gg_string_literal(__func__),
-//                  subscript,
-//                  gg_string_literal(refer.subscripts[i].field->name),
-//                  NULL_TREE);
-
-      if( (refer.subscripts[i].field->attr & FIGCONST_MASK) == zero_value_e )
-        {
-        // This refer is a figconst ZERO; we treat it as an ALL ZERO
-        // This is our internal representation for ALL, as in TABLE(ALL)
-
-        // Set the subscript to 1
-        gg_assign(subscript,
-                  build_int_cst_type( TREE_TYPE(subscript), 1));
-        // Flag this position as ALL
-        all_flags |= all_flag_bit;
-        }
-      all_flag_bit <<= 1;
-
-      // Subscript is now a one-based integer
-      // Make it zero-based:
-
-      gg_decrement(subscript);
-
-      IF( subscript, lt_op, gg_cast(TREE_TYPE(subscript), integer_zero_node) )
-        {
-        // The subscript is too small
-        set_exception_code(ec_bound_subscript_e);
-        gg_assign(subscript, build_int_cst_type(TREE_TYPE(subscript), 0));
-        }
-      ELSE
-        {
-        // gg_printf("parent->occurs.ntimes() is %d\n", build_int_cst_type(INT, parent->occurs.ntimes()), NULL_TREE);
-        IF( subscript,
-            ge_op,
-            build_int_cst_type(TREE_TYPE(subscript), parent->occurs.ntimes()) )
-          {
-          // The subscript is too large
-          set_exception_code(ec_bound_subscript_e);
-          gg_assign(subscript, build_int_cst_type(TREE_TYPE(subscript), 0));
-          }
-        ELSE
-          {
-          // We have a good subscript:
-          // Check for an ODO violation:
-          if( parent->occurs.depending_on )
-            {
-            cbl_field_t *depending_on = cbl_field_of(symbol_at(parent->occurs.depending_on));
-            get_integer_value(value64, depending_on);
-            IF( subscript, ge_op, value64 )
-              {
-              gg_assign(var_decl_odo_violation, integer_one_node);
-              }
-            ELSE
-              ENDIF
-            }
-
-          tree augment = gg_multiply(subscript, get_any_capacity(parent));
-          gg_assign(retval, gg_add(retval, gg_cast(SIZE_T, augment)));
-          }
-          ENDIF
-        }
-        ENDIF
-      parent = parent_of(parent);
-      }
-    }
-
-  if( refer.refmod.from )
-    {
-    // We have a refmod to deal with
-    static tree refstart = gg_define_variable(LONG, "..gdos_refstart", vs_file_static);
-
-    get_integer_value(refstart,
-                      refer.refmod.from->field,
-                      refer_offset_source(*refer.refmod.from),
-                      CHECK_FOR_FRACTIONAL_DIGITS);
-    IF( var_decl_rdigits,
-        ne_op,
-        integer_zero_node )
-      {
-      // refmod offset is not an integer, and has to be
-      set_exception_code(ec_bound_ref_mod_e);
-      }
-    ELSE
-      ENDIF
-
-    // Make refstart zero-based:
-    gg_decrement(refstart);
-
-    IF( refstart, lt_op, gg_cast(LONG, integer_zero_node) )
-      {
-      set_exception_code(ec_bound_ref_mod_e);
-      gg_assign(refstart, build_int_cst_type(TREE_TYPE(refstart), 0));
-      }
-    ELSE
-      {
-      tree capacity = get_any_capacity(refer.field);
-      IF( refstart, gt_op, gg_cast(LONG, capacity) )
-        {
-        set_exception_code(ec_bound_ref_mod_e);
-        gg_assign(refstart, build_int_cst_type(TREE_TYPE(refstart), 0));
-        }
-      ELSE
-        ENDIF
-      }
-      ENDIF
-
-    // We have a good refstart
-    gg_assign(retval, gg_add(retval, gg_cast(SIZE_T, refstart)));
-    }
-
-  if( pflags )
-    {
-    *pflags = all_flags;
+    return build_int_cst_type(SIZE_T, field->data.capacity);
     }
-
-//  gg_printf("*****>>>>> %s(): returning %p\n",
-//            gg_string_literal(__func__),
-//            retval,
-//            NULL_TREE);
-  return retval;
   }
 
 static tree
-get_data_offset_source(cbl_refer_t &refer,
+get_data_offset(cbl_refer_t &refer,
                 int *pflags = NULL)
   {
   Analyze();
@@ -535,7 +343,7 @@ get_data_offset_source(cbl_refer_t &refer,
 
       get_integer_value(subscript,
                         refer.subscripts[i].field,
-                        refer_offset_source(refer.subscripts[i]),
+                        refer_offset(refer.subscripts[i]),
                         CHECK_FOR_FRACTIONAL_DIGITS);
       IF( var_decl_rdigits,
           ne_op,
@@ -623,7 +431,7 @@ get_data_offset_source(cbl_refer_t &refer,
 
     get_integer_value(refstart,
                       refer.refmod.from->field,
-                      refer_offset_source(*refer.refmod.from),
+                      refer_offset(*refer.refmod.from),
                       CHECK_FOR_FRACTIONAL_DIGITS);
     IF( var_decl_rdigits,
         ne_op,
@@ -645,7 +453,7 @@ get_data_offset_source(cbl_refer_t &refer,
       }
     ELSE
       {
-      tree capacity = get_any_capacity(refer.field);
+      tree capacity = get_any_capacity(refer.field);  // This is a size_t
       IF( refstart, gt_op, gg_cast(LONG, capacity) )
         {
         set_exception_code(ec_bound_ref_mod_e);
@@ -710,7 +518,7 @@ get_binary_value( tree value,
       {
       if( SCALAR_FLOAT_TYPE_P(value) )
         {
-        gg_assign(value, gg_cast(TREE_TYPE(value), field->literal_decl_node));
+        cbl_internal_error("Can't get float value from %s", field->name);
         }
       else
         {
@@ -1758,7 +1566,7 @@ build_array_of_treeplets( int ngroup,
                     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_source(refers[i]));
+                    refer_offset(refers[i]));
           gg_assign(gg_array_value(var_decl_treeplet_1s, i),
                     refer_size_source(refers[i]));
           }
@@ -1770,7 +1578,7 @@ build_array_of_treeplets( int ngroup,
                     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_source(refers[i]));
+                    refer_offset(refers[i]));
           gg_assign(gg_array_value(var_decl_treeplet_2s, i),
                     refer_size_source(refers[i]));
           }
@@ -1782,7 +1590,7 @@ build_array_of_treeplets( int ngroup,
                     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_source(refers[i]));
+                    refer_offset(refers[i]));
           gg_assign(gg_array_value(var_decl_treeplet_3s, i),
                     refer_size_source(refers[i]));
           }
@@ -1794,7 +1602,7 @@ build_array_of_treeplets( int ngroup,
                     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_source(refers[i]));
+                    refer_offset(refers[i]));
           gg_assign(gg_array_value(var_decl_treeplet_4s, i),
                     refer_size_source(refers[i]));
           }
@@ -1839,7 +1647,7 @@ build_array_of_fourplets( int ngroup,
       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),
-                refer_offset_source(refers[i], &flag_bits));
+                refer_offset(refers[i], &flag_bits));
       gg_assign(gg_array_value(var_decl_treeplet_1s, i),
                 refer_size_source(refers[i]));
       gg_assign(gg_array_value(var_decl_fourplet_flags, i),
@@ -1962,6 +1770,11 @@ REFER_CHECK(const char *func,
   counter+=1;
   }
 
+
+/*  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
+    to make sure that result falls within refer.capacity.
+    */
 static
 tree  // size_t
 refer_refmod_length(cbl_refer_t &refer)
@@ -1969,17 +1782,14 @@ refer_refmod_length(cbl_refer_t &refer)
   Analyze();
   if( refer.refmod.from || refer.refmod.len )
     {
-    // First, check for compile-time errors
     static tree refstart = gg_define_variable(LONG, "..rrl_refstart", vs_file_static);
     static tree reflen   = gg_define_variable(LONG, "..rrl_reflen", vs_file_static);
 
-    tree rt_capacity = get_any_capacity(refer.field);
-
-    gg_assign(reflen, gg_cast(TREE_TYPE(reflen), integer_one_node));
+    tree rt_capacity = get_any_capacity(refer.field); // This is a size_t
 
     get_integer_value(refstart,
                       refer.refmod.from->field,
-                      refer_offset_source(*refer.refmod.from),
+                      refer_offset(*refer.refmod.from),
                       CHECK_FOR_FRACTIONAL_DIGITS);
     IF( var_decl_rdigits,
         ne_op,
@@ -1998,6 +1808,8 @@ refer_refmod_length(cbl_refer_t &refer)
       {
       set_exception_code(ec_bound_ref_mod_e);
       gg_assign(refstart, gg_cast(LONG, integer_zero_node));
+      // Set reflen to one here, because otherwise it won't be established.
+      gg_assign(reflen, gg_cast(TREE_TYPE(reflen), integer_one_node));
       }
     ELSE
       {
@@ -2005,6 +1817,8 @@ refer_refmod_length(cbl_refer_t &refer)
         {
         set_exception_code(ec_bound_ref_mod_e);
         gg_assign(refstart, gg_cast(LONG, integer_zero_node));
+        // Set reflen to one here, because otherwise it won't be established.
+        gg_assign(reflen, gg_cast(TREE_TYPE(reflen), integer_one_node));
         }
       ELSE
         {
@@ -2012,7 +1826,7 @@ refer_refmod_length(cbl_refer_t &refer)
           {
           get_integer_value(reflen,
                             refer.refmod.len->field,
-                            refer_offset_source(*refer.refmod.len),
+                            refer_offset(*refer.refmod.len),
                             CHECK_FOR_FRACTIONAL_DIGITS);
           IF( var_decl_rdigits,
               ne_op,
@@ -2044,10 +1858,10 @@ refer_refmod_length(cbl_refer_t &refer)
 
               // Our intentions are honorable.  But at this point, where
               // we notice that start + length is too long, the
-              // get_data_offset_source routine has already been run and
+              // get_data_offset routine has already been run and
               // it's too late to actually change the refstart.  There are
               // theoretical solutions to this -- mainly,
-              // get_data_offset_source needs to check the start + len for
+              // get_data_offset needs to check the start + len for
               // validity.  But I am not going to do it now.  Think of this
               // as the TODO item.
               gg_assign(refstart, gg_cast(LONG, integer_zero_node));
@@ -2156,26 +1970,24 @@ refer_fill_depends(cbl_refer_t &refer)
   }
 
 tree  // size_t
-refer_offset_dest(cbl_refer_t &refer)
+refer_offset(cbl_refer_t &refer,
+                    int *pflags)
   {
-  Analyze();
-  // This has to be on the stack, because there are places where this routine
-  // is called twice before the results are used.
-
   if( !refer.field )
     {
     return size_t_zero_node;
     }
-
   if( !refer.nsubscript )
     {
-    return get_data_offset_dest(refer);
+    return get_data_offset(refer);
     }
 
-  gg_assign(var_decl_odo_violation, integer_zero_node);
+  Analyze();
 
   tree retval = gg_define_variable(SIZE_T);
-  gg_assign(retval, get_data_offset_dest(refer));
+  gg_assign(var_decl_odo_violation, integer_zero_node);
+
+  gg_assign(retval, get_data_offset(refer, pflags));
   IF( var_decl_odo_violation, ne_op, integer_zero_node )
     {
     set_exception_code(ec_bound_odo_e);
@@ -2185,44 +1997,33 @@ refer_offset_dest(cbl_refer_t &refer)
   return retval;
   }
 
-tree  // size_t
-refer_size_dest(cbl_refer_t &refer)
+static
+tree
+refer_size(cbl_refer_t &refer, refer_type_t refer_type)
   {
   Analyze();
-  //static tree retval = gg_define_variable(SIZE_T, "..rsd_retval", vs_file_static);
-  tree retval = gg_define_variable(SIZE_T);
+  static tree retval = gg_define_variable(SIZE_T, "..rs_retval", vs_file_static);
 
   if( !refer.field )
     {
     return size_t_zero_node;
     }
+
   if( refer_is_clean(refer) )
     {
-    // When the refer has no modifications, we return zero, which is interpreted
-    // as "use the original length"
     return get_any_capacity(refer.field);
     }
 
   // Step the first:  Get the actual full length:
-  if( refer.field->attr & (intermediate_e | any_length_e) )
-    {
-    // This is an intermediate; use the length that might have changed
-    // because of a FUNCTION TRIM, or whatnot.
-
-    // We also pick up capacity for variables that were specified in
-    // linkage as ANY LENGTH
-    gg_assign(retval, member(refer.field->var_decl_node, "capacity"));
-    }
 
-  if( refer_has_depends(refer, refer_dest) )
+  if( refer_has_depends(refer, refer_type) )
     {
     // Because there is a depends, we might have to change the length:
     gg_assign(retval, refer_fill_depends(refer));
     }
   else
     {
-    // Use the compile-time value
-    gg_assign(retval, build_int_cst_type(SIZE_T, refer.field->data.capacity));
+    gg_assign(retval, get_any_capacity(refer.field));
     }
 
   if( refer.refmod.from || refer.refmod.len )
@@ -2231,7 +2032,7 @@ refer_size_dest(cbl_refer_t &refer)
     // retval is the ODO based total length.
     // refmod is the length resulting from refmod(from:len)
     // We have to reduce retval by the effect of refmod:
-    tree diff = gg_subtract(build_int_cst_type(SIZE_T, refer.field->data.capacity),
+    tree diff = gg_subtract(get_any_capacity(refer.field),
                             refmod);
     gg_assign(retval, gg_subtract(retval, diff));
     }
@@ -2239,103 +2040,51 @@ refer_size_dest(cbl_refer_t &refer)
   }
 
 tree  // size_t
-refer_offset_source(cbl_refer_t &refer,
-                    int *pflags)
+refer_size_dest(cbl_refer_t &refer)
   {
-  if( !refer.field )
-    {
-    return size_t_zero_node;
-    }
-  if( !refer.nsubscript )
-    {
-    return get_data_offset_source(refer);
-    }
-
-  Analyze();
-
-  tree retval = gg_define_variable(SIZE_T);
-  gg_assign(var_decl_odo_violation, integer_zero_node);
-
-  gg_assign(retval, get_data_offset_source(refer, pflags));
-  IF( var_decl_odo_violation, ne_op, integer_zero_node )
-    {
-    set_exception_code(ec_bound_odo_e);
-    }
-  ELSE
-    ENDIF
-  return retval;
+  return refer_size(refer, refer_dest);
   }
 
 tree  // size_t
 refer_size_source(cbl_refer_t &refer)
   {
-  if( !refer.field )
-    {
-    return size_t_zero_node;
-    }
-  if( refer_is_clean(refer) )
-    {
-    // When the refer has no modifications, we return zero, which is interpreted
-    // as "use the original length"
-    if( refer.field->attr & (intermediate_e | any_length_e) )
-      {
-      return member(refer.field->var_decl_node, "capacity");
-      }
-    else
-      {
-      return build_int_cst_type(SIZE_T, refer.field->data.capacity);
-      }
-    }
+  /*  There are oddities involved with refer_size_source and refer_size_dest.
+      See the comments in refer_has_depends for some explanation.  There are
+      other considerations, as well.  For example, consider a move, where you
+      have both a source and a dest.  Given that refer_size returns a static,
+      there are ways that the source and dest can trip over each other.
 
-  Analyze();
+      The logic here avoids all known cases where they might trip over each
+      other.  But there conceivably might be others,.
 
-  // Step the first:  Get the actual full length:
-  static tree retval = gg_define_variable(SIZE_T, "..rss_retval", vs_file_static);
-  if( refer.field->attr & (intermediate_e | any_length_e) )
-    {
-    // This is an intermediate; use the length that might have changed
-    // because of a FUNCTION TRIM, or whatnot.
+      You have been warned.
 
-    // We also pick up capacity for variables that were specified in
-    // linkage as ANY LENGTH
-    gg_assign(retval,
-              member(refer.field->var_decl_node, "capacity"));
-    }
+      */
 
-  if( refer_has_depends(refer, refer_source) )
-    {
-    // Because there is a depends, we might have to change the length:
-    gg_assign(retval, refer_fill_depends(refer));
-    }
-  else
+  // This test has to be here, otherwise there are failures in regression
+  // testing.
+  if( !refer.field )
     {
-    // Use the compile-time value
-    gg_assign(retval, build_int_cst_type(SIZE_T, refer.field->data.capacity));
+    return size_t_zero_node;
     }
 
-  if( refer.refmod.from || refer.refmod.len )
+  // This test has to be here, otherwise there are failures in regression
+  // testing.
+  if( refer_is_clean(refer) )
     {
-    tree refmod = refer_refmod_length(refer);
-    // retval is the ODO based total length.
-    // refmod is the length resulting from refmod(from:len)
-    // We have to reduce retval by the effect of refmod:
-    tree diff = gg_subtract(build_int_cst_type(SIZE_T, refer.field->data.capacity),
-                            refmod);
-    gg_assign(retval, gg_subtract(retval, diff));
+    return get_any_capacity(refer.field);
     }
-  return retval;
-  }
 
-tree
-qualified_data_source(cbl_refer_t &refer)
-  {
-  return gg_add(member(refer.field->var_decl_node, "data"),
-                refer_offset_source(refer));
+  // This assignment has to be here. Simply returning refer_size() results
+  // in regression testing errors.
+  static tree retval = gg_define_variable(SIZE_T, "..rss_retval", vs_file_static);
+  gg_assign(retval, refer_size(refer, refer_source));
+  return retval;
   }
 
 tree
-qualified_data_dest(cbl_refer_t &refer)
+qualified_data_location(cbl_refer_t &refer)
   {
   return gg_add(member(refer.field->var_decl_node, "data"),
-                refer_offset_dest(refer));
+                refer_offset(refer));
   }
diff --git a/gcc/cobol/genutil.h b/gcc/cobol/genutil.h
index 6ef4dee..c216dba 100644
--- a/gcc/cobol/genutil.h
+++ b/gcc/cobol/genutil.h
@@ -45,8 +45,6 @@ extern bool suppress_dest_depends;
 extern std::vector<std::string>current_filename;
 
 extern tree var_decl_exception_code;         // int         __gg__exception_code;
-extern tree var_decl_exception_handled;      // int         __gg__exception_handled;
-extern tree var_decl_exception_file_number;  // int         __gg__exception_file_number;
 extern tree var_decl_exception_file_status;  // int         __gg__exception_file_status;
 extern tree var_decl_exception_file_name;    // const char *__gg__exception_file_name;
 extern tree var_decl_exception_statement;    // const char *__gg__exception_statement;
@@ -143,10 +141,9 @@ char     *get_literal_string(cbl_field_t *field);
 
 bool      refer_is_clean(cbl_refer_t &refer);
 
-tree      refer_offset_source(cbl_refer_t &refer,
-                              int *pflags=NULL);
+tree      refer_offset(cbl_refer_t &refer,
+                       int *pflags=NULL);
 tree      refer_size_source(cbl_refer_t &refer);
-tree      refer_offset_dest(cbl_refer_t &refer);
 tree      refer_size_dest(cbl_refer_t &refer);
 
 void     REFER_CHECK( const char *func,
@@ -155,9 +152,7 @@ void     REFER_CHECK( const char *func,
                       );
 #define refer_check(a) REFER_CHECK(__func__, __LINE__, a)
 
-tree      qualified_data_source(cbl_refer_t &refer);
-
-tree      qualified_data_dest(cbl_refer_t &refer);
+tree      qualified_data_location(cbl_refer_t &refer);
 
 void      build_array_of_treeplets( int ngroup,
                                     size_t N,
diff --git a/gcc/cobol/lexio.cc b/gcc/cobol/lexio.cc
index 99824b6..a992166 100644
--- a/gcc/cobol/lexio.cc
+++ b/gcc/cobol/lexio.cc
@@ -406,6 +406,22 @@ valid_sequence_area( const char *p, const char *eodata ) {
   return true; // characters either digits or blanks
 }
 
+// Inspect the 2nd line for telltale signs of a NIST file.
+// If true, caller sets right margin to 73, indicating Reference Format
+static bool
+likely_nist_file( const char *p, const char *eodata ) {
+  if( (p = std::find(p, eodata, '\n')) == eodata ) return false;
+  if ( eodata < ++p + 80 ) return false;
+  p += 72;
+
+  return
+    ISALPHA(p[0]) && ISALPHA(p[1]) && 
+    ISDIGIT(p[2]) && ISDIGIT(p[3]) && ISDIGIT(p[4]) &&
+    p[5] == '4' &&
+    p[6] == '.' &&
+    p[7] == '2';
+}
+
 const char * esc( size_t len, const char input[] );
 
 static bool
@@ -1638,9 +1654,11 @@ cdftext::free_form_reference_format( int input ) {
       if( p < mfile.eodata) p++;
     }
     if( valid_sequence_area(p, mfile.eodata) ) indicator.column = 7;
+    if( likely_nist_file(p, mfile.eodata) )    indicator.right_margin = 73;
 
-    dbgmsg("%s:%d: %s format detected", __func__, __LINE__,
-           indicator.column == 7? "FIXED" : "FREE");
+    dbgmsg("%s:%d: %s%s format detected", __func__, __LINE__,
+           indicator.column == 7? "FIXED" : "FREE",
+           indicator.right_margin == 73? "" : "-extended");
   }
 
   while( mfile.next_line() ) {
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 96f993e..c6b40fa 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -701,6 +701,7 @@
                         relative_key_clause reserve_clause sharing_clause
 
 %type   <file>          filename read_body write_body delete_body
+%type   <file>		start_impl start_cond start_body
 %type   <rewrite_t>     rewrite_body
 %type   <min_max>       record_vary rec_contains from_to record_desc
 %type   <file_op>       read_file rewrite1 write_file
@@ -714,7 +715,7 @@
 %type   <refer>         move_tgt selected_name read_key read_into vary_by
 %type   <refer>         accept_refer num_operand envar search_expr any_arg
 %type   <accept_func>	accept_body
-%type   <refers>        expr_list subscripts arg_list free_tgts
+%type   <refers>        subscript_exprs subscripts arg_list free_tgts
 %type   <targets>       move_tgts set_tgts
 %type   <field>         search_varying
 %type   <field>         search_term search_terms
@@ -1338,10 +1339,55 @@
       return strlen(lit.data) == lit.len? lit.data : NULL;
   }
 
+  static inline void strip_trailing_zeroes(char * const psz)
+    {
+    if( yydebug) return;
+    // The idea here is to take the output of real_to_decimal and make it
+    // more integer friendly.  Any integer value that can be expressed in 1
+    // to MAX_FIXED_POINT_DIGITS digits is converted to a string without a
+    // decimal point and no exponent.
+    char *pdot = strchr(psz, '.');
+    char *pe = strchr(psz, 'e');
+    char *pnz = pe-1;
+    while(*pnz == '0')
+      {
+      pnz--;
+      }
+    // pdot points to the decimal point.
+    // pe points to the 'e'.
+    // pnz points to the rightmost non-zero significand digit.
+
+    // Put the exponent on top of the trailing zeroes:
+    memmove(pnz+1, pe, strlen(pe)+1);
+    pe = pnz+1;
+    int exp = atoi(pe+1);
+    // Compute the number digits to the right of the decimal point:
+    int non_zero_digits = pe - (pdot+1);
+    if( exp >= 1 && exp <= MAX_FIXED_POINT_DIGITS && non_zero_digits <= exp)
+      {
+      // Further simplification is possible, because the value does not actually
+      // need a decimal point.  That's because we are dealing with something
+      // like 1.e+0, or 1.23e2 or 1.23e3
+
+      // Terminate the value where the 'e' is now:
+      *pe = '\0';
+      // Figure out where the extra zeroes will go:
+      pe -= 1;
+      // Get rid of the decimal place:
+      memmove(pdot, pdot+1, strlen(pdot)+1);
+      // Tack on the additional zeroes:
+      for(int i=0; i<exp - non_zero_digits; i++)
+        {
+        *pe++ = '0';
+        }
+      *pe++ = '\0';
+      }
+    }
+
   static inline char * string_of( const REAL_VALUE_TYPE &cce ) {
       char output[64];
       real_to_decimal( output, &cce, sizeof(output), 32, 0 );
-
+      strip_trailing_zeroes(output);
       char decimal = symbol_decimal_point();
       std::replace(output, output + strlen(output), '.', decimal);
       return xstrdup(output);
@@ -1662,9 +1708,9 @@ namestr:        ctx_name {
                               $$.prefix);
                     YYERROR;
                   }
-                  if( !is_cobol_word($$.data) ) {
+		  if( !is_cobol_charset($$.data) ) {
 		    error_msg(@1, "literal '%s' must be a COBOL or C identifier",
-                              $$.data);
+			      $$.data);
                   }
                 }
                 ;
@@ -5259,7 +5305,7 @@ allocate:       ALLOCATE expr[size] CHARACTERS initialized RETURNING scalar[retu
                   statement_begin(@1, ALLOCATE);
                   if( $size->field->type == FldLiteralN ) {
 		    auto size = TREE_REAL_CST_PTR ($size->field->data.value_of());
-                    if( real_isneg(size) || real_iszero(size) ) { 
+                    if( real_isneg(size) || real_iszero(size) ) {
                       error_msg(@size, "size must be greater than 0");
                       YYERROR;
                     }
@@ -5299,7 +5345,7 @@ compute_impl:   COMPUTE compute_body[body]
                 {
                   parser_assign( $body.ntgt, $body.tgts, *$body.expr,
                                  NULL, NULL, current.compute_label() );
-                  current.declaratives_evaluate(ec_none_e);
+                  current.declaratives_evaluate();
                 }
                 ;
 compute_cond:   COMPUTE compute_body[body] arith_errs[err]
@@ -5307,7 +5353,7 @@ compute_cond:   COMPUTE compute_body[body] arith_errs[err]
                   parser_assign( $body.ntgt, $body.tgts, *$body.expr,
                                  $err.on_error, $err.not_error,
                                  current.compute_label() );
-                  current.declaratives_evaluate(ec_size_e);
+                  current.declaratives_evaluate();
                 }
                 ;
 end_compute:    %empty %prec COMPUTE
@@ -5353,7 +5399,7 @@ display:        disp_body end_display
 				   args.empty()? NULL : args.data(), args.size(),
 				   DISPLAY_ADVANCE);
 		  }
-		  current.declaratives_evaluate(ec_none_e);
+		  current.declaratives_evaluate();
                 }
         |       disp_body NO ADVANCING end_display
                 {
@@ -5369,10 +5415,10 @@ display:        disp_body end_display
 		    parser_move( dst, src );
 		  } else {
 		    parser_display($1.special,
-				   args.empty()? NULL : args.data(), args.size(), 
+				   args.empty()? NULL : args.data(), args.size(),
 				   DISPLAY_NO_ADVANCE);
 		  }
-		  current.declaratives_evaluate(ec_none_e);
+		  current.declaratives_evaluate();
                 }
                 ;
 end_display:    %empty
@@ -6348,14 +6394,14 @@ tableish:	name subscripts[subs] refmod[ref]  %prec NAME
 
 refmod:         LPAREN expr[from] ':' expr[len] ')' %prec NAME
                 {
-		  if( ! require_numeric(@from, *$from) ) YYERROR;
-		  if( ! require_numeric(@len, *$len) ) YYERROR;
+		  if( ! require_integer(@from, *$from) ) YYERROR;
+		  if( ! require_integer(@len, *$len) ) YYERROR;
                   $$.from = $from;
                   $$.len = $len;
                 }
         |       LPAREN expr[from] ':'           ')' %prec NAME
                 {
-		  if( ! require_numeric(@from, *$from) ) YYERROR;
+		  if( ! require_integer(@from, *$from) ) YYERROR;
                   $$.from = $from;
                   $$.len = nullptr;
                 }
@@ -7016,7 +7062,7 @@ stop_status:    status         { $$ = NULL; }
                 }
                 ;
 
-subscripts:     LPAREN expr_list ')' {
+subscripts:     LPAREN subscript_exprs ')' {
 		  $$ = $2;
 		  const auto& exprs( $$->refers );
 		  bool ok = std::all_of( exprs.begin(), exprs.end(),
@@ -7036,18 +7082,18 @@ subscripts:     LPAREN expr_list ')' {
 		  }
 		}
                 ;
-expr_list:	expr
+subscript_exprs:	expr
 		{
-		  if( ! require_numeric(@expr, *$expr) ) YYERROR;
+		  if( ! require_integer(@expr, *$expr) ) YYERROR;
 		  $$ = new refer_list_t($expr);
 		}
-        |       expr_list expr {
+        |       subscript_exprs expr {
                   if( $1->size() == MAXIMUM_TABLE_DIMENSIONS ) {
                     error_msg(@1, "table dimensions limited to %d",
                              MAXIMUM_TABLE_DIMENSIONS);
                     YYERROR;
                   }
-		  if( ! require_numeric(@expr, *$expr) ) YYERROR;
+		  if( ! require_integer(@expr, *$expr) ) YYERROR;
                   $1->push_back($2); $$ = $1;
                 }
         |       ALL {
@@ -7718,7 +7764,7 @@ raise:          RAISE EXCEPTION NAME
 
 read:           read_file
                 {
-                  current.declaratives_evaluate($1.file, $1.handled);
+                  current.declaratives_evaluate($1.file);
                 }
                 ;
 
@@ -7905,7 +7951,7 @@ read_key:       %empty      { $$ = new cbl_refer_t();  }
 
 write:          write_file
                 {
-                  current.declaratives_evaluate( $1.file, $1.handled );
+                  current.declaratives_evaluate($1.file );
                 }
                 ;
 
@@ -8121,7 +8167,7 @@ end_delete:     %empty %prec DELETE
 
 rewrite:        rewrite1
                 {
-                  current.declaratives_evaluate($1.file, $1.handled);
+                  current.declaratives_evaluate($1.file);
                 }
                 ;
 
@@ -8162,12 +8208,21 @@ end_rewrite:    %empty %prec REWRITE
                 ;
 
 start:          start_impl end_start
+                {
+                  current.declaratives_evaluate($1);
+                }
         |       start_cond end_start
+                {
+                  current.declaratives_evaluate($1);
+                }
                 ;
-start_impl:     START start_body
+start_impl:     START start_body {
+		  $$ = $2;
+		}
                 ;
 start_cond:     START start_body io_invalids {
                   parser_fi();
+		  $$ = $2;
                 }
                 ;
 end_start:      %empty %prec START
@@ -8177,7 +8232,7 @@ end_start:      %empty %prec START
 start_body:     filename[file]
                 {
                   statement_begin(@$, START);
-                  file_start_args.init(@file, $file);
+                  $$ = file_start_args.init(@file, $file);
                   parser_file_start( $file, lt_op, 0 );
                 }
         |       filename[file] KEY relop name[key]
@@ -8191,26 +8246,26 @@ start_body:     filename[file]
                     yywarn("START: key #%d '%s' has size %d",
                           key, $key->name, size);
                   }
-                  file_start_args.init(@file, $file);
+                  $$ = file_start_args.init(@file, $file);
                   parser_file_start( $file, relop_of($relop), key, ksize );
                 }
         |       filename[file] KEY relop name[key] with LENGTH expr
                 { // lexer swallows IS, although relop allows it.
                   statement_begin(@$, START);
                   int key = $file->key_one($key);
-                  file_start_args.init(@file, $file);
+                  $$ = file_start_args.init(@file, $file);
                   parser_file_start( $file, relop_of($relop), key, *$expr );
                 }
         |       filename[file] FIRST
                 {
                   statement_begin(@$, START);
-                  file_start_args.init(@file, $file);
+                  $$ = file_start_args.init(@file, $file);
                   parser_file_start( $file, lt_op, -1 );
                 }
         |       filename[file] LAST
                 {
                   statement_begin(@$, START);
-                  file_start_args.init(@file, $file);
+                  $$ = file_start_args.init(@file, $file);
                   parser_file_start( $file, gt_op, -2 );
                 }
                 ;
@@ -9270,7 +9325,7 @@ call_impl:      CALL call_body[body]
 		  cbl_ffi_arg_t *pargs = NULL;
                   if( narg > 0 ) {
 		    std::copy( params->elems.begin(),
-			       params->elems.end(), args.begin() );	 
+			       params->elems.end(), args.begin() );
                     pargs = args.data();
                   }
                   ast_call( $body.loc, *$body.ffi_name,
@@ -9287,15 +9342,13 @@ call_cond:      CALL call_body[body] call_excepts[except]
 		  cbl_ffi_arg_t *pargs = NULL;
                   if( narg > 0 ) {
 		    std::copy( params->elems.begin(),
-			       params->elems.end(), args.begin() );	 
+			       params->elems.end(), args.begin() );
                     pargs = args.data();
                   }
                   ast_call( $body.loc, *$body.ffi_name,
                                *$body.ffi_returning, narg, pargs,
                                $except.on_error, $except.not_error, false );
-                  auto handled = ec_type_t( static_cast<size_t>(ec_program_e) |
-                                            static_cast<size_t>(ec_external_e));
-                  current.declaratives_evaluate(handled);
+                  current.declaratives_evaluate();
                 }
                 ;
 end_call:       %empty %prec CALL
@@ -9635,14 +9688,14 @@ string:         string_impl end_string
 string_impl:    STRING_kw string_body[body]
                 {
                   stringify($body.inputs, *$body.into.first, *$body.into.second);
-                  current.declaratives_evaluate(ec_none_e);
+                  current.declaratives_evaluate();
                 }
                 ;
 string_cond:    STRING_kw string_body[body] on_overflows[over]
                 {
                   stringify($body.inputs, *$body.into.first, *$body.into.second,
                             $over.on_error, $over.not_error);
-                  current.declaratives_evaluate(ec_overflow_e);
+                  current.declaratives_evaluate();
                 }
                 ;
 end_string:     %empty %prec LITERAL
@@ -9781,14 +9834,14 @@ end_unstring:   %empty %prec UNSTRING
 unstring_impl:  UNSTRING unstring_body[body]
                 {
                   unstringify( *$body.input, $body.delimited, $body.into );
-                  current.declaratives_evaluate(ec_none_e);
+                  current.declaratives_evaluate();
                 }
                 ;
 unstring_cond:  UNSTRING unstring_body[body] on_overflows[over]
                 {
                   unstringify( *$body.input, $body.delimited, $body.into,
                                $over.on_error, $over.not_error );
-                  current.declaratives_evaluate(ec_overflow_e);
+                  current.declaratives_evaluate();
                 }
                 ;
 
@@ -9963,7 +10016,6 @@ function_udf:   FUNCTION_UDF '(' arg_list[args] ')' {
                  *  var: [ALL] LITERAL, NUMSTR, instrinsic, or scalar
                  *  num_operand: signed NUMSTR/ZERO, instrinsic, or scalar
                  *  alpahaval: LITERAL, reserved_value, instrinsic, or scalar
-                 * Probably any numeric argument could be an expression.
                  */
 intrinsic:      function_udf
         |       intrinsic0
@@ -9989,7 +10041,7 @@ intrinsic:      function_udf
 					  args.size(), args.data() );
                 }
 
-        |       PRESENT_VALUE '(' expr_list[args] ')'
+        |       PRESENT_VALUE '(' arg_list[args] ')'
                 {
                   static char s[] = "__gg__present_value";
                   location_set(@1);
@@ -9997,11 +10049,15 @@ intrinsic:      function_udf
                   size_t n = $args->size();
                   assert(n > 0);
                   if( n < 2 ) {
-                    error_msg(@args, "PRESENT VALUE requires 2 parameters");
+                    error_msg(@args, "PRESENT-VALUE requires 2 parameters");
                     YYERROR;
                   }
                   std::vector <cbl_refer_t> args(n);
 		  std::copy( $args->begin(), $args->end(), args.begin() );
+		  bool ok = std::all_of( args.begin(),
+					 args.end(), [loc = @1]( auto r ) {
+					     return require_numeric(loc, r); } );
+		  if( ! ok ) YYERROR;
                   parser_intrinsic_callv( $$, s, args.size(), args.data() );
                 }
 
@@ -10910,7 +10966,12 @@ cdf_basis:      BASIS NAME /* BASIS is never passed to the parser.  */
         |       BASIS LITERAL
                 ;
 
-cdf_use:        USE DEBUGGING on labels
+cdf_use:        cdf_use_when {
+		  statement_cleanup = false;
+		}
+		;
+
+cdf_use_when:	USE DEBUGGING on labels
                 {
                   if( ! current.declarative_section_name() ) {
                     error_msg(@1, "USE valid only in DECLARATIVES");
@@ -10928,12 +10989,11 @@ cdf_use:        USE DEBUGGING on labels
                   }
                   static const cbl_label_t all = {
 		    LblNone, 0, 0,0,0, false, false, false, 0,0, ":all:" };
-		      ////.name = { ':', 'a', 'l', 'l', ':',  } // workaround for gcc < 11.3
                   add_debugging_declarative(&all);
                  }
 
         |       USE globally mistake procedure on filenames
-		{
+		{ // Format 1
                   if( ! current.declarative_section_name() ) {
 		    error_msg(@1, "USE valid only in DECLARATIVES");
                     YYERROR;
@@ -10945,8 +11005,8 @@ cdf_use:        USE DEBUGGING on labels
                                     std::back_inserter(files),
                                     file_list_t::symbol_index );
                   cbl_declarative_t declarative(current.declarative_section(),
-                                                ec_all_e, files,
-                                                file_mode_none_e, global);
+                                                ec_io_e, files,
+                                                file_mode_any_e, global);
                   current.declaratives.add(declarative);
 		}
 
@@ -10959,12 +11019,12 @@ cdf_use:        USE DEBUGGING on labels
                   bool global = $globally == GLOBAL;
                   std::list<size_t> files;
                   cbl_declarative_t declarative(current.declarative_section(),
-                                                ec_all_e, files,
+                                                ec_io_e, files,
                                                 $io_mode, global);
                   current.declaratives.add(declarative);
                 }
-        |       USE cdf_use_excepts // Format 3: AFTER swallowed by lexer
-                {
+        |       USE cdf_use_excepts
+                { // Format 3 (AFTER swallowed by lexer)
                   if( ! current.declarative_section_name() ) {
                     error_msg(@1, "USE valid only in DECLARATIVES");
                     YYERROR;
@@ -11079,23 +11139,71 @@ void ast_call( const YYLTYPE& loc, cbl_refer_t name, cbl_refer_t returning,
   parser_call( name, returning, narg, args, except, not_except, is_function );
 }
 
-static size_t
-statement_begin( const YYLTYPE& loc, int token ) {
-  // The following statement generates a message at run-time
-  // parser_print_string("statement_begin()\n");
-  location_set(loc);
-  prior_statement = token;
-
-  parser_statement_begin();
+/*
+ * Check if any EC *could* be raised that would be handled by a declarative. If
+ * so, the generated statement epilog will ask the runtime library to attempt
+ * to match any raised EC with a declarative.  If not, the statement epilog
+ * will be limited to calling the default EC handler, which logs unhandled ECs
+ * [todo] and calls abort(3) for fatal ECs.
+ */
+static bool
+possible_ec() {
+  bool format_1 = current.declaratives.has_format_1();
+      
+  bool enabled = 0xFF < (current.declaratives.status()
+			 &
+			 enabled_exceptions.status());
+  bool epilog = enabled || format_1;
+  
+  dbgmsg("%sEC handling for DCL %08x && EC %08x with %s Format 1",
+	 epilog? "" : "no ", 
+	 current.declaratives.status(),
+	 enabled_exceptions.status(), format_1? "a" : "no");
+  
+  return epilog;
+}
 
-  if( token != CONTINUE ) {
+/*
+ * If there's potential overlap between enabled ECs and Declaratives, generate
+ * a PERFORM of the _DECLARATIVES_EVAL "ladder" that matches a section number
+ * to its name, and executes the Declarative.
+ */
+static void
+statement_epilog( int token ) {
+  if( possible_ec() && token != CONTINUE ) { 
     if( enabled_exceptions.size() ) {
-      current.declaratives_evaluate(ec_none_e);
-      cbl_enabled_exceptions_array_t enabled(enabled_exceptions);
-      parser_exception_prepare( keyword_str(token), &enabled );
+      current.declaratives_evaluate();
     }
   }
-  return 0;
+  parser_check_fatal_exception();
+}
+
+static inline void
+statement_prolog( int token ) {
+  parser_statement_begin( keyword_str(token),
+			  current.declaratives.runtime.ena,
+			  current.declaratives.runtime.dcl );
+}
+
+/*
+ * We check the EC against the Declarative status prior to parsing the
+ * statement because a TURN directive can be embedded in the statement.  An
+ * embedded directive applies to the following statement, not the one being
+ * parsed.
+ */
+static void
+statement_begin( const YYLTYPE& loc, int token ) {
+  static int prior_token = 0;
+
+  if( statement_cleanup )  {
+    statement_epilog(prior_token);
+  } else {
+    statement_cleanup = true;
+  }
+  location_set(loc);
+  statement_prolog(token);
+
+  prior_token = token;
 }
 
 #include "parse_util.h"
@@ -11137,6 +11245,8 @@ tokenset_t::tokenset_t() {
 #include "token_names.h"
 }
 
+bool iso_cobol_word( const std::string& name, bool include_intrinsics );
+
 // Look up the lowercase form of a keyword, excluding some CDF names.
 int
 tokenset_t::find( const cbl_name_t name, bool include_intrinsics ) {
@@ -11166,8 +11276,10 @@ tokenset_t::find( const cbl_name_t name, bool include_intrinsics ) {
       }
   }
 
+  //// if( ! iso_cobol_word(uppercase(name), include_intrinsics) ) return 0;
+
   cbl_name_t lname;
-  std::transform(name, name + strlen(name) + 1, lname, tolower);
+  std::transform(name, name + strlen(name) + 1, lname, ftolower);
   auto p = tokens.find(lname);
   if( p == tokens.end() ) return 0;
   int token = p->second;
@@ -11645,8 +11757,7 @@ ast_add( arith_t *arith ) {
 
   parser_add( nC, pC, nA, pA, arith->format, arith->on_error, arith->not_error );
 
-  ec_type_t handled = arith->on_error || arith->not_error ? ec_size_e : ec_none_e;
-  current.declaratives_evaluate(handled);
+  current.declaratives_evaluate();
 }
 
 static bool
@@ -11662,8 +11773,7 @@ ast_subtract( arith_t *arith ) {
 
   parser_subtract( nC, pC, nA, pA, nB, pB, arith->format, arith->on_error, arith->not_error );
 
-  ec_type_t handled = arith->on_error || arith->not_error ? ec_size_e : ec_none_e;
-  current.declaratives_evaluate(handled);
+  current.declaratives_evaluate();
   return true;
 }
 
@@ -11680,8 +11790,7 @@ ast_multiply( arith_t *arith ) {
 
   parser_multiply( nC, pC, nA, pA, nB, pB, arith->on_error, arith->not_error );
 
-  ec_type_t handled = arith->on_error || arith->not_error ? ec_size_e : ec_none_e;
-  current.declaratives_evaluate(handled);
+  current.declaratives_evaluate();
   return true;
 }
 
@@ -11699,8 +11808,7 @@ ast_divide( arith_t *arith ) {
   parser_divide( nC, pC, nA, pA, nB, pB,
                  arith->remainder, arith->on_error, arith->not_error );
 
-  ec_type_t handled = arith->on_error || arith->not_error ? ec_size_e : ec_none_e;
-  current.declaratives_evaluate(handled);
+  current.declaratives_evaluate();
   return true;
 }
 
@@ -12686,7 +12794,7 @@ mode_syntax_only( cbl_division_t division ) {
 bool
 mode_syntax_only() {
   return cbl_syntax_only != not_syntax_only
-    && cbl_syntax_only <= current_division;
+      && cbl_syntax_only <= current_division;
 }
 
 void
@@ -12845,6 +12953,17 @@ require_numeric( YYLTYPE loc, cbl_refer_t scalar ) {
   return true;
 }
 
+static bool
+require_integer( YYLTYPE loc, cbl_refer_t scalar ) {
+  if( is_literal(scalar.field) ) {
+    if( ! is_integer_literal(scalar.field) ) {
+      error_msg(loc, "numeric literal '%s' must be an integer",
+		scalar.field->pretty_name());
+      return false;
+    }
+  }
+  return require_numeric(loc, scalar);
+}
 /* eval methods */
 
 eval_subject_t::eval_subject_t()
diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h
index 9de471f..f3a002a 100644
--- a/gcc/cobol/parse_ante.h
+++ b/gcc/cobol/parse_ante.h
@@ -76,33 +76,37 @@ void labels_dump();
 cbl_dialect_t cbl_dialect;
 size_t cbl_gcobol_features;
 
+static enum cbl_division_t current_division;
 static size_t nparse_error = 0;
 
-size_t parse_error_inc() { return ++nparse_error; }
+size_t parse_error_inc() {
+  mode_syntax_only(current_division);
+  return ++nparse_error;
+}
 size_t parse_error_count() { return nparse_error; }
 void input_file_status_notify();
 
-#define YYLLOC_DEFAULT(Current, Rhs, N)					\
-  do {									\
-      if (N)								\
-        {								\
-          (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;	\
-          (Current).first_column = YYRHSLOC (Rhs, 1).first_column;	\
-          (Current).last_line    = YYRHSLOC (Rhs, N).last_line;		\
-          (Current).last_column  = YYRHSLOC (Rhs, N).last_column;	\
-          location_dump("parse.c", N,					\
-                        "rhs N  ", YYRHSLOC (Rhs, N));			\
-        }								\
-      else								\
-        {								\
-          (Current).first_line   =					\
-          (Current).last_line    = YYRHSLOC (Rhs, 0).last_line;		\
-          (Current).first_column =					\
-          (Current).last_column  = YYRHSLOC (Rhs, 0).last_column;	\
-        }								\
-      location_dump("parse.c", __LINE__, "current", (Current));		\
-      gcc_location_set( location_set(Current) );			\
-      input_file_status_notify();					\
+#define YYLLOC_DEFAULT(Current, Rhs, N)                                 \
+  do {                                                                  \
+      if (N)                                                            \
+        {                                                               \
+          (Current).first_line   = YYRHSLOC (Rhs, 1).first_line;        \
+          (Current).first_column = YYRHSLOC (Rhs, 1).first_column;      \
+          (Current).last_line    = YYRHSLOC (Rhs, N).last_line;         \
+          (Current).last_column  = YYRHSLOC (Rhs, N).last_column;       \
+          location_dump("parse.c", N,                                   \
+                        "rhs N  ", YYRHSLOC (Rhs, N));                  \
+        }                                                               \
+      else                                                              \
+        {                                                               \
+          (Current).first_line   =                                      \
+          (Current).last_line    = YYRHSLOC (Rhs, 0).last_line;         \
+          (Current).first_column =                                      \
+          (Current).last_column  = YYRHSLOC (Rhs, 0).last_column;       \
+        }                                                               \
+      location_dump("parse.c", __LINE__, "current", (Current));         \
+      gcc_location_set( location_set(Current) );                        \
+      input_file_status_notify();                                       \
   } while (0)
 
 int yylex(void);
@@ -131,8 +135,6 @@ const char * original_picture();
 
 static const relop_t invalid_relop = static_cast<relop_t>(-1);
 
-static enum cbl_division_t current_division;
-
 static cbl_refer_t null_reference;
 static cbl_field_t *literally_one, *literally_zero;
 
@@ -181,21 +183,23 @@ has_clause( int data_clauses, data_clause_t clause ) {
   return clause == (data_clauses & clause);
 }
 
+
 static bool
-is_cobol_word( const char name[] ) {
+is_cobol_charset( const char name[] ) {
   auto eoname = name + strlen(name);
-  auto p = std::find_if( name, eoname,
+  auto ok = std::all_of( name, eoname,
                          []( char ch ) {
                            switch(ch) {
                            case '-':
                            case '_':
-                             return false;
+                             return true;
                            case '$': // maybe one day (IBM allows)
+                             return false;
                              break;
                            }
-                           return !ISALNUM(ch);
+                           return 0 != ISALNUM(ch);
                          } );
-  return p == eoname;
+  return ok;
 }
 
 bool
@@ -239,7 +243,7 @@ new_reference_like( const cbl_field_t& skel ) {
 
 static void reject_refmod( YYLTYPE loc, cbl_refer_t );
 static bool require_pointer( YYLTYPE loc, cbl_refer_t );
-static bool require_numeric( YYLTYPE loc, cbl_refer_t );
+static bool require_integer( YYLTYPE loc, cbl_refer_t );
 
 struct cbl_field_t * constant_of( size_t isym );
 
@@ -459,11 +463,12 @@ static class file_start_args_t {
   cbl_file_t *file;
 public:
   file_start_args_t() : file(NULL) {}
-  void init( YYLTYPE loc, cbl_file_t *file ) {
+  cbl_file_t * init( YYLTYPE loc, cbl_file_t *file ) {
     this->file = file;
     if( is_sequential(file) ) {
       error_msg(loc, "START invalid with sequential file %s", file->name);
     }
+    return file;
   }
   bool ready() const { return file != NULL; }
   void call_parser_file_start() {
@@ -933,6 +938,12 @@ class tokenset_t {
     std::transform(name, name + strlen(name) + 1, lname, ftolower);
     return lname;
   }
+  static std::string
+  uppercase( const cbl_name_t name ) {
+    cbl_name_t uname;
+    std::transform(name, name + strlen(name) + 1, uname, ftoupper);
+    return uname;
+  }
 
  public:
   tokenset_t();
@@ -1711,18 +1722,11 @@ static class current_t {
   int first_statement;
   bool in_declaratives;
   // from command line or early TURN
-  std::list<cbl_exception_files_t> cobol_exceptions;
+  std::list<exception_turn_t> exception_turns;
 
   error_labels_t error_labels;
 
   static void declarative_execute( cbl_label_t *eval ) {
-    if( !eval ) {
-      if( !enabled_exceptions.empty() ) {
-        auto index = new_temporary(FldNumericBin5);
-        parser_match_exception(index, NULL);
-      }
-      return;
-    }
     assert(eval);
     auto iprog = symbol_elem_of(eval)->program;
     if( iprog  == current_program_index() ) {
@@ -1825,6 +1829,11 @@ static class current_t {
     };
     std::set<file_exception_t> file_exceptions;
    public:
+    // current compiled data for enabled ECs and Declaratives, used by library.
+    struct runtime_t {
+      tree ena, dcl;
+    } runtime;
+    
     bool empty() const {
       return declaratives_list_t::empty();
     }
@@ -1854,14 +1863,44 @@ static class current_t {
       declaratives_list_t::push_back(declarative);
       return true;
     }
+
+    uint32_t status() const {
+      uint32_t status_word = 0;
+      for( auto dcl : *this ) {
+        status_word |= (EC_ALL_E & dcl.type );
+      }
+      return status_word;
+    }
+
+    bool has_format_1() const {
+      return std::any_of( begin(), end(),
+                          []( const cbl_declarative_t& dcl ) {
+                            return dcl.is_format_1();
+                          } );
+    }
+
+    std::vector<uint64_t> 
+    encode() const {
+      std::vector<uint64_t> encoded;
+      auto p = std::back_inserter(encoded);
+      for( const auto& dcl : *this ) {
+        *p++ = dcl.section;
+        *p++ = dcl.global;
+        *p++ = dcl.type;
+        *p++ = dcl.nfile;
+        p = std::copy(dcl.files, std::end(dcl.files), p);
+        *p++ = dcl.mode;
+      }
+      return encoded;
+    }
+
   } declaratives;
 
   void exception_add( ec_type_t ec,  bool enabled = true) {
-    std::set<size_t> files;
-    enabled_exceptions.turn_on_off(enabled,
-                                   false,  // for now
-                                   ec, files);
-    if( yydebug) enabled_exceptions.dump();
+    exception_turns.push_back(exception_turn_t(ec, enabled));
+  }
+  std::list<exception_turn_t>& pending_exceptions() {
+    return exception_turns;
   }
 
   bool typedef_add( const cbl_field_t *field ) {
@@ -2066,7 +2105,7 @@ static class current_t {
    */
   std::set<std::string>  end_program() {
     if( enabled_exceptions.size() ) {
-      declaratives_evaluate(ec_none_e);
+      declaratives_evaluate();
     }
 
     assert(!programs.empty());
@@ -2128,7 +2167,7 @@ static class current_t {
     return symbol_index(symbol_elem_of(section));
   }
 
-  cbl_label_t *doing_declaratives( bool begin ) {
+  cbl_label_t * doing_declaratives( bool begin ) {
     if( begin ) {
       in_declaratives = true;
       return NULL;
@@ -2138,6 +2177,8 @@ static class current_t {
     if( declaratives.empty() ) return NULL;
     assert(!declaratives.empty());
 
+    declaratives.runtime.dcl = parser_compile_dcls(declaratives.encode());
+
     size_t idcl = symbol_declaratives_add(program_index(), declaratives.as_list());
     programs.top().declaratives_index = idcl;
 
@@ -2163,6 +2204,25 @@ static class current_t {
     std::swap( programs.top().section, section );
     return section;
   }
+  
+  ec_type_t ec_type_of( file_status_t status ) {
+    static std::vector<ec_type_t> ec_by_status {
+      /* 0 */ ec_none_e, // ec_io_warning_e if low byte is nonzero
+      /* 1 */ ec_io_at_end_e, 
+      /* 2 */ ec_io_invalid_key_e,
+      /* 3 */ ec_io_permanent_error_e,
+      /* 4 */ ec_io_logic_error_e,
+      /* 5 */ ec_io_record_operation_e,
+      /* 6 */ ec_io_file_sharing_e,
+      /* 7 */ ec_io_record_content_e,
+      /* 8 */ ec_io_imp_e, // unused, not defined by ISO
+      /* 9 */ ec_io_imp_e,
+    };
+    int status10 = static_cast<unsigned int>(status) / 10;
+    gcc_assert(ec_by_status.size() == 10);
+    gcc_assert(0 <= status10 && status10 < 10 && status10 != 8);
+    return ec_by_status[status10];
+  }
 
   /*
    * END DECLARATIVES causes:
@@ -2180,18 +2240,8 @@ static class current_t {
    * alternative entry point (TODO).
    */
   void
-  declaratives_evaluate( cbl_file_t *file,
-                         file_status_t status = FsSuccess ) {
-    // The exception file number is assumed to be zero at all times unless
-    // it has been set to non-zero, at which point whoever picks it up and takes
-    // action on it is charged with setting it back to zero.
-    if( file )
-      {
-      parser_set_file_number((int)symbol_index(symbol_elem_of(file)));
-      }
-    // parser_set_file_number(file ? (int)symbol_index(symbol_elem_of(file)) : 0);
-    parser_set_handled((ec_type_t)status);
-
+  declaratives_evaluate( cbl_file_t *file ) {
+    gcc_assert(file);
     parser_file_stash(file);
 
     cbl_label_t *eval = programs.first_declarative();
@@ -2219,7 +2269,7 @@ static class current_t {
    * To indicate to the runtime-match function that we want to evaluate
    * only the exception condition, unrelated to a file, we set the
    * file register to 0 and the handled-exception register to the
-   * handled exception condition (not file status).
+   * handled exception condition. 
    *
    * declaratives_execute performs the "declarative ladder" produced
    * by declaratives_runtime_match.  That section CALLs the
@@ -2230,16 +2280,9 @@ static class current_t {
    * index, per usual.
    */
   void
-  declaratives_evaluate( ec_type_t handled = ec_none_e ) {
-    // The exception file number  is assumed to be zero unless it has been
-    // changed to a non-zero value.  The program picking it up and referencing
-    // it is charged with setting it back to zero.
-    // parser_set_file_number(0);
-
-    parser_set_handled(handled);
-
+  declaratives_evaluate() {
     cbl_label_t *eval = programs.first_declarative();
-    declarative_execute(eval);
+    if( eval ) declarative_execute(eval);
   }
 
   cbl_label_t * new_paragraph( cbl_label_t *para ) {
@@ -2283,6 +2326,10 @@ static class current_t {
   cbl_label_t * compute_label() { return error_labels.compute_error; }
 } current;
 
+void current_enabled_ecs( tree ena ) {
+  current.declaratives.runtime.ena = ena;
+}
+
 #define PROGRAM current.program_index()
 
 static void
@@ -2382,11 +2429,27 @@ literal_refmod_valid( YYLTYPE loc, const cbl_refer_t& r );
 
 static bool
 is_integer_literal( const cbl_field_t *field ) {
-  if( is_literal(field) ) {
-    int v, n;
+  if( field->type == FldLiteralN ) {
     const char *initial = field->data.initial;
 
-    return 1 == sscanf(initial, "%d%n", &v, &n) && n == (int)strlen(initial);
+    switch( *initial ) {
+    case '-': case '+': ++initial;
+    }
+
+    const char *eos = initial + strlen(initial);
+    auto p = std::find_if_not( initial, eos, fisdigit );
+    if( p == eos ) return true;
+    
+    if( *p++ == symbol_decimal_point() ) {
+      switch( *p++ ) {
+      case 'E': case 'e':
+	switch( *p++ ) {
+	case '+': case '-':
+	  return std::all_of(p, eos, []( char ch ) { return ch == '0'; } );
+	  break;
+	}
+      }
+    }
   }
   return false;
 }
@@ -3312,6 +3375,13 @@ procedure_division_ready( YYLTYPE loc, cbl_field_t *returning, ffi_args_t *ffi_a
     }
   }
 
+  // Apply ECs from the command line
+  std::list<exception_turn_t>& exception_turns = current.pending_exceptions();
+  for( const auto& exception_turn : exception_turns) {
+    apply_cdf_turn(exception_turn);
+  }
+  exception_turns.clear();
+  
   // Start the Procedure Division.
   size_t narg = ffi_args? ffi_args->elems.size() : 0;
   std::vector <cbl_ffi_arg_t> args(narg);
@@ -3544,6 +3614,11 @@ goodnight_gracie() {
   return true;
 }
 
+// false after USE statement, to enter Declarative with EC intact. 
+static bool statement_cleanup = true;
+
+static void statement_epilog( int token );
+
 const char * keyword_str( int token );
 
 static YYLTYPE current_location;
@@ -3555,9 +3630,7 @@ location_set( const YYLTYPE& loc ) {
   return current_location = loc;
 }
 
-static int prior_statement;
-
-static size_t statement_begin( const YYLTYPE& loc, int token );
+static void statement_begin( const YYLTYPE& loc, int token );
 
 static void ast_first_statement( const YYLTYPE& loc ) {
   if( current.is_first_statement( loc ) ) {
diff --git a/gcc/cobol/show_parse.h b/gcc/cobol/show_parse.h
index 9b1abb4..f7ab982 100644
--- a/gcc/cobol/show_parse.h
+++ b/gcc/cobol/show_parse.h
@@ -54,11 +54,20 @@ extern bool cursor_at_sol;
 #pragma GCC diagnostic push
 #pragma GCC diagnostic ignored "-Wmissing-field-initializers"
 
+/*
+ * In syntax-only mode, return immediately.  By using these macros, the parser
+ * can call code-generation functions unconditionally because it does not rely
+ * on the results.
+ */
 #define RETURN_IF_PARSE_ONLY                    \
   do { if(  mode_syntax_only() ) return; } while(0)
 
-#define SHOW_PARSE1                      if(bSHOW_PARSE)
-#define SHOW_PARSE RETURN_IF_PARSE_ONLY; if(bSHOW_PARSE)
+#define RETURN_XX_PARSE_ONLY(XX)			\
+  do { if(  mode_syntax_only() ) return XX; } while(0)
+
+#define SHOW_PARSE1                                   if(bSHOW_PARSE)
+#define SHOW_PARSE        RETURN_IF_PARSE_ONLY;       if(bSHOW_PARSE)
+#define SHOW_IF_PARSE(XX) RETURN_XX_PARSE_ONLY((XX)); if(bSHOW_PARSE)
 
 // _HEADER and _END are generally the first and last things inside the
 // SHOW_PARSE statement.  They don't have to be; SHOW_PARSE can be used
diff --git a/gcc/cobol/structs.cc b/gcc/cobol/structs.cc
index 6192486..7a4db97 100644
--- a/gcc/cobol/structs.cc
+++ b/gcc/cobol/structs.cc
@@ -217,6 +217,7 @@ create_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
+    size_t               symbol_index;     // The symbol table index of the related cbl_file_t structure
     char                *filename;         // The name of the file to be opened
     FILE                *file_pointer;     // The FILE *pointer
     cblc_field_t        *default_record;   // The record_area
@@ -251,8 +252,9 @@ typedef struct cblc_file_t
 
     tree retval = NULL_TREE;
     retval = gg_get_filelevel_struct_type_decl( "cblc_file_t",
-                                            30,
+                                            31,
                                             CHAR_P,    "name",
+                                            SIZE_T,    "symbol_table_index",
                                             CHAR_P,    "filename",
                                             FILE_P,    "file_pointer",
                                             cblc_field_p_type_node, "default_record",
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index 49152c7..13e78ee 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -1530,6 +1530,23 @@ field_str( const cbl_field_t *field ) {
       auto n = asprintf(&s, "'%s'", data);
       gcc_assert(n);
       auto eodata = data + field->data.capacity;
+      // It is possible for data.initial to be shorter than capacity.
+      
+      // This whole thing needs to be reexamined.  There is an assumption for
+      // FldAlphanumeric values that the valid data in data.initial be the same
+      // length as data.capacity.  But that does not hold true for other types.
+      // For example, a PIC 9V9 has a capacity of two, but the initial
+      // string provided by the COBOL programmer might be "1.2".  Likewise, a
+      // PIC 999999 (capacity 5) might have a value of "1".
+      
+      for(size_t i = 0; i<field->data.capacity; i++)
+        {
+        if( data[i] == '\0' )
+          {
+          eodata = data + i;
+          break;
+          }
+        }
       if( eodata != std::find_if_not(data, eodata, fisprint) ) {
         char *p = reinterpret_cast<char*>(xrealloc(s, n + 8 + 2 * field->data.capacity));
         if( is_elementary(field->type) &&
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index ea425ed..adfa8d9 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -513,7 +513,6 @@ struct cbl_field_t {
   tree data_decl_node;  // Reference to the run-time data of the COBOL variable
   //                    // For linkage_e variables, data_decl_node is a pointer
   //                    // to the data, rather than the actual data
-  tree literal_decl_node; // This is a FLOAT128 version of data.value
 
   void set_linkage( cbl_ffi_crv_t crv, bool optional ) {
     linkage.optional = optional;
@@ -2402,4 +2401,6 @@ void gcc_location_set( const LOC& loc );
 //  create an entire .h module.  So, I stuck it here.
 size_t count_characters(const char *in, size_t length);
 
+void current_enabled_ecs( tree ena );
+
 #endif
diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc
index dcf9538..edf4aa8 100644
--- a/gcc/cobol/util.cc
+++ b/gcc/cobol/util.cc
@@ -2214,6 +2214,7 @@ cbl_message(int fd, const char *format_string, ...)
   char *ostring = xvasprintf(format_string, ap);
   va_end(ap);
   write(fd, ostring, strlen(ostring));
+  write(fd, "\n", 1);
   free(ostring);
   }
 
@@ -2319,7 +2320,548 @@ int  ftolower(int c)
   {
   return TOLOWER(c);
   }
+int  ftoupper(int c)
+  {
+  return TOUPPER(c);
+  }
 bool fisprint(int c)
   {
   return ISPRINT(c);
   };
+
+// 8.9 Reserved words
+static const std::set<std::string> reserved_words = {
+  "ACCEPT",
+  "ACCESS",
+  "ACTIVE-CLASS",
+  "ADD",
+  "ADDRESS",
+  "ADVANCING",
+  "AFTER",
+  "ALIGNED",
+  "ALL",
+  "ALLOCATE",
+  "ALPHABET",
+  "ALPHABETIC",
+  "ALPHABETIC-LOWER",
+  "ALPHABETIC-UPPER",
+  "ALPHANUMERIC",
+  "ALPHANUMERIC-EDITED",
+  "ALSO",
+  "ALTERNATE",
+  "AND",
+  "ANY",
+  "ANYCASE",
+  "ARE",
+  "AREA",
+  "AREAS",
+  "AS",
+  "ASCENDING",
+  "ASSIGN",
+  "AT",
+  "B-AND",
+  "B-NOT",
+  "B-OR",
+  "B-SHIFT-L",
+  "B-SHIFT-LC",
+  "B-SHIFT-R",
+  "B-SHIFT-RC",
+  "B-XOR",
+  "BASED",
+  "BEFORE",
+  "BINARY",
+  "BINARY-CHAR",
+  "BINARY-DOUBLE",
+  "BINARY-LONG",
+  "BINARY-SHORT",
+  "BIT",
+  "BLANK",
+  "BLOCK",
+  "BOOLEAN",
+  "BOTTOM",
+  "BY",
+  "CALL",
+  "CANCEL",
+  "CF",
+  "CH",
+  "CHARACTER",
+  "CHARACTERS",
+  "CLASS",
+  "CLASS-ID",
+  "CLOSE",
+  "CODE",
+  "CODE-SET",
+  "COL",
+  "COLLATING",
+  "COLS",
+  "COLUMN",
+  "COLUMNS",
+  "COMMA",
+  "COMMIT",
+  "COMMON",
+  "COMP",
+  "COMPUTATIONAL",
+  "COMPUTE",
+  "CONDITION",
+  "CONFIGURATION",
+  "CONSTANT",
+  "CONTAINS",
+  "CONTENT",
+  "CONTINUE",
+  "CONTROL",
+  "CONTROLS",
+  "CONVERTING",
+  "COPY",
+  "CORR",
+  "CORRESPONDING",
+  "COUNT",
+  "CRT",
+  "CURRENCY",
+  "CURSOR",
+  "DATA",
+  "DATA-POINTER",
+  "DATE",
+  "DAY",
+  "DAY-OF-WEEK",
+  "DE",
+  "DECIMAL-POINT",
+  "DECLARATIVES",
+  "DEFAULT",
+  "DELETE",
+  "DELIMITED",
+  "DELIMITER",
+  "DEPENDING",
+  "DESCENDING",
+  "DESTINATION",
+  "DETAIL",
+  "DISPLAY",
+  "DIVIDE",
+  "DIVISION",
+  "DOWN",
+  "DUPLICATES",
+  "DYNAMIC",
+  "EC",
+  "EDITING",
+  "ELSE",
+  "EMD-START",
+  "END",
+  "END-ACCEPT",
+  "END-ADD",
+  "END-CALL",
+  "END-COMPUTE",
+  "END-DELETE",
+  "END-DISPLAY",
+  "END-DIVIDE",
+  "END-EVALUATE",
+  "END-IF",
+  "END-MULTIPLY",
+  "END-OF-PAGE",
+  "END-PERFORM",
+  "END-READ",
+  "END-RECEIVE",
+  "END-RETURN",
+  "END-REWRITE",
+  "END-SEARCH",
+  "END-SEND",
+  "END-STRING",
+  "END-SUBTRACT",
+  "END-UNSTRING",
+  "END-WRITE",
+  "ENVIRONMENT",
+  "EO",
+  "EOP",
+  "EQUAL",
+  "ERROR",
+  "EVALUATE",
+  "EXCEPTION",
+  "EXCEPTION-OBJECT",
+  "EXCLUSIVE-OR",
+  "EXIT",
+  "EXTEND",
+  "EXTERNAL",
+  "FACTORY",
+  "FALSE",
+  "FARTHEST-FROM-ZERO",
+  "FD",
+  "FILE",
+  "FILE-CONTROL",
+  "FILLER",
+  "FINAL",
+  "FINALLY",
+  "FIRST",
+  "FLOAT-BINARY-128",
+  "FLOAT-BINARY-32",
+  "FLOAT-BINARY-64",
+  "FLOAT-DECIMAL-16",
+  "FLOAT-DECIMAL-34",
+  "FLOAT-EXTENDED",
+  "FLOAT-INFINITY",
+  "FLOAT-LONG",
+  "FLOAT-NOT-A-NUMBER",
+  "FLOAT-NOT-A-NUMBER-",
+  "FLOAT-NOT-A-NUMBER-",
+  "FLOAT-SHORT",
+  "FOOTING",
+  "FOR",
+  "FORMAT",
+  "FREE",
+  "FROM",
+  "FUNCTION",
+  "FUNCTION-ID",
+  "FUNCTION-POINTER",
+  "GENERATE",
+  "GET",
+  "GIVING",
+  "GLOBAL",
+  "GO",
+  "GOBACK",
+  "GREATER",
+  "GROUP",
+  "GROUP-USAGE",
+  "HEADING",
+  "HIGH-VALUE",
+  "HIGH-VALUES",
+  "I-O",
+  "I-OICONTROL",
+  "IDENTIFICATION",
+  "IF",
+  "IN",
+  "IN-ARITHMETIC-RANGE",
+  "INDEX",
+  "INDEXED",
+  "INDICATE",
+  "INHERITS",
+  "INITIAL",
+  "INITIALIZE",
+  "INITIATE",
+  "INPUT",
+  "INPUT-OUTPUT",
+  "INSPECT",
+  "INTERFACE",
+  "INTERFACE-ID",
+  "INTO",
+  "INVALID",
+  "INVOKE",
+  "IS",
+  "JUST",
+  "JUSTIFIED",
+  "KEY",
+  "LAST",
+  "LEADING",
+  "LEFT",
+  "LENGTH",
+  "LESS",
+  "LIMIT",
+  "LIMITS",
+  "LINAGE",
+  "LINAGE-COUNTER",
+  "LINE",
+  "LINE-COUNTER",
+  "LINES",
+  "LINKAGE",
+  "LOCAL-STORAGE",
+  "LOCALE",
+  "LOCATION",
+  "LOCK",
+  "LOW-VALUE",
+  "LOW-VALUES",
+  "MERGE",
+  "MESSAGE-TAG",
+  "METHOD-ID",
+  "MINUS",
+  "MODE",
+  "MOVE",
+  "MULTIPLY",
+  "NATIONAL",
+  "NATIONAL-EDITED",
+  "NATIVE",
+  "NEAREST-TO-ZERO",
+  "NEGATIVE",
+  "NESTED",
+  "NEXT",
+  "NO",
+  "NOT",
+  "NULL",
+  "NUMBER",
+  "NUMERIC",
+  "NUMERIC-EDITED",
+  "OBJECT",
+  "OBJECT-COMPUTER",
+  "OBJECT-REFERENCE",
+  "OCCURS",
+  "OF",
+  "OFF",
+  "OMITTED",
+  "ON",
+  "OPEN",
+  "OPTIONAL",
+  "OPTIONS",
+  "OR",
+  "ORDER",
+  "ORGANIZATION",
+  "OTHER",
+  "OUTPUT",
+  "OVERFLOW",
+  "OVERRIDE",
+  "PACKED-DECIMAL",
+  "PAGE",
+  "PAGE-COUNTER",
+  "PERFORM",
+  "PF",
+  "PH",
+  "PIC",
+  "PICTURE",
+  "PLUS",
+  "POINTER",
+  "POSITIVE",
+  "PRESENT",
+  "PRINTING",
+  "PROCEDURE",
+  "PROGRAM",
+  "PROGRAM-ID",
+  "PROGRAM-POINTER",
+  "PROPERTY",
+  "PROTOTYPE",
+  "QUIET",
+  "QUOTE",
+  "QUOTES",
+  "RAISE",
+  "RAISING",
+  "RANDOM",
+  "RD",
+  "READ",
+  "RECEIVE",
+  "RECORD",
+  "RECORDS",
+  "REDEFINES",
+  "REEL",
+  "REFERENCE",
+  "RELATIVE",
+  "RELEASE",
+  "REMAINDER",
+  "REMOVAL",
+  "RENAMES",
+  "REPLACE",
+  "REPLACING",
+  "REPORT",
+  "REPORTING",
+  "REPORTS",
+  "REPOSITORY",
+  "RESERVE",
+  "RESET",
+  "RESUME",
+  "RETRY",
+  "RETURN",
+  "RETURNING",
+  "REWIND",
+  "REWRITE",
+  "RF",
+  "RH",
+  "RIGHT",
+  "ROLLBACK",
+  "ROUNDED",
+  "RUN",
+  "SAME",
+  "SCREEN",
+  "SD",
+  "SEARCH",
+  "SECTION",
+  "SELECT",
+  "SELF",
+  "SEND",
+  "SENTENCE",
+  "SEPARATE",
+  "SEQUENCE",
+  "SEQUENTIAL",
+  "SET",
+  "SHARING",
+  "SIGN",
+  "SIGNALING",
+  "SIZE",
+  "SORT",
+  "SORT-MERGE",
+  "SOURCE",
+  "SOURCE-COMPUTER",
+  "SOURCES",
+  "SPACE",
+  "SPACES",
+  "SPECIAL-NAMES",
+  "STANDARD",
+  "STANDARD-1",
+  "STANDARD-2",
+  "START",
+  "STATUS",
+  "STOP",
+  "STRING",
+  "SUBTRACT",
+  "SUM",
+  "SUPER",
+  "SUPPRESS",
+  "SYMBOLIC",
+  "SYNC",
+  "SYNCHRONIZED",
+  "SYSTEM-DEFAULT",
+  "TABLE",
+  "TALLYING",
+  "TERMINATE",
+  "TEST",
+  "THAN",
+  "THEN",
+  "THROUGH",
+  "THRU",
+  "TIME",
+  "TIMES",
+  "TO",
+  "TOP",
+  "TRAILING",
+  "TRUE",
+  "TYPE",
+  "TYPEDEF",
+  "UNIT",
+  "UNIVERSAL",
+  "UNLOCK",
+  "UNSTRING",
+  "UNTIL",
+  "UP",
+  "UPON",
+  "USAGE",
+  "USE",
+  "USER-DEFAULT",
+  "USING",
+  "VAL-STATUS",
+  "VALID",
+  "VALIDATE",
+  "VALIDATE-STATUS",
+  "VALUE",
+  "VALUES",
+  "VARYING",
+  "WHEN",
+  "WITH",
+  "WORKING-STORAGE",
+  "WRITE",
+  "XOR",
+  "ZERO",
+  "ZEROES",
+  "ZEROS",
+  "+",
+  "-",
+  "*",
+  "/",
+  "**",
+  "<",
+  "<=",
+  "<>",
+  "=",
+  ">",
+  ">=",
+  "&",
+  "*>",
+  "::",
+  ">>",
+};
+
+// 8.10 Context-sensitive words
+static const std::set<std::string> context_sensitive_words = {
+  "ACTIVATING",              // MODULE-NAME intrinsic function
+  "ANUM",                    // CONVERT intrinsic function
+  "APPLY",                   // I-O-CONTROL paragraph
+  "ARITHMETIC",              // OPTIONS paragraph
+  "ATTRIBUTE",               // SET statement
+  "AUTO",                    // screen description entry
+  "AUTOMATIC",               // LOCK MODE clause
+  "AWAY-FROM-ZERO",          // ROUNDED phrase
+  "BACKGROUND-COLOR",        // screen description entry
+  "BACKWARD",                // INSPECT statement
+  "BELL",                    // screen description entry and SET attribute statement
+  "BINARY-ENCODING",         // USAGE clause and FLOAT-DECIMAL clause
+  "BLINK",                   // screen description entry and SET attribute statement
+  "BYTE",                    // CONVERT intrinsic function
+  "BYTES",                   // RECORD clause
+  "BYTE-LENGTH",             // constant entry
+  "CAPACITY",                // OCCURS clause
+  "CENTER",                  // COLUMN clause
+  "CLASSIFICATION",          // OBJECT-COMPUTER paragraph
+  "CURRENT",                 // MODULE-NAME intrinsic function
+  "CYCLE",                   // EXIT statement
+  "DECIMAL-ENCODING",        // USAGE clause and FLOAT-DECIMAL clause
+  "EOL",                     // ERASE clause in a screen description entry
+  "EOS",                     // ERASE clause in a screen description entry
+  "ENTRY-CONVENTION",        // OPTIONS paragraph
+  "ERASE",                   // screen description entry
+  "EXPANDS",                 // class-specifier and interface-specifier of the REPOSITORY paragraph
+  "FLOAT-BINARY",            // OPTIONS paragraph
+  "FLOAT-DECIMAL",           // OPTIONS paragraph
+  "FOREGROUND-COLOR",        // screen description entry
+  "FOREVER",                 // RETRY phrase
+  "FULL",                    // screen description entry
+  "HEX",                     // CONVERT intrinsic function
+  "HIGH-ORDER-LEFT",         // FLOAT-BINARY clause, FLOAT-DECIMAL clause, and USAGE clause
+  "HIGH-ORDER-RIGHT",        // FLOAT-BINARY clause, FLOAT-DECIMAL clause, and USAGE clause
+  "HIGHLIGHT",               // screen description entry and SET attribute statement
+  "IGNORING",                // READ statement
+  "IMPLEMENTS",              // FACTORY paragraph and OBJECT paragraph
+  "INITIALIZED",             // ALLOCATE statement and OCCURS clause
+  "INTERMEDIATE",            // OPTIONS paragraph
+  "INTRINSIC",               // function-specifier of the REPOSITORY paragraph
+  "LC_ALL",                  // SET statement
+  "LC_COLLATE",              // SET statement
+  "LC_CTYPE",                // SET statement
+  "LC_MESSAGES",             // SET statement
+  "LC_MONETARY",             // SET statement
+  "LC_NUMERIC",              // SET statement
+  "LC_TIME",                 // SET statement
+  "LOWLIGHT",                // screen description entry and SET attribute statement
+  "MANUAL",                  // LOCK MODE clause
+  "MULTIPLE",                // LOCK ON phrase
+  "NAT",                     // CONVERT intrinsic function
+  "NEAREST-AWAY-FROM-ZERO",  // INTERMEDIATE ROUNDING clause and ROUNDED phrase
+  "NEAREST-EVEN",            // INTERMEDIATE ROUNDING clause and ROUNDED phrase
+  "NEAREST-TOWARD-ZERO",     // INTERMEDIATE ROUNDING clause and ROUNDED phrase
+  "NONE",                    // DEFAULT clause
+  "NORMAL",                  // STOP statement
+  "NUMBERS",                 // COLUMN clause and LINE clause
+  "ONLY",                    // Object-view, SHARING clause, SHARING phrase, and USAGE clause
+  "PARAGRAPH",               // EXIT statement
+  "PREFIXED",                // DYNAMIC LENGTH STRUCTURE clause
+  "PREVIOUS",                // READ statement
+  "PROHIBITED",              // INTERMEDIATE ROUNDING clause and ROUNDED phrase
+  "RECURSIVE",               // PROGRAM-ID paragraph
+  "RELATION",                // VALIDATE-STATUS clause
+  "REQUIRED",                // screen description entry
+  "REVERSE-VIDEO",           // screen description entry and SET attribute statement
+  "ROUNDING",                // OPTIONS paragraph
+  "SECONDS",                 // RETRY phrase, CONTINUE statement
+  "SECURE",                  // screen description entry
+  "SHORT",                   // DYNAMIC LENGTH STRUCTURE clause
+  "SIGNED",                  // DYNAMIC LENGTH STRUCTURE clause and USAGE clause
+  "STACK",                   // MODULE-NAME intrinsic function
+  "STANDARD-BINARY",         // ARITHMETIC clause
+  "STANDARD-DECIMAL",        // ARITHMETIC clause
+  "STATEMENT",               // RESUME statement
+  "STEP",                    // OCCURS clause
+  "STRONG",                  // TYPEDEF clause
+  "STRUCTURE",               // DYNAMIC LENGTH STRUCTURE clause
+  "SYMBOL",                  // CURRENCY clause
+  "TOP-LEVEL",               // MODULE-NAME intrinsic function
+  "TOWARD-GREATER",          // ROUNDED phrase
+  "TOWARD-LESSER",           // ROUNDED phrase
+  "TRUNCATION",              // INTERMEDIATE ROUNDING clause and ROUNDED phrase
+  "UCS-4",                   // ALPHABET clause
+  "UNDERLINE",               // screen description entry and SET attribute statement
+  "UNSIGNED",                // USAGE clause
+  "UTF-8",                   // ALPHABET clause
+  "UTF-16",                  // ALPHABET clause
+  "YYYYDDD",                 // ACCEPT statement
+  "YYYYMMDD",                // ACCEPT statement
+};
+
+// Is the input a COBOL word, per ISO/IEC 1989:2023 (E) ?
+bool
+iso_cobol_word( const std::string& name, bool include_intrinsics ) {
+  auto ok = 1 == reserved_words.count(name);
+  if( include_intrinsics && !ok ) {
+    ok = 1 == context_sensitive_words.count(name);
+  }
+  return ok;
+}
+
diff --git a/gcc/cobol/util.h b/gcc/cobol/util.h
index eb08ed7..20d735d 100644
--- a/gcc/cobol/util.h
+++ b/gcc/cobol/util.h
@@ -40,6 +40,7 @@ void cbl_errx(const char *format_string, ...);
 bool fisdigit(int c);
 bool fisspace(int c);
 int  ftolower(int c);
+int  ftoupper(int c);
 bool fisprint(int c);
 
 const char * cobol_filename_restore();