1 ------------------------------------------------------------------------------
3 -- GNAT RUNTIME COMPONENTS --
5 -- S Y S T E M . W C H _ S T W --
9 -- Copyright (C) 1992-2000 Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 2, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
17 -- for more details. You should have received a copy of the GNU General --
18 -- Public License distributed with GNAT; see file COPYING. If not, write --
19 -- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
20 -- MA 02111-1307, USA. --
22 -- As a special exception, if other files instantiate generics from this --
23 -- unit, or you link this unit with other files to produce an executable, --
24 -- this unit does not by itself cause the resulting executable to be --
25 -- covered by the GNU General Public License. This exception does not --
26 -- however invalidate any other reasons why the executable file might be --
27 -- covered by the GNU Public License. --
29 -- GNAT was originally developed by the GNAT team at New York University. --
30 -- Extensive contributions were provided by Ada Core Technologies Inc. --
32 ------------------------------------------------------------------------------
34 with Interfaces; use Interfaces;
35 with System.WCh_Con; use System.WCh_Con;
36 with System.WCh_JIS; use System.WCh_JIS;
38 package body System.WCh_StW is
40 ---------------------------
41 -- String_To_Wide_String --
42 ---------------------------
44 function String_To_Wide_String
46 EM : WC_Encoding_Method)
49 R : Wide_String (1 .. S'Length);
57 Last : constant Natural := S'Last;
59 function Get_Hex (C : Character) return Unsigned_16;
60 -- Converts character from hex digit to value in range 0-15. The
61 -- input must be in 0-9, A-F, or a-f, and no check is needed.
64 -- Translates four hex characters starting at S (SP) to a single
65 -- wide character. Used in WCEM_Hex and WCEM_Brackets mode. SP
66 -- is not modified by the call. The resulting wide character value
67 -- is stored in R (RP). RP is not modified by the call.
69 function Get_Hex (C : Character) return Unsigned_16 is
71 if C in '0' .. '9' then
72 return Character'Pos (C) - Character'Pos ('0');
73 elsif C in 'A' .. 'F' then
74 return Character'Pos (C) - Character'Pos ('A') + 10;
76 return Character'Pos (C) - Character'Pos ('a') + 10;
80 procedure Get_Hex_4 is
82 R (RP) := Wide_Character'Val (
83 Get_Hex (S (SP + 3)) + 16 *
84 (Get_Hex (S (SP + 2)) + 16 *
85 (Get_Hex (S (SP + 1)) + 16 *
86 (Get_Hex (S (SP + 0))))));
89 -- Start of processing for String_To_Wide_String
97 -- ESC-Hex representation
100 while SP <= Last - 4 loop
103 if S (SP) = ASCII.ESC then
108 R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
113 -- Upper bit shift, internal code = external code
119 if S (SP) >= Character'Val (16#80#) then
120 U1 := Character'Pos (S (SP));
121 U2 := Character'Pos (S (SP + 1));
122 R (RP) := Wide_Character'Val (256 * U1 + U2);
125 R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
130 -- Upper bit shift, shift-JIS
132 when WCEM_Shift_JIS =>
136 if S (SP) >= Character'Val (16#80#) then
137 R (RP) := Shift_JIS_To_JIS (S (SP), S (SP + 1));
140 R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
145 -- Upper bit shift, EUC
151 if S (SP) >= Character'Val (16#80#) then
152 R (RP) := EUC_To_JIS (S (SP), S (SP + 1));
155 R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
160 -- Upper bit shift, UTF-8
166 if S (SP) >= Character'Val (16#80#) then
167 U1 := Character'Pos (S (SP));
168 U2 := Character'Pos (S (SP + 1));
170 U := Shift_Left (U1 and 2#00011111#, 6) +
171 (U2 and 2#00111111#);
174 if U1 >= 2#11100000# then
175 U3 := Character'Pos (S (SP));
176 U := Shift_Left (U, 6) + (U3 and 2#00111111#);
180 R (RP) := Wide_Character'Val (U);
183 R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
188 -- Brackets representation
190 when WCEM_Brackets =>
191 while SP <= Last - 7 loop
195 and then S (SP + 1) = '"'
196 and then S (SP + 2) /= '"'
203 R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
210 while SP <= Last loop
212 R (RP) := Wide_Character'Val (Character'Pos (S (SP)));
217 end String_To_Wide_String;