1
0
mirror of https://github.com/moparisthebest/Simba synced 2024-12-12 02:22:20 -05:00
Simba/Units/RUTIS/Rutis_Defs.pas

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.