pmodules.pas 84 KB

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