paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-11-02 06:23:35 +01:00
Code Issues Packages Projects Releases Wiki Activity

Lazarus can communicate with debugger on win32

Browse Source 
git-svn-id: trunk@5299 -
This commit is contained in:
vincents 2004-03-12 21:39:29 +00:00
parent f5351d76fa
commit cb8744a5e5
2 changed files with 27 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
debugger/cmdlinedebugger.pp
View File

@ -172,11 +172,8 @@ begin
end;
{$ELSE linux}
{$IFDEF WIN32}
{$IFDEF DebuggerUsePeekNamedPipe}
var
Count: Integer;
PipeHandle: Integer;
BytesRead: integer;
TotalBytesAvailable: integer;
R: LongBool;
n: integer;
@ -188,16 +185,14 @@ begin
for n:= 0 to High(AHandles) do
begin
PipeHandle := AHandles[n];
R := Windows.PeekNamedPipe(PipeHandle, null, 0, 0, @TotalBytesAvailable, null);
writeln('PeekNamedPipe returned with ',R);
R := Windows.PeekNamedPipe(PipeHandle, nil, 0, nil, @TotalBytesAvailable, nil);
if not R then begin
// PeekNamedPipe failed
Writeln('GetLastError is ', GetLastError);
Continue;
Writeln('PeekNamedPipe failed, GetLastError is ', GetLastError);
Exit;
end;
if R then begin
// PeekNamedPipe successfull
writeln('TotalBytesAvailable: ', TotalBytesAvailable);
if (TotalBytesAvailable>0) then begin
Result := 1 shl n;
Break;
@ -210,48 +205,6 @@ begin
// sleep a bit
Sleep(10);
end;
writeln('[WaitForHandles returns ', Result);
{$ELSE DebuggerUsePeekNamedPipe}
var
Count: Integer;
TimeOut: Integer;
R: Integer;
P: Pointer;
begin
Result := 0;
Count := High(AHandles)+1;
if Count < 0 then Exit;
if Count > 31 then Count := 31;
// I know MAXIMUM_WAIT_OBJECTS is 64, but that wont fit in an int :)
while True do
begin
// Wait infinite, since if there are messages, we wake up
TimeOut := INFINITE;
P := @AHandles[0];
R := Windows.MsgWaitForMultipleObjects(Count, P, False, TimeOut, QS_ALLINPUT);
if (R >= WAIT_OBJECT_0) and (R < WAIT_OBJECT_0 + Count)
then begin
// A handle is signalled
Result := 1 shl (R - WAIT_OBJECT_0);
Break;
end;
if (R = WAIT_OBJECT_0 + Count)
then begin
// we got a message
Application.ProcessMessages;
if Application.Terminated then Break;
end;
if (R >= WAIT_ABANDONED_0) and (R < WAIT_ABANDONED_0 + Count)
then begin
// A handle is abandoned
// don't know exacly what to do
// Fo now return unset
Result := 0;
Break;
end;
end;
{$ENDIF DebuggerUsePeekNamedPipe}
{$ELSE win32}
begin
writeln('ToDo: implement WaitForHandles for this OS');
@ -456,7 +409,7 @@ begin
DoDbgOutput('<' + ACommand + '>');
if ACommand <> ''
then FDbgProcess.Input.Write(ACommand[1], Length(ACommand));
FDbgProcess.Input.Write(LineEnding, Length(LineEnding));
FDbgProcess.Input.Write(LineEnding[1], Length(LineEnding));
end
else begin
WriteLN('[TCmdLineDebugger.SendCmdLn] Unable to send <', ACommand, '>. No process running.');
@ -478,6 +431,9 @@ initialization
end.
{ =============================================================================
$Log$
Revision 1.31 2004/03/12 21:39:29 vincents
Lazarus can communicate with debugger on win32
Revision 1.30 2004/03/08 09:55:41 marc
* Fixed length on writing LineEnding

21
debugger/gdbmidebugger.pp
View File

@ -365,11 +365,27 @@ begin
end;
function TGDBMIDebugger.ChangeFileName: Boolean;
function GetFileNameForGDB: string;
// GDB wants forward slashes in its filenames, even on win32.
var
SeperatorPos: integer;
begin
Result := FileName;
if DirectorySeparator<>'/' then
repeat
SeperatorPos := Pos(DirectorySeparator, Result);
if SeperatorPos>0 then begin
Delete(Result, SeperatorPos, 1);
Insert('/', Result, SeperatorPos);
end;
until SeperatorPos=0;
end;
begin
Result:=false;
if not ExecuteCommand('-file-exec-and-symbols %s', [FileName], []) then exit;
if not ExecuteCommand('-file-exec-and-symbols %s',
[GetFileNameForGDB], []) then exit;
if State=dsError then exit;
if not (inherited ChangeFileName) then exit;
if State=dsError then exit;
@ -2247,6 +2263,9 @@ initialization
end.
{ =============================================================================
$Log$
Revision 1.43 2004/03/12 21:39:29 vincents
Lazarus can communicate with debugger on win32
Revision 1.42 2004/01/17 13:29:04 mattias
using now fpc constant LineEnding from Vincent