Changeset 7754 for branches


Ignore:
Timestamp:
Nov 26, 2007, 3:33:46 AM (17 years ago)
Author:
Gary Byers
Message:

Add :macintosh (MacOSRoman) character encoding.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/working-0711/ccl/level-1/l1-unicode.lisp

    r7624 r7754  
    360360;;; the break is at #x80 instead of #xa0).
    361361
    362 (defparameter *iso-8859-2-to-unicode*
     362(defstatic *iso-8859-2-to-unicode*
    363363  #(
    364364  ;; #xa0
    … …  
    382382))
    383383
    384 (defparameter *unicode-00a0-0180-to-iso-8859-2*
     384(defstatic *unicode-00a0-0180-to-iso-8859-2*
    385385  #(
    386386    #xa0 nil nil nil #xa4 nil nil #xa7 ; #xa0-#xa7
    … …  
    415415    ))
    416416
    417 (defparameter *unicode-00c0-00e0-to-iso-8859-2*
     417(defstatic *unicode-00c0-00e0-to-iso-8859-2*
    418418  #(
    419419    nil nil nil nil nil nil nil #xb7  ; #xc0-#xc7
    … …  
    527527  )
    528528
    529 (defparameter *iso-8859-3-to-unicode*
     529(defstatic *iso-8859-3-to-unicode*
    530530  #(
    531531    ;; #xa0
    … …  
    549549    ))
    550550
    551 (defparameter *unicode-a0-100-to-iso-8859-3*
     551(defstatic *unicode-a0-100-to-iso-8859-3*
    552552  #(
    553553    #xa0 nil nil #xa3 #xa4 nil nil #xa7 ; #xa0-#xa7
    … …  
    565565    ))
    566566
    567 (defparameter *unicode-108-180-to-iso-8859-3*
     567(defstatic *unicode-108-180-to-iso-8859-3*
    568568  #(
    569569    #xc6 #xe6 #xc5 #xe5 #x00 #x00 #x00 #x00 ; #x108-#x10f
    … …  
    584584    ))
    585585
    586 (defparameter *unicode-2d8-2e0-to-iso-8859-3*
     586(defstatic *unicode-2d8-2e0-to-iso-8859-3*
    587587  #(
    588588    #xa2 #xff nil nil nil nil nil nil   ; #x2d8-#x2df
    … …  
    707707
    708708
    709 (defparameter *iso-8859-4-to-unicode*
     709(defstatic *iso-8859-4-to-unicode*
    710710  #(
    711711    ;; #xa0
    … …  
    730730
    731731
    732 (defparameter *unicode-a0-180-to-iso-8859-4*
     732(defstatic *unicode-a0-180-to-iso-8859-4*
    733733  #(
    734734    #xa0 nil nil nil #xa4 nil nil #xa7  ; #xa0-#xa7
    … …  
    762762    ))
    763763
    764 (defparameter *unicode-2c0-2e0-to-iso-8859-4*
     764(defstatic *unicode-2c0-2e0-to-iso-8859-4*
    765765  #(
    766766    nil nil nil nil nil nil nil #xb7    ; #x2c0-#x2c7
    … …  
    878878  )
    879879
    880 (defparameter *iso-8859-5-to-unicode*
     880(defstatic *iso-8859-5-to-unicode*
    881881  #(
    882882    ;; #xa0
    … …  
    901901
    902902
    903 (defparameter *unicode-a0-b0-to-iso-8859-5*
     903(defstatic *unicode-a0-b0-to-iso-8859-5*
    904904  #(
    905905    #xa0 nil nil nil nil nil nil #xfd   ; #xa0-#xa7
    … …  
    907907    ))
    908908
    909 (defparameter *unicode-400-460-to-iso-8859-5*
     909(defstatic *unicode-400-460-to-iso-8859-5*
    910910  #(
    911911    nil #xa1 #xa2 #xa3 #xa4 #xa5 #xa6 #xa7 ; #x400-#x407
    … …  
    10301030  )
    10311031
    1032 (defparameter *iso-8859-6-to-unicode*
     1032(defstatic *iso-8859-6-to-unicode*
    10331033  #(
    10341034    ;; #xa0
    … …  
    10521052    ))
    10531053
    1054 (defparameter *unicode-a0-b0-to-iso-8859-6*
     1054(defstatic *unicode-a0-b0-to-iso-8859-6*
    10551055  #(
    10561056    0xa0 nil nil nil 0xa4 nil nil nil   ; #xa0-#xa7
    … …  
    10591059
    10601060
    1061 (defparameter *unicode-608-658-to-iso-8859-6*
     1061(defstatic *unicode-608-658-to-iso-8859-6*
    10621062  #(
    10631063    nil nil nil nil #xac nil nil nil    ; #x608-#x60f
    … …  
    11791179  )
    11801180
    1181 (defparameter *iso-8859-7-to-unicode*
     1181(defstatic *iso-8859-7-to-unicode*
    11821182  #(
    11831183    ;; #xa0
    … …  
    12011201    ))
    12021202
    1203 (defparameter *unicode-a0-c0-to-iso-8859-7*
     1203(defstatic *unicode-a0-c0-to-iso-8859-7*
    12041204  #(
    12051205    #xa0 nil nil #xa3 nil nil #xa6 #xa7 ; #xa0-#xa7
    … …  
    12091209    ))
    12101210
    1211 (defparameter *unicode-378-3d0-to-iso-8859-7*
     1211(defstatic *unicode-378-3d0-to-iso-8859-7*
    12121212  #(
    12131213    nil nil #xaa nil nil nil nil nil    ; #x378-#x37f
    … …  
    12241224    ))
    12251225
    1226 (defparameter *unicode-2010-2020-to-iso-8859-7*
     1226(defstatic *unicode-2010-2020-to-iso-8859-7*
    12271227  #(
    12281228    nil nil nil nil nil #xaf nil nil    ; #x2010-#x2017
    … …  
    12301230    ))
    12311231
    1232 (defparameter *unicode-20ac-20b0-to-iso-8859-7*
     1232(defstatic *unicode-20ac-20b0-to-iso-8859-7*
    12331233  #(
    12341234    #xa4 nil nil #xa5
    … …  
    13591359  )
    13601360
    1361 (defparameter *iso-8859-8-to-unicode*
     1361(defstatic *iso-8859-8-to-unicode*
    13621362  #(
    13631363    ;; #xa0
    … …  
    13811381    ))
    13821382
    1383 (defparameter *unicode-a0-f8-to-iso-8859-8*
     1383(defstatic *unicode-a0-f8-to-iso-8859-8*
    13841384  #(
    13851385    #xa0 nil #xa2 #xa3 #xa4 #xa5 #xa6 #xa7 ; #xa0-#xa7
    … …  
    13961396    ))
    13971397
    1398 (defparameter *unicode-5d0-5f0-to-iso-8859-8*
     1398(defstatic *unicode-5d0-5f0-to-iso-8859-8*
    13991399  #(
    14001400    #xe0 #xe1 #xe2 #xe3 #xe4 #xe5 #xe6 #xe7 ; #x5d0-#x5d7
    … …  
    14041404    ))
    14051405
    1406 (defparameter *unicode-2008-2018-to-iso-8859-8*
     1406(defstatic *unicode-2008-2018-to-iso-8859-8*
    14071407  #(
    14081408    nil nil nil nil nil nil #xfd #xfe   ; #x2008-#x200f
    … …  
    15251525  )
    15261526
    1527 (defparameter *iso-8859-9-to-unicode*
     1527(defstatic *iso-8859-9-to-unicode*
    15281528  #(
    15291529    ;; #xd0
    … …  
    15381538    ))
    15391539
    1540 (defparameter *unicode-d0-100-to-iso-8859-9*
     1540(defstatic *unicode-d0-100-to-iso-8859-9*
    15411541  #(
    15421542    nil #xd1 #xd2 #xd3 #xd4 #xd5 #xd6 #xd7 ; #xd0-#xd7
    … …  
    15481548    ))
    15491549
    1550 (defparameter *unicode-118-160-to-iso-8859-9*
     1550(defstatic *unicode-118-160-to-iso-8859-9*
    15511551  #(
    15521552    nil nil nil nil nil nil #xd0 #xf0   ; #x118-#x11f
    … …  
    16681668  )
    16691669
    1670 (defparameter *iso-8859-10-to-unicode*
     1670(defstatic *iso-8859-10-to-unicode*
    16711671  #(
    16721672    ;; #xa0
    … …  
    16901690    ))
    16911691
    1692 (defparameter *unicode-a0-180-to-iso-8859-10*
     1692(defstatic *unicode-a0-180-to-iso-8859-10*
    16931693  #(
    16941694    #xa0 nil nil nil nil nil nil #xa7   ; #xa0-#xa7
    … …  
    19301930;;; There is no iso-8859-12 encoding.
    19311931
    1932 (defparameter *iso-8859-13-to-unicode*
     1932(defstatic *iso-8859-13-to-unicode*
    19331933  #(
    19341934    ;; #xa0
    … …  
    19521952    ))
    19531953
    1954 (defparameter *unicode-a0-180-to-iso-8859-13*
     1954(defstatic *unicode-a0-180-to-iso-8859-13*
    19551955  #(
    19561956    #xa0 nil #xa2 #xa3 #xa4 nil #xa6 #xa7 ; #xa0-#xa7
    … …  
    19841984    ))
    19851985
    1986 (defparameter *unicode-2018-2020-to-iso-8859-13*
     1986(defstatic *unicode-2018-2020-to-iso-8859-13*
    19871987  #(
    19881988    nil #xff nil nil #xb4 #xa1 #xa5 nil ; #x2018-#x201f */
    … …  
    20982098  )
    20992099
    2100 (defparameter *iso-8859-14-to-unicode*
     2100(defstatic *iso-8859-14-to-unicode*
    21012101  #(
    21022102    ;; #xa0
    … …  
    21202120    ))
    21212121
    2122 (defparameter *unicode-a0-100-to-iso-8859-14*
     2122(defstatic *unicode-a0-100-to-iso-8859-14*
    21232123  #(
    21242124    #xa0 nil nil #xa3 nil nil nil #xa7  ; #xa0-#xa7
    … …  
    21362136    ))
    21372137
    2138 (defparameter *unicode-108-128-to-iso-8859-14*
     2138(defstatic *unicode-108-128-to-iso-8859-14*
    21392139  #(
    21402140    nil nil #xa4 #xa5 nil nil nil nil   ; #x108-#x10f
    … …  
    21442144    ))
    21452145
    2146 (defparameter *unicode-170-180-to-iso-8859-14*
     2146(defstatic *unicode-170-180-to-iso-8859-14*
    21472147  #(
    21482148    nil nil nil nil #xd0 #xf0 #xde #xfe ; #x170-#x177
    … …  
    21502150    ))   
    21512151
    2152 (defparameter *unicode-1e00-1e88-to-iso-8859-14*
     2152(defstatic *unicode-1e00-1e88-to-iso-8859-14*
    21532153  #(
    21542154    nil nil #xa1 #xa2 nil nil nil nil   ; #x1e00-#x1e07
    … …  
    21712171    ))
    21722172
    2173 (defparameter *unicode-1ef0-1ef8-to-iso-8859-14*
     2173(defstatic *unicode-1ef0-1ef8-to-iso-8859-14*
    21742174  #(
    21752175    nil nil #xac #xbc nil nil nil nil   ; #x1ef0-#x1ef7
    … …  
    23072307  )
    23082308
    2309 (defparameter *iso-8859-15-to-unicode*
     2309(defstatic *iso-8859-15-to-unicode*
    23102310  #(
    23112311    ;; #xa0
    … …  
    23332333    ))
    23342334
    2335 (defparameter *unicode-a0-100-to-iso-8859-15*
     2335(defstatic *unicode-a0-100-to-iso-8859-15*
    23362336  #(
    23372337    #xa0 #xa1 #xa2 #xa3 nil #xa5 nil #xa7 ; #xa0-#xa7
    … …  
    23492349    ))
    23502350
    2351 (defparameter *unicode-150-180-to-iso-8859-15*
     2351(defstatic *unicode-150-180-to-iso-8859-15*
    23522352  #(
    23532353    nil nil #xbc #xbd nil nil nil nil   ; #x150-#x157
    … …  
    24672467  )
    24682468
    2469 (defparameter *iso-8859-16-to-unicode*
     2469(defstatic *iso-8859-16-to-unicode*
    24702470  #(
    24712471    ;; #xa0
    … …  
    24892489    ))
    24902490
    2491 (defparameter *unicode-a0-180-to-iso-8859-16*
     2491(defstatic *unicode-a0-180-to-iso-8859-16*
    24922492  #(
    24932493    #xa0 nil nil nil nil nil nil #xa7   ; #xa0-#xa7
    … …  
    25212521    ))
    25222522
    2523 (defparameter *unicode-218-220-to-iso-8859-16*
     2523(defstatic *unicode-218-220-to-iso-8859-16*
    25242524  #(
    25252525    #xaa #xba #xde #xfe nil nil nil nil ; #x218-#x21f
    25262526    ))
    25272527
    2528 (defparameter *unicode-2018-2020-to-iso-8859-16*
     2528(defstatic *unicode-2018-2020-to-iso-8859-16*
    25292529  #(
    25302530    nil nil nil nil nil #xb5 #xa5 nil   ; #x2018-#x201f
    … …  
    26482648  )
    26492649
     2650(defstatic *macintosh-to-unicode*
     2651  #(
     2652    ;; #x80
     2653    #\u+00c4 #\u+00c5 #\u+00c7 #\u+00c9 #\u+00d1 #\u+00d6 #\u+00dc #\u+00e1
     2654    #\u+00e0 #\u+00e2 #\u+00e4 #\u+00e3 #\u+00e5 #\u+00e7 #\u+00e9 #\u+00e8
     2655    ;; #x90
     2656    #\u+00ea #\u+00eb #\u+00ed #\u+00ec #\u+00ee #\u+00ef #\u+00f1 #\u+00f3
     2657    #\u+00f2 #\u+00f4 #\u+00f6 #\u+00f5 #\u+00fa #\u+00f9 #\u+00fb #\u+00fc
     2658    ;; #xa0
     2659    #\u+2020 #\u+00b0 #\u+00a2 #\u+00a3 #\u+00a7 #\u+2022 #\u+00b6 #\u+00df
     2660    #\u+00ae #\u+00a9 #\u+2122 #\u+00b4 #\u+00a8 #\u+2260 #\u+00c6 #\u+00d8
     2661    ;; #xb0
     2662    #\u+221e #\u+00b1 #\u+2264 #\u+2265 #\u+00a5 #\u+00b5 #\u+2202 #\u+2211
     2663    #\u+220f #\u+03c0 #\u+222b #\u+00aa #\u+00ba #\u+2126 #\u+00e6 #\u+00f8
     2664    ;; #xc0
     2665    #\u+00bf #\u+00a1 #\u+00ac #\u+221a #\u+0192 #\u+2248 #\u+2206 #\u+00ab
     2666    #\u+00bb #\u+2026 #\u+00a0 #\u+00c0 #\u+00c3 #\u+00d5 #\u+0152 #\u+0153
     2667    ;; #xd0
     2668    #\u+2013 #\u+2014 #\u+201c #\u+201d #\u+2018 #\u+2019 #\u+00f7 #\u+25ca
     2669    #\u+00ff #\u+0178 #\u+2044 #\u+00a4 #\u+2039 #\u+203a #\u+fb01 #\u+fb02
     2670    ;; #xe0
     2671    #\u+2021 #\u+00b7 #\u+201a #\u+201e #\u+2030 #\u+00c2 #\u+00ca #\u+00c1
     2672    #\u+00cb #\u+00c8 #\u+00cd #\u+00ce #\u+00cf #\u+00cc #\u+00d3 #\u+00d4
     2673    ;; #xf0
     2674    #\u+f8ff #\u+00d2 #\u+00da #\u+00db #\u+00d9 #\u+0131 #\u+02c6 #\u+02dc
     2675    #\u+00af #\u+02d8 #\u+02d9 #\u+02da #\u+00b8 #\u+02dd #\u+02db #\u+02c7
     2676    ))
     2677
     2678
     2679(defstatic *unicode-a0-100-to-macintosh*
     2680  #(
     2681    #xca #xc1 #xa2 #xa3 #xdb #xb4 nil #xa4 ; #xa0-#xa7
     2682    #xac #xa9 #xbb #xc7 #xc2 nil #xa8 #xf8 ; #xa8-#xaf
     2683    #xa1 #xb1 nil nil #xab #xb5 #xa6 #xe1 ; #xb0-#xb7
     2684    #xfc nil #xbc #xc8 nil nil nil #xc0 ; #xb8-#xbf
     2685    #xcb #xe7 #xe5 #xcc #x80 #x81 #xae #x82 ; #xc0-#xc7
     2686    #xe9 #x83 #xe6 #xe8 #xed #xea #xeb #xec ; #xc8-#xcf
     2687    nil #x84 #xf1 #xee #xef #xcd #x85 nil ; #xd0-#xd7
     2688    #xaf #xf4 #xf2 #xf3 #x86 nil nil #xa7 ; #xd8-#xdf
     2689    #x88 #x87 #x89 #x8b #x8a #x8c #xbe #x8d ; #xe0-#xe7
     2690    #x8f #x8e #x90 #x91 #x93 #x92 #x94 #x95 ; #xe8-#xef
     2691    nil #x96 #x98 #x97 #x99 #x9b #x9a #xd6 ; #xf0-#xf7
     2692    #xbf #x9d #x9c #x9e #x9f nil nil #xd8 ; #xf8-#xff
     2693    ))
     2694
     2695(defstatic *unicode-130-198-to-macintosh*
     2696  #(
     2697    nil #xf5 nil nil nil nil nil nil ; #x130-#x137
     2698    nil nil nil nil nil nil nil nil ; #x138-#x13f
     2699    nil nil nil nil nil nil nil nil ; #x140-#x147
     2700    nil nil nil nil nil nil nil nil ; #x148-#x14f
     2701    nil nil #xce #xcf nil nil nil nil ; #x150-#x157
     2702    nil nil nil nil nil nil nil nil ; #x158-#x15f
     2703    nil nil nil nil nil nil nil nil ; #x160-#x167
     2704    nil nil nil nil nil nil nil nil ; #x168-#x16f
     2705    nil nil nil nil nil nil nil nil ; #x170-#x177
     2706    #xd9 nil nil nil nil nil nil nil ; #x178-#x17f
     2707    nil nil nil nil nil nil nil nil ; #x180-#x187
     2708    nil nil nil nil nil nil nil nil ; #x188-#x18f
     2709    nil nil #xc4 nil nil nil nil nil ; #x190-#x197
     2710    ))
     2711
     2712(defstatic *unicode-2c0-2e0-to-macintosh*
     2713  #(
     2714    nil nil nil nil nil nil #xf6 #xff   ; #x2c0-#x2c7
     2715    nil nil nil nil nil nil nil nil     ; #x2c8-#x2cf
     2716    nil nil nil nil nil nil nil nil     ; #x2d0-#x2d7
     2717    #xf9 #xfa #xfb #xfe #xf7 #xfd nil nil ; #x2d8-#x2df
     2718    ))
     2719
     2720(defstatic *unicode-2010-2048-to-macintosh*
     2721  #(
     2722  nil nil nil #xd0 #xd1 nil nil nil ; #x2010-#x2017
     2723  #xd4 #xd5 #xe2 nil #xd2 #xd3 #xe3 nil ; #x2018-#x201f
     2724  #xa0 #xe0 #xa5 nil nil nil #xc9 nil ; #x2020-#x2027
     2725  nil nil nil nil nil nil nil nil ; #x2028-#x202f
     2726  #xe4 nil nil nil nil nil nil nil ; #x2030-#x2037
     2727  nil #xdc #xdd nil nil nil nil nil ; #x2038-#x203f
     2728  nil nil nil nil #xda nil nil nil ; #x2040-#x2047
     2729    ))
     2730
     2731(defstatic *unicode-2120-2128-to-macintosh*
     2732  #(
     2733    nil nil #xaa nil nil nil #xbd nil   ; #x2120-#x2127
     2734    ))
     2735
     2736(defstatic *unicode-2200-2268-to-macintosh*
     2737  #(
     2738    nil nil #xb6 nil nil nil #xc6 nil   ; #x2200-#x2207
     2739    nil nil nil nil nil nil nil #xb8    ; #x2208-#x220f
     2740    nil #xb7 nil nil nil nil nil nil    ; #x2210-#x2217
     2741    nil nil #xc3 nil nil nil #xb0 nil   ; #x2218-#x221f
     2742    nil nil nil nil nil nil nil nil     ; #x2220-#x2227
     2743    nil nil nil #xba nil nil nil nil    ; #x2228-#x222f
     2744    nil nil nil nil nil nil nil nil     ; #x2230-#x2237
     2745    nil nil nil nil nil nil nil nil     ; #x2238-#x223f
     2746    nil nil nil nil nil nil nil nil     ; #x2240-#x2247
     2747    #xc5 nil nil nil nil nil nil nil    ; #x2248-#x224f
     2748    nil nil nil nil nil nil nil nil     ; #x2250-#x2257
     2749    nil nil nil nil nil nil nil nil     ; #x2258-#x225f
     2750    #xad nil nil nil #xb2 #xb3 nil nil  ; #x2260-#x2267
     2751    ))
     2752
     2753(defstatic *unicode-fb00-fb08-to-macintosh*
     2754  #(
     2755    nil #xde #xdf nil nil nil nil nil ; #xfb00-#xfb07
     2756    ))
     2757
     2758(define-character-encoding :macintosh
     2759    "An 8-bit, fixed-width character encoding in which codes #x00-#x7f
     2760map to their Unicode equivalents and other codes map to other Unicode
     2761character values.  Traditionally used on Classic MacOS to encode characters
     2762used in western languages."
     2763  :aliases '(:macos-roman :macosroman :mac-roman :macroman)
     2764
     2765  :stream-encode-function
     2766  (nfunction
     2767   macintosh-stream-encode
     2768   (lambda (char write-function stream)
     2769     (let* ((code (char-code char))
     2770            (c2 (cond ((< code #x80) code)
     2771                      ((and (>= code #xa0) (< code #x100)
     2772                       (svref *unicode-a0-100-to-macintosh*
     2773                              (the fixnum (- code #xa0)))))
     2774                      ((and (>= code #x130) (< code #x198))
     2775                       (svref *unicode-130-198-to-macintosh*
     2776                              (the fixnum (- code #x130))))
     2777                      ((and (>= code #x2c0) (< code #x2e0))
     2778                       (svref *unicode-2c0-2e0-to-macintosh*
     2779                              (the fixnum (- code #x2c0))))
     2780                      ((= code #x3c0) #xb9)
     2781                      ((and (>= code #x2010) (< code #x2048))
     2782                       (svref *unicode-2010-2048-to-macintosh*
     2783                              (the fixnum (- code #x2010))))
     2784                      ((and (>= code #x2120) (< code #x2128))
     2785                       (svref *unicode-2120-2128-to-macintosh*
     2786                              (the fixnum (- code #x2120))))
     2787                      ((and (>= code #x2200) (< code #x2268))
     2788                       (svref *unicode-2200-2268-to-macintosh*
     2789                              (the fixnum (- code #x2200))))
     2790                      ((= code #x25ca) #xd7)
     2791                      ((and (>= code #xfb00) (< code #xfb08))
     2792                       (svref *unicode-fb00-fb08-to-macintosh*
     2793                              (the fixnum (- code #xfb00))))
     2794                      ((= code #xf8ff) #xf0))))
     2795       (declare (type (mod #x110000) code))
     2796       (funcall write-function stream (or c2 (char-code #\Sub)))
     2797       1)))
     2798  :stream-decode-function
     2799  (nfunction
     2800   macintosh-stream-decode
     2801   (lambda (1st-unit next-unit-function stream)
     2802     (declare (ignore next-unit-function stream)
     2803              (type (unsigned-byte 8) 1st-unit))
     2804     (if (< 1st-unit #x80)
     2805       (code-char 1st-unit)
     2806       (svref *macintosh-to-unicode* (the fixnum (- 1st-unit #x80))))))
     2807  :vector-encode-function
     2808  (nfunction
     2809   macintosh-vector-encode
     2810   (lambda (string vector idx start end)
     2811     (declare (type (simple-array (unsigned-byte 8) (*)) vector)
     2812              (fixnum idx))
     2813     (do* ((i start (1+ i)))
     2814          ((>= i end) idx)
     2815       (let* ((char (schar string i))
     2816              (code (char-code char))
     2817            (c2 (cond ((< code #x80) code)
     2818                      ((and (>= code #xa0) (< code #x100)
     2819                       (svref *unicode-a0-100-to-macintosh*
     2820                              (the fixnum (- code #xa0)))))
     2821                      ((and (>= code #x130) (< code #x198))
     2822                       (svref *unicode-130-198-to-macintosh*
     2823                              (the fixnum (- code #x130))))
     2824                      ((and (>= code #x2c0) (< code #x2e0))
     2825                       (svref *unicode-2c0-2e0-to-macintosh*
     2826                              (the fixnum (- code #x2c0))))
     2827                      ((= code #x3c0) #xb9)
     2828                      ((and (>= code #x2010) (< code #x2048))
     2829                       (svref *unicode-2010-2048-to-macintosh*
     2830                              (the fixnum (- code #x2010))))
     2831                      ((and (>= code #x2120) (< code #x2128))
     2832                       (svref *unicode-2120-2128-to-macintosh*
     2833                              (the fixnum (- code #x2120))))
     2834                      ((and (>= code #x2200) (< code #x2268))
     2835                       (svref *unicode-2200-2268-to-macintosh*
     2836                              (the fixnum (- code #x2200))))
     2837                      ((= code #x25ca) #xd7)
     2838                      ((and (>= code #xfb00) (< code #xfb08))
     2839                       (svref *unicode-fb00-fb08-to-macintosh*
     2840                              (the fixnum (- code #xfb00))))
     2841                      ((= code #xf8ff) #xf0))))
     2842         (declare (type (mod #x110000) code))
     2843         (setf (aref vector idx) (or c2 (char-code #\Sub)))
     2844         (incf idx)))))
     2845  :vector-decode-function
     2846  (nfunction
     2847   macintosh-vector-decode
     2848   (lambda (vector idx noctets string)
     2849     (declare (type (simple-array (unsigned-byte 8) (*)) vector))
     2850     (do* ((i 0 (1+ i))
     2851           (index idx (1+ index)))
     2852          ((>= i noctets) index)
     2853       (let* ((1st-unit (aref vector index)))
     2854         (declare (type (unsigned-byte 8) 1st-unit))
     2855         (setf (schar string i)
     2856               (if (< 1st-unit #x80)
     2857                 (code-char 1st-unit)
     2858                 (svref *macintosh-to-unicode* (the fixnum (- 1st-unit #x80)))))))))
     2859  :memory-encode-function
     2860  (nfunction
     2861   macintosh-memory-encode
     2862   (lambda (string pointer idx start end)
     2863     (do* ((i start (1+ i)))
     2864          ((>= i end) idx)
     2865       (let* ((code (char-code (schar string i)))
     2866            (c2 (cond ((< code #x80) code)
     2867                      ((and (>= code #xa0) (< code #x100)
     2868                       (svref *unicode-a0-100-to-macintosh*
     2869                              (the fixnum (- code #xa0)))))
     2870                      ((and (>= code #x130) (< code #x198))
     2871                       (svref *unicode-130-198-to-macintosh*
     2872                              (the fixnum (- code #x130))))
     2873                      ((and (>= code #x2c0) (< code #x2e0))
     2874                       (svref *unicode-2c0-2e0-to-macintosh*
     2875                              (the fixnum (- code #x2c0))))
     2876                      ((= code #x3c0) #xb9)
     2877                      ((and (>= code #x2010) (< code #x2048))
     2878                       (svref *unicode-2010-2048-to-macintosh*
     2879                              (the fixnum (- code #x2010))))
     2880                      ((and (>= code #x2120) (< code #x2128))
     2881                       (svref *unicode-2120-2128-to-macintosh*
     2882                              (the fixnum (- code #x2120))))
     2883                      ((and (>= code #x2200) (< code #x2268))
     2884                       (svref *unicode-2200-2268-to-macintosh*
     2885                              (the fixnum (- code #x2200))))
     2886                      ((= code #x25ca) #xd7)
     2887                      ((and (>= code #xfb00) (< code #xfb08))
     2888                       (svref *unicode-fb00-fb08-to-macintosh*
     2889                              (the fixnum (- code #xfb00))))
     2890                      ((= code #xf8ff) #xf0))))
     2891         (declare (type (mod #x110000) code))
     2892         (setf (%get-unsigned-byte pointer idx) (or c2 (char-code #\Sub)))
     2893         (incf idx)))))
     2894  :memory-decode-function
     2895  (nfunction
     2896   macintosh--memory-decode
     2897   (lambda (pointer noctets idx string)
     2898     (do* ((i 0 (1+ i))
     2899           (index idx (1+ index)))
     2900          ((>= i noctets) index)
     2901       (let* ((1st-unit (%get-unsigned-byte pointer index)))
     2902         (declare (type (unsigned-byte 8) 1st-unit))
     2903         (setf (schar string i)
     2904               (if (< 1st-unit #x80)
     2905                 (code-char 1st-unit)
     2906                 (svref *macintosh-to-unicode* (the fixnum (- 1st-unit #xa0)))))))))
     2907  :octets-in-string-function
     2908  #'8-bit-fixed-width-octets-in-string
     2909  :length-of-vector-encoding-function
     2910  #'8-bit-fixed-width-length-of-vector-encoding
     2911  :length-of-memory-encoding-function
     2912  #'8-bit-fixed-width-length-of-memory-encoding
     2913  :decode-literal-code-unit-limit #x80
     2914  :encode-literal-char-code-limit #x80 
     2915  )
    26502916
    26512917;;; UTF-8.  Decoding checks for malformed sequences; it might be faster (and
Note: See TracChangeset for help on using the changeset viewer.