------------------------------------------------------------------------------
--                                                                          --
--                        JGNAT COMPILER COMPONENTS                         --
--                                                                          --
--                                  J V M                                   --
--                                                                          --
--                                 S p e c                                  --
--                                                                          --
--                            $Revision: 1.43 $
--                                                                          --
--           Copyright (C) 1998-2000 Ada Core Technologies, Inc.            --
--                                                                          --
-- GNAT is free software;  you can  redistribute it  and/or modify it under --
-- terms of the  GNU General Public License as published  by the Free Soft- --
-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
-- for  more details.  You should have  received  a copy of the GNU General --
-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
-- to  the Free Software Foundation,  59 Temple Place - Suite 330,  Boston, --
-- MA 02111-1307, USA.                                                      --
--                                                                          --
-- JGNAT -  The GNAT Ada 95 tool chain for the Java (TM) Virtual Machine is --
--          maintained by Ada Core Technologies, Inc. - http://www.gnat.com --
--                                                                          --
------------------------------------------------------------------------------

--  JVM is the interface used by the JGNAT back end to create Java
--  classes. It provides the means of declaring fields and methods for
--  classes and generating Java instruction sequences for individual
--  methods. It allows for intermixed generation of multiple classes and
--  methods.

--  This interface defines a relatively abstract level for producing
--  classes, insulating the client from the details of the class file
--  format and from knowledge of specific Java byte code instructions. It
--  provides several private data types that act as abstract handles for
--  classes, fields, methods, etc., together with operations for creating
--  and referencing them. The operations for instruction generation have a
--  clear correspondence with JVM instructions, but are also at a somewhat
--  high level, removing the need for the caller to specify exact opcodes
--  and operand data types.

--  Note that generation of constant pool items takes place entirely behind
--  the scenes of this interface. Pool items are generated when needed for
--  numeric constants and upon references to JVM entities such as classes,
--  fields, and methods.

with J_Types; use J_Types;
with Types;   use Types;
with Uintp;   use Uintp;
with Urealp;  use Urealp;

package JVM is

   ----------------------
   -- JVM Entity Types --
   ----------------------

   type Class_Id is private;
   --  Values of this type denote Java classes and interfaces

   type Field_Id is private;
   --  Values of this type denote fields of a class. Each Field_Id
   --  is implicitly associated with a specific Class_Id.

   type Method_Id is private;
   --  Values of this type denote methods of a class. Each Method_Id
   --  is implicitly associated with a specific Class_Id.

   type Type_Id is private;
   --  A value of this type is associated with each of the Java primitive
   --  types as well as with each Java array and class type.

   type Local_Var_Id is private;
   --  Values of this type denote local variables of a method. These
   --  values are generated by calls to New_Method_Parameter and
   --  New_Local_Var. Each Local_Var_Id has a Type_Id associated
   --  with it upon creation. It's an error to perform an instruction
   --  generation operation on a Local_Var_Id associated with a method
   --  other than the current method (see Set_Current_Method).

   type String_Const_Id is private;
   --  Values of this type denote static string values saved in the
   --  constant pool of a class (see New_String_Const).

   type Label_Id is private;
   --  Values of this type are handles associated with a point in
   --  the instruction sequence of a method. Label_Ids are used
   --  as targets of branches and subroutine calls.

   type Subroutine_Id is private;
   --  Values of this type are handles associated with subroutine
   --  code sequences.

   --  A set of distinguished constants that indicate a null JVM entity
   --  reference for each form of JVM entity id type:

   Null_Class     : constant Class_Id;
   Null_Field     : constant Field_Id;
   Null_Method    : constant Method_Id;
   Null_Type      : constant Type_Id;
   Null_Local_Var : constant Local_Var_Id;
   Null_Label     : constant Label_Id;

   type Member_Access is
     (Public_Access, Package_Access, Protected_Access, Private_Access);
   --  Access permissions available for class members (fields and methods)

   procedure Initialize;
   --  This procedure must be called prior to using any other operations of
   --  the JVM interface. It takes care of initializing various predefined
   --  JVM entities.

   -----------------------------------------------------------------------
   -- Operations for creating and generating JVM classes and interfaces --
   -----------------------------------------------------------------------

   Java_Lang_Object : constant Class_Id;
   --  The Class_Id associated with the predefined class
   --  java.lang.Object (the mother of all classes).

   function New_Class
     (Name        : Name_Id;
      Pkg_Name    : String_Id := No_String;
      Src_Name    : Name_Id   := No_Name;
      Super       : Class_Id  := Java_Lang_Object;
      Outer_Class : Class_Id  := Null_Class;
      Public      : Boolean   := True;
      Abstrct     : Boolean   := False;
      Final       : Boolean   := False)
      return        Class_Id;
   --  Creates a new class with the given (simple) Name as a member of
   --  the specified package Pkg_Name (a name in dotted form). The class's
   --  associated source file is given by Src_Name. Super denotes the
   --  superclass of the new class. If the new class is an inner class,
   --  then the class's parent class is given by Outer_Class. Public
   --  indicates whether the class is visible outside of its associated
   --  (Java) package. Abstrct specifies whether the class is abstract
   --  and Final specifies whether the class is a final class. Also
   --  declares the default constructor method for the class (but does
   --  not generate its body).

   function New_Interface
     (Name     : Name_Id;
      Pkg_Name : String_Id := No_String;
      Src_Name : Name_Id   := No_Name;
      Public   : Boolean   := True)
      return     Class_Id;
   --  Creates a new interface with the given Name as a member of the
   --  specified package (Pkg_Name). The interface's associated source
   --  file is given by Src_Name. Public indicates whether the class
   --  is visible outside of its associated (Java) package.

   procedure Associate_Interface (Class : Class_Id; Interface : Class_Id);
   --  Establishes a superinterface Interface that the class (or interface)
   --  denoted by Class implements (or extends).

   function Is_Interface (Class_Or_Interface : Class_Id) return Boolean;
   --  Returns True if and only if Class_Or_Interface denotes an interface

   procedure Change_To_Interface (Class : Class_Id);
   --  Changes the JVM entity denoted by Class to an interface. The class's
   --  superclass must be java.lang.Object and the class must not have fields
   --  or methods that violate the restrictions for Java interfaces.

   procedure Begin_Class_File (Class : Class_Id);
   --  Starts generation of the class file for the given class (or interface).
   --  Enables generation of instruction sequences for methods of the class.

   procedure End_Class_File (Class : Class_Id);
   --  Completes generation of the given class (or interface) and
   --  its class file. If any nonabstract methods of the class have
   --  been defined but not closed then an exception is raised.

   function Class_File_Is_Open (Class : Class_Id) return Boolean;
   --  Returns True if and only if Class's associated class file is
   --  open for generation (i.e., Begin_Class_File has been called).

   function Name (Class : Class_Id) return Name_Id;
   --  Returns the name associated with the given class.

   function Superclass (Class : Class_Id) return Class_Id;
   --  Returns the superclass of the given class. If Class denotes an
   --  interface, then class java.lang.Object is returned. Returns
   --  Null_Class if passed the Class_Id for java.lang.Object.

   function Is_Parent_Class (Test_Class, Child : Class_Id) return Boolean;
   --  Returns True if and only if Test_Class is the superclass of
   --  Child or Is_Parent_Class of the superclass.

   function Type_Of (Class : Class_Id) return Type_Id;
   --  Returns the Type_Id associated with Class (i.e., its class type)

   function First_Field (Class : Class_Id) return Field_Id;
   --  Returns the first of the fields associated with the class.
   --  (Subsequent fields are retrieved by calls to Next_Field.)

   function First_Method (Class : Class_Id) return Method_Id;
   --  Returns the first of the methods associated with the class.
   --  (Subsequent methods are retrieved by calls to Next_Method.)

   function Default_Constructor (Class : Class_Id) return Method_Id;
   --  Returns the Method_Id for the default ("no-arg") constructor
   --  for the class.

   procedure Set_Superclass (Class : Class_Id; Super : Class_Id);
   --  Sets the superclass attribute of Class to Super, replacing
   --  the superclass established by New_Class.

   procedure Set_Abstract (Class : Class_Id; Abstrct : Boolean := True);
   --  Sets the abstract attribute of Class to Abstrct, replacing
   --  the value established by New_Class.

   procedure Set_Trace (Trace : Boolean);
   --  Enables (Trace = True) or disables (Trace = False) debugging
   --  output (which includes symbolic output of fields, methods,
   --  and JVM instruction sequences).

   ----------------------------------------------
   -- Type-related declarations and operations --
   ----------------------------------------------

   --  The basic classification of JVM types

   type JVM_Type_Kind is
     (Void_Kind,
      Boolean_Kind,
      Byte_Kind,
      Char_Kind,
      Short_Kind,
      Int_Kind,
      Long_Kind,
      Float_Kind,
      Double_Kind,
      Array_Kind,
      Class_Kind,
      Return_Addr_Kind);

   --  The following correspond to Java's predefined primitive types

   Boolean_Type : constant Type_Id;
   Byte_Type    : constant Type_Id;
   Char_Type    : constant Type_Id;
   Short_Type   : constant Type_Id;
   Int_Type     : constant Type_Id;
   Long_Type    : constant Type_Id;
   Float_Type   : constant Type_Id;
   Double_Type  : constant Type_Id;

   Void_Type    : constant Type_Id;
   --  Used as the result type of methods with a void result

   Retaddr_Type : constant Type_Id;
   --  Used for the type of subroutine return addresses

   String_Type  : constant Type_Id;
   JVM_String_Type  : constant Type_Id;
   --  Corresponds to the type of the predefined class java.lang.String
   Native_Int_Type : constant Type_Id;

   --  create a new enumeration type with for MSIL
   function New_Enum_Type (E : Entity_Id) return Type_Id;

   function Type_Kind (Typ : Type_Id) return JVM_Type_Kind;
   --  Returns the type's associated kind

   function Name (Typ : Type_Id) return Name_Id;
   --  Returns the type's associated name

   function Is_Primitive_Type (Typ : Type_Id) return Boolean;
   --  Returns True if and only if Typ denotes a JVM primitive type
   --  (i.e., has a numeric type kind).

   function Is_Reference_Type (Typ : Type_Id) return Boolean;
   --  Returns True if and only if Typ denotes a JVM reference type
   --  (i.e., is an array or class type).

   function New_Array_Type
     (Element_Type : Type_Id;
      Dimensions   : Pos_8    := 1;
      Type_Name    : Name_Id  := No_Name)
      return         Type_Id;
   --  Defines a JVM array type with the given element type and number
   --  of dimensions. The array type can optionally be given a name.

   function Dimensionality (Arr_Type : Type_Id) return Pos_8;
   --  Returns the number of dimensions associated with Arr_Type.
   --  Raises an exception if Arr_Type does not denote an array type.

   function Class_Of_Type (Class_Type : Type_Id) return Class_Id;
   --  Returns the Class_Id associated with the given type. Raises
   --  an exception if Class_Type is not associated with a class.

   function Literal_Needs_Pool_Ref
     (I_Type  : Type_Id;
      Literal : Uint)
      return    Boolean;
   --  Returns whether an integer literal of type Integer_Type requires
   --  a load from the constant pool when pushed via Gen_Push_Int or
   --  Gen_Push_Long (according to the type kind). Raises an exception
   --  if the type's kind is not in the range Boolean_Kind .. Long_Kind.

   function Literal_Needs_Pool_Ref
     (F_Type  : Type_Id;
      Literal : Ureal)
      return    Boolean;
   --  Returns whether a floating point literal of type Float_Pt_Type requires
   --  a load from the constant pool when pushed via Gen_Push_Float or
   --  Gen_Push_Double (according to the type kind). Raises an exception
   --  if the type's kind is not in the range Float_Kind .. Double_Kind.

   ------------------------------------------
   -- Operations for defining class fields --
   ------------------------------------------

   function New_Field
     (Class    : Class_Id;
      Name     : Name_Id;
      Ftype    : Type_Id;
      Static   : Boolean;
      Final    : Boolean       := False;
      Volatile : Boolean       := False;
      Acc_Mode : Member_Access := Public_Access)
      return     Field_Id;
   --  Defines a field with the given Name for Class and establishes
   --  the field's type (Ftype). The parameters Static and Final
   --  specify the field's static and final properties. Volatile
   --  specifies whether the field is volatile. Acc_Mode defines
   --  the access permission for the field.

   function Name (Field : Field_Id) return Name_Id;
   --  Returns the name associated with the given field.

   function Next_Field (Field : Field_Id) return Field_Id;
   --  Returns the successor of the given field, or Null_Field
   --  if it has no successor.

   function Type_Of (Field : Field_Id) return Type_Id;
   --  Returns the Type_Id associated with the given field

   function Is_Static (Field : Field_Id) return Boolean;
   --  Returns True is Field is static, otherwise returns False.

   function Field (Class : Class_Id; Name : Name_Id) return Field_Id;
   --  Returns the field in Class with the given name, if any.
   --  Returns Null_Field if no field of that name belongs to
   --  Class. If more than one field of the name exists, returns
   --  the Field_Id associated with the field in the deepest of
   --  the parent classes that contain a field of that name.

   function Field (Class : Class_Id; Name : String) return Field_Id;
   --  Same as the preceding function, but for convenience allows
   --  passing a string for the field name.

   ---------------------------------------------------------------
   -- Operations for defining class methods and local variables --
   ---------------------------------------------------------------

   function New_Method
     (Class    : Class_Id;
      Name     : Name_Id;
      Result   : Type_Id;
      Static   : Boolean;
      Abstrct  : Boolean := False;
      Final    : Boolean := False;
      Synch    : Boolean := False;
      Acc_Mode : Member_Access := Public_Access;
      Parent   : Method_Id := Null_Method)
      return     Method_Id;
   --  Defines a method of Class with the given Name . The Result
   --  parameter specifies the method's result type. The parameters
   --  Static, Abstrct, and Final specify the method's static,
   --  abstract, and final properties. Synch specifies whether
   --  the method is a synchronized method. Acc_Mode defines the
   --  access permission for the method. In the case of a nonstatic
   --  method, the method's 'this' parameter is implicitly created.
   --  A parent method can optionally be associated with the method
   --  and is intended to denote a method associated with a statically
   --  enclosing Ada subprogram. Even though the JVM does not support
   --  the notion of method nesting, we provide the Parent parameter
   --  to facilitate the JGNAT back end's implementation of nested
   --  Ada subprograms (this attribute can be retrieved using the
   --  Parent_Method function).

   function Next_Method (Method : Method_Id) return Method_Id;
   --  Returns the successor of the given method, or Null_Method
   --  if it has no successor.

   function New_Method_Parameter
     (Method : Method_Id;
      Name   : Name_Id;
      Ptype  : Type_Id)
      return   Local_Var_Id;
   --  Establishes a new parameter of the given Name of the type Ptype
   --  for Method. All parameters must be established for a method prior
   --  to calling Open_Method on the method. An exception will be raised
   --  if an attempt is made to add a parameter to an open method. Returns
   --  a Local_Var_Id handle that corresponds to the parameter's associated
   --  local variable in the frame of the parameter's method.

   function New_Method_Parameter
     (Method : Method_Id;
      Name   : String;
      Ptype  : Type_Id)
      return   Local_Var_Id;
   --  Same as preceding function, but for convenience allows passing
   --  a string for the parameter name

   function Name (Method : Method_Id) return Name_Id;
   --  Returns the name associated with the given method.

   procedure Open_Method (Method : Method_Id);
   --  Opens the method, allowing its instruction sequence to be generated.
   --  It's only permitted to call this for a method that is associated with
   --  an open class file. Raises an exception if passed an unassociated
   --  method, a method that has been closed, or an abstract method.

   procedure Close_Method (Method : Method_Id);
   --  Closes the method, completing its instruction sequence.
   --  Once a method has been closed it may not be reopened. Raises
   --  an exception if the method is not currently open. Also raises
   --  an exception if any labels created for the method have not
   --  been generated (via Gen_Label), unless those labels are not
   --  targeted by any instructions of the method. The method must
   --  also not have any open subroutine at this point.

   procedure Set_Current_Method (Method : Method_Id);
   --  Establishes the method as the current method for code generation.
   --  The method must be open for code generation. An additional condition
   --  is that there must not be an active subroutine in effect at the time
   --  this procedure is called.

   function Current_Method return Method_Id;
   --  Returns the current method (as established by Set_Current_Method)

   procedure Start_Entry_Code_Sequence;
   --  Allows generation of a sequence of code to be inserted at the
   --  beginning of the current method's code sequence. Only one such
   --  sequence can be active and no calls to either Set_Current_Method
   --  or Start_Entry_Code_Sequence are permitted while and entry code
   --  sequence is active.

   procedure End_Entry_Code_Sequence;
   --  Completes the generation of an entry code sequence (as started
   --  by a call to Start_Entry_Code_Sequence). The sequence will be
   --  appended to the beginning of the current method's code.

   function Method (Class : Class_Id; Name : Name_Id) return Method_Id;
   --  Returns the method in Class with the given name, if any.
   --  Returns Null_Method if no method of that name belongs to
   --  Class. This function is only designed to work for methods
   --  that are not overloaded within the given class, otherwise
   --  the behavior is undefined.

   function Method (Class : Class_Id; Name : String) return Method_Id;
   --  Same as the preceding function, but for convenience allows
   --  passing a string for the method name.

   function Method
     (Class   : Class_Id;
      Name    : Name_Id;
      Result  : Type_Id;
      Param_0 : Type_Id := Null_Type;
      Param_1 : Type_Id := Null_Type)
      return    Method_Id;
   --  Returns the method, if any, in Class with the given name and having the
   --  given Result_Type and one to two parameters of types Param_Type_0..1
   --  (or having no parameters if Param_0 = Null_Type). The value Null_Type
   --  is used to indicate that a parameter is not present (and all parameter
   --  types after that will be ignored). Returns Null_Method if no method of
   --  that name and type profile belongs to Class. This function is designed
   --  to work for methods that may be overloaded within the given class.
   --  For now we just support the case of zero to two parameters, but this
   --  function could easily be extended to allow more type parameters.

   function Method
     (Class   : Class_Id;
      Name    : String;
      Result  : Type_Id;
      Param_0 : Type_Id := Null_Type;
      Param_1 : Type_Id := Null_Type)
      return    Method_Id;
   --  Same as the preceding function, but for convenience allows
   --  passing a string for the method name.

   function Class_Of (Method : Method_Id) return Class_Id;
   --  Returns the class to which the method belongs

   function Parent_Method (Method : Method_Id) return Method_Id;
   --  Returns the method's associated parent method, if any,
   --  or Null_Method if there is no associated parent.

   function Is_Completed (Method : Method_Id) return Boolean;
   --  Returns True if and only if the method has been generated and closed

   procedure Set_Current_Source_Loc (Sloc : Source_Ptr);
   --  Establishes the given source location for code being generated for
   --  the current method (causes emission of line table information).

   function Get_Current_Source_Loc return Source_Ptr;
   --  returns the source location from last Set_Current_Source_Loc.

   function New_Local_Var
     (Method : Method_Id;
      Name   : Name_Id;
      Ltype  : Type_Id)
      return   Local_Var_Id;
   --  Creates a local variable of type Ltype with the given Name for Method.

   function New_Local_Var
     (Name  : Name_Id;
      Ltype : Type_Id)
      return  Local_Var_Id;
   --  Creates a local variable of type Ltype with the given Name for the
   --  current method.

   function New_Local_Var
     (Name  : String;
      Ltype : Type_Id)
      return  Local_Var_Id;
   --  Creates a local variable of type Ltype with the given Name for the
   --  current method.

   function Name (Local : Local_Var_Id) return Name_Id;
   --  Returns the name associated with the given local variable.

   function First_Local_Var (Method : Method_Id) return Local_Var_Id;
   --  Returns the Local_Var_Id for the first local variable of the method,
   --  or Null_Local_Var if none.

   function Next_Local_Var (Local : Local_Var_Id) return Local_Var_Id;
   --  Returns the Local_Var_Id for the successor of the given local variable,
   --  or Null_Local_Var if none.

   function This_Local (Method : Method_Id) return Local_Var_Id;
   --  Returns the Local_Var_Id associated with the 'this' parameter
   --  of the given method. Raises an exception if the method is static
   --  (i.e., if it's not an instance method).

   function Local_Var (Method : Method_Id; Name : Name_Id) return Local_Var_Id;
   --  Returns the local variable in Method with the given name, if any.
   --  Raises an exception if no local with that name belongs to Method.

   function Local_Var (Method : Method_Id; Name : String) return Local_Var_Id;
   --  Same as the preceding function, but for convenience allows
   --  passing a string for the local variable name.

   function Type_Of (Local : Local_Var_Id) return Type_Id;
   --  Returns the Type_Id associated with the given local variable

   function Method_Of (Local : Local_Var_Id) return Method_Id;
   --  Returns the Method_Id for the method to which Local belongs

   function New_String_Constant (Str : String_Id) return String_Const_Id;
   --  Creates a constant pool entry for the given string value
   --  in the current method's class file.


   -----------------------------------------------------------------
   -- Operations for generating Java Virtual Machine instructions --
   -----------------------------------------------------------------

   --  Note: The paradigm presently defined by this interface is that
   --  instructions are generated for the currently active method (i.e.,
   --  the method established as current by Set_Current_Method).

   --  The implementation performs certain simple checks to try
   --  and ensure that invalid instruction sequences are not
   --  generated, but we don't fully specify the extent of those
   --  checks here. For example, checks are made that the stack has
   --  an appropriate number and type of operands available when
   --  generating instructions that consume operands. Note also
   --  that, for the most part, operations generating instructions
   --  that apply to stack operands do not specify the type of the
   --  operands, simplifying the use of these operations by clients
   --  of the interface. The implementation will generate the
   --  appropriately typed Java instruction based on the types
   --  of operands that have been pushed on the conceptual stack
   --  by preceding instructions.

   -------------------------------------------
   -- Operations for pushing literal values --
   -------------------------------------------

   procedure Gen_Push_Null;
   --  Generates the push of a null reference value

   procedure Gen_Push_Int (Value : Uint);
   --  Generates the push of an integer value of type Int

   procedure Gen_Push_Long (Value : Uint);
   --  Generates the push of an integer value of type Long

   procedure Gen_Push_Float (Value : Ureal);
   --  Generates the push of a floating point value of type Float

   procedure Gen_Push_Double (Value : Ureal);
   --  Generates the push of a floating point value of type Double

   procedure Gen_Push_String_Const (Str : String_Const_Id);
   --  Generates the push of a reference to a Java string literal
   --  contained in the constant pool of the current method's class.

   procedure Gen_Push_String_Const (S : String);
   --  Generates the push of a reference to a Java string literal;
   --  implicitly generates the given string in the constant pool
   --  of the current method's class.

   ---------------------------------------------------------
   -- Operations for loading and updating local variables --
   ---------------------------------------------------------

   procedure Gen_Load_Local (Local : Local_Var_Id);
   --  Generates a load of a local variable. Raises an exception
   --  if Local doesn't belong to the current method.

   procedure Gen_Load_Local_Address (Local : Local_Var_Id);
   --  Generates a load of address of a local variable. Raises an exception
   --  if Local doesn't belong to the current method.

   procedure Gen_Store_Local (Local : Local_Var_Id);
   --  Generates a store of the top-of-stack value into a local variable.
   --  Raises an exception if Local doesn't belong to the current method.

   --------------------------------------------------------
   -- Operations for loading and updating array elements --
   --------------------------------------------------------

   procedure Gen_Load_Array_Element (Ref_Only : Boolean := False);
   --  Generates a load of an array element, based on an array reference
   --  and index on the top of stack.  If Ref_Only, for valuetypes
   --  just load the address

   procedure Gen_Load_Subarray_Reference;
   --  Generates a load of a reference to a subarray of a multidimensional
   --  array, based on an array reference and index on the top of stack.

   procedure Gen_Store_Array_Element;
   --  Generates a store of the top-of-stack value into an array element,
   --  based on an array reference and index following the top-of-stack value.

   --------------------------------------------------------
   -- Operations for accessing and updating class fields --
   --------------------------------------------------------

   procedure Gen_Get_Field (Field : Field_Id);
   --  Generates a load of the given static or object field.

   procedure Gen_Put_Field (Field : Field_Id);
   --  Generates a store of the top-of-stack value into the given static
   --  or object field.

   procedure Gen_Get_Static_Field (Field : Field_Id);
   --  Generates a load of the given static class field

   procedure Gen_Put_Static_Field (Field : Field_Id);
   --  Generates a store of the top-of-stack value into the given static
   --  class field.

   procedure Gen_Get_Object_Field (Field : Field_Id);
   --  Generates a load of an object field as determined by a top-of-stack
   --  object reference.

   procedure Gen_Get_Object_Field_Address (Field : Field_Id);
   --  Generates a load of an object field's address as determined by
   --  a top-of-stack object reference.

   procedure Gen_Put_Object_Field (Field : Field_Id);
   --  Generates a store of the top-of-stack value into an object field
   --  as determined by the next to top-of-stack object reference.

   ------------------------------------------------
   -- Operations for creating objects and arrays --
   ------------------------------------------------

   procedure Gen_New_Object (Class : Class_Id; Method : Method_Id);
   --  Generates an allocation of an object of the class (pushing the
   --  resulting object reference on the stack).

   procedure Gen_Default_Object (Class : Class_Id);
   --  Generates an allocation of an object of the class, as well as
   --  an invocation of the default constructor for the class. Leaves
   --  a reference to the new object on the stack.

   procedure Gen_New_Array (Array_Type : Type_Id);
   --  Generates an allocation of an array of the given type (pushing
   --  the resulting array reference on the stack). Requires that a value
   --  of type Int be on the top of the evaluation stack, indicating the
   --  number of array elements to allocate.

   procedure Gen_New_Multiarray (Array_Type : Type_Id);
   --  Generates an allocation of a multidimensional array of the given type
   --  (pushing the resulting array reference on the stack). Requires that
   --  the lengths of each dimension are present in index order on the top
   --  of stack (with highest dimension on the top of stack). Array_Type
   --  is allowed to be a one-dimensional array type, but only if it
   --  has an element type that is also a one-dimensional array type,
   --  in which case the lengths for both array levels must be on the stack.

   procedure Gen_Array_Length;
   --  Generates an instruction to push the length of an array (where
   --  the current top of stack contains a reference to the array).

   ---------------------------
   -- Arithmetic operations --
   ---------------------------

   procedure Gen_Add;
   --  Generates the addition of the top two stack elements

   procedure Gen_Sub;
   --  Generates the subtraction of the top two stack elements

   procedure Gen_Mul;
   --  Generates the multiplication of the top two stack elements

   procedure Gen_Div;
   --  Generates the division of the top two stack elements

   procedure Gen_Rem;
   --  Generates the remainder of the top two stack elements

   procedure Gen_Neg;
   --  Generates the arithmetic negation of the top stack element

   procedure Gen_Incr_Local (Local : Local_Var_Id; Value : Uint);
   --  Generates an increment of the local integer variable by Value

   ----------------------------------
   -- Logical and shift operations --
   ----------------------------------

   procedure Gen_And;
   --  Generates the logical "and" of the top two stack elements

   procedure Gen_Or;
   --  Generates the logical "or" of the top two stack elements

   procedure Gen_Xor;
   --  Generates the logical exclusive "or" of the top two stack elements

   procedure Gen_Not;
   --  Generates the logical complement of the top stack element

   procedure Gen_Shift_Left (Size : Uint);
   --  Generates a left shift of the top stack element using the Size
   --  least significant bits of the integer (any bits shifted off
   --  the end of the lower Size bits will be converted to zeros).

   procedure Gen_Shift_Right_Arithmetic (Size : Uint);
   --  Generates an arithmetic right shift of the top stack element
   --  using the Size least significant bits of the integer (so if
   --  the high bit of the lower Size bits is one, then the upper
   --  bit will be sign extended as a result of the shift).

   procedure Gen_Shift_Right_Logical;
   --  Generates a logical right shift of the top stack element

   procedure Gen_Rotate_Left (Size : Uint);
   --  Generates a left circular rotation of the top stack element
   --  using the Size least significant bits of the integer.

   procedure Gen_Rotate_Right (Size : Uint);
   --  Generates a right circular rotation of the top stack element
   --  using the Size least significant bits of the integer.

   -----------------------------------
   -- Numeric conversion operations --
   -----------------------------------

   procedure Gen_Conversion (Target_Type : Type_Id);
   --  Generates a conversion of the top stack element to the given
   --  type. Raises an exception if Target_Type and the current
   --  top-of-stack type are not compatible for conversion.

   ---------------------------------
   -- Branch and label generation --
   ---------------------------------

   --  NOTE: All branch and label generation procedures perform
   --  a check that the evaluation stack is empty after the conceptual
   --  execution of a branch and at the point of a label, and raise
   --  an exception if there are any operands on the stack. This is
   --  overly strict from the JVM point of view, but avoids the need
   --  for tracking of stack states across branches and labels.
   --  For cases where this checking needs to be relaxed (e.g.,
   --  conditional expression generation), special routines are
   --  provided to allow disciplined suppression of stack checking
   --  in localized regions (see Set_Stack_Checking, Mark_Stack,
   --  and Release_Stack).

   function New_Label return Label_Id;
   --  Creates a new label for the current method and
   --  returns a handle to the label. The label is
   --  not associated with a point in the method's
   --  instruction sequence until Gen_Label is called.
   --  Note: Instructions that are generated to target
   --  this label must be generated for the same method
   --  associated with the label, otherwise the generation
   --  of the instruction will raise an exception.

   procedure Gen_Label
     (Label       : Label_Id;
      Line_Number : Source_Ptr := No_Location);
   --  Establishes the given label at the current point
   --  in the instruction sequence of the current method.
   --  Raises an exception if Gen_Label has already been
   --  called for this label, or if the label was created
   --  for a method other than the current method. The
   --  logical operand stack for the current method must
   --  be empty at the point of generating any label (unless
   --  stack checking is suppressed, see Set_Stack_Checking).

   --  procedure Gen_Comparison;
   --  Generates a comparison of two numeric values on the top
   --  of the stack (result is -1 if TOS-1 is less than TOS;
   --  0 if TOS-1 = TOS; +1 if TOS-1 > TOS). Raises an exception
   --  if the numeric values are not of the same type.

   procedure Gen_Branch_Equal (Label : Label_Id);
   --  Generates a branch to Label if top of stack is zero

   procedure Gen_Branch_Not_Equal (Label : Label_Id);
   --  Generates a branch to Label if top of stack is nonzero

   procedure Gen_Branch_Less (Label : Label_Id);
   --  Generates a branch to Label if top of stack is less than zero

   procedure Gen_Branch_Less_Equal (Label : Label_Id);
   --  Generates a branch to Label if top of stack is less or equal to zero

   procedure Gen_Branch_Greater (Label : Label_Id);
   --  Generates a branch to Label if top of stack is greater than zero

   procedure Gen_Branch_Greater_Equal (Label : Label_Id);
   --  Generates a branch to Label if top of stack is greater or equal to zero

   procedure Gen_Compare_Branch_Equal (Label : Label_Id);
   --  Generates a comparison and branch to Label (if TOS-1 = TOS).
   --  Raises an exception if the top two stack items are not of the
   --  reference type or are not both of type Int_Type.

   procedure Gen_Compare_Branch_Not_Equal (Label : Label_Id);
   --  Generates a comparison and branch to Label (if TOS-1 = TOS).
   --  Raises an exception if the top two stack items are not of the
   --  same reference type or are not both of type Int_Type.

   procedure Gen_Compare_Branch_Less (Label : Label_Id);
   --  Generates a comparison and branch to Label (if TOS-1 < TOS).
   --  Raises an exception if the top two stack items are not of
   --  type Int_Type.

   procedure Gen_Compare_Branch_Less_Equal (Label : Label_Id);
   --  Generates a comparison and branch to Label (if TOS-1 <= TOS).
   --  Raises an exception if the top two stack items are not of
   --  type Int_Type.

   procedure Gen_Compare_Branch_Greater (Label : Label_Id);
   --  Generates a comparison and branch to Label (if TOS-1 > TOS).
   --  Raises an exception if the top two stack items are not of
   --  of type Int_Type.

   procedure Gen_Compare_Branch_Greater_Equal (Label : Label_Id);
   --  Generates a comparison and branch to Label (if TOS-1 >= TOS).
   --  Raises an exception if the top two stack items are not of
   --  of type Int_Type.

   procedure Gen_Branch_If_Null (Label : Label_Id);
   --  Generates a branch to Label on the condition that TOS equals null.
   --  Raises an exception if the type of TOS is not a reference type.

   procedure Gen_Branch_If_Not_Null (Label : Label_Id);
   --  Generates a branch to Label on the condition that TOS is not equal to
   --  null. Raises an exception if the type of TOS is not a reference type.

   procedure Gen_Goto (Label : Label_Id);
   --  Generates an unconditional branch to Label

   procedure Gen_Leave (Label : Label_Id);
   --  Generates an unconditional branch to Label from an exception handler

   procedure Set_Stack_Checking (Enable : Boolean);
   --  Turns consistency checking of the current method's operand
   --  stack on or off. With an argument of Enable => False, specifically
   --  relaxes the checks that the stack must be empty at the point of
   --  a branch or label. This allows generation of code sequences that
   --  would otherwise be disallowed by the strictly imposed checking
   --  (e.g., conditional expressions that involve branches). Typical
   --  usage should be to suppress stack checking for a very localized
   --  region of code generation. Nesting of such regions is not
   --  currently allowed, and so an attempt to turn checking off
   --  if it's already suppressed (or to turn it on if it's not
   --  already suppressed) will raise an exception. An exception
   --  will also be raised if the stack has been marked but not
   --  released (see Mark_Stack and Release_Stack). Note that this
   --  procedure does not suppress the checks for an empty stack that
   --  occur upon generation of a method or subroutine return (nor
   --  the checks that occur at the closing of a method or subroutine).

   procedure Suppress_Stack_Checking (Check_State : out Boolean);
   --  Turns off operand stack consistency checking and returns the state
   --  of stack checking prior to this suppression in Check_State. This
   --  procedure facilitates nesting of stack suppression calls.

   procedure Restore_Stack_Checking (Check_State : Boolean);
   --  Restores the operand stack checking state to an earlier value.
   --  Intended for use in conjunction with Suppress_Stack_Checking,
   --  and should only be called with a check state value obtained
   --  as the out parameter of a matching Suppress_Stack_Checking call.

   procedure Mark_Stack;
   --  Records the current level of the stack for later use with a
   --  call to Release_Stack. Only intended to be used in conjunction
   --  with suppression of stack checking (see Set_Stack_Checking and
   --  Release_Stack). Raises an exception if there has been a preceding
   --  call to Mark_Stack for the current method that has not been
   --  matched with a corresponding Release_Stack (i.e., mark/release
   --  pairs currently may not be nested), or if stack checking is
   --  not currently suppressed.

   procedure Release_Stack;
   --  Restores the top of stack to the previous level determined
   --  during a call to Mark_Stack, effectively discarding any
   --  operands that have been accumulated on the stack since the
   --  stack was marked. Only intended to be used in conjunction
   --  with suppression of stack checking (see Set_Stack_Checking).
   --  Typical usage is when generating a conditional expression,
   --  to free a stack element accumulated during the execution
   --  of the second arm of the conditional sequence (the stack
   --  element pushed as a result of the first arm would not
   --  be released, and serves to reflect the computed result of
   --  the conditional expression). Raises an exception if a
   --  preceding (unreleased) call to Mark_Stack for the current
   --  method has not occurred. Also raises an exception if the
   --  released stack element types are not mirrored by corresponding
   --  types in the same relative positions below the mark point.

   procedure Reset_Stack;
   --  Pops all contents of the current method's operand type stack,
   --  leaving it empty. Useful for handling exceptions in the JVM
   --  Back End and then continuing processing (avoids later stack
   --  errors). Should only be used at boundary points between
   --  processing of Ada declarations and statements where the
   --  stack should be empty.

   procedure Push_Type (JVM_Type : Type_Id);
   --  Pushes JVM_Type on the current method's conceptual operand
   --  stack. Used in special situations such as exception handling
   --  to represent an implicit push of a stack operand by the JVM.

   procedure Pop_Type (Count : Positive := 1);
   --  Pops the specified number of types off of the current method's
   --  operand type stack. Raises an exception if the stack does not
   --  have sufficient elements to pop. Can be used together with
   --  Push_Type in situations where the stack needs to be adjusted
   --  to reflect a different operand type.

   function Top_Type return Type_Id;
   --  Returns the Type_Id for the type at the top of the operand
   --  stack. Raises an exception if the stack is empty.

   -----------------------------------
   -- Subroutine-related operations --
   -----------------------------------

   function New_Subroutine return Subroutine_Id;
   --  Creates a new subroutine for the current method and returns
   --  a handle for it. Note that a call to Open_Subroutine must
   --  occur prior to generating any code for the subroutine.

   procedure Open_Subroutine (Subroutine : Subroutine_Id);
   --  Enables code generation for the subroutine. Raises an exception
   --  if the subroutine is not associated with the current method or
   --  if another subroutine is open for the current method (i.e.,
   --  nested subroutines are not presently allowed). Any generated
   --  instructions will be associated with this subroutine until the
   --  subroutine is closed by a call to Close_Subroutine.

   procedure Close_Subroutine;
   --  Closes the current open subroutine associated with the current
   --  method. Raises an exception if there is not such a currently open
   --  subroutine.

   procedure Gen_JSR (Subroutine : Subroutine_Id);
   --  Generates a a jump to the given subroutine. At present it's required
   --  that the code for a subroutine must be fully generated prior to making
   --  a call to it. Also, we require that the operand stack be empty when
   --  making a subroutine call. An exception will be raised if either of
   --  these restrictions is violated.

   procedure Gen_Save_Subroutine_Return (Local : Local_Var_Id);
   --  Generates a save of the return address from the stack into
   --  the given local variable.

   procedure Gen_Subroutine_Return (Local : Local_Var_Id);
   --  Generates a subroutine return instruction via the return
   --  address saved in the given local variable.

   ---------------------------
   -- Case table generation --
   ---------------------------

   procedure Start_Switch_Table (Default : Label_Id);
   --  Start generation of a case switch instruction, using Default
   --  as the default target label. It's an error to generate any
   --  further instructions for the current method prior to calling
   --  End_Switch_Table.

   procedure Add_Switch_Pair
     (Match_Low  : Uint;
      Match_High : Uint;
      Target     : Label_Id);
   --  Add the pair of a match range (Match_Low .. Match_High) and
   --  jump target to the current switch table. If this is not the
   --  first switch pair of the table, then the value of Match_Low
   --  must be strictly greater than the Match_High value of the
   --  last-generated pair's match range. Raises an exception if
   --  a switch table is not being generated for the current method.

   procedure End_Switch_Table;
   --  Complete generation of a case switch instruction. Raises an exception
   --  if not preceded by a corresponding call to Start_Switch_Table.

   procedure Cancel_Switch_Table;
   --  Cancel generation of a case switch instruction. Raises an exception
   --  if not preceded by a corresponding call to Start_Switch_Table.
   --  In some cases we want to abort generating a switch table that
   --  has been started (e.g., when we discover that it's not needed
   --  due to empty choices -- the JVM doesn't allow empty tables).

   ------------------------------
   -- Method return operations --
   ------------------------------

   procedure Gen_Method_Return;
   --  Generates an appropriately typed return instruction, according
   --  to the result type of the current method. If the current method
   --  has a void result, then generates a return without result.

   ----------------------------------
   -- Method invocation operations --
   ----------------------------------

   procedure Gen_Invoke_Method (Method : Method_Id);
   --  Generates a call to a static or instance method. Must not be
   --  called for a constructor or interface method.

   procedure Gen_Invoke_Virtual (Method : Method_Id);
   --  Generates a call to an instance method (the call will pop any
   --  actual parameters of the call and push the result if any).
   --  Raises an exception if the method is not an instance method.

   procedure Gen_Invoke_Special (Method : Method_Id);
   --  Generates a call to a constructor method (the call will pop
   --  any actual parameters of the call).

   procedure Gen_Invoke_Static (Method : Method_Id);
   --  Generates a call to a static method (the call will pop
   --  any actual parameters of the call and push the result
   --  if the method any). Raises an exception if the method
   --  is not a static method.

   procedure Gen_Invoke_Interface (Method : Method_Id);
   --  Generates a call to an interface method (the call will pop
   --  any actual parameters of the call and push the result if any).

   -------------------------------------------------
   -- Miscellaneous stack manipulation operations --
   -------------------------------------------------

   procedure Gen_Pop (Items : Positive := 1);
   --  Generates instructions to pop the given number of items off
   --  the stack. Note that the types of the items can be arbitrary
   --  and are not limited to being of the same size.

   procedure Gen_Duplicate;
   --  Generates instructions to duplicate the item on the top of the
   --  the stack.

   procedure Gen_Double_Duplicate;
   --  Generates instructions to duplicate the top two items on the
   --  top of the the stack. The two items are required to be of
   --  the same type.

   procedure Gen_Swap;
   --  Generates a swap of the top two stack items (the items can
   --  be of arbitrary types).

   ----------------------------------
   -- Exception-related operations --
   ----------------------------------

   procedure Gen_Exception_Throw;
   --  Generates a throw of an exception indicated by the top of stack

   type Handler_Kind is (Filter, Non_Filter);

   procedure Gen_Exc_Handler_Entry
     (Exc_Class       : Class_Id;
      Start_Lbl       : Label_Id;
      End_Lbl         : Label_Id;
      Handler_Lbl     : Label_Id;
      End_Handler_Lbl : Label_Id;
      Kind            : Handler_Kind;
      Filter_Lbl      : Label_Id);
   --  Emits an exception handler entry for the exception class Exc_Class
   --  that covers the range of instructions bounded by Start_Lbl through
   --  End_Lbl corresponding to a handler starting at Handler_Lbl.

   ----------------------
   -- Other operations --
   ----------------------
   procedure Gen_Load_Function_Pointer (Method : Method_Id);
   --  load a function pointer for the given method onto the stack

   procedure Gen_Block_Copy;
   --  Generate a block copy instruction

   procedure Gen_Sizeof (JVM_Type : Type_Id);
   --  Generate sizeof instruction

   procedure Gen_Check_Cast (Class : Class_Id);
   --  Generates a check that an object reference on the top of stack
   --  indicates an object belonging to the given class.

   procedure Gen_Check_Cast (JVM_Type : Type_Id);
   --  Generates a check that an object reference on the top of stack
   --  indicates an object belonging a compatible class or array type.

   procedure Gen_Instance_Of (Class : Class_Id);
   --  Generates a test that an object reference on the top of stack
   --  indicates an object belonging to the given class. Pushes a
   --  result of type Int_Type.

   procedure Gen_NOP;
   --  Generates a no-operation ('nop') instruction.

   procedure Gen_Monitor_Enter;
   --  Generates a monitorenter instruction

   procedure Gen_Monitor_Exit;
   --  Generates a monitorexit instruction

   procedure Gen_End_Filter;
   --  Generates an endfilter instruction

   procedure Print_Stack;
   --  Prints the contents of the current method's operand type stack
   --  to standard output. Useful for debugging.

   procedure Set_Class (Method : Method_Id; Class : Class_Id);
   --  Associates the method with Class

   procedure For_Valuetypes_Use_Address;
   --  when loading a valuetype, load only its address

   procedure For_Valuetypes_Use_Value;
   --  when loading a valuetype, load its value (the default)

   procedure Inside_Try_Catch_Finally;
   --  make sure all ret stmts are really "leave" instructions

   function Inside_Try_Catch_Finally return Boolean;
   --  were we inside_try_catch_finally

   procedure Outside_Try_Catch_Finally;
   --  go back to default for "ret"

private

   JVM_Id_Low_Bound : constant := 0;

   JVM_Id_High_Bound : constant := 10_000_000;

   type JVM_Id is range JVM_Id_Low_Bound .. JVM_Id_High_Bound;

   Null_JVM_Id : constant JVM_Id := JVM_Id_Low_Bound;

   First_JVM_Id : constant := JVM_Id_Low_Bound + 1;

   type Class_Id is new JVM_Id;

   type Type_Id is new JVM_Id;

   type Field_Id is new JVM_Id;

   type Method_Id is new JVM_Id;

   type Label_Id is new JVM_Id;

   type Local_Var_Id is new JVM_Id;

   type String_Const_Id is new JVM_Id;

   type Subroutine_Id is new JVM_Id;

   type Pool_Id is new JVM_Id;

   type JVM_Entity_Ref is new JVM_Id;

   Null_Class      : constant Class_Id        := Class_Id (Null_JVM_Id);
   Null_Field      : constant Field_Id        := Field_Id (Null_JVM_Id);
   Null_Method     : constant Method_Id       := Method_Id (Null_JVM_Id);
   Null_Type       : constant Type_Id         := Type_Id (Null_JVM_Id);
   Null_Local_Var  : constant Local_Var_Id    := Local_Var_Id (Null_JVM_Id);
   Null_Label      : constant Label_Id        := Label_Id (Null_JVM_Id);
   Null_Str_Const  : constant String_Const_Id := String_Const_Id (Null_JVM_Id);
   Null_Subroutine : constant Subroutine_Id   := Subroutine_Id (Null_JVM_Id);
   Null_Pool_Item  : constant Pool_Id         := Pool_Id (Null_JVM_Id);
   Null_Entity_Ref : constant JVM_Entity_Ref  := JVM_Entity_Ref (Null_JVM_Id);

   Void_Type    : constant Type_Id := First_JVM_Id + 1;
   Boolean_Type : constant Type_Id := First_JVM_Id + 2;
   Byte_Type    : constant Type_Id := First_JVM_Id + 3;
   Char_Type    : constant Type_Id := First_JVM_Id + 4;
   Short_Type   : constant Type_Id := First_JVM_Id + 5;
   Int_Type     : constant Type_Id := First_JVM_Id + 6;
   Long_Type    : constant Type_Id := First_JVM_Id + 7;
   Float_Type   : constant Type_Id := First_JVM_Id + 8;
   Double_Type  : constant Type_Id := First_JVM_Id + 9;
   Retaddr_Type : constant Type_Id := First_JVM_Id + 10;

   Any_Ref_Type : constant Type_Id := First_JVM_Id + 11;

   Java_Lang_Object      : constant Class_Id := First_JVM_Id + 12;
   Java_Lang_Object_Type : constant Type_Id  := First_JVM_Id + 13;

   Java_Lang_String      : constant Class_Id := First_JVM_Id + 14;
   String_Type           : constant Type_Id  := First_JVM_Id + 15;
   JVM_String_Type           : constant Type_Id  := First_JVM_Id + 16;
   Native_Int_Type           : constant Type_Id  := First_JVM_Id + 17;
end JVM;
