pmodules.pas 87 KB

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