dbgclass.pas

Borland Pascal写的8051单片机模拟仿真器。内有源码

unit DbgClass;

interface

implementation

uses WinTypes, WinProcs, Objects, Strings, Win31, BWCC, DbgZmTypy, DbgAsm;

const
  HOfsTyp=0; HOfsAdr=2; HOfsAkt=4;
  Tabul:array[0..2] of word=(50,115,170);
  MoverString:PChar=
    '8051 ADD Debugger home page:'#13'http://www.amwaw.edu.pl/~adybkows'#13#13#13#13+
    'CREDITS:'#13'--------------'#13'Adam Dybkowski'#13'Adam Augustyn'#13'Tadeusz Studnik'#13+
    #13'FiDoNet Poland'#13#13'and the others...'#13#13#13#13#13#13#13#13#13#13#13#13#13;

type
  PPorty=^TPorty;
  TPorty=array[0..7] of record
    a:byte;
    p:word;
  end;
  PTerminalTekst=^TTerminalTekst;
  TTerminalTekst=array[0..24,0..79] of char;

var
  redr:byte;
  OrygLB:TWndClass;

procedure RysujROM(Okno:HWnd;auto:boolean);
var
  Paint:TPaintStruct;
  b:HBitmap;
  orgDC,DC:HDC;
  R:TRect;
  n,a:byte;
  maxy:shortint;
  i:string[40];
  is:array[0..40] of char;
  adrespocz,adresakt,adres,adreslin:word;
  l,szerwys:word;
begin
  if auto then orgDC:=BeginPaint(Okno,Paint) else orgDC:=GetDC(Okno);
  GetClientRect(Okno,R);
  Dec(R.right,WindaSzer); Dec(R.bottom,WindaWys);
  b:=CreateCompatibleBitmap(orgDC,R.right,R.bottom);
  DC:=CreateCompatibleDC(orgDC);
  SelectObject(DC,b);
  SelectObject(DC,GetStockObject(BLACK_BRUSH));
  SelectObject(DC,GetStockObject(BLACK_PEN));
  SelectObject(DC,CzcionkaOEM);
  SetBkMode(DC,TRANSPARENT);
  Rectangle(DC,R.left,R.top,R.right,R.bottom); {wype硁iamy na czarno}
  maxy:=((R.bottom-R.top) div FontOEMwys)-1;
  if maxy<1 then maxy:=1;
  l:=GetWindowWord(Okno,HOfsTyp);
  adrespocz:=GetWindowWord(Okno,HOfsAdr);
  adresakt:=GetWindowWord(Okno,HOfsAkt);
  adreslin:=adresakt and $FFF8;
  if l=0 then      { widok pamieci EPROM }
  begin
    SetTextColor(DC,$00ffff00);   { $00bbggrr - blue,green,red }
    adres:=adrespocz;
    for a:=0 to maxy do
    begin
      i:=WtoHEX(adres)+': ';
      for n:=0 to 7 do i:=i+BtoHEX(Mem[selROM:adres+n])+' ';
      for n:=0 to 7 do i:=i+char(Mem[selROM:adres+n]);
      for n:=1 to Length(i) do if (i[n]=#0) or (i[n]=#255) then i[n]:=' ';
      TextOut(DC,2,a*FontOEMwys,StrPCopy(is,i),38);
      if adres=adreslin then
      begin
        szerwys:=GetTextExtent(DC,is,(adresakt and 7)*3+6);
        SetTextColor(DC,$000000ff);
        TextOut(DC,2+LoWord(szerwys),((adreslin-adrespocz) div 8)*FontOEMwys,
          is+(adresakt and 7)*3+6,2);
        SetTextColor(DC,$00ffff00);
      end;
      if adres=$FFF8 then break;
      adres:=adres+8;
    end;
  end else
  if l=1 then      { widok pamieci zewnetrznej RAM }
  begin
    SetTextColor(DC,$0000ffff);
    adres:=adrespocz;
    for a:=0 to maxy do
    begin
      i:=WtoHEX(adres)+': ';
      for n:=0 to 7 do i:=i+BtoHEX(Mem[selRAM:adres+n])+' ';
      for n:=0 to 7 do i:=i+char(Mem[selRAM:adres+n]);
      for n:=1 to Length(i) do if (i[n]=#0) or (i[n]=#255) then i[n]:=' ';
      TextOut(DC,2,a*FontOEMwys,StrPCopy(is,i),38);
      if adres=adreslin then
      begin
        szerwys:=GetTextExtent(DC,is,(adresakt and 7)*3+6);
        SetTextColor(DC,$000000ff);
        TextOut(DC,2+LoWord(szerwys),((adreslin-adrespocz) div 8)*FontOEMwys,
          is+(adresakt and 7)*3+6,2);
        SetTextColor(DC,$0000ffff);
      end;
      if adres=$FFF8 then break;
      adres:=adres+8;
    end;
  end else
  if l=2 then      { widok pamieci wewnetrznej RAM i rejestrow }
  begin
    SetTextColor(DC,$0000ff00);
    adres:=adrespocz;
    for a:=0 to maxy do
    begin
      i:=WtoHEX(adres)+': ';
      if bigmem and (adres>=128) then
      begin
        for n:=0 to 7 do i:=i+BtoHEX(Mem[selRAMInt:adres+n+128])+' ';
        for n:=0 to 7 do i:=i+char(Mem[selRAMInt:adres+n+128]);
      end else
      begin
        for n:=0 to 7 do i:=i+BtoHEX(Mem[selRAMInt:adres+n])+' ';
        for n:=0 to 7 do i:=i+char(Mem[selRAMInt:adres+n]);
      end;
      for n:=1 to Length(i) do if (i[n]=#0) or (i[n]=#255) then i[n]:=' ';
      TextOut(DC,2,a*FontOEMwys,StrPCopy(is,i),38);
      if adres=adreslin then
      begin
        szerwys:=GetTextExtent(DC,is,(adresakt and 7)*3+6);
        SetTextColor(DC,$000000ff);
        TextOut(DC,2+LoWord(szerwys),((adreslin-adrespocz) div 8)*FontOEMwys,
          is+(adresakt and 7)*3+6,2);
        SetTextColor(DC,$0000ff00);
      end;
      if adres=$F8 then break;
      adres:=(adres+8) and $FF;
    end;
  end;
  BitBlt(orgDC,1,0,R.right-1,R.bottom,DC,1,0,SrcCopy);
  DeleteDC(DC);
  DeleteObject(b);
  if auto then EndPaint(Okno,Paint) else ReleaseDC(Okno,orgDC);
end;

procedure PrzewinHex(Okno:HWnd;wScrollCode,nPos:word;hwndCtl:HWnd);
var
  R:TRect;
  l,adrpocz,adrakt,adrlin,adrkon,mas,maxy8:word;
  maxy:shortint;
begin
  GetClientRect(Okno,R);
  Dec(R.right,WindaSzer); Dec(R.bottom,WindaWys);
  maxy:=((R.bottom-R.top) div FontOEMwys)-1;
  if maxy<1 then maxy:=1;
  maxy8:=maxy*8;
  l:=GetWindowWord(Okno,HOfsTyp);
  adrpocz:=GetWindowWord(Okno,HOfsAdr);
  adrakt:=GetWindowWord(Okno,HOfsAkt);
  if l=2 then mas:=$F8 else mas:=$FFF8;
  adrlin:=adrakt and mas;
  if longint(adrpocz)+maxy8>mas then adrkon:=mas else adrkon:=adrpocz+maxy8;
  case wScrollCode of
    sb_LineUp        : if adrlin>adrpocz then Dec(adrakt,8) else
                         if adrpocz>0 then begin Dec(adrpocz,8); Dec(adrakt,8) end;
    sb_LineDown      : if adrakt<mas then
                       begin
                         if adrlin<adrkon then Inc(adrakt,8) else
                           if adrkon<mas then
                           begin Inc(adrpocz,8); Inc(adrakt,8); end;
                       end;
    sb_PageUp        : if adrlin>adrpocz then adrakt:=adrpocz or (adrakt and 7) else
                       begin
                         if adrpocz>maxy8+8 then Dec(adrpocz,maxy8+8) else adrpocz:=0;
                         adrakt:=adrpocz or (adrakt and 7);
                       end;
    sb_PageDown      : if adrakt<mas then
                       if adrlin<adrkon then adrakt:=adrkon or (adrakt and 7) else
                       begin
                         if adrlin<mas-maxy8 then Inc(adrpocz,maxy8+8) else adrpocz:=mas-maxy8;
                         adrakt:=adrpocz+maxy8 or (adrakt and 7);
                       end;
    sb_ThumbTrack    : begin
                         if l=2 then adrlin:=(nPos and $F8) else adrlin:=(nPos*4 and $FFF8);
                         if adrlin<adrpocz then adrpocz:=adrlin;
                         if adrlin>adrkon then adrpocz:=adrlin-maxy8;
                         if adrpocz>mas-maxy8 then adrpocz:=mas-maxy8;
                         adrakt:=adrlin or (adrakt and 7);
                       end;
    end;
  SetWindowWord(Okno,HOfsAdr,adrpocz);
  SetWindowWord(Okno,HOfsAkt,adrakt);
  if l=2 then
    SetScrollPos(hwndCtl,sb_Ctl,adrakt and $FFF8,true) else
    SetScrollPos(hwndCtl,sb_Ctl,(adrakt and $FFF8) div 4,true);
  InvalidateRect(Okno,@R,false);
end;

procedure PrzewinHoriz(Okno:HWnd;wScrollCode,nPos:word;hwndCtl:HWnd);
var
  adrakt:word;
  R:TRect;
begin
  adrakt:=GetWindowWord(Okno,HOfsAkt);
  case wScrollCode of
    sb_LineUp        : if (adrakt and 7)>0 then Dec(adrakt);
    sb_LineDown      : if (adrakt and 7)<7 then Inc(adrakt);
    sb_PageUp        : adrakt:=adrakt and $FFF8;
    sb_PageDown      : adrakt:=adrakt or 7;
    sb_ThumbTrack    : adrakt:=(adrakt and $FFF8) or nPos;
    end;
  SetWindowWord(Okno,HOfsAkt,adrakt);
  SetScrollPos(hwndCtl,sb_Ctl,adrakt and 7,true);
  GetClientRect(Okno,R);
  Dec(R.right,WindaSzer); Dec(R.bottom,WindaWys);
  InvalidateRect(Okno,@R,false);
end;

procedure SkokHex(Okno:HWnd);
var
  code,b:integer;
  l,adrpocz,adrakt,off:word;
  R:TRect;
begin
  l:=GetWindowWord(Okno,HOfsTyp);
  b:=PokazDialog('ADRSKOKU',@FunOffset);
  if b<>1 then Exit;
  if wynik='' then
  begin
    MessageBeep(mb_IconHand);
    BWCCMessageBox(0,Napis1(66),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
    Exit;
  end;
  if (wynik='PC') and (l=0) then off:=RejPC else
  begin
    Val('$'+wynik,off,code);
    if code<>0 then
    begin
      MessageBeep(mb_IconHand);
      BWCCMessageBox(0,Napis1(1),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
      Exit;
    end;
  end;
  if (l=2) and (off>$FF) then
  begin
    MessageBeep(mb_IconHand);
    BWCCMessageBox(0,Napis1(8),Napis2(2),mb_OK or mb_TaskModal or mb_IconExclamation);
    Exit;
  end;
  adrakt:=off;
  adrpocz:=off and $FFF8;
  if (l=2) and (adrpocz>$C0) then adrpocz:=$C0;
  if (l<2) and (adrpocz>$FFC0) then adrpocz:=$FFC0;
  SetWindowWord(Okno,HOfsAdr,adrpocz);
  SetWindowWord(Okno,HOfsAkt,adrakt);
  if l=2 then
    SetScrollPos(GetDlgItem(Okno,500),sb_Ctl,(adrakt and $FFF8),true) else
    SetScrollPos(GetDlgItem(Okno,500),sb_Ctl,(adrakt and $FFF8) div 4,true);
  SetScrollPos(GetDlgItem(Okno,501),sb_Ctl,adrakt and 7,true);
  GetClientRect(Okno,R);
  Dec(R.right,WindaSzer); Dec(R.bottom,WindaWys);
  InvalidateRect(Okno,@R,false);
end;

procedure ClickHex(Okno:HWnd;xPos,yPos:word);
var
  R:TRect;
  nx,ny,adrpocz,adrakt,l:word;
begin
  if (xPos<6*FontOEMszer+2) or (xPos>30*FontOEMszer+2) then Exit;
  nx:=(xPos-2-6*FontOEMszer) div (FontOEMszer*3);
  ny:=yPos div FontOEMwys;
  l:=GetWindowWord(Okno,HOfsTyp);
  adrpocz:=GetWindowWord(Okno,HOfsAdr);
  adrakt:=adrpocz+nx+8*ny;
  SetWindowWord(Okno,HOfsAkt,adrakt);
  if l=2 then
    SetScrollPos(GetDlgItem(Okno,500),sb_Ctl,adrakt and $FFF8,true) else
    SetScrollPos(GetDlgItem(Okno,500),sb_Ctl,(adrakt and $FFF8) div 4,true);
  SetScrollPos(GetDlgItem(Okno,501),sb_Ctl,adrakt and 7,true);
  GetClientRect(Okno,R);
  Dec(R.right,WindaSzer); Dec(R.bottom,WindaWys);
  InvalidateRect(Okno,@R,false);
end;

procedure DblClickHex(Okno:HWnd;xPos,yPos:word);
var
  R:TRect;
  l,adrpocz,adrakt,newad:word;
  maxy:shortint;
begin
  if (xPos<6*FontOEMszer+2) or (xPos>30*FontOEMszer+2) then Exit;
  GetClientRect(Okno,R);
  Dec(R.right,WindaSzer); Dec(R.bottom,WindaWys);
  maxy:=((R.bottom-R.top) div FontOEMwys)-1;
  if maxy<1 then maxy:=1;
  l:=GetWindowWord(Okno,HOfsTyp);
  adrpocz:=GetWindowWord(Okno,HOfsAdr);
  adrakt:=GetWindowWord(Okno,HOfsAkt);
  case l of
    0: begin
         BajtyWstaw(Okno,selROM,adrakt,$FFFF,newad);
         OdrysujOkna(0); {Instr}
         OdrysujOkna(3); {HEX ROM}
       end;
    1: begin
         BajtyWstaw(Okno,selRAM,adrakt,$FFFF,newad);
         OdrysujOkna(4); {HEX RAM}
       end;
    2: begin
         BajtyWstaw(Okno,selRAMInt,adrakt,$FF,newad);
         OdrysujOkna(1); {Rej}
         OdrysujOkna(2); {Bit}
         OdrysujOkna(5); {HEX RAM Int}
         OdrysujOkna(9); {Porty}
       end;
  end;
  OdrysujOkna(6); {Symb}
  adrakt:=newad;
  SetWindowWord(Okno,HOfsAkt,adrakt);
  if adrakt>adrpocz+maxy*8+7 then
  begin
    adrpocz:=(adrakt-maxy*8) and $FFF8;
    if l=2 then adrpocz:=adrpocz and $F8;
    SetWindowWord(Okno,HOfsAdr,adrpocz);
  end else
  if adrakt<adrpocz then
  begin
    adrpocz:=adrakt and $FFF8;
    if l=2 then adrpocz:=adrpocz and $F8;
    SetWindowWord(Okno,HOfsAdr,adrpocz);
  end;
  if l=2 then
    SetScrollPos(GetDlgItem(Okno,500),sb_Ctl,adrakt and $FFF8,true) else
    SetScrollPos(GetDlgItem(Okno,500),sb_Ctl,(adrakt and $FFF8) div 4,true);
  SetScrollPos(GetDlgItem(Okno,501),sb_Ctl,adrakt and 7,true);
  InvalidateRect(Okno,@R,false);
end;

procedure ZmienWielkoscHex(Okno:HWnd;szer,wys:word);
var R:TRect;
begin
  MoveWindow(Okno,0,0,szer,wys,false);
  MoveWindow(GetDlgItem(Okno,500),szer-WindaSzer,0,WindaSzer,wys-WindaWys,true);
  MoveWindow(GetDlgItem(Okno,501),0,wys-WindaWys,szer-WindaSzer,WindaWys,true);
  MoveWindow(GetDlgItem(Okno,502),szer-WindaSzer,wys-WindaWys,WindaSzer,WindaWys,true);
  R.left:=0; R.top:=0; R.right:=szer-WindaSzer; R.bottom:=wys-WindaWys;
  InvalidateRect(Okno,@R,true); UpdateWindow(Okno);
end;

function FunHexView(Okno:HWnd;Kod_meldunku,wParam:word;LParam:longint):longint;  EXPORT;
var
  parm:^TCreateStruct;
  R:TRect;
  l:word;
  s:HWnd;
begin
  FunHexView:=0;
  case Kod_meldunku of
    wm_Create      : begin
                       parm:=pointer(LParam);
                       l:=LoWord(longint(parm^.lpCreateParams));
                       SetWindowWord(Okno,HOfsTyp,l);
                       SetWindowWord(Okno,HOfsAdr,0);
                       SetWindowWord(Okno,HOfsAkt,0);
                       GetClientRect(Okno,R);
                       s:=CreateWindow('SCROLLBAR','',ws_Child or ws_Visible or sbs_LeftAlign or
                         sbs_Vert,R.right-WindaSzer,0,WindaSzer,R.bottom-WindaWys,Okno,500,
                         hInstance,nil);
                       if l<2 then
                         SetScrollRange(s,sb_Ctl,0,16383,false) else
                         SetScrollRange(s,sb_Ctl,0,255,false);
                       SetScrollPos(s,sb_Ctl,0,true);
                       s:=CreateWindow('SCROLLBAR','',ws_Child or ws_Visible or sbs_TopAlign or
                         sbs_Horz,0,R.bottom-WindaWys,R.right-WindaSzer,WindaWys,Okno,501,
                         hInstance,nil);
                       SetScrollRange(s,sb_Ctl,0,7,false);
                       SetScrollPos(s,sb_Ctl,0,true);
                       CreateWindow('BUTTON','',ws_Child or ws_Visible,R.right-WindaSzer,
                         R.bottom-WindaWys,WindaSzer,WindaWys,Okno,502,hInstance,nil);
                     end;
    wm_Paint       : RysujROM(Okno,true);
    wm_VScroll     : PrzewinHex(Okno,wParam,LoWord(LParam),HWnd(HiWord(LParam)));
    wm_HScroll     : PrzewinHoriz(Okno,wParam,LoWord(LParam),HWnd(HiWord(LParam)));
    wm_LButtonDown : ClickHex(Okno,LoWord(LParam),HiWord(LParam));
    wm_LButtonDblClk : DblClickHex(Okno,LoWord(LParam),HiWord(LParam));
    wm_Command     : case wParam of
                       502           : SkokHex(Okno);
                       us_OdnowWidok : if (runprog=0) or (GetWindowWord(Okno,HOfsTyp)<>0) then
                                       RysujROM(Okno,false);
                       us_ZmienRozmiary: ZmienWielkoscHex(Okno,LoWord(LParam),HiWord(LParam));
                     end;
  else FunHexView:=DefWindowProc(Okno,Kod_meldunku,wParam,LParam);
  end;
end;

procedure RysujBitki(Okno:HWnd;auto:boolean);
var
  Paint:TPaintStruct;
  DC:HDC;
  x,y:integer;
  p:longint;
  n,ad,oldad:byte;
  a:string[5];
  is:array[0..5] of char;
begin
  if auto then DC:=BeginPaint(Okno,Paint) else DC:=GetDC(Okno);
  SelectObject(DC,GetStockObject(LTGRAY_BRUSH));
  SelectObject(DC,CzcionkaOEM);
  SetBkColor(DC,$00C0C0C0);
  y:=0; oldad:=$88;
  p:=0;
  for n:=0 to 39 do
  begin
    ad:=HEXtoB(Copy(RejBity[n],1,2));
    if ad<>oldad then Inc(y,FontOEMwys+4);
    x:=byte(RejBity[n,3])-48;
    if (Mem[selRAMInt:ad] and Maski[x])=0 then
    begin
      if p<>$00808080 then
      begin
        SetTextColor(DC,$00808080);
        p:=$00808080;
      end;
    end else
      if p<>$000000ff then
      begin
        SetTextColor(DC,$000000ff);
        p:=$000000ff;
      end;
    a:=Copy(Copy(RejBity[n],4,255)+'   ',1,3);
    StrPCopy(is,a);
    TextOut(DC,(7-x)*(3*FontOEMszer+2),y,is,Length(a));
    oldad:=ad;
  end;
  if auto then EndPaint(Okno,Paint) else ReleaseDC(Okno,DC);
end;

procedure ZmienBitki(x,y:word;Okno:HWnd);
var
  w:byte;
  R:TRect;
begin
  w:=RejBityA[y div (FontOEMwys+4)];
  Mem[selRAMInt:w]:=Mem[selRAMInt:w] xor Maski[7-x div (3*FontOEMszer+2)];
  SetRect(R,x-(3*FontOEMszer+2),y-(FontOEMwys+4),x+(3*FontOEMszer+2),y+(FontOEMwys+4));
  InvalidateRect(Okno,@R,false);
  OdrysujOkna(1); {Rej}
  OdrysujOkna(2); {Bit}
  OdrysujOkna(5); {HEX RAM Int}
  OdrysujOkna(6); {Symb}
  OdrysujOkna(9); {Porty}
end;

function FunBitView(Okno:HWnd;Kod_meldunku,WParam:word;LParam:longint):longint;  EXPORT;
begin
  FunBitView := 0;
  case Kod_meldunku of