pmodules.pas 58 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551
  1. {
  2. Copyright (c) 1998-2002 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_program(islibrary : boolean);
  22. implementation
  23. uses
  24. SysUtils,
  25. globtype,version,systems,tokens,
  26. cutils,cfileutils,cclasses,comphook,
  27. globals,verbose,fmodule,finput,fppu,
  28. symconst,symbase,symtype,symdef,symsym,symtable,
  29. aasmtai,aasmdata,aasmcpu,aasmbase,
  30. cgbase,cgobj,
  31. nbas,ncgutil,
  32. link,assemble,import,export,gendef,ppu,comprsrc,dbgbase,
  33. cresstr,procinfo,
  34. pexports,
  35. scanner,pbase,pexpr,psystem,psub,pdecsub,ptype;
  36. procedure create_objectfile;
  37. var
  38. DLLScanner : TDLLScanner;
  39. s : string;
  40. KeepShared : TCmdStrList;
  41. begin
  42. { try to create import entries from system dlls }
  43. if (tf_has_dllscanner in target_info.flags) and
  44. (not current_module.linkOtherSharedLibs.Empty) then
  45. begin
  46. { Init DLLScanner }
  47. if assigned(CDLLScanner[target_info.system]) then
  48. DLLScanner:=CDLLScanner[target_info.system].Create
  49. else
  50. internalerror(200104121);
  51. KeepShared:=TCmdStrList.Create;
  52. { Walk all shared libs }
  53. While not current_module.linkOtherSharedLibs.Empty do
  54. begin
  55. S:=current_module.linkOtherSharedLibs.Getusemask(link_always);
  56. if not DLLScanner.scan(s) then
  57. KeepShared.Concat(s);
  58. end;
  59. DLLscanner.Free;
  60. { Recreate import section }
  61. if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
  62. begin
  63. if assigned(current_asmdata.asmlists[al_imports]) then
  64. current_asmdata.asmlists[al_imports].clear
  65. else
  66. current_asmdata.asmlists[al_imports]:=TAsmList.Create;
  67. importlib.generatelib;
  68. end;
  69. { Readd the not processed files }
  70. while not KeepShared.Empty do
  71. begin
  72. s:=KeepShared.GetFirst;
  73. current_module.linkOtherSharedLibs.add(s,link_always);
  74. end;
  75. KeepShared.Free;
  76. end;
  77. { Start and end module debuginfo, at least required for stabs
  78. to insert n_sourcefile lines }
  79. if (cs_debuginfo in current_settings.moduleswitches) or
  80. (cs_use_lineinfo in current_settings.globalswitches) then
  81. current_debuginfo.insertmoduleinfo;
  82. { create the .s file and assemble it }
  83. GenerateAsm(false);
  84. { Also create a smartlinked version ? }
  85. if create_smartlink_library then
  86. begin
  87. GenerateAsm(true);
  88. if (af_needar in target_asm.flags) then
  89. Linker.MakeStaticLibrary;
  90. end;
  91. { resource files }
  92. CompileResourceFiles;
  93. end;
  94. procedure insertobjectfile;
  95. { Insert the used object file for this unit in the used list for this unit }
  96. begin
  97. current_module.linkunitofiles.add(current_module.objfilename^,link_static);
  98. current_module.flags:=current_module.flags or uf_static_linked;
  99. if create_smartlink_library then
  100. begin
  101. current_module.linkunitstaticlibs.add(current_module.staticlibfilename^,link_smart);
  102. current_module.flags:=current_module.flags or uf_smart_linked;
  103. end;
  104. end;
  105. procedure create_dwarf;
  106. begin
  107. { Dwarf conflicts with smartlinking in separate .a files }
  108. if create_smartlink_library then
  109. exit;
  110. { Call frame information }
  111. if (tf_needs_dwarf_cfi in target_info.flags) and
  112. (af_supports_dwarf in target_asm.flags) then
  113. begin
  114. current_asmdata.asmlists[al_dwarf].Free;
  115. current_asmdata.asmlists[al_dwarf] := TAsmList.create;
  116. current_asmdata.asmcfi.generate_code(current_asmdata.asmlists[al_dwarf]);
  117. end;
  118. end;
  119. procedure InsertThreadvarTablesTable;
  120. var
  121. hp : tused_unit;
  122. ltvTables : TAsmList;
  123. count : longint;
  124. begin
  125. if (tf_section_threadvars in target_info.flags) then
  126. exit;
  127. ltvTables:=TAsmList.Create;
  128. count:=0;
  129. hp:=tused_unit(usedunits.first);
  130. while assigned(hp) do
  131. begin
  132. If (hp.u.flags and uf_threadvars)=uf_threadvars then
  133. begin
  134. ltvTables.concat(Tai_const.Createname(make_mangledname('THREADVARLIST',hp.u.globalsymtable,''),0));
  135. inc(count);
  136. end;
  137. hp:=tused_unit(hp.next);
  138. end;
  139. { Add program threadvars, if any }
  140. If (current_module.flags and uf_threadvars)=uf_threadvars then
  141. begin
  142. ltvTables.concat(Tai_const.Createname(make_mangledname('THREADVARLIST',current_module.localsymtable,''),0));
  143. inc(count);
  144. end;
  145. { Insert TableCount at start }
  146. ltvTables.insert(Tai_const.Create_32bit(count));
  147. { insert in data segment }
  148. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  149. new_section(current_asmdata.asmlists[al_globals],sec_data,'FPC_THREADVARTABLES',sizeof(aint));
  150. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('FPC_THREADVARTABLES',AT_DATA,0));
  151. current_asmdata.asmlists[al_globals].concatlist(ltvTables);
  152. current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('FPC_THREADVARTABLES'));
  153. ltvTables.free;
  154. end;
  155. procedure AddToThreadvarList(p:TObject;arg:pointer);
  156. var
  157. ltvTable : TAsmList;
  158. begin
  159. ltvTable:=TAsmList(arg);
  160. if (tsym(p).typ=staticvarsym) and
  161. (vo_is_thread_var in tstaticvarsym(p).varoptions) then
  162. begin
  163. { address of threadvar }
  164. ltvTable.concat(tai_const.Createname(tstaticvarsym(p).mangledname,0));
  165. { size of threadvar }
  166. ltvTable.concat(tai_const.create_32bit(tstaticvarsym(p).getsize));
  167. end;
  168. end;
  169. procedure InsertThreadvars;
  170. var
  171. s : string;
  172. ltvTable : TAsmList;
  173. begin
  174. if (tf_section_threadvars in target_info.flags) then
  175. exit;
  176. ltvTable:=TAsmList.create;
  177. if assigned(current_module.globalsymtable) then
  178. current_module.globalsymtable.SymList.ForEachCall(@AddToThreadvarList,ltvTable);
  179. current_module.localsymtable.SymList.ForEachCall(@AddToThreadvarList,ltvTable);
  180. if ltvTable.first<>nil then
  181. begin
  182. s:=make_mangledname('THREADVARLIST',current_module.localsymtable,'');
  183. { end of the list marker }
  184. ltvTable.concat(tai_const.create_sym(nil));
  185. { add to datasegment }
  186. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  187. new_section(current_asmdata.asmlists[al_globals],sec_data,s,sizeof(aint));
  188. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global(s,AT_DATA,0));
  189. current_asmdata.asmlists[al_globals].concatlist(ltvTable);
  190. current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname(s));
  191. current_module.flags:=current_module.flags or uf_threadvars;
  192. end;
  193. ltvTable.Free;
  194. end;
  195. Procedure InsertResourceInfo;
  196. var
  197. hp : tused_unit;
  198. found : Boolean;
  199. I : Integer;
  200. ResourceInfo : TAsmList;
  201. begin
  202. if target_res.id=res_elf then
  203. begin
  204. hp:=tused_unit(usedunits.first);
  205. found:=false;
  206. Found:=((current_module.flags and uf_has_resourcefiles)=uf_has_resourcefiles);
  207. If not found then
  208. While Assigned(hp) and not Found do
  209. begin
  210. Found:=((hp.u.flags and uf_has_resourcefiles)=uf_has_resourcefiles);
  211. hp:=tused_unit(hp.next);
  212. end;
  213. ResourceInfo:=TAsmList.Create;
  214. if found then
  215. begin
  216. { Valid pointer to resource information }
  217. ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESLOCATION',AT_DATA,0));
  218. ResourceInfo.concat(Tai_const.Createname('FPC_RESSYMBOL',0));
  219. {$ifdef EXTERNALRESPTRS}
  220. current_module.linkotherofiles.add('resptrs.o',link_always);
  221. {$else EXTERNALRESPTRS}
  222. new_section(ResourceInfo,sec_fpc,'resptrs',4);
  223. ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESSYMBOL',AT_DATA,0));
  224. For I:=1 to 32 do
  225. ResourceInfo.Concat(Tai_const.Create_32bit(0));
  226. {$endif EXTERNALRESPTRS}
  227. end
  228. else
  229. begin
  230. { Nil pointer to resource information }
  231. ResourceInfo.concat(Tai_symbol.Createname_global('FPC_RESLOCATION',AT_DATA,0));
  232. ResourceInfo.Concat(Tai_const.Create_32bit(0));
  233. end;
  234. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  235. current_asmdata.asmlists[al_globals].concatlist(ResourceInfo);
  236. ResourceInfo.free;
  237. end;
  238. end;
  239. Procedure InsertResourceTablesTable;
  240. var
  241. hp : tmodule;
  242. ResourceStringTables : tasmlist;
  243. count : longint;
  244. begin
  245. ResourceStringTables:=tasmlist.Create;
  246. count:=0;
  247. hp:=tmodule(loaded_units.first);
  248. while assigned(hp) do
  249. begin
  250. If (hp.flags and uf_has_resourcestrings)=uf_has_resourcestrings then
  251. begin
  252. ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESSTR',hp.localsymtable,'START'),0));
  253. ResourceStringTables.concat(Tai_const.Createname(make_mangledname('RESSTR',hp.localsymtable,'END'),0));
  254. inc(count);
  255. end;
  256. hp:=tmodule(hp.next);
  257. end;
  258. { Insert TableCount at start }
  259. ResourceStringTables.insert(Tai_const.Create_aint(count));
  260. { Add to data segment }
  261. maybe_new_object_file(current_asmdata.AsmLists[al_globals]);
  262. new_section(current_asmdata.AsmLists[al_globals],sec_data,'FPC_RESOURCESTRINGTABLES',sizeof(aint));
  263. current_asmdata.AsmLists[al_globals].concat(Tai_symbol.Createname_global('FPC_RESOURCESTRINGTABLES',AT_DATA,0));
  264. current_asmdata.AsmLists[al_globals].concatlist(ResourceStringTables);
  265. current_asmdata.AsmLists[al_globals].concat(Tai_symbol_end.Createname('FPC_RESOURCESTRINGTABLES'));
  266. ResourceStringTables.free;
  267. end;
  268. procedure InsertInitFinalTable;
  269. var
  270. hp : tused_unit;
  271. unitinits : TAsmList;
  272. count : longint;
  273. begin
  274. unitinits:=TAsmList.Create;
  275. count:=0;
  276. hp:=tused_unit(usedunits.first);
  277. while assigned(hp) do
  278. begin
  279. { call the unit init code and make it external }
  280. if (hp.u.flags and (uf_init or uf_finalize))<>0 then
  281. begin
  282. if (hp.u.flags and uf_init)<>0 then
  283. unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',hp.u.globalsymtable,''),0))
  284. else
  285. unitinits.concat(Tai_const.Create_sym(nil));
  286. if (hp.u.flags and uf_finalize)<>0 then
  287. unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',hp.u.globalsymtable,''),0))
  288. else
  289. unitinits.concat(Tai_const.Create_sym(nil));
  290. inc(count);
  291. end;
  292. hp:=tused_unit(hp.next);
  293. end;
  294. { Insert initialization/finalization of the program }
  295. if (current_module.flags and (uf_init or uf_finalize))<>0 then
  296. begin
  297. if (current_module.flags and uf_init)<>0 then
  298. unitinits.concat(Tai_const.Createname(make_mangledname('INIT$',current_module.localsymtable,''),0))
  299. else
  300. unitinits.concat(Tai_const.Create_sym(nil));
  301. if (current_module.flags and uf_finalize)<>0 then
  302. unitinits.concat(Tai_const.Createname(make_mangledname('FINALIZE$',current_module.localsymtable,''),0))
  303. else
  304. unitinits.concat(Tai_const.Create_sym(nil));
  305. inc(count);
  306. end;
  307. { Insert TableCount,InitCount at start }
  308. unitinits.insert(Tai_const.Create_32bit(0));
  309. unitinits.insert(Tai_const.Create_32bit(count));
  310. { Add to data segment }
  311. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  312. new_section(current_asmdata.asmlists[al_globals],sec_data,'INITFINAL',sizeof(aint));
  313. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('INITFINAL',AT_DATA,0));
  314. current_asmdata.asmlists[al_globals].concatlist(unitinits);
  315. current_asmdata.asmlists[al_globals].concat(Tai_symbol_end.Createname('INITFINAL'));
  316. unitinits.free;
  317. end;
  318. procedure insertmemorysizes;
  319. {$IFDEF POWERPC}
  320. var
  321. stkcookie: string;
  322. {$ENDIF POWERPC}
  323. begin
  324. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  325. { Insert Ident of the compiler in the .fpc.version section }
  326. current_asmdata.asmlists[al_globals].concat(Tai_section.create(sec_fpc,'version',0));
  327. current_asmdata.asmlists[al_globals].concat(Tai_align.Create(const_align(32)));
  328. current_asmdata.asmlists[al_globals].concat(Tai_string.Create('FPC '+full_version_string+
  329. ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname));
  330. if not(tf_no_generic_stackcheck in target_info.flags) then
  331. begin
  332. { stacksize can be specified and is now simulated }
  333. new_section(current_asmdata.asmlists[al_globals],sec_data,'__stklen', sizeof(aint));
  334. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__stklen',AT_DATA,sizeof(aint)));
  335. current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(stacksize));
  336. end;
  337. {$IFDEF POWERPC}
  338. { AmigaOS4 "stack cookie" support }
  339. if ( target_info.system = system_powerpc_amiga ) then
  340. begin
  341. { this symbol is needed to ignite powerpc amigaos' }
  342. { stack allocation magic for us with the given stack size. }
  343. { note: won't work for m68k amigaos or morphos. (KB) }
  344. str(stacksize,stkcookie);
  345. stkcookie:='$STACK: '+stkcookie+#0;
  346. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  347. new_section(current_asmdata.asmlists[al_globals],sec_data,'__stack_cookie',length(stkcookie));
  348. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__stack_cookie',AT_DATA,length(stkcookie)));
  349. current_asmdata.asmlists[al_globals].concat(Tai_string.Create(stkcookie));
  350. end;
  351. {$ENDIF POWERPC}
  352. { Initial heapsize }
  353. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  354. new_section(current_asmdata.asmlists[al_globals],sec_data,'__heapsize',sizeof(aint));
  355. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__heapsize',AT_DATA,sizeof(aint)));
  356. current_asmdata.asmlists[al_globals].concat(Tai_const.Create_aint(heapsize));
  357. { Initial heapsize }
  358. maybe_new_object_file(current_asmdata.asmlists[al_globals]);
  359. new_section(current_asmdata.asmlists[al_globals],sec_data,'__fpc_valgrind',sizeof(boolean));
  360. current_asmdata.asmlists[al_globals].concat(Tai_symbol.Createname_global('__fpc_valgrind',AT_DATA,sizeof(boolean)));
  361. current_asmdata.asmlists[al_globals].concat(Tai_const.create_8bit(byte(cs_gdb_valgrind in current_settings.globalswitches)));
  362. end;
  363. procedure AddUnit(const s:string);
  364. var
  365. hp : tppumodule;
  366. unitsym : tunitsym;
  367. begin
  368. { load unit }
  369. hp:=registerunit(current_module,s,'');
  370. hp.loadppu;
  371. hp.adddependency(current_module);
  372. { add to symtable stack }
  373. symtablestack.push(hp.globalsymtable);
  374. if (m_mac in current_settings.modeswitches) and
  375. assigned(hp.globalmacrosymtable) then
  376. macrosymtablestack.push(hp.globalmacrosymtable);
  377. { insert unitsym }
  378. unitsym:=tunitsym.create(s,hp);
  379. inc(unitsym.refs);
  380. current_module.localsymtable.insert(unitsym);
  381. { add to used units }
  382. current_module.addusedunit(hp,false,unitsym);
  383. end;
  384. procedure maybeloadvariantsunit;
  385. var
  386. hp : tmodule;
  387. begin
  388. { Do we need the variants unit? Skip this
  389. for VarUtils unit for bootstrapping }
  390. if (current_module.flags and uf_uses_variants=0) or
  391. (current_module.modulename^='VARUTILS') then
  392. exit;
  393. { Variants unit already loaded? }
  394. hp:=tmodule(loaded_units.first);
  395. while assigned(hp) do
  396. begin
  397. if hp.modulename^='VARIANTS' then
  398. exit;
  399. hp:=tmodule(hp.next);
  400. end;
  401. { Variants unit is not loaded yet, load it now }
  402. Message(parser_w_implicit_uses_of_variants_unit);
  403. AddUnit('variants');
  404. end;
  405. procedure loaddefaultunits;
  406. begin
  407. { we are going to rebuild the symtablestack, clear it first }
  408. symtablestack.clear;
  409. macrosymtablestack.clear;
  410. { macro symtable }
  411. macrosymtablestack.push(initialmacrosymtable);
  412. { are we compiling the system unit? }
  413. if (cs_compilesystem in current_settings.moduleswitches) then
  414. begin
  415. systemunit:=tglobalsymtable(current_module.localsymtable);
  416. { create system defines }
  417. create_intern_symbols;
  418. create_intern_types;
  419. { Set the owner of errorsym and errortype to symtable to
  420. prevent crashes when accessing .owner }
  421. generrorsym.owner:=systemunit;
  422. generrordef.owner:=systemunit;
  423. exit;
  424. end;
  425. { insert the system unit, it is allways the first. Load also the
  426. internal types from the system unit }
  427. AddUnit('system');
  428. systemunit:=tglobalsymtable(symtablestack.top);
  429. load_intern_types;
  430. { Set the owner of errorsym and errortype to symtable to
  431. prevent crashes when accessing .owner }
  432. generrorsym.owner:=systemunit;
  433. generrordef.owner:=systemunit;
  434. { Units only required for main module }
  435. if not(current_module.is_unit) then
  436. begin
  437. { Heaptrc unit, load heaptrace before any other units especially objpas }
  438. if (cs_use_heaptrc in current_settings.globalswitches) then
  439. AddUnit('heaptrc');
  440. { Lineinfo unit }
  441. if (cs_use_lineinfo in current_settings.globalswitches) then begin
  442. if (paratargetdbg = dbg_stabs) then
  443. AddUnit('lineinfo')
  444. else
  445. AddUnit('lnfodwrf');
  446. end;
  447. { Valgrind requires c memory manager }
  448. if (cs_gdb_valgrind in current_settings.globalswitches) then
  449. AddUnit('cmem');
  450. {$ifdef cpufpemu}
  451. { Floating point emulation unit?
  452. softfpu must be in the system unit anyways (FK)
  453. if (cs_fp_emulation in current_settings.moduleswitches) and not(target_info.system in system_wince) then
  454. AddUnit('softfpu');
  455. }
  456. {$endif cpufpemu}
  457. end;
  458. { Objpas unit? }
  459. if m_objpas in current_settings.modeswitches then
  460. AddUnit('objpas');
  461. { Macpas unit? }
  462. if m_mac in current_settings.modeswitches then
  463. AddUnit('macpas');
  464. { Profile unit? Needed for go32v2 only }
  465. if (cs_profile in current_settings.moduleswitches) and
  466. (target_info.system in [system_i386_go32v2,system_i386_watcom]) then
  467. AddUnit('profile');
  468. if (cs_load_fpcylix_unit in current_settings.globalswitches) then
  469. begin
  470. AddUnit('fpcylix');
  471. AddUnit('dynlibs');
  472. end;
  473. end;
  474. procedure loadautounits;
  475. var
  476. hs,s : string;
  477. begin
  478. hs:=autoloadunits;
  479. repeat
  480. s:=GetToken(hs,',');
  481. if s='' then
  482. break;
  483. AddUnit(s);
  484. until false;
  485. end;
  486. procedure loadunits;
  487. var
  488. s,sorg : TIDString;
  489. fn : string;
  490. pu : tused_unit;
  491. hp2 : tmodule;
  492. unitsym : tunitsym;
  493. begin
  494. consume(_USES);
  495. repeat
  496. s:=pattern;
  497. sorg:=orgpattern;
  498. consume(_ID);
  499. { support "<unit> in '<file>'" construct, but not for tp7 }
  500. fn:='';
  501. if not(m_tp7 in current_settings.modeswitches) and
  502. try_to_consume(_OP_IN) then
  503. fn:=FixFileName(get_stringconst);
  504. { Give a warning if lineinfo is loaded }
  505. if s='LINEINFO' then begin
  506. Message(parser_w_no_lineinfo_use_switch);
  507. if (paratargetdbg in [dbg_dwarf2, dbg_dwarf3]) then
  508. s := 'LNFODWRF';
  509. sorg := s;
  510. end;
  511. { Give a warning if objpas is loaded }
  512. if s='OBJPAS' then
  513. Message(parser_w_no_objpas_use_mode);
  514. { Using the unit itself is not possible }
  515. if (s<>current_module.modulename^) then
  516. begin
  517. { check if the unit is already used }
  518. hp2:=nil;
  519. pu:=tused_unit(current_module.used_units.first);
  520. while assigned(pu) do
  521. begin
  522. if (pu.u.modulename^=s) then
  523. begin
  524. hp2:=pu.u;
  525. break;
  526. end;
  527. pu:=tused_unit(pu.next);
  528. end;
  529. if not assigned(hp2) then
  530. hp2:=registerunit(current_module,sorg,fn)
  531. else
  532. Message1(sym_e_duplicate_id,s);
  533. { Create unitsym, we need to use the name as specified, we
  534. can not use the modulename because that can be different
  535. when -Un is used }
  536. unitsym:=tunitsym.create(sorg,nil);
  537. current_module.localsymtable.insert(unitsym);
  538. { the current module uses the unit hp2 }
  539. current_module.addusedunit(hp2,true,unitsym);
  540. end
  541. else
  542. Message1(sym_e_duplicate_id,s);
  543. if token=_COMMA then
  544. begin
  545. pattern:='';
  546. consume(_COMMA);
  547. end
  548. else
  549. break;
  550. until false;
  551. { Load the units }
  552. pu:=tused_unit(current_module.used_units.first);
  553. while assigned(pu) do
  554. begin
  555. { Only load the units that are in the current
  556. (interface/implementation) uses clause }
  557. if pu.in_uses and
  558. (pu.in_interface=current_module.in_interface) then
  559. begin
  560. tppumodule(pu.u).loadppu;
  561. { is our module compiled? then we can stop }
  562. if current_module.state=ms_compiled then
  563. exit;
  564. { add this unit to the dependencies }
  565. pu.u.adddependency(current_module);
  566. { save crc values }
  567. pu.checksum:=pu.u.crc;
  568. pu.interface_checksum:=pu.u.interface_crc;
  569. { connect unitsym to the module }
  570. pu.unitsym.module:=pu.u;
  571. { add to symtable stack }
  572. symtablestack.push(pu.u.globalsymtable);
  573. if (m_mac in current_settings.modeswitches) and
  574. assigned(pu.u.globalmacrosymtable) then
  575. macrosymtablestack.push(pu.u.globalmacrosymtable);
  576. end;
  577. pu:=tused_unit(pu.next);
  578. end;
  579. consume(_SEMICOLON);
  580. end;
  581. procedure reset_all_defs;
  582. procedure reset_used_unit_defs(hp:tmodule);
  583. var
  584. pu : tused_unit;
  585. begin
  586. pu:=tused_unit(hp.used_units.first);
  587. while assigned(pu) do
  588. begin
  589. if not pu.u.is_reset then
  590. begin
  591. { prevent infinte loop for circular dependencies }
  592. pu.u.is_reset:=true;
  593. if assigned(pu.u.globalsymtable) then
  594. begin
  595. tglobalsymtable(pu.u.globalsymtable).reset_all_defs;
  596. reset_used_unit_defs(pu.u);
  597. end;
  598. end;
  599. pu:=tused_unit(pu.next);
  600. end;
  601. end;
  602. var
  603. hp2 : tmodule;
  604. begin
  605. hp2:=tmodule(loaded_units.first);
  606. while assigned(hp2) do
  607. begin
  608. hp2.is_reset:=false;
  609. hp2:=tmodule(hp2.next);
  610. end;
  611. reset_used_unit_defs(current_module);
  612. end;
  613. procedure free_localsymtables(st:TSymtable);
  614. var
  615. i : longint;
  616. def : tstoreddef;
  617. pd : tprocdef;
  618. begin
  619. for i:=0 to st.DefList.Count-1 do
  620. begin
  621. def:=tstoreddef(st.DefList[i]);
  622. if def.typ=procdef then
  623. begin
  624. pd:=tprocdef(def);
  625. if assigned(pd.localst) and
  626. (pd.localst.symtabletype<>staticsymtable) and
  627. not(po_inline in pd.procoptions) then
  628. begin
  629. free_localsymtables(pd.localst);
  630. pd.localst.free;
  631. pd.localst:=nil;
  632. end;
  633. end;
  634. end;
  635. end;
  636. procedure parse_implementation_uses;
  637. begin
  638. if token=_USES then
  639. loadunits;
  640. end;
  641. procedure setupglobalswitches;
  642. begin
  643. if (cs_create_pic in current_settings.moduleswitches) then
  644. begin
  645. def_system_macro('FPC_PIC');
  646. def_system_macro('PIC');
  647. end;
  648. end;
  649. function create_main_proc(const name:string;potype:tproctypeoption;st:TSymtable):tcgprocinfo;
  650. var
  651. ps : tprocsym;
  652. pd : tprocdef;
  653. begin
  654. { there should be no current_procinfo available }
  655. if assigned(current_procinfo) then
  656. internalerror(200304275);
  657. {Generate a procsym for main}
  658. ps:=tprocsym.create('$'+name);
  659. { main are allways used }
  660. inc(ps.refs);
  661. st.insert(ps);
  662. pd:=tprocdef.create(main_program_level);
  663. include(pd.procoptions,po_global);
  664. pd.procsym:=ps;
  665. ps.ProcdefList.Add(pd);
  666. { set procdef options }
  667. pd.proctypeoption:=potype;
  668. pd.proccalloption:=pocall_default;
  669. include(pd.procoptions,po_hascallingconvention);
  670. pd.forwarddef:=false;
  671. pd.setmangledname(target_info.cprefix+name);
  672. pd.aliasnames.insert(pd.mangledname);
  673. handle_calling_convention(pd);
  674. { We don't need is a local symtable. Change it into the static
  675. symtable }
  676. pd.localst.free;
  677. pd.localst:=st;
  678. { set procinfo and current_procinfo.procdef }
  679. result:=tcgprocinfo(cprocinfo.create(nil));
  680. result.procdef:=pd;
  681. { main proc does always a call e.g. to init system unit }
  682. include(result.flags,pi_do_call);
  683. end;
  684. procedure release_main_proc(pi:tcgprocinfo);
  685. begin
  686. { remove localst as it was replaced by staticsymtable }
  687. pi.procdef.localst:=nil;
  688. { remove procinfo }
  689. current_module.procinfo:=nil;
  690. pi.free;
  691. pi:=nil;
  692. end;
  693. function gen_implicit_initfinal(flag:word;st:TSymtable):tcgprocinfo;
  694. begin
  695. { update module flags }
  696. current_module.flags:=current_module.flags or flag;
  697. { create procdef }
  698. case flag of
  699. uf_init :
  700. begin
  701. result:=create_main_proc(make_mangledname('',current_module.localsymtable,'init_implicit'),potype_unitinit,st);
  702. result.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
  703. end;
  704. uf_finalize :
  705. begin
  706. result:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize_implicit'),potype_unitfinalize,st);
  707. result.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
  708. if (not current_module.is_unit) then
  709. result.procdef.aliasnames.insert('PASCALFINALIZE');
  710. end;
  711. else
  712. internalerror(200304253);
  713. end;
  714. result.code:=cnothingnode.create;
  715. end;
  716. procedure copy_macro(p:TObject; arg:pointer);
  717. begin
  718. current_module.globalmacrosymtable.insert(tmacro(p).getcopy);
  719. end;
  720. procedure proc_unit;
  721. function is_assembler_generated:boolean;
  722. var
  723. hal : tasmlisttype;
  724. begin
  725. result:=false;
  726. if Errorcount=0 then
  727. begin
  728. for hal:=low(TasmlistType) to high(TasmlistType) do
  729. if not current_asmdata.asmlists[hal].empty then
  730. begin
  731. result:=true;
  732. exit;
  733. end;
  734. end;
  735. end;
  736. var
  737. main_file: tinputfile;
  738. {$ifdef EXTDEBUG}
  739. store_crc,
  740. {$endif EXTDEBUG}
  741. store_interface_crc : cardinal;
  742. s1,s2 : ^string; {Saves stack space}
  743. force_init_final : boolean;
  744. init_procinfo,
  745. finalize_procinfo : tcgprocinfo;
  746. unitname8 : string[8];
  747. has_impl,ag: boolean;
  748. {$ifdef i386}
  749. gotvarsym : tstaticvarsym;
  750. {$endif i386}
  751. begin
  752. init_procinfo:=nil;
  753. finalize_procinfo:=nil;
  754. if m_mac in current_settings.modeswitches then
  755. current_module.mode_switch_allowed:= false;
  756. consume(_UNIT);
  757. if compile_level=1 then
  758. Status.IsExe:=false;
  759. if token=_ID then
  760. begin
  761. { create filenames and unit name }
  762. main_file := current_scanner.inputfile;
  763. while assigned(main_file.next) do
  764. main_file := main_file.next;
  765. new(s1);
  766. s1^:=current_module.modulename^;
  767. current_module.SetFileName(main_file.path^+main_file.name^,true);
  768. current_module.SetModuleName(orgpattern);
  769. { check for system unit }
  770. new(s2);
  771. s2^:=upper(ChangeFileExt(ExtractFileName(main_file.name^),''));
  772. unitname8:=copy(current_module.modulename^,1,8);
  773. if (cs_check_unit_name in current_settings.globalswitches) and
  774. (
  775. not(
  776. (current_module.modulename^=s2^) or
  777. (
  778. (length(current_module.modulename^)>8) and
  779. (unitname8=s2^)
  780. )
  781. )
  782. or
  783. (
  784. (length(s1^)>8) and
  785. (s1^<>current_module.modulename^)
  786. )
  787. ) then
  788. Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
  789. if (current_module.modulename^='SYSTEM') then
  790. include(current_settings.moduleswitches,cs_compilesystem);
  791. dispose(s2);
  792. dispose(s1);
  793. end;
  794. if (target_info.system in system_unit_program_exports) then
  795. exportlib.preparelib(current_module.realmodulename^);
  796. consume(_ID);
  797. consume(_SEMICOLON);
  798. consume(_INTERFACE);
  799. { global switches are read, so further changes aren't allowed }
  800. current_module.in_global:=false;
  801. { handle the global switches }
  802. setupglobalswitches;
  803. message1(unit_u_loading_interface_units,current_module.modulename^);
  804. { update status }
  805. status.currentmodule:=current_module.realmodulename^;
  806. { maybe turn off m_objpas if we are compiling objpas }
  807. if (current_module.modulename^='OBJPAS') then
  808. exclude(current_settings.modeswitches,m_objpas);
  809. { maybe turn off m_mac if we are compiling macpas }
  810. if (current_module.modulename^='MACPAS') then
  811. exclude(current_settings.modeswitches,m_mac);
  812. parse_only:=true;
  813. { generate now the global symboltable,
  814. define first as local to overcome dependency conflicts }
  815. current_module.localsymtable:=tglobalsymtable.create(current_module.modulename^,current_module.moduleid);
  816. { insert unitsym of this unit to prevent other units having
  817. the same name }
  818. current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
  819. { load default units, like the system unit }
  820. loaddefaultunits;
  821. { insert qualifier for the system unit (allows system.writeln) }
  822. if not(cs_compilesystem in current_settings.moduleswitches) and
  823. (token=_USES) then
  824. begin
  825. loadunits;
  826. { has it been compiled at a higher level ?}
  827. if current_module.state=ms_compiled then
  828. exit;
  829. end;
  830. { move the global symtable from the temporary local to global }
  831. current_module.globalsymtable:=current_module.localsymtable;
  832. current_module.localsymtable:=nil;
  833. reset_all_defs;
  834. { number all units, so we know if a unit is used by this unit or
  835. needs to be added implicitly }
  836. current_module.updatemaps;
  837. { ... parse the declarations }
  838. Message1(parser_u_parsing_interface,current_module.realmodulename^);
  839. symtablestack.push(current_module.globalsymtable);
  840. read_interface_declarations;
  841. symtablestack.pop(current_module.globalsymtable);
  842. { Export macros defined in the interface for macpas. The macros
  843. are put in the globalmacrosymtable that will only be used by other
  844. units. The current unit continues to use the localmacrosymtable }
  845. if (m_mac in current_settings.modeswitches) then
  846. begin
  847. current_module.globalmacrosymtable:=tmacrosymtable.create(true);
  848. current_module.localmacrosymtable.SymList.ForEachCall(@copy_macro,nil);
  849. end;
  850. { leave when we got an error }
  851. if (Errorcount>0) and not status.skip_error then
  852. begin
  853. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  854. status.skip_error:=true;
  855. exit;
  856. end;
  857. { Our interface is compiled, generate CRC and switch to implementation }
  858. if not(cs_compilesystem in current_settings.moduleswitches) and
  859. (Errorcount=0) then
  860. tppumodule(current_module).getppucrc;
  861. current_module.in_interface:=false;
  862. current_module.interface_compiled:=true;
  863. { First reload all units depending on our interface, we need to do this
  864. in the implementation part to prevent errorneous circular references }
  865. reload_flagged_units;
  866. { Parse the implementation section }
  867. if (m_mac in current_settings.modeswitches) and try_to_consume(_END) then
  868. has_impl:= false
  869. else
  870. has_impl:= true;
  871. parse_only:=false;
  872. { generates static symbol table }
  873. current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
  874. {$ifdef i386}
  875. if cs_create_pic in current_settings.moduleswitches then
  876. begin
  877. { insert symbol for got access in assembler code}
  878. gotvarsym:=tstaticvarsym.create('_GLOBAL_OFFSET_TABLE_',vs_value,voidpointertype,[vo_is_external]);
  879. gotvarsym.set_mangledname('_GLOBAL_OFFSET_TABLE_');
  880. current_module.localsymtable.insert(gotvarsym);
  881. { avoid unnecessary warnings }
  882. gotvarsym.varstate:=vs_read;
  883. gotvarsym.refs:=1;
  884. end;
  885. {$endif i386}
  886. if has_impl then
  887. begin
  888. consume(_IMPLEMENTATION);
  889. Message1(unit_u_loading_implementation_units,current_module.modulename^);
  890. { Read the implementation units }
  891. parse_implementation_uses;
  892. end;
  893. if current_module.state=ms_compiled then
  894. exit;
  895. { reset ranges/stabs in exported definitions }
  896. reset_all_defs;
  897. { All units are read, now give them a number }
  898. current_module.updatemaps;
  899. symtablestack.push(current_module.globalsymtable);
  900. symtablestack.push(current_module.localsymtable);
  901. if has_impl then
  902. begin
  903. Message1(parser_u_parsing_implementation,current_module.modulename^);
  904. if current_module.in_interface then
  905. internalerror(200212285);
  906. { Compile the unit }
  907. init_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'init'),potype_unitinit,current_module.localsymtable);
  908. init_procinfo.procdef.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
  909. init_procinfo.parse_body;
  910. { save file pos for debuginfo }
  911. current_module.mainfilepos:=init_procinfo.entrypos;
  912. end;
  913. { Generate specializations of objectdefs methods }
  914. generate_specialization_procs;
  915. { if the unit contains ansi/widestrings, initialization and
  916. finalization code must be forced }
  917. force_init_final:=tglobalsymtable(current_module.globalsymtable).needs_init_final or
  918. tstaticsymtable(current_module.localsymtable).needs_init_final;
  919. { should we force unit initialization? }
  920. { this is a hack, but how can it be done better ? }
  921. if force_init_final and ((current_module.flags and uf_init)=0) then
  922. begin
  923. { first release the not used init procinfo }
  924. if assigned(init_procinfo) then
  925. release_main_proc(init_procinfo);
  926. init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable);
  927. end;
  928. { finalize? }
  929. if has_impl and (token=_FINALIZATION) then
  930. begin
  931. { set module options }
  932. current_module.flags:=current_module.flags or uf_finalize;
  933. { Compile the finalize }
  934. finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
  935. finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
  936. finalize_procinfo.parse_body;
  937. end
  938. else if force_init_final then
  939. finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
  940. { Now both init and finalize bodies are read and it is known
  941. which variables are used in both init and finalize we can now
  942. generate the code. This is required to prevent putting a variable in
  943. a register that is also used in the finalize body (PFV) }
  944. if assigned(init_procinfo) then
  945. begin
  946. init_procinfo.generate_code;
  947. init_procinfo.resetprocdef;
  948. release_main_proc(init_procinfo);
  949. end;
  950. if assigned(finalize_procinfo) then
  951. begin
  952. finalize_procinfo.generate_code;
  953. finalize_procinfo.resetprocdef;
  954. release_main_proc(finalize_procinfo);
  955. end;
  956. symtablestack.pop(current_module.localsymtable);
  957. symtablestack.pop(current_module.globalsymtable);
  958. { the last char should always be a point }
  959. consume(_POINT);
  960. if (Errorcount=0) then
  961. begin
  962. { tests, if all (interface) forwards are resolved }
  963. tstoredsymtable(current_module.globalsymtable).check_forwards;
  964. { check if all private fields are used }
  965. tstoredsymtable(current_module.globalsymtable).allprivatesused;
  966. { remove cross unit overloads }
  967. tstoredsymtable(current_module.globalsymtable).unchain_overloaded;
  968. { test static symtable }
  969. tstoredsymtable(current_module.localsymtable).allsymbolsused;
  970. tstoredsymtable(current_module.localsymtable).allprivatesused;
  971. tstoredsymtable(current_module.localsymtable).check_forwards;
  972. tstoredsymtable(current_module.localsymtable).checklabels;
  973. tstoredsymtable(current_module.localsymtable).unchain_overloaded;
  974. { used units }
  975. current_module.allunitsused;
  976. end;
  977. { leave when we got an error }
  978. if (Errorcount>0) and not status.skip_error then
  979. begin
  980. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  981. status.skip_error:=true;
  982. exit;
  983. end;
  984. { do we need to add the variants unit? }
  985. maybeloadvariantsunit;
  986. { generate wrappers for interfaces }
  987. gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.globalsymtable);
  988. gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
  989. { generate pic helpers to load eip if necessary }
  990. gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
  991. { generate rtti/init tables }
  992. write_persistent_type_info(current_module.globalsymtable);
  993. write_persistent_type_info(current_module.localsymtable);
  994. { Tables }
  995. insertThreadVars;
  996. { Resource strings }
  997. GenerateResourceStrings;
  998. { generate debuginfo }
  999. if (cs_debuginfo in current_settings.moduleswitches) then
  1000. current_debuginfo.inserttypeinfo;
  1001. { generate imports }
  1002. if current_module.ImportLibraryList.Count>0 then
  1003. importlib.generatelib;
  1004. { insert own objectfile, or say that it's in a library
  1005. (no check for an .o when loading) }
  1006. ag:=is_assembler_generated;
  1007. if ag then
  1008. insertobjectfile
  1009. else
  1010. begin
  1011. current_module.flags:=current_module.flags or uf_no_link;
  1012. current_module.flags:=current_module.flags and not uf_has_debuginfo;
  1013. end;
  1014. if ag then
  1015. begin
  1016. { create dwarf debuginfo }
  1017. create_dwarf;
  1018. { assemble }
  1019. create_objectfile;
  1020. end;
  1021. { Write out the ppufile after the object file has been created }
  1022. store_interface_crc:=current_module.interface_crc;
  1023. {$ifdef EXTDEBUG}
  1024. store_crc:=current_module.crc;
  1025. {$endif EXTDEBUG}
  1026. if (Errorcount=0) then
  1027. tppumodule(current_module).writeppu;
  1028. if not(cs_compilesystem in current_settings.moduleswitches) then
  1029. if store_interface_crc<>current_module.interface_crc then
  1030. Message1(unit_u_interface_crc_changed,current_module.ppufilename^);
  1031. {$ifdef EXTDEBUG}
  1032. if not(cs_compilesystem in current_settings.moduleswitches) then
  1033. if (store_crc<>current_module.crc) and simplify_ppu then
  1034. Message1(unit_u_implementation_crc_changed,current_module.ppufilename^);
  1035. {$endif EXTDEBUG}
  1036. { release all overload references and local symtables that
  1037. are not needed anymore }
  1038. tstoredsymtable(current_module.localsymtable).unchain_overloaded;
  1039. tstoredsymtable(current_module.globalsymtable).unchain_overloaded;
  1040. free_localsymtables(current_module.globalsymtable);
  1041. free_localsymtables(current_module.localsymtable);
  1042. { leave when we got an error }
  1043. if (Errorcount>0) and not status.skip_error then
  1044. begin
  1045. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1046. status.skip_error:=true;
  1047. exit;
  1048. end;
  1049. Message1(unit_u_finished_compiling,current_module.modulename^);
  1050. end;
  1051. procedure proc_program(islibrary : boolean);
  1052. var
  1053. main_file : tinputfile;
  1054. hp,hp2 : tmodule;
  1055. finalize_procinfo,
  1056. init_procinfo,
  1057. main_procinfo : tcgprocinfo;
  1058. force_init_final : boolean;
  1059. begin
  1060. DLLsource:=islibrary;
  1061. Status.IsLibrary:=IsLibrary;
  1062. Status.IsExe:=true;
  1063. parse_only:=false;
  1064. main_procinfo:=nil;
  1065. init_procinfo:=nil;
  1066. finalize_procinfo:=nil;
  1067. { DLL defaults to create reloc info }
  1068. if islibrary then
  1069. begin
  1070. if not RelocSectionSetExplicitly then
  1071. RelocSection:=true;
  1072. end;
  1073. { Relocation works only without stabs under Windows when }
  1074. { external linker (LD) is used. LD generates relocs for }
  1075. { stab sections which is not loaded in memory. It causes }
  1076. { AV error when DLL is loaded and relocation is needed. }
  1077. { Internal linker does not have this problem. }
  1078. if RelocSection and
  1079. (target_info.system in system_all_windows+[system_i386_wdosx]) and
  1080. (cs_link_extern in current_settings.globalswitches) then
  1081. begin
  1082. include(current_settings.globalswitches,cs_link_strip);
  1083. { Warning stabs info does not work with reloc section !! }
  1084. if cs_debuginfo in current_settings.moduleswitches then
  1085. begin
  1086. Message1(parser_w_parser_reloc_no_debug,current_module.mainsource^);
  1087. Message(parser_w_parser_win32_debug_needs_WN);
  1088. exclude(current_settings.moduleswitches,cs_debuginfo);
  1089. end;
  1090. end;
  1091. { get correct output names }
  1092. main_file := current_scanner.inputfile;
  1093. while assigned(main_file.next) do
  1094. main_file := main_file.next;
  1095. current_module.SetFileName(main_file.path^+main_file.name^,true);
  1096. if islibrary then
  1097. begin
  1098. consume(_LIBRARY);
  1099. current_module.setmodulename(orgpattern);
  1100. current_module.islibrary:=true;
  1101. exportlib.preparelib(orgpattern);
  1102. if tf_library_needs_pic in target_info.flags then
  1103. include(current_settings.moduleswitches,cs_create_pic);
  1104. consume(_ID);
  1105. consume(_SEMICOLON);
  1106. end
  1107. else
  1108. { is there an program head ? }
  1109. if token=_PROGRAM then
  1110. begin
  1111. consume(_PROGRAM);
  1112. current_module.setmodulename(orgpattern);
  1113. if (target_info.system in system_unit_program_exports) then
  1114. exportlib.preparelib(orgpattern);
  1115. consume(_ID);
  1116. if token=_LKLAMMER then
  1117. begin
  1118. consume(_LKLAMMER);
  1119. repeat
  1120. consume(_ID);
  1121. until not try_to_consume(_COMMA);
  1122. consume(_RKLAMMER);
  1123. end;
  1124. consume(_SEMICOLON);
  1125. end
  1126. else if (target_info.system in system_unit_program_exports) then
  1127. exportlib.preparelib(current_module.realmodulename^);
  1128. { global switches are read, so further changes aren't allowed }
  1129. current_module.in_global:=false;
  1130. { setup things using the switches }
  1131. setupglobalswitches;
  1132. { set implementation flag }
  1133. current_module.in_interface:=false;
  1134. current_module.interface_compiled:=true;
  1135. { insert after the unit symbol tables the static symbol table }
  1136. { of the program }
  1137. current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
  1138. { load standard units (system,objpas,profile unit) }
  1139. loaddefaultunits;
  1140. { Load units provided on the command line }
  1141. loadautounits;
  1142. {Load the units used by the program we compile.}
  1143. if token=_USES then
  1144. loadunits;
  1145. { reset ranges/stabs in exported definitions }
  1146. reset_all_defs;
  1147. { All units are read, now give them a number }
  1148. current_module.updatemaps;
  1149. {Insert the name of the main program into the symbol table.}
  1150. if current_module.realmodulename^<>'' then
  1151. current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
  1152. Message1(parser_u_parsing_implementation,current_module.mainsource^);
  1153. symtablestack.push(current_module.localsymtable);
  1154. { The program intialization needs an alias, so it can be called
  1155. from the bootstrap code.}
  1156. if islibrary then
  1157. begin
  1158. main_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,current_module.localsymtable);
  1159. { Win32 startup code needs a single name }
  1160. if not(target_info.system in systems_darwin) then
  1161. main_procinfo.procdef.aliasnames.insert('PASCALMAIN')
  1162. else
  1163. main_procinfo.procdef.aliasnames.insert(target_info.Cprefix+'PASCALMAIN')
  1164. end
  1165. else if (target_info.system in ([system_i386_netware,system_i386_netwlibc,system_powerpc_macos]+systems_darwin)) then
  1166. begin
  1167. main_procinfo:=create_main_proc('PASCALMAIN',potype_proginit,current_module.localsymtable);
  1168. end
  1169. else
  1170. begin
  1171. main_procinfo:=create_main_proc(mainaliasname,potype_proginit,current_module.localsymtable);
  1172. main_procinfo.procdef.aliasnames.insert('PASCALMAIN');
  1173. end;
  1174. main_procinfo.parse_body;
  1175. { save file pos for debuginfo }
  1176. current_module.mainfilepos:=main_procinfo.entrypos;
  1177. { Generate specializations of objectdefs methods }
  1178. generate_specialization_procs;
  1179. { should we force unit initialization? }
  1180. force_init_final:=tstaticsymtable(current_module.localsymtable).needs_init_final;
  1181. if force_init_final then
  1182. init_procinfo:=gen_implicit_initfinal(uf_init,current_module.localsymtable);
  1183. { Add symbol to the exports section for win32 so smartlinking a
  1184. DLL will include the edata section }
  1185. if assigned(exportlib) and
  1186. (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1187. ((current_module.flags and uf_has_exports)<>0) then
  1188. current_asmdata.asmlists[al_procedures].concat(tai_const.createname(make_mangledname('EDATA',current_module.localsymtable,''),0));
  1189. { finalize? }
  1190. if token=_FINALIZATION then
  1191. begin
  1192. { set module options }
  1193. current_module.flags:=current_module.flags or uf_finalize;
  1194. { Parse the finalize }
  1195. finalize_procinfo:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
  1196. finalize_procinfo.procdef.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
  1197. finalize_procinfo.procdef.aliasnames.insert('PASCALFINALIZE');
  1198. finalize_procinfo.parse_body;
  1199. end
  1200. else
  1201. if force_init_final then
  1202. finalize_procinfo:=gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
  1203. { the finalization routine of libraries is generic (and all libraries need to }
  1204. { be finalized, so they can finalize any units they use }
  1205. if (islibrary) then
  1206. exportlib.setfininame(current_asmdata.asmlists[al_procedures],'FPC_LIB_EXIT');
  1207. { all labels must be defined before generating code }
  1208. if Errorcount=0 then
  1209. tstoredsymtable(current_module.localsymtable).checklabels;
  1210. { See remark in unit init/final }
  1211. main_procinfo.generate_code;
  1212. main_procinfo.resetprocdef;
  1213. release_main_proc(main_procinfo);
  1214. if assigned(init_procinfo) then
  1215. begin
  1216. init_procinfo.generate_code;
  1217. init_procinfo.resetprocdef;
  1218. release_main_proc(init_procinfo);
  1219. end;
  1220. if assigned(finalize_procinfo) then
  1221. begin
  1222. finalize_procinfo.generate_code;
  1223. finalize_procinfo.resetprocdef;
  1224. release_main_proc(finalize_procinfo);
  1225. end;
  1226. symtablestack.pop(current_module.localsymtable);
  1227. { consume the last point }
  1228. consume(_POINT);
  1229. if (Errorcount=0) then
  1230. begin
  1231. { test static symtable }
  1232. tstoredsymtable(current_module.localsymtable).allsymbolsused;
  1233. tstoredsymtable(current_module.localsymtable).allprivatesused;
  1234. tstoredsymtable(current_module.localsymtable).check_forwards;
  1235. tstoredsymtable(current_module.localsymtable).unchain_overloaded;
  1236. current_module.allunitsused;
  1237. end;
  1238. { leave when we got an error }
  1239. if (Errorcount>0) and not status.skip_error then
  1240. begin
  1241. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1242. status.skip_error:=true;
  1243. exit;
  1244. end;
  1245. { remove all unused units, this happends when units are removed
  1246. from the uses clause in the source and the ppu was already being loaded }
  1247. hp:=tmodule(loaded_units.first);
  1248. while assigned(hp) do
  1249. begin
  1250. hp2:=hp;
  1251. hp:=tmodule(hp.next);
  1252. if hp2.is_unit and
  1253. not assigned(hp2.globalsymtable) then
  1254. loaded_units.remove(hp2);
  1255. end;
  1256. { do we need to add the variants unit? }
  1257. maybeloadvariantsunit;
  1258. linker.initsysinitunitname;
  1259. if target_info.system in system_internal_sysinit then
  1260. begin
  1261. { add start/halt unit }
  1262. AddUnit(linker.sysinitunit);
  1263. end;
  1264. {$ifdef arm}
  1265. { Insert .pdata section for arm-wince.
  1266. It is needed for exception handling. }
  1267. if target_info.system in [system_arm_wince] then
  1268. InsertPData;
  1269. {$endif arm}
  1270. InsertThreadvars;
  1271. { generate pic helpers to load eip if necessary }
  1272. gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
  1273. { generate rtti/init tables }
  1274. write_persistent_type_info(current_module.localsymtable);
  1275. { generate wrappers for interfaces }
  1276. gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
  1277. { generate imports }
  1278. if current_module.ImportLibraryList.Count>0 then
  1279. importlib.generatelib;
  1280. { generate debuginfo }
  1281. if (cs_debuginfo in current_settings.moduleswitches) then
  1282. current_debuginfo.inserttypeinfo;
  1283. if islibrary or (target_info.system in system_unit_program_exports) then
  1284. exportlib.generatelib;
  1285. { Reference all DEBUGINFO sections from the main .fpc section }
  1286. if (cs_debuginfo in current_settings.moduleswitches) then
  1287. current_debuginfo.referencesections(current_asmdata.asmlists[al_procedures]);
  1288. { Resource strings }
  1289. GenerateResourceStrings;
  1290. { insert Tables and StackLength }
  1291. insertinitfinaltable;
  1292. InsertThreadvarTablesTable;
  1293. InsertResourceTablesTable;
  1294. insertmemorysizes;
  1295. { Insert symbol to resource info }
  1296. InsertResourceInfo;
  1297. { create dwarf debuginfo }
  1298. create_dwarf;
  1299. { insert own objectfile }
  1300. insertobjectfile;
  1301. { assemble and link }
  1302. create_objectfile;
  1303. { We might need the symbols info if not using
  1304. the default do_extractsymbolinfo
  1305. which is a dummy function PM }
  1306. needsymbolinfo:=do_extractsymbolinfo<>@def_extractsymbolinfo;
  1307. { release all local symtables that are not needed anymore }
  1308. if (not needsymbolinfo) then
  1309. free_localsymtables(current_module.localsymtable);
  1310. { leave when we got an error }
  1311. if (Errorcount>0) and not status.skip_error then
  1312. begin
  1313. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1314. status.skip_error:=true;
  1315. exit;
  1316. end;
  1317. if (not current_module.is_unit) then
  1318. begin
  1319. { create the executable when we are at level 1 }
  1320. if (compile_level=1) then
  1321. begin
  1322. { create global resource file by collecting all resource files }
  1323. CollectResourceFiles;
  1324. { write .def file }
  1325. if (cs_link_deffile in current_settings.globalswitches) then
  1326. deffile.writefile;
  1327. { insert all .o files from all loaded units and
  1328. unload the units, we don't need them anymore.
  1329. Keep the current_module because that is still needed }
  1330. hp:=tmodule(loaded_units.first);
  1331. while assigned(hp) do
  1332. begin
  1333. linker.AddModuleFiles(hp);
  1334. hp2:=tmodule(hp.next);
  1335. if (hp<>current_module) and
  1336. (not needsymbolinfo) then
  1337. begin
  1338. loaded_units.remove(hp);
  1339. hp.free;
  1340. end;
  1341. hp:=hp2;
  1342. end;
  1343. { finally we can create a executable }
  1344. if DLLSource then
  1345. linker.MakeSharedLibrary
  1346. else
  1347. linker.MakeExecutable;
  1348. end;
  1349. { Give Fatal with error count for linker errors }
  1350. if (Errorcount>0) and not status.skip_error then
  1351. begin
  1352. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1353. status.skip_error:=true;
  1354. end;
  1355. end;
  1356. end;
  1357. end.