Eliminate char->ascii and ascii->char, which were misnomers.

Change char-ascii? to be true only for 7-bit chars.  Also change char-ascii? to
return a boolean and implement ascii-char?.

diff --git a/src/6001/pic-read.scm b/src/6001/pic-read.scm
index 635312b93de495dd9ced4682137e2b30ca189ba0..8ca6802b18e8bb2f8944639c4b14c3d3a47303d4 100644 (file)
--- a/src/6001/pic-read.scm
+++ b/src/6001/pic-read.scm
@@ -86,7 +86,7 @@ USA.
            (flo:vector-set!
             nth-row
             m
-            (exact->inexact (char->ascii (read-char port)))))))))
+            (exact->inexact (char->integer (read-char port)))))))))
     (picture-set-data! pic data)
     pic))
 \f

diff --git a/src/6001/picture.scm b/src/6001/picture.scm
index 838473c98573f2d07678d5ed6b15ac00f0ada8c7..e5e70d975e95bcbef2a595358d9c2ba76930f5ab 100644 (file)
--- a/src/6001/picture.scm
+++ b/src/6001/picture.scm
@@ -441,11 +441,11 @@ USA.
          (if (>= row 0)
              (let ((rowvals
                     (map (cond ((= pmin pmax)
-                                (lambda (x) x (ascii->char 0)))
+                                (lambda (x) x (integer->char 0)))
                                (else
                                 (let ((scale (/ 255. (- pmax pmin))))
                                   (lambda (x)
-                                    (ascii->char
+                                    (integer->char
                                      (round->exact (* (- x pmin) scale)))))))
                          (flo:vector->list (vector-ref data row)))))
                (begin

diff --git a/src/compiler/base/utils.scm b/src/compiler/base/utils.scm
index a972150d49309ecac5105eb6d3ad3f2778522125..b9c229d40b2f804e030b05f1c349f4e6b9a743c3 100644 (file)
--- a/src/compiler/base/utils.scm
+++ b/src/compiler/base/utils.scm
@@ -242,7 +242,7 @@ USA.
     FLO:TRUNCATE->EXACT FLO:ROUND->EXACT
 
     ;; Random
-    OBJECT-TYPE CHAR-ASCII? ASCII->CHAR CHAR->INTEGER CHAR-BITS CHAR-CODE
+    OBJECT-TYPE CHAR->INTEGER CHAR-BITS CHAR-CODE
     CHAR-DOWNCASE CHAR-UPCASE INTEGER->CHAR MAKE-CHAR
     PRIMITIVE-PROCEDURE-ARITY
 

diff --git a/src/compiler/machines/i386/rules1.scm b/src/compiler/machines/i386/rules1.scm
index 345cf890510c82abb3b2728b2fe2f887c344966e..9c0207ddd255c31a4196123418b30a9ec87b5691 100644 (file)
--- a/src/compiler/machines/i386/rules1.scm
+++ b/src/compiler/machines/i386/rules1.scm
@@ -317,7 +317,7 @@ USA.
     (LAP (MOV B ,target ,source))))
 
 (define (char->signed-8-bit-immediate character)
-  (let ((ascii (char->ascii character)))
+  (let ((ascii (char->integer character)))
     (if (< ascii 128) ascii (- ascii 256))))
 \f
 ;;;; Utilities specific to rules1

diff --git a/src/compiler/machines/svm/rules.scm b/src/compiler/machines/svm/rules.scm
index cfcfeba11b733bc10bff4d4cdb3a48273000720a..cdb501f68633474f2c65c71a2c409731d4eab3e0 100644 (file)
--- a/src/compiler/machines/svm/rules.scm
+++ b/src/compiler/machines/svm/rules.scm
@@ -228,7 +228,7 @@ USA.
 (define-rule statement
   (ASSIGN (REGISTER (? target))
          (CHAR->ASCII (CONSTANT (? char))))
-  (QUALIFIER (and (char? char) (char-ascii? char)))
+  (QUALIFIER (ascii-char? char))
   (inst:load-immediate (word-target target)
                       (object-datum char)))
 

diff --git a/src/compiler/machines/x86-64/rules1.scm b/src/compiler/machines/x86-64/rules1.scm
index 4a7de17f0af3b59333c5d3ffbd203874eb0e95b2..157a1e198e8b7cc4e9b1e08fffba9b3e79397af0 100644 (file)
--- a/src/compiler/machines/x86-64/rules1.scm
+++ b/src/compiler/machines/x86-64/rules1.scm
@@ -338,7 +338,7 @@ USA.
     (LAP (MOV B ,target ,source))))
 
 (define (char->signed-8-bit-immediate character)
-  (let ((ascii (char->ascii character)))
+  (let ((ascii (char->integer character)))
     (if (< ascii 128) ascii (- ascii 256))))
 \f
 ;;;; Utilities specific to rules1

diff --git a/src/edwin/artdebug.scm b/src/edwin/artdebug.scm
index f6ced6ef734fc1bf5b7203541094acacf492b3f7..ba3d96b7c812b96875233826cc9c1061ca1e47c6 100644 (file)
--- a/src/edwin/artdebug.scm
+++ b/src/edwin/artdebug.scm
@@ -1301,7 +1301,7 @@ Prefix argument means do not kill the debugger buffer."
       value)))
 
 (define (operation/write-char port char)
-  (guarantee-8-bit-char char)
+  (guarantee 8-bit-char? char)
   (region-insert-char! (port/state port) char))
 
 (define (operation/write-substring port string start end)

diff --git a/src/edwin/basic.scm b/src/edwin/basic.scm
index 945211fe3991b5347617c24e4c3ef56e5b98c913..2dcc88ab0b362f3237230d6188780711b6c90fcc 100644 (file)
--- a/src/edwin/basic.scm
+++ b/src/edwin/basic.scm
@@ -69,7 +69,7 @@ Whichever character you type to run this command is inserted."
             (if (input-event? input)
                 (abort-current-command input)
                 (begin
-                  (if (not (and (char? input) (char-ascii? input)))
+                  (if (not (ascii-char? input))
                       (editor-error "Can't quote non-ASCII char:" input))
                   (set-command-prompt!
                    (string-append (command-prompt) (key-name input)))
@@ -82,7 +82,7 @@ Whichever character you type to run this command is inserted."
       (let ((char (read-ascii-char)))
        (let ((digit (char->digit char 4)))
          (if digit
-             (ascii->char
+             (integer->char
               (let ((digit2 (read-digit)))
                 (let ((digit3 (read-digit)))
                   (+ (* (+ (* digit 8) digit2) 8) digit3))))

diff --git a/src/edwin/bufout.scm b/src/edwin/bufout.scm
index d0d534b0349e2f7cae490c6a33fd2ff46fc09f38..2ebc95843444eee4be8662aa937a8f23eeb5855f 100644 (file)
--- a/src/edwin/bufout.scm
+++ b/src/edwin/bufout.scm
@@ -73,7 +73,7 @@ USA.
   (write (port/mark port) output))
 
 (define (operation/write-char port char)
-  (guarantee-8-bit-char char)
+  (guarantee 8-bit-char? char)
   (region-insert-char! (port/mark port) char)
   1)
 

diff --git a/src/edwin/bufwin.scm b/src/edwin/bufwin.scm
index 111d5c22e5bcf7406f119d765317b7b8e7f422f5..d529a8a8ca7bc4edccb05d3102ab7c312174ab51 100644 (file)
--- a/src/edwin/bufwin.scm
+++ b/src/edwin/bufwin.scm
@@ -217,7 +217,7 @@ USA.
 
 (define-integrable (%window-char->image window char)
   (vector-ref (%window-char-image-strings window)
-             (char->ascii char)))
+             (char->integer char)))
 
 (define-integrable (%window-point window)
   (with-instance-variables buffer-window window () point))

diff --git a/src/edwin/debug.scm b/src/edwin/debug.scm
index d7da786578f417f99a425952bb1895851ca87303..dbcbbae1f61580971f216709a0861c50ebdd80e2 100644 (file)
--- a/src/edwin/debug.scm
+++ b/src/edwin/debug.scm
@@ -480,7 +480,7 @@ USA.
   (make-port-type
    `((WRITE-CHAR
       ,(lambda (port char)
-        (guarantee-8-bit-char char)
+        (guarantee 8-bit-char? char)
         (region-insert-char! (port/state port) char)
         1))
      (PROMPT-FOR-CONFIRMATION

diff --git a/src/edwin/intmod.scm b/src/edwin/intmod.scm
index 549248da301dd33b31d3970414659307c6a0c0dd..55e0b49aaa6ab5e0c944b7524bdadd73792d8bd2 100644 (file)
--- a/src/edwin/intmod.scm
+++ b/src/edwin/intmod.scm
@@ -881,7 +881,7 @@ If this is an error, the debugger examines the error condition."
 ;;; Output operations
 
 (define (operation/write-char port char)
-  (guarantee-8-bit-char char)
+  (guarantee 8-bit-char? char)
   (enqueue-output-string! port (string char))
   1)
 

diff --git a/src/edwin/prompt.scm b/src/edwin/prompt.scm
index 014488ab180eb46cda457d3dae5519e37139a172..384cb3ddc85ade59950605cd120bac1d43442702 100644 (file)
--- a/src/edwin/prompt.scm
+++ b/src/edwin/prompt.scm
@@ -849,12 +849,12 @@ a repetition of this command will exit."
         (prompt-for-typein (string-append prompt ": ") #f
           (lambda ()
             (let ((input (with-editor-interrupts-disabled keyboard-read)))
-              (if (and (char? input) (char-ascii? input))
+              (if (ascii-char? input)
                   (set-typein-string! (key-name input) #t))
               (if (input-event? input)
                   (abort-typein-edit input)
                   input))))))
-    (if (not (and (char? input) (char-ascii? input)))
+    (if (not (ascii-char? input))
        (editor-error "Not an ASCII character:" input))
     input))
 
@@ -1024,7 +1024,7 @@ it is added to the front of the command history."
                                     (set! phrase (string-head phrase length))
                                     (string-fill! phrase* #\NUL)
                                     (set! phrase* #f)))))
-                           ((and (char? input) (char-ascii? input))
+                           ((ascii-char? input)
                             (set! phrase* phrase)
                             (set! phrase
                                   (string-append phrase (string input)))

diff --git a/src/edwin/syntax.scm b/src/edwin/syntax.scm
index 6a6094e23d01c22f46d1f6569bdf5b173e5a43df..f729f1937dba9d8c91f67a1bc6d26ef54ddbf4bf 100644 (file)
--- a/src/edwin/syntax.scm
+++ b/src/edwin/syntax.scm
@@ -32,7 +32,8 @@ USA.
 
 (define (modify-syntax-entries! syntax-table cl ch string)
   (set-char-syntax! syntax-table
-                   (ascii-range->char-set (char->ascii cl) (char->ascii ch))
+                   (ascii-range->char-set (char->integer cl)
+                                          (char->integer ch))
                    string))
 
 (define (group-syntax-table-entries group)
@@ -56,7 +57,7 @@ which is selected so you can see it."
                (lambda (bottom top)
                  (let ((describe-char
                         (lambda (ascii)
-                          (emacs-key-name (ascii->char ascii) #f)))
+                          (emacs-key-name (integer->char ascii) #f)))
                        (top (- top 1)))
                    (if (= bottom top)
                        (describe-char bottom)
@@ -97,7 +98,7 @@ which is selected so you can see it."
            (if (not (zero? match))
                (begin
                  (write-string ", matches ")
-                 (write-string (emacs-key-name (ascii->char match) #f)))))
+                 (write-string (emacs-key-name (integer->char match) #f)))))
          (let ((decode-comment-bit
                 (lambda (code pos se style)
                   (if (not (fix:= 0 (fix:and code entry)))

diff --git a/src/edwin/wincom.scm b/src/edwin/wincom.scm
index 7690f81756985d4bff216a2e82e0a4721417846b..56e776c83d6abc3c4e98c9a2dcd18a1d0f6753bc 100644 (file)
--- a/src/edwin/wincom.scm
+++ b/src/edwin/wincom.scm
@@ -239,7 +239,7 @@ means scroll one screenful down."
        (message (if (group-end? point)
                     ""
                     (let ((char (mark-right-char point)))
-                      (let ((n (char->ascii char)))
+                      (let ((n (char->integer char)))
                         (string-append "Char: " (key-name char)
                                        " ("
                                        (if (zero? n) "" "0")

diff --git a/src/edwin/winout.scm b/src/edwin/winout.scm
index 8e68c24f60989587b0fbd7927aad04abf92c2c88..91b685521b1f787a307bbbb5f2c088dfe92ab7c4 100644 (file)
--- a/src/edwin/winout.scm
+++ b/src/edwin/winout.scm
@@ -39,7 +39,7 @@ USA.
   (make-port window-output-port-type window))
 
 (define (operation/write-char port char)
-  (guarantee-8-bit-char char)
+  (guarantee 8-bit-char? char)
   (let ((window (port/state port)))
     (let ((buffer (window-buffer window))
          (point (window-point window)))

diff --git a/src/mcrypt/mcrypt-check.scm b/src/mcrypt/mcrypt-check.scm
index a6bb22c8a456ce3a01480b05c95430b3e9fde441..dea12edc7fda5f23000a2d6a207076cfca86d75d 100644 (file)
--- a/src/mcrypt/mcrypt-check.scm
+++ b/src/mcrypt/mcrypt-check.scm
@@ -30,7 +30,7 @@ USA.
   (list->string (make-initialized-list length
                                       (lambda (i)
                                         (declare (ignore i))
-                                        (ascii->char (random 256))))))
+                                        (integer->char (random 256))))))
 
 (if (not (member "tripledes" (mcrypt-algorithm-names)))
     (error "No tripledes."))

diff --git a/src/runtime/char.scm b/src/runtime/char.scm
index 2e2aedc34577417ac1754b240db4febe7c4aeeb0..18772031ea02217193be56c10d5fc79dcdfd14e3 100644 (file)
--- a/src/runtime/char.scm
+++ b/src/runtime/char.scm
@@ -80,26 +80,12 @@ USA.
   (and (char? object)
        (fix:< (char->integer object) #x100)))
 
-(define (guarantee-8-bit-char object #!optional caller)
-  caller
-  (if (not (8-bit-char? object))
-      (error:not-8-bit-char object)))
-
-(define (char-ascii? char)
-  (let ((n (char->integer char)))
-    (and (fix:< n #x100)
-        n)))
-
-(define (char->ascii char)
-  (guarantee-8-bit-char char 'CHAR->ASCII)
-  (char->integer char))
-
-(define (ascii->char code)
-  (guarantee-limited-index-fixnum code #x100 'ASCII->CHAR)
-  (%make-char code 0))
-
-(define (chars->ascii chars)
-  (map char->ascii chars))
+(define (ascii-char? object)
+  (and (char? object)
+       (char-ascii? object)))
+
+(define-integrable (char-ascii? char)
+  (fix:< (char->integer char) #x100))
 
 (define (char=? x y)
   (fix:= (char->integer x) (char->integer y)))

diff --git a/src/runtime/chrsyn.scm b/src/runtime/chrsyn.scm
index 1036fbbf30acb20c1110d24c41a0b87ea947b845..cda8635971baaeab98eecf46abaac906e7729d43 100644 (file)
--- a/src/runtime/chrsyn.scm
+++ b/src/runtime/chrsyn.scm
@@ -47,16 +47,16 @@ USA.
 
 (define (get-char-syntax table char)
   (vector-ref (guarantee-char-syntax-table table 'GET-CHAR-SYNTAX)
-             (char->ascii char)))
+             (char->integer char)))
 
 (define (set-char-syntax! table char string)
   (let ((entries (guarantee-char-syntax-table table 'SET-CHAR-SYNTAX!))
        (entry (string->char-syntax string)))
     (cond ((char? char)
-          (vector-set! entries (char->ascii char) entry))
+          (vector-set! entries (char->integer char) entry))
          ((char-set? char)
           (for-each (lambda (char)
-                      (vector-set! entries (char->ascii char) entry))
+                      (vector-set! entries (char->integer char) entry))
                     (char-set-members char)))
          (else
           (error:wrong-type-argument char "character" 'SET-CHAR-SYNTAX!)))))
@@ -117,7 +117,7 @@ USA.
      (let ((match (fix:and #xff (fix:lsh entry -4))))
        (if (zero? match)
           " "
-          (string (ascii->char match))))
+          (string (integer->char match))))
      (let ((cbits (fix:and #xFF (fix:lsh entry -12))))
        (string-append
        (if (fix:= 0 (fix:and #x40 cbits)) "" "1")

diff --git a/src/runtime/format.scm b/src/runtime/format.scm
index 8bce0eec1548d4fb93166fedaf30e7102a91045a..28233b6e71824955dd1421bd60fee805285c9da1 100644 (file)
--- a/src/runtime/format.scm
+++ b/src/runtime/format.scm
@@ -212,7 +212,7 @@ USA.
        (let ((table (make-vector 256 parse-default)))
          (for-each (lambda (entry)
                      (vector-set! table
-                                  (char->ascii (car entry))
+                                  (char->integer (car entry))
                                   (cadr entry)))
                    (let ((format-string
                           (format-wrapper (format-object display)))
@@ -235,10 +235,10 @@ USA.
                        (#\@ ,(parse-modifier 'AT))
                        (#\: ,(parse-modifier 'COLON))
                        (#\%
-                        ,(format-wrapper (format-insert-character #\Newline)))
+                        ,(format-wrapper (format-insert-character #\newline)))
                        (#\~ ,(format-wrapper (format-insert-character #\~)))
                        (#\; ,(format-wrapper format-ignore-comment))
-                       (#\Newline ,(format-wrapper format-ignore-whitespace))
+                       (#\newline ,(format-wrapper format-ignore-whitespace))
                        (#\A ,format-string)
                        (#\a ,format-string)
                        (#\S ,format-object)

diff --git a/src/runtime/intrpt.scm b/src/runtime/intrpt.scm
index 796c2824f2780325cb83c4fb5b139d1d92e5db8d..185978977e833a0614e7a5b47599a023a1b80de5 100644 (file)
--- a/src/runtime/intrpt.scm
+++ b/src/runtime/intrpt.scm
@@ -47,7 +47,7 @@ USA.
        (let ((table (make-vector 256 false)))
          (for-each (lambda (entry)
                      (vector-set! table
-                                  (char->ascii (car entry))
+                                  (char->integer (car entry))
                                   (cadr entry)))
                    `((#\B ,^B-interrupt-handler)
                      (#\G ,^G-interrupt-handler)

diff --git a/src/runtime/krypt.scm b/src/runtime/krypt.scm
index a93a97ed00c6ed683126ebdc88f809dad31d7a13..f4bd7ad1d977c4464c2d202797386aac0f90f443 100644 (file)
--- a/src/runtime/krypt.scm
+++ b/src/runtime/krypt.scm
@@ -195,7 +195,7 @@ USA.
                            (update-checksum checksum output-string index
                                             count))
                      (rcm-iter key1 count output-string index))))
-             (let ((check-char (ascii->char (modulo (- checksum) ts))))
+             (let ((check-char (integer->char (modulo (- checksum) ts))))
                (let ((cc-string (char->string check-char)))
                  (rcm key1 1 cc-string)
                  (string-set! output-string

diff --git a/src/runtime/mime-codec.scm b/src/runtime/mime-codec.scm
index 8da33ca94e8dfe2b813450f12c33ddd1ceca4b42..ca0d502f47b36eb0d23312fcfa31983259f85669 100644 (file)
--- a/src/runtime/mime-codec.scm
+++ b/src/runtime/mime-codec.scm
@@ -32,7 +32,7 @@ USA.
   (make-textual-port-type
    `((WRITE-CHAR
       ,(lambda (port char)
-        (guarantee-8-bit-char char)
+        (guarantee 8-bit-char? char)
         (update (textual-port-state port) (string char) 0 1)
         1))
      (WRITE-SUBSTRING
@@ -796,7 +796,7 @@ USA.
   (make-textual-port-type
    `((WRITE-CHAR
       ,(lambda (port char)
-        (guarantee-8-bit-char char)
+        (guarantee 8-bit-char? char)
         (let ((state (textual-port-state port)))
           (let ((port (binhex40-rld-state/port state))
                 (char* (binhex40-rld-state/char state)))
@@ -854,7 +854,7 @@ USA.
   (make-textual-port-type
    `((WRITE-CHAR
       ,(lambda (port char)
-        (guarantee-8-bit-char char)
+        (guarantee 8-bit-char? char)
         (case (binhex40-decon/state (textual-port-state port))
           ((READING-HEADER) (binhex40-decon-reading-header port char))
           ((COPYING-DATA) (binhex40-decon-copying-data port char))

diff --git a/src/runtime/predicate-metadata.scm b/src/runtime/predicate-metadata.scm
index c1db926046f0c30a2043e4a6350f984ba9c3797a..bed365b92296009a5f97db8c8ab20ef73335db8e 100644 (file)
--- a/src/runtime/predicate-metadata.scm
+++ b/src/runtime/predicate-metadata.scm
@@ -287,6 +287,7 @@ USA.
  (lambda ()
    ;; MIT/GNU Scheme: misc
    (register-predicate! 8-bit-char? '8-bit-char '<= char?)
+   (register-predicate! ascii-char? 'ascii-char '<= 8-bit-char?)
    (register-predicate! bit-string? 'bit-string)
    (register-predicate! cell? 'cell)
    (register-predicate! compiled-code-address? 'compiled-code-address)

diff --git a/src/runtime/rgxcmp.scm b/src/runtime/rgxcmp.scm
index c709a686dae42752e80336dc9584ba2b40a1e4e5..4c0667a0361de380b00f5e22d76ff688505ada3b 100644 (file)
--- a/src/runtime/rgxcmp.scm
+++ b/src/runtime/rgxcmp.scm
@@ -357,7 +357,7 @@ USA.
   (cached-procedure 16
     (lambda (pattern case-fold?)
       (let* ((output (list 'OUTPUT))
-            (ctx (make-rgxcmpctx (map char->ascii (string->list pattern))
+            (ctx (make-rgxcmpctx (map char->integer (string->list pattern))
                                  #f    ;current-byte
                                  (re-translation-table case-fold?)
                                  output ;output-head
@@ -380,7 +380,7 @@ USA.
                (if (not (stack-empty? ctx))
                    (compilation-error ctx "Unmatched \\("))
                (make-compiled-regexp
-                (list->string (map ascii->char (cdr (output-head ctx))))
+                (list->string (map integer->char (cdr (output-head ctx))))
                 case-fold?))
              (begin
                (compile-pattern-char ctx)
@@ -424,7 +424,7 @@ USA.
        char)))
 
 (define (input-match? byte . chars)
-  (memv (ascii->char byte) chars))
+  (memv (integer->char byte) chars))
 \f
 ;;;; Output
 
@@ -508,7 +508,7 @@ USA.
   (caddr (list-ref (stack ctx) i)))
 
 (define (ascii->syntax-entry ascii)
-  ((ucode-primitive string->syntax-entry) (char->string (ascii->char ascii))))
+  ((ucode-primitive string->syntax-entry) (char->string (integer->char ascii))))
 \f
 ;;;; Pattern Dispatch
 
@@ -538,7 +538,7 @@ USA.
        (pointer-operate! (pending-exact ctx) 1+))))
 
 (define (define-pattern-char char procedure)
-  (vector-set! pattern-chars (char->ascii char) procedure)
+  (vector-set! pattern-chars (char->integer char) procedure)
   unspecific)
 
 (define pattern-chars
@@ -553,7 +553,7 @@ USA.
          ((vector-ref backslash-chars (input-peek-1 ctx)) ctx)))))
 
 (define (define-backslash-char char procedure)
-  (vector-set! backslash-chars (char->ascii char) procedure)
+  (vector-set! backslash-chars (char->integer char) procedure)
   unspecific)
 
 (define backslash-chars
@@ -674,7 +674,7 @@ USA.
     (let ((invert?
           (and (input-match? (input-peek ctx) #\^)
                (begin (input-discard! ctx) #t)))
-         (charset (make-string 32 (ascii->char 0))))
+         (charset (make-string 32 (integer->char 0))))
       (if (input-end? ctx)
          (premature-end ctx))
       (let loop
@@ -692,10 +692,10 @@ USA.
                (for-each
                 (lambda (char)
                   ((ucode-primitive re-char-set-adjoin!) charset
-                                                         (char->ascii char)))
+                                                         (char->integer char)))
                 (char-set-members
                  (re-compile-char-set
-                  (list->string (map ascii->char (reverse! chars)))
+                  (list->string (map integer->char (reverse! chars)))
                   #f))))
              (loop (cons char chars)))))
       (output-start! ctx (if invert? re-code:not-char-set re-code:char-set))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 531cec0855117bfcd49d374e9e8f3d1c7954fd27..9eb7d89004b62cb48251e589ebeb0cc45ba8f6aa 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -1324,6 +1324,7 @@ USA.
          ;; BEGIN deprecated bindings
          (error:not-wide-char error:not-unicode-char)
          (guarantee-wide-char guarantee-unicode-char)
+         (wide-char? unicode-char?)
          error:not-char
          error:not-radix
          error:not-unicode-char
@@ -1333,10 +1334,8 @@ USA.
          guarantee-unicode-char
          guarantee-unicode-scalar-value
          ;; END deprecated bindings
-         (wide-char? unicode-char?)
          8-bit-char?
-         ascii->char
-         char->ascii
+         ascii-char?
          char->digit
          char->integer
          char->name
@@ -1370,7 +1369,6 @@ USA.
          char>=?
          char>?
          char?
-         chars->ascii
          clear-char-bits
          code->char
          decode-utf16be-char
@@ -1384,7 +1382,6 @@ USA.
          encode-utf32be-char!
          encode-utf32le-char!
          encode-utf8-char!
-         guarantee-8-bit-char
          initial-byte->utf8-char-length
          initial-u16->utf16-char-length
          initial-u32->utf32-char-length

diff --git a/src/runtime/string.scm b/src/runtime/string.scm
index dbe385ed6515b9410fd68d1aef26ba4a7f689ad2..7766f5a2b06f18d0623dcf9eda81891fbe03cd16 100644 (file)
--- a/src/runtime/string.scm
+++ b/src/runtime/string.scm
@@ -81,7 +81,7 @@ USA.
          result))))
 
 (define (make-vector-8b length #!optional ascii)
-  (make-string length (if (default-object? ascii) ascii (ascii->char ascii))))
+  (make-string length (if (default-object? ascii) ascii (integer->char ascii))))
 
 (define (string-fill! string char #!optional start end)
   (substring-fill! string
@@ -280,7 +280,7 @@ USA.
        (else (error:wrong-type-argument object "string component" caller))))
 
 (define (char->string char)
-  (guarantee-8-bit-char char 'CHAR->STRING)
+  (guarantee 8-bit-char? char 'CHAR->STRING)
   (make-string 1 char))
 
 (define (list->string chars)
@@ -289,7 +289,7 @@ USA.
     (let loop ((chars chars) (index 0))
       (if (pair? chars)
          (begin
-           (guarantee-8-bit-char (car chars))
+           (guarantee 8-bit-char? (car chars))
            (string-set! result index (car chars))
            (loop (cdr chars) (fix:+ index 1)))
          result))))

diff --git a/src/runtime/stringio.scm b/src/runtime/stringio.scm
index 82f355b6633558ed6984719b81373647fc0541ea..f328228632b7d538600080601f9bc2aa0f156ef1 100644 (file)
--- a/src/runtime/stringio.scm
+++ b/src/runtime/stringio.scm
@@ -133,7 +133,7 @@ USA.
                (j start* (fix:+ j 1)))
               ((not (fix:< i limit))
                (set! index i))
-            (bytevector-u8-set! bv j (char->ascii (ustring-ref string i)))))
+            (bytevector-u8-set! bv j (char->integer (ustring-ref string i)))))
         n)))))
 
 (define (make-octets-input-type)

diff --git a/src/runtime/unpars.scm b/src/runtime/unpars.scm
index 810d9e7ffdebf2837f3daf6e578cc86338bf3dc7..bc81606da9d262b13d96fdc0dd8c041980ed69a6 100644 (file)
--- a/src/runtime/unpars.scm
+++ b/src/runtime/unpars.scm
@@ -587,7 +587,7 @@ USA.
       (*unparse-string string)))
 
 (define (char->octal char)
-  (let ((qr1 (integer-divide (char->ascii char) 8)))
+  (let ((qr1 (integer-divide (char->integer char) 8)))
     (let ((qr2 (integer-divide (integer-divide-quotient qr1) 8)))
       (string (digit->char (integer-divide-quotient qr2) 8)
               (digit->char (integer-divide-remainder qr2) 8)

diff --git a/src/runtime/ustring.scm b/src/runtime/ustring.scm
index 38ae038457f79b1783a8e2e42f362c7bd20cf32e..1adfcf49f930afeecc961cb7b94c9361f9648932 100644 (file)
--- a/src/runtime/ustring.scm
+++ b/src/runtime/ustring.scm
@@ -73,9 +73,6 @@ USA.
             (loop (fix:+ i 1)))
        #t)))
 
-(define-integrable (char-ascii? char)
-  (fix:< (char->integer char) #x80))
-
 (define (min-length string-length string strings)
   (do ((strings strings (cdr strings))
        (n (string-length string)

diff --git a/src/sf/object.scm b/src/sf/object.scm
index a8ec9732bbc08a7836a4ad81f14c761fe925ec55..4ea0f632f07994e8bcf67887ede950b7f9be48b9 100644 (file)
--- a/src/sf/object.scm
+++ b/src/sf/object.scm
@@ -227,7 +227,6 @@ USA.
          &>
          BIT-STRING?
          CELL?
-         CHAR-ASCII?
          CHAR?
          EQ?
          EQUAL-FIXNUM?
@@ -358,11 +357,8 @@ USA.
         &/
         -1+
         1+
-        ASCII->CHAR
         CELL?
-        CHAR->ASCII
         CHAR->INTEGER
-        CHAR-ASCII?
         CHAR-BITS
         CHAR-CODE
         CHAR-DOWNCASE

diff --git a/src/x11/x11-base.scm b/src/x11/x11-base.scm
index 96e331a6e90524e451d1981138a0b4c35faae6aa..dd6c903efd8f01a67b9d563e1c35159a1749e111 100644 (file)
--- a/src/x11/x11-base.scm
+++ b/src/x11/x11-base.scm
@@ -275,7 +275,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
                                 (cond ((and (= keysym (C-enum "XK_BackSpace"))
                                             (= nbytes 1)
                                             (= (C-> buffer "char")
-                                               (char->ascii #\backspace)))
+                                               (char->integer #\backspace)))
                                        (char->string #\Delete))
                                       ((> nbytes 0)
                                        (let ((s (make-string nbytes)))
@@ -834,7 +834,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
     (let loop ((index 0))
       (if (< index length)
          (begin
-           (string-set! result index (ascii->char (c-> scan "uchar")))
+           (string-set! result index (integer->char (c-> scan "uchar")))
            (alien-byte-increment! scan (c-sizeof "uchar"))
            (loop (1+ index)))))
     result))

diff --git a/src/x11/x11-terminal.scm b/src/x11/x11-terminal.scm
index bf22529eb1d039d0c05c0a8dcb5f744dbeeab028..6fa0dcddbf4c351bd7bbdc9484a2e496a68e819f 100644 (file)
--- a/src/x11/x11-terminal.scm
+++ b/src/x11/x11-terminal.scm
@@ -99,7 +99,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (xterm-write-char! xterm x y char highlight)
   (let ((code (c-call "xterm_write_char"
-                     xterm x y (char->ascii char) highlight)))
+                     xterm x y (char->integer char) highlight)))
     (case code
       ((1) (error:bad-range-argument x 'xterm-write-char!))
       ((2) (error:bad-range-argument y 'xterm-write-char!))

diff --git a/tests/ffi/test-ffi-wrapper.scm b/tests/ffi/test-ffi-wrapper.scm
index 36058b5f57d1f6e18ab516e02dc21063d71110d2..090cd201559297e99d3e699af3bf62a41d02a448 100644 (file)
--- a/tests/ffi/test-ffi-wrapper.scm
+++ b/tests/ffi/test-ffi-wrapper.scm
@@ -17,9 +17,9 @@
         (chars (malloc (1+ (* (c-sizeof "char") (string-length string)))
                        '(* char)))
         (callback-id (C-callback (lambda (d) (* d pi)))))
-    (C->= struct "TestStruct first" (char->ascii #\A))
+    (C->= struct "TestStruct first" (char->integer #\A))
     (C->= struct "TestStruct second" pi)
-    (C->= struct "TestStruct third" (char->ascii #\C))
+    (C->= struct "TestStruct third" (char->integer #\C))
     (c-poke-string chars string)
     (C->= struct "TestStruct fourth" chars)
     (C-call "test_register_double"