1 { 2 Copyright (c) 1998-2008 by Florian Klaempfl 3 4 Handles the parsing and loading of the modules (ppufiles) 5 6 This program is free software; you can redistribute it and/or modify 7 it under the terms of the GNU General Public License as published by 8 the Free Software Foundation; either version 2 of the License, or 9 (at your option) any later version. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 GNU General Public License for more details. 15 16 You should have received a copy of the GNU General Public License 17 along with this program; if not, write to the Free Software 18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 19 20 **************************************************************************** 21 } 22 unit pmodules; 23 24 {$i fpcdefs.inc} 25 26 interface 27 proc_unitnull28 function proc_unit:boolean; 29 procedure proc_package; 30 procedure proc_program(islibrary : boolean); 31 32 implementation 33 34 uses 35 SysUtils, 36 globtype,systems,tokens, 37 cutils,cfileutl,cclasses,comphook, 38 globals,verbose,fmodule,finput,fppu,globstat,fpcp,fpkg, 39 symconst,symbase,symtype,symdef,symsym,symtable,symcreat, 40 wpoinfo, 41 aasmtai,aasmdata,aasmbase,aasmcpu, 42 cgbase,ngenutil, 43 nbas,nutils,ncgutil, 44 link,assemble,import,export,gendef,ppu,comprsrc,dbgbase, 45 cresstr,procinfo, 46 objcgutl, 47 pkgutil, 48 wpobase, 49 scanner,pbase,pexpr,psystem,psub,pdecsub,pgenutil,pparautl,ncgvmt,ncgrtti, 50 cpuinfo; 51 52 53 procedure create_objectfile; 54 var 55 DLLScanner : TDLLScanner; 56 s : string; 57 KeepShared : TCmdStrList; 58 begin 59 { try to create import entries from system dlls } 60 if (tf_has_dllscanner in target_info.flags) and 61 (not current_module.linkOtherSharedLibs.Empty) then 62 begin 63 { Init DLLScanner } 64 if assigned(CDLLScanner[target_info.system]) then 65 DLLScanner:=CDLLScanner[target_info.system].Create 66 else 67 internalerror(200104121); 68 KeepShared:=TCmdStrList.Create; 69 { Walk all shared libs } 70 While not current_module.linkOtherSharedLibs.Empty do 71 begin 72 S:=current_module.linkOtherSharedLibs.Getusemask(link_always); 73 if not DLLScanner.scan(s) then 74 KeepShared.Concat(s); 75 end; 76 DLLscanner.Free; 77 { Recreate import section } 78 if (target_info.system in [system_i386_win32,system_i386_wdosx]) then 79 begin 80 if assigned(current_asmdata.asmlists[al_imports]) then 81 current_asmdata.asmlists[al_imports].clear 82 else 83 current_asmdata.asmlists[al_imports]:=TAsmList.Create; 84 importlib.generatelib; 85 end; 86 { Readd the not processed files } 87 while not KeepShared.Empty do 88 begin 89 s:=KeepShared.GetFirst; 90 current_module.linkOtherSharedLibs.add(s,link_always); 91 end; 92 KeepShared.Free; 93 end; 94 95 { allow a target-specific pass over all assembler code (used by LLVM 96 to insert type definitions } 97 cnodeutils.InsertObjectInfo; 98 99 { Start and end module debuginfo, at least required for stabs 100 to insert n_sourcefile lines } 101 if (cs_debuginfo in current_settings.moduleswitches) or 102 (cs_use_lineinfo in current_settings.globalswitches) then 103 current_debuginfo.insertmoduleinfo; 104 105 { create the .s file and assemble it } 106 if not(create_smartlink_library) or not(tf_no_objectfiles_when_smartlinking in target_info.flags) then 107 GenerateAsm(false); 108 109 { Also create a smartlinked version ? } 110 if create_smartlink_library then 111 begin 112 GenerateAsm(true); 113 if (af_needar in target_asm.flags) then 114 Linker.MakeStaticLibrary; 115 end; 116 117 { resource files } 118 CompileResourceFiles; 119 end; 120 121 122 procedure insertobjectfile; 123 { Insert the used object file for this unit in the used list for this unit } 124 begin 125 current_module.linkunitofiles.add(current_module.objfilename,link_static); 126 current_module.flags:=current_module.flags or uf_static_linked; 127 128 if create_smartlink_library then 129 begin 130 current_module.linkunitstaticlibs.add(current_module.staticlibfilename ,link_smart); 131 current_module.flags:=current_module.flags or uf_smart_linked; 132 end; 133 end; 134 135 136 procedure create_dwarf_frame; 137 begin 138 { Dwarf conflicts with smartlinking in separate .a files } 139 if create_smartlink_library then 140 exit; 141 { Call frame information } 142 { MWE: we write our own info, so dwarf asm support is not really needed } 143 { if (af_supports_dwarf in target_asm.flags) and } 144 { CFI is currently broken for Darwin } 145 if not(target_info.system in systems_darwin) and 146 ( 147 (tf_needs_dwarf_cfi in target_info.flags) or 148 (target_dbg.id in [dbg_dwarf2, dbg_dwarf3]) 149 ) then 150 begin 151 current_asmdata.asmlists[al_dwarf_frame].Free; 152 current_asmdata.asmlists[al_dwarf_frame] := TAsmList.create; 153 current_asmdata.asmcfi.generate_code(current_asmdata.asmlists[al_dwarf_frame]); 154 end; 155 end; 156 CheckResourcesUsednull157 Function CheckResourcesUsed : boolean; 158 var 159 hp : tused_unit; 160 found : Boolean; 161 begin 162 CheckResourcesUsed:=tf_has_winlike_resources in target_info.flags; 163 if not CheckResourcesUsed then exit; 164 165 hp:=tused_unit(usedunits.first); 166 found:=((current_module.flags and uf_has_resourcefiles)=uf_has_resourcefiles); 167 If not found then 168 While Assigned(hp) and not found do 169 begin 170 Found:=((hp.u.flags and uf_has_resourcefiles)=uf_has_resourcefiles); 171 hp:=tused_unit(hp.next); 172 end; 173 CheckResourcesUsed:=found; 174 end; 175 AddUnitnull176 function AddUnit(const s:string;addasused:boolean): tppumodule; 177 var 178 hp : tppumodule; 179 unitsym : tunitsym; 180 begin 181 { load unit } 182 hp:=registerunit(current_module,s,''); 183 hp.loadppu; 184 hp.adddependency(current_module); 185 { add to symtable stack } 186 symtablestack.push(hp.globalsymtable); 187 if (m_mac in current_settings.modeswitches) and 188 assigned(hp.globalmacrosymtable) then 189 macrosymtablestack.push(hp.globalmacrosymtable); 190 { insert unitsym } 191 unitsym:=cunitsym.create(hp.modulename^,hp); 192 inc(unitsym.refs); 193 tabstractunitsymtable(current_module.localsymtable).insertunit(unitsym); 194 if addasused then 195 { add to used units } 196 current_module.addusedunit(hp,false,unitsym); 197 result:=hp; 198 end; 199 200 AddUnitnull201 function AddUnit(const s:string):tppumodule; 202 begin 203 result:=AddUnit(s,true); 204 end; 205 206 207 procedure maybeloadvariantsunit; 208 var 209 hp : tmodule; 210 begin 211 { Do we need the variants unit? Skip this 212 for VarUtils unit for bootstrapping } 213 if (current_module.flags and uf_uses_variants=0) or 214 (current_module.modulename^='VARUTILS') then 215 exit; 216 { Variants unit already loaded? } 217 hp:=tmodule(loaded_units.first); 218 while assigned(hp) do 219 begin 220 if hp.modulename^='VARIANTS' then 221 exit; 222 hp:=tmodule(hp.next); 223 end; 224 { Variants unit is not loaded yet, load it now } 225 Message(parser_w_implicit_uses_of_variants_unit); 226 AddUnit('variants'); 227 end; 228 229 MaybeRemoveResUnitnull230 function MaybeRemoveResUnit : boolean; 231 var 232 resources_used : boolean; 233 hp : tmodule; 234 uu : tused_unit; 235 unitname : shortstring; 236 begin 237 { We simply remove the unit from: 238 - usedunit list, so that things like init/finalization table won't 239 contain references to this unit 240 - loaded_units list, so that the unit object file doesn't get linked 241 with the executable. } 242 { Note: on windows we always need resources! } 243 resources_used:=(target_info.system in systems_all_windows) 244 or CheckResourcesUsed; 245 if (not resources_used) and (tf_has_winlike_resources in target_info.flags) then 246 begin 247 { resources aren't used, so we don't need this unit } 248 if target_res.id=res_ext then 249 unitname:='FPEXTRES' 250 else 251 unitname:='FPINTRES'; 252 Message1(unit_u_unload_resunit,unitname); 253 { find the module } 254 hp:=tmodule(loaded_units.first); 255 while assigned(hp) do 256 begin 257 if hp.is_unit and (hp.modulename^=unitname) then break; 258 hp:=tmodule(hp.next); 259 end; 260 if not assigned(hp) then 261 internalerror(200801071); 262 { find its tused_unit in the global list } 263 uu:=tused_unit(usedunits.first); 264 while assigned(uu) do 265 begin 266 if uu.u=hp then break; 267 uu:=tused_unit(uu.next); 268 end; 269 if not assigned(uu) then 270 internalerror(200801072); 271 { remove the tused_unit } 272 usedunits.Remove(uu); 273 uu.Free; 274 { remove the module } 275 loaded_units.Remove(hp); 276 unloaded_units.Concat(hp); 277 end; 278 MaybeRemoveResUnit:=resources_used; 279 end; 280 281 282 procedure loadsystemunit; 283 begin 284 { we are going to rebuild the symtablestack, clear it first } 285 symtablestack.clear; 286 macrosymtablestack.clear; 287 288 { macro symtable } 289 macrosymtablestack.push(initialmacrosymtable); 290 291 { are we compiling the system unit? } 292 if (cs_compilesystem in current_settings.moduleswitches) then 293 begin 294 systemunit:=tglobalsymtable(current_module.localsymtable); 295 { create system defines } 296 create_intern_types; 297 create_intern_symbols; 298 { Set the owner of errorsym and errortype to symtable to 299 prevent crashes when accessing .owner } 300 generrorsym.owner:=systemunit; 301 generrordef.owner:=systemunit; 302 exit; 303 end; 304 305 { insert the system unit, it is allways the first. Load also the 306 internal types from the system unit } 307 AddUnit('system'); 308 systemunit:=tglobalsymtable(symtablestack.top); 309 load_intern_types; 310 311 { Set the owner of errorsym and errortype to symtable to 312 prevent crashes when accessing .owner } 313 generrorsym.owner:=systemunit; 314 generrordef.owner:=systemunit; 315 end; 316 317 318 procedure loaddefaultunits; 319 begin 320 { Units only required for main module } 321 if not(current_module.is_unit) then 322 begin 323 { Heaptrc unit, load heaptrace before any other units especially objpas } 324 if (cs_use_heaptrc in current_settings.globalswitches) then 325 AddUnit('heaptrc'); 326 { Valgrind requires c memory manager } 327 if (cs_gdb_valgrind in current_settings.globalswitches) then 328 AddUnit('cmem'); 329 { Lineinfo unit } 330 if (cs_use_lineinfo in current_settings.globalswitches) then begin 331 case target_dbg.id of 332 dbg_stabs: 333 AddUnit('lineinfo'); 334 dbg_stabx: 335 AddUnit('lnfogdb'); 336 else 337 AddUnit('lnfodwrf'); 338 end; 339 end; 340 {$ifdef cpufpemu} 341 { Floating point emulation unit? 342 softfpu must be in the system unit anyways (FK) 343 if (cs_fp_emulation in current_settings.moduleswitches) and not(target_info.system in system_wince) then 344 AddUnit('softfpu'); 345 } 346 {$endif cpufpemu} 347 { Which kind of resource support? 348 Note: if resources aren't used this unit will be removed later, 349 otherwise we need it here since it must be loaded quite early } 350 if (tf_has_winlike_resources in target_info.flags) then 351 if target_res.id=res_ext then 352 AddUnit('fpextres') 353 else 354 AddUnit('fpintres'); 355 end 356 else if (cs_checkpointer in current_settings.localswitches) then 357 AddUnit('heaptrc'); 358 { Objpas unit? } 359 if m_objpas in current_settings.modeswitches then 360 AddUnit('objpas'); 361 362 { Macpas unit? } 363 if m_mac in current_settings.modeswitches then 364 AddUnit('macpas'); 365 366 if m_iso in current_settings.modeswitches then 367 AddUnit('iso7185'); 368 369 if m_extpas in current_settings.modeswitches then 370 begin 371 { basic procedures for Extended Pascal are for now provided by the iso unit } 372 AddUnit('iso7185'); 373 AddUnit('extpas'); 374 end; 375 376 { blocks support? } 377 if m_blocks in current_settings.modeswitches then 378 AddUnit('blockrtl'); 379 380 { default char=widechar? } 381 if m_default_unicodestring in current_settings.modeswitches then 382 AddUnit('uuchar'); 383 384 { Objective-C support unit? } 385 if (m_objectivec1 in current_settings.modeswitches) then 386 begin 387 { interface to Objective-C run time } 388 AddUnit('objc'); 389 loadobjctypes; 390 { NSObject } 391 if not(current_module.is_unit) or 392 (current_module.modulename^<>'OBJCBASE') then 393 AddUnit('objcbase'); 394 end; 395 { Profile unit? Needed for go32v2 only } 396 if (cs_profile in current_settings.moduleswitches) and 397 (target_info.system in [system_i386_go32v2,system_i386_watcom]) then 398 AddUnit('profile'); 399 if (cs_load_fpcylix_unit in current_settings.globalswitches) then 400 begin 401 AddUnit('fpcylix'); 402 AddUnit('dynlibs'); 403 end; 404 {$push} 405 {$warn 6018 off} { Unreachable code due to compile time evaluation } 406 { CPU targets with microcontroller support can add a controller specific unit } 407 if ControllerSupport and (target_info.system in systems_embedded) and 408 (current_settings.controllertype<>ct_none) and 409 (embedded_controllers[current_settings.controllertype].controllerunitstr<>'') then 410 AddUnit(embedded_controllers[current_settings.controllertype].controllerunitstr); 411 {$pop} 412 end; 413 414 415 procedure loadautounits; 416 var 417 hs,s : string; 418 begin 419 hs:=autoloadunits; 420 repeat 421 s:=GetToken(hs,','); 422 if s='' then 423 break; 424 AddUnit(s); 425 until false; 426 end; 427 428 429 procedure loadunits(preservest:tsymtable); 430 var 431 s,sorg : ansistring; 432 fn : string; 433 pu,pu2 : tused_unit; 434 hp2 : tmodule; 435 unitsym : tunitsym; 436 filepos : tfileposinfo; 437 begin 438 consume(_USES); 439 repeat 440 s:=pattern; 441 sorg:=orgpattern; 442 filepos:=current_tokenpos; 443 consume(_ID); 444 while token=_POINT do 445 begin 446 consume(_POINT); 447 s:=s+'.'+pattern; 448 sorg:=sorg+'.'+orgpattern; 449 consume(_ID); 450 end; 451 { support "<unit> in '<file>'" construct, but not for tp7 } 452 fn:=''; 453 if not(m_tp7 in current_settings.modeswitches) and 454 try_to_consume(_OP_IN) then 455 fn:=FixFileName(get_stringconst); 456 { Give a warning if lineinfo is loaded } 457 if s='LINEINFO' then 458 begin 459 Message(parser_w_no_lineinfo_use_switch); 460 if (target_dbg.id in [dbg_dwarf2, dbg_dwarf3]) then 461 s := 'LNFODWRF'; 462 sorg := s; 463 end; 464 { Give a warning if objpas is loaded } 465 if s='OBJPAS' then 466 Message(parser_w_no_objpas_use_mode); 467 { Using the unit itself is not possible } 468 if (s<>current_module.modulename^) then 469 begin 470 { check if the unit is already used } 471 hp2:=nil; 472 pu:=tused_unit(current_module.used_units.first); 473 while assigned(pu) do 474 begin 475 if (pu.u.modulename^=s) then 476 begin 477 hp2:=pu.u; 478 break; 479 end; 480 pu:=tused_unit(pu.next); 481 end; 482 if not assigned(hp2) then 483 hp2:=registerunit(current_module,sorg,fn) 484 else 485 Message1(sym_e_duplicate_id,s); 486 { Create unitsym, we need to use the name as specified, we 487 can not use the modulename because that can be different 488 when -Un is used } 489 current_tokenpos:=filepos; 490 unitsym:=cunitsym.create(sorg,nil); 491 { the current module uses the unit hp2 } 492 current_module.addusedunit(hp2,true,unitsym); 493 end 494 else 495 Message1(sym_e_duplicate_id,s); 496 if token=_COMMA then 497 begin 498 pattern:=''; 499 consume(_COMMA); 500 end 501 else 502 break; 503 until false; 504 505 { Load the units } 506 pu:=tused_unit(current_module.used_units.first); 507 while assigned(pu) do 508 begin 509 { Only load the units that are in the current 510 (interface/implementation) uses clause } 511 if pu.in_uses and 512 (pu.in_interface=current_module.in_interface) then 513 begin 514 tppumodule(pu.u).loadppu; 515 { is our module compiled? then we can stop } 516 if current_module.state=ms_compiled then 517 exit; 518 { add this unit to the dependencies } 519 pu.u.adddependency(current_module); 520 { save crc values } 521 pu.checksum:=pu.u.crc; 522 pu.interface_checksum:=pu.u.interface_crc; 523 pu.indirect_checksum:=pu.u.indirect_crc; 524 if tppumodule(pu.u).nsprefix<>'' then 525 begin 526 { use the name as declared in the uses section for -Un } 527 sorg:=tppumodule(pu.u).nsprefix+'.'+pu.unitsym.realname; 528 s:=upper(sorg); 529 { check whether the module was already loaded } 530 hp2:=nil; 531 pu2:=tused_unit(current_module.used_units.first); 532 while assigned(pu2) and (pu2<>pu) do 533 begin 534 if (pu2.u.modulename^=s) then 535 begin 536 hp2:=pu.u; 537 break; 538 end; 539 pu2:=tused_unit(pu2.next); 540 end; 541 if assigned(hp2) then 542 begin 543 MessagePos1(pu.unitsym.fileinfo,sym_e_duplicate_id,s); 544 pu:=tused_unit(pu.next); 545 continue; 546 end; 547 { update unitsym now that we have access to the full name } 548 pu.unitsym.free; 549 pu.unitsym:=cunitsym.create(sorg,pu.u); 550 end 551 else 552 begin 553 { connect unitsym to the module } 554 pu.unitsym.module:=pu.u; 555 pu.unitsym.register_sym; 556 end; 557 tabstractunitsymtable(current_module.localsymtable).insertunit(pu.unitsym); 558 { add to symtable stack } 559 if assigned(preservest) then 560 symtablestack.pushafter(pu.u.globalsymtable,preservest) 561 else 562 symtablestack.push(pu.u.globalsymtable); 563 if (m_mac in current_settings.modeswitches) and 564 assigned(pu.u.globalmacrosymtable) then 565 macrosymtablestack.push(pu.u.globalmacrosymtable); 566 { check hints } 567 pu.check_hints; 568 end; 569 pu:=tused_unit(pu.next); 570 end; 571 end; 572 573 574 procedure reset_all_defs; 575 begin 576 if assigned(current_module.wpoinfo) then 577 current_module.wpoinfo.resetdefs; 578 end; 579 580 581 procedure free_localsymtables(st:TSymtable); 582 var 583 i : longint; 584 def : tstoreddef; 585 pd : tprocdef; 586 begin 587 for i:=0 to st.DefList.Count-1 do 588 begin 589 def:=tstoreddef(st.DefList[i]); 590 if def.typ=procdef then 591 begin 592 pd:=tprocdef(def); 593 if assigned(pd.localst) and 594 (pd.localst.symtabletype<>staticsymtable) and 595 not(po_inline in pd.procoptions) then 596 begin 597 free_localsymtables(pd.localst); 598 pd.localst.free; 599 pd.localst:=nil; 600 end; 601 pd.freeimplprocdefinfo; 602 pd.done_paraloc_info(calleeside); 603 end; 604 end; 605 end; 606 607 608 procedure free_unregistered_localsymtable_elements; 609 var 610 i: longint; 611 def: tdef; 612 sym: tsym; 613 begin 614 for i:=current_module.localsymtable.deflist.count-1 downto 0 do 615 begin 616 def:=tdef(current_module.localsymtable.deflist[i]); 617 { this also frees def, as the defs are owned by the symtable } 618 if not def.is_registered and 619 not(df_not_registered_no_free in def.defoptions) then 620 begin 621 { if it's a procdef, unregister it from its procsym first, 622 unless that sym hasn't been registered either (it's possible 623 to have one overload in the interface and another in the 624 implementation) } 625 if (def.typ=procdef) and 626 tprocdef(def).procsym.is_registered then 627 tprocsym(tprocdef(def).procsym).ProcdefList.Remove(def); 628 current_module.localsymtable.deletedef(def); 629 end; 630 end; 631 { from high to low so we hopefully have moves of less data } 632 for i:=current_module.localsymtable.symlist.count-1 downto 0 do 633 begin 634 sym:=tsym(current_module.localsymtable.symlist[i]); 635 { this also frees sym, as the symbols are owned by the symtable } 636 if not sym.is_registered then 637 current_module.localsymtable.Delete(sym); 638 end; 639 end; 640 641 642 procedure setupglobalswitches; 643 begin 644 if (cs_create_pic in current_settings.moduleswitches) then 645 begin 646 def_system_macro('FPC_PIC'); 647 def_system_macro('PIC'); 648 end; 649 end; 650 651 create_main_procnull652 function create_main_proc(const name:string;potype:tproctypeoption;st:TSymtable):tcgprocinfo; 653 var 654 ps : tprocsym; 655 pd : tprocdef; 656 begin 657 { there should be no current_procinfo available } 658 if assigned(current_procinfo) then 659 internalerror(200304275); 660 {Generate a procsym for main} 661 ps:=cprocsym.create('$'+name); 662 { always register the symbol } 663 ps.register_sym; 664 { main are allways used } 665 inc(ps.refs); 666 st.insert(ps); 667 pd:=tprocdef(cnodeutils.create_main_procdef(target_info.cprefix+name,potype,ps)); 668 { We don't need a local symtable, change it into the static symtable } 669 if not (potype in [potype_mainstub,potype_pkgstub]) then 670 begin 671 pd.localst.free; 672 pd.localst:=st; 673 end 674 else if (potype=potype_pkgstub) and 675 (target_info.system in systems_all_windows+systems_nativent) then 676 pd.proccalloption:=pocall_stdcall 677 else 678 pd.proccalloption:=pocall_cdecl; 679 handle_calling_convention(pd,hcc_default_actions_impl); 680 { set procinfo and current_procinfo.procdef } 681 result:=tcgprocinfo(cprocinfo.create(nil)); 682 result.procdef:=pd; 683 { main proc does always a call e.g. to init system unit } 684 if potype<>potype_pkgstub then 685 include(result.flags,pi_do_call); 686 end; 687 688 689 procedure release_main_proc(pi:tcgprocinfo); 690 begin 691 { remove localst as it was replaced by staticsymtable } 692 pi.procdef.localst:=nil; 693 { remove procinfo } 694 current_module.procinfo:=nil; 695 pi.free; 696 pi:=nil; 697 end; 698 699 700 701 { Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it } 702 703 procedure maybe_load_got; 704 {$if defined(i386) or defined (sparcgen)} 705 var 706 gotvarsym : tstaticvarsym; 707 {$endif i386 or sparcgen} 708 begin 709 {$if defined(i386) or defined(sparcgen)} 710 if (cs_create_pic in current_settings.moduleswitches) and 711 (tf_pic_uses_got in target_info.flags) then 712 begin 713 { insert symbol for got access in assembler code} 714 gotvarsym:=cstaticvarsym.create('_GLOBAL_OFFSET_TABLE_', 715 vs_value,voidpointertype,[vo_is_external]); 716 gotvarsym.set_mangledname('_GLOBAL_OFFSET_TABLE_'); 717 current_module.localsymtable.insert(gotvarsym); 718 { avoid unnecessary warnings } 719 gotvarsym.varstate:=vs_read; 720 gotvarsym.refs:=1; 721 end; 722 {$endif i386 or sparcgen} 723 end; 724 gen_implicit_initfinalnull725 function gen_implicit_initfinal(flag:word;st:TSymtable):tcgprocinfo; 726 begin 727 { create procdef } 728 case flag of 729 uf_init : 730 begin 731 result:=create_main_proc(make_mangledname('',current_module.localsymtable,'init_implicit$'),potype_unitinit,st); 732 result.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,'')); 733 end; 734 uf_finalize : 735 begin 736 result:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize_implicit$'),potype_unitfinalize,st); 737 result.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,'')); 738 if (not current_module.is_unit) then 739 result.procdef.aliasnames.insert('PASCALFINALIZE'); 740 end; 741 else 742 internalerror(200304253); 743 end; 744 result.code:=cnothingnode.create; 745 end; 746 747 748 procedure copy_macro(p:TObject; arg:pointer); 749 begin 750 current_module.globalmacrosymtable.insert(tmacro(p).getcopy); 751 end; 752 try_consume_hintdirectivenull753 function try_consume_hintdirective(var moduleopt:tmoduleoptions; var deprecatedmsg:pshortstring):boolean; 754 var 755 deprecated_seen, 756 last_is_deprecated:boolean; 757 begin 758 try_consume_hintdirective:=false; 759 deprecated_seen:=false; 760 repeat 761 last_is_deprecated:=false; 762 case idtoken of 763 _LIBRARY : 764 begin 765 include(moduleopt,mo_hint_library); 766 try_consume_hintdirective:=true; 767 end; 768 _DEPRECATED : 769 begin 770 { allow deprecated only once } 771 if deprecated_seen then 772 break; 773 include(moduleopt,mo_hint_deprecated); 774 try_consume_hintdirective:=true; 775 last_is_deprecated:=true; 776 deprecated_seen:=true; 777 end; 778 _EXPERIMENTAL : 779 begin 780 include(moduleopt,mo_hint_experimental); 781 try_consume_hintdirective:=true; 782 end; 783 _PLATFORM : 784 begin 785 include(moduleopt,mo_hint_platform); 786 try_consume_hintdirective:=true; 787 end; 788 _UNIMPLEMENTED : 789 begin 790 include(moduleopt,mo_hint_unimplemented); 791 try_consume_hintdirective:=true; 792 end; 793 else 794 break; 795 end; 796 consume(Token); 797 { handle deprecated message } 798 if ((token=_CSTRING) or (token=_CCHAR)) and last_is_deprecated then 799 begin 800 if deprecatedmsg<>nil then 801 internalerror(201001221); 802 if token=_CSTRING then 803 deprecatedmsg:=stringdup(cstringpattern) 804 else 805 deprecatedmsg:=stringdup(pattern); 806 consume(token); 807 include(moduleopt,mo_has_deprecated_msg); 808 end; 809 until false; 810 end; 811 812 813 {$ifdef jvm} 814 procedure addmoduleclass; 815 var 816 def: tobjectdef; 817 typesym: ttypesym; 818 begin 819 { java_jlobject may not have been parsed yet (system unit); in any 820 case, we only use this to refer to the class type, so inheritance 821 does not matter } 822 def:=cobjectdef.create(odt_javaclass,'__FPC_JVM_Module_Class_Alias$',nil,true); 823 include(def.objectoptions,oo_is_external); 824 include(def.objectoptions,oo_is_sealed); 825 def.objextname:=stringdup(current_module.realmodulename^); 826 typesym:=ctypesym.create('__FPC_JVM_Module_Class_Alias$',def); 827 symtablestack.top.insert(typesym); 828 end; 829 {$endif jvm} 830 831 type 832 tfinishstate=record 833 init_procinfo:tcgprocinfo; 834 finalize_procinfo:tcgprocinfo; 835 end; 836 pfinishstate=^tfinishstate; 837 838 procedure finish_unit(module:tmodule;immediate:boolean);forward; 839 proc_unitnull840 function proc_unit:boolean; 841 var 842 main_file: tinputfile; 843 s1,s2 : ^string; {Saves stack space} 844 finalize_procinfo, 845 init_procinfo : tcgprocinfo; 846 unitname : ansistring; 847 unitname8 : string[8]; 848 i,j : longint; 849 finishstate:pfinishstate; 850 globalstate:pglobalstate; 851 consume_semicolon_after_uses:boolean; 852 feature : tfeature; 853 begin 854 result:=true; 855 856 init_procinfo:=nil; 857 finalize_procinfo:=nil; 858 859 if m_mac in current_settings.modeswitches then 860 current_module.mode_switch_allowed:= false; 861 862 consume(_UNIT); 863 if compile_level=1 then 864 Status.IsExe:=false; 865 866 unitname:=orgpattern; 867 consume(_ID); 868 while token=_POINT do 869 begin 870 consume(_POINT); 871 unitname:=unitname+'.'+orgpattern; 872 consume(_ID); 873 end; 874 875 { create filenames and unit name } 876 main_file := current_scanner.inputfile; 877 while assigned(main_file.next) do 878 main_file := main_file.next; 879 880 new(s1); 881 s1^:=current_module.modulename^; 882 current_module.SetFileName(main_file.path+main_file.name,true); 883 current_module.SetModuleName(unitname); 884 885 { check for system unit } 886 new(s2); 887 s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name),'')); 888 unitname8:=copy(current_module.modulename^,1,8); 889 if (cs_check_unit_name in current_settings.globalswitches) and 890 ( 891 not( 892 (current_module.modulename^=s2^) or 893 ( 894 (length(current_module.modulename^)>8) and 895 (unitname8=s2^) 896 ) 897 ) 898 or 899 ( 900 (length(s1^)>8) and 901 (s1^<>current_module.modulename^) 902 ) 903 ) then 904 Message2(unit_e_illegal_unit_name,current_module.realmodulename^,s1^); 905 if (current_module.modulename^='SYSTEM') then 906 include(current_settings.moduleswitches,cs_compilesystem); 907 dispose(s2); 908 dispose(s1); 909 910 if (target_info.system in systems_unit_program_exports) then 911 exportlib.preparelib(current_module.realmodulename^); 912 913 { parse hint directives } 914 try_consume_hintdirective(current_module.moduleoptions, current_module.deprecatedmsg); 915 916 consume(_SEMICOLON); 917 918 { handle the global switches, do this before interface, because after interface has been 919 read, all following directives are parsed as well } 920 setupglobalswitches; 921 922 { generate now the global symboltable, 923 define first as local to overcome dependency conflicts } 924 current_module.localsymtable:=tglobalsymtable.create(current_module.modulename^,current_module.moduleid); 925 926 { insert unitsym of this unit to prevent other units having 927 the same name } 928 tabstractunitsymtable(current_module.localsymtable).insertunit(cunitsym.create(current_module.realmodulename^,current_module)); 929 930 { load default system unit, it must be loaded before interface is parsed 931 else we cannot use e.g. feature switches before the next real token } 932 loadsystemunit; 933 934 { system unit is loaded, now insert feature defines } 935 for feature:=low(tfeature) to high(tfeature) do 936 if feature in features then 937 def_system_macro('FPC_HAS_FEATURE_'+featurestr[feature]); 938 939 consume(_INTERFACE); 940 941 { global switches are read, so further changes aren't allowed } 942 current_module.in_global:=false; 943 944 message1(unit_u_loading_interface_units,current_module.modulename^); 945 946 { update status } 947 status.currentmodule:=current_module.realmodulename^; 948 949 { maybe turn off m_objpas if we are compiling objpas } 950 if (current_module.modulename^='OBJPAS') then 951 exclude(current_settings.modeswitches,m_objpas); 952 953 { maybe turn off m_mac if we are compiling macpas } 954 if (current_module.modulename^='MACPAS') then 955 exclude(current_settings.modeswitches,m_mac); 956 957 parse_only:=true; 958 959 { load default units, like language mode units } 960 if not(cs_compilesystem in current_settings.moduleswitches) then 961 loaddefaultunits; 962 963 { insert qualifier for the system unit (allows system.writeln) } 964 if not(cs_compilesystem in current_settings.moduleswitches) and 965 (token=_USES) then 966 begin 967 loadunits(nil); 968 { has it been compiled at a higher level ?} 969 if current_module.state=ms_compiled then 970 begin 971 Message1(parser_u_already_compiled,current_module.realmodulename^); 972 exit; 973 end; 974 975 consume_semicolon_after_uses:=true; 976 end 977 else 978 consume_semicolon_after_uses:=false; 979 980 { move the global symtable from the temporary local to global } 981 current_module.globalsymtable:=current_module.localsymtable; 982 current_module.localsymtable:=nil; 983 984 { number all units, so we know if a unit is used by this unit or 985 needs to be added implicitly } 986 current_module.updatemaps; 987 988 { consume the semicolon after maps have been updated else conditional compiling expressions 989 might cause internal errors, see tw8611 } 990 if consume_semicolon_after_uses then 991 consume(_SEMICOLON); 992 993 { create whole program optimisation information (may already be 994 updated in the interface, e.g., in case of classrefdef typed 995 constants } 996 current_module.wpoinfo:=tunitwpoinfo.create; 997 998 { ... parse the declarations } 999 Message1(parser_u_parsing_interface,current_module.realmodulename^); 1000 symtablestack.push(current_module.globalsymtable); 1001 {$ifdef jvm} 1002 { fake classdef to represent the class corresponding to the unit } 1003 addmoduleclass; 1004 {$endif} 1005 read_interface_declarations; 1006 1007 { Export macros defined in the interface for macpas. The macros 1008 are put in the globalmacrosymtable that will only be used by other 1009 units. The current unit continues to use the localmacrosymtable } 1010 if (m_mac in current_settings.modeswitches) then 1011 begin 1012 current_module.globalmacrosymtable:=tmacrosymtable.create(true); 1013 current_module.localmacrosymtable.SymList.ForEachCall(@copy_macro,nil); 1014 end; 1015 1016 { leave when we got an error } 1017 if (Errorcount>0) and not status.skip_error then 1018 begin 1019 Message1(unit_f_errors_in_unit,tostr(Errorcount)); 1020 status.skip_error:=true; 1021 symtablestack.pop(current_module.globalsymtable); 1022 exit; 1023 end; 1024 1025 { Our interface is compiled, generate CRC and switch to implementation } 1026 if not(cs_compilesystem in current_settings.moduleswitches) and 1027 (Errorcount=0) then 1028 tppumodule(current_module).getppucrc; 1029 current_module.in_interface:=false; 1030 current_module.interface_compiled:=true; 1031 1032 { First reload all units depending on our interface, we need to do this 1033 in the implementation part to prevent erroneous circular references } 1034 tppumodule(current_module).setdefgeneration; 1035 tppumodule(current_module).reload_flagged_units; 1036 1037 { Parse the implementation section } 1038 if (m_mac in current_settings.modeswitches) and try_to_consume(_END) then 1039 current_module.interface_only:=true 1040 else 1041 current_module.interface_only:=false; 1042 1043 parse_only:=false; 1044 1045 { create static symbol table } 1046 current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid); 1047 1048 { Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it } 1049 maybe_load_got; 1050 1051 if not current_module.interface_only then 1052 begin 1053 consume(_IMPLEMENTATION); 1054 Message1(unit_u_loading_implementation_units,current_module.modulename^); 1055 { Read the implementation units } 1056 if token=_USES then 1057 begin 1058 loadunits(current_module.globalsymtable); 1059 consume(_SEMICOLON); 1060 end; 1061 end; 1062 1063 if current_module.state=ms_compiled then 1064 begin 1065 symtablestack.pop(current_module.globalsymtable); 1066 exit; 1067 end; 1068 1069 { All units are read, now give them a number } 1070 current_module.updatemaps; 1071 1072 { further, changing the globalsymtable is not allowed anymore } 1073 current_module.globalsymtable.sealed:=true; 1074 symtablestack.push(current_module.localsymtable); 1075 1076 if not current_module.interface_only then 1077 begin 1078 Message1(parser_u_parsing_implementation,current_module.modulename^); 1079 if current_module.in_interface then 1080 internalerror(200212285); 1081 1082 { Compile the unit } 1083 init_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'init$'),potype_unitinit,current_module.localsymtable); 1084 init_procinfo.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,'')); 1085 init_procinfo.parse_body; 1086 { save file pos for debuginfo } 1087 current_module.mainfilepos:=init_procinfo.entrypos; 1088 1089 { parse finalization section } 1090 if token=_FINALIZATION then 1091 begin 1092 { Compile the finalize } 1093 finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize$'),potype_unitfinalize,current_module.localsymtable); 1094 finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,'')); 1095 finalize_procinfo.parse_body; 1096 end 1097 end; 1098 1099 { remove all units that we are waiting for that are already waiting for 1100 us => breaking up circles } 1101 for i:=0 to current_module.waitingunits.count-1 do 1102 for j:=current_module.waitingforunit.count-1 downto 0 do 1103 if current_module.waitingunits[i]=current_module.waitingforunit[j] then 1104 current_module.waitingforunit.delete(j); 1105 1106 {$ifdef DEBUG_UNITWAITING} 1107 Writeln('Units waiting for ', current_module.modulename^, ': ', 1108 current_module.waitingforunit.Count); 1109 {$endif} 1110 result:=current_module.waitingforunit.count=0; 1111 1112 { save all information that is needed for finishing the unit } 1113 New(finishstate); 1114 finishstate^.init_procinfo:=init_procinfo; 1115 finishstate^.finalize_procinfo:=finalize_procinfo; 1116 current_module.finishstate:=finishstate; 1117 1118 if result then 1119 finish_unit(current_module,true) 1120 else 1121 begin 1122 { save the current state, so the parsing can continue where we left 1123 of here } 1124 New(globalstate); 1125 save_global_state(globalstate^,true); 1126 current_module.globalstate:=globalstate; 1127 end; 1128 end; 1129 1130 procedure finish_unit(module:tmodule;immediate:boolean); 1131 is_assembler_generatednull1132 function is_assembler_generated:boolean; 1133 var 1134 hal : tasmlisttype; 1135 begin 1136 result:=false; 1137 if Errorcount=0 then 1138 begin 1139 for hal:=low(TasmlistType) to high(TasmlistType) do 1140 if not current_asmdata.asmlists[hal].empty then 1141 begin 1142 result:=true; 1143 exit; 1144 end; 1145 end; 1146 end; 1147 1148 procedure module_is_done;inline; 1149 begin 1150 dispose(pglobalstate(current_module.globalstate)); 1151 current_module.globalstate:=nil; 1152 dispose(pfinishstate(current_module.finishstate)); 1153 current_module.finishstate:=nil; 1154 end; 1155 1156 var 1157 {$ifdef EXTDEBUG} 1158 store_crc, 1159 {$endif EXTDEBUG} 1160 store_interface_crc, 1161 store_indirect_crc: cardinal; 1162 force_init_final : boolean; 1163 init_procinfo, 1164 finalize_procinfo : tcgprocinfo; 1165 i : longint; 1166 ag : boolean; 1167 finishstate : tfinishstate; 1168 globalstate : tglobalstate; 1169 waitingmodule : tmodule; 1170 begin 1171 fillchar(globalstate,sizeof(tglobalstate),0); 1172 if not immediate then 1173 begin 1174 {$ifdef DEBUG_UNITWAITING} 1175 writeln('finishing waiting unit ''', module.modulename^, ''''); 1176 {$endif DEBUG_UNITWAITING} 1177 { restore the state when we stopped working on the unit } 1178 save_global_state(globalstate,true); 1179 if not assigned(module.globalstate) then 1180 internalerror(2012091802); 1181 restore_global_state(pglobalstate(module.globalstate)^,true); 1182 end; 1183 1184 { current_module is now module } 1185 1186 if not assigned(current_module.finishstate) then 1187 internalerror(2012091801); 1188 finishstate:=pfinishstate(current_module.finishstate)^; 1189 1190 finalize_procinfo:=finishstate.finalize_procinfo; 1191 init_procinfo:=finishstate.init_procinfo; 1192 1193 { Generate specializations of objectdefs methods } 1194 generate_specialization_procs; 1195 1196 { Generate VMTs } 1197 if Errorcount=0 then 1198 begin 1199 write_vmts(current_module.globalsymtable,true); 1200 write_vmts(current_module.localsymtable,false); 1201 end; 1202 1203 { add implementations for synthetic method declarations added by 1204 the compiler } 1205 add_synthetic_method_implementations(current_module.globalsymtable); 1206 add_synthetic_method_implementations(current_module.localsymtable); 1207 1208 { if the unit contains ansi/widestrings, initialization and 1209 finalization code must be forced } 1210 force_init_final:=tglobalsymtable(current_module.globalsymtable).needs_init_final or 1211 tstaticsymtable(current_module.localsymtable).needs_init_final; 1212 1213 { should we force unit initialization? } 1214 { this is a hack, but how can it be done better ? } 1215 { Now the sole purpose of this is to change 'init' to 'init_implicit', 1216 is it needed at all? (Sergei) } 1217 { it's needed in case cnodeutils.force_init = true } 1218 if (force_init_final or cnodeutils.force_init) and 1219 ( 1220 not assigned(init_procinfo) or 1221 has_no_code(init_procinfo.code) 1222 ) then 1223 begin 1224 { first release the not used init procinfo } 1225 if assigned(init_procinfo) then 1226 begin 1227 release_proc_symbol(init_procinfo.procdef); 1228 release_main_proc(init_procinfo); 1229 end; 1230 init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable); 1231 end; 1232 if (force_init_final or cnodeutils.force_final) and 1233 ( 1234 not assigned(finalize_procinfo) or 1235 has_no_code(finalize_procinfo.code) 1236 ) then 1237 begin 1238 { first release the not used finalize procinfo } 1239 if assigned(finalize_procinfo) then 1240 begin 1241 release_proc_symbol(finalize_procinfo.procdef); 1242 release_main_proc(finalize_procinfo); 1243 end; 1244 finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable); 1245 end; 1246 1247 { Now both init and finalize bodies are read and it is known 1248 which variables are used in both init and finalize we can now 1249 generate the code. This is required to prevent putting a variable in 1250 a register that is also used in the finalize body (PFV) } 1251 if assigned(init_procinfo) then 1252 begin 1253 if (force_init_final or cnodeutils.force_init) or 1254 not(has_no_code(init_procinfo.code)) then 1255 begin 1256 init_procinfo.code:=cnodeutils.wrap_proc_body(init_procinfo.procdef,init_procinfo.code); 1257 init_procinfo.generate_code; 1258 current_module.flags:=current_module.flags or uf_init; 1259 end 1260 else 1261 release_proc_symbol(init_procinfo.procdef); 1262 init_procinfo.resetprocdef; 1263 release_main_proc(init_procinfo); 1264 end; 1265 if assigned(finalize_procinfo) then 1266 begin 1267 if force_init_final or 1268 cnodeutils.force_init or 1269 not(has_no_code(finalize_procinfo.code)) then 1270 begin 1271 finalize_procinfo.code:=cnodeutils.wrap_proc_body(finalize_procinfo.procdef,finalize_procinfo.code); 1272 finalize_procinfo.generate_code; 1273 current_module.flags:=current_module.flags or uf_finalize; 1274 end 1275 else 1276 release_proc_symbol(finalize_procinfo.procdef); 1277 finalize_procinfo.resetprocdef; 1278 release_main_proc(finalize_procinfo); 1279 end; 1280 1281 symtablestack.pop(current_module.localsymtable); 1282 symtablestack.pop(current_module.globalsymtable); 1283 1284 { the last char should always be a point } 1285 consume(_POINT); 1286 1287 { reset wpo flags for all defs } 1288 reset_all_defs; 1289 1290 if (Errorcount=0) then 1291 begin 1292 { tests, if all (interface) forwards are resolved } 1293 tstoredsymtable(current_module.globalsymtable).check_forwards; 1294 { check if all private fields are used } 1295 tstoredsymtable(current_module.globalsymtable).allprivatesused; 1296 1297 { test static symtable } 1298 tstoredsymtable(current_module.localsymtable).allsymbolsused; 1299 tstoredsymtable(current_module.localsymtable).allprivatesused; 1300 tstoredsymtable(current_module.localsymtable).check_forwards; 1301 tstoredsymtable(current_module.localsymtable).checklabels; 1302 1303 { used units } 1304 current_module.allunitsused; 1305 end; 1306 1307 { leave when we got an error } 1308 if (Errorcount>0) and not status.skip_error then 1309 begin 1310 Message1(unit_f_errors_in_unit,tostr(Errorcount)); 1311 status.skip_error:=true; 1312 module_is_done; 1313 if not immediate then 1314 restore_global_state(globalstate,true); 1315 exit; 1316 end; 1317 1318 { if an Objective-C module, generate rtti and module info } 1319 MaybeGenerateObjectiveCImageInfo(current_module.globalsymtable,current_module.localsymtable); 1320 1321 { do we need to add the variants unit? } 1322 maybeloadvariantsunit; 1323 1324 { generate rtti/init tables } 1325 write_persistent_type_info(current_module.globalsymtable,true); 1326 write_persistent_type_info(current_module.localsymtable,false); 1327 1328 { Tables } 1329 cnodeutils.InsertThreadvars; 1330 1331 { Resource strings } 1332 GenerateResourceStrings; 1333 1334 { Widestring typed constants } 1335 cnodeutils.InsertWideInits; 1336 1337 { Resourcestring references } 1338 cnodeutils.InsertResStrInits; 1339 1340 { generate debuginfo } 1341 if (cs_debuginfo in current_settings.moduleswitches) then 1342 current_debuginfo.inserttypeinfo; 1343 1344 { generate imports } 1345 if current_module.ImportLibraryList.Count>0 then 1346 importlib.generatelib; 1347 1348 { insert own objectfile, or say that it's in a library 1349 (no check for an .o when loading) } 1350 ag:=is_assembler_generated; 1351 if ag then 1352 insertobjectfile 1353 else 1354 begin 1355 current_module.flags:=current_module.flags or uf_no_link; 1356 current_module.flags:=current_module.flags and not (uf_has_stabs_debuginfo or uf_has_dwarf_debuginfo); 1357 end; 1358 1359 if ag then 1360 begin 1361 { create callframe info } 1362 create_dwarf_frame; 1363 { assemble } 1364 create_objectfile; 1365 end; 1366 1367 { Write out the ppufile after the object file has been created } 1368 store_interface_crc:=current_module.interface_crc; 1369 store_indirect_crc:=current_module.indirect_crc; 1370 {$ifdef EXTDEBUG} 1371 store_crc:=current_module.crc; 1372 {$endif EXTDEBUG} 1373 if (Errorcount=0) then 1374 tppumodule(current_module).writeppu; 1375 1376 if not(cs_compilesystem in current_settings.moduleswitches) then 1377 begin 1378 if store_interface_crc<>current_module.interface_crc then 1379 Message1(unit_u_interface_crc_changed,current_module.ppufilename); 1380 if store_indirect_crc<>current_module.indirect_crc then 1381 Message1(unit_u_indirect_crc_changed,current_module.ppufilename); 1382 end; 1383 {$ifdef EXTDEBUG} 1384 if not(cs_compilesystem in current_settings.moduleswitches) then 1385 if (store_crc<>current_module.crc) then 1386 Message1(unit_u_implementation_crc_changed,current_module.ppufilename); 1387 {$endif EXTDEBUG} 1388 1389 { release unregistered defs/syms from the localsymtable } 1390 free_unregistered_localsymtable_elements; 1391 { release local symtables that are not needed anymore } 1392 free_localsymtables(current_module.globalsymtable); 1393 free_localsymtables(current_module.localsymtable); 1394 1395 { leave when we got an error } 1396 if (Errorcount>0) and not status.skip_error then 1397 begin 1398 Message1(unit_f_errors_in_unit,tostr(Errorcount)); 1399 status.skip_error:=true; 1400 module_is_done; 1401 if not immediate then 1402 restore_global_state(globalstate,true); 1403 exit; 1404 end; 1405 1406 {$ifdef debug_devirt} 1407 { print out all instantiated class/object types } 1408 writeln('constructed object/class/classreftypes in ',current_module.realmodulename^); 1409 for i := 0 to current_module.wpoinfo.createdobjtypes.count-1 do 1410 begin 1411 write(' ',tdef(current_module.wpoinfo.createdobjtypes[i]).GetTypeName); 1412 case tdef(current_module.wpoinfo.createdobjtypes[i]).typ of 1413 objectdef: 1414 case tobjectdef(current_module.wpoinfo.createdobjtypes[i]).objecttype of 1415 odt_object: 1416 writeln(' (object)'); 1417 odt_class: 1418 writeln(' (class)'); 1419 else 1420 internalerror(2008101103); 1421 end; 1422 else 1423 internalerror(2008101104); 1424 end; 1425 end; 1426 1427 for i := 0 to current_module.wpoinfo.createdclassrefobjtypes.count-1 do 1428 begin 1429 write(' Class Of ',tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).GetTypeName); 1430 case tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).typ of 1431 objectdef: 1432 case tobjectdef(current_module.wpoinfo.createdclassrefobjtypes[i]).objecttype of 1433 odt_class: 1434 writeln(' (classrefdef)'); 1435 else 1436 internalerror(2008101105); 1437 end 1438 else 1439 internalerror(2008101102); 1440 end; 1441 end; 1442 {$endif debug_devirt} 1443 1444 Message1(unit_u_finished_compiling,current_module.modulename^); 1445 1446 module_is_done; 1447 if not immediate then 1448 restore_global_state(globalstate,true); 1449 1450 for i:=0 to module.waitingunits.count-1 do 1451 begin 1452 waitingmodule:=tmodule(module.waitingunits[i]); 1453 waitingmodule.waitingforunit.remove(module); 1454 { only finish the module if it isn't already finished } 1455 if (waitingmodule.waitingforunit.count=0) and 1456 assigned(waitingmodule.finishstate) then 1457 begin 1458 finish_unit(waitingmodule,false); 1459 waitingmodule.end_of_parsing; 1460 end; 1461 end; 1462 end; 1463 1464 1465 procedure proc_package; 1466 var 1467 main_file : tinputfile; 1468 hp,hp2 : tmodule; 1469 pkg : tpcppackage; 1470 {finalize_procinfo, 1471 init_procinfo,} 1472 main_procinfo : tcgprocinfo; 1473 force_init_final : boolean; 1474 uu : tused_unit; 1475 module_name: ansistring; 1476 pentry: ppackageentry; 1477 feature : tfeature; 1478 begin 1479 Status.IsPackage:=true; 1480 Status.IsExe:=true; 1481 parse_only:=false; 1482 main_procinfo:=nil; 1483 {init_procinfo:=nil; 1484 finalize_procinfo:=nil;} 1485 1486 if not (tf_supports_packages in target_info.flags) then 1487 message1(parser_e_packages_not_supported,target_info.name); 1488 1489 if not RelocSectionSetExplicitly then 1490 RelocSection:=true; 1491 1492 { Relocation works only without stabs under Windows when } 1493 { external linker (LD) is used. LD generates relocs for } 1494 { stab sections which is not loaded in memory. It causes } 1495 { AV error when DLL is loaded and relocation is needed. } 1496 { Internal linker does not have this problem. } 1497 if RelocSection and 1498 (target_info.system in systems_all_windows+[system_i386_wdosx]) and 1499 (cs_link_extern in current_settings.globalswitches) then 1500 begin 1501 include(current_settings.globalswitches,cs_link_strip); 1502 { Warning stabs info does not work with reloc section !! } 1503 if (cs_debuginfo in current_settings.moduleswitches) and 1504 (target_dbg.id=dbg_stabs) then 1505 begin 1506 Message1(parser_w_parser_reloc_no_debug,current_module.mainsource); 1507 Message(parser_w_parser_win32_debug_needs_WN); 1508 exclude(current_settings.moduleswitches,cs_debuginfo); 1509 end; 1510 end; 1511 { get correct output names } 1512 main_file := current_scanner.inputfile; 1513 while assigned(main_file.next) do 1514 main_file := main_file.next; 1515 1516 current_module.SetFileName(main_file.path+main_file.name,true); 1517 1518 { consume _PACKAGE word } 1519 consume(_ID); 1520 1521 module_name:=orgpattern; 1522 consume(_ID); 1523 while token=_POINT do 1524 begin 1525 consume(_POINT); 1526 module_name:=module_name+'.'+orgpattern; 1527 consume(_ID); 1528 end; 1529 1530 current_module.setmodulename(module_name); 1531 current_module.ispackage:=true; 1532 exportlib.preparelib(module_name); 1533 pkg:=tpcppackage.create(module_name); 1534 1535 if tf_library_needs_pic in target_info.flags then 1536 include(current_settings.moduleswitches,cs_create_pic); 1537 1538 { setup things using the switches, do this before the semicolon, because after the semicolon has been 1539 read, all following directives are parsed as well } 1540 1541 setupglobalswitches; 1542 1543 consume(_SEMICOLON); 1544 1545 { global switches are read, so further changes aren't allowed } 1546 current_module.in_global:=false; 1547 1548 { set implementation flag } 1549 current_module.in_interface:=false; 1550 current_module.interface_compiled:=true; 1551 1552 { insert after the unit symbol tables the static symbol table } 1553 { of the program } 1554 current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid); 1555 1556 { ensure that no packages are picked up from the options } 1557 packagelist.clear; 1558 1559 {Read the packages used by the package we compile.} 1560 if (token=_ID) and (idtoken=_REQUIRES) then 1561 begin 1562 { consume _REQUIRES word } 1563 consume(_ID); 1564 while true do 1565 begin 1566 if token=_ID then 1567 begin 1568 module_name:=orgpattern; 1569 consume(_ID); 1570 while token=_POINT do 1571 begin 1572 consume(_POINT); 1573 module_name:=module_name+'.'+orgpattern; 1574 consume(_ID); 1575 end; 1576 add_package(module_name,false,true); 1577 end 1578 else 1579 consume(_ID); 1580 if token=_COMMA then 1581 consume(_COMMA) 1582 else 1583 break; 1584 end; 1585 consume(_SEMICOLON); 1586 end; 1587 1588 { now load all packages, so that we can determine whether a unit is 1589 already provided by one of the loaded packages } 1590 load_packages; 1591 1592 if packagelist.Count>0 then 1593 begin 1594 { this means the SYSTEM unit *must* be part of one of the required 1595 packages, so load it } 1596 AddUnit('system',false); 1597 systemunit:=tglobalsymtable(symtablestack.top); 1598 load_intern_types; 1599 { system unit is loaded, now insert feature defines } 1600 for feature:=low(tfeature) to high(tfeature) do 1601 if feature in features then 1602 def_system_macro('FPC_HAS_FEATURE_'+featurestr[feature]); 1603 end; 1604 1605 {Load the units used by the program we compile.} 1606 if (token=_ID) and (idtoken=_CONTAINS) then 1607 begin 1608 { consume _CONTAINS word } 1609 consume(_ID); 1610 while true do 1611 begin 1612 if token=_ID then 1613 begin 1614 module_name:=orgpattern; 1615 consume(_ID); 1616 while token=_POINT do 1617 begin 1618 consume(_POINT); 1619 module_name:=module_name+'.'+orgpattern; 1620 consume(_ID); 1621 end; 1622 hp:=AddUnit(module_name); 1623 if (hp.modulename^='SYSTEM') and not assigned(systemunit) then 1624 begin 1625 systemunit:=tglobalsymtable(hp.globalsymtable); 1626 load_intern_types; 1627 end; 1628 end 1629 else 1630 consume(_ID); 1631 if token=_COMMA then 1632 consume(_COMMA) 1633 else break; 1634 end; 1635 consume(_SEMICOLON); 1636 end; 1637 1638 { All units are read, now give them a number } 1639 current_module.updatemaps; 1640 1641 hp:=tmodule(loaded_units.first); 1642 while assigned(hp) do 1643 begin 1644 if (hp<>current_module) and not assigned(hp.package) then 1645 begin 1646 if (hp.flags and uf_package_deny) <> 0 then 1647 message1(package_e_unit_deny_package,hp.realmodulename^); 1648 { part of the package's used, aka contained units? } 1649 uu:=tused_unit(current_module.used_units.first); 1650 while assigned(uu) do 1651 begin 1652 if uu.u=hp then 1653 break; 1654 uu:=tused_unit(uu.next); 1655 end; 1656 if not assigned(uu) then 1657 message2(package_n_implicit_unit_import,hp.realmodulename^,current_module.realmodulename^); 1658 end; 1659 { was this unit listed as a contained unit? If so => error } 1660 if (hp<>current_module) and assigned(hp.package) then 1661 begin 1662 uu:=tused_unit(current_module.used_units.first); 1663 while assigned(uu) do 1664 begin 1665 if uu.u=hp then 1666 break; 1667 uu:=tused_unit(uu.next); 1668 end; 1669 if assigned(uu) then 1670 message2(package_e_unit_already_contained_in_package,hp.realmodulename^,hp.package.realpackagename^); 1671 end; 1672 hp:=tmodule(hp.next); 1673 end; 1674 1675 {Insert the name of the main program into the symbol table.} 1676 if current_module.realmodulename^<>'' then 1677 tabstractunitsymtable(current_module.localsymtable).insertunit(cunitsym.create(current_module.realmodulename^,current_module)); 1678 1679 Message1(parser_u_parsing_implementation,current_module.mainsource); 1680 1681 symtablestack.push(current_module.localsymtable); 1682 1683 { create whole program optimisation information } 1684 current_module.wpoinfo:=tunitwpoinfo.create; 1685 1686 { should we force unit initialization? } 1687 force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final; 1688 if force_init_final or cnodeutils.force_init then 1689 {init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable)}; 1690 1691 { Add symbol to the exports section for win32 so smartlinking a 1692 DLL will include the edata section } 1693 if assigned(exportlib) and 1694 (target_info.system in [system_i386_win32,system_i386_wdosx]) and 1695 ((current_module.flags and uf_has_exports)<>0) then 1696 current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',current_module.localsymtable,''),0)); 1697 1698 { all labels must be defined before generating code } 1699 if Errorcount=0 then 1700 tstoredsymtable(current_module.localsymtable).checklabels; 1701 1702 symtablestack.pop(current_module.localsymtable); 1703 1704 { consume the last point } 1705 consume(_END); 1706 consume(_POINT); 1707 1708 if (Errorcount=0) then 1709 begin 1710 { test static symtable } 1711 tstoredsymtable(current_module.localsymtable).allsymbolsused; 1712 tstoredsymtable(current_module.localsymtable).allprivatesused; 1713 tstoredsymtable(current_module.localsymtable).check_forwards; 1714 1715 { Note: all contained units are considered as used } 1716 end; 1717 1718 if target_info.system in systems_all_windows+systems_nativent then 1719 begin 1720 main_procinfo:=create_main_proc('_DLLMainCRTStartup',potype_pkgstub,current_module.localsymtable); 1721 main_procinfo.code:=generate_pkg_stub(main_procinfo.procdef); 1722 main_procinfo.generate_code; 1723 end; 1724 1725 { leave when we got an error } 1726 if (Errorcount>0) and not status.skip_error then 1727 begin 1728 Message1(unit_f_errors_in_unit,tostr(Errorcount)); 1729 status.skip_error:=true; 1730 pkg.free; 1731 exit; 1732 end; 1733 1734 { remove all unused units, this happends when units are removed 1735 from the uses clause in the source and the ppu was already being loaded } 1736 hp:=tmodule(loaded_units.first); 1737 while assigned(hp) do 1738 begin 1739 hp2:=hp; 1740 hp:=tmodule(hp.next); 1741 if assigned(hp2.package) then 1742 add_package_unit_ref(hp2.package); 1743 if hp2.is_unit and 1744 not assigned(hp2.globalsymtable) then 1745 loaded_units.remove(hp2); 1746 end; 1747 1748 exportlib.ignoreduplicates:=true; 1749 1750 { force exports } 1751 uu:=tused_unit(usedunits.first); 1752 while assigned(uu) do 1753 begin 1754 if not assigned(systemunit) and (uu.u.modulename^='SYSTEM') then 1755 begin 1756 systemunit:=tglobalsymtable(uu.u.globalsymtable); 1757 load_intern_types; 1758 end; 1759 if not assigned(uu.u.package) then 1760 export_unit(uu.u); 1761 1762 uu:=tused_unit(uu.next); 1763 end; 1764 1765 {$ifdef arm} 1766 { Insert .pdata section for arm-wince. 1767 It is needed for exception handling. } 1768 if target_info.system in [system_arm_wince] then 1769 InsertPData; 1770 {$endif arm} 1771 1772 { generate debuginfo } 1773 if (cs_debuginfo in current_settings.moduleswitches) then 1774 current_debuginfo.inserttypeinfo; 1775 1776 exportlib.generatelib; 1777 1778 exportlib.ignoreduplicates:=false; 1779 1780 { create import libraries for all packages } 1781 if packagelist.count>0 then 1782 createimportlibfromexternals; 1783 1784 { generate imports } 1785 if current_module.ImportLibraryList.Count>0 then 1786 importlib.generatelib; 1787 1788 { Reference all DEBUGINFO sections from the main .fpc section } 1789 if (cs_debuginfo in current_settings.moduleswitches) then 1790 current_debuginfo.referencesections(current_asmdata.asmlists[al_procedures]); 1791 1792 { insert own objectfile } 1793 insertobjectfile; 1794 1795 { assemble and link } 1796 create_objectfile; 1797 1798 { We might need the symbols info if not using 1799 the default do_extractsymbolinfo 1800 which is a dummy function PM } 1801 needsymbolinfo:=do_extractsymbolinfo<>@def_extractsymbolinfo; 1802 { release all local symtables that are not needed anymore } 1803 if (not needsymbolinfo) then 1804 free_localsymtables(current_module.localsymtable); 1805 1806 { leave when we got an error } 1807 if (Errorcount>0) and not status.skip_error then 1808 begin 1809 Message1(unit_f_errors_in_unit,tostr(Errorcount)); 1810 status.skip_error:=true; 1811 pkg.free; 1812 exit; 1813 end; 1814 1815 if (not current_module.is_unit) then 1816 begin 1817 { we add all loaded units that are not part of a package to the 1818 package; this includes units in the "contains" section as well 1819 as implicitely imported ones } 1820 hp:=tmodule(loaded_units.first); 1821 while assigned(hp) do 1822 begin 1823 if (hp<>current_module) then 1824 begin 1825 if not assigned(hp.package) then 1826 begin 1827 pkg.addunit(hp); 1828 check_for_indirect_package_usages(hp.used_units); 1829 end 1830 else 1831 begin 1832 pentry:=ppackageentry(packagelist.find(hp.package.packagename^)); 1833 if not assigned(pentry) then 1834 internalerror(2015112301); 1835 pkg.add_required_package(hp.package); 1836 end; 1837 end; 1838 hp:=tmodule(hp.next); 1839 end; 1840 1841 pkg.initmoduleinfo(current_module); 1842 1843 { create the executable when we are at level 1 } 1844 if (compile_level=1) then 1845 begin 1846 { create global resource file by collecting all resource files } 1847 CollectResourceFiles; 1848 { write .def file } 1849 if (cs_link_deffile in current_settings.globalswitches) then 1850 deffile.writefile; 1851 1852 { generate the pcp file } 1853 pkg.savepcp; 1854 1855 { insert all .o files from all loaded units and 1856 unload the units, we don't need them anymore. 1857 Keep the current_module because that is still needed } 1858 hp:=tmodule(loaded_units.first); 1859 while assigned(hp) do 1860 begin 1861 { only link in those units which should become part of this 1862 package } 1863 if not assigned(hp.package) then 1864 linker.AddModuleFiles(hp); 1865 hp2:=tmodule(hp.next); 1866 if (hp<>current_module) and 1867 (not needsymbolinfo) then 1868 begin 1869 loaded_units.remove(hp); 1870 hp.free; 1871 end; 1872 hp:=hp2; 1873 end; 1874 { add the library of directly used packages } 1875 add_package_libs(linker); 1876 { and now link the package library } 1877 linker.MakeSharedLibrary 1878 end; 1879 1880 { Give Fatal with error count for linker errors } 1881 if (Errorcount>0) and not status.skip_error then 1882 begin 1883 Message1(unit_f_errors_in_unit,tostr(Errorcount)); 1884 status.skip_error:=true; 1885 end; 1886 1887 pkg.free; 1888 end; 1889 end; 1890 1891 1892 procedure proc_program(islibrary : boolean); 1893 type 1894 TProgramParam = record 1895 name : ansistring; 1896 nr : dword; 1897 end; 1898 var 1899 main_file : tinputfile; 1900 hp,hp2 : tmodule; 1901 finalize_procinfo, 1902 init_procinfo, 1903 main_procinfo : tcgprocinfo; 1904 force_init_final : boolean; 1905 resources_used : boolean; 1906 program_uses_checkpointer : boolean; 1907 initname, 1908 program_name : ansistring; 1909 consume_semicolon_after_uses : boolean; 1910 ps : tprogramparasym; 1911 paramnum : longint; 1912 textsym : ttypesym; 1913 sc : array of TProgramParam; 1914 i : Longint; 1915 sysinitmod: tmodule; 1916 feature : tfeature; 1917 begin 1918 Status.IsLibrary:=IsLibrary; 1919 Status.IsPackage:=false; 1920 Status.IsExe:=true; 1921 parse_only:=false; 1922 main_procinfo:=nil; 1923 init_procinfo:=nil; 1924 finalize_procinfo:=nil; 1925 resources_used:=false; 1926 { make the compiler happy and avoid an uninitialized variable warning on Setlength(sc,length(sc)+1); } 1927 sc:=nil; 1928 1929 { DLL defaults to create reloc info } 1930 if islibrary then 1931 begin 1932 if not RelocSectionSetExplicitly then 1933 RelocSection:=true; 1934 end; 1935 1936 { Relocation works only without stabs under Windows when } 1937 { external linker (LD) is used. LD generates relocs for } 1938 { stab sections which is not loaded in memory. It causes } 1939 { AV error when DLL is loaded and relocation is needed. } 1940 { Internal linker does not have this problem. } 1941 if RelocSection and 1942 (target_info.system in systems_all_windows+[system_i386_wdosx]) and 1943 (cs_link_extern in current_settings.globalswitches) then 1944 begin 1945 include(current_settings.globalswitches,cs_link_strip); 1946 { Warning stabs info does not work with reloc section !! } 1947 if (cs_debuginfo in current_settings.moduleswitches) and 1948 (target_dbg.id=dbg_stabs) then 1949 begin 1950 Message1(parser_w_parser_reloc_no_debug,current_module.mainsource); 1951 Message(parser_w_parser_win32_debug_needs_WN); 1952 exclude(current_settings.moduleswitches,cs_debuginfo); 1953 end; 1954 end; 1955 { get correct output names } 1956 main_file := current_scanner.inputfile; 1957 while assigned(main_file.next) do 1958 main_file := main_file.next; 1959 1960 current_module.SetFileName(main_file.path+main_file.name,true); 1961 1962 if islibrary then 1963 begin 1964 consume(_LIBRARY); 1965 program_name:=orgpattern; 1966 consume(_ID); 1967 while token=_POINT do 1968 begin 1969 consume(_POINT); 1970 program_name:=program_name+'.'+orgpattern; 1971 consume(_ID); 1972 end; 1973 current_module.setmodulename(program_name); 1974 current_module.islibrary:=true; 1975 exportlib.preparelib(program_name); 1976 1977 if tf_library_needs_pic in target_info.flags then 1978 begin 1979 include(current_settings.moduleswitches,cs_create_pic); 1980 { also set create_pic for all unit compilation } 1981 include(init_settings.moduleswitches,cs_create_pic); 1982 end; 1983 1984 { setup things using the switches, do this before the semicolon, because after the semicolon has been 1985 read, all following directives are parsed as well } 1986 setupglobalswitches; 1987 1988 consume(_SEMICOLON); 1989 end 1990 else 1991 { is there an program head ? } 1992 if token=_PROGRAM then 1993 begin 1994 consume(_PROGRAM); 1995 program_name:=orgpattern; 1996 consume(_ID); 1997 while token=_POINT do 1998 begin 1999 consume(_POINT); 2000 program_name:=program_name+'.'+orgpattern; 2001 consume(_ID); 2002 end; 2003 current_module.setmodulename(program_name); 2004 if (target_info.system in systems_unit_program_exports) then 2005 exportlib.preparelib(program_name); 2006 if token=_LKLAMMER then 2007 begin 2008 consume(_LKLAMMER); 2009 paramnum:=1; 2010 repeat 2011 if m_isolike_program_para in current_settings.modeswitches then 2012 begin 2013 if (pattern<>'INPUT') and (pattern<>'OUTPUT') then 2014 begin 2015 { the symtablestack is not setup here, so text must be created later on } 2016 Setlength(sc,length(sc)+1); 2017 with sc[high(sc)] do 2018 begin 2019 name:=pattern; 2020 nr:=paramnum; 2021 end; 2022 inc(paramnum); 2023 end; 2024 end; 2025 consume(_ID); 2026 until not try_to_consume(_COMMA); 2027 consume(_RKLAMMER); 2028 end; 2029 2030 { setup things using the switches, do this before the semicolon, because after the semicolon has been 2031 read, all following directives are parsed as well } 2032 setupglobalswitches; 2033 2034 consume(_SEMICOLON); 2035 end 2036 else 2037 begin 2038 if (target_info.system in systems_unit_program_exports) then 2039 exportlib.preparelib(current_module.realmodulename^); 2040 2041 { setup things using the switches } 2042 setupglobalswitches; 2043 end; 2044 2045 { load all packages, so we know whether a unit is contained inside a 2046 package or not } 2047 load_packages; 2048 2049 { global switches are read, so further changes aren't allowed } 2050 current_module.in_global:=false; 2051 2052 { set implementation flag } 2053 current_module.in_interface:=false; 2054 current_module.interface_compiled:=true; 2055 2056 { insert after the unit symbol tables the static symbol table 2057 of the program } 2058 current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid); 2059 2060 { load system unit } 2061 loadsystemunit; 2062 2063 { system unit is loaded, now insert feature defines } 2064 for feature:=low(tfeature) to high(tfeature) do 2065 if feature in features then 2066 def_system_macro('FPC_HAS_FEATURE_'+featurestr[feature]); 2067 2068 { load standard units, e.g objpas,profile unit } 2069 loaddefaultunits; 2070 2071 { Load units provided on the command line } 2072 loadautounits; 2073 2074 { insert iso program parameters } 2075 if length(sc)>0 then 2076 begin 2077 textsym:=search_system_type('TEXT'); 2078 if not(assigned(textsym)) then 2079 internalerror(2013011201); 2080 for i:=0 to high(sc) do 2081 begin 2082 ps:=cprogramparasym.create(sc[i].name,sc[i].nr); 2083 current_module.localsymtable.insert(ps,true); 2084 end; 2085 end; 2086 2087 { Load the units used by the program we compile. } 2088 if token=_USES then 2089 begin 2090 loadunits(nil); 2091 consume_semicolon_after_uses:=true; 2092 end 2093 else 2094 consume_semicolon_after_uses:=false; 2095 2096 { All units are read, now give them a number } 2097 current_module.updatemaps; 2098 2099 { consume the semicolon after maps have been updated else conditional compiling expressions 2100 might cause internal errors, see tw8611 } 2101 if consume_semicolon_after_uses then 2102 consume(_SEMICOLON); 2103 2104 {Insert the name of the main program into the symbol table.} 2105 if current_module.realmodulename^<>'' then 2106 tabstractunitsymtable(current_module.localsymtable).insertunit(cunitsym.create(current_module.realmodulename^,current_module)); 2107 2108 Message1(parser_u_parsing_implementation,current_module.mainsource); 2109 2110 symtablestack.push(current_module.localsymtable); 2111 2112 {$ifdef jvm} 2113 { fake classdef to represent the class corresponding to the unit } 2114 addmoduleclass; 2115 {$endif} 2116 2117 { Insert _GLOBAL_OFFSET_TABLE_ symbol if system uses it } 2118 maybe_load_got; 2119 2120 { create whole program optimisation information } 2121 current_module.wpoinfo:=tunitwpoinfo.create; 2122 2123 { The program intialization needs an alias, so it can be called 2124 from the bootstrap code.} 2125 if islibrary then 2126 begin 2127 main_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,current_module.localsymtable); 2128 { Win32 startup code needs a single name } 2129 if not(target_info.system in (systems_darwin+systems_aix)) then 2130 main_procinfo.procdef.aliasnames.insert('PASCALMAIN') 2131 else 2132 main_procinfo.procdef.aliasnames.insert(target_info.Cprefix+'PASCALMAIN'); 2133 2134 { ToDo: systems that use indirect entry info, but check back with Windows! } 2135 if target_info.system in systems_darwin then 2136 { we need to call FPC_LIBMAIN in sysinit which in turn will call PascalMain } 2137 initname:=target_info.cprefix+'FPC_LIBMAIN' 2138 else 2139 initname:=main_procinfo.procdef.mangledname; 2140 { setinitname may generate a new section -> don't add to the 2141 current list, because we assume this remains a text section 2142 -- add to pure assembler section, so in case of special directives 2143 they are directly added to the assembler output by llvm } 2144 exportlib.setinitname(current_asmdata.AsmLists[al_pure_assembler],initname); 2145 end 2146 else if (target_info.system in ([system_i386_netware,system_i386_netwlibc,system_powerpc_macosclassic]+systems_darwin+systems_aix)) then 2147 begin 2148 { create a stub with the name of the desired main routine, with 2149 the same signature as the C "main" function, and call through to 2150 FPC_SYSTEMMAIN, which will initialise everything based on its 2151 parameters. This function cannot be in the system unit, because 2152 its name can be configured on the command line (for use with e.g. 2153 SDL, where the main function should be called SDL_main) } 2154 main_procinfo:=create_main_proc(mainaliasname,potype_mainstub,current_module.localsymtable); 2155 call_through_new_name(main_procinfo.procdef,target_info.cprefix+'FPC_SYSTEMMAIN'); 2156 main_procinfo.free; 2157 { now create the PASCALMAIN routine (which will be called from 2158 FPC_SYSTEMMAIN) } 2159 main_procinfo:=create_main_proc('PASCALMAIN',potype_proginit,current_module.localsymtable); 2160 end 2161 else 2162 begin 2163 main_procinfo:=create_main_proc(mainaliasname,potype_proginit,current_module.localsymtable); 2164 main_procinfo.procdef.aliasnames.insert('PASCALMAIN'); 2165 end; 2166 main_procinfo.parse_body; 2167 { save file pos for debuginfo } 2168 current_module.mainfilepos:=main_procinfo.entrypos; 2169 2170 { finalize? } 2171 if token=_FINALIZATION then 2172 begin 2173 { Parse the finalize } 2174 finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize$'),potype_unitfinalize,current_module.localsymtable); 2175 finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,'')); 2176 finalize_procinfo.procdef.aliasnames.insert('PASCALFINALIZE'); 2177 finalize_procinfo.parse_body; 2178 end; 2179 2180 { Generate specializations of objectdefs methods } 2181 generate_specialization_procs; 2182 2183 { Generate VMTs } 2184 if Errorcount=0 then 2185 write_vmts(current_module.localsymtable,false); 2186 2187 { add implementations for synthetic method declarations added by 2188 the compiler } 2189 add_synthetic_method_implementations(current_module.localsymtable); 2190 2191 { should we force unit initialization? } 2192 force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final; 2193 if force_init_final or cnodeutils.force_init then 2194 init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable); 2195 2196 { Add symbol to the exports section for win32 so smartlinking a 2197 DLL will include the edata section } 2198 if assigned(exportlib) and 2199 (target_info.system in [system_i386_win32,system_i386_wdosx]) and 2200 ((current_module.flags and uf_has_exports)<>0) then 2201 current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',current_module.localsymtable,''),0)); 2202 2203 if (force_init_final or cnodeutils.force_final) and 2204 ( 2205 not assigned(finalize_procinfo) 2206 or has_no_code(finalize_procinfo.code) 2207 ) then 2208 begin 2209 { first release the not used finalize procinfo } 2210 if assigned(finalize_procinfo) then 2211 begin 2212 release_proc_symbol(finalize_procinfo.procdef); 2213 release_main_proc(finalize_procinfo); 2214 end; 2215 finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable); 2216 end; 2217 2218 { the finalization routine of libraries is generic (and all libraries need to } 2219 { be finalized, so they can finalize any units they use } 2220 { Place in "pure assembler" list so that the llvm assembler writer 2221 directly emits the generated directives } 2222 if (islibrary) then 2223 exportlib.setfininame(current_asmdata.asmlists[al_pure_assembler],'FPC_LIB_EXIT'); 2224 2225 { all labels must be defined before generating code } 2226 if Errorcount=0 then 2227 tstoredsymtable(current_module.localsymtable).checklabels; 2228 2229 { See remark in unit init/final } 2230 main_procinfo.generate_code; 2231 main_procinfo.resetprocdef; 2232 release_main_proc(main_procinfo); 2233 if assigned(init_procinfo) then 2234 begin 2235 { initialization can be implicit only } 2236 current_module.flags:=current_module.flags or uf_init; 2237 init_procinfo.code:=cnodeutils.wrap_proc_body(init_procinfo.procdef,init_procinfo.code); 2238 init_procinfo.generate_code; 2239 init_procinfo.resetprocdef; 2240 release_main_proc(init_procinfo); 2241 end; 2242 if assigned(finalize_procinfo) then 2243 begin 2244 if force_init_final or 2245 cnodeutils.force_init or 2246 not(has_no_code(finalize_procinfo.code)) then 2247 begin 2248 finalize_procinfo.code:=cnodeutils.wrap_proc_body(finalize_procinfo.procdef,finalize_procinfo.code); 2249 finalize_procinfo.generate_code; 2250 current_module.flags:=current_module.flags or uf_finalize; 2251 end; 2252 finalize_procinfo.resetprocdef; 2253 release_main_proc(finalize_procinfo); 2254 end; 2255 2256 symtablestack.pop(current_module.localsymtable); 2257 2258 { consume the last point } 2259 consume(_POINT); 2260 2261 { reset wpo flags for all defs } 2262 reset_all_defs; 2263 2264 if (Errorcount=0) then 2265 begin 2266 { test static symtable } 2267 tstoredsymtable(current_module.localsymtable).allsymbolsused; 2268 tstoredsymtable(current_module.localsymtable).allprivatesused; 2269 tstoredsymtable(current_module.localsymtable).check_forwards; 2270 2271 current_module.allunitsused; 2272 end; 2273 2274 { leave when we got an error } 2275 if (Errorcount>0) and not status.skip_error then 2276 begin 2277 Message1(unit_f_errors_in_unit,tostr(Errorcount)); 2278 status.skip_error:=true; 2279 exit; 2280 end; 2281 2282 { remove all unused units, this happens when units are removed 2283 from the uses clause in the source and the ppu was already being loaded } 2284 hp:=tmodule(loaded_units.first); 2285 while assigned(hp) do 2286 begin 2287 hp2:=hp; 2288 hp:=tmodule(hp.next); 2289 if hp2.is_unit and 2290 not assigned(hp2.globalsymtable) then 2291 begin 2292 loaded_units.remove(hp2); 2293 unloaded_units.concat(hp2); 2294 end; 2295 end; 2296 2297 { do we need to add the variants unit? } 2298 maybeloadvariantsunit; 2299 2300 { Now that everything has been compiled we know if we need resource 2301 support. If not, remove the unit. } 2302 resources_used:=MaybeRemoveResUnit; 2303 2304 linker.initsysinitunitname; 2305 if target_info.system in systems_internal_sysinit then 2306 begin 2307 { add start/halt unit } 2308 sysinitmod:=AddUnit(linker.sysinitunit); 2309 end 2310 else 2311 sysinitmod:=nil; 2312 2313 {$ifdef arm} 2314 { Insert .pdata section for arm-wince. 2315 It is needed for exception handling. } 2316 if target_info.system in [system_arm_wince] then 2317 InsertPData; 2318 {$endif arm} 2319 2320 cnodeutils.InsertThreadvars; 2321 2322 { generate rtti/init tables } 2323 write_persistent_type_info(current_module.localsymtable,false); 2324 2325 { if an Objective-C module, generate rtti and module info } 2326 MaybeGenerateObjectiveCImageInfo(nil,current_module.localsymtable); 2327 2328 { generate debuginfo } 2329 if (cs_debuginfo in current_settings.moduleswitches) then 2330 current_debuginfo.inserttypeinfo; 2331 2332 if islibrary or (target_info.system in systems_unit_program_exports) then 2333 exportlib.generatelib; 2334 2335 { Reference all DEBUGINFO sections from the main .fpc section } 2336 if (cs_debuginfo in current_settings.moduleswitches) then 2337 current_debuginfo.referencesections(current_asmdata.asmlists[al_procedures]); 2338 2339 { Resource strings } 2340 GenerateResourceStrings; 2341 2342 { Windows widestring needing initialization } 2343 cnodeutils.InsertWideInits; 2344 2345 { Resourcestring references (const foo:string=someresourcestring) } 2346 cnodeutils.InsertResStrInits; 2347 2348 { insert Tables and StackLength } 2349 cnodeutils.InsertInitFinalTable; 2350 cnodeutils.InsertThreadvarTablesTable; 2351 cnodeutils.InsertResourceTablesTable; 2352 cnodeutils.InsertWideInitsTablesTable; 2353 cnodeutils.InsertResStrTablesTable; 2354 cnodeutils.InsertMemorySizes; 2355 2356 { Insert symbol to resource info } 2357 cnodeutils.InsertResourceInfo(resources_used); 2358 2359 { create callframe info } 2360 create_dwarf_frame; 2361 2362 { create import library for all packages } 2363 if packagelist.count>0 then 2364 createimportlibfromexternals; 2365 2366 { generate imports } 2367 if current_module.ImportLibraryList.Count>0 then 2368 importlib.generatelib; 2369 2370 { insert own objectfile } 2371 insertobjectfile; 2372 2373 { assemble and link } 2374 create_objectfile; 2375 2376 { We might need the symbols info if not using 2377 the default do_extractsymbolinfo 2378 which is a dummy function PM } 2379 needsymbolinfo:= 2380 (do_extractsymbolinfo<>@def_extractsymbolinfo) or 2381 ((current_settings.genwpoptimizerswitches*WPOptimizationsNeedingAllUnitInfo)<>[]); 2382 2383 { release all local symtables that are not needed anymore } 2384 if (not needsymbolinfo) then 2385 free_localsymtables(current_module.localsymtable); 2386 2387 { leave when we got an error } 2388 if (Errorcount>0) and not status.skip_error then 2389 begin 2390 Message1(unit_f_errors_in_unit,tostr(Errorcount)); 2391 status.skip_error:=true; 2392 exit; 2393 end; 2394 2395 if (not current_module.is_unit) then 2396 begin 2397 { create the executable when we are at level 1 } 2398 if (compile_level=1) then 2399 begin 2400 { create global resource file by collecting all resource files } 2401 CollectResourceFiles; 2402 { write .def file } 2403 if (cs_link_deffile in current_settings.globalswitches) then 2404 deffile.writefile; 2405 { link SysInit (if any) first, to have behavior consistent with 2406 assembler startup files } 2407 if assigned(sysinitmod) then 2408 linker.AddModuleFiles(sysinitmod); 2409 { Does any unit use checkpointer function } 2410 program_uses_checkpointer:=false; 2411 { insert all .o files from all loaded units and 2412 unload the units, we don't need them anymore. 2413 Keep the current_module because that is still needed } 2414 hp:=tmodule(loaded_units.first); 2415 while assigned(hp) do 2416 begin 2417 if (hp<>sysinitmod) and (hp.flags and uf_in_library=0) then 2418 begin 2419 linker.AddModuleFiles(hp); 2420 if (hp.flags and uf_checkpointer_called)<>0 then 2421 program_uses_checkpointer:=true; 2422 end; 2423 hp2:=tmodule(hp.next); 2424 if assigned(hp.package) then 2425 add_package_unit_ref(hp.package); 2426 if (hp<>current_module) and 2427 (not needsymbolinfo) then 2428 begin 2429 loaded_units.remove(hp); 2430 hp.free; 2431 end; 2432 hp:=hp2; 2433 end; 2434 { free also unneeded units we didn't free before } 2435 if not needsymbolinfo then 2436 unloaded_units.Clear; 2437 { Does any unit use checkpointer function } 2438 if program_uses_checkpointer then 2439 Message1(link_w_program_uses_checkpointer,current_module.modulename^); 2440 2441 { add all directly used packages as libraries } 2442 add_package_libs(linker); 2443 { finally we can create an executable } 2444 if current_module.islibrary then 2445 linker.MakeSharedLibrary 2446 else 2447 linker.MakeExecutable; 2448 2449 { collect all necessary information for whole-program optimization } 2450 wpoinfomanager.extractwpoinfofromprogram; 2451 end; 2452 2453 2454 { Give Fatal with error count for linker errors } 2455 if (Errorcount>0) and not status.skip_error then 2456 begin 2457 Message1(unit_f_errors_in_unit,tostr(Errorcount)); 2458 status.skip_error:=true; 2459 end; 2460 end; 2461 end; 2462 2463 end. 2464