Implement 8-BIT-CHAR?. Move GUARANTEE-8-BIT-CHAR to "char.scm".

diff --git a/v7/src/runtime/char.scm b/v7/src/runtime/char.scm
index c7f8f5c18265f53c1619e568147fce357b2edc7a..6cac0227b901a9f124e67223830abb3202a021c8 100644 (file)
--- a/v7/src/runtime/char.scm
+++ b/v7/src/runtime/char.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: char.scm,v 14.30 2007/01/05 21:19:28 cph Exp $
+$Id: char.scm,v 14.31 2007/08/10 17:57:25 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -88,6 +88,14 @@ USA.
   (guarantee-char char 'CLEAR-CHAR-BITS)
   (%make-char (%char-code char)
              (fix:andc (%char-bits char) bits)))
+\f
+(define (8-bit-char? object)
+  (and (char? object)
+       (fix:< (char->integer char) 256)))
+
+(define (guarantee-8-bit-char object #!optional caller)
+  caller
+  (error:not-8-bit-char object))
 
 (define (char-ascii? char)
   (guarantee-char char 'CHAR-ASCII?)
@@ -96,11 +104,8 @@ USA.
         n)))
 
 (define (char->ascii char)
-  (guarantee-char char 'CHAR->ASCII)
-  (let ((n (char->integer char)))
-    (if (not (fix:< n 256))
-       (error:bad-range-argument char 'CHAR->ASCII))
-    n))
+  (guarantee-8-bit-char char 'CHAR->ASCII)
+  (char->integer char))
 
 (define (ascii->char code)
   (guarantee-limited-index-fixnum code 256 'ASCII->CHAR)

diff --git a/v7/src/runtime/port.scm b/v7/src/runtime/port.scm
index 5a6ee663ff46cc68237ef80efaf578ef41c39f7d..46052da22dc38945139f2aa0639b95954955ccb1 100644 (file)
--- a/v7/src/runtime/port.scm
+++ b/v7/src/runtime/port.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: port.scm,v 1.50 2007/01/09 06:16:53 cph Exp $
+$Id: port.scm,v 1.51 2007/08/10 17:57:26 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -758,10 +758,6 @@ USA.
 
 (define (error:not-i/o-port port caller)
   (error:wrong-type-argument port "I/O port" caller))
-
-(define-integrable (guarantee-8-bit-char char)
-  (if (fix:>= (char->integer char) #x100)
-      (error:not-8-bit-char char)))
 \f
 (define (port/supports-coding? port)
   (let ((operation (port/operation port 'SUPPORTS-CODING?)))

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 77729b2c006ad22f1c93251fd5e4c43a252a1d29..df4b9b39196997ae04d9e93e31ae71841b1db02a 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.620 2007/07/07 17:22:19 cph Exp $
+$Id: runtime.pkg,v 14.621 2007/08/10 17:57:27 cph Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -976,6 +976,7 @@ USA.
   (files "char")
   (parent (runtime))
   (export ()
+         8-bit-char?
          ascii->char
          char->ascii
          char->digit
@@ -1012,6 +1013,7 @@ USA.
          digit->char
          error:not-char
          error:not-radix
+         guarantee-8-bit-char
          guarantee-char
          guarantee-radix
          integer->char
@@ -1919,7 +1921,6 @@ USA.
          close-port
          current-input-port
          current-output-port
-         guarantee-8-bit-char
          guarantee-i/o-port
          guarantee-input-port
          guarantee-output-port