From: Guillermo J. Rozas Date: Thu, 12 Mar 1987 17:48:32 +0000 (+0000) Subject: Add RELOAD-BAND-NAME. X-Git-Tag: 20090517-FFI~13674 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=4c9582ce79ff5981a9a8447476474a61802da33e;p=mit-scheme.git Add RELOAD-BAND-NAME. --- diff --git a/v7/src/microcode/fasload.c b/v7/src/microcode/fasload.c index 4da0924ff..7ab38464c 100644 --- a/v7/src/microcode/fasload.c +++ b/v7/src/microcode/fasload.c @@ -30,7 +30,7 @@ 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/fasload.c,v 9.21 1987/01/22 14:24:16 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.22 1987/03/12 17:45:09 jinx Exp $ The "fast loader" which reads in and relocates binary files and then interns symbols. It is called with one argument: the (character @@ -229,23 +229,25 @@ Pointer Name; /* Load_File, continued */ if (!Read_Header()) - { printf("\nThis file does not appear to be in FASL format.\n"); + { fprintf(stderr, + "\nLoad_File: The file does not appear to be in FASL format.\n"); goto CANNOT_LOAD; } if (File_Load_Debug) printf("\nMachine type %d, Version %d, Subversion %d\n", Machine_Type, Version, Sub_Version); #ifdef BYTE_INVERSION - if ((Sub_Version > FASL_SUBVERSION)) + if ((Sub_Version != FASL_SUBVERSION)) #else - if ((Sub_Version > FASL_SUBVERSION) || + if ((Sub_Version != FASL_SUBVERSION) || (Machine_Type != FASL_INTERNAL_FORMAT)) #endif - { printf("\nFASL File Version %4d Subversion %4d Machine Type %4d\n", - Version, Sub_Version , Machine_Type); - printf("Expected: Version %4d Subversion %4d Machine Type %4d\n", + { fprintf(stderr, + "\nLoad_File: FASL File Version %4d Subversion %4d Machine Type %4d.\n", + Version, Sub_Version , Machine_Type); + fprintf(stderr, + " Expected: Version %4d Subversion %4d Machine Type %4d.\n", FASL_FORMAT_VERSION, FASL_SUBVERSION, FASL_INTERNAL_FORMAT); - printf("You may need to use the `Bintopsb' and `Psbtobin' programs.\n"); CANNOT_LOAD: fclose(File_Handle); Primitive_Error(ERR_FASL_FILE_BAD_DATA); @@ -563,19 +565,40 @@ Built_In_Primitive(Prim_Binary_Fasload, 1, "BINARY-FASLOAD") return Fasload(Arg1, true); } +/* Band loading. */ + +static char *reload_band_name = ((char *) NULL); + +/* (RELOAD-BAND-NAME) + Returns the filename (as a Scheme string) from which the runtime system + was band loaded (load-band'ed ?), or NIL if the system was fasl'ed. +*/ +Built_In_Primitive(Prim_reload_band_name, 0, "RELOAD-BAND-NAME") +{ + Primitive_0_Args(); + + if (reload_band_name == NULL) + return NIL; + + return C_String_To_Scheme_String(reload_band_name); +} + /* (LOAD-BAND FILE-NAME) - [Primitive number 0xB9] - Restores the heap and pure space from the contents of FILE-NAME, - which is typically a file created by BAND_DUMP. The file can, - however, be any file which can be loaded with BINARY_FASLOAD. + Restores the heap and pure space from the contents of FILE-NAME, + which is typically a file created by DUMP-BAND. The file can, + however, be any file which can be loaded with BINARY-FASLOAD. */ Built_In_Primitive(Prim_Band_Load, 1, "LOAD-BAND") { Pointer Save_FO, *Save_Free, *Save_Free_Constant, Save_Undefined, *Save_Stack_Pointer, *Save_Stack_Guard, Result; long Jump_Value; jmp_buf Swapped_Buf, *Saved_Buf; + Pointer scheme_band_name; + char *band_name; + int length; Primitive_1_Arg(); + band_name = ((char *) NULL); Save_Fixed_Obj(Save_FO); Save_Undefined = Undefined_Externals; Undefined_Externals = NIL; @@ -597,9 +620,21 @@ Built_In_Primitive(Prim_Band_Load, 1, "LOAD-BAND") Saved_Buf = Back_To_Eval; Jump_Value = setjmp(Swapped_Buf); if (Jump_Value == 0) - { Back_To_Eval = (jmp_buf *) Swapped_Buf; + { extern char *malloc(); + extern strcpy(), free(); + + length = Get_Integer(Fast_Vector_Ref(Arg1, STRING_LENGTH)); + band_name = malloc(length); + if (band_name != ((char *) NULL)) + strcpy(band_name, Scheme_String_To_C_String(Arg1)); + + Back_To_Eval = (jmp_buf *) Swapped_Buf; Result = Fasload(Arg1, false); Back_To_Eval = Saved_Buf; + + if (reload_band_name != ((char *) NULL)) + free(reload_band_name); + reload_band_name = band_name; History = Make_Dummy_History(); Initialize_Stack(); Store_Return(RC_END_OF_COMPUTATION); @@ -614,7 +649,9 @@ Built_In_Primitive(Prim_Band_Load, 1, "LOAD-BAND") longjmp(*Back_To_Eval, PRIM_DO_EXPRESSION); } else - { Back_To_Eval = Saved_Buf; + { if (band_name != ((char *) NULL)) + free(band_name); + Back_To_Eval = Saved_Buf; Free = Save_Free; Free_Constant = Save_Free_Constant; Stack_Pointer = Save_Stack_Pointer; diff --git a/v7/src/microcode/storage.c b/v7/src/microcode/storage.c index 62502fd35..a5e8562fe 100644 --- a/v7/src/microcode/storage.c +++ b/v7/src/microcode/storage.c @@ -30,7 +30,7 @@ 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/storage.c,v 9.25 1987/03/11 07:33:51 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/storage.c,v 9.26 1987/03/12 17:45:52 jinx Exp $ This file defines the storage for global variables for the Scheme Interpreter. */ @@ -599,10 +599,11 @@ char Arg_Count_Table[] = { /* 19F */ (char) 1, /* OPEN-DIRECTORY */ /* 1A0 */ (char) 0, /* DIRECTORY-READ */ /* 1A1 */ (char) 0, /* UNDER-EMACS? */ -/* 1A2 */ (char) 0 /* TTY-FLUSH-OUTPUT */ +/* 1A2 */ (char) 0, /* TTY-FLUSH-OUTPUT */ +/* 1A3 */ (char) 0 /* RELOAD-BAND-NAME */ }; -#if (MAX_PRIMITIVE_NUMBER != 0x1A2) +#if (MAX_PRIMITIVE_NUMBER != 0x1A3) /* Cause an error */ #include "prims.h and storage.c are inconsistent -- arity table" #endif @@ -870,7 +871,7 @@ extern Pointer Prim_bit_string_and_x(), Prim_bit_string_andc_x(), Prim_bit_string_equal_p(), Prim_bit_string_zero_p(), - Prim_under_emacs_p(); + Prim_under_emacs_p(), Prim_reload_band_name(); /* The table of all primitive procedures */ @@ -1327,10 +1328,11 @@ Pointer (*(Primitive_Table[]))() = { /* 19F */ Prim_open_directory, /* 1A0 */ Prim_directory_read, /* 1A1 */ Prim_under_emacs_p, -/* 1A2 */ Prim_tty_flush_output +/* 1A2 */ Prim_tty_flush_output, +/* 1A3 */ Prim_reload_band_name }; -#if (MAX_PRIMITIVE_NUMBER != 0x1A2) +#if (MAX_PRIMITIVE_NUMBER != 0x1A3) /* Cause an error */ #include "Prims.h and storage.c are inconsistent -- Procedure Table" #endif @@ -1793,10 +1795,11 @@ char *Primitive_Names[] = { /* 0x19F in fileio */ "OPEN-DIRECTORY", /* 0x1A0 in fileio */ "DIRECTORY-READ", /* 0x1A1 in sysprim */ "UNDER-EMACS?", -/* 0x1A2 in ttyio */ "TTY-FLUSH-OUTPUT" +/* 0x1A2 in ttyio */ "TTY-FLUSH-OUTPUT", +/* 0x1A3 in fasload */ "RELOAD-BAND-NAME" }; -#if (MAX_PRIMITIVE_NUMBER != 0x1A2) +#if (MAX_PRIMITIVE_NUMBER != 0x1A3) /* Cause an error */ #include "Error: prims.h and storage.c are inconsistent -- Names Table" #endif diff --git a/v7/src/microcode/utabmd.scm b/v7/src/microcode/utabmd.scm index 463305c35..fd1d73d36 100644 --- a/v7/src/microcode/utabmd.scm +++ b/v7/src/microcode/utabmd.scm @@ -37,7 +37,7 @@ ;;;; Machine Dependent Type Tables -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.22 1987/03/09 14:45:18 cph Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.23 1987/03/12 17:48:32 jinx Exp $ (declare (usual-integrations)) @@ -738,6 +738,7 @@ DIRECTORY-READ ;$1A0 UNDER-EMACS? ;$1A1 TTY-FLUSH-OUTPUT ;$1A2 + RELOAD-BAND-NAME ;$1A3 )) ;;; [] External @@ -849,3 +850,4 @@ ;;; This identification string is saved by the system. +"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/utabmd.scm,v 9.23 1987/03/12 17:48:32 jinx Exp $" diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h index 9bbcb620b..db3f7f17b 100644 --- a/v7/src/microcode/version.h +++ b/v7/src/microcode/version.h @@ -30,7 +30,7 @@ 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/version.h,v 9.33 1987/03/11 07:32:56 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 9.34 1987/03/12 17:44:30 jinx Exp $ This file contains version information for the microcode. */ @@ -46,7 +46,7 @@ This file contains version information for the microcode. */ #define VERSION 9 #endif #ifndef SUBVERSION -#define SUBVERSION 33 +#define SUBVERSION 34 #endif #ifndef UCODE_TABLES_FILENAME diff --git a/v8/src/microcode/utabmd.scm b/v8/src/microcode/utabmd.scm index 7b1bc8044..01d7c0e9d 100644 --- a/v8/src/microcode/utabmd.scm +++ b/v8/src/microcode/utabmd.scm @@ -37,7 +37,7 @@ ;;;; Machine Dependent Type Tables -;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.22 1987/03/09 14:45:18 cph Exp $ +;;; $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.23 1987/03/12 17:48:32 jinx Exp $ (declare (usual-integrations)) @@ -738,6 +738,7 @@ DIRECTORY-READ ;$1A0 UNDER-EMACS? ;$1A1 TTY-FLUSH-OUTPUT ;$1A2 + RELOAD-BAND-NAME ;$1A3 )) ;;; [] External @@ -849,3 +850,4 @@ ;;; This identification string is saved by the system. +"$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/utabmd.scm,v 9.23 1987/03/12 17:48:32 jinx Exp $" diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h index 20e96aa9d..b588039fc 100644 --- a/v8/src/microcode/version.h +++ b/v8/src/microcode/version.h @@ -30,7 +30,7 @@ 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/v8/src/microcode/version.h,v 9.33 1987/03/11 07:32:56 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 9.34 1987/03/12 17:44:30 jinx Exp $ This file contains version information for the microcode. */ @@ -46,7 +46,7 @@ This file contains version information for the microcode. */ #define VERSION 9 #endif #ifndef SUBVERSION -#define SUBVERSION 33 +#define SUBVERSION 34 #endif #ifndef UCODE_TABLES_FILENAME