SteppingClass.pas

   1 unit SteppingClass;
   2
   3 interface
   4
   5 uses
   6   ConstantsClass, FunctionsClass, HardwareClass, ResourcesClass, TypesClass;
   7
   8 type
   9
  10   TStepping = class;
  11
  12   { TStepBlock }
  13
  14   TStepBlock = class
  15   private
  16     pCall: TInstruction;
  17     pError: String;
  18     pOwner: TStepping;
  19     pPosition: Integer;
  20     pBranch: Boolean;
  21     function pErrorSet: Boolean; virtual;
  22     procedure pSetError(Input: String = GLOB_NO_ERROR); virtual;
  23   public
  24     constructor Create(Owner: TStepping; Call: TInstruction); virtual;
  25     function ExecuteCall: Integer; virtual;
  26     function Valid: Boolean; virtual;
  27     property CallFunction: TInstruction read pCall write pCall;
  28     property LastError: String read pError;
  29     property Position: Integer read pPosition write pPosition default -1;
  30     property IsBranch: Boolean read pBranch;
  31     destructor Destroy; override;
  32   end;
  33
  34   { TStepping }
  35
  36   TStepping = class
  37   private
  38     pError: String;
  39     pSteps: array of TStepBlock;
  40     pHardware: THardware;
  41     pLength, pStepBlock: Integer;
  42     pOnStep: TChangeEvent;
  43     pValid: Boolean;
  44     function pBlockFromCall(Position: Integer; Call: TInstruction): TStepBlock; virtual;
  45     function pErrorSet: Boolean; virtual;
  46     function pGetBlock(Position: Integer): TStepBlock; virtual;
  47     function pValidPosition(var Position: Integer): Boolean; virtual;
  48     procedure pSetError(Input: String = GLOB_NO_ERROR; Where: String = ''); virtual;
  49     procedure pSetStepBlock(Input: Integer); virtual;
  50   public
  51     constructor Create; virtual;
  52     function AddStepBlock(Position: Integer; Call: TInstruction): Boolean; virtual;
  53     function ChangeStepBlock(Position: Integer; Call: TInstruction): Boolean; virtual;
  54     function RemoveStepBlock(Position: Integer): Boolean; virtual;
  55     function Valid: Boolean; virtual;
  56     procedure SingleStep; virtual;
  57     // ? function Animate(Input: Pointer); ?
  58     destructor Destroy; override;
  59     property Block[Position: Integer]: TStepBlock read pGetBlock; default;
  60     property Hardware: THardware read pHardware write pHardware;
  61     property LastError: String read pError;
  62     property Length: Integer read pLength default 0;
  63     property OnStep: TChangeEvent read pOnStep write pOnStep;
  64     property StepBlock: Integer read pStepBlock write pSetStepBlock;
  65   end;
  66
  67
  68 implementation
  69
  70 // ************************************************************************** //
  71 // *                      TStepBlock implementation                         * //
  72 // ************************************************************************** //
  73
  74   function TStepBlock.pErrorSet: Boolean;
  75   begin
  76     Result := not(pError = GLOB_NO_ERROR);
  77   end;
  78
  79   procedure TStepBlock.pSetError(Input: String = GLOB_NO_ERROR);
  80   begin
  81     pError := Input;
  82   end;
  83
  84   constructor TStepBlock.Create(Owner: TStepping; Call: TInstruction);
  85   begin
  86     pOwner := Owner;
  87     pCall := Call;
  88     pBranch := (not(Call = nil) and (Call.Branch = BRANCH_BRANCH));
  89     pSetError;
  90   end;
  91
  92   function TStepBlock.ExecuteCall: Integer;
  93   begin
  94     Result := -1;
  95     if not Valid then Exit;
  96     if pCall.Execute and IsBranch then
  97       Result := StringToAddress(pCall.BranchAddress, Position)
  98     else
  99       Result := Position + 1;
 100   end;
 101
 102   function TStepBlock.Valid: Boolean;
 103   var
 104     lbranch: Integer;
 105   begin
 106     pSetError;
 107     Result := False;
 108     if (pCall = nil) then pSetError(STEP_NO_CALL_FUNCTION)
 109     else if IsBranch then
 110     begin
 111       lbranch := StringToAddress(pCall.BranchAddress, Position);
 112       if (lbranch < 0) or (lbranch > pOwner.Length) then
 113         pSetError(STEP_BRANCH_OUT_OF_RANGE);
 114     end;
 115     if not pErrorSet then Result := True;
 116   end;
 117
 118   destructor TStepBlock.Destroy;
 119   begin
 120     CallFunction.Free;
 121     inherited Destroy;
 122   end;
 123
 124 // ************************************************************************** //
 125 // *                       TStepping implementation                         * //
 126 // ************************************************************************** //
 127
 128   function TStepping.pBlockFromCall(Position: Integer; Call: TInstruction): TStepBlock;
 129   begin
 130     Result := nil;
 131     if (Call = nil) then
 132     begin
 133       pSetError(STEP_NO_CALL_FUNCTION);
 134       Exit;
 135     end;
 136     Result := TStepBlock.Create(Self, Call);
 137     Result.Position := Position;
 138     pValid := False;
 139   end;
 140
 141   function TStepping.pErrorSet: Boolean;
 142   begin
 143     Result := not(pError = GLOB_NO_ERROR);
 144   end;
 145
 146   function TStepping.pGetBlock(Position: Integer): TStepBlock;
 147   begin
 148     pSetError;
 149     if pValidPosition(Position) then Result := pSteps[Position]
 150     else Result := nil;
 151   end;
 152
 153   function TStepping.pValidPosition(var Position: Integer): Boolean;
 154   begin
 155     Result := False;
 156     if (Position < STEP_FIRST) then
 157     begin
 158       pSetError(STEP_POSITION_OUT_OF_RANGE);
 159       Exit;
 160     end;
 161     if (Position = STEP_LAST) then Position := pLength - 1;
 162     if not(Position < pLength) then pSetError(STEP_POSITION_OUT_OF_RANGE)
 163     else Result := True;
 164   end;
 165
 166   procedure TStepping.pSetError(Input: String = GLOB_NO_ERROR;
 167     Where: String = '');
 168   begin
 169     pError := Input;
 170     if not(Where = '') then pError := Where + ': ' + pError;
 171   end;
 172
 173   procedure TStepping.pSetStepBlock(Input: Integer);
 174   begin
 175     pSetError;
 176     if not pValidPosition(Input) then Input := -1;
 177     pStepBlock := Input;
 178     if not(@pOnStep = nil) then pOnStep(Self);
 179   end;
 180
 181   constructor TStepping.Create;
 182   begin
 183     StepBlock := -1;
 184     SetLength(pSteps, 0);
 185     pValid := True;
 186     pSetError;
 187   end;
 188
 189   function TStepping.AddStepBlock(Position: Integer; Call: TInstruction
 190     ): Boolean;
 191   var
 192     i: Integer;
 193     lblock: TStepBlock;
 194   begin
 195     pSetError;
 196     Result := False;
 197     pLength := pLength + 1;
 198     if not pValidPosition(Position) then
 199     begin
 200       pLength := pLength - 1;
 201       Exit;
 202     end;
 203     lblock := pBlockFromCall(Position, Call);
 204     if pErrorSet then
 205     begin
 206       pLength := pLength - 1;
 207       Exit;
 208     end;
 209     SetLength(pSteps, pLength);
 210     for i := (pLength - 2) downto Position do
 211     begin
 212       pSteps[i + 1] := pSteps[i];
 213       pSteps[i + 1].Position := i + 1;
 214     end;
 215     pSteps[Position] := lblock;
 216     if not(Hardware = nil) then Hardware.MaxAddress := pLength;
 217     pValid := False;
 218     Result := True;
 219   end;
 220
 221   function TStepping.ChangeStepBlock(Position: Integer; Call: TInstruction
 222     ): Boolean;
 223   var
 224     lblock: TStepBlock;
 225   begin
 226     pSetError;
 227     Result := False;
 228     if not pValidPosition(Position) then Exit;
 229     lblock := pBlockFromCall(Position, Call);
 230     if pErrorSet then Exit;
 231     pSteps[Position].Free;
 232     pSteps[Position] := lblock;
 233     pValid := False;
 234     Result := True;
 235   end;
 236
 237   function TStepping.RemoveStepBlock(Position: Integer): Boolean;
 238   var
 239     i: Integer;
 240   begin
 241     pSetError;
 242     Result := False;
 243     if not pValidPosition(Position) then Exit;
 244     pSteps[Position].Free;
 245     for i := Position to (pLength - 2) do
 246     begin
 247       pSteps[i] := pSteps[i + 1];
 248       pSteps[i].Position := i;
 249     end;
 250     pLength := pLength - 1;
 251     SetLength(pSteps, pLength);
 252     if not(Hardware = nil) then Hardware.MaxAddress := pLength;
 253     pValid := False;
 254     Result := True;
 255   end;
 256
 257   function TStepping.Valid: Boolean;
 258   var
 259     i: Integer;
 260   begin
 261     pSetError;
 262     Result := True;
 263     if pValid then Exit;
 264     for i := 0 to (pLength - 1) do
 265     begin
 266       Result := Result and pSteps[i].Valid;
 267       if pSteps[i].pErrorSet then
 268         pSetError(pSteps[i].LastError, ZeroPaddedInteger(i, CONST_PADDING));
 269       if not Result or pErrorSet then Break;
 270     end;
 271     pValid := Result;
 272   end;
 273
 274   procedure TStepping.SingleStep;
 275   var
 276     lpos: Integer;
 277   begin
 278     pSetError;
 279     if not pValid then Valid;
 280     if not pValid then Exit;
 281     lpos := StepBlock;
 282     if not pValidPosition(lpos) then StepBlock := 0
 283     else StepBlock := pSteps[lpos].ExecuteCall;
 284   end;
 285
 286   destructor TStepping.Destroy;
 287   begin
 288     while (Length > 0) do RemoveStepBlock(STEP_LAST);
 289     inherited Destroy;
 290   end;
 291
 292 end.