------------------------------------------------------------------------------
--                                                                          --
--             ASIS Tester And iNTerpreter (ASIStant) COMPONENTS            --
--                                                                          --
--                       A S I S T A N T . T A B L E                        --
--                                                                          --
--                                 B o d y                                  --
--                                                                          --
--          Copyright (c) 1997-2006, Free Software Foundation, Inc.         --
--                                                                          --
-- ASIStant  is  free  software;  you can  redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software Foundation;  either version 2,  or  (at your option)  any later --
-- version.  ASIStant is  distributed  in the hope  that it will be useful, --
-- but  WITHOUT  ANY  WARRANTY;  without  even the implied warranty of MER- --
-- CHANTABILITY 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,  51 Franklin Street, Fifth --
-- Floor, Boston, MA 02110-1301, USA.                                       --
--                                                                          --
-- ASIStant  is an evolution of  ASIStint tool that was created by  Vasiliy --
-- Fofanov  as  part  of  a  collaboration  between  Software   Engineering --
-- Laboratory  of the  Swiss  Federal Institute of Technology in  Lausanne, --
-- Switzerland,  and the Scientific Research Computer Center of the  Moscow --
-- University, Russia,  supported by the  Swiss National Science Foundation --
-- grant #7SUPJ048247, "Development of ASIS for GNAT with industry quality" --
--                                                                          --
-- ASIStant  is  distributed as a part of the  ASIS implementation for GNAT --
-- (ASIS-for-GNAT) and is maintained by AdaCore (http://www.adacore.com).   --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Strings;            use  Ada.Strings;
with Ada.Strings.Wide_Fixed; use Ada.Strings.Wide_Fixed;

with ASIStant.String_Handling;
with ASIStant.XTable;        use ASIStant.XTable;

package body ASIStant.Table is

   -----------------------
   -- Local subprograms --
   -----------------------

   function Get_Var_Idx (T : Var_Table; N : Wide_String) return Natural;
   --  Scans for the variable index in table T. Returns 0 if fails.

------------------------------------------------------------------------------
--  This package provides handling of ASIStant language variable tables
------------------------------------------------------------------------------

   function Get_Var_Idx (T : Var_Table; N : Wide_String) return Natural is
   --  Scans for the variable index in table T. Returns 0 if fails.
      Name : Var_Name;
   begin
      Move (N, Name, Right);
      ASIStant.String_Handling.To_Upper (Name);
      for i in 1 .. T.Free - 1 loop
         if T.Table.all (i).Name = Name then
            return i;
         end if;
      end loop;
      return 0;
   end Get_Var_Idx;

   function Get_Var (T : Var_Table; N : Wide_String) return Var_Info is
   --  Scans for the variable in table T. Returns Var_Unknown if fails.
      Idx : constant Integer := Get_Var_Idx (T, N);
   begin
      if Idx = 0 then
         return Var_Unknown;
      else
         return T.Table (Idx);
      end if;
   end Get_Var;

   function Get_Var_Value (VI : Var_Info) return Query_Result is
      QR : Query_Result (VI.VType);
   begin
      case VI.VType is
         when Par_Absent    => null;
         when Par_String    => QR.S   := String_Ptr (VI.SValue);
         when Par_Boolean   => QR.B   := Boolean'Val (VI.IValue);
         when Par_CUnit     => QR.C   := ATICUnit (VI.IValue);
         when Par_CUnitList => QR.CL  := ATICUnitList (VI.IValue);
         when Par_Element   => QR.E   := ATIElem (VI.IValue);
         when Par_ElemList  => QR.EL  := ATIElemList (VI.IValue);
         when Par_Context | Par_Integer
                            => QR.I   := VI.IValue;
         when Par_Line      => QR.L   := ATILine (VI.IValue);
         when Par_Line_List  => QR.LL  := ATILineList (VI.IValue);
         when Par_Relationship
                            => QR.R   := ATIRelship (VI.IValue);
         when Par_Span      => QR.Sp  := ATISpan (VI.IValue);
         when Par_DDA_Array_Component
                            => QR.AC  := DDA_ArrC (VI.IValue);
         when Par_DDA_Array_Component_List
                            => QR.ACL := DDA_ArrCList (VI.IValue);
         when Par_DDA_Record_Component
                            => QR.RC  := DDA_RecC (VI.IValue);
         when Par_DDA_Record_Component_List
                            => QR.RCL := DDA_RecCList (VI.IValue);

         when others => Error (ERR_BADPARAM);
      end case;
      return QR;
   exception
      when others =>
         Error (ERR_INTERNAL, "Get_Var_Value");
   end Get_Var_Value;

   function Store_Var_Value (QR : Query_Result) return Var_Info is
      VI : Var_Info;
   begin
      VI.VType := QR.RType;
      case QR.RType is
         when Par_String    =>
            VI.SValue := String_Ptr (QR.S);
         when Par_Boolean   =>
            VI.IValue := Boolean'Pos (QR.B);
         when Par_CUnit     =>
            ATICUnit (0) := QR.C;
            VI.IValue := 0;
         when Par_CUnitList =>
            ATICUnitList (0) := QR.CL;
            VI.IValue := 0;
         when Par_Element   =>
            ATIElem (0) := QR.E;
            VI.IValue := 0;
         when Par_ElemList  =>
            ATIElemList (0) := QR.EL;
            VI.IValue := 0;
         when Par_Context | Par_Integer =>
            VI.IValue := QR.I;
         when Par_Line      =>
            ATILine (0) := QR.L;
            VI.IValue := 0;
         when Par_Line_List =>
            ATILineList (0) := QR.LL;
            VI.IValue := 0;
         when Par_Relationship =>
            ATIRelship (0) := QR.R;
            VI.IValue := 0;
         when Par_Span      =>
            ATISpan (0) := QR.Sp;
            VI.IValue := 0;
         when Par_DDA_Array_Component =>
            DDA_ArrC (0) := QR.AC;
            VI.IValue := 0;
         when Par_DDA_Array_Component_List =>
            DDA_ArrCList (0) := QR.ACL;
            VI.IValue := 0;
         when Par_DDA_Record_Component =>
            DDA_RecC (0) := QR.RC;
            VI.IValue := 0;
         when Par_DDA_Record_Component_List =>
            DDA_RecCList (0) := QR.RCL;
            VI.IValue := 0;

         when others =>
            Error (ERR_BADPARAM);
      end case;

      return VI;

   exception
      when others => Error (ERR_INTERNAL, "Store_Var_Value");
   end Store_Var_Value;

   procedure Modify_Var (T : in out Var_Table; V : Var_Info) is
   --  Adds/changes variable
      Idx   : constant Integer := Get_Var_Idx (T, V.Name);
      VT    : V_TablePtr;
      VName : Var_Name := V.Name;
   begin
      ASIStant.String_Handling.To_Upper (VName);

      if Idx = 0 then

         if T.Free > T.Max then
            --  Increase length of var. table
            T.Max := T.Max + MAX_VARIABLES;
            VT := new V_Table (1 .. T.Max);

            for i in 1 .. T.Free - 1 loop
               VT (i) := T.Table (i);
            end loop;

            T.Table := VT;
         end if;

         T.Table (T.Free) := V;
         T.Table (T.Free).Name := VName;
         T.Free := T.Free + 1;
      else
         T.Table (Idx) := V;
         T.Table (Idx).Name := VName;
      end if;

   end Modify_Var;

end ASIStant.Table;
