diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 66c6f4f44f513405f21f85407d44a067609f3140..5be51cf8ee42e4cb7e863d1c3278f605a3efd15e 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -11043,7 +11043,7 @@ apply_acrcs( cbl_refer_t *cond, const acrc_t& ante, acrcs_t& abbrs,
   if( is_conditional(cond) ) {
     assert(ante.term || abbrs.empty());
     for( const auto& abbr : abbrs ) {
-      static auto rhs_cond = new_temporary(FldConditional);
+      static auto rhs_cond = keep_temporary(FldConditional);
       auto R = is_conditional(abbr.term) ? abbr.term->cond() : rhs_cond;
       assert(abbr.term);
       if( !is_conditional(abbr.term) ) { // expand using ante
diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h
index e48035f788fcd31050334c72f530cb9dfac61ba9..c8c8c1b8b4677e674f5f6b52e38b568353f54332 100644
--- a/gcc/cobol/parse_ante.h
+++ b/gcc/cobol/parse_ante.h
@@ -322,7 +322,7 @@ struct evaluate_elem_t {
       : oper(eq_op)
       , subject(subject)
       , object(NULL)
-      , cond( new_temporary(FldConditional) )
+      , cond( keep_temporary(FldConditional) )
     {}
 
     cbl_field_t * object_set( cbl_field_t *obj, relop_t op ) {
@@ -372,7 +372,7 @@ void dump() const {
 
   explicit evaluate_elem_t( const char skel[] )
     : nother(0)
-    , result( new_temporary(FldConditional) )
+    , result( keep_temporary(FldConditional) )
     , pcase( cases.end() )
   {
     static const cbl_label_t protolabel = { .type = LblEvaluate };
@@ -743,7 +743,6 @@ static T* use_any( list<T>& src, T *tgt) {
 }
 
 class evaluate_t : public std::list<evaluate_elem_t> {
-  cbl_field_t *zero_field;
 public:
   cbl_label_t *label() { assert(!empty()); return &this->back().label; }
 
@@ -754,9 +753,6 @@ public:
   }
   void free()  { assert(!empty()); this->pop_back(); }
 
-  cbl_field_t *zero( cbl_field_t *z ) { return zero_field = z; }
-  cbl_field_t *zero() const { return zero_field; }
-
   void dump() const {
     warnx("last of %zu evaluation elements (line %d):", size(), yylineno);
     if( !empty() ) back().dump();
@@ -1434,7 +1430,7 @@ static class current_t {
   static void declarative_execute( cbl_label_t *eval ) {
     if( !eval ) {
       if( !enabled_exceptions.empty() ) {
-        static auto index = new_temporary(FldNumericBin5);
+        static auto index = keep_temporary(FldNumericBin5);
         parser_match_exception(index, NULL);
       }
       return;
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index 0134956bdedbd57e0fccb43ba9bfa3460547310f..0fb7ee0889dab346996dd4a10d6552a91b2def63 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -3219,6 +3219,14 @@ new_temporary( enum cbl_field_type_t type, const char *initial ) {
   return field;
 }
 
+cbl_field_t *
+keep_temporary( cbl_field_type_t type ) {
+  auto field = new_temporary(type);
+  bool ok = temporaries.keep(field);
+  assert(ok);
+  return field;
+}
+
 cbl_field_t *
 new_temporary_like( cbl_field_t skel ) {
   auto field = temporaries.reuse(skel.type);
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index 7d6b1568d42bf5a20a9acd43d5fa73b4df1d997f..83383a348ef46b3f1416a8e50fa8b635747832f2 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -1214,6 +1214,7 @@ size_t field_index( const cbl_field_t *f );
 cbl_field_t * new_temporary( enum cbl_field_type_t type, const char initial[] = NULL );
 cbl_field_t * new_temporary_like( cbl_field_t skel );
 cbl_field_t * new_temporary_clone( const cbl_field_t *orig);
+cbl_field_t * keep_temporary( cbl_field_type_t type );
 
 cbl_field_t * new_literal( uint32_t len, const char initial[], 
                            enum cbl_field_attr_t attr = none_e );
@@ -1244,13 +1245,13 @@ class temporaries_t {
   typedef std::set<cbl_field_t *> fieldset_t;
   typedef std::map<cbl_field_type_t, fieldset_t> fieldmap_t;
   fieldmap_t used, freed;
-  std::stack<fieldmap_t> keepers;
 
 public:
   cbl_field_t * literal( const char value[], uint32_t len, cbl_field_attr_t attr  = none_e );
   cbl_field_t * reuse( cbl_field_type_t type );
   cbl_field_t * acquire( cbl_field_type_t type );
   cbl_field_t *  add( cbl_field_t *field );
+  bool keep( cbl_field_t *field ) { return 1 == used[field->type].erase(field); }
   void dump() const;
   ~temporaries_t();
 };