2
0

pmodules.pas 55 KB

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