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"