pmodules.pas 55 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. Handles the parsing and loading of the modules (ppufiles)
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. unit pmodules;
  19. {$i fpcdefs.inc}
  20. {$define New_GDB}
  21. interface
  22. procedure proc_unit;
  23. procedure proc_program(islibrary : boolean);
  24. implementation
  25. uses
  26. globtype,version,systems,tokens,
  27. cutils,cclasses,comphook,
  28. globals,verbose,fmodule,finput,fppu,
  29. symconst,symbase,symtype,symdef,symsym,symtable,
  30. aasmbase,aasmtai,aasmcpu,
  31. cgbase,cpuinfo,
  32. ncgutil,
  33. link,assemble,import,export,gendef,ppu,comprsrc,
  34. cresstr,cpubase,
  35. {$ifdef GDB}
  36. gdb,
  37. {$endif GDB}
  38. scanner,pbase,pexpr,psystem,psub;
  39. procedure create_objectfile;
  40. var
  41. DLLScanner : TDLLScanner;
  42. s : string;
  43. KeepShared : TStringList;
  44. begin
  45. { try to create import entries from system dlls }
  46. if target_info.DllScanSupported and
  47. (not current_module.linkOtherSharedLibs.Empty) then
  48. begin
  49. { Init DLLScanner }
  50. if assigned(CDLLScanner[target_info.system]) then
  51. DLLScanner:=CDLLScanner[target_info.system].Create
  52. else
  53. internalerror(200104121);
  54. KeepShared:=TStringList.Create;
  55. { Walk all shared libs }
  56. While not current_module.linkOtherSharedLibs.Empty do
  57. begin
  58. S:=current_module.linkOtherSharedLibs.Getusemask(link_allways);
  59. if not DLLScanner.scan(s) then
  60. KeepShared.Concat(s);
  61. end;
  62. DLLscanner.Free;
  63. { Recreate import section }
  64. if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
  65. begin
  66. if assigned(importssection)then
  67. importssection.clear
  68. else
  69. importssection:=taasmoutput.Create;
  70. importlib.generatelib;
  71. end;
  72. { Readd the not processed files }
  73. while not KeepShared.Empty do
  74. begin
  75. s:=KeepShared.GetFirst;
  76. current_module.linkOtherSharedLibs.add(s,link_allways);
  77. end;
  78. KeepShared.Free;
  79. end;
  80. { create the .s file and assemble it }
  81. GenerateAsm(false);
  82. { Also create a smartlinked version ? }
  83. if (cs_create_smart in aktmoduleswitches) then
  84. begin
  85. { regenerate the importssection for win32 }
  86. if assigned(importssection) and
  87. (target_info.system in [system_i386_win32,system_i386_wdosx]) then
  88. begin
  89. importsSection.clear;
  90. importlib.generatesmartlib;
  91. end;
  92. GenerateAsm(true);
  93. if target_asm.needar then
  94. Linker.MakeStaticLibrary;
  95. end;
  96. { resource files }
  97. CompileResourceFiles;
  98. end;
  99. procedure insertobjectfile;
  100. { Insert the used object file for this unit in the used list for this unit }
  101. begin
  102. current_module.linkunitofiles.add(current_module.objfilename^,link_static);
  103. current_module.flags:=current_module.flags or uf_static_linked;
  104. if (cs_create_smart in aktmoduleswitches) then
  105. begin
  106. current_module.linkunitstaticlibs.add(current_module.staticlibfilename^,link_smart);
  107. current_module.flags:=current_module.flags or uf_smart_linked;
  108. end;
  109. end;
  110. procedure insertsegment;
  111. procedure fixseg(p:TAAsmoutput;sec:TSection);
  112. begin
  113. p.insert(Tai_section.Create(sec));
  114. if (cs_create_smart in aktmoduleswitches) then
  115. p.insert(Tai_cut.Create);
  116. p.concat(Tai_section.Create(sec_none));
  117. end;
  118. begin
  119. { Insert Ident of the compiler }
  120. if (not (cs_create_smart in aktmoduleswitches))
  121. {$ifndef EXTDEBUG}
  122. and (not current_module.is_unit)
  123. {$endif}
  124. then
  125. begin
  126. { align the first data }
  127. dataSegment.insert(Tai_align.Create(used_align(32,
  128. aktalignment.constalignmin,aktalignment.constalignmax)));
  129. dataSegment.insert(Tai_string.Create('FPC '+full_version_string+
  130. ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.shortname));
  131. end;
  132. { align code segment }
  133. codeSegment.concat(Tai_align.Create(aktalignment.procalign));
  134. { Insert start and end of sections }
  135. fixseg(codesegment,sec_code);
  136. fixseg(datasegment,sec_data);
  137. fixseg(bsssegment,sec_bss);
  138. { we should use .rdata section for these two no ? }
  139. { .rdata is a read only data section (PM) }
  140. fixseg(rttilist,sec_data);
  141. fixseg(consts,sec_data);
  142. if assigned(resourcestringlist) then
  143. fixseg(resourcestringlist,sec_data);
  144. {$ifdef GDB}
  145. if assigned(debuglist) then
  146. begin
  147. debugList.insert(Tai_symbol.Createname('gcc2_compiled',0));
  148. debugList.insert(Tai_symbol.Createname('fpc_compiled',0));
  149. fixseg(debuglist,sec_code);
  150. end;
  151. {$endif GDB}
  152. end;
  153. procedure InsertThreadvarTablesTable;
  154. var
  155. hp : tused_unit;
  156. ltvTables : taasmoutput;
  157. count : longint;
  158. begin
  159. ltvTables:=TAAsmOutput.Create;
  160. count:=0;
  161. hp:=tused_unit(usedunits.first);
  162. while assigned(hp) do
  163. begin
  164. If (hp.u.flags and uf_threadvars)=uf_threadvars then
  165. begin
  166. ltvTables.concat(Tai_const_symbol.Createname(hp.u.modulename^+'_$THREADVARLIST'));
  167. inc(count);
  168. end;
  169. hp:=tused_unit(hp.next);
  170. end;
  171. { Add program threadvars, if any }
  172. If (current_module.flags and uf_threadvars)=uf_threadvars then
  173. begin
  174. ltvTables.concat(Tai_const_symbol.Createname(current_module.modulename^+'_$THREADVARLIST'));
  175. inc(count);
  176. end;
  177. { TableCount }
  178. ltvTables.insert(Tai_const.Create_32bit(count));
  179. ltvTables.insert(Tai_symbol.Createdataname_global('FPC_THREADVARTABLES',0));
  180. ltvTables.concat(Tai_symbol_end.Createname('FPC_THREADVARTABLES'));
  181. { insert in data segment }
  182. if (cs_create_smart in aktmoduleswitches) then
  183. dataSegment.concat(Tai_cut.Create);
  184. dataSegment.concatlist(ltvTables);
  185. ltvTables.free;
  186. if count > 0 then
  187. have_local_threadvars := true;
  188. end;
  189. procedure AddToThreadvarList(p:tnamedindexitem;arg:pointer);
  190. var
  191. ltvTable : taasmoutput;
  192. begin
  193. ltvTable:=taasmoutput(arg);
  194. if (tsym(p).typ=varsym) and
  195. (vo_is_thread_var in tvarsym(p).varoptions) then
  196. begin
  197. { address of threadvar }
  198. ltvTable.concat(tai_const_symbol.createname(tvarsym(p).mangledname));
  199. { size of threadvar }
  200. ltvTable.concat(tai_const.create_32bit(tvarsym(p).getsize));
  201. end;
  202. end;
  203. procedure InsertThreadvars;
  204. var
  205. ltvTable : TAAsmoutput;
  206. begin
  207. ltvTable:=TAAsmoutput.create;
  208. if assigned(current_module.globalsymtable) then
  209. current_module.globalsymtable.foreach_static({$ifdef FPCPROCVAR}@{$endif}AddToThreadvarList,ltvTable);
  210. current_module.localsymtable.foreach_static({$ifdef FPCPROCVAR}@{$endif}AddToThreadvarList,ltvTable);
  211. if ltvTable.first<>nil then
  212. begin
  213. { add begin and end of the list }
  214. ltvTable.insert(tai_symbol.createdataname_global(current_module.modulename^+'_$THREADVARLIST',0));
  215. ltvTable.concat(tai_const.create_32bit(0)); { end of list marker }
  216. ltvTable.concat(tai_symbol_end.createname(current_module.modulename^+'_$THREADVARLIST'));
  217. if (cs_create_smart in aktmoduleswitches) then
  218. dataSegment.concat(Tai_cut.Create);
  219. dataSegment.concatlist(ltvTable);
  220. current_module.flags:=current_module.flags or uf_threadvars;
  221. end;
  222. ltvTable.Free;
  223. end;
  224. Procedure InsertResourceTablesTable;
  225. var
  226. hp : tused_unit;
  227. ResourceStringTables : taasmoutput;
  228. count : longint;
  229. begin
  230. ResourceStringTables:=TAAsmOutput.Create;
  231. count:=0;
  232. hp:=tused_unit(usedunits.first);
  233. while assigned(hp) do
  234. begin
  235. If (hp.u.flags and uf_has_resources)=uf_has_resources then
  236. begin
  237. ResourceStringTables.concat(Tai_const_symbol.Createname(hp.u.modulename^+'_RESOURCESTRINGLIST'));
  238. inc(count);
  239. end;
  240. hp:=tused_unit(hp.next);
  241. end;
  242. { Add program resources, if any }
  243. If ResourceStringList<>Nil then
  244. begin
  245. ResourceStringTables.concat(Tai_const_symbol.Createname(current_module.modulename^+'_RESOURCESTRINGLIST'));
  246. Inc(Count);
  247. end;
  248. { TableCount }
  249. ResourceStringTables.insert(Tai_const.Create_32bit(count));
  250. ResourceStringTables.insert(Tai_symbol.Createdataname_global('FPC_RESOURCESTRINGTABLES',0));
  251. ResourceStringTables.concat(Tai_symbol_end.Createname('FPC_RESOURCESTRINGTABLES'));
  252. { insert in data segment }
  253. if (cs_create_smart in aktmoduleswitches) then
  254. dataSegment.concat(Tai_cut.Create);
  255. dataSegment.concatlist(ResourceStringTables);
  256. ResourceStringTables.free;
  257. end;
  258. procedure InsertInitFinalTable;
  259. var
  260. hp : tused_unit;
  261. unitinits : taasmoutput;
  262. count : longint;
  263. begin
  264. unitinits:=TAAsmOutput.Create;
  265. count:=0;
  266. hp:=tused_unit(usedunits.first);
  267. while assigned(hp) do
  268. begin
  269. { call the unit init code and make it external }
  270. if (hp.u.flags and (uf_init or uf_finalize))<>0 then
  271. begin
  272. if (hp.u.flags and uf_init)<>0 then
  273. unitinits.concat(Tai_const_symbol.Createname('INIT$$'+hp.u.modulename^))
  274. else
  275. unitinits.concat(Tai_const.Create_32bit(0));
  276. if (hp.u.flags and uf_finalize)<>0 then
  277. unitinits.concat(Tai_const_symbol.Createname('FINALIZE$$'+hp.u.modulename^))
  278. else
  279. unitinits.concat(Tai_const.Create_32bit(0));
  280. inc(count);
  281. end;
  282. hp:=tused_unit(hp.next);
  283. end;
  284. { Insert initialization/finalization of the program }
  285. if (current_module.flags and (uf_init or uf_finalize))<>0 then
  286. begin
  287. if (current_module.flags and uf_init)<>0 then
  288. unitinits.concat(Tai_const_symbol.Createname('INIT$$'+current_module.modulename^))
  289. else
  290. unitinits.concat(Tai_const.Create_32bit(0));
  291. if (current_module.flags and uf_finalize)<>0 then
  292. unitinits.concat(Tai_const_symbol.Createname('FINALIZE$$'+current_module.modulename^))
  293. else
  294. unitinits.concat(Tai_const.Create_32bit(0));
  295. inc(count);
  296. end;
  297. { TableCount,InitCount }
  298. unitinits.insert(Tai_const.Create_32bit(0));
  299. unitinits.insert(Tai_const.Create_32bit(count));
  300. unitinits.insert(Tai_symbol.Createdataname_global('INITFINAL',0));
  301. unitinits.concat(Tai_symbol_end.Createname('INITFINAL'));
  302. { insert in data segment }
  303. if (cs_create_smart in aktmoduleswitches) then
  304. dataSegment.concat(Tai_cut.Create);
  305. dataSegment.concatlist(unitinits);
  306. unitinits.free;
  307. end;
  308. procedure insertheap;
  309. begin
  310. if (cs_create_smart in aktmoduleswitches) then
  311. begin
  312. bssSegment.concat(Tai_cut.Create);
  313. dataSegment.concat(Tai_cut.Create);
  314. end;
  315. { On the Macintosh Classic M68k Architecture
  316. The Heap variable is simply a POINTER to the
  317. real HEAP. The HEAP must be set up by the RTL
  318. and must store the pointer in this value.
  319. On OS/2 the heap is also intialized by the RTL. We do
  320. not output a pointer }
  321. case target_info.system of
  322. {$ifdef x86_64}
  323. target_x86_64_linux:
  324. ;
  325. {$endif x86_64}
  326. {$ifdef i386}
  327. system_i386_OS2:
  328. ;
  329. {$endif i386}
  330. {$ifdef powerpc}
  331. system_powerpc_macos:
  332. ;
  333. {$endif powerpc}
  334. {$ifdef alpha}
  335. system_alpha_linux:
  336. ;
  337. {$endif alpha}
  338. {$ifdef m68k}
  339. system_m68k_Mac:
  340. bssSegment.concat(Tai_datablock.Create_global('HEAP',4));
  341. system_m68k_PalmOS:
  342. ;
  343. {$endif m68k}
  344. {$IFDEF SPARC}
  345. system_SPARC_Linux:
  346. ;
  347. {$ENDIF SPARC}
  348. else
  349. bssSegment.concat(Tai_datablock.Create_global('HEAP',heapsize));
  350. end;
  351. {$ifdef m68k}
  352. if target_info.system<>system_m68k_PalmOS then
  353. begin
  354. dataSegment.concat(Tai_symbol.Createdataname_global('HEAPSIZE',4));
  355. dataSegment.concat(Tai_const.Create_32bit(heapsize));
  356. end;
  357. {$else m68k}
  358. dataSegment.concat(Tai_symbol.Createdataname_global('HEAPSIZE',4));
  359. dataSegment.concat(Tai_const.Create_32bit(heapsize));
  360. {$endif m68k}
  361. end;
  362. procedure insertstacklength;
  363. begin
  364. { stacksize can be specified and is now simulated }
  365. dataSegment.concat(Tai_symbol.Createdataname_global('__stklen',4));
  366. dataSegment.concat(Tai_const.Create_32bit(stacksize));
  367. end;
  368. procedure loaddefaultunits;
  369. var
  370. hp : tmodule;
  371. unitsym : tunitsym;
  372. begin
  373. { are we compiling the system unit? }
  374. if (cs_compilesystem in aktmoduleswitches) then
  375. begin
  376. { create system defines }
  377. createconstdefs;
  378. { we don't need to reset anything, it's already done in parser.pas }
  379. exit;
  380. end;
  381. { insert the system unit, it is allways the first }
  382. hp:=loadunit('System','');
  383. systemunit:=tglobalsymtable(hp.globalsymtable);
  384. { it's always the first unit }
  385. systemunit.next:=nil;
  386. symtablestack:=systemunit;
  387. { add to the used units }
  388. current_module.used_units.concat(tused_unit.create(hp,true));
  389. unitsym:=tunitsym.create('System',systemunit);
  390. inc(unitsym.refs);
  391. refsymtable.insert(unitsym);
  392. { read default constant definitions }
  393. make_ref:=false;
  394. readconstdefs;
  395. make_ref:=true;
  396. { Thread support unit? }
  397. if (cs_threading in aktmoduleswitches) then
  398. begin
  399. hp:=loadunit('systhrds','');
  400. tsymtable(hp.globalsymtable).next:=symtablestack;
  401. symtablestack:=hp.globalsymtable;
  402. { add to the used units }
  403. current_module.used_units.concat(tused_unit.create(hp,true));
  404. unitsym:=tunitsym.create('Threads',hp.globalsymtable);
  405. inc(unitsym.refs);
  406. refsymtable.insert(unitsym);
  407. end;
  408. { Objpas unit? }
  409. if m_objpas in aktmodeswitches then
  410. begin
  411. hp:=loadunit('ObjPas','');
  412. tsymtable(hp.globalsymtable).next:=symtablestack;
  413. symtablestack:=hp.globalsymtable;
  414. { add to the used units }
  415. current_module.used_units.concat(tused_unit.create(hp,true));
  416. unitsym:=tunitsym.create('ObjPas',hp.globalsymtable);
  417. inc(unitsym.refs);
  418. refsymtable.insert(unitsym);
  419. end;
  420. { Profile unit? Needed for go32v2 only }
  421. if (cs_profile in aktmoduleswitches) and (target_info.system=system_i386_go32v2) then
  422. begin
  423. hp:=loadunit('Profile','');
  424. tsymtable(hp.globalsymtable).next:=symtablestack;
  425. symtablestack:=hp.globalsymtable;
  426. { add to the used units }
  427. current_module.used_units.concat(tused_unit.create(hp,true));
  428. unitsym:=tunitsym.create('Profile',hp.globalsymtable);
  429. inc(unitsym.refs);
  430. refsymtable.insert(unitsym);
  431. end;
  432. { Units only required for main module }
  433. if not(current_module.is_unit) then
  434. begin
  435. { Heaptrc unit }
  436. if (cs_gdb_heaptrc in aktglobalswitches) then
  437. begin
  438. hp:=loadunit('HeapTrc','');
  439. tsymtable(hp.globalsymtable).next:=symtablestack;
  440. symtablestack:=hp.globalsymtable;
  441. { add to the used units }
  442. current_module.used_units.concat(tused_unit.create(hp,true));
  443. unitsym:=tunitsym.create('HeapTrc',hp.globalsymtable);
  444. inc(unitsym.refs);
  445. refsymtable.insert(unitsym);
  446. end;
  447. { Lineinfo unit }
  448. if (cs_gdb_lineinfo in aktglobalswitches) then
  449. begin
  450. hp:=loadunit('LineInfo','');
  451. tsymtable(hp.globalsymtable).next:=symtablestack;
  452. symtablestack:=hp.globalsymtable;
  453. { add to the used units }
  454. current_module.used_units.concat(tused_unit.create(hp,true));
  455. unitsym:=tunitsym.create('LineInfo',hp.globalsymtable);
  456. inc(unitsym.refs);
  457. refsymtable.insert(unitsym);
  458. end;
  459. end;
  460. { save default symtablestack }
  461. defaultsymtablestack:=symtablestack;
  462. end;
  463. procedure loadunits;
  464. var
  465. s,sorg : stringid;
  466. fn : string;
  467. pu,
  468. hp : tused_unit;
  469. hp2 : tmodule;
  470. hp3 : tsymtable;
  471. oldprocsym:tprocsym;
  472. oldprocdef:tprocdef;
  473. unitsym : tunitsym;
  474. begin
  475. oldprocsym:=aktprocsym;
  476. oldprocdef:=aktprocdef;
  477. consume(_USES);
  478. {$ifdef DEBUG}
  479. test_symtablestack;
  480. {$endif DEBUG}
  481. repeat
  482. s:=pattern;
  483. sorg:=orgpattern;
  484. consume(_ID);
  485. { support "<unit> in '<file>'" construct, but not for tp7 }
  486. if not(m_tp7 in aktmodeswitches) then
  487. begin
  488. if try_to_consume(_OP_IN) then
  489. fn:=get_stringconst
  490. else
  491. fn:='';
  492. end;
  493. { Give a warning if objpas is loaded }
  494. if s='OBJPAS' then
  495. Message(parser_w_no_objpas_use_mode);
  496. { check if the unit is already used }
  497. pu:=tused_unit(current_module.used_units.first);
  498. while assigned(pu) do
  499. begin
  500. if (pu.name^=s) then
  501. break;
  502. pu:=tused_unit(pu.next);
  503. end;
  504. { avoid uses of itself }
  505. if not assigned(pu) and (s<>current_module.modulename^) then
  506. begin
  507. { load the unit }
  508. hp2:=loadunit(sorg,fn);
  509. { the current module uses the unit hp2 }
  510. current_module.used_units.concat(tused_unit.create(hp2,not current_module.in_implementation));
  511. tused_unit(current_module.used_units.last).in_uses:=true;
  512. if current_module.compiled then
  513. exit;
  514. unitsym:=tunitsym.create(sorg,hp2.globalsymtable);
  515. { never claim about unused unit if
  516. there is init or finalize code PM }
  517. if (hp2.flags and (uf_init or uf_finalize))<>0 then
  518. inc(unitsym.refs);
  519. refsymtable.insert(unitsym);
  520. end
  521. else
  522. Message1(sym_e_duplicate_id,s);
  523. if token=_COMMA then
  524. begin
  525. pattern:='';
  526. consume(_COMMA);
  527. end
  528. else
  529. break;
  530. until false;
  531. consume(_SEMICOLON);
  532. { set the symtable to systemunit so it gets reorderd correctly }
  533. symtablestack:=defaultsymtablestack;
  534. { now insert the units in the symtablestack }
  535. hp:=tused_unit(current_module.used_units.first);
  536. while assigned(hp) do
  537. begin
  538. {$IfDef GDB}
  539. if (cs_debuginfo in aktmoduleswitches) and
  540. (cs_gdb_dbx in aktglobalswitches) and
  541. not hp.is_stab_written then
  542. begin
  543. tglobalsymtable(hp.u.globalsymtable).concattypestabto(debuglist);
  544. hp.is_stab_written:=true;
  545. hp.unitid:=tsymtable(hp.u.globalsymtable).unitid;
  546. end;
  547. {$EndIf GDB}
  548. if hp.in_uses then
  549. begin
  550. hp3:=symtablestack;
  551. while assigned(hp3) do
  552. begin
  553. { insert units only once ! }
  554. if hp.u.globalsymtable=hp3 then
  555. break;
  556. hp3:=hp3.next;
  557. { unit isn't inserted }
  558. if hp3=nil then
  559. begin
  560. tsymtable(hp.u.globalsymtable).next:=symtablestack;
  561. symtablestack:=tsymtable(hp.u.globalsymtable);
  562. {$ifdef DEBUG}
  563. test_symtablestack;
  564. {$endif DEBUG}
  565. end;
  566. end;
  567. end;
  568. hp:=tused_unit(hp.next);
  569. end;
  570. aktprocsym:=oldprocsym;
  571. aktprocdef:=oldprocdef;
  572. end;
  573. procedure write_gdb_info;
  574. {$IfDef GDB}
  575. var
  576. hp : tused_unit;
  577. begin
  578. if not (cs_debuginfo in aktmoduleswitches) then
  579. exit;
  580. if (cs_gdb_dbx in aktglobalswitches) then
  581. begin
  582. debugList.concat(tai_comment.Create(strpnew('EINCL of global '+
  583. tglobalsymtable(current_module.globalsymtable).name^+' has index '+
  584. tostr(tglobalsymtable(current_module.globalsymtable).unitid))));
  585. debugList.concat(Tai_stabs.Create(strpnew('"'+
  586. tglobalsymtable(current_module.globalsymtable).name^+'",'+
  587. tostr(N_EINCL)+',0,0,0')));
  588. tglobalsymtable(current_module.globalsymtable).dbx_count_ok:={true}false;
  589. dbx_counter:=tglobalsymtable(current_module.globalsymtable).prev_dbx_counter;
  590. do_count_dbx:=false;
  591. end;
  592. { now insert the units in the symtablestack }
  593. hp:=tused_unit(current_module.used_units.first);
  594. while assigned(hp) do
  595. begin
  596. if (cs_debuginfo in aktmoduleswitches) and
  597. not hp.is_stab_written then
  598. begin
  599. tglobalsymtable(hp.u.globalsymtable).concattypestabto(debuglist);
  600. hp.is_stab_written:=true;
  601. hp.unitid:=tsymtable(hp.u.globalsymtable).unitid;
  602. end;
  603. hp:=tused_unit(hp.next);
  604. end;
  605. if current_module.in_implementation and
  606. assigned(current_module.localsymtable) then
  607. begin
  608. { all types }
  609. tstaticsymtable(current_module.localsymtable).concattypestabto(debuglist);
  610. { and all local symbols}
  611. tstaticsymtable(current_module.localsymtable).concatstabto(debuglist);
  612. end
  613. else if assigned(current_module.globalsymtable) then
  614. begin
  615. { all types }
  616. tglobalsymtable(current_module.globalsymtable).concattypestabto(debuglist);
  617. { and all local symbols}
  618. tglobalsymtable(current_module.globalsymtable).concatstabto(debuglist);
  619. end;
  620. end;
  621. {$Else GDB}
  622. begin
  623. end;
  624. {$EndIf GDB}
  625. procedure parse_implementation_uses(symt:tsymtable);
  626. begin
  627. if token=_USES then
  628. begin
  629. loadunits;
  630. {$ifdef DEBUG}
  631. test_symtablestack;
  632. {$endif DEBUG}
  633. end;
  634. end;
  635. procedure setupglobalswitches;
  636. begin
  637. { can't have local browser when no global browser }
  638. if (cs_local_browser in aktmoduleswitches) and
  639. not(cs_browser in aktmoduleswitches) then
  640. exclude(aktmoduleswitches,cs_local_browser);
  641. { define a symbol in delphi,objfpc,tp,gpc mode }
  642. if (m_delphi in aktmodeswitches) then
  643. current_scanner.def_macro('FPC_DELPHI')
  644. else
  645. if (m_tp7 in aktmodeswitches) then
  646. current_scanner.def_macro('FPC_TP')
  647. else
  648. if (m_objfpc in aktmodeswitches) then
  649. current_scanner.def_macro('FPC_OBJFPC')
  650. else
  651. if (m_gpc in aktmodeswitches) then
  652. current_scanner.def_macro('FPC_GPC');
  653. end;
  654. procedure gen_main_procsym(const name:string;options:tproctypeoption;st:tsymtable);
  655. var
  656. stt : tsymtable;
  657. begin
  658. {Generate a procsym for main}
  659. make_ref:=false;
  660. aktprocsym:=tprocsym.create('$'+name);
  661. { main are allways used }
  662. inc(aktprocsym.refs);
  663. {Try to insert in in static symtable ! }
  664. stt:=symtablestack;
  665. symtablestack:=st;
  666. aktprocdef:=tprocdef.create;
  667. aktprocsym.addprocdef(aktprocdef);
  668. aktprocdef.procsym:=aktprocsym;
  669. symtablestack:=stt;
  670. aktprocdef.proctypeoption:=options;
  671. aktprocdef.setmangledname(target_info.cprefix+name);
  672. aktprocdef.forwarddef:=false;
  673. make_ref:=true;
  674. { The localst is a local symtable. Change it into the static
  675. symtable }
  676. aktprocdef.localst.free;
  677. aktprocdef.localst:=st;
  678. { and insert the procsym in symtable }
  679. st.insert(aktprocsym);
  680. { set some informations about the main program }
  681. with procinfo do
  682. begin
  683. _class:=nil;
  684. para_offset:=target_info.first_parm_offset;
  685. framepointer:=FRAME_POINTER_REG;
  686. flags:=0;
  687. procdef:=aktprocdef;
  688. end;
  689. end;
  690. procedure proc_unit;
  691. function is_assembler_generated:boolean;
  692. begin
  693. is_assembler_generated:=(Errorcount=0) and
  694. not(
  695. codeSegment.empty and
  696. dataSegment.empty and
  697. bssSegment.empty and
  698. ((importssection=nil) or importsSection.empty) and
  699. ((resourcesection=nil) or resourceSection.empty) and
  700. ((resourcestringlist=nil) or resourcestringList.empty)
  701. );
  702. end;
  703. var
  704. main_file: tinputfile;
  705. st : tsymtable;
  706. unitst : tglobalsymtable;
  707. {$ifdef GDB}
  708. pu : tused_unit;
  709. {$endif GDB}
  710. store_crc,store_interface_crc : cardinal;
  711. s2 : ^string; {Saves stack space}
  712. force_init_final : boolean;
  713. begin
  714. consume(_UNIT);
  715. if compile_level=1 then
  716. Status.IsExe:=false;
  717. if token=_ID then
  718. begin
  719. { create filenames and unit name }
  720. main_file := current_scanner.inputfile;
  721. while assigned(main_file.next) do
  722. main_file := main_file.next;
  723. current_module.SetFileName(main_file.path^+main_file.name^,true);
  724. stringdispose(current_module.modulename);
  725. stringdispose(current_module.realmodulename);
  726. current_module.modulename:=stringdup(pattern);
  727. current_module.realmodulename:=stringdup(orgpattern);
  728. { check for system unit }
  729. new(s2);
  730. s2^:=upper(SplitName(main_file.name^));
  731. if (cs_check_unit_name in aktglobalswitches) and
  732. not((current_module.modulename^=s2^) or
  733. ((length(current_module.modulename^)>8) and
  734. (copy(current_module.modulename^,1,8)=s2^))) then
  735. Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
  736. if (current_module.modulename^='SYSTEM') then
  737. include(aktmoduleswitches,cs_compilesystem);
  738. dispose(s2);
  739. end;
  740. consume(_ID);
  741. consume(_SEMICOLON);
  742. consume(_INTERFACE);
  743. { global switches are read, so further changes aren't allowed }
  744. current_module.in_global:=false;
  745. { handle the global switches }
  746. setupglobalswitches;
  747. Message1(unit_u_start_parse_interface,current_module.realmodulename^);
  748. { update status }
  749. status.currentmodule:=current_module.realmodulename^;
  750. { maybe turn off m_objpas if we are compiling objpas }
  751. if (current_module.modulename^='OBJPAS') then
  752. exclude(aktmodeswitches,m_objpas);
  753. parse_only:=true;
  754. { generate now the global symboltable }
  755. st:=tglobalsymtable.create(current_module.modulename^);
  756. refsymtable:=st;
  757. unitst:=tglobalsymtable(st);
  758. { define first as local to overcome dependency conflicts }
  759. current_module.localsymtable:=st;
  760. { the unit name must be usable as a unit specifier }
  761. { inside the unit itself (PM) }
  762. { this also forbids to have another symbol }
  763. { with the same name as the unit }
  764. refsymtable.insert(tunitsym.create(current_module.realmodulename^,unitst));
  765. { load default units, like the system unit }
  766. loaddefaultunits;
  767. { reset }
  768. make_ref:=true;
  769. lexlevel:=0;
  770. { insert qualifier for the system unit (allows system.writeln) }
  771. if not(cs_compilesystem in aktmoduleswitches) then
  772. begin
  773. if token=_USES then
  774. begin
  775. loadunits;
  776. { has it been compiled at a higher level ?}
  777. if current_module.compiled then
  778. begin
  779. { this unit symtable is obsolete }
  780. { dispose(unitst,done);
  781. disposed as localsymtable !! }
  782. RestoreUnitSyms;
  783. exit;
  784. end;
  785. end;
  786. { ... but insert the symbol table later }
  787. st.next:=symtablestack;
  788. symtablestack:=st;
  789. end
  790. else
  791. { while compiling a system unit, some types are directly inserted }
  792. begin
  793. st.next:=symtablestack;
  794. symtablestack:=st;
  795. insert_intern_types(st);
  796. end;
  797. { now we know the place to insert the constants }
  798. constsymtable:=symtablestack;
  799. { move the global symtab from the temporary local to global }
  800. current_module.globalsymtable:=current_module.localsymtable;
  801. current_module.localsymtable:=nil;
  802. reset_global_defs;
  803. { number all units, so we know if a unit is used by this unit or
  804. needs to be added implicitly }
  805. current_module.numberunits;
  806. { ... parse the declarations }
  807. Message1(parser_u_parsing_interface,current_module.realmodulename^);
  808. read_interface_declarations;
  809. { leave when we got an error }
  810. if (Errorcount>0) and not status.skip_error then
  811. begin
  812. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  813. status.skip_error:=true;
  814. exit;
  815. end;
  816. {else in inteface its somatimes necessary even if unused
  817. st^.allunitsused; }
  818. {$ifdef New_GDB}
  819. write_gdb_info;
  820. {$endIf Def New_GDB}
  821. if not(cs_compilesystem in aktmoduleswitches) then
  822. if (Errorcount=0) then
  823. tppumodule(current_module).getppucrc;
  824. { Parse the implementation section }
  825. consume(_IMPLEMENTATION);
  826. current_module.in_implementation:=true;
  827. Message1(unit_u_start_parse_implementation,current_module.modulename^);
  828. parse_only:=false;
  829. { generates static symbol table }
  830. st:=tstaticsymtable.create(current_module.modulename^);
  831. current_module.localsymtable:=st;
  832. { remove the globalsymtable from the symtable stack }
  833. { to reinsert it after loading the implementation units }
  834. symtablestack:=unitst.next;
  835. { we don't want implementation units symbols in unitsymtable !! PM }
  836. refsymtable:=st;
  837. { Read the implementation units }
  838. parse_implementation_uses(unitst);
  839. if current_module.compiled then
  840. begin
  841. RestoreUnitSyms;
  842. exit;
  843. end;
  844. { reset ranges/stabs in exported definitions }
  845. reset_global_defs;
  846. { All units are read, now give them a number }
  847. current_module.numberunits;
  848. { now we can change refsymtable }
  849. refsymtable:=st;
  850. { but reinsert the global symtable as lasts }
  851. unitst.next:=symtablestack;
  852. symtablestack:=unitst;
  853. tstoredsymtable(symtablestack).chainoperators;
  854. {$ifdef DEBUG}
  855. test_symtablestack;
  856. {$endif DEBUG}
  857. constsymtable:=symtablestack;
  858. {$ifdef Splitheap}
  859. if testsplit then
  860. begin
  861. Split_Heap;
  862. allow_special:=true;
  863. Switch_to_temp_heap;
  864. end;
  865. { it will report all crossings }
  866. allow_special:=false;
  867. {$endif Splitheap}
  868. Message1(parser_u_parsing_implementation,current_module.realmodulename^);
  869. { Compile the unit }
  870. codegen_newprocedure;
  871. gen_main_procsym(current_module.modulename^+'_init',potype_unitinit,st);
  872. aktprocdef.aliasnames.insert('INIT$$'+current_module.modulename^);
  873. aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_init');
  874. compile_proc_body(true,false);
  875. codegen_doneprocedure;
  876. { avoid self recursive destructor call !! PM }
  877. aktprocdef.localst:=nil;
  878. { if the unit contains ansi/widestrings, initialization and
  879. finalization code must be forced }
  880. force_init_final:=tglobalsymtable(current_module.globalsymtable).needs_init_final or
  881. tstaticsymtable(current_module.localsymtable).needs_init_final;
  882. { should we force unit initialization? }
  883. { this is a hack, but how can it be done better ? }
  884. if force_init_final and ((current_module.flags and uf_init)=0) then
  885. begin
  886. current_module.flags:=current_module.flags or uf_init;
  887. { now we can insert a cut }
  888. if (cs_create_smart in aktmoduleswitches) then
  889. codeSegment.concat(Tai_cut.Create);
  890. genimplicitunitinit(codesegment);
  891. end;
  892. { finalize? }
  893. if token=_FINALIZATION then
  894. begin
  895. { set module options }
  896. current_module.flags:=current_module.flags or uf_finalize;
  897. { Compile the finalize }
  898. codegen_newprocedure;
  899. gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
  900. aktprocdef.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
  901. aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
  902. compile_proc_body(true,false);
  903. codegen_doneprocedure;
  904. end
  905. else if force_init_final then
  906. begin
  907. current_module.flags:=current_module.flags or uf_finalize;
  908. { now we can insert a cut }
  909. if (cs_create_smart in aktmoduleswitches) then
  910. codeSegment.concat(Tai_cut.Create);
  911. genimplicitunitfinal(codesegment);
  912. end;
  913. { the last char should always be a point }
  914. consume(_POINT);
  915. { generate a list of threadvars }
  916. InsertThreadvars;
  917. { Generate resoucestrings }
  918. If ResourceStrings.ResStrCount>0 then
  919. begin
  920. ResourceStrings.CreateResourceStringList;
  921. current_module.flags:=current_module.flags or uf_has_resources;
  922. { only write if no errors found }
  923. if (Errorcount=0) then
  924. ResourceStrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst'));
  925. end;
  926. { avoid self recursive destructor call !! PM }
  927. aktprocdef.localst:=nil;
  928. { absence does not matter here !! }
  929. aktprocdef.forwarddef:=false;
  930. { test static symtable }
  931. if (Errorcount=0) then
  932. begin
  933. tstoredsymtable(st).allsymbolsused;
  934. tstoredsymtable(st).allunitsused;
  935. tstoredsymtable(st).allprivatesused;
  936. end;
  937. { size of the static data }
  938. datasize:=st.datasize;
  939. {$ifdef GDB}
  940. { add all used definitions even for implementation}
  941. if (cs_debuginfo in aktmoduleswitches) then
  942. begin
  943. {$IfnDef New_GDB}
  944. if assigned(current_module.globalsymtable) then
  945. begin
  946. { all types }
  947. tglobalsymtable(current_module.globalsymtable).concattypestabto(debuglist);
  948. { and all local symbols}
  949. tglobalsymtable(current_module.globalsymtable).concatstabto(debuglist);
  950. end;
  951. { all local types }
  952. tglobalsymtable(st)^.concattypestabto(debuglist);
  953. { and all local symbols}
  954. st^.concatstabto(debuglist);
  955. {$else New_GDB}
  956. write_gdb_info;
  957. {$endIf Def New_GDB}
  958. end;
  959. {$endif GDB}
  960. reset_global_defs;
  961. if (Errorcount=0) then
  962. begin
  963. { tests, if all (interface) forwards are resolved }
  964. tstoredsymtable(symtablestack).check_forwards;
  965. { check if all private fields are used }
  966. tstoredsymtable(symtablestack).allprivatesused;
  967. { remove cross unit overloads }
  968. tstoredsymtable(symtablestack).unchain_overloaded;
  969. end;
  970. current_module.in_implementation:=false;
  971. {$ifdef GDB}
  972. tglobalsymtable(symtablestack).is_stab_written:=false;
  973. {$endif GDB}
  974. { leave when we got an error }
  975. if (Errorcount>0) and not status.skip_error then
  976. begin
  977. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  978. status.skip_error:=true;
  979. exit;
  980. end;
  981. { generate imports }
  982. if current_module.uses_imports then
  983. importlib.generatelib;
  984. { insert own objectfile, or say that it's in a library
  985. (no check for an .o when loading) }
  986. if is_assembler_generated then
  987. insertobjectfile
  988. else
  989. current_module.flags:=current_module.flags or uf_no_link;
  990. if cs_local_browser in aktmoduleswitches then
  991. current_module.localsymtable:=refsymtable;
  992. {$ifdef GDB}
  993. pu:=tused_unit(usedunits.first);
  994. while assigned(pu) do
  995. begin
  996. if assigned(pu.u.globalsymtable) then
  997. tglobalsymtable(pu.u.globalsymtable).is_stab_written:=false;
  998. pu:=tused_unit(pu.next);
  999. end;
  1000. {$endif GDB}
  1001. if is_assembler_generated then
  1002. begin
  1003. { finish asmlist by adding segment starts }
  1004. insertsegment;
  1005. { assemble }
  1006. create_objectfile;
  1007. end;
  1008. { Write out the ppufile after the object file has been created }
  1009. store_interface_crc:=current_module.interface_crc;
  1010. store_crc:=current_module.crc;
  1011. if (Errorcount=0) then
  1012. tppumodule(current_module).writeppu;
  1013. if not(cs_compilesystem in aktmoduleswitches) then
  1014. if store_interface_crc<>current_module.interface_crc then
  1015. Comment(V_Warning,current_module.ppufilename^+' Interface CRC changed '+
  1016. hexstr(store_crc,8)+'<>'+hexstr(current_module.interface_crc,8));
  1017. {$ifdef EXTDEBUG}
  1018. if not(cs_compilesystem in aktmoduleswitches) then
  1019. if (store_crc<>current_module.crc) and simplify_ppu then
  1020. Comment(V_Warning,current_module.ppufilename^+' implementation CRC changed '+
  1021. hexstr(store_crc,8)+'<>'+hexstr(current_module.crc,8));
  1022. {$endif EXTDEBUG}
  1023. { remove static symtable (=refsymtable) here to save some mem }
  1024. if not (cs_local_browser in aktmoduleswitches) then
  1025. begin
  1026. st.free;
  1027. current_module.localsymtable:=nil;
  1028. end;
  1029. RestoreUnitSyms;
  1030. { leave when we got an error }
  1031. if (Errorcount>0) and not status.skip_error then
  1032. begin
  1033. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1034. status.skip_error:=true;
  1035. exit;
  1036. end;
  1037. end;
  1038. procedure proc_program(islibrary : boolean);
  1039. var
  1040. main_file: tinputfile;
  1041. st : tsymtable;
  1042. hp : tmodule;
  1043. begin
  1044. DLLsource:=islibrary;
  1045. Status.IsLibrary:=IsLibrary;
  1046. Status.IsExe:=true;
  1047. parse_only:=false;
  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. current_module.modulename:=stringdup(pattern);
  1074. current_module.islibrary:=true;
  1075. exportlib.preparelib(pattern);
  1076. consume(_ID);
  1077. consume(_SEMICOLON);
  1078. end
  1079. else
  1080. { is there an program head ? }
  1081. if token=_PROGRAM then
  1082. begin
  1083. consume(_PROGRAM);
  1084. stringdispose(current_module.modulename);
  1085. stringdispose(current_module.realmodulename);
  1086. current_module.modulename:=stringdup(pattern);
  1087. current_module.realmodulename:=stringdup(orgpattern);
  1088. if (target_info.system in [system_i386_WIN32,system_i386_wdosx]) then
  1089. exportlib.preparelib(pattern);
  1090. consume(_ID);
  1091. if token=_LKLAMMER then
  1092. begin
  1093. consume(_LKLAMMER);
  1094. repeat
  1095. consume(_ID);
  1096. until not try_to_consume(_COMMA);
  1097. consume(_RKLAMMER);
  1098. end;
  1099. consume(_SEMICOLON);
  1100. end
  1101. else if (target_info.system in [system_i386_WIN32,system_i386_wdosx]) then
  1102. exportlib.preparelib(current_module.modulename^);
  1103. { global switches are read, so further changes aren't allowed }
  1104. current_module.in_global:=false;
  1105. { setup things using the global switches }
  1106. setupglobalswitches;
  1107. { set implementation flag }
  1108. current_module.in_implementation:=true;
  1109. { insert after the unit symbol tables the static symbol table }
  1110. { of the program }
  1111. st:=tstaticsymtable.create(current_module.modulename^);;
  1112. current_module.localsymtable:=st;
  1113. refsymtable:=st;
  1114. { load standard units (system,objpas,profile unit) }
  1115. loaddefaultunits;
  1116. { reset }
  1117. lexlevel:=0;
  1118. {Load the units used by the program we compile.}
  1119. if token=_USES then
  1120. loadunits;
  1121. tstoredsymtable(symtablestack).chainoperators;
  1122. { reset ranges/stabs in exported definitions }
  1123. reset_global_defs;
  1124. { All units are read, now give them a number }
  1125. current_module.numberunits;
  1126. {Insert the name of the main program into the symbol table.}
  1127. if current_module.realmodulename^<>'' then
  1128. st.insert(tunitsym.create(current_module.realmodulename^,st));
  1129. { ...is also constsymtable, this is the symtable where }
  1130. { the elements of enumeration types are inserted }
  1131. constsymtable:=st;
  1132. Message1(parser_u_parsing_implementation,current_module.mainsource^);
  1133. {The program intialization needs an alias, so it can be called
  1134. from the bootstrap code.}
  1135. codegen_newprocedure;
  1136. if islibrary then
  1137. begin
  1138. gen_main_procsym(current_module.modulename^+'_main',potype_proginit,st);
  1139. aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_main');
  1140. { Win32 startup code needs a single name }
  1141. if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
  1142. aktprocdef.aliasnames.insert('PASCALMAIN');
  1143. { this code is called from C so we need to save some
  1144. registers }
  1145. include(aktprocdef.procoptions,po_savestdregs);
  1146. end
  1147. else
  1148. begin
  1149. gen_main_procsym('main',potype_proginit,st);
  1150. aktprocdef.aliasnames.insert('program_init');
  1151. aktprocdef.aliasnames.insert('PASCALMAIN');
  1152. aktprocdef.aliasnames.insert(target_info.cprefix+'main');
  1153. end;
  1154. compile_proc_body(true,false);
  1155. { should we force unit initialization? }
  1156. if tstaticsymtable(current_module.localsymtable).needs_init_final then
  1157. begin
  1158. current_module.flags:=current_module.flags or (uf_init or uf_finalize);
  1159. { Add initialize section }
  1160. if (cs_create_smart in aktmoduleswitches) then
  1161. codeSegment.concat(Tai_cut.Create);
  1162. genimplicitunitinit(codesegment);
  1163. { Add finalize section }
  1164. if (cs_create_smart in aktmoduleswitches) then
  1165. codeSegment.concat(Tai_cut.Create);
  1166. genimplicitunitfinal(codesegment);
  1167. end;
  1168. { Add symbol to the exports section for win32 so smartlinking a
  1169. DLL will include the edata section }
  1170. if assigned(exportlib) and
  1171. (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1172. assigned(current_module._exports.first) then
  1173. codesegment.concat(tai_const_symbol.create(exportlib.edatalabel));
  1174. { avoid self recursive destructor call !! PM }
  1175. aktprocdef.localst:=nil;
  1176. { consider these symbols as global ones for browser
  1177. but the typecasting of the globalsymtable with tglobalsymtable
  1178. can then lead to problems (PFV)
  1179. current_module.globalsymtable:=current_module.localsymtable;
  1180. current_module.localsymtable:=nil;}
  1181. If ResourceStrings.ResStrCount>0 then
  1182. begin
  1183. ResourceStrings.CreateResourceStringList;
  1184. { only write if no errors found }
  1185. if (Errorcount=0) then
  1186. ResourceStrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst'));
  1187. end;
  1188. codegen_doneprocedure;
  1189. { finalize? }
  1190. if token=_FINALIZATION then
  1191. begin
  1192. { set module options }
  1193. current_module.flags:=current_module.flags or uf_finalize;
  1194. { Compile the finalize }
  1195. codegen_newprocedure;
  1196. gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
  1197. aktprocdef.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
  1198. aktprocdef.aliasnames.insert(target_info.cprefix+current_module.modulename^+'_finalize');
  1199. compile_proc_body(true,false);
  1200. codegen_doneprocedure;
  1201. end;
  1202. { consume the last point }
  1203. consume(_POINT);
  1204. {$ifdef New_GDB}
  1205. write_gdb_info;
  1206. {$endIf Def New_GDB}
  1207. { leave when we got an error }
  1208. if (Errorcount>0) and not status.skip_error then
  1209. begin
  1210. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1211. status.skip_error:=true;
  1212. exit;
  1213. end;
  1214. { test static symtable }
  1215. if (Errorcount=0) then
  1216. begin
  1217. tstoredsymtable(st).allsymbolsused;
  1218. tstoredsymtable(st).allunitsused;
  1219. tstoredsymtable(st).allprivatesused;
  1220. end;
  1221. { generate a list of threadvars }
  1222. InsertThreadvars;
  1223. { generate imports }
  1224. if current_module.uses_imports then
  1225. importlib.generatelib;
  1226. if islibrary or
  1227. (target_info.system in [system_i386_WIN32,system_i386_wdosx]) or
  1228. (target_info.system=system_i386_NETWARE) then
  1229. exportlib.generatelib;
  1230. { insert Tables and Heap }
  1231. insertThreadVarTablesTable;
  1232. insertResourceTablesTable;
  1233. insertinitfinaltable;
  1234. insertheap;
  1235. insertstacklength;
  1236. datasize:=symtablestack.datasize;
  1237. { finish asmlist by adding segment starts }
  1238. insertsegment;
  1239. { insert own objectfile }
  1240. insertobjectfile;
  1241. { assemble and link }
  1242. create_objectfile;
  1243. { leave when we got an error }
  1244. if (Errorcount>0) and not status.skip_error then
  1245. begin
  1246. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1247. status.skip_error:=true;
  1248. exit;
  1249. end;
  1250. { create the executable when we are at level 1 }
  1251. if (compile_level=1) then
  1252. begin
  1253. { insert all .o files from all loaded units }
  1254. hp:=tmodule(loaded_units.first);
  1255. while assigned(hp) do
  1256. begin
  1257. linker.AddModuleFiles(hp);
  1258. hp:=tmodule(hp.next);
  1259. end;
  1260. { write .def file }
  1261. if (cs_link_deffile in aktglobalswitches) then
  1262. deffile.writefile;
  1263. { finally we can create a executable }
  1264. if (not current_module.is_unit) then
  1265. begin
  1266. if DLLSource then
  1267. linker.MakeSharedLibrary
  1268. else
  1269. linker.MakeExecutable;
  1270. end;
  1271. end;
  1272. end;
  1273. end.
  1274. {
  1275. $Log$
  1276. Revision 1.82 2002-10-16 06:32:52 michael
  1277. + Renamed thread unit to systhrds
  1278. Revision 1.81 2002/10/14 19:42:34 peter
  1279. * only use init tables for threadvars
  1280. Revision 1.80 2002/10/06 19:41:30 peter
  1281. * Add finalization of typed consts
  1282. * Finalization of globals in the main program
  1283. Revision 1.79 2002/09/09 17:34:15 peter
  1284. * tdicationary.replace added to replace and item in a dictionary. This
  1285. is only allowed for the same name
  1286. * varsyms are inserted in symtable before the types are parsed. This
  1287. fixes the long standing "var longint : longint" bug
  1288. - consume_idlist and idstringlist removed. The loops are inserted
  1289. at the callers place and uses the symtable for duplicate id checking
  1290. Revision 1.78 2002/09/07 15:25:07 peter
  1291. * old logs removed and tabs fixed
  1292. Revision 1.77 2002/09/03 16:26:27 daniel
  1293. * Make Tprocdef.defs protected
  1294. Revision 1.76 2002/09/02 18:46:26 peter
  1295. * insert PASCALMAIN in library for Win32 only
  1296. Revision 1.75 2002/08/31 15:59:30 florian
  1297. + HEAP* stuff must be generated for Linux/PPC as well
  1298. + direct assembler reader searches now global and static symtables as well
  1299. Revision 1.74 2002/08/25 19:25:20 peter
  1300. * sym.insert_in_data removed
  1301. * symtable.insertvardata/insertconstdata added
  1302. * removed insert_in_data call from symtable.insert, it needs to be
  1303. called separatly. This allows to deref the address calculation
  1304. * procedures now calculate the parast addresses after the procedure
  1305. directives are parsed. This fixes the cdecl parast problem
  1306. * push_addr_param has an extra argument that specifies if cdecl is used
  1307. or not
  1308. Revision 1.73 2002/08/18 20:06:25 peter
  1309. * inlining is now also allowed in interface
  1310. * renamed write/load to ppuwrite/ppuload
  1311. * tnode storing in ppu
  1312. * nld,ncon,nbas are already updated for storing in ppu
  1313. Revision 1.72 2002/08/17 09:23:39 florian
  1314. * first part of procinfo rewrite
  1315. Revision 1.71 2002/08/11 13:24:12 peter
  1316. * saving of asmsymbols in ppu supported
  1317. * asmsymbollist global is removed and moved into a new class
  1318. tasmlibrarydata that will hold the info of a .a file which
  1319. corresponds with a single module. Added librarydata to tmodule
  1320. to keep the library info stored for the module. In the future the
  1321. objectfiles will also be stored to the tasmlibrarydata class
  1322. * all getlabel/newasmsymbol and friends are moved to the new class
  1323. Revision 1.70 2002/08/10 14:46:29 carl
  1324. + moved target_cpu_string to cpuinfo
  1325. * renamed asmmode enum.
  1326. * assembler reader has now less ifdef's
  1327. * move from nppcmem.pas -> ncgmem.pas vec. node.
  1328. Revision 1.69 2002/07/26 21:15:41 florian
  1329. * rewrote the system handling
  1330. Revision 1.68 2002/07/04 20:43:01 florian
  1331. * first x86-64 patches
  1332. Revision 1.67 2002/07/01 18:46:25 peter
  1333. * internal linker
  1334. * reorganized aasm layer
  1335. Revision 1.66 2002/05/16 19:46:43 carl
  1336. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1337. + try to fix temp allocation (still in ifdef)
  1338. + generic constructor calls
  1339. + start of tassembler / tmodulebase class cleanup
  1340. Revision 1.65 2002/05/14 19:34:49 peter
  1341. * removed old logs and updated copyright year
  1342. Revision 1.64 2002/05/12 16:53:09 peter
  1343. * moved entry and exitcode to ncgutil and cgobj
  1344. * foreach gets extra argument for passing local data to the
  1345. iterator function
  1346. * -CR checks also class typecasts at runtime by changing them
  1347. into as
  1348. * fixed compiler to cycle with the -CR option
  1349. * fixed stabs with elf writer, finally the global variables can
  1350. be watched
  1351. * removed a lot of routines from cga unit and replaced them by
  1352. calls to cgobj
  1353. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1354. u32bit then the other is typecasted also to u32bit without giving
  1355. a rangecheck warning/error.
  1356. * fixed pascal calling method with reversing also the high tree in
  1357. the parast, detected by tcalcst3 test
  1358. Revision 1.63 2002/05/06 19:54:50 carl
  1359. + added more patches from Mazen for SPARC port
  1360. Revision 1.62 2002/04/20 21:32:24 carl
  1361. + generic FPC_CHECKPOINTER
  1362. + first parameter offset in stack now portable
  1363. * rename some constants
  1364. + move some cpu stuff to other units
  1365. - remove unused constents
  1366. * fix stacksize for some targets
  1367. * fix generic size problems which depend now on EXTEND_SIZE constant
  1368. Revision 1.61 2002/04/19 15:46:02 peter
  1369. * mangledname rewrite, tprocdef.mangledname is now created dynamicly
  1370. in most cases and not written to the ppu
  1371. * add mangeledname_prefix() routine to generate the prefix of
  1372. manglednames depending on the current procedure, object and module
  1373. * removed static procprefix since the mangledname is now build only
  1374. on demand from tprocdef.mangledname
  1375. Revision 1.60 2002/04/14 16:53:10 carl
  1376. + align code section and data section according to alignment rules
  1377. Revision 1.59 2002/04/07 17:58:38 carl
  1378. + generic stack checking
  1379. Revision 1.58 2002/04/04 19:06:03 peter
  1380. * removed unused units
  1381. * use tlocation.size in cg.a_*loc*() routines
  1382. }