pmodules.pas 93 KB

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