pmodules.pas 57 KB

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