1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- S Y S T E M . W C H _ S T W --
10 -- Copyright (C) 1992-2000 Free Software Foundation, Inc. --
12 -- GNAT is free software; you can redistribute it and/or modify it under --
13 -- terms of the GNU General Public License as published by the Free Soft- --
14 -- ware Foundation; either version 2, or (at your option) any later ver- --
15 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
16 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
17 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
18 -- for more details. You should have received a copy of the GNU General --
19 -- Public License distributed with GNAT; see file COPYING. If not, write --
20 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
21 -- MA 02111-1307, USA. --
23 -- As a special exception, if other files instantiate generics from this --
24 -- unit, or you link this unit with other files to produce an executable, --
25 -- this unit does not by itself cause the resulting executable to be --
26 -- covered by the GNU General Public License. This exception does not --
27 -- however invalidate any other reasons why the executable file might be --
28 -- covered by the GNU Public License. --
30 -- GNAT was originally developed by the GNAT team at New York University. --
31 -- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
33 ------------------------------------------------------------------------------
35 with Interfaces; use Interfaces;
36 with System.WCh_Con; use System.WCh_Con;
37 with System.WCh_JIS; use System.WCh_JIS;
39 package body System.WCh_StW is
41 ---------------------------
42 -- String_To_Wide_String --
43 ---------------------------
45 function String_To_Wide_String
47 EM : WC_Encoding_Method)
50 R : Wide_String (1 .. S'Length);
58 Last : constant Natural := S'Last;
60 function Get_Hex (C : Character) return Unsigned_16;
61 -- Converts character from hex digit to value in range 0-15. The
62 -- input must be in 0-9, A-F, or a-f, and no check is needed.
65 -- Translates four hex characters starting at S (SP) to a single
66 -- wide character. Used in WCEM_Hex and WCEM_Brackets mode. SP
67 -- is not modified by the call. The resulting wide character value
68 -- is stored in R (RP). RP is not modified by the call.
70 function Get_Hex (C : Character) return Unsigned_16 is
72 if C in '0' .. '9' then
73 return Character'Pos (C) - Character'Pos ('0');
74 elsif C in 'A' .. 'F' then
75 return Character'Pos (C) - Character'Pos ('A') + 10;
77 return Character'Pos (C) - Character'Pos ('a') + 10;
81 procedure Get_Hex_4 is
83 R (RP) := Wide_Character'Val (
84 Get_Hex (S (SP + 3)) + 16 *
85 (Get_Hex (S (SP + 2)) + 16 *
86 (Get_Hex (S (SP + 1)) + 16 *
87 (Get_Hex (S (SP + 0))))));
90 -- Start of processing for String_To_Wide_String
98 -- ESC-Hex representation
101 while SP <= Last - 4 loop
104 if S (SP) = ASCII.ESC then
109 R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
114 -- Upper bit shift, internal code = external code
120 if S (SP) >= Character'Val (16#80#) then
121 U1 := Character'Pos (S (SP));
122 U2 := Character'Pos (S (SP + 1));
123 R (RP) := Wide_Character'Val (256 * U1 + U2);
126 R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
131 -- Upper bit shift, shift-JIS
133 when WCEM_Shift_JIS =>
137 if S (SP) >= Character'Val (16#80#) then
138 R (RP) := Shift_JIS_To_JIS (S (SP), S (SP + 1));
141 R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
146 -- Upper bit shift, EUC
152 if S (SP) >= Character'Val (16#80#) then
153 R (RP) := EUC_To_JIS (S (SP), S (SP + 1));
156 R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
161 -- Upper bit shift, UTF-8
167 if S (SP) >= Character'Val (16#80#) then
168 U1 := Character'Pos (S (SP));
169 U2 := Character'Pos (S (SP + 1));
171 U := Shift_Left (U1 and 2#00011111#, 6) +
172 (U2 and 2#00111111#);
175 if U1 >= 2#11100000# then
176 U3 := Character'Pos (S (SP));
177 U := Shift_Left (U, 6) + (U3 and 2#00111111#);
181 R (RP) := Wide_Character'Val (U);
184 R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
189 -- Brackets representation
191 when WCEM_Brackets =>
192 while SP <= Last - 7 loop
196 and then S (SP + 1) = '"'
197 and then S (SP + 2) /= '"'
204 R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
211 while SP <= Last loop
213 R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
218 end String_To_Wide_String;