pmodules.pas 55 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487
  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. globalvarsym : tglobalvarsym;
  750. begin
  751. if m_mac in aktmodeswitches then
  752. current_module.mode_switch_allowed:= false;
  753. consume(_UNIT);
  754. if compile_level=1 then
  755. Status.IsExe:=false;
  756. if token=_ID then
  757. begin
  758. { create filenames and unit name }
  759. main_file := current_scanner.inputfile;
  760. while assigned(main_file.next) do
  761. main_file := main_file.next;
  762. new(s1);
  763. s1^:=current_module.modulename^;
  764. current_module.SetFileName(main_file.path^+main_file.name^,true);
  765. current_module.SetModuleName(orgpattern);
  766. { check for system unit }
  767. new(s2);
  768. s2^:=upper(SplitName(main_file.name^));
  769. unitname8:=copy(current_module.modulename^,1,8);
  770. if (cs_check_unit_name in aktglobalswitches) and
  771. (
  772. not(
  773. (current_module.modulename^=s2^) or
  774. (
  775. (length(current_module.modulename^)>8) and
  776. (unitname8=s2^)
  777. )
  778. )
  779. or
  780. (
  781. (length(s1^)>8) and
  782. (s1^<>current_module.modulename^)
  783. )
  784. ) then
  785. Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
  786. if (current_module.modulename^='SYSTEM') then
  787. include(aktmoduleswitches,cs_compilesystem);
  788. dispose(s2);
  789. dispose(s1);
  790. end;
  791. if (target_info.system in system_unit_program_exports) then
  792. exportlib.preparelib(current_module.realmodulename^);
  793. consume(_ID);
  794. consume(_SEMICOLON);
  795. consume(_INTERFACE);
  796. { global switches are read, so further changes aren't allowed }
  797. current_module.in_global:=false;
  798. { handle the global switches }
  799. setupglobalswitches;
  800. message1(unit_u_loading_interface_units,current_module.modulename^);
  801. { update status }
  802. status.currentmodule:=current_module.realmodulename^;
  803. { maybe turn off m_objpas if we are compiling objpas }
  804. if (current_module.modulename^='OBJPAS') then
  805. exclude(aktmodeswitches,m_objpas);
  806. { maybe turn off m_mac if we are compiling macpas }
  807. if (current_module.modulename^='MACPAS') then
  808. exclude(aktmodeswitches,m_mac);
  809. parse_only:=true;
  810. { generate now the global symboltable,
  811. define first as local to overcome dependency conflicts }
  812. current_module.localsymtable:=tglobalsymtable.create(current_module.modulename^,current_module.moduleid);
  813. { insert unitsym of this unit to prevent other units having
  814. the same name }
  815. current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
  816. { load default units, like the system unit }
  817. loaddefaultunits;
  818. { reset }
  819. make_ref:=true;
  820. { insert qualifier for the system unit (allows system.writeln) }
  821. if not(cs_compilesystem in aktmoduleswitches) and
  822. (token=_USES) then
  823. begin
  824. loadunits;
  825. { has it been compiled at a higher level ?}
  826. if current_module.state=ms_compiled then
  827. exit;
  828. end;
  829. { move the global symtable from the temporary local to global }
  830. current_module.globalsymtable:=current_module.localsymtable;
  831. current_module.localsymtable:=nil;
  832. reset_all_defs;
  833. { number all units, so we know if a unit is used by this unit or
  834. needs to be added implicitly }
  835. current_module.updatemaps;
  836. { ... parse the declarations }
  837. Message1(parser_u_parsing_interface,current_module.realmodulename^);
  838. symtablestack.push(current_module.globalsymtable);
  839. read_interface_declarations;
  840. symtablestack.pop(current_module.globalsymtable);
  841. { Export macros defined in the interface for macpas. The macros
  842. are put in the globalmacrosymtable that will only be used by other
  843. units. The current unit continues to use the localmacrosymtable }
  844. if (m_mac in aktmodeswitches) then
  845. begin
  846. current_module.globalmacrosymtable:=tmacrosymtable.create(true);
  847. current_module.localmacrosymtable.foreach_static(@copy_macro,nil);
  848. end;
  849. { leave when we got an error }
  850. if (Errorcount>0) and not status.skip_error then
  851. begin
  852. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  853. status.skip_error:=true;
  854. exit;
  855. end;
  856. { Our interface is compiled, generate CRC and switch to implementation }
  857. if not(cs_compilesystem in aktmoduleswitches) and
  858. (Errorcount=0) then
  859. tppumodule(current_module).getppucrc;
  860. current_module.in_interface:=false;
  861. current_module.interface_compiled:=true;
  862. { First reload all units depending on our interface, we need to do this
  863. in the implementation part to prevent errorneous circular references }
  864. reload_flagged_units;
  865. { Parse the implementation section }
  866. if (m_mac in aktmodeswitches) and try_to_consume(_END) then
  867. has_impl:= false
  868. else
  869. has_impl:= true;
  870. parse_only:=false;
  871. { generates static symbol table }
  872. current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
  873. {$ifdef i386}
  874. if cs_create_pic in aktmoduleswitches then
  875. begin
  876. { insert symbol for got access in assembler code}
  877. globalvarsym:=tglobalvarsym.create('_GLOBAL_OFFSET_TABLE_',vs_value,voidpointertype,[vo_is_external,vo_is_C_var]);
  878. globalvarsym.set_mangledname('_GLOBAL_OFFSET_TABLE_');
  879. current_module.localsymtable.insert(globalvarsym);
  880. { avoid unnecessary warnings }
  881. globalvarsym.varstate:=vs_read;
  882. globalvarsym.refs:=1;
  883. end;
  884. {$endif i386}
  885. if has_impl then
  886. begin
  887. consume(_IMPLEMENTATION);
  888. Message1(unit_u_loading_implementation_units,current_module.modulename^);
  889. { Read the implementation units }
  890. parse_implementation_uses;
  891. end;
  892. if current_module.state=ms_compiled then
  893. exit;
  894. { reset ranges/stabs in exported definitions }
  895. reset_all_defs;
  896. { All units are read, now give them a number }
  897. current_module.updatemaps;
  898. symtablestack.push(current_module.globalsymtable);
  899. symtablestack.push(current_module.localsymtable);
  900. if has_impl then
  901. begin
  902. Message1(parser_u_parsing_implementation,current_module.modulename^);
  903. if current_module.in_interface then
  904. internalerror(200212285);
  905. { Compile the unit }
  906. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'init'),potype_unitinit,current_module.localsymtable);
  907. pd.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
  908. tcgprocinfo(current_procinfo).parse_body;
  909. tcgprocinfo(current_procinfo).generate_code;
  910. tcgprocinfo(current_procinfo).resetprocdef;
  911. { save file pos for debuginfo }
  912. current_module.mainfilepos:=current_procinfo.entrypos;
  913. release_main_proc(pd);
  914. end;
  915. { Generate specializations of objectdefs methods }
  916. generate_specialization_procs;
  917. { if the unit contains ansi/widestrings, initialization and
  918. finalization code must be forced }
  919. force_init_final:=tglobalsymtable(current_module.globalsymtable).needs_init_final or
  920. tstaticsymtable(current_module.localsymtable).needs_init_final;
  921. { should we force unit initialization? }
  922. { this is a hack, but how can it be done better ? }
  923. if force_init_final and ((current_module.flags and uf_init)=0) then
  924. gen_implicit_initfinal(uf_init,current_module.localsymtable);
  925. { finalize? }
  926. if has_impl and (token=_FINALIZATION) then
  927. begin
  928. { set module options }
  929. current_module.flags:=current_module.flags or uf_finalize;
  930. { Compile the finalize }
  931. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
  932. pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
  933. tcgprocinfo(current_procinfo).parse_body;
  934. tcgprocinfo(current_procinfo).generate_code;
  935. tcgprocinfo(current_procinfo).resetprocdef;
  936. release_main_proc(pd);
  937. end
  938. else if force_init_final then
  939. gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
  940. symtablestack.pop(current_module.localsymtable);
  941. symtablestack.pop(current_module.globalsymtable);
  942. { the last char should always be a point }
  943. consume(_POINT);
  944. if (Errorcount=0) then
  945. begin
  946. { tests, if all (interface) forwards are resolved }
  947. tstoredsymtable(current_module.globalsymtable).check_forwards;
  948. { check if all private fields are used }
  949. tstoredsymtable(current_module.globalsymtable).allprivatesused;
  950. { remove cross unit overloads }
  951. tstoredsymtable(current_module.globalsymtable).unchain_overloaded;
  952. { test static symtable }
  953. tstoredsymtable(current_module.localsymtable).allsymbolsused;
  954. tstoredsymtable(current_module.localsymtable).allprivatesused;
  955. tstoredsymtable(current_module.localsymtable).check_forwards;
  956. tstoredsymtable(current_module.localsymtable).checklabels;
  957. tstoredsymtable(current_module.localsymtable).unchain_overloaded;
  958. { used units }
  959. current_module.allunitsused;
  960. end;
  961. { leave when we got an error }
  962. if (Errorcount>0) and not status.skip_error then
  963. begin
  964. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  965. status.skip_error:=true;
  966. exit;
  967. end;
  968. { do we need to add the variants unit? }
  969. maybeloadvariantsunit;
  970. { generate debuginfo }
  971. if (cs_debuginfo in aktmoduleswitches) then
  972. debuginfo.inserttypeinfo;
  973. { generate wrappers for interfaces }
  974. gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.globalsymtable);
  975. gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
  976. { generate pic helpers to load eip if necessary }
  977. gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
  978. { Tables }
  979. insertThreadVars;
  980. { Resource strings }
  981. GenerateResourceStrings;
  982. { generate imports }
  983. if current_module.uses_imports then
  984. importlib.generatelib;
  985. { insert own objectfile, or say that it's in a library
  986. (no check for an .o when loading) }
  987. ag:=is_assembler_generated;
  988. if ag then
  989. insertobjectfile
  990. else
  991. begin
  992. current_module.flags:=current_module.flags or uf_no_link;
  993. current_module.flags:=current_module.flags and not uf_has_debuginfo;
  994. end;
  995. if ag then
  996. begin
  997. { create dwarf debuginfo }
  998. create_dwarf;
  999. { assemble }
  1000. create_objectfile;
  1001. end;
  1002. { Write out the ppufile after the object file has been created }
  1003. store_interface_crc:=current_module.interface_crc;
  1004. {$ifdef EXTDEBUG}
  1005. store_crc:=current_module.crc;
  1006. {$endif EXTDEBUG}
  1007. if (Errorcount=0) then
  1008. tppumodule(current_module).writeppu;
  1009. if not(cs_compilesystem in aktmoduleswitches) then
  1010. if store_interface_crc<>current_module.interface_crc then
  1011. Message1(unit_u_interface_crc_changed,current_module.ppufilename^);
  1012. {$ifdef EXTDEBUG}
  1013. if not(cs_compilesystem in aktmoduleswitches) then
  1014. if (store_crc<>current_module.crc) and simplify_ppu then
  1015. Message1(unit_u_implementation_crc_changed,current_module.ppufilename^);
  1016. {$endif EXTDEBUG}
  1017. { release all overload references and local symtables that
  1018. are not needed anymore }
  1019. tstoredsymtable(current_module.localsymtable).unchain_overloaded;
  1020. tstoredsymtable(current_module.globalsymtable).unchain_overloaded;
  1021. free_localsymtables(current_module.globalsymtable);
  1022. free_localsymtables(current_module.localsymtable);
  1023. { leave when we got an error }
  1024. if (Errorcount>0) and not status.skip_error then
  1025. begin
  1026. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1027. status.skip_error:=true;
  1028. exit;
  1029. end;
  1030. Message1(unit_u_finished_compiling,current_module.modulename^);
  1031. end;
  1032. procedure proc_program(islibrary : boolean);
  1033. var
  1034. main_file : tinputfile;
  1035. hp,hp2 : tmodule;
  1036. pd : tprocdef;
  1037. begin
  1038. DLLsource:=islibrary;
  1039. Status.IsLibrary:=IsLibrary;
  1040. Status.IsExe:=true;
  1041. parse_only:=false;
  1042. { DLL defaults to create reloc info }
  1043. if islibrary then
  1044. begin
  1045. if not RelocSectionSetExplicitly then
  1046. RelocSection:=true;
  1047. end;
  1048. { relocation works only without stabs under win32 !! PM }
  1049. { internal assembler uses rva for stabs info
  1050. so it should work with relocated DLLs }
  1051. if RelocSection and
  1052. (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1053. (target_info.assem<>as_i386_pecoff) then
  1054. begin
  1055. include(aktglobalswitches,cs_link_strip);
  1056. { Warning stabs info does not work with reloc section !! }
  1057. if cs_debuginfo in aktmoduleswitches then
  1058. begin
  1059. Message1(parser_w_parser_reloc_no_debug,current_module.mainsource^);
  1060. Message(parser_w_parser_win32_debug_needs_WN);
  1061. exclude(aktmoduleswitches,cs_debuginfo);
  1062. end;
  1063. end;
  1064. { get correct output names }
  1065. main_file := current_scanner.inputfile;
  1066. while assigned(main_file.next) do
  1067. main_file := main_file.next;
  1068. current_module.SetFileName(main_file.path^+main_file.name^,true);
  1069. if islibrary then
  1070. begin
  1071. consume(_LIBRARY);
  1072. stringdispose(current_module.modulename);
  1073. stringdispose(current_module.realmodulename);
  1074. current_module.modulename:=stringdup(pattern);
  1075. current_module.realmodulename:=stringdup(orgpattern);
  1076. current_module.islibrary:=true;
  1077. exportlib.preparelib(orgpattern);
  1078. if tf_library_needs_pic in target_info.flags then
  1079. include(aktmoduleswitches,cs_create_pic);
  1080. consume(_ID);
  1081. consume(_SEMICOLON);
  1082. end
  1083. else
  1084. { is there an program head ? }
  1085. if token=_PROGRAM then
  1086. begin
  1087. consume(_PROGRAM);
  1088. stringdispose(current_module.modulename);
  1089. stringdispose(current_module.realmodulename);
  1090. current_module.modulename:=stringdup(pattern);
  1091. current_module.realmodulename:=stringdup(orgpattern);
  1092. if (target_info.system in system_unit_program_exports) then
  1093. exportlib.preparelib(orgpattern);
  1094. consume(_ID);
  1095. if token=_LKLAMMER then
  1096. begin
  1097. consume(_LKLAMMER);
  1098. repeat
  1099. consume(_ID);
  1100. until not try_to_consume(_COMMA);
  1101. consume(_RKLAMMER);
  1102. end;
  1103. consume(_SEMICOLON);
  1104. end
  1105. else if (target_info.system in system_unit_program_exports) then
  1106. exportlib.preparelib(current_module.realmodulename^);
  1107. { global switches are read, so further changes aren't allowed }
  1108. current_module.in_global:=false;
  1109. { setup things using the switches }
  1110. setupglobalswitches;
  1111. { set implementation flag }
  1112. current_module.in_interface:=false;
  1113. current_module.interface_compiled:=true;
  1114. { insert after the unit symbol tables the static symbol table }
  1115. { of the program }
  1116. current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
  1117. { load standard units (system,objpas,profile unit) }
  1118. loaddefaultunits;
  1119. { Load units provided on the command line }
  1120. loadautounits;
  1121. {Load the units used by the program we compile.}
  1122. if token=_USES then
  1123. loadunits;
  1124. { reset ranges/stabs in exported definitions }
  1125. reset_all_defs;
  1126. { All units are read, now give them a number }
  1127. current_module.updatemaps;
  1128. {Insert the name of the main program into the symbol table.}
  1129. if current_module.realmodulename^<>'' then
  1130. current_module.localsymtable.insert(tunitsym.create(current_module.realmodulename^,current_module));
  1131. Message1(parser_u_parsing_implementation,current_module.mainsource^);
  1132. symtablestack.push(current_module.localsymtable);
  1133. { The program intialization needs an alias, so it can be called
  1134. from the bootstrap code.}
  1135. if islibrary then
  1136. begin
  1137. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,mainaliasname),potype_proginit,current_module.localsymtable);
  1138. { Win32 startup code needs a single name }
  1139. if not(target_info.system in [system_powerpc_darwin,system_i386_darwin]) then
  1140. pd.aliasnames.insert('PASCALMAIN')
  1141. else
  1142. pd.aliasnames.insert(target_info.Cprefix+'PASCALMAIN')
  1143. end
  1144. else if (target_info.system in [system_i386_netware,system_i386_netwlibc,system_powerpc_macos,system_powerpc_darwin,system_i386_darwin]) then
  1145. begin
  1146. pd:=create_main_proc('PASCALMAIN',potype_proginit,current_module.localsymtable);
  1147. end
  1148. else
  1149. begin
  1150. pd:=create_main_proc(mainaliasname,potype_proginit,current_module.localsymtable);
  1151. pd.aliasnames.insert('PASCALMAIN');
  1152. end;
  1153. tcgprocinfo(current_procinfo).parse_body;
  1154. tcgprocinfo(current_procinfo).generate_code;
  1155. tcgprocinfo(current_procinfo).resetprocdef;
  1156. { save file pos for debuginfo }
  1157. current_module.mainfilepos:=current_procinfo.entrypos;
  1158. release_main_proc(pd);
  1159. { Generate specializations of objectdefs methods }
  1160. generate_specialization_procs;
  1161. { should we force unit initialization? }
  1162. if tstaticsymtable(current_module.localsymtable).needs_init_final then
  1163. begin
  1164. { initialize section }
  1165. gen_implicit_initfinal(uf_init,current_module.localsymtable);
  1166. { finalize section }
  1167. gen_implicit_initfinal(uf_finalize,current_module.localsymtable);
  1168. end;
  1169. { Add symbol to the exports section for win32 so smartlinking a
  1170. DLL will include the edata section }
  1171. if assigned(exportlib) and
  1172. (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1173. ((current_module.flags and uf_has_exports)<>0) then
  1174. current_asmdata.asmlists[al_procedures].concat(tai_const.create_sym(exportlib.edatalabel));
  1175. { finalize? }
  1176. if token=_FINALIZATION then
  1177. begin
  1178. { set module options }
  1179. current_module.flags:=current_module.flags or uf_finalize;
  1180. { Compile the finalize }
  1181. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,current_module.localsymtable);
  1182. pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
  1183. tcgprocinfo(current_procinfo).parse_body;
  1184. tcgprocinfo(current_procinfo).generate_code;
  1185. tcgprocinfo(current_procinfo).resetprocdef;
  1186. release_main_proc(pd);
  1187. end;
  1188. symtablestack.pop(current_module.localsymtable);
  1189. { consume the last point }
  1190. consume(_POINT);
  1191. if (Errorcount=0) then
  1192. begin
  1193. { test static symtable }
  1194. tstoredsymtable(current_module.localsymtable).allsymbolsused;
  1195. tstoredsymtable(current_module.localsymtable).allprivatesused;
  1196. tstoredsymtable(current_module.localsymtable).check_forwards;
  1197. tstoredsymtable(current_module.localsymtable).checklabels;
  1198. tstoredsymtable(current_module.localsymtable).unchain_overloaded;
  1199. current_module.allunitsused;
  1200. end;
  1201. { leave when we got an error }
  1202. if (Errorcount>0) and not status.skip_error then
  1203. begin
  1204. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1205. status.skip_error:=true;
  1206. exit;
  1207. end;
  1208. { remove all unused units, this happends when units are removed
  1209. from the uses clause in the source and the ppu was already being loaded }
  1210. hp:=tmodule(loaded_units.first);
  1211. while assigned(hp) do
  1212. begin
  1213. hp2:=hp;
  1214. hp:=tmodule(hp.next);
  1215. if hp2.is_unit and
  1216. not assigned(hp2.globalsymtable) then
  1217. loaded_units.remove(hp2);
  1218. end;
  1219. { do we need to add the variants unit? }
  1220. maybeloadvariantsunit;
  1221. {$ifdef arm}
  1222. { Insert .pdata section for arm-wince.
  1223. It is needed for exception handling. }
  1224. if target_info.system in [system_arm_wince] then
  1225. InsertPData;
  1226. {$endif arm}
  1227. { generate debuginfo }
  1228. if (cs_debuginfo in aktmoduleswitches) then
  1229. debuginfo.inserttypeinfo;
  1230. InsertThreadvars;
  1231. { generate wrappers for interfaces }
  1232. gen_intf_wrappers(current_asmdata.asmlists[al_procedures],current_module.localsymtable);
  1233. { generate pic helpers to load eip if necessary }
  1234. gen_pic_helpers(current_asmdata.asmlists[al_procedures]);
  1235. { generate imports }
  1236. if current_module.uses_imports then
  1237. importlib.generatelib;
  1238. if islibrary or (target_info.system in system_unit_program_exports) then
  1239. exportlib.generatelib;
  1240. { Reference all DEBUGINFO sections from the main .text section }
  1241. if (cs_debuginfo in aktmoduleswitches) then
  1242. debuginfo.referencesections(current_asmdata.asmlists[al_procedures]);
  1243. { Resource strings }
  1244. GenerateResourceStrings;
  1245. { insert Tables and StackLength }
  1246. insertinitfinaltable;
  1247. InsertThreadvarTablesTable;
  1248. InsertResourceTablesTable;
  1249. insertmemorysizes;
  1250. { Insert symbol to resource info }
  1251. InsertResourceInfo;
  1252. { create dwarf debuginfo }
  1253. create_dwarf;
  1254. { insert own objectfile }
  1255. insertobjectfile;
  1256. { assemble and link }
  1257. create_objectfile;
  1258. { release all local symtables that are not needed anymore }
  1259. free_localsymtables(current_module.localsymtable);
  1260. { leave when we got an error }
  1261. if (Errorcount>0) and not status.skip_error then
  1262. begin
  1263. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1264. status.skip_error:=true;
  1265. exit;
  1266. end;
  1267. if (not current_module.is_unit) then
  1268. begin
  1269. { create the executable when we are at level 1 }
  1270. if (compile_level=1) then
  1271. begin
  1272. { write .def file }
  1273. if (cs_link_deffile in aktglobalswitches) then
  1274. deffile.writefile;
  1275. { insert all .o files from all loaded units and
  1276. unload the units, we don't need them anymore.
  1277. Keep the current_module because that is still needed }
  1278. hp:=tmodule(loaded_units.first);
  1279. while assigned(hp) do
  1280. begin
  1281. linker.AddModuleFiles(hp);
  1282. hp2:=tmodule(hp.next);
  1283. if hp<>current_module then
  1284. begin
  1285. loaded_units.remove(hp);
  1286. hp.free;
  1287. end;
  1288. hp:=hp2;
  1289. end;
  1290. { finally we can create a executable }
  1291. if DLLSource then
  1292. linker.MakeSharedLibrary
  1293. else
  1294. linker.MakeExecutable;
  1295. end;
  1296. end;
  1297. end;
  1298. end.