pmodules.pas 90 KB

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