pmodules.pas 88 KB

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