unit debug;
{$IFDEF FPC}
  {$MODE DELPHI}{$H+}
{$ENDIF}
(***************************************)
(* Copyright (C) 2003, SHIRAISHI Kazuo *)
(***************************************)



interface
uses Graphics, Forms, ComCtrls, SysUtils, Dialogs,
    struct;
//function inspectBox(statement:TStatement):boolean;
procedure ShowCurrentLine(lineNumb:integer);
procedure DeshowCurrentLine;
var
   CurrentLineNumb:integer;

implementation

uses
      myutils, express,base,texthand,variabl,helpctex,sConsts,
      compiler,base0;



var
   prevline:integer;

procedure ShowCurrentLine(lineNumb:integer);
begin
   CurrentLineNumb:=LineNumb;
   SelectLine(TextHand.memo,LineNumb);

end;

procedure DeshowCurrentLine;
begin
    with Texthand.memo do SelEnd:=SelStart; //Texthand.memo.SelLength:=0;

end;



type
    TBreak=class(TStatement)
       //procedure exec;override;
       function Code:Ansistring;override;
    end;



type

     TDebug=class(TStatement)
           state:boolean;
       constructor create(prev,eld:TStatement);
       //procedure exec;override;
       function Code:Ansistring;override;
     end;

     TTRace=class(TStatement)
           state:boolean;
           chn:TPrincipal;
       constructor create(prev,eld:TStatement);
       //procedure exec;override;
       function Code:Ansistring;override;
     end;

constructor TDebug.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   Punit.haveDebugst:=true;   //2017.04.28
   if token='ON' then
       begin
          gettoken;
          state:=true;
       end
   else if token='OFF' then
       begin
          gettoken;
          state:=false;
       end
   else
       seterrExpected('ON or OFF',IDH_DEBUG);
end;

constructor TTrace.create(prev,eld:TStatement);
begin
   inherited create(prev,eld);
   if (pass=2) and not PUnit.HaveDebugst then
                  seterr('DEBUG'+s_Needed, IDH_DEBUG) ;

   if token='ON' then
       begin
          gettoken;
          state:=true;
          if Token='TO' then
            begin
               GetToken;
               Check('#',IDH_DEBUG);
               chn:=NExpression;
            end;
          Punit.haveTraceSt:=true;     //2010.9.10 for code gen.
       end
   else if token='OFF' then
       begin
          gettoken;
          state:=false;
       end
   else
       seterrExpected('ON or OFF',IDH_DEBUG);
end;

function DEBUGst(prev,eld:TStatement):TStatement;
begin
       DEBUGst:=TDebug.create(prev,eld);
end;

function BREAKst(prev,eld:TStatement):TStatement;
begin
   BREAKst:=TBreak.create(prev,eld);
   if (pass=2) and not ProgramUnit.HaveDebugst then
                  seterr('DEBUG'+s_Needed, IDH_DEBUG) ;
end;

function TRACEst(prev,eld:TStatement):TStatement;
begin
       TRACEst:=TTRACE.create(prev,eld);
       TextMode:=true;
end;

function TBreak.code:ansistring;
begin
  DebugVariables.add('var Debug'+IntToStr(PUNIT.LineNumb+1)+':boolean=false;');
  result:='if Debug'+IntToStr(PUNIT.LineNumb+1)
        + ' then BreakPr('+QuotedStr(TextHand.memo.lines[linenumb])+');';
end;

function TDebug.code:ansistring;
begin
  DebugVariables.add('var Debug'+IntToStr(PUNIT.LineNumb+1)+':boolean=false;');
  result:='Debug'+IntToStr(PUNIT.LineNumb+1)+':='+TruthLiteral(state)+';'
end;

function TTrace.code:ansistring;
begin
  DebugVariables.add('var Trace'+IntToStr(PUNIT.LineNumb+1)+':TTextDevice=nil;');
  result := 'if Debug'+IntToStr(PUNIT.LineNumb+1)+
            ' then Trace' + IntToStr(PUNIT.LineNumb+1) + ':=';
  if state then
     if chn <>nil then
        result:=result + 'ChannelList.channel(' + chn.code + ');'
     else
        result:=result + 'console;'
  else
    result:=result + 'nil;' ;

end;

{**********}
{initialize}
{**********}
procedure statementTableinit;
begin
       statementTableinitImperative('DEBUG',DEBUGst);
       statementTableinitImperative('BREAK',BREAKst);
       statementTableinitImperative('TRACE',TRACEst);
   prevline:=-1;
end;


begin
   if TableInitProcs=nil then
      TableInitProcs:=TProcsCollection.create; //
   tableInitProcs.accept(statementTableinit);
end.
