1------------------------------------------------------------------------------
2--                                                                          --
3--                            Matreshka Project                             --
4--                                                                          --
5--         Localization, Internationalization, Globalization for Ada        --
6--                                                                          --
7--                              Tools Component                             --
8--                                                                          --
9------------------------------------------------------------------------------
10--                                                                          --
11-- Copyright © 2010, Vadim Godunko <vgodunko@gmail.com>                     --
12-- All rights reserved.                                                     --
13--                                                                          --
14-- Redistribution and use in source and binary forms, with or without       --
15-- modification, are permitted provided that the following conditions       --
16-- are met:                                                                 --
17--                                                                          --
18--  * Redistributions of source code must retain the above copyright        --
19--    notice, this list of conditions and the following disclaimer.         --
20--                                                                          --
21--  * Redistributions in binary form must reproduce the above copyright     --
22--    notice, this list of conditions and the following disclaimer in the   --
23--    documentation and/or other materials provided with the distribution.  --
24--                                                                          --
25--  * Neither the name of the Vadim Godunko, IE nor the names of its        --
26--    contributors may be used to endorse or promote products derived from  --
27--    this software without specific prior written permission.              --
28--                                                                          --
29-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS      --
30-- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT        --
31-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR    --
32-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT     --
33-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,   --
34-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED --
35-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR   --
36-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF   --
37-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING     --
38-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS       --
39-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.             --
40--                                                                          --
41------------------------------------------------------------------------------
42--  $Revision: 1060 $ $Date: 2010-11-01 00:17:01 +0300 (Mon, 01 Nov 2010) $
43------------------------------------------------------------------------------
44--  This program generates tables for Shift JIS codec.
45with Ada.Command_Line;
46with Ada.Strings.Fixed;
47with Ada.Text_IO;
48
49procedure Gen_SHIFTJIS is
50
51   type Code_Unit_32 is mod 2**32;
52   type Code_Unit_16 is mod 2**16;
53   type Code_Unit_8 is mod 2**8;
54
55   type Code_Unit_32_Array is array (Code_Unit_8) of Code_Unit_32;
56   type Code_Unit_32_Array_Access is access all Code_Unit_32_Array;
57
58   type Expansion is record
59      First  : Code_Unit_32;
60      Second : Code_Unit_32;
61   end record;
62
63   function Image (Item : Code_Unit_8) return String;
64   function Image (Item : Code_Unit_32) return String;
65
66   -----------
67   -- Image --
68   -----------
69
70   function Image (Item : Code_Unit_8) return String is
71      Hex : constant array (Code_Unit_8 range 0 .. 15) of Character
72        := "0123456789ABCDEF";
73
74   begin
75      return Result : String (1 .. 2) do
76         Result (1) := Hex (Item / 16);
77         Result (2) := Hex (Item mod 16);
78      end return;
79   end Image;
80
81   -----------
82   -- Image --
83   -----------
84
85   function Image (Item : Code_Unit_32) return String is
86      Hex : constant array (Code_Unit_32 range 0 .. 15) of Character
87        := "0123456789ABCDEF";
88
89   begin
90      if Item <= 16#FFFF# then
91         return Result : String (1 .. 4) do
92            Result (1) := Hex (Item / 16 ** 3);
93            Result (2) := Hex ((Item / 16 ** 2) mod 16);
94            Result (3) := Hex ((Item / 16) mod 16);
95            Result (4) := Hex (Item mod 16);
96         end return;
97
98      else
99         return Result : String (1 .. 7) do
100            Result (1) := Hex (Item / 16 ** 5);
101            Result (2) := Hex ((Item / 16 ** 4) mod 16);
102            Result (3) := '_';
103            Result (4) := Hex ((Item / 16 ** 3) mod 16);
104            Result (5) := Hex ((Item / 16 ** 2) mod 16);
105            Result (6) := Hex ((Item / 16) mod 16);
106            Result (7) := Hex (Item mod 16);
107         end return;
108      end if;
109   end Image;
110
111   Undefined       : constant Code_Unit_32 := 16#FFFF_FFFF#;
112   Reserved        : constant Code_Unit_32 := 16#FFFF_FFFE#;
113   Double_Bytes    : constant Code_Unit_32 := 16#FFFF_FFFD#;
114   First_Expansion : constant Code_Unit_32 := 16#FFFF_FF00#;
115
116   File         : Ada.Text_IO.File_Type;
117   Buffer       : String (1 .. 256);
118   Last         : Natural;
119   First        : Positive;
120   Tab          : Natural;
121   Plus         : Natural;
122   Encoded_Code : Code_Unit_16;
123   Low_Code     : Code_Unit_8;
124   High_Code    : Code_Unit_8;
125   Unicode_Code : Code_Unit_32;
126
127   Single_Map     : array (Code_Unit_8) of Code_Unit_32
128     := (others => Undefined);
129   Double_Map     : array (Code_Unit_8) of Code_Unit_32_Array_Access;
130   Expansion_List :
131     array (First_Expansion .. First_Expansion + 32) of Expansion;
132   Last_Expansion : Code_Unit_32 := First_Expansion - 1;
133   Valid_Second   : array (Code_Unit_8) of Boolean := (others => False);
134
135begin
136   Ada.Text_IO.Open
137    (File, Ada.Text_IO.In_File, Ada.Command_Line.Argument (1));
138
139   while not Ada.Text_IO.End_Of_File (File) loop
140      Ada.Text_IO.Get_Line (File, Buffer, Last);
141
142      if Last /= 0 and Buffer (1) /= '#' then
143         First := Buffer'First;
144
145         Tab :=
146           Ada.Strings.Fixed.Index (Buffer (First .. Last), "" & ASCII.HT);
147         Encoded_Code :=
148           Code_Unit_16'Value ("16#" & Buffer (First + 2 .. Tab - 1) & '#');
149         Low_Code := Code_Unit_8 (Encoded_Code mod 256);
150         High_Code := Code_Unit_8 (Encoded_Code / 256);
151         First := Tab + 1;
152
153         Tab :=
154           Ada.Strings.Fixed.Index
155            (Buffer (First .. Last), "" & ASCII.HT);
156
157         if High_Code = 0 then
158            if First = Tab then
159               Single_Map (Low_Code) := Reserved;
160
161            else
162               Unicode_Code :=
163                 Code_Unit_32'Value
164                  ("16#" & Buffer (First + 2 .. Tab - 1) & '#');
165               Single_Map (Low_Code) := Unicode_Code;
166            end if;
167
168         else
169            if Double_Map (High_Code) = null then
170               Double_Map (High_Code) :=
171                 new Code_Unit_32_Array'(others => Undefined);
172               Single_Map (High_Code) := Double_Bytes;
173            end if;
174
175            if First = Tab then
176               Double_Map (High_Code) (Low_Code) := Reserved;
177
178            else
179               Plus :=
180                 Ada.Strings.Fixed.Index (Buffer (First + 2 .. Tab - 1), "+");
181
182               if Plus = 0 then
183                  Unicode_Code :=
184                    Code_Unit_32'Value
185                     ("16#" & Buffer (First + 2 .. Tab - 1) & '#');
186                  Double_Map (High_Code) (Low_Code) := Unicode_Code;
187
188               else
189                  Last_Expansion := Last_Expansion + 1;
190                  Expansion_List (Last_Expansion) :=
191                    (Code_Unit_32'Value
192                      ("16#" & Buffer (First + 2 .. Plus - 1) & '#'),
193                     Code_Unit_32'Value
194                      ("16#" & Buffer (Plus + 1 .. Tab - 1) & '#'));
195                  Double_Map (High_Code) (Low_Code) := Last_Expansion;
196               end if;
197            end if;
198         end if;
199      end if;
200   end loop;
201
202   Ada.Text_IO.Close (File);
203
204   --  Analysis
205
206   for J in Double_Map'Range loop
207      if Double_Map (J) /= null then
208         for K in Double_Map (J)'Range loop
209            if Double_Map (J) (K) /= Undefined then
210               Valid_Second (K) := True;
211            end if;
212         end loop;
213      end if;
214   end loop;
215
216   --  Generation
217
218   Ada.Text_IO.Put_Line
219    ("-----------------------------------------------------------------------"
220       & "-------");
221   Ada.Text_IO.Put_Line
222    ("--                                                                     "
223       & "     --");
224   Ada.Text_IO.Put_Line
225    ("--                            Matreshka Project                        "
226       & "     --");
227   Ada.Text_IO.Put_Line
228    ("--                                                                     "
229       & "     --");
230   Ada.Text_IO.Put_Line
231    ("--         Localization, Internationalization, Globalization for Ada   "
232       & "     --");
233   Ada.Text_IO.Put_Line
234    ("--                                                                     "
235       & "     --");
236   Ada.Text_IO.Put_Line
237    ("--                        Runtime Library Component                    "
238       & "     --");
239   Ada.Text_IO.Put_Line
240    ("--                                                                     "
241       & "     --");
242   Ada.Text_IO.Put_Line
243    ("-----------------------------------------------------------------------"
244       & "-------");
245   Ada.Text_IO.Put_Line
246    ("--                                                                     "
247       & "     --");
248   Ada.Text_IO.Put_Line
249    ("-- Copyright © 2010, Vadim Godunko <vgodunko@gmail.com>                "
250       & "     --");
251   Ada.Text_IO.Put_Line
252    ("-- All rights reserved.                                                "
253       & "     --");
254   Ada.Text_IO.Put_Line
255    ("--                                                                     "
256       & "     --");
257   Ada.Text_IO.Put_Line
258    ("-- Redistribution and use in source and binary forms, with or without  "
259       & "     --");
260   Ada.Text_IO.Put_Line
261    ("-- modification, are permitted provided that the following conditions  "
262       & "     --");
263   Ada.Text_IO.Put_Line
264    ("-- are met:                                                            "
265       & "     --");
266   Ada.Text_IO.Put_Line
267    ("--                                                                     "
268       & "     --");
269   Ada.Text_IO.Put_Line
270    ("--  * Redistributions of source code must retain the above copyright   "
271       & "     --");
272   Ada.Text_IO.Put_Line
273    ("--    notice, this list of conditions and the following disclaimer.    "
274       & "     --");
275   Ada.Text_IO.Put_Line
276    ("--                                                                     "
277       & "     --");
278   Ada.Text_IO.Put_Line
279    ("--  * Redistributions in binary form must reproduce the above copyright"
280       & "     --");
281   Ada.Text_IO.Put_Line
282    ("--    notice, this list of conditions and the following disclaimer in t"
283       & "he   --");
284   Ada.Text_IO.Put_Line
285    ("--    documentation and/or other materials provided with the distributi"
286       & "on.  --");
287   Ada.Text_IO.Put_Line
288    ("--                                                                     "
289       & "     --");
290   Ada.Text_IO.Put_Line
291    ("--  * Neither the name of the Vadim Godunko, IE nor the names of its   "
292       & "     --");
293   Ada.Text_IO.Put_Line
294    ("--    contributors may be used to endorse or promote products derived f"
295       & "rom  --");
296   Ada.Text_IO.Put_Line
297    ("--    this software without specific prior written permission.         "
298       & "     --");
299   Ada.Text_IO.Put_Line
300    ("--                                                                     "
301       & "     --");
302   Ada.Text_IO.Put_Line
303    ("-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "
304       & "     --");
305   Ada.Text_IO.Put_Line
306    ("-- ""AS IS"" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT "
307       & "       --");
308   Ada.Text_IO.Put_Line
309    ("-- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FO"
310       & "R    --");
311   Ada.Text_IO.Put_Line
312    ("-- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT"
313       & "     --");
314   Ada.Text_IO.Put_Line
315    ("-- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTA"
316       & "L,   --");
317   Ada.Text_IO.Put_Line
318    ("-- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIM"
319       & "ITED --");
320   Ada.Text_IO.Put_Line
321    ("-- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, "
322       & "OR   --");
323   Ada.Text_IO.Put_Line
324    ("-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY "
325       & "OF   --");
326   Ada.Text_IO.Put_Line
327    ("-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING"
328       & "     --");
329   Ada.Text_IO.Put_Line
330    ("-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS  "
331       & "     --");
332   Ada.Text_IO.Put_Line
333    ("-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.        "
334       & "     --");
335   Ada.Text_IO.Put_Line
336    ("--                                                                     "
337       & "     --");
338   Ada.Text_IO.Put_Line
339    ("-----------------------------------------------------------------------"
340       & "-------");
341   Ada.Text_IO.Put_Line
342    ("--  $Revision: 1060 $ $Date: 2010-11-01 00:17:01 +0300 (Mon, 01 Nov 2010) $");
343   Ada.Text_IO.Put_Line
344    ("-----------------------------------------------------------------------"
345       & "-------");
346   Ada.Text_IO.New_Line;
347   Ada.Text_IO.Put_Line
348    ("private package Matreshka.Internals.Text_Codecs.SHIFTJIS.Tables is");
349   Ada.Text_IO.New_Line;
350   Ada.Text_IO.Put_Line ("   pragma Preelaborate;");
351
352   --  Generate meta class table
353   --
354   --  0 - Single/Valid
355   --  1 - Single/Invalid
356   --  2 - First/Valid
357   --  3 - First/Invalid
358   --  4 - Invalid/Valid
359   --  5 - Invalid/Invalid
360
361   Ada.Text_IO.New_Line;
362   Ada.Text_IO.Put_Line ("   Meta_Class :");
363   Ada.Text_IO.Put_Line ("     constant array (Ada.Streams.Stream_Element)");
364   Ada.Text_IO.Put_Line ("       of SHIFTJIS_Meta_Class");
365   Ada.Text_IO.Put ("         := (");
366
367   for J in Single_Map'Range loop
368      if Single_Map (J) = Undefined or Single_Map (J) = Reserved then
369         if Valid_Second (J) then
370            Ada.Text_IO.Put ("4");
371
372         else
373            Ada.Text_IO.Put ("5");
374         end if;
375
376      elsif Single_Map (J) = Double_Bytes then
377         if Valid_Second (J) then
378            Ada.Text_IO.Put ("2");
379
380         else
381            Ada.Text_IO.Put ("3");
382         end if;
383
384      else
385         if Valid_Second (J) then
386            Ada.Text_IO.Put ("0");
387
388         else
389            Ada.Text_IO.Put ("1");
390         end if;
391      end if;
392
393      if J = 255 then
394         Ada.Text_IO.Put_Line (");");
395
396      elsif J mod 16 = 15 then
397         Ada.Text_IO.Put_Line (",");
398         Ada.Text_IO.Put ("             ");
399
400      else
401         Ada.Text_IO.Put (", ");
402      end if;
403   end loop;
404
405   --  Generate single byte conversion table
406
407   Ada.Text_IO.New_Line;
408   Ada.Text_IO.Put_Line ("   Decode_Single :");
409   Ada.Text_IO.Put_Line ("     constant array (Ada.Streams.Stream_Element)");
410   Ada.Text_IO.Put_Line ("       of Matreshka.Internals.Unicode.Code_Point");
411   Ada.Text_IO.Put ("         := (");
412
413   for J in Single_Map'Range loop
414      if Single_Map (J) = Undefined
415        or Single_Map (J) = Reserved
416        or Single_Map (J) = Double_Bytes
417      then
418         Ada.Text_IO.Put ("16#0000#");
419
420      else
421         Ada.Text_IO.Put ("16#" & Image (Single_Map (J)) & '#');
422      end if;
423
424      if J = 255 then
425         Ada.Text_IO.Put_Line (");");
426
427      elsif J mod 4 = 3 then
428         Ada.Text_IO.Put_Line (",");
429         Ada.Text_IO.Put ("             ");
430
431      else
432         Ada.Text_IO.Put (", ");
433      end if;
434   end loop;
435
436   --  Generate secondary tables for double byte conversion
437
438   Ada.Text_IO.New_Line;
439   Ada.Text_IO.Put_Line ("   Decode_Double_Invalid : aliased constant SHIFTJIS_Code_Point_Array");
440   Ada.Text_IO.Put_Line ("     := (16#0000#, 16#0000#, 16#0000#, 16#0000#,");
441   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
442   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
443   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
444   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
445   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
446   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
447   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
448   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
449   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
450   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
451   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
452   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
453   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
454   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
455   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
456   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
457   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
458   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
459   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
460   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
461   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
462   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
463   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
464   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
465   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
466   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
467   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
468   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
469   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
470   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
471   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
472   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
473   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
474   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
475   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
476   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
477   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
478   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
479   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
480   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
481   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
482   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
483   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
484   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
485   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
486   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
487   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
488   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
489   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
490   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
491   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
492   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
493   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
494   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
495   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
496   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
497   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
498   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
499   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
500   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
501   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
502   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#,");
503   Ada.Text_IO.Put_Line ("         16#0000#, 16#0000#, 16#0000#, 16#0000#);");
504
505   for J in Double_Map'Range loop
506      if Double_Map (J) /= null then
507         Ada.Text_IO.New_Line;
508         Ada.Text_IO.Put_Line
509          ("   Decode_Double_"
510             & Image (J)
511             & " : aliased constant SHIFTJIS_Code_Point_Array");
512         Ada.Text_IO.Put ("     := (");
513
514         for K in Double_Map (J)'Range loop
515            if Double_Map (J) (K) = Undefined
516              or Double_Map (J) (K) = Reserved
517            then
518               Ada.Text_IO.Put ("16#0000#");
519
520            elsif Double_Map (J) (K) >= First_Expansion then
521               Ada.Text_IO.Put
522                ("16#"
523                   & Image (Double_Map (J) (K) - First_Expansion + 1)
524                   & '#');
525
526            else
527               Ada.Text_IO.Put ("16#" & Image (Double_Map (J) (K)) & '#');
528            end if;
529
530            if K = 255 then
531               Ada.Text_IO.Put_Line (");");
532
533            elsif K mod 4 = 3 then
534               Ada.Text_IO.Put_Line (",");
535               Ada.Text_IO.Put ("         ");
536
537            else
538               Ada.Text_IO.Put (", ");
539            end if;
540         end loop;
541      end if;
542   end loop;
543
544   --  Generate double byte encoding table
545
546   Ada.Text_IO.New_Line;
547   Ada.Text_IO.Put_Line ("   Decode_Double :");
548   Ada.Text_IO.Put_Line ("     constant array (Ada.Streams.Stream_Element)");
549   Ada.Text_IO.Put_Line ("       of not null SHIFTJIS_Code_Point_Array_Access");
550   Ada.Text_IO.Put ("         := (");
551
552   for J in Double_Map'Range loop
553      if Double_Map (J) /= null then
554          Ada.Text_IO.Put ("Decode_Double_" & Image (J) & "'Access");
555
556      else
557          Ada.Text_IO.Put ("Decode_Double_Invalid'Access");
558      end if;
559
560      if J = 255 then
561         Ada.Text_IO.Put_Line (");");
562
563      elsif J mod 2 = 1 then
564         Ada.Text_IO.Put_Line (",");
565         Ada.Text_IO.Put ("             ");
566
567      else
568         Ada.Text_IO.Put (", ");
569      end if;
570   end loop;
571
572   --  Generate expansion table
573
574   Ada.Text_IO.New_Line;
575   Ada.Text_IO.Put_Line ("   Expansion :");
576   Ada.Text_IO.Put_Line
577    ("     constant array (Matreshka.Internals.Unicode.Code_Unit_32 range 1 .."
578       & Code_Unit_32'Image (Last_Expansion - First_Expansion + 1)
579       & ")");
580   Ada.Text_IO.Put_Line ("       of SHIFTJIS_Expansion_Pair");
581   Ada.Text_IO.Put ("         := (");
582
583   for J in First_Expansion .. Last_Expansion loop
584      Ada.Text_IO.Put
585       ("(16#"
586          & Image (Expansion_List (J).First)
587          & "#, 16#"
588          & Image (Expansion_List (J).Second)
589          & "#)");
590
591      if J = Last_Expansion then
592         Ada.Text_IO.Put_Line (");");
593
594      elsif J mod 2 = 1 then
595         Ada.Text_IO.Put_Line (",");
596         Ada.Text_IO.Put ("             ");
597
598      else
599         Ada.Text_IO.Put (", ");
600      end if;
601   end loop;
602
603   Ada.Text_IO.New_Line;
604   Ada.Text_IO.Put_Line
605    ("end Matreshka.Internals.Text_Codecs.SHIFTJIS.Tables;");
606end Gen_SHIFTJIS;
607