1 { 2 Copyright (c) 1998-2008 by Peter Vreman 3 4 This unit implements support import,export,link routines 5 for the (i386) Win32 target 6 7 This program is free software; you can redistribute it and/or modify 8 it under the terms of the GNU General Public License as published by 9 the Free Software Foundation; either version 2 of the License, or 10 (at your option) any later version. 11 12 This program is distributed in the hope that it will be useful, 13 but WITHOUT ANY WARRANTY; without even the implied warranty of 14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 GNU General Public License for more details. 16 17 You should have received a copy of the GNU General Public License 18 along with this program; if not, write to the Free Software 19 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 20 **************************************************************************** 21 } 22 unit t_win; 23 24 {$i fpcdefs.inc} 25 26 interface 27 28 uses 29 cutils,cclasses, 30 aasmbase,aasmtai,aasmdata,aasmcpu,fmodule,globtype,globals,systems,verbose, 31 symconst,symdef,symsym, 32 cscript,gendef, 33 cpubase, 34 import,export,link,comprsrc,i_win; 35 36 37 const 38 MAX_DEFAULT_EXTENSIONS = 3; 39 40 type 41 tStr4=array[1..MAX_DEFAULT_EXTENSIONS] of string[4]; 42 pStr4=^tStr4; 43 44 TImportLibWin=class(timportlib) 45 private 46 procedure generateimportlib; 47 procedure generateidatasection; 48 public 49 procedure generatelib;override; 50 end; 51 52 TExportLibWin=class(texportlib) 53 private 54 st : string; 55 EList_indexed:TFPList; 56 EList_nonindexed:TFPList; 57 public 58 destructor Destroy;override; 59 procedure preparelib(const s:string);override; 60 procedure exportprocedure(hp : texported_item);override; 61 procedure exportvar(hp : texported_item);override; 62 procedure exportfromlist(hp : texported_item); 63 procedure generatelib;override; 64 procedure generatenasmlib;virtual; 65 end; 66 67 TInternalLinkerWin = class(tinternallinker) 68 constructor create;override; 69 procedure DefaultLinkScript;override; 70 procedure InitSysInitUnitName;override; 71 procedure ConcatEntryName; virtual; 72 end; 73 74 TExternalLinkerWin=class(texternallinker) 75 private WriteResponseFilenull76 Function WriteResponseFile(isdll:boolean) : Boolean; PostProcessExecutablenull77 Function PostProcessExecutable(const fn:string;isdll:boolean) : Boolean; 78 public 79 Constructor Create;override; 80 Procedure SetDefaultInfo;override; MakeExecutablenull81 function MakeExecutable:boolean;override; MakeSharedLibrarynull82 function MakeSharedLibrary:boolean;override; 83 procedure InitSysInitUnitName;override; 84 end; 85 86 TDLLScannerWin=class(tDLLScanner) 87 private 88 importfound : boolean; 89 procedure CheckDLLFunc(const dllname,funcname:string); 90 public Scannull91 function Scan(const binname:string):boolean;override; 92 end; 93 94 implementation 95 96 uses 97 SysUtils, 98 cfileutl, 99 cgutils,dbgbase, 100 owar,ogbase 101 {$ifdef SUPPORT_OMF} 102 ,ogomf 103 {$endif SUPPORT_OMF} 104 ,ogcoff; 105 106 107 const 108 res_gnu_windres_info : tresinfo = 109 ( 110 id : res_gnu_windres; 111 resbin : 'fpcres'; 112 rescmd : '-o $OBJ -a $ARCH -of coff $DBG'; 113 rcbin : 'windres'; 114 rccmd : '--include $INC -O res -D FPC -o $RES $RC'; 115 resourcefileclass : nil; 116 resflags : []; 117 ); 118 {$ifdef x86_64} 119 res_win64_gorc_info : tresinfo = 120 ( 121 id : res_win64_gorc; 122 resbin : 'fpcres'; 123 rescmd : '-o $OBJ -a $ARCH -of coff $DBG'; 124 rcbin : 'gorc'; 125 rccmd : '/machine x64 /nw /ni /r /d FPC /fo $RES $RC'; 126 resourcefileclass : nil; 127 resflags : []; 128 ); 129 {$endif x86_64} 130 131 132 Procedure GlobalInitSysInitUnitName(Linker : TLinker); 133 var 134 hp : tmodule; 135 linkcygwin : boolean; 136 begin 137 if target_info.system=system_i386_win32 then 138 begin 139 hp:=tmodule(loaded_units.first); 140 while assigned(hp) do 141 begin 142 linkcygwin := hp.linkothersharedlibs.find('cygwin') or hp.linkotherstaticlibs.find('cygwin'); 143 if linkcygwin then 144 break; 145 hp:=tmodule(hp.next); 146 end; 147 if cs_profile in current_settings.moduleswitches then 148 linker.sysinitunit:='sysinitgprof' 149 else if linkcygwin or (Linker.SharedLibFiles.Find('cygwin')<>nil) or (Linker.StaticLibFiles.Find('cygwin')<>nil) then 150 linker.sysinitunit:='sysinitcyg' 151 else 152 linker.sysinitunit:='sysinitpas'; 153 end 154 else if target_info.system=system_x86_64_win64 then 155 linker.sysinitunit:='sysinit'; 156 end; 157 158 159 {***************************************************************************** 160 TImportLibWin 161 *****************************************************************************} 162 163 procedure TImportLibWin.generateimportlib; 164 var 165 ObjWriter : tarobjectwriter; 166 ObjOutput : TPECoffObjOutput; 167 basedllname : string; 168 AsmPrefix : string; 169 idatalabnr, 170 SmartFilesCount, 171 SmartHeaderCount : longint; 172 CreateObjDatanull173 function CreateObjData(place:tcutplace):TObjData; 174 var 175 s : string; 176 begin 177 s:=''; 178 case place of 179 cut_begin : 180 begin 181 inc(SmartHeaderCount); 182 s:=asmprefix+tostr(SmartHeaderCount)+'h'; 183 end; 184 cut_normal : 185 s:=asmprefix+tostr(SmartHeaderCount)+'s'; 186 cut_end : 187 s:=asmprefix+tostr(SmartHeaderCount)+'t'; 188 end; 189 inc(SmartFilesCount); 190 result:=ObjOutput.NewObjData(FixFileName(s+tostr(SmartFilesCount)+target_info.objext)); 191 ObjOutput.startobjectfile(Result.Name); 192 end; 193 194 procedure WriteObjData(objdata:TObjData); 195 begin 196 ObjOutput.writeobjectfile(ObjData); 197 end; 198 199 procedure StartImport(const dllname:string); 200 var 201 headlabel, 202 idata4label, 203 idata5label, 204 idata7label : TObjSymbol; 205 emptyint : longint; 206 objdata : TObjData; 207 idata2objsection, 208 idata4objsection, 209 idata5objsection : TObjSection; 210 begin 211 objdata:=CreateObjData(cut_begin); 212 idata2objsection:=objdata.createsection(sec_idata2,''); 213 idata4objsection:=objdata.createsection(sec_idata4,''); 214 idata5objsection:=objdata.createsection(sec_idata5,''); 215 emptyint:=0; 216 basedllname:=ExtractFileName(dllname); 217 { idata4 } 218 objdata.SetSection(idata4objsection); 219 idata4label:=objdata.SymbolDefine(asmprefix+'_names_'+basedllname,AB_GLOBAL,AT_DATA); 220 { idata5 } 221 objdata.SetSection(idata5objsection); 222 idata5label:=objdata.SymbolDefine(asmprefix+'_fixup_'+basedllname,AB_GLOBAL,AT_DATA); 223 { idata2 } 224 objdata.SetSection(idata2objsection); 225 headlabel:=objdata.SymbolDefine(asmprefix+'_head_'+basedllname,AB_GLOBAL,AT_DATA); 226 ObjOutput.exportsymbol(headlabel); 227 objdata.writereloc(0,sizeof(longint),idata4label,RELOC_RVA); 228 objdata.writebytes(emptyint,sizeof(emptyint)); 229 objdata.writebytes(emptyint,sizeof(emptyint)); 230 idata7label:=objdata.SymbolRef(asmprefix+'_dll_'+basedllname); 231 objdata.writereloc(0,sizeof(longint),idata7label,RELOC_RVA); 232 objdata.writereloc(0,sizeof(longint),idata5label,RELOC_RVA); 233 WriteObjData(objdata); 234 objdata.free; 235 end; 236 237 procedure EndImport; 238 var 239 idata7label : TObjSymbol; 240 emptyint : longint; 241 objdata : TObjData; 242 idata4objsection, 243 idata5objsection, 244 idata7objsection : TObjSection; 245 begin 246 objdata:=CreateObjData(cut_end); 247 idata4objsection:=objdata.createsection(sec_idata4,''); 248 idata5objsection:=objdata.createsection(sec_idata5,''); 249 idata7objsection:=objdata.createsection(sec_idata7,''); 250 emptyint:=0; 251 { idata4 } 252 objdata.SetSection(idata4objsection); 253 objdata.writebytes(emptyint,sizeof(emptyint)); 254 if target_info.system=system_x86_64_win64 then 255 objdata.writebytes(emptyint,sizeof(emptyint)); 256 { idata5 } 257 objdata.SetSection(idata5objsection); 258 objdata.writebytes(emptyint,sizeof(emptyint)); 259 if target_info.system=system_x86_64_win64 then 260 objdata.writebytes(emptyint,sizeof(emptyint)); 261 { idata7 } 262 objdata.SetSection(idata7objsection); 263 idata7label:=objdata.SymbolDefine(asmprefix+'_dll_'+basedllname,AB_GLOBAL,AT_DATA); 264 objoutput.exportsymbol(idata7label); 265 objdata.writebytes(basedllname[1],length(basedllname)); 266 objdata.writebytes(emptyint,1); 267 WriteObjData(objdata); 268 objdata.free; 269 end; 270 271 procedure AddImport(const afuncname,mangledname:string;ordnr:longint;isvar:boolean); 272 const 273 {$ifdef x86_64} 274 jmpopcode : array[0..1] of byte = ( 275 $ff,$25 // jmp qword [rip + offset32] 276 ); 277 {$else x86_64} 278 {$ifdef arm} 279 jmpopcode : array[0..7] of byte = ( 280 $00,$c0,$9f,$e5, // ldr ip, [pc, #0] 281 $00,$f0,$9c,$e5 // ldr pc, [ip] 282 ); 283 {$else arm} 284 jmpopcode : array[0..1] of byte = ( 285 $ff,$25 286 ); 287 {$endif arm} 288 {$endif x86_64} 289 nopopcodes : array[0..1] of byte = ( 290 $90,$90 291 ); 292 var 293 implabel, 294 idata2label, 295 idata5label, 296 idata6label : TObjSymbol; 297 emptyint : longint; 298 objdata : TObjData; 299 textobjsection, 300 idata4objsection, 301 idata5objsection, 302 idata6objsection, 303 idata7objsection : TObjSection; 304 absordnr: word; 305 306 procedure WriteTableEntry; 307 var 308 ordint: dword; 309 begin 310 if ordnr <= 0 then 311 begin 312 { import by name } 313 objdata.writereloc(0,sizeof(longint),idata6label,RELOC_RVA); 314 if target_info.system=system_x86_64_win64 then 315 objdata.writebytes(emptyint,sizeof(emptyint)); 316 end 317 else 318 begin 319 { import by ordinal } 320 ordint:=ordnr; 321 if target_info.system=system_x86_64_win64 then 322 begin 323 objdata.writebytes(ordint,sizeof(ordint)); 324 ordint:=$80000000; 325 objdata.writebytes(ordint,sizeof(ordint)); 326 end 327 else 328 begin 329 ordint:=ordint or $80000000; 330 objdata.writebytes(ordint,sizeof(ordint)); 331 end; 332 end; 333 end; 334 335 begin 336 implabel:=nil; 337 idata5label:=nil; 338 textobjsection:=nil; 339 objdata:=CreateObjData(cut_normal); 340 if not isvar then 341 textobjsection:=objdata.createsection(sec_code,''); 342 idata4objsection:=objdata.createsection(sec_idata4,''); 343 idata5objsection:=objdata.createsection(sec_idata5,''); 344 idata6objsection:=objdata.createsection(sec_idata6,''); 345 idata7objsection:=objdata.createsection(sec_idata7,''); 346 emptyint:=0; 347 { idata7, link to head } 348 objdata.SetSection(idata7objsection); 349 idata2label:=objdata.SymbolRef(asmprefix+'_head_'+basedllname); 350 objdata.writereloc(0,sizeof(longint),idata2label,RELOC_RVA); 351 { idata6, import data (ordnr+name) } 352 objdata.SetSection(idata6objsection); 353 inc(idatalabnr); 354 idata6label:=objdata.SymbolDefine(asmprefix+'_'+tostr(idatalabnr),AB_LOCAL,AT_DATA); 355 absordnr:=Abs(ordnr); 356 { write index hint } 357 objdata.writebytes(absordnr,2); 358 if ordnr <= 0 then 359 objdata.writebytes(afuncname[1],length(afuncname)); 360 objdata.writebytes(emptyint,1); 361 objdata.writebytes(emptyint,align(objdata.CurrObjSec.size,2)-objdata.CurrObjSec.size); 362 { idata4, import lookup table } 363 objdata.SetSection(idata4objsection); 364 WriteTableEntry; 365 { idata5, import address table } 366 objdata.SetSection(idata5objsection); 367 if isvar then 368 implabel:=objdata.SymbolDefine(mangledname,AB_GLOBAL,AT_DATA) 369 else 370 idata5label:=objdata.SymbolDefine(asmprefix+'_'+mangledname,AB_LOCAL,AT_DATA); 371 WriteTableEntry; 372 { text, jmp } 373 if not isvar then 374 begin 375 objdata.SetSection(textobjsection); 376 if mangledname <> '' then 377 implabel:=objdata.SymbolDefine(mangledname,AB_GLOBAL,AT_FUNCTION) elsenull378 else 379 implabel:=objdata.SymbolDefine(basedllname+'_index_'+tostr(ordnr),AB_GLOBAL,AT_FUNCTION); 380 objdata.writebytes(jmpopcode,sizeof(jmpopcode)); 381 {$ifdef x86_64} 382 objdata.writereloc(0,sizeof(longint),idata5label,RELOC_RELATIVE); 383 {$else} 384 objdata.writereloc(0,sizeof(longint),idata5label,RELOC_ABSOLUTE32); 385 {$endif x86_64} 386 objdata.writebytes(nopopcodes,align(objdata.CurrObjSec.size,qword(sizeof(nopopcodes)))-objdata.CurrObjSec.size); 387 end; 388 ObjOutput.exportsymbol(implabel); 389 WriteObjData(objdata); 390 objdata.free; 391 end; 392 393 var 394 i,j : longint; 395 ImportLibrary : TImportLibrary; 396 ImportSymbol : TImportSymbol; 397 begin 398 AsmPrefix:='imp'+Lower(current_module.modulename^); 399 idatalabnr:=0; 400 SmartFilesCount:=0; 401 SmartHeaderCount:=0; 402 current_module.linkotherstaticlibs.add(current_module.importlibfilename,link_always); 403 ObjWriter:=TARObjectWriter.CreateAr(current_module.importlibfilename); 404 ObjOutput:=TPECoffObjOutput.Create(ObjWriter); 405 for i:=0 to current_module.ImportLibraryList.Count-1 do 406 begin 407 ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); 408 StartImport(ImportLibrary.Name); 409 for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do 410 begin 411 ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); 412 AddImport(ImportSymbol.Name,ImportSymbol.MangledName,ImportSymbol.OrdNr,ImportSymbol.IsVar); 413 end; 414 EndImport; 415 end; 416 ObjOutput.Free; 417 ObjWriter.Free; 418 end; 419 420 421 procedure TImportLibWin.generateidatasection; 422 var 423 templab, 424 l1,l2,l3,l4 {$ifdef ARM} ,l5 {$endif ARM} : tasmlabel; 425 importname : string; 426 suffix : integer; 427 href : treference; 428 i,j : longint; 429 ImportLibrary : TImportLibrary; 430 ImportSymbol : TImportSymbol; 431 ImportLabels : TFPList; 432 begin 433 if current_asmdata.asmlists[al_imports]=nil then 434 current_asmdata.asmlists[al_imports]:=TAsmList.create; 435 436 if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then 437 begin 438 new_section(current_asmdata.asmlists[al_imports],sec_code,'',0); 439 for i:=0 to current_module.ImportLibraryList.Count-1 do 440 begin 441 ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); 442 for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do 443 begin 444 ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); 445 current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_extern,ImportSymbol.Name)); 446 current_asmdata.asmlists[al_imports].concat(tai_directive.create(asd_nasm_import,ImportSymbol.Name+' '+ImportLibrary.Name+' '+ImportSymbol.Name)); 447 end; 448 end; 449 exit; 450 end; 451 452 for i:=0 to current_module.ImportLibraryList.Count-1 do 453 begin 454 ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]); 455 { align al_procedures for the jumps } 456 new_section(current_asmdata.asmlists[al_imports],sec_code,'',sizeof(aint)); 457 { Get labels for the sections } 458 current_asmdata.getjumplabel(l1); 459 current_asmdata.getjumplabel(l2); 460 current_asmdata.getjumplabel(l3); 461 new_section(current_asmdata.asmlists[al_imports],sec_idata2,'',0); 462 { pointer to procedure names } 463 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l2)); 464 { two empty entries follow } 465 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); 466 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); 467 { pointer to dll name } 468 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l1)); 469 { pointer to fixups } 470 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(l3)); 471 472 { only create one section for each else it will 473 create a lot of idata* } 474 475 { first write the name references } 476 new_section(current_asmdata.asmlists[al_imports],sec_idata4,'',0); 477 current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l2)); 478 479 ImportLabels:=TFPList.Create; 480 ImportLabels.Count:=ImportLibrary.ImportSymbolList.Count; 481 for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do 482 begin 483 ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); 484 485 current_asmdata.getjumplabel(templab); 486 ImportLabels[j]:=templab; 487 if ImportSymbol.Name<>'' then 488 begin 489 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(TAsmLabel(ImportLabels[j]))); 490 if target_info.system=system_x86_64_win64 then 491 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); 492 end 493 else 494 begin 495 if target_info.system=system_x86_64_win64 then 496 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_64bit(int64($8000000000000000) or ImportSymbol.ordnr)) 497 else 498 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(longint($80000000) or ImportSymbol.ordnr)); 499 end; 500 end; 501 { finalize the names ... } 502 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); 503 if target_info.system=system_x86_64_win64 then 504 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); 505 506 { then the addresses and create also the indirect jump } 507 new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0); 508 current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l3)); 509 510 for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do 511 begin 512 ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); 513 if not ImportSymbol.IsVar then 514 begin 515 current_asmdata.getjumplabel(l4); 516 {$ifdef ARM} 517 current_asmdata.getjumplabel(l5); 518 {$endif ARM} 519 { create indirect jump and } 520 { place jump in al_procedures } 521 new_section(current_asmdata.asmlists[al_imports],sec_code,'',0); 522 if ImportSymbol.Name <> '' then 0null523 current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ImportSymbol.MangledName,AT_FUNCTION,0,voidcodepointertype)) 524 else 525 current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ExtractFileName(ImportLibrary.Name)+'_index_'+tostr(ImportSymbol.ordnr),AT_FUNCTION,0,voidcodepointertype)); 526 current_asmdata.asmlists[al_imports].concat(tai_function_name.create('')); 527 {$ifdef ARM} 528 reference_reset_symbol(href,l5,0,sizeof(pint),[]); 529 current_asmdata.asmlists[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R12,href)); 530 reference_reset_base(href,NR_R12,0,ctempposinvalid,sizeof(pint),[]); 531 current_asmdata.asmlists[al_imports].concat(Taicpu.op_reg_ref(A_LDR,NR_R15,href)); 532 current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l5)); 533 reference_reset_symbol(href,l4,0,sizeof(pint),[]); 534 current_asmdata.asmlists[al_imports].concat(tai_const.create_sym_offset(href.symbol,href.offset)); 535 {$else ARM} 536 reference_reset_symbol(href,l4,0,sizeof(pint),[]); 537 {$ifdef X86_64} 538 href.base:=NR_RIP; 539 {$endif X86_64} 540 541 current_asmdata.asmlists[al_imports].concat(Taicpu.Op_ref(A_JMP,S_NO,href)); 542 current_asmdata.asmlists[al_imports].concat(Tai_align.Create_op(4,$90)); 543 {$endif ARM} 544 { add jump field to al_imports } 545 new_section(current_asmdata.asmlists[al_imports],sec_idata5,'',0); 546 if (cs_debuginfo in current_settings.moduleswitches) then 547 begin 548 if ImportSymbol.MangledName<>'' then 549 begin 550 importname:='__imp_'+ImportSymbol.MangledName; 551 suffix:=0; 552 while assigned(current_asmdata.getasmsymbol(importname)) do 553 begin 554 inc(suffix); 555 importname:='__imp_'+ImportSymbol.MangledName+'_'+tostr(suffix); 556 end; 4null557 current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4,voidcodepointertype)); 558 end 559 else 560 begin 561 importname:='__imp_by_ordinal'+tostr(ImportSymbol.ordnr); 562 suffix:=0; 563 while assigned(current_asmdata.getasmsymbol(importname)) do 564 begin 565 inc(suffix); 566 importname:='__imp_by_ordinal'+tostr(ImportSymbol.ordnr)+'_'+tostr(suffix); 567 end; 4null568 current_asmdata.asmlists[al_imports].concat(tai_symbol.createname(importname,AT_FUNCTION,4,voidcodepointertype)); 569 end; 570 end; 571 current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l4)); 572 end 573 else 574 current_asmdata.asmlists[al_imports].concat(Tai_symbol.Createname_global(ImportSymbol.MangledName,AT_DATA,0,voidpointertype)); 575 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_rva_sym(TAsmLabel(Importlabels[j]))); 576 if target_info.system=system_x86_64_win64 then 577 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); 578 end; 579 { finalize the addresses } 580 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); 581 if target_info.system=system_x86_64_win64 then 582 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_32bit(0)); 583 584 { finally the import information } 585 new_section(current_asmdata.asmlists[al_imports],sec_idata6,'',0); 586 for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do 587 begin 588 ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]); 589 current_asmdata.asmlists[al_imports].concat(Tai_label.Create(TAsmLabel(ImportLabels[j]))); 590 { the ordinal number } 591 current_asmdata.asmlists[al_imports].concat(Tai_const.Create_16bit(ImportSymbol.ordnr)); 592 current_asmdata.asmlists[al_imports].concat(Tai_string.Create(ImportSymbol.Name+#0)); 593 current_asmdata.asmlists[al_imports].concat(Tai_align.Create_op(2,0)); 594 end; 595 { create import dll name } 596 new_section(current_asmdata.asmlists[al_imports],sec_idata7,'',0); 597 current_asmdata.asmlists[al_imports].concat(Tai_label.Create(l1)); 598 current_asmdata.asmlists[al_imports].concat(Tai_string.Create(ImportLibrary.Name+#0)); 599 ImportLabels.Free; 600 ImportLabels:=nil; 601 end; 602 end; 603 604 605 procedure TImportLibWin.generatelib; 606 begin 607 if GenerateImportSection then 608 generateidatasection 609 else 610 generateimportlib; 611 end; 612 613 614 {***************************************************************************** 615 TExportLibWin 616 *****************************************************************************} 617 618 destructor TExportLibWin.Destroy; 619 begin 620 EList_indexed.Free; 621 EList_nonindexed.Free; 622 inherited; 623 end; 624 625 626 procedure TExportLibWin.preparelib(const s:string); 627 begin 628 if current_asmdata.asmlists[al_exports]=nil then 629 current_asmdata.asmlists[al_exports]:=TAsmList.create; 630 if EList_indexed=nil then 631 EList_indexed:=tFPList.Create; 632 if EList_nonindexed=nil then 633 EList_nonindexed:=tFPList.Create; 634 end; 635 636 637 procedure TExportLibWin.exportvar(hp : texported_item); 638 begin 639 { same code used !! PM } 640 exportprocedure(hp); 641 end; 642 643 var 644 Gl_DoubleIndex:boolean; 645 Gl_DoubleIndexValue:longint; 646 IdxComparenull647 function IdxCompare(Item1, Item2: Pointer): Integer; 648 var 649 I1:texported_item absolute Item1; 650 I2:texported_item absolute Item2; 651 begin 652 Result:=I1.index-I2.index; 653 if(Result=0)and(Item1<>Item2)then 654 begin 655 Gl_DoubleIndex:=true; 656 Gl_DoubleIndexValue:=I1.index; 657 end; 658 end; 659 660 661 procedure TExportLibWin.exportprocedure(hp : texported_item); 662 begin 663 if (eo_index in hp.options) and ((hp.index<=0) or (hp.index>$ffff)) then 664 begin 665 message1(parser_e_export_invalid_index,tostr(hp.index)); 666 exit; 667 end; 668 if eo_index in hp.options then 669 EList_indexed.Add(hp) 670 else 671 EList_nonindexed.Add(hp); 672 end; 673 674 675 procedure TExportLibWin.exportfromlist(hp : texported_item); 676 //formerly TExportLibWin.exportprocedure 677 { must be ordered at least for win32 !! } 678 var 679 hp2 : texported_item; 680 begin 681 hp2:=texported_item(current_module._exports.first); 682 while assigned(hp2) and 683 (hp.name^>hp2.name^) do 684 hp2:=texported_item(hp2.next); 685 { insert hp there !! } 686 if hp2=nil then 687 current_module._exports.concat(hp) 688 else 689 begin 690 if hp2.name^=hp.name^ then 691 begin 692 { this is not allowed !! } 693 duplicatesymbol(hp.name^); 694 exit; 695 end; 696 current_module._exports.insertbefore(hp,hp2); 697 end; 698 end; 699 700 701 procedure TExportLibWin.generatelib; 702 var 703 ordinal_base,ordinal_max,ordinal_min : longint; 704 current_index : longint; 705 entries,named_entries : longint; 706 name_label,dll_name_label,export_address_table : tasmlabel; 707 export_name_table_pointers,export_ordinal_table : tasmlabel; 708 hp,hp2 : texported_item; 709 temtexport : TLinkedList; 710 address_table,name_table_pointers, 711 name_table,ordinal_table : TAsmList; 712 i,autoindex,ni_high : longint; 713 hole : boolean; 714 asmsym : TAsmSymbol; 715 begin 716 Gl_DoubleIndex:=false; 717 ELIst_indexed.Sort(@IdxCompare); 718 719 if Gl_DoubleIndex then 720 begin 721 message1(parser_e_export_ordinal_double,tostr(Gl_DoubleIndexValue)); 722 FreeAndNil(EList_indexed); 723 FreeAndNil(EList_nonindexed); 724 exit; 725 end; 726 727 autoindex:=1; 728 while EList_nonindexed.Count>0 do 729 begin 730 hole:=(EList_indexed.Count>0) and (texported_item(EList_indexed.Items[0]).index>1); 731 if not hole then 732 for i:=autoindex to pred(EList_indexed.Count) do 733 if texported_item(EList_indexed.Items[i]).index-texported_item(EList_indexed.Items[pred(i)]).index>1 then 734 begin 735 autoindex:=succ(texported_item(EList_indexed.Items[pred(i)]).index); 736 hole:=true; 737 break; 738 end; 739 ni_high:=pred(EList_nonindexed.Count); 740 if not hole then 741 begin 742 autoindex:=succ(EList_indexed.Count); 743 EList_indexed.Add(EList_nonindexed.Items[ni_high]); 744 end 745 else 746 EList_indexed.Insert(pred(AutoIndex),EList_nonindexed.Items[ni_high]); 747 EList_nonindexed.Delete(ni_high); 748 texported_item(EList_indexed.Items[pred(AutoIndex)]).index:=autoindex; 749 end; 750 FreeAndNil(EList_nonindexed); 751 for i:=0 to pred(EList_indexed.Count) do 752 exportfromlist(texported_item(EList_indexed.Items[i])); 753 FreeAndNil(EList_indexed); 754 755 if (target_asm.id in [as_i386_masm,as_i386_tasm,as_i386_nasmwin32]) then 756 begin 757 generatenasmlib; 758 exit; 759 end; 760 761 hp:=texported_item(current_module._exports.first); 762 if not assigned(hp) then 763 exit; 764 765 ordinal_max:=0; 766 ordinal_min:=$7FFFFFFF; 767 entries:=0; 768 named_entries:=0; 769 current_asmdata.getjumplabel(dll_name_label); 770 current_asmdata.getjumplabel(export_address_table); 771 current_asmdata.getjumplabel(export_name_table_pointers); 772 current_asmdata.getjumplabel(export_ordinal_table); 773 774 { count entries } 775 while assigned(hp) do 776 begin 777 inc(entries); 778 if (hp.index>ordinal_max) then 779 ordinal_max:=hp.index; 780 if (hp.index>0) and (hp.index<ordinal_min) then 781 ordinal_min:=hp.index; 782 if assigned(hp.name) then 783 inc(named_entries); 784 hp:=texported_item(hp.next); 785 end; 786 787 { no support for higher ordinal base yet !! } 788 ordinal_base:=1; 789 current_index:=ordinal_base; 790 { we must also count the holes !! } 791 entries:=ordinal_max-ordinal_base+1; 792 793 new_section(current_asmdata.asmlists[al_exports],sec_edata,'',0); 794 { create label to reference from main so smartlink will include 795 the .edata section } 796 current_asmdata.asmlists[al_exports].concat(Tai_symbol.Createname_global(make_mangledname('EDATA',current_module.localsymtable,''),AT_METADATA,0,voidpointertype)); 797 { export flags } 798 current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(0)); 799 { date/time stamp } 800 current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(0)); 801 { major version } 802 current_asmdata.asmlists[al_exports].concat(Tai_const.Create_16bit(0)); 803 { minor version } 804 current_asmdata.asmlists[al_exports].concat(Tai_const.Create_16bit(0)); 805 { pointer to dll name } 806 current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(dll_name_label)); 807 { ordinal base normally set to 1 } 808 current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(ordinal_base)); 809 { number of entries } 810 current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(entries)); 811 { number of named entries } 812 current_asmdata.asmlists[al_exports].concat(Tai_const.Create_32bit(named_entries)); 813 { address of export address table } 814 current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(export_address_table)); 815 { address of name pointer pointers } 816 current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(export_name_table_pointers)); 817 { address of ordinal number pointers } 818 current_asmdata.asmlists[al_exports].concat(Tai_const.Create_rva_sym(export_ordinal_table)); 819 { the name } 820 current_asmdata.asmlists[al_exports].concat(Tai_label.Create(dll_name_label)); 821 if st='' then 822 current_asmdata.asmlists[al_exports].concat(Tai_string.Create(current_module.modulename^+target_info.sharedlibext+#0)) 823 else 824 current_asmdata.asmlists[al_exports].concat(Tai_string.Create(st+target_info.sharedlibext+#0)); 825 826 { export address table } 827 address_table:=TAsmList.create; 828 address_table.concat(Tai_align.Create_op(4,0)); 829 address_table.concat(Tai_label.Create(export_address_table)); 830 name_table_pointers:=TAsmList.create; 831 name_table_pointers.concat(Tai_align.Create_op(4,0)); 832 name_table_pointers.concat(Tai_label.Create(export_name_table_pointers)); 833 ordinal_table:=TAsmList.create; 834 ordinal_table.concat(Tai_align.Create_op(4,0)); 835 ordinal_table.concat(Tai_label.Create(export_ordinal_table)); 836 name_table:=TAsmList.Create; 837 name_table.concat(Tai_align.Create_op(4,0)); 838 { write each address } 839 hp:=texported_item(current_module._exports.first); 840 while assigned(hp) do 841 begin 842 if eo_name in hp.options then 843 begin 844 current_asmdata.getjumplabel(name_label); 845 name_table_pointers.concat(Tai_const.Create_rva_sym(name_label)); 846 ordinal_table.concat(Tai_const.Create_16bit(hp.index-ordinal_base)); 847 name_table.concat(Tai_align.Create_op(2,0)); 848 name_table.concat(Tai_label.Create(name_label)); 849 name_table.concat(Tai_string.Create(hp.name^+#0)); 850 end; 851 hp:=texported_item(hp.next); 852 end; 853 { order in increasing ordinal values } 854 { into temtexport list } 855 temtexport:=TLinkedList.Create; 856 hp:=texported_item(current_module._exports.first); 857 while assigned(hp) do 858 begin 859 current_module._exports.remove(hp); 860 hp2:=texported_item(temtexport.first); 861 while assigned(hp2) and (hp.index>hp2.index) do 862 hp2:=texported_item(hp2.next); 863 if hp2=nil then 864 temtexport.concat(hp) 865 else 866 temtexport.insertbefore(hp,hp2); 867 hp:=texported_item(current_module._exports.first); 868 end; 869 870 { write the export adress table } 871 current_index:=ordinal_base; 872 hp:=texported_item(temtexport.first); 873 while assigned(hp) do 874 begin 875 { fill missing values } 876 while current_index<hp.index do 877 begin 878 address_table.concat(Tai_const.Create_32bit(0)); 879 inc(current_index); 880 end; 881 882 { symbol known? then get a new name } 883 if assigned(hp.sym) and not (eo_no_sym_name in hp.options) then 884 case hp.sym.typ of 885 staticvarsym : 886 asmsym:=current_asmdata.RefAsmSymbol(tstaticvarsym(hp.sym).mangledname,AT_DATA); 887 procsym : 888 asmsym:=current_asmdata.RefAsmSymbol(tprocdef(tprocsym(hp.sym).ProcdefList[0]).mangledname,AT_FUNCTION) elsenull889 else 890 internalerror(200709272); 891 end 892 else 893 asmsym:=current_asmdata.RefAsmSymbol(hp.name^,AT_DATA); 894 address_table.concat(Tai_const.Create_rva_sym(asmsym)); 895 inc(current_index); 896 hp:=texported_item(hp.next); 897 end; 898 899 current_asmdata.asmlists[al_exports].concatlist(address_table); 900 current_asmdata.asmlists[al_exports].concatlist(name_table_pointers); 901 current_asmdata.asmlists[al_exports].concatlist(ordinal_table); 902 current_asmdata.asmlists[al_exports].concatlist(name_table); 903 address_table.Free; 904 name_table_pointers.free; 905 ordinal_table.free; 906 name_table.free; 907 908 { the package support needs this data later on 909 to create the import library } 910 current_module._exports.concatlist(temtexport); 911 temtexport.free; 912 end; 913 914 915 procedure TExportLibWin.generatenasmlib; 916 var 917 hp : texported_item; 918 {p : pchar; 919 s : string;} 920 begin 921 new_section(current_asmdata.asmlists[al_exports],sec_code,'',0); 922 hp:=texported_item(current_module._exports.first); 923 while assigned(hp) do 924 begin 925 { case hp.sym.typ of 926 staticvarsym : 927 s:=tstaticvarsym(hp.sym).mangledname; 928 procsym : 929 s:=tprocdef(tprocsym(hp.sym).ProcdefList[0]).mangledname; 930 else 931 s:=''; 932 end; 933 p:=strpnew(#9+'export '+s+' '+hp.Name^+' '+tostr(hp.index)); 934 current_asmdata.asmlists[al_exports].concat(tai_direct.create(p));} 935 hp:=texported_item(hp.next); 936 end; 937 end; 938 939 940 {**************************************************************************** 941 TInternalLinkerWin 942 ****************************************************************************} 943 944 constructor TInternalLinkerWin.Create; 945 begin 946 inherited Create; 947 CArObjectReader:=TArObjectReader; 948 CExeoutput:=TPECoffexeoutput; 949 CObjInput:=TPECoffObjInput; 950 end; 951 952 953 procedure TInternalLinkerWin.DefaultLinkScript; 954 begin 955 ScriptAddSourceStatements(true); 956 with LinkScript do 957 begin 958 if IsSharedLibrary then 959 Concat('ISSHAREDLIBRARY'); 960 ConcatEntryName; 961 if not ImageBaseSetExplicity then 962 begin 963 if IsSharedLibrary then 964 imagebase:={$ifdef cpu64bitaddr} $110000000 {$else} $10000000 {$endif} 965 else 966 if target_info.system in systems_wince then 967 imagebase:=$10000 968 else 969 {$ifdef cpu64bitaddr} 970 if (target_dbg.id = dbg_stabs) then 971 imagebase:=$400000 972 else 973 imagebase:= $100000000; 974 {$else} 975 imagebase:=$400000; 976 {$endif} 977 end; 978 Concat('IMAGEBASE $' + hexStr(imagebase, SizeOf(imagebase)*2)); 979 Concat('HEADER'); 980 Concat('EXESECTION .text'); 981 Concat(' SYMBOL __text_start__'); 982 Concat(' OBJSECTION .text*'); 983 Concat(' SYMBOL ___CTOR_LIST__'); 984 Concat(' SYMBOL __CTOR_LIST__'); 985 Concat(' LONG -1'); 986 {$ifdef x86_64} 987 Concat(' LONG -1'); 988 {$endif x86_64} 989 Concat(' OBJSECTION .ctor*'); 990 Concat(' LONG 0'); 991 {$ifdef x86_64} 992 Concat(' LONG 0'); 993 {$endif x86_64} 994 Concat(' SYMBOL ___DTOR_LIST__'); 995 Concat(' SYMBOL __DTOR_LIST__'); 996 Concat(' LONG -1'); 997 {$ifdef x86_64} 998 Concat(' LONG -1'); 999 {$endif x86_64} 1000 Concat(' OBJSECTION .dtor*'); 1001 Concat(' LONG 0'); 1002 {$ifdef x86_64} 1003 Concat(' LONG 0'); 1004 {$endif x86_64} 1005 Concat(' SYMBOL etext'); 1006 Concat('ENDEXESECTION'); 1007 Concat('EXESECTION .data'); 1008 Concat(' SYMBOL __data_start__'); 1009 Concat(' OBJSECTION .data*'); 1010 Concat(' OBJSECTION .fpc*'); 1011 Concat(' PROVIDE '+target_info.Cprefix+'_tls_index'); 1012 Concat(' LONG 0'); 1013 Concat(' SYMBOL edata'); 1014 Concat(' SYMBOL __data_end__'); 1015 Concat('ENDEXESECTION'); 1016 Concat('EXESECTION .rdata'); 1017 Concat(' SYMBOL ___RUNTIME_PSEUDO_RELOC_LIST__'); 1018 Concat(' SYMBOL __RUNTIME_PSEUDO_RELOC_LIST__'); 1019 Concat(' OBJSECTION .rdata_runtime_pseudo_reloc'); 1020 Concat(' SYMBOL ___RUNTIME_PSEUDO_RELOC_LIST_END__'); 1021 Concat(' SYMBOL __RUNTIME_PSEUDO_RELOC_LIST_END__'); 1022 Concat(' OBJSECTION .rdata*'); 1023 Concat(' OBJSECTION .rodata*'); 1024 Concat(' OBJSECTION .xdata*'); 1025 Concat('ENDEXESECTION'); 1026 Concat('EXESECTION .pdata'); 1027 Concat(' OBJSECTION .pdata*'); 1028 Concat('ENDEXESECTION'); 1029 Concat('EXESECTION .bss'); 1030 Concat(' SYMBOL __bss_start__'); 1031 Concat(' OBJSECTION .bss*'); 1032 Concat(' SYMBOL __bss_end__'); 1033 Concat('ENDEXESECTION'); 1034 Concat('EXESECTION .tls'); 1035 Concat(' SYMBOL ___tls_start__'); 1036 Concat(' OBJSECTION .tls*'); 1037 Concat(' SYMBOL ___tls_end__'); 1038 Concat('ENDEXESECTION'); 1039 Concat('EXESECTION .CRT'); 1040 Concat(' SYMBOL ___crt_xc_start__'); 1041 Concat(' OBJSECTION .CRT$XC*');{ /* C initialization */');} 1042 Concat(' SYMBOL ___crt_xc_end__'); 1043 Concat(' SYMBOL ___crt_xi_start__'); 1044 Concat(' OBJSECTION .CRT$XI*');{ /* C++ initialization */');} 1045 Concat(' SYMBOL ___crt_xi_end__'); 1046 Concat(' SYMBOL ___crt_xl_start__'); 1047 Concat(' OBJSECTION .CRT$XL*'); { /* TLS callbacks */'); } 1048 { In GNU ld, this is defined in the TLS Directory support code } 1049 Concat(' PROVIDE ___crt_xl_end__'); 1050 { Add a nil pointer as last element } 1051 Concat(' LONG 0'); 1052 {$ifdef x86_64} 1053 Concat(' LONG 0'); 1054 {$endif x86_64} 1055 Concat(' SYMBOL ___crt_xp_start__'); 1056 Concat(' OBJSECTION .CRT$XP*'); { /* Pre-termination */');} 1057 Concat(' SYMBOL ___crt_xp_end__'); 1058 Concat(' SYMBOL ___crt_xt_start__'); 1059 Concat(' OBJSECTION .CRT$XT*');{ /* Termination */');} 1060 Concat(' SYMBOL ___crt_xt_end__'); 1061 Concat('ENDEXESECTION'); 1062 Concat('EXESECTION .idata'); 1063 Concat(' OBJSECTION .idata$2*'); 1064 Concat(' OBJSECTION .idata$3*'); 1065 Concat(' ZEROS 20'); 1066 Concat(' OBJSECTION .idata$4*'); 1067 Concat(' SYMBOL __IAT_start__'); 1068 Concat(' OBJSECTION .idata$5*'); 1069 Concat(' SYMBOL __IAT_end__'); 1070 Concat(' OBJSECTION .idata$6*'); 1071 Concat(' OBJSECTION .idata$7*'); 1072 Concat('ENDEXESECTION'); 1073 ScriptAddGenericSections('.edata,.rsrc,.reloc,.gnu_debuglink,'+ 1074 '.debug_aranges,.debug_pubnames,.debug_info,.debug_abbrev,.debug_line,.debug_frame,.debug_str,.debug_loc,'+ 1075 '.debug_macinfo,.debug_weaknames,.debug_funcnames,.debug_typenames,.debug_varnames,.debug_ranges'); 1076 { Can't use the generic rules, because that will add also .stabstr to .stab } 1077 Concat('EXESECTION .stab'); 1078 Concat(' OBJSECTION .stab'); 1079 Concat('ENDEXESECTION'); 1080 Concat('EXESECTION .stabstr'); 1081 Concat(' OBJSECTION .stabstr'); 1082 Concat('ENDEXESECTION'); 1083 Concat('STABS'); 1084 Concat('SYMBOLS'); 1085 end; 1086 end; 1087 1088 1089 procedure TInternalLinkerWin.InitSysInitUnitName; 1090 begin 1091 GlobalInitSysInitUnitName(self) 1092 end; 1093 1094 procedure TInternalLinkerWin.ConcatEntryName; 1095 begin 1096 with LinkScript do 1097 begin 1098 if IsSharedLibrary then 1099 begin 1100 Concat('ISSHAREDLIBRARY'); 1101 if apptype=app_gui then 1102 Concat('ENTRYNAME _DLLWinMainCRTStartup') 1103 else 1104 Concat('ENTRYNAME _DLLMainCRTStartup'); 1105 end 1106 else 1107 begin 1108 if apptype=app_gui then 1109 Concat('ENTRYNAME _WinMainCRTStartup') 1110 else 1111 Concat('ENTRYNAME _mainCRTStartup'); 1112 end; 1113 end; 1114 end; 1115 1116 1117 {**************************************************************************** 1118 TExternalLinkerWin 1119 ****************************************************************************} 1120 1121 Constructor TExternalLinkerWin.Create; 1122 begin 1123 Inherited Create; 1124 { allow duplicated libs (PM) } 1125 SharedLibFiles.doubles:=true; 1126 StaticLibFiles.doubles:=true; 1127 end; 1128 1129 1130 Procedure TExternalLinkerWin.SetDefaultInfo; 1131 var 1132 targetopts: string; 1133 begin 1134 with Info do 1135 begin 1136 {$ifdef x86_64} 1137 targetopts:='-b pei-x86-64'; 1138 {$else x86_64} 1139 if target_info.system=system_arm_wince then 1140 targetopts:='-m arm_wince_pe' 1141 else 1142 targetopts:='-b pei-i386 -m i386pe'; 1143 {$endif not x86_64} 1144 ExeCmd[1]:='ld '+targetopts+' $OPT $GCSECTIONS $MAP $STRIP $APPTYPE $ENTRY $IMAGEBASE $RELOC -o $EXE $RES'; 1145 DllCmd[1]:='ld '+targetopts+' $OPT $GCSECTIONS $MAP $STRIP --dll $APPTYPE $ENTRY $IMAGEBASE $RELOC -o $EXE $RES'; 1146 { ExeCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF'; 1147 use short forms to avoid 128 char limitation problem } 1148 ExeCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF'; 1149 ExeCmd[3]:='ld '+targetopts+' $OPT $STRIP $APPTYPE $ENTRY $IMAGEBASE -o $EXE $RES exp.$$$'; 1150 { DllCmd[2]:='dlltool --as $ASBIN --dllname $EXE --output-exp exp.$$$ $RELOC $DEF'; } 1151 DllCmd[2]:='dlltool -S $ASBIN -D $EXE -e exp.$$$ $RELOC $DEF'; 1152 DllCmd[3]:='ld '+targetopts+' $OPT $STRIP --dll $APPTYPE $ENTRY $IMAGEBASE -o $EXE $RES exp.$$$'; 1153 end; 1154 end; 1155 1156 1157 TExternalLinkerWin.WriteResponseFilenull1158 Function TExternalLinkerWin.WriteResponseFile(isdll:boolean) : Boolean; 1159 Var 1160 linkres : TLinkRes; 1161 HPath : TCmdStrListItem; 1162 s,s2 : TCmdStr; 1163 i : integer; 1164 begin 1165 WriteResponseFile:=False; 1166 1167 if (cs_profile in current_settings.moduleswitches) then 1168 begin 1169 SharedLibFiles.Concat('gmon'); 1170 SharedLibFiles.Concat('c'); 1171 SharedLibFiles.Concat('gcc'); 1172 SharedLibFiles.Concat('kernel32'); 1173 end; 1174 1175 { Open link.res file } 1176 LinkRes:=TLinkres.Create(outputexedir+Info.ResName,true); 1177 with linkres do 1178 begin 1179 { Write path to search libraries } 1180 HPath:=TCmdStrListItem(current_module.locallibrarysearchpath.First); 1181 while assigned(HPath) do 1182 begin 1183 Add('SEARCH_DIR("'+HPath.Str+'")'); 1184 HPath:=TCmdStrListItem(HPath.Next); 1185 end; 1186 HPath:=TCmdStrListItem(LibrarySearchPath.First); 1187 while assigned(HPath) do 1188 begin 1189 Add('SEARCH_DIR("'+HPath.Str+'")'); 1190 HPath:=TCmdStrListItem(HPath.Next); 1191 end; 1192 1193 { add objectfiles, start with prt0 always } 1194 { profiling of shared libraries is currently not supported } 1195 if not ObjectFiles.Empty then 1196 begin 1197 Add('INPUT('); 1198 while not ObjectFiles.Empty do 1199 begin 1200 s:=ObjectFiles.GetFirst; 1201 if s<>'' then 1202 AddFileName(MaybeQuoted(s)); 1203 end; 1204 Add(')'); 1205 end; 1206 1207 { Write staticlibraries } 1208 if (not StaticLibFiles.Empty) then 1209 begin 1210 Add('GROUP('); 1211 While not StaticLibFiles.Empty do 1212 begin 1213 S:=StaticLibFiles.GetFirst; 1214 AddFileName(MaybeQuoted(s)); 1215 end; 1216 Add(')'); 1217 end; 1218 1219 { Write sharedlibraries (=import libraries) } 1220 if not SharedLibFiles.Empty then 1221 begin 1222 Add('INPUT(') ; 1223 While not SharedLibFiles.Empty do 1224 begin 1225 S:=SharedLibFiles.GetFirst; 1226 if FindLibraryFile(s,target_info.staticClibprefix,target_info.staticClibext,s2) then 1227 begin 1228 Add(MaybeQuoted(s2)); 1229 continue; 1230 end; 1231 if pos(target_info.sharedlibprefix,s)=1 then 1232 s:=copy(s,length(target_info.sharedlibprefix)+1,255); 1233 i:=Pos(target_info.sharedlibext,S); 1234 if i>0 then 1235 Delete(S,i,255); 1236 Add('-l'+s); 1237 end; 1238 Add(')'); 1239 end; 1240 1241 Add('SEARCH_DIR("/usr/i686-pc-cygwin/lib"); SEARCH_DIR("/usr/lib"); SEARCH_DIR("/usr/lib/w32api");'); 1242 {$ifdef x86_64} 1243 Add('OUTPUT_FORMAT(pei-x86-64)'); 1244 {$else not 86_64} 1245 Add('OUTPUT_FORMAT(pei-i386)'); 1246 {$endif not x86_64} 1247 Add('ENTRY(_mainCRTStartup)'); 1248 Add('SECTIONS'); 1249 Add('{'); 1250 Add(' . = SIZEOF_HEADERS;'); 1251 Add(' . = ALIGN(__section_alignment__);'); 1252 Add(' .text __image_base__ + ( __section_alignment__ < 0x1000 ? . : __section_alignment__ ) :'); 1253 Add(' {'); 1254 Add(' __text_start__ = . ;'); 1255 Add(' *(.init)'); 1256 add(' *(.text .stub .text.* .gnu.linkonce.t.*)'); 1257 Add(' *(SORT(.text$*))'); 1258 Add(' *(.glue_7t)'); 1259 Add(' *(.glue_7)'); 1260 Add(' . = ALIGN(8);'); 1261 Add(' ___CTOR_LIST__ = .; __CTOR_LIST__ = . ;'); 1262 Add(' LONG (-1);'); 1263 {$ifdef x86_64} 1264 Add(' LONG (-1);'); 1265 {$endif x86_64} 1266 Add(' *(.ctors); *(.ctor); *(SORT(.ctors.*)); LONG (0);'); 1267 {$ifdef x86_64} 1268 Add(' LONG (0);'); 1269 {$endif x86_64} 1270 Add(' ___DTOR_LIST__ = .; __DTOR_LIST__ = . ;'); 1271 Add(' LONG (-1);'); 1272 {$ifdef x86_64} 1273 Add(' LONG (-1);'); 1274 {$endif x86_64} 1275 Add(' *(.dtors); *(.dtor); *(SORT(.dtors.*)); LONG (0);'); 1276 {$ifdef x86_64} 1277 Add(' LONG (0);'); 1278 {$endif x86_64} 1279 Add(' *(.fini)'); 1280 Add(' PROVIDE (etext = .);'); 1281 Add(' *(.gcc_except_table)'); 1282 Add(' }'); 1283 Add(' .data BLOCK(__section_alignment__) :'); 1284 Add(' {'); 1285 Add(' __data_start__ = . ;'); 1286 add(' *(.data .data.* .gnu.linkonce.d.* .fpc*)'); 1287 Add(' *(.data2)'); 1288 Add(' *(SORT(.data$*))'); 1289 Add(' *(.jcr)'); 1290 Add(' PROVIDE ('+target_info.Cprefix+'_tls_index = .);'); 1291 Add(' LONG (0);'); 1292 Add(' __data_end__ = . ;'); 1293 Add(' *(.data_cygwin_nocopy)'); 1294 Add(' }'); 1295 Add(' .rdata BLOCK(__section_alignment__) :'); 1296 Add(' {'); 1297 Add(' *(.rdata)'); 1298 Add(' *(.rdata.*)'); 1299 add(' *(.rodata .rodata.* .gnu.linkonce.r.*)'); 1300 Add(' *(SORT(.rdata$*))'); 1301 Add(' *(.eh_frame)'); 1302 Add(' ___RUNTIME_PSEUDO_RELOC_LIST__ = .;'); 1303 Add(' __RUNTIME_PSEUDO_RELOC_LIST__ = .;'); 1304 Add(' *(.rdata_runtime_pseudo_reloc)'); 1305 Add(' ___RUNTIME_PSEUDO_RELOC_LIST_END__ = .;'); 1306 Add(' __RUNTIME_PSEUDO_RELOC_LIST_END__ = .;'); 1307 Add(' }'); 1308 Add(' .pdata BLOCK(__section_alignment__) : { *(.pdata) }'); 1309 Add(' .bss BLOCK(__section_alignment__) :'); 1310 Add(' {'); 1311 Add(' __bss_start__ = . ;'); 1312 Add(' *(.bss .bss.* .gnu.linkonce.b.*)'); 1313 Add(' *(SORT(.bss$*))'); 1314 Add(' *(COMMON)'); 1315 Add(' __bss_end__ = . ;'); 1316 Add(' }'); 1317 Add(' .edata BLOCK(__section_alignment__) : { *(.edata) }'); 1318 Add(' .idata BLOCK(__section_alignment__) :'); 1319 Add(' {'); 1320 Add(' SORT(*)(.idata$2)'); 1321 Add(' SORT(*)(.idata$3)'); 1322 Add(' /* These zeroes mark the end of the import list. */'); 1323 Add(' LONG (0); LONG (0); LONG (0); LONG (0); LONG (0);'); 1324 Add(' SORT(*)(.idata$4)'); 1325 Add(' SORT(*)(.idata$5)'); 1326 Add(' SORT(*)(.idata$6)'); 1327 Add(' SORT(*)(.idata$7)'); 1328 Add(' }'); 1329 Add(' .CRT BLOCK(__section_alignment__) :'); 1330 Add(' {'); 1331 Add(' ___crt_xc_start__ = . ;'); 1332 Add(' *(SORT(.CRT$XC*)) /* C initialization */'); 1333 Add(' ___crt_xc_end__ = . ;'); 1334 Add(' ___crt_xi_start__ = . ;'); 1335 Add(' *(SORT(.CRT$XI*)) /* C++ initialization */'); 1336 Add(' ___crt_xi_end__ = . ;'); 1337 Add(' ___crt_xl_start__ = . ;'); 1338 Add(' *(SORT(.CRT$XL*)) /* TLS callbacks */'); 1339 Add(' /* ___crt_xl_end__ is defined in the TLS Directory support code */'); 1340 Add(' PROVIDE (___crt_xl_end__ = .);'); 1341 Add(' ___crt_xp_start__ = . ;'); 1342 Add(' *(SORT(.CRT$XP*)) /* Pre-termination */'); 1343 Add(' ___crt_xp_end__ = . ;'); 1344 Add(' ___crt_xt_start__ = . ;'); 1345 Add(' *(SORT(.CRT$XT*)) /* Termination */'); 1346 Add(' ___crt_xt_end__ = . ;'); 1347 Add(' }'); 1348 Add(' .tls BLOCK(__section_alignment__) :'); 1349 Add(' {'); 1350 Add(' ___tls_start__ = . ;'); 1351 Add(' *(.tls .tls.*)'); 1352 Add(' *(.tls$)'); 1353 Add(' *(SORT(.tls$*))'); 1354 Add(' ___tls_end__ = . ;'); 1355 Add(' }'); 1356 Add(' .rsrc BLOCK(__section_alignment__) :'); 1357 Add(' {'); 1358 Add(' *(.rsrc)'); 1359 Add(' *(SORT(.rsrc$*))'); 1360 Add(' }'); 1361 Add(' .reloc BLOCK(__section_alignment__) : { *(.reloc) }'); 1362 Add(' .stab BLOCK(__section_alignment__) (NOLOAD) : { *(.stab) }'); 1363 Add(' .stabstr BLOCK(__section_alignment__) (NOLOAD) : { *(.stabstr) }'); 1364 Add(' .debug_aranges BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_aranges) }'); 1365 Add(' .debug_pubnames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_pubnames) }'); 1366 Add(' .debug_info BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_info) *(.gnu.linkonce.wi.*) }'); 1367 Add(' .debug_abbrev BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_abbrev) }'); 1368 Add(' .debug_line BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_line) }'); 1369 Add(' .debug_frame BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_frame) }'); 1370 Add(' .debug_str BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_str) }'); 1371 Add(' .debug_loc BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_loc) }'); 1372 Add(' .debug_macinfo BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_macinfo) }'); 1373 Add(' .debug_weaknames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_weaknames) }'); 1374 Add(' .debug_funcnames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_funcnames) }'); 1375 Add(' .debug_typenames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_typenames) }'); 1376 Add(' .debug_varnames BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_varnames) }'); 1377 Add(' .debug_ranges BLOCK(__section_alignment__) (NOLOAD) : { *(.debug_ranges) }'); 1378 Add('}'); 1379 1380 { Write and Close response } 1381 writetodisk; 1382 Free; 1383 end; 1384 1385 WriteResponseFile:=True; 1386 end; 1387 1388 TExternalLinkerWin.MakeExecutablenull1389 function TExternalLinkerWin.MakeExecutable:boolean; 1390 var 1391 MapStr, 1392 binstr, 1393 cmdstr : TCmdStr; 1394 success : boolean; 1395 cmds,i : longint; 1396 AsBinStr : string[80]; 1397 GCSectionsStr, 1398 StripStr, 1399 RelocStr, 1400 AppTypeStr, 1401 EntryStr, 1402 ImageBaseStr : string[40]; 1403 begin 1404 if not(cs_link_nolink in current_settings.globalswitches) then 1405 Message1(exec_i_linking,current_module.exefilename); 1406 1407 { Create some replacements } 1408 RelocStr:=''; 1409 AppTypeStr:=''; 1410 EntryStr:=''; 1411 ImageBaseStr:=''; 1412 StripStr:=''; 1413 MapStr:=''; 1414 GCSectionsStr:=''; 1415 AsBinStr:=FindUtil(utilsprefix+'as'); 1416 if RelocSection then 1417 RelocStr:='--base-file base.$$$'; 1418 if create_smartlink_sections then 1419 GCSectionsStr:='--gc-sections'; 1420 if target_info.system in systems_wince then 1421 AppTypeStr:='--subsystem wince' 1422 else 1423 begin 1424 if apptype=app_gui then 1425 AppTypeStr:='--subsystem windows'; 1426 end; 1427 if apptype=app_gui then 1428 EntryStr:='--entry=_WinMainCRTStartup' 1429 else 1430 EntryStr:='--entry=_mainCRTStartup'; 1431 if ImageBaseSetExplicity then 1432 ImageBaseStr:='--image-base=0x'+hexStr(imagebase, SizeOf(imagebase)*2); 1433 if (cs_link_strip in current_settings.globalswitches) then 1434 StripStr:='-s'; 1435 if (cs_link_map in current_settings.globalswitches) then 1436 MapStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename,'.map')); 1437 1438 { Write used files and libraries } 1439 WriteResponseFile(false); 1440 1441 { Call linker } 1442 success:=false; 1443 if RelocSection or (not Deffile.empty) then 1444 cmds:=3 1445 else 1446 cmds:=1; 1447 for i:=1 to cmds do 1448 begin 1449 SplitBinCmd(Info.ExeCmd[i],binstr,cmdstr); 1450 if binstr<>'' then 1451 begin 1452 Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename)); 1453 Replace(cmdstr,'$OPT',Info.ExtraOptions); 1454 Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); 1455 Replace(cmdstr,'$APPTYPE',AppTypeStr); 1456 Replace(cmdstr,'$ENTRY',EntryStr); 1457 Replace(cmdstr,'$ASBIN',AsbinStr); 1458 Replace(cmdstr,'$RELOC',RelocStr); 1459 Replace(cmdstr,'$IMAGEBASE',ImageBaseStr); 1460 Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); 1461 Replace(cmdstr,'$STRIP',StripStr); 1462 Replace(cmdstr,'$MAP',MapStr); 1463 if not DefFile.Empty then 1464 begin 1465 DefFile.WriteFile; 1466 Replace(cmdstr,'$DEF','-d '+maybequoted(deffile.fname)); 1467 end 1468 else 1469 Replace(cmdstr,'$DEF',''); 1470 success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,(i=1),false); 1471 if not success then 1472 break; 1473 end; 1474 end; 1475 1476 { Post process } 1477 if success then 1478 success:=PostProcessExecutable(current_module.exefilename,false); 1479 1480 { Remove ReponseFile } 1481 if (success) and not(cs_link_nolink in current_settings.globalswitches) then 1482 begin 1483 DeleteFile(outputexedir+Info.ResName); 1484 DeleteFile('base.$$$'); 1485 DeleteFile('exp.$$$'); 1486 DeleteFile('deffile.$$$'); 1487 end; 1488 1489 MakeExecutable:=success; { otherwise a recursive call to link method } 1490 end; 1491 1492 TExternalLinkerWin.MakeSharedLibrarynull1493 Function TExternalLinkerWin.MakeSharedLibrary:boolean; 1494 var 1495 MapStr, 1496 binstr, 1497 cmdstr : TCmdStr; 1498 success : boolean; 1499 cmds, 1500 i : longint; 1501 AsBinStr : string[80]; 1502 StripStr, 1503 GCSectionsStr, 1504 RelocStr, 1505 AppTypeStr, 1506 EntryStr, 1507 ImageBaseStr : string[40]; 1508 begin 1509 MakeSharedLibrary:=false; 1510 if not(cs_link_nolink in current_settings.globalswitches) then 1511 Message1(exec_i_linking,current_module.sharedlibfilename); 1512 1513 { Create some replacements } 1514 RelocStr:=''; 1515 AppTypeStr:=''; 1516 EntryStr:=''; 1517 ImageBaseStr:=''; 1518 StripStr:=''; 1519 MapStr:=''; 1520 GCSectionsStr:=''; 1521 AsBinStr:=FindUtil(utilsprefix+'as'); 1522 if RelocSection then 1523 RelocStr:='--base-file base.$$$'; 1524 if create_smartlink_sections then 1525 GCSectionsStr:='--gc-sections'; 1526 if apptype=app_gui then 1527 begin 1528 AppTypeStr:='--subsystem windows'; 1529 EntryStr:='--entry _DLLWinMainCRTStartup' 1530 end 1531 else 1532 EntryStr:='--entry _DLLMainCRTStartup'; 1533 if ImageBaseSetExplicity then 1534 ImageBaseStr:='--image-base=0x'+hexStr(imagebase, SizeOf(imagebase)*2); 1535 if (cs_link_strip in current_settings.globalswitches) then 1536 StripStr:='-s'; 1537 if (cs_link_map in current_settings.globalswitches) then 1538 MapStr:='-Map '+maybequoted(ChangeFileExt(current_module.exefilename,'.map')); 1539 1540 { Write used files and libraries } 1541 WriteResponseFile(true); 1542 1543 { Call linker } 1544 success:=false; 1545 if RelocSection or (not Deffile.empty) then 1546 cmds:=3 1547 else 1548 cmds:=1; 1549 for i:=1 to cmds do 1550 begin 1551 SplitBinCmd(Info.DllCmd[i],binstr,cmdstr); 1552 if binstr<>'' then 1553 begin 1554 Replace(cmdstr,'$EXE',maybequoted(current_module.sharedlibfilename)); 1555 Replace(cmdstr,'$OPT',Info.ExtraOptions); 1556 Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName)); 1557 Replace(cmdstr,'$APPTYPE',AppTypeStr); 1558 Replace(cmdstr,'$ENTRY',EntryStr); 1559 Replace(cmdstr,'$ASBIN',AsbinStr); 1560 Replace(cmdstr,'$RELOC',RelocStr); 1561 Replace(cmdstr,'$IMAGEBASE',ImageBaseStr); 1562 Replace(cmdstr,'$STRIP',StripStr); 1563 Replace(cmdstr,'$GCSECTIONS',GCSectionsStr); 1564 Replace(cmdstr,'$MAP',MapStr); 1565 if not DefFile.Empty then 1566 begin 1567 DefFile.WriteFile; 1568 Replace(cmdstr,'$DEF','-d '+maybequoted(deffile.fname)); 1569 end 1570 else 1571 Replace(cmdstr,'$DEF',''); 1572 success:=DoExec(FindUtil(utilsprefix+binstr),cmdstr,(i=1),false); 1573 if not success then 1574 break; 1575 end; 1576 end; 1577 1578 { Post process } 1579 if success then 1580 success:=PostProcessExecutable(current_module.sharedlibfilename,true); 1581 1582 { Remove ReponseFile } 1583 if (success) and not(cs_link_nolink in current_settings.globalswitches) then 1584 begin 1585 DeleteFile(outputexedir+Info.ResName); 1586 DeleteFile('base.$$$'); 1587 DeleteFile('exp.$$$'); 1588 DeleteFile('deffile.$$$'); 1589 end; 1590 MakeSharedLibrary:=success; { otherwise a recursive call to link method } 1591 end; 1592 1593 TExternalLinkerWin.postprocessexecutablenull1594 function TExternalLinkerWin.postprocessexecutable(const fn : string;isdll:boolean):boolean; 1595 type 1596 tdosheader = packed record 1597 e_magic : word; 1598 e_cblp : word; 1599 e_cp : word; 1600 e_crlc : word; 1601 e_cparhdr : word; 1602 e_minalloc : word; 1603 e_maxalloc : word; 1604 e_ss : word; 1605 e_sp : word; 1606 e_csum : word; 1607 e_ip : word; 1608 e_cs : word; 1609 e_lfarlc : word; 1610 e_ovno : word; 1611 e_res : array[0..3] of word; 1612 e_oemid : word; 1613 e_oeminfo : word; 1614 e_res2 : array[0..9] of word; 1615 e_lfanew : longint; 1616 end; 1617 psecfill=^TSecfill; 1618 TSecfill=record 1619 fillpos, 1620 fillsize : longint; 1621 next : psecfill; 1622 end; 1623 var 1624 f : file; 1625 cmdstr : string; 1626 dosheader : tdosheader; 1627 peheader : tcoffheader; 1628 peoptheader : tcoffpeoptheader; 1629 firstsecpos, 1630 maxfillsize, 1631 l,peheaderpos : longint; 1632 coffsec : tcoffsechdr; 1633 secroot,hsecroot : psecfill; 1634 zerobuf : pointer; 1635 begin 1636 postprocessexecutable:=false; 1637 { when -s is used or it's a dll then quit } 1638 if (cs_link_nolink in current_settings.globalswitches) then 1639 begin 1640 case apptype of 1641 app_native : 1642 cmdstr:='--subsystem native'; 1643 app_gui : 1644 cmdstr:='--subsystem gui'; 1645 app_cui : 1646 cmdstr:='--subsystem console'; 1647 end; 1648 if dllversion<>'' then 1649 cmdstr:=cmdstr+' --version '+dllversion; 1650 cmdstr:=cmdstr+' --input '+maybequoted(fn); 1651 cmdstr:=cmdstr+' --stack '+tostr(stacksize); 1652 if target_info.system in [system_i386_win32, system_i386_wdosx] then 1653 DoExec(FindUtil(utilsprefix+'postw32'),cmdstr,false,false); 1654 postprocessexecutable:=true; 1655 exit; 1656 end; 1657 { open file } 1658 assign(f,fn); 1659 {$push}{$I-} 1660 reset(f,1); 1661 if ioresult<>0 then 1662 Message1(execinfo_f_cant_open_executable,fn); 1663 { read headers } 1664 blockread(f,dosheader,sizeof(tdosheader)); 1665 peheaderpos:=dosheader.e_lfanew; 1666 { skip to headerpos and skip pe magic } 1667 seek(f,peheaderpos+4); 1668 blockread(f,peheader,sizeof(tcoffheader)); 1669 blockread(f,peoptheader,sizeof(tcoffpeoptheader)); 1670 { write info } 1671 Message1(execinfo_x_codesize,tostr(peoptheader.tsize)); 1672 Message1(execinfo_x_initdatasize,tostr(peoptheader.dsize)); 1673 Message1(execinfo_x_uninitdatasize,tostr(peoptheader.bsize)); 1674 { change stack size (PM) } 1675 { I am not sure that the default value is adequate !! } 1676 peoptheader.SizeOfStackReserve:=stacksize; 1677 if SetPEFlagsSetExplicity then 1678 peoptheader.LoaderFlags:=peflags; 1679 if ImageBaseSetExplicity then 1680 peoptheader.ImageBase:=imagebase; 1681 if MinStackSizeSetExplicity then 1682 peoptheader.SizeOfStackCommit:=minstacksize; 1683 if MaxStackSizeSetExplicity then 1684 peoptheader.SizeOfStackReserve:=maxstacksize; 1685 { change the header } 1686 { sub system } 1687 { gui=2 } 1688 { cui=3 } 1689 { wincegui=9 } 1690 if target_info.system in systems_wince then 1691 peoptheader.Subsystem:=9 1692 else 1693 case apptype of 1694 app_native : 1695 peoptheader.Subsystem:=1; 1696 app_gui : 1697 peoptheader.Subsystem:=2; 1698 app_cui : 1699 peoptheader.Subsystem:=3; 1700 end; 1701 if dllversion<>'' then 1702 begin 1703 peoptheader.MajorImageVersion:=dllmajor; 1704 peoptheader.MinorImageVersion:=dllminor; 1705 end; 1706 { reset timestamp } 1707 peheader.time:=0; 1708 { write header back, skip pe magic } 1709 seek(f,peheaderpos+4); 1710 blockwrite(f,peheader,sizeof(tcoffheader)); 1711 if ioresult<>0 then 1712 Message1(execinfo_f_cant_process_executable,fn); 1713 blockwrite(f,peoptheader,sizeof(tcoffpeoptheader)); 1714 if ioresult<>0 then 1715 Message1(execinfo_f_cant_process_executable,fn); 1716 { skip to headerpos and skip pe magic } 1717 seek(f,peheaderpos+4); 1718 blockread(f,peheader,sizeof(tcoffheader)); 1719 blockread(f,peoptheader,sizeof(tcoffpeoptheader)); 1720 { write the value after the change } 1721 Message1(execinfo_x_stackreserve,tostr(peoptheader.SizeOfStackReserve)); 1722 Message1(execinfo_x_stackcommit,tostr(peoptheader.SizeOfStackCommit)); 1723 { read section info } 1724 maxfillsize:=0; 1725 firstsecpos:=0; 1726 secroot:=nil; 1727 for l:=1 to peheader.nsects do 1728 begin 1729 blockread(f,coffsec,sizeof(tcoffsechdr)); 1730 if coffsec.datapos>0 then 1731 begin 1732 if secroot=nil then 1733 firstsecpos:=coffsec.datapos; 1734 new(hsecroot); 1735 hsecroot^.fillpos:=coffsec.datapos+coffsec.vsize; 1736 hsecroot^.fillsize:=coffsec.datasize-coffsec.vsize; 1737 hsecroot^.next:=secroot; 1738 secroot:=hsecroot; 1739 if secroot^.fillsize>maxfillsize then 1740 maxfillsize:=secroot^.fillsize; 1741 end; 1742 end; 1743 if firstsecpos>0 then 1744 begin 1745 l:=firstsecpos-filepos(f); 1746 if l>maxfillsize then 1747 maxfillsize:=l; 1748 end 1749 else 1750 l:=0; 1751 { get zero buffer } 1752 getmem(zerobuf,maxfillsize); 1753 fillchar(zerobuf^,maxfillsize,0); 1754 { zero from sectioninfo until first section } 1755 blockwrite(f,zerobuf^,l); 1756 { zero section alignments } 1757 while assigned(secroot) do 1758 begin 1759 seek(f,secroot^.fillpos); 1760 blockwrite(f,zerobuf^,secroot^.fillsize); 1761 hsecroot:=secroot; 1762 secroot:=secroot^.next; 1763 dispose(hsecroot); 1764 end; 1765 freemem(zerobuf,maxfillsize); 1766 close(f); 1767 {$pop} 1768 if ioresult<>0 then; 1769 postprocessexecutable:=true; 1770 end; 1771 1772 1773 procedure TExternalLinkerWin.InitSysInitUnitName; 1774 begin 1775 GlobalInitSysInitUnitName(self); 1776 end; 1777 1778 1779 {**************************************************************************** 1780 TDLLScannerWin 1781 ****************************************************************************} 1782 1783 procedure TDLLScannerWin.CheckDLLFunc(const dllname,funcname:string); 1784 var 1785 i : longint; 1786 ExtName : string; 1787 begin 1788 for i:=0 to current_module.dllscannerinputlist.count-1 do 1789 begin 1790 ExtName:=current_module.dllscannerinputlist.NameOfIndex(i); 1791 if (ExtName=funcname) then 1792 begin 1793 current_module.AddExternalImport(dllname,funcname,funcname,0,false,false); 1794 importfound:=true; 1795 current_module.dllscannerinputlist.Delete(i); 1796 exit; 1797 end; 1798 end; 1799 end; 1800 1801 TDLLScannerWin.scannull1802 function TDLLScannerWin.scan(const binname:string):boolean; 1803 var 1804 hs, 1805 dllname : TCmdStr; 1806 begin 1807 result:=false; 1808 { is there already an import library the we will use that one } 1809 if FindLibraryFile(binname,target_info.staticClibprefix,target_info.staticClibext,hs) then 1810 exit; 1811 { check if we can find the dll } 1812 hs:=binname; 1813 if ExtractFileExt(hs)='' then 1814 hs:=ChangeFileExt(hs,target_info.sharedlibext); 1815 if not FindDll(hs,dllname) then 1816 exit; 1817 importfound:=false; 1818 ReadDLLImports(dllname,@CheckDLLFunc); 1819 if importfound then 1820 current_module.dllscannerinputlist.Pack; 1821 result:=importfound; 1822 end; 1823 1824 {***************************************************************************** 1825 Initialize 1826 *****************************************************************************} 1827 1828 initialization 1829 RegisterLinker(ld_int_windows,TInternalLinkerWin); 1830 RegisterLinker(ld_windows,TExternalLinkerWin); 1831 {$ifdef i386} 1832 { Win32 } 1833 RegisterImport(system_i386_win32,TImportLibWin); 1834 RegisterExport(system_i386_win32,TExportLibWin); 1835 RegisterDLLScanner(system_i386_win32,TDLLScannerWin); 1836 RegisterRes(res_gnu_windres_info,TWinLikeResourceFile); 1837 RegisterTarget(system_i386_win32_info); 1838 { WinCE } 1839 RegisterImport(system_i386_wince,TImportLibWin); 1840 RegisterExport(system_i386_wince,TExportLibWin); 1841 RegisterDLLScanner(system_i386_wince,TDLLScannerWin); 1842 RegisterTarget(system_i386_wince_info); 1843 {$endif i386} 1844 {$ifdef x86_64} 1845 RegisterImport(system_x86_64_win64,TImportLibWin); 1846 RegisterExport(system_x86_64_win64,TExportLibWin); 1847 RegisterDLLScanner(system_x86_64_win64,TDLLScannerWin); 1848 RegisterRes(res_gnu_windres_info,TWinLikeResourceFile); 1849 RegisterRes(res_win64_gorc_info,TWinLikeResourceFile); 1850 RegisterTarget(system_x64_win64_info); 1851 {$endif x86_64} 1852 {$ifdef arm} 1853 RegisterImport(system_arm_wince,TImportLibWin); 1854 RegisterExport(system_arm_wince,TExportLibWin); 1855 RegisterRes(res_gnu_windres_info,TWinLikeResourceFile); 1856 RegisterTarget(system_arm_wince_info); 1857 {$endif arm} 1858 end. 1859