From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 4 Jan 2001 22:27:50 +0000 (+0000)
Subject: Add interface to external strings.
X-Git-Tag: 20090517-FFI~3020
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=39e6dc4ddfdb67f2912d7be917f7161cdec04c07;p=mit-scheme.git

Add interface to external strings.
---

diff --git a/v7/src/runtime/make.scm b/v7/src/runtime/make.scm
index aa92a3fc3..e01a4239a 100644
--- a/v7/src/runtime/make.scm
+++ b/v7/src/runtime/make.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 14.65 2000/04/10 19:01:30 cph Exp $
+$Id: make.scm,v 14.66 2001/01/04 22:25:42 cph Exp $
 
-Copyright (c) 1988-2000 Massachusetts Institute of Technology
+Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -484,6 +484,7 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
    (RUNTIME STARBASE-GRAPHICS)
    (RUNTIME X-GRAPHICS)
    (RUNTIME OS2-GRAPHICS)
+   (RUNTIME STRING)
    ;; Emacs -- last because it installs hooks everywhere which must be initted.
    (RUNTIME EMACS-INTERFACE)
    ;; More debugging
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index a646ab458..4b1aaba53 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.355 2000/07/05 18:27:33 cph Exp $
+$Id: runtime.pkg,v 14.356 2001/01/04 22:25:46 cph Exp $
 
-Copyright (c) 1988-2000 Massachusetts Institute of Technology
+Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -77,11 +77,14 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   (files "string")
   (parent ())
   (export ()
+	  allocate-external-string
 	  burst-string
 	  char->string
 	  decorated-string-append
-	  list->string
+	  external-string-length
+	  external-string?
 	  guarantee-string
+	  list->string
 	  make-string
 	  reverse-string
 	  reverse-string!
@@ -195,7 +198,8 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	  vector-8b-ref
 	  vector-8b-set!)
   (export (runtime char-syntax)
-	  guarantee-substring))
+	  guarantee-substring)
+  (initialization (initialize-package!)))
 
 (define-package (runtime 1d-property)
   (files "prop1d")
diff --git a/v7/src/runtime/string.scm b/v7/src/runtime/string.scm
index c62b2b427..35eb8db38 100644
--- a/v7/src/runtime/string.scm
+++ b/v7/src/runtime/string.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: string.scm,v 14.35 2000/05/16 14:43:39 cph Exp $
+$Id: string.scm,v 14.36 2001/01/04 22:25:49 cph Exp $
 
-Copyright (c) 1988-2000 Massachusetts Institute of Technology
+Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -966,6 +966,32 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 	    (outer k (fix:+ q 1)))))
     pi))
 
+;;;; External Strings
+
+(define external-strings)
+(define (initialize-package!)
+  (set! external-strings
+	(make-gc-finalizer (ucode-primitive deallocate-external-string)))
+  unspecific)
+
+(define-structure external-string
+  (descriptor #f read-only #t))
+
+(define (allocate-external-string n-bytes)
+  (without-interrupts
+   (lambda ()
+     (let ((descriptor ((ucode-primitive allocate-external-string) n-bytes)))
+       (let ((xstring (make-external-string descriptor)))
+	 (add-to-gc-finalizer! external-strings xstring descriptor)
+	 xstring)))))
+
+(define (external-string-length xstring)
+  (if (not (external-string? xstring))
+      (error:wrong-type-argument xstring "external string"
+				 'EXTERNAL-STRING-LENGTH))
+  ((ucode-primitive extended-string-length)
+   (external-string-descriptor xstring)))
+
 ;;;; Guarantors
 ;;
 ;; The guarantors are integrated.  Most are structured as combination of
diff --git a/v7/src/runtime/version.scm b/v7/src/runtime/version.scm
index 354bb9824..f63881fe8 100644
--- a/v7/src/runtime/version.scm
+++ b/v7/src/runtime/version.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: version.scm,v 14.190 2000/12/19 18:56:14 cph Exp $
+$Id: version.scm,v 14.191 2001/01/04 22:27:50 cph Exp $
 
-Copyright (c) 1988-2000 Massachusetts Institute of Technology
+Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -25,10 +25,10 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
 (declare (usual-integrations))
 
 (define (initialize-package!)
-  (add-subsystem-identification! "Release" '(7 5 12))
+  (add-subsystem-identification! "Release" '(7 5 13))
   (snarf-microcode-version!)
   (add-event-receiver! event:after-restore snarf-microcode-version!)
-  (add-subsystem-identification! "Runtime" '(14 184)))
+  (add-subsystem-identification! "Runtime" '(14 185)))
 
 (define (snarf-microcode-version!)
   (add-subsystem-identification! "Microcode"