From af0bcf9c286619266f26832caaea624c33683adb Mon Sep 17 00:00:00 2001
From: sof <unknown>
Date: Fri, 14 Mar 1997 03:09:09 +0000
Subject: [PATCH] [project @ 1997-03-14 03:08:24 by sof] Free foreign objects
 on exit

---
 ghc/runtime/storage/SMextn.lc |   72 +++++++++++++++++++++++++++++++++++++++--
 ghc/runtime/storage/SMextn.lh |    1 +
 ghc/runtime/storage/SMinit.lc |    4 ++-
 3 files changed, 74 insertions(+), 3 deletions(-)

diff --git a/ghc/runtime/storage/SMextn.lc b/ghc/runtime/storage/SMextn.lc
index 67020a8..481fe7b 100644
--- a/ghc/runtime/storage/SMextn.lc
+++ b/ghc/runtime/storage/SMextn.lc
@@ -161,8 +161,8 @@ Trace_ForeignObj( FOptr )
   P_ FOptr;
 {
   if (RTSflags.GcFlags.trace & DEBUG_TRACE_FOREIGNOBJS) {
-    printf("DEBUG: ForeignObj(%lx)=<%lx,_,%lx,%lx,%lx>\n", (W_) FOptr, (W_) FOptr[0], (W_) FOptr[1], (W_) FOptr[2], (W_) FOptr[3]);
-    printf(" Data = %lx, Finaliser = %lx, Next = %lx\n", 
+    printf("DEBUG: ForeignObj(%0x)=<%0x,%0x,%0x,%0x>\n", (W_) FOptr, (W_) FOptr[0], (W_) FOptr[1], (W_) FOptr[2], (W_) FOptr[3]);
+    printf(" Data = %0x, Finaliser = %0x, Next = %0x\n", 
 	(W_) ForeignObj_CLOSURE_DATA(FOptr), 
 	(W_) ForeignObj_CLOSURE_FINALISER(FOptr), 
 	(W_) ForeignObj_CLOSURE_LINK(FOptr) );
@@ -362,6 +362,74 @@ reportDeadForeignObjs(oldFOList, new, newFOList)
 #endif /* _INFO_COPYING */
 \end{code}
 
+@freeForeigns@ summarily calls the finaliser routines for
+all live foreign objects, done when closing down.
+(code is just a rip off of the above).
+
+\begin{code}
+#if defined(_INFO_COPYING)
+
+#if defined(DEBUG)
+# if defined(GCgn)
+
+EXTDATA_RO(Forward_Ref_New_info);
+EXTDATA_RO(Forward_Ref_Old_info);
+EXTDATA_RO(OldRoot_Forward_Ref_info);
+
+# else
+
+EXTDATA_RO(Forward_Ref_info);
+
+# endif
+#endif
+
+/* 
+  Call the ForeignObj finalising routine on all the live FOs,
+  used when shutting down.
+*/
+int
+freeForeigns(foList)
+  P_ foList;
+{
+    P_ FOptr, temp;
+    I_ FO_deaths = 0;
+
+    /* At this point, exitSSM() has been calledthe ForeignObjList is in an invalid state (since
+       some info ptrs will have been mangled) so we can't validate
+       it. ADR */
+
+    DEBUG_STRING("Freeing all live Foreign Objects:");
+    FOptr = foList;
+    while ( FOptr != NULL ) {
+
+	/* I'm not convinced that the situation of having
+	   indirections linked into the FO list can ever occur,
+	   but chasing indirections doesn't hurt. */
+       while(IS_INDIRECTION(INFO_PTR(FOptr))) {
+    	   FOptr = (P_) IND_CLOSURE_PTR(FOptr);
+       }
+
+       if ((P_) INFO_PTR(FOptr) == ForeignObj_info ) {
+          TRACE_ForeignObj(FOptr);
+          TRACE_FOdies(FOptr);
+          (*(void (*)(StgAddr))(ForeignObj_CLOSURE_FINALISER(FOptr)))((StgAddr)ForeignObj_CLOSURE_DATA(FOptr));
+          FO_deaths++;
+
+          temp  = FOptr;
+          FOptr = ForeignObj_CLOSURE_LINK(FOptr);
+     
+          /* Now trash the closure to encourage bugs to show themselves */
+          TRASH_ForeignObj_CLOSURE( temp );
+      } else {
+	  fprintf(stderr, "Warning: Foreign object list contained unexpected element, bailing out of FO cleanup.\n"); 
+	  return 1;
+      }
+    }
+    return 0;
+}
+#endif /* _INFO_COPYING */
+\end{code}
+
 \upsection
 
 \begin{code}
diff --git a/ghc/runtime/storage/SMextn.lh b/ghc/runtime/storage/SMextn.lh
index 4bac2bc..8e0b7f2 100644
--- a/ghc/runtime/storage/SMextn.lh
+++ b/ghc/runtime/storage/SMextn.lh
@@ -9,6 +9,7 @@ void initExtensions PROTO((smInfo *sm));
 
 void evacSPTable PROTO((smInfo *sm));
 void reportDeadForeignObjs PROTO((StgPtr oldMPList, StgPtr new, StgPtr *newMPLust));
+int  freeForeigns PROTO((StgPtr foList));
 
 # endif /* _INFO_COPYING */
 
diff --git a/ghc/runtime/storage/SMinit.lc b/ghc/runtime/storage/SMinit.lc
index 6de8ecb..2693f10 100644
--- a/ghc/runtime/storage/SMinit.lc
+++ b/ghc/runtime/storage/SMinit.lc
@@ -23,8 +23,10 @@ A filehandle to which any storage-manager statistics should be written.
 rtsBool
 exitSM (smInfo *sm_info)
 {
+    int rc;
      /* Upon closing down the storage manager, we free all foreign objects */
-    freeForeigns(sm_info->ForeignObjList);
+    rc = freeForeigns(sm_info->ForeignObjList);
+     /* Return code ignored for now */
     stat_exit(sm_info->hp - hp_start);
 
     return rtsTrue; /* I'm happy */
-- 
1.7.10.4