From: Guillermo J. Rozas Date: Fri, 5 Jun 1987 04:16:55 +0000 (+0000) Subject: Fix a long standing bug in fasdump, fasload, band-dump, and band-load. X-Git-Tag: 20090517-FFI~13414 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f12adf0ac8cccda69f750ed04625438def38593e;p=mit-scheme.git Fix a long standing bug in fasdump, fasload, band-dump, and band-load. If a file write fails, a scheme error is reported. Similarly if a read fails. --- diff --git a/v7/src/microcode/bchdmp.c b/v7/src/microcode/bchdmp.c index 01503c052..54d8564a7 100644 --- a/v7/src/microcode/bchdmp.c +++ b/v7/src/microcode/bchdmp.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/Attic/bchdmp.c,v 9.30 1987/06/02 00:16:04 jinx Exp $ */ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchdmp.c,v 9.31 1987/06/05 04:12:14 jinx Exp $ */ /* bchgcl, bchmmg, bchpur, and bchdmp can replace gcloop, memmag, purify, and fasdump, respectively, to provide garbage collection @@ -103,17 +103,18 @@ static fixup_count = 0; *--fixup = ((Pointer) location); \ } -void +Boolean fasdump_exit(length) long length; { extern int ftruncate(), unlink(); fast Pointer *fixes, *fix_address; + Boolean result; Free = saved_free; gc_file = real_gc_file; ftruncate(dump_file, length); - close(dump_file); + result = (close(dump_file) == 0); if (length == 0) unlink(dump_file_name); dump_file_name = ((char *) NULL); @@ -130,8 +131,14 @@ next_buffer: if (fixup_count >= 0) { - lseek(real_gc_file, (fixup_count * GC_BUFFER_BYTES), 0); - read(real_gc_file, fixup_buffer, GC_BUFFER_BYTES); + if ((lseek(real_gc_file, (fixup_count * GC_BUFFER_BYTES), 0) == -1) || + (read(real_gc_file, fixup_buffer, GC_BUFFER_BYTES) != + GC_BUFFER_BYTES)) + { + fprintf(stderr, + "\nCould not read back the fasdump fixup information.\n"); + Microcode_Termination(TERM_EXIT); + } fixup_count -= 1; fixes = fixup_buffer; goto next_buffer; @@ -139,7 +146,7 @@ next_buffer: fixup = fixes; Fasdump_Exit_Hook(); - return; + return result; } Boolean @@ -368,8 +375,8 @@ Built_In_Primitive(Prim_Prim_Fasdump, 3, "PRIMITIVE-FASDUMP", 0x56) fasdump_exit(0); PRIMITIVE_RETURN(NIL); } - fasdump_exit((sizeof(Pointer) * length) + hlength); - PRIMITIVE_RETURN(TRUTH); + PRIMITIVE_RETURN(fasdump_exit((sizeof(Pointer) * length) + hlength) ? + TRUTH : NIL); } /* (DUMP-BAND PROCEDURE FILE-NAME) @@ -382,6 +389,7 @@ Built_In_Primitive(Prim_Band_Dump, 2, "DUMP-BAND", 0xB7) extern Pointer compiler_utilities; Pointer Combination, Ext_Prims; long Arg1Type; + Boolean result; Primitive_2_Args(); Band_Dump_Permitted(); @@ -410,9 +418,17 @@ Built_In_Primitive(Prim_Band_Dump, 2, "DUMP-BAND", 0xB7) /* Aligning here confuses some of the counts computed. Align_Float(Free); */ - Write_File(((long) (Free-Heap_Bottom)), Heap_Bottom, Free-2, - ((long) (Free_Constant-Constant_Space)), - Constant_Space, Free-1); - fclose(File_Handle); - PRIMITIVE_RETURN(TRUTH); + result = Write_File(((long) (Free - Heap_Bottom)), Heap_Bottom, (Free - 2), + ((long) (Free_Constant - Constant_Space)), + Constant_Space, (Free - 1)); + result = (result && Close_Dump_File()); + if (result) + PRIMITIVE_RETURN(TRUTH); + else + { + extern int unlink(); + + unlink(Scheme_String_To_C_String(Arg2)); + PRIMITIVE_RETURN(NIL); + } } diff --git a/v7/src/microcode/bintopsb.c b/v7/src/microcode/bintopsb.c index d7fe0c671..a1e46d8ca 100644 --- a/v7/src/microcode/bintopsb.c +++ b/v7/src/microcode/bintopsb.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/Attic/bintopsb.c,v 9.25 1987/04/16 15:30:25 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bintopsb.c,v 9.26 1987/06/05 04:10:41 jinx Rel $ * * This File contains the code to translate internal format binary * files to portable format. @@ -56,10 +56,14 @@ static long NFlonums, NIntegers, NStrings; static long NBits, NChars; static Pointer *Free_Objects, *Free_Cobjects; +long Load_Data(Count, To_Where) -long Count; -char *To_Where; -{ fread(To_Where, sizeof(Pointer), Count, Internal_File); + long Count; + char *To_Where; +{ + extern int fread(); + + return (fread(To_Where, sizeof(Pointer), Count, Internal_File)); } #define Reloc_or_Load_Debug false diff --git a/v7/src/microcode/boot.c b/v7/src/microcode/boot.c index 19f443c53..7c2842c10 100644 --- a/v7/src/microcode/boot.c +++ b/v7/src/microcode/boot.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.35 1987/05/31 16:32:57 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/boot.c,v 9.36 1987/06/05 04:12:40 jinx Exp $ Copyright (c) 1987 Massachusetts Institute of Technology @@ -535,7 +535,8 @@ long Err, Micro_Error; printf("Mismatch between compiled code and compiled code support.\n"); break; case TERM_DISK_RESTORE: - printf("DISK restore.\n"); break; + printf("Unrecoverable error while loading a band.\n"); + break; case TERM_EOF: printf("\nEnd of input stream reached.\n"); break; case TERM_END_OF_COMPUTATION: diff --git a/v7/src/microcode/config.h b/v7/src/microcode/config.h index 66c0eef18..c3a616c70 100644 --- a/v7/src/microcode/config.h +++ b/v7/src/microcode/config.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/config.h,v 9.25 1987/05/30 23:04:34 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/config.h,v 9.26 1987/06/05 04:13:17 jinx Exp $ * * This file contains the configuration information and the information * given on the command line on Unix. @@ -443,13 +443,13 @@ longjmp(Exit_Point, NORMAL_EXIT) #ifndef STACK_SIZE #ifndef USE_STACKLETS -#define STACK_SIZE 30 /* Default Kcells for stack */ +#define STACK_SIZE 100 /* Default Kcells for stack */ #else #define STACK_SIZE 256 /* Default stacklet size */ #endif #endif #ifndef CONSTANT_SIZE -#define CONSTANT_SIZE 180 /* Default Kcells for constant */ +#define CONSTANT_SIZE 300 /* Default Kcells for constant */ #endif #ifndef HEAP_SIZE #define HEAP_SIZE 250 /* Default Kcells for each heap */ diff --git a/v7/src/microcode/dump.c b/v7/src/microcode/dump.c index 9c12b1430..dca0600bc 100644 --- a/v7/src/microcode/dump.c +++ b/v7/src/microcode/dump.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/Attic/dump.c,v 9.23 1987/06/02 00:17:13 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/dump.c,v 9.24 1987/06/05 04:13:39 jinx Rel $ * * This file contains common code for dumping internal format binary files. */ @@ -82,6 +82,7 @@ prepare_dump_header(Buffer, Heap_Count, Heap_Relocation, Dumped_Object, return; } +Boolean Write_File(Heap_Count, Heap_Relocation, Dumped_Object, Constant_Count, Constant_Relocation, Prim_Exts) Pointer *Heap_Relocation, *Dumped_Object, @@ -92,9 +93,20 @@ Write_File(Heap_Count, Heap_Relocation, Dumped_Object, prepare_dump_header(Buffer,Heap_Count, Heap_Relocation, Dumped_Object, Constant_Count, Constant_Relocation, Prim_Exts); - Write_Data(FASL_HEADER_LENGTH, ((char *) Buffer)); + if (Write_Data(FASL_HEADER_LENGTH, ((char *) Buffer)) != + FASL_HEADER_LENGTH) + return false; if (Heap_Count != 0) - Write_Data(Heap_Count, ((char *) Heap_Relocation)); + { + if (Write_Data(Heap_Count, ((char *) Heap_Relocation)) != + Heap_Count) + return false; + } if (Constant_Count != 0) - Write_Data(Constant_Count, ((char *) Constant_Relocation)); + { + if (Write_Data(Constant_Count, ((char *) Constant_Relocation)) != + Constant_Count) + return false; + } + return true; } diff --git a/v7/src/microcode/extern.h b/v7/src/microcode/extern.h index e291801c1..91bf9c4ec 100644 --- a/v7/src/microcode/extern.h +++ b/v7/src/microcode/extern.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/extern.h,v 9.25 1987/05/29 02:22:08 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/extern.h,v 9.26 1987/06/05 04:13:51 jinx Exp $ * * External declarations. * @@ -132,7 +132,6 @@ extern long Prev_Restore_History_Offset; /* And file "channels" */ extern FILE *(Channels[FILE_CHANNELS]); -extern FILE *File_Handle; /* Used by Fasload/Fasdump */ extern FILE *Photo_File_Handle; /* Used by Photo */ extern int Saved_argc; @@ -163,10 +162,9 @@ extern Pointer C_Integer_To_Scheme_Integer(), Allocate_Float(), /* Random and OS utilities */ extern int Parse_Option(); -extern Boolean Open_File(), Restore_History(), Open_Dump_File(); +extern Boolean Restore_History(); extern long NColumns(), NLines(), System_Clock(); -extern void OS_Flush_Output_Buffer(); -extern void Load_Data(), Write_Data(), OS_Re_Init(); +extern void OS_Flush_Output_Buffer(), OS_Re_Init(); /* Memory management utilities */ diff --git a/v7/src/microcode/fasdump.c b/v7/src/microcode/fasdump.c index e8dc97a5c..9bc22318d 100644 --- a/v7/src/microcode/fasdump.c +++ b/v7/src/microcode/fasdump.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/fasdump.c,v 9.27 1987/06/02 00:17:22 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasdump.c,v 9.28 1987/06/05 04:14:05 jinx Exp $ This file contains code for fasdump and dump-band. */ @@ -185,13 +185,14 @@ int Dump_Mode; return true; } /* DumpLoop */ -void +Boolean Fasdump_Exit() { + Boolean result; fast Pointer *Fixes; Fixes = Fixup; - fclose(File_Handle); + result = Close_Dump_File(); while (Fixes != NewMemTop) { fast Pointer *Fix_Address; @@ -201,6 +202,7 @@ Fasdump_Exit() } Fixup = Fixes; Fasdump_Exit_Hook(); + return result; } /* (PRIMITIVE-FASDUMP object-to-dump file-name flag) @@ -221,6 +223,7 @@ Built_In_Primitive(Prim_Prim_Fasdump, 3, "PRIMITIVE-FASDUMP", 0x56) Pointer Object, File_Name, Flag, *New_Object, *Addr_Of_New_Object, Prim_Exts; long Pure_Length, Length; + Boolean result; Primitive_3_Args(); Object = Arg1; @@ -246,7 +249,8 @@ Built_In_Primitive(Prim_Prim_Fasdump, 3, "PRIMITIVE-FASDUMP", 0x56) #if false if (Flag == TRUTH) - { if (!DumpLoop(New_Object, PURE_COPY)) + { + if (!DumpLoop(New_Object, PURE_COPY)) { Fasdump_Exit(); PRIMITIVE_RETURN(NIL); @@ -262,20 +266,21 @@ Built_In_Primitive(Prim_Prim_Fasdump, 3, "PRIMITIVE-FASDUMP", 0x56) Fasdump_Exit(); PRIMITIVE_RETURN(NIL); } - Length = NewFree-New_Object+2; + Length = ((NewFree - New_Object) + 2); *NewFree++ = Make_Non_Pointer(TC_MANIFEST_SPECIAL_NM_VECTOR, 1); - *NewFree++ = Make_Non_Pointer(END_OF_BLOCK, Length-1); + *NewFree++ = Make_Non_Pointer(END_OF_BLOCK, (Length - 1)); Addr_Of_New_Object = Get_Pointer(New_Object[0]); Prim_Exts = New_Object[1]; New_Object[0] = Make_Non_Pointer(TC_MANIFEST_SPECIAL_NM_VECTOR, Pure_Length); - New_Object[1] = Make_Non_Pointer(PURE_PART, Length-1); - Write_File(0, 0x000000, Addr_Of_New_Object, - Length, New_Object, Prim_Exts); + New_Object[1] = Make_Non_Pointer(PURE_PART, (Length - 1)); + result = Write_File(0, 0x000000, Addr_Of_New_Object, + Length, New_Object, Prim_Exts); } else /* Dumping for reload into heap */ #endif - { if (!DumpLoop(New_Object, NORMAL_GC)) + { + if (!DumpLoop(New_Object, NORMAL_GC)) { Fasdump_Exit(); PRIMITIVE_RETURN(NIL); @@ -283,12 +288,12 @@ Built_In_Primitive(Prim_Prim_Fasdump, 3, "PRIMITIVE-FASDUMP", 0x56) /* Aligning might screw up some of the counters. Align_Float(NewFree); */ - Length = NewFree-New_Object; - Write_File(Length, New_Object, New_Object, - 0, Constant_Space, New_Object+1); + Length = (NewFree - New_Object); + result = Write_File(Length, New_Object, New_Object, + 0, Constant_Space, (New_Object + 1)); } - Fasdump_Exit(); - PRIMITIVE_RETURN(TRUTH); + result = (result && Fasdump_Exit()); + PRIMITIVE_RETURN(result ? TRUTH : NIL); } /* (DUMP-BAND PROCEDURE FILE-NAME) @@ -301,6 +306,7 @@ Built_In_Primitive(Prim_Band_Dump, 2, "DUMP-BAND", 0xB7) extern Pointer compiler_utilities; Pointer Combination, Ext_Prims; long Arg1Type; + Boolean result; Primitive_2_Args(); Band_Dump_Permitted(); @@ -329,9 +335,9 @@ Built_In_Primitive(Prim_Band_Dump, 2, "DUMP-BAND", 0xB7) /* Aligning here confuses some of the counts computed. Align_Float(Free); */ - Write_File(((long) (Free-Heap_Bottom)), Heap_Bottom, Free-2, - ((long) (Free_Constant-Constant_Space)), - Constant_Space, Free-1); - fclose(File_Handle); - PRIMITIVE_RETURN(TRUTH); + result = Write_File(((long) (Free - Heap_Bottom)), Heap_Bottom, (Free - 2), + ((long) (Free_Constant - Constant_Space)), + Constant_Space, (Free - 1)); + result = (result && Close_Dump_File()); + PRIMITIVE_RETURN(result ? TRUTH : NIL); } diff --git a/v7/src/microcode/fasl.h b/v7/src/microcode/fasl.h index a65a9837d..17220c01f 100644 --- a/v7/src/microcode/fasl.h +++ b/v7/src/microcode/fasl.h @@ -30,11 +30,14 @@ 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/fasl.h,v 9.23 1987/04/03 00:12:15 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasl.h,v 9.24 1987/06/05 04:14:25 jinx Rel $ Contains information relating to the format of FASL files. Some information is contained in CONFIG.H. */ + +extern long Load_Data(), Write_Data(); +extern Boolean Open_Dump_File(), Close_Dump_File(); /* FASL Version */ diff --git a/v7/src/microcode/fasload.c b/v7/src/microcode/fasload.c index c0ac9d04d..8841fe54e 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.26 1987/05/29 02:22:32 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.27 1987/06/05 04:14:38 jinx Exp $ The "fast loader" which reads in and relocates binary files and then interns symbols. It is called with one argument: the (character @@ -48,25 +48,26 @@ MIT in each case. */ #include "load.c" -void -Load_File(Name) - Pointer Name; +long +read_file_start(name) + Pointer name; { - char *Char; - long N, i; - Boolean File_Opened; + Boolean file_opened; + + if (Type_Code(name) != TC_CHARACTER_STRING) + return ERR_ARG_1_WRONG_TYPE; + + file_opened = Open_Dump_File(name, OPEN_FLAG); - File_Opened = Open_Dump_File(Name, OPEN_FLAG); if (Per_File) Handle_Debug_Flags(); - if (!File_Opened) - Primitive_Error(ERR_ARG_1_BAD_RANGE); + + if (!file_opened) + return ERR_ARG_1_BAD_RANGE; if (!Read_Header()) - { fprintf(stderr, - "\nLoad_File: The file does not appear to be in FASL format.\n"); - goto CANNOT_LOAD; - } + goto cannot_load; + if (File_Load_Debug) printf("\nMachine type %d, Version %d, Subversion %d\n", Machine_Type, Version, Sub_Version); @@ -80,44 +81,70 @@ Load_File(Name) { fprintf(stderr, - "\nLoad_File: FASL File Version %4d Subversion %4d Machine Type %4d.\n", + "\nread_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); -CANNOT_LOAD: - fclose(File_Handle); - Primitive_Error(ERR_FASL_FILE_BAD_DATA); + +cannot_load: + + Close_Dump_File(); + return ERR_FASL_FILE_BAD_DATA; } - if (!Test_Pure_Space_Top(Free_Constant+Const_Count)) + + if (!Test_Pure_Space_Top(Free_Constant + Const_Count)) { - fclose(File_Handle); - Primitive_Error(ERR_FASL_FILE_TOO_BIG); + Close_Dump_File(); + return ERR_FASL_FILE_TOO_BIG; } + if (GC_Check(Heap_Count)) { - fclose(File_Handle); + Close_Dump_File(); Request_GC(Heap_Count); - Primitive_Interrupt(); + return PRIM_INTERRUPT; } + return PRIM_DONE; +} + +void +read_file_end() +{ /* Aligning Free here confuses the counters Align_Float(Free); */ - Load_Data(Heap_Count, (char *) Free); + if (Load_Data(Heap_Count, ((char *) Free)) != Heap_Count) + { + Close_Dump_File(); + Primitive_Error(ERR_EXTERNAL_RETURN); + } + #ifdef BYTE_INVERSION Byte_Invert_Region((char *) Free, Heap_Count); #endif + Free += Heap_Count; - Load_Data(Const_Count, (char *) Free_Constant); + if (Load_Data(Const_Count, ((char *) Free_Constant)) != Const_Count) + { + Close_Dump_File(); + Primitive_Error(ERR_EXTERNAL_RETURN); + } + #ifdef BYTE_INVERSION Byte_Invert_Region((char *) Free_Constant, Const_Count); #endif + Free_Constant += Const_Count; + /* Same Align_Float(Free); */ - fclose(File_Handle); - return; + + if (Close_Dump_File()) + return; + else + Primitive_Error(ERR_EXTERNAL_RETURN); } /* Statics used by Relocate, below */ @@ -131,7 +158,9 @@ relocation_type Heap_Relocation, Const_Reloc, Stack_Relocation; */ #ifdef ENABLE_DEBUGGING_TOOLS + static Boolean Warned = false; + Pointer * Relocate(P) long P; @@ -310,8 +339,8 @@ Intern_Block(Next_Pointer, Stop_At) */ void -Install_Ext_Prims(Normal_FASLoad) - Boolean Normal_FASLoad; +Install_Ext_Prims(normal_fasload) + Boolean normal_fasload; { long i; Pointer *Next; @@ -319,9 +348,13 @@ Install_Ext_Prims(Normal_FASLoad) Vector_Set(Ext_Prim_Vector, 0, Make_Non_Pointer(TC_MANIFEST_NM_VECTOR, Ext_Prim_Count)); Next = Nth_Vector_Loc(Ext_Prim_Vector, 1); - if (Normal_FASLoad) - for (i = 0; i < Ext_Prim_Count; i++) Intern(Next++); - else Undefined_Externals = NIL; + if (normal_fasload) + { + for (i = 0; i < Ext_Prim_Count; i++) + Intern(Next++); + } + else + Undefined_Externals = NIL; return; } @@ -366,24 +399,20 @@ Update_Ext_Prims(Next_Pointer, Stop_At) } Pointer -Fasload(FileName, Not_From_Band_Load) - Pointer FileName; - Boolean Not_From_Band_Load; +load_file(from_band_load) + Boolean from_band_load; { Pointer *Heap_End, *Constant_End, *Orig_Heap, *Orig_Constant, *Xtemp; + /* Read File */ + #ifdef ENABLE_DEBUGGING_TOOLS Warned = false; #endif - if (Type_Code(FileName) != TC_CHARACTER_STRING) - Primitive_Error(ERR_ARG_1_WRONG_TYPE); - - /* Read File */ - Orig_Heap = Free; Orig_Constant = Free_Constant; - Load_File(FileName); + read_file_end(); Heap_End = Free; Constant_End = Free_Constant; Heap_Relocation = ((relocation_type) Orig_Heap) - Heap_Base; @@ -404,25 +433,25 @@ Fasload(FileName, Not_From_Band_Load) Found_Ext_Prims = false; Relocate_Block(Orig_Heap, Free); Relocate_Block(Orig_Constant, Free_Constant); - + #ifdef BYTE_INVERSION Finish_String_Inversion(); #endif - - if (Not_From_Band_Load) + + if (!from_band_load) { Intern_Block(Orig_Constant, Constant_End); Intern_Block(Orig_Heap, Heap_End); } - /* Update External Primitives */ + /* Update External Primitives */ if ((Ext_Prim_Vector != NIL) && Found_Ext_Prims) { Relocate_Into(Xtemp, Address(Ext_Prim_Vector)); Ext_Prim_Vector = *Xtemp; Ext_Prim_Count = Vector_Length(Ext_Prim_Vector); - Install_Ext_Prims(Not_From_Band_Load); + Install_Ext_Prims(!from_band_load); Update_Ext_Prims(Orig_Heap, Free); Update_Ext_Prims(Orig_Constant, Free_Constant); } @@ -433,22 +462,37 @@ Fasload(FileName, Not_From_Band_Load) } /* (BINARY-FASLOAD FILE-NAME) - Load the contents of FILE-NAME into memory. The file was - presumably made by a call to PRIMITIVE-FASDUMP, and may contain - data for the heap and/or the pure area. The value returned is - the object which was dumped. Typically (but not always) this - will be a piece of SCode which is then evaluated to perform - definitions in some environment. + Load the contents of FILE-NAME into memory. The file was + presumably made by a call to PRIMITIVE-FASDUMP, and may contain + data for the heap and/or the pure area. The value returned is + the object which was dumped. Typically (but not always) this + will be a piece of SCode which is then evaluated to perform + definitions in some environment. */ Built_In_Primitive(Prim_Binary_Fasload, 1, "BINARY-FASLOAD", 0x57) { + long result; Primitive_1_Arg(); - return Fasload(Arg1, true); + + result = read_file_start(Arg1); + if (result != PRIM_DONE) + { + if (result == PRIM_INTERRUPT) + { + Primitive_Interrupt(); + } + else + { + Primitive_Error(result); + } + } + PRIMITIVE_RETURN(load_file(false)); } - + /* Band loading. */ static char *reload_band_name = ((char *) NULL); + /* (RELOAD-BAND-NAME) Returns the filename (as a Scheme string) from which the runtime system @@ -464,6 +508,8 @@ Built_In_Primitive(Prim_reload_band_name, 0, "RELOAD-BAND-NAME", 0x1A3) return C_String_To_Scheme_String(reload_band_name); } +/* Utility for load band below. */ + extern void compiler_reset_error(); void @@ -475,7 +521,7 @@ compiler_reset_error() "the compiled code interface in this microcode are inconsistent.\n"); Microcode_Termination(TERM_COMPILER_DEATH); } - + /* (LOAD-BAND FILE-NAME) Restores the heap and pure space from the contents of FILE-NAME, which is typically a file created by DUMP-BAND. The file can, @@ -483,91 +529,94 @@ compiler_reset_error() */ Built_In_Primitive(Prim_Band_Load, 1, "LOAD-BAND", 0xB9) { + extern char *malloc(); + extern strcpy(), free(); + extern void compiler_reset(); extern Pointer compiler_utilities; - Pointer Save_FO, *Save_Free, *Save_Free_Constant, - Save_Undefined, *Save_Stack_Pointer, - *Save_Stack_Guard, saved_utilities, Result; - long Jump_Value; - jmp_buf Swapped_Buf, *Saved_Buf; - Pointer scheme_band_name; + jmp_buf swapped_buf, *saved_buf; + Pointer *saved_free, *saved_free_constant, *saved_stack_pointer; + long temp, length; + Pointer result; char *band_name; - int length; Primitive_1_Arg(); - band_name = ((char *) NULL); - Save_Fixed_Obj(Save_FO); - Save_Undefined = Undefined_Externals; - Undefined_Externals = NIL; - Save_Free = Free; + saved_free = Free; Free = Heap_Bottom; - Save_Free_Constant = Free_Constant; + saved_free_constant = Free_Constant; Free_Constant = Constant_Space; - Save_Stack_Pointer = Stack_Pointer; - Save_Stack_Guard = Stack_Guard; - saved_utilities = compiler_utilities; + saved_stack_pointer = Stack_Pointer; + Stack_Pointer = Highest_Allocated_Address; + + result = read_file_start(Arg1); + if (result != PRIM_DONE) + { + Free = saved_free; + Free_Constant = saved_free_constant; + Stack_Pointer = saved_stack_pointer; -/* Prim_Band_Load continues on next page */ + if (result == PRIM_INTERRUPT) + { + Primitive_Interrupt(); + } + else + { + Primitive_Error(result); + } + } -/* Prim_Band_Load, continued */ + /* Point of no return. */ + + 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)); /* There is some jiggery-pokery going on here to make sure that all returns from Fasload (including error exits) return to the clean-up code before returning on up the C call stack. */ - Saved_Buf = Back_To_Eval; - Jump_Value = setjmp(Swapped_Buf); - if (Jump_Value == 0) - { - extern char *malloc(); - extern strcpy(), free(); - extern void compiler_reset(); - 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); - Store_Expression(NIL); - Save_Cont(); - Store_Expression(Vector_Ref(Result,0)); - /* Primitive externals handled by Fasload */ - compiler_utilities = Vector_Ref(Result, 1); - compiler_reset(compiler_utilities); - Store_Env(Make_Non_Pointer(GLOBAL_ENV, GO_TO_GLOBAL)); - Set_Pure_Top(); - Band_Load_Hook(); - PRIMITIVE_ABORT(PRIM_DO_EXPRESSION); - } - else + saved_buf = Back_To_Eval; + temp = setjmp(swapped_buf); + if (temp != 0) { + fprintf(stderr, + "\nload-band: Error %d past the point of no return.\n", + temp); if (band_name != ((char *) NULL)) - free(band_name); - compiler_utilities = saved_utilities; - Back_To_Eval = Saved_Buf; - Free = Save_Free; - Free_Constant = Save_Free_Constant; - Stack_Pointer = Save_Stack_Pointer; - Set_Stack_Guard(Save_Stack_Guard); - Undefined_Externals = Save_Undefined; - Restore_Fixed_Obj(Save_FO); - if (Jump_Value == PRIM_INTERRUPT) { - fprintf(stderr, "\nFile too large for memory.\n"); - Jump_Value = ERR_FASL_FILE_BAD_DATA; + fprintf(stderr, "band-name = \"%s\".\n", band_name); + free(band_name); } - Primitive_Error(Jump_Value); + Microcode_Termination(TERM_DISK_RESTORE); + /*NOTREACHED*/ } + + Back_To_Eval = ((jmp_buf *) swapped_buf); + result = load_file(true); + 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); + Store_Expression(NIL); + Save_Cont(); + Store_Expression(Vector_Ref(result, 0)); + + /* Primitive externals handled by load_file */ + + compiler_utilities = Vector_Ref(result, 1); + compiler_reset(compiler_utilities); + Store_Env(Make_Non_Pointer(GLOBAL_ENV, GO_TO_GLOBAL)); + Set_Pure_Top(); + Band_Load_Hook(); + PRIMITIVE_ABORT(PRIM_DO_EXPRESSION); + /*NOTREACHED*/ } #ifdef BYTE_INVERSION diff --git a/v7/src/microcode/load.c b/v7/src/microcode/load.c index 6b7c2c34f..efa349803 100644 --- a/v7/src/microcode/load.c +++ b/v7/src/microcode/load.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/Attic/load.c,v 9.22 1987/04/16 02:25:31 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/load.c,v 9.23 1987/06/05 04:15:09 jinx Rel $ * * This file contains common code for reading internal * format binary files. @@ -54,7 +54,9 @@ Read_Header() Pointer Buffer[FASL_HEADER_LENGTH]; Pointer Pointer_Heap_Base, Pointer_Const_Base; - Load_Data(FASL_OLD_LENGTH, (char *) Buffer); + if (Load_Data(FASL_OLD_LENGTH, ((char *) Buffer)) != + FASL_OLD_LENGTH) + return false; if (Buffer[FASL_Offset_Marker] != FASL_FILE_MARKER) return false; #ifdef BYTE_INVERSION @@ -78,8 +80,10 @@ Read_Header() C_To_Scheme(Nth_Vector_Loc(Pointer_Heap_Base, Heap_Count)); Dumped_Constant_Top = C_To_Scheme(Nth_Vector_Loc(Pointer_Const_Base, Const_Count)); - Load_Data((FASL_HEADER_LENGTH - FASL_OLD_LENGTH), - ((char *) &(Buffer[FASL_OLD_LENGTH]))); + if (Load_Data((FASL_HEADER_LENGTH - FASL_OLD_LENGTH), + ((char *) &(Buffer[FASL_OLD_LENGTH]))) != + (FASL_HEADER_LENGTH - FASL_OLD_LENGTH)) + return false; #ifdef BYTE_INVERSION Byte_Invert_Region(((char *) &(Buffer[FASL_OLD_LENGTH])), (FASL_HEADER_LENGTH - FASL_OLD_LENGTH)); diff --git a/v7/src/microcode/ppband.c b/v7/src/microcode/ppband.c index f1d1d3b86..e989be2a0 100644 --- a/v7/src/microcode/ppband.c +++ b/v7/src/microcode/ppband.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/Attic/ppband.c,v 9.24 1987/04/03 00:06:29 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/ppband.c,v 9.25 1987/06/05 04:11:11 jinx Exp $ * * Dumps Scheme FASL in user-readable form . */ @@ -41,6 +41,8 @@ MIT in each case. */ static Pointer *Memory_Base; +extern int fread(); + #define Load_Data(Count,To_Where) \ fread(To_Where, sizeof(Pointer), Count, stdin) @@ -81,8 +83,10 @@ Boolean scheme_string(From, Quoted) long From; Boolean Quoted; -{ fast long i, Count; +{ + fast long i, Count; fast char *Chars; + Chars = (char *) &Data[From+STRING_CHARS]; if (Chars < ((char *) end_of_memory)) { Count = Get_Integer(Data[From+STRING_LENGTH]); @@ -104,7 +108,9 @@ Boolean Quoted; void scheme_symbol(From) long From; -{ Pointer *symbol; +{ + Pointer *symbol; + symbol = &Data[From+SYMBOL_NAME]; if ((symbol >= end_of_memory) || !scheme_string(via(From+SYMBOL_NAME), false)) @@ -114,7 +120,9 @@ long From; Display(Location, Type, The_Datum) long Location, Type, The_Datum; -{ long Points_To; +{ + long Points_To; + printf("%5x: %2x|%6x ", Location, Type, The_Datum); if (GC_Type_Map[Type & MAX_SAFE_TYPE] != GC_Non_Pointer) Points_To = Relocate((Pointer *) The_Datum); @@ -217,10 +225,12 @@ long Location, Type, The_Datum; main(argc, argv) int argc; char **argv; -{ Pointer *Next; - long i; +{ + Pointer *Next; + long i, total_length; if (argc == 1) - { if (!Read_Header()) + { + if (!Read_Header()) { fprintf(stderr, "Input does not appear to be in FASL format.\n"); exit(1); } @@ -229,40 +239,66 @@ char **argv; printf("External primitives at 0x%x\n\n", Relocate(Ext_Prim_Vector)); } else - { Const_Count = 0; + { + Const_Count = 0; sscanf(argv[1], "%x", &Heap_Base); sscanf(argv[2], "%x", &Const_Base); sscanf(argv[3], "%d", &Heap_Count); printf("Heap Base = 0x%08x; Constant Base = 0x%08x; Heap Count = %d\n", Heap_Base, Const_Base, Heap_Count); } - Data = (Pointer *) malloc(sizeof(Pointer) * (Heap_Count + Const_Count)); + Data = ((Pointer *) malloc(sizeof(Pointer) * (Heap_Count + Const_Count))); end_of_memory = &Data[Heap_Count + Const_Count]; - Load_Data(Heap_Count + Const_Count, Data); - printf("Heap contents\n\n"); - for (Next=Data, i=0; i < Heap_Count; Next++, i++) - if (Safe_Type_Code(*Next)==TC_MANIFEST_NM_VECTOR) - { long j, count = Get_Integer(*Next); + total_length = Load_Data(Heap_Count + Const_Count, Data); + if (total_length != (Heap_Count + Const_Count)) + { + printf("The FASL file does not have the right length.\n"); + printf("Expected %d objects. Obtained %d objects.\n\n", + (Heap_Count + Const_Count), total_length); + if (total_length < Heap_Count) + { + Heap_Count = total_length; + } + total_length -= Heap_Count; + if (total_length < Const_Count) + Const_Count = total_length; + } + printf("Heap contents:\n\n"); + for (Next = Data, i = 0; i < Heap_Count; Next++, i++) + { + if (Safe_Type_Code(*Next) == TC_MANIFEST_NM_VECTOR) + { + long j, count; + + count = Get_Integer(*Next); Display(i, Type_Code(*Next), Address(*Next)); Next += 1; - for (j=0; j < count ; j++, Next++) + for (j = 0; j < count ; j++, Next++) printf(" %02x%06x\n", Type_Code(*Next), Address(*Next)); i += count; Next -= 1; } - else Display(i, Type_Code(*Next), Address(*Next)); - printf("\n\nConstant space\n\n"); - for (; i < Heap_Count+Const_Count; Next++, i++) - if (Safe_Type_Code(*Next)==TC_MANIFEST_NM_VECTOR) - { long j, count = Get_Integer(*Next); + else + Display(i, Type_Code(*Next), Address(*Next)); + } + printf("\n\nConstant space:\n\n"); + for (; i < Heap_Count + Const_Count; Next++, i++) + { + if (Safe_Type_Code(*Next) == TC_MANIFEST_NM_VECTOR) + { + long j, count; + + count = Get_Integer(*Next); Display(i, Type_Code(*Next), Address(*Next)); Next += 1; - for (j=0; j < count ; j++, Next++) + for (j = 0; j < count ; j++, Next++) printf(" %02x%06x\n", Type_Code(*Next), Address(*Next)); i += count; Next -= 1; } - else Display(i, Type_Code(*Next), Address(*Next)); + else + Display(i, Type_Code(*Next), Address(*Next)); + } } diff --git a/v7/src/microcode/psbtobin.c b/v7/src/microcode/psbtobin.c index 69f55e5a6..d23b78a9b 100644 --- a/v7/src/microcode/psbtobin.c +++ b/v7/src/microcode/psbtobin.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/Attic/psbtobin.c,v 9.24 1987/04/17 15:56:08 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/psbtobin.c,v 9.25 1987/06/05 04:11:31 jinx Rel $ * * This File contains the code to translate portable format binary * files to internal format. @@ -55,11 +55,14 @@ static Pointer *Constant_Base, *Constant_Table, static Pointer *Pure_Base, *Pure_Table, *Pure_Object_Base, *Free_Pure; static Pointer *Stack_Top; +long Write_Data(Count, From_Where) long Count; Pointer *From_Where; { - fwrite(((char *) From_Where), sizeof(Pointer), Count, Internal_File); + extern int fwrite(); + + return (fwrite(((char *) From_Where), sizeof(Pointer), Count, Internal_File)); } #include "dump.c" @@ -657,6 +660,7 @@ Read_Header_and_Allocate() do_it() { + Boolean result; long Size; Size = Read_Header_and_Allocate(); @@ -722,8 +726,8 @@ do_it() if ((Constant_Objects == 0) && (Constant_Count == 0) && (Pure_Objects == 0) && (Pure_Count == 0)) - Write_File((Free - Heap_Base), Heap_Base, Dumped_Object, - 0, &Heap[Size], Dumped_Ext_Prim); + result = Write_File((Free - Heap_Base), Heap_Base, Dumped_Object, + 0, &Heap[Size], Dumped_Ext_Prim); else { long Pure_Length, Total_Length; @@ -743,10 +747,15 @@ do_it() Free_Constant[1] = Make_Non_Pointer(END_OF_BLOCK, Total_Length); - Write_File((Free - Heap_Base), Heap_Base, Dumped_Object, - Total_Length, (Pure_Base - 2), Dumped_Ext_Prim); + result = Write_File((Free - Heap_Base), Heap_Base, Dumped_Object, + Total_Length, (Pure_Base - 2), Dumped_Ext_Prim); } } + if (!result) + { + fprintf(stderr, "Error writing the output file.\n"); + exit(1); + } return; } diff --git a/v7/src/microcode/storage.c b/v7/src/microcode/storage.c index 781b1d4cc..6b6c9381b 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.33 1987/05/31 16:37:51 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/storage.c,v 9.34 1987/06/05 04:15:27 jinx Exp $ This file defines the storage for global variables for the Scheme Interpreter. */ @@ -78,7 +78,7 @@ long IntCode, /* Interrupts requesting */ Declare_Fixed_Objects(); -FILE *(Channels[FILE_CHANNELS]), *File_Handle, *Photo_File_Handle; +FILE *(Channels[FILE_CHANNELS]), *Photo_File_Handle; int Saved_argc; char **Saved_argv; diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h index 6a001669a..de6bb6f3d 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.63 1987/06/03 19:57:42 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 9.64 1987/06/05 04:16:55 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 63 +#define SUBVERSION 64 #endif #ifndef UCODE_TABLES_FILENAME diff --git a/v8/src/microcode/bintopsb.c b/v8/src/microcode/bintopsb.c index db968577e..3d14385be 100644 --- a/v8/src/microcode/bintopsb.c +++ b/v8/src/microcode/bintopsb.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/v8/src/microcode/bintopsb.c,v 9.25 1987/04/16 15:30:25 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/bintopsb.c,v 9.26 1987/06/05 04:10:41 jinx Rel $ * * This File contains the code to translate internal format binary * files to portable format. @@ -56,10 +56,14 @@ static long NFlonums, NIntegers, NStrings; static long NBits, NChars; static Pointer *Free_Objects, *Free_Cobjects; +long Load_Data(Count, To_Where) -long Count; -char *To_Where; -{ fread(To_Where, sizeof(Pointer), Count, Internal_File); + long Count; + char *To_Where; +{ + extern int fread(); + + return (fread(To_Where, sizeof(Pointer), Count, Internal_File)); } #define Reloc_or_Load_Debug false diff --git a/v8/src/microcode/fasl.h b/v8/src/microcode/fasl.h index d1917ae2d..f6a2e578b 100644 --- a/v8/src/microcode/fasl.h +++ b/v8/src/microcode/fasl.h @@ -30,11 +30,14 @@ 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/fasl.h,v 9.23 1987/04/03 00:12:15 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/fasl.h,v 9.24 1987/06/05 04:14:25 jinx Rel $ Contains information relating to the format of FASL files. Some information is contained in CONFIG.H. */ + +extern long Load_Data(), Write_Data(); +extern Boolean Open_Dump_File(), Close_Dump_File(); /* FASL Version */ diff --git a/v8/src/microcode/ppband.c b/v8/src/microcode/ppband.c index 590fdf6f0..bdb4f3484 100644 --- a/v8/src/microcode/ppband.c +++ b/v8/src/microcode/ppband.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/v8/src/microcode/ppband.c,v 9.24 1987/04/03 00:06:29 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/ppband.c,v 9.25 1987/06/05 04:11:11 jinx Exp $ * * Dumps Scheme FASL in user-readable form . */ @@ -41,6 +41,8 @@ MIT in each case. */ static Pointer *Memory_Base; +extern int fread(); + #define Load_Data(Count,To_Where) \ fread(To_Where, sizeof(Pointer), Count, stdin) @@ -81,8 +83,10 @@ Boolean scheme_string(From, Quoted) long From; Boolean Quoted; -{ fast long i, Count; +{ + fast long i, Count; fast char *Chars; + Chars = (char *) &Data[From+STRING_CHARS]; if (Chars < ((char *) end_of_memory)) { Count = Get_Integer(Data[From+STRING_LENGTH]); @@ -104,7 +108,9 @@ Boolean Quoted; void scheme_symbol(From) long From; -{ Pointer *symbol; +{ + Pointer *symbol; + symbol = &Data[From+SYMBOL_NAME]; if ((symbol >= end_of_memory) || !scheme_string(via(From+SYMBOL_NAME), false)) @@ -114,7 +120,9 @@ long From; Display(Location, Type, The_Datum) long Location, Type, The_Datum; -{ long Points_To; +{ + long Points_To; + printf("%5x: %2x|%6x ", Location, Type, The_Datum); if (GC_Type_Map[Type & MAX_SAFE_TYPE] != GC_Non_Pointer) Points_To = Relocate((Pointer *) The_Datum); @@ -217,10 +225,12 @@ long Location, Type, The_Datum; main(argc, argv) int argc; char **argv; -{ Pointer *Next; - long i; +{ + Pointer *Next; + long i, total_length; if (argc == 1) - { if (!Read_Header()) + { + if (!Read_Header()) { fprintf(stderr, "Input does not appear to be in FASL format.\n"); exit(1); } @@ -229,40 +239,66 @@ char **argv; printf("External primitives at 0x%x\n\n", Relocate(Ext_Prim_Vector)); } else - { Const_Count = 0; + { + Const_Count = 0; sscanf(argv[1], "%x", &Heap_Base); sscanf(argv[2], "%x", &Const_Base); sscanf(argv[3], "%d", &Heap_Count); printf("Heap Base = 0x%08x; Constant Base = 0x%08x; Heap Count = %d\n", Heap_Base, Const_Base, Heap_Count); } - Data = (Pointer *) malloc(sizeof(Pointer) * (Heap_Count + Const_Count)); + Data = ((Pointer *) malloc(sizeof(Pointer) * (Heap_Count + Const_Count))); end_of_memory = &Data[Heap_Count + Const_Count]; - Load_Data(Heap_Count + Const_Count, Data); - printf("Heap contents\n\n"); - for (Next=Data, i=0; i < Heap_Count; Next++, i++) - if (Safe_Type_Code(*Next)==TC_MANIFEST_NM_VECTOR) - { long j, count = Get_Integer(*Next); + total_length = Load_Data(Heap_Count + Const_Count, Data); + if (total_length != (Heap_Count + Const_Count)) + { + printf("The FASL file does not have the right length.\n"); + printf("Expected %d objects. Obtained %d objects.\n\n", + (Heap_Count + Const_Count), total_length); + if (total_length < Heap_Count) + { + Heap_Count = total_length; + } + total_length -= Heap_Count; + if (total_length < Const_Count) + Const_Count = total_length; + } + printf("Heap contents:\n\n"); + for (Next = Data, i = 0; i < Heap_Count; Next++, i++) + { + if (Safe_Type_Code(*Next) == TC_MANIFEST_NM_VECTOR) + { + long j, count; + + count = Get_Integer(*Next); Display(i, Type_Code(*Next), Address(*Next)); Next += 1; - for (j=0; j < count ; j++, Next++) + for (j = 0; j < count ; j++, Next++) printf(" %02x%06x\n", Type_Code(*Next), Address(*Next)); i += count; Next -= 1; } - else Display(i, Type_Code(*Next), Address(*Next)); - printf("\n\nConstant space\n\n"); - for (; i < Heap_Count+Const_Count; Next++, i++) - if (Safe_Type_Code(*Next)==TC_MANIFEST_NM_VECTOR) - { long j, count = Get_Integer(*Next); + else + Display(i, Type_Code(*Next), Address(*Next)); + } + printf("\n\nConstant space:\n\n"); + for (; i < Heap_Count + Const_Count; Next++, i++) + { + if (Safe_Type_Code(*Next) == TC_MANIFEST_NM_VECTOR) + { + long j, count; + + count = Get_Integer(*Next); Display(i, Type_Code(*Next), Address(*Next)); Next += 1; - for (j=0; j < count ; j++, Next++) + for (j = 0; j < count ; j++, Next++) printf(" %02x%06x\n", Type_Code(*Next), Address(*Next)); i += count; Next -= 1; } - else Display(i, Type_Code(*Next), Address(*Next)); + else + Display(i, Type_Code(*Next), Address(*Next)); + } } diff --git a/v8/src/microcode/psbtobin.c b/v8/src/microcode/psbtobin.c index 1723a1f33..37267fece 100644 --- a/v8/src/microcode/psbtobin.c +++ b/v8/src/microcode/psbtobin.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/v8/src/microcode/psbtobin.c,v 9.24 1987/04/17 15:56:08 jinx Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/psbtobin.c,v 9.25 1987/06/05 04:11:31 jinx Rel $ * * This File contains the code to translate portable format binary * files to internal format. @@ -55,11 +55,14 @@ static Pointer *Constant_Base, *Constant_Table, static Pointer *Pure_Base, *Pure_Table, *Pure_Object_Base, *Free_Pure; static Pointer *Stack_Top; +long Write_Data(Count, From_Where) long Count; Pointer *From_Where; { - fwrite(((char *) From_Where), sizeof(Pointer), Count, Internal_File); + extern int fwrite(); + + return (fwrite(((char *) From_Where), sizeof(Pointer), Count, Internal_File)); } #include "dump.c" @@ -657,6 +660,7 @@ Read_Header_and_Allocate() do_it() { + Boolean result; long Size; Size = Read_Header_and_Allocate(); @@ -722,8 +726,8 @@ do_it() if ((Constant_Objects == 0) && (Constant_Count == 0) && (Pure_Objects == 0) && (Pure_Count == 0)) - Write_File((Free - Heap_Base), Heap_Base, Dumped_Object, - 0, &Heap[Size], Dumped_Ext_Prim); + result = Write_File((Free - Heap_Base), Heap_Base, Dumped_Object, + 0, &Heap[Size], Dumped_Ext_Prim); else { long Pure_Length, Total_Length; @@ -743,10 +747,15 @@ do_it() Free_Constant[1] = Make_Non_Pointer(END_OF_BLOCK, Total_Length); - Write_File((Free - Heap_Base), Heap_Base, Dumped_Object, - Total_Length, (Pure_Base - 2), Dumped_Ext_Prim); + result = Write_File((Free - Heap_Base), Heap_Base, Dumped_Object, + Total_Length, (Pure_Base - 2), Dumped_Ext_Prim); } } + if (!result) + { + fprintf(stderr, "Error writing the output file.\n"); + exit(1); + } return; } diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h index 9137ecef6..9add31099 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.63 1987/06/03 19:57:42 cph Exp $ +/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 9.64 1987/06/05 04:16:55 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 63 +#define SUBVERSION 64 #endif #ifndef UCODE_TABLES_FILENAME