From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 28 Apr 1989 03:48:08 +0000 (+0000)
Subject: Implement new primitive: `set-string-maximum-length!'.
X-Git-Tag: 20090517-FFI~12103
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=43686a64b60567c2cbde92bdc3c2cfe719e48773;p=mit-scheme.git

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

diff --git a/v7/src/microcode/string.c b/v7/src/microcode/string.c
index bebde9522..69feb7b00 100644
--- 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 7472ca278..8428ae8e1 100644
--- 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 c46a92606..2582fb7c8 100644
--- 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