{ $Id$ }
{                        ----------------------------------------------  
                         CMDLineDebugger.pp  -  Debugger class for 
                                                commandline debuggers
                         ---------------------------------------------- 
 
 @created(Wed Feb 28st WET 2001)
 @lastmod($Date$)
 @author(Marc Weustink <marc@@lazarus.dommelstein.net>)                       

 This unit contains the Commandline debugger class for external commandline
 debuggers.
 
 
/*************************************************************************** 
 *                                                                         * 
 *   This program is free software; you can redistribute it and/or modify  * 
 *   it under the terms of the GNU General Public License as published by  * 
 *   the Free Software Foundation; either version 2 of the License, or     * 
 *   (at your option) any later version.                                   * 
 *                                                                         * 
 ***************************************************************************/ 
} 
unit CmdLineDebugger;

{$mode objfpc}
{$H+}

interface

uses
  Classes, Process, Debugger{, strmlsnr};

type
  TCmdLineDebugger = class(TDebugger)
  private
    FTargetProcess: TProcess;         // The target process to be debugged
    FDbgProcess: TProcess;            // The process used to call the debugger

    FTargetOutputBuf: String;         // Tempbuffer for process output
    FOutputLines: TStringList;        // Debugger output

    procedure GetOutput;
  protected
    WaitPrompt: String;               // Prompt to wait for
    procedure CreateDebugProcess(const AName: String);
    procedure CreateTargetProcess(const AName: String);
    procedure KillTargetProcess;
    procedure SendCmdLn(const ACommand: String; const AGetOutput: Boolean); overload;
    procedure SendCmdLn(const ACommand: String; Values: array of const; const AGetOutput: Boolean); overload;
    property  TargetProcess: TProcess read FTargetProcess;         
    property  DebugProcess: TProcess read FDbgProcess;         
    property  OutputLines: TStringList read FOutputLines;
  public
    constructor Create; override;
    destructor Destroy; override;
    procedure TestCmd(const ACommand: String); // For internal debugging purposes
  end;

procedure SendBreak(const AHandle: Integer);

implementation

uses
  Linux, 
  SysUtils, Forms;
  
//////////////////////////////////////////////////
//       Needs to go to proper include
//          Platform dependent
//////////////////////////////////////////////////

{------------------------------------------------------------------------------
  Function: SendBreak
  Params:   AHandle              THe handle of the proces tosend break to
  Returns:  
 ------------------------------------------------------------------------------}
procedure SendBreak(const AHandle: Integer);
begin
  if AHandle <> 0
  then Kill(AHandle, SIGINT);
end;

{------------------------------------------------------------------------------
  Function: WaitForHandles
  Params:  AHandles:              A set of handles to wait for (max 32)
  Returns: BitArray of handles set, 0 when an error ocoured
 ------------------------------------------------------------------------------}
function WaitForHandles(const AHandles: array of Integer): Integer;
var
  n, R, Max, Count: Integer;
  TimeOut: Integer;
  FDSWait, FDS: TFDSet;
begin      
  Result := 0;
  Max := 0;
  Count := High(AHandles);
  if Count < 0 then Exit;
  if Count > 31 then Count := 31;
  FD_ZERO(FDS);

  for n := 0 to Count do   
  begin
    if Max < AHandles[n] then Max := AHandles[n];
    if AHandles[n] <> 0
    then FD_Set(AHandles[n], FDS);
  end;

  repeat
    FDSWait := FDS;
    TimeOut := 10;
    R := Select(Max + 1, @FDSWait, nil, nil, TimeOut);
    Application.ProcessMessages;
  until R <> 0;
  
  if R > 0 
  then begin
    for n := 0 to Count do   
      if  (AHandles[n] <> 0) 
      and (FD_ISSET(AHandles[n], FDSWait))
      then begin
        Result := Result or 1 shl n;
        Dec(R);
        if R=0 then Break;
      end;
  end;
end;
  
//////////////////////////////////////////////////

//////////////////////////////////////////////////
//           Tools and utilities
//          
//////////////////////////////////////////////////
function GetLine(var ABuffer: String): String;
var
  idx: Integer;
begin
  idx := Pos(#10, ABuffer);
  if idx = 0
  then Result := ''
  else begin
    Result := Copy(ABuffer, 1, idx);
    Delete(ABuffer, 1, idx);
  end;
end;

function StripLN(const ALine: String): String;
var
  idx: Integer;
begin
  idx := Pos(#10, ALine);
  if idx = 0
  then Result := ''
  else begin
    if (idx > 1)
    and (ALine[idx - 1] = #13)
    then Dec(idx);
    Result := Copy(ALine, 1, idx - 1);
  end;
end;

//////////////////////////////////////////////////

{ TCmdLineDebugger }

constructor TCmdLineDebugger.Create;
begin
  FDbgProcess := nil;
  FTargetProcess := nil;
  FOutputLines := TStringList.Create;
  FTargetOutputBuf := '';
  inherited Create;
end;

procedure TCmdLineDebugger.CreateDebugProcess(const AName:String);
begin
  if FDbgProcess = nil 
  then begin
    FDbgProcess := TProcess.Create(AName, [poUsePipes, poNoConsole, poExecuteOnCreate]);
    WriteLn('[TCmdLineDebugger] Debug PID: ', FDbgProcess.Handle);
    GetOutput;
  end;
end;

procedure TCmdLineDebugger.CreateTargetProcess(const AName:String);
begin
  // TODO: Better cleanup
  FTargetProcess.Free;
  FTargetProcess := TProcess.Create(AName, [poUsePipes, poNoConsole, poExecuteOnCreate, poRunSuspended]);
  WriteLN('[TCmdLineDebugger] Target PID = ', FTargetProcess.Handle);
end;

destructor TCmdLineDebugger.Destroy;
begin
  inherited;
  FDbgProcess.Free;
  FTargetProcess.Free;
end;

procedure TCmdLineDebugger.GetOutput;
  function ReadData(const AStream: TStream; var ABuffer: String): Integer;
  var
    S: String;
  begin
    SetLength(S, 1024);
    Result := AStream.Read(S[1], 1024);
    if Result > 0
    then begin
      SetLength(S, Result);
      ABuffer := ABuffer + S;
    end;
  end;

var   
  OutputBuf: String;
  Line: String;
  OutHandle: Integer;
  WaitSet: Integer;
  Count: Integer;
begin                
  WriteLN('[GetOutput] Enter');

  if (FTargetProcess = nil)
  then OutHandle := 0
  else OutHandle := FTargetProcess.Output.Handle;
  
  OutputBuf := '';
  Line := '';
  OutputLines.Clear;
  repeat 
    WaitSet := WaitForHandles([FDbgProcess.Output.Handle, OutHandle]);
    if WaitSet = 0
    then begin
      WriteLN('[Getoutput] Error waiting ');
      SetState(dsError);
      Break;
    end;
    
    if ((WaitSet and 1) <> 0) and (FDbgProcess <> nil)
    then begin
      Count := ReadData(FDbgProcess.Output, OutputBuf);
      if Count > 0 
      then while True do
      begin
        Line := GetLine(OutputBuf);
        if Line = '' then Break;
        Line := StripLN(Line);
        if Line <> '' then FOutputLines.Add(Line);
        DoDbgOutput(Line);
      end;
    end;

    if ((WaitSet and 2) <> 0) and (FTargetProcess <> nil)
    then begin
      Count := ReadData(FTargetProcess.Output, FTargetOutputBuf);
      if Count > 0
      then while True do
      begin
        Line := StripLN(GetLine(FTargetOutputBuf));
        if Line = '' then Break;
        DoOutput(Line); 
      end;
    end;
  until OutputBuf = WaitPrompt; 
  
  WriteLN('[GetOutput] Leave');
end;

procedure TCmdLineDebugger.KillTargetProcess;
begin
  FTargetProcess.Terminate(0);
  FTargetProcess.WaitOnExit;
  FTargetProcess.Free;
  FTargetProcess:= nil;
end;

procedure TCmdLineDebugger.SendCmdLn(const ACommand: String; const AGetOutput: Boolean); overload;
const 
  LF = #10;
begin
  if FDbgProcess <> nil 
  then begin
    WriteLN(Format('[TCmdLineDebugger.SendCmd] CMD: <%s>', [ACommand]));
    FDbgProcess.Input.Write(ACommand[1], Length(ACommand));
    FDbgProcess.Input.Write(LF, 1);
    if AGetOutput
    then GetOutput;
  end;
end;

procedure TCmdLineDebugger.SendCmdLn(const ACommand: String; Values: array of const; const AGetOutput: Boolean);
begin
  SendCmdLn(Format(ACommand, Values), AGetOutput);
end;

procedure TCmdLineDebugger.TestCmd(const ACommand: String);
begin
  SendCmdLn(ACommand, True);
end;

end.
{ =============================================================================
  $Log$
  Revision 1.1  2001/11/05 00:12:51  lazarus
  MWE: First steps of a debugger.


}