Implement new primitive: `set-string-maximum-length!'.

diff --git a/v7/src/microcode/string.c b/v7/src/microcode/string.c
index bebde9522c0519eeebcae31ea4e45d1955e6a235..69feb7b008afd2147f61483c0c513e2367cc6007 100644 (file)
--- a/v7/src/microcode/string.c
+++ b/v7/src/microcode/string.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/string.c,v 9.31 1988/08/15 20:55:43 cph Exp $ */
+/* $Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/string.c,v 9.32 1989/04/28 03:47:37 cph Rel $ */
 
 /* String primitives. */
 
@@ -122,6 +122,26 @@ DEFINE_PRIMITIVE ("SET-STRING-LENGTH!", Prim_set_string_length, 2, 2, 0)
   PRIMITIVE_RETURN (Make_Unsigned_Fixnum (result));
 }
 
+DEFINE_PRIMITIVE ("SET-STRING-MAXIMUM-LENGTH!", Prim_set_string_maximum_length, 2, 2, 0)
+{
+  fast Pointer string;
+  fast long length;
+  PRIMITIVE_HEADER (2);
+
+  CHECK_ARG (1, STRING_P);
+  string = (ARG_REF (1));
+  length = (arg_nonnegative_integer (2));
+  if (length > (maximum_string_length (string)))
+    error_bad_range_arg (2);
+
+  Vector_Set (string,
+             STRING_HEADER,
+             (Make_Non_Pointer (TC_MANIFEST_NM_VECTOR,
+                                ((BYTES_TO_POINTERS (length + 1)) + 1))));
+  set_string_length (string, length);
+  PRIMITIVE_RETURN (Make_Non_Pointer (TC_TRUE, 1));
+}
+
 long
 substring_length_min (start1, end1, start2, end2)
      long start1, end1, start2, end2;

diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h
index 7472ca278dcb78019c6bdf3665a62d1b715c1fe3..8428ae8e195075c6fec0586789f358fcfccf36c4 100644 (file)
--- a/v7/src/microcode/version.h
+++ b/v7/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.75 1989/04/25 02:25:10 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 10.76 1989/04/28 03:48:08 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION                10
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     75
+#define SUBVERSION     76
 #endif
 
 #ifndef UCODE_TABLES_FILENAME

diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h
index c46a926067db45a38aa3d3ef817c8c5294bc214c..2582fb7c882841d14454f083abeb529faee4eecb 100644 (file)
--- a/v8/src/microcode/version.h
+++ b/v8/src/microcode/version.h
@@ -1,6 +1,6 @@
 /* -*-C-*-
 
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.75 1989/04/25 02:25:10 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 10.76 1989/04/28 03:48:08 cph Exp $
 
 Copyright (c) 1988, 1989 Massachusetts Institute of Technology
 
@@ -46,7 +46,7 @@ MIT in each case. */
 #define VERSION                10
 #endif
 #ifndef SUBVERSION
-#define SUBVERSION     75
+#define SUBVERSION     76
 #endif
 
 #ifndef UCODE_TABLES_FILENAME