2
0

pmodules.pas 90 KB

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