unit prgprog;
{
   Tässä tiedostossa on logiikkaohjelmien peruskäskyt

   Author:  Vesa Lappalainen
   Date:    15.03.1997
   Changes: 26.03.1997
     + lisätty metodi IsCond, sillä joskus on kiva periä TStepCond
       -luokkaa, mutta silti ei haluta tehdä ehtoa.  Samalla
       muutettu kaikki testit  if ( step is TStepCond ) muotoon
                               if ( step.IsCond )
   Changes: 05.04.1997
     + pistetty etenemään heti startista ja suorittaa samalla
       vuorolla kunnes sama askel pitäisi suorittaa kahdesti,
       eli käytännössä ehto, joka ei toteudu 

   Changes: 26.12.1997
     + aloitettu muuttumaan kaikki ohjelmat omiksi säikeikseen.
       Ohjelman säie luodaan sen ensimmäisen star-komennon yhteydessä.
   Changes 30.12.1997
     + ehdot hoidettu säikeenä
   Changes 01.01.1998
     + step viivästetysti, samoin DoGoto
     + ehtojen säikeet korjattu tekemään Wait jos ehto jäi samaan
       askeleeseen.
     + timeout DoKillThreadin odotukseen
   Changes 25.04.1998
     + pino Reaaliluvuille ja aliohjelman paluille
         PushReturn  (Repeat-askel palaa, eli jos seuraava askel on -1)
         PushVar
         PopVar
   Changes 06.09.1998
     + TStepProgram.DoJob:
         muutettu: value => v??? (koska näytti että kaikku kutsut oli
         DoJob(value) 
   Changes 22.09.1998
     + CriticalSection Threadin luontiin, koska saattoi luoda thredeja
       toisesta prosessista samaan aikaan.
   Changes 19.02.2000
     + yksi DoStartIn InitNextStep muutettu IniNewStep koska suoritti
       ensimmäisen askeleen kaksi kertaa ja samalla ensimmäisen varsinaisen
       askeleen alustuksen kaksi kertaa (ollut ehkä kirjoitusvirhe)   

   Explanation:
     Ohjelma-askeleet etenevät seuraavalla periaatteella:
     1) Suoritettavasta ohjelmasta (joko TStepProgram tai sen jälkeläinen)
        kutsutaan metodia
          DoStep  - suorittaa ohjelma-askeleen ja palautta true tai ei
                    suorita (vika) ja palautta false
                    suoritus tehdään kutsumalla kohdalla olevan askeleen
                    DoJob-metodia.  DoJob tekee askeleen tehtävät ja
                    palauttaa seuraavan ohjelma-askeleen numeron.
     2) Valmistellaan seuraava suoritettava ohjelma-askel
          InitNewStep - kutsutaan mm. askeleen Init-metodia
     3) Jos ohjelman seuraava askel ei ole odotus tai ehto, suoritetaan
        seuraava askel =>  jokaisessa ohjelmassa on oltava joko pysähtymiseen
        päättyvä lause, odotus tai ehto, muuten ohjelma varastaa kaiken
        suoritusajan!  Tosin ohjelma-askeleita suoritetaan tietty max.maara
        ja sitten vuoro menee joka tapauksessa.

     Korjattu ettei enää ole noin:
        Tällä hetkellä jokaisessa ohjelmassa on oma kello, jonka perusteella
        ohjelmalle annetaan suoritusvuoro.  Kaikki ohjelma-askeleet ajetaan
        tällä hetkellä samassa säikeessä.

   Testien tuloksia:
     CondAOutOn
     DoAOutOn        => 100 us

     CondAInpOn
     DoAOutOn        => 0.5-0.9 ms

     CondAInpOn
     Post
     (StartProg)
     DoAOutOn       => 1-4 ms (2.2 avg), 1 ms jos ei muuta kuormaa

   Ihmeellistä:
     Ohjelmat tahdistuvat 10 ms jaksoille.   Johtunee siitä, että NT:ssä
     TimeOut tarkistetaan 10 ms kellolla ja kaikki TimeOutiin tulevat
     WaitSingleObjectit signaloidaan sitten peräjälkeen.

   Tekemättä:
     -- pausen jälkeen ei jatku
}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  PrgSteps,PrgLabel, StdCtrls, ExtCtrls, kComp, KParam,syncobjs,stack;

//{$define BYTIMER}  // Kommentoi tämä sen mukaan halutaanko thredit vai timer
{$ifdef BYTIMER}
const ProgUseThread : boolean = false;
{$else}
const ProgUseThread : boolean = true;
{$endif}

const MaxCallStack  = 0;
const MaxVarStack = 0;

type
  TFormAskProg = class(TForm)
    LabelId: TLabel;
    ButtonCancel: TButton;
    ButtonOK: TButton;
    Label1: TLabel;
    EditProg: TEdit;
    kParamInterval: TkParam;
    EditId: TComboBox;
    ButtonPause: TButton;
    ButtonRun: TButton;
    procedure ButtonPauseClick(Sender: TObject);
    procedure ButtonRunClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;


type
{$ifndef BYTIMER}
  TProgThread = class;
{$endif}

  TStepProgram = class (TStepLabel)
   private
    StartName: string;
    FCurNr    : integer;
    FNextNr   : integer;
    FMustNr   : integer;
    cnr       : integer;
    Current  : TOneProgStep;
    value : TStepValue;
    DebugForm : TForm;
{$ifdef BYTIMER}
    Timer : TTimer;
{$else}
    Timer : TProgThread;
{$endif}
    Interval : double;
    CurInterval : double;
    waiting : boolean;
    FStopped : boolean;
    StartPaused : boolean;
    FSingleStep : boolean;
    function GetEnabled: boolean;
    function GetPaused: boolean;
//    Limit   : TOneProgStep;
   protected

//    procedure Show; virtual;
    function GetEvent : integer; virtual;
    function InitNextStep(newnr:integer):boolean; virtual;
    function InitNewStep(newnr:integer):boolean; virtual;
    function StepThis:boolean; virtual;
    function InitSteps:boolean; virtual;
    function ContinueRun:boolean;
    procedure TimerEvent(Sender: TObject); virtual;
    function ThreadEvent : boolean; virtual;
    function GetCurNr : integer;   virtual;
    procedure SetCurNr(n:integer); virtual;
    function CheckNr : boolean; virtual;
   public
//    Constructor Create(stps:TList; const s:string); virtual;
//    constructor Create; override;
    CallStack : TIntStack;
    VarStack : TDoubleStack;
    constructor Create; override;
    destructor Destroy; override;
    function Ask:boolean; override;
    function Name : string; override;
    function Expl : string; override;
   //--------------------------------------------------------------------------
   public // With must be handled carefully because of multiple access
    function DoJob(var v:TStepValue) : integer; override;
    procedure Init(var v:TStepValue); override;
    function GetStr : string; override;
    procedure SetStr(const s:string); override;
    function InsertBefore : string; override;
    function InsertAfter : string; override;
    function Level : Integer;      override;
    function Color : TColor;       override;
    function TextColor : TColor;   override;
    function Style : TFontStyles;  override;
    function DoOneStep:boolean; virtual;
    function DoStopDebug:boolean; virtual;
    function DoContinue:boolean; virtual;
    function DoContinueRun:boolean; virtual;
    function DoPause:boolean; virtual;
    function DoGoto(n:integer) : boolean; virtual;
    function DoStop:boolean; virtual;
    function DoStart:boolean;  virtual;
    function DoStartRun:boolean; virtual;
    function DoUpdate:boolean; virtual;
    function DoStartDebug(form:TForm):boolean; virtual;
    function DoStopTotally : boolean; virtual;
    function PushReturn(nr:integer):boolean; virtual;
    function PushVar(d:double) : boolean; virtual;
    function PopVar : double; virtual;
    function PeekVar : double; virtual;
    function Rotate(n:double) : double; virtual;
    procedure ClearEvent; virtual;
   public // Those that are not supposed to call publicly
    function StepWait(ms:integer):boolean; virtual; // friend to TStepWait.DoJob
    procedure Sync(Method: TThreadMethod);
   published
    property CurNr:integer read GetCurNr; // write SetCurNr;
    property Event : integer read GetEvent;
    property Thread : TProgThread read Timer;
    property Enabled : boolean read GetEnabled;
    property Stopped : boolean read FStopped;
    property SingleStep : boolean read FSingleStep;
    property Paused : boolean read GetPaused;
  end;

{$ifndef BYTIMER}
  TProgThread = class(TThread)
  private
//    ivalue : integer;
//    nr : integer;
    prg : TStepProgram;
    FInterval : integer;
    FEnabled : boolean;
//    PrgId : string;
    Event : TEvent;
    Ended : boolean;
    procedure SetEnabled(b:boolean); virtual;
    //Rakentaja, joka alustaa mm. sis. muut.
    constructor Create(p:TStepProgram);
    procedure DoKillThread; virtual;
    property Enabled : boolean read FEnabled write SetEnabled;
    property Interval : integer read FInterval write FInterval;
  protected
    procedure Execute; override;
  public
    procedure Sync(Method: TThreadMethod);
    destructor Destroy; override;
  end;
{$endif}

  function DoAskProg(const q:string;p:TStepProgram):boolean;
  function GetProgFromV(const v:TStepValue) : TStepProgram;


implementation
{$R *.DFM}
uses debug,kdouble,KFormPrg;

const nrNoJump = -100;
var CriTh:TRTLCriticalSection;


function GetProgFromV(const v:TStepValue) : TStepProgram;
begin
  Result := TStepProgram(v.prog);
end;

function DoAskProg(const q:string;p:TStepProgram):boolean;
var FormAskProg: TFormAskProg;
begin
  FormAskProg := TFormAskProg.Create(NIL);
  p.steps.FillCombo(FormAskProg.EditID,TStepLabel,['','Pause','Repeat','Run','Start']);
  FormAskProg.EditId.Text := p.StartName;
  FormAskProg.EditProg.Text := p.id;
  FormAskProg.Caption := q;
  FormAskProg.kParamInterval.Value := p.Interval;
  CenterForm(FormAskProg,'ButtonOK');
  Result := false;
  if ( FormAskProg.ShowModal <> mrCancel ) and
     ( FormAskProg.EditProg.Text <> '' ) then begin
    Result := true;
    p.StartName := FormAskProg.EditId.Text;
    p.id := FormAskProg.EditProg.Text;
    p.Interval := FormAskProg.kParamInterval.Value;
  end;
  FormAskProg.Free;
end;

//------------------------------------------------------------------------------
procedure TFormAskProg.ButtonPauseClick(Sender: TObject);
begin
  EditId.Text := 'Pause';
end;

procedure TFormAskProg.ButtonRunClick(Sender: TObject);
begin
  EditId.Text := '';
end;

//------------------------------------------------------------------------------
//------------------------------------------------------------------------------
constructor TStepProgram.Create;
begin
  FNextNr := nrNoJump;
  FMustNr := -1;
  CallStack := TIntStack.Create(MaxCallStack);
  VarStack := TDoubleStack.Create(MaxVarStack);
  inherited;
end;


destructor TStepProgram.Destroy;
begin
  if ( assigned(Timer) ) then Timer.Free;
  Timer := Nil;
  VarStack.Free;
  CallStack.Free;
  VarStack := nil;
  CallStack := nil;
  inherited Destroy;
  id := 'Del';
end;

//------------------------------------------------------------------------------
function TStepProgram.Ask:boolean;
begin
  Result := DoAskProg('Give the program information',self);
end;

function TStepProgram.Name : string; begin Result := 'Program'; end;
function TStepProgram.Expl : string;
begin Result := 'Program to run'; end;

function TStepProgram.DoJob(var v:TStepValue) : integer;
begin
  Result := inherited DoJob(v); 
end;

procedure TStepProgram.Init(var v:TStepValue);
begin
end;

const StartStr : string = 'start';
{
procedure TStepProgram.Show;
begin
  if ( assigned(DebugForm) ) then (DebugForm as TFormDebug).SetIndex(CurNr);
end;
}
function TStepProgram.GetStr : string;
begin
  Result := id;
  if ( StartName <> '' ) then
    Result := id + ' ' + StartStr + ' ' + StartName;
  Result := Result + ', ' + DoubleToIniStr(Interval,0);
end;

procedure TStepProgram.SetStr(const s:string);
var i1,i2,len:integer; st : string;
begin
  st := s;
  if ( st = '' ) then st := StartStr + ' Pause,100';
  id := st; StartName := '';
  i1 := POS(StartStr,st);
  len := length(StartStr);
  i2 := POS(',',st);
  if ( i2 <= 0 ) then i2 := Length(st);
  if ( i1 <= 0 ) then begin i1 := i2; len := 0; end;
  id := trim(copy(st,1,i1-1));
  StartName := trim(copy(st,i1+len,i2-(i1+len)));
  Interval := IniStrToDouble(copy(st,i2+1,100),0);
end;

function TStepProgram.InsertBefore : string;
begin
  Result := '--';
end;

function TStepProgram.InsertAfter : string;
begin
  Result := 'Repeat';
end;

function TStepProgram.Level : Integer;     begin Result := 1;       end;
function TStepProgram.Color : TColor;      begin Result := clYellow end;
function TStepProgram.TextColor : TColor;  begin Result := 0;       end;
function TStepProgram.Style : TFontStyles; begin Result :=[fsBold]; end;

//------------------------------------------------------------------------------
// Getters and setters
//------------------------------------------------------------------------------
function TStepProgram.GetCurNr : integer;
begin
  Result := FCurNr;
end;

procedure TStepProgram.SetCurNr(n:integer);
begin
  FCurNr := n;
end;

procedure TStepProgram.ClearEvent; // virtual;
begin
  if ( Timer = nil ) then Exit;
{$ifndef BYTIMER}
  Timer.Event.ResetEvent;
{$endif}
end;

function TStepProgram.GetEvent : integer;
begin
  Result := 0;
  if ( Timer = nil ) then Exit;
{$ifndef BYTIMER}
  Result := Timer.Event.Handle;
{$endif}
end;

//------------------------------------------------------------------------------
// Public methods that must be handled carefully because of public access
//------------------------------------------------------------------------------

function TStepProgram.DoOneStep:boolean;
// Steps on step forward in debug mode. If program is running, it is stopped
// after this step
// - Not corrected
begin
  Result := true;
  if ( not Assigned(Timer) ) then exit;
  DoPause;
{$ifdef BYTIMER}
  SingleStep := true;
  Timer.Enabled := true;
{$else}
  if ( not Timer.Enabled ) then begin // Suspended => enabled
    FSingleStep := true;
    Timer.Enabled := true;
//    Timer.Enabled := false;
  end;
{$endif}
end;

function TStepProgram.DoStartDebug(form:TForm):boolean;
// Starts debuging mode.  If Debug form allready exits then just show,
// otherwise create and show.
var df : TFormDebug;
begin
  Result := True;
  if ( Assigned(DebugForm) ) then begin
    df := TFormDebug(DebugForm);
    df.Show;
//    df.ShowStop(stopped);
//    if ( Assigned(Timer) ) then df.ShowPause(not Timer.Enabled);
    Exit;
  end;
  Result := InitSteps;
  if ( Not Result ) then exit;
  df := TFormDebug.Create2(form,self);
  df.Start(self);
//  df.ShowStop(stopped);
//  if ( Assigned(Timer) ) then df.ShowPause(not Timer.Enabled);
  DebugForm := df;
//  Result := Start;
end;

function TStepProgram.DoStopDebug:boolean;
// Stops debugging by deleting the debug form. Don't start program
// even it's stopped while stepping.
// - Is DebugForm accessed after destroy?
var df : TForm;
begin
  Result := False;
  df := DebugForm;
  if not ( Assigned(df) ) then exit;
  DebugForm := NIL;
  df.Destroy;
  Result := True;
end;

function TStepProgram.DoContinue:boolean;
// Continues the run from last position, no run if in begining and start
// mode is pause.
begin
  Result := true;
  FSingleStep := false;
  if ( Timer.Enabled ) then Exit;
  Result := ContinueRun;
end;

function TStepProgram.DoContinueRun:boolean;
// Continues the run from last position and runs in every case
begin
  Result := DoContinue;
  if ( not Result ) then exit;
  Timer.Enabled := True;
{$ifdef BYTIMER}
  TimerEvent(self);
{$endif}
end;

function TStepProgram.DoPause:boolean;
// Pauses the program
// Should be OK, because of stopping just by Timer.Enabled := true
begin
  Result := False;
  if not ( Assigned(Timer) ) then exit;
  Timer.Enabled := False;
//  if ( assigned(DebugForm) ) then with TFormDebug(DebugForm) do begin
//    ShowPause(true);
//  end;
end;

function TStepProgram.DoGoto(n:integer) : boolean;
// Changes to step for next program step to do.
// Starts running from given position
begin
  Result := false;
  if not ( Assigned(Timer) ) then exit;
  Timer.Enabled := False;
  Result := InitSteps;
  if ( Not Result ) then exit;
  Result := InitNextStep(n);
  DoContinue;
end;

function TStepProgram.DoStop:boolean;
// Stops the program to current step. OK if DoPause is OK
begin
  FStopped := true;
  Result := DoPause;
//  if ( assigned(DebugForm) ) then TFormDebug(DebugForm).ShowStop(true);
end;


function TStepProgram.DoStart:boolean;
// Goes to the place where the program should start.
// If place is Pause, then just goes to begining of program and stayes there
// If place is not given, starts from begining of the program.
// Program is also startted if place is not Pause
// Returns: is program startted
//
var n : integer; t:TDateTime;
begin
  Result := false;
  CallStack.Clear;
  VarStack.Clear;
  if ( Steps.FullStop ) then exit;
  Result := InitSteps;
  if ( Not Result ) then exit;
  if ( Assigned(Timer) ) and ( Timer.Enabled ) then begin
    DoPause;
    t := Time;
    if ( t > 0 ) then; // so that compiler is not complaining
//    while (not Timer.Suspended) and ( (Time-t)*60*60*24 < 1 ) do; // Jotta ei muuta ohjelma-askelta jatkossa!
  end;

  n := -1;
  cnr := -2;
  FNextNr := nrNoJump;
  StartPaused := False;
  if ( StartName <>'' ) then n := Steps.FindStep(StartName);
  if ( n < 0 ) then StartPaused := CompareText(StartName,'Pause') = 0;
  if ( n < 0 ) then n := Parent.CurNr;
//  Result := InitNextStep(n);
  Result := InitNewStep(n);
  if ( Assigned(Timer) ) and ( not Timer.Suspended ) then
    FMustNr := n;
  EnterCriticalSection(CriTH);
  if not Assigned(Timer) then begin
{$ifdef BYTIMER}
    Timer := TTimer.Create(NIL);
{$else}
    Timer := TProgThread.Create(self);
{$endif}
    if ( Timer = NIL ) then begin
      Result := false;
      LeaveCriticalSection(CriTh);
      exit;
    end;
    Result := InitNewStep(n); // Thread not running, so this is safe to do
  end;
{$ifdef BYTIMER}
  Timer.OnTimer := TimerEvent;
{$else}
{$endif}

  Timer.Interval := Trunc(Interval);
  CurInterval := Interval;
  Timer.Enabled := ( not StartPaused ) and ( not stopped );
//  if ( assigned(DebugForm) ) then with TFormDebug(DebugForm) do begin
//    ShowPause(not Timer.Enabled);
//  end;
  LeaveCriticalSection(CriTh);
//  Result := Timer.Enabled;
end;

function TStepProgram.DoStartRun:boolean;
// Sama as DoStart but starts even when start place is Pause
begin
  Result := DoStart;
  if not ( Result ) then exit;
  Result := DoContinueRun;
  Sleep(0);
end;

function TStepProgram.DoUpdate:boolean;
begin
  if Assigned(DebugForm) then begin
    (DebugForm as TFormDebug).UpdateList;
  end;
  Result := DoStart;
end;

function TStepProgram.DoStopTotally : boolean;
begin
  Result := true;
{$ifndef BYTIMER}
  if ( Assigned(Timer) ) then Timer.DoKillThread;
{$endif}
end;

//------------------------------------------------------------------------------
// Public functions meaned to called only by "friends":
//------------------------------------------------------------------------------

function TStepProgram.StepWait(ms:integer):boolean;
// "Friend" just for TStepWait.DoJob
begin
  Result := True;
  if ( ms = 0 ) then exit;
  CurInterval := ms;
  waiting := true;
{$ifdef BYTIMER}
{$else}
  if ( waiting ) then begin
    Timer.Event.ResetEvent;
    Result := ( Timer.Event.WaitFor(ms) = wrTimeout );
  end;
{$endif}
end;

//------------------------------------------------------------------------------
// Other methods
//------------------------------------------------------------------------------
function TStepProgram.InitNextStep(newnr:integer):boolean;
begin
  FNextNr := newnr;
  Result := True;
end;

function TStepProgram.InitNewStep(newnr:integer):boolean;
begin
  Result := True;
  if ( FMustNr >= 0 ) then begin
    newnr := FMustNr;
    FMustNr := -1;
  end;
  if ( newnr = -1 ) then begin
    if ( CallStack.Empty ) then begin
      DoStart;
      exit;
    end;
    FCurNr := CallStack.Pop;
    Current := Steps[CurNr];
    value.progNr := Parent.CurNr;
    value.Prog := self;
    Current.Step.Init(value);
  end
  else if ( CurNr = -2 ) then begin
    DoPause;
    exit;
  end
  else if ( newnr < Steps.count ) then begin
    FCurNr := newnr;
    Current := Steps[CurNr];
    value.progNr := Parent.CurNr;
    value.Prog := self;
    Current.Step.Init(value);
  end
  else Result :=False;
  if ( assigned(DebugForm) ) then (TFormDebug(DebugForm)).SetIndex(CurNr);
  if ( assigned(Timer) ) then
    Timer.Interval := Trunc(Interval);
end;

function TStepProgram.CheckNr : boolean;
begin
  Result := True;
  if ( FNextNr <> nrNoJump ) and ( FNextNr <> CurNr ) then begin
    InitNewStep(FNextNr); FNextNr := nrNoJump;
    Result := false;
  end;
end;

function TStepProgram.StepThis:boolean;
var newnr:integer;
begin
  waiting := false;
  CurInterval := Interval;
  Result := false;
  if ( CurNr >= Steps.Count ) then exit;
  Result := true;
  newnr := Current.Step.DoJob(value);
  if ( newnr = CurNr ) then exit;
//  if assigned(Timer) and ( Timer.Enabled = false ) then exit;
  Result := InitNewStep(newnr);
  CheckNr;
  if ( assigned(Timer) ) then
    Timer.Interval := Trunc(CurInterval);
end;

function TStepProgram.InitSteps:boolean;
begin
  Result := false;
  if ( Parent = NIL ) then exit;
  Result := true;
end;


function TStepProgram.ContinueRun:boolean;
{ Ei käynnistä ohjelmaa, joka on alussa ja käynnistyspaikkana Pause }
begin
  FSingleStep := false;
  Result := False;
  cnr := -2;
  if not ( Assigned(Timer) ) then exit;
  if not ( ( current.step = self ) and ( StartPaused ) ) then begin
    Timer.Enabled := True; { Jos (alussa ja StartPaused), ei käyntiin }
  end;
  FStopped := false;
//  if ( assigned(DebugForm) ) then with TFormDebug(DebugForm) do begin
//    ShowStop(false);
//    ShowPause(false);
//  end;
  Result := True;
end;

procedure TStepProgram.TimerEvent(Sender: TObject);
var i:integer;
begin
  i := 0;
  if ( SingleStep ) then begin FSingleStep := false; Timer.Enabled := false; end;
  repeat
    inc(i);
    CheckNr;
    cnr := CurNr;
    StepThis;
  until ( waiting ) {or (Current.Step.IsCond)} or ( cnr = CurNr ) or
        ( i > 20 )  or ( not Timer.Enabled );
  i := Timer.Interval;
  min(i,0);
end;

function TStepProgram.ThreadEvent : boolean;
begin
  if ( cnr = -2 ) then cnr := -1
  else
    cnr := CurNr;
  StepThis;
  Result := true;
end;

function TStepProgram.GetEnabled: boolean;
begin
  Result := Timer.Enabled;
end;


//-----------------------------------------------------------------------------
function TStepProgram.PushReturn(nr:integer):boolean; //  virtual;
begin
  Result := CallStack.Push(nr);
end;

//-----------------------------------------------------------------------------
function TStepProgram.PushVar(d:double) : boolean; //  virtual;
begin
  Result := VarStack.Push(d);
end;


//-----------------------------------------------------------------------------
function TStepProgram.PopVar : double; //  virtual;
begin
  Result := VarStack.Pop;
end;

//-----------------------------------------------------------------------------
function TStepProgram.PeekVar: double;
begin
  Result := VarStack.Peek;
end;

//-----------------------------------------------------------------------------
function TStepProgram.Rotate(n: double): double;
begin
  Result := VarStack.Rotate(Round(n));
end;


procedure TStepProgram.Sync(Method: TThreadMethod);
begin
  Timer.Sync(Method);
end;

function TStepProgram.GetPaused: boolean;
begin
  Result := true;
  if ( Timer = nil ) then exit; 
  Result := (not Timer.Enabled) or (Timer.Suspended) or ( SingleStep );
end;

//------------------------------------------------------------------------------
//  TProgThread = class(TThread)
//------------------------------------------------------------------------------
{$ifndef BYTIMER}
{$ifdef TnrTest}
var tnr : integer;
{$endif}

procedure TProgThread.Execute;
begin

  while ( not terminated ) do begin
    prg.CheckNr;
{$ifdef TnrTest}
    if ( tnr = 0 ) and ( prg.CurNr = 182 ) then begin
      tnr := ThreadId;
      ShowMessage(IntToStr(tnr));
    end;
{$endif}
    if ( terminated ) then break;
    if ( Enabled ) then prg.ThreadEvent;
    if ( terminated ) then break;
    if ( not Enabled ) or ( prg.SingleStep ) then
      begin prg.FSingleStep:=False; prg.CheckNr; Suspend;  end
    else if ( prg.CurNr = prg.cnr ) then begin
      prg.StepWait(round(prg.interval));
      if ( not Enabled ) then
        Suspend;
    end;
  end;
  Ended := true;
//  Event.SetEvent;
end;

constructor TProgThread.Create(p:TStepProgram);
begin
  prg := p;
//  PrgId := p.id;
  Event := TEvent.Create(nil,False,False,prg.Name+prg.Id+'Event');
  Ended := false;
  FEnabled := false;
  inherited Create(True);
end;

procedure TProgThread.DoKillThread;
var error : DWORD;
begin

  if ( Ended ) then exit;
  if ( not Enabled ) then begin // suspended => not Enabled
    Terminate;
    Resume;
  end;
  if ( not Ended ) then begin  // suspended???
    Terminate;
    if ( Assigned(Event) ) then Event.SetEvent;
  end;

  error := WaitForSingleObject(Handle,1000);
  if (  error = WAIT_TIMEOUT ) then
    TerminateThread(Handle,0);
  if (  error = WAIT_ABANDONED ) then
    TerminateThread(Handle,0);
  if (  error = WAIT_OBJECT_0 ) then
    ; //killing := true;
  if (  error = WAIT_FAILED ) then
    TerminateThread(Handle,0);
  if ( not ended ) then
    TerminateThread(Handle,0);
end;

destructor TProgThread.Destroy;
begin
  DoKillThread;
  if ( Assigned(Event) ) then Event.Free;
  inherited;
end;

procedure TProgThread.SetEnabled(b:boolean);
begin
  if ( b = Enabled ) then exit; // Jos thredi jo oikeassa "asennossa"
  FEnabled := b;
  if ( b ) then begin
    Resume;
    if ( Suspended  ) then begin
//      ShowMessage('Did not start!');
    end;
  end;
//  if ( b = not Suspended ) then exit; // Jos thredi jo oikeassa "asennossa"
//  if ( b ) then Resume
//  else begin
  if ( not b) then begin
    Event.ResetEvent;
    Event.SetEvent;
  end;
end;
{$endif}

procedure TProgThread.Sync(Method: TThreadMethod);
begin
  Synchronize(Method);
end;

//------------------------------------------------------------------------------





initialization begin
  StepAdd(TStepProgram.Create);
  InitializeCriticalSection(CriTh);
end;

finalization begin
  DeleteCriticalSection(CriTh);
end;





end.