unit relocs;
interface
uses sysutils,windows,common,gname,datas,savefile;
{
  >* This class maintains a list of relocation items from the exe file.    *
  >* Borg keeps a list of any items which have been or should be relocated *
  >* when an executable is loaded. The class includes functions to         *
  >* maintain the list including loading and saving to a database file,    *
  >* and including relocating the image in memory when the database and    *
  >* the file are reloaded.                                                *
  >* The main reason for doing this is that during disassembly we can gain *
  >* additional information by knowing that a certain location is          *
  >* relocated on file load. For example with an instruction like          *
  >* mov eax,400000h, if the location containing 400000h is a relocation   *
  >* item then we know that 400000h is an offset, and so we can            *
  >* immediately rewrite it as mov eax, offset 400000h                     *
}
type
  reloctype =(reloc0,RELOC_NONE,RELOC_SEG,RELOC_OFFS16,RELOC_OFFS32,RELOC_SEGOFFS16,RELOC_SEGOFFS32);

  prelocitem=^trelocitem;
  trelocitem=packed record
    addr:lptr;
    typ :reloctype;
  end;

  trelocs=class(tslist)
  public
    constructor create;
    procedure addreloc(loc:lptr;x:dword; typ:reloctype);
    function isreloc(loc:lptr;x:dword):boolean;
    function savedb(sf:tsavefile):boolean;
    function loaddb(sf:tsavefile):boolean;
    function relocfile:boolean;
  end;

var
  reloc:trelocs;

implementation

//compare function to order in list
function relocscfunc(i,j:listitem):integer;
begin
  if eq(prelocitem(i).addr,prelocitem(j).addr) then begin result:=0; exit; end;
  if gr(prelocitem(i).addr,prelocitem(j).addr) then begin result:=1; exit; end;
  result:=-1;
end;

//deletion function for list
procedure relocsdfunc(i:listitem);
begin
  dispose(prelocitem(i));
end;

constructor trelocs.create;
begin
  inherited create;
  setcomparefunc(relocscfunc);
  setdelfunc(relocsdfunc);
end;

// addreloc                                                              *
// - adds a reloc item to the list of relocs                             *
// - a reloc item consists of only a location which is in the reloc      *
//   table, and a type for the relocation                                *
procedure trelocs.addreloc(loc:lptr;x:dword; typ:reloctype);
var newname:prelocitem;
begin
  inc(loc.o,x);
  newname:=new(prelocitem);
  newname.addr:=loc;
  newname.typ :=typ;
  addto(listitem(newname));
end;

// isreloc                                                               *
// - this is the function used throughout the disassembly engine to see  *
//   if somewhere was relocated. It returns true if the location is in   *
//   the table                                                           *
function trelocs.isreloc(loc:lptr;x:dword):boolean;
var
  checkit:trelocitem;
  findit:prelocitem;
begin
  result:=TRUE;
  inc(loc.o,x);
  checkit.addr:=loc;
  findit:=prelocitem(find(listitem(@checkit)));
  if findit<>nil then if eq(findit.addr,loc) then exit;
  result:=FALSE;
end;

// savedb                                                                *
// - this saves the relocs list to the database file.                    *
// - we can simply save the number of items followed by each item        *
function trelocs.savedb(sf:tsavefile):boolean;
var
  nrels:dword;
  currrel:prelocitem;
begin
  result:=false;
  nrels:=numlistitems;
  resetiterator;
  // save number of reloc items
writeln(log,'pos=',inttohex(numwriten,8));
writeln(log,'relocs=',nrels);
  if not sf.swrite(@nrels,sizeof(dword)) then exit;
  while nrels<>0 do begin
    currrel:=prelocitem(nextiterator);
    // save each reloc item
with currrel^ do writeln(log,format(' %4.4x:%8.8x %d',[addr.s,addr.o,word(typ)]));
    if not sf.swrite(@currrel,sizeof(trelocitem)) then exit;
    dec(nrels);
  end;
  result:=TRUE;
end;

// loaddb                                                                *
// - this reloads the list of relocs from the database file and          *
//   constructs the list again                                           *
function trelocs.loaddb(sf:tsavefile):boolean;
var
  nrels,num:integer;
  currrel:prelocitem;
begin
  result:=false;
  // get number of items
  if not sf.sread(@nrels,sizeof(integer),num) then exit;
  while nrels<>0 do begin
    currrel:=new(prelocitem);
    // load each and add to list
    if not sf.sread(@currrel^,sizeof(trelocitem),num) then exit;
    addto(listitem(currrel));
    dec(nrels);
  end;
  result:=TRUE;
end;

// relocfile                                                             *
// - this should be called after loading a database file. It goes        *
//   through all of the relocs and relocates the file again since when   *
//   we load a database we simply load the file image and do not work    *
//   our way through the whole file format again.                        *
function trelocs.relocfile:boolean;
var
  ds:pdsegitem;
  ri:prelocitem;
begin
  resetiterator;
  ri:=prelocitem(nextiterator);
  while ri<>nil do begin
    // relocate item.
    ds:=dta.findseg(ri.addr);
    if ds<>nil then begin // changed in build 14, used to return FALSE if not found
      case reloctype(ri.typ) of
       RELOC_NONE: ;
       RELOC_OFFS16: ;
       RELOC_OFFS32: ;
       RELOC_SEGOFFS16: ;
       RELOC_SEGOFFS32: ;
       RELOC_SEG: inc(pw(@ds.data[ri.addr.o-ds.addr.o])^,options.loadaddr.s);
       else result:=FALSE; exit;
      end;
    end;
    ri:=prelocitem(nextiterator);
  end;
  result:=TRUE;
end;

initialization
  reloc:=trelocs.create;
finalization
  reloc.free;
end.

