Fix fatal error: FASDUMP wasn't cleaning up correctly when signalling

an error.

diff --git a/v7/src/microcode/fasdump.c b/v7/src/microcode/fasdump.c
index 6356b70953fee27b98397db589ad509c2bdfd5dc..e59f5b147f619434a0635dc882562b50c61b5aa8 100644 (file)
--- a/v7/src/microcode/fasdump.c
+++ b/v7/src/microcode/fasdump.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: fasdump.c,v 9.73 2008/01/30 20:02:12 cph Exp $
+$Id: fasdump.c,v 9.74 2008/02/13 23:26:21 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -72,6 +72,7 @@ typedef struct
 } fasl_file_info_t;
 
 static void close_fasl_file (void *);
+static void abort_fasdump (void *);
 static gc_walk_proc_t save_tospace_write;
 
 static fasl_header_t fasl_header;
@@ -139,6 +140,8 @@ at by compiled code are ignored (and discarded).")
   transaction_record_action (tat_always, close_fasl_file, (&ff_info));
 
   open_tospace (heap_start);
+  /* This must be _before_ the call to initialize_fixups(): */
+  transaction_record_action (tat_abort, abort_fasdump, 0);
   initialize_fixups ();
 
   new_heap_start = (get_newspace_ptr ());
@@ -193,6 +196,12 @@ close_fasl_file (void * p)
     OS_file_remove (ff_info->filename);
 }
 
+static void
+abort_fasdump (void * p)
+{
+  discard_tospace ();
+}
+
 static bool
 save_tospace_write (SCHEME_OBJECT * start, SCHEME_OBJECT * end, void * p)
 {

diff --git a/v7/src/microcode/gccode.h b/v7/src/microcode/gccode.h
index eecef351e734bad31970f017b169e5bbd3767b38..606a6fbebb5b1c76db2b3b7fa77039bcf89d89d2 100644 (file)
--- a/v7/src/microcode/gccode.h
+++ b/v7/src/microcode/gccode.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: gccode.h,v 9.64 2008/01/30 20:02:13 cph Exp $
+$Id: gccode.h,v 9.65 2008/02/13 23:26:22 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -201,6 +201,7 @@ extern SCHEME_OBJECT * get_newspace_ptr (void);
 extern void * tospace_to_newspace (void *);
 extern void * newspace_to_tospace (void *);
 extern bool save_tospace (gc_walk_proc_t *, void *);
+extern void discard_tospace (void);
 
 extern void initialize_weak_chain (void);
 extern void update_weak_pointers (void);

diff --git a/v7/src/microcode/gcloop.c b/v7/src/microcode/gcloop.c
index d0fda91fdb46f2064eb5cbe1345b4886631330e5..ac4c0bcbbb0c9c788ea6b62a052c579dcd8075cc 100644 (file)
--- a/v7/src/microcode/gcloop.c
+++ b/v7/src/microcode/gcloop.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Id: gcloop.c,v 9.55 2008/01/30 20:02:13 cph Exp $
+$Id: gcloop.c,v 9.56 2008/02/13 23:26:23 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -207,6 +207,14 @@ save_tospace (gc_walk_proc_t * proc, void * ctx)
   return (ok);
 }
 
+void
+discard_tospace (void)
+{
+  GUARANTEE_TOSPACE_OPEN ();
+  CHECK_NEWSPACE_SYNC ();
+  CLOSE_TOSPACE ();
+}
+
 bool
 tospace_available_p (unsigned long n_words)
 {