From addcfaa3225a64aa23d29d9171b721c8a4895ef9 Mon Sep 17 00:00:00 2001
From: David Kastrup <dak@gnu.org>
Date: Fri, 8 May 2015 11:04:01 +0200
Subject: [PATCH] Issue 4378: Rewrite Protected_scm for static lifetime
 requirements

The use of Protected_scm is required where the per-instance object
marking mechanisms don't work.  This patch changes its semantics to
cater exclusively for the use case of permanent variable life time (as
opposed to permanent value life time).  It no longer employs the
reversible scm_gc_protect_object but rather uses scm_permanent_object
for protecting one cons cell as its principal storage mechanism.

It is also ensured that construction/destruction (which happen at very
early/late phases of program execution) do not require a working memory
subsystem.
---
 lily/include/protected-scm.hh | 18 +++++++++++++--
 lily/protected-scm.cc         | 43 ++++++++++++++++-------------------
 2 files changed, 36 insertions(+), 25 deletions(-)

diff --git a/lily/include/protected-scm.hh b/lily/include/protected-scm.hh
index 03f61e318e..61d0173dac 100644
--- a/lily/include/protected-scm.hh
+++ b/lily/include/protected-scm.hh
@@ -24,19 +24,33 @@
 
 /*
   Mix GUILE GC with C++ ctors and dtors.
+
+  This version is intended to be only used for variables of static
+  lifetime (which are not feasible to protect using the per-instance
+  mechanism of the smob classes) but possibly varying content.  As a
+  result, the protection mechanism being used is the irreversible
+  scm_permanent_object.  The destructor (typically called after the
+  end of program execution) does not free resources and consequently
+  does not require the memory subsystem to be still workable.  A
+  working memory subsystem is only required once a non-immediate
+  Scheme value is assigned to the variable.  Since creation of a
+  non-immediate Scheme value requires a working memory subsystem in
+  the first place, this is not really a restriction.
+
+  To avoid accidental creation of temporaries, the copy constructor is
+  made unavailable.
 */
 class Protected_scm
 {
   SCM object_;
+  Protected_scm (Protected_scm const &);
 public:
   Protected_scm ();
   Protected_scm (SCM);
-  Protected_scm (Protected_scm const &);
   ~Protected_scm ();
   Protected_scm &operator = (SCM);
   Protected_scm &operator = (Protected_scm const &);
   operator SCM () const;
-  SCM to_SCM () const;
 };
 
 #endif /* PROTECTED_SCM_HH */
diff --git a/lily/protected-scm.cc b/lily/protected-scm.cc
index c0235496f4..c0eb374baf 100644
--- a/lily/protected-scm.cc
+++ b/lily/protected-scm.cc
@@ -19,54 +19,51 @@
 
 #include "protected-scm.hh"
 
+// We store the data in the car of a cons cell: it is faster to keep
+// only one object protected during the life time of Protected_scm
+// than several.
+
 Protected_scm::Protected_scm ()
+  : object_ (SCM_UNDEFINED)
 {
-  object_ = SCM_UNDEFINED;
 }
 
 Protected_scm::Protected_scm (SCM s)
+  : object_ (s)
 {
-  object_ = SCM_NIMP (s) ? scm_gc_protect_object (s) : s;
+  // Only allow immediate objects at construction time.  Protected_scm
+  // is intended for variables of static duration, and creating
+  // non-immediate objects when GUILE is not yet up is a bad idea.
+  assert (SCM_IMP (s));
 }
 
-Protected_scm::Protected_scm (Protected_scm const &s)
-{
-  object_ = (SCM_NIMP (s.object_) ? scm_gc_protect_object (s.object_)
-             : s.object_);
-}
+// For static objects, this will be called at program exit.  With the
+// state of the memory system unknown, we refrain from any cleanup
+// actions outside of the object memory itself.
 
 Protected_scm::~Protected_scm ()
 {
-  if (SCM_NIMP (object_))
-    scm_gc_unprotect_object (object_);
+  object_ = SCM_UNDEFINED;
 }
 
 Protected_scm &
 Protected_scm::operator = (SCM s)
 {
-  if (object_ == s)
-    return *this;
+  if (SCM_CONSP (object_))
+    SCM_SETCAR (object_, s);
+  else
+    object_ = SCM_NIMP (s) ? scm_permanent_object (scm_list_1 (s)) : s;
 
-  if (SCM_NIMP (object_))
-    scm_gc_unprotect_object (object_);
-
-  object_ = SCM_NIMP (s) ? scm_gc_protect_object (s) : s;
   return *this;
 }
 
 Protected_scm &
 Protected_scm::operator = (Protected_scm const &s)
 {
-  return operator = (s.object_);
+  return *this = (SCM) s;
 }
 
 Protected_scm::operator SCM () const
 {
-  return object_;
-}
-
-SCM
-Protected_scm::to_SCM () const
-{
-  return object_;
+  return SCM_CONSP (object_) ? SCM_CAR (object_) : object_;
 }
-- 
2.39.2