Changeset 12

Timestamp:

Apr 21, 2026, 11:04:26 AM (6 days ago)

Author:

chronos

Message:

• Added: Implemented breakpoints and run to cursor action.

Location:

trunk

Files:

• Core.lfm (modified) (1 diff)
• Core.pas (modified) (3 diffs)
• Disassembler.pas (modified) (2 diffs)
• Forms/FormDisassembler.lfm (modified) (1 diff)
• Forms/FormDisassembler.pas (modified) (8 diffs)
• Z80/Z80.pas (modified) (7 diffs)

trunk/Core.lfm

@@ -44 +44 @@
       Caption = 'Run to cursor'
       ShortCut = 115
+      OnExecute = ARunToCursorExecute
     end
     object APause: TAction

trunk/Core.pas

@@ -37 +37 @@
     procedure AResetExecute(Sender: TObject);
     procedure ARunExecute(Sender: TObject);
+    procedure ARunToCursorExecute(Sender: TObject);
     procedure AStepInExecute(Sender: TObject);
     procedure AStepOutExecute(Sender: TObject);
@@ -139 +140 @@
 end;
 
+procedure TCore.ARunToCursorExecute(Sender: TObject);
+begin
+  SharpMz800.Cpu.DebugMode := dmStopAddress;
+  SharpMz800.Cpu.DebugStopAddress := FormDisassembler.GetCurrentAddress;
+  SharpMz800.Cpu.Running := True;
+  UpdateInterface;
+end;
+
 procedure TCore.AStepInExecute(Sender: TObject);
 begin
@@ -182 +191 @@
     FormDisassembler.Disassembler.Memory := SharpMz800.MappedMemory;
     FormDisassembler.OnChangePC := DoChangePC;
+    FormDisassembler.Cpu := SharpMz800.Cpu;
     SharpMz800.OnMemoryMappingChange := FormDisassembler.Disassemble;
   end;

trunk/Disassembler.pas

@@ -51 +51 @@
 
 const
-  Comments: array[0..16] of TComment = (
+  Comments: array[0..35] of TComment = (
+    (Address: $3; Text: 'GETL (Reads one line of data from the keyboard and stores it in the memory area starting at the address in the DE register.)'),
     (Address: $6; Text: 'LETNL (Moves the cursor to the beginning of the next line.)'),
+    (Address: $9; Text: 'Line feed'),
     (Address: $c; Text: 'PRNTS (Display a space at the cursor position.)'),
+    (Address: $f; Text: 'Move cursor to next tab position'),
     (Address: $12; Text: 'PRNTS (Display a character.)'),
     (Address: $15; Text: 'MSG (Displays a message.)'),
+    (Address: $18; Text: 'IOSVC'),
+    (Address: $1b; Text: 'GETKEY (Reads a character code (ASCII) from the keyboard.)'),
+    (Address: $1e; Text: 'BRKEY (Checks whether the I SHIFT I and I BREAK I keys are both being pressed.)'),
     (Address: $30; Text: 'MELDY'),
+    (Address: $33; Text: 'TIMST (Sets and starts the built-in clock.)'),
+    (Address: $3b; Text: 'TIMRD (Reads the built-in clock and returns the time.'),
     (Address: $3e; Text: 'BELL'),
     (Address: $41; Text: 'XTEMP (Sets the music tempo.)'),
     (Address: $44; Text: 'MSTA (Generates a continuous sound of the specified frequency.)'),
-    (Address: $309; Text: 'Init 8253 counters.'),
+    (Address: $47; Text: 'MSTP (Stops the sound generated with the CALL MSTA subroutine.)'),
+    (Address: $308; Text: 'Init 8253 counters.'),
     (Address: $3da; Text: 'ASC (Loads the ASCII character.)'),
     (Address: $3f9; Text: 'HEX (Converts the 8 data bits stored in the ACC into a hexadecimal number.)'),
@@ -66 +75 @@
     (Address: $41f; Text: '2HEX (Converts a string of 2 ASCII characters into a hexadecimal number and loads it into the ACC.)'),
     (Address: $73e; Text: 'Init 8255 PIO.'),
+    (Address: $9b3; Text: '??KEY (Blinks the cursor to prompt for key input.)'),
+    (Address: $a32; Text: 'Something with 8255 PIO.'),
+    (Address: $bb9; Text: '?ADCN (Converts ASCII codes into display codes.)'),
+    (Address: $bce; Text: '?DACN (Converts display codes into ASCII codes.)'),
+    (Address: $da6; Text: '?BLNK (Detects the vertical blanking period.)'),
+    (Address: $ddc; Text: '?DPCT (Controls display.)'),
+    (Address: $fb1; Text: '?POINT (Loads the current cursor location into the HL register.)'),
+    (Address: $fd8; Text: 'Write FF to (HL) B times.'),
+    (Address: $1171; Text: 'Cursor pos.'),
+    (Address: $1172; Text: 'Cursor pos.'),
     (Address: $e414; Text: 'Delay'),
     (Address: $e800; Text: 'Cold start'),

trunk/Forms/FormDisassembler.lfm

@@ -49 +49 @@
   end
   object PopupMenu1: TPopupMenu
-    Left = 433
-    Top = 343
+    OnPopup = PopupMenu1Popup
+    Left = 440
+    Top = 352
     object MenuItemSetAddress: TMenuItem
       Caption = 'Set PC to address'
       OnClick = MenuItemSetAddressClick
     end
+    object MenuItemAddBreakPoint: TMenuItem
+      Caption = 'Add break point'
+      OnClick = MenuItemAddBreakPointClick
+    end
+    object MenuItemRemoveBreakPoint: TMenuItem
+      Caption = 'Remove break point'
+      OnClick = MenuItemRemoveBreakPointClick
+    end
   end
 end

trunk/Forms/FormDisassembler.pas

@@ -5 +5 @@
 uses
   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ComCtrls,
-  ExtCtrls, Menus, Disassembler;
+  ExtCtrls, Menus, Disassembler, Z80;
 
 type
-  TChangePCEvent = procedure (Address: Word) of object;
+  TAddressEvent = procedure (Address: Word) of object;
 
   { TFormDisassembler }
@@ -14 +14 @@
   TFormDisassembler = class(TForm)
     ListView1: TListView;
+    MenuItemRemoveBreakPoint: TMenuItem;
+    MenuItemAddBreakPoint: TMenuItem;
     MenuItemSetAddress: TMenuItem;
     PopupMenu1: TPopupMenu;
@@ -21 +23 @@
     procedure FormShow(Sender: TObject);
     procedure ListView1Data(Sender: TObject; Item: TListItem);
+    procedure MenuItemAddBreakPointClick(Sender: TObject);
+    procedure MenuItemRemoveBreakPointClick(Sender: TObject);
     procedure MenuItemSetAddressClick(Sender: TObject);
+    procedure PopupMenu1Popup(Sender: TObject);
   private
-    FOnChangePC: TChangePCEvent;
+    FOnAddBreakPoint: TAddressEvent;
+    FOnChangePC: TAddressEvent;
     procedure DoChangePC(Address: Word);
+    procedure DoAddBreakPoint(Address: Word);
   public
+    Cpu: TCpuZ80;
     Disassembler: TDisassembler;
     procedure Disassemble(Sender: TObject);
     procedure SelectAddress(Address: Word);
     procedure ReloadList;
-    property OnChangePC: TChangePCEvent read FOnChangePC write FOnChangePC;
+    function GetCurrentAddress: Word;
+    property OnChangePC: TAddressEvent read FOnChangePC write FOnChangePC;
+    property OnAddBreakPoint: TAddressEvent read FOnAddBreakPoint write FOnAddBreakPoint;
   end;
 
@@ -64 +74 @@
 
 procedure TFormDisassembler.ListView1Data(Sender: TObject; Item: TListItem);
+var
+  BreakPoint: string;
 begin
   if Item.Index < Disassembler.DecodedInstructions.Count then
   with TDecodedInstruction(Disassembler.DecodedInstructions[Item.Index]) do begin
-    Item.Caption := IntToHex(Address, 4);
+    if Cpu.BreakPoints.Contains(Address) then BreakPoint := ' @'
+      else BreakPoint := '';
+    Item.Caption := IntToHex(Address, 4) + BreakPoint;
     Item.Data := Disassembler.DecodedInstructions[Item.Index];
     Item.SubItems.Add(GetOpcodesText);
@@ -76 +90 @@
 end;
 
+procedure TFormDisassembler.MenuItemAddBreakPointClick(Sender: TObject);
+begin
+  if Assigned(ListView1.Selected) then begin
+    Cpu.BreakPoints.Add(TDecodedInstruction(ListView1.Selected.Data).Address);
+    ReloadList;
+  end;
+end;
+
+procedure TFormDisassembler.MenuItemRemoveBreakPointClick(Sender: TObject);
+begin
+  if Assigned(ListView1.Selected) then begin
+    Cpu.BreakPoints.Remove(TDecodedInstruction(ListView1.Selected.Data).Address);
+    ReloadList;
+  end;
+end;
+
 procedure TFormDisassembler.MenuItemSetAddressClick(Sender: TObject);
 begin
@@ -81 +111 @@
     DoChangePC(TDecodedInstruction(ListView1.Selected.Data).Address);
     SelectAddress(TDecodedInstruction(ListView1.Selected.Data).Address);
+  end;
+end;
+
+procedure TFormDisassembler.PopupMenu1Popup(Sender: TObject);
+begin
+
+  MenuItemSetAddress.Enabled := Assigned(ListView1.Selected);
+  if Assigned(ListView1.Selected) then begin
+    MenuItemRemoveBreakPoint.Enabled := Pos('@', ListView1.Selected.Caption) > 0;
+    MenuItemAddBreakPoint.Enabled := not MenuItemRemoveBreakPoint.Enabled;
+  end else begin
+    MenuItemRemoveBreakPoint.Enabled := False;
+    MenuItemAddBreakPoint.Enabled := False;
   end;
 end;
@@ -93 +136 @@
 begin
   if Assigned(FOnChangePC) then FOnChangePC(Address);
+end;
+
+procedure TFormDisassembler.DoAddBreakPoint(Address: Word);
+begin
+  if Assigned(FOnAddBreakPoint) then FOnAddBreakPoint(Address);
 end;
 
@@ -124 +172 @@
 end;
 
+function TFormDisassembler.GetCurrentAddress: Word;
+begin
+  if Assigned(ListView1.Selected) then
+    Result := TDecodedInstruction(ListView1.Selected.Data).Address
+    else Result := 0;
+end;
+
 end.
 

trunk/Z80/Z80.pas

@@ -4 +4 @@
 
 uses
-  Classes, SysUtils, Memory, Base, Z80Instructions;
+  Classes, SysUtils, Memory, Base, Z80Instructions, Generics.Collections,
+  Generics.Defaults;
 
 type
@@ -41 +42 @@
 
   TDebugMode = (dmNone, dmStepIn, dmStepOut, dmStepOver, dmStopAddress);
+
+  { TBreakPoints }
+
+  TBreakPoints = class(TList<Word>)
+  private
+    function Comparer(constref Left, Right: Word): Integer;
+  public
+    function Contains(Address: Word): Boolean;
+    procedure AddNew(Address: Word);
+  end;
 
   { TCpuZ80 }
@@ -821 +832 @@
     InterruptEnabled: Boolean;
     InterruptMode: Byte;
+    BreakPoints: TBreakPoints;
     DebugMode: TDebugMode;
     DebugStopAddress: Word;
@@ -851 +863 @@
   while not Terminated do begin
     Cpu.Step;
-    if Cpu.DebugMode <> dmNone then begin
-      if Cpu.DebugMode = dmStepIn then begin
-        Cpu.DebugMode := dmNone;
-        Terminate;
-      end;
-      if (Cpu.DebugMode = dmStopAddress) and (Cpu.DebugStopAddress = Cpu.PC) then begin
-        Cpu.DebugMode := dmNone;
-        Terminate;
-      end;
-      if Cpu.DebugMode = dmStepOver then begin
-        Cpu.DebugMode := dmNone;
-        Terminate;
-      end;
-    end;
   end;
   Cpu.FRunning := False;
+end;
+
+{ TBreakPoints }
+
+function TBreakPoints.Comparer(constref Left, Right: Word): Integer;
+begin
+  if Left > Right then Result := 1
+  else if Left < Right then Result := -1
+  else Result := 0;
+end;
+
+function TBreakPoints.Contains(Address: Word): Boolean;
+var
+  Index: SizeInt;
+begin
+  if (Count > 0) and BinarySearch(Address, Index, TComparer<Word>.Construct(Comparer)) then begin
+    Result := True;
+  end else Result := False;
+end;
+
+procedure TBreakPoints.AddNew(Address: Word);
+begin
+  Add(Address);
+  Sort;
 end;
 
@@ -5533 +5555 @@
   end;
   Ticks := Cardinal(Ticks + 1);
+
+  // Debugging
+  if DebugMode <> dmNone then begin
+    if DebugMode = dmStepIn then begin
+      DebugMode := dmNone;
+      FThread.Terminate;
+    end;
+    if (DebugMode = dmStopAddress) and (DebugStopAddress = PC) then begin
+      DebugMode := dmNone;
+      FThread.Terminate;
+    end;
+    if DebugMode = dmStepOver then begin
+      DebugMode := dmNone;
+      FThread.Terminate;
+    end;
+  end;
+  if BreakPoints.Contains(PC) then begin
+    DebugMode := dmNone;
+    FThread.Terminate;
+  end;
 end;
 
@@ -5550 +5592 @@
 constructor TCpuZ80.Create;
 begin
+  BreakPoints := TBreakPoints.Create;
   InitInstructions;
   Reset;
@@ -5557 +5600 @@
 begin
   Running := False;
+  FreeAndNil(BreakPoints);
   inherited;
 end;