pmodules.pas 87 KB

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