unit frmDebuggerunt;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Profile, IntvDis,
  ExtCtrls, StdCtrls, Buttons;

Const
  GameScreenSize    = 160 * 200;
  BMnem : Array[0..15] Of String[4] =
   ('B   ','BC  ','BOV ','BPL ','BEQ ','BLT ','BLE ','BUSC',
    'NOP ','BNC ','BNOV','BMI ','BNEQ','BGE ','BGT ','BESC');
  ColorStackLoc  = $0028;
  BorderColorLoc = $002C;
  BACKTAB        = $200;
  EXEC_Loc       = $1000;
  GROM_Loc       = $3000;
  GRAM_Loc       = $3800;
  Game_Loc       = $5000;
  Boot_Loc       = $1000;

  Num_Mnemonics = 78;
  Mnemonic: Array[0..Num_Mnemonics - 1] Of String[4] =
   ('HLT' ,'SDBD','EIS' ,'DIS' ,'J'   ,'JE'  ,'JD'  ,'JSR' ,'JSRE','JSRD',
    'TCI' ,'CLRC','SETC','INCR','DECR','COMR','NEGR','ADCR','GSWD','NOP',
    'SIN' ,'RSWD','SWAP','SLL' ,'RLC' ,'SLLC','SLR' ,'SAR' ,'RRC' ,'SARC',
    'JR'  ,'TSTR','MOVR','ADDR','SUBR','CMPR','ANDR','XORR','BEXT','MVO',
    'MVO@','PSHR','MVOI','MVI' ,'MVI@','PULR','MVII','ADD' ,'ADD@','ADDI',
    'SUB' ,'SUB@','SUBT','CMP' ,'CMP@','CMPI','AND' ,'AND@','ANDI','XOR',
    'XOR@','XORI','B   ','BC  ','BOV ','BPL ','BEQ ','BLT ','BLE ','BUSC',
    'NOP ','BNC ','BNOV','BMI ','BNEQ','BGE ','BGT ','BESC');

type
  TfrmDebugger = class(TForm)
    dlgSave: TSaveDialog;
    pnlButtons: TPanel;
    bvlInstructions: TBevel;
    bvlFlags: TBevel;
    bvlRegs: TBevel;
    bvlScreenData: TBevel;
    bvlTIARegs: TBevel;
    bvlInputRegs: TBevel;
    bvlObjectLoc: TBevel;
    bvlData: TBevel;
    btnGo: TBitBtn;
    btnTrace: TBitBtn;
    btnSkip: TBitBtn;
    btnReg: TBitBtn;
    btnMem: TBitBtn;
    btnExpression: TBitBtn;
    btnHere: TBitBtn;
    btnAsm: TBitBtn;
    btnSave: TBitBtn;
    btnStop: TBitBtn;
    sbInstructions: TScrollBar;
    btnPC: TSpeedButton;
    btnTop: TSpeedButton;
    btnExpRef: TBitBtn;
    sbData: TScrollBar;
    btnObjectLoc: TBitBtn;
    procedure FormPaint(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormResize(Sender: TObject);
    procedure btnTraceClick(Sender: TObject);
    procedure btnGoClick(Sender: TObject);
    procedure btnSkipClick(Sender: TObject);
    procedure btnHereClick(Sender: TObject);
    procedure btnMemClick(Sender: TObject);
    procedure btnSaveClick(Sender: TObject);
    procedure btnStopClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure sbInstructionsScroll(Sender: TObject;
      ScrollCode: TScrollCode; var ScrollPos: Integer);
    procedure btnPCClick(Sender: TObject);
    procedure btnTopClick(Sender: TObject);
    procedure btnRegClick(Sender: TObject);
    procedure btnExpRefClick(Sender: TObject);
    procedure btnExpressionClick(Sender: TObject);
    procedure btnAsmClick(Sender: TObject);
    procedure sbDataScroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
    procedure btnObjectLocClick(Sender: TObject);
  private
    { Private declarations }
    DataTop  : Word;
    Opcode   : Byte;
    Addr     : Word;
    Color    : Word;
    TopAddr  : Word;
    _DLines  : Word;
    St       : String;
    OutFile  : File;
    SDBDInst : Array Of Boolean;
    Procedure FBox(X1,Y1,X2,Y2: Integer; Col: Byte);
    Procedure Display;
    Procedure WriteOut(B: TBevel; X,Y: Integer; St: String; Col: Word);
    Procedure WriteOutBold(B: TBevel; X,Y: Integer; St: String; Col: Word);
    Procedure FillInBevel(B: TBevel; Col: Byte);
    Function  TransWordWrite(Addr: Word): String;
    Function  TransWordRead(Addr: Word): String;
    Function  TransByteRead(Addr: Word): String;
    Function  TransByteWrite(Addr: Word): String;
    Function  TransWord(Addr: Word): String;
    Function  TransByte(Addr: Word): String;
    Function  Assemble(St: String; PC: Word; SDBD: Boolean; Var Word1,Word2,Word3,NumWords: Word;
                       Var Warn: Boolean): Boolean;
    Function  Disassemble(Buf: CP1600Mem; Var Addr: Word; SDBD: Boolean): String;
    Function  LoadSaveState: Boolean;
  public
    { Public declarations }
    Showing : Boolean;
    Closing : Boolean;
    ShowObjs : Boolean;
    Procedure InitDebugger;
    Procedure Enable(Running: Boolean);
  end;

var
  frmDebugger   : TfrmDebugger;
  ScreenPalette : Array[0..255] Of TColor;

implementation

{$R *.DFM}

Uses HexWrite,Base,frmMainUnt,Equation,ProtMenu,frmExpRefUnt,
  frmDebugger6502unt;

Const
  NormTextColor = 0;
  DataTextColor = 0;
  HiTextColor   = 6;
  PCTextColor   = 2;
  HelpTextColor = 8;
  HelpHiColor   = 6;
  LineColor     = 14;
  BackColor     = 0;
  DisasmColor   = 9;
  FlagsColor    = 15;
  RegsColor     = 12;
  DataColor     = 13;
  ScrDatColor   = 2;
  TIA_Color     = 1;
  TextBGColor   = 1;
  PopupColor    = 8;
  HelpColor     = 1;
  MarkTextColor = 7;
  MarkBackColor = 0;
  ObjLocColor   = 13;
  TopAsmColor   = 5;
  TextStart     = 2;
  TextHeight    = 8;
  DisasmLines   = 16;
  DataLines     = 16;
  SmFontSize    = 1024;

Var
  BreakExp    : String;

Function TfrmDebugger.Assemble(St: String; PC: Word; SDBD: Boolean; Var Word1,Word2,Word3,NumWords: Word;
                               Var Warn: Boolean): Boolean;
Var
  I       : Integer;
  P       : Integer;
  Code    : Integer;
  St1     : String;
  Found   : Boolean;
  R1,R2   : Word;
  Addr    : LongInt;
  Ext     : Integer;

  Procedure Handle_SDBD;
  Begin
    If SDBD Then
    Begin
      Word2    := Addr And $FF;
      Word3    := Addr Shr 8;
      NumWords := 3;
    End
    Else
    Begin
      Word2    := Addr;
      If (Word2 And $FC00) <> 0 Then Warn := True; { More than 10 bits }
      NumWords := 2;
    End;
  End; { Handle_SDBD }

  Function Get_Reg: Boolean;
  Var Code: Integer;
  Begin
    If (St <> '') And (St[1] = 'R') Then
    Begin
      St := Trim(Copy(St,2,Length(St) - 1));
      Val(St,R1,Code);
      Get_Reg := ((Code = 0) And (R1 In [0..7]));
    End
    Else Get_Reg := False;
  End; { Get_Reg }

  Function Get_Reg_Reg: Boolean;
  Var P,Code,Code1: Integer;
  Begin
    If (St <> '') And (St[1] = 'R') Then
    Begin
      P := Pos(',',St);
      If P <> 0 Then
      Begin
        St1 := Trim(Copy(St,2,P - 2));
        St  := Trim(Copy(St,P + 1,Length(St) - P));
        If (St <> '') And (St[1] = 'R') Then
        Begin
          St := Trim(Copy(St,2,Length(St) - 1));
          Val(St1,R1,Code);
          Val(St,R2,Code1);
          Get_Reg_Reg := ((Code  = 0) And (R1 In [0..7]) And
                          (Code1 = 0) And (R2 In [0..7]));
        End
        Else Get_Reg_Reg := False;
      End
      Else Get_Reg_Reg := False;
    End
    Else Get_Reg_Reg := False;
  End; { Get_Reg_Reg }

  Function Get_Reg_Word: Boolean;
  Var P,Code: Integer;
  Begin
    If (St <> '') And (St[1] = 'R') Then
    Begin
      P := Pos(',',St);
      If P <> 0 Then
      Begin
        St1 := Trim(Copy(St,2,P - 2));
        St  := Trim(Copy(St,P + 1,Length(St) - P));
        Val(St1,R1,Code);
        Addr := ValHex(St);
        Get_Reg_Word := ((Code = 0) And (R1 In [0..7]) And
                         (Addr >= 0) And (Addr <= $FFFF));
      End
      Else Get_Reg_Word := False;
    End
    Else Get_Reg_Word := False;
  End; { Get_Reg_Word }

  Function Get_Word_Reg: Boolean;
  Var P,Code: Integer;
  Begin
    If St <> '' Then
    Begin
      P := Pos(',',St);
      If P <> 0 Then
      Begin
        St1 := Trim(Copy(St,1,P - 1));
        St  := Trim(Copy(St,P + 1,Length(St) - P));
        If (St <> '') And (St[1] = 'R') Then
        Begin
          St := Trim(Copy(St,2,Length(St) - 1));
          Addr := ValHex(St1);
          Val(St,R1,Code);
          Get_Word_Reg := ((R1 In [0..7]) And (Code = 0) And
                           (Addr >= 0) And (Addr <= $FFFF));
        End
        Else Get_Word_Reg := False;
      End
      Else Get_Word_Reg := False;
    End
    Else Get_Word_Reg := False;
  End; { Get_Word_Reg }

Begin

  { Separate the mnemonic from the parameters }

  Warn := False;
  St   := UpperCase(Trim(St));
  If St <> '' Then
  Begin
    I     := Pos(' ',St);
    If I = 0 Then I := Length(St) + 1;
    St1   := Copy(St,1,I - 1);
    St    := Trim(Copy(St,I + 1,Length(St) - I));

    { Identify the mnemonic }

    I     := 0;
    Found := False;
    While (I < Num_Mnemonics) And Not Found Do
    Begin
      If St1 = Mnemonic[I] Then Found := True Else Inc(I);
    End; { While }
    If Found Then
    Begin
      Assemble := False;
      Case I Of
        0..3: Begin              { HLT, SDBD, EIS, DIS }
                Word1    := I;
                NumWords := 1;
                Assemble := True;
              End;
       4,5,6: Begin              { J, JE, JD }
                Addr     := ValHex(St);
                If (Addr >= 0) And (Addr <= $FFFF) Then
                Begin
                  Word1    := 4;
                  Word2    := $0300 + ((Addr And $FC00) Shr 8) + (I - 4);
                  Word3    := Addr And $3FF;
                  NumWords := 3;
                  Assemble := True;
                End;
              End;
       7,8,9: Begin              { JSR, JSRE, JSRD }
                P := Pos(',',St);
                If (P <> 0) And (St[1] = 'R') Then
                Begin
                  St1 := Trim(Copy(St,2,P - 2)); { Register number }
                  St  := Trim(Copy(St,P + 1,Length(St) - P)); { Address }
                  Val(St1,R1,Code);
                  If (Code = 0) And (R1 In [4..6]) Then
                  Begin
                    Addr     := ValHex(St);
                    If (Addr >= 0) And (Addr <= $FFFF) Then
                    Begin
                      Word1    := 4;
                      Word2    := ((R1 - 4) Shl 8) + ((Addr And $FC00) Shr 8) + (I - 7);
                      Word3    := Addr And $3FF;
                      NumWords := 3;
                      Assemble := True;
                    End;
                  End;
                End;
              End;
      10..12: Begin              { TCI, CLRC, SETC }
                Word1    := I - 5;
                NumWords := 1;
                Assemble := True;
              End;
      13..17: Begin              { INCR, DECR, COMR, NEGR, ADCR }
                If Get_Reg Then
                Begin
                  Word1    := R1 + (I - 12) * 8;
                  NumWords := 1;
                  Assemble := True;
                End;
              End;
          18: Begin              { GSWD }
                If Get_Reg And (R1 In [0..3]) Then
                Begin
                  Word1    := R1 + 48;
                  NumWords := 1;
                  Assemble := True;
                End;
              End;
       19,20: Begin              { NOP,SIN }
                Word1    := 52 + (I - 19) * 2;
                NumWords := 1;
                Assemble := True;
              End;
          21: Begin              { RSWD }
                If Get_Reg Then
                Begin
                  Word1    := R1 + 56;
                  NumWords := 1;
                  Assemble := True;
                End;
              End;
      22..29: Begin              { SWAP, SLL, RLC, SLLC, SLR, SAR, RRC, SARC }
                If (St <> '') And (St[1] = 'R') Then
                Begin
                  P := Pos(',2',St);
                  If P <> 0                              { Register number }
                   Then St := Trim(Copy(St,2,P - 2))
                   Else St := Trim(Copy(St,2,Length(St) - 1));
                  Val(St,R1,Code);
                  If (Code = 0) And (R1 In [0..3]) Then
                  Begin
                    Word1 := 64 + (I - 22) * 8 + R1;
                    If P <> 0 Then Word1 := Word1 Or 4;
                    NumWords := 1;
                    Assemble := True;
                  End;
                End;
              End;
          30: Begin              { JR (MOVR RR,R7) }
                If Get_Reg Then
                Begin
                  Word1    := $0087 + (R1 Shl 3);
                  NumWords := 1;
                  Assemble := True;
                End;
              End;
          31: Begin              { TSTR (MOVR RR,RR) }
                If Get_Reg Then
                Begin
                  Word1    := $0080 + (R1 Shl 3) + R1;
                  NumWords := 1;
                  Assemble := True;
                End;
              End;
      32..37: Begin              { MOVR, ADDR, SUBR, CMPR, ANDR, XORR }
                If Get_Reg_Reg Then
                Begin
                  Word1    := $0080 + ($40 * (I - 32)) + (R1 Shl 3) + R2;
                  NumWords := 1;
                  Assemble := True;
                End;
              End;
          38: Begin              { BEXT }
                P := Pos(',',St);
                If P <> 0 Then
                Begin
                  St1  := Trim(Copy(St,1,P - 1));
                  St   := Trim(Copy(St,P + 1,Length(St) - P));
                  Addr := ValHex(St1);
                  Ext  := ValHex(St);
                  If (Ext  >= 0) And (Ext <= $F) And
                     (Addr >= 0) And (Addr <= $FFFF) Then
                  Begin
                    If Addr >= PC + 2 Then
                    Begin
                      Dec(Addr,PC + 2);
                      Word1 := $0210 + Ext;
                    End
                    Else
                    Begin
                      Addr  := PC + 1 - Addr;
                      Word1 := $0230 + Ext;
                    End;
                    Word2    := Addr;
                    If (Word2 And $FC00) <> 0 Then Warn := True; { More than 10 bits }
                    NumWords := 2;
                    Assemble := True;
                  End;
                End;
              End;
          39: Begin              { MVO }
                If Get_Reg_Word Then
                Begin
                  Word1 := $0240 + (R1 Shl 3);
                  Handle_SDBD;
                  Assemble := True;
                End;
              End;
          40: Begin              { MVO@ }
                If Get_Reg_Reg Then
                Begin
                  Word1    := $0240 + (R2 Shl 3) + R1;
                  NumWords := 1;
                  Assemble := True;
                End;
              End;
          41: Begin              { PSHR (MVO@ RR,R6) }
                If Get_Reg Then
                Begin
                  Word1    := $0270 + R1;
                  NumWords := 1;
                  Assemble := True;
                End;
              End;
          42: Begin              { MVOI (MVO@ RR,R7) }
                If Get_Reg_Word Then
                Begin
                  Word1 := $0278 + R1;
                  Handle_SDBD;
                  Assemble := True;
                End;
              End;
          43: Begin              { MVI }
                If Get_Word_Reg Then
                Begin
                  Word1 := $0280 + (R1 Shl 3);
                  Handle_SDBD;
                  Assemble := True;
                End;
              End;
          44: Begin              { MVI@ }
                If Get_Reg_Reg Then
                Begin
                  Word1    := $0280 + (R1 Shl 3) + R2;
                  NumWords := 1;
                  Assemble := True;
                End;
              End;
          45: Begin              { PULR (MVI@ R6,RR) }
                If Get_Reg Then
                Begin
                  Word1    := $02B0 + R1;
                  NumWords := 1;
                  Assemble := True;
                End;
              End;
          46: Begin              { MVII (MVI@ R7,RR) }
                If Get_Word_Reg Then
                Begin
                  Word1 := $02B8 + R1;
                  Handle_SDBD;
                  Assemble := True;
                End;
              End;
  47,50,53,56,59: Begin          { ADD, SUB, CMP, AND, XOR }
                If Get_Word_Reg Then
                Begin
                  Word1 := $02C0 + ((I - 47) Div 3) * $40 + R1;
                  Handle_SDBD;
                  Assemble := True;
                End;
              End;
  48,51,54,57,60: Begin          { ADD@, SUB@, CMP@, AND@, XOR@ }
                If Get_Reg_Reg Then
                Begin
                  Word1    := $02C0 + ((I - 48) Div 3) * $40 + (R1 Shl 3) + R2;
                  NumWords := 1;
                  Assemble := True;
                End;
              End;
  49,52,55,58,61: Begin          { ADDI, SUBT, CMPI, ANDI, XORI }
                If Get_Word_Reg Then
                Begin
                  Word1 := $02F8 + R1 + ((I - 49) Div 3) * $40;
                  Handle_SDBD;
                  Assemble := True;
                End;
              End;
      62..78: Begin              { Conditional branches }
                Addr := ValHex(St);
                If (Addr >= 0) And (Addr <= $FFFF) Then
                Begin
                  If Addr >= PC + 2 Then
                  Begin
                    Dec(Addr,PC + 2);
                    Word1 := $0200 + I - 62;
                  End
                  Else
                  Begin
                    Addr  := PC + 1 - Addr;
                    Word1 := $0220 + I - 62;
                  End;
                  Word2    := Addr;
                  If (Word2 And $FC00) <> 0 Then Warn := True; { More than 10 bits }
                  NumWords := 2;
                  Assemble := True;
                End;
              End;
      End; { Case }
    End
    Else Assemble := False;
  End
  Else Assemble := False;
End; { TfrmDebugger.Assemble }

Function TfrmDebugger.Disassemble(Buf: CP1600Mem; Var Addr: Word; SDBD: Boolean): String;
Var
  St      : String;
  Disp    : LongInt;
  Opcode  : Word;
  Opcode2 : Word;
  Opcode3 : Word;

  Procedure Disasm_ALU_Mem(Base: Word; Const Mnem1,Mnem2,Mnem3: String);
  Begin
    If Opcode < Base + 8 Then
    Begin
      If SDBD Then
      Begin
        St := Mnem1 + '   ' + HexWord((Opcode2 And $FF) + (Opcode3 Shl 8)) +
                       ',R' + IntToStr(Opcode And 7);
        Inc(Addr,2);
      End
      Else
      Begin
        St := Mnem1 + '   ' + HexWord(Opcode2) +
                       ',R' + IntToStr(Opcode And 7);
        Inc(Addr);
      End;
    End
    Else
    Begin
      If ((Opcode Shr 3) And 7) <> 7 Then
       St := Mnem2 + '   R' + IntToStr((Opcode Shr 3) And 7) +
                       ',R' + IntToStr(Opcode And 7)
      Else
      Begin
        If SDBD Then
        Begin
          St := Mnem3 + '   ' + HexWord((Opcode2 And $FF) + (Opcode3 Shl 8)) +
                         ',R' + IntToStr(Opcode And 7);
          Inc(Addr,2);
        End
        Else
        Begin
          St := Mnem3 + '   ' + HexWord(Opcode2) +
                         ',R' + IntToStr(Opcode And 7);
          Inc(Addr);
        End;
      End;
    End;
  End; { Disasm_ALU_Mem }

Begin
  St  := '';
  Opcode  := IntvMem[Addr] And $3FF;
  Opcode2 := IntvMem[Addr + 1] And $3FF;
  Opcode3 := IntvMem[Addr + 2] And $3FF;
  Case Opcode Of
     0: St := 'HLT';
     1: St := 'SDBD';
     2: St := 'EIS';
     3: St := 'DIS';
     4: Begin
          Case (Opcode2 And 3) Of
            0: If (Opcode2 And $300) = $300 Then St := 'J      ' Else St := 'JSR    R';
            1: If (Opcode2 And $300) = $300 Then St := 'JE     ' Else St := 'JSRE   R';
            2: If (Opcode2 And $300) = $300 Then St := 'JD     ' Else St := 'JSRD   R';
          End; { Case }
          If (Opcode2 And $300) <> $300 Then St := St + IntToStr(((Opcode2 And $300) Shr 8) + 4) + ',';
          St := St + HexWord((Opcode3 And $3FF) + ((Opcode2 And $FC) Shl 8));
          Inc(Addr,2);
        End;
     5: St := 'TCI';
     6: St := 'CLRC';
     7: St := 'SETC';
 8..15: St := 'INCR   R' + IntToStr(Opcode And 7);
16..23: St := 'DECR   R' + IntToStr(Opcode And 7);
24..31: St := 'COMR   R' + IntToStr(Opcode And 7);
32..39: St := 'NEGR   R' + IntToStr(Opcode And 7);
40..47: St := 'ADCR   R' + IntToStr(Opcode And 7);
48..51: St := 'GSWD   R' + IntToStr(Opcode And 3);
52..53: St := 'NOP';
54..55: St := 'SIN';
56..63: St := 'RSWD   R' + IntToStr(Opcode And 7);
64..71: Begin
          St := 'SWAP   R' + IntToStr(Opcode And 3);
          If (Opcode And 4) <> 0 Then St := St + ',2';
        End;
72..79: Begin
          St := 'SLL    R' + IntToStr(Opcode And 3);
          If (Opcode And 4) <> 0 Then St := St + ',2';
        End;
80..87: Begin
          St := 'RLC    R' + IntToStr(Opcode And 3);
          If (Opcode And 4) <> 0 Then St := St + ',2';
        End;
88..95: Begin
          St := 'SLLC   R' + IntToStr(Opcode And 3);
          If (Opcode And 4) <> 0 Then St := St + ',2';
        End;
96..103: Begin
          St := 'SLR    R' + IntToStr(Opcode And 3);
          If (Opcode And 4) <> 0 Then St := St + ',2';
        End;
104..111: Begin
          St := 'SAR    R' + IntToStr(Opcode And 3);
          If (Opcode And 4) <> 0 Then St := St + ',2';
        End;
112..119: Begin
          St := 'RRC    R' + IntToStr(Opcode And 3);
          If (Opcode And 4) <> 0 Then St := St + ',2';
        End;
120..127: Begin
          St := 'SARC   R' + IntToStr(Opcode And 3);
          If (Opcode And 4) <> 0 Then St := St + ',2';
        End;
128..191: Begin
          If (Opcode And 7) = 7 Then
           St := 'JR     R' + IntToStr((Opcode Shr 3) And 7)
          Else
          Begin
            If (Opcode And 7) = ((Opcode Shr 3) And 7)
             Then St := 'TSTR   R' + IntToStr((Opcode Shr 3) And 7)
             Else St := 'MOVR   R' + IntToStr((Opcode Shr 3) And 7) +
                              ',R' + IntToStr(Opcode And 7);
          End;
        End;
192..255: St := 'ADDR   R' + IntToStr((Opcode Shr 3) And 7) +
                      ',R' + IntToStr(Opcode And 7);
256..319: St := 'SUBR   R' + IntToStr((Opcode Shr 3) And 7) +
                      ',R' + IntToStr(Opcode And 7);
320..383: St := 'CMPR   R' + IntToStr((Opcode Shr 3) And 7) +
                      ',R' + IntToStr(Opcode And 7);
384..447: St := 'ANDR   R' + IntToStr((Opcode Shr 3) And 7) +
                      ',R' + IntToStr(Opcode And 7);
448..511: St := 'XORR   R' + IntToStr((Opcode Shr 3) And 7) +
                      ',R' + IntToStr(Opcode And 7);
512..575: Begin
          Disp := Opcode2;
          If (Opcode And $20) <> 0 Then Disp := -(Disp + 1);
          Inc(Disp,Addr + 2);
          If (Opcode And $10) <> 0
           Then St := 'BEXT   ' + HexWord(Disp) +
                            ',' + HexByte(Opcode And $F)
           Else St := BMnem[Opcode And $F] + '   ' + HexWord(Disp);
          Inc(Addr);
        End;
576..583: Begin
          If SDBD Then
          Begin
            St := 'MVO    R' + IntToStr(Opcode And 7) +
                         ',' + HexWord((Opcode2 And $FF) + (Opcode3 Shl 8));
            Inc(Addr,2);
          End
          Else
          Begin
            St := 'MVO    R' + IntToStr(Opcode And 7) +
                         ',' + HexWord(Opcode2);
            Inc(Addr);
          End;
        End;
584..639: Begin
          Case (Opcode Shr 3) And 7 Of
            0..5: St := 'MVO@   R' + IntToStr(Opcode And 7) +
                              ',R' + IntToStr((Opcode Shr 3) And 7);
               6: St := 'PSHR   R' + IntToStr(Opcode And 7);
               7: Begin
                    If SDBD Then
                    Begin
                      St := 'MVOI   R' + IntToStr(Opcode And 7) +
                                   ',' + HexWord((Opcode2 And $FF) + (Opcode3 Shl 8));
                      Inc(Addr,2);
                    End
                    Else
                    Begin
                      St := 'MVOI   R' + IntToStr(Opcode And 7) +
                                   ',' + HexWord(Opcode2);
                      Inc(Addr);
                    End;
                  End;
          End; { Case }
        End;
640..647: Begin
          If SDBD Then
          Begin
            St := 'MVI    ' + HexWord((Opcode2 And $FF) + (Opcode3 Shl 8)) +
                       ',R' + IntToStr(Opcode And 7);
            Inc(Addr,2);
          End
          Else
          Begin
            St := 'MVI    ' + HexWord(Opcode2) +
                       ',R' + IntToStr(Opcode And 7);
            Inc(Addr);
          End;
        End;
648..703: Begin
          Case (Opcode Shr 3) And 7 Of
            0..5: St := 'MVI@   R' + IntToStr((Opcode Shr 3) And 7) +
                              ',R' + IntToStr(Opcode And 7);
               6: St := 'PULR   R' + IntToStr(Opcode And 7);
               7: Begin
                    If SDBD Then
                    Begin
                      St := 'MVII   ' + HexWord((Opcode2 And $FF) + (Opcode3 Shl 8)) +
                                 ',R' + IntToStr(Opcode And 7);
                      Inc(Addr,2);
                    End
                    Else
                    Begin
                      St := 'MVII   ' + HexWord(Opcode2) +
                                 ',R' + IntToStr(Opcode And 7);
                      Inc(Addr);
                    End;
                  End;
          End; { Case }
        End;
 704..767: Disasm_ALU_Mem(704,'ADD ','ADD@','ADDI');
 768..831: Disasm_ALU_Mem(768,'SUB ','SUB@','SUBT');
 832..895: Disasm_ALU_Mem(832,'CMP ','CMP@','CMPI');
 896..959: Disasm_ALU_Mem(896,'AND ','AND@','ANDI');
960..1023: Disasm_ALU_Mem(960,'XOR ','XOR@','XORI');
  End; { Case }
  Inc(Addr);
  Disassemble := St;
End; { TfrmDebugger.Disassemble }

Procedure TfrmDebugger.FBox(X1,Y1,X2,Y2: Integer; Col: Byte);
Begin
  Canvas.Pen.Color   := ScreenPalette[Col];
  Canvas.Brush.Color := ScreenPalette[Col];
  Canvas.Brush.Style := bsSolid;
  Canvas.Rectangle(X1,Y1,X2 + 1,Y2 + 1);
End; { TfrmDebugger.FBox }


Procedure TfrmDebugger.WriteOut(B: TBevel; X,Y: Integer; St: String; Col: Word);
Begin
  X := (X - 1) * Canvas.TextWidth('M')   + B.Left + 1;
  Y := (Y - 1) * Canvas.TextHeight('Mg') + B.Top  + 1;
  Canvas.Font.Color  := ScreenPalette[Lo(Col)];
  Canvas.Brush.Color := ScreenPalette[Hi(Col)];
  Canvas.TextOut(X,Y,St);
End; // TfrmDebugger.WriteOut


Procedure TfrmDebugger.WriteOutBold(B: TBevel; X,Y: Integer; St: String; Col: Word);
Begin
  X := (X - 1) * Canvas.TextWidth('M')   + B.Left + 1;
  Y := (Y - 1) * Canvas.TextHeight('Mg') + B.Top  + 1;
  Canvas.Font.Style := [fsBold];
  Canvas.Font.Color  := ScreenPalette[Lo(Col)];
  Canvas.Brush.Color := ScreenPalette[Hi(Col)];
  Canvas.TextOut(X,Y,St);
  Canvas.Font.Style := [];
End; // TfrmDebugger.WriteOutBold


Procedure TfrmDebugger.FillInBevel(B: TBevel; Col: Byte);
Begin
  FBox(B.Left + 1,B.Top + 1,B.Left + B.Width - 2,B.Top + B.Height - 2,Col);
End; // TfrmDebugger.FillInBevel

Procedure TfrmDebugger.Display;
Var I,J,K: Integer;

  Procedure ShowBasicInfo;
  Var I: Integer;
  Begin
    WriteOut(bvlFlags,1,1,'SZOC',NormTextColor + (FlagsColor Shl 8));

    WriteOut(bvlRegs,1,1,'R0=    h',NormTextColor + (RegsColor Shl 8));
    WriteOut(bvlRegs,1,2,'R1=    h',NormTextColor + (RegsColor Shl 8));
    WriteOut(bvlRegs,1,3,'R2=    h',NormTextColor + (RegsColor Shl 8));
    WriteOut(bvlRegs,1,4,'R3=    h',NormTextColor + (RegsColor Shl 8));
    WriteOut(bvlRegs,1,5,'R4=    h',NormTextColor + (RegsColor Shl 8));
    WriteOut(bvlRegs,1,6,'R5=    h',NormTextColor + (RegsColor Shl 8));
    WriteOut(bvlRegs,1,7,'R6=    h',NormTextColor + (RegsColor Shl 8));
    WriteOut(bvlRegs,1,8,'R7=    h',NormTextColor + (RegsColor Shl 8));
    
    { Display flag data }

    For I := 0 To 3 Do
    Begin
      If (StatusWord And (1 Shl I)) <> 0
       Then WriteOutBold(bvlFlags,4 - I,2,'1',HiTextColor + (FlagsColor Shl 8))
       Else WriteOutBold(bvlFlags,4 - I,2,'0',HiTextColor + (FlagsColor Shl 8));
    End; { For I }

    If IntPending
     Then WriteOutBold(bvlFlags,6,2,'IP',HiTextColor + (FlagsColor Shl 8))
     Else WriteOutBold(bvlFlags,6,2,'NI',HiTextColor + (FlagsColor Shl 8));
    WriteOutBold(bvlFlags,8,2,IntToStr(Interrupts),HiTextColor + (FlagsColor Shl 8));


    { Display reg data }

    WriteOutBold(bvlRegs,4,1,HexWord(Regs[0]),HiTextColor + (RegsColor Shl 8));
    WriteOutBold(bvlRegs,4,2,HexWord(Regs[1]),HiTextColor + (RegsColor Shl 8));
    WriteOutBold(bvlRegs,4,3,HexWord(Regs[2]),HiTextColor + (RegsColor Shl 8));
    WriteOutBold(bvlRegs,4,4,HexWord(Regs[3]),HiTextColor + (RegsColor Shl 8));
    WriteOutBold(bvlRegs,4,5,HexWord(Regs[4]),HiTextColor + (RegsColor Shl 8));
    WriteOutBold(bvlRegs,4,6,HexWord(Regs[5]),HiTextColor + (RegsColor Shl 8));
    WriteOutBold(bvlRegs,4,7,HexWord(Regs[6]),HiTextColor + (RegsColor Shl 8));
    WriteOutBold(bvlRegs,4,8,HexWord(Regs[7]),HiTextColor + (RegsColor Shl 8));

    // Display screen mode information 

    WriteOut(bvlScreenData,1,1,'Mode:',NormTextColor + (ScrDatColor Shl 8));
    If ScreenMode = smForeBack
     Then WriteOutBold(bvlScreenData,6,1,'F/B',HiTextColor + (ScrDatColor Shl 8))
     Else WriteOutBold(bvlScreenData,6,1,'ClStk',HiTextColor + (ScrDatColor Shl 8));

    // Show color stack information

    WriteOut(bvlScreenData,1,2,'CStk+BdCol',NormTextColor + (ScrDatColor Shl 8));
    For I := 0 To 3 Do
    Begin
      J  := IntvMem[ColorStackLoc + I] And $F;
      St := IntToStr(J);
      If Length(St) = 1 Then St := ' ' + St;
      K  := _Palette[J].R + _Palette[J].G + _Palette[J].B;
      If K >= 32*3
       Then WriteOutBold(bvlScreenData,I * 2 + 1,3,St,J Shl 8)
       Else WriteOutBold(bvlScreenData,I * 2 + 1,3,St,(J Shl 8) + 7);
    End; { For I }

    // Show border information

    J  := IntvMem[BorderColorLoc] And $F;
    St := IntToStr(J);
    If Length(St) = 1 Then St := ' ' + St;
    K  := _Palette[J].R + _Palette[J].G + _Palette[J].B;
    If K >= 32*3
     Then WriteOutBold(bvlScreenData,9,3,St,J Shl 8)
     Else WriteOutBold(bvlScreenData,9,3,St,(J Shl 8) + 7);

    // Show horizontal & vertical delay

    WriteOut(bvlScreenData,1,4,'Delay= ,',NormTextColor + (ScrDatColor Shl 8));
    WriteOutBold(bvlScreenData,7,4,IntToStr(HDelay),HiTextColor + (ScrDatColor Shl 8));
    WriteOutBold(bvlScreenData,9,4,IntToStr(VDelay),HiTextColor + (ScrDatColor Shl 8));

    // Display other window headings

    WriteOutBold(bvlObjectLoc,1,1,'Object positions',NormTextColor + (ObjLocColor Shl 8));
    WriteOutBold(bvlData,1,1,'CP-1600 Memory dump',NormTextColor + (DataColor Shl 8));

  End; // ShowBasicInfo

Begin
  FillInBevel(bvlInstructions,DisasmColor);
  FillInBevel(bvlFlags,FlagsColor);
  FillInBevel(bvlRegs,RegsColor);
  FillInBevel(bvlScreenData,ScrDatColor);
  FillInBevel(bvlTIARegs,TIA_Color);
  FillInBevel(bvlInputRegs,DataColor);
  FillInBevel(bvlObjectLoc,ObjLocColor);
  FillInBevel(bvlData,DataColor);
  
  ShowBasicInfo;
  
  // Display object locations

  For I := 0 To 7 Do
  Begin
    WriteOut(bvlObjectLoc,(I Mod 4) * 14 + 1,2 + I Div 4,'S' + IntToStr(I) + '=',NormTextColor + (ObjLocColor Shl 8));
    WriteOutBold(bvlObjectLoc,(I Mod 4) * 14 + 4,2 + I Div 4,'(' + IntToStr(SpriteX[I]) + ',' + IntToStr(SpriteY[I]) + ')',ScrDatColor + (ObjLocColor Shl 8));
  End; // For I

  // Display data area

  For I := 0 To DataLines - 1 Do
  Begin
    WriteOutBold(bvlData,1,2 + I,HexWord(DataTop + I * 8),NormTextColor + (DataColor Shl 8));
    For J := 0 To 7 Do
     WriteOut(bvlData,6 + J * 5,2 + I, HexWord(IntvMem[DataTop + I * 8 + J]),NormTextColor + (DataColor Shl 8));
  End; { For I }
End; { TfrmDebugger.Display }


Function TfrmDebugger.TransWordWrite(Addr: Word): String;
Begin
  TransWordWrite := HexWord(Addr);
End; { TfrmDebugger.TransWordWrite }


Function TfrmDebugger.TransWordRead(Addr: Word): String;
Begin
  TransWordRead := HexWord(Addr);
End; { TfrmDebugger.TransWordRead }


Function TfrmDebugger.TransByteRead(Addr: Word): String;
Begin
  TransByteRead := HexByte(Addr);
End; { TfrmDebugger.TransByteRead }


Function TfrmDebugger.TransByteWrite(Addr: Word): String;
Begin
  TransByteWrite := HexByte(Addr);
End; { TfrmDebugger.TransByteWrite }


Function TfrmDebugger.TransWord(Addr: Word): String;
Begin
  TransWord := HexWord(Addr);
End; { TfrmDebugger.TransWord }


Function TfrmDebugger.TransByte(Addr: Word): String;
Begin
  TransByte := HexByte(Addr);
End; { TfrmDebugger.TransByte }

procedure TfrmDebugger.FormPaint(Sender: TObject);
Var
  I,J,K,H  : Integer;
  SDBD     : Boolean;

begin
  Display;

  H := Canvas.TextHeight('Mg');

  // Set scrollbar position

  I := TopAddr;
  If I < 0 Then I := 0;
  If I > sbInstructions.Max Then I := sbInstructions.Max;
  sbInstructions.Position := I;

  { Display instructions }

  Addr := TopAddr;
  _DLines := (bvlInstructions.Height - 2) Div H;

  I    := TopAddr - 1;
  SDBD := ((TopAddr > 0) And ((IntvMem[I] And $3FF) = 1));
  SetLength(SDBDInst,_DLines);
  For I := 0 To _DLines - 1 Do
  Begin
    If Addr = Regs[7] Then
    Begin
      Color := PCTextColor + (HiTextColor Shl 8);
      FBox(bvlInstructions.Left + 1,bvlInstructions.Top + I * H + 1,
           bvlInstructions.Left + bvlInstructions.Width - 2,
           bvlInstructions.Top + I * H + 1 + H,HiTextColor);
    End
    Else
    Begin
      If I = 0 Then
      Begin
        Color := NormTextColor + (TopAsmColor Shl 8);
        FBox(bvlInstructions.Left + 1,bvlInstructions.Top + I * H + 1,
             bvlInstructions.Left + bvlInstructions.Width - 2,
             bvlInstructions.Top + I * H + 1 + H,TopAsmColor);
      End
      Else
      Begin
        Color := NormTextColor + (DisasmColor Shl 8);
        FBox(bvlInstructions.Left + 1,bvlInstructions.Top + I * H + 1,
             bvlInstructions.Left + bvlInstructions.Width - 2,
             bvlInstructions.Top + I * H + 1 + H,DisasmColor);
      End;
    End;

    Opcode := IntvMem[Addr] And $3FF;
    If Opcode = 1 Then SDBD := True;

    // Display the instruction address

    WriteOutBold(bvlInstructions,1,1 + I,HexWord(Addr),Color);

    // Display the instruction mnemonic and determine its size

    K := Addr;
    WriteOut(bvlInstructions,23,1 + I,Disassemble(IntvMem,Addr,SDBD),Color);
    SDBDInst[I] := SDBD;

    // Display the opcodes

    For J := 0 To Addr - K - 1 Do
     WriteOut(bvlInstructions,7 + J * 5,1 + I,HexWord(IntvMem[K + J]),Color);
    If Opcode <> 1 Then SDBD := False;
  End; { For I }
end;

Procedure TfrmDebugger.InitDebugger;
Type
  TRGBA = Packed Record
    R,G,B,A: Byte;
  End;

Var
  I : Integer;
  C : TRGBA;

Begin
  Font.Name := FontName;
  Font.Size := FontSize;
  TopAddr   := Regs[7];

  // Fill in ScreenPalette

  C.A := 0;
  For I := 0 To 255 Do
  Begin
    C.R := Pal[I].R;
    C.G := Pal[I].G;
    C.B := Pal[I].B;
    ScreenPalette[I] := TColor(C);
  End; // For I
End; // TfrmDebugger.InitDebugger

procedure TfrmDebugger.FormShow(Sender: TObject);
begin
  If Not Showing Then
  Begin
    Showing := True;
    Caption := 'IntvWin ' + Version;
    InitDebugger;
    btnStop.Enabled := False;
    sbData.LargeChange := DataLines;
    If Not frmDebugger6502.Showing Then
    Begin
      If Not frmDebugger6502.Visible
       Then frmDebugger6502.Show
       Else frmDebugger6502.FormShow(Self);
    End;   
    Showing := False;
  End;
end;

procedure TfrmDebugger.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  If Not Closing Then
  Begin
    Closing := True;
    If ShowObjs Then Move(DebugScnBuf,ScnBuf,SizeOf(ScnBuf));
    Debugger                     := False;
    frmMain.ShowObjectLocs       := False;
    frmMain.UseDebugger1.Checked := Debugger;
    frmMain.Display;
    If Not frmDebugger6502.Closing Then frmDebugger6502.Close;
    Closing := False;
  End;  
end;

procedure TfrmDebugger.FormResize(Sender: TObject);
Var W,H: Integer;
begin

  // Get character dimensions

  W := Canvas.TextWidth('M');
  H := Canvas.TextHeight('Mg');

  // There are a minimum required width and height.  Don't allow anything smaller.

  If ClientWidth < 53 * W + 10 Then ClientWidth := 53 * W + 10;
  If ClientHeight < 42 * H + 14 + pnlButtons.Height Then ClientHeight := 42 * H + 14 + pnlButtons.Height;

  // Set positions

  bvlFlags.Width         := 10 * W + 2;
  bvlRegs.Width          := bvlFlags.Width;
  bvlScreenData.Width    := bvlFlags.Width;

  bvlFlags.Height        := 2 * H + 2;
  bvlRegs.Height         := 8 * H + 2;
  bvlScreenData.Height   := 6 * H + 2;

  bvlRegs.Top            := bvlFlags.Height;
  bvlScreenData.Top      := bvlRegs.Top + bvlRegs.Height;

  bvlFlags.Left          := ClientWidth - bvlRegs.Width;
  bvlRegs.Left           := bvlFlags.Left;
  bvlScreenData.Left     := bvlFlags.Left;

  bvlinstructions.Width  := bvlFlags.Left - sbInstructions.Width;
  sbInstructions.Left    := bvlInstructions.Width;
  btnPC.Left             := sbInstructions.Left;
  btnTop.Left            := sbInstructions.Left;

  bvlTIARegs.Width       := ClientWidth;
  bvlInputRegs.Width     := ClientWidth;
  bvlObjectLoc.Width     := ClientWidth;
  bvlData.Width          := ClientWidth;

  bvlTIARegs.Height      := 4 * H + 2;
  bvlInputRegs.Height    := 2 * H + 2;
  bvlObjectLoc.Height    := 3 * H + 2;
  bvlData.Height         := (DataLines + 1) * H + 2;

  sbData.Top             := bvlData.Top;
  sbData.Height          := bvlData.Height;
  sbData.Left            := bvlData.Left + bvlData.Width - sbData.Width;

  bvlData.Top            := pnlButtons.Top - bvlData.Height;
  bvlObjectLoc.Top       := bvlData.Top - bvlObjectLoc.Height;
  bvlInputRegs.Top       := bvlObjectLoc.Top - bvlInputRegs.Height;
  bvlTIARegs.Top         := bvlInputRegs.Top - bvlTIARegs.Height;
  bvlInstructions.Height := bvlTIARegs.Top - bvlInstructions.Top;
  sbInstructions.Height  := bvlInstructions.Height - btnPC.Height - btnTop.Height;
  btnPC.Top              := sbInstructions.Height + btnTop.Height;
end;

procedure TfrmDebugger.btnTraceClick(Sender: TObject);
begin
  Trace := 1;
  If ShowObjs Then Move(DebugScnBuf,ScnBuf,SizeOf(ScnBuf));
  frmMain.ShowObjectLocs := False;
  Emulate;
  Trace := 0;
  If ShowObjs Then Move(ScnBuf,DebugScnBuf,SizeOf(DebugScnBuf));
  frmMain.ShowObjectLocs := ShowObjs;
  frmMain.Display;
end;

Procedure TfrmDebugger.Enable(Running: Boolean);
Begin
  If Running Then
  Begin
    If ShowObjs Then Move(DebugScnBuf,ScnBuf,SizeOf(ScnBuf));
    frmMain.ShowObjectLocs  := False;
    btnGo.Enabled           := False;
    btnTrace.Enabled        := False;
    btnSkip.Enabled         := False;
    btnHere.Enabled         := False;
    btnAsm.Enabled          := False;
    btnExpression.Enabled   := False;
    btnReg.Enabled          := False;
    btnMem.Enabled          := False;
    btnSave.Enabled         := False;
    btnObjectLoc.Enabled    := False;
    btnStop.Enabled         := True;
    sbInstructions.Enabled  := False;
    sbData.Enabled          := False;

    frmDebugger6502.btnGo.Enabled          := False;
    frmDebugger6502.btnTrace.Enabled       := False;
    frmDebugger6502.btnSkip.Enabled        := False;
    frmDebugger6502.btnHere.Enabled        := False;
    frmDebugger6502.btnExpression.Enabled  := False;
    frmDebugger6502.btnReg.Enabled         := False;
    frmDebugger6502.btnMem.Enabled         := False;
    frmDebugger6502.btnSave.Enabled        := False;
    frmDebugger6502.btnStop.Enabled        := True;
    frmDebugger6502.sbData.Enabled         := False;
    frmDebugger6502.sbInstructions.Enabled := False;
  End
  Else
  Begin
    If ShowObjs Then Move(ScnBuf,DebugScnBuf,SizeOf(DebugScnBuf));
    frmMain.ShowObjectLocs := ShowObjs;
    frmMain.Display;
    btnGo.Enabled          := True;
    btnTrace.Enabled       := True;
    btnSkip.Enabled        := True;
    btnHere.Enabled        := True;
    btnAsm.Enabled         := True;
    btnExpression.Enabled  := True;
    btnReg.Enabled         := True;
    btnMem.Enabled         := True;
    btnSave.Enabled        := True;
    btnObjectLoc.Enabled   := True;
    btnStop.Enabled        := False;

    frmDebugger6502.btnGo.Enabled          := True;
    frmDebugger6502.btnTrace.Enabled       := True;
    frmDebugger6502.btnSkip.Enabled        := True;
    frmDebugger6502.btnHere.Enabled        := True;
    frmDebugger6502.btnExpression.Enabled  := True;
    frmDebugger6502.btnReg.Enabled         := True;
    frmDebugger6502.btnMem.Enabled         := True;
    frmDebugger6502.btnSave.Enabled        := True;
    frmDebugger6502.btnStop.Enabled        := False;
    frmDebugger6502.sbData.Enabled         := True;
    frmDebugger6502.sbInstructions.Enabled := True;

    sbInstructions.Enabled := True;
    sbData.Enabled         := True;
  End;
End; // TfrmDebugger.Enable

procedure TfrmDebugger.btnGoClick(Sender: TObject);
begin
  DebugAddr := 0;
  Debug6502 := False;
  Enable(True);
  Emulate;
  Enable(False);
end;

procedure TfrmDebugger.btnSkipClick(Sender: TObject);
Var I: Word;
begin
  Opcode := IntvMem[Regs[7]] And $3FF;
  I := Regs[7];
  If (Regs[7] > 0) And ((IntvMem[Regs[7] - 1] And $3FF) = 1)
   Then Disassemble(IntvMem,I,True)
   Else Disassemble(IntvMem,I,False);
  DebugAddr := I;
  Debug6502 := False;
  Enable(True);
  Emulate;
  Enable(False);
  frmMain.Display;
end;

procedure TfrmDebugger.btnHereClick(Sender: TObject);
begin
  DebugAddr := TopAddr;
  Debug6502 := False;
  Enable(True);
  Emulate;
  Enable(False);
  frmMain.Display;
end;

procedure TfrmDebugger.btnMemClick(Sender: TObject);
Var
  St                  : String;
  HexAddr,Code,HexVal : Integer;

begin
  St := Trim(InputBox('Change memory contents','Enter new data in the form "address=value"',''));
  If St <> '' Then
  Begin
    Code := Pos('=',St);
    If Code <> 0 Then
    Begin
      HexAddr := ValHex(Trim(Copy(St,1,Code - 1)));
      If (HexAddr >= 0) And (HexAddr >= $80) Then
      Begin
        St   := Trim(Copy(St,Code + 1,Length(St) - Code));
        Code := Pos(' ',St);
        If (Code = 0) And (St <> '') Then Code := Length(St) + 1;
        While Code <> 0 Do
        Begin
          HexVal := ValHex(Trim(Copy(St,1,Code - 1)));
          If HexVal >= 0 Then IntvMem[HexAddr] := HexVal And $FF;
          Inc(HexAddr);
          St   := Trim(Copy(St,Code + 1,Length(St) - Code));
          Code := Pos(' ',St);
          If (Code = 0) And (St <> '') Then Code := Length(St) + 1;
        End; { While }
        Repaint;
      End;
    End;
  End;
end;

procedure TfrmDebugger.btnSaveClick(Sender: TObject);
begin
  If dlgSave.Execute Then
  Begin
    St := Trim(dlgSave.FileName);
    If St <> '' Then
    Begin
    {$I-}
      AssignFile(OutFile,St);
      ReWrite(OutFile,1);
    {$I+}
      If IOResult = 0 Then
      Begin
        BlockWrite(OutFile,IntvMem[$1000],$1000);
        CloseFile(OutFile);
      End;
    End;
  End;  
end;

procedure TfrmDebugger.btnStopClick(Sender: TObject);
begin
  If Emulating > 0 Then NewList := True;
  Emulating  := 0;
end;

procedure TfrmDebugger.FormCreate(Sender: TObject);
begin
  ShowObjs := False;
  DataTop  := 0;
  Showing  := False;
  Closing  := False;
end;

procedure TfrmDebugger.sbInstructionsScroll(Sender: TObject;
  ScrollCode: TScrollCode; var ScrollPos: Integer);
Var
  I,J   : Integer;
  K     : Word;
  SDBD  : Boolean;

begin
  Case ScrollCode Of
    scLineUp: If TopAddr > 0 Then Dec(TopAddr);
  scLineDown: Begin
                Opcode := IntvMem[TopAddr] And $3FF;
                Disassemble(IntvMem,TopAddr,SDBDInst[0]);
              End;
    scPageUp: Begin
                SDBD := False;
                I := TopAddr;
                Repeat
                  J := 0;
                  K := I;
                  While K < TopAddr Do
                  Begin
                    Inc(J);
                    Opcode := IntvMem[K] And $3FF;
                    Disassemble(IntvMem,K,SDBD);
                    SDBD := (Opcode = 1);
                  End; { While }
                  If J < _DLines - 1 Then Dec(I);
                Until J >= _Dlines - 1;
                TopAddr := I;
              End;
  scPageDown: TopAddr := Addr;
  scPosition,scTrack: TopAddr := ScrollPos;
       scTop: TopAddr := 0;
    scBottom: TopAddr := $FFFF;
  End; // Case
  Repaint;
end;

procedure TfrmDebugger.btnPCClick(Sender: TObject);
begin
  TopAddr := Regs[7];
  Repaint;
end;

procedure TfrmDebugger.btnTopClick(Sender: TObject);
begin
  TopAddr := 0;
  Repaint;
end;

procedure TfrmDebugger.btnRegClick(Sender: TObject);
Var
  St          : String;
  Code,HexVal : Integer;

begin
  St   := UpperCase(Trim(InputBox('Change register contents','Enter new value in the form reg=value','')));
  Code := Pos(' ',St);
  While Code <> 0 Do
  Begin
    Delete(St,Code,1);
    Code := Pos(' ',St);
  End; { While }
  If St <> '' Then
  Begin
    If Copy(St,1,3) = 'R0=' Then
    Begin
      HexVal := ValHex(Copy(St,4,Length(St) - 3));
      If HexVal >= 0 Then
      Begin
        Regs[0] := HexVal;
        Repaint;
      End;
    End;
    If Copy(St,1,3) = 'R1=' Then
    Begin
      HexVal := ValHex(Copy(St,4,Length(St) - 3));
      If HexVal >= 0 Then
      Begin
        Regs[1] := HexVal;
        Repaint;
      End;
    End;
    If Copy(St,1,3) = 'R2=' Then
    Begin
      HexVal := ValHex(Copy(St,4,Length(St) - 3));
      If HexVal >= 0 Then
      Begin
        Regs[2] := HexVal;
        Repaint;
      End;
    End;
    If Copy(St,1,3) = 'R3=' Then
    Begin
      HexVal := ValHex(Copy(St,4,Length(St) - 3));
      If HexVal >= 0 Then
      Begin
        Regs[3] := HexVal;
        Repaint;
      End;
    End;
    If Copy(St,1,3) = 'R4=' Then
    Begin
      HexVal := ValHex(Copy(St,4,Length(St) - 3));
      If HexVal >= 0 Then
      Begin
        Regs[4] := HexVal;
        Repaint;
      End;
    End;
    If Copy(St,1,3) = 'R5=' Then
    Begin
      HexVal := ValHex(Copy(St,4,Length(St) - 3));
      If HexVal >= 0 Then
      Begin
        Regs[5] := HexVal;
        Repaint;
      End;
    End;
    If Copy(St,1,3) = 'R6=' Then
    Begin
      HexVal := ValHex(Copy(St,4,Length(St) - 3));
      If HexVal >= 0 Then
      Begin
        Regs[6] := HexVal;
        Repaint;
      End;
    End;
    If Copy(St,1,3) = 'R7=' Then
    Begin
      HexVal := ValHex(Copy(St,4,Length(St) - 3));
      If HexVal >= 0 Then
      Begin
        Regs[7] := HexVal;
        Repaint;
      End;
    End;
    If Copy(St,1,3) = 'SW=' Then
    Begin
      HexVal := ValHex(Copy(St,4,Length(St) - 3));
      If HexVal >= 0 Then
      Begin
        StatusWord := HexVal And $F;
        Display;
      End;
    End;
  End;  
end;

procedure TfrmDebugger.btnExpRefClick(Sender: TObject);
begin
  frmExpRef.Show;
end;

procedure TfrmDebugger.btnExpressionClick(Sender: TObject);
Var ExpError: Boolean;
begin
  St := Trim(InputBox('Break on expression','Enter breakpoint expression',BreakExp));

  { Get rid of the last break expression collection, if any }

  If BreakExpColl <> Nil Then
  Begin
    BreakExpColl.Free;
    BreakExpColl := Nil;
  End;
  ExpError := False;
  If St <> '' Then
  Begin
    BreakExpColl := PostFix(St);
    If BreakExpColl <> Nil Then
    Begin

      { Try to evaluate it to make sure it's ok (ignore the result) }

      Evaluate(BreakExpColl,IntvMem,Regs,StatusWord,SpriteX,SpriteY,ReadMem,WriteMem,RWMemLoc,ExpError);
      If ExpError Then
      Begin
        BreakExpColl.Free;
        BreakExpColl := Nil;
        St := '';
      End;
    End
    Else
    Begin
      St       := '';
      ExpError := True;
    End;
  End;
  BreakExp := St;  { Remember the last one }
  If ExpError Then ShowMessage('Error in expression');
end;

Function TfrmDebugger.LoadSaveState: Boolean;
Var
  St : String;
  I  : Integer;
  F  : File;
  B  : Byte;
  FB : Byte;

Begin
  If dlgSave.Execute Then
  Begin
    St := UpperCase(dlgSave.FileName);
    If (St <> '') And FileExists(St) Then
    Begin
      AssignFile(F,St);
      Reset(F,1);
      BlockRead(F,IntvMem[0],$20000);

      { Load CP1600 status word }

      Seek(F,$2001D);         { Not sure about this }
      BlockRead(F,StatusWord,2);

      { Load CP1600 registers }

      Seek(F,$2001E);
      BlockRead(F,Regs,16);

      { Load sound information }

      Seek(F,$20008);
      For I := 0 To $F Do
      Begin
        BlockRead(F,B,1);
        Handle_IO_Write($1F0 + I,B);
      End; { For I }

      { Load foreground/background / color stack information }

      Seek(F,$20039);
      BlockRead(F,FB,1);

      CloseFile(F);
      For I := 0 To $65 Do Handle_IO_Write(I,IntvMem[I]);
      If FB <> 0 Then Handle_IO_Write($0021,0) Else Handle_IO_Read($0021,0);
      LoadSaveState := True;
    End
    Else LoadSaveState := False;
  End
  Else LoadSaveState := False;  
End; { TfrmDebugger.LoadSaveState }

procedure TfrmDebugger.btnAsmClick(Sender: TObject);
Var
  St       : String;
  SDBD     : Boolean;
  AsmWord  : Array[0..2] Of Word;
  NumWords : Word;
  Warn     : Boolean;
  I        : Integer;

begin
  St := UpperCase(Trim(InputBox('Assemble','Enter instruction: ','')));
  If St <> '' Then
  Begin
    SDBD := ((TopAddr > 0) And ((IntvMem[TopAddr - 1] And $3FF) = 1));
    If Assemble(St,TopAddr,SDBD,AsmWord[0],AsmWord[1],AsmWord[2],NumWords,Warn) Then
    Begin
      For I := 0 To NumWords - 1 Do
      Begin
        IntvMem[TopAddr + I] := AsmWord[I];
        Handle_IO_Write(TopAddr + I,AsmWord[I]);
      End; { For I }
      If Warn Then ShowMessage('Warning! Instruction > 10 bits.');
      Display;
    End
    Else ShowMessage('Invalid instruction');
  End;
end;

procedure TfrmDebugger.sbDataScroll(Sender: TObject;
  ScrollCode: TScrollCode; var ScrollPos: Integer);
Var I: Integer;
Begin
  Case ScrollCode Of
    scLineUp: If DataTop > 7 Then Dec(DataTop,8);
  scLineDown: If DataTop < 65536 - (DataLines * 8) Then Inc(DataTop,8);
    scPageUp,
  scPageDown,
  scPosition,scTrack: Begin
                        I := ScrollPos * 8;
                        If I < 0 Then I := 0;
                        If I > 65536 - (DataLines * 8) Then I := 65536 - (DataLines * 8);
                        DataTop := I;
                      End;
       scTop: DataTop := 0;
    scBottom: DataTop := 65536 - (DataLines * 8);
  End; // Case
  Repaint;
end;

procedure TfrmDebugger.btnObjectLocClick(Sender: TObject);
begin
  If Not ShowObjs Then Move(ScnBuf,DebugScnBuf,SizeOf(DebugScnBuf));
  ShowObjs := Not ShowObjs;
  If Not ShowObjs Then Move(DebugScnBuf,ScnBuf,SizeOf(ScnBuf));
  frmMain.ShowObjectLocs := ShowObjs;
  frmMain.Display;
end;

Initialization
  BreakExp := '';
end.

// ----------------------------------------------------------------------
// IntvWin - Mattel Intellivision Emulator
// Copyright (C) 2000 John Dullea
//
//  This program is free software; you can redistribute it and/or modify
//  it under the terms of the GNU General Public License as published by
//  the Free Software Foundation; either version 2 of the License, or
//  (at your option) any later version.
//
//  This program is distributed in the hope that it will be useful,
//  but WITHOUT ANY WARRANTY; without even the implied warranty of
//  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
//  GNU General Public License for more details.
//
//  You should have received a copy of the GNU General Public License
//  along with this program; if not, write to the Free Software
//  Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
// ----------------------------------------------------------------------
