pmodules.pas 83 KB

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