Add -gc-start-position and -gc-end-position options for bchscheme.

diff --git a/v7/src/microcode/bchdmp.c b/v7/src/microcode/bchdmp.c
index 896aaa32e69229e15e4254d30ae0226cb88a1637..e578363809f18a0954de32323381fe0857a9153b 100644 (file)
--- a/v7/src/microcode/bchdmp.c
+++ b/v7/src/microcode/bchdmp.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchdmp.c,v 9.57 1991/10/29 22:35:36 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchdmp.c,v 9.58 1991/11/04 16:49:52 jinx Exp $
 
 Copyright (c) 1987-1991 Massachusetts Institute of Technology
 
@@ -62,7 +62,8 @@ extern SCHEME_OBJECT
   EXFUN (dump_renumber_primitive, (SCHEME_OBJECT)),
   * EXFUN (initialize_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *)),
   * EXFUN (cons_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *)),
-  * EXFUN (cons_whole_primitive_table, (SCHEME_OBJECT *, SCHEME_OBJECT *, long *));
+  * EXFUN (cons_whole_primitive_table,
+          (SCHEME_OBJECT *, SCHEME_OBJECT *, long *));
 
 static char *dump_file_name;
 static int real_gc_file, dump_file;
@@ -261,10 +262,12 @@ next_buffer:
 
   if (fixup_count >= 0)
   {
-    if (((lseek (real_gc_file, (fixup_count << gc_buffer_byte_shift), 0))
-        == -1)
-       || ((read (real_gc_file, ((char *) fixup_buffer), gc_buffer_bytes))
-           != gc_buffer_bytes))
+    if ((retrying_file_operation
+        (read, real_gc_file, ((char *) fixup_buffer),
+         (gc_file_start_position + (fixup_count << gc_buffer_byte_shift)),
+         gc_buffer_bytes, "read", "the fixup buffer",
+         &gc_file_current_position, io_error_retry_p))
+       != gc_buffer_bytes)
     {
       gc_death (TERM_EXIT,
                "fasdump: Could not read back the fasdump fixup information",
@@ -284,14 +287,18 @@ next_buffer:
 Boolean
 DEFUN_VOID (reset_fixes)
 {
+  long start;
+
   fixup_count += 1;
-  if (((lseek (real_gc_file, (fixup_count << gc_buffer_byte_shift), 0))
-       == -1)
-      || ((write (real_gc_file, ((char *) fixup_buffer), gc_buffer_bytes))
+  start = (gc_file_start_position + (fixup_count << gc_buffer_byte_shift));
+
+  if (((start + gc_buffer_bytes) > gc_file_end_position)
+      || ((retrying_file_operation
+          (write, real_gc_file, ((char *) fixup_buffer),
+           start, gc_buffer_bytes, "write", "the fixup buffer",
+           &gc_file_current_position, io_error_always_abort))
          != gc_buffer_bytes))
-  {
     return (false);
-  }
   fixup = fixup_buffer_end;
   return (true);
 }

diff --git a/v7/src/microcode/bchgcc.h b/v7/src/microcode/bchgcc.h
index 837081f9f462c7e807d98eedbfb4bb7163de93c0..a9325ae2f95568c9968d0aca5a2439bb22a38348 100644 (file)
--- a/v7/src/microcode/bchgcc.h
+++ b/v7/src/microcode/bchgcc.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcc.h,v 9.41 1991/10/29 22:34:01 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/bchgcc.h,v 9.42 1991/11/04 16:49:35 jinx Exp $
 
 Copyright (c) 1987-1991 Massachusetts Institute of Technology
 
@@ -44,6 +44,17 @@ MIT in each case. */
 #include <fcntl.h>
 #endif
 #include <sys/param.h>
+
+extern char * EXFUN (error_name, (int));
+
+extern int EXFUN (retrying_file_operation,
+                 (/* no prototype because (const char *) != (char *) */
+                  int (*)(),
+                  int, char *, long, long, char *, char *, long *,
+                  int (*)(char *, char *)));
+
+extern int EXFUN (io_error_retry_p, (char *, char *));
+extern int EXFUN (io_error_always_abort, (char *, char *));
 \f
 #define GC_FILE_FLAGS          (O_RDWR | O_CREAT) /* O_SYNCIO removed */
 #define GC_FILE_MASK           0644    /* Everyone reads, owner writes */
@@ -65,6 +76,11 @@ MIT in each case. */
 #define ALIGNED_TO_IO_PAGE_P(addr)                                     \
   (((unsigned long) (addr)) == (ALIGN_DOWN_TO_IO_PAGE (addr)))
 
+extern long
+  gc_file_end_position,
+  gc_file_current_position,
+  gc_file_start_position;
+
 extern unsigned long
   gc_buffer_size,
   gc_buffer_bytes,

diff --git a/v7/src/microcode/option.c b/v7/src/microcode/option.c
index 2cf3ff7c13a081678782ca1454c7409d271da471..2529848355cd0b1129dfbf0f3c923bd7cf645d2f 100644 (file)
--- a/v7/src/microcode/option.c
+++ b/v7/src/microcode/option.c
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/option.c,v 1.11 1991/10/29 22:38:56 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/option.c,v 1.12 1991/11/04 16:49:03 jinx Exp $
 
 Copyright (c) 1990-1991 Massachusetts Institute of Technology
 
@@ -95,8 +95,10 @@ unsigned int option_constant_size;
 unsigned int option_stack_size;
 
 /* These only matter for bchscheme */
-static CONST char * option_raw_gcfile = 0;
+static CONST char * option_raw_gc_end_position = 0;
+static CONST char * option_raw_gc_file = 0;
 static CONST char * option_raw_gc_read_overlap = 0;
+static CONST char * option_raw_gc_start_position = 0;
 static CONST char * option_raw_gc_window_size = 0;
 static CONST char * option_raw_gc_write_overlap = 0;
 CONST char * option_gc_directory = 0;
@@ -106,6 +108,8 @@ int option_gc_keep;
 int option_gc_read_overlap;
 int option_gc_window_size;
 int option_gc_write_overlap;
+long option_gc_start_position;
+long option_gc_end_position;
 \f/*
 Scheme accepts the following command-line options.  The options may
 appear in any order, but they must all appear before any other
@@ -172,7 +176,7 @@ arguments on the command line.
 
 -option-summary
   Causes Scheme to write option information to standard error.
-
+\f
 -emacs
   Specifies that Scheme is running as a subprocess of GNU Emacs.
   This option is automatically supplied by GNU Emacs, and should not
@@ -204,8 +208,7 @@ compiled-code support:
   MITSCHEME_EDWIN_BAND is used, otherwise "edwin.com" is used.  It
   also specifies the use of large sizes, exactly like "-large".
 
-The following options are only meaningful to bchscheme
-(garbage collection to disk):
+The following options are only meaningful to bchscheme:
 
 -gc-directory DIRECTORY
   Specifies what directory to use to allocate the garbage collection file.
@@ -213,6 +216,9 @@ The following options are only meaningful to bchscheme
 -gc-drone FILENAME
   Specifies the program to use as the gc drones for overlapped I/O.
 
+-gc-end-position N
+  Specifies a position into the gc file past which bchscheme should not use. 
+
 -gc-file FILENAME
   Specifies that FILENAME should be used garbage collection.  Overrides
   -gc-directory if it is an absolute pathname.  -gcfile means the same thing,
@@ -226,13 +232,15 @@ The following options are only meaningful to bchscheme
   for overlapped I/O.  Each implies a drone process to manage it,
   if supported.
 
+-gc-start-position N
+  Specifies a position into the gc file before which bchscheme should not use.
+
 -gc-window-size BLOCKS
   Specifies the size in 1024-word blocks of each GC window.
 
 -gc-write-overlap N
-  Specifies the number of additional GC windows to use when writing
-  for overlapped I/O.  Each implies a drone process to manage it,
-  if supported.
+  Specifies the number of additional GC windows to use when writing for
+  overlapped I/O.  Each implies a drone process to manage it, if supported.
 */
 \f
 #ifndef LIBRARY_PATH_VARIABLE
@@ -355,52 +363,68 @@ The following options are only meaningful to bchscheme
 \f
 /* These are only meaningful for bchscheme */
 
+#ifndef DEFAULT_GC_DIRECTORY
+#define DEFAULT_GC_DIRECTORY           "/tmp"
+#endif
+
+#ifndef GC_DIRECTORY_VARIABLE
+#define GC_DIRECTORY_VARIABLE          "MITSCHEME_GC_DIRECTORY"
+#endif
+
 #ifndef DEFAULT_GC_DRONE
-#define DEFAULT_GC_DRONE "gcdrone"
+#define DEFAULT_GC_DRONE               "gcdrone"
 #endif
 
 #ifndef GC_DRONE_VARIABLE
-#define GC_DRONE_VARIABLE "MITSCHEME_GC_DRONE"
+#define GC_DRONE_VARIABLE              "MITSCHEME_GC_DRONE"
 #endif
 
-#ifndef DEFAULT_GC_DIRECTORY
-#define DEFAULT_GC_DIRECTORY "/tmp"
+#ifndef DEFAULT_GC_END_POSITION
+#define DEFAULT_GC_END_POSITION                -1
 #endif
 
-#ifndef GC_DIRECTORY_VARIABLE
-#define GC_DIRECTORY_VARIABLE "MITSCHEME_GC_DIRECTORY"
+#ifndef GC_END_POSITION_VARIABLE
+#define GC_END_POSITION_VARIABLE       "MITSCHEME_GC_END_POSITION"
 #endif
 
 #ifndef DEFAULT_GC_FILE
-#define DEFAULT_GC_FILE "GCXXXXXX"
+#define DEFAULT_GC_FILE                        "GCXXXXXX"
 #endif
 
 #ifndef GC_FILE_VARIABLE
-#define GC_FILE_VARIABLE "MITSCHEME_GC_FILE"
+#define GC_FILE_VARIABLE               "MITSCHEME_GC_FILE"
 #endif
 
 #ifndef DEFAULT_GC_READ_OVERLAP
-#define DEFAULT_GC_READ_OVERLAP 0
+#define DEFAULT_GC_READ_OVERLAP                0
 #endif
 
 #ifndef GC_READ_OVERLAP_VARIABLE
-#define GC_READ_OVERLAP_VARIABLE "MITSCHEME_GC_READ_OVERLAP"
+#define GC_READ_OVERLAP_VARIABLE       "MITSCHEME_GC_READ_OVERLAP"
+#endif
+
+#ifndef DEFAULT_GC_START_POSITION
+#define DEFAULT_GC_START_POSITION      0
+#endif
+
+#ifndef GC_START_POSITION_VARIABLE
+#define GC_START_POSITION_VARIABLE     "MITSCHEME_GC_START_POSITION"
 #endif
 
 #ifndef DEFAULT_GC_WINDOW_SIZE
-#define DEFAULT_GC_WINDOW_SIZE 16
+#define DEFAULT_GC_WINDOW_SIZE         16
 #endif
 
 #ifndef GC_WINDOW_SIZE_VARIABLE
-#define GC_WINDOW_SIZE_VARIABLE "MITSCHEME_GC_WINDOW_SIZE"
+#define GC_WINDOW_SIZE_VARIABLE                "MITSCHEME_GC_WINDOW_SIZE"
 #endif
 
 #ifndef DEFAULT_GC_WRITE_OVERLAP
-#define DEFAULT_GC_WRITE_OVERLAP 0
+#define DEFAULT_GC_WRITE_OVERLAP       0
 #endif
 
 #ifndef GC_WRITE_OVERLAP_VARIABLE
-#define GC_WRITE_OVERLAP_VARIABLE "MITSCHEME_GC_WRITE_OVERLAP"
+#define GC_WRITE_OVERLAP_VARIABLE      "MITSCHEME_GC_WRITE_OVERLAP"
 #endif
 \f
 static int
@@ -578,12 +602,14 @@ DEFUN (parse_standard_options, (argc, argv), int argc AND CONST char ** argv)
   /* The following options are only meaningful to bchscheme. */
   option_argument ("-gc-directory", 1, (&option_gc_directory));
   option_argument ("-gc-drone", 1, (&option_gc_drone));
+  option_argument ("-gc-end-position", 1, (&option_raw_gc_end_position));
   option_argument ("-gc-file", 1, (&option_gc_file));
   option_argument ("-gc-keep", 0, (&option_gc_keep));
+  option_argument ("-gc-start-position", 1, (&option_raw_gc_start_position));
   option_argument ("-gc-read-overlap", 1, (&option_raw_gc_read_overlap));
   option_argument ("-gc-window-size", 1, (&option_raw_gc_window_size));
   option_argument ("-gc-write-overlap", 1, (&option_raw_gc_write_overlap));
-  option_argument ("-gcfile", 1, (&option_raw_gcfile)); /* Obsolete */
+  option_argument ("-gcfile", 1, (&option_raw_gc_file)); /* Obsolete */
   parse_options (argc, argv);
 }
 \f
@@ -601,16 +627,16 @@ DEFUN (standard_string_option, (option, variable, defval),
   }
 }
 
-static unsigned int
-DEFUN (overlap_numeric_option, (option, optval, variable, defval),
+static long
+DEFUN (non_negative_numeric_option, (option, optval, variable, defval),
        CONST char * option AND
        CONST char * optval AND
        CONST char * variable AND
-       unsigned int defval)
+       long defval)
 {
   if (optval != 0)
     {
-      int n = (atoi (optval));
+      long n = (strtol (optval, ((char **) NULL), 0));
       if (n < 0)
        {
          fprintf (stderr, "%s: illegal argument %s for option %s.\n",
@@ -623,7 +649,7 @@ DEFUN (overlap_numeric_option, (option, optval, variable, defval),
     CONST char * t = (getenv (variable));
     if (t != 0)
       {
-       int n = (atoi (t));
+       long n = (strtol (t, ((char **) NULL), 0));
        if (n < 0)
          {
            fprintf (stderr, "%s: illegal value %s for variable %s.\n",
@@ -968,18 +994,22 @@ DEFUN_VOID (describe_options)
   describe_string_option ("microcode tables", option_utabmd_file);
   {
     /* These are only relevant to bchscheme. */
+    if (option_gc_directory != DEFAULT_GC_DIRECTORY)
+      describe_string_option ("GC directory", option_gc_directory);
+    if (option_gc_drone != DEFAULT_GC_DRONE)
+      describe_string_option ("GC drone program", option_gc_drone);
+    if (option_raw_gc_end_position)
+      describe_numeric_option ("GC end position", option_gc_end_position);
     if (option_gc_file != DEFAULT_GC_FILE)
       describe_string_option ("GC file", option_gc_file);
-    if (option_gc_file != DEFAULT_GC_DIRECTORY)
-      describe_string_option ("GC directory", option_gc_directory);
-    if (option_raw_gc_window_size)
-      describe_size_option ("GC window size", option_gc_window_size);
     if (option_raw_gc_read_overlap)
       describe_numeric_option ("GC read overlap", option_gc_read_overlap);
+    if (option_raw_gc_start_position)
+      describe_numeric_option ("GC start position", option_gc_start_position);
+    if (option_raw_gc_window_size)
+      describe_size_option ("GC window size", option_gc_window_size);
     if (option_raw_gc_write_overlap)
       describe_numeric_option ("GC write overlap", option_gc_write_overlap);
-    if (option_gc_drone != DEFAULT_GC_DRONE)
-      describe_string_option ("GC drone program", option_gc_drone);
     if (option_gc_keep)
       describe_boolean_option ("keep GC file", option_gc_keep);
   }
@@ -1118,12 +1148,12 @@ DEFUN (read_command_line_options, (argc, argv),
 
   /* These are only meaningful for bchscheme. */
 
-  if (option_raw_gcfile != ((char *) 0))
+  if (option_raw_gc_file != ((char *) 0))
   {
     if (option_gc_file != ((char *) 0))
       conflicting_options ("-gcfile", "-gc-file");
     else
-      option_gc_file = option_raw_gcfile;
+      option_gc_file = option_raw_gc_file;
   }
 
   option_gc_directory =
@@ -1140,16 +1170,29 @@ DEFUN (read_command_line_options, (argc, argv),
                             GC_DRONE_VARIABLE,
                             DEFAULT_GC_DRONE));
 
+  option_gc_end_position =
+    (non_negative_numeric_option ("-gc-end-position",
+                                 option_raw_gc_end_position,
+                                 GC_END_POSITION_VARIABLE,
+                                 DEFAULT_GC_END_POSITION));
+
   option_gc_file =
     (standard_string_option (option_gc_file,
                             GC_FILE_VARIABLE,
                             DEFAULT_GC_FILE));
 
   option_gc_read_overlap =
-    (overlap_numeric_option ("-gc-read-overlap",
-                            option_raw_gc_read_overlap,
-                            GC_READ_OVERLAP_VARIABLE,
-                            DEFAULT_GC_READ_OVERLAP));
+    ((int)
+     (non_negative_numeric_option ("-gc-read-overlap",
+                                  option_raw_gc_read_overlap,
+                                  GC_READ_OVERLAP_VARIABLE,
+                                  DEFAULT_GC_READ_OVERLAP)));
+
+  option_gc_start_position =
+    (non_negative_numeric_option ("-gc-start-position",
+                                 option_raw_gc_start_position,
+                                 GC_START_POSITION_VARIABLE,
+                                 DEFAULT_GC_START_POSITION));
 
   option_gc_window_size =
     (standard_numeric_option ("-gc-window-size",
@@ -1158,10 +1201,11 @@ DEFUN (read_command_line_options, (argc, argv),
                              DEFAULT_GC_WINDOW_SIZE));
 
   option_gc_write_overlap =
-    (overlap_numeric_option ("-gc-write-overlap",
-                            option_raw_gc_write_overlap,
-                            GC_WRITE_OVERLAP_VARIABLE,
-                            DEFAULT_GC_WRITE_OVERLAP));
+    ((int)
+     (non_negative_numeric_option ("-gc-write-overlap",
+                                  option_raw_gc_write_overlap,
+                                  GC_WRITE_OVERLAP_VARIABLE,
+                                  DEFAULT_GC_WRITE_OVERLAP)));
 
   if (option_summary)
     describe_options ();

diff --git a/v7/src/microcode/option.h b/v7/src/microcode/option.h
index b893d87b4d0fcd37f6dbc0d3b77cf64ef0ed95c0..9140b68ec1e22e065668904bdcfe7a09b83301f6 100644 (file)
--- a/v7/src/microcode/option.h
+++ b/v7/src/microcode/option.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/option.h,v 1.5 1991/10/29 22:38:34 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/option.h,v 1.6 1991/11/04 16:48:54 jinx Exp $
 
 Copyright (c) 1990-1991 Massachusetts Institute of Technology
 
@@ -64,10 +64,12 @@ extern unsigned int option_stack_size;
 extern CONST char * option_gc_directory;
 extern CONST char * option_gc_drone;
 extern CONST char * option_gc_file;
-int option_gc_keep;
-int option_gc_read_overlap;
-int option_gc_window_size;
-int option_gc_write_overlap;
+extern int option_gc_keep;
+extern int option_gc_read_overlap;
+extern int option_gc_window_size;
+extern int option_gc_write_overlap;
+extern long option_gc_start_position;
+extern long option_gc_end_position;
 
 extern void EXFUN (read_command_line_options, (int argc, CONST char ** argv));