From bccc157681d0c3368ce8c4929ed1c6ad94684d2c Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 10 Aug 2007 17:57:27 +0000
Subject: [PATCH] Implement 8-BIT-CHAR?.  Move GUARANTEE-8-BIT-CHAR to
 "char.scm".

---
 v7/src/runtime/char.scm    | 17 +++++++++++------
 v7/src/runtime/port.scm    |  6 +-----
 v7/src/runtime/runtime.pkg |  5 +++--
 3 files changed, 15 insertions(+), 13 deletions(-)

diff --git a/v7/src/runtime/char.scm b/v7/src/runtime/char.scm
index c7f8f5c18..6cac0227b 100644
--- 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)))
+
+(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 5a6ee663f..46052da22 100644
--- 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)))
 
 (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 77729b2c0..df4b9b391 100644
--- 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
-- 
2.25.1