Index: lib/exts/ForeignPtr.hs
===================================================================
RCS file: /home/cvs/root/hugs98/lib/exts/ForeignPtr.hs,v
retrieving revision 1.8
diff -c -r1.8 ForeignPtr.hs
*** lib/exts/ForeignPtr.hs	2002/09/25 22:51:23	1.8
--- lib/exts/ForeignPtr.hs	2002/09/27 10:22:26
***************
*** 16,22 ****
  import Ptr
  import Dynamic
  import Storable         ( Storable )
! import MarshalAlloc     ( malloc, mallocBytes, finalizerFree )
  
  -- #include "Dynamic.h"
  -- INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")
--- 16,22 ----
  import Ptr
  import Dynamic
  import Storable         ( Storable )
! import MarshalAlloc --     ( malloc, mallocBytes, finalizerFree )
  
  -- #include "Dynamic.h"
  -- INSTANCE_TYPEABLE1(ForeignPtr,foreignPtrTc,"ForeignPtr")
***************
*** 29,49 ****
      p == q = eqForeignPtr p q
      p /= q = not (eqForeignPtr p q)
  
! primitive newForeignPtr :: Ptr a -> FunPtr (Ptr a -> IO ()) -> IO (ForeignPtr a)
  
! primitive addForeignPtrFinalizer :: ForeignPtr a -> FunPtr (Ptr a -> IO ()) -> IO ()
  
  primitive touchForeignPtr :: ForeignPtr a -> IO ()
  
  mallocForeignPtr :: Storable a => IO (ForeignPtr a)
  mallocForeignPtr = do
    r <- malloc
!   newForeignPtr r finalizerFree
  
  mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
  mallocForeignPtrBytes n = do
    r <- mallocBytes n
!   newForeignPtr r finalizerFree
  
  withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
  withForeignPtr fo io
--- 29,49 ----
      p == q = eqForeignPtr p q
      p /= q = not (eqForeignPtr p q)
  
! primitive newForeignPtr :: Ptr a -> IO () -> IO (ForeignPtr a)
  
! primitive addForeignPtrFinalizer :: ForeignPtr a -> IO () -> IO ()
  
  primitive touchForeignPtr :: ForeignPtr a -> IO ()
  
  mallocForeignPtr :: Storable a => IO (ForeignPtr a)
  mallocForeignPtr = do
    r <- malloc
!   newForeignPtr r (free r)
  
  mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
  mallocForeignPtrBytes n = do
    r <- mallocBytes n
!   newForeignPtr r (free r)
  
  withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
  withForeignPtr fo io
cvs server: Diffing lib/hugs
cvs server: Diffing libraries
cvs server: Diffing libraries/Hugs
cvs server: Diffing src
Index: src/builtin.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/builtin.c,v
retrieving revision 1.33
diff -c -r1.33 builtin.c
*** src/builtin.c	2002/09/18 16:09:21	1.33
--- src/builtin.c	2002/09/27 10:22:27
***************
*** 2192,2197 ****
--- 2192,2207 ----
      return 1;
  }    
  
+ /* Running finalizers (probably shouldn't be here) */
+ Void runFinalizers() {
+     Cell f;
+     while (next_pending_finalizer > 0) {
+ 	f = pendingFinalizers[--next_pending_finalizer];
+ 	push(f);
+ 	runIO(0);
+     }
+ }
+ 
  static void apMany(n)
  int n; {
      /* stack = argn : ... : arg1 : fun : rest */
Index: src/iomonad.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/iomonad.c,v
retrieving revision 1.34
diff -c -r1.34 iomonad.c
*** src/iomonad.c	2002/09/25 13:49:46	1.34
--- src/iomonad.c	2002/09/27 10:22:28
***************
*** 1614,1625 ****
  
  primFun(primNewFP) { /* Ptr a -> FunPtr (Ptr a -> IO ()) -> IO (ForeignPtr a) */
      Pointer addr = 0;
-     CFinalizer cleanup;
      eval(IOArg(2));
      addr = ptrOf(whnfHead);
!     eval(IOArg(1));
!     cleanup = (CFinalizer)ptrOf(whnfHead);
!     IOReturn(mkMallocPtr(addr,cleanup));
  }
  
  primFun(primAddFPF) { /* ForeignPtr a -> FunPtr (Ptr a -> IO ()) -> IO () */
--- 1614,1622 ----
  
  primFun(primNewFP) { /* Ptr a -> FunPtr (Ptr a -> IO ()) -> IO (ForeignPtr a) */
      Pointer addr = 0;
      eval(IOArg(2));
      addr = ptrOf(whnfHead);
!     IOReturn(mkMallocPtr(addr,IOArg(1)));
  }
  
  primFun(primAddFPF) { /* ForeignPtr a -> FunPtr (Ptr a -> IO ()) -> IO () */
Index: src/machine.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/machine.c,v
retrieving revision 1.9
diff -c -r1.9 machine.c
*** src/machine.c	2002/05/15 18:11:22	1.9
--- src/machine.c	2002/09/27 10:22:28
***************
*** 1310,1315 ****
--- 1310,1320 ----
  					/* is in interval 0..NUM_STACK-1   */
  #endif
  
+     /* run finalizers if there are any... */
+     if (anyPendingFinalizers()) {
+ 	runFinalizers();
+     }
+ 
  unw:switch (whatIs(n)) {                /* unwind spine of application     */
  
  	case AP        : push(n);
Index: src/storage.c
===================================================================
RCS file: /home/cvs/root/hugs98/src/storage.c,v
retrieving revision 1.51
diff -c -r1.51 storage.c
*** src/storage.c	2002/09/25 13:49:46	1.51
--- src/storage.c	2002/09/27 10:22:29
***************
*** 3086,3091 ****
--- 3086,3096 ----
  
  struct strMallocPtr mallocPtrs[NUM_MALLOCPTRS];
  
+ #define NUM_PENDING_FINALIZERS 100
+ 
+ Cell pendingFinalizers[NUM_PENDING_FINALIZERS];
+ int next_pending_finalizer = 0;
+ 
  /* Points to the next available slot in 'mallocPtrs'. */
  int mallocPtr_hw;
  
***************
*** 3095,3101 ****
   */
  Cell mkMallocPtr(ptr,cleanup)            /* create a new malloc pointer    */
  Pointer ptr;
! CFinalizer cleanup; {
      Int i;
      for (i=0; i<NUM_MALLOCPTRS && mallocPtrs[i].refCount!=0; ++i)
  	;					/* Search for unused entry */
--- 3100,3106 ----
   */
  Cell mkMallocPtr(ptr,cleanup)            /* create a new malloc pointer    */
  Pointer ptr;
! Cell cleanup; /* :: IO () */ {
      Int i;
      for (i=0; i<NUM_MALLOCPTRS && mallocPtrs[i].refCount!=0; ++i)
  	;					/* Search for unused entry */
***************
*** 3116,3125 ****
      if (i >= mallocPtr_hw) {
  	mallocPtr_hw = i + 1;
      }
!     mallocPtrs[i].finalizers = cons(mkPtr(cleanup), mallocPtrs[i].finalizers);
      return (mallocPtrs[i].mpcell = ap(MPCELL,i));
  }
  
  Void incMallocPtrRefCnt(n,i)             /* change ref count of MallocPtr */
  Int n;
  Int i; {	
--- 3121,3140 ----
      if (i >= mallocPtr_hw) {
  	mallocPtr_hw = i + 1;
      }
!     mallocPtrs[i].finalizers = cons(cleanup, mallocPtrs[i].finalizers);
      return (mallocPtrs[i].mpcell = ap(MPCELL,i));
  }
  
+ Void addPendingFinalizer(finalizer)
+ Cell finalizer; /* :: IO () */ {
+     if (next_pending_finalizer >= NUM_PENDING_FINALIZERS) {
+ 	ERRMSG(0) "Too many pending finalizers"
+ 	EEND;
+     }
+     fprintf(stderr,"pending finalizer\n");
+     pendingFinalizers[next_pending_finalizer++] = finalizer;
+ }
+ 
  Void incMallocPtrRefCnt(n,i)             /* change ref count of MallocPtr */
  Int n;
  Int i; {	
***************
*** 3128,3135 ****
      mallocPtrs[n].refCount += i;
      if (mallocPtrs[n].refCount <= 0) {
  	Cell p;
! 	for (p=mallocPtrs[n].finalizers; nonNull(p); p=tl(p))
! 	    ((CFinalizer)ptrOf(hd(p)))(mallocPtrs[n].ptr);
  
  	mallocPtrs[n].ptr      = 0;
  	mallocPtrs[n].finalizers = NIL;
--- 3143,3151 ----
      mallocPtrs[n].refCount += i;
      if (mallocPtrs[n].refCount <= 0) {
  	Cell p;
! 	for (p=mallocPtrs[n].finalizers; nonNull(p); p=tl(p)) {
! 	    addPendingFinalizer(hd(p));
! 	}
  
  	mallocPtrs[n].ptr      = 0;
  	mallocPtrs[n].finalizers = NIL;
***************
*** 3563,3568 ****
--- 3579,3588 ----
  		       for (i=0; i<mallocPtr_hw; ++i)
  			   if (isPair(mallocPtrs[i].mpcell))
  			       mark(mallocPtrs[i].finalizers);
+ 
+ 		       for (i=0; i<next_pending_finalizer; ++i) {
+ 			   mark(pendingFinalizers[i]);
+ 		       }
  #endif
  
  		       if (consGC) {
Index: src/storage.h
===================================================================
RCS file: /home/cvs/root/hugs98/src/storage.h,v
retrieving revision 1.44
diff -c -r1.44 storage.h
*** src/storage.h	2002/09/25 13:49:45	1.44
--- src/storage.h	2002/09/27 10:22:29
***************
*** 1038,1049 ****
      Cell finalizers;		/* List of finalizer functions             */
  };
  
! typedef Void (*CFinalizer) Args((Pointer));
  
  extern struct strMallocPtr       mallocPtrs[];
! extern Cell   mkMallocPtr        Args((Void *, CFinalizer));
  extern Void   freeMallocPtr      Args((Cell));
  extern Void   incMallocPtrRefCnt Args((Int, Int));
  
  extern Int    mallocPtr_hw;
  
--- 1038,1050 ----
      Cell finalizers;		/* List of finalizer functions             */
  };
  
! /* typedef Void (*CFinalizer) Args((Pointer)); */
  
  extern struct strMallocPtr       mallocPtrs[];
! extern Cell   mkMallocPtr        Args((Void *, Cell));
  extern Void   freeMallocPtr      Args((Cell));
  extern Void   incMallocPtrRefCnt Args((Int, Int));
+ extern Void   runFinalizers      ();
  
  extern Int    mallocPtr_hw;
  
***************
*** 1051,1056 ****
--- 1052,1063 ----
  #define derefMP(c) (mallocPtrs[(Int)mpOf(c)].ptr)
  #endif /* GC_MALLOCPTRS */
  
+ /* Finalizers waiting to run... */
+ extern Cell pendingFinalizers[];
+ extern int next_pending_finalizer;
+ 
+ #define anyPendingFinalizers() (next_pending_finalizer > 0)
+ 
  #if GC_WEAKPTRS
  /* --------------------------------------------------------------------------
   * Weak Pointers
***************
*** 1185,1191 ****
    Cell  (*makeTuple)       Args((Int));
    Pair  (*pair)            Args((Cell,Cell));
  			   
!   Cell  (*mkMallocPtr)     Args((Void *, CFinalizer));
    Void *(*derefMallocPtr)  Args((Cell));
  			   
    Int   (*mkStablePtr)     Args((Cell));
--- 1192,1198 ----
    Cell  (*makeTuple)       Args((Int));
    Pair  (*pair)            Args((Cell,Cell));
  			   
!   Cell  (*mkMallocPtr)     Args((Void *, Cell));
    Void *(*derefMallocPtr)  Args((Cell));
  			   
    Int   (*mkStablePtr)     Args((Cell));