From: Chris Hanson Date: Sun, 29 Jan 2017 08:42:13 +0000 (-0800) Subject: Eliminate char->ascii and ascii->char, which were misnomers. X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~34 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d22863f2fc00a200aa4d2a4f4a87b8d6d86ca589;p=mit-scheme.git 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 635312b93..8ca6802b1 100644 --- 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)) diff --git a/src/6001/picture.scm b/src/6001/picture.scm index 838473c98..e5e70d975 100644 --- 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 a972150d4..b9c229d40 100644 --- 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 345cf8905..9c0207ddd 100644 --- 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)))) ;;;; Utilities specific to rules1 diff --git a/src/compiler/machines/svm/rules.scm b/src/compiler/machines/svm/rules.scm index cfcfeba11..cdb501f68 100644 --- 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 4a7de17f0..157a1e198 100644 --- 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)))) ;;;; Utilities specific to rules1 diff --git a/src/edwin/artdebug.scm b/src/edwin/artdebug.scm index f6ced6ef7..ba3d96b7c 100644 --- 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 945211fe3..2dcc88ab0 100644 --- 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 d0d534b03..2ebc95843 100644 --- 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 111d5c22e..d529a8a8c 100644 --- 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 d7da78657..dbcbbae1f 100644 --- 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 549248da3..55e0b49aa 100644 --- 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 014488ab1..384cb3ddc 100644 --- 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 6a6094e23..f729f1937 100644 --- 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 7690f8175..56e776c83 100644 --- 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 8e68c24f6..91b685521 100644 --- 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 a6bb22c8a..dea12edc7 100644 --- 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 2e2aedc34..18772031e 100644 --- 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 1036fbbf3..cda863597 100644 --- 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 8bce0eec1..28233b6e7 100644 --- 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 796c2824f..185978977 100644 --- 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 a93a97ed0..f4bd7ad1d 100644 --- 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 8da33ca94..ca0d502f4 100644 --- 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 c1db92604..bed365b92 100644 --- 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 c709a686d..4c0667a03 100644 --- 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)) ;;;; 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)))) ;;;; 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 531cec085..9eb7d8900 100644 --- 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 dbe385ed6..7766f5a2b 100644 --- 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 82f355b66..f32822863 100644 --- 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 810d9e7ff..bc81606da 100644 --- 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 38ae03845..1adfcf49f 100644 --- 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 a8ec9732b..4ea0f632f 100644 --- 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 96e331a6e..dd6c903ef 100644 --- 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 bf22529eb..6fa0dcddb 100644 --- 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 36058b5f5..090cd2015 100644 --- 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"