From e1a83d59dca28211e4d2b458b71fe6543418e8f0 Mon Sep 17 00:00:00 2001 From: "Guillermo J. Rozas" Date: Sat, 11 Apr 1987 16:05:19 +0000 Subject: [PATCH] Use a new version of GNU Emacs's unexec, and make it work on Suns. --- v7/src/microcode/dmpwrld.c | 192 +++++++++++++++++++++++++------------ 1 file changed, 130 insertions(+), 62 deletions(-) diff --git a/v7/src/microcode/dmpwrld.c b/v7/src/microcode/dmpwrld.c index f3efd253e..76c8e17c7 100644 --- 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 + +/* 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; +} + /* 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; -/* 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); -} - -/* 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" -- 2.25.1