diff --git a/gcc/cobol/cobol1.cc b/gcc/cobol/cobol1.cc
index 3bd21c7..63f2b37 100644
--- a/gcc/cobol/cobol1.cc
+++ b/gcc/cobol/cobol1.cc
@@ -20,15 +20,15 @@
 
 
 #include "cobol-system.h"
-#include "coretypes.h"
-#include "tree.h"
-#include "diagnostic.h"
-#include "opts.h"
-#include "debug.h"
-#include "langhooks.h"
-#include "langhooks-def.h"
-#include "target.h"
-#include "stringpool.h"
+#include <coretypes.h>
+#include <tree.h>
+#include <diagnostic.h>
+#include <opts.h>
+#include <debug.h>
+#include <langhooks.h>
+#include <langhooks-def.h>
+#include <target.h>
+#include <stringpool.h>
 #include "../../libgcobol/ec.h"
 #include "../../libgcobol/common-defs.h"
 #include "util.h"
@@ -39,7 +39,6 @@
 #include "genapi.h"
 #include "../../libgcobol/exceptl.h"
 #include "exceptg.h"
-#include "util.h"
 #include "gengen.h"   // This has some GTY(()) markers
 #include "structs.h"  // This has some GTY(()) markers
 
@@ -357,6 +356,10 @@
             copybook_extension_add(cobol_copyext);
             return true;
 
+        case OPT_M:
+	    cobol_set_pp_option('M');
+            return true;
+
         case OPT_fstatic_call:
             use_static_call( arg? true : false );
             return true;
diff --git a/gcc/cobol/except.cc b/gcc/cobol/except.cc
index 2118233..d477139 100644
--- a/gcc/cobol/except.cc
+++ b/gcc/cobol/except.cc
@@ -78,10 +78,10 @@
 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 );
+              i,
+              location? "location" : "    none",
+              ec_type_str(ec),
+              file );
 }
 
 cbl_enabled_exceptions_t enabled_exceptions;
@@ -263,66 +263,6 @@
 }
 
 cbl_field_t * new_temporary_decl();
-
-/*
- * For a program, create a "DECLARATIVES" entry in the symbol table,
- * representing eligible declarative sections in priorty order:
- * in-program first, followed by any global declaratives in parent
- * programs.  These decribe the USE criteria declared for each
- * declarative section.
- *
- * The field's initial value is actually an array of
- * cbl_declarartive_t, in which the first element is unused, except
- * that array[0].section represents the number of elements, starting
- * at array[1].
- *
- * The returned value is the declarative's symbol index.  It is passed
- * to match_exception, which scans it for a declarative whose criteria
- * match the raised exception.  That function returns the
- * cbl_declarative_t::section, which the program then uses to PERFORM
- * that section.
- */
-size_t
-symbol_declaratives_add( size_t program,
-                         const std::list<cbl_declarative_t>& dcls )
-{
-  auto n = dcls.size();
-  if( n == 0 ) return 0;
-
-  auto blob = new cbl_declarative_t[ 1 + n ];
-
-  auto pend = std::copy_if( dcls.begin(), dcls.end(), blob + 1,
-                            choose_declarative(program) );
-
-  std::sort( blob + 1, pend, sort_supers_last );
-
-  // Overload blob[0].section to be the count.
-  blob[0].section = (pend - blob) - 1;
-
-  size_t len = reinterpret_cast<char*>(pend)
-             - reinterpret_cast<char*>(blob);
-  assert(len == (blob[0].section + 1) * sizeof(blob[0]));
-
-  // Construct a "blob" in the symbol table.
-  static int blob_count = 1;
-  char achBlob[32];
-  sprintf(achBlob, "_DECLARATIVE_BLOB%d_", blob_count++);
-
-  cbl_field_data_t data = {};
-  data.memsize = capacity_cast(len);
-  data.capacity = capacity_cast(len);
-  data.initial = reinterpret_cast<char*>(blob);
-  data.picture = reinterpret_cast<char*>(blob);
-  cbl_field_t field = { 0, FldBlob, FldInvalid, constant_e,
-                        0, 0, 0, cbl_occurs_t(), 0, "",
-                        0, {}, data, NULL };
-  strcpy(field.name, achBlob);
-
-  auto e = symbol_field_add(program, &field);
-  parser_symbol_add(cbl_field_of(e));
-  return symbol_index(e);
-}
-
 /*
  * Generate the code to evaluate declaratives.  This is the "secret
  * section" right after END DECLARATIVES.  Its name is
@@ -345,37 +285,42 @@
 file_status_t current_file_handled_status();
 
 void
-declarative_runtime_match( cbl_field_t *declaratives, cbl_label_t *lave ) {
+declarative_runtime_match( const std::list<cbl_declarative_t>& declaratives,
+			   cbl_label_t *lave )
+{
   if( getenv("GCOBOL_SHOW") )
     {
     fprintf(stderr, "( %d ) %s: \n", cobol_location().first_line, __func__);
     }
   if( getenv("GCOBOL_TRACE") )
     {
-    gg_printf(">>>>>>( %d )(%s) declaratives:%s lave:%s\n",
+    gg_printf(">>>>>>( %d )(%s) declaratives: lave:%s\n",
               build_int_cst_type(INT, cobol_location().first_line),
               gg_string_literal(__func__),
-              gg_string_literal(declaratives->name),
               gg_string_literal(lave->name),
               NULL_TREE);
     }
   static auto yes = new_temporary(FldConditional);
-  static auto psection = new_temporary(FldNumericBin5);
+  static auto isection = new_temporary(FldNumericBin5);
+  static auto index = new_temporary(FldNumericBin5);
 
+  /*
+   * Generate a sequence of COBOL IF statements to match the Declarative's
+   * symbol table index to its performable section.  The entire sequence is
+   * guarded by a runtime IF that evaluates to TRUE only if the "current EC" is
+   * nonzero.  This way, when _DECLARATIVES_EVAL is performed, it does nothing
+   * if no EC was raised.
+   */
   IF( var_decl_exception_code, ne_op, integer_zero_node ) {
-    // Send blob, get declarative section index.
-    auto index = new_temporary(FldNumericBin5);
+    // Get declarative section index matching any raised EC.
     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 );
+    for( const auto& dcl : declaratives ) {
+      parser_set_numeric( isection, dcl.section );
+      parser_relop( yes, index, eq_op, isection );
       parser_if( yes );
-      auto section = cbl_label_of(symbol_at(p->section));
+      auto section = cbl_label_of(symbol_at(dcl.section));
       parser_push_exception();
       parser_perform(section);
       parser_pop_exception();
@@ -385,17 +330,15 @@
     }
   }
   ELSE {
-    if( getenv("TRACE1") )
+    if( getenv("GCOBOL_TRACE") )
       {
-	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);
+        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);
 }
 
 ec_type_t
diff --git a/gcc/cobol/exceptg.h b/gcc/cobol/exceptg.h
index 1cfb8df..e29e056 100644
--- a/gcc/cobol/exceptg.h
+++ b/gcc/cobol/exceptg.h
@@ -36,8 +36,8 @@
 extern const char * ec_type_str( ec_type_t type );
 extern ec_disposition_t ec_type_disposition( ec_type_t type );
 
-extern void declarative_runtime_match(cbl_field_t *declaratives,
-                                      cbl_label_t *lave );
+extern void declarative_runtime_match( const std::list<cbl_declarative_t>& declaratives,
+				       cbl_label_t *lave );
 
 static inline ec_disposition_t
 ec_implemented( ec_disposition_t disposition ) {
@@ -96,9 +96,6 @@
 
 };
 
-size_t symbol_declaratives_add( size_t program,
-                                const std::list<cbl_declarative_t>& dcls );
-
 #endif
 
 
diff --git a/gcc/cobol/gcobc b/gcc/cobol/gcobc
index 1d469ed..6154c78 100755
--- a/gcc/cobol/gcobc
+++ b/gcc/cobol/gcobc
@@ -73,7 +73,7 @@
 
 exit_status=0
 skip_arg=
-opts="$copydir ${dialect:--dialect mf} $includes"
+opts="-dialect gnu $copydir ${dialect:--dialect mf} $includes"
 mode=-shared
 
 incomparable="has no comparable gcobol option"
diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index 70df86a..1ed4cef 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -80,6 +80,8 @@
 bool show_parse_sol = true;
 int  show_parse_indent = 0;
 
+static bool sv_is_i_o = false;
+
 #define DEFAULT_LINE_NUMBER 2
 
 #ifdef LINE_TICK
@@ -933,8 +935,20 @@
  * Performs the matched declarative, and execution continues with the next
  * statement.
  */
-tree parser_compile_ecs( const std::vector<uint64_t>& ecs )
+tree
+parser_compile_ecs( const std::vector<uint64_t>& ecs )
   {
+  if( ecs.empty() )
+    {
+    SHOW_IF_PARSE(nullptr)
+      {
+      SHOW_PARSE_HEADER
+      SHOW_PARSE_TEXT("ecs is empty");
+      SHOW_PARSE_END
+      }
+    return NULL_TREE;
+    }
+
   char ach[32];
   static int counter = 1;
   sprintf(ach, "_ecs_table_%d", counter++);
@@ -968,12 +982,23 @@
  * 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 )
+tree
+parser_compile_dcls( const std::vector<uint64_t>& dcls )
   {
+  if( dcls.empty() )
+    {
+    SHOW_IF_PARSE(nullptr)
+      {
+      SHOW_PARSE_HEADER
+      SHOW_PARSE_TEXT("dcls is empty");
+      SHOW_PARSE_END
+      }
+    return NULL_TREE;
+    }
+
   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)
     {
@@ -983,7 +1008,6 @@
     SHOW_PARSE_TEXT(ach);
     SHOW_PARSE_END
     }
-
   TRACE1
     {
     TRACE1_HEADER
@@ -1036,16 +1060,28 @@
     gg_assign(var_decl_nop, build_int_cst_type(INT, 106));
     }
 
-  store_location_stuff(statement_name);
+  // At this point, if any exception is enabled, we store the location stuff.
+  // Each file I-O routine calls store_location_stuff explicitly, because
+  // those exceptions can't be defeated.
+
+  if( enabled_exceptions.size() )
+    {
+    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);
-  
+  // if( ecs || dcls || sv_is_i_o )
+    {
+    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() );
+  sv_is_i_o = false;
   }
 
 static void
@@ -1516,42 +1552,28 @@
 //  gg_attribute_bit_clear(var, refmod_e);
   }
 
-static void
-gg_get_depending_on_value(tree depending_on, cbl_field_t *current_sizer)
+static
+void
+depending_on_value(tree depending_on, cbl_field_t *current_sizer)
   {
   // We have to deal with the possibility of a DEPENDING_ON variable,
   // and we have to apply array bounds whether or not there is a DEPENDING_ON
   // variable:
 
-  tree occurs_lower = gg_define_variable(LONG, "_lower");
-  tree occurs_upper = gg_define_variable(LONG, "_upper");
-
-  gg_assign(occurs_lower, build_int_cst_type(LONG, current_sizer->occurs.bounds.lower));
-  gg_assign(occurs_upper, build_int_cst_type(LONG, current_sizer->occurs.bounds.upper));
+//  tree occurs_lower = gg_define_variable(LONG, "_lower");
+//  tree occurs_upper = gg_define_variable(LONG, "_upper");
+//
+//  gg_assign(occurs_lower, build_int_cst_type(LONG, current_sizer->occurs.bounds.lower));
+//  gg_assign(occurs_upper, build_int_cst_type(LONG, current_sizer->occurs.bounds.upper));
 
   if( current_sizer->occurs.depending_on )
     {
-    // Get the current value of the depending_on data-item:
-    tree value = gg_define_int128();
-    get_binary_value( value,
-                      NULL,
-                      cbl_field_of(symbol_at(current_sizer->occurs.depending_on)),
-                      size_t_zero_node);
-    gg_assign(depending_on, gg_cast(LONG, value));
-    IF( depending_on, lt_op, occurs_lower )
-    // depending_is can be no less than occurs_lower:
-      gg_assign(depending_on, occurs_lower );
-    ELSE
-      ENDIF
-    IF( depending_on, gt_op, occurs_upper )
-    // depending_is can be no greater than occurs_upper:
-      gg_assign(depending_on, occurs_upper );
-    ELSE
-      ENDIF
+    get_depending_on_value_from_odo(depending_on, current_sizer);
     }
   else
     {
-    gg_assign(depending_on, occurs_upper);
+    gg_assign(depending_on,
+              build_int_cst_type(LONG, current_sizer->occurs.bounds.upper));
     }
   }
 
@@ -5107,7 +5129,7 @@
  *  2.  ARG_VALUE_e, the ARGUMENT-VALUE
  *  3.  ENV_NAME_e, the ENVIRONMENT-NAME
  *  4.  ENV_VALUE_e, the ENVIRONMENT-VALUE
- * that need special care and feeding. 
+ * that need special care and feeding.
  */
 void
 parser_display( const struct cbl_special_name_t *upon,
@@ -5169,6 +5191,18 @@
         gg_assign(file_descriptor, integer_two_node);
         break;
 
+      case ENV_NAME_e:
+        // This Part I of the slightly absurd method of using DISPLAY...UPON
+        // to fetch, or set, environment variables.
+        gg_call(VOID,
+                "__gg__set_env_name",
+                gg_get_address_of(refs[0].field->var_decl_node),
+                refer_offset(refs[0]),
+                refer_size_source(refs[0]),
+                NULL_TREE);
+         return;
+         break;
+
       default:
         if( upon->os_filename[0] )
           {
@@ -9281,6 +9315,7 @@
     quoted_name = true;
     }
 
+  sv_is_i_o = true;
   store_location_stuff("OPEN");
   gg_call(VOID,
           "__gg__file_open",
@@ -9332,6 +9367,7 @@
   // We are done with the filename.  The library routine will free "filename"
   // memory and set it back to null
 
+  sv_is_i_o = true;
   store_location_stuff("CLOSE");
   gg_call(VOID,
           "__gg__file_close",
@@ -9417,6 +9453,7 @@
     where = 1;
     }
 
+  sv_is_i_o = true;
   store_location_stuff("READ");
   gg_call(VOID,
           "__gg__file_read",
@@ -9551,6 +9588,7 @@
     record_area = cbl_field_of(symbol_at(file->default_record));
     }
 
+  sv_is_i_o = true;
   store_location_stuff("WRITE");
   gg_call(VOID,
           "__gg__file_write",
@@ -9620,6 +9658,7 @@
     SHOW_PARSE_END
     }
 
+  sv_is_i_o = true;
   store_location_stuff("DELETE");
   gg_call(VOID,
           "__gg__file_delete",
@@ -9676,6 +9715,7 @@
     record_area = cbl_field_of(symbol_at(file->default_record));
     }
 
+  sv_is_i_o = true;
   store_location_stuff("REWRITE");
   gg_call(VOID,
           "__gg__file_rewrite",
@@ -9785,6 +9825,7 @@
                       refer_offset(length_ref));
     }
 
+  sv_is_i_o = true;
   store_location_stuff("START");
   gg_call(VOID,
           "__gg__file_start",
@@ -10320,6 +10361,7 @@
     TRACE1_END
     }
 
+  sv_is_i_o = true;
   store_location_stuff("SUBSTITUTE");
   unsigned char *control_bytes = (unsigned char *)xmalloc(argc * sizeof(unsigned char));
   cbl_refer_t *arg1 = (cbl_refer_t *)xmalloc(argc * sizeof(cbl_refer_t));
@@ -10512,7 +10554,7 @@
     if( is_table(ref1.field) && !ref1.nsubscript )
       {
       static tree depending_on = gg_define_variable(LONG, "..pic1_dep");
-      gg_get_depending_on_value(depending_on, ref1.field);
+      depending_on_value(depending_on, ref1.field);
       gg_call(VOID,
               "__gg__int128_to_field",
               gg_get_address_of(tgt->var_decl_node),
@@ -10822,7 +10864,7 @@
       {
       // Extract the number of elements in that rightmost dimension.
       lsearch->limit = gg_define_variable(LONG);
-      gg_get_depending_on_value(lsearch->limit, current);
+      depending_on_value(lsearch->limit, current);
       break;
       }
     current = parent_of(current);
@@ -11059,7 +11101,7 @@
 
   // Assign the left and right values:
   gg_assign(bsearch->left, build_int_cst_type(LONG, 1));
-  gg_get_depending_on_value(bsearch->right, current);
+  depending_on_value(bsearch->right, current);
 
   // Create the variable that will take the compare result.
   bsearch->compare_result = gg_define_int();
@@ -11344,7 +11386,7 @@
   tree ascending = gg_array_of_size_t( total_keys, flattened_ascending );
 
   tree depending_on = gg_define_variable(LONG, "_sort_size");
-  gg_get_depending_on_value(depending_on, table);
+  depending_on_value(depending_on, table);
 
   if( alphabet )
     {
@@ -13389,8 +13431,6 @@
   if( exception_location_active && !current_declarative_section_name() )
     {
     // We need to establish some stuff for EXCEPTION- function processing
-    gg_assign(var_decl_exception_source_file,
-              gg_string_literal(current_filename.back().c_str()));
 
     gg_assign(var_decl_exception_program_id,
               gg_string_literal(current_function->our_unmangled_name));
@@ -13522,7 +13562,7 @@
   {
   gg_call(VOID, "__gg__exception_pop", NULL_TREE);
   }
-  
+
 void
 parser_clear_exception()
   {
diff --git a/gcc/cobol/genmath.cc b/gcc/cobol/genmath.cc
index 721aafb..edf3f22 100644
--- a/gcc/cobol/genmath.cc
+++ b/gcc/cobol/genmath.cc
@@ -756,12 +756,6 @@
     TRACE1_END
     }
 
-  tree compute_error = (tree)compute_error_p;
-  if( compute_error == NULL )
-    {
-    gg_assign(var_decl_default_compute_error, integer_zero_node);
-    compute_error = gg_get_address_of(var_decl_default_compute_error);
-    }
   bool handled = false;
 
   if( fast_add( nC, C,
@@ -772,6 +766,13 @@
     }
   else
     {
+    tree compute_error = (tree)compute_error_p;
+    if( compute_error == NULL )
+      {
+      gg_assign(var_decl_default_compute_error, integer_zero_node);
+      compute_error = gg_get_address_of(var_decl_default_compute_error);
+      }
+
     bool computation_is_float =    is_somebody_float(nA, A)
                                 || is_somebody_float(nC, C);
     // We now start deciding which arithmetic routine we are going to use:
@@ -1452,13 +1453,6 @@
 
   bool handled = false;
 
-  tree compute_error = (tree)compute_error_p;
-  if( compute_error == NULL )
-    {
-    gg_assign(var_decl_default_compute_error, integer_zero_node);
-    compute_error = gg_get_address_of(var_decl_default_compute_error);
-    }
-
   if( fast_subtract(nC, C,
                     nA, A,
                     nB, B,
@@ -1468,6 +1462,12 @@
     }
   else
     {
+    tree compute_error = (tree)compute_error_p;
+    if( compute_error == NULL )
+      {
+      gg_assign(var_decl_default_compute_error, integer_zero_node);
+      compute_error = gg_get_address_of(var_decl_default_compute_error);
+      }
     bool computation_is_float =    is_somebody_float(nA, A)
                                 || is_somebody_float(nC, C);
 
diff --git a/gcc/cobol/genutil.cc b/gcc/cobol/genutil.cc
index 3235c38..d0aaf2b3 100644
--- a/gcc/cobol/genutil.cc
+++ b/gcc/cobol/genutil.cc
@@ -107,13 +107,13 @@
 tree var_decl_main_called;        // int         __gg__main_called;
 
 #if 0
-#define REFER
+#define REFER(a)
 #else
-#define REFER do                                \
+#define REFER(a) do                                \
   {                                             \
   if( getenv("REFER") )                         \
     {                                           \
-    fprintf(stderr, "REFER %s\n", __func__);    \
+    fprintf(stderr, "REFER %s %s\n", __func__, a);    \
     }                                           \
   }while(0);
 #endif
@@ -232,16 +232,17 @@
   }
 
 void
-get_integer_value(tree value,
+get_integer_value(tree value, // We know this is a LONG
                   cbl_field_t *field,
                   tree         offset,
                   bool check_for_fractional_digits)
   {
-  if(field->type == FldLiteralN)
+  if( field->type == FldLiteralN && field->data.rdigits==0 )
     {
+    gg_assign(value, gg_cast(LONG, field->data_decl_node));
+    return;
     }
 
-
   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
@@ -292,15 +293,248 @@
     }
   }
 
-static tree
+/*  This routine, used by both get_data_offset and refer_refmod_length,
+    fetches the refmod_from and refmod_length.  If ec-bound-ref-mod checking
+    is enabled, it does those checks and sets the exception condition when they
+    are violated.
+
+    The return value for refstart is the actual offset, that is val(7:3) returns
+    the value 7-1, that is, 6.
+    */
+static
+void
+get_and_check_refstart_and_reflen(  tree         refstart,// LONG returned value
+                                    tree         reflen,  // LONG returned value
+                                    cbl_refer_t &refer)
+  {
+  if( !enabled_exceptions.match(ec_bound_ref_mod_e) )
+    {
+    // This is normal operation -- no exception checking.  Thus, we won't
+    // be trying to check for boundaries or integerness.  And the programmer
+    // is accepting the responsibility for bad code:  "If you specify
+    // disaster, disaster is what you get."
+
+    get_integer_value(refstart,
+                      refer.refmod.from->field,
+                      refer_offset(*refer.refmod.from));
+    gg_decrement(refstart);
+
+    if( refer.refmod.len )
+      {
+      // The length was specified, so that's what we return:
+      get_integer_value(reflen,
+                        refer.refmod.len->field,
+                        refer_offset(*refer.refmod.len));
+      }
+    else
+      {
+      // The length was not specified, so we need to return the distance
+      // between refmod.from and the end of the field:
+      gg_assign(reflen, gg_subtract( get_any_capacity(refer.field), refstart) );
+      }
+    return;
+    }
+
+  // ec_bound_ref_mode_e checking is enabled:
+
+  get_integer_value(refstart,
+                    refer.refmod.from->field,
+                    refer_offset(*refer.refmod.from),
+                    CHECK_FOR_FRACTIONAL_DIGITS);
+
+  IF( var_decl_rdigits,
+      ne_op,
+      integer_zero_node )
+    {
+    // The value for refstart had non-zero decimal places.  This is an
+    // error condition:
+    set_exception_code(ec_bound_ref_mod_e);
+    gg_assign(refstart, gg_cast(LONG, integer_one_node));
+    gg_assign(var_decl_rdigits, integer_zero_node);
+    }
+  ELSE
+    ENDIF
+
+  // Make refstart zero-based:
+  gg_decrement(refstart);
+
+  IF( refstart, lt_op, build_int_cst_type(LONG, 0 ) )
+    {
+    // A negative value for refstart is an error condition:
+    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
+    {
+    IF( refstart, gt_op, gg_cast(TREE_TYPE(refstart), get_any_capacity(refer.field)) )
+      {
+      // refstart greater than zero is an error condition:
+      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
+      {
+      if( refer.refmod.len )
+        {
+        get_integer_value(reflen,
+                          refer.refmod.len->field,
+                          refer_offset(*refer.refmod.len),
+                          CHECK_FOR_FRACTIONAL_DIGITS);
+        IF( var_decl_rdigits,
+            ne_op,
+            integer_zero_node )
+          {
+          // length is not an integer, which is an error condition
+          set_exception_code(ec_bound_ref_mod_e);
+          gg_assign(reflen, gg_cast(LONG, integer_one_node));
+          gg_assign(var_decl_rdigits, integer_zero_node);
+          }
+        ELSE
+          {
+          // The length is an integer, so we can keep going.
+          IF( reflen, lt_op, gg_cast(LONG, integer_one_node) )
+            {
+            // length is too small, which is an error condition.
+            set_exception_code(ec_bound_ref_mod_e);
+            gg_assign(reflen, gg_cast(LONG, integer_one_node));
+            }
+          ELSE
+            {
+            IF( gg_add(refstart, reflen),
+                gt_op,
+                gg_cast(TREE_TYPE(refstart), get_any_capacity(refer.field)) )
+              {
+              // Start + Length is too large, which yet again is an error
+              // condition
+              set_exception_code(ec_bound_ref_mod_e);
+
+              // Our intentions are honorable.  But at this point, where
+              // we notice that start + length is too long, the
+              // 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 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));
+              gg_assign(reflen, gg_cast(LONG, integer_one_node));
+              }
+            ELSE
+              {
+              // There are no problems, so there is no error condition, and
+              // refstart and reflen are correct.
+              }
+              ENDIF
+            }
+            ENDIF
+          }
+          ENDIF
+        }
+      else
+        {
+        // There is no refmod length, so we default to the remaining characters
+        gg_assign(reflen, gg_subtract(get_any_capacity(refer.field),
+                                      refstart));
+        }
+      }
+      ENDIF
+    }
+    ENDIF
+  }
+
+void
+get_depending_on_value_from_odo(tree retval, cbl_field_t *odo)
+  {
+  /*  This routine, called only when we know there is an OCCURS DEPENDING ON
+      clause, returns the current value of the DEPENDING ON variable.  When
+      ec_bound_odo_e is turned on, and there is any kind of ec-bound-odo
+      error condition, the value returned is occurs.bounds.lower.
+
+      This should ensure that there is no memory violation in the event of a
+      declarative with a RESUME NEXT STATEMENT, or before the default_condition
+      processing can do a controlled exit.
+      */
+  cbl_field_t *depending_on;
+  depending_on = cbl_field_of(symbol_at(odo->occurs.depending_on));
+
+  if( !enabled_exceptions.match(ec_bound_odo_e) )
+    {
+    // With no exception testing, just pick up the value.  If there is a
+    // the programmer will simply have to live with the consequences.
+    get_integer_value(retval,
+                      depending_on,
+                      NULL);
+    return;
+    }
+
+  // Bounds checking is enabled, so we test the DEPENDING ON value to be between
+  // the lower and upper OCCURS limits:
+  get_integer_value(retval,
+                    depending_on,
+                    NULL,
+                    CHECK_FOR_FRACTIONAL_DIGITS);
+
+  IF( var_decl_rdigits, ne_op, integer_zero_node )
+    {
+    // This needs to evaluate to an integer
+    set_exception_code(ec_bound_odo_e);
+    gg_assign(retval, build_int_cst_type(TREE_TYPE(retval), odo->occurs.bounds.lower));
+    gg_assign(var_decl_rdigits, integer_zero_node);
+    }
+  ELSE
+    ENDIF
+
+  IF( retval, gt_op, build_int_cst_type(TREE_TYPE(retval), odo->occurs.bounds.upper) )
+    {
+    set_exception_code(ec_bound_odo_e);
+    gg_assign(retval, build_int_cst_type(TREE_TYPE(retval), odo->occurs.bounds.lower));
+    }
+  ELSE
+    {
+    IF( retval, lt_op, build_int_cst_type(TREE_TYPE(retval), odo->occurs.bounds.lower) )
+      {
+      set_exception_code(ec_bound_odo_e);
+      gg_assign(retval, build_int_cst_type(TREE_TYPE(retval), odo->occurs.bounds.lower));
+      }
+    ELSE
+      ENDIF
+    IF( retval, lt_op, gg_cast(TREE_TYPE(retval), integer_zero_node) )
+      {
+      set_exception_code(ec_bound_odo_e);
+      gg_assign(retval, gg_cast(TREE_TYPE(retval), integer_zero_node));
+      }
+    ELSE
+      ENDIF
+    }
+    ENDIF
+  }
+
+static
+void
+get_depending_on_value(tree retval, cbl_refer_t &refer)
+  {
+  /*  This routine, called only when we know there is an OCCURS DEPENDING ON
+      clause, returns the current value of the DEPENDING ON variable.  When
+      ec_bound_odo_e is turned on, and there is any kind of ec-bound-odo
+      error condition, the value returned is occurs.bounds.lower.
+
+      This should ensure that there is no memory violation in the event of a
+      declarative with a RESUME NEXT STATEMENT, or before the default_condition
+      processing can do a controlled exit.
+      */
+  cbl_field_t *odo = symbol_find_odo(refer.field);
+  get_depending_on_value_from_odo(retval, odo);
+  }
+
+static
+tree
 get_data_offset(cbl_refer_t &refer,
                 int *pflags = NULL)
   {
-  REFER;
-  if( getenv("REFER") )
-    {
-    fprintf(stderr, "      %s %s\n", refer.field->name, refer.field->data.initial);
-    }
   Analyze();
   // This routine returns a tree which is the size_t offset to the data in the
   // refer/field
@@ -316,10 +550,9 @@
   int all_flags = 0;
   int all_flag_bit = 1;
 
-  static tree value64 = gg_define_variable(LONG, ".._gdos_value64", vs_file_static);
-
   if( refer.nsubscript )
     {
+    REFER("subscript");
     // We have at least one subscript:
 
     // Figure we have three subscripts, so nsubscript is 3
@@ -355,29 +588,6 @@
       // Pick up the integer value of the subscript:
       tree subscript  = gg_define_variable(LONG);
 
-      get_integer_value(subscript,
-                        refer.subscripts[i].field,
-                        refer_offset(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);
-        gg_assign(var_decl_rdigits, integer_zero_node);
-        }
-      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
@@ -389,98 +599,94 @@
         // Flag this position as ALL
         all_flags |= all_flag_bit;
         }
+      else
+        {
+        if( !enabled_exceptions.match(ec_bound_subscript_e) )
+          {
+          // With no exception testing, just pick up the value
+          get_integer_value(subscript,
+                            refer.subscripts[i].field,
+                            refer_offset(refer.subscripts[i]));
+          }
+        else
+          {
+          get_integer_value(subscript,
+                            refer.subscripts[i].field,
+                            refer_offset(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);
+            gg_assign(subscript, build_int_cst_type(TREE_TYPE(subscript), 1));
+            gg_assign(var_decl_rdigits, integer_zero_node);
+            }
+          ELSE
+            {
+            IF( subscript, lt_op, gg_cast(TREE_TYPE(subscript), integer_one_node) )
+              {
+              // The subscript is too small
+              set_exception_code(ec_bound_subscript_e);
+              gg_assign(subscript, build_int_cst_type(TREE_TYPE(subscript), 1));
+              }
+            ELSE
+              {
+              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), 1));
+                }
+              ELSE
+                {
+                }
+                ENDIF
+              }
+              ENDIF
+            }
+          ENDIF
+          }
+        }
+
       all_flag_bit <<= 1;
 
+      // Although we strictly don't need to look at the ODO value at this point,
+      // we do want it checked for the purposes of ec-bound-odo
+
+      if( enabled_exceptions.match(ec_bound_odo_e) )
+        {
+        if( parent->occurs.depending_on )
+          {
+          static tree value64 = gg_define_variable(LONG, ".._gdos_value64", vs_file_static);
+          cbl_field_t *odo = symbol_find_odo(parent);
+          get_depending_on_value_from_odo(value64, odo);
+          }
+        }
+
       // Subscript is now a one-based integer
       // Make it zero-based:
 
       gg_decrement(subscript);
-      // gg_printf("process_this_exception is true\n", NULL_TREE);
-      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 )
-              {
-              set_exception_code(ec_bound_odo_e);
-              }
-            ELSE
-              ENDIF
-            }
 
-          tree augment = gg_multiply(subscript, get_any_capacity(parent));
-          gg_assign(retval, gg_add(retval, gg_cast(SIZE_T, augment)));
-          }
-          ENDIF
-        }
-        ENDIF
+      tree augment = gg_multiply(subscript, get_any_capacity(parent));
+      gg_assign(retval, gg_add(retval, gg_cast(SIZE_T, augment)));
+
       parent = parent_of(parent);
       }
     }
 
   if( refer.refmod.from )
     {
+    REFER("refmod refstart");
     // We have a refmod to deal with
     static tree refstart = gg_define_variable(LONG, "..gdo_refstart", vs_file_static);
+    static tree reflen   = gg_define_variable(LONG, "..gdo_reflen", vs_file_static);
+    get_and_check_refstart_and_reflen(refstart, reflen, refer);
 
-    get_integer_value(refstart,
-                      refer.refmod.from->field,
-                      refer_offset(*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);
-      gg_assign(var_decl_rdigits, integer_zero_node);
-      }
-    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, gg_cast(LONG, integer_zero_node));
-      }
-    ELSE
-      {
-      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);
-        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)));
     }
 
@@ -489,11 +695,6 @@
     *pflags = all_flags;
     }
 
-
-//  gg_printf("*****>>>>> %s(): returning %p\n",
-//            gg_string_literal(__func__),
-//            retval,
-//            NULL_TREE);
   return retval;
   }
 
@@ -1734,7 +1935,7 @@
     // It is routine for a refer to have no field.  It happens when the parser
     // passes us a refer for an optional parameter that has been omitted, for
     // example.
-    
+
     // It is also the case that a FldLiteralN will never have suscripts, or the
     // like.
     return true;
@@ -1749,195 +1950,43 @@
           ;
   }
 
+
 /*  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.
+
+    This routine shouldn't be called unless there is refmod involved.
     */
 static
 tree  // size_t
 refer_refmod_length(cbl_refer_t &refer)
   {
-  REFER;
   Analyze();
-  if( refer.refmod.from || refer.refmod.len )
-    {
-    static tree refstart = gg_define_variable(LONG, "..rrl_refstart", vs_file_static);
-    static tree reflen   = gg_define_variable(LONG, "..rrl_reflen", vs_file_static);
+  REFER("refstart and reflen");
+  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); // This is a size_t
+  get_and_check_refstart_and_reflen( refstart, reflen, refer);
 
-    get_integer_value(refstart,
-                      refer.refmod.from->field,
-                      refer_offset(*refer.refmod.from),
-                      CHECK_FOR_FRACTIONAL_DIGITS);
-    IF( var_decl_rdigits,
-        ne_op,
-        integer_zero_node )
-      {
-      set_exception_code(ec_bound_ref_mod_e);
-      gg_assign(refstart, gg_cast(LONG, integer_one_node));
-      gg_assign(var_decl_rdigits, integer_zero_node);
-      }
-    ELSE
-      ENDIF
+  // Arrive here with a valid value for reflen:
 
-    // Make refstart zero-based:
-    gg_decrement(refstart);
-
-    IF( refstart, lt_op, build_int_cst_type(LONG, 0 ) )
-      {
-      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
-      {
-      IF( refstart, gt_op, gg_cast(TREE_TYPE(refstart), rt_capacity) )
-        {
-        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
-        {
-        if( refer.refmod.len )
-          {
-          get_integer_value(reflen,
-                            refer.refmod.len->field,
-                            refer_offset(*refer.refmod.len),
-                            CHECK_FOR_FRACTIONAL_DIGITS);
-          IF( var_decl_rdigits,
-              ne_op,
-              integer_zero_node )
-            {
-            // length is not an integer
-            set_exception_code(ec_bound_ref_mod_e);
-            gg_assign(reflen, gg_cast(LONG, integer_one_node));
-            gg_assign(var_decl_rdigits, integer_zero_node);
-            }
-          ELSE
-            {
-            }
-          ENDIF
-
-          IF( reflen, lt_op, gg_cast(LONG, integer_one_node) )
-            {
-            // length is too small
-            set_exception_code(ec_bound_ref_mod_e);
-            gg_assign(reflen, gg_cast(LONG, integer_one_node));
-            }
-          ELSE
-            {
-            IF( gg_add(refstart, reflen),
-                gt_op,
-                gg_cast(TREE_TYPE(refstart), rt_capacity) )
-              {
-              // Start + Length is too large
-              set_exception_code(ec_bound_ref_mod_e);
-
-              // Our intentions are honorable.  But at this point, where
-              // we notice that start + length is too long, the
-              // 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 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));
-              gg_assign(reflen, gg_cast(LONG, integer_one_node));
-              }
-            ELSE
-              ENDIF
-            }
-            ENDIF
-          }
-        else
-          {
-          // There is no refmod length, so we default to the remaining characters
-          tree subtract_expr = gg_subtract( rt_capacity,
-                                            refstart);
-          gg_assign(reflen, subtract_expr);
-          }
-        }
-        ENDIF
-      }
-      ENDIF
-
-    // Arrive here with valid values for refstart and reflen:
-
-    return gg_cast(SIZE_T, reflen);
-    }
-  else
-    {
-    return size_t_zero_node;
-    }
+  return gg_cast(SIZE_T, reflen);
   }
 
 static
 tree // size_t
 refer_fill_depends(cbl_refer_t &refer)
   {
-  REFER;
+  REFER("");
   // This returns a positive number which is the amount a depends-limited
   // capacity needs to be reduced.
   Analyze();
   cbl_field_t *odo = symbol_find_odo(refer.field);
-  cbl_field_t *depending_on;
-  depending_on = cbl_field_of(symbol_at(odo->occurs.depending_on));
-  // refer.field has a relevant DEPENDING ON clause
-
-  // gg_printf("var is %s type is %s\n",
-            // gg_string_literal(refer.field->name),
-            // gg_string_literal(cbl_field_type_str(refer.field->type)),
-            // NULL_TREE);
-  // gg_printf("   odo is %s\n", gg_string_literal(odo->name), NULL_TREE);
-
-  // gg_printf("      depending_on is %s\n", gg_string_literal(depending_on->name), NULL_TREE);
-  // fprintf(stderr,
-          // "symbol_find_odo found %s, with depending_on %s\n",
-          // odo->name,
-          // depending_on->name);
 
   static tree value64 = gg_define_variable(LONG, "..rfd_value64", vs_file_static);
-  get_integer_value(value64,
-                    depending_on,
-                    NULL,
-                    CHECK_FOR_FRACTIONAL_DIGITS);
-  IF( var_decl_rdigits, ne_op, integer_zero_node )
-    {
-    // This needs to evaluate to an integer
-    set_exception_code(ec_bound_odo_e);
-    gg_assign(value64, build_int_cst_type(TREE_TYPE(value64), odo->occurs.bounds.upper));
-    gg_assign(var_decl_rdigits, integer_zero_node);
-    }
-  ELSE
-    ENDIF
 
-  IF( value64, gt_op, build_int_cst_type(TREE_TYPE(value64), odo->occurs.bounds.upper) )
-    {
-    set_exception_code(ec_bound_odo_e);
-    gg_assign(value64, build_int_cst_type(TREE_TYPE(value64), odo->occurs.bounds.upper));
-    }
-  ELSE
-    {
-    IF( value64, lt_op, build_int_cst_type(TREE_TYPE(value64), odo->occurs.bounds.lower) )
-      {
-      set_exception_code(ec_bound_odo_e);
-      gg_assign(value64, build_int_cst_type(TREE_TYPE(value64), odo->occurs.bounds.lower));
-      }
-    ELSE
-      ENDIF
-    IF( value64, lt_op, gg_cast(TREE_TYPE(value64), integer_zero_node) )
-      {
-      set_exception_code(ec_bound_odo_e);
-      gg_assign(value64, gg_cast(TREE_TYPE(value64), integer_zero_node));
-      }
-    ELSE
-      ENDIF
-    }
-    ENDIF
+  get_depending_on_value(value64, refer);
+
   // value64 is >= zero and < bounds.upper
 
   // We multiply the ODO value by the size of the data capacity to get the
@@ -1958,11 +2007,10 @@
   {
   // This routine calculates the effect of a refer offset on the
   // refer.field->data location.  When there are subscripts, the data location
-  // gets augmented by the (subscript-1)*element_size calculation.  And when 
+  // gets augmented by the (subscript-1)*element_size calculation.  And when
   // there is a refmod, the data location additionally gets augmented by
   // (refmod.from-1)
 
-  REFER;
   if( !refer.field )
     {
     // It's common for the field to be missing.  It generally means that an
@@ -1981,10 +2029,9 @@
   }
 
 static
-tree
+tree   // size_t
 refer_size(cbl_refer_t &refer, refer_type_t refer_type)
   {
-  REFER;
   Analyze();
   static tree retval = gg_define_variable(SIZE_T, "..rs_retval", vs_file_static);
 
@@ -2026,14 +2073,12 @@
 tree  // size_t
 refer_size_dest(cbl_refer_t &refer)
   {
-  REFER;
   return refer_size(refer, refer_dest);
   }
 
 tree  // size_t
 refer_size_source(cbl_refer_t &refer)
   {
-  REFER;
   /*  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
diff --git a/gcc/cobol/genutil.h b/gcc/cobol/genutil.h
index 8244481..2f4bc36 100644
--- a/gcc/cobol/genutil.h
+++ b/gcc/cobol/genutil.h
@@ -154,4 +154,5 @@
 void      build_array_of_fourplets( int ngroup,
                                     size_t N,
                                     cbl_refer_t *refers);
+void      get_depending_on_value_from_odo(tree retval, cbl_field_t *odo);
 #endif
diff --git a/gcc/cobol/lang-specs.h b/gcc/cobol/lang-specs.h
index 78e84c0..b7f1517 100644
--- a/gcc/cobol/lang-specs.h
+++ b/gcc/cobol/lang-specs.h
@@ -34,7 +34,7 @@
     {".CBL", "@cobol", 0, 0, 0},
     {"@cobol",
         "cobol1 %i %(cc1_options) "
-        "%{D*} %{E} %{I*} %{fmax-errors*} %{fsyntax-only*} "
+        "%{D*} %{E} %{I*} %{M} %{fmax-errors*} %{fsyntax-only*} "
         "%{fcobol-exceptions*} "
         "%{copyext} "
         "%{fstatic-call} %{fdefaultbyte} "
diff --git a/gcc/cobol/lang.opt b/gcc/cobol/lang.opt
index 59278a1..1f2a616 100644
--- a/gcc/cobol/lang.opt
+++ b/gcc/cobol/lang.opt
@@ -38,6 +38,11 @@
 ;;  -I <dir>	Add copybook search directory
 ; Documented in c.opt
 
+M
+Cobol
+; Documented in c.opt
+
+
 dialect
 Cobol Joined Separate Enum(dialect_type) EnumBitSet Var(cobol_dialect)
 Accept COBOL constructs used by non-ISO compilers
diff --git a/gcc/cobol/lexio.h b/gcc/cobol/lexio.h
index cf7f53a..ed642af 100644
--- a/gcc/cobol/lexio.h
+++ b/gcc/cobol/lexio.h
@@ -43,7 +43,6 @@
 #define SPACE ' '
 
 bool lexer_echo();
-
 bool is_reference_format();
 
 static inline bool isquote( char ch ) {
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index cecdd22..cb96c90 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -1346,8 +1346,16 @@
     // 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, '.');
+    gcc_assert(pdot);
     char *pe = strchr(psz, 'e');
+    if( !pe )
+      {
+      // The most likely cause of this is a "0.0" result.
+      strcpy(psz, "0");
+      return;
+      }
     char *pnz = pe-1;
     while(*pnz == '0')
       {
@@ -2277,7 +2285,9 @@
 config_paragraph:
                 SPECIAL_NAMES '.'
         |       SPECIAL_NAMES '.' specials '.'
+        |       SOURCE_COMPUTER  '.' 
         |       SOURCE_COMPUTER  '.' NAME with_debug '.'
+        |       OBJECT_COMPUTER  '.' 
         |       OBJECT_COMPUTER  '.' NAME collating_sequence[name] '.'
                 {
                   if( $name ) {
@@ -4015,8 +4025,8 @@
                   cbl_field_t *field = current_field();
 
 		  if( field->type == FldNumericBin5 &&
-		      field->data.capacity == 0  &&
-		      dialect_mf() )
+		      field->data.capacity == 0xFF  &&
+		      (dialect_gnu() || dialect_mf()) )
 		  { // PIC X COMP-X or COMP-9
 		    if( ! field->has_attr(all_x_e) ) {
 		      error_msg(@2, "COMP PICTURE requires all X's or all 9's");
@@ -4024,6 +4034,7 @@
 		    }
 		  } else {
                     if( !field_type_update(field, FldAlphanumeric, @$) ) {
+		      dbgmsg("alnum_pic: %s", field_str(field));
                       YYERROR;
                     }
 		  }
@@ -4240,21 +4251,21 @@
 		      case FldAlphanumeric:   // PIC X COMP-5 or COMP-X
 			assert( field->data.digits == 0 );
 			assert( field->data.rdigits == 0 );
-		        if( dialect_mf() ) {
+		        if( (dialect_mf() || dialect_gnu()) ) {
                           field->type = $comp.type;
 			  field->clear_attr(signable_e);
 		        } else {
 			  error_msg(@comp, "numeric USAGE invalid "
 				           "with Alpnanumeric PICTURE");
-			  dialect_error(@1, "Alpnanumeric COMP-5 or COMP-X", "mf");
+			  dialect_error(@1, "Alpnanumeric COMP-5 or COMP-X", "mf or gnu");
 			  YYERROR;
 		        }
                         break;
 		      case FldNumericDisplay: // PIC 9 COMP-5 or COMP-X
 		        if( $comp.capacity == 0xFF ) { // comp-x is a bit like comp-5
 			  assert( field->data.digits == field->data.capacity );
-		          if( ! dialect_mf() ) {
-				  dialect_error(@1, "COMP-X", "mf");
+		          if( ! (dialect_mf() || dialect_gnu()) ) {
+				  dialect_error(@1, "COMP-X", "mf or gnu");
 		          }
 			}
                         field->type = $comp.type;
@@ -4321,21 +4332,21 @@
 		      case FldAlphanumeric:   // PIC X COMP-5 or COMP-X
 			assert( field->data.digits == 0 );
 			assert( field->data.rdigits == 0 );
-		        if( dialect_mf() ) {
+		        if( (dialect_mf() || dialect_gnu()) ) {
                           field->type = $comp.type;
 			  field->clear_attr(signable_e);
 		        } else {
 			  error_msg(@comp, "numeric USAGE invalid "
 				           "with Alpnanumeric PICTURE");
-			  dialect_error(@1, "Alpnanumeric COMP-5 or COMP-X", "mf");
+			  dialect_error(@1, "Alpnanumeric COMP-5 or COMP-X", "mf or gnu");
 			  YYERROR;
 		        }
                         break;
 		      case FldNumericDisplay: // PIC 9 COMP-5 or COMP-X
 		        if( $comp.capacity == 0xFF ) { // comp-x is a bit like comp-5
 			  assert( field->data.digits == field->data.capacity );
-		          if( ! dialect_mf() ) {
-				  dialect_error(@1, "COMP-X", "mf");
+		          if( ! (dialect_mf() || dialect_gnu()) ) {
+				  dialect_error(@1, "COMP-X", "mf or gnu");
 		          }
 			}
                         field->type = $comp.type;
@@ -5236,9 +5247,19 @@
                 {
                   $$ = special_of($1);
                   if( !$$ ) {
-                    error_msg(@NAME, "no such environment mnemonic name: %s", $NAME);
-                    YYERROR;
-                  }
+		    const special_name_t *special_type = cmd_or_env_special_of($NAME);
+		    if( !special_type ) {
+                      error_msg(@NAME, "no such special name '%s'", $NAME);
+                      YYERROR;
+		    }
+		    // Add the name now, as a convenience. 
+		    cbl_special_name_t special = { 0, *special_type };
+		    namcpy(@NAME, special.name, $NAME);
+
+		    symbol_elem_t *e = symbol_special_add(PROGRAM, &special);
+		    $$ = cbl_special_name_of(e);
+		  }
+		  assert($$);
                 }
                 ;
 
@@ -7114,9 +7135,21 @@
                 {
                   if( $1 ) {
 		    if( *$1 == '-' ) {
-		      error_msg(@1, "SECTION segment %s is negative", $1);
+		      error_msg(@1, "SECTION segment %<%s%> is negative", $1);
                     } else {
-                      cbl_unimplementedw("SECTION segment %s was ignored", $1);
+		      if( dialect_ibm() ) {
+			int sectno;
+			sscanf($1, "%u", &sectno);
+			if( ! (0 <= sectno && sectno <= 99) ) {
+			  error_msg(@1, "SECTION segment %<%s%> must be 0-99", $1);
+			} else {
+			  if(false) { // stand-in for warning, someday.
+			    yywarn("SECTION segment %<%s%> was ignored", $1);
+			  }
+			}
+		      } else {
+			cbl_unimplemented("SECTION segment %<%s%> is not ISO syntax", $1);
+		      }
                     }
 		  }
                 }
@@ -7498,18 +7531,7 @@
 		perform_ec_finally
 		END_PERFORM
                 {
-		  auto perf = perform_current();
-		  // produce blob, jumped over by FINALLY paragraph
-		  size_t iblob = symbol_declaratives_add( PROGRAM, perf->dcls );
-		  auto lave = perf->ec_labels.new_label(LblParagraph, "lave");
-		  auto handlers = cbl_field_of(symbol_at(iblob));
-
-		  // install blob
-		  parser_label_label(perf->ec_labels.init);
-		  declarative_runtime_match(handlers, lave);
-
-		  // uninstall blob
-		  parser_label_label(perf->ec_labels.fini);
+		  cbl_unimplemented("PERFORM Format 3");
                 }
 		;
 
@@ -12920,10 +12942,22 @@
 
 void
 cobol_dialect_set( cbl_dialect_t dialect ) {
-  cbl_dialect = dialect;
-  if( dialect & dialect_ibm_e ) cobol_gcobol_feature_set(feature_embiggen_e);
+  switch(dialect) {
+  case dialect_gcc_e:
+    break;
+  case dialect_ibm_e:
+    cobol_gcobol_feature_set(feature_embiggen_e);
+    break;
+  case dialect_mf_e:
+    break;
+  case dialect_gnu_e:
+    if( 0 == (cbl_dialects & dialect) ) { // first time
+      tokens.equate(YYLTYPE(), "BINARY-DOUBLE", "BINARY-C-LONG");
+    }
+    break;
+  }    
+  cbl_dialects |= dialect;
 }
-cbl_dialect_t cobol_dialect() { return cbl_dialect; }
 
 static bool internal_ebcdic_locked = false;
 
diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h
index 0369f7b..997ad4f 100644
--- a/gcc/cobol/parse_ante.h
+++ b/gcc/cobol/parse_ante.h
@@ -47,9 +47,6 @@
 #pragma GCC diagnostic push
 #pragma GCC diagnostic ignored "-Wmissing-field-initializers"
 
-extern void declarative_runtime_match(cbl_field_t *declaratives,
-                                      cbl_label_t *lave );
-
 extern YYLTYPE yylloc;
 
 extern int yylineno, yyleng, yychar;
@@ -73,7 +70,7 @@
 const char * keyword_str( int token );
 void labels_dump();
 
-cbl_dialect_t cbl_dialect;
+unsigned int cbl_dialects;
 size_t cbl_gcobol_features;
 
 static enum cbl_division_t current_division;
@@ -1035,7 +1032,7 @@
   int find( const cbl_name_t name, bool include_intrinsics ) {
     return tokens.find(name, include_intrinsics);
   }
-  bool equate( const YYLTYPE& loc, cbl_name_t keyword, const cbl_name_t alias ) {
+  bool equate( const YYLTYPE& loc, const cbl_name_t keyword, const cbl_name_t alias ) {
     int token; 
     if( 0 == (token = binary_integer_usage_of(keyword)) ) {
       if( 0 == (token = keyword_tok(keyword)) ) {
@@ -1054,7 +1051,7 @@
   bool undefine( const YYLTYPE& loc, cbl_name_t keyword ) {
     return tokens.undefine(loc, keyword);
   }
-  bool substitute( const YYLTYPE& loc, cbl_name_t keyword, const cbl_name_t alias ) {
+  bool substitute( const YYLTYPE& loc, const cbl_name_t keyword, const cbl_name_t alias ) {
     int token; 
     if( 0 == (token = binary_integer_usage_of(keyword)) ) {
       if( 0 == (token = keyword_tok(keyword)) ) {
@@ -1476,7 +1473,7 @@
   std::set<std::string> call_targets, subprograms;
  public:
   std::set<function_descr_t> function_repository;
-  size_t program_index, declaratives_index;
+  size_t program_index;
   cbl_label_t *declaratives_eval, *paragraph, *section;
   const char *collating_sequence;
   struct locale_t {
@@ -1494,7 +1491,6 @@
 
   prog_descr_t( size_t isymbol )
     : program_index(isymbol)
-    , declaratives_index(0)
     , declaratives_eval(NULL)
     , paragraph(NULL)
     , section(NULL)
@@ -2101,10 +2097,6 @@
     assert(!programs.empty());
     return programs.top().program_index;
   }
-  size_t  program_declaratives(void) const {
-    if( programs.empty() ) return 0;
-    return programs.top().declaratives_index;
-  }
   const cbl_label_t * program(void) {
     return programs.empty()?
                 NULL : cbl_label_of(symbol_at(programs.top().program_index));
@@ -2118,12 +2110,16 @@
 
   bool is_first_statement( const YYLTYPE& loc )  {
     if( ! in_declaratives && first_statement == 0 ) {
-      if( ! symbol_label_section_exists(program_index()) ) {
-        if( ! dialect_ibm() ) {
-          error_msg(loc,
-                    "Per ISO a program with DECLARATIVES must begin with a SECTION, "
-                    "requires -dialect ibm");
-        }
+      auto eval = programs.top().declaratives_eval;
+      if( eval ) {
+	size_t ilabel = symbol_index(symbol_elem_of(eval));
+	if( ! symbol_label_section_exists(ilabel) ) {
+	  if( ! dialect_ibm() ) {
+	    error_msg(loc,
+		      "Per ISO a program with DECLARATIVES must begin with a SECTION, "
+		      "requires -dialect ibm");
+	  }
+	}
       }
       first_statement = loc.first_line;
       return true;
@@ -2214,24 +2210,25 @@
 
     declaratives.runtime.dcl = parser_compile_dcls(declaratives.encode());
 
-    size_t idcl = symbol_declaratives_add(program_index(), declaratives.as_list());
-    programs.top().declaratives_index = idcl;
-
     // Create section to evaluate declaratives.  Given them unique names so
     // that we can figure out what is going on in a trace or looking at the
     // assembly language.
-    static int eval_count=1;
-    char eval[32];
-    char lave[32];
+    static int eval_count = 1;
+    char eval[32], lave[32];
+    
     sprintf(eval, "_DECLARATIVES_EVAL%d", eval_count);
-    sprintf(lave, "_DECLARATIVES_LAVE%d", eval_count);
-    eval_count +=1 ;
+    sprintf(lave, "_DECLARATIVES_LAVE%d", eval_count++);
 
     struct cbl_label_t*& eval_label = programs.top().declaratives_eval;
     eval_label = label_add(LblSection, eval, yylineno);
     struct cbl_label_t * lave_label = label_add(LblSection, lave, yylineno);
+
     ast_enter_section(eval_label);
-    declarative_runtime_match(cbl_field_of(symbol_at(idcl)), lave_label);
+
+    declarative_runtime_match(declaratives.as_list(), lave_label);
+    
+    parser_label_label(lave_label);
+    
     return lave_label;
   }
 
@@ -2261,11 +2258,10 @@
 
   /*
    * END DECLARATIVES causes:
-   *   1. Add DECLARATIVES symbol, containing criteria blob.
-   *   2. Create section _DECLARATIVES_EVAL
+   *   1. Create section _DECLARATIVES_EVAL
    *      and exit label _DECLARATIVES_LAVE
-   *   3. declarative_runtime_match generates runtime evaluation "ladder".
-   *   4. After a declarative is executed, control branches to the exit label.
+   *   2. declarative_runtime_match generates runtime evaluation "ladder".
+   *   3. After a declarative is executed, control branches to the exit label.
    *
    * After each verb, we call declaratives_evaluate,
    * which PERFORMs _DECLARATIVES_EVAL.
diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l
index dfc0c30..5ca2728 100644
--- a/gcc/cobol/scan.l
+++ b/gcc/cobol/scan.l
@@ -2124,7 +2124,7 @@
 			input_file_status.enter(filename);
 		}
 
-  {POP_FILE} 	{
+  {POP_FILE}{OSPC} 	{
 			yy_set_bol(true);
 			input_file_status.leave();
 		}
diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h
index c8c93ed..f60f5d5 100644
--- a/gcc/cobol/scan_ante.h
+++ b/gcc/cobol/scan_ante.h
@@ -372,7 +372,7 @@
   enter_leave_t(parser_leave_file_f *leaving)
     : entering(NULL), leaving(leaving), filename(NULL) {}
 
-  void notify() {
+  void notify( unsigned int newlines = 0 ) {
     if( entering ) {
       cobol_filename(filename, 0);
       if( yy_flex_debug ) dbgmsg("starting line %4d of %s",
@@ -382,6 +382,7 @@
     }
     if( leaving ) {
       auto name = cobol_filename_restore();
+      yylineno += newlines;
       if( yy_flex_debug ) dbgmsg("resuming line %4d of %s",
                                  yylineno, name? name : "<none>");
       leaving();
@@ -392,17 +393,22 @@
 
 static class input_file_status_t {
   std::queue <enter_leave_t> inputs;
+  unsigned int trailing_newlines = 0;
  public:
   void enter(const char *filename) {
     inputs.push( enter_leave_t(parser_enter_file, filename) );
   }
   void leave() {
+    // Add the number of newlines following the POP to yylineno when it's restored. 
+    trailing_newlines = std::count(yytext, yytext + yyleng, '\n');
+    if( trailing_newlines && yy_flex_debug )
+      dbgmsg("adding %u lines after POP", trailing_newlines);
     inputs.push( parser_leave_file );
   }
   void notify() {
     while( ! inputs.empty() ) {
       auto enter_leave = inputs.front();
-      enter_leave.notify();
+      enter_leave.notify(trailing_newlines);
       inputs.pop();
     }
   }
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index 1d0acf90..dc91fad 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -487,9 +487,6 @@
   case SymDataSection:
     return k->elem.section.type == e->elem.section.type ? 0 : 1;
     break;
-  case SymFunction:
-    return strcmp(k->elem.function.name, e->elem.function.name);
-    break;
   case SymField:
     if( has_parent(k) && cbl_field_of(k)->parent != cbl_field_of(e)->parent ) {
       return 1;
@@ -1065,10 +1062,6 @@
       s = xasprintf("%4" GCC_PRISZ "u %-18s line %d", (fmt_size_t)e->program,
                     cbl_section_of(e)->name(), cbl_section_of(e)->line);
       break;
-    case SymFunction:
-      s = xasprintf("%4" GCC_PRISZ "u %-15s %s", (fmt_size_t)e->program,
-                    "Function", e->elem.function.name);
-      break;
     case SymField: {
       auto field = cbl_field_of(e);
       char *odo_str = NULL;
@@ -3749,39 +3742,27 @@
 }
 
 /*
- * Under ISO (and not IBM) Declaratives are followed by a Section name.  When
- * the first statement is parsed, verify, if Declaratives were used, that it
+ * Under ISO (and not IBM) Declaratives are followed by a Section name.  If
+ * Declaratives were used, when the first statement is parsed verify that it
  * was preceeded by a Section name.
  */
 bool
-symbol_label_section_exists( size_t program ) {
-  auto pblob = std::find_if( symbols_begin(program), symbols_end(),
-                               []( const auto& sym ) {
-                                 if( sym.type == SymField ) {
-                                   auto& f( sym.elem.field );
-                                   return f.type == FldBlob;
-                                 }
-                                 return false;
-                               } );
-  if( pblob == symbols_end() ) return true; // Section name not required
-
-  bool has_section = std::any_of( ++pblob, symbols_end(),
-                               []( const auto& sym ) {
-                                 if( sym.type == SymLabel ) {
+symbol_label_section_exists( size_t eval_label_index ) {
+  auto eval = symbols_begin(eval_label_index);
+  bool has_section = std::any_of( ++eval, symbols_end(),
+                               [program = eval->program]( const auto& sym ) {
+                                 if( program == sym.program && sym.type == SymLabel ) {
                                    auto& L(sym.elem.label);
-                                   if( L.type == LblSection ) {
-                                     if( L.name[0] != '_' ) { // not implicit
-                                       return true; // Section name exists
-                                     }
-                                   }
+				   // true if the symbol is an explicit label.
+                                   return L.type == LblSection &&  L.name[0] != '_'; 
                                  }
                                  return false;
                                } );
   if( yydebug && ! has_section ) {
-    symbols_dump(program, true);
+    symbols_dump(eval_label_index, true);
   }
-  // Return true if no Declaratives, because the (non-)requirement is met.
-  // Return false if Declaratives exist, because no Section name was found.
+  // Return true if a user-defined SECTION was found after the Declaratives
+  // label section. 
   return has_section;
 }
 
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index e272907..4a86c67 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -46,11 +46,6 @@
 #include <string>
 #include <vector>
 
-// Provide fallback definition.
-#ifndef NAME_MAX
-#define NAME_MAX 255
-#endif
-
 #define PICTURE_MAX 64
 
 extern const char *numed_message;
@@ -62,19 +57,22 @@
   dialect_gnu_e = 0x04,
 };
 
-extern cbl_dialect_t cbl_dialect;
+// Dialects may be combined. 
+extern unsigned int cbl_dialects;
 void cobol_dialect_set( cbl_dialect_t dialect );
-cbl_dialect_t dialect_is();
 
+// GCC dialect means no other dialects
 static inline bool dialect_gcc() {
-  return dialect_gcc_e  == cbl_dialect;
+  return dialect_gcc_e == cbl_dialects;
 }
-
 static inline bool dialect_ibm() {
-  return dialect_ibm_e == (cbl_dialect & dialect_ibm_e);
+  return dialect_ibm_e == (cbl_dialects & dialect_ibm_e);
 }
 static inline bool dialect_mf() {
-  return dialect_mf_e  == (cbl_dialect & dialect_mf_e );
+  return dialect_mf_e  == (cbl_dialects & dialect_mf_e );
+}
+static inline bool dialect_gnu() {
+  return dialect_gnu_e  == (cbl_dialects & dialect_gnu_e );
 }
 
 enum cbl_gcobol_feature_t {
@@ -220,7 +218,6 @@
 
 enum symbol_type_t {
   SymFilename,
-  SymFunction,
   SymField,
   SymLabel,                     // section, paragraph, or label
   SymSpecial,
@@ -1475,14 +1472,6 @@
   }
 };
 
-// a function pointer
-typedef void ( *cbl_function_ptr ) ( void );
-
-struct cbl_function_t {
-  char name[NAME_MAX];
-  cbl_function_ptr func;
-};
-
 static inline const char *
 file_org_str( enum cbl_file_org_t org ) {
   switch ( org ) {
@@ -1638,7 +1627,6 @@
   size_t program;
   union symbol_elem_u {
     char *filename;
-    cbl_function_t     function;
     cbl_field_t        field;
     cbl_label_t        label;
     cbl_special_name_t special;
@@ -1692,9 +1680,6 @@
     case SymFilename:
       elem.filename = that.elem.filename;
       break;
-    case SymFunction:
-      elem.function = that.elem.function;
-      break;
     case SymField:
       elem.field = that.elem.field;
       break;
@@ -1814,13 +1799,6 @@
 
 bool redefine_field( cbl_field_t *field );
 
-// Functions to correctly extract the underlying type.
-static inline struct cbl_function_t *
-cbl_function_of( struct symbol_elem_t *e ) {
-  assert(e->type == SymFunction);
-  return &e->elem.function;
-}
-
 static inline struct cbl_section_t *
 cbl_section_of( struct symbol_elem_t *e ) {
   assert(e->type == SymDataSection);
diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc
index 87b19b6..75a0b26 100644
--- a/gcc/cobol/util.cc
+++ b/gcc/cobol/util.cc
@@ -100,8 +100,6 @@
     switch(type) {
     case SymFilename:
         return "SymFilename";
-    case SymFunction:
-        return "SymFunction";
     case SymField:
         return "SymField";
     case SymLabel:
@@ -1764,7 +1762,21 @@
 
 class unique_stack : public std::stack<input_file_t>
 {
+  friend void cobol_set_pp_option(int opt);
+  bool option_m;
+  std::set<std::string> all_names;
+  
+  const char *
+  no_wd( const char *wd, const char *name ) {
+    int i;
+    for( i=0; wd[i] == name[i]; i++ ) i++;
+    if( wd[i] == '\0' && name[i] == '/' ) i++;
+    return yydebug? name : name + i;
+  }
+
  public:
+  unique_stack() : option_m(false) {}
+  
   bool push( const value_type& value ) {
     auto ok = std::none_of( c.cbegin(), c.cend(),
                             [value]( auto& that ) {
@@ -1772,6 +1784,7 @@
                                 } );
     if( ok ) {
       std::stack<input_file_t>::push(value);
+      all_names.insert(value.name);
       return true;
     }
     size_t n = c.size();
@@ -1792,12 +1805,23 @@
     }
     return false;
   }
-  const char *
-  no_wd( const char *wd, const char *name ) {
-    int i;
-    for( i=0; wd[i] == name[i]; i++ ) i++;
-    if( wd[i] == '\0' && name[i] == '/' ) i++;
-    return yydebug? name : name + i;
+  
+  void option( int opt ) { // capture other preprocessor options eventually
+    assert(opt == 'M');
+    option_m = true;
+  }
+  int option() const {
+    return option_m?  'M' : 0;
+  }
+
+  void print() const {
+    std::string input( top().name );
+    printf( "%s: ", input.c_str() );
+    for( auto name : all_names ) {
+      if( name != input ) 
+	printf( "\\\n\t%s ", name.c_str() );
+    }
+    printf("\n");
   }
 };
 
@@ -1806,6 +1830,12 @@
 static std::map<std::string, ino_t> old_filenames;
 static const unsigned int sysp = 0;  // not a C header file, cf. line-map.h
 
+void cobol_set_pp_option(int opt) {
+  // capture other preprocessor options eventually
+  assert(opt == 'M');
+  input_filenames.option_m = true;
+}
+				  
 /*
  * Maintain a stack of input filenames.  Ensure the files are unique (by
  * inode), to prevent copybook cycles. Before pushing a new name, Record the
@@ -2137,6 +2167,11 @@
 
   parser_enter_file(filename);
 
+  if( input_filenames.option() == 'M' ) {
+    input_filenames.print();
+    return 0;
+  }
+
   cbl_timespec start;
 
   int erc = yyparse();
diff --git a/gcc/cobol/util.h b/gcc/cobol/util.h
index 20d735d..9a968ea 100644
--- a/gcc/cobol/util.h
+++ b/gcc/cobol/util.h
@@ -43,6 +43,8 @@
 int  ftoupper(int c);
 bool fisprint(int c);
 
+void cobol_set_pp_option(int opt);
+
 const char * cobol_filename_restore();
 const char * cobol_lineno_save();
 
diff --git a/gcc/testsuite/cobol.dg/group1/declarative_1.cob b/gcc/testsuite/cobol.dg/group1/declarative_1.cob
index ec68e9c..744495a 100644
--- a/gcc/testsuite/cobol.dg/group1/declarative_1.cob
+++ b/gcc/testsuite/cobol.dg/group1/declarative_1.cob
@@ -1,14 +1,14 @@
 *> { dg-do run }
 *> { dg-output {Turning EC\-ALL CHECKING OFF \-\- Expecting \+00\.00 from ACOS\(\-3\)(\n|\r\n|\r)} }
-*> { dg-output {      \+00\.00      TABL\(VSIX\) is 1(\n|\r\n|\r)} }
+*> { dg-output {      \+00\.00      TABL\(VSIX\) is 6(\n|\r\n|\r)} }
 *> { dg-output {Turning EC\-ARGUMENT\-FUNCTION CHECKING ON(\n|\r\n|\r)} }
 *> { dg-output {      Expecting \+0\.00 and DECLARATIVE FOR EC\-ARGUMENT\-FUNCTION(\n|\r\n|\r)} }
 *> { dg-output {      DECLARATIVE FOR EC\-ARGUMENT\-FUNCTION(\n|\r\n|\r)} }
-*> { dg-output {      \+00\.00      TABL\(VSIX\) is 1(\n|\r\n|\r)} }
+*> { dg-output {      \+00\.00      TABL\(VSIX\) is 6(\n|\r\n|\r)} }
 *> { dg-output {Turning EC\-ARGUMENT CHECKING ON(\n|\r\n|\r)} }
 *> { dg-output {      Expecting \+0\.00 and DECLARATIVE FOR EC\-ARGUMENT\-FUNCTION(\n|\r\n|\r)} }
 *> { dg-output {      DECLARATIVE FOR EC\-ARGUMENT\-FUNCTION(\n|\r\n|\r)} }
-*> { dg-output {      \+00\.00      TABL\(VSIX\) is 1(\n|\r\n|\r)} }
+*> { dg-output {      \+00\.00      TABL\(VSIX\) is 6(\n|\r\n|\r)} }
 *> { dg-output {Turning EC\-ALL CHECKING ON(\n|\r\n|\r)} }
 *> { dg-output {      Expecting \+0\.00 and DECLARATIVE EC\-ARGUMENT\-FUNCTION(\n|\r\n|\r)} }
 *> { dg-output {      Followed by DECLARATIVE EC\-ALL for TABL\(6\) access(\n|\r\n|\r)} }
diff --git a/libgcobol/common-defs.h b/libgcobol/common-defs.h
index e3471c5..8c4858c 100644
--- a/libgcobol/common-defs.h
+++ b/libgcobol/common-defs.h
@@ -458,25 +458,11 @@
 struct cbl_declarative_t {
   enum { files_max = 16 };
   size_t section; // implies program
-  uint32_t global;  // See the note below
+  bool global;
   ec_type_t type;
   uint32_t nfile, files[files_max];
   cbl_file_mode_t mode;
 
-/*  The ::global member originally was "bool global".  A bool, however, occupies
-    only one byte of storage.  The structure, in turn, is constructed on
-    four-byte boundaries for members, so there were three padding bytes between
-    the single byte of global and the ::type member.
-
-    When used to create a "blob", where the structure was treated as a stream
-    of bytes that were used to create a constructor for an array of bytes,
-    valgrind noticed that those three padding bytes were not initialized, and
-    generated the appropriate error message.  This made it hard to find other
-    problems.
-
-    Changing the declaration from "bool" to "uint32_t" seems to have eliminated
-    the valgrind error without affecting overall performance.  */
-
   cbl_declarative_t( cbl_file_mode_t mode = file_mode_none_e )
     : section(0), global(false)
     , type(ec_none_e)
@@ -524,7 +510,6 @@
   constexpr cbl_declarative_t& operator=(const cbl_declarative_t&) = default;
 
   std::vector<uint64_t> encode() const;
-  void decode( const std::vector<uint64_t>& encoded );
 
   /*
    * Sort file names before file modes, and file modes before non-IO.
diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc
index 56b1a7b..6bae27a 100644
--- a/libgcobol/libgcobol.cc
+++ b/libgcobol/libgcobol.cc
@@ -13108,3 +13108,58 @@
   prior.dcls = dcls;
   }
 
+static char *sv_envname = NULL;
+
+extern "C"
+void
+__gg__set_env_name( cblc_field_t   *var,
+                    size_t          offset,
+                    size_t          length )
+  {
+  free(sv_envname);
+  sv_envname = (char *)malloc(length+1);
+  memcpy(sv_envname, var->data+offset, length);
+  sv_envname[length] = '\0';
+  }
+
+extern "C"
+void
+__gg__set_env_value(cblc_field_t   *value,
+                    size_t          offset,
+                    size_t          length )
+  {
+  size_t name_length  = strlen(sv_envname);
+  size_t value_length = length;
+
+  static char   *env        = NULL;
+  static size_t  env_length = 0;
+  static char   *val        = NULL;
+  static size_t  val_length = 0;
+  if( env_length < name_length+1 )
+    {
+    env_length = name_length+1;
+    env = (char *)realloc(env, env_length);
+    }
+  if( val_length < value_length+1 )
+    {
+    val_length = value_length+1;
+    val = (char *)realloc(val, val_length);
+    }
+
+  // The name and the value arrive in the internal codeset:
+  memcpy(env, sv_envname, name_length);
+  env[name_length] = '\0';
+  memcpy(val, value->data+offset, value_length);
+  val[value_length] = '\0';
+
+  // Get rid of leading and trailing internal_space characters
+  char *trimmed_env = brute_force_trim(env);
+  char *trimmed_val = brute_force_trim(val);
+
+  // Conver them to the console codeset
+  __gg__internal_to_console_in_place(trimmed_env, strlen(trimmed_env));
+  __gg__internal_to_console_in_place(trimmed_val, strlen(trimmed_val));
+
+  // And now, anticlimactically, set the variable:
+  setenv(trimmed_env, trimmed_val, 1);
+  }