Flesh out vector-8b operations a bit.

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 46cc1f464785e78b03f91970dec4c35282f0790b..3c36de6eb1f4b9d7b65f46efca2faa65e07be4fd 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,10 +1,10 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.524 2004/12/23 04:43:38 cph Exp $
+$Id: runtime.pkg,v 14.525 2005/01/06 18:10:17 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
-Copyright 2000,2001,2002,2003,2004 Massachusetts Institute of Technology
+Copyright 2000,2001,2002,2003,2004,2005 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -745,6 +745,10 @@ USA.
   (files "string")
   (parent (runtime))
   (export ()
+         (set-vector-8b-length! set-string-length!)
+         (set-vector-8b-maximum-length! set-string-maximum-length!)
+         (vector-8b-length string-length)
+         (vector-8b-maximum-length string-maximum-length)
          allocate-external-string
          burst-string
          char->string
@@ -758,6 +762,7 @@ USA.
          guarantee-substring-start-index
          list->string
          make-string
+         make-vector-8b
          reverse-string
          reverse-string!
          reverse-substring
@@ -862,6 +867,7 @@ USA.
          substring<?
          substring=?
          substring?
+         vector-8b->hexadecimal
          vector-8b-fill!
          vector-8b-find-next-char
          vector-8b-find-next-char-ci

diff --git a/v7/src/runtime/string.scm b/v7/src/runtime/string.scm
index f64797768310a645bb69ab1d248e209ee6240f86..5e7ca51cd65324381302138861f1bce027aedec6 100644 (file)
--- a/v7/src/runtime/string.scm
+++ b/v7/src/runtime/string.scm
@@ -1,10 +1,10 @@
 #| -*-Scheme-*-
 
-$Id: string.scm,v 14.56 2004/02/17 05:35:46 cph Exp $
+$Id: string.scm,v 14.57 2005/01/06 18:10:27 cph Exp $
 
 Copyright 1986,1987,1988,1992,1993,1994 Massachusetts Institute of Technology
 Copyright 1995,1997,1999,2000,2001,2002 Massachusetts Institute of Technology
-Copyright 2003,2004 Massachusetts Institute of Technology
+Copyright 2003,2004,2005 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -74,6 +74,21 @@ USA.
 (define-integrable (vector-8b-find-previous-char-ci string start end ascii)
   (substring-find-previous-char-ci string start end (ascii->char ascii)))
 
+(define (vector-8b->hexadecimal bytes)
+  (let ((n (vector-8b-length bytes)))
+    (let ((s (make-string (fix:* 2 n))))
+      (do ((i 0 (fix:+ i 1))
+          (j 0 (fix:+ j 2)))
+         ((not (fix:< i n)))
+       (string-set! s j (hex-digit (fix:lsh (vector-8b-ref bytes i) -4)))
+       (string-set! s
+                    (fix:+ j 1)
+                    (hex-digit (fix:and (vector-8b-ref bytes i) #x0F))))
+      s)))
+
+(define-integrable (hex-digit k)
+  (string-ref "0123456789abcdef" k))
+
 ;;; Character optimizations
 
 (define-integrable (%%char-downcase char)
@@ -102,6 +117,9 @@ USA.
          (%substring-fill! result 0 length char)
          result))))
 
+(define (make-vector-8b length #!optional ascii)
+  (make-string length (if (default-object? ascii) ascii (ascii->char ascii))))
+
 (define (string-fill! string char)
   (guarantee-string string 'STRING-FILL!)
   (guarantee-char char 'STRING-FILL!)

diff --git a/v7/src/sf/usiexp.scm b/v7/src/sf/usiexp.scm
index dfa2596b1d3546e3cb56a2e0646642de461c7b0a..7c0fab2c2b67f249b6d80785d85b561ca773eeac 100644 (file)
--- a/v7/src/sf/usiexp.scm
+++ b/v7/src/sf/usiexp.scm
@@ -1,10 +1,10 @@
 #| -*-Scheme-*-
 
-$Id: usiexp.scm,v 4.44 2004/11/18 18:17:59 cph Exp $
+$Id: usiexp.scm,v 4.45 2005/01/06 18:10:44 cph Exp $
 
 Copyright 1987,1988,1989,1990,1991,1992 Massachusetts Institute of Technology
 Copyright 1993,1994,1995,1997,2000,2001 Massachusetts Institute of Technology
-Copyright 2004 Massachusetts Institute of Technology
+Copyright 2004,2005 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -673,6 +673,7 @@ USA.
     intern
     list
     make-string
+    make-vector-8b
     ;; modulo  ; Compiler does not currently open-code it.
     negative?
     number?
@@ -755,6 +756,7 @@ USA.
    intern-expansion
    list-expansion
    make-string-expansion
+   make-string-expansion
    ;; modulo-expansion
    negative?-expansion
    complex?-expansion