Hacker/Hacker.iso/HACKER/DECOMP/DECAF/clasfile.adb

Text File | 1996-09-19 | 10.3 KB | 306 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 Flags;

with Field.Method;
with Field.Variable;

package body Class_File is

   use Byte_Utilities;
   use Attribute;

   -- the reference each Java class file must contain
   --------------------------------------------------
   Magic_Reference : constant Unsigned_32 := 16#CAFEBABE#;

   -- Current major and minor versions of the Java Compiler
   --------------------------------------------------------
   Current_Major_Version : constant Unsigned_16 := 45;
   Current_Minor_Version : constant Unsigned_16 := 3;


   function Read_Class (From_File : Byte_Utilities.File_Type)
            return Class_File is
      New_Class : Class_File;
      I         : Unsigned_16;
   begin

      -- Reads the Java file code and checks it
      Read (From_File, New_Class.Magic);
      if New_Class.Magic /= Magic_Reference then
         raise Bad_File;
      end if;

      -- Reads the Minor version and checks it
      Read (From_File, New_Class.Minor_Version);
      if New_Class.Minor_Version /= Current_Minor_Version then
         Ada.Text_Io.Put_Line
            (" Warning : Minor version different than expected.");
      end if;

      -- Reads the Major version and checks it
      Read (From_File, New_Class.Major_Version);
      if New_Class.Major_Version /= Current_Major_Version then
         Ada.Text_Io.Put_Line
            (" Warning : Major version different than expected.");
      end if;

      -- Read the number of constants pool informations and allocate
      -- the table
      Read (From_File, New_Class.Constant_Pool_Count);

      New_Class.Constant_Pool :=
        new CP.CP_infos'(0..New_Class.Constant_Pool_Count - 1 => null);

      -- Stores all the constant pool informations
      I := 1;
      while I <= New_Class.Constant_Pool_Count - 1 loop
         New_Class.Constant_Pool (I) := CP.Read_Constant (From_File);
         if CP.Use_Two_Indexes_In_Table (New_Class.Constant_Pool (I)) then
            I := I + 2;
         else
            I := I + 1;
         end if;
      end loop;

      -- Reads access flags, class and superclass indexes, number of
      -- interfaces implemented by the class
      Read (From_File, New_Class.Access_Flags);
      Read (From_File, New_Class.This_Class);
      Read (From_File, New_Class.Super_Class);
      Read (From_File, New_Class.Interfaces_Count);

      -- Reads the interface name indexes (if necessary)
      if New_Class.Interfaces_Count > 0 then
         New_Class.Interfaces :=
           new Unsigned_16_Array (1 .. New_Class.Interfaces_Count);
         for J in 1..New_Class.Interfaces_Count loop
            Read (From_File, New_Class.Interfaces (J));
         end loop;
      else
         New_Class.Interfaces := null;
      end if;

      -- Reads the number of variables or constants
      Read (From_File, New_Class.Fields_Count);

      -- Reads the variables or constants (if necessary)
      if New_Class.Fields_Count > 0 then
         New_Class.Fields := new Field.Field_Infos
                                    (1 .. New_Class.Fields_Count);
         for J in 1 .. New_Class.Fields_Count loop
            New_Class.Fields (J) := Field.Variable.Read_Field
                                       (From_File, New_Class.Constant_Pool);
         end loop;
      else
         New_Class.Fields := null;
      end if;

      -- Reads the number of methods
      Read (From_File, New_Class.Methods_Count);

      -- Reads the methods (if necessary)
      if New_Class.Methods_Count > 0 then
         New_Class.Methods := new Field.Field_Infos
                                     (1 .. New_Class.Methods_Count);
         for J in 1 .. New_Class.Methods_Count loop
            New_Class.Methods (J) := Field.Method.Read_Field
                                        (From_File, New_Class.Constant_Pool);
         end loop;
      else
         New_Class.Methods := null;
      end if;

      -- Reads the number of class attributes
      Read (From_File, New_Class.Attribute_Count);

      return New_Class;

   end Read_Class;


   -- should disappear soon
   procedure Display_Class (Infos : in Class_File) is
   begin
      Ada.Text_Io.Put_Line ("            Java Class Report ");
      Ada.Text_Io.Put_Line ("            ----------------- ");
      Ada.Text_Io.New_Line;
      Ada.Text_Io.Put_Line
         (" minor version : " &
          unsigned_16'Image (Infos.Minor_Version));
      Ada.Text_Io.Put_Line
         (" major version : " &
          unsigned_16'Image (Infos.Major_Version));
      Ada.Text_Io.Put_Line
         (" constant pool number : " &
          unsigned_16'Image (Infos.Constant_Pool_Count));
      Ada.Text_Io.Put_Line
         (" access flags : " &
          unsigned_16'Image (Infos.Access_Flags));
      if not Flags.Is_Correct (Infos.Access_Flags, Flags.Class_Flag) then
         Ada.Text_Io.Put_Line (" this flag is not correct for a class");
      end if;
      Ada.Text_Io.Put_Line
         (" this class : " &
          unsigned_16'Image (Infos.This_Class));
      CP.Display (Infos.Constant_Pool (Infos.This_Class),
               Infos.Constant_Pool);
      Ada.Text_Io.Put_Line
         (" super class : " &
          unsigned_16'Image (Infos.Super_Class));
      if Infos.Super_Class /= 0 then
         CP.Display (Infos.Constant_Pool (Infos.Super_Class),
                          Infos.Constant_Pool);
      else
         Ada.Text_Io.Put_Line (" No SuperClass");
      end if;
      Ada.Text_Io.Put_Line
         (" interfaces count : " &
          unsigned_16'Image (Infos.Interfaces_Count));
      Ada.Text_Io.Put_Line
         (" fields count : " &
          unsigned_16'Image (Infos.Fields_Count));
      if Infos.Fields_Count = 0 then
         Ada.Text_Io.Put_Line (" No instance variables");
      else
         for I in 1..Infos.Fields_Count loop
            Field.Display (Infos.Fields (I), Infos.Constant_Pool);
         end loop;
      end if;
      Ada.Text_Io.Put_Line
         (" methods count : " &
          unsigned_16'Image (Infos.Methods_Count));
      Ada.Text_Io.Put_Line
         (" attribute count : " &
          unsigned_16'Image (Infos.Attribute_Count));
   end Display_Class;


   procedure Display_Java_Spec (Infos     : in Class_File;
                                For_Body  : in Boolean := False) is
   begin
      -- is the Class public, private ...
      Flags.Display (Infos.Access_Flags, Flags.Class_Flag);

      -- test if it is a class or an interface
      if Flags.Is_Interface (Infos.Access_Flags) then
         -- display the Interface name
         Ada.Text_Io.Put
            (CP.Java_Decoded_String
                (Infos.Constant_Pool (Infos.This_Class),
                 Infos.Constant_Pool,
                 CP.Class_Name));
      else
         -- display the Class name
         Ada.Text_Io.Put
            ("class " &
             CP.Java_Decoded_String
                (Infos.Constant_Pool (Infos.This_Class),
                 Infos.Constant_Pool,
                 CP.Class_Name));
      end if;

      -- display the Superclass name
      if Infos.Super_Class /= 0 then
         Ada.Text_Io.Put
            (" extends " &
             CP.Java_Decoded_String
                (Infos.Constant_Pool (Infos.Super_Class),
                 Infos.Constant_Pool,
                 CP.Class_Name));
      end if;

      -- display the Interfaces implemented bye the class if applicable
      if Infos.Interfaces_Count > 0 then
         Ada.Text_Io.Put (" implements ");
         for I in 1 .. Infos.Interfaces_Count loop
            if I > 1 then
               Ada.Text_Io.Put (", ");
            end if;
            Ada.Text_Io.Put
               (CP.Java_Decoded_String
                  (Infos.Constant_Pool (Infos.Interfaces (I)),
                   Infos.Constant_Pool,
                   CP.Class_Name));
         end loop;
      end if;

      Ada.Text_Io.Put_Line (" { ");

      -- display the Class ans Instance variables
      if Infos.Fields_Count /= 0 then
         Ada.Text_Io.Put_Line ("   // instance and class variables");
         for I in 1..Infos.Fields_Count loop
            Field.Display_Java_Spec
               (Infos     => Infos.Fields (I),
                Context   => Infos.Constant_Pool,
                For_Class => Infos.This_Class,
                For_Body  => For_Body);
         end loop;
      end if;

      -- display the Class methods
      if Infos.Methods_Count /= 0 then
         Ada.Text_Io.Put_Line ("   // methods");
         for I in 1..Infos.Methods_Count loop
            if For_Body then
               Field.Display_Java_Body
                  (Infos     => Infos.Methods (I),
                   Context   => Infos.Constant_Pool,
                   For_Class => Infos.This_Class);
            else
               Field.Display_Java_Spec
                  (Infos     => Infos.Methods (I),
                   Context   => Infos.Constant_Pool,
                   For_Class => Infos.This_Class,
                   For_Body  => False);
            end if;
         end loop;
      end if;

      -- well, this is the end ...
      Ada.Text_Io.Put_Line ("   }");
      Ada.Text_Io.New_Line;

   end Display_Java_Spec;

   procedure Display_Ada_Spec (Infos : in Class_File) is
   begin
      Ada.Text_Io.Put_Line (" sorry, Ada spec generation not available ...");
   end Display_Ada_Spec;

   procedure Display_Ada_Body (Infos : in Class_File) is
   begin
      Ada.Text_Io.Put_Line (" sorry, Ada body generation not available ...");
   end Display_Ada_Body;

   procedure Display_Stk_Spec (Infos : in Class_File) is
   begin
      Ada.Text_Io.Put_Line
         (" sorry, Smalltalk kind-of spec generation not available ...");
   end Display_Stk_Spec;

   procedure Display_Stk_Body (Infos : in Class_File) is
   begin
      Ada.Text_Io.Put_Line
         (" sorry, Smalltalk body generation not available ...");
   end Display_Stk_Body;

end Class_File;