Simba/Units/RUTIS/Rutis_Defs.pas

{/==============================================================================
//==============================================================================

RUTIS-Engine (RunTimeScript-Engine)

Rutis_Defs.pas (part of) RUTIS-Engine

--> This unit contains the types, defines, functions, etc.
    which are used by the RUTIS-Engine

//==============================================================================

Author : Björn Zeutzheim
E-Mail : bjoern@zeutzheim-boppard.de

//==============================================================================

License: Dieses Projekt (RUTIS-Engine) steht unter einer /
         This project is licensed under the
         Creative Commons 3.0 BY-NC-SA (German) License

Diese Lizens beinhaltet                  / This license includes:
-> Namensnennung                         / Attribution
-> Keine kommerzielle Nutzung            / Noncommercial
-> Weitergabe unter gleichen Bedingungen / Share Alike

Ein ausformulierter Lizensvertrag ist über folgende Adresse erreichbar:
The Legal Code (the full license) can be read at the following adress:
> http: //creativecommons.org/licenses/by-nc-sa/3.0/de/

//==============================================================================
//==============================================================================}

Unit Rutis_Defs;

Interface

{$i Delphi_Versions.inc}

{$IFDEF FPC}
  {$mode objfpc}{$H+}
{$ENDIF}

Uses
  lclintf, {$ifdef DELPHI_7_UP}Variants, {$endif}
  SysUtils, Rutis_Stack;

 //====================================================================
 //====================================================================

Type
  TOperatorCode = (ocEqual, ocGreater, ocLess, ocGEqual, ocLEqual, ocUnequal{, ocAnd, ocOr, ocXOr, ocNot});

  TVariantArray = Array Of Variant;
  PVariantArray = ^TVariantArray;

  //====================================================================
{$REGION 'Exceptions'}
  ERutisCompilerError = Class(Exception)
  Public
    ENamespace  : String;
    ELine       : Integer;
    EChrPos     : Integer;
    Constructor Create(Msg, Namespace : String); Overload;
    Constructor Create(Msg, Namespace : String; CLine, CPos : Integer); Overload;
    Constructor CreateFmt(Const Msg : String; Const Args : Array Of Const; Namespace : String); Overload;
    Constructor CreateFmt(Const Msg : String; Const Args : Array Of Const; Namespace : String; CLine, CPos : Integer); Overload;
    Procedure Assign(E : ERutisCompilerError);
  End;

{$ENDREGION}

//====================================================================
{$REGION 'Commands'}
//====================================================================
//====================================================================
//Byte-Code Commands

Type
  TRutisCmd = (_gen, _gen1, _gen2, _gen4,
    _lod, _sto, _mov,                    // Stack Variables
    _lodp, _stop,
    _at, _at2, _Ptr, _PtrP, _CPtr,
    _CopyAStr, _CopyWStr, _StoAStr, _StoWStr,
    _SMem, _MemS,
    _getCh, _setCh, _GASL, _SASL, _GWSL, _SWSL,
    _pupo,
    _call, _ret, _ext,                   // Call
    _add, _sub, _mult, _div, _mod, _ets, // math
    _inc, _conv,                         // other math
    _opr, _And, _Or, _XOr, _Not,         // Opr
    _jmp, _JZ, _JL, _JG, _JLZ, _JGZ,
    _wri, _lodr, _RStr,                  // others (write,ressource)
    _nocmd);

Const
  cCmd  : Array[TRutisCmd] Of ShortString   = (
    'gen', 'gen1', 'gen2', 'gen4',
    'lod', 'sto', 'mov',                       // Stack Global Vriables
    'lodp', 'stop',                            {'movp',}
    'at', 'at2', 'ptr', 'ptrp', 'cptr',
    'castr', 'cwstr', 'sastr', 'swstr',
    'smem', 'meml',
    'getch', 'setch', 'getasl', 'setasl', 'getwsl', 'setwsl',
    'pupo',
    'call', 'ret', 'ext',                      // Call
    'add', 'sub', 'mult', 'div', 'mod', 'ets', // math
    'inc', 'conv',                             // other math
    'opr', 'and', 'or', 'xor', 'not',          // Opr
    'jmp', 'jz', 'jl', 'jg', 'jlz', 'jgz',
    'wri', 'lodr', 'rstr',                     // others (write,ressource)
    'nop');

  CmdParamCount  : Array[TRutisCmd] Of Byte = (
    1, 1, 1, 1,
    3, 3, 3,                       // Stack Global Vriables
    3, 3,
    0, 0, 2, 2, 0,
    0, 0, 3, 3,
    0, 0,
    0, 0, 0, 0, 0, 0,
    1,
    2, 1, 2,                          // Call
    2, 2, 1, 1, 1, 1,                 // math
    3, 2,                             // other math
    3, 1, 1, 1, 2,                    // Opr
    1, 2, 2, 2, 2, 2,
    1, 2, 1,                          // others (write,ressource)
    0);

Const
  LongCMD  : Array[TRutisCmd] Of ShortString = (
    'GenVar     ', 'GenByte    ', 'GenWord    ',
    'GenCardinal', 'Load       ', 'Store      ',
    'Move       ', 'LoadFromPtr', 'StoreAtPtr ',
    'GetAddr    ', 'GetAddr2   ', 'GetPtr     ',
    'PtrP       ', 'CheckPtr   ',
    'CopyAStr   ', 'CopyWStr   ',
    'StoreAStr  ', 'StoreWStr  ',
    'ScaleMem   ', 'MemSize    ',
    'GetChar    ', 'SetChar    ',
    'GetAStrLen ', 'SetAStrLen ',
    'GetWStrLen ', 'SetWStrLen ',
    'PushOrPop  ',
    'Call       ', 'Return     ', 'ExtCall    ',
    'Add        ', 'Sub        ', 'Mult       ',
    'Div        ', 'Modulo     ', 'EnumToSet  ',
    'Inc        ', 'Convert    ',
    'Operand    ', 'And        ', 'Or         ',
    'XOr        ', 'Not        ',
    'Jump       ', 'JumpFalse  ',
    'JmpLess    ', 'JmpGreater ',
    'JmpLessZ   ', 'JmpGreaterZ',
    'Write      ', 'LoadRes    ', 'LoadResStr ',
    'NoOperation');

Type
  TRutisScriptCmd = Record
    Cmd       : TRutisCmd;     // Befehl
    P1        : Integer;       // Parameter 1
    P2        : Integer;       // Parameter 2
    P3        : Word;          // Parameter 3
    CodeLine  : Smallint;      // Debug-Zeile
    //StatementID : Word;      // Debug-Statement ID
  End;

  TRutisCode = Array Of TRutisScriptCmd;
  PRutisCode = ^TRutisCode;

{$ENDREGION}

//====================================================================
{$REGION 'Rutis-Internal-Types'}
//====================================================================
//====================================================================
// Rutis-Internal-Types

Type
  TRutisIntType  = (
    intByte, intShortInt,
    intWord, intSmallint,
    intCardinal, intInteger,
    intSingle, intDouble, intExtended,
    intBoolean, intPointer, intArray, intRecord,
    //intEnum, intSet1, intSet2, intSet4, intSet8, intSetN,
    intEnum, intSet,
    intShortString, intAChar, intAString, intWChar, intWString,
    intMethod, intObjMethod,
    intNone);
  TRutisIntTypes = Set Of TRutisIntType;

Const
  IntTypeSizes  : Array [TRutisIntType] Of Word =
    (1, 1,
    2, 2,
    4, 4,
    //intSingle, intDouble, intExtended,
    4, 8, 10,
    //intBoolean, intPointer, intArray, intRecord,
    1, 4, 4, 0,
    //intEnum, intSet,
    1, 4,
    //intShortString, intAChar, intAString, intWChar, intWString,
    256, 1, 4, 2, 4,
    4, 8,
    0);
  IntTypeAlignSizes  : Array [TRutisIntType] Of Word =
    (1, 1,
    2, 2,
    4, 4,
    //intSingle, intDouble, intExtended,
    4, 8, 16,
    //intBoolean, intPointer, intArray, intRecord,
    1, 4, 4, 1,
    //intEnum, intSet,
    1, 4,
    //intShortString, intAChar, intAString, intWChar, intWString,
    1, 1, 4, 2, 4,
    4, 8,
    1);

  InternalIntegers  : TRutisIntTypes = [intByte..intInteger, intEnum];
  InternalFloats  : TRutisIntTypes  = [intSingle, intDouble, intExtended];
  InternalNumbers  : TRutisIntTypes = [intByte..intInteger, intEnum] + [intSingle, intDouble, intExtended];

  RutisVarTypeTOString  : Array [TRutisIntType] Of String =
    ('Byte', 'ShortInt',
    'Word', 'Smallint',
    'Cardinal', 'Integer',
    'Single', 'Double', 'Extended',
    'Boolean', 'Pointer', 'Array', 'Record',
    'Enumeration', 'Set',
    'ShortString', 'AnsiChar', 'AnsiString', 'WideChar', 'WideString',
    'Method', 'Method-of-Object',
    'None');

  RutisTypeConvertTable  : Array [TRutisIntType] Of TRutisIntTypes =
    ({intByte}[intByte..intExtended, intBoolean, intAChar, intEnum],
    {intShortInt}[intByte..intExtended, intBoolean, intAChar, intEnum],
    {intWord}[intByte..intExtended, intBoolean, intAChar, intEnum],
    {intSmallint}[intByte..intExtended, intBoolean, intAChar, intEnum],
    {intCardinal}[intByte..intExtended, intBoolean, intAChar, intMethod, intEnum],
    {intInteger}[intByte..intExtended, intBoolean, intAChar, intMethod, intEnum],
    //=============================
    {intSingle}[intSingle..intExtended],
    {intDouble}[intSingle..intExtended],
    {intExtended}[intSingle..intExtended],
    //=============================
    {intBoolean}[intByte..intInteger, intBoolean],
    {intPointer}[intCardinal, intInteger, intPointer, intArray, intEnum],
    {intArray}[intCardinal, intPointer, intArray],
    {intRecord}[],
    {intEnum}[intByte..intInteger, intSet],
    {intSet}[intByte..intInteger],
    {intShortString}[intAString],
    {intAChar}[intByte..intInteger, intAString{, intShortString}],
    {intAString}[intCardinal, intPointer, intArray, intWString],
    {intWChar}[intWord..intInteger, intAString, intWString],
    {intWString}[intCardinal, intPointer, intAString],
    {intMethod}[intCardinal, intInteger, intPointer],
    {intObjMethod}[intCardinal, intInteger, intPointer],
    {intNone}[]);

{$ENDREGION}

//====================================================================
{$REGION 'Rutis Stack'}
Type
  TRutisStack = Class(TRutisBasicStack)
  Public
    Function ReadToStr(intType : TRutisIntType; Adr : Integer) : String;
    Function ReadToVariant(intType : TRutisIntType; Adr : Integer) : Variant;
    Procedure WriteFromVariant(intType : TRutisIntType; Adr : Integer; Val : Variant);
  End;

{$ENDREGION}

//====================================================================
{$REGION 'Rutis Declarations'}
//====================================================================
//====================================================================
//Rutis Declarations

Type
  TRutisScriptData = Class;

  TRutisDecl       = Class
  Public
    Name  : String;
  End;

  TRutisDeclArray = Array Of TRutisDecl;
  PRutisDeclArray = ^TRutisDeclArray;

  //==============================================================================

  TRutisNamespace = Class(TRutisDecl)
  Public
    Declarations  : TRutisDeclArray;
    CodeFile      : String;
    CodeStart,
    CodeEnd       : Integer;
    Destructor Destroy; Override;
    Procedure AddDeclaration(Decl : TRutisDecl);
    Function GetDeclaration(AName : String) : TRutisDecl; Overload;
    Function GetDeclaration(AName : String; Exclude : Array Of TRutisDecl) : TRutisDecl; Overload;
    Function GetDeclarationID(AName : String) : Integer;
  End;

  TRutisNamespaceArray = Array Of TRutisNamespace;
  PRutisNamespaceArray = ^TRutisNamespaceArray;

  //==============================================================================

  TRutisTypeDecl      = Class;

  TRutisTypeDeclClass = Class Of TRutisTypeDecl;
  TRutisTypeArray     = Array Of TRutisTypeDecl;

  TRutisTypeDecl = Class(TRutisDecl)
  Private
    Function GetAlignSize : Byte; Virtual;
  Public
    Size          : Word;
    ExplicitCast  : Boolean;
    Function ConvertTo(WantType : TRutisTypeDecl; ScriptData : TRutisScriptData) : Boolean; Virtual;
    Function GetInternalType : TRutisIntType; Virtual;
    Function InternalType : TRutisIntType;
    Property AlignSize  : Byte Read GetAlignSize;
  End;

  //==============================================================================

  TRutisVarDecl = Class(TRutisDecl)
    VarType   : TRutisTypeDecl;
    Address   : Integer;
    Level     : Byte;
    isConst   : Boolean;
    ConstVal  : Variant;
  End;

  //==============================================================================
  TRutisParamInfo = Record
    Data     : Pointer;
    Adr      : Integer;
    IntType  : TRutisIntType;
    Size     : Word;
  End;
  PRutisParamInfo = ^TRutisParamInfo;

  TRutisParamInfoArray = Array Of TRutisParamInfo;
  PRutisParamInfoArray = ^TRutisParamInfoArray;

  TExtVariMethod  = Procedure(Params : PVariantArray; Result : PVariant);
  TExtStackMethod = Procedure(Params : PRutisParamInfoArray; Result : PRutisParamInfo);

  //==============================================================================

  TRutisTypeCopy = Class(TRutisTypeDecl)
  Public
    CopyType  : TRutisTypeDecl;
    Function GetInternalType : TRutisIntType; Override;
  End;

  TRutisVarType = Class(TRutisTypeDecl)
  Public
    IntType  : TRutisIntType;
    Function GetInternalType : TRutisIntType; Override;
  End;

  TEnumVal = Record
    Name   : String;
    Value  : Integer;
  End;

  TRutisEnumType = Class(TRutisTypeDecl)
  Public
    Enums  : Array Of TEnumVal;
    Function GetInternalType : TRutisIntType; Override;
  End;

  TRutisSetType = Class(TRutisTypeDecl)
  Public
    EnumType  : TRutisEnumType;
    Function GetInternalType : TRutisIntType; Override;
    Function ConvertTo(WantType : TRutisTypeDecl; ScriptData : TRutisScriptData) : Boolean; Override;
  End;

  TRutisPointerType = Class(TRutisTypeDecl)
  Public
    PointerType  : TRutisTypeDecl;
    Constructor Create;
    Function GetInternalType : TRutisIntType; Override;
  End;

  TRutisArrayType = Class(TRutisTypeDecl)
  Public
    ArrayType  : TRutisTypeDecl;
    Constructor Create;
    Function GetInternalType : TRutisIntType; Override;
  End;

  TRutisStructType = Class(TRutisTypeDecl)
  Private
    Function GetAlignSize : Byte; Override;
  Public
    StructTypes  : Array Of TRutisVarDecl;
    IsPacked     : Boolean;
    fAlignSize   : Byte;
    Destructor Destroy; Override;
    Function GetInternalType : TRutisIntType; Override;
    Function ConvertTo(WantType : TRutisTypeDecl; ScriptData : TRutisScriptData) : Boolean; Override;
    Function VarID(VarName : String) : Integer;
  End;

  TRutisClassType = Class(TRutisTypeDecl)
  Public
    IsExternal   : Boolean;
    ClassStruct  : TRutisStructType;
    ParentClass  : TRutisClassType;
    Constructor Create;
    Function GetInternalType : TRutisIntType; Override;
  End;

  TRutisTypeLink = Record
    Name          : String;
    Size          : Word;
    InternalType  : TRutisIntType;
    TypeData      : TRutisTypeDecl;
    isVarParam    : Boolean;
  End;
  TRutisMethodParamArray = Array Of TRutisTypeLink;

  TRutisMethodType = Class(TRutisTypeDecl)
  Public
    Method_Name  : String;
    Description  : String;

    IsFunction    : Boolean;
    Overloaded    : Boolean;
    Params        : TRutisMethodParamArray;
    ParamsSize    : Word;
    MethodResult  : TRutisTypeLink;

    Declarations   : TRutisDeclArray;
    MethodTableID  : Integer;
    Constructor Create;
    Destructor Destroy; Override;
    Function GetInternalType : TRutisIntType; Override;
  End;

  TRutisExtMethodType = Class(TRutisMethodType)
  Public
    VariMethod   : TExtVariMethod;
    StackMethod  : TExtStackMethod;
  End;

  TRutisDllMethodType = Class(TRutisMethodType)
  Public
    ProcAddress  : Pointer;
    DllName      : String;
    ProcName     : String;
  End;

{$ENDREGION}

//====================================================================
//====================================================================

  TIdentType = (itVar, itPVar, itConst, itFixVal, itMethod, itError);

  TAnalyzeIdentInfo = Record
  //AllowedIdents  : TRutisIntTypes;
    TypeData          : TRutisTypeDecl;
    InternalType      : TRutisIntType;
    VarDecl           : TRutisVarDecl;
    Adr, Lvl{, Size}  : Integer;
    IdentType         : TIdentType;
  End;

  //====================================================================

  TRutisCallStackItem = Record
    CallLine   : Integer;
    StackBase  : Integer;
    Level      : Integer;
  End;
  TRutisCallStack = Array Of TRutisCallStackItem;

  //====================================================================

  TMemoryRange = Record
    Start  : PByte;
    Size   : Integer;
  End;

  //====================================================================

  TRutisErrorType = (etHint, etWarning, etCompilerError, etRuntimeError);

  TErrorProcedure = Procedure(s : String; ErrorType : TRutisErrorType) Of Object;

  //====================================================================

  TRutisScriptData = Class
  Private
    Function GetDeclListCount : Integer;
    Function GetDeclListItem(Index : Integer) : TRutisDecl;
    Procedure SetDeclListItem(Index : Integer; Value : TRutisDecl);
    Function IsCompiled : Boolean;
  Public
    ScriptName     : String;
    Code           : TRutisCode;
    Ressources     : TRutisStack;
    MethodTable    : Array Of TRutisMethodType;
    //========================
    Running        : Boolean;
    Paused         : Boolean;
    Stack          : TRutisStack;
    CallStack      : TRutisCallStack;
    AddrRanges     : Array Of TMemoryRange;
    //========================
    CodeLine       : Integer;
    CurrCmd        : TRutisScriptCmd;
    //========================
    CompilerLine   : Integer;
    CodeInsertPos  : Integer;
    Namespaces     : TRutisNamespaceArray;
    //========================
    Constructor Create(StackBlockSize : Cardinal = 1024);
    Destructor Destroy; Override;
    Procedure Clear;
    Procedure FreeExtData;
    //========================
    Function GenCodeV(Command : TRutisCmd; Param1, Param2, Param3 : Variant; LineDiff : Integer = 0) : Integer;
    Function GenCode(Command : TRutisCmd; Param1, Param2 : Integer; Param3 : Word; LineDiff : Integer = 0) : Integer;
    Procedure InsertCodeV(Index : Integer; Command : TRutisCmd; Param1, Param2, Param3 : Variant; LineDiff : Integer = 0);
    Procedure InsertCode(Index : Integer; Command : TRutisCmd; Param1, Param2 : Integer; Param3 : Word; LineDiff : Integer = 0);
    Procedure DeleteInstruction(index : Integer);
    //========================
    Function GetNamespace(Name : String) : TRutisNamespace;
    Procedure AddDeclaration(Decl : TRutisDecl; Namespace : String);
    Function GetDeclarationID(Name : String; Namespace : String) : Integer; //overload;
    Function GetDeclaration(Name : String; Namespace : String) : TRutisDecl; Overload;
    Function GetDeclaration(Name : String; Namespace : String; Exclude : Array Of TRutisDecl) : TRutisDecl; Overload;
    {Function GetDeclarationID(Name: String): Integer; overload;
    Function GetDeclaration(Name: String): TRutisDecl; overload;}
    //========================
    Property Compiled  : Boolean Read IsCompiled;
    Property DeclarationCount  : Integer Read GetDeclListCount;
    Property DeclarationList[Index  : Integer]  : TRutisDecl Read GetDeclListItem Write SetDeclListItem;
  End;

  PRutisScriptData = ^TRutisScriptData;

 //====================================================================
 //====================================================================

{$ifndef FPC}
//Function OutputDebugString(lpDebugStrA : PAnsiChar) : Cardinal; Stdcall;
//  External 'kernel32.dll' Name 'OutputDebugStringA';
{$endif}


//==============================================================================
//==============================================================================
{$ifndef FPC}
Function DynamicDllCall(Dll : String; Const Name : String; HasResult : Boolean; Var Returned : Cardinal; Const Parameters : Array Of Pointer) : Boolean; Overload;
Function DynamicDllCall(hDll : THandle; Const Name : String; HasResult : Boolean; Var Returned : Cardinal; Const Parameters : Array Of Pointer) : Boolean; Overload;
Function DynamicDllCall(Proc : Pointer; HasResult : Boolean; Var Returned : Cardinal; Const Parameters : Array Of Pointer) : Boolean; Overload;
{$endif}
//====================================================================
//====================================================================
Function SymToStr(Sym : TRutisCmd) : String;
Function StrToSym(Sym : String) : TRutisCmd;
//====================================================================
Function FindDeclarationID(Name : String; Decl : PRutisDeclArray) : Integer;
Function FindDeclaration(Name : String; Decl : PRutisDeclArray) : TRutisDecl;
//====================================================================

//====================================================================
//====================================================================
Implementation
//====================================================================
//====================================================================

{$ifndef FPC}
// Calls a function from a library.
// if it's not loaded yet, it will call LoadLibrary() to load it.
Function DynamicDllCall(Dll : String; Const Name : String; HasResult : Boolean; Var Returned : Cardinal; Const Parameters : Array Of Pointer) : Boolean;
Var
  Proc  : Pointer;
  x, n  : Integer;
  p     : Pointer;
  hDll  : THandle;
Begin
  Result   := False;
  Returned := 0;
  //Get Libary
  hDll     := GetModuleHandle(PChar(Dll));
  If hDll = 0 Then
    hDll := LoadLibrary(PChar(Dll));
  If hDll = 0 Then
    exit;
  //Get Proc-Address
  Proc := GetProcAddress(hDll, PChar(Name));
  If not Assigned(Proc) Then
    exit;
  //Load Parameters
  n    := High(Parameters);
  If n > -1 Then
  Begin
    x := n;
    Repeat
      p := Parameters[x];
      Asm
        PUSH p
      End;
      Dec(x);
    Until x = -1;
  End;
  //Call Procedure
  Asm
    CALL Proc
  End;
  //Get Result
  If HasResult Then
  Begin
    Asm
      MOV p, EAX
    End;
    Returned := Cardinal(p);
  End;
  Result := True;
End;
// Calls a function from a loaded library
Function DynamicDllCall(hDll : THandle; Const Name : String; HasResult : Boolean; Var Returned : Cardinal; Const Parameters : Array Of Pointer) : Boolean;
Var
  Proc  : Pointer;
  x, n  : Integer;
  p     : Pointer;
Begin
  Result   := False;
  Returned := 0;
  //Get Proc-Address
  Proc     := GetProcAddress(hDll, PChar(Name));
  If not Assigned(Proc) Then
    exit;
  //Load Parameters
  n        := High(Parameters);
  If n > -1 Then
  Begin
    x := n;
    Repeat
      p := Parameters[x];
      Asm
        PUSH p
      End;
      Dec(x);
    Until x = -1;
  End;
  //Call Procedure
  Asm
    CALL Proc
  End;
  //Get Result
  If HasResult Then
  Begin
    Asm
      MOV p, EAX
    End;
    Returned := Cardinal(p);
  End;
  Result := True;
End;
// Calls a function from a Proc-Address
Function DynamicDllCall(Proc : Pointer; HasResult : Boolean; Var Returned : Cardinal; Const Parameters : Array Of Pointer) : Boolean;
Var
  x, n  : Integer;
  p     : Pointer;
Begin
  Result   := False;
  Returned := 0;
  //Check Proc-Address
  If not Assigned(Proc) Then
    exit;
  //Load Parameters
  n        := High(Parameters);
  If n > -1 Then
  Begin
    x := n;
    Repeat
      p := Parameters[x];
      Asm
        PUSH p
      End;
      Dec(x);
    Until x = -1;
  End;
  //Call Procedure
  Asm
    CALL Proc
  End;
  //Get Result
  If HasResult Then
  Begin
    Asm
      MOV p, EAX
    End;
    Returned := Cardinal(p);
  End;
  Result := True;
End;

{$endif}


//==============================================================================
 { ERutisCompilerError }

Constructor ERutisCompilerError.Create(Msg, Namespace : String);
Begin
  Inherited Create(Msg);
  ENamespace := Namespace;
  ELine      := -1;
  EChrPos    := 0;
End;

Constructor ERutisCompilerError.Create(Msg, Namespace : String; CLine, CPos : Integer);
Begin
  Inherited Create(Msg);
  ENamespace := Namespace;
  ELine      := CLine;
  EChrPos    := CPos;
End;

Constructor ERutisCompilerError.CreateFmt(Const Msg : String; Const Args : Array Of Const; Namespace : String);
Begin
  Inherited CreateFmt(Msg, Args);
  ENamespace := Namespace;
  ELine      := -1;
  EChrPos    := 0;
End;

Constructor ERutisCompilerError.CreateFmt(Const Msg : String; Const Args : Array Of Const; Namespace : String; CLine, CPos : Integer);
Begin
  Inherited CreateFmt(Msg, Args);
  ENamespace := Namespace;
  ELine      := CLine;
  EChrPos    := CPos;
End;

Procedure ERutisCompilerError.Assign(E : ERutisCompilerError);
Begin
  Message    := E.Message;
  ENamespace := E.ENamespace;
  ELine      := E.ELine;
  EChrPos    := E.EChrPos;
End;

//====================================================================
{$REGION 'Rutis Declarations'}
//====================================================================

//====================================================================
 { TRutisNamespaceDecl }

Destructor TRutisNamespace.Destroy;
Var
  i  : Integer;
Begin
  For I := 0 To high(Declarations) Do
    Declarations[i].Free;
  //SetLength(Declarations, 0);
  Inherited;
End;

Procedure TRutisNamespace.AddDeclaration(Decl : TRutisDecl);
Begin
  If Decl = nil Then exit;
  SetLength(Declarations, Length(Declarations) + 1);
  Declarations[high(Declarations)] := Decl;
  Decl.Name := UpperCase(Decl.Name);
End;

Function TRutisNamespace.GetDeclaration(AName : String) : TRutisDecl;
Var i  : Integer;
Begin
  Result := nil;
  AName  := UpperCase(AName);
  For I := high(Declarations) Downto 0 Do
    If Declarations[i].Name = AName Then
    Begin
      Result := Declarations[i];
      exit;
    End;
End;

Function TRutisNamespace.GetDeclaration(AName : String; Exclude : Array Of TRutisDecl) : TRutisDecl;
Var
  i, j      : Integer;
  Excluded  : Boolean;
Begin
  Result := nil;
  AName  := UpperCase(AName);
  For I := high(Declarations) Downto 0 Do
    If (Declarations[i].Name = AName) Then
    Begin
      Excluded := False;
      For j := 0 To high(Exclude) Do
        If Declarations[i] = Exclude[j] Then
        Begin
          Excluded := True;
          break;
        End;
      If Excluded Then Continue;
      Result := Declarations[i];
      exit;
    End;
End;

Function TRutisNamespace.GetDeclarationID(AName : String) : Integer;
Begin
  AName := UpperCase(AName);
  For Result := high(Declarations) Downto 0 Do
    If Declarations[Result].Name = AName Then
      exit;
  Result := -1;
End;

//====================================================================
 { TRutisTypeDecl }

Function TRutisTypeDecl.ConvertTo(WantType : TRutisTypeDecl; ScriptData : TRutisScriptData) : Boolean;
Begin
  Result := True;
  If (WantType = self) Then exit;
  If not ExplicitCast Then
  Begin
    If (WantType.InternalType = InternalType) and not (InternalType in [intRecord]) Then exit;
    Result := False;
    If not (WantType.InternalType in RutisTypeConvertTable[InternalType]) Then exit;
    ScriptData.GenCodeV(_conv, InternalType, WantType.InternalType, 0);
    Result := True;
  End
  Else
    Result := False;
End;

Function TRutisTypeDecl.GetAlignSize : Byte;
Begin
  Result := IntTypeAlignSizes[InternalType];
End;

Function TRutisTypeDecl.GetInternalType : TRutisIntType;
Begin
  Result := intNone;
End;

Function TRutisTypeDecl.InternalType : TRutisIntType;
Begin
  If self = nil Then
    Result := intNone
  Else
    Result := GetInternalType;
End;

//====================================================================
 { TRutisTypeCopy }

Function TRutisTypeCopy.GetInternalType : TRutisIntType;
Begin
  Result := self.CopyType.InternalType;
End;

//====================================================================
 { TRutisVarType }

Function TRutisVarType.GetInternalType : TRutisIntType;
Begin
  Result := IntType;
End;

//==============================================================================
 { TRutisEnumType }

Function TRutisEnumType.GetInternalType : TRutisIntType;
Begin
  Result := intEnum;
End;

//==============================================================================
 { TRutisSetType }

Function TRutisSetType.GetInternalType : TRutisIntType;
Begin
  Result := intSet;
End;

Function TRutisSetType.ConvertTo(WantType : TRutisTypeDecl; ScriptData : TRutisScriptData) : Boolean;
Begin
  Result := True;
  If (WantType = self) Then exit;
  If not ExplicitCast Then
  Begin
    If (WantType.InternalType = InternalType) and
      (WantType.Size = Size) Then
      exit;
    Result := False;
    If not (WantType.InternalType in RutisTypeConvertTable[InternalType]) Then exit;
    If (WantType.Size <> Size) Then exit;
    Case Size Of
      1  : ScriptData.GenCodeV(_conv, intByte, WantType.InternalType, 0);
      2  : ScriptData.GenCodeV(_conv, intWord, WantType.InternalType, 0);
      4  : ScriptData.GenCodeV(_conv, intCardinal, WantType.InternalType, 0);
    Else
      exit;
    End;
    Result := True;
  End
  Else
    Result := False;
End;

//====================================================================
 { TRutisPointerType }

Constructor TRutisPointerType.Create;
Begin
  Size := 4;
End;

Function TRutisPointerType.GetInternalType : TRutisIntType;
Begin
  Result := intPointer;
  //  Result := PointerType.InternalType;
End;

//====================================================================
{ TRutisArrayType }

Constructor TRutisArrayType.Create;
Begin
  Size := 4;
End;

Function TRutisArrayType.GetInternalType : TRutisIntType;
Begin
  Result := intArray;
  //Result := ArrayType.InternalType;
End;

//====================================================================
{ TRutisStructType }

Destructor TRutisStructType.Destroy;
Var i  : Integer;
Begin
  For i := 0 To high(StructTypes) Do
    StructTypes[i].Free;
  Inherited;
End;

Function TRutisStructType.GetInternalType : TRutisIntType;
Begin
  Result := intRecord;
End;

Function TRutisStructType.ConvertTo(WantType : TRutisTypeDecl; ScriptData : TRutisScriptData) : Boolean;
Begin
  Result := WantType = self;
End;

Function TRutisStructType.GetAlignSize : Byte;
Begin
  Result := fAlignSize;
End;

Function TRutisStructType.VarID(VarName : String) : Integer;
Begin
  VarName := UpperCase(VarName);
  For Result := 0 To high(StructTypes) Do
    If StructTypes[Result].Name = VarName Then
      exit;
  Result := -1;
End;

//==============================================================================
 { TRutisClassType }

Constructor TRutisClassType.Create;
Begin
  Size := 4;
End;

Function TRutisClassType.GetInternalType : TRutisIntType;
Begin
  Result := intPointer;
End;

//====================================================================
 { TRutisMethodType }

Constructor TRutisMethodType.Create;
Begin
  MethodTableID := -1;
End;

Destructor TRutisMethodType.Destroy;
Var i  : Integer;
Begin
  For i := 0 To high(Declarations) Do
    Declarations[i].Free;
  Inherited;
End;

Function TRutisMethodType.GetInternalType : TRutisIntType;
Begin
  Result := intMethod;
  //Result := ResultType.InternalType;
End;

{$ENDREGION}

//==============================================================================
{$REGION 'Rutis Stack'}
//==============================================================================

Function TRutisStack.ReadToStr(intType : TRutisIntType; Adr : Integer) : String;
Begin
  If Adr >= Top Then
  Begin
    Result := 'NA';
    exit;
  End;
  Case intType Of
    intByte  : Result     := IntToStr(ReadByte(Adr));
    intShortInt  : Result := IntToStr(ReadShortInt(Adr));
    intWord  : Result     := IntToStr(ReadWord(Adr));
    intSmallint  : Result := IntToStr(ReadSmallint(Adr));
    intCardinal  : Result := IntToStr(ReadCardinal(Adr));
    intInteger  : Result  := IntToStr(ReadInteger(Adr));
    intSingle  : Result   := FloatToStr(ReadSingle(Adr));
    intDouble  : Result   := FloatToStr(ReadDouble(Adr));
    intExtended  : Result := FloatToStr(ReadExtended(Adr));
    intPointer  : Result  := IntToHex(ReadCardinal(Adr), 6);
    intArray  : Result    := IntToHex(ReadCardinal(Adr), 6);
    intRecord  : Result   := 'RECORD';
    intEnum  : Result     := IntToStr(ReadByte(Adr));
    intBoolean  : If ReadByte(Adr) = 0 Then
        Result := 'false'
      Else
        Result := 'true';
    intAChar  : Result := ReadAChar(Adr);
    intAString :
    Begin
      Try
        Result := Ansistring(ReadString(Adr - 4));
      Except
        On E : EAccessViolation Do
        Begin
          If Adr = 0 Then Result := '';
        End;
      End;
    End;
    intMethod  : Result := '@' + IntToStr(ReadCardinal(Adr));
    //intMethod    : Result := 'METHOD';//Result := '@' + ;
  Else
    Result := '';
  End;
End;

Function TRutisStack.ReadToVariant(intType : TRutisIntType; Adr : Integer) : Variant;
Begin
  If Adr >= Top Then
  Begin
    Result := 0;
    exit;
  End;
  Case intType Of
    intByte  : Result := ReadByte(Adr);
    intShortInt  : Result := ReadShortInt(Adr);
    intWord  : Result := ReadWord(Adr);
    intSmallint  : Result := ReadSmallint(Adr);
    intCardinal  : Result := ReadCardinal(Adr);
    intInteger  : Result := ReadInteger(Adr);
    intSingle  : Result := ReadSingle(Adr);
    intDouble  : Result := ReadSingle(Adr);
    intExtended  : Result := ReadSingle(Adr);
    intPointer  : Result := ReadCardinal(Adr);
    //intArray     : Result := ReadCardinal(Adr);
    intRecord  : Result := 0;
    intBoolean  : Result := Boolean(GetByte(Adr));
    intAString  : Result := Ansistring(GetString(Adr));
    intAChar  : Result := ReadAChar(Adr);
    intWChar  : Result := ReadWChar(Adr);
    intMethod  : Result := 0;
  Else
    Result := 0;
  End;
End;

Procedure TRutisStack.WriteFromVariant(intType : TRutisIntType; Adr : Integer; Val : Variant);
Begin
  If Adr >= Top Then exit;
  Case intType Of
    intByte  : WriteByte(Adr, Val);
    intShortInt  : WriteShortInt(Adr, Val);
    intWord  : WriteWord(Adr, Val);
    intSmallint  : WriteSmallint(Adr, Val);
    intCardinal,
    intPointer,
    intArray  : WriteCardinal(Adr, Val);
    intInteger  : WriteInteger(Adr, Val);
    intSingle  : WriteSingle(Adr, Val);
    intDouble  : WriteSingle(Adr, Val);
    intExtended  : WriteSingle(Adr, Val);
    intBoolean  : WriteByte(Adr, Val);
    intAString  : WriteString(Adr, Pointer(Ansistring(Val)));
    intAChar  : WriteAChar(Adr, AnsiChar(Byte(Val)));
    intWChar  : WriteWChar(Adr, Widechar(Word(Val)));
  End;
End;

{$ENDREGION}

//==============================================================================
//==============================================================================

Function SymToStr(Sym : TRutisCmd) : String;
Begin
  Result := cCmd[Sym];
End;

Function StrToSym(Sym : String) : TRutisCmd;
Begin
  For Result := _gen To _nocmd Do
    If cCmd[Result] = Sym Then
      exit;
  Result := _nocmd;
End;

//==============================================================================
//==============================================================================

Function FindDeclarationID(Name : String; Decl : PRutisDeclArray) : Integer;
Begin
  Name := UpperCase(Name);
  For Result := 0 To high(Decl^) Do
    If Decl^[Result].Name = Name Then
      exit;
  Result := -1;
End;

Function FindDeclaration(Name : String; Decl : PRutisDeclArray) : TRutisDecl;
Var id  : Integer;
Begin
  id := FindDeclarationID(Name, Decl);
  If id >= 0 Then
    Result := Decl^[id]
  Else
    Result := nil;
End;

//==============================================================================
//==============================================================================
 { TRutisScriptData }

Constructor TRutisScriptData.Create(StackBlockSize : Cardinal);
Begin
  If StackBlockSize < 256 Then StackBlockSize := 256;
  Stack := TRutisStack.Create(StackBlockSize);
  Ressources := TRutisStack.Create(1024 * 2);
End;

Destructor TRutisScriptData.Destroy;
Var i  : Integer;
Begin
  For i := 0 To high(Namespaces) Do
  Begin
    If Namespaces[i].Name = '$STATIC' Then
      SetLength(Namespaces[i].Declarations, 0);
    Namespaces[i].Free;
  End;
  SetLength(Namespaces, 0);

  FreeAndNil(Ressources);

  FreeAndNil(Stack);

  FreeExtData;

  Inherited;
End;

Procedure TRutisScriptData.Clear;
Var i  : Integer;
Begin
  For i := 0 To high(Namespaces) Do
  Begin
    If Namespaces[i].Name = '$STATIC' Then
      SetLength(Namespaces[i].Declarations, 0);
    Namespaces[i].Free;
  End;
  SetLength(Namespaces, 0);

  For i := 0 To high(MethodTable) Do
    MethodTable[i].MethodTableID := -1;
  SetLength(MethodTable, 0);

  SetLength(Code, 0);

  FreeExtData;
  If Stack <> nil Then
    Stack.Clear;
  Try
    Ressources.Clear;
  Except End;
End;

Procedure TRutisScriptData.FreeExtData;
Var
  i  : Integer;
Begin
  For i := 0 To high(AddrRanges) Do
    FreeMem(AddrRanges[i].Start{, ScriptData.AddrRanges[i].Size});
  SetLength(AddrRanges, 0);
End;

//==============================================================================

Function TRutisScriptData.GenCodeV(Command : TRutisCmd; Param1, Param2, Param3 : Variant; LineDiff : Integer = 0) : Integer;
Var
  sng       : Single;
  pp1, pp2  : Integer;
Begin
  If VarType(Param1) in [VarSingle, VarDouble] Then
  Begin
    sng := Param1;
    pp1 := PInteger(@sng)^;
  End
  Else
    pp1 := Param1;

  If VarType(Param2) in [VarSingle, VarDouble] Then
  Begin
    sng := Param2;
    pp2 := PInteger(@sng)^;
  End
  Else
    pp2 := Param2;

  Result := GenCode(Command, pp1, pp2, Param3, LineDiff);
End;

Function TRutisScriptData.GenCode(Command : TRutisCmd; Param1, Param2 : Integer; Param3 : Word; LineDiff : Integer = 0) : Integer;
Var i  : Integer;
Begin
  SetLength(Code, length(Code) + 1);
  If CodeInsertPos > 0 Then
  Begin
    Result := CodeInsertPos;
    Inc(CodeInsertPos);
    For I := high(Code) Downto Result + 1 Do
      Code[i] := Code[i - 1];
  End
  Else
    Result := high(Code);

  With Code[Result] Do
  Begin
    Cmd      := Command;
    P1       := Param1;
    P2       := Param2;
    P3       := Param3;
    CodeLine := CompilerLine + LineDiff;
    //StatementID := CurrStatementID;
  End;
End;

Procedure TRutisScriptData.InsertCodeV(Index : Integer; Command : TRutisCmd; Param1, Param2, Param3 : Variant; LineDiff : Integer = 0);
Var
  sng       : Single;
  pp1, pp2  : Integer;
Begin
  If VarType(Param1) in [VarSingle, VarDouble] Then
  Begin
    sng := Param1;
    pp1 := PInteger(@sng)^;
  End
  Else
    pp1 := Param1;

  If VarType(Param2) in [VarSingle, VarDouble] Then
  Begin
    sng := Param2;
    pp2 := PInteger(@sng)^;
  End
  Else
    pp2 := Param2;

  InsertCode(Index, Command, pp1, pp2, Param3, LineDiff);
End;

Function TRutisScriptData.IsCompiled : Boolean;
Begin
  Result := length(Code) > 0;
End;

Procedure TRutisScriptData.InsertCode(Index : Integer; Command : TRutisCmd; Param1, Param2 : Integer; Param3 : Word; LineDiff : Integer = 0);
Var
  i  : Integer;
Begin
  SetLength(Code, length(Code) + 1);
  For I := high(Code) Downto Index + 1 Do
    Code[i] := Code[i - 1];

  For i := Index + 1 To high(Code) Do
    If (Code[i].Cmd in [_jmp, _jz, _JL, _jg, _call]) and (Code[i].P1 > index) Then
      Inc(Code[i].P1);

  With Code[Index] Do
  Begin
    Cmd      := Command;
    P1       := Param1;
    P2       := Param2;
    P3       := Param3;
    CodeLine := CompilerLine + LineDiff;
  End;
End;

Procedure TRutisScriptData.DeleteInstruction(index : Integer);
Var
  i, j  : Integer;
  jpos  : PInteger;
Begin
  For i := 0 To high(Code) Do
    If (Code[i].Cmd in [_jmp, _jz, _JL, _JG, _JLZ, _JGZ, _call]) and (Code[i].P1 > index) Then
      Dec(Code[i].P1);

  For i := 0 To high(Namespaces) Do
    For j := 0 To high(Namespaces[i].Declarations) Do
      If Namespaces[i].Declarations[j] is TRutisVarDecl Then
        If TRutisVarDecl(Namespaces[i].Declarations[j]).VarType.ClassType = TRutisMethodType Then
        Begin
          jpos := Ressources.GetInteger(TRutisVarDecl(Namespaces[i].Declarations[j]).Address);
          If (jpos^ > index) Then
            jpos^ := jpos^ - 1;
        End;

  For i := index To high(Code) - 1 Do
    Code[i] := Code[i + 1];
  SetLength(Code, length(Code) - 1);
End;

//==============================================================================

Function TRutisScriptData.GetNamespace(Name : String) : TRutisNamespace;
Var i  : Integer;
Begin
  Result := nil;
  Name   := UpperCase(Name);
  For i := 0 To high(Namespaces) Do
    If Namespaces[i].Name = Name Then
    Begin
      Result := Namespaces[i];
      exit;
    End;
End;

Procedure TRutisScriptData.AddDeclaration(Decl : TRutisDecl; Namespace : String);
Var
  Namespacedecl  : TRutisNamespace;
Begin
  If Decl = nil Then exit;
  Namespacedecl := GetNamespace(Namespace);
  If Namespacedecl = nil Then
  Begin
    SetLength(Namespaces, length(Namespaces) + 1);
    Namespacedecl      := TRutisNamespace.Create;
    Namespacedecl.Name := UpperCase(Namespace);
    Namespaces[high(Namespaces)] := Namespacedecl;
  End;
  Namespacedecl.AddDeclaration(Decl);
End;

Function TRutisScriptData.GetDeclarationID(Name : String; Namespace : String) : Integer;
Var
  Namespacedecl  : TRutisNamespace;
Begin
  Result        := -1;
  Namespacedecl := GetNamespace(Namespace);
  If (Namespacedecl = nil) Then exit;
  Result        := Namespacedecl.GetDeclarationID(Name);
End;

Function TRutisScriptData.GetDeclaration(Name : String; Namespace : String) : TRutisDecl;
Var
  Namespacedecl  : TRutisNamespace;
Begin
  Result        := nil;
  Namespacedecl := GetNamespace(Namespace);
  If (Namespacedecl = nil) Then exit;
  Result        := Namespacedecl.GetDeclaration(Name);
End;

Function TRutisScriptData.GetDeclaration(Name : String; Namespace : String; Exclude : Array Of TRutisDecl) : TRutisDecl;
Var
  Namespacedecl  : TRutisNamespace;
Begin
  Result        := nil;
  Namespacedecl := GetNamespace(Namespace);
  If (Namespacedecl = nil) Then exit;
  Result        := Namespacedecl.GetDeclaration(Name, Exclude);
End;

{
Function TRutisScriptData.GetDeclarationID(Name: String) : Integer;
var
  i : Integer;
Begin
  for I := high(Namespaces) downto 0 do
  begin
    Result := Namespaces[i].GetDeclarationID(Name);
    If Result <> -1 then exit;
  end;
  Result := -1;
End;
Function TRutisScriptData.GetDeclaration(Name: String) : TRutisDecl;
var
  i : Integer;
Begin
  for I := high(Namespaces) downto 0 do
  begin
    Result := Namespaces[i].GetDeclaration(Name);
    If Result <> nil then exit;
  end;
  Result := nil;
End;
}
//==============================================================================

Function TRutisScriptData.GetDeclListCount : Integer;
Var i  : Integer;
Begin
  Result := 0;
  For I := 0 To high(Namespaces) Do
    Result := Result + length(Namespaces[i].Declarations);
End;

Function TRutisScriptData.GetDeclListItem(Index : Integer) : TRutisDecl;
Var i  : Integer;
Begin
  Result := nil;
  If length(Namespaces) = 0 Then exit;
  i      := 0;
  While Index >= length(Namespaces[i].Declarations) Do
  Begin
    Index := Index - length(Namespaces[i].Declarations);
    Inc(i);
    If i > high(Namespaces) Then exit;
  End;
  Result := Namespaces[i].Declarations[Index];
End;

Procedure TRutisScriptData.SetDeclListItem(Index : Integer; Value : TRutisDecl);
Var i  : Integer;
Begin
  If length(Namespaces) = 0 Then exit;
  i := 0;
  While Index >= length(Namespaces[i].Declarations) Do
  Begin
    Index := Index - length(Namespaces[i].Declarations);
    Inc(i);
    If i > high(Namespaces) Then exit;
  End;
  Namespaces[i].Declarations[Index] := Value;
End;

//==============================================================================
End.