pmodules.pas 98 KB

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