123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716 |
- {
- $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,
- symconst,symsym,
- 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;
- importname : string;
- suffix : integer;
- 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));
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) then
- begin
- if assigned(hp2.name) then
- begin
- importname:='__imp_'+hp2.name^;
- suffix:=0;
- while assigned(getasmsymbol(importname)) do
- begin
- inc(suffix);
- importname:='__imp_'+hp2.name^+'_'+tostr(suffix);
- end;
- importssection.concat(tai_symbol.createname(importname,4));
- end
- else
- begin
- importname:='__imp_by_ordinal'+tostr(hp2.ordnr);
- suffix:=0;
- while assigned(getasmsymbol(importname)) do
- begin
- inc(suffix);
- importname:='__imp_by_ordinal'+tostr(hp2.ordnr)+'_'+tostr(suffix);
- end;
- importssection.concat(tai_symbol.createname(importname,4));
- end;
- end;
- {$endif GDB}
- 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;
- importname : string;
- suffix : integer;
- 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));
- {$ifdef GDB}
- if (cs_debuginfo in aktmoduleswitches) then
- begin
- if assigned(hp2.name) then
- begin
- importname:='__imp_'+hp2.name^;
- suffix:=0;
- while assigned(getasmsymbol(importname)) do
- begin
- inc(suffix);
- importname:='__imp_'+hp2.name^+'_'+tostr(suffix);
- end;
- importssection.concat(tai_symbol.createname(importname,4));
- end
- else
- begin
- importname:='__imp_by_ordinal'+tostr(hp2.ordnr);
- suffix:=0;
- while assigned(getasmsymbol(importname)) do
- begin
- inc(suffix);
- importname:='__imp_by_ordinal'+tostr(hp2.ordnr)+'_'+tostr(suffix);
- end;
- importssection.concat(tai_symbol.createname(importname,4));
- end;
- end;
- {$endif GDB}
- 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;
- case hp.sym.typ of
- varsym :
- address_table.concat(Tai_const_symbol.Createname_rva(tvarsym(hp.sym).mangledname));
- typedconstsym :
- address_table.concat(Tai_const_symbol.Createname_rva(ttypedconstsym(hp.sym).mangledname));
- procsym :
- address_table.concat(Tai_const_symbol.Createname_rva(tprocsym(hp.sym).defs^.def.mangledname));
- end;
- 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;
- s : string;
- begin
- exportssection.concat(tai_section.create(sec_code));
- hp:=texported_item(current_module._exports.first);
- while assigned(hp) do
- begin
- case hp.sym.typ of
- varsym :
- s:=tvarsym(hp.sym).mangledname;
- typedconstsym :
- s:=ttypedconstsym(hp.sym).mangledname;
- procsym :
- s:=tprocsym(hp.sym).defs^.def.mangledname;
- else
- s:='';
- end;
- p:=strpnew(#9+'export '+s+' '+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,s2 : string;
- i : integer;
- linklibc : boolean;
- begin
- WriteResponseFile:=False;
- linklibc:=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;
- { add libaries required for profiling }
- if cs_profile in aktmoduleswitches then
- begin
- LinkRes.Add('-lgmon');
- LinkRes.Add('-lc');
- 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 sharedlibraries }
- if not SharedLibFiles.Empty then
- begin
- LinkRes.Add('INPUT(') ;
- While not SharedLibFiles.Empty do
- begin
- S:=SharedLibFiles.GetFirst;
- if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then
- begin
- LinkRes.Add(GetShortName(s2));
- continue;
- end;
- if pos(target_info.sharedlibprefix,s)=1 then
- s:=copy(s,length(target_info.sharedlibprefix)+1,255);
- if s<>'c' then
- begin
- i:=Pos(target_info.sharedlibext,S);
- if i>0 then
- Delete(S,i,255);
- LinkRes.Add('-l'+s);
- end
- else
- begin
- LinkRes.Add('-l'+s);
- linklibc:=true;
- end;
- end;
- { be sure that libc is the last lib }
- if linklibc then
- LinkRes.Add('-lc');
- 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,'.'+source_info.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'+source_info.DirSep+';'+sysdir+'system32'+source_info.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;
- foundimp : string;
- begin
- Scan:=false;
- { is there already an import library the we will use that one }
- if FindLibraryFile(binname,target_info.staticClibprefix,target_info.staticClibext,foundimp) then
- exit;
- { check if we can find the dll }
- if not FindDll(DLLName(binname),impname) then
- exit;
- { read the dll file }
- 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';
- sourceext : '.pp';
- pasext : '.pas';
- exeext : '.exe';
- defext : '.def';
- scriptext : '.bat';
- smartext : '.slw';
- unitext : '.ppw';
- unitlibext : '.ppl';
- asmext : '.sw';
- objext : '.ow';
- resext : '.rc';
- resobjext : '.owr';
- sharedlibext : '.dll';
- staticlibext : '.aw';
- staticlibprefix : 'libp';
- sharedlibprefix : '';
- sharedClibext : '.dll';
- staticClibext : '.a';
- staticClibprefix : 'lib';
- sharedClibprefix : '';
- Cprefix : '_';
- newline : #13#10;
- dirsep : '\';
- files_case_relevent : false;
- assem : as_i386_pecoff;
- assemextern : as_i386_asw;
- link : ld_i386_win32;
- linkextern : ld_i386_win32;
- ar : ar_gnu_arw;
- res : res_gnu_windres;
- script : script_dos;
- 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.21 2001-11-02 22:58:12 peter
- * procsym definition rewrite
- Revision 1.20 2001/10/12 16:06:27 peter
- * duplicate imports fix for gdb (merged)
- Revision 1.19 2001/09/30 21:29:47 peter
- * gdb fixes merged
- Revision 1.18 2001/09/18 11:32:00 michael
- * Fixes win32 linking problems with import libraries
- * LINKLIB Libraries are now looked for using C file extensions
- * get_exepath fix
- Revision 1.17 2001/09/17 21:29:16 peter
- * merged netbsd, fpu-overflow from fixes branch
- Revision 1.16 2001/09/13 14:47:19 michael
- + Committed patch from peter
- Revision 1.15 2001/08/07 18:47:15 peter
- * merged netbsd start
- * profile for win32
- 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
- }
|