From 4d94da3931c7743ae21ef07e56c959b1b7224d9d Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Wed, 13 Feb 2008 23:26:23 +0000
Subject: [PATCH] Fix fatal error: FASDUMP wasn't cleaning up correctly when
 signalling an error.

---
 v7/src/microcode/fasdump.c | 11 ++++++++++-
 v7/src/microcode/gccode.h  |  3 ++-
 v7/src/microcode/gcloop.c  | 10 +++++++++-
 3 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/v7/src/microcode/fasdump.c b/v7/src/microcode/fasdump.c
index 6356b7095..e59f5b147 100644
--- 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 eecef351e..606a6fbeb 100644
--- 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 d0fda91fd..ac4c0bcbb 100644
--- 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)
 {
-- 
2.25.1