Fix relocation of stack environments on band restore.

diff --git a/v7/src/microcode/bchdmp.c b/v7/src/microcode/bchdmp.c
index 09d0cc8a4d342aadd904b1d7372850775a09ed32..5c27d5e04713cea06c8b91bfe5a30bf3830a6f5f 100644 (file)
--- 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.33 1987/06/18 21:14:40 jinx Rel $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchdmp.c,v 9.34 1987/09/21 21:55:23 jinx Rel $ */
 
 /* bchgcl, bchmmg, bchpur, and bchdmp can replace gcloop, memmag,
    purify, and fasdump, respectively, to provide garbage collection
@@ -184,7 +184,7 @@ dumploop(Scan, To_ptr, To_Address_ptr)
     Switch_by_GC_Type(Temp)
     {
       case TC_BROKEN_HEART:
-        if (Datum(Temp) == 0)
+        if (OBJECT_DATUM(Temp) == 0)
          break;
         if (Scan != (Get_Pointer(Temp)))
        {
@@ -218,10 +218,12 @@ dumploop(Scan, To_ptr, To_Address_ptr)
            return false;
          break;
        }
-
-      case_Non_Pointer:
-       break;
 \f
+      case TC_PRIMITIVE_EXTERNAL:
+      case TC_STACK_ENVIRONMENT:
+      case_Fasload_Non_Pointer:
+       break;
+
       case_compiled_entry_point:
        Old = Get_Pointer(Temp);
        Compiled_BH(true, continue);
@@ -242,12 +244,13 @@ dumploop(Scan, To_ptr, To_Address_ptr)
        fasdump_normal_pointer(copy_cell(), 1);
 
       case TC_REFERENCE_TRAP:
-       if (Datum(Temp) <= TRAP_MAX_IMMEDIATE)
+       if (OBJECT_DATUM(Temp) <= TRAP_MAX_IMMEDIATE)
        {
          /* It is a non pointer. */
          break;
        }
        /* It is a pair, fall through. */
+
       case TC_WEAK_CONS:
       case_Fasdump_Pair:
        fasdump_normal_pointer(copy_pair(), 2);

diff --git a/v7/src/microcode/bintopsb.c b/v7/src/microcode/bintopsb.c
index 46dffa3b94086738d8180c7ab505eecdec68106b..a5bfc9bdb61994d3613f7b15ead2b4ef43463c1d 100644 (file)
--- 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.27 1987/08/07 15:34:56 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bintopsb.c,v 9.28 1987/09/21 21:54:48 jinx Rel $
  *
  * This File contains the code to translate internal format binary
  * files to portable format.
@@ -585,7 +585,7 @@ Process_Area(Code, Area, Bound, Obj, FObj)
 
       case TC_BROKEN_HEART:
        /* [Broken Heart 0] is the cdr of fasdumped symbols. */
-       if (Get_Integer(This) != 0)
+       if (OBJECT_DATUM(This) != 0)
        {
          fprintf(stderr, "%s: Broken Heart found in scan.\n",
                  Program_Name);
@@ -594,6 +594,7 @@ Process_Area(Code, Area, Bound, Obj, FObj)
        *Area += 1;
        break;
 
+      case TC_STACK_ENVIRONMENT:
       case_compiled_entry_point:
        fprintf(stderr,
                "%s: File is not portable: Compiled code.\n",

diff --git a/v7/src/microcode/fasdump.c b/v7/src/microcode/fasdump.c
index 519bd6ac80e12bab1acd88338b10996a2c37238e..ae9153de6178bde4cec6b7f8d424339a6b7e236c 100644 (file)
--- 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.29 1987/06/18 21:15:11 jinx Rel $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasdump.c,v 9.30 1987/09/21 21:55:35 jinx Rel $
 
    This file contains code for fasdump and dump-band.
 */
@@ -46,6 +46,7 @@ MIT in each case. */
 extern Pointer Make_Prim_Exts();
 \f
 /* Some statics used freely in this file */
+
 Pointer *NewFree, *NewMemTop, *Fixup, *Orig_New_Free;
 
 /* FASDUMP:
@@ -92,21 +93,31 @@ Dump_Pointer(Fasdump_Setup_Pointer(Extra_Code, Normal_BH(false, continue)))
 
 #define FASDUMP_FIX_BUFFER 10
 
-Boolean DumpLoop(Scan, Dump_Mode)
-fast Pointer *Scan;
-int Dump_Mode;
-{ fast Pointer *To, *Old, Temp, New_Address, *Fixes;
+Boolean
+DumpLoop(Scan, Dump_Mode)
+     fast Pointer *Scan;
+     int Dump_Mode;
+{
+  fast Pointer *To, *Old, Temp, New_Address, *Fixes;
 
   To = NewFree;
   Fixes = Fixup;
 
   for ( ; Scan != To; Scan++)
-  { Temp = *Scan;
-
+  {
+    Temp = *Scan;
+\f
     Switch_by_GC_Type(Temp)
-    { case TC_BROKEN_HEART:
-        if (Datum(Temp) != 0)
-       { fprintf(stderr, "\nDump: Broken heart in scan.\n");
+    {
+      case TC_PRIMITIVE_EXTERNAL:
+      case TC_STACK_ENVIRONMENT:
+      case_Fasload_Non_Pointer:
+       break;
+
+      case TC_BROKEN_HEART:
+        if (OBJECT_DATUM(Temp) != 0)
+       {
+         fprintf(stderr, "\nDump: Broken heart in scan.\n");
          Microcode_Termination(TERM_BROKEN_HEART);
        }
        break;
@@ -116,12 +127,6 @@ int Dump_Mode;
        Scan += Get_Integer(Temp);
        break;
 
-       /* This should really be case_Fasdump_Non_Pointer,
-          and PRIMITIVE_EXTERNAL should be handled specially
-        */
-      case_Non_Pointer:
-       break;
-
       case_compiled_entry_point:
        Dump_Pointer(Fasdump_Setup_Pointer(Transport_Compiled(),
                                           Compiled_BH(false, continue)));
@@ -130,12 +135,13 @@ int Dump_Mode;
        Setup_Pointer_for_Dump(Transport_Cell());
 
       case TC_REFERENCE_TRAP:
-       if (Datum(Temp) <= TRAP_MAX_IMMEDIATE)
+       if (OBJECT_DATUM(Temp) <= TRAP_MAX_IMMEDIATE)
        {
          /* It is a non pointer. */
          break;
        }
        /* Fall through. */
+
       case TC_WEAK_CONS:
       case_Fasdump_Pair:
        Setup_Pointer_for_Dump(Transport_Pair());

diff --git a/v7/src/microcode/fasload.c b/v7/src/microcode/fasload.c
index 42d678c357f0a8c5e0aa04d80b70c2b04e9aad1b..60cdc6e4fbff3aa798357a4047ec4d9130386b19 100644 (file)
--- 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.29 1987/07/29 08:24:27 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/fasload.c,v 9.30 1987/09/21 21:55:47 jinx Rel $
 
    The "fast loader" which reads in and relocates binary files and then
    interns symbols.  It is called with one argument: the (character
@@ -235,9 +235,10 @@ Relocate_Block(Next_Pointer, Stop_At)
 
     Temp = *Next_Pointer;
     Switch_by_GC_Type(Temp)
-    { case TC_BROKEN_HEART:
+    {
+      case TC_BROKEN_HEART:
       case TC_MANIFEST_SPECIAL_NM_VECTOR:
-      case_Fasdump_Non_Pointer:
+      case_Fasload_Non_Pointer:
         Next_Pointer += 1;
        break;
        
@@ -263,8 +264,11 @@ Relocate_Block(Next_Pointer, Stop_At)
          break;
        }
        /* It is a pointer, fall through. */
+
+      case TC_STACK_ENVIRONMENT:
       case_compiled_entry_point:
-       /* Compiled entry points work automagically. */
+       /* Compiled entry points and stack environments work automagically. */
+
       default:
       {
        fast long Next;

diff --git a/v7/src/microcode/gccode.h b/v7/src/microcode/gccode.h
index 3d8acc19c032ee85271b79cc19bcd369abc429ae..00db3b4b6f09f6ae000b5e6e435ab4d7f5ad8119 100644 (file)
--- a/v7/src/microcode/gccode.h
+++ b/v7/src/microcode/gccode.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/gccode.h,v 9.27 1987/08/16 15:48:31 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/gccode.h,v 9.28 1987/09/21 21:56:03 jinx Exp $
  *
  * This file contains the macros for use in code which does GC-like
  * loops over memory.  It is only included in a few files, unlike
@@ -53,17 +53,17 @@ MIT in each case. */
   case TC_THE_ENVIRONMENT:                             \
   case TC_RETURN_CODE:                                 \
   case TC_PRIMITIVE:                                   \
-  case TC_PCOMB0:                                      \
-  case TC_STACK_ENVIRONMENT
+  case TC_PCOMB0
 
-#define case_Fasdump_Non_Pointer                       \
- case TC_FIXNUM:                                       \
- case TC_CHARACTER:                                    \
- case_simple_Non_Pointer
+#define case_Fasload_Non_Pointer                       \
+  case TC_FIXNUM:                                      \
+  case TC_CHARACTER:                                   \
+  case_simple_Non_Pointer
 
 #define case_Non_Pointer                               \
- case TC_PRIMITIVE_EXTERNAL:                           \
- case_Fasdump_Non_Pointer
+  case TC_PRIMITIVE_EXTERNAL:                          \
+  case TC_STACK_ENVIRONMENT:                           \
+  case_Fasload_Non_Pointer
 
 /* Missing Non Pointer types (must always be treated specially):
    TC_BROKEN_HEART

diff --git a/v7/src/microcode/psbtobin.c b/v7/src/microcode/psbtobin.c
index 71fb7b49e07b152afe8e5afdaafba8491400e0f3..38635d42fb58ba5fa30b3554e7cef6883f86e9b2 100644 (file)
--- 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.26 1987/08/07 15:34:27 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/psbtobin.c,v 9.27 1987/09/21 21:55:06 jinx Rel $
  *
  * This File contains the code to translate portable format binary
  * files to internal format.
@@ -124,12 +124,16 @@ read_a_string(To, Slot)
   string = ((char *) (&To[STRING_CHARS]));
   *Slot = Make_Pointer(TC_CHARACTER_STRING, To);
   fscanf(Portable_File, "%ld %ld", &maxlen, &len);
-  maxlen += 1;                                 /* Null terminated */
+
+  /* Null terminated */
+  maxlen += 1;
   Pointer_Count = STRING_CHARS + char_to_pointer(maxlen);
   To[STRING_HEADER] =
     Make_Non_Pointer(TC_MANIFEST_NM_VECTOR, (Pointer_Count - 1));
   To[STRING_LENGTH] = Make_Non_Pointer(TC_FIXNUM, len);
-  getc(Portable_File);                         /* Space */
+
+  /* Space */
+  getc(Portable_File);
   while (--len >= 0)
     *string++ = ((char) read_a_char());
   *string = '\0';
@@ -353,8 +357,8 @@ read_a_flonum()
   else if ((exponent > MAX_FLONUM_EXPONENT) ||
           (exponent < -MAX_FLONUM_EXPONENT))
   {
-
     /* Skip over mantissa */
+
     while (getc(Portable_File) != '\n') { };
     fprintf(stderr,
            "%s: Floating point exponent too %s!\n",
@@ -473,16 +477,20 @@ Relocate_Objects(From, N, disp)
 
   Until = &From[N];
   while (From < Until)
-  { switch(Type_Code(*From))
-    { case TC_FIXNUM:
+  {
+    switch(Type_Code(*From))
+    {
+      case TC_FIXNUM:
       case TC_CHARACTER:
         From += 1;
         break;
+
       case TC_BIG_FIXNUM:
       case TC_BIG_FLONUM:
       case TC_CHARACTER_STRING:
        *From++ == Make_Object(Type_Code(*From), (disp + Datum(*From)));
        break;
+
       default:
        fprintf(stderr,
                "%s: Unknown External Object Reference with Type 0x%02x",
@@ -534,7 +542,8 @@ Read_Pointers_and_Relocate(N, To)
     VMS_BUG(The_Datum = 0);
     fscanf(Portable_File, "%2x %lx", &The_Type, &The_Datum);
     switch(The_Type)
-    { case CONSTANT_CODE:
+    {
+      case CONSTANT_CODE:
        *To++ = Constant_Table[The_Datum];
        continue;
        
@@ -607,8 +616,10 @@ Print_External_Objects(area_name, Table, N)
 
   for( ; Table < Table_End; Table++)
     switch (Type_Code(*Table))
-    { case TC_FIXNUM:
-      { long The_Number;
+    {
+      case TC_FIXNUM:
+      {
+       long The_Number;
 
        Sign_Extend(*Table, The_Number);
         fprintf(stderr,

diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index d1ad6327380219e40fa4eba5ca2d37de607b3017..2ba45acd00e01ca9d66c3a8c715f86fc56a2a053 100644 (file)
--- 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.100 1987/08/28 21:29:37 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 9.101 1987/09/21 21:56:14 jinx Exp $
 
 This file contains version information for the microcode. */
 \f
@@ -46,7 +46,7 @@ This file contains version information for the microcode. */
 #define VERSION                9
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     100
+#define SUBVERSION     101
 #endif
 
 #ifndef UCODE_TABLES_FILENAME

diff --git a/v8/src/microcode/bintopsb.c b/v8/src/microcode/bintopsb.c
index 9e551cab7757583095d59a84f09918f2bd12b9de..f9965980399a2ff20da64f572ec27880b66f5fa0 100644 (file)
--- 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.27 1987/08/07 15:34:56 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/bintopsb.c,v 9.28 1987/09/21 21:54:48 jinx Rel $
  *
  * This File contains the code to translate internal format binary
  * files to portable format.
@@ -585,7 +585,7 @@ Process_Area(Code, Area, Bound, Obj, FObj)
 
       case TC_BROKEN_HEART:
        /* [Broken Heart 0] is the cdr of fasdumped symbols. */
-       if (Get_Integer(This) != 0)
+       if (OBJECT_DATUM(This) != 0)
        {
          fprintf(stderr, "%s: Broken Heart found in scan.\n",
                  Program_Name);
@@ -594,6 +594,7 @@ Process_Area(Code, Area, Bound, Obj, FObj)
        *Area += 1;
        break;
 
+      case TC_STACK_ENVIRONMENT:
       case_compiled_entry_point:
        fprintf(stderr,
                "%s: File is not portable: Compiled code.\n",

diff --git a/v8/src/microcode/psbtobin.c b/v8/src/microcode/psbtobin.c
index 49cf78eb9353e7b0bb98977557a69013b7e0071e..cfbac4df06b4f002fc92c3902b638315f5ce051f 100644 (file)
--- 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.26 1987/08/07 15:34:27 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/psbtobin.c,v 9.27 1987/09/21 21:55:06 jinx Rel $
  *
  * This File contains the code to translate portable format binary
  * files to internal format.
@@ -124,12 +124,16 @@ read_a_string(To, Slot)
   string = ((char *) (&To[STRING_CHARS]));
   *Slot = Make_Pointer(TC_CHARACTER_STRING, To);
   fscanf(Portable_File, "%ld %ld", &maxlen, &len);
-  maxlen += 1;                                 /* Null terminated */
+
+  /* Null terminated */
+  maxlen += 1;
   Pointer_Count = STRING_CHARS + char_to_pointer(maxlen);
   To[STRING_HEADER] =
     Make_Non_Pointer(TC_MANIFEST_NM_VECTOR, (Pointer_Count - 1));
   To[STRING_LENGTH] = Make_Non_Pointer(TC_FIXNUM, len);
-  getc(Portable_File);                         /* Space */
+
+  /* Space */
+  getc(Portable_File);
   while (--len >= 0)
     *string++ = ((char) read_a_char());
   *string = '\0';
@@ -353,8 +357,8 @@ read_a_flonum()
   else if ((exponent > MAX_FLONUM_EXPONENT) ||
           (exponent < -MAX_FLONUM_EXPONENT))
   {
-
     /* Skip over mantissa */
+
     while (getc(Portable_File) != '\n') { };
     fprintf(stderr,
            "%s: Floating point exponent too %s!\n",
@@ -473,16 +477,20 @@ Relocate_Objects(From, N, disp)
 
   Until = &From[N];
   while (From < Until)
-  { switch(Type_Code(*From))
-    { case TC_FIXNUM:
+  {
+    switch(Type_Code(*From))
+    {
+      case TC_FIXNUM:
       case TC_CHARACTER:
         From += 1;
         break;
+
       case TC_BIG_FIXNUM:
       case TC_BIG_FLONUM:
       case TC_CHARACTER_STRING:
        *From++ == Make_Object(Type_Code(*From), (disp + Datum(*From)));
        break;
+
       default:
        fprintf(stderr,
                "%s: Unknown External Object Reference with Type 0x%02x",
@@ -534,7 +542,8 @@ Read_Pointers_and_Relocate(N, To)
     VMS_BUG(The_Datum = 0);
     fscanf(Portable_File, "%2x %lx", &The_Type, &The_Datum);
     switch(The_Type)
-    { case CONSTANT_CODE:
+    {
+      case CONSTANT_CODE:
        *To++ = Constant_Table[The_Datum];
        continue;
        
@@ -607,8 +616,10 @@ Print_External_Objects(area_name, Table, N)
 
   for( ; Table < Table_End; Table++)
     switch (Type_Code(*Table))
-    { case TC_FIXNUM:
-      { long The_Number;
+    {
+      case TC_FIXNUM:
+      {
+       long The_Number;
 
        Sign_Extend(*Table, The_Number);
         fprintf(stderr,

diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index ea0ee5ec687e7163c3b6a48b04022e17915e1ad3..89fbd100e493f46a280f395d0a0b3c6a5dd4880a 100644 (file)
--- 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.100 1987/08/28 21:29:37 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 9.101 1987/09/21 21:56:14 jinx Exp $
 
 This file contains version information for the microcode. */
 \f
@@ -46,7 +46,7 @@ This file contains version information for the microcode. */
 #define VERSION                9
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     100
+#define SUBVERSION     101
 #endif
 
 #ifndef UCODE_TABLES_FILENAME