Store bucky bits in variables, and provide operations to test and set

them.  This should provide a little more abstraction than at present.

diff --git a/v7/src/runtime/char.scm b/v7/src/runtime/char.scm
index 245b33feb9dc22edb3d529f4eb77df5be67fd86a..c61fb8f4e8c29322fe76254d1c5dc43335cf3df6 100644 (file)
--- a/v7/src/runtime/char.scm
+++ b/v7/src/runtime/char.scm
@@ -1,9 +1,9 @@
 #| -*-Scheme-*-
 
-$Id: char.scm,v 14.26 2005/06/03 13:32:16 cph Exp $
+$Id: char.scm,v 14.27 2006/10/24 04:08:46 cph Exp $
 
 Copyright 1986,1987,1988,1991,1995,1997 Massachusetts Institute of Technology
-Copyright 1998,2001,2003,2004,2005 Massachusetts Institute of Technology
+Copyright 1998,2001,2003,2004,2005,2006 Massachusetts Institute of Technology
 
 This file is part of MIT/GNU Scheme.
 
@@ -66,6 +66,28 @@ USA.
   (guarantee-char char 'CHAR-BITS)
   (%char-bits char))
 
+(define (char-bits-set? bits char)
+  (guarantee-limited-index-fixnum bits char-bits-limit 'CHAR-BITS-SET?)
+  (guarantee-char char 'CHAR-BITS-SET?)
+  (fix:= bits (fix:and (%char-bits char) bits)))
+
+(define (char-bits-clear? bits char)
+  (guarantee-limited-index-fixnum bits char-bits-limit 'CHAR-BITS-CLEAR?)
+  (guarantee-char char 'CHAR-BITS-CLEAR?)
+  (fix:= 0 (fix:and (%char-bits char) bits)))
+
+(define (set-char-bits bits char)
+  (guarantee-limited-index-fixnum bits char-bits-limit 'SET-CHAR-BITS)
+  (guarantee-char char 'SET-CHAR-BITS)
+  (%make-char (%char-code char)
+             (fix:or (%char-bits char) bits)))
+
+(define (clear-char-bits bits char)
+  (guarantee-limited-index-fixnum bits char-bits-limit 'CLEAR-CHAR-BITS)
+  (guarantee-char char 'CLEAR-CHAR-BITS)
+  (%make-char (%char-code char)
+             (fix:andc (%char-bits char) bits)))
+
 (define (char-ascii? char)
   (guarantee-char char 'CHAR-ASCII?)
   (let ((n (char->integer char)))
@@ -353,4 +375,9 @@ USA.
   '((#x01 "M" "meta")
     (#x02 "C" "control" "ctrl")
     (#x04 "S" "super")
-    (#x08 "H" "hyper")))
\ No newline at end of file
+    (#x08 "H" "hyper")))
+
+(define char-bit:meta #x01)
+(define char-bit:control #x02)
+(define char-bit:super #x04)
+(define char-bit:hyper #x08)
\ No newline at end of file

diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 3c1123312b7668f78f6579f68987a855475f0b0f..95183d3ef595e6233a141028a7314046f31dc6c1 100644 (file)
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.598 2006/10/04 19:02:26 cph Exp $
+$Id: runtime.pkg,v 14.599 2006/10/24 04:08:58 cph Exp $
 
 Copyright 1988,1989,1990,1991,1992,1993 Massachusetts Institute of Technology
 Copyright 1994,1995,1996,1997,1998,1999 Massachusetts Institute of Technology
@@ -973,8 +973,14 @@ USA.
          char->integer
          char->name
          char-ascii?
+         char-bit:control
+         char-bit:hyper
+         char-bit:meta
+         char-bit:super
          char-bits
+         char-bits-clear?
          char-bits-limit
+         char-bits-set?
          char-ci<=?
          char-ci<?
          char-ci=?
@@ -992,6 +998,7 @@ USA.
          char>?
          char?
          chars->ascii
+         clear-char-bits
          code->char
          digit->char
          error:not-char
@@ -1001,7 +1008,8 @@ USA.
          integer->char
          make-char
          name->char
-         radix?)
+         radix?
+         set-char-bits)
   (export (runtime string)
          %char<?
          downcase-table