779 lines
24 KiB
ObjectPascal
779 lines
24 KiB
ObjectPascal
////////////////////////////////////////////////////////////////////////////
|
|
// PaxCompiler
|
|
// Site: http://www.paxcompiler.com
|
|
// Author: Alexander Baranovsky (paxscript@gmail.com)
|
|
// ========================================================================
|
|
// Copyright (c) Alexander Baranovsky, 2006-2014. All rights reserved.
|
|
// Code Version: 4.2
|
|
// ========================================================================
|
|
// Unit: PAXINT_CRT.pas
|
|
// ========================================================================
|
|
////////////////////////////////////////////////////////////////////////////
|
|
|
|
{$I PaxCompiler.def}
|
|
unit PAXINT_CRT;
|
|
interface
|
|
|
|
procedure EmitInterProc(akernel, aprog: Pointer; context: Pointer = nil);
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils,
|
|
PAXCOMP_CONSTANTS,
|
|
PAXCOMP_TYPES,
|
|
PAXCOMP_SYS,
|
|
PAXCOMP_KERNEL,
|
|
PAXCOMP_BYTECODE,
|
|
PAXCOMP_MAP,
|
|
PAXCOMP_CLASSLST,
|
|
PAXCOMP_CLASSFACT,
|
|
PAXCOMP_SYMBOL_REC,
|
|
PAXCOMP_SYMBOL_TABLE,
|
|
PAXCOMP_BASERUNNER,
|
|
PAXINT_SYS,
|
|
PAXINT_RUNNER;
|
|
type
|
|
TRunnerCreator = class
|
|
private
|
|
kernel: TKernel;
|
|
Code: TCode;
|
|
SymbolTable: TSymbolTable;
|
|
|
|
Runner: TIRunner;
|
|
R: TIRunRec;
|
|
|
|
IsEval: Boolean;
|
|
|
|
constructor Create(akernel: Pointer;
|
|
aRunner: TIRunner);
|
|
destructor Destroy; override;
|
|
procedure CreateClassList;
|
|
procedure CreateArg(Id: Integer; var result: TIArg);
|
|
function LookupCodeRec(Op, Id: Integer): Integer;
|
|
procedure AddSubExtraData(I, SubId: Integer);
|
|
procedure AddEventExtraData(I, EventId: Integer);
|
|
procedure CreateRunner;
|
|
end;
|
|
|
|
constructor TRunnerCreator.Create(akernel: Pointer;
|
|
aRunner: TIRunner);
|
|
begin
|
|
inherited Create;
|
|
|
|
kernel := akernel;
|
|
Runner := aRunner;
|
|
|
|
Code := Kernel.Code;
|
|
SymbolTable := Kernel.SymbolTable;
|
|
end;
|
|
|
|
destructor TRunnerCreator.Destroy;
|
|
begin
|
|
inherited;
|
|
end;
|
|
|
|
procedure TRunnerCreator.CreateClassList;
|
|
var
|
|
I, J, K, Id, IntfId, AncestorId, Offset: Integer;
|
|
JMP: IntPax;
|
|
InterfaceMethodIds, ClassMethodIds: TIntegerList;
|
|
IntfRec: TIntfRec;
|
|
ClassRec: TClassRec;
|
|
SZ: Integer;
|
|
temp: Boolean;
|
|
RR: TSymbolRec;
|
|
PaxInfo: PPaxInfo;
|
|
PaxFactoryRec: TPaxClassFactoryRec;
|
|
MapRec: TMapRec;
|
|
begin
|
|
Code.CreateMapping(Runner.ScriptMapTable, false,
|
|
Runner.HostMapTable, Runner.ScriptMapTable);
|
|
Runner.CreateMapOffsets;
|
|
for I := 1 to Code.Card do
|
|
if Code[I].Op = OP_INIT_SUB then
|
|
begin
|
|
Id := Code[I].Arg1;
|
|
SymbolTable[Id].Value := I;
|
|
MapRec := Runner.ScriptMapTable.LookupEx(SymbolTable[Id].FullName,
|
|
SymbolTable[Id].OverCount);
|
|
if MapRec <> nil then
|
|
begin
|
|
MapRec.Shift := I;
|
|
MapRec.Offset := I;
|
|
end;
|
|
end;
|
|
|
|
if kernel.SignCompression then
|
|
SZ := kernel.OffsetList.GetSize
|
|
else
|
|
SZ := SymbolTable.GetDataSize + 4096;
|
|
|
|
temp := Runner.UseMapping;
|
|
Runner.UseMapping := false;
|
|
Runner.Allocate(0, SZ);
|
|
Runner.UseMapping := temp;
|
|
|
|
TKernel(kernel).AllocateConstants(Runner.ResultPtr);
|
|
|
|
InterfaceMethodIds := TIntegerList.Create;
|
|
ClassMethodIds := TIntegerList.Create;
|
|
|
|
try
|
|
|
|
for I := FirstLocalId + 1 to SymbolTable.Card do
|
|
begin
|
|
if SymbolTable[I].Host then
|
|
begin
|
|
RR := SymbolTable[I];
|
|
|
|
if RR.Address <> nil then
|
|
begin
|
|
if not SymbolTable.InCode[I] then
|
|
continue;
|
|
|
|
if not TKernel(kernel).ExistsOffset(RR) then
|
|
begin
|
|
continue;
|
|
end;
|
|
|
|
offset := kernel.GetOffset(RR);
|
|
Runner.SetAddress(offset, RR.Address);
|
|
end
|
|
else if RR.ClassIndex <> -1 then
|
|
begin
|
|
RR := SymbolTable[I + 1]; // cls ref
|
|
J := RR.Value;
|
|
|
|
if J = 0 then
|
|
begin
|
|
ClassRec := Runner.ClassList.Add(SymbolTable[I].FullName, SymbolTable[I].Host);
|
|
ClassRec.InstSize := SizeOf(Pointer);
|
|
end
|
|
else
|
|
begin
|
|
ClassRec := Runner.RegisterClass(TClass(Pointer(J)), SymbolTable[I].FullName, kernel.GetOffset(RR));
|
|
ClassRec.InstSize := TClass(Pointer(J)).InstanceSize;
|
|
end;
|
|
ClassRec.ParentFullName := SymbolTable[SymbolTable[I].AncestorId].FullName;
|
|
end;
|
|
end
|
|
else if SymbolTable[I].ClassIndex >= 0 then
|
|
begin
|
|
ClassRec := Runner.ClassList.Add(SymbolTable[I].FullName, false);
|
|
ClassRec.Offset := kernel.GetOffset(SymbolTable[I + 1]);
|
|
ClassRec.SizeOfScriptClassFields := SymbolTable[I].GetSizeOfScriptClassFields;
|
|
ClassRec.PClass := TClass(IntPax(SymbolTable[I + 1].Value));
|
|
ClassRec.ParentFullName := SymbolTable[SymbolTable[I].AncestorId].FullName;
|
|
|
|
J := SymbolTable.FindDestructorId(I);
|
|
if J > 0 then
|
|
ClassRec.DestructorProgOffset := LookupCodeRec(OP_INIT_SUB, J);
|
|
|
|
PaxInfo := GetPaxInfo(ClassRec.PClass);
|
|
if PaxInfo = nil then
|
|
kernel.RaiseError(errInternalError, []);
|
|
|
|
if not IsEval then
|
|
begin
|
|
PaxInfo^.Prog := Runner;
|
|
PaxInfo^.ClassIndex := SymbolTable[I].ClassIndex;
|
|
end;
|
|
|
|
PaxFactoryRec := Runner.ProgClassFactory.FindRecord(ClassRec.PClass);
|
|
if PaxFactoryRec = nil then
|
|
kernel.RaiseError(errInternalError, []);
|
|
|
|
if SymbolTable[I].SupportedInterfaces = nil then
|
|
begin
|
|
ClassRec.InstSize := SymbolTable[I].GetSizeOfAllClassFields(Runner);
|
|
Inc(ClassRec.InstSize, SizeOf(Pointer)); // add monitor space
|
|
PaxFactoryRec.SetInstanceSize(ClassRec.InstSize);
|
|
continue;
|
|
end
|
|
else
|
|
begin
|
|
ClassRec.InstSize := SymbolTable[I].GetSizeOfAllClassFields(Runner) +
|
|
SymbolTable[I].SupportedInterfaces.Count * SizeOf(Pointer);
|
|
Inc(ClassRec.InstSize, SizeOf(Pointer)); // add monitor space
|
|
PaxFactoryRec.SetInstanceSize(ClassRec.InstSize);
|
|
end;
|
|
|
|
if SymbolTable[I].SupportedInterfaces.Count = 0 then
|
|
continue;
|
|
|
|
for J:=0 to SymbolTable[I].SupportedInterfaces.Count - 1 do
|
|
begin
|
|
Offset := - SymbolTable[I].GetSizeOfAllClassFields(nil) +
|
|
J * SizeOf(Pointer);
|
|
|
|
InterfaceMethodIds.Clear;
|
|
ClassMethodIds.Clear;
|
|
IntfId := SymbolTable[I].SupportedInterfaces[J].Id;
|
|
SymbolTable.CreateInterfaceMethodList(I, IntfId,
|
|
InterfaceMethodIds,
|
|
ClassMethodIds);
|
|
IntfRec := ClassRec.IntfList.Add;
|
|
IntfRec.GUID := SymbolTable[I].SupportedInterfaces[J].GUID;
|
|
AncestorId := SymbolTable[I].AncestorId;
|
|
while not SymbolTable[AncestorId].Host do
|
|
AncestorId := SymbolTable[AncestorId].AncestorId;
|
|
|
|
for K:=0 to ClassMethodIds.Count - 1 do
|
|
begin
|
|
Id := ClassMethodIds[K];
|
|
TKernel(kernel).Code.Add(OP_JUMP_SUB, Id,
|
|
- Offset, K, 0, false, 0, 0, 0);
|
|
JMP := TKernel(kernel).Code.Card;
|
|
IntfRec.IntfMethods.AddMethod(SymbolTable[Id].FullName, JMP, Offset);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
finally
|
|
FreeAndNil(InterfaceMethodIds);
|
|
FreeAndNil(ClassMethodIds);
|
|
end;
|
|
|
|
kernel.CreateRTI(Runner);
|
|
|
|
if not IsEval then
|
|
begin
|
|
TKernel(kernel).Code.CreateMethodEntryLists;
|
|
SymbolTable.ProcessClassFactory(kernel.ClassFactory, Runner);
|
|
kernel.ClassFactory.SetupStdVirtuals(Runner.ClassList, Runner.CodePtr);
|
|
Runner.SetupInterfaces(nil);
|
|
Runner.ProgTypeInfoList.AddToProgram(Runner);
|
|
end;
|
|
end;
|
|
|
|
procedure TRunnerCreator.CreateArg(Id: Integer; var result: TIArg);
|
|
var
|
|
S: TSymbolRec;
|
|
PatternId: Integer;
|
|
P: Pointer;
|
|
V: Int64;
|
|
begin
|
|
S := SymbolTable[Id];
|
|
|
|
result.Id := Id;
|
|
result.Offset := Kernel.GetOffset(S);
|
|
result.Kind := S.Kind;
|
|
|
|
result.ByRef := S.ByRef or S.ByRefEx or S.Host;
|
|
result.Local := S.Local or S.Param;
|
|
result.PtrSize := S.PtrSize;
|
|
result.FT := S.FinalTypeId;
|
|
|
|
if IsEval then
|
|
result.Local := false;
|
|
|
|
if result.Offset = 0 then
|
|
if S.Kind = KindCONST then
|
|
begin
|
|
result.Offset := Runner.DataSize;
|
|
Inc(Runner.fDataSize, result.PtrSize);
|
|
ReallocMem(Runner.Data, Runner.DataSize);
|
|
P := ShiftPointer(Runner.Data, result.Offset);
|
|
{$IFDEF VARIANTS}
|
|
V := S.Value;
|
|
{$ELSE}
|
|
V := Integer(S.Value);
|
|
{$ENDIF}
|
|
Move(V, P^, result.PtrSize);
|
|
result.ByRef := false;
|
|
end;
|
|
|
|
if result.FT = typeSET then
|
|
result.PtrSize := SymbolTable.GetSizeOfSetType(S.TerminalTypeId)
|
|
else if result.FT = typeRECORD then
|
|
begin
|
|
if result.ByRef then
|
|
result.PtrSize := SizeOf(Pointer);
|
|
end;
|
|
|
|
if result.FT = typePOINTER then
|
|
begin
|
|
{$IFNDEF PAXARM}
|
|
if S.HasPAnsiCharType then
|
|
result.FT := typePANSICHAR
|
|
else
|
|
{$ENDIF}
|
|
if S.HasPWideCharType then
|
|
result.FT := typePWIDECHAR;
|
|
end;
|
|
result.Level := S.Level;
|
|
|
|
if S.OwnerId > 0 then
|
|
if S.Kind = KindVAR then
|
|
begin
|
|
PatternId := S.PatternId; // find id of pattern field
|
|
R.JMP := Kernel.GetOffset(SymbolTable[PatternId]);
|
|
|
|
result.HasOwner := true;
|
|
// result.PtrSize := SizeOf(Pointer);
|
|
end;
|
|
|
|
if result.ByRef and (not result.Local) and (not S.Host) then
|
|
result.HasOwner := true;
|
|
end;
|
|
|
|
function TRunnerCreator.LookupCodeRec(Op, Id: Integer): Integer;
|
|
var
|
|
I: Integer;
|
|
begin
|
|
result := 0;
|
|
for I := 1 to Code.Card do
|
|
if Code[I].Arg1 = Id then
|
|
if Code[I].Op = Op then
|
|
begin
|
|
result := I;
|
|
Exit;
|
|
end;
|
|
end;
|
|
|
|
procedure TRunnerCreator.AddSubExtraData(I, SubId: Integer);
|
|
var
|
|
SubExtraData: TISubExtraData;
|
|
K, J, ParamId, Level: Integer;
|
|
begin
|
|
R.ExtraDataIndex := Runner.ExtraDataList.IndexOf(SubId);
|
|
if R.ExtraDataIndex = -1 then
|
|
begin
|
|
SubExtraData := Runner.AddSubExtraData(I, SubId);
|
|
SubExtraData.FullName := SymbolTable[SubId].FullName;
|
|
SubExtraData.Kind := SymbolTable[SubId].Kind;
|
|
SubExtraData.Host := SymbolTable[SubId].Host;
|
|
SubExtraData.IsShared := SymbolTable[SubId].IsSharedMethod;
|
|
SubExtraData.IsFakeMethod := SymbolTable[SubId].IsFakeMethod;
|
|
SubExtraData.RunnerParam := SymbolTable[SubId].RunnerParameter;
|
|
SubExtraData.ExtraParamNeeded := SymbolTable[SubId].ExtraParamNeeded;
|
|
SubExtraData.Count := SymbolTable[SubId].Count;
|
|
SubExtraData.OverCount := SymbolTable[SubId].OverCount;
|
|
SubExtraData.CallConv := SymbolTable[SubId].CallConv;
|
|
SubExtraData.FT := SymbolTable[SubId].FinalTypeId;
|
|
SubExtraData.MethodIndex := SymbolTable[SubId].MethodIndex;
|
|
SubExtraData.PushProgRequired := SymbolTable[SubId].PushProgRequired;
|
|
Level := SymbolTable[SubId].Level;
|
|
SubExtraData.Level := Level;
|
|
|
|
SubExtraData.CallMode := SymbolTable[SubId].CallMode;
|
|
|
|
SubExtraData.IsInterfaceMethod :=
|
|
(Level > 0) and
|
|
(SymbolTable[Level].Kind = KindTYPE) and
|
|
(SymbolTable[Level].FinalTypeId = typeINTERFACE);
|
|
SubExtraData.IsRecordMethod :=
|
|
(Level > 0) and
|
|
(SymbolTable[Level].Kind = KindTYPE) and
|
|
(SymbolTable[Level].FinalTypeId = typeRECORD);
|
|
|
|
if Level > 0 then
|
|
if SymbolTable[Level].Kind = KindTYPE then
|
|
if SymbolTable[Level].FinalTypeId = typeHELPER then
|
|
begin
|
|
K := SymbolTable[Level].PatternId;
|
|
if SymbolTable[K].FinalTypeId <> typeCLASS then
|
|
SubExtraData.IsRecordMethod := true;
|
|
end;
|
|
|
|
{$IFDEF PAX64}
|
|
SubExtraData.LocalSize := SymbolTable.GetSubRSPSize(SubId);
|
|
{$ELSE}
|
|
SubExtraData.LocalSize := SymbolTable.GetSizeOfLocalsEx(SubId);
|
|
{$ENDIF}
|
|
|
|
K := SubExtraData.Count;
|
|
SetLength(SubExtraData.ParamDescList, K);
|
|
for J := 0 to K - 1 do
|
|
begin
|
|
ParamId := SymbolTable.GetParamId(SubId, J);
|
|
SubExtraData.ParamDescList[J].Offset :=
|
|
Kernel.GetOffset(SymbolTable[ParamId]);
|
|
SubExtraData.ParamDescList[J].ByRef := SymbolTable[ParamId].ByRef or
|
|
SymbolTable[ParamId].ByRefEx;
|
|
SubExtraData.ParamDescList[J].IsConst := SymbolTable[ParamId].IsConst;
|
|
SubExtraData.ParamDescList[J].FT := SymbolTable[ParamId].FinalTypeId;
|
|
SubExtraData.ParamDescList[J].PtrSize := SymbolTable[ParamId].PtrSize;
|
|
SubExtraData.ParamDescList[J].IsOpenArray := SymbolTable[ParamId].IsOpenArray;
|
|
SubExtraData.ParamDescList[J].Register := SymbolTable[ParamId].Register;
|
|
if SymbolTable[ParamId].XMMReg > 0 then
|
|
SubExtraData.ParamDescList[J].Register := SymbolTable[ParamId].XMMReg;
|
|
|
|
if not SubExtraData.Host then
|
|
if SubExtraData.ParamDescList[J].IsOpenArray then
|
|
begin
|
|
ParamId := SymbolTable.GetOpenArrayHighId(ParamId);
|
|
SubExtraData.ParamDescList[J].HighOffset :=
|
|
SymbolTable[ParamId].Shift;
|
|
end;
|
|
end;
|
|
ParamId := SymbolTable.GetResultId(SubId);
|
|
SubExtraData.ResRegister := SymbolTable[ParamId].Register;
|
|
SubExtraData.SizeOfParams := SymbolTable.GetSizeOfParams(SubId);
|
|
SubExtraData.ResSize := SymbolTable[ParamId].PtrSize;
|
|
SubExtraData.ResOffset := Kernel.GetOffset(SymbolTable[ParamId]);
|
|
SubExtraData.ResByRef := SymbolTable[ParamId].ByRef or
|
|
SymbolTable[ParamId].ByRefEx;
|
|
if not SubExtraData.Host then
|
|
SubExtraData.JMP := LookupCodeRec(OP_INIT_SUB, SubId);
|
|
end;
|
|
R.JMP := LookupCodeRec(OP_INIT_SUB, SubId);
|
|
end;
|
|
|
|
procedure TRunnerCreator.AddEventExtraData(I, EventId: Integer);
|
|
var
|
|
EventExtraData: TIEventExtraData;
|
|
DataId, SubId: Integer;
|
|
begin
|
|
DataId := SymbolTable[EventId].OwnerId;
|
|
if SymbolTable[DataId].Kind = KindTYPE then
|
|
Inc(DataId);
|
|
|
|
SubId := SymbolTable[EventId].PatternId;
|
|
AddSubExtraData(I, SubId);
|
|
EventExtraData := Runner.AddEventExtraData(I, EventId);
|
|
CreateArg(SubId, EventExtraData.CodeArg);
|
|
CreateArg(DataId, EventExtraData.DataArg);
|
|
EventExtraData.CodeArg.HasOwner := true;
|
|
EventExtraData.DataArg.HasOwner := true;
|
|
end;
|
|
|
|
procedure TRunnerCreator.CreateRunner;
|
|
var
|
|
I, J,SubId, PropIndex, ClassId, Shift: Integer;
|
|
RI: TCodeRec;
|
|
ArrExtraData: TIArrExtraData;
|
|
StructExtraData: TIStructExtraData;
|
|
TypeId, FT,
|
|
ArrayTypeId, ElemTypeId, ElemFinalTypeId, RangeTypeId, H1, ElSize: Integer;
|
|
begin
|
|
kernel.Modules.Recalc;
|
|
CreateClassList;
|
|
|
|
for I := 1 to Code.Card do
|
|
begin
|
|
Runner.N := I;
|
|
Code.N := I;
|
|
|
|
RI := Code[I];
|
|
R := Runner.AddRecord;
|
|
|
|
R.Op := RI.Op;
|
|
if RI.IsInherited then
|
|
if RI.Op = OP_CALL then
|
|
R.Op := OP_CALL_INHERITED;
|
|
|
|
R.Lang := RI.Language;
|
|
|
|
if (R.Op = OP_GET_ORD_PROP) or
|
|
{$IFNDEF PAXARM}
|
|
(R.Op = OP_GET_ANSISTR_PROP) or
|
|
(R.Op = OP_GET_WIDESTR_PROP) or
|
|
{$ENDIF}
|
|
(R.Op = OP_GET_UNICSTR_PROP) or
|
|
(R.Op = OP_GET_INTERFACE_PROP) or
|
|
(R.Op = OP_GET_VARIANT_PROP) or
|
|
(R.Op = OP_GET_INT64_PROP) or
|
|
(R.Op = OP_GET_FLOAT_PROP) or
|
|
(R.Op = OP_GET_SET_PROP) or
|
|
(R.Op = OP_GET_EVENT_PROP)
|
|
or
|
|
(R.Op = OP_SET_ORD_PROP) or
|
|
{$IFNDEF PAXARM}
|
|
(R.Op = OP_SET_ANSISTR_PROP) or
|
|
(R.Op = OP_SET_WIDESTR_PROP) or
|
|
{$ENDIF}
|
|
(R.Op = OP_SET_UNICSTR_PROP) or
|
|
(R.Op = OP_SET_INTERFACE_PROP) or
|
|
(R.Op = OP_SET_VARIANT_PROP) or
|
|
(R.Op = OP_SET_INT64_PROP) or
|
|
(R.Op = OP_SET_FLOAT_PROP) or
|
|
(R.Op = OP_SET_SET_PROP) or
|
|
(R.Op = OP_SET_EVENT_PROP) or
|
|
(R.Op = OP_SET_EVENT_PROP2)
|
|
then
|
|
begin
|
|
PropIndex := SymbolTable[RI.Arg2].PropIndex;
|
|
ClassId := SymbolTable[RI.Arg1].TerminalHostClassId;
|
|
Shift := SymbolTable[ClassId + 1].Shift;
|
|
Inc(Shift, (PropIndex + 1) * SizeOf(Pointer));
|
|
J := RI.Arg2;
|
|
repeat
|
|
Inc(J);
|
|
until SymbolTable[J].Shift = Shift;
|
|
|
|
CreateArg(Code[I].Arg1, R.A1);
|
|
CreateArg(J, R.A2);
|
|
CreateArg(Code[I].Res, R.AR);
|
|
if R.Op = OP_SET_EVENT_PROP then
|
|
begin
|
|
AddEventExtraData(I, Code[I].Res);
|
|
end;
|
|
end
|
|
else if (R.Op = OP_GET_DRTTI_PROP) or
|
|
(R.Op = OP_SET_DRTTI_PROP) then
|
|
begin
|
|
PropIndex := SymbolTable[RI.Arg2].PropIndex;
|
|
ClassId := SymbolTable[RI.Arg1].TerminalHostClassId;
|
|
Shift := SymbolTable[ClassId + 1].Shift;
|
|
Inc(Shift, (PropIndex + 1) * SizeOf(Pointer));
|
|
J := RI.Arg2;
|
|
repeat
|
|
Inc(J);
|
|
until SymbolTable[J].Shift = Shift;
|
|
CreateArg(Code[I].Arg1, R.A1);
|
|
CreateArg(J, R.A2);
|
|
CreateArg(Code[I].Res, R.AR);
|
|
end
|
|
else if R.Op = OP_STRUCTURE_CLR then
|
|
begin
|
|
J := Code[I].Arg1;
|
|
if SymbolTable[J].FinalTypeId = typeRECORD then
|
|
begin
|
|
TypeId := SymbolTable[J].TerminalTypeId;
|
|
J := SymbolTable.FindDestructorId(TypeId);
|
|
R.JMP := LookupCodeRec(OP_INIT_SUB, J);
|
|
|
|
R.ExtraDataIndex := Runner.ExtraDataList.IndexOf(TypeId);
|
|
if R.ExtraDataIndex = -1 then
|
|
begin
|
|
StructExtraData := Runner.AddStructExtraData(I, TypeId);
|
|
FreeAndNil(StructExtraData.Types);
|
|
StructExtraData.FinTypes.Clear;
|
|
FreeAndNil(StructExtraData.Offsets);
|
|
StructExtraData.Offsets := SymbolTable.GetShiftsOfDynamicFields(TypeId);
|
|
StructExtraData.Types := SymbolTable.GetTypesOfDynamicFields(TypeId);
|
|
|
|
for J := 0 to StructExtraData.Types.Count - 1 do
|
|
begin
|
|
TypeId := StructExtraData.Types[J];
|
|
FT := SymbolTable[TypeId].FinalTypeId;
|
|
StructExtraData.FinTypes.Add(FT);
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
TypeId := SymbolTable[J].TerminalTypeId;
|
|
StructExtraData := Runner.AddStructExtraData(I, TypeId);
|
|
FreeAndNil(StructExtraData.Types);
|
|
StructExtraData.FinTypes.Clear;
|
|
FreeAndNil(StructExtraData.Offsets);
|
|
StructExtraData.Offsets := SymbolTable.GetShiftsOfDynamicFields(TypeId);
|
|
StructExtraData.Types := SymbolTable.GetTypesOfDynamicFields(TypeId);
|
|
for J := 0 to StructExtraData.Types.Count - 1 do
|
|
begin
|
|
TypeId := StructExtraData.Types[J];
|
|
FT := SymbolTable[TypeId].FinalTypeId;
|
|
StructExtraData.FinTypes.Add(FT);
|
|
end;
|
|
end;
|
|
CreateArg(Code[I].Arg1, R.A1);
|
|
end
|
|
else if (R.Op = OP_ELEM) or (R.Op = OP_SET_LENGTH_EX) or
|
|
(R.Op = OP_DYNARRAY_CLR) or (R.Op = OP_DYNARRAY_ASSIGN) or
|
|
(R.Op = OP_INIT_FWARRAY) then
|
|
begin
|
|
J := SymbolTable[Code[I].Arg1].FinalTypeId;
|
|
case J of
|
|
typeCLASS:
|
|
begin
|
|
J := SymbolTable[Code[I].Arg1].TerminalTypeId;
|
|
ArrayTypeId := SymbolTable[J].PatternId;
|
|
ElemTypeId := SymbolTable[ArrayTypeId].PatternId;
|
|
ElemFinalTypeId := SymbolTable[ElemTypeId].FinalTypeId;
|
|
ElSize := SymbolTable[ElemTypeId].Size;
|
|
R.ExtraDataIndex := Runner.ExtraDataList.IndexOf(ArrayTypeId);
|
|
if R.ExtraDataIndex = -1 then
|
|
begin
|
|
ArrExtraData := Runner.AddArrExtraData(I, ArrayTypeId);
|
|
ArrExtraData.ElSize := ElSize;
|
|
ArrExtraData.ElTypeId := ElemTypeId;
|
|
ArrExtraData.ElFinTypeId := ElemFinalTypeId;
|
|
end;
|
|
end;
|
|
typeARRAY:
|
|
begin
|
|
ArrayTypeId := SymbolTable[Code[I].Arg1].TerminalTypeId;
|
|
SymbolTable.GetArrayTypeInfo(ArrayTypeId, RangeTypeId, ElemTypeId);
|
|
H1 := SymbolTable.GetLowBoundRec(RangeTypeId).Value;
|
|
ElSize := SymbolTable[ElemTypeId].Size;
|
|
|
|
R.ExtraDataIndex := Runner.ExtraDataList.IndexOf(ArrayTypeId);
|
|
if R.ExtraDataIndex = -1 then
|
|
begin
|
|
ArrExtraData := Runner.AddArrExtraData(I, ArrayTypeId);
|
|
ArrExtraData.ElSize := ElSize;
|
|
ArrExtraData.H1 := H1;
|
|
end;
|
|
end;
|
|
typeDYNARRAY, typeOPENARRAY:
|
|
begin
|
|
ArrayTypeId := SymbolTable[Code[I].Arg1].TerminalTypeId;
|
|
ElemTypeId := SymbolTable[ArrayTypeId].PatternId;
|
|
ElemFinalTypeId := SymbolTable[ElemTypeId].FinalTypeId;
|
|
ElSize := SymbolTable[ElemTypeId].Size;
|
|
|
|
R.ExtraDataIndex := Runner.ExtraDataList.IndexOf(ArrayTypeId);
|
|
if R.ExtraDataIndex = -1 then
|
|
begin
|
|
ArrExtraData := Runner.AddArrExtraData(I, ArrayTypeId);
|
|
ArrExtraData.ElSize := ElSize;
|
|
ArrExtraData.ElTypeId := ElemTypeId;
|
|
ArrExtraData.ElFinTypeId := ElemFinalTypeId;
|
|
|
|
if ElemFinalTypeId = typeDYNARRAY then
|
|
begin
|
|
ArrayTypeId := ElemTypeId;
|
|
if Runner.ExtraDataList.IndexOf(ArrayTypeId) = -1 then
|
|
begin
|
|
ElemTypeId := SymbolTable[ArrayTypeId].PatternId;
|
|
ElemFinalTypeId := SymbolTable[ElemTypeId].FinalTypeId;
|
|
ElSize := SymbolTable[ElemTypeId].Size;
|
|
ArrExtraData := Runner.AddArrExtraData(I, ArrayTypeId);
|
|
ArrExtraData.ElSize := ElSize;
|
|
ArrExtraData.ElTypeId := ElemTypeId;
|
|
ArrExtraData.ElFinTypeId := ElemFinalTypeId;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
CreateArg(Code[I].Arg1, R.A1);
|
|
CreateArg(Code[I].Arg2, R.A2);
|
|
CreateArg(Code[I].Res, R.AR);
|
|
end
|
|
else if R.Op = OP_GET_VMT_ADDRESS then
|
|
begin
|
|
R.ExtraDataIndex := Runner.ExtraDataList.IndexOf(Code[I].Arg2);
|
|
CreateArg(Code[I].Arg1, R.A1);
|
|
CreateArg(Code[I].Arg2, R.A2);
|
|
CreateArg(Code[I].Res, R.AR);
|
|
end
|
|
else if (R.Op = OP_BEGIN_CALL) or
|
|
(R.Op = OP_CALL) or
|
|
(R.Op = OP_CALL_INHERITED) or
|
|
(R.Op = OP_INIT_SUB) or
|
|
(R.Op = OP_JUMP_SUB) or
|
|
(R.Op = OP_LOAD_PROC) then
|
|
begin
|
|
SubId := Code[I].Arg1;
|
|
|
|
CreateArg(SubId, R.A1);
|
|
CreateArg(Code[I].Res, R.AR);
|
|
|
|
SubId := Code.GetTrueSubId;
|
|
|
|
AddSubExtraData(I, SubId);
|
|
|
|
if R.Op = OP_INIT_SUB then
|
|
begin
|
|
J := Code.GetCurrSelfId(I);
|
|
if J > 0 then
|
|
begin
|
|
CreateArg(J, R.A2);
|
|
Code[I].Arg2 := J;
|
|
end;
|
|
end
|
|
else if R.Op = OP_LOAD_PROC then
|
|
begin
|
|
CreateArg(Code[I].Arg2, R.A2);
|
|
end
|
|
else if R.Op = OP_JUMP_SUB then
|
|
begin
|
|
CreateArg(Code[I].Arg2, R.A2);
|
|
R.JMP := LookupCodeRec(OP_INIT_SUB, SubId);
|
|
end;
|
|
end
|
|
else if PushOperators.IndexOf(R.Op) >= 0 then
|
|
begin
|
|
CreateArg(Code[I].Arg1, R.A1);
|
|
begin
|
|
CreateArg(Code[I].Arg2, R.A2);
|
|
CreateArg(Code[I].Res, R.AR);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
CreateArg(Code[I].Arg1, R.A1);
|
|
CreateArg(Code[I].Arg2, R.A2);
|
|
CreateArg(Code[I].Res, R.AR);
|
|
|
|
if (R.Op = OP_GO) or
|
|
(R.Op = OP_GO_DL) or
|
|
(R.Op = OP_GO_FALSE) or
|
|
(R.Op = OP_GO_TRUE) then
|
|
begin
|
|
R.JMP := LookupCodeRec(OP_LABEL, Code[I].Arg1);
|
|
end
|
|
else if R.Op = OP_TRY_ON then
|
|
begin
|
|
R.AR.Id := Code.GetCurrSubId(I);
|
|
end
|
|
else if R.Op = OP_EXCEPT_ON then
|
|
begin
|
|
J := SymbolTable[Code[I].Res].TerminalTypeId;
|
|
R.JMP := SymbolTable[J].ClassIndex;
|
|
end
|
|
else if R.Op = OP_ADDRESS then
|
|
begin
|
|
if SymbolTable[Code[I].Arg1].Kind in KindSUBS then
|
|
if SymbolTable[Code[I].Arg1].Host = false then
|
|
R.JMP := LookupCodeRec(OP_INIT_SUB, Code[I].Arg1);
|
|
end
|
|
else if R.Op = OP_CREATE_EVENT then
|
|
begin
|
|
if SymbolTable[Code[I].Arg2].Kind in KindSUBS then
|
|
if SymbolTable[Code[I].Arg2].Host = false then
|
|
R.JMP := LookupCodeRec(OP_INIT_SUB, Code[I].Arg2);
|
|
end
|
|
else if R.Op = OP_CREATE_OBJECT then
|
|
begin
|
|
J := Code.GetCurrSelfId(I);
|
|
CreateArg(J, R.A2);
|
|
end
|
|
else if R.Op = OP_INTERFACE_FROM_CLASS then
|
|
begin
|
|
J := SymbolTable[Code[I].Arg1].TerminalTypeId + 1;
|
|
CreateArg(J, R.A1);
|
|
end
|
|
else if R.Op = OP_INTERFACE_CAST then
|
|
begin
|
|
J := SymbolTable[Code[I].Arg2].TerminalTypeId + 1;
|
|
CreateArg(J, R.A2);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
Runner.CreateTryList;
|
|
Runner.SetGlobalAddresses;
|
|
Runner.InitStringLiterals;
|
|
|
|
Runner.ExtraDataList.AttachRTTI;
|
|
|
|
Runner.N := 1;
|
|
end;
|
|
|
|
procedure EmitInterProc(akernel, aprog: Pointer; context: Pointer = nil);
|
|
var
|
|
runner: TIRunner;
|
|
RunnerCreator: TRunnerCreator;
|
|
begin
|
|
runner := TIRunner(aprog);
|
|
|
|
RunnerCreator := TRunnerCreator.Create(akernel, runner);
|
|
RunnerCreator.IsEval := context <> nil;
|
|
try
|
|
RunnerCreator.CreateRunner;
|
|
if RunnerCreator.IsEval then
|
|
Dump_All(DUMP_PATH, akernel, nil, nil)
|
|
else
|
|
Dump_All(DUMP_PATH, akernel, aprog, nil);
|
|
finally
|
|
FreeAndNil(RunnerCreator);
|
|
end;
|
|
end;
|
|
|
|
end.
|