mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-07-05 18:48:52 +02:00

* -Oa argument supports more alignment settings that can be specified per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN RECORDMAX,LOCALMIN,LOCALMAX. It is possible to set the mimimum required alignment and the maximum usefull alignment. The final alignment will be choosen per variable size dependent on these settings
1560 lines
50 KiB
ObjectPascal
1560 lines
50 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 1998-2000 by Peter Vreman
|
|
|
|
This unit implements support import,export,link routines
|
|
for the (i386) Win32 target
|
|
|
|
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.
|
|
****************************************************************************
|
|
}
|
|
unit t_win32;
|
|
|
|
{$i defines.inc}
|
|
|
|
interface
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
{$ifdef Delphi}
|
|
dmisc,
|
|
{$else Delphi}
|
|
dos,
|
|
{$endif Delphi}
|
|
cutils,cclasses,
|
|
aasm,fmodule,globtype,globals,systems,verbose,
|
|
script,gendef,
|
|
cpubase,cpuasm,
|
|
{$ifdef GDB}
|
|
gdb,
|
|
{$endif}
|
|
import,export,link;
|
|
|
|
type
|
|
timportlibwin32=class(timportlib)
|
|
procedure preparelib(const s:string);override;
|
|
procedure importprocedure(const func,module:string;index:longint;const name:string);override;
|
|
procedure importvariable(const varname,module:string;const name:string);override;
|
|
procedure generatelib;override;
|
|
procedure generatenasmlib;virtual;
|
|
procedure generatesmartlib;override;
|
|
end;
|
|
|
|
texportlibwin32=class(texportlib)
|
|
st : string;
|
|
last_index : longint;
|
|
procedure preparelib(const s:string);override;
|
|
procedure exportprocedure(hp : texported_item);override;
|
|
procedure exportvar(hp : texported_item);override;
|
|
procedure generatelib;override;
|
|
procedure generatenasmlib;virtual;
|
|
end;
|
|
|
|
tlinkerwin32=class(tlinker)
|
|
private
|
|
Function WriteResponseFile(isdll:boolean) : Boolean;
|
|
Function PostProcessExecutable(const fn:string;isdll:boolean) : Boolean;
|
|
public
|
|
Constructor Create;override;
|
|
Procedure SetDefaultInfo;override;
|
|
function MakeExecutable:boolean;override;
|
|
function MakeSharedLibrary:boolean;override;
|
|
end;
|
|
|
|
tDLLScannerWin32=class(tDLLScanner)
|
|
private
|
|
cstring : array[0..127]of char;
|
|
function DOSstubOK(var x:cardinal):boolean;
|
|
function FindDLL(const s:string;var founddll:string):boolean;
|
|
function DllName(Const Name : string) : string;
|
|
public
|
|
function isSuitableFileType(x:cardinal):longbool;override;
|
|
function GetEdata(HeaderEntry:cardinal):longbool;override;
|
|
function Scan(const binname:string):longbool;override;
|
|
end;
|
|
|
|
|
|
function DllName(Const Name : string) : string;
|
|
var n : string;
|
|
begin
|
|
n:=Upper(SplitExtension(Name));
|
|
if (n='.DLL') or (n='.DRV') or (n='.EXE') then
|
|
DllName:=Name
|
|
else
|
|
DllName:=Name+target_info.sharedlibext;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TIMPORTLIBWIN32
|
|
*****************************************************************************}
|
|
|
|
procedure timportlibwin32.preparelib(const s : string);
|
|
begin
|
|
if not(assigned(importssection)) then
|
|
importssection:=TAAsmoutput.create;
|
|
end;
|
|
|
|
|
|
procedure timportlibwin32.importprocedure(const func,module : string;index : longint;const name : string);
|
|
var
|
|
hp1 : timportlist;
|
|
hp2 : timported_item;
|
|
hs : string;
|
|
begin
|
|
hs:=DllName(module);
|
|
{ search for the module }
|
|
hp1:=timportlist(current_module.imports.first);
|
|
while assigned(hp1) do
|
|
begin
|
|
if hs=hp1.dllname^ then
|
|
break;
|
|
hp1:=timportlist(hp1.next);
|
|
end;
|
|
{ generate a new item ? }
|
|
if not(assigned(hp1)) then
|
|
begin
|
|
hp1:=timportlist.create(hs);
|
|
current_module.imports.concat(hp1);
|
|
end;
|
|
{ search for reuse of old import item }
|
|
hp2:=timported_item(hp1.imported_items.first);
|
|
while assigned(hp2) do
|
|
begin
|
|
if hp2.func^=func then
|
|
break;
|
|
hp2:=timported_item(hp2.next);
|
|
end;
|
|
if not assigned(hp2) then
|
|
begin
|
|
hp2:=timported_item.create(func,name,index);
|
|
hp1.imported_items.concat(hp2);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure timportlibwin32.importvariable(const varname,module:string;const name:string);
|
|
var
|
|
hp1 : timportlist;
|
|
hp2 : timported_item;
|
|
hs : string;
|
|
begin
|
|
hs:=DllName(module);
|
|
{ search for the module }
|
|
hp1:=timportlist(current_module.imports.first);
|
|
while assigned(hp1) do
|
|
begin
|
|
if hs=hp1.dllname^ then
|
|
break;
|
|
hp1:=timportlist(hp1.next);
|
|
end;
|
|
{ generate a new item ? }
|
|
if not(assigned(hp1)) then
|
|
begin
|
|
hp1:=timportlist.create(hs);
|
|
current_module.imports.concat(hp1);
|
|
end;
|
|
hp2:=timported_item.create_var(varname,name);
|
|
hp1.imported_items.concat(hp2);
|
|
end;
|
|
|
|
procedure timportlibwin32.generatenasmlib;
|
|
var
|
|
hp1 : timportlist;
|
|
hp2 : timported_item;
|
|
p : pchar;
|
|
begin
|
|
importssection.concat(tai_section.create(sec_code));
|
|
hp1:=timportlist(current_module.imports.first);
|
|
while assigned(hp1) do
|
|
begin
|
|
hp2:=timported_item(hp1.imported_items.first);
|
|
while assigned(hp2) do
|
|
begin
|
|
if (aktoutputformat=as_i386_tasm) or
|
|
(aktoutputformat=as_i386_masm) then
|
|
p:=strpnew(#9+'EXTRN '+hp2.func^)
|
|
else
|
|
p:=strpnew(#9+'EXTERN '+hp2.func^);
|
|
importssection.concat(tai_direct.create(p));
|
|
p:=strpnew(#9+'import '+hp2.func^+' '+hp1.dllname^+' '+hp2.name^);
|
|
importssection.concat(tai_direct.create(p));
|
|
hp2:=timported_item(hp2.next);
|
|
end;
|
|
hp1:=timportlist(hp1.next);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure timportlibwin32.generatesmartlib;
|
|
var
|
|
hp1 : timportlist;
|
|
hp2 : timported_item;
|
|
lhead,lname,lcode,
|
|
lidata4,lidata5 : tasmlabel;
|
|
r : preference;
|
|
begin
|
|
if (aktoutputformat<>as_i386_asw) and
|
|
(aktoutputformat<>as_i386_pecoff) then
|
|
begin
|
|
generatenasmlib;
|
|
exit;
|
|
end;
|
|
hp1:=timportlist(current_module.imports.first);
|
|
while assigned(hp1) do
|
|
begin
|
|
{ Get labels for the sections }
|
|
getdatalabel(lhead);
|
|
getdatalabel(lname);
|
|
getaddrlabel(lidata4);
|
|
getaddrlabel(lidata5);
|
|
{ create header for this importmodule }
|
|
importsSection.concat(Tai_cut.Create_begin);
|
|
importsSection.concat(Tai_section.Create(sec_idata2));
|
|
importsSection.concat(Tai_label.Create(lhead));
|
|
{ pointer to procedure names }
|
|
importsSection.concat(Tai_const_symbol.Create_rva(lidata4));
|
|
{ two empty entries follow }
|
|
importsSection.concat(Tai_const.Create_32bit(0));
|
|
importsSection.concat(Tai_const.Create_32bit(0));
|
|
{ pointer to dll name }
|
|
importsSection.concat(Tai_const_symbol.Create_rva(lname));
|
|
{ pointer to fixups }
|
|
importsSection.concat(Tai_const_symbol.Create_rva(lidata5));
|
|
{ first write the name references }
|
|
importsSection.concat(Tai_section.Create(sec_idata4));
|
|
importsSection.concat(Tai_const.Create_32bit(0));
|
|
importsSection.concat(Tai_label.Create(lidata4));
|
|
{ then the addresses and create also the indirect jump }
|
|
importsSection.concat(Tai_section.Create(sec_idata5));
|
|
importsSection.concat(Tai_const.Create_32bit(0));
|
|
importsSection.concat(Tai_label.Create(lidata5));
|
|
|
|
{ create procedures }
|
|
hp2:=timported_item(hp1.imported_items.first);
|
|
while assigned(hp2) do
|
|
begin
|
|
{ insert cuts }
|
|
importsSection.concat(Tai_cut.Create);
|
|
{ create indirect jump }
|
|
if not hp2.is_var then
|
|
begin
|
|
getlabel(lcode);
|
|
new(r);
|
|
reset_reference(r^);
|
|
r^.symbol:=lcode;
|
|
{ place jump in codesegment, insert a code section in the
|
|
importsection to reduce the amount of .s files (PFV) }
|
|
importsSection.concat(Tai_section.Create(sec_code));
|
|
{$IfDef GDB}
|
|
if (cs_debuginfo in aktmoduleswitches) then
|
|
importsSection.concat(Tai_stab_function_name.Create(nil));
|
|
{$EndIf GDB}
|
|
importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
|
|
importsSection.concat(Taicpu.Op_ref(A_JMP,S_NO,r));
|
|
importsSection.concat(Tai_align.Create_op(4,$90));
|
|
end;
|
|
{ create head link }
|
|
importsSection.concat(Tai_section.Create(sec_idata7));
|
|
importsSection.concat(Tai_const_symbol.Create_rva(lhead));
|
|
{ fixup }
|
|
getlabel(tasmlabel(hp2.lab));
|
|
importsSection.concat(Tai_section.Create(sec_idata4));
|
|
importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab));
|
|
{ add jump field to importsection }
|
|
importsSection.concat(Tai_section.Create(sec_idata5));
|
|
if hp2.is_var then
|
|
importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0))
|
|
else
|
|
importsSection.concat(Tai_label.Create(lcode));
|
|
if hp2.name^<>'' then
|
|
importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab))
|
|
else
|
|
importsSection.concat(Tai_const.Create_32bit($80000000 or hp2.ordnr));
|
|
{ finally the import information }
|
|
importsSection.concat(Tai_section.Create(sec_idata6));
|
|
importsSection.concat(Tai_label.Create(hp2.lab));
|
|
importsSection.concat(Tai_const.Create_16bit(hp2.ordnr));
|
|
importsSection.concat(Tai_string.Create(hp2.name^+#0));
|
|
importsSection.concat(Tai_align.Create_op(2,0));
|
|
hp2:=timported_item(hp2.next);
|
|
end;
|
|
|
|
{ write final section }
|
|
importsSection.concat(Tai_cut.Create_end);
|
|
{ end of name references }
|
|
importsSection.concat(Tai_section.Create(sec_idata4));
|
|
importsSection.concat(Tai_const.Create_32bit(0));
|
|
{ end if addresses }
|
|
importsSection.concat(Tai_section.Create(sec_idata5));
|
|
importsSection.concat(Tai_const.Create_32bit(0));
|
|
{ dllname }
|
|
importsSection.concat(Tai_section.Create(sec_idata7));
|
|
importsSection.concat(Tai_label.Create(lname));
|
|
importsSection.concat(Tai_string.Create(hp1.dllname^+#0));
|
|
|
|
hp1:=timportlist(hp1.next);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure timportlibwin32.generatelib;
|
|
var
|
|
hp1 : timportlist;
|
|
hp2 : timported_item;
|
|
l1,l2,l3,l4 : tasmlabel;
|
|
r : preference;
|
|
begin
|
|
if (aktoutputformat<>as_i386_asw) and
|
|
(aktoutputformat<>as_i386_pecoff) then
|
|
begin
|
|
generatenasmlib;
|
|
exit;
|
|
end;
|
|
hp1:=timportlist(current_module.imports.first);
|
|
while assigned(hp1) do
|
|
begin
|
|
{ align codesegment for the jumps }
|
|
importsSection.concat(Tai_section.Create(sec_code));
|
|
importsSection.concat(Tai_align.Create_op(4,$90));
|
|
{ Get labels for the sections }
|
|
getlabel(l1);
|
|
getlabel(l2);
|
|
getlabel(l3);
|
|
importsSection.concat(Tai_section.Create(sec_idata2));
|
|
{ pointer to procedure names }
|
|
importsSection.concat(Tai_const_symbol.Create_rva(l2));
|
|
{ two empty entries follow }
|
|
importsSection.concat(Tai_const.Create_32bit(0));
|
|
importsSection.concat(Tai_const.Create_32bit(0));
|
|
{ pointer to dll name }
|
|
importsSection.concat(Tai_const_symbol.Create_rva(l1));
|
|
{ pointer to fixups }
|
|
importsSection.concat(Tai_const_symbol.Create_rva(l3));
|
|
|
|
{ only create one section for each else it will
|
|
create a lot of idata* }
|
|
|
|
{ first write the name references }
|
|
importsSection.concat(Tai_section.Create(sec_idata4));
|
|
importsSection.concat(Tai_label.Create(l2));
|
|
|
|
hp2:=timported_item(hp1.imported_items.first);
|
|
while assigned(hp2) do
|
|
begin
|
|
getlabel(tasmlabel(hp2.lab));
|
|
if hp2.name^<>'' then
|
|
importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab))
|
|
else
|
|
importsSection.concat(Tai_const.Create_32bit($80000000 or hp2.ordnr));
|
|
hp2:=timported_item(hp2.next);
|
|
end;
|
|
{ finalize the names ... }
|
|
importsSection.concat(Tai_const.Create_32bit(0));
|
|
|
|
{ then the addresses and create also the indirect jump }
|
|
importsSection.concat(Tai_section.Create(sec_idata5));
|
|
importsSection.concat(Tai_label.Create(l3));
|
|
hp2:=timported_item(hp1.imported_items.first);
|
|
while assigned(hp2) do
|
|
begin
|
|
if not hp2.is_var then
|
|
begin
|
|
getlabel(l4);
|
|
{ create indirect jump }
|
|
new(r);
|
|
reset_reference(r^);
|
|
r^.symbol:=l4;
|
|
{ place jump in codesegment }
|
|
importsSection.concat(Tai_section.Create(sec_code));
|
|
importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
|
|
importsSection.concat(Taicpu.Op_ref(A_JMP,S_NO,r));
|
|
importsSection.concat(Tai_align.Create_op(4,$90));
|
|
{ add jump field to importsection }
|
|
importsSection.concat(Tai_section.Create(sec_idata5));
|
|
importsSection.concat(Tai_label.Create(l4));
|
|
end
|
|
else
|
|
begin
|
|
importsSection.concat(Tai_symbol.Createname_global(hp2.func^,0));
|
|
end;
|
|
importsSection.concat(Tai_const_symbol.Create_rva(hp2.lab));
|
|
hp2:=timported_item(hp2.next);
|
|
end;
|
|
{ finalize the addresses }
|
|
importsSection.concat(Tai_const.Create_32bit(0));
|
|
|
|
{ finally the import information }
|
|
importsSection.concat(Tai_section.Create(sec_idata6));
|
|
hp2:=timported_item(hp1.imported_items.first);
|
|
while assigned(hp2) do
|
|
begin
|
|
importsSection.concat(Tai_label.Create(hp2.lab));
|
|
{ the ordinal number }
|
|
importsSection.concat(Tai_const.Create_16bit(hp2.ordnr));
|
|
importsSection.concat(Tai_string.Create(hp2.name^+#0));
|
|
importsSection.concat(Tai_align.Create_op(2,0));
|
|
hp2:=timported_item(hp2.next);
|
|
end;
|
|
{ create import dll name }
|
|
importsSection.concat(Tai_section.Create(sec_idata7));
|
|
importsSection.concat(Tai_label.Create(l1));
|
|
importsSection.concat(Tai_string.Create(hp1.dllname^+#0));
|
|
|
|
hp1:=timportlist(hp1.next);
|
|
end;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TEXPORTLIBWIN32
|
|
*****************************************************************************}
|
|
|
|
procedure texportlibwin32.preparelib(const s:string);
|
|
begin
|
|
if not(assigned(exportssection)) then
|
|
exportssection:=TAAsmoutput.create;
|
|
last_index:=0;
|
|
getdatalabel(edatalabel);
|
|
end;
|
|
|
|
|
|
|
|
procedure texportlibwin32.exportvar(hp : texported_item);
|
|
begin
|
|
{ same code used !! PM }
|
|
exportprocedure(hp);
|
|
end;
|
|
|
|
|
|
procedure texportlibwin32.exportprocedure(hp : texported_item);
|
|
{ must be ordered at least for win32 !! }
|
|
var
|
|
hp2 : texported_item;
|
|
begin
|
|
{ first test the index value }
|
|
if (hp.options and eo_index)<>0 then
|
|
begin
|
|
if (hp.index<=0) or (hp.index>$ffff) then
|
|
begin
|
|
message1(parser_e_export_invalid_index,tostr(hp.index));
|
|
exit;
|
|
end;
|
|
if (hp.index<=last_index) then
|
|
begin
|
|
message1(parser_e_export_ordinal_double,tostr(hp.index));
|
|
{ disregard index value }
|
|
inc(last_index);
|
|
hp.index:=last_index;
|
|
exit;
|
|
end
|
|
else
|
|
begin
|
|
last_index:=hp.index;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
inc(last_index);
|
|
hp.index:=last_index;
|
|
end;
|
|
{ now place in correct order }
|
|
hp2:=texported_item(current_module._exports.first);
|
|
while assigned(hp2) and
|
|
(hp.name^>hp2.name^) do
|
|
hp2:=texported_item(hp2.next);
|
|
{ insert hp there !! }
|
|
if assigned(hp2) and (hp2.name^=hp.name^) then
|
|
begin
|
|
{ this is not allowed !! }
|
|
message1(parser_e_export_name_double,hp.name^);
|
|
exit;
|
|
end;
|
|
if hp2=texported_item(current_module._exports.first) then
|
|
current_module._exports.concat(hp)
|
|
else if assigned(hp2) then
|
|
begin
|
|
hp.next:=hp2;
|
|
hp.previous:=hp2.previous;
|
|
if assigned(hp2.previous) then
|
|
hp2.previous.next:=hp;
|
|
hp2.previous:=hp;
|
|
end
|
|
else
|
|
current_module._exports.concat(hp);
|
|
end;
|
|
|
|
|
|
procedure texportlibwin32.generatelib;
|
|
var
|
|
ordinal_base,ordinal_max,ordinal_min : longint;
|
|
current_index : longint;
|
|
entries,named_entries : longint;
|
|
name_label,dll_name_label,export_address_table : tasmlabel;
|
|
export_name_table_pointers,export_ordinal_table : tasmlabel;
|
|
hp,hp2 : texported_item;
|
|
temtexport : TLinkedList;
|
|
address_table,name_table_pointers,
|
|
name_table,ordinal_table : TAAsmoutput;
|
|
begin
|
|
if (aktoutputformat<>as_i386_asw) and
|
|
(aktoutputformat<>as_i386_pecoff) then
|
|
begin
|
|
generatenasmlib;
|
|
exit;
|
|
end;
|
|
|
|
hp:=texported_item(current_module._exports.first);
|
|
if not assigned(hp) then
|
|
exit;
|
|
|
|
ordinal_max:=0;
|
|
ordinal_min:=$7FFFFFFF;
|
|
entries:=0;
|
|
named_entries:=0;
|
|
getlabel(dll_name_label);
|
|
getlabel(export_address_table);
|
|
getlabel(export_name_table_pointers);
|
|
getlabel(export_ordinal_table);
|
|
|
|
{ count entries }
|
|
while assigned(hp) do
|
|
begin
|
|
inc(entries);
|
|
if (hp.index>ordinal_max) then
|
|
ordinal_max:=hp.index;
|
|
if (hp.index>0) and (hp.index<ordinal_min) then
|
|
ordinal_min:=hp.index;
|
|
if assigned(hp.name) then
|
|
inc(named_entries);
|
|
hp:=texported_item(hp.next);
|
|
end;
|
|
|
|
{ no support for higher ordinal base yet !! }
|
|
ordinal_base:=1;
|
|
current_index:=ordinal_base;
|
|
{ we must also count the holes !! }
|
|
entries:=ordinal_max-ordinal_base+1;
|
|
|
|
exportsSection.concat(Tai_section.Create(sec_edata));
|
|
{ create label to reference from main so smartlink will include
|
|
the .edata section }
|
|
exportsSection.concat(Tai_symbol.Create(edatalabel,0));
|
|
{ export flags }
|
|
exportsSection.concat(Tai_const.Create_32bit(0));
|
|
{ date/time stamp }
|
|
exportsSection.concat(Tai_const.Create_32bit(0));
|
|
{ major version }
|
|
exportsSection.concat(Tai_const.Create_16bit(0));
|
|
{ minor version }
|
|
exportsSection.concat(Tai_const.Create_16bit(0));
|
|
{ pointer to dll name }
|
|
exportsSection.concat(Tai_const_symbol.Create_rva(dll_name_label));
|
|
{ ordinal base normally set to 1 }
|
|
exportsSection.concat(Tai_const.Create_32bit(ordinal_base));
|
|
{ number of entries }
|
|
exportsSection.concat(Tai_const.Create_32bit(entries));
|
|
{ number of named entries }
|
|
exportsSection.concat(Tai_const.Create_32bit(named_entries));
|
|
{ address of export address table }
|
|
exportsSection.concat(Tai_const_symbol.Create_rva(export_address_table));
|
|
{ address of name pointer pointers }
|
|
exportsSection.concat(Tai_const_symbol.Create_rva(export_name_table_pointers));
|
|
{ address of ordinal number pointers }
|
|
exportsSection.concat(Tai_const_symbol.Create_rva(export_ordinal_table));
|
|
{ the name }
|
|
exportsSection.concat(Tai_label.Create(dll_name_label));
|
|
if st='' then
|
|
exportsSection.concat(Tai_string.Create(current_module.modulename^+target_info.sharedlibext+#0))
|
|
else
|
|
exportsSection.concat(Tai_string.Create(st+target_info.sharedlibext+#0));
|
|
|
|
{ export address table }
|
|
address_table:=TAAsmoutput.create;
|
|
address_table.concat(Tai_align.Create_op(4,0));
|
|
address_table.concat(Tai_label.Create(export_address_table));
|
|
name_table_pointers:=TAAsmoutput.create;
|
|
name_table_pointers.concat(Tai_align.Create_op(4,0));
|
|
name_table_pointers.concat(Tai_label.Create(export_name_table_pointers));
|
|
ordinal_table:=TAAsmoutput.create;
|
|
ordinal_table.concat(Tai_align.Create_op(4,0));
|
|
ordinal_table.concat(Tai_label.Create(export_ordinal_table));
|
|
name_table:=TAAsmoutput.Create;
|
|
name_table.concat(Tai_align.Create_op(4,0));
|
|
{ write each address }
|
|
hp:=texported_item(current_module._exports.first);
|
|
while assigned(hp) do
|
|
begin
|
|
if (hp.options and eo_name)<>0 then
|
|
begin
|
|
getlabel(name_label);
|
|
name_table_pointers.concat(Tai_const_symbol.Create_rva(name_label));
|
|
ordinal_table.concat(Tai_const.Create_16bit(hp.index-ordinal_base));
|
|
name_table.concat(Tai_align.Create_op(2,0));
|
|
name_table.concat(Tai_label.Create(name_label));
|
|
name_table.concat(Tai_string.Create(hp.name^+#0));
|
|
end;
|
|
hp:=texported_item(hp.next);
|
|
end;
|
|
{ order in increasing ordinal values }
|
|
{ into temtexport list }
|
|
temtexport:=TLinkedList.Create;
|
|
hp:=texported_item(current_module._exports.first);
|
|
while assigned(hp) do
|
|
begin
|
|
current_module._exports.remove(hp);
|
|
hp2:=texported_item(temtexport.first);
|
|
while assigned(hp2) and (hp.index>hp2.index) do
|
|
begin
|
|
hp2:=texported_item(hp2.next);
|
|
end;
|
|
if hp2=texported_item(temtexport.first) then
|
|
temtexport.insert(hp)
|
|
else
|
|
begin
|
|
if assigned(hp2) then
|
|
begin
|
|
hp.next:=hp2;
|
|
hp.previous:=hp2.previous;
|
|
hp2.previous:=hp;
|
|
if assigned(hp.previous) then
|
|
hp.previous.next:=hp;
|
|
end
|
|
else
|
|
temtexport.concat(hp);
|
|
end;
|
|
hp:=texported_item(current_module._exports.first);;
|
|
end;
|
|
|
|
{ write the export adress table }
|
|
current_index:=ordinal_base;
|
|
hp:=texported_item(temtexport.first);
|
|
while assigned(hp) do
|
|
begin
|
|
{ fill missing values }
|
|
while current_index<hp.index do
|
|
begin
|
|
address_table.concat(Tai_const.Create_32bit(0));
|
|
inc(current_index);
|
|
end;
|
|
address_table.concat(Tai_const_symbol.Createname_rva(hp.sym.mangledname));
|
|
inc(current_index);
|
|
hp:=texported_item(hp.next);
|
|
end;
|
|
|
|
exportsSection.concatlist(address_table);
|
|
exportsSection.concatlist(name_table_pointers);
|
|
exportsSection.concatlist(ordinal_table);
|
|
exportsSection.concatlist(name_table);
|
|
address_table.Free;
|
|
name_table_pointers.free;
|
|
ordinal_table.free;
|
|
name_table.free;
|
|
temtexport.free;
|
|
end;
|
|
|
|
procedure texportlibwin32.generatenasmlib;
|
|
var
|
|
hp : texported_item;
|
|
p : pchar;
|
|
begin
|
|
exportssection.concat(tai_section.create(sec_code));
|
|
hp:=texported_item(current_module._exports.first);
|
|
while assigned(hp) do
|
|
begin
|
|
p:=strpnew(#9+'export '+hp.sym.mangledname+' '+hp.name^+' '+tostr(hp.index));
|
|
exportssection.concat(tai_direct.create(p));
|
|
hp:=texported_item(hp.next);
|
|
end;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TLINKERWIN32
|
|
****************************************************************************}
|
|
|
|
|
|
Constructor TLinkerWin32.Create;
|
|
begin
|
|
Inherited Create;
|
|
{ allow duplicated libs (PM) }
|
|
SharedLibFiles.doubles:=true;
|
|
StaticLibFiles.doubles:=true;
|
|
If not ForceDeffileForExport then
|
|
UseDeffileForExport:=false;
|
|
end;
|
|
|
|
Procedure TLinkerWin32.SetDefaultInfo;
|
|
begin
|
|
with Info do
|
|
begin
|
|
ExeCmd[1]:='ldw $OPT $STRIP $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES';
|
|
DllCmd[1]:='ldw $OPT $STRIP --dll $APPTYPE $IMAGEBASE $RELOC -o $EXE $RES';
|
|
if RelocSection or UseDeffileForExport then
|
|
begin
|
|
{ ExeCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF';
|
|
use short forms to avoid 128 char limitation problem }
|
|
ExeCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF';
|
|
ExeCmd[3]:='ldw $OPT $STRIP $APPTYPE $IMAGEBASE -o $EXE $RES exp.$$$';
|
|
{ DllCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF'; }
|
|
DllCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF';
|
|
DllCmd[3]:='ldw $OPT $STRIP --dll $APPTYPE $IMAGEBASE -o $EXE $RES exp.$$$';
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
Function TLinkerWin32.WriteResponseFile(isdll:boolean) : Boolean;
|
|
Var
|
|
linkres : TLinkRes;
|
|
HPath : TStringListItem;
|
|
s : string;
|
|
begin
|
|
WriteResponseFile:=False;
|
|
|
|
{ Open link.res file }
|
|
LinkRes:=TLinkRes.Create(outputexedir+Info.ResName);
|
|
|
|
{ Write path to search libraries }
|
|
HPath:=TStringListItem(current_module.locallibrarysearchpath.First);
|
|
while assigned(HPath) do
|
|
begin
|
|
LinkRes.Add('SEARCH_DIR('+GetShortName(HPath.Str)+')');
|
|
HPath:=TStringListItem(HPath.Next);
|
|
end;
|
|
HPath:=TStringListItem(LibrarySearchPath.First);
|
|
while assigned(HPath) do
|
|
begin
|
|
LinkRes.Add('SEARCH_DIR('+GetShortName(HPath.Str)+')');
|
|
HPath:=TStringListItem(HPath.Next);
|
|
end;
|
|
|
|
{ add objectfiles, start with prt0 always }
|
|
LinkRes.Add('INPUT(');
|
|
if isdll then
|
|
LinkRes.AddFileName(GetShortName(FindObjectFile('wdllprt0','')))
|
|
else
|
|
LinkRes.AddFileName(GetShortName(FindObjectFile('wprt0','')));
|
|
while not ObjectFiles.Empty do
|
|
begin
|
|
s:=ObjectFiles.GetFirst;
|
|
if s<>'' then
|
|
LinkRes.AddFileName(GetShortName(s));
|
|
end;
|
|
LinkRes.Add(')');
|
|
|
|
{ Write staticlibraries }
|
|
if not StaticLibFiles.Empty then
|
|
begin
|
|
LinkRes.Add('GROUP(');
|
|
While not StaticLibFiles.Empty do
|
|
begin
|
|
S:=StaticLibFiles.GetFirst;
|
|
LinkRes.AddFileName(GetShortName(s));
|
|
end;
|
|
LinkRes.Add(')');
|
|
end;
|
|
|
|
{ Write and Close response }
|
|
linkres.writetodisk;
|
|
LinkRes.Free;
|
|
|
|
WriteResponseFile:=True;
|
|
end;
|
|
|
|
|
|
function TLinkerWin32.MakeExecutable:boolean;
|
|
var
|
|
binstr,
|
|
cmdstr : string;
|
|
success : boolean;
|
|
i : longint;
|
|
AsBinStr : string[80];
|
|
StripStr,
|
|
RelocStr,
|
|
AppTypeStr,
|
|
ImageBaseStr : string[40];
|
|
begin
|
|
if not(cs_link_extern in aktglobalswitches) then
|
|
Message1(exec_i_linking,current_module.exefilename^);
|
|
|
|
{ Create some replacements }
|
|
RelocStr:='';
|
|
AppTypeStr:='';
|
|
ImageBaseStr:='';
|
|
StripStr:='';
|
|
FindExe('asw',AsBinStr);
|
|
if RelocSection then
|
|
{ Using short form to avoid problems with 128 char limitation under Dos. }
|
|
RelocStr:='-b base.$$$';
|
|
if apptype=app_gui then
|
|
AppTypeStr:='--subsystem windows';
|
|
if assigned(DLLImageBase) then
|
|
ImageBaseStr:='--image-base=0x'+DLLImageBase^;
|
|
if (cs_link_strip in aktglobalswitches) then
|
|
StripStr:='-s';
|
|
|
|
{ Write used files and libraries }
|
|
WriteResponseFile(false);
|
|
|
|
{ Call linker }
|
|
success:=false;
|
|
for i:=1 to 3 do
|
|
begin
|
|
SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr);
|
|
if binstr<>'' then
|
|
begin
|
|
Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^));
|
|
Replace(cmdstr,'$OPT',Info.ExtraOptions);
|
|
Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
|
|
Replace(cmdstr,'$APPTYPE',AppTypeStr);
|
|
Replace(cmdstr,'$ASBIN',AsbinStr);
|
|
Replace(cmdstr,'$RELOC',RelocStr);
|
|
Replace(cmdstr,'$IMAGEBASE',ImageBaseStr);
|
|
Replace(cmdstr,'$STRIP',StripStr);
|
|
if not DefFile.Empty {and UseDefFileForExport} then
|
|
begin
|
|
DefFile.WriteFile;
|
|
Replace(cmdstr,'$DEF','-d '+maybequoted(deffile.fname));
|
|
end
|
|
else
|
|
Replace(cmdstr,'$DEF','');
|
|
success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
|
|
if not success then
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
{ Post process }
|
|
if success then
|
|
success:=PostProcessExecutable(current_module.exefilename^,false);
|
|
|
|
{ Remove ReponseFile }
|
|
if (success) and not(cs_link_extern in aktglobalswitches) then
|
|
begin
|
|
RemoveFile(outputexedir+Info.ResName);
|
|
RemoveFile('base.$$$');
|
|
RemoveFile('exp.$$$');
|
|
RemoveFile('deffile.$$$');
|
|
end;
|
|
|
|
MakeExecutable:=success; { otherwise a recursive call to link method }
|
|
end;
|
|
|
|
|
|
Function TLinkerWin32.MakeSharedLibrary:boolean;
|
|
var
|
|
binstr,
|
|
cmdstr : string;
|
|
success : boolean;
|
|
i : longint;
|
|
AsBinStr : string[80];
|
|
StripStr,
|
|
RelocStr,
|
|
AppTypeStr,
|
|
ImageBaseStr : string[40];
|
|
begin
|
|
MakeSharedLibrary:=false;
|
|
if not(cs_link_extern in aktglobalswitches) then
|
|
Message1(exec_i_linking,current_module.sharedlibfilename^);
|
|
|
|
{ Create some replacements }
|
|
RelocStr:='';
|
|
AppTypeStr:='';
|
|
ImageBaseStr:='';
|
|
StripStr:='';
|
|
FindExe('asw',AsBinStr);
|
|
if RelocSection then
|
|
{ Using short form to avoid problems with 128 char limitation under Dos. }
|
|
RelocStr:='-b base.$$$';
|
|
if apptype=app_gui then
|
|
AppTypeStr:='--subsystem windows';
|
|
if assigned(DLLImageBase) then
|
|
ImageBaseStr:='--image-base=0x'+DLLImageBase^;
|
|
if (cs_link_strip in aktglobalswitches) then
|
|
StripStr:='-s';
|
|
|
|
{ Write used files and libraries }
|
|
WriteResponseFile(true);
|
|
|
|
{ Call linker }
|
|
success:=false;
|
|
for i:=1 to 3 do
|
|
begin
|
|
SplitBinCmd(Info.DllCmd[i],binstr,cmdstr);
|
|
if binstr<>'' then
|
|
begin
|
|
Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename^));
|
|
Replace(cmdstr,'$OPT',Info.ExtraOptions);
|
|
Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
|
|
Replace(cmdstr,'$APPTYPE',AppTypeStr);
|
|
Replace(cmdstr,'$ASBIN',AsbinStr);
|
|
Replace(cmdstr,'$RELOC',RelocStr);
|
|
Replace(cmdstr,'$IMAGEBASE',ImageBaseStr);
|
|
Replace(cmdstr,'$STRIP',StripStr);
|
|
if not DefFile.Empty {and UseDefFileForExport} then
|
|
begin
|
|
DefFile.WriteFile;
|
|
Replace(cmdstr,'$DEF','-d '+maybequoted(deffile.fname));
|
|
end
|
|
else
|
|
Replace(cmdstr,'$DEF','');
|
|
success:=DoExec(FindUtil(binstr),cmdstr,(i=1),false);
|
|
if not success then
|
|
break;
|
|
end;
|
|
end;
|
|
|
|
{ Post process }
|
|
if success then
|
|
success:=PostProcessExecutable(current_module.sharedlibfilename^,true);
|
|
|
|
{ Remove ReponseFile }
|
|
if (success) and not(cs_link_extern in aktglobalswitches) then
|
|
begin
|
|
RemoveFile(outputexedir+Info.ResName);
|
|
RemoveFile('base.$$$');
|
|
RemoveFile('exp.$$$');
|
|
end;
|
|
MakeSharedLibrary:=success; { otherwise a recursive call to link method }
|
|
end;
|
|
|
|
|
|
function tlinkerwin32.postprocessexecutable(const fn : string;isdll:boolean):boolean;
|
|
type
|
|
tdosheader = packed record
|
|
e_magic : word;
|
|
e_cblp : word;
|
|
e_cp : word;
|
|
e_crlc : word;
|
|
e_cparhdr : word;
|
|
e_minalloc : word;
|
|
e_maxalloc : word;
|
|
e_ss : word;
|
|
e_sp : word;
|
|
e_csum : word;
|
|
e_ip : word;
|
|
e_cs : word;
|
|
e_lfarlc : word;
|
|
e_ovno : word;
|
|
e_res : array[0..3] of word;
|
|
e_oemid : word;
|
|
e_oeminfo : word;
|
|
e_res2 : array[0..9] of word;
|
|
e_lfanew : longint;
|
|
end;
|
|
tpeheader = packed record
|
|
PEMagic : array[0..3] of char;
|
|
Machine : word;
|
|
NumberOfSections : word;
|
|
TimeDateStamp : longint;
|
|
PointerToSymbolTable : longint;
|
|
NumberOfSymbols : longint;
|
|
SizeOfOptionalHeader : word;
|
|
Characteristics : word;
|
|
Magic : word;
|
|
MajorLinkerVersion : byte;
|
|
MinorLinkerVersion : byte;
|
|
SizeOfCode : longint;
|
|
SizeOfInitializedData : longint;
|
|
SizeOfUninitializedData : longint;
|
|
AddressOfEntryPoint : longint;
|
|
BaseOfCode : longint;
|
|
BaseOfData : longint;
|
|
ImageBase : longint;
|
|
SectionAlignment : longint;
|
|
FileAlignment : longint;
|
|
MajorOperatingSystemVersion : word;
|
|
MinorOperatingSystemVersion : word;
|
|
MajorImageVersion : word;
|
|
MinorImageVersion : word;
|
|
MajorSubsystemVersion : word;
|
|
MinorSubsystemVersion : word;
|
|
Reserved1 : longint;
|
|
SizeOfImage : longint;
|
|
SizeOfHeaders : longint;
|
|
CheckSum : longint;
|
|
Subsystem : word;
|
|
DllCharacteristics : word;
|
|
SizeOfStackReserve : longint;
|
|
SizeOfStackCommit : longint;
|
|
SizeOfHeapReserve : longint;
|
|
SizeOfHeapCommit : longint;
|
|
LoaderFlags : longint;
|
|
NumberOfRvaAndSizes : longint;
|
|
DataDirectory : array[1..$80] of byte;
|
|
end;
|
|
tcoffsechdr=packed record
|
|
name : array[0..7] of char;
|
|
vsize : longint;
|
|
rvaofs : longint;
|
|
datalen : longint;
|
|
datapos : longint;
|
|
relocpos : longint;
|
|
lineno1 : longint;
|
|
nrelocs : word;
|
|
lineno2 : word;
|
|
flags : longint;
|
|
end;
|
|
psecfill=^tsecfill;
|
|
tsecfill=record
|
|
fillpos,
|
|
fillsize : longint;
|
|
next : psecfill;
|
|
end;
|
|
var
|
|
f : file;
|
|
cmdstr : string;
|
|
dosheader : tdosheader;
|
|
peheader : tpeheader;
|
|
firstsecpos,
|
|
maxfillsize,
|
|
l,peheaderpos : longint;
|
|
coffsec : tcoffsechdr;
|
|
secroot,hsecroot : psecfill;
|
|
zerobuf : pointer;
|
|
begin
|
|
postprocessexecutable:=false;
|
|
{ when -s is used or it's a dll then quit }
|
|
if (cs_link_extern in aktglobalswitches) then
|
|
begin
|
|
case apptype of
|
|
app_gui :
|
|
cmdstr:='--subsystem gui';
|
|
app_cui :
|
|
cmdstr:='--subsystem console';
|
|
end;
|
|
if dllversion<>'' then
|
|
cmdstr:=cmdstr+' --version '+dllversion;
|
|
cmdstr:=cmdstr+' --input '+fn;
|
|
cmdstr:=cmdstr+' --stack '+tostr(stacksize);
|
|
DoExec(FindUtil('postw32'),cmdstr,false,false);
|
|
postprocessexecutable:=true;
|
|
exit;
|
|
end;
|
|
{ open file }
|
|
assign(f,fn);
|
|
{$I-}
|
|
reset(f,1);
|
|
if ioresult<>0 then
|
|
Message1(execinfo_f_cant_open_executable,fn);
|
|
{ read headers }
|
|
blockread(f,dosheader,sizeof(tdosheader));
|
|
peheaderpos:=dosheader.e_lfanew;
|
|
seek(f,peheaderpos);
|
|
blockread(f,peheader,sizeof(tpeheader));
|
|
{ write info }
|
|
Message1(execinfo_x_codesize,tostr(peheader.SizeOfCode));
|
|
Message1(execinfo_x_initdatasize,tostr(peheader.SizeOfInitializedData));
|
|
Message1(execinfo_x_uninitdatasize,tostr(peheader.SizeOfUninitializedData));
|
|
{ change stack size (PM) }
|
|
{ I am not sure that the default value is adequate !! }
|
|
peheader.SizeOfStackReserve:=stacksize;
|
|
{ change the header }
|
|
{ sub system }
|
|
{ gui=2 }
|
|
{ cui=3 }
|
|
case apptype of
|
|
app_gui :
|
|
peheader.Subsystem:=2;
|
|
app_cui :
|
|
peheader.Subsystem:=3;
|
|
end;
|
|
if dllversion<>'' then
|
|
begin
|
|
peheader.MajorImageVersion:=dllmajor;
|
|
peheader.MinorImageVersion:=dllminor;
|
|
end;
|
|
{ reset timestamp }
|
|
peheader.TimeDateStamp:=0;
|
|
{ write header back }
|
|
seek(f,peheaderpos);
|
|
blockwrite(f,peheader,sizeof(tpeheader));
|
|
if ioresult<>0 then
|
|
Message1(execinfo_f_cant_process_executable,fn);
|
|
seek(f,peheaderpos);
|
|
blockread(f,peheader,sizeof(tpeheader));
|
|
{ write the value after the change }
|
|
Message1(execinfo_x_stackreserve,tostr(peheader.SizeOfStackReserve));
|
|
Message1(execinfo_x_stackcommit,tostr(peheader.SizeOfStackCommit));
|
|
{ read section info }
|
|
maxfillsize:=0;
|
|
firstsecpos:=0;
|
|
secroot:=nil;
|
|
for l:=1 to peheader.NumberOfSections do
|
|
begin
|
|
blockread(f,coffsec,sizeof(tcoffsechdr));
|
|
if coffsec.datapos>0 then
|
|
begin
|
|
if secroot=nil then
|
|
firstsecpos:=coffsec.datapos;
|
|
new(hsecroot);
|
|
hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize;
|
|
hsecroot^.fillsize:=coffsec.datalen-coffsec.vsize;
|
|
hsecroot^.next:=secroot;
|
|
secroot:=hsecroot;
|
|
if secroot^.fillsize>maxfillsize then
|
|
maxfillsize:=secroot^.fillsize;
|
|
end;
|
|
end;
|
|
if firstsecpos>0 then
|
|
begin
|
|
l:=firstsecpos-filepos(f);
|
|
if l>maxfillsize then
|
|
maxfillsize:=l;
|
|
end
|
|
else
|
|
l:=0;
|
|
{ get zero buffer }
|
|
getmem(zerobuf,maxfillsize);
|
|
fillchar(zerobuf^,maxfillsize,0);
|
|
{ zero from sectioninfo until first section }
|
|
blockwrite(f,zerobuf^,l);
|
|
{ zero section alignments }
|
|
while assigned(secroot) do
|
|
begin
|
|
seek(f,secroot^.fillpos);
|
|
blockwrite(f,zerobuf^,secroot^.fillsize);
|
|
hsecroot:=secroot;
|
|
secroot:=secroot^.next;
|
|
dispose(hsecroot);
|
|
end;
|
|
freemem(zerobuf,maxfillsize);
|
|
close(f);
|
|
{$I+}
|
|
if ioresult<>0 then;
|
|
postprocessexecutable:=true;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TDLLScannerWin32
|
|
****************************************************************************}
|
|
|
|
function tDLLScannerWin32.DOSstubOK(var x:cardinal):boolean;
|
|
begin
|
|
blockread(f,TheWord,2,loaded);
|
|
if loaded<>2 then
|
|
DOSstubOK:=false
|
|
else
|
|
begin
|
|
DOSstubOK:=(TheWord='MZ');
|
|
seek(f,$3C);
|
|
blockread(f,x,4,loaded);
|
|
if(loaded<>4)or(longint(x)>filesize(f))then
|
|
DOSstubOK:=false;
|
|
end;
|
|
end;
|
|
|
|
function TDLLScannerWin32.FindDLL(const s:string;var founddll:string):boolean;
|
|
var
|
|
sysdir : string;
|
|
Found : boolean;
|
|
begin
|
|
Found:=false;
|
|
{ Look for DLL in:
|
|
1. Current dir
|
|
2. Library Path
|
|
3. windir,windir/system,windir/system32 }
|
|
Found:=FindFile(s,'.'+DirSep,founddll);
|
|
if (not found) then
|
|
Found:=librarysearchpath.FindFile(s,founddll);
|
|
if (not found) then
|
|
begin
|
|
sysdir:=FixPath(GetEnv('windir'),false);
|
|
Found:=FindFile(s,sysdir+';'+sysdir+'system'+DirSep+';'+sysdir+'system32'+DirSep,founddll);
|
|
end;
|
|
if (not found) then
|
|
begin
|
|
message1(exec_w_libfile_not_found,s);
|
|
FoundDll:=s;
|
|
end;
|
|
FindDll:=Found;
|
|
end;
|
|
|
|
|
|
function tDLLScannerWin32.DllName(Const Name : string) : string;
|
|
var n : string;
|
|
begin
|
|
n:=Upper(SplitExtension(Name));
|
|
if (n='.DLL') or (n='.DRV') or (n='.EXE') then
|
|
DllName:=Name
|
|
else
|
|
DllName:=Name+target_info.sharedlibext;
|
|
end;
|
|
|
|
|
|
|
|
function tDLLScannerWin32.isSuitableFileType(x:cardinal):longbool;
|
|
begin
|
|
seek(f,x);
|
|
blockread(f,TheWord,2,loaded);
|
|
isSuitableFileType:=(loaded=2)and(TheWord='PE');
|
|
end;
|
|
|
|
|
|
function tDLLScannerWin32.GetEdata(HeaderEntry:cardinal):longbool;
|
|
type
|
|
TObjInfo=packed record
|
|
ObjName:array[0..7]of char;
|
|
VirtSize,
|
|
VirtAddr,
|
|
RawSize,
|
|
RawOffset,
|
|
Reloc,
|
|
LineNum:cardinal;
|
|
RelCount,
|
|
LineCount:word;
|
|
flags:cardinal;
|
|
end;
|
|
var
|
|
i:cardinal;
|
|
ObjOfs:cardinal;
|
|
Obj:TObjInfo;
|
|
APE_obj,APE_Optsize:word;
|
|
ExportRVA:cardinal;
|
|
delta:cardinal;
|
|
const
|
|
IMAGE_SCN_CNT_CODE=$00000020;
|
|
var
|
|
_d:dirstr;
|
|
_n:namestr;
|
|
_e:extstr;
|
|
function isUsedFunction(name:pchar):longbool;
|
|
var
|
|
hp:tExternalsItem;
|
|
begin
|
|
isUsedFunction:=false;
|
|
hp:=tExternalsItem(current_module.Externals.first);
|
|
while assigned(hp)do
|
|
begin
|
|
if(assigned(hp.data))and(not hp.found)then
|
|
if hp.data^=StrPas(name)then
|
|
begin
|
|
isUsedFunction:=true;
|
|
hp.found:=true;
|
|
exit;
|
|
end;
|
|
hp:=tExternalsItem(hp.next);
|
|
end;
|
|
end;
|
|
|
|
procedure Store(index:cardinal;name:pchar;isData:longbool);
|
|
begin
|
|
if not isUsedFunction(name)then
|
|
exit;
|
|
if not(current_module.uses_imports) then
|
|
begin
|
|
current_module.uses_imports:=true;
|
|
importlib.preparelib(current_module.modulename^);
|
|
end;
|
|
if IsData then
|
|
importlib.importvariable(name,_n,name)
|
|
else
|
|
importlib.importprocedure(name,_n,index,name);
|
|
end;
|
|
|
|
procedure ProcessEdata;
|
|
type
|
|
a8=array[0..7]of char;
|
|
function GetSectionName(rva:cardinal;var Flags:cardinal):a8;
|
|
var
|
|
i:cardinal;
|
|
LocObjOfs:cardinal;
|
|
LocObj:TObjInfo;
|
|
begin
|
|
GetSectionName:='';
|
|
Flags:=0;
|
|
LocObjOfs:=APE_OptSize+HeaderOffset+24;
|
|
for i:=1 to APE_obj do
|
|
begin
|
|
seek(f,LocObjOfs);
|
|
blockread(f,LocObj,sizeof(LocObj));
|
|
if(rva>=LocObj.VirtAddr)and(rva<=LocObj.VirtAddr+LocObj.RawSize)then
|
|
begin
|
|
GetSectionName:=a8(LocObj.ObjName);
|
|
Flags:=LocObj.flags;
|
|
end;
|
|
end;
|
|
end;
|
|
var
|
|
j,Fl:cardinal;
|
|
ulongval,procEntry:cardinal;
|
|
Ordinal:word;
|
|
isData:longbool;
|
|
ExpDir:packed record
|
|
flag,
|
|
stamp:cardinal;
|
|
Major,
|
|
Minor:word;
|
|
Name,
|
|
Base,
|
|
NumFuncs,
|
|
NumNames,
|
|
AddrFuncs,
|
|
AddrNames,
|
|
AddrOrds:cardinal;
|
|
end;
|
|
begin
|
|
with Obj do
|
|
begin
|
|
seek(f,RawOffset+delta);
|
|
blockread(f,ExpDir,sizeof(ExpDir));
|
|
fsplit(impname,_d,_n,_e);
|
|
for j:=0 to pred(ExpDir.NumNames)do
|
|
begin
|
|
seek(f,RawOffset-VirtAddr+ExpDir.AddrOrds+j*2);
|
|
blockread(f,Ordinal,2);
|
|
seek(f,RawOffset-VirtAddr+ExpDir.AddrFuncs+cardinal(Ordinal)*4);
|
|
blockread(f,ProcEntry,4);
|
|
seek(f,RawOffset-VirtAddr+ExpDir.AddrNames+j*4);
|
|
blockread(f,ulongval,4);
|
|
seek(f,RawOffset-VirtAddr+ulongval);
|
|
blockread(f,cstring,sizeof(cstring));
|
|
isData:=GetSectionName(procentry,Fl)='';
|
|
if not isData then
|
|
isData:=Fl and IMAGE_SCN_CNT_CODE<>IMAGE_SCN_CNT_CODE;
|
|
Store(succ(Ordinal),cstring,isData);
|
|
end;
|
|
end;
|
|
end;
|
|
begin
|
|
GetEdata:=false;
|
|
seek(f,HeaderEntry+120);
|
|
blockread(f,ExportRVA,4);
|
|
seek(f,HeaderEntry+6);
|
|
blockread(f,APE_Obj,2);
|
|
seek(f,HeaderEntry+20);
|
|
blockread(f,APE_OptSize,2);
|
|
ObjOfs:=APE_OptSize+HeaderOffset+24;
|
|
for i:=1 to APE_obj do
|
|
begin
|
|
seek(f,ObjOfs);
|
|
blockread(f,Obj,sizeof(Obj));
|
|
inc(ObjOfs,sizeof(Obj));
|
|
with Obj do
|
|
if(VirtAddr<=ExportRva)and(ExportRva<VirtAddr+VirtSize)then
|
|
begin
|
|
delta:=ExportRva-VirtAddr;
|
|
ProcessEdata;
|
|
GetEdata:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function tDLLScannerWin32.scan(const binname:string):longbool;
|
|
var
|
|
OldFileMode:longint;
|
|
begin
|
|
if not FindDll(DLLName(binname),impname) then
|
|
exit;
|
|
assign(f,impname);
|
|
OldFileMode:=filemode;
|
|
filemode:=0;
|
|
reset(f,1);
|
|
filemode:=OldFileMode;
|
|
if not DOSstubOK(HeaderOffset)then
|
|
scan:=false
|
|
else if not isSuitableFileType(HeaderOffset)then
|
|
scan:=false
|
|
else
|
|
scan:=GetEdata(HeaderOffset);
|
|
close(f);
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
Initialize
|
|
*****************************************************************************}
|
|
|
|
const
|
|
ar_gnu_arw_info : tarinfo =
|
|
(
|
|
id : ar_gnu_arw;
|
|
arcmd : 'arw rs $LIB $FILES'
|
|
);
|
|
|
|
const
|
|
res_gnu_windres_info : tresinfo =
|
|
(
|
|
id : res_gnu_windres;
|
|
resbin : 'windres';
|
|
rescmd : '--include $INC -O coff -o $OBJ $RES'
|
|
);
|
|
|
|
const
|
|
target_i386_win32_info : ttargetinfo =
|
|
(
|
|
target : target_i386_WIN32;
|
|
name : 'Win32 for i386';
|
|
shortname : 'Win32';
|
|
flags : [];
|
|
cpu : i386;
|
|
unit_env : 'WIN32UNITS';
|
|
extradefines : 'MSWINDOWS';
|
|
sharedlibext : '.dll';
|
|
staticlibext : '.aw';
|
|
sourceext : '.pp';
|
|
pasext : '.pas';
|
|
exeext : '.exe';
|
|
defext : '.def';
|
|
scriptext : '.bat';
|
|
smartext : '.slw';
|
|
unitext : '.ppw';
|
|
unitlibext : '.ppl';
|
|
asmext : '.sw';
|
|
objext : '.ow';
|
|
resext : '.rc';
|
|
resobjext : '.owr';
|
|
staticlibprefix : 'libp';
|
|
sharedlibprefix : '';
|
|
Cprefix : '_';
|
|
newline : #13#10;
|
|
assem : as_i386_pecoff;
|
|
assemextern : as_i386_asw;
|
|
link : ld_i386_win32;
|
|
linkextern : ld_i386_win32;
|
|
ar : ar_gnu_arw;
|
|
res : res_gnu_windres;
|
|
endian : endian_little;
|
|
alignment :
|
|
(
|
|
procalign : 4;
|
|
loopalign : 4;
|
|
jumpalign : 0;
|
|
constalignmin : 0;
|
|
constalignmax : 1;
|
|
varalignmin : 0;
|
|
varalignmax : 1;
|
|
localalignmin : 0;
|
|
localalignmax : 1;
|
|
paraalign : 4;
|
|
recordalignmin : 0;
|
|
recordalignmax : 2;
|
|
maxCrecordalign : 16
|
|
);
|
|
size_of_pointer : 4;
|
|
size_of_longint : 4;
|
|
heapsize : 256*1024;
|
|
maxheapsize : 32*1024*1024;
|
|
stacksize : 32*1024*1024;
|
|
DllScanSupported:true;
|
|
use_bound_instruction : false;
|
|
use_function_relative_addresses : true
|
|
);
|
|
|
|
|
|
initialization
|
|
RegisterLinker(ld_i386_win32,TLinkerWin32);
|
|
RegisterImport(target_i386_win32,TImportLibWin32);
|
|
RegisterExport(target_i386_win32,TExportLibWin32);
|
|
RegisterDLLScanner(target_i386_win32,TDLLScannerWin32);
|
|
RegisterAr(ar_gnu_arw_info);
|
|
RegisterRes(res_gnu_windres_info);
|
|
RegisterTarget(target_i386_win32_info);
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.14 2001-07-01 20:16:21 peter
|
|
* alignmentinfo record added
|
|
* -Oa argument supports more alignment settings that can be specified
|
|
per type: PROC,LOOP,VARMIN,VARMAX,CONSTMIN,CONSTMAX,RECORDMIN
|
|
RECORDMAX,LOCALMIN,LOCALMAX. It is possible to set the mimimum
|
|
required alignment and the maximum usefull alignment. The final
|
|
alignment will be choosen per variable size dependent on these
|
|
settings
|
|
|
|
Revision 1.13 2001/06/28 19:46:25 peter
|
|
* added override and virtual for constructors
|
|
|
|
Revision 1.12 2001/06/18 20:36:26 peter
|
|
* -Ur switch (merged)
|
|
* masm fixes (merged)
|
|
* quoted filenames for go32v2 and win32
|
|
|
|
Revision 1.11 2001/06/06 21:58:16 peter
|
|
* Win32 fixes for Makefile so it doesn't require sh.exe
|
|
|
|
Revision 1.10 2001/06/03 20:18:13 peter
|
|
* define also MSWINDOWS
|
|
|
|
Revision 1.9 2001/06/03 15:15:32 peter
|
|
* dllprt0 stub for linux shared libs
|
|
* pass -init and -fini for linux shared libs
|
|
* libprefix splitted into staticlibprefix and sharedlibprefix
|
|
|
|
Revision 1.8 2001/06/02 19:22:44 peter
|
|
* extradefines field added
|
|
|
|
Revision 1.7 2001/04/21 13:33:16 peter
|
|
* move winstackpagesize const to cgai386 to remove uses t_win32
|
|
|
|
Revision 1.6 2001/04/18 22:02:04 peter
|
|
* registration of targets and assemblers
|
|
|
|
Revision 1.5 2001/04/13 23:51:02 peter
|
|
* fix for the stricter compilemode
|
|
|
|
Revision 1.4 2001/04/13 01:22:22 peter
|
|
* symtable change to classes
|
|
* range check generation and errors fixed, make cycle DEBUG=1 works
|
|
* memory leaks fixed
|
|
|
|
Revision 1.3 2001/04/02 21:20:40 peter
|
|
* resulttype rewrite
|
|
|
|
Revision 1.2 2001/03/06 18:28:02 peter
|
|
* patch from Pavel with a new and much faster DLL Scanner for
|
|
automatic importing so $linklib works for DLLs. Thanks Pavel!
|
|
|
|
Revision 1.1 2001/02/26 19:43:11 peter
|
|
* moved target units to subdir
|
|
|
|
Revision 1.10 2001/02/20 21:41:16 peter
|
|
* new fixfilename, findfile for unix. Look first for lowercase, then
|
|
NormalCase and last for UPPERCASE names.
|
|
|
|
Revision 1.9 2001/01/13 00:09:22 peter
|
|
* made Pavel O. happy ;)
|
|
|
|
Revision 1.8 2000/12/30 22:53:25 peter
|
|
* export with the case provided in the exports section
|
|
|
|
Revision 1.7 2000/12/25 00:07:30 peter
|
|
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
|
|
tlinkedlist objects)
|
|
|
|
Revision 1.6 2000/11/12 22:20:37 peter
|
|
* create generic toutputsection for binary writers
|
|
|
|
Revision 1.5 2000/09/24 15:06:31 peter
|
|
* use defines.inc
|
|
|
|
Revision 1.4 2000/08/27 16:11:54 peter
|
|
* moved some util functions from globals,cobjects to cutils
|
|
* splitted files into finput,fmodule
|
|
|
|
Revision 1.3 2000/07/21 15:14:02 jonas
|
|
+ added is_addr field for labels, if they are only used for getting the address
|
|
(e.g. for io checks) and corresponding getaddrlabel() procedure
|
|
|
|
Revision 1.2 2000/07/13 11:32:50 michael
|
|
+ removed logs
|
|
|
|
}
|