Use a new version of GNU Emacs's unexec, and make it work on Suns.

diff --git a/v7/src/microcode/dmpwrld.c b/v7/src/microcode/dmpwrld.c
index f3efd253ed4de8f0e6c0ca73eaa60e4a9ecd4994..76c8e17c7bad5b96265a56f7374a3a0afabd0f22 100644 (file)
--- a/v7/src/microcode/dmpwrld.c
+++ b/v7/src/microcode/dmpwrld.c
@@ -30,9 +30,11 @@ Technology nor of any adaptation thereof in any advertising,
 promotional, or sales literature without prior written consent from
 MIT in each case. */
 
-/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dmpwrld.c,v 9.22 1987/04/09 15:59:37 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dmpwrld.c,v 9.23 1987/04/11 16:05:19 jinx Exp $
  *
  * This file contains a primitive to dump an executable version of Scheme.
+ * It uses unexec.c from GNU Emacs.
+ * Look at unexec.c for more information.
  */
 
 #include "scheme.h"
@@ -42,14 +44,97 @@ MIT in each case. */
 #include "Error: dumpworld.c does not work on non-unix machines."
 #endif
 
-#if (!defined(vax) && !defined(hp9000s200) && !defined(celerity) && !defined(sun3))
+/* Compatibility definitions for GNU Emacs's unexec.c.
+   Taken from the various m-*.h and s-*.h files for GNU Emacs.
+*/
+
+#ifdef vax
+#define UNEXEC_AVAILABLE
+#endif
+
+#ifdef hp9000s200
+#define UNEXEC_AVAILABLE
+#define ADJUST_EXEC_HEADER                                             \
+  hdr.a_magic = ((ohdr.a_magic.file_type == OLDMAGIC.file_type) ?      \
+                NEWMAGIC : ohdr.a_magic);
+
+#endif
+
+#ifdef sun3
+#define UNEXEC_AVAILABLE
+#define SEGMENT_MASK           (SEGSIZ - 1)
+#define A_TEXT_OFFSET(HDR)     sizeof (HDR)
+#define TEXT_START             (PAGSIZ + (sizeof(struct exec)))
+#endif
+
+/* I don't know whether the following two are right or not. */
+
+#ifdef sun2
+#define UNEXEC_AVAILABLE
+#define SEGMENT_MASK           (SEGSIZ - 1)
+#endif
+
+#ifdef celerity
+#define UNEXEC_AVAILABLE
+#endif
+
+#ifndef UNEXEC_AVAILABLE
 #include "Error: dumpworld.c only works on a few machines."
 #endif
 
+#ifndef TEXT_START
+#define TEXT_START     0
+#endif
+
+#ifndef SEGMENT_MASK
+#define DATA_START     (&etext)
+#else
+#define DATA_START     \
+(((((unsigned) &etext) - 1) & ~SEGMENT_MASK) + (SEGMENT_MASK + 1))
+#endif
+
+#ifdef hpux
+#define USG
+#define HPUX
+#endif
+\f
+/* More compatibility definitions for unexec. */
+
+extern int end, etext, edata;
+char *start_of_text(), *start_of_data();
+void bzero();
+
+#include "unexec.c"
+
+char 
+*start_of_text()
+{ 
+  return ((char *) TEXT_START);
+}
+
+char 
+*start_of_data()
+{ 
+  return ((char *) DATA_START);
+}
+
+void
+bzero (b, length)
+     register char *b;
+     register int length;
+{
+  while (length-- > 0)
+    *b++ = 0;
+}
+\f
 /* Making sure that IO will be alright when restored. */
 
-Boolean there_are_open_files()
-{ register int i = FILE_CHANNELS;
+Boolean
+there_are_open_files()
+{
+  register int i;
+
+  i = FILE_CHANNELS;
   while (i > 0)
     if (Channels[--i] != NULL) return true;
   return false;
@@ -58,33 +143,37 @@ Boolean there_are_open_files()
 /* These two procedures depend on the internal structure of a 
    FILE object.  See /usr/include/stdio.h for details. */
 
-long Save_Input_Buffer()
-{ long result = (stdin)->_cnt;
+long 
+Save_Input_Buffer()
+{ 
+  long result;
+
+  result = (stdin)->_cnt;
   (stdin)->_cnt = 0;
   return result;
 }
 
-void Restore_Input_Buffer(Buflen)
-fast long Buflen;
-{ (stdin)->_cnt = Buflen;
+void 
+Restore_Input_Buffer(Buflen)
+     fast long Buflen;
+{
+  (stdin)->_cnt = Buflen;
   return;
 }
-
-extern int end, etext, edata;
-extern int unexec();
-static jmp_buf for_error;
 \f
-/* The primitive itself.  Uses unexec from GNU-EMACS */
+/* The primitive visible from Scheme. */
+
+extern Boolean Was_Scheme_Dumped;
+extern unix_find_pathname();
 
 Define_Primitive(Prim_Dump_World, 1, "DUMP-WORLD")
-{ char *fname;
-  extern Boolean Was_Scheme_Dumped;
-  Boolean Saved_Dumped_Value = Was_Scheme_Dumped;
-  Boolean Saved_Photo_Open = Photo_Open;
+{
+  char *fname, path_buffer[FILE_NAME_LENGTH];
+  Boolean Saved_Dumped_Value, Saved_Photo_Open;
   int Result;
   long Buflen;
-
   Primitive_1_Arg();
+
   Arg_1_Type(TC_CHARACTER_STRING);
 
   if (there_are_open_files())
@@ -94,13 +183,20 @@ Define_Primitive(Prim_Dump_World, 1, "DUMP-WORLD")
 
   /* Set up for restore */
 
+  Saved_Dumped_Value = Was_Scheme_Dumped;
+  Saved_Photo_Open = Photo_Open;
+
   /* IO: flushing pending output, and flushing cached input. */
+
   fflush(stdout);
   fflush(stderr);
+
   if (Photo_Open)
-  { fflush(Photo_File_Handle);
+  {
+    fflush(Photo_File_Handle);
     Photo_Open = false;
   }
+
   Buflen = Save_Input_Buffer();
 
   Was_Scheme_Dumped = true;
@@ -110,60 +206,32 @@ Define_Primitive(Prim_Dump_World, 1, "DUMP-WORLD")
 
   /* Dump! */
   
-  Result = setjmp(for_error);
-  if (Result == 0)
-    Result = unexec(fname,
-                   Saved_argv[0],
-                   ((unsigned) (&etext)),
-                   ((unsigned) 0),
-                   ((unsigned) 0)
-                   );
+  unix_find_pathname(Saved_argv[0], path_buffer);
+  Result = unexec(fname,
+                 path_buffer,
+                 ((unsigned) 0),                       /* default */
+                 ((unsigned) 0),                       /* default */
+                 ((unsigned) start_of_text())
+                 );
 
   /* Restore State */
 
   OS_Re_Init();
   Val = NIL;
   Was_Scheme_Dumped = Saved_Dumped_Value;
+
   /* IO: Restoring cached input for this job. */
+
   Restore_Input_Buffer(Buflen);
   Photo_Open = Saved_Photo_Open;
 
   if (Result != 0)
-  { Push(Arg1);                /* Since popped above */
-    Primitive_Error(ERR_FASL_FILE_TOO_BIG);
+  {
+    Push(Arg1);                /* Since popped above */
+    Primitive_Error(ERR_EXTERNAL_RETURN);
   }
-  longjmp(*Back_To_Eval, PRIM_POP_RETURN);
-}
-\f
-/* These things are needed by unexec */
 
-#ifdef hpux
-#define USG
-#define HPUX
-#endif
-
-char *start_of_text()
-{ 
-#if false
-  return ((char *) _start);
-#else
-  return ((char *) 0);
-#endif
-}
-
-char *start_of_data()
-{ return ((char *) (&etext));
-}
-
-#define has_error
-
-void error(msg, a1, a2)
-char *msg;
-int a1, a2;
-{ putc('\n', stderr);
-  fprintf(stderr, msg, a1, a2);
-  putc('\n', stderr);
-  longjmp(for_error, -1);
+  longjmp(*Back_To_Eval, PRIM_POP_RETURN);
+  /*NOTREACHED*/
 }
 
-#include "unexec.c"