/VM/ori_vmVariables.pas

{

 *   Copyright Š 2011 Dmitriy Zaytsev aka Dim-S

 *   mail: dz@dim-s.net

 *   site: http://orion-lang.org

 *

 *   This file is part of OrionLang.

 *

 * Permission is hereby granted, free of charge, to any person obtaining a copy

 * of this software and associated documentation files (the "Software"), to deal

 * in the Software without restriction, including without limitation the rights

 * to use, copy, modify, merge, publish, distribute, sublicense, and/or sell

 * copies of the Software, and to permit persons to whom the Software is

 * furnished to do so, subject to the following conditions:

 *

 * The above copyright notice and this permission notice shall be included in

 * all copies or substantial portions of the Software.

 *

 * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR

 * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,

 * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE

 * AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER

 * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,

 * OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN

 * THE SOFTWARE.

}

unit ori_vmVariables;



{$ifdef fpc}{$mode delphi}{$endif}

{$H+}



interface



uses

  Classes, SysUtils,

  ori_StrUtils,

  ori_vmTypes,

  ori_vmTables,

  ori_Types,

  ori_Errors,

  ori_StrConsts,

  ori_Parser,

  ori_vmClasses,

  ori_vmMemory,

  ori_vmGC,

  ori_FastArrays,

  ori_HashList,

  ori_HashMap;



  procedure initSGlobalVars();

  procedure finalSGlobalVars();

  

   type

      TOriVariables = class(TOriTable)



         public

            function setVariable(const name: MP_String; val: TOriMemory;

                      ErrPool: TOriErrorPool; const isLink: boolean = false): TOriMemory; overload;

            procedure setVariableFromStack(const name: MP_String; val: TOriMemory; const isLink: boolean = false);



            function setVariable(const name: MP_String; var cnst: TVMConstant;

                aClass: TOriClass; ErrPool: TOriErrorPool; const line: Cardinal): Integer; overload;



            function getVariable(const name: MP_String): Integer;



            procedure FastClear;



            constructor Create;

            destructor Destroy; override;

      end;



   type

     POriVarMan = ^TOriVarMan;

     TOriVarMan = record

        Variables    : TOriVariables;

        InternalIndex: Integer;

        HashCode     : Cardinal;

        Name         : AnsiString;

        Next         : POriVarMan;

     end;



     TOriVarManager = class(TPtrArray)



      protected

          List: THashList;

      public

          function Get(aVariables: TOriVariables; const HashCode: Cardinal; const Name: AnsiString): POriVarMan;

          function GetVar(Item: POriVarMan; aVariables: TOriVariables): TOriMemory;

          function GetReVar(Item: POriVarMan; aVariables: TOriVariables): TOriMemory;



          procedure Clear;

          constructor Create;

     end;



   var

    GlobalVars: TOriVariables;

    VarsManager: TOriVarManager;





implementation



  uses

    ori_ManRes,

    ori_vmConstants;



procedure initSGlobalVars();

begin

  GlobalVars := TOriVariables.Create;

  GlobalVars.Ref_Count := High(Longint)-1;

  GlobalVars.GetCreateValue('globals').ValTable(GlobalVars);

end;



procedure finalSGlobalVars();

begin

  // --todo

  GlobalVars.Delete ( 'globals' );

  GlobalVars.Free;

  VarsManager.Clear;

end;





function TOriVariables.setVariable(const name: MP_String; val: TOriMemory;

          ErrPool: TOriErrorPool; const isLink: boolean = false): TOriMemory;

begin

   if isLink then

   begin

       if not val.IsVarMem then

       begin

          ErrPool.newError(errFatal, MSG_ERR_NOPTR);

          exit;

       end;

          Result         := Self.GetCreate(Name).val;

          Result.UnUse;



          Result.Typ     := mvtPointer;

          Result.Mem.ptr := val.AsPtrMemory;

          val.Use;

          exit;

   end else begin

       Result := Self.GetCreate(Name).val;

       Result.Val(val, false );

   end;

   Result.UseObject;

end;



procedure TOriVariables.setVariableFromStack(const name: MP_String; val: TOriMemory; const isLink: boolean = false);

  var

  r: TOriMemory;

begin

   val.UseObject;

   r := Self.GetCreateValue(Name);

   

   if isLink then

   begin

          r.Typ := mvtPointer;

          r.Mem.ptr := val.AsRealMemory;

          val.Use;

          exit;

   end else

       r.Val( val, false );

end;



function TOriVariables.setVariable(const name: MP_String; var cnst: TVMConstant;

         aClass: TOriClass; ErrPool: TOriErrorPool; const line: Cardinal): Integer;

  var

  r: TOriMemory;

  id: integer;

  x1,x2: MP_String;

  m: POriMethod;

  xClass: TOriClass;

begin



      r := Self.GetCreate(Name).val;



      if cnst.typ = mvtWord then

      begin

         if Pos(defStatic,cnst.str) > 0 then

         begin

             x1 := ori_StrLower( CopyL(cnst.str,defStatic) );

             x2 := CopyR(cnst.str,defStatic);



             if x1 = defSelf then

             begin

                xClass := aClass;

             end else if x1 = defParent then

             begin

                if (aClass = nil) or (aClass.parent = nil) then

                begin

                    xClass := nil;

                end else begin

                    xClass := aClass.parent;

                    aClass := xClass;

                end;

             end else

             begin

                 xClass := ori_vmClasses.findByName(x1);

             end;



             if xClass = nil then

             begin

                ErrPool.newError(errFatal, MSG_ERR_NO_CLASS_OR_OBJECT, line);

                exit;

             end;



             m := xClass.GetInMethod(x2, aClass);

             if (m <> nil) and (m^.typ = omtConst) then

             begin

                TOriConsts.assignVMConstant(cnst, TOriMemory(m^.ptr));

             end else begin

                ErrPool.newError(errFatal, Format(MSG_ERR_NO_CLASS_CONST,[x2,x1]), line);

                exit;

             end;



         end else begin

            id := ori_vmConstants.VM_Constants.getConstant(cnst.str);

            if id <> -1 then

            begin

                cnst := ori_vmConstants.VM_Constants.Constants[ id ];

            end;

         end;

      end;



      r.ValCnst(cnst);

end;



function TOriVariables.getVariable(const name: MP_String): Integer;

begin

      Result := byNameIndex(name);

      if Result = -1 then

      begin

         Result := Count;

         Add(name, TOriMemory.GetMemory(mvtNull));

      end;

end;





{ TVariables }



constructor TOriVariables.Create;

begin

   inherited;

   OrionGC.SetRoot(Self);

end;



destructor TOriVariables.Destroy;

begin

  OrionGC.UnsetRoot(Self);

  inherited;

end;



procedure TOriVariables.FastClear;

begin

  //UnuseObjectAll;

  NoneAll;

end;



{ TOriVarManager }



procedure TOriVarManager.Clear;

  var

  i: integer;

  item,prev: POriVarMan;

begin

   for i := 0 to Count - 1 do

     begin

        item := Self[ i ];

        repeat

           prev := item;

           item := item.Next;

           Dispose(prev);

        until item = nil;

     end;

   inherited Clear;

   List.Clear;

end;



constructor TOriVarManager.Create;

begin

  inherited Create(100);

  List := THashList.Create();

end;



function TOriVarManager.Get(aVariables: TOriVariables; const HashCode: Cardinal;

  const Name: AnsiString): POriVarMan;

  var

  id: integer;

  Item: POriVarMan;

begin

   id := List.getHashValueCrc(HashCode, Name) - 1;

   if id = -1 then

   begin

       id := Self.Count;

       List.setValue(Name, id + 1);



       new(Item);

       Item.Name          := Name;

       Item.Variables     := aVariables;

       Item.Next          := nil;

       Item.InternalIndex := aVariables.GetCreate(Name).id;

       Item.HashCode      := HashCode;



       Result := Item;

       Self.Add( Item );



   end else begin

       Item := Self[ id ];

       Result := Item;

       repeat

          if Item.Variables = aVariables then

          if Item.InternalIndex < aVariables.Count then

          with PTableItem(aVariables.Value[Item.InternalIndex].ID)^ do

               if (real_crc = HashCode) and (key = Name) then

                   exit;



           if Item.Next = nil then

           begin

              New(Item.Next);



              Item := Item.Next;

              Item^.Name := Name;

              Item^.Variables     := aVariables;

              Item^.InternalIndex := aVariables.GetCreate(Name).id;

              Item^.HashCode      := HashCode;

              Item^.Next := nil;

              exit;

           end;



          item := item.Next;

       until item = nil;

   end;

end;





function TOriVarManager.GetReVar(Item: POriVarMan;

  aVariables: TOriVariables): TOriMemory;

  var

  Origin: POriVarMan;

  TableItem: PTableItem;

begin

  Origin := Item;

  Item := Item.Next;

  while Item <> nil do

  begin

    Dispose(Item);

    Item := Item.Next;

  end;

  Origin.Next := nil;

  Origin.Variables := aVariables;

  Origin.InternalIndex := aVariables.GetCreate(Origin.Name).id;

  Result := aVariables.Values^[ Origin.InternalIndex ];

end;



function TOriVarManager.GetVar(Item: POriVarMan;

  aVariables: TOriVariables): TOriMemory;

  var

   Origin: POriVarMan;

   TableItem: PTableItem;

   Cnt: Integer;

begin

  Origin := Item;

  Cnt := 0;

  repeat

     if Item.Variables = aVariables then

     begin

         if Item.InternalIndex < aVariables.Count then

         begin

            Result := aVariables.Values^[ Item.InternalIndex ];

            TableItem := PTableItem(Result.ID);

            if (TableItem.real_crc = Origin.HashCode) {and (TableItem.key = Origin.Name)} then

            begin

              exit;

            end else begin

              Item.InternalIndex := aVariables.GetCreate(Origin.Name).id;

              Result := aVariables.Values^[ Item.InternalIndex ];

              exit;

            end;

         end;

     end;



     if Item.Next = nil then

     begin

              New(Item.Next);

              with Item.Next^ do begin

                Variables     := aVariables;

                InternalIndex := aVariables.GetCreate(Origin.Name).id;

                Name          := Origin.Name;

                HashCode      := Origin.HashCode;

                Next          := nil;

                Result := Variables.Values^[ InternalIndex ];

              end;

              break;

     end;

     Inc(Cnt);

     Item := Item.Next;

     if Cnt > 30 then

     begin

        Result := GetReVar(Origin, aVariables);

        exit;

     end;



  until False;

end;





initialization

   VarsManager := TOriVarManager.Create;



end.