pmodules.pas 92 KB

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