unit xref;
interface
uses sysutils,windows,common,gname,datas,schedule,savefile,mainwind,menus;

// class to maintain xref list - xref items consist simply of an address
// which is the location being referenced and a ref_by address which is
// where the reference is from. It is ordered by location and then by ref_by.
type
  pxrefitem=^txrefitem;
  txrefitem=packed record
    addr :lptr;
    refby:lptr;
  end;

  txref=class(tslist)
  public
    repeater:boolean;
  public
    constructor create;
    procedure addxref(loc,ref_by:lptr;x:dword);
    procedure printfirst(loc:lptr);
    procedure xrefsviewer;
    procedure delxref(loc,ref_by:lptr);
    function savedb(sf:tsavefile):boolean;
    function loaddb(sf:tsavefile):boolean;
  end;

var
  xrefs:txref;

implementation
uses disasm,disio;

//compare function for list - uses address/referencing address to sort list
function xrefcfunc(i,j:listitem):integer;
begin
  if le(pxrefitem(i).addr,pxrefitem(j).addr) then begin result:=-1; exit; end;
  if gr(pxrefitem(i).addr,pxrefitem(j).addr) then begin result:= 1; exit; end;
  if le(pxrefitem(i).refby,pxrefitem(j).refby) then begin result:=-1; exit; end;
  if gr(pxrefitem(i).refby,pxrefitem(j).refby) then begin result:= 1; exit; end;
  result:=0;
end;

//deletion function for list
procedure xrefdfunc(i:listitem);
begin
  dispose(pxrefitem(i));
end;


// sets up compare and deletion functions for the xref lists.
constructor txref.create;
begin
  inherited create;
  setcomparefunc(xrefcfunc);
  setdelfunc(xrefdfunc);
end;

procedure txref.addxref(loc,ref_by:lptr;x:dword);
var
  newxref:pxrefitem;
  chk:pxrefitem;
  chkseg:pdsegitem;
begin
  inc(ref_by.o,x);
  newxref:=new(pxrefitem);
  chkseg:=dta.findseg(loc);
  if chkseg=nil then begin
    freemem(newxref); exit;
  end;
  newxref.addr:=loc;
  newxref.refby:=ref_by;
  chk:=pxrefitem(find(listitem(newxref)));
  if chk<>nil then
    if xrefcfunc(listitem(newxref),listitem(chk))=0 then begin
      dispose(newxref); exit;
    end;
  addto(listitem(newxref));
  scheduler.addtask(dis_xref,priority_xref,loc,0,nil);
end;

procedure txref.printfirst(loc:lptr);
var
  numents:dword;
  findit:txrefitem;
  chk:pxrefitem;
begin
  numents:=0;
  findit.addr:=loc;
  findit.refby:=nlptr;
  find(listitem(@findit));
  chk:=pxrefitem(nextiterator);
  if chk=nil then exit;
  while chk.addr.o<>loc.o do begin
    chk:=pxrefitem(nextiterator);
    if chk=nil then exit;
  end;
  if options.mode32 then LastPrintBuff('%4.4x:%8.8x',[chk.refby.s,chk.refby.o])
  else LastPrintBuff('%4.4x:%8.8x',[chk.refby.s,chk.refby.o]);
  while chk<>nil do begin
    if chk.addr.o=loc.o then begin
      chk:=pxrefitem(nextiterator);
      inc(numents);
    end else break;
  end;
  LastPrintBuff(' Number : %d',[numents]);
end;

function xrefsbox(hdwnd,msg,wParam,lParam:dword):dword;stdcall;
const
  brush:HBRUSH=0;
  nseg :string='';
  noffs:string='';
  t:pxrefitem=nil;
  vt:pxrefitem=nil;
  xtmp:txrefitem=();
var
  st:dword;
  i:dword;
  drect:tRECT;
begin
  result:=0;
  case msg of
   WM_COMMAND:
    begin
     case wParam of
      IDC_OKBUTTON:
       begin
         EndDialog(hdwnd,0);
         exit;
       end;
      IDC_JUMPTOBUTTON:
       begin
         scheduler.addtask(user_jumptoaddr,priority_userrequest,t.refby,0,nil);
         xrefs.repeater:=FALSE;
         EndDialog(hdwnd,0);
         exit;
       end;
      XREFS_DELETE:
       begin
         xrefs.delxref(t.addr,t.refby);
         scheduler.addtask(windowupdate,priority_window,nlptr,0,nil);
         EndDialog(hdwnd,0);
         xrefs.repeater:=TRUE;
         exit;
       end;
     end;
     case HIWORD(wParam) of
      LBN_SELCHANGE:
       begin
         i:=SendDlgItemMessage(hdwnd,IDC_XREFSLISTBOX,LB_GETCURSEL,0,0);
         t:=pxrefitem(xrefs.find(listitem(@xtmp)));
         if t<>nil then t:=pxrefitem(xrefs.nextiterator);
         if t.addr.o<>xtmp.addr.o then t:=pxrefitem(xrefs.nextiterator);
         vt:=t;
         while i<>0 do begin
           vt:=pxrefitem(xrefs.nextiterator); dec(i)
         end;
         t:=vt;
       end;
      end;
    end;
   WM_INITDIALOG:
    begin
      GetWindowRect(hdwnd,drect);
      MoveWindow(hdwnd,((mainwnd.right+mainwnd.left)-(drect.right-drect.left)) div 2,
        ((mainwnd.bottom+mainwnd.top)-(drect.bottom-drect.top)) div 2,drect.right-drect.left,drect.bottom-drect.top,TRUE);
      dio.findcurrentaddr(xtmp.addr);
      xtmp.refby:=nlptr;
      t:=pxrefitem(xrefs.find(listitem(@xtmp)));
      if t<>nil then t:=pxrefitem(xrefs.nextiterator);
      if t<>nil then begin
        if t.addr.o<>xtmp.addr.o then t:=pxrefitem(xrefs.nextiterator);
      end;
      vt:=t;
      if vt<>nil then begin
        while vt.addr.o=xtmp.addr.o do begin
          fmtstr(nseg,'0x%4x',[vt.refby.s]);
          fmtstr(noffs,'0x%4x',[vt.refby.o]);
          nseg:=nseg+':'+noffs;
          SendDlgItemMessage(hdwnd,IDC_XREFSLISTBOX,LB_ADDSTRING,0,dword(pchar(nseg)));
          vt:=pxrefitem(xrefs.nextiterator);
          if vt=nil then break;
        end;
      end;
      SendDlgItemMessage(hdwnd,IDC_XREFSLISTBOX,LB_SETCURSEL,0,0);
      brush:=CreateSolidBrush(GetSysColor(COLOR_BTNFACE));
      SetFocus(GetDlgItem(hdwnd,IDC_OKBUTTON));
      exit;
    end;
   WM_DESTROY:
    begin
      DeleteObject(brush); exit;
    end;
    WM_CTLCOLORSTATIC,
    WM_CTLCOLORBTN,
    WM_CTLCOLORDLG,
    WM_SYSCOLORCHANGE:
     begin
       SetBkColor(HDC(wParam),GetSysColor(COLOR_BTNFACE));
       result:=brush;
    end;
  end;
end;

procedure txref.xrefsviewer;
var
  findit:pxrefitem;
  xtmp:txrefitem;
begin
  repeater:=TRUE;
  while repeater do begin
    scheduler.stopthread;
    dio.findcurrentaddr(xtmp.addr);
    xtmp.refby:=nlptr;
    findit:=pxrefitem(find(listitem(@xtmp)));
    if findit<>nil then findit:=pxrefitem(nextiterator);
    if findit<>nil then begin
      if findit.addr.o<>xtmp.addr.o then findit:=pxrefitem(nextiterator);
    end;
    if findit=nil then begin
      scheduler.continuethread;
      MessageBox(mainwindow,'Unable to find any xrefs for the location','Borg Message',MB_OK);
      exit;
    end;
    if findit.addr.o<>xtmp.addr.o then begin
      scheduler.continuethread;
      MessageBox(mainwindow,'There are no xrefs for the current location in the list','Borg Message',MB_OK);
      exit;
    end;
    repeater:=FALSE;
    DialogBox(Inst,MAKEINTRESOURCE(Xrefs_Viewer),mainwindow,@xrefsbox);
    scheduler.continuethread;
  end;
end;

function txref.savedb(sf:tsavefile):boolean;
var
  nxrefs:dword;
  currxref:pxrefitem;
begin
  result:=FALSE;
  nxrefs:=numlistitems;
  resetiterator;
writeln(log,'pos=',inttohex(numwriten,8));
writeln(log,'xrefs-',nxrefs);
  if not sf.swrite(@nxrefs,sizeof(dword)) then exit;
  while nxrefs<>0 do begin
    currxref:=pxrefitem(nextiterator);
with currxref^ do writeln(log,format(' %4.4x:%8.8x  %4.4x:%8.8x',[addr.s,addr.o,refby.s,refby.o]));
    if not sf.swrite(@currxref,sizeof(txrefitem)) then exit;
    dec(nxrefs);
  end;
  result:=TRUE;
end;

function txref.loaddb(sf:tsavefile):boolean;
var
  nxrefs,num:integer;
  currxref:pxrefitem;
begin
  result:=FALSE;
  if not sf.sread(@nxrefs,sizeof(integer),num) then exit;
  while nxrefs<>0 do begin
    currxref:=new(pxrefitem);
    if not sf.sread(@currxref^,sizeof(txrefitem),num) then exit;
    addto(listitem(currxref));
    dec(nxrefs);
  end;
  result:=TRUE;
end;

procedure txref.delxref(loc,ref_by:lptr);
var
  xtmp:txrefitem;
  xfind:pxrefitem;
begin
  xtmp.addr:=loc;
  xtmp.refby:=ref_by;
  xfind:=pxrefitem(find(listitem(@xtmp)));
  if xfind=nil then exit;
  if (xfind.addr.o=loc.o)and(xfind.refby.o=ref_by.o) then begin
    delfrom(listitem(xfind));
    xtmp.refby:=nlptr;
    xfind:=pxrefitem(find(listitem(@xtmp)));
    if xfind<>nil then if xfind.addr.o<>loc.o then xfind:=pxrefitem(nextiterator);
    if xfind<>nil then if xfind.addr.o<>loc.o then xfind:=pxrefitem(nextiterator);
    if xfind<>nil then if xfind.addr.o=loc.o then exit;
    dsm.delcomment(loc,dsmxref);
  end;
end;

initialization
  xrefs:=txref.create;
finalization
  xrefs.free;
end.

