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