Delphi/pascalscript
Delphi/pascalscript
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add optional OnWriteLine2. Can be used to support Step Out debugging.

Browse Source
This commit is contained in:
Martijn Laan 2020-08-31 07:03:54 +02:00
parent ab01a58610
commit e42274928a
No known key found for this signature in database
GPG Key ID: 9F8C8C5DDA579626
1 changed files with 20 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
Source/uPSCompiler.pas
View File

@ -907,8 +907,10 @@ type
{$IFNDEF PS_USESSUPPORT} {$IFNDEF PS_USESSUPPORT}
TPSOnWriteLineEvent = function (Sender: TPSPascalCompiler; Position: Cardinal): Boolean; TPSOnWriteLineEvent = function (Sender: TPSPascalCompiler; Position: Cardinal): Boolean;
TPSOnWriteLine2Event = function (Sender: TPSPascalCompiler; Position: Cardinal; IsProcExit: Boolean): Boolean;
{$ELSE} {$ELSE}
TPSOnWriteLineEvent = function (Sender: TPSPascalCompiler; FileName: tbtString; Position: Cardinal): Boolean; TPSOnWriteLineEvent = function (Sender: TPSPascalCompiler; FileName: tbtString; Position: Cardinal): Boolean;
TPSOnWriteLine2Event = function (Sender: TPSPascalCompiler; FileName: tbtString; Position: Cardinal; IsProcExit: Boolean): Boolean;
{$ENDIF} {$ENDIF}
TPSOnExternalProc = function (Sender: TPSPascalCompiler; Decl: TPSParametersDecl; const Name, FExternal: tbtString): TPSRegProc; TPSOnExternalProc = function (Sender: TPSPascalCompiler; Decl: TPSParametersDecl; const Name, FExternal: tbtString): TPSRegProc;
@ -952,6 +954,7 @@ type
FOnBeforeOutput: TPSOnNotify; FOnBeforeOutput: TPSOnNotify;
FOnBeforeCleanup: TPSOnNotify; FOnBeforeCleanup: TPSOnNotify;
FOnWriteLine: TPSOnWriteLineEvent; FOnWriteLine: TPSOnWriteLineEvent;
FOnWriteLine2: TPSOnWriteLine2Event;
FContinueOffsets, FBreakOffsets: TPSList; FContinueOffsets, FBreakOffsets: TPSList;
FOnTranslateLineInfo: TPSOnTranslateLineInfoProc; FOnTranslateLineInfo: TPSOnTranslateLineInfoProc;
FAutoFreeList: TPSList; FAutoFreeList: TPSList;
@ -1037,7 +1040,7 @@ type
procedure Debug_WriteParams(ProcNo: Cardinal; Proc: TPSInternalProcedure); procedure Debug_WriteParams(ProcNo: Cardinal; Proc: TPSInternalProcedure);
procedure Debug_WriteLine(BlockInfo: TPSBlockInfo); procedure Debug_WriteLine(BlockInfo: TPSBlockInfo);
procedure Debug_WriteLine2(BlockInfo: TPSBlockInfo; IsProcExit: Boolean);
function IsCompatibleType(p1, p2: TPSType; Cast: Boolean): Boolean; function IsCompatibleType(p1, p2: TPSType; Cast: Boolean): Boolean;
@ -1179,6 +1182,8 @@ type
property OnWriteLine: TPSOnWriteLineEvent read FOnWriteLine write FOnWriteLine; property OnWriteLine: TPSOnWriteLineEvent read FOnWriteLine write FOnWriteLine;
property OnWriteLine2: TPSOnWriteLine2Event read FOnWriteLine2 write FOnWriteLine2;
property OnExternalProc: TPSOnExternalProc read FOnExternalProc write FOnExternalProc; property OnExternalProc: TPSOnExternalProc read FOnExternalProc write FOnExternalProc;
property OnUseVariable: TPSOnUseVariable read FOnUseVariable write FOnUseVariable; property OnUseVariable: TPSOnUseVariable read FOnUseVariable write FOnUseVariable;
@ -5354,10 +5359,21 @@ begin
end; end;
procedure TPSPascalCompiler.Debug_WriteLine(BlockInfo: TPSBlockInfo); procedure TPSPascalCompiler.Debug_WriteLine(BlockInfo: TPSBlockInfo);
begin
Debug_WriteLine2(BlockInfo, False);
end;
procedure TPSPascalCompiler.Debug_WriteLine2(BlockInfo: TPSBlockInfo; IsProcExit: Boolean);
var var
b: Boolean; b: Boolean;
begin begin
if @FOnWriteLine <> nil then begin if @FOnWriteLine2 <> nil then begin
{$IFNDEF PS_USESSUPPORT}
b := FOnWriteLine2(Self, FParser.CurrTokenPos, IsProcExit);
{$ELSE}
b := FOnWriteLine2(Self, FModule, FParser.CurrTokenPos, IsProcExit);
{$ENDIF}
end else if @FOnWriteLine <> nil then begin
{$IFNDEF PS_USESSUPPORT} {$IFNDEF PS_USESSUPPORT}
b := FOnWriteLine(Self, FParser.CurrTokenPos); b := FOnWriteLine(Self, FParser.CurrTokenPos);
{$ELSE} {$ELSE}
@ -10966,7 +10982,7 @@ begin
end; end;
CSTII_Exit: CSTII_Exit:
begin begin
Debug_WriteLine(BlockInfo); Debug_WriteLine2(BlockInfo, BlockInfo.SubType = tProcBegin);
BlockWriteByte(BlockInfo, Cm_R); BlockWriteByte(BlockInfo, Cm_R);
FParser.Next; FParser.Next;
if (BlockInfo.SubType = tifOneliner) or (BlockInfo.SubType = TOneLiner) then if (BlockInfo.SubType = tifOneliner) or (BlockInfo.SubType = TOneLiner) then
@ -11108,7 +11124,7 @@ begin
if (BlockInfo.SubType = tMainBegin) or (BlockInfo.SubType = tProcBegin) if (BlockInfo.SubType = tMainBegin) or (BlockInfo.SubType = tProcBegin)
{$IFDEF PS_USESSUPPORT} or (BlockInfo.SubType = tUnitInit) or (BlockInfo.SubType = tUnitFinish) {$endif} then //nvds {$IFDEF PS_USESSUPPORT} or (BlockInfo.SubType = tUnitInit) or (BlockInfo.SubType = tUnitFinish) {$endif} then //nvds
begin begin
Debug_WriteLine(BlockInfo); Debug_WriteLine2(BlockInfo, BlockInfo.SubType = tProcBegin);
BlockWriteByte(BlockInfo, Cm_R); BlockWriteByte(BlockInfo, Cm_R);
{$IFDEF PS_USESSUPPORT} {$IFDEF PS_USESSUPPORT}
if FParser.CurrTokenId = CSTII_End then //nvds if FParser.CurrTokenId = CSTII_End then //nvds