Change the representation of compiled procedures and other entries:
authorGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Sat, 12 Mar 1988 15:58:27 +0000 (15:58 +0000)
committerGuillermo J. Rozas <edu/mit/csail/zurich/gjr>
Sat, 12 Mar 1988 15:58:27 +0000 (15:58 +0000)
They are now just the address of an instruction with a gc offset
preceding the instruction and an arity/type word preceding that.
Compiled closures are done by creating a tiny fake compiled code block
which jumps to the right place and sets up the free variables for
reference.

Uuo style links are now just jump instructions to the correct address.
All relocators have been updated to reflect this change.

Variable caches have no type code. The relocators know about this.

Incorporate JRM's fix to signal to close interrupt gap in hp-ux.

New types:
TC_COMPILED_ENTRY
TC_MANIFEST_CLOSURE
TC_LINKAGE_SECTION

v7/src/microcode/bintopsb.c
v7/src/microcode/psbtobin.c
v8/src/microcode/bintopsb.c
v8/src/microcode/psbtobin.c

index 1812e0ce162ccf98e17ae716f7fe1453fab2c61f..ada5c24b0dee95b5979905a62b5a7a403f4033d0 100644 (file)
@@ -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.33 1988/02/10 15:41:50 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bintopsb.c,v 9.34 1988/03/12 15:58:02 jinx Rel $
  *
  * This File contains the code to translate internal format binary
  * files to portable format.
@@ -650,7 +650,7 @@ print_a_flonum(val)
   Old_Contents = *Old_Address;                                         \
                                                                        \
   Mem_Base[(Scn)] =                                                    \
-   Make_Non_Pointer(TC_COMPILED_EXPRESSION,                            \
+   Make_Non_Pointer(TC_COMPILED_ENTRY,                                 \
                    (compiled_entry_pointer - compiled_entry_table));   \
                                                                        \
   offset = (((char *) saved) - ((char *) Old_Address));                        \
@@ -903,6 +903,7 @@ Process_Area(Code, Area, Bound, Obj, FObj)
 
     Switch_by_GC_Type(This)
     {
+
 #ifndef PRIMITIVE_EXTERNAL_REUSED
 
       case TC_PRIMITIVE_EXTERNAL:
@@ -951,6 +952,15 @@ Process_Area(Code, Area, Bound, Obj, FObj)
        *Area += 1;
        break;
 
+      case TC_MANIFEST_CLOSURE:
+      case TC_LINKAGE_SECTION:
+      {
+       fprintf(stderr,
+               "%s: File contains linked compiled code.\n",
+               program_name);
+       quit(1);
+      }
+
       case_compiled_entry_point:
        compiled_p = true;
        if (!allow_compiled_p)
@@ -1149,7 +1159,7 @@ print_objects(from, to)
        fprintf(portable_file, "%lx\n", ((unsigned long) *from++));
       }
     }
-    else if (the_type == TC_COMPILED_EXPRESSION)
+    else if (the_type == TC_COMPILED_ENTRY)
     {
       Pointer base;
       long offset;
@@ -1158,7 +1168,7 @@ print_objects(from, to)
       base = compiled_entry_table[the_datum + 1];
 
       fprintf(portable_file, "%02x %lx %02x %lx\n",
-             TC_COMPILED_EXPRESSION, offset,
+             TC_COMPILED_ENTRY, offset,
              OBJECT_TYPE(base), OBJECT_DATUM(base));
     }
     else
@@ -1191,7 +1201,7 @@ when(what, message)
   return;
 }
 
-#define PRINT_HEADER(name, format, obj)                                        \
+#define WRITE_HEADER(name, format, obj)                                        \
 {                                                                      \
   fprintf(portable_file, (format), (obj));                             \
   fprintf(portable_file, "\n");                                                \
@@ -1206,7 +1216,7 @@ when(what, message)
 
 #define WHEN(what, message)
 
-#define PRINT_HEADER(name, format, obj)                                        \
+#define WRITE_HEADER(name, format, obj)                                        \
 {                                                                      \
   fprintf(portable_file, (format), (obj));                             \
   fprintf(portable_file, "\n");                                                \
@@ -1471,38 +1481,38 @@ do_it()
 
   /* Header */
 
-  PRINT_HEADER("Portable Version", "%ld", PORTABLE_VERSION);
-  PRINT_HEADER("Machine", "%ld", FASL_INTERNAL_FORMAT);
-  PRINT_HEADER("Version", "%ld", FASL_FORMAT_VERSION);
-  PRINT_HEADER("Sub Version", "%ld", FASL_SUBVERSION);
-  PRINT_HEADER("Flags", "%ld", (MAKE_FLAGS()));
+  WRITE_HEADER("Portable Version", "%ld", PORTABLE_VERSION);
+  WRITE_HEADER("Machine", "%ld", FASL_INTERNAL_FORMAT);
+  WRITE_HEADER("Version", "%ld", FASL_FORMAT_VERSION);
+  WRITE_HEADER("Sub Version", "%ld", FASL_SUBVERSION);
+  WRITE_HEADER("Flags", "%ld", (MAKE_FLAGS()));
 
-  PRINT_HEADER("Heap Count", "%ld", (Free - NROOTS));
-  PRINT_HEADER("Heap Base", "%ld", NROOTS);
-  PRINT_HEADER("Heap Objects", "%ld", Objects);
+  WRITE_HEADER("Heap Count", "%ld", (Free - NROOTS));
+  WRITE_HEADER("Heap Base", "%ld", NROOTS);
+  WRITE_HEADER("Heap Objects", "%ld", Objects);
 
   /* Currently Constant and Pure not supported, but the header is ready */
 
-  PRINT_HEADER("Pure Count", "%ld", 0);
-  PRINT_HEADER("Pure Base", "%ld", Free_Constant);
-  PRINT_HEADER("Pure Objects", "%ld", 0);
+  WRITE_HEADER("Pure Count", "%ld", 0);
+  WRITE_HEADER("Pure Base", "%ld", Free_Constant);
+  WRITE_HEADER("Pure Objects", "%ld", 0);
 
-  PRINT_HEADER("Constant Count", "%ld", 0);
-  PRINT_HEADER("Constant Base", "%ld", Free_Constant);
-  PRINT_HEADER("Constant Objects", "%ld", 0);
+  WRITE_HEADER("Constant Count", "%ld", 0);
+  WRITE_HEADER("Constant Base", "%ld", Free_Constant);
+  WRITE_HEADER("Constant Objects", "%ld", 0);
 
-  PRINT_HEADER("& Dumped Object", "%ld", (OBJECT_DATUM(Mem_Base[0])));
+  WRITE_HEADER("& Dumped Object", "%ld", (OBJECT_DATUM(Mem_Base[0])));
 
-  PRINT_HEADER("Number of flonums", "%ld", NFlonums);
-  PRINT_HEADER("Number of integers", "%ld", NIntegers);
-  PRINT_HEADER("Number of bits in integers", "%ld", NBits);
-  PRINT_HEADER("Number of bit strings", "%ld", NBitstrs);
-  PRINT_HEADER("Number of bits in bit strings", "%ld", NBBits);
-  PRINT_HEADER("Number of character strings", "%ld", NStrings);
-  PRINT_HEADER("Number of characters in strings", "%ld", NChars);
+  WRITE_HEADER("Number of flonums", "%ld", NFlonums);
+  WRITE_HEADER("Number of integers", "%ld", NIntegers);
+  WRITE_HEADER("Number of bits in integers", "%ld", NBits);
+  WRITE_HEADER("Number of bit strings", "%ld", NBitstrs);
+  WRITE_HEADER("Number of bits in bit strings", "%ld", NBBits);
+  WRITE_HEADER("Number of character strings", "%ld", NStrings);
+  WRITE_HEADER("Number of characters in strings", "%ld", NChars);
 
-  PRINT_HEADER("Number of primitives", "%ld", Primitive_Table_Length);
-  PRINT_HEADER("Number of characters in primitives", "%ld", NPChars);
+  WRITE_HEADER("Number of primitives", "%ld", Primitive_Table_Length);
+  WRITE_HEADER("Number of characters in primitives", "%ld", NPChars);
 
   if (!compiled_p)
   {
@@ -1510,11 +1520,11 @@ do_it()
     dumped_interface_version = 0;
   }
 
-  PRINT_HEADER("CPU type", "%ld", dumped_processor_type);
-  PRINT_HEADER("Compiled code interface version", "%ld",
+  WRITE_HEADER("CPU type", "%ld", dumped_processor_type);
+  WRITE_HEADER("Compiled code interface version", "%ld",
               dumped_interface_version);
 #if false
-  PRINT_HEADER("Compiler utilities vector", "%ld",
+  WRITE_HEADER("Compiler utilities vector", "%ld",
               OBJECT_DATUM(dumped_utilities));
 #endif
 \f
@@ -1597,7 +1607,11 @@ do_it()
 \f
 /* Top Level */
 
-Boolean ci_version_sup_p, ci_processor_sup_p;
+static Boolean
+  help_p = false,
+  help_sup_p,
+  ci_version_sup_p,
+  ci_processor_sup_p;
 
 /* The boolean value here is what value to store when the option is present. */
 
@@ -1613,6 +1627,7 @@ static struct keyword_struct
            &ci_version_sup_p),
     KEYWORD("ci_processor", &compiler_processor_type, INT_KYWRD, "%ld",
            &ci_processor_sup_p),
+    KEYWORD("help", &help_p, BOOLEAN_KYWRD, BFRMT, &help_sup_p),
     OUTPUT_KEYWORD(),
     INPUT_KEYWORD(),
     END_KEYWORD()
@@ -1623,6 +1638,11 @@ main(argc, argv)
      char *argv[];
 {
   parse_keywords(argc, argv, options, false);
+  if (help_sup_p && help_p)
+  {
+    print_usage_and_exit(options, 0);
+    /*NOTREACHED*/
+  }
   setup_io();
   do_it();
   quit(0);
index d9a53a596df0a775da256fcf0b5df8b57b526918..37ce4e83ae339089609d1e06e09147b2b7889daa 100644 (file)
@@ -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.32 1988/02/10 15:43:12 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/psbtobin.c,v 9.33 1988/03/12 15:58:27 jinx Rel $
  *
  * This File contains the code to translate portable format binary
  * files to internal format.
@@ -527,34 +527,34 @@ Move_Memory(From, N, To)
 #endif
 
 void
-Relocate_Objects(From, N, disp)
-     fast Pointer *From;
-     long N;
+Relocate_Objects(from, how_many, disp)
+     fast Pointer *from;
      fast long disp;
+     long how_many;
 {
   fast Pointer *Until;
 
-  Until = &From[N];
-  while (From < Until)
+  Until = &from[how_many];
+  while (from < Until)
   {
-    switch(Type_Code(*From))
+    switch(OBJECT_TYPE(*from))
     {
       case TC_FIXNUM:
       case TC_CHARACTER:
-        From += 1;
+        from += 1;
         break;
 
       case TC_BIG_FIXNUM:
       case TC_BIG_FLONUM:
       case TC_CHARACTER_STRING:
-       *From++ == Make_Object(Type_Code(*From), (disp + Datum(*From)));
+       *from++ == Make_Object(OBJECT_TYPE(*from), (disp + OBJECT_DATUM(*from)));
        break;
 
       default:
        fprintf(stderr,
                "%s: Unknown External Object Reference with Type 0x%02x",
                program_name,
-               Type_Code(*From));
+               OBJECT_TYPE(*from));
        inconsistency();
     }
   }
@@ -596,18 +596,18 @@ static Pointer *Relocate_Temp;
 #endif
 \f
 Pointer *
-Read_Pointers_and_Relocate(N, To)
-     fast long N;
-     fast Pointer *To;
+Read_Pointers_and_Relocate(how_many, to)
+     fast long how_many;
+     fast Pointer *to;
 {
   int The_Type;
   long The_Datum;
 
 #if false
-  Align_Float(To);
+  Align_Float(to);
 #endif
 
-  while (--N >= 0)
+  while (--how_many >= 0)
   {
     VMS_BUG(The_Type = 0);
     VMS_BUG(The_Datum = 0);
@@ -615,36 +615,36 @@ Read_Pointers_and_Relocate(N, To)
     switch(The_Type)
     {
       case CONSTANT_CODE:
-       *To++ = Constant_Table[The_Datum];
+       *to++ = Constant_Table[The_Datum];
        continue;
        
       case HEAP_CODE:
-       *To++ = Heap_Table[The_Datum];
+       *to++ = Heap_Table[The_Datum];
        continue;
        
       case TC_MANIFEST_NM_VECTOR:
-       *To++ = Make_Non_Pointer(The_Type, The_Datum);
+       *to++ = Make_Non_Pointer(The_Type, The_Datum);
         {
          fast long count;
          
          count = The_Datum;
-         N -= count;
+         how_many -= count;
          while (--count >= 0)
          {
-           VMS_BUG(*To = 0);
-           fscanf(portable_file, "%lx", To++);
+           VMS_BUG(*to = 0);
+           fscanf(portable_file, "%lx", to++);
          }
        }
        continue;
 \f
-      case TC_COMPILED_EXPRESSION:
+      case TC_COMPILED_ENTRY:
       {
        Pointer *temp;
        long base_type, base_datum;
 
        fscanf(portable_file, "%02x %lx", &base_type, &base_datum);
        temp = Relocate(base_datum);
-       *To++ = Make_Pointer(base_type,
+       *to++ = Make_Pointer(base_type,
                             ((Pointer *) (&(((char *) temp)[The_Datum]))));
        break;
       }
@@ -652,7 +652,7 @@ Read_Pointers_and_Relocate(N, To)
       case TC_BROKEN_HEART:
        if (The_Datum != 0)
        {
-         fprintf(stderr, "%s: Broken Heart Found\n", program_name);
+         fprintf(stderr, "%s: Broken Heart found.\n", program_name);
          inconsistency();
        }
        /* fall through */
@@ -661,27 +661,35 @@ Read_Pointers_and_Relocate(N, To)
       case TC_PRIMITIVE:
       case TC_MANIFEST_SPECIAL_NM_VECTOR:
       case_simple_Non_Pointer:
-       *To++ = Make_Non_Pointer(The_Type, The_Datum);
+       *to++ = Make_Non_Pointer(The_Type, The_Datum);
        continue;
 
+      case TC_MANIFEST_CLOSURE:
+      case TC_LINKAGE_SECTION:
+      {
+       fprintf(stderr, "%s: File contains linked compiled code.\n",
+               program_name);
+       inconsistency();
+      }
+
       case TC_REFERENCE_TRAP:
        if (The_Datum <= TRAP_MAX_IMMEDIATE)
        {
-         *To++ = Make_Non_Pointer(The_Type, The_Datum);
+         *to++ = Make_Non_Pointer(The_Type, The_Datum);
          continue;
        }
        /* It is a pointer, fall through. */
 
       default:
        /* Should be stricter */
-       *To++ = Make_Pointer(The_Type, Relocate(The_Datum));
+       *to++ = Make_Pointer(The_Type, Relocate(The_Datum));
        continue;
     }
   }
 #if false
-  Align_Float(To);
+  Align_Float(to);
 #endif
-  return (To);
+  return (to);
 }
 \f
 static Boolean primitive_warn = false;
@@ -1103,10 +1111,15 @@ do_it()
 \f
 /* Top level */
 
+static Boolean
+  help_p = false,
+  help_sup_p;
+
 static struct keyword_struct
   options[] = {
     KEYWORD("allow_nmv", &allow_nmv_p, BOOLEAN_KYWRD, BFRMT, NULL),
     KEYWORD("allow_cc", &allow_compiled_p, BOOLEAN_KYWRD, BFRMT, NULL),
+    KEYWORD("help", &help_p, BOOLEAN_KYWRD, BFRMT, &help_sup_p),
     OUTPUT_KEYWORD(),
     INPUT_KEYWORD(),
     END_KEYWORD()
@@ -1117,6 +1130,11 @@ main(argc, argv)
      char *argv[];
 {
   parse_keywords(argc, argv, options, false);
+  if (help_sup_p && help_p)
+  {
+    print_usage_and_exit(options, 0);
+    /*NOTREACHED*/
+  }
   setup_io();
   do_it();
   quit(0);
index e46dacccbe4231aa9eb0a6b409884e02e2f53b70..b84184ec97c4486e1977256e100d576ca8dfb9c3 100644 (file)
@@ -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.33 1988/02/10 15:41:50 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/bintopsb.c,v 9.34 1988/03/12 15:58:02 jinx Rel $
  *
  * This File contains the code to translate internal format binary
  * files to portable format.
@@ -650,7 +650,7 @@ print_a_flonum(val)
   Old_Contents = *Old_Address;                                         \
                                                                        \
   Mem_Base[(Scn)] =                                                    \
-   Make_Non_Pointer(TC_COMPILED_EXPRESSION,                            \
+   Make_Non_Pointer(TC_COMPILED_ENTRY,                                 \
                    (compiled_entry_pointer - compiled_entry_table));   \
                                                                        \
   offset = (((char *) saved) - ((char *) Old_Address));                        \
@@ -903,6 +903,7 @@ Process_Area(Code, Area, Bound, Obj, FObj)
 
     Switch_by_GC_Type(This)
     {
+
 #ifndef PRIMITIVE_EXTERNAL_REUSED
 
       case TC_PRIMITIVE_EXTERNAL:
@@ -951,6 +952,15 @@ Process_Area(Code, Area, Bound, Obj, FObj)
        *Area += 1;
        break;
 
+      case TC_MANIFEST_CLOSURE:
+      case TC_LINKAGE_SECTION:
+      {
+       fprintf(stderr,
+               "%s: File contains linked compiled code.\n",
+               program_name);
+       quit(1);
+      }
+
       case_compiled_entry_point:
        compiled_p = true;
        if (!allow_compiled_p)
@@ -1149,7 +1159,7 @@ print_objects(from, to)
        fprintf(portable_file, "%lx\n", ((unsigned long) *from++));
       }
     }
-    else if (the_type == TC_COMPILED_EXPRESSION)
+    else if (the_type == TC_COMPILED_ENTRY)
     {
       Pointer base;
       long offset;
@@ -1158,7 +1168,7 @@ print_objects(from, to)
       base = compiled_entry_table[the_datum + 1];
 
       fprintf(portable_file, "%02x %lx %02x %lx\n",
-             TC_COMPILED_EXPRESSION, offset,
+             TC_COMPILED_ENTRY, offset,
              OBJECT_TYPE(base), OBJECT_DATUM(base));
     }
     else
@@ -1191,7 +1201,7 @@ when(what, message)
   return;
 }
 
-#define PRINT_HEADER(name, format, obj)                                        \
+#define WRITE_HEADER(name, format, obj)                                        \
 {                                                                      \
   fprintf(portable_file, (format), (obj));                             \
   fprintf(portable_file, "\n");                                                \
@@ -1206,7 +1216,7 @@ when(what, message)
 
 #define WHEN(what, message)
 
-#define PRINT_HEADER(name, format, obj)                                        \
+#define WRITE_HEADER(name, format, obj)                                        \
 {                                                                      \
   fprintf(portable_file, (format), (obj));                             \
   fprintf(portable_file, "\n");                                                \
@@ -1471,38 +1481,38 @@ do_it()
 
   /* Header */
 
-  PRINT_HEADER("Portable Version", "%ld", PORTABLE_VERSION);
-  PRINT_HEADER("Machine", "%ld", FASL_INTERNAL_FORMAT);
-  PRINT_HEADER("Version", "%ld", FASL_FORMAT_VERSION);
-  PRINT_HEADER("Sub Version", "%ld", FASL_SUBVERSION);
-  PRINT_HEADER("Flags", "%ld", (MAKE_FLAGS()));
+  WRITE_HEADER("Portable Version", "%ld", PORTABLE_VERSION);
+  WRITE_HEADER("Machine", "%ld", FASL_INTERNAL_FORMAT);
+  WRITE_HEADER("Version", "%ld", FASL_FORMAT_VERSION);
+  WRITE_HEADER("Sub Version", "%ld", FASL_SUBVERSION);
+  WRITE_HEADER("Flags", "%ld", (MAKE_FLAGS()));
 
-  PRINT_HEADER("Heap Count", "%ld", (Free - NROOTS));
-  PRINT_HEADER("Heap Base", "%ld", NROOTS);
-  PRINT_HEADER("Heap Objects", "%ld", Objects);
+  WRITE_HEADER("Heap Count", "%ld", (Free - NROOTS));
+  WRITE_HEADER("Heap Base", "%ld", NROOTS);
+  WRITE_HEADER("Heap Objects", "%ld", Objects);
 
   /* Currently Constant and Pure not supported, but the header is ready */
 
-  PRINT_HEADER("Pure Count", "%ld", 0);
-  PRINT_HEADER("Pure Base", "%ld", Free_Constant);
-  PRINT_HEADER("Pure Objects", "%ld", 0);
+  WRITE_HEADER("Pure Count", "%ld", 0);
+  WRITE_HEADER("Pure Base", "%ld", Free_Constant);
+  WRITE_HEADER("Pure Objects", "%ld", 0);
 
-  PRINT_HEADER("Constant Count", "%ld", 0);
-  PRINT_HEADER("Constant Base", "%ld", Free_Constant);
-  PRINT_HEADER("Constant Objects", "%ld", 0);
+  WRITE_HEADER("Constant Count", "%ld", 0);
+  WRITE_HEADER("Constant Base", "%ld", Free_Constant);
+  WRITE_HEADER("Constant Objects", "%ld", 0);
 
-  PRINT_HEADER("& Dumped Object", "%ld", (OBJECT_DATUM(Mem_Base[0])));
+  WRITE_HEADER("& Dumped Object", "%ld", (OBJECT_DATUM(Mem_Base[0])));
 
-  PRINT_HEADER("Number of flonums", "%ld", NFlonums);
-  PRINT_HEADER("Number of integers", "%ld", NIntegers);
-  PRINT_HEADER("Number of bits in integers", "%ld", NBits);
-  PRINT_HEADER("Number of bit strings", "%ld", NBitstrs);
-  PRINT_HEADER("Number of bits in bit strings", "%ld", NBBits);
-  PRINT_HEADER("Number of character strings", "%ld", NStrings);
-  PRINT_HEADER("Number of characters in strings", "%ld", NChars);
+  WRITE_HEADER("Number of flonums", "%ld", NFlonums);
+  WRITE_HEADER("Number of integers", "%ld", NIntegers);
+  WRITE_HEADER("Number of bits in integers", "%ld", NBits);
+  WRITE_HEADER("Number of bit strings", "%ld", NBitstrs);
+  WRITE_HEADER("Number of bits in bit strings", "%ld", NBBits);
+  WRITE_HEADER("Number of character strings", "%ld", NStrings);
+  WRITE_HEADER("Number of characters in strings", "%ld", NChars);
 
-  PRINT_HEADER("Number of primitives", "%ld", Primitive_Table_Length);
-  PRINT_HEADER("Number of characters in primitives", "%ld", NPChars);
+  WRITE_HEADER("Number of primitives", "%ld", Primitive_Table_Length);
+  WRITE_HEADER("Number of characters in primitives", "%ld", NPChars);
 
   if (!compiled_p)
   {
@@ -1510,11 +1520,11 @@ do_it()
     dumped_interface_version = 0;
   }
 
-  PRINT_HEADER("CPU type", "%ld", dumped_processor_type);
-  PRINT_HEADER("Compiled code interface version", "%ld",
+  WRITE_HEADER("CPU type", "%ld", dumped_processor_type);
+  WRITE_HEADER("Compiled code interface version", "%ld",
               dumped_interface_version);
 #if false
-  PRINT_HEADER("Compiler utilities vector", "%ld",
+  WRITE_HEADER("Compiler utilities vector", "%ld",
               OBJECT_DATUM(dumped_utilities));
 #endif
 \f
@@ -1597,7 +1607,11 @@ do_it()
 \f
 /* Top Level */
 
-Boolean ci_version_sup_p, ci_processor_sup_p;
+static Boolean
+  help_p = false,
+  help_sup_p,
+  ci_version_sup_p,
+  ci_processor_sup_p;
 
 /* The boolean value here is what value to store when the option is present. */
 
@@ -1613,6 +1627,7 @@ static struct keyword_struct
            &ci_version_sup_p),
     KEYWORD("ci_processor", &compiler_processor_type, INT_KYWRD, "%ld",
            &ci_processor_sup_p),
+    KEYWORD("help", &help_p, BOOLEAN_KYWRD, BFRMT, &help_sup_p),
     OUTPUT_KEYWORD(),
     INPUT_KEYWORD(),
     END_KEYWORD()
@@ -1623,6 +1638,11 @@ main(argc, argv)
      char *argv[];
 {
   parse_keywords(argc, argv, options, false);
+  if (help_sup_p && help_p)
+  {
+    print_usage_and_exit(options, 0);
+    /*NOTREACHED*/
+  }
   setup_io();
   do_it();
   quit(0);
index b93630e9989e02995d3c5ae63a270709b605eb32..5dfedd96d2a440a68a4d66893b010dd236ccb055 100644 (file)
@@ -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.32 1988/02/10 15:43:12 jinx Exp $
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/psbtobin.c,v 9.33 1988/03/12 15:58:27 jinx Rel $
  *
  * This File contains the code to translate portable format binary
  * files to internal format.
@@ -527,34 +527,34 @@ Move_Memory(From, N, To)
 #endif
 
 void
-Relocate_Objects(From, N, disp)
-     fast Pointer *From;
-     long N;
+Relocate_Objects(from, how_many, disp)
+     fast Pointer *from;
      fast long disp;
+     long how_many;
 {
   fast Pointer *Until;
 
-  Until = &From[N];
-  while (From < Until)
+  Until = &from[how_many];
+  while (from < Until)
   {
-    switch(Type_Code(*From))
+    switch(OBJECT_TYPE(*from))
     {
       case TC_FIXNUM:
       case TC_CHARACTER:
-        From += 1;
+        from += 1;
         break;
 
       case TC_BIG_FIXNUM:
       case TC_BIG_FLONUM:
       case TC_CHARACTER_STRING:
-       *From++ == Make_Object(Type_Code(*From), (disp + Datum(*From)));
+       *from++ == Make_Object(OBJECT_TYPE(*from), (disp + OBJECT_DATUM(*from)));
        break;
 
       default:
        fprintf(stderr,
                "%s: Unknown External Object Reference with Type 0x%02x",
                program_name,
-               Type_Code(*From));
+               OBJECT_TYPE(*from));
        inconsistency();
     }
   }
@@ -596,18 +596,18 @@ static Pointer *Relocate_Temp;
 #endif
 \f
 Pointer *
-Read_Pointers_and_Relocate(N, To)
-     fast long N;
-     fast Pointer *To;
+Read_Pointers_and_Relocate(how_many, to)
+     fast long how_many;
+     fast Pointer *to;
 {
   int The_Type;
   long The_Datum;
 
 #if false
-  Align_Float(To);
+  Align_Float(to);
 #endif
 
-  while (--N >= 0)
+  while (--how_many >= 0)
   {
     VMS_BUG(The_Type = 0);
     VMS_BUG(The_Datum = 0);
@@ -615,36 +615,36 @@ Read_Pointers_and_Relocate(N, To)
     switch(The_Type)
     {
       case CONSTANT_CODE:
-       *To++ = Constant_Table[The_Datum];
+       *to++ = Constant_Table[The_Datum];
        continue;
        
       case HEAP_CODE:
-       *To++ = Heap_Table[The_Datum];
+       *to++ = Heap_Table[The_Datum];
        continue;
        
       case TC_MANIFEST_NM_VECTOR:
-       *To++ = Make_Non_Pointer(The_Type, The_Datum);
+       *to++ = Make_Non_Pointer(The_Type, The_Datum);
         {
          fast long count;
          
          count = The_Datum;
-         N -= count;
+         how_many -= count;
          while (--count >= 0)
          {
-           VMS_BUG(*To = 0);
-           fscanf(portable_file, "%lx", To++);
+           VMS_BUG(*to = 0);
+           fscanf(portable_file, "%lx", to++);
          }
        }
        continue;
 \f
-      case TC_COMPILED_EXPRESSION:
+      case TC_COMPILED_ENTRY:
       {
        Pointer *temp;
        long base_type, base_datum;
 
        fscanf(portable_file, "%02x %lx", &base_type, &base_datum);
        temp = Relocate(base_datum);
-       *To++ = Make_Pointer(base_type,
+       *to++ = Make_Pointer(base_type,
                             ((Pointer *) (&(((char *) temp)[The_Datum]))));
        break;
       }
@@ -652,7 +652,7 @@ Read_Pointers_and_Relocate(N, To)
       case TC_BROKEN_HEART:
        if (The_Datum != 0)
        {
-         fprintf(stderr, "%s: Broken Heart Found\n", program_name);
+         fprintf(stderr, "%s: Broken Heart found.\n", program_name);
          inconsistency();
        }
        /* fall through */
@@ -661,27 +661,35 @@ Read_Pointers_and_Relocate(N, To)
       case TC_PRIMITIVE:
       case TC_MANIFEST_SPECIAL_NM_VECTOR:
       case_simple_Non_Pointer:
-       *To++ = Make_Non_Pointer(The_Type, The_Datum);
+       *to++ = Make_Non_Pointer(The_Type, The_Datum);
        continue;
 
+      case TC_MANIFEST_CLOSURE:
+      case TC_LINKAGE_SECTION:
+      {
+       fprintf(stderr, "%s: File contains linked compiled code.\n",
+               program_name);
+       inconsistency();
+      }
+
       case TC_REFERENCE_TRAP:
        if (The_Datum <= TRAP_MAX_IMMEDIATE)
        {
-         *To++ = Make_Non_Pointer(The_Type, The_Datum);
+         *to++ = Make_Non_Pointer(The_Type, The_Datum);
          continue;
        }
        /* It is a pointer, fall through. */
 
       default:
        /* Should be stricter */
-       *To++ = Make_Pointer(The_Type, Relocate(The_Datum));
+       *to++ = Make_Pointer(The_Type, Relocate(The_Datum));
        continue;
     }
   }
 #if false
-  Align_Float(To);
+  Align_Float(to);
 #endif
-  return (To);
+  return (to);
 }
 \f
 static Boolean primitive_warn = false;
@@ -1103,10 +1111,15 @@ do_it()
 \f
 /* Top level */
 
+static Boolean
+  help_p = false,
+  help_sup_p;
+
 static struct keyword_struct
   options[] = {
     KEYWORD("allow_nmv", &allow_nmv_p, BOOLEAN_KYWRD, BFRMT, NULL),
     KEYWORD("allow_cc", &allow_compiled_p, BOOLEAN_KYWRD, BFRMT, NULL),
+    KEYWORD("help", &help_p, BOOLEAN_KYWRD, BFRMT, &help_sup_p),
     OUTPUT_KEYWORD(),
     INPUT_KEYWORD(),
     END_KEYWORD()
@@ -1117,6 +1130,11 @@ main(argc, argv)
      char *argv[];
 {
   parse_keywords(argc, argv, options, false);
+  if (help_sup_p && help_p)
+  {
+    print_usage_and_exit(options, 0);
+    /*NOTREACHED*/
+  }
   setup_io();
   do_it();
   quit(0);