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
/* 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);
return Fasload(Arg1, true);
}
\f
+/* 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;
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);
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;
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. */
/* 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
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();
\f
/* The table of all primitive procedures */
/* 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
/* 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
projects / mit-scheme.git / commitdiff