mirror of
https://github.com/moparisthebest/Simba
synced 2024-12-25 08:48:51 -05:00
1483 lines
42 KiB
ObjectPascal
1483 lines
42 KiB
ObjectPascal
{/==============================================================================
|
|
//==============================================================================
|
|
|
|
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.
|
|
|