pmodules.pas 55 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498
  1. {
  2. Copyright (c) 1998-2002 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. procedure proc_unit;
  21. procedure proc_program(islibrary : boolean);
  22. implementation
  23. uses
  24. globtype,version,systems,tokens,
  25. cutils,cclasses,comphook,
  26. globals,verbose,fmodule,finput,fppu,
  27. symconst,symbase,symtype,symdef,symsym,symtable,
  28. aasmtai,aasmdata,aasmcpu,aasmbase,
  29. cgbase,cgobj,
  30. nbas,ncgutil,
  31. link,assemble,import,export,gendef,ppu,comprsrc,dbgbase,
  32. cresstr,procinfo,
  33. pexports,
  34. scanner,pbase,pexpr,psystem,psub,pdecsub;
  35. procedure create_objectfile;
  36. var
  37. DLLScanner : TDLLScanner;
  38. s : string;
  39. KeepShared : TStringList;
  40. begin
  41. { try to create import entries from system dlls }
  42. if (tf_has_dllscanner in target_info.flags) and
  43. (not current_module.linkOtherSharedLibs.Empty) then
  44. begin
  45. { Init DLLScanner }
  46. if assigned(CDLLScanner[target_info.system]) then
  47. DLLScanner:=CDLLScanner[target_info.system].Create
  48. else
  49. internalerror(200104121);
  50. KeepShared:=TStringList.Create;
  51. { Walk all shared libs }
  52. While not current_module.linkOtherSharedLibs.Empty do
  53. begin
  54. S:=current_module.linkOtherSharedLibs.Getusemask(link_always);
  55. if not DLLScanner.scan(s) then
  56. KeepShared.Concat(s);
  57. end;
  58. DLLscanner.Free;
  59. { Recreate import section }
  60. if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
  61. begin
  62. if assigned(current_asmdata.asmlists[al_imports]) then
  63. current_asmdata.asmlists[al_imports].clear
  64. else
  65. current_asmdata.asmlists[al_imports]:=TAsmList.Create;
  66. importlib.generatelib;
  67. end;
  68. { Readd the not processed files }
  69. while not KeepShared.Empty do
  70. begin
  71. s:=KeepShared.GetFirst;
  72. current_module.linkOtherSharedLibs.add(s,link_always);
  73. end;
  74. KeepShared.Free;
  75. end;
  76. { Start and end module debuginfo, at least required for stabs
  77. to insert n_sourcefile lines }
  78. if (cs_debuginfo in current_settings.moduleswitches) or
  79. (cs_use_lineinfo in current_settings.globalswitches) then
  80. debuginfo.insertmoduleinfo;
  81. { create the .s file and assemble it }
  82. GenerateAsm(false);
  83. { Also create a smartlinked version ? }
  84. if (cs_create_smart in current_settings.moduleswitches) and
  85. (not use_smartlink_section) then
  86. begin
  87. GenerateAsm(true);
  88. if (af_needar in target_asm.flags) then
  89. Linker.MakeStaticLibrary;
  90. end;
  91. { resource files }
  92. CompileResourceFiles;
  93. end;
  94. procedure insertobjectfile;
  95. { Insert the used object file for this unit in the used list for this unit }
  96. begin
  97. current_module.linkunitofiles.add(current_module.objfilename^,link_static);
  98. current_module.flags:=current_module.flags or uf_static_linked;
  99. if (cs_create_smart in current_settings.moduleswitches) and
  100. not use_smartlink_section then
  101. begin
  102. current_module.linkunitstaticlibs.add(current_module.staticlibfilename^,link_smart);
  103. current_module.flags:=current_module.flags or uf_smart_linked;
  104. end;
  105. end;
  106. procedure create_dwarf;
  107. begin
  108. { Dwarf conflicts with smartlinking in separate .a files }
  109. if (cs_create_smart in current_settings.moduleswitches) and
  110. not use_smartlink_section then
  111. exit;
  112. { Call frame information }
  113. if (tf_needs_dwarf_cfi in target_info.flags) and
  114. (af_supports_dwarf in target_asm.flags) then
  115. begin
  116. current_asmdata.asmlists[al_dwarf]:=TAsmList.create;
  117. current_asmdata.asmcfi.generate_code(current_asmdata.asmlists[al_dwarf]);
  118. end;
  119. end;
  120. procedure InsertThreadvarTablesTable;
  121. var
  122. hp : tused_unit;
  123. ltvTables : TAsmList;
  124. count : longint;
  125. begin
  126. if (tf_section_threadvars in target_info.flags) then
  127. exit;
  128. ltvTables:=TAsmList.Create;
  129. count:=0;
  130. hp:=tused_unit(usedunits.first);
  131. while assigned(hp) do
  132. begin
  133. If (hp.u.flags and uf_threadvars)=uf_threadvars then
  134. begin
  135. ltvTables.concat(Tai_const.Createname(make_mangledname('THREADVARLIST',hp.u.globalsymtable,''),0));
  136. inc(count);
  137. end;
  138. hp:=tused_unit(hp.next);
  139. end;
  140. { Add program threadvars, if any }
  141. If (current_module.flags and uf_threadvars)=uf_threadvars then
  142. begin
  143. ltvTables.concat(Tai_const.Createname(make_mangledname('THREADVARLIST',current_module.localsymtable,''),0));
  144. inc(count);
  145. end;
  146. { Insert TableCount at start }
  147. ltvTables.insert(Tai_const.Create_32bit(count));
  148. { insert in data segment }
  149. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  150. new_section(current_asmdata.asmlists[al_globals],sec_data,'FPC_THREADVARTABLES',sizeof(aint));
  151. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('FPC_THREADVARTABLES',AT_DATA,0));
  152. current_asmdata.asmlists[al_globals].concatlist(ltvTables);
  153. current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('FPC_THREADVARTABLES'));
  154. ltvTables.free;
  155. end;
  156. procedure AddToThreadvarList(p:tnamedindexitem;arg:pointer);
  157. var
  158. ltvTable : TAsmList;
  159. begin
  160. ltvTable:=TAsmList(arg);
  161. if (tsym(p).typ=globalvarsym) and
  162. (vo_is_thread_var in tglobalvarsym(p).varoptions) then
  163. begin
  164. { address of threadvar }
  165. ltvTable.concat(tai_const.Createname(tglobalvarsym(p).mangledname,0));
  166. { size of threadvar }
  167. ltvTable.concat(tai_const.create_32bit(tglobalvarsym(p).getsize));
  168. end;
  169. end;
  170. procedure InsertThreadvars;
  171. var
  172. s : string;
  173. ltvTable : TAsmList;
  174. begin
  175. if (tf_section_threadvars in target_info.flags) then
  176. exit;
  177. ltvTable:=TAsmList.create;
  178. if assigned(current_module.globalsymtable) then
  179. current_module.globalsymtable.foreach_static(@AddToThreadvarList,ltvTable);
  180. current_module.localsymtable.foreach_static(@AddToThreadvarList,ltvTable);
  181. if ltvTable.first<>nil then
  182. begin
  183. s:=make_mangledname('THREADVARLIST',current_module.localsymtable,'');
  184. { end of the list marker }
  185. ltvTable.concat(tai_const.create_sym(nil));
  186. { add to datasegment }
  187. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  188. new_section(current_asmdata.asmlists[al_globals],sec_data,s,sizeof(aint));
  189. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0));
  190. current_asmdata.asmlists[al_globals].concatlist(ltvTable);
  191. current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(s));
  192. current_module.flags:=current_module.flags or uf_threadvars;
  193. end;
  194. ltvTable.Free;
  195. end;
  196. {$ifdef arm}
  197. procedure InsertPData;
  198. begin
  199. new_section(current_asmdata.asmlists[al_globals],sec_pdata,'FPC_EH_PROLOG',sizeof(aint));
  200. current_asmdata.asmlists[al_globals].concat(Tai_const.Createname('_ARM_ExceptionHandler', 0));
  201. current_asmdata.asmlists[al_globals].concat(Tai_const.Create_32bit(0));
  202. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('FPC_EH_CODE_START',AT_DATA,0));
  203. new_section(current_asmdata.asmlists[al_globals],sec_pdata,'',sizeof(aint));
  204. current_asmdata.asmlists[al_globals].concat(Tai_const.Createname('FPC_EH_CODE_START', 0));
  205. current_asmdata.asmlists[al_globals].concat(Tai_const.Create_32bit($cfffff02));
  206. end;
  207. {$endif arm}
  208. Procedure InsertResourceInfo;
  209. var
  210. hp : tused_unit;
  211. found : Boolean;
  212. I : Integer;
  213. ResourceInfo : TAsmList;
  214. begin
  215. if target_res.id=res_elf then
  216. begin
  217. hp:=tused_unit(usedunits.first);
  218. found:=false;
  219. Found:=((current_module.flags and uf_has_resourcefiles)=uf_has_resourcefiles);
  220. If not found then
  221. While Assigned(hp) and not Found do
  222. begin
  223. Found:=((hp.u.flags and uf_has_resourcefiles)=uf_has_resourcefiles);
  224. hp:=tused_unit(hp.next);
  225. end;
  226. ResourceInfo:=TAsmList.Create;
  227. if found then
  228. begin
  229. { Valid pointer to resource information }
  230. ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESLOCATION',AT_DATA,0));
  231. ResourceInfo.concat(Tai_const.Createname('FPC_RESSYMBOL',0));
  232. {$ifdef EXTERNALRESPTRS}
  233. current_module.linkotherofiles.add('resptrs.o',link_always);
  234. {$else EXTERNALRESPTRS}
  235. new_section(ResourceInfo,sec_fpc,'resptrs',4);
  236. ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESSYMBOL',AT_DATA,0));
  237. For I:=1 to 32 do
  238. ResourceInfo.Concat(Tai_const.Create_32bit(0));
  239. {$endif EXTERNALRESPTRS}
  240. end
  241. else
  242. begin
  243. { Nil pointer to resource information }
  244. ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESLOCATION',AT_DATA,0));
  245. ResourceInfo.Concat(Tai_const.Create_32bit(0));
  246. end;
  247. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  248. current_asmdata.asmlists[al_globals].concatlist(ResourceInfo);
  249. ResourceInfo.free;
  250. end;
  251. end;
  252. Procedure InsertResourceTablesTable;
  253. var
  254. hp : tmodule;
  255. ResourceStringTables : tasmlist;
  256. count : longint;
  257. begin
  258. ResourceStringTables:=tasmlist.Create;
  259. count:=0;
  260. hp:=tmodule(loaded_units.first);
  261. while assigned(hp) do
  262. begin
  263. If (hp.flags and uf_has_resourcestrings)=uf_has_resourcestrings then
  264. begin
  265. ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESSTR',hp.localsymtable,'START'),0));
  266. ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESSTR',hp.localsymtable,'END'),0));
  267. inc(count);
  268. end;
  269. hp:=tmodule(hp.next);
  270. end;
  271. { Insert TableCount at start }
  272. ResourceStringTables.insert(Tai_const.Create_aint(count));
  273. { Add to data segment }
  274. maybe_new_object_file(current_asmdata.AsmLists[al_globals]);
  275. new_section(current_asmdata.AsmLists[al_globals],sec_data,'FPC_RESOURCESTRINGTABLES',sizeof(aint));
  276. current_asmdata.AsmLists[al_globals].concat(Tai_symbol.Createname_global('FPC_RESOURCESTRINGTABLES',AT_DATA,0));
  277. current_asmdata.AsmLists[al_globals].concatlist(ResourceStringTables);
  278. current_asmdata.AsmLists[al_globals].concat(Tai_symbol_end.Createname('FPC_RESOURCESTRINGTABLES'));
  279. ResourceStringTables.free;
  280. end;
  281. procedure InsertInitFinalTable;
  282. var
  283. hp : tused_unit;
  284. unitinits : TAsmList;
  285. count : longint;
  286. begin
  287. unitinits:=TAsmList.Create;
  288. count:=0;
  289. hp:=tused_unit(usedunits.first);
  290. while assigned(hp) do
  291. begin
  292. { call the unit init code and make it external }
  293. if (hp.u.flags and (uf_init or uf_finalize))<>0 then
  294. begin
  295. if (hp.u.flags and uf_init)<>0 then
  296. unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',hp.u.globalsymtable,''),0))
  297. else
  298. unitinits.concat(Tai_const.Create_sym(nil));
  299. if (hp.u.flags and uf_finalize)<>0 then
  300. unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',hp.u.globalsymtable,''),0))
  301. else
  302. unitinits.concat(Tai_const.Create_sym(nil));
  303. inc(count);
  304. end;
  305. hp:=tused_unit(hp.next);
  306. end;
  307. { Insert initialization/finalization of the program }
  308. if (current_module.flags and (uf_init or uf_finalize))<>0 then
  309. begin
  310. if (current_module.flags and uf_init)<>0 then
  311. unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',current_module.localsymtable,''),0))
  312. else
  313. unitinits.concat(Tai_const.Create_sym(nil));
  314. if (current_module.flags and uf_finalize)<>0 then
  315. unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',current_module.localsymtable,''),0))
  316. else
  317. unitinits.concat(Tai_const.Create_sym(nil));
  318. inc(count);
  319. end;
  320. { Insert TableCount,InitCount at start }
  321. unitinits.insert(Tai_const.Create_32bit(0));
  322. unitinits.insert(Tai_const.Create_32bit(count));
  323. { Add to data segment }
  324. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  325. new_section(current_asmdata.asmlists[al_globals],sec_data,'INITFINAL',sizeof(aint));
  326. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('INITFINAL',AT_DATA,0));
  327. current_asmdata.asmlists[al_globals].concatlist(unitinits);
  328. current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('INITFINAL'));
  329. unitinits.free;
  330. end;
  331. procedure insertmemorysizes;
  332. {$IFDEF POWERPC}
  333. var
  334. stkcookie: string;
  335. {$ENDIF POWERPC}
  336. begin
  337. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  338. { Insert Ident of the compiler in the main .data section }
  339. current_asmdata.asmlists[al_globals].concat(Tai_section.create(sec_data,'',0));
  340. current_asmdata.asmlists[al_globals].concat(Tai_align.Create(const_align(32)));
  341. current_asmdata.asmlists[al_globals].concat(Tai_string.Create('FPC '+full_version_string+
  342. ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname));
  343. { stacksize can be specified and is now simulated }
  344. new_section(current_asmdata.asmlists[al_globals],sec_data,'__stklen', sizeof(aint));
  345. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__stklen',AT_DATA,sizeof(aint)));
  346. current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(stacksize));
  347. {$IFDEF POWERPC}
  348. { AmigaOS4 "stack cookie" support }
  349. if ( target_info.system = system_powerpc_amiga ) then
  350. begin
  351. { this symbol is needed to ignite powerpc amigaos' }
  352. { stack allocation magic for us with the given stack size. }
  353. { note: won't work for m68k amigaos or morphos. (KB) }
  354. str(stacksize,stkcookie);
  355. stkcookie:='$STACK: '+stkcookie+#0;
  356. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  357. new_section(current_asmdata.asmlists[al_globals],sec_data,'__stack_cookie',length(stkcookie));
  358. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__stack_cookie',AT_DATA,length(stkcookie)));
  359. current_asmdata.asmlists[al_globals].concat(Tai_string.Create(stkcookie));
  360. end;
  361. {$ENDIF POWERPC}
  362. { Initial heapsize }
  363. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  364. new_section(current_asmdata.asmlists[al_globals],sec_data,'__heapsize',sizeof(aint));
  365. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__heapsize',AT_DATA,sizeof(aint)));
  366. current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(heapsize));
  367. end;
  368. procedure AddUnit(const s:string);
  369. var
  370. hp : tppumodule;
  371. unitsym : tunitsym;
  372. begin
  373. { load unit }
  374. hp:=registerunit(current_module,s,'');
  375. hp.loadppu;
  376. hp.adddependency(current_module);
  377. { add to symtable stack }
  378. symtablestack.push(hp.globalsymtable);
  379. if (m_mac in current_settings.modeswitches) and
  380. assigned(hp.globalmacrosymtable) then
  381. macrosymtablestack.push(hp.globalmacrosymtable);
  382. { insert unitsym }
  383. unitsym:=tunitsym.create(s,hp);
  384. inc(unitsym.refs);
  385. current_module.localsymtable.insert(unitsym);
  386. { add to used units }
  387. current_module.addusedunit(hp,false,unitsym);
  388. end;
  389. procedure maybeloadvariantsunit;
  390. var
  391. hp : tmodule;
  392. begin
  393. { Do we need the variants unit? Skip this
  394. for VarUtils unit for bootstrapping }
  395. if (current_module.flags and uf_uses_variants=0) or
  396. (current_module.modulename^='VARUTILS') then
  397. exit;
  398. { Variants unit already loaded? }
  399. hp:=tmodule(loaded_units.first);
  400. while assigned(hp) do
  401. begin
  402. if hp.modulename^='VARIANTS' then
  403. exit;
  404. hp:=tmodule(hp.next);
  405. end;
  406. { Variants unit is not loaded yet, load it now }
  407. Message(parser_w_implicit_uses_of_variants_unit);
  408. AddUnit('Variants');
  409. end;
  410. procedure loaddefaultunits;
  411. begin
  412. { we are going to rebuild the symtablestack, clear it first }
  413. symtablestack.clear;
  414. macrosymtablestack.clear;
  415. { macro symtable }
  416. macrosymtablestack.push(initialmacrosymtable);
  417. { are we compiling the system unit? }
  418. if (cs_compilesystem in current_settings.moduleswitches) then
  419. begin
  420. systemunit:=tglobalsymtable(current_module.localsymtable);
  421. { create system defines }
  422. create_intern_symbols;
  423. create_intern_types;
  424. exit;
  425. end;
  426. { insert the system unit, it is allways the first. Load also the
  427. internal types from the system unit }
  428. AddUnit('System');
  429. systemunit:=tglobalsymtable(symtablestack.top);
  430. load_intern_types;
  431. { Set the owner of errorsym and errortype to symtable to
  432. prevent crashes when accessing .owner }
  433. generrorsym.owner:=systemunit;
  434. generrordef.owner:=systemunit;
  435. { Units only required for main module }
  436. if not(current_module.is_unit) then
  437. begin
  438. { Heaptrc unit, load heaptrace before any other units especially objpas }
  439. if (cs_use_heaptrc in current_settings.globalswitches) then
  440. AddUnit('HeapTrc');
  441. { Lineinfo unit }
  442. if (cs_use_lineinfo in current_settings.globalswitches) then
  443. AddUnit('LineInfo');
  444. { Lineinfo unit }
  445. if (cs_gdb_valgrind in current_settings.globalswitches) then
  446. AddUnit('CMem');
  447. {$ifdef cpufpemu}
  448. { Floating point emulation unit?
  449. softfpu must be in the system unit anyways (FK)
  450. if (cs_fp_emulation in current_settings.moduleswitches) and not(target_info.system in system_wince) then
  451. AddUnit('SoftFpu');
  452. }
  453. {$endif cpufpemu}
  454. end;
  455. { Objpas unit? }
  456. if m_objpas in current_settings.modeswitches then
  457. AddUnit('ObjPas');
  458. { Macpas unit? }
  459. if m_mac in current_settings.modeswitches then
  460. AddUnit('MacPas');
  461. { Profile unit? Needed for go32v2 only }
  462. if (cs_profile in current_settings.moduleswitches) and
  463. (target_info.system in [system_i386_go32v2,system_i386_watcom]) then
  464. AddUnit('Profile');
  465. if (cs_load_fpcylix_unit in current_settings.globalswitches) then
  466. begin
  467. AddUnit('FPCylix');
  468. AddUnit('DynLibs');
  469. end;
  470. end;
  471. procedure loadautounits;
  472. var
  473. hs,s : string;
  474. begin
  475. hs:=autoloadunits;
  476. repeat
  477. s:=GetToken(hs,',');
  478. if s='' then
  479. break;
  480. AddUnit(s);
  481. until false;
  482. end;
  483. procedure loadunits;
  484. var
  485. s,sorg : stringid;
  486. fn : string;
  487. pu : tused_unit;
  488. hp2 : tmodule;
  489. unitsym : tunitsym;
  490. begin
  491. consume(_USES);
  492. repeat
  493. s:=pattern;
  494. sorg:=orgpattern;
  495. consume(_ID);
  496. { support "<unit> in '<file>'" construct, but not for tp7 }
  497. fn:='';
  498. if not(m_tp7 in current_settings.modeswitches) and
  499. try_to_consume(_OP_IN) then
  500. fn:=FixFileName(get_stringconst);
  501. { Give a warning if objpas is loaded }
  502. if s='OBJPAS' then
  503. Message(parser_w_no_objpas_use_mode);
  504. { Using the unit itself is not possible }
  505. if (s<>current_module.modulename^) then
  506. begin
  507. { check if the unit is already used }
  508. hp2:=nil;
  509. pu:=tused_unit(current_module.used_units.first);
  510. while assigned(pu) do
  511. begin
  512. if (pu.u.modulename^=s) then
  513. begin
  514. hp2:=pu.u;
  515. break;
  516. end;
  517. pu:=tused_unit(pu.next);
  518. end;
  519. if not assigned(hp2) then
  520. hp2:=registerunit(current_module,sorg,fn)
  521. else
  522. Message1(sym_e_duplicate_id,s);
  523. { Create unitsym, we need to use the name as specified, we
  524. can not use the modulename because that can be different
  525. when -Un is used }
  526. unitsym:=tunitsym.create(sorg,nil);
  527. current_module.localsymtable.insert(unitsym);
  528. { the current module uses the unit hp2 }
  529. current_module.addusedunit(hp2,true,unitsym);
  530. end
  531. else
  532. Message1(sym_e_duplicate_id,s);
  533. if token=_COMMA then
  534. begin
  535. pattern:='';
  536. consume(_COMMA);
  537. end
  538. else
  539. break;
  540. until false;
  541. { Load the units }
  542. pu:=tused_unit(current_module.used_units.first);
  543. while assigned(pu) do
  544. begin
  545. { Only load the units that are in the current
  546. (interface/implementation) uses clause }
  547. if pu.in_uses and
  548. (pu.in_interface=current_module.in_interface) then
  549. begin
  550. tppumodule(pu.u).loadppu;
  551. { is our module compiled? then we can stop }
  552. if current_module.state=ms_compiled then
  553. exit;
  554. { add this unit to the dependencies }
  555. pu.u.adddependency(current_module);
  556. { save crc values }
  557. pu.checksum:=pu.u.crc;
  558. pu.interface_checksum:=pu.u.interface_crc;
  559. { connect unitsym to the module }
  560. pu.unitsym.module:=pu.u;
  561. { add to symtable stack }
  562. symtablestack.push(pu.u.globalsymtable);
  563. if (m_mac in current_settings.modeswitches) and
  564. assigned(pu.u.globalmacrosymtable) then
  565. macrosymtablestack.push(pu.u.globalmacrosymtable);
  566. end;
  567. pu:=tused_unit(pu.next);
  568. end;
  569. consume(_SEMICOLON);
  570. end;
  571. procedure reset_all_defs;
  572. procedure reset_used_unit_defs(hp:tmodule);
  573. var
  574. pu : tused_unit;
  575. begin
  576. pu:=tused_unit(hp.used_units.first);
  577. while assigned(pu) do
  578. begin
  579. if not pu.u.is_reset then
  580. begin
  581. { prevent infinte loop for circular dependencies }
  582. pu.u.is_reset:=true;
  583. if assigned(pu.u.globalsymtable) then
  584. begin
  585. tglobalsymtable(pu.u.globalsymtable).reset_all_defs;
  586. reset_used_unit_defs(pu.u);
  587. end;
  588. end;
  589. pu:=tused_unit(pu.next);
  590. end;
  591. end;
  592. var
  593. hp2 : tmodule;
  594. begin
  595. hp2:=tmodule(loaded_units.first);
  596. while assigned(hp2) do
  597. begin
  598. hp2.is_reset:=false;
  599. hp2:=tmodule(hp2.next);
  600. end;
  601. reset_used_unit_defs(current_module);
  602. end;
  603. procedure free_localsymtables(st:tsymtable);
  604. var
  605. def : tstoreddef;
  606. pd : tprocdef;
  607. begin
  608. def:=tstoreddef(st.defindex.first);
  609. while assigned(def) do
  610. begin
  611. if def.deftype=procdef then
  612. begin
  613. pd:=tprocdef(def);
  614. if assigned(pd.localst) and
  615. (pd.localst.symtabletype<>staticsymtable) and
  616. not((po_inline in pd.procoptions) or
  617. ((current_module.flags and uf_local_browser)<>0)) then
  618. begin
  619. free_localsymtables(pd.localst);
  620. pd.localst.free;
  621. pd.localst:=nil;
  622. end;
  623. end;
  624. def:=tstoreddef(def.indexnext);
  625. end;
  626. end;
  627. procedure parse_implementation_uses;
  628. begin
  629. if token=_USES then
  630. loadunits;
  631. end;
  632. procedure setupglobalswitches;
  633. begin
  634. { can't have local browser when no global browser }
  635. if (cs_local_browser in current_settings.moduleswitches) and
  636. not(cs_browser in current_settings.moduleswitches) then
  637. exclude(current_settings.moduleswitches,cs_local_browser);
  638. if (cs_create_pic in current_settings.moduleswitches) then
  639. begin
  640. def_system_macro('FPC_PIC');
  641. def_system_macro('PIC');
  642. end;
  643. end;
  644. function create_main_proc(const name:string;potype:tproctypeoption;st:tsymtable):tprocdef;
  645. var
  646. ps : tprocsym;
  647. pd : tprocdef;
  648. begin
  649. { there should be no current_procinfo available }
  650. if assigned(current_procinfo) then
  651. internalerror(200304275);
  652. {Generate a procsym for main}
  653. ps:=tprocsym.create('$'+name);
  654. { main are allways used }
  655. inc(ps.refs);
  656. st.insert(ps);
  657. pd:=tprocdef.create(main_program_level);
  658. include(pd.procoptions,po_global);
  659. pd.procsym:=ps;
  660. ps.addprocdef(pd);
  661. { set procdef options }
  662. pd.proctypeoption:=potype;
  663. pd.proccalloption:=pocall_default;
  664. pd.forwarddef:=false;
  665. pd.setmangledname(target_info.cprefix+name);
  666. pd.aliasnames.insert(pd.mangledname);
  667. handle_calling_convention(pd);
  668. { We don't need is a local symtable. Change it into the static
  669. symtable }
  670. pd.localst.free;
  671. pd.localst:=st;
  672. { set procinfo and current_procinfo.procdef }
  673. current_procinfo:=cprocinfo.create(nil);
  674. current_module.procinfo:=current_procinfo;
  675. current_procinfo.procdef:=pd;
  676. { return procdef }
  677. create_main_proc:=pd;
  678. { main proc does always a call e.g. to init system unit }
  679. include(current_procinfo.flags,pi_do_call);
  680. end;
  681. procedure release_main_proc(pd:tprocdef);
  682. begin
  683. { this is a main proc, so there should be no parent }
  684. if not(assigned(current_procinfo)) or
  685. assigned(current_procinfo.parent) or
  686. not(current_procinfo.procdef=pd) then
  687. internalerror(200304276);
  688. { remove procinfo }
  689. current_module.procinfo:=nil;
  690. current_procinfo.free;
  691. current_procinfo:=nil;
  692. { remove localst as it was replaced by staticsymtable }
  693. pd.localst:=nil;
  694. end;
  695. procedure gen_implicit_initfinal(flag:word;st:tsymtable);
  696. var
  697. pd : tprocdef;
  698. begin
  699. { update module flags }
  700. current_module.flags:=current_module.flags or flag;
  701. { create procdef }
  702. case flag of
  703. uf_init :
  704. begin
  705. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'init_implicit'),potype_unitinit,st);
  706. pd.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
  707. end;
  708. uf_finalize :
  709. begin
  710. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize_implicit'),potype_unitfinalize,st);
  711. pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
  712. end;
  713. else
  714. internalerror(200304253);
  715. end;
  716. tcgprocinfo(current_procinfo).code:=cnothingnode.create;
  717. tcgprocinfo(current_procinfo).generate_code;
  718. release_main_proc(pd);
  719. end;
  720. procedure copy_macro(p:TNamedIndexItem; arg:pointer);
  721. begin
  722. current_module.globalmacrosymtable.insert(tmacro(p).getcopy);
  723. end;
  724. procedure proc_unit;
  725. function is_assembler_generated:boolean;
  726. var
  727. hal : tasmlisttype;
  728. begin
  729. result:=false;
  730. if Errorcount=0 then
  731. begin
  732. for hal:=low(TasmlistType) to high(TasmlistType) do
  733. if not current_asmdata.asmlists[hal].empty then
  734. begin
  735. result:=true;
  736. exit;
  737. end;
  738. end;
  739. end;
  740. var
  741. main_file: tinputfile;
  742. {$ifdef EXTDEBUG}
  743. store_crc,
  744. {$endif EXTDEBUG}
  745. store_interface_crc : cardinal;
  746. s1,s2 : ^string; {Saves stack space}
  747. force_init_final : boolean;
  748. pd : tprocdef;
  749. unitname8 : string[8];
  750. has_impl,ag: boolean;
  751. {$ifdef i386}
  752. globalvarsym : tglobalvarsym;
  753. {$endif i386}
  754. begin
  755. if m_mac in current_settings.modeswitches then
  756. current_module.mode_switch_allowed:= false;
  757. consume(_UNIT);
  758. if compile_level=1 then
  759. Status.IsExe:=false;
  760. if token=_ID then
  761. begin
  762. { create filenames and unit name }
  763. main_file := current_scanner.inputfile;
  764. while assigned(main_file.next) do
  765. main_file := main_file.next;
  766. new(s1);
  767. s1^:=current_module.modulename^;
  768. current_module.SetFileName(main_file.path^+main_file.name^,true);
  769. current_module.SetModuleName(orgpattern);
  770. { check for system unit }
  771. new(s2);
  772. s2^:=upper(SplitName(main_file.name^));
  773. unitname8:=copy(current_module.modulename^,1,8);
  774. if (cs_check_unit_name in current_settings.globalswitches) and
  775. (
  776. not(
  777. (current_module.modulename^=s2^) or
  778. (
  779. (length(current_module.modulename^)>8) and
  780. (unitname8=s2^)
  781. )
  782. )
  783. or
  784. (
  785. (length(s1^)>8) and
  786. (s1^<>current_module.modulename^)
  787. )
  788. ) then
  789. Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
  790. if (current_module.modulename^='SYSTEM') then
  791. include(current_settings.moduleswitches,cs_compilesystem);
  792. dispose(s2);
  793. dispose(s1);
  794. end;
  795. if (target_info.system in system_unit_program_exports) then
  796. exportlib.preparelib(current_module.realmodulename^);
  797. consume(_ID);
  798. consume(_SEMICOLON);
  799. consume(_INTERFACE);
  800. { global switches are read, so further changes aren't allowed }
  801. current_module.in_global:=false;
  802. { handle the global switches }
  803. setupglobalswitches;
  804. message1(unit_u_loading_interface_units,current_module.modulename^);
  805. { update status }
  806. status.currentmodule:=current_module.realmodulename^;
  807. { maybe turn off m_objpas if we are compiling objpas }
  808. if (current_module.modulename^='OBJPAS') then
  809. exclude(current_settings.modeswitches,m_objpas);
  810. { maybe turn off m_mac if we are compiling macpas }
  811. if (current_module.modulename^='MACPAS') then
  812. exclude(current_settings.modeswitches,m_mac);
  813. parse_only:=true;
  814. { generate now the global symboltable,
  815. define first as local to overcome dependency conflicts }
  816. current_module.localsymtable:=tglobalsymtable.create(current_module.modulename^,current_module.moduleid);
  817. { insert unitsym of this unit to prevent other units having
  818. the same name }
  819. current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
  820. { load default units, like the system unit }
  821. loaddefaultunits;
  822. { reset }
  823. make_ref:=true;
  824. { insert qualifier for the system unit (allows system.writeln) }
  825. if not(cs_compilesystem in current_settings.moduleswitches) and
  826. (token=_USES) then
  827. begin
  828. loadunits;
  829. { has it been compiled at a higher level ?}
  830. if current_module.state=ms_compiled then
  831. exit;
  832. end;
  833. { move the global symtable from the temporary local to global }
  834. current_module.globalsymtable:=current_module.localsymtable;
  835. current_module.localsymtable:=nil;
  836. reset_all_defs;
  837. { number all units, so we know if a unit is used by this unit or
  838. needs to be added implicitly }
  839. current_module.updatemaps;
  840. { ... parse the declarations }
  841. Message1(parser_u_parsing_interface,current_module.realmodulename^);
  842. symtablestack.push(current_module.globalsymtable);
  843. read_interface_declarations;
  844. symtablestack.pop(current_module.globalsymtable);
  845. { Export macros defined in the interface for macpas. The macros
  846. are put in the globalmacrosymtable that will only be used by other
  847. units. The current unit continues to use the localmacrosymtable }
  848. if (m_mac in current_settings.modeswitches) then
  849. begin
  850. current_module.globalmacrosymtable:=tmacrosymtable.create(true);
  851. current_module.localmacrosymtable.foreach_static(@copy_macro,nil);
  852. end;
  853. { leave when we got an error }
  854. if (Errorcount>0) and not status.skip_error then
  855. begin
  856. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  857. status.skip_error:=true;
  858. exit;
  859. end;
  860. { Our interface is compiled, generate CRC and switch to implementation }
  861. if not(cs_compilesystem in current_settings.moduleswitches) and
  862. (Errorcount=0) then
  863. tppumodule(current_module).getppucrc;
  864. current_module.in_interface:=false;
  865. current_module.interface_compiled:=true;
  866. { First reload all units depending on our interface, we need to do this
  867. in the implementation part to prevent errorneous circular references }
  868. reload_flagged_units;
  869. { Parse the implementation section }
  870. if (m_mac in current_settings.modeswitches) and try_to_consume(_END) then
  871. has_impl:= false
  872. else
  873. has_impl:= true;
  874. parse_only:=false;
  875. { generates static symbol table }
  876. current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
  877. {$ifdef i386}
  878. if cs_create_pic in current_settings.moduleswitches then
  879. begin
  880. { insert symbol for got access in assembler code}
  881. globalvarsym:=tglobalvarsym.create('_GLOBAL_OFFSET_TABLE_',vs_value,voidpointertype,[vo_is_external,vo_is_C_var]);
  882. globalvarsym.set_mangledname('_GLOBAL_OFFSET_TABLE_');
  883. current_module.localsymtable.insert(globalvarsym);
  884. { avoid unnecessary warnings }
  885. globalvarsym.varstate:=vs_read;
  886. globalvarsym.refs:=1;
  887. end;
  888. {$endif i386}
  889. if has_impl then
  890. begin
  891. consume(_IMPLEMENTATION);
  892. Message1(unit_u_loading_implementation_units,current_module.modulename^);
  893. { Read the implementation units }
  894. parse_implementation_uses;
  895. end;
  896. if current_module.state=ms_compiled then
  897. exit;
  898. { reset ranges/stabs in exported definitions }
  899. reset_all_defs;
  900. { All units are read, now give them a number }
  901. current_module.updatemaps;
  902. symtablestack.push(current_module.globalsymtable);
  903. symtablestack.push(current_module.localsymtable);
  904. if has_impl then
  905. begin
  906. Message1(parser_u_parsing_implementation,current_module.modulename^);
  907. if current_module.in_interface then
  908. internalerror(200212285);
  909. { Compile the unit }
  910. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'init'),potype_unitinit,current_module.localsymtable);
  911. pd.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
  912. tcgprocinfo(current_procinfo).parse_body;
  913. tcgprocinfo(current_procinfo).generate_code;
  914. tcgprocinfo(current_procinfo).resetprocdef;
  915. { save file pos for debuginfo }
  916. current_module.mainfilepos:=current_procinfo.entrypos;
  917. release_main_proc(pd);
  918. end;
  919. { Generate specializations of objectdefs methods }
  920. generate_specialization_procs;
  921. { if the unit contains ansi/widestrings, initialization and
  922. finalization code must be forced }
  923. force_init_final:=tglobalsymtable(current_module.globalsymtable).needs_init_final or
  924. tstaticsymtable(current_module.localsymtable).needs_init_final;
  925. { should we force unit initialization? }
  926. { this is a hack, but how can it be done better ? }
  927. if force_init_final and ((current_module.flags and uf_init)=0) then
  928. gen_implicit_initfinal(uf_init,current_module.localsymtable);
  929. { finalize? }
  930. if has_impl and (token=_FINALIZATION) then
  931. begin
  932. { set module options }
  933. current_module.flags:=current_module.flags or uf_finalize;
  934. { Compile the finalize }
  935. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
  936. pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
  937. tcgprocinfo(current_procinfo).parse_body;
  938. tcgprocinfo(current_procinfo).generate_code;
  939. tcgprocinfo(current_procinfo).resetprocdef;
  940. release_main_proc(pd);
  941. end
  942. else if force_init_final then
  943. gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
  944. symtablestack.pop(current_module.localsymtable);
  945. symtablestack.pop(current_module.globalsymtable);
  946. { the last char should always be a point }
  947. consume(_POINT);
  948. if (Errorcount=0) then
  949. begin
  950. { tests, if all (interface) forwards are resolved }
  951. tstoredsymtable(current_module.globalsymtable).check_forwards;
  952. { check if all private fields are used }
  953. tstoredsymtable(current_module.globalsymtable).allprivatesused;
  954. { remove cross unit overloads }
  955. tstoredsymtable(current_module.globalsymtable).unchain_overloaded;
  956. { test static symtable }
  957. tstoredsymtable(current_module.localsymtable).allsymbolsused;
  958. tstoredsymtable(current_module.localsymtable).allprivatesused;
  959. tstoredsymtable(current_module.localsymtable).check_forwards;
  960. tstoredsymtable(current_module.localsymtable).checklabels;
  961. tstoredsymtable(current_module.localsymtable).unchain_overloaded;
  962. { used units }
  963. current_module.allunitsused;
  964. end;
  965. { leave when we got an error }
  966. if (Errorcount>0) and not status.skip_error then
  967. begin
  968. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  969. status.skip_error:=true;
  970. exit;
  971. end;
  972. { do we need to add the variants unit? }
  973. maybeloadvariantsunit;
  974. { generate debuginfo }
  975. if (cs_debuginfo in current_settings.moduleswitches) then
  976. debuginfo.inserttypeinfo;
  977. { generate wrappers for interfaces }
  978. gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.globalsymtable);
  979. gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
  980. { generate pic helpers to load eip if necessary }
  981. gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
  982. { Tables }
  983. insertThreadVars;
  984. { Resource strings }
  985. GenerateResourceStrings;
  986. { generate imports }
  987. if current_module.ImportLibraryList.Count>0 then
  988. importlib.generatelib;
  989. { insert own objectfile, or say that it's in a library
  990. (no check for an .o when loading) }
  991. ag:=is_assembler_generated;
  992. if ag then
  993. insertobjectfile
  994. else
  995. begin
  996. current_module.flags:=current_module.flags or uf_no_link;
  997. current_module.flags:=current_module.flags and not uf_has_debuginfo;
  998. end;
  999. if ag then
  1000. begin
  1001. { create dwarf debuginfo }
  1002. create_dwarf;
  1003. { assemble }
  1004. create_objectfile;
  1005. end;
  1006. { Write out the ppufile after the object file has been created }
  1007. store_interface_crc:=current_module.interface_crc;
  1008. {$ifdef EXTDEBUG}
  1009. store_crc:=current_module.crc;
  1010. {$endif EXTDEBUG}
  1011. if (Errorcount=0) then
  1012. tppumodule(current_module).writeppu;
  1013. if not(cs_compilesystem in current_settings.moduleswitches) then
  1014. if store_interface_crc<>current_module.interface_crc then
  1015. Message1(unit_u_interface_crc_changed,current_module.ppufilename^);
  1016. {$ifdef EXTDEBUG}
  1017. if not(cs_compilesystem in current_settings.moduleswitches) then
  1018. if (store_crc<>current_module.crc) and simplify_ppu then
  1019. Message1(unit_u_implementation_crc_changed,current_module.ppufilename^);
  1020. {$endif EXTDEBUG}
  1021. { release all overload references and local symtables that
  1022. are not needed anymore }
  1023. tstoredsymtable(current_module.localsymtable).unchain_overloaded;
  1024. tstoredsymtable(current_module.globalsymtable).unchain_overloaded;
  1025. free_localsymtables(current_module.globalsymtable);
  1026. free_localsymtables(current_module.localsymtable);
  1027. { leave when we got an error }
  1028. if (Errorcount>0) and not status.skip_error then
  1029. begin
  1030. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1031. status.skip_error:=true;
  1032. exit;
  1033. end;
  1034. Message1(unit_u_finished_compiling,current_module.modulename^);
  1035. end;
  1036. procedure proc_program(islibrary : boolean);
  1037. var
  1038. main_file : tinputfile;
  1039. hp,hp2 : tmodule;
  1040. pd : tprocdef;
  1041. begin
  1042. DLLsource:=islibrary;
  1043. Status.IsLibrary:=IsLibrary;
  1044. Status.IsExe:=true;
  1045. parse_only:=false;
  1046. { DLL defaults to create reloc info }
  1047. if islibrary then
  1048. begin
  1049. if not RelocSectionSetExplicitly then
  1050. RelocSection:=true;
  1051. end;
  1052. { relocation works only without stabs under win32 !! PM }
  1053. { internal assembler uses rva for stabs info
  1054. so it should work with relocated DLLs }
  1055. if RelocSection and
  1056. (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1057. (target_info.assem<>as_i386_pecoff) then
  1058. begin
  1059. include(current_settings.globalswitches,cs_link_strip);
  1060. { Warning stabs info does not work with reloc section !! }
  1061. if cs_debuginfo in current_settings.moduleswitches then
  1062. begin
  1063. Message1(parser_w_parser_reloc_no_debug,current_module.mainsource^);
  1064. Message(parser_w_parser_win32_debug_needs_WN);
  1065. exclude(current_settings.moduleswitches,cs_debuginfo);
  1066. end;
  1067. end;
  1068. { get correct output names }
  1069. main_file := current_scanner.inputfile;
  1070. while assigned(main_file.next) do
  1071. main_file := main_file.next;
  1072. current_module.SetFileName(main_file.path^+main_file.name^,true);
  1073. if islibrary then
  1074. begin
  1075. consume(_LIBRARY);
  1076. stringdispose(current_module.modulename);
  1077. stringdispose(current_module.realmodulename);
  1078. current_module.modulename:=stringdup(pattern);
  1079. current_module.realmodulename:=stringdup(orgpattern);
  1080. current_module.islibrary:=true;
  1081. exportlib.preparelib(orgpattern);
  1082. if tf_library_needs_pic in target_info.flags then
  1083. include(current_settings.moduleswitches,cs_create_pic);
  1084. consume(_ID);
  1085. consume(_SEMICOLON);
  1086. end
  1087. else
  1088. { is there an program head ? }
  1089. if token=_PROGRAM then
  1090. begin
  1091. consume(_PROGRAM);
  1092. stringdispose(current_module.modulename);
  1093. stringdispose(current_module.realmodulename);
  1094. current_module.modulename:=stringdup(pattern);
  1095. current_module.realmodulename:=stringdup(orgpattern);
  1096. if (target_info.system in system_unit_program_exports) then
  1097. exportlib.preparelib(orgpattern);
  1098. consume(_ID);
  1099. if token=_LKLAMMER then
  1100. begin
  1101. consume(_LKLAMMER);
  1102. repeat
  1103. consume(_ID);
  1104. until not try_to_consume(_COMMA);
  1105. consume(_RKLAMMER);
  1106. end;
  1107. consume(_SEMICOLON);
  1108. end
  1109. else if (target_info.system in system_unit_program_exports) then
  1110. exportlib.preparelib(current_module.realmodulename^);
  1111. { global switches are read, so further changes aren't allowed }
  1112. current_module.in_global:=false;
  1113. { setup things using the switches }
  1114. setupglobalswitches;
  1115. { set implementation flag }
  1116. current_module.in_interface:=false;
  1117. current_module.interface_compiled:=true;
  1118. { insert after the unit symbol tables the static symbol table }
  1119. { of the program }
  1120. current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
  1121. { load standard units (system,objpas,profile unit) }
  1122. loaddefaultunits;
  1123. { Load units provided on the command line }
  1124. loadautounits;
  1125. {Load the units used by the program we compile.}
  1126. if token=_USES then
  1127. loadunits;
  1128. { reset ranges/stabs in exported definitions }
  1129. reset_all_defs;
  1130. { All units are read, now give them a number }
  1131. current_module.updatemaps;
  1132. {Insert the name of the main program into the symbol table.}
  1133. if current_module.realmodulename^<>'' then
  1134. current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
  1135. Message1(parser_u_parsing_implementation,current_module.mainsource^);
  1136. symtablestack.push(current_module.localsymtable);
  1137. { The program intialization needs an alias, so it can be called
  1138. from the bootstrap code.}
  1139. if islibrary then
  1140. begin
  1141. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,current_module.localsymtable);
  1142. { Win32 startup code needs a single name }
  1143. if not(target_info.system in [system_powerpc_darwin,system_i386_darwin]) then
  1144. pd.aliasnames.insert('PASCALMAIN')
  1145. else
  1146. pd.aliasnames.insert(target_info.Cprefix+'PASCALMAIN')
  1147. end
  1148. else if (target_info.system in [system_i386_netware,system_i386_netwlibc,system_powerpc_macos,system_powerpc_darwin,system_i386_darwin]) then
  1149. begin
  1150. pd:=create_main_proc('PASCALMAIN',potype_proginit,current_module.localsymtable);
  1151. end
  1152. else
  1153. begin
  1154. pd:=create_main_proc(mainaliasname,potype_proginit,current_module.localsymtable);
  1155. pd.aliasnames.insert('PASCALMAIN');
  1156. end;
  1157. tcgprocinfo(current_procinfo).parse_body;
  1158. tcgprocinfo(current_procinfo).generate_code;
  1159. tcgprocinfo(current_procinfo).resetprocdef;
  1160. { save file pos for debuginfo }
  1161. current_module.mainfilepos:=current_procinfo.entrypos;
  1162. release_main_proc(pd);
  1163. { Generate specializations of objectdefs methods }
  1164. generate_specialization_procs;
  1165. { should we force unit initialization? }
  1166. if tstaticsymtable(current_module.localsymtable).needs_init_final then
  1167. begin
  1168. { initialize section }
  1169. gen_implicit_initfinal(uf_init,current_module.localsymtable);
  1170. { finalize section }
  1171. gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
  1172. end;
  1173. { Add symbol to the exports section for win32 so smartlinking a
  1174. DLL will include the edata section }
  1175. if assigned(exportlib) and
  1176. (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1177. ((current_module.flags and uf_has_exports)<>0) then
  1178. current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',current_module.localsymtable,''),0));
  1179. { finalize? }
  1180. if token=_FINALIZATION then
  1181. begin
  1182. { set module options }
  1183. current_module.flags:=current_module.flags or uf_finalize;
  1184. { Compile the finalize }
  1185. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
  1186. pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
  1187. tcgprocinfo(current_procinfo).parse_body;
  1188. tcgprocinfo(current_procinfo).generate_code;
  1189. tcgprocinfo(current_procinfo).resetprocdef;
  1190. release_main_proc(pd);
  1191. end;
  1192. symtablestack.pop(current_module.localsymtable);
  1193. { consume the last point }
  1194. consume(_POINT);
  1195. if (Errorcount=0) then
  1196. begin
  1197. { test static symtable }
  1198. tstoredsymtable(current_module.localsymtable).allsymbolsused;
  1199. tstoredsymtable(current_module.localsymtable).allprivatesused;
  1200. tstoredsymtable(current_module.localsymtable).check_forwards;
  1201. tstoredsymtable(current_module.localsymtable).checklabels;
  1202. tstoredsymtable(current_module.localsymtable).unchain_overloaded;
  1203. current_module.allunitsused;
  1204. end;
  1205. { leave when we got an error }
  1206. if (Errorcount>0) and not status.skip_error then
  1207. begin
  1208. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1209. status.skip_error:=true;
  1210. exit;
  1211. end;
  1212. { remove all unused units, this happends when units are removed
  1213. from the uses clause in the source and the ppu was already being loaded }
  1214. hp:=tmodule(loaded_units.first);
  1215. while assigned(hp) do
  1216. begin
  1217. hp2:=hp;
  1218. hp:=tmodule(hp.next);
  1219. if hp2.is_unit and
  1220. not assigned(hp2.globalsymtable) then
  1221. loaded_units.remove(hp2);
  1222. end;
  1223. { do we need to add the variants unit? }
  1224. maybeloadvariantsunit;
  1225. {$ifdef arm}
  1226. { Insert .pdata section for arm-wince.
  1227. It is needed for exception handling. }
  1228. if target_info.system in [system_arm_wince] then
  1229. InsertPData;
  1230. {$endif arm}
  1231. { generate debuginfo }
  1232. if (cs_debuginfo in current_settings.moduleswitches) then
  1233. debuginfo.inserttypeinfo;
  1234. InsertThreadvars;
  1235. { generate wrappers for interfaces }
  1236. gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
  1237. { generate pic helpers to load eip if necessary }
  1238. gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
  1239. { generate imports }
  1240. if current_module.ImportLibraryList.Count>0 then
  1241. importlib.generatelib;
  1242. if islibrary or (target_info.system in system_unit_program_exports) then
  1243. exportlib.generatelib;
  1244. { Reference all DEBUGINFO sections from the main .text section }
  1245. if (cs_debuginfo in current_settings.moduleswitches) then
  1246. debuginfo.referencesections(current_asmdata.asmlists[al_procedures]);
  1247. { Resource strings }
  1248. GenerateResourceStrings;
  1249. { insert Tables and StackLength }
  1250. insertinitfinaltable;
  1251. InsertThreadvarTablesTable;
  1252. InsertResourceTablesTable;
  1253. insertmemorysizes;
  1254. { Insert symbol to resource info }
  1255. InsertResourceInfo;
  1256. { create dwarf debuginfo }
  1257. create_dwarf;
  1258. { insert own objectfile }
  1259. insertobjectfile;
  1260. { assemble and link }
  1261. create_objectfile;
  1262. { release all local symtables that are not needed anymore }
  1263. free_localsymtables(current_module.localsymtable);
  1264. { leave when we got an error }
  1265. if (Errorcount>0) and not status.skip_error then
  1266. begin
  1267. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1268. status.skip_error:=true;
  1269. exit;
  1270. end;
  1271. if (not current_module.is_unit) then
  1272. begin
  1273. { create the executable when we are at level 1 }
  1274. if (compile_level=1) then
  1275. begin
  1276. { write .def file }
  1277. if (cs_link_deffile in current_settings.globalswitches) then
  1278. deffile.writefile;
  1279. { insert all .o files from all loaded units and
  1280. unload the units, we don't need them anymore.
  1281. Keep the current_module because that is still needed }
  1282. hp:=tmodule(loaded_units.first);
  1283. while assigned(hp) do
  1284. begin
  1285. linker.AddModuleFiles(hp);
  1286. hp2:=tmodule(hp.next);
  1287. if hp<>current_module then
  1288. begin
  1289. loaded_units.remove(hp);
  1290. hp.free;
  1291. end;
  1292. hp:=hp2;
  1293. end;
  1294. { finally we can create a executable }
  1295. if DLLSource then
  1296. linker.MakeSharedLibrary
  1297. else
  1298. linker.MakeExecutable;
  1299. end;
  1300. { Give Fatal with error count for linker errors }
  1301. if (Errorcount>0) and not status.skip_error then
  1302. begin
  1303. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1304. status.skip_error:=true;
  1305. end;
  1306. end;
  1307. end;
  1308. end.