Hacker/Hacker.iso/HACKER/DECOMP/DECAF/cp-utf8.adb

Text File | 1996-09-19 | 10.7 KB | 292 lines

--
-- Copyright (C) 1996 Ada Resource Association (ARA), Columbus, Ohio.
-- Author: Gilles Demailly
--
--
-- Permission to use, copy, modify, and distribute this software and its
-- documentation for any purpose and without fee is hereby granted,
-- provided that the above copyright and authorship notice appear in all
-- copies and that both that copyright notice and this permission notice
-- appear in supporting documentation.
--
-- The ARA makes no representations about the suitability of this software
-- for any purpose.  It is provided "as is" without express
-- or implied warranty.
--

with Ada.Text_Io;
with Ada.Unchecked_Conversion;
with Ada.Characters.Handling;

package body CP.Utf8 is

   use Byte_Utilities;
   use Ada.Strings.Wide_Unbounded;

   -- Limit value for a character represented by a single byte
   C_One_Byte : constant Unsigned_8 := 2#10000000#;

   -- Limit value for a character represented by two bytes or three bytes
   -- (under : two bytes, over : three bytes)
   C_Two_Bytes : constant Unsigned_8 := 2#11100000#;

   E_Bad_String : exception;

   -- Utf8 characters are represented in decaf as Wide_Characters
   -- instanciation of the conversion between Unsigned_16 and Wide_Character
   function To_Wide is new Ada.Unchecked_Conversion
                              (Unsigned_16, Wide_Character);



   procedure Decode_String (Some_Info : access Utf8) is
      Index  : Unsigned_32 := 1;
      Answer : Wide_String (1..Natural(Some_Info.Length));
      Length : Natural := 0;
   begin
      while Index <= Unsigned_32 (Some_Info.Length) loop
         Length := Length + 1;
         if Some_Info.bytes (Index) < C_One_Byte then
            -- character represented by a single byte
            -- conversion from a byte to a character
            Answer (Length) := To_Wide (Unsigned_16 (Some_Info.bytes (Index)));
            Index := Index + 1;
         elsif Some_Info.bytes (Index) < C_Two_Bytes then
            -- character represented by two bytes
            Answer (Length) := '?';
            Ada.Text_Io.Put_Line
               ("Warning : this version does not handle characters stored on multiple bytes.");
            Ada.Text_Io.Put_Line
               ("          no test has been conducted with multiple bytes characters.");
            Ada.Text_Io.Put_Line
               ("          proceeding ...");
            Index := Index + 2;
         else
            -- character represented by three bytes
            Answer (Length) := '?';
            Ada.Text_Io.Put_Line
               ("Warning : this version does not handle characters stored on multiple bytes.");
            Ada.Text_Io.Put_Line
               ("          no test has been conducted with multiple bytes characters.");
            Ada.Text_Io.Put_Line
               ("          proceeding ...");
            Index := Index + 3;
         end if;

      end loop;

      -- stores the String
      Some_Info.Contents := To_Unbounded_Wide_String (Answer (1..Length));
   end Decode_String;

   procedure Decode (From_File : Byte_Utilities.File_Type;
                     Some_Info : access Utf8) is
   begin
      Some_Info.Tag := C_Class_Tag;

      -- Reads the String length
      Read (From_File, Some_Info.Length);

      -- byte array allocation
      Some_Info.bytes := new Bytes (1..Unsigned_32(Some_Info.Length));

      -- Reads the bytes
      for I in 1..Unsigned_32(Some_Info.Length) loop
         Read (From_File, Some_Info.bytes (I));
      end loop;

      -- Decode the string from the bytes
      Decode_String (Some_Info);
   end Decode;

   procedure Display (Some_Info : access Utf8;
                      Context   : in Acc_CP_Infos) is
   begin
      -- Displays the String
      Ada.Text_Io.Put
         (Ada.Characters.Handling.To_String (
          To_Wide_String (Some_Info.Contents)));
   end Display;

   function As_String
               (Some_Info : access Utf8) return Wide_String is
   begin
      return To_Wide_String (Some_Info.Contents);
   end As_String;

   function Print_String
               (Some_Info : access Utf8;
                Context   : in Acc_CP_Infos) return String is
   begin
      return Ada.Characters.Handling.To_String
                (To_Wide_String (Some_Info.Contents));
   end Print_String;

   function Java_Decoded_String
               (Some_Info : access Utf8;
                Context   : Acc_CP_Infos;
                Purpose   : Decoding_Purpose) return String is
      From         : constant String := Print_String (Some_Info, Context);
      Answer       : String (1..From'Length + 1024);
      Index        : Natural := 0;
      Answer_Index : Natural := 0;
      Char         : Character;
      Continue     : Boolean;
      Is_Array     : Boolean := False;
      Array_Size   : String (1..50);
      Array_Index  : Natural := 0;
      Is_Argument  : Boolean := False;

      procedure Test_Array is
      begin
         if char /= '[' and then Is_Array then
            if Array_Index = 0 then
               Answer (Answer_Index + 1..Answer_Index + 3) := " []";
               Answer_Index := Answer_Index + 3;
            else
               Answer (Answer_Index + 1..Answer_Index + 2) := " [";
               Answer_Index := Answer_Index + 2;
               Answer (Answer_Index + 1..Answer_Index + Array_Index) :=
                 Array_Size (1..Answer_Index);
               Answer_Index := Answer_Index + Array_Index;
               Answer (Answer_Index + 1..Answer_Index + 1) := "]";
               Answer_Index := Answer_Index + 1;
            end if;
            Is_Array     := False;
         end if;
      end Test_Array;

      procedure Test_Argument is
      begin
         if Char /= '(' and then
            Char /= '[' and then
            Is_Argument and then
            From (From'First + Index + 1) /= ')' then
            Answer (Answer_Index + 1..Answer_Index + 2) := ", ";
            Answer_Index := Answer_Index + 2;
         end if;
      end Test_Argument;

      procedure Decode_Signature is
      begin
         while Index < From'Length loop
            Char := From (From'First + Index);
            case Char is
               when '[' =>
                  -- this is an array
                  Is_Array    := True;
                  Array_Index := 0;
                  Char        := From (From'First + Index + 1);
                  while Ada.Characters.Handling.Is_Digit (Char) loop
                     Array_Index := Array_Index + 1;
                     Array_Size (Array_Index) := Char;
                     Index := Index + 1;
                     Char  := From (From'First + Index + 1);
                  end loop;
                  Char := '[';
               when 'B' =>
                  -- type Byte
                  Answer (Answer_Index + 1..Answer_Index + 4) := "byte";
                  Answer_Index := Answer_Index + 4;
               when 'C' =>
                  -- type Char
                  Answer (Answer_Index + 1..Answer_Index + 4) := "char";
                  Answer_Index := Answer_Index + 4;
               when 'D' =>
                  -- type Double Float
                  Answer (Answer_Index + 1..Answer_Index + 6) := "double";
                  Answer_Index := Answer_Index + 6;
               when 'F' =>
                  -- type Single Float
                  Answer (Answer_Index + 1..Answer_Index + 5) := "float";
                  Answer_Index := Answer_Index + 5;
               when 'I' =>
                  -- type Integer
                  Answer (Answer_Index + 1..Answer_Index + 3) := "int";
                  Answer_Index := Answer_Index + 3;
               when 'J' =>
                  -- type Long Integer
                  Answer (Answer_Index + 1..Answer_Index + 4) := "long";
                  Answer_Index := Answer_Index + 4;
               when 'L' =>
                  -- this is an object of a given class
                  Index    := Index + 1;
                  Continue := True;
                  while Continue loop
                     Char := From (From'First + Index);
                     if Char = ';' then
                        -- end of name
                        Continue := False;
                     else
                        if Char = '/' then
                           Answer (Answer_Index + 1) := '.';
                        else
                           Answer (Answer_Index + 1) := Char;
                        end if;
                        Answer_Index := Answer_Index + 1;
                        Index        := Index + 1;
                        Continue     := Index < From'Length;
                     end if;
                  end loop;
               when 'S' =>
                  -- type Signed Short
                  Answer (Answer_Index + 1..Answer_Index + 5) := "short";
                  Answer_Index := Answer_Index + 5;
               when 'V' =>
                  -- type Void
                  Answer (Answer_Index + 1..Answer_Index + 4) := "void";
                  Answer_Index := Answer_Index + 4;
               when 'Z' =>
                  -- type Boolean
                  Answer (Answer_Index + 1..Answer_Index + 7) := "boolean";
                  Answer_Index := Answer_Index + 7;
               when '(' =>
                  -- this is an argument list beginning
                  if From (From'First + Index + 1) = ')' then
                     Answer (Answer_Index + 1..Answer_Index + 2) := "()";
                     Answer_Index := Answer_Index + 2;
                     Index := Index + 1;
                  else
                     Answer (Answer_Index + 1) := '(';
                     Answer_Index := Answer_Index + 1;
                     Is_Argument := True;
                  end if;
               when ')' =>
                  -- this is an argument list end
                  Answer (Answer_Index + 1) := ')';
                  Answer_Index := Answer_Index + 1;
                  Is_Argument := False;
               when others =>
                  raise E_Bad_String;
            end case;
            Test_Array;
            Test_Argument;
            Index := Index + 1;
         end loop;
      end Decode_Signature;

      procedure Decode_Name is
      begin
         while Index < From'Length loop
            Char := From (From'First + Index);
            Answer_Index := Answer_Index + 1;
            if Char = '/' then
               Answer (Answer_Index) := '.';
            else
               Answer (Answer_Index) := Char;
            end if;
            Index := Index + 1;
         end loop;
      end Decode_Name;

   begin
      case Purpose is
         when Class_Name          => Decode_Name;
         when Variable_Signature  => Decode_Signature;
         when Method_Signature    => Decode_Signature;
      end case;
      return Answer (1..Answer_Index);
   end Java_Decoded_String;

end CP.Utf8;