/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.61 1990/06/20 17:38:38 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.62 1990/07/28 18:56:36 jinx Exp $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
#ifndef islower
#include <ctype.h>
#endif
+#include "ostop.h"
extern PTR EXFUN (malloc, (unsigned int size));
extern void EXFUN (free, (PTR ptr));
}
\f
/* Used to test whether it is a dumped executable version */
-Boolean Was_Scheme_Dumped = false;
-int Saved_Heap_Size;
-int Saved_Stack_Size;
-int Saved_Constant_Size;
+
+extern Boolean scheme_dumped_p;
+Boolean scheme_dumped_p = false;
+
+int dumped_heap_size;
+int dumped_stack_size;
+int dumped_constant_size;
static void
DEFUN (find_image_parameters, (file_name, cold_load_p, supplied_p),
(*supplied_p) = false;
(*cold_load_p) = false;
(*file_name) = DEFAULT_BAND_NAME;
- if (!Was_Scheme_Dumped)
+ if (!scheme_dumped_p)
{
Heap_Size = HEAP_SIZE;
Stack_Size = STACK_SIZE;
}
else
{
- Saved_Heap_Size = Heap_Size;
- Saved_Stack_Size = Stack_Size;
- Saved_Constant_Size = Constant_Size;
+ dumped_heap_size = Heap_Size;
+ dumped_stack_size = Stack_Size;
+ dumped_constant_size = Constant_Size;
}
/* This does not set found_p because the image spec. can be
overridden by the options below. It just sets different
Heap_Size = (numeric_option_argument ("-heap", Heap_Size));
Stack_Size = (numeric_option_argument ("-stack", Stack_Size));
Constant_Size = (numeric_option_argument ("-constant", Constant_Size));
- if (Was_Scheme_Dumped
- && ((Heap_Size != Saved_Heap_Size)
- || (Stack_Size != Saved_Stack_Size)
- || (Constant_Size != Saved_Constant_Size)))
+ if (scheme_dumped_p
+ && ((Heap_Size != dumped_heap_size)
+ || (Stack_Size != dumped_stack_size)
+ || (Constant_Size != dumped_constant_size)))
{
fprintf (stderr, "%s warning: Allocation parameters ignored.\n",
(Saved_argv[0]));
fflush (stderr);
- Heap_Size = Saved_Heap_Size;
- Stack_Size = Saved_Stack_Size;
- Constant_Size = Saved_Constant_Size;
+ Heap_Size = dumped_heap_size;
+ Stack_Size = dumped_stack_size;
+ Constant_Size = dumped_constant_size;
}
}
\f
find_image_parameters (&file_name, &cold_load_p, &supplied_p);
- if (Was_Scheme_Dumped)
+ if (scheme_dumped_p)
{
- printf("Executable Scheme Image\n");
+ OS_reset ();
if (!supplied_p)
{
printf ("Scheme Microcode Version %d.%d\n", VERSION, SUBVERSION);
(BLOCKS_TO_BYTES (Stack_Size)),
(BLOCKS_TO_BYTES (Constant_Size)));
/* We are reloading from scratch anyway. */
- Was_Scheme_Dumped = false;
+ scheme_dumped_p = false;
Start_Scheme ((cold_load_p ? BOOT_FASLOAD : BOOT_LOAD_BAND),
file_name);
}
}
-
- Command_Line_Hook();
- Setup_Memory ((BLOCKS_TO_BYTES (Heap_Size)),
- (BLOCKS_TO_BYTES (Stack_Size)),
- (BLOCKS_TO_BYTES (Constant_Size)));
- compiler_initialize ((long) cold_load_p);
- Start_Scheme ((cold_load_p ? BOOT_FASLOAD : BOOT_LOAD_BAND),
- file_name);
+ else
+ {
+ Command_Line_Hook();
+ Setup_Memory ((BLOCKS_TO_BYTES (Heap_Size)),
+ (BLOCKS_TO_BYTES (Stack_Size)),
+ (BLOCKS_TO_BYTES (Constant_Size)));
+ compiler_initialize ((long) cold_load_p);
+ Start_Scheme ((cold_load_p ? BOOT_FASLOAD : BOOT_LOAD_BAND),
+ file_name);
+ }
+ exit (1);
}
\f
#define Default_Init_Fixed_Objects(Fixed_Objects) \
void
Enter_Interpreter()
{
- Interpret (Was_Scheme_Dumped);
+ Interpret (scheme_dumped_p);
fprintf (stderr, "\nThe interpreter returned to top level!\n");
fflush (stderr);
Microcode_Termination (TERM_EXIT);
gc_death_message_buffer[100];
void
-gc_death(code, message, scan, free)
+gc_death (code, message, scan, free)
long code;
char *message;
SCHEME_OBJECT *scan, *free;
{
- fprintf(stderr, "\n%s.\n", message);
- fprintf(stderr, "scan = 0x%lx; free = 0x%lx\n", scan, free);
+ fprintf (stderr, "\n%s.\n", message);
+ fprintf (stderr, "scan = 0x%lx; free = 0x%lx\n", scan, free);
deadly_scan = scan;
deadly_free = free;
- Microcode_Termination(code);
+ Microcode_Termination (code);
/*NOTREACHED*/
}
\f
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dmpwrld.c,v 9.31 1990/06/20 17:40:00 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dmpwrld.c,v 9.32 1990/07/28 18:56:45 jinx Exp $
Copyright (c) 1987, 1988, 1989, 1990 Massachusetts Institute of Technology
#include "scheme.h"
#include "prims.h"
-\f
+
#ifndef unix
#include "Error: dumpworld.c does not work on non-unix machines."
#endif
+#include "ux.h"
+#include "osfs.h"
+#include <sys/file.h>
+\f
/* 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
+#define CANNOT_UNEXEC
+
+#if defined (vax)
+#undef CANNOT_UNEXEC
#endif
-#ifdef hp9000s300
-#define UNEXEC_AVAILABLE
+#if defined (hp9000s300)
+#undef CANNOT_UNEXEC
#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
+#if defined (sun3)
+#undef CANNOT_UNEXEC
#define SEGMENT_MASK (SEGSIZ - 1)
#define A_TEXT_OFFSET(HDR) sizeof (HDR)
#define TEXT_START (PAGSIZ + (sizeof(struct exec)))
/* I haven't tried any below this point. */
-#if defined(umax)
-#define UNEXEC_AVAILABLE
+#if defined (umax)
+#undef CANNOT_UNEXEC
#define HAVE_GETPAGESIZE
#define COFF
#define UMAX
#define SEGMENT_MASK (64 * 1024 - 1)
#endif
-#ifdef celerity
-#define UNEXEC_AVAILABLE
+#if defined (celerity)
+#undef CANNOT_UNEXEC
#endif
-#ifdef sun2
-#define UNEXEC_AVAILABLE
+#if defined (sun2)
+#undef CANNOT_UNEXEC
#define SEGMENT_MASK (SEGSIZ - 1)
#endif
-#ifdef pyr
-#define UNEXEC_AVAILABLE
+#if defined (pyr)
+#undef CANNOT_UNEXEC
#define SEGMENT_MASK (2048-1) /* ZMAGIC format */
/* man a.out for info */
#endif
\f
-#ifndef UNEXEC_AVAILABLE
+#if defined (CANNOT_UEXEC)
#include "Error: dumpworld.c only works on a few machines."
#endif
(((((unsigned) &etext) - 1) & ~SEGMENT_MASK) + (SEGMENT_MASK + 1))
#endif
-#ifdef _HPUX
+#if defined (_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 *) 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. */
+#if defined (USG) || defined (NO_BZERO)
-Boolean
-there_are_open_files()
-{
- register int i;
+#define bzero(b,len) (memset((b), 0, (len)))
- i = FILE_CHANNELS;
- while (i > 0)
- if (Channels[--i] != NULL) return true;
- return false;
-}
+#else
-/* These two procedures depend on the internal structure of a
- FILE object. See /usr/include/stdio.h for details. */
+extern void bzero();
-long
-Save_Input_Buffer()
-{
- long result;
+#endif
- result = (stdin)->_cnt;
- (stdin)->_cnt = 0;
- return result;
-}
+#define static
+
+#if defined (hp9000s800)
+#include "unexhp9k800.c"
+#else
+#include "unexec.c"
+#endif
+#undef static
+\f
void
-Restore_Input_Buffer(Buflen)
- fast long Buflen;
+DEFUN (unix_find_pathname, (program_name, target),
+ CONST char * program_name AND char * target)
{
- (stdin)->_cnt = Buflen;
+ int length;
+ char
+ * path,
+ * next;
+ extern char *
+ EXFUN (index, (char * path AND char srchr));
+ extern void
+ EXFUN (strcpy, (char * target AND CONST char * source));
+
+ /* Attempt first in the connected directory */
+
+ if (((program_name[0]) == '/')
+ || (OS_file_access (program_name, X_OK))
+ || ((path = ((char *) (getenv ("PATH")))) == ((char *) NULL)))
+ {
+ strcpy (target, program_name);
+ return;
+ }
+ for (next = (index (path, ':'));
+ path != ((char *) NULL);
+ path = (next + 1),
+ next = (index (path, ':')))
+ {
+ length = ((next == ((char *) NULL))
+ ? (strlen (path))
+ : (next-path));
+ strncpy (target, path, length);
+ target[length] = '/';
+ target[length + 1] = '\0';
+ strcpy ((target + (length + 1)), program_name);
+ if (OS_file_access (target, X_OK))
+ {
+ return;
+ }
+ }
+ strcpy (target, program_name);
return;
}
-\f
+
/* The primitive visible from Scheme. */
-extern Boolean Was_Scheme_Dumped;
-extern unix_find_pathname();
+extern Boolean scheme_dumped_p;
DEFINE_PRIMITIVE ("DUMP-WORLD", Prim_dump_world, 1, 1, 0)
{
- char *fname, path_buffer[FILE_NAME_LENGTH];
- Boolean Saved_Dumped_Value, Saved_Photo_Open;
- int Result;
- long Buflen;
+ int result;
+ SCHEME_OBJECT arg;
+ Boolean saved_dumped_p;
+ char
+ * fname,
+ path_buffer[FILE_NAME_LENGTH];
+ extern
+ char ** Saved_Argv;
PRIMITIVE_HEADER (1);
PRIMITIVE_CANONICALIZE_CONTEXT();
- if (there_are_open_files())
- signal_error_from_primitive (ERR_OUT_OF_FILE_HANDLES);
+
+ arg = (ARG_REF (1));
fname = (STRING_ARG (1));
/* Set up for restore */
- Saved_Dumped_Value = Was_Scheme_Dumped;
- Saved_Photo_Open = Photo_Open;
-
- /* IO: flushing pending output, and flushing cached input. */
+ saved_dumped_p = scheme_dumped_p;
- fflush(stdout);
- fflush(stderr);
-
- if (Photo_Open)
- {
- fflush(Photo_File_Handle);
- Photo_Open = false;
- }
-
- Buflen = Save_Input_Buffer();
-
- Was_Scheme_Dumped = true;
+ scheme_dumped_p = true;
Val = SHARP_T;
- OS_quit (TERM_HALT, false);
POP_PRIMITIVE_FRAME (1);
/* Dump! */
- unix_find_pathname(Saved_argv[0], path_buffer);
- Result = unexec(fname,
- path_buffer,
- ((unsigned) 0), /* default */
- ((unsigned) 0), /* default */
- ((unsigned) start_of_text())
- );
+ 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_reinitialize();
Val = SHARP_F;
- Was_Scheme_Dumped = Saved_Dumped_Value;
+ scheme_dumped_p = saved_dumped_p;
/* IO: Restoring cached input for this job. */
- Restore_Input_Buffer(Buflen);
- Photo_Open = Saved_Photo_Open;
-
- if (Result != 0)
- {
- STACK_PUSH (ARG_REF (1)); /* Since popped above */
- error_external_return ();
- }
+ if (result != 0)
+ {
+ STACK_PUSH (arg);
+ error_external_return ();
+ }
PRIMITIVE_ABORT (PRIM_POP_RETURN);
/*NOTREACHED*/
/* -*- C -*-
Switzerland local additions to the makefile
- $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/unxutl/Attic/y300.lcl,v 1.9 1990/06/25 18:29:04 jinx Exp $
+ $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/unxutl/Attic/y300.lcl,v 1.10 1990/07/28 18:57:14 jinx Exp $
*/
/* These extra files are for 6003. They assume we're using HP-UX. */
6003_SOURCES = $(X_SOURCES) $(CTERM_SOURCES) $(GRAPHICS_SOURCES)\
- SOURCES_SYSTEM SOURCES_MACHINE Sgraph_ar.c fft.c array.c image.c
+ SOURCES_SYSTEM SOURCES_MACHINE Sgraph_ar.c fft.c array.c\
+ image.c dmpwrld.c
6003_OBJECTS = $(X_OBJECTS) $(CTERM_OBJECTS) $(GRAPHICS_OBJECTS)\
- OBJECTS_SYSTEM OBJECTS_MACHINE Sgraph_ar.o fft.o array.o image.o\
- usr6003.o
+ OBJECTS_SYSTEM OBJECTS_MACHINE Sgraph_ar.o fft.o array.o\
+ image.o dmpwrld.o usr6003.o
6003_LIB = $(USER_LIBS) $(GRAPHICS_LIBS) $(X_LIB) $(CTERM_LIB)\
LIB_MATH LIBS_SYSTEM LIBS_MACHINE LIB_DEBUG LIB_STANDARD
*/
KIT_SOURCES = $(X_SOURCES) $(CTERM_SOURCES) $(GRAPHICS_SOURCES)\
- SOURCES_SYSTEM SOURCES_MACHINE gpio.c
+ SOURCES_SYSTEM SOURCES_MACHINE gpio.c dmpwrld.c
KIT_OBJECTS = $(X_OBJECTS) $(CTERM_OBJECTS) $(GRAPHICS_OBJECTS)\
- OBJECTS_SYSTEM OBJECTS_MACHINE gpio.o usrkit.o
-KIT_LIB = $(USER_LIBS) $(GRAPHICS_LIBS) $(X_LIB) $(CTERM_LIB)\
+ OBJECTS_SYSTEM OBJECTS_MACHINE gpio.o dmpwrld.o usrkit.o
+KIT_LIB = $(USER_LIBS) $(GRAPHICS_LIBS) $(X_LIB) $(CTERM_LIB)\
LIB_MATH LIBS_SYSTEM LIBS_MACHINE LIB_DEBUG LIB_STANDARD -ldvio
/* Franklyn's personal scheme: 6003-like + Sgraph_xt. */
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/unxutl/Attic/ymkfile,v 1.25 1990/06/28 18:20:16 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/unxutl/Attic/ymkfile,v 1.26 1990/07/28 18:57:17 jinx Exp $
Copyright (c) 1989, 1990 Massachusetts Institute of Technology
char.o string.o : scheme.touch prims.h
-boot.o : scheme.touch prims.h version.h paths.h
+boot.o : scheme.touch prims.h version.h paths.h ostop.h
term.o : scheme.touch
compiler.o : config.h object.h sdata.h types.h errors.h const.h returns.h
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/ux.h,v 1.2 1990/07/16 21:06:52 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/ux.h,v 1.3 1990/07/28 18:56:52 jinx Exp $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
#define UX_chmod chmod
#define UX_close close
#define UX_ctime ctime
+#define UX_free free
#define UX_fstat fstat
#define UX_getenv getenv
#define UX_getegid getegid
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxio.c,v 1.2 1990/06/21 20:01:48 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxio.c,v 1.3 1990/07/28 18:56:56 jinx Exp $
Copyright (c) 1990 Massachusetts Institute of Technology
}
}
+void
+DEFUN_VOID (UX_reset_channels)
+{
+ UX_free (channel_table);
+ channel_table = 0;
+ OS_channel_table_size = 0;
+}
+
void
DEFUN_VOID (OS_channel_close_all)
{
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxproc.c,v 1.1 1990/06/20 19:37:22 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxproc.c,v 1.2 1990/07/28 18:57:00 jinx Exp $
Copyright (c) 1990 Massachusetts Institute of Technology
}
}
+void
+DEFUN_VOID (UX_reset_processes)
+{
+ UX_free (process_table);
+ process_table = 0;
+ OS_process_table_size = 0;
+}
+
static Tprocess
DEFUN_VOID (process_allocate)
{
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxterm.c,v 1.2 1990/06/21 20:01:53 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxterm.c,v 1.3 1990/07/28 18:57:03 jinx Exp $
Copyright (c) 1990 Massachusetts Institute of Technology
}
}
+void
+DEFUN_VOID (UX_reset_terminals)
+{
+ UX_free (terminal_table);
+ terminal_table = 0;
+}
+
/* This is called from the file-opening code. */
void
DEFUN (terminal_open, (channel), Tchannel channel)
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxtop.c,v 1.1 1990/06/20 19:37:45 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/uxtop.c,v 1.2 1990/07/28 18:57:07 jinx Exp $
Copyright (c) 1990 Massachusetts Institute of Technology
extern void EXFUN (UX_initialize_tty, (void));
extern void EXFUN (UX_initialize_userio, (void));
+extern void EXFUN (UX_reset_channels, (void));
+extern void EXFUN (UX_reset_processes, (void));
+extern void EXFUN (UX_reset_terminals, (void));
+
extern void EXFUN (OS_initialize_transcript_file, (void));
extern void EXFUN (UX_ctty_save_external_state, (void));
#endif
}
+void
+DEFUN_VOID (OS_reset)
+{
+ /*
+ There should really be a reset for each initialize above,
+ but the rest seem innocuous.
+ */
+
+ UX_reset_channels ();
+ UX_reset_terminals ();
+ UX_reset_processes ();
+}
+\f
void
DEFUN (OS_quit, (code, abnormal_p), int code AND int abnormal_p)
{
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.39 1990/07/24 22:16:52 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.40 1990/07/28 18:57:10 jinx Exp $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 39
+#define SUBVERSION 40
#endif
#ifndef UCODE_TABLES_FILENAME
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.39 1990/07/24 22:16:52 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.40 1990/07/28 18:57:10 jinx Exp $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 39
+#define SUBVERSION 40
#endif
#ifndef UCODE_TABLES_FILENAME
projects / mit-scheme.git / commitdiff