/[cmucl]/src/hemlock/charmacs.lisp
ViewVC logotype

Contents of /src/hemlock/charmacs.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (hide annotations)
Fri Jun 19 13:27:30 2009 UTC (4 years, 10 months ago) by rtoy
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, post-merge-intl-branch, intl-branch-working-2010-02-19-1000, unicode-string-buffer-impl-base, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, sparc-tramp-assem-2010-07-19, amd64-dd-start, intl-2-branch-base, GIT-CONVERSION, cross-sol-x86-merged, intl-branch-working-2010-02-11-1000, RELEASE_20b, release-20a-base, cross-sol-x86-base, snapshot-2010-12, snapshot-2010-11, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, pre-merge-intl-branch, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, snapshot-2010-08, cross-sol-x86-2010-12-20, intl-branch-2010-03-18-1300, RELEASE_20a, release-20a-pre1, snapshot-2009-11, snapshot-2009-12, cross-sparc-branch-base, intl-branch-base, snapshot-2009-08, snapshot-2009-07, HEAD
Branch point for: cross-sparc-branch, RELEASE-20B-BRANCH, unicode-string-buffer-branch, sparc-tramp-assem-branch, RELEASE-20A-BRANCH, amd64-dd-branch, unicode-string-buffer-impl-branch, intl-branch, cross-sol-x86-branch, intl-2-branch
Changes since 1.4: +2 -2 lines
Change all references to char-code-limit to 256 when compiling on a
Unicode build.  This allows Hemlock to load and run but does not work
correctly with a Unicode build.  The display is wrong, among other
things.
1 ram 1.1 ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*-
2     ;;;
3     ;;; **********************************************************************
4 ram 1.3 ;;; This code was written as part of the CMU Common Lisp project at
5     ;;; Carnegie Mellon University, and has been placed in the public domain.
6     ;;;
7     (ext:file-comment
8 rtoy 1.5 "$Header: /tiger/var/lib/cvsroots/cmucl/src/hemlock/charmacs.lisp,v 1.5 2009/06/19 13:27:30 rtoy Rel $")
9 ram 1.3 ;;;
10 ram 1.1 ;;; **********************************************************************
11     ;;;
12     ;;; Implementation specific character-hacking macros and constants.
13     ;;;
14 ram 1.3 (in-package "HEMLOCK-INTERNALS")
15     (export ' (syntax-char-code-limit search-char-code-limit do-alpha-chars))
16 ram 1.1
17 ram 1.3 ;;; This file contains various constants and macros which are implementation or
18     ;;; ASCII dependant. It contains some versions of CHAR-CODE which do not check
19     ;;; types and ignore the top bit so that various structures can be allocated
20     ;;; 128 long instead of 256, and we don't get errors if a loser visits a binary
21     ;;; file.
22     ;;;
23     ;;; There are so many different constants and macros implemented the same.
24     ;;; This is to separate various mechanisms; for example, in principle the
25     ;;; char-code-limit for the syntax functions is independant of that for the
26     ;;; searching functions
27     ;;;
28 ram 1.1
29    
30 ram 1.2
31     ;;;; Stuff for the Syntax table functions (syntax)
32 ram 1.1
33 rtoy 1.5 (defconstant syntax-char-code-limit #-unicode char-code-limit #+unicode 256
34 ram 1.1 "The highest char-code which a character argument to the syntax
35     table functions may have.")
36 ram 1.3
37 ram 1.1 (defmacro syntax-char-code (char)
38     `(char-code ,char))
39    
40    
41     ;;;; Stuff used by the searching primitives (search)
42     ;;;
43     (defconstant search-char-code-limit 128
44     "The exclusive upper bound on significant char-codes for searching.")
45     (defmacro search-char-code (ch)
46 ram 1.3 `(logand (char-code ,ch) #x+7F))
47 ram 1.1 ;;;
48     ;;; search-hash-code must be a function with the following properties:
49     ;;; given any character it returns a number between 0 and
50     ;;; search-char-code-limit, and the same hash code must be returned
51     ;;; for the upper and lower case forms of each character.
52     ;;; In ASCII this is can be done by ANDing out the 5'th bit.
53     ;;;
54     (defmacro search-hash-code (ch)
55 ram 1.3 `(logand (char-code ,ch) #x+5F))
56 ram 1.1
57     ;;; Doesn't do anything special, but it should fast and not waste any time
58     ;;; checking type and whatnot.
59     (defmacro search-char-upcase (ch)
60 ram 1.3 `(char-upcase (the base-char ,ch)))
61 ram 1.1
62    
63 ram 1.2
64     ;;;; DO-ALPHA-CHARS.
65 ram 1.1
66     ;;; ALPHA-CHARS-LOOP loops from start-char through end-char binding var
67     ;;; to the alphabetic characters and executing body. Note that the manual
68     ;;; guarantees lower and upper case char codes to be separately in order,
69     ;;; but other characters may be interspersed within that ordering.
70     (defmacro alpha-chars-loop (var start-char end-char result body)
71     (let ((n (gensym))
72     (end-char-code (gensym)))
73     `(do ((,n (char-code ,start-char) (1+ ,n))
74     (,end-char-code (char-code ,end-char)))
75     ((> ,n ,end-char-code) ,result)
76     (let ((,var (code-char ,n)))
77     (when (alpha-char-p ,var)
78     ,@body)))))
79    
80     (defmacro do-alpha-chars ((var kind &optional result) &rest forms)
81     "(do-alpha-chars (var kind [result]) . body). Kind is one of
82     :lower, :upper, or :both, and var is bound to each character in
83     order as specified under character relations in the manual. When
84     :both is specified, lowercase letters are processed first."
85     (case kind
86     (:both
87     `(progn (alpha-chars-loop ,var #\a #\z nil ,forms)
88     (alpha-chars-loop ,var #\A #\Z ,result ,forms)))
89     (:lower
90     `(alpha-chars-loop ,var #\a #\z ,result ,forms))
91     (:upper
92     `(alpha-chars-loop ,var #\A #\Z ,result ,forms))
93     (t (error "Kind argument not one of :lower, :upper, or :both -- ~S."
94     kind))))

  ViewVC Help
Powered by ViewVC 1.1.5