pmodules.pas 87 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358
  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 system_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 system_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 system_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. reload_flagged_units;
  1021. { Parse the implementation section }
  1022. if (m_mac in current_settings.modeswitches) and try_to_consume(_END) then
  1023. current_module.interface_only:=true
  1024. else
  1025. current_module.interface_only:=false;
  1026. parse_only:=false;
  1027. { create static symbol table }
  1028. current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
  1029. {$ifdef i386}
  1030. if cs_create_pic in current_settings.moduleswitches then
  1031. begin
  1032. { insert symbol for got access in assembler code}
  1033. gotvarsym:=tstaticvarsym.create('_GLOBAL_OFFSET_TABLE_',vs_value,voidpointertype,[vo_is_external]);
  1034. gotvarsym.set_mangledname('_GLOBAL_OFFSET_TABLE_');
  1035. current_module.localsymtable.insert(gotvarsym);
  1036. { avoid unnecessary warnings }
  1037. gotvarsym.varstate:=vs_read;
  1038. gotvarsym.refs:=1;
  1039. end;
  1040. {$endif i386}
  1041. if not current_module.interface_only then
  1042. begin
  1043. consume(_IMPLEMENTATION);
  1044. Message1(unit_u_loading_implementation_units,current_module.modulename^);
  1045. { Read the implementation units }
  1046. parse_implementation_uses;
  1047. end;
  1048. if current_module.state=ms_compiled then
  1049. exit;
  1050. { reset ranges/stabs in exported definitions }
  1051. reset_all_defs;
  1052. { All units are read, now give them a number }
  1053. current_module.updatemaps;
  1054. symtablestack.push(current_module.globalsymtable);
  1055. symtablestack.push(current_module.localsymtable);
  1056. if not current_module.interface_only then
  1057. begin
  1058. Message1(parser_u_parsing_implementation,current_module.modulename^);
  1059. if current_module.in_interface then
  1060. internalerror(200212285);
  1061. { Compile the unit }
  1062. init_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'init'),potype_unitinit,current_module.localsymtable);
  1063. init_procinfo.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
  1064. init_procinfo.parse_body;
  1065. { save file pos for debuginfo }
  1066. current_module.mainfilepos:=init_procinfo.entrypos;
  1067. end;
  1068. { Generate specializations of objectdefs methods }
  1069. generate_specialization_procs;
  1070. { if the unit contains ansi/widestrings, initialization and
  1071. finalization code must be forced }
  1072. force_init_final:=tglobalsymtable(current_module.globalsymtable).needs_init_final or
  1073. tstaticsymtable(current_module.localsymtable).needs_init_final;
  1074. { should we force unit initialization? }
  1075. { this is a hack, but how can it be done better ? }
  1076. if force_init_final and ((current_module.flags and uf_init)=0) then
  1077. begin
  1078. { first release the not used init procinfo }
  1079. if assigned(init_procinfo) then
  1080. release_main_proc(init_procinfo);
  1081. init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable);
  1082. end;
  1083. { finalize? }
  1084. if not current_module.interface_only and (token=_FINALIZATION) then
  1085. begin
  1086. { set module options }
  1087. current_module.flags:=current_module.flags or uf_finalize;
  1088. { Compile the finalize }
  1089. finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
  1090. finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
  1091. finalize_procinfo.parse_body;
  1092. end
  1093. else if force_init_final then
  1094. finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
  1095. { Now both init and finalize bodies are read and it is known
  1096. which variables are used in both init and finalize we can now
  1097. generate the code. This is required to prevent putting a variable in
  1098. a register that is also used in the finalize body (PFV) }
  1099. if assigned(init_procinfo) then
  1100. begin
  1101. init_procinfo.generate_code;
  1102. init_procinfo.resetprocdef;
  1103. release_main_proc(init_procinfo);
  1104. end;
  1105. if assigned(finalize_procinfo) then
  1106. begin
  1107. finalize_procinfo.generate_code;
  1108. finalize_procinfo.resetprocdef;
  1109. release_main_proc(finalize_procinfo);
  1110. end;
  1111. symtablestack.pop(current_module.localsymtable);
  1112. symtablestack.pop(current_module.globalsymtable);
  1113. { the last char should always be a point }
  1114. consume(_POINT);
  1115. if (Errorcount=0) then
  1116. begin
  1117. { tests, if all (interface) forwards are resolved }
  1118. tstoredsymtable(current_module.globalsymtable).check_forwards;
  1119. { check if all private fields are used }
  1120. tstoredsymtable(current_module.globalsymtable).allprivatesused;
  1121. { test static symtable }
  1122. tstoredsymtable(current_module.localsymtable).allsymbolsused;
  1123. tstoredsymtable(current_module.localsymtable).allprivatesused;
  1124. tstoredsymtable(current_module.localsymtable).check_forwards;
  1125. tstoredsymtable(current_module.localsymtable).checklabels;
  1126. { used units }
  1127. current_module.allunitsused;
  1128. end;
  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. { if an Objective-C module, generate rtti and module info }
  1137. MaybeGenerateObjectiveCImageInfo(current_module.globalsymtable,current_module.localsymtable);
  1138. { do we need to add the variants unit? }
  1139. maybeloadvariantsunit;
  1140. { generate wrappers for interfaces }
  1141. gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.globalsymtable);
  1142. gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
  1143. { generate pic helpers to load eip if necessary }
  1144. gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
  1145. { generate rtti/init tables }
  1146. write_persistent_type_info(current_module.globalsymtable);
  1147. write_persistent_type_info(current_module.localsymtable);
  1148. { Tables }
  1149. insertThreadVars;
  1150. { Resource strings }
  1151. GenerateResourceStrings;
  1152. { Widestring typed constants }
  1153. InsertWideInits;
  1154. { generate debuginfo }
  1155. if (cs_debuginfo in current_settings.moduleswitches) then
  1156. current_debuginfo.inserttypeinfo;
  1157. { generate imports }
  1158. if current_module.ImportLibraryList.Count>0 then
  1159. importlib.generatelib;
  1160. { insert own objectfile, or say that it's in a library
  1161. (no check for an .o when loading) }
  1162. ag:=is_assembler_generated;
  1163. if ag then
  1164. insertobjectfile
  1165. else
  1166. begin
  1167. current_module.flags:=current_module.flags or uf_no_link;
  1168. current_module.flags:=current_module.flags and not (uf_has_stabs_debuginfo or uf_has_dwarf_debuginfo);
  1169. end;
  1170. if ag then
  1171. begin
  1172. { create callframe info }
  1173. create_dwarf_frame;
  1174. { assemble }
  1175. create_objectfile;
  1176. end;
  1177. { Write out the ppufile after the object file has been created }
  1178. store_interface_crc:=current_module.interface_crc;
  1179. store_indirect_crc:=current_module.indirect_crc;
  1180. {$ifdef EXTDEBUG}
  1181. store_crc:=current_module.crc;
  1182. {$endif EXTDEBUG}
  1183. if (Errorcount=0) then
  1184. tppumodule(current_module).writeppu;
  1185. if not(cs_compilesystem in current_settings.moduleswitches) then
  1186. begin
  1187. if store_interface_crc<>current_module.interface_crc then
  1188. Message1(unit_u_interface_crc_changed,current_module.ppufilename^);
  1189. if store_indirect_crc<>current_module.indirect_crc then
  1190. Message1(unit_u_indirect_crc_changed,current_module.ppufilename^);
  1191. end;
  1192. {$ifdef EXTDEBUG}
  1193. if not(cs_compilesystem in current_settings.moduleswitches) then
  1194. if (store_crc<>current_module.crc) and simplify_ppu then
  1195. Message1(unit_u_implementation_crc_changed,current_module.ppufilename^);
  1196. {$endif EXTDEBUG}
  1197. { release local symtables that are not needed anymore }
  1198. free_localsymtables(current_module.globalsymtable);
  1199. free_localsymtables(current_module.localsymtable);
  1200. { leave when we got an error }
  1201. if (Errorcount>0) and not status.skip_error then
  1202. begin
  1203. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1204. status.skip_error:=true;
  1205. exit;
  1206. end;
  1207. {$ifdef debug_devirt}
  1208. { print out all instantiated class/object types }
  1209. writeln('constructed object/class/classreftypes in ',current_module.realmodulename^);
  1210. for i := 0 to current_module.wpoinfo.createdobjtypes.count-1 do
  1211. begin
  1212. write(' ',tdef(current_module.wpoinfo.createdobjtypes[i]).GetTypeName);
  1213. case tdef(current_module.wpoinfo.createdobjtypes[i]).typ of
  1214. objectdef:
  1215. case tobjectdef(current_module.wpoinfo.createdobjtypes[i]).objecttype of
  1216. odt_object:
  1217. writeln(' (object)');
  1218. odt_class:
  1219. writeln(' (class)');
  1220. else
  1221. internalerror(2008101103);
  1222. end;
  1223. else
  1224. internalerror(2008101104);
  1225. end;
  1226. end;
  1227. for i := 0 to current_module.wpoinfo.createdclassrefobjtypes.count-1 do
  1228. begin
  1229. write(' Class Of ',tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).GetTypeName);
  1230. case tdef(current_module.wpoinfo.createdclassrefobjtypes[i]).typ of
  1231. objectdef:
  1232. case tobjectdef(current_module.wpoinfo.createdclassrefobjtypes[i]).objecttype of
  1233. odt_class:
  1234. writeln(' (classrefdef)');
  1235. else
  1236. internalerror(2008101105);
  1237. end
  1238. else
  1239. internalerror(2008101102);
  1240. end;
  1241. end;
  1242. {$endif debug_devirt}
  1243. Message1(unit_u_finished_compiling,current_module.modulename^);
  1244. end;
  1245. procedure procexport(const s : string);
  1246. var
  1247. hp : texported_item;
  1248. begin
  1249. hp:=texported_item.create;
  1250. hp.name:=stringdup(s);
  1251. hp.options:=hp.options or eo_name;
  1252. exportlib.exportprocedure(hp);
  1253. end;
  1254. procedure varexport(const s : string);
  1255. var
  1256. hp : texported_item;
  1257. begin
  1258. hp:=texported_item.create;
  1259. hp.name:=stringdup(s);
  1260. hp.options:=hp.options or eo_name;
  1261. exportlib.exportvar(hp);
  1262. end;
  1263. procedure insert_export(sym : TObject;arg:pointer);
  1264. var
  1265. i : longint;
  1266. item : TCmdStrListItem;
  1267. begin
  1268. case TSym(sym).typ of
  1269. { ignore: }
  1270. unitsym,
  1271. syssym,
  1272. constsym,
  1273. enumsym,
  1274. typesym:
  1275. ;
  1276. procsym:
  1277. begin
  1278. for i:=0 to tprocsym(sym).ProcdefList.Count-1 do
  1279. begin
  1280. if not(tprocdef(tprocsym(sym).ProcdefList[i]).proccalloption in [pocall_internproc]) and
  1281. ((tprocdef(tprocsym(sym).ProcdefList[i]).procoptions*[po_external])=[]) and
  1282. ((tsymtable(arg).symtabletype=globalsymtable) or
  1283. ((tsymtable(arg).symtabletype=staticsymtable) and (po_public in tprocdef(tprocsym(sym).ProcdefList[i]).procoptions))
  1284. ) then
  1285. begin
  1286. procexport(tprocdef(tprocsym(sym).ProcdefList[i]).mangledname);
  1287. { walk through all aliases }
  1288. item:=TCmdStrListItem(tprocdef(tprocsym(sym).ProcdefList[i]).aliasnames.first);
  1289. while assigned(item) do
  1290. begin
  1291. { avoid duplicate entries, sometimes aliasnames contains the mangledname }
  1292. if item.str<>tprocdef(tprocsym(sym).ProcdefList[i]).mangledname then
  1293. procexport(item.str);
  1294. item:=TCmdStrListItem(item.next);
  1295. end;
  1296. end;
  1297. end;
  1298. end;
  1299. staticvarsym:
  1300. begin
  1301. varexport(tsym(sym).mangledname);
  1302. end;
  1303. else
  1304. begin
  1305. writeln('unknown: ',ord(TSym(sym).typ));
  1306. end;
  1307. end;
  1308. end;
  1309. Function RewritePPU(const PPUFn,PPLFn:String):Boolean;
  1310. Var
  1311. MakeStatic : Boolean;
  1312. Var
  1313. buffer : array[0..$1fff] of byte;
  1314. inppu,
  1315. outppu : tppufile;
  1316. b,
  1317. untilb : byte;
  1318. l,m : longint;
  1319. f : file;
  1320. ext,
  1321. s : string;
  1322. ppuversion : dword;
  1323. begin
  1324. Result:=false;
  1325. MakeStatic:=False;
  1326. inppu:=tppufile.create(PPUFn);
  1327. if not inppu.openfile then
  1328. begin
  1329. inppu.free;
  1330. Comment(V_Error,'Could not open : '+PPUFn);
  1331. Exit;
  1332. end;
  1333. { Check the ppufile }
  1334. if not inppu.CheckPPUId then
  1335. begin
  1336. inppu.free;
  1337. Comment(V_Error,'Not a PPU File : '+PPUFn);
  1338. Exit;
  1339. end;
  1340. ppuversion:=inppu.GetPPUVersion;
  1341. if ppuversion<CurrentPPUVersion then
  1342. begin
  1343. inppu.free;
  1344. Comment(V_Error,'Wrong PPU Version '+tostr(ppuversion)+' in '+PPUFn);
  1345. Exit;
  1346. end;
  1347. { No .o file generated for this ppu, just skip }
  1348. if (inppu.header.flags and uf_no_link)<>0 then
  1349. begin
  1350. inppu.free;
  1351. Result:=true;
  1352. Exit;
  1353. end;
  1354. { Already a lib? }
  1355. if (inppu.header.flags and uf_in_library)<>0 then
  1356. begin
  1357. inppu.free;
  1358. Comment(V_Error,'PPU is already in a library : '+PPUFn);
  1359. Exit;
  1360. end;
  1361. { We need a static linked unit }
  1362. if (inppu.header.flags and uf_static_linked)=0 then
  1363. begin
  1364. inppu.free;
  1365. Comment(V_Error,'PPU is not static linked : '+PPUFn);
  1366. Exit;
  1367. end;
  1368. { Check if shared is allowed }
  1369. if tsystem(inppu.header.target) in [system_i386_go32v2] then
  1370. begin
  1371. Comment(V_Error,'Shared library not supported for ppu target, switching to static library');
  1372. MakeStatic:=true;
  1373. end;
  1374. { Create the new ppu }
  1375. if PPUFn=PPLFn then
  1376. outppu:=tppufile.create('ppumove.$$$')
  1377. else
  1378. outppu:=tppufile.create(PPLFn);
  1379. outppu.createfile;
  1380. { Create new header, with the new flags }
  1381. outppu.header:=inppu.header;
  1382. outppu.header.flags:=outppu.header.flags or uf_in_library;
  1383. if MakeStatic then
  1384. outppu.header.flags:=outppu.header.flags or uf_static_linked
  1385. else
  1386. outppu.header.flags:=outppu.header.flags or uf_shared_linked;
  1387. { read until the object files are found }
  1388. untilb:=iblinkunitofiles;
  1389. repeat
  1390. b:=inppu.readentry;
  1391. if b in [ibendinterface,ibend] then
  1392. begin
  1393. inppu.free;
  1394. outppu.free;
  1395. Comment(V_Error,'No files to be linked found : '+PPUFn);
  1396. Exit;
  1397. end;
  1398. if b<>untilb then
  1399. begin
  1400. repeat
  1401. inppu.getdatabuf(buffer,sizeof(buffer),l);
  1402. outppu.putdata(buffer,l);
  1403. until l<sizeof(buffer);
  1404. outppu.writeentry(b);
  1405. end;
  1406. until (b=untilb);
  1407. { we have now reached the section for the files which need to be added,
  1408. now add them to the list }
  1409. case b of
  1410. iblinkunitofiles :
  1411. begin
  1412. { add all o files, and save the entry when not creating a static
  1413. library to keep staticlinking possible }
  1414. while not inppu.endofentry do
  1415. begin
  1416. s:=inppu.getstring;
  1417. m:=inppu.getlongint;
  1418. if not MakeStatic then
  1419. begin
  1420. outppu.putstring(s);
  1421. outppu.putlongint(m);
  1422. end;
  1423. current_module.linkotherofiles.add(s,link_always);;
  1424. end;
  1425. if not MakeStatic then
  1426. outppu.writeentry(b);
  1427. end;
  1428. { iblinkunitstaticlibs :
  1429. begin
  1430. AddToLinkFiles(ExtractLib(inppu.getstring));
  1431. if not inppu.endofentry then
  1432. begin
  1433. repeat
  1434. inppu.getdatabuf(buffer^,bufsize,l);
  1435. outppu.putdata(buffer^,l);
  1436. until l<bufsize;
  1437. outppu.writeentry(b);
  1438. end;
  1439. end; }
  1440. end;
  1441. { just add a new entry with the new lib }
  1442. if MakeStatic then
  1443. begin
  1444. outppu.putstring('imp'+current_module.realmodulename^);
  1445. outppu.putlongint(link_static);
  1446. outppu.writeentry(iblinkunitstaticlibs)
  1447. end
  1448. else
  1449. begin
  1450. outppu.putstring('imp'+current_module.realmodulename^);
  1451. outppu.putlongint(link_shared);
  1452. outppu.writeentry(iblinkunitsharedlibs);
  1453. end;
  1454. { read all entries until the end and write them also to the new ppu }
  1455. repeat
  1456. b:=inppu.readentry;
  1457. { don't write ibend, that's written automaticly }
  1458. if b<>ibend then
  1459. begin
  1460. if b=iblinkothersharedlibs then
  1461. begin
  1462. while not inppu.endofentry do
  1463. begin
  1464. s:=inppu.getstring;
  1465. m:=inppu.getlongint;
  1466. outppu.putstring(s);
  1467. outppu.putlongint(m);
  1468. { strip lib prefix }
  1469. if copy(s,1,3)='lib' then
  1470. delete(s,1,3);
  1471. ext:=ExtractFileExt(s);
  1472. if ext<>'' then
  1473. delete(s,length(s)-length(ext)+1,length(ext));
  1474. current_module.linkOtherSharedLibs.add(s,link_always);
  1475. end;
  1476. end
  1477. else
  1478. repeat
  1479. inppu.getdatabuf(buffer,sizeof(buffer),l);
  1480. outppu.putdata(buffer,l);
  1481. until l<sizeof(buffer);
  1482. outppu.writeentry(b);
  1483. end;
  1484. until b=ibend;
  1485. { write the last stuff and close }
  1486. outppu.flush;
  1487. outppu.writeheader;
  1488. outppu.free;
  1489. inppu.free;
  1490. { rename }
  1491. if PPUFn=PPLFn then
  1492. begin
  1493. {$I-}
  1494. assign(f,PPUFn);
  1495. erase(f);
  1496. assign(f,'ppumove.$$$');
  1497. rename(f,PPUFn);
  1498. {$I+}
  1499. if ioresult<>0 then;
  1500. end;
  1501. Result:=True;
  1502. end;
  1503. procedure createimportlibfromexports;
  1504. var
  1505. hp : texported_item;
  1506. begin
  1507. hp:=texported_item(current_module._exports.first);
  1508. while assigned(hp) do
  1509. begin
  1510. current_module.AddExternalImport(current_module.realmodulename^,hp.name^,hp.index,hp.is_var,false);
  1511. hp:=texported_item(hp.next);
  1512. end;
  1513. end;
  1514. procedure proc_package;
  1515. var
  1516. main_file : tinputfile;
  1517. hp,hp2 : tmodule;
  1518. {finalize_procinfo,
  1519. init_procinfo,
  1520. main_procinfo : tcgprocinfo;}
  1521. force_init_final : boolean;
  1522. uu : tused_unit;
  1523. begin
  1524. Status.IsPackage:=true;
  1525. Status.IsExe:=true;
  1526. parse_only:=false;
  1527. {main_procinfo:=nil;
  1528. init_procinfo:=nil;
  1529. finalize_procinfo:=nil;}
  1530. if not RelocSectionSetExplicitly then
  1531. RelocSection:=true;
  1532. { Relocation works only without stabs under Windows when }
  1533. { external linker (LD) is used. LD generates relocs for }
  1534. { stab sections which is not loaded in memory. It causes }
  1535. { AV error when DLL is loaded and relocation is needed. }
  1536. { Internal linker does not have this problem. }
  1537. if RelocSection and
  1538. (target_info.system in system_all_windows+[system_i386_wdosx]) and
  1539. (cs_link_extern in current_settings.globalswitches) then
  1540. begin
  1541. include(current_settings.globalswitches,cs_link_strip);
  1542. { Warning stabs info does not work with reloc section !! }
  1543. if (cs_debuginfo in current_settings.moduleswitches) and
  1544. (target_dbg.id=dbg_stabs) then
  1545. begin
  1546. Message1(parser_w_parser_reloc_no_debug,current_module.mainsource^);
  1547. Message(parser_w_parser_win32_debug_needs_WN);
  1548. exclude(current_settings.moduleswitches,cs_debuginfo);
  1549. end;
  1550. end;
  1551. { get correct output names }
  1552. main_file := current_scanner.inputfile;
  1553. while assigned(main_file.next) do
  1554. main_file := main_file.next;
  1555. current_module.SetFileName(main_file.path^+main_file.name^,true);
  1556. consume(_ID);
  1557. current_module.setmodulename(orgpattern);
  1558. current_module.ispackage:=true;
  1559. exportlib.preparelib(orgpattern);
  1560. if tf_library_needs_pic in target_info.flags then
  1561. include(current_settings.moduleswitches,cs_create_pic);
  1562. consume(_ID);
  1563. consume(_SEMICOLON);
  1564. { global switches are read, so further changes aren't allowed }
  1565. current_module.in_global:=false;
  1566. { setup things using the switches }
  1567. setupglobalswitches;
  1568. { set implementation flag }
  1569. current_module.in_interface:=false;
  1570. current_module.interface_compiled:=true;
  1571. { insert after the unit symbol tables the static symbol table }
  1572. { of the program }
  1573. current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
  1574. {Load the units used by the program we compile.}
  1575. if token=_REQUIRES then
  1576. begin
  1577. end;
  1578. {Load the units used by the program we compile.}
  1579. if (token=_ID) and (idtoken=_CONTAINS) then
  1580. begin
  1581. consume(_ID);
  1582. while true do
  1583. begin
  1584. if token=_ID then
  1585. AddUnit(pattern);
  1586. consume(_ID);
  1587. if token=_COMMA then
  1588. consume(_COMMA)
  1589. else break;
  1590. end;
  1591. consume(_SEMICOLON);
  1592. end;
  1593. { reset ranges/stabs in exported definitions }
  1594. reset_all_defs;
  1595. { All units are read, now give them a number }
  1596. current_module.updatemaps;
  1597. {Insert the name of the main program into the symbol table.}
  1598. if current_module.realmodulename^<>'' then
  1599. current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
  1600. Message1(parser_u_parsing_implementation,current_module.mainsource^);
  1601. symtablestack.push(current_module.localsymtable);
  1602. { create whole program optimisation information }
  1603. current_module.wpoinfo:=tunitwpoinfo.create;
  1604. { should we force unit initialization? }
  1605. force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final;
  1606. if force_init_final then
  1607. {init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable)};
  1608. { Add symbol to the exports section for win32 so smartlinking a
  1609. DLL will include the edata section }
  1610. if assigned(exportlib) and
  1611. (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1612. ((current_module.flags and uf_has_exports)<>0) then
  1613. current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',current_module.localsymtable,''),0));
  1614. { all labels must be defined before generating code }
  1615. if Errorcount=0 then
  1616. tstoredsymtable(current_module.localsymtable).checklabels;
  1617. symtablestack.pop(current_module.localsymtable);
  1618. { consume the last point }
  1619. consume(_END);
  1620. consume(_POINT);
  1621. if (Errorcount=0) then
  1622. begin
  1623. { test static symtable }
  1624. tstoredsymtable(current_module.localsymtable).allsymbolsused;
  1625. tstoredsymtable(current_module.localsymtable).allprivatesused;
  1626. tstoredsymtable(current_module.localsymtable).check_forwards;
  1627. current_module.allunitsused;
  1628. end;
  1629. new_section(current_asmdata.asmlists[al_globals],sec_data,'_FPCDummy',4);
  1630. current_asmdata.asmlists[al_globals].concat(tai_symbol.createname_global('_FPCDummy',AT_DATA,0));
  1631. current_asmdata.asmlists[al_globals].concat(tai_const.create_32bit(0));
  1632. new_section(current_asmdata.asmlists[al_procedures],sec_code,'',0);
  1633. current_asmdata.asmlists[al_procedures].concat(tai_symbol.createname_global('_DLLMainCRTStartup',AT_FUNCTION,0));
  1634. {$ifdef i386}
  1635. { fix me! }
  1636. current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_const_reg(A_MOV,S_L,1,NR_EAX));
  1637. current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_const(A_RET,S_W,12));
  1638. {$endif i386}
  1639. current_asmdata.asmlists[al_procedures].concat(tai_const.createname('_FPCDummy',0));
  1640. { leave when we got an error }
  1641. if (Errorcount>0) and not status.skip_error then
  1642. begin
  1643. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1644. status.skip_error:=true;
  1645. exit;
  1646. end;
  1647. { remove all unused units, this happends when units are removed
  1648. from the uses clause in the source and the ppu was already being loaded }
  1649. hp:=tmodule(loaded_units.first);
  1650. while assigned(hp) do
  1651. begin
  1652. hp2:=hp;
  1653. hp:=tmodule(hp.next);
  1654. if hp2.is_unit and
  1655. not assigned(hp2.globalsymtable) then
  1656. loaded_units.remove(hp2);
  1657. end;
  1658. { force exports }
  1659. uu:=tused_unit(usedunits.first);
  1660. while assigned(uu) do
  1661. begin
  1662. uu.u.globalsymtable.symlist.ForEachCall(@insert_export,uu.u.globalsymtable);
  1663. { check localsymtable for exports too to get public symbols }
  1664. uu.u.localsymtable.symlist.ForEachCall(@insert_export,uu.u.localsymtable);
  1665. { create special exports }
  1666. if (uu.u.flags and uf_init)<>0 then
  1667. procexport(make_mangledname('INIT$',uu.u.globalsymtable,''));
  1668. if (uu.u.flags and uf_finalize)<>0 then
  1669. procexport(make_mangledname('FINALIZE$',uu.u.globalsymtable,''));
  1670. if (uu.u.flags and uf_threadvars)=uf_threadvars then
  1671. varexport(make_mangledname('THREADVARLIST',uu.u.globalsymtable,''));
  1672. uu:=tused_unit(uu.next);
  1673. end;
  1674. {$ifdef arm}
  1675. { Insert .pdata section for arm-wince.
  1676. It is needed for exception handling. }
  1677. if target_info.system in [system_arm_wince] then
  1678. InsertPData;
  1679. {$endif arm}
  1680. { generate debuginfo }
  1681. if (cs_debuginfo in current_settings.moduleswitches) then
  1682. current_debuginfo.inserttypeinfo;
  1683. exportlib.generatelib;
  1684. { write all our exports to the import library,
  1685. needs to be done after exportlib.generatelib; }
  1686. createimportlibfromexports;
  1687. { generate imports }
  1688. if current_module.ImportLibraryList.Count>0 then
  1689. importlib.generatelib;
  1690. { Reference all DEBUGINFO sections from the main .fpc section }
  1691. if (cs_debuginfo in current_settings.moduleswitches) then
  1692. current_debuginfo.referencesections(current_asmdata.asmlists[al_procedures]);
  1693. { insert own objectfile }
  1694. insertobjectfile;
  1695. { assemble and link }
  1696. create_objectfile;
  1697. { We might need the symbols info if not using
  1698. the default do_extractsymbolinfo
  1699. which is a dummy function PM }
  1700. needsymbolinfo:=do_extractsymbolinfo<>@def_extractsymbolinfo;
  1701. { release all local symtables that are not needed anymore }
  1702. if (not needsymbolinfo) then
  1703. free_localsymtables(current_module.localsymtable);
  1704. { leave when we got an error }
  1705. if (Errorcount>0) and not status.skip_error then
  1706. begin
  1707. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1708. status.skip_error:=true;
  1709. exit;
  1710. end;
  1711. if (not current_module.is_unit) then
  1712. begin
  1713. { finally rewrite all units included into the package }
  1714. uu:=tused_unit(usedunits.first);
  1715. while assigned(uu) do
  1716. begin
  1717. RewritePPU(uu.u.ppufilename^,uu.u.ppufilename^);
  1718. uu:=tused_unit(uu.next);
  1719. end;
  1720. { create the executable when we are at level 1 }
  1721. if (compile_level=1) then
  1722. begin
  1723. { create global resource file by collecting all resource files }
  1724. CollectResourceFiles;
  1725. { write .def file }
  1726. if (cs_link_deffile in current_settings.globalswitches) then
  1727. deffile.writefile;
  1728. { insert all .o files from all loaded units and
  1729. unload the units, we don't need them anymore.
  1730. Keep the current_module because that is still needed }
  1731. hp:=tmodule(loaded_units.first);
  1732. while assigned(hp) do
  1733. begin
  1734. { the package itself contains no code so far }
  1735. linker.AddModuleFiles(hp);
  1736. hp2:=tmodule(hp.next);
  1737. if (hp<>current_module) and
  1738. (not needsymbolinfo) then
  1739. begin
  1740. loaded_units.remove(hp);
  1741. hp.free;
  1742. end;
  1743. hp:=hp2;
  1744. end;
  1745. linker.MakeSharedLibrary
  1746. end;
  1747. { Give Fatal with error count for linker errors }
  1748. if (Errorcount>0) and not status.skip_error then
  1749. begin
  1750. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1751. status.skip_error:=true;
  1752. end;
  1753. end;
  1754. end;
  1755. procedure proc_program(islibrary : boolean);
  1756. var
  1757. main_file : tinputfile;
  1758. hp,hp2 : tmodule;
  1759. finalize_procinfo,
  1760. init_procinfo,
  1761. main_procinfo : tcgprocinfo;
  1762. force_init_final : boolean;
  1763. resources_used : boolean;
  1764. begin
  1765. DLLsource:=islibrary;
  1766. Status.IsLibrary:=IsLibrary;
  1767. Status.IsPackage:=false;
  1768. Status.IsExe:=true;
  1769. parse_only:=false;
  1770. main_procinfo:=nil;
  1771. init_procinfo:=nil;
  1772. finalize_procinfo:=nil;
  1773. resources_used:=false;
  1774. { DLL defaults to create reloc info }
  1775. if islibrary then
  1776. begin
  1777. if not RelocSectionSetExplicitly then
  1778. RelocSection:=true;
  1779. end;
  1780. { Relocation works only without stabs under Windows when }
  1781. { external linker (LD) is used. LD generates relocs for }
  1782. { stab sections which is not loaded in memory. It causes }
  1783. { AV error when DLL is loaded and relocation is needed. }
  1784. { Internal linker does not have this problem. }
  1785. if RelocSection and
  1786. (target_info.system in system_all_windows+[system_i386_wdosx]) and
  1787. (cs_link_extern in current_settings.globalswitches) then
  1788. begin
  1789. include(current_settings.globalswitches,cs_link_strip);
  1790. { Warning stabs info does not work with reloc section !! }
  1791. if (cs_debuginfo in current_settings.moduleswitches) and
  1792. (target_dbg.id=dbg_stabs) then
  1793. begin
  1794. Message1(parser_w_parser_reloc_no_debug,current_module.mainsource^);
  1795. Message(parser_w_parser_win32_debug_needs_WN);
  1796. exclude(current_settings.moduleswitches,cs_debuginfo);
  1797. end;
  1798. end;
  1799. { get correct output names }
  1800. main_file := current_scanner.inputfile;
  1801. while assigned(main_file.next) do
  1802. main_file := main_file.next;
  1803. current_module.SetFileName(main_file.path^+main_file.name^,true);
  1804. if islibrary then
  1805. begin
  1806. consume(_LIBRARY);
  1807. current_module.setmodulename(orgpattern);
  1808. current_module.islibrary:=true;
  1809. exportlib.preparelib(orgpattern);
  1810. if tf_library_needs_pic in target_info.flags then
  1811. include(current_settings.moduleswitches,cs_create_pic);
  1812. consume(_ID);
  1813. consume(_SEMICOLON);
  1814. end
  1815. else
  1816. { is there an program head ? }
  1817. if token=_PROGRAM then
  1818. begin
  1819. consume(_PROGRAM);
  1820. current_module.setmodulename(orgpattern);
  1821. if (target_info.system in system_unit_program_exports) then
  1822. exportlib.preparelib(orgpattern);
  1823. consume(_ID);
  1824. if token=_LKLAMMER then
  1825. begin
  1826. consume(_LKLAMMER);
  1827. repeat
  1828. consume(_ID);
  1829. until not try_to_consume(_COMMA);
  1830. consume(_RKLAMMER);
  1831. end;
  1832. consume(_SEMICOLON);
  1833. end
  1834. else if (target_info.system in system_unit_program_exports) then
  1835. exportlib.preparelib(current_module.realmodulename^);
  1836. { global switches are read, so further changes aren't allowed }
  1837. current_module.in_global:=false;
  1838. { setup things using the switches }
  1839. setupglobalswitches;
  1840. { set implementation flag }
  1841. current_module.in_interface:=false;
  1842. current_module.interface_compiled:=true;
  1843. { insert after the unit symbol tables the static symbol table }
  1844. { of the program }
  1845. current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
  1846. { load standard units (system,objpas,profile unit) }
  1847. loaddefaultunits;
  1848. { Load units provided on the command line }
  1849. loadautounits;
  1850. {Load the units used by the program we compile.}
  1851. if token=_USES then
  1852. loadunits;
  1853. { reset ranges/stabs in exported definitions }
  1854. reset_all_defs;
  1855. { All units are read, now give them a number }
  1856. current_module.updatemaps;
  1857. {Insert the name of the main program into the symbol table.}
  1858. if current_module.realmodulename^<>'' then
  1859. current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
  1860. Message1(parser_u_parsing_implementation,current_module.mainsource^);
  1861. symtablestack.push(current_module.localsymtable);
  1862. { create whole program optimisation information }
  1863. current_module.wpoinfo:=tunitwpoinfo.create;
  1864. { The program intialization needs an alias, so it can be called
  1865. from the bootstrap code.}
  1866. if islibrary then
  1867. begin
  1868. main_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,current_module.localsymtable);
  1869. { Win32 startup code needs a single name }
  1870. if not(target_info.system in systems_darwin) then
  1871. main_procinfo.procdef.aliasnames.insert('PASCALMAIN')
  1872. else
  1873. main_procinfo.procdef.aliasnames.insert(target_info.Cprefix+'PASCALMAIN')
  1874. end
  1875. else if (target_info.system in ([system_i386_netware,system_i386_netwlibc,system_powerpc_macos]+systems_darwin)) then
  1876. begin
  1877. main_procinfo:=create_main_proc('PASCALMAIN',potype_proginit,current_module.localsymtable);
  1878. end
  1879. else
  1880. begin
  1881. main_procinfo:=create_main_proc(mainaliasname,potype_proginit,current_module.localsymtable);
  1882. main_procinfo.procdef.aliasnames.insert('PASCALMAIN');
  1883. end;
  1884. main_procinfo.parse_body;
  1885. { save file pos for debuginfo }
  1886. current_module.mainfilepos:=main_procinfo.entrypos;
  1887. { Generate specializations of objectdefs methods }
  1888. generate_specialization_procs;
  1889. { should we force unit initialization? }
  1890. force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final;
  1891. if force_init_final then
  1892. init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable);
  1893. { Add symbol to the exports section for win32 so smartlinking a
  1894. DLL will include the edata section }
  1895. if assigned(exportlib) and
  1896. (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1897. ((current_module.flags and uf_has_exports)<>0) then
  1898. current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',current_module.localsymtable,''),0));
  1899. { finalize? }
  1900. if token=_FINALIZATION then
  1901. begin
  1902. { set module options }
  1903. current_module.flags:=current_module.flags or uf_finalize;
  1904. { Parse the finalize }
  1905. finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
  1906. finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
  1907. finalize_procinfo.procdef.aliasnames.insert('PASCALFINALIZE');
  1908. finalize_procinfo.parse_body;
  1909. end
  1910. else
  1911. if force_init_final then
  1912. finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
  1913. { the finalization routine of libraries is generic (and all libraries need to }
  1914. { be finalized, so they can finalize any units they use }
  1915. if (islibrary) then
  1916. exportlib.setfininame(current_asmdata.asmlists[al_procedures],'FPC_LIB_EXIT');
  1917. { all labels must be defined before generating code }
  1918. if Errorcount=0 then
  1919. tstoredsymtable(current_module.localsymtable).checklabels;
  1920. { See remark in unit init/final }
  1921. main_procinfo.generate_code;
  1922. main_procinfo.resetprocdef;
  1923. release_main_proc(main_procinfo);
  1924. if assigned(init_procinfo) then
  1925. begin
  1926. init_procinfo.generate_code;
  1927. init_procinfo.resetprocdef;
  1928. release_main_proc(init_procinfo);
  1929. end;
  1930. if assigned(finalize_procinfo) then
  1931. begin
  1932. finalize_procinfo.generate_code;
  1933. finalize_procinfo.resetprocdef;
  1934. release_main_proc(finalize_procinfo);
  1935. end;
  1936. symtablestack.pop(current_module.localsymtable);
  1937. { consume the last point }
  1938. consume(_POINT);
  1939. if (Errorcount=0) then
  1940. begin
  1941. { test static symtable }
  1942. tstoredsymtable(current_module.localsymtable).allsymbolsused;
  1943. tstoredsymtable(current_module.localsymtable).allprivatesused;
  1944. tstoredsymtable(current_module.localsymtable).check_forwards;
  1945. current_module.allunitsused;
  1946. end;
  1947. { leave when we got an error }
  1948. if (Errorcount>0) and not status.skip_error then
  1949. begin
  1950. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1951. status.skip_error:=true;
  1952. exit;
  1953. end;
  1954. { remove all unused units, this happens when units are removed
  1955. from the uses clause in the source and the ppu was already being loaded }
  1956. hp:=tmodule(loaded_units.first);
  1957. while assigned(hp) do
  1958. begin
  1959. hp2:=hp;
  1960. hp:=tmodule(hp.next);
  1961. if hp2.is_unit and
  1962. not assigned(hp2.globalsymtable) then
  1963. begin
  1964. loaded_units.remove(hp2);
  1965. unloaded_units.concat(hp2);
  1966. end;
  1967. end;
  1968. { do we need to add the variants unit? }
  1969. maybeloadvariantsunit;
  1970. { Now that everything has been compiled we know if we need resource
  1971. support. If not, remove the unit. }
  1972. resources_used:=MaybeRemoveResUnit;
  1973. linker.initsysinitunitname;
  1974. if target_info.system in system_internal_sysinit then
  1975. begin
  1976. { add start/halt unit }
  1977. AddUnit(linker.sysinitunit);
  1978. end;
  1979. {$ifdef arm}
  1980. { Insert .pdata section for arm-wince.
  1981. It is needed for exception handling. }
  1982. if target_info.system in [system_arm_wince] then
  1983. InsertPData;
  1984. {$endif arm}
  1985. InsertThreadvars;
  1986. { generate pic helpers to load eip if necessary }
  1987. gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
  1988. { generate rtti/init tables }
  1989. write_persistent_type_info(current_module.localsymtable);
  1990. { if an Objective-C module, generate rtti and module info }
  1991. MaybeGenerateObjectiveCImageInfo(nil,current_module.localsymtable);
  1992. { generate wrappers for interfaces }
  1993. gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
  1994. { generate imports }
  1995. if current_module.ImportLibraryList.Count>0 then
  1996. importlib.generatelib;
  1997. { generate debuginfo }
  1998. if (cs_debuginfo in current_settings.moduleswitches) then
  1999. current_debuginfo.inserttypeinfo;
  2000. if islibrary or (target_info.system in system_unit_program_exports) then
  2001. exportlib.generatelib;
  2002. { Reference all DEBUGINFO sections from the main .fpc section }
  2003. if (cs_debuginfo in current_settings.moduleswitches) then
  2004. current_debuginfo.referencesections(current_asmdata.asmlists[al_procedures]);
  2005. { Resource strings }
  2006. GenerateResourceStrings;
  2007. { Windows widestring needing initialization }
  2008. InsertWideInits;
  2009. { insert Tables and StackLength }
  2010. insertinitfinaltable;
  2011. InsertThreadvarTablesTable;
  2012. InsertResourceTablesTable;
  2013. InsertWideInitsTablesTable;
  2014. insertmemorysizes;
  2015. { Insert symbol to resource info }
  2016. InsertResourceInfo(resources_used);
  2017. { create callframe info }
  2018. create_dwarf_frame;
  2019. { insert own objectfile }
  2020. insertobjectfile;
  2021. { assemble and link }
  2022. create_objectfile;
  2023. { We might need the symbols info if not using
  2024. the default do_extractsymbolinfo
  2025. which is a dummy function PM }
  2026. needsymbolinfo:=
  2027. (do_extractsymbolinfo<>@def_extractsymbolinfo) or
  2028. ((current_settings.genwpoptimizerswitches*WPOptimizationsNeedingAllUnitInfo)<>[]);
  2029. { release all local symtables that are not needed anymore }
  2030. if (not needsymbolinfo) then
  2031. free_localsymtables(current_module.localsymtable);
  2032. { leave when we got an error }
  2033. if (Errorcount>0) and not status.skip_error then
  2034. begin
  2035. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  2036. status.skip_error:=true;
  2037. exit;
  2038. end;
  2039. if (not current_module.is_unit) then
  2040. begin
  2041. { create the executable when we are at level 1 }
  2042. if (compile_level=1) then
  2043. begin
  2044. { create global resource file by collecting all resource files }
  2045. CollectResourceFiles;
  2046. { write .def file }
  2047. if (cs_link_deffile in current_settings.globalswitches) then
  2048. deffile.writefile;
  2049. { insert all .o files from all loaded units and
  2050. unload the units, we don't need them anymore.
  2051. Keep the current_module because that is still needed }
  2052. hp:=tmodule(loaded_units.first);
  2053. while assigned(hp) do
  2054. begin
  2055. linker.AddModuleFiles(hp);
  2056. hp2:=tmodule(hp.next);
  2057. if (hp<>current_module) and
  2058. (not needsymbolinfo) then
  2059. begin
  2060. loaded_units.remove(hp);
  2061. hp.free;
  2062. end;
  2063. hp:=hp2;
  2064. end;
  2065. { free also unneeded units we didn't free before }
  2066. if not needsymbolinfo then
  2067. unloaded_units.Clear;
  2068. { finally we can create a executable }
  2069. if DLLSource then
  2070. linker.MakeSharedLibrary
  2071. else
  2072. linker.MakeExecutable;
  2073. { collect all necessary information for whole-program optimization }
  2074. wpoinfomanager.extractwpoinfofromprogram;
  2075. end;
  2076. { Give Fatal with error count for linker errors }
  2077. if (Errorcount>0) and not status.skip_error then
  2078. begin
  2079. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  2080. status.skip_error:=true;
  2081. end;
  2082. end;
  2083. end;
  2084. end.