From 847b05514865e8f0b4c315f43814bb00edb2b63d Mon Sep 17 00:00:00 2001
From: "Guillermo J. Rozas" <edu/mit/csail/zurich/gjr>
Date: Mon, 21 Sep 1987 21:56:14 +0000
Subject: [PATCH] Fix relocation of stack environments on band restore.

---
 v7/src/microcode/bchdmp.c   | 15 ++++++++------
 v7/src/microcode/bintopsb.c |  5 +++--
 v7/src/microcode/fasdump.c  | 40 +++++++++++++++++++++----------------
 v7/src/microcode/fasload.c  | 12 +++++++----
 v7/src/microcode/gccode.h   | 18 ++++++++---------
 v7/src/microcode/psbtobin.c | 29 ++++++++++++++++++---------
 v7/src/microcode/version.h  |  4 ++--
 v8/src/microcode/bintopsb.c |  5 +++--
 v8/src/microcode/psbtobin.c | 29 ++++++++++++++++++---------
 v8/src/microcode/version.h  |  4 ++--
 10 files changed, 99 insertions(+), 62 deletions(-)

diff --git a/v7/src/microcode/bchdmp.c b/v7/src/microcode/bchdmp.c
index 09d0cc8a4..5c27d5e04 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.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;
 
+      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 46dffa3b9..a5bfc9bdb 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.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 519bd6ac8..ae9153de6 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.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();
 
 /* 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;
+
     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 42d678c35..60cdc6e4f 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.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 3d8acc19c..00db3b4b6 100644
--- 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 71fb7b49e..38635d42f 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.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 d1ad63273..2ba45acd0 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.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. */
 
@@ -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 9e551cab7..f99659803 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.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 49cf78eb9..cfbac4df0 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.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 ea0ee5ec6..89fbd100e 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.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. */
 
@@ -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
-- 
2.25.1