Changeset 36 for trunk/Target

Timestamp:

Feb 19, 2012, 9:44:58 AM (13 years ago)

Author:

chronos

Message:

• Modified: Redone brakepoint system for system stepping breakpoints. Now system breakpoint are managed using BreakPoints filed in TTarget.
• Added: Program can be started using Step in, Step over and Run to cursor actions.

Location:

trunk/Target

Files:

• UTarget.pas (modified) (7 diffs)
• UTargetInterpretter.pas (modified) (10 diffs)

trunk/Target/UTarget.pas

@@ -32 +32 @@
     function SearchByTargetPos(Pos: Integer): TDebugStep;
     procedure AddStep(SourcePos, TargetPos: Integer; Operation: TStepOperation);
+  end;
+
+  TBreakPoint = class
+    TargetAddress: Integer;
+    System: Boolean;
+  end;
+
+  { TBreakPointList }
+
+  TBreakPointList = class(TListObject)
+    procedure AddItem(TargetAddress: Integer);
+    procedure SetSystem(TargetAddress: Integer);
+    procedure ClearSystem;
+    function SearchByTargetPos(Pos: Integer): TBreakPoint;
   end;
 
@@ -50 +64 @@
     function LongFileName(FileName: string): string;
     function GetExecutionPosition: Integer; virtual;
+    procedure SetState(AValue: TRunState); virtual;
   public
     Name: string;
@@ -59 +74 @@
     ProjectFileName: string;
     Capabilities: TTargetCapabilities;
-    BreakPoints: TListInteger;
+    BreakPoints: TBreakPointList;
     DebugSteps: TDebugStepList;
     constructor Create; virtual;
@@ -75 +90 @@
     procedure LoadFromRegistry(Root: HKEY; Key: string); virtual;
     procedure SaveToRegistry(Root: HKEY; Key: string); virtual;
-    property State: TRunState read FState;
+    property State: TRunState read FState write SetState;
     property OnChangeState: TNotifyEvent read FOnChangeState write FOnChangeState;
     property SourceCode: string write SetSourceCode;
@@ -98 +113 @@
 
 implementation
+
+{ TBreakPointList }
+
+procedure TBreakPointList.AddItem(TargetAddress: Integer);
+var
+  NewItem: TBreakPoint;
+begin
+  NewItem := TBreakPoint.Create;
+  NewItem.TargetAddress := TargetAddress;
+  Add(NewItem);
+end;
+
+procedure TBreakPointList.SetSystem(TargetAddress: Integer);
+var
+  NewItem: TBreakPoint;
+begin
+  ClearSystem;
+  NewItem := TBreakPoint.Create;
+  NewItem.TargetAddress := TargetAddress;
+  NewItem.System := True;
+  Add(NewItem);
+end;
+
+procedure TBreakPointList.ClearSystem;
+var
+  I: Integer;
+begin
+  for I := Count - 1 downto 0 do
+    if TBreakPoint(Items[I]).System then Delete(I);
+end;
+
+function TBreakPointList.SearchByTargetPos(Pos: Integer): TBreakPoint;
+var
+  I: Integer;
+begin
+  I := 0;
+  while (I < Count) and (TBreakPoint(Items[I]).TargetAddress < Pos) do Inc(I);
+  if I < Count then Result := TBreakPoint(Items[I])
+    else Result := nil;
+end;
 
 { TDebugStepList }
@@ -191 +246 @@
 begin
 
+end;
+
+procedure TTarget.SetState(AValue: TRunState);
+begin
+  if FState = AValue then Exit;
+  FState := AValue;
 end;
 
@@ -218 +279 @@
   inherited;
   Optimization := coNormal;
-  BreakPoints := TListInteger.Create;
+  BreakPoints := TBreakPointList.Create;
   DebugSteps := TDebugStepList.Create;
 end;

trunk/Target/UTargetInterpretter.pas

@@ -34 +34 @@
     function GetMemorySize: Integer;
     procedure SetMemorySize(AValue: Integer);
-    procedure SetState(AValue: TRunState);
     procedure SetThread(State: Boolean);
     procedure PrepareJumpTable;
@@ -48 +47 @@
     procedure PrepareBreakPoints;
   protected
+    procedure SetState(AValue: TRunState); override;
     function GetTargetCode: string; override;
     function GetExecutionPosition: Integer; override;
@@ -93 +93 @@
   SJumpTableColision = 'Jump table colision';
   SMemoryCellOutOfRange = 'Memory cell %s value out of range';
+  SProgramNotRunning = 'Program not running';
 
 { TTargetInterpretterThread }
@@ -104 +105 @@
         if FProgramBreakpoints[SourcePosition] then begin
           FProgramBreakpoints[SourcePosition] := False;
-          SetState(rsPaused);
+          State := rsPaused;
         end else begin
           FCommandTable[FProgram[SourcePosition]];
@@ -113 +114 @@
       if State = rsPaused then Sleep(1);
     end;
-    SetState(rsStopped);
+    State := rsStopped;
   until Terminated or (State = rsStopped);
 end;
@@ -295 +296 @@
     Memory[I] := 0;
   FStepCount := 0;
+  PrepareBreakPoints;
 end;
 
@@ -305 +307 @@
     FProgramBreakpoints[I] := False;
   for I := 0 to BreakPoints.Count - 1 do
-    FProgramBreakpoints[BreakPoints[I]] := True;
+    FProgramBreakpoints[TBreakPoint(BreakPoints[I]).TargetAddress] := True;
 end;
 
@@ -324 +326 @@
 procedure TTargetInterpretter.Run;
 begin
-  SetState(rsRunning);
-  Reset;
-  PrepareBreakPoints;
+  if FState = rsStopped then begin
+    Reset;
+    SetThread(True);
+    State := rsRunning;
+  end else State := rsRunning;
+end;
+
+procedure TTargetInterpretter.Pause;
+begin
+  if State = rsRunning then State := rsPaused;
+end;
+
+procedure TTargetInterpretter.Stop;
+begin
+  State := rsStopped;
   SetThread(False);
-  SetThread(True);
-end;
-
-procedure TTargetInterpretter.Pause;
-begin
-  if State = rsRunning then SetState(rsPaused);
-end;
-
-procedure TTargetInterpretter.Stop;
-begin
-  SetState(rsStopped);
 end;
 
@@ -345 +348 @@
   Step: TDebugStep;
 begin
-  Step := DebugSteps.SearchByTargetPos(SourcePosition);
-  FProgramBreakpoints[Step.TargetPosition + 1] := True;
+  if State = rsPaused then begin
+    Step := DebugSteps.SearchByTargetPos(SourcePosition);
+    BreakPoints.SetSystem(Step.TargetPosition + 1);
+    Run;
+  end else raise Exception.Create(SProgramNotRunning);
 end;
 
@@ -352 +358 @@
 var
   Step: TDebugStep;
-begin
+  StepIndex: Integer;
+  Nesting: Integer;
+begin
+  if State = rsPaused then begin
+    Step := DebugSteps.SearchByTargetPos(SourcePosition);
+    if Step.Operation = soStepIn then begin
+      StepIndex := DebugSteps.IndexOf(Step);
+      Inc(StepIndex);
+      Nesting := 1;
+      while (StepIndex < DebugSteps.Count) and (Nesting > 0) do begin
+        if TDebugStep(DebugSteps[StepIndex]).Operation <> soStepOut then Dec(Nesting);
+        if TDebugStep(DebugSteps[StepIndex]).Operation <> soStepIn then Inc(Nesting);
+        Inc(StepIndex);
+      end;
+      BreakPoints.SetSystem(TDebugStep(DebugSteps[StepIndex]).TargetPosition);
+    end else BreakPoints.SetSystem(Step.TargetPosition + 1);
+    Run;
+  end else raise Exception.Create(SProgramNotRunning);
 end;
 
 procedure TTargetInterpretter.StepOut;
-begin
-  inherited StepOut;
+var
+  Step: TDebugStep;
+  StepIndex: Integer;
+begin
+  if State = rsPaused then begin
+    Step := DebugSteps.SearchByTargetPos(SourcePosition);
+    StepIndex := DebugSteps.IndexOf(Step);
+    while (StepIndex < DebugSteps.Count) and (TDebugStep(DebugSteps[StepIndex]).Operation <> soStepOut) do Inc(StepIndex);
+    if StepIndex < DebugSteps.Count then begin
+      Breakpoints.SetSystem(TDebugStep(DebugSteps[StepIndex]).TargetPosition);
+      Run;
+    end;
+  end else raise Exception.Create(SProgramNotRunning);
 end;
 
 procedure TTargetInterpretter.RunToCursor(Pos: Integer);
 begin
-  FProgramBreakpoints[Pos] := True;
+  Breakpoints.SetSystem(Pos);
+  Run;
 end;