From 8f28c28f64916758402f1b56c630766dc52c3cf6 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Tue, 16 Jun 2009 21:25:02 +0000 Subject: [PATCH] Cleanups for non-unicode build. code/stream.lisp: o Only define (setf stream-external-format) for Unicode builds. o In stream-external-format, don't try to look up the external format from the fd-stream structure, which doesn't exist in non-unicode builds. code/strings.lisp: o Conditionalize out things that will only work if unicode is available. tools/worldcom.lisp: o Only compile fd-stream-extfmt for unicode builds. --- code/stream.lisp | 4 +++- code/string.lisp | 12 +++++++++++- tools/worldcom.lisp | 9 +++++---- 3 files changed, 19 insertions(+), 6 deletions(-) diff --git a/code/stream.lisp b/code/stream.lisp index efc2ec92f..2ecd54c10 100644 --- a/code/stream.lisp +++ b/code/stream.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.84 2009/06/11 16:03:59 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/stream.lisp,v 1.85 2009/06/16 21:25:02 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -290,6 +290,7 @@ (stream::%stream-external-format stream) ;; lisp-stream (typecase stream + #+unicode (fd-stream (fd-stream-external-format stream)) (synonym-stream (stream-external-format (symbol-value (synonym-stream-symbol stream)))) @@ -297,6 +298,7 @@ ;; fundamental-stream :default)) +#+unicode (defun (setf stream-external-format) (extfmt stream) (declare (type stream stream)) (stream-dispatch stream diff --git a/code/string.lisp b/code/string.lisp index 107a51382..67aa4f74a 100644 --- a/code/string.lisp +++ b/code/string.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/string.lisp,v 1.14 2009/06/16 17:23:15 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/string.lisp,v 1.15 2009/06/16 21:25:02 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -109,6 +109,7 @@ (setf widep t))) (values codepoint widep))) +#+unicode (defun utf16-string-p (string) "Check if String is a valid UTF-16 string. If the string is valid, T is returned. If the string is not valid, NIL is returned, and the @@ -610,6 +611,7 @@ ;; Handle ASCII specially because this is called early in ;; initialization, before unidata is available. (cond ((< 96 code 123) (decf code 32)) + #+unicode ((> code 127) (setq code (unicode-upper code)))) ;;@@ WARNING: this may, in theory, need to extend newstring ;; but that never actually occurs as of Unicode 5.1.0, @@ -626,6 +628,7 @@ (setf (schar newstring new-index) (schar string index))) newstring)))) +#+unicode (defun string-upcase-full (string &key (start 0) end) (declare (fixnum start)) (let* ((string (if (stringp string) string (string string))) @@ -711,6 +714,7 @@ (setf (schar newstring new-index) (schar string index))) newstring)))) +#+unicode (defun string-downcase-full (string &key (start 0) end) (declare (fixnum start)) (let* ((string (if (stringp string) string (string string))) @@ -794,6 +798,7 @@ (setf (schar newstring new-index) (schar string index))) newstring)))) +#+unicode (defun string-capitalize-full (string &key (start 0) end) (declare (fixnum start)) (let* ((string (if (stringp string) string (string string))) @@ -869,6 +874,7 @@ ;; Handle ASCII specially because this is called early in ;; initialization, before unidata is available. (cond ((< 96 code 123) (decf code 32)) + #+unicode ((> code 127) (setq code (unicode-upper code)))) ;;@@ WARNING: this may, in theory, need to extend string ;; (which, obviously, we can't do here. Unless @@ -893,6 +899,7 @@ (multiple-value-bind (code wide) (codepoint string index) (declare (ignore wide)) (cond ((< 64 code 91) (incf code 32)) + #+unicode ((> code 127) (setq code (unicode-lower code)))) ;;@@ WARNING: this may, in theory, need to extend string ;; (which, obviously, we can't do here. Unless @@ -1080,6 +1087,8 @@ (subseq (the simple-string string) left-end right-end)))) ) ; non-unicode version +#+unicode +(progn (declaim (inline %glyph-f %glyph-b)) (defun %glyph-f (string index) (declare (optimize (speed 3) (space 0) (safety 0) (debug 0)) @@ -1112,6 +1121,7 @@ (setq prev d) (decf n (if (> c #xFFFF) 2 1)))) n)) +) ; unicode (defun glyph (string index &key (from-end nil)) "GLYPH returns the glyph at the indexed position in a string, and the diff --git a/tools/worldcom.lisp b/tools/worldcom.lisp index b9508c27e..562888412 100644 --- a/tools/worldcom.lisp +++ b/tools/worldcom.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldcom.lisp,v 1.100 2009/06/11 16:04:02 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/tools/worldcom.lisp,v 1.101 2009/06/16 21:25:02 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -208,8 +208,8 @@ (comf "target:compiler/proclaim") -#+unicode -(comf "target:code/unidata") +(when (c:backend-featurep :unicode) + (comf "target:code/unidata")) (comf "target:code/char") (comf "target:code/misc") (comf "target:code/extensions" :byte-compile t) @@ -245,7 +245,8 @@ (comf "target:code/extfmts") (comf "target:code/fd-stream") -(comf "target:code/fd-stream-extfmt") +(when (c:backend-featurep :unicode) + (comf "target:code/fd-stream-extfmt")) (comf "target:code/pathname") #-no-runtime (comf "target:code/pathname" :byte-compile t) (comf "target:code/filesys") -- GitLab