pmodules.pas 88 KB

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