pmodules.pas 65 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842
  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. interface
  21. procedure proc_unit;
  22. procedure proc_program(islibrary : boolean);
  23. implementation
  24. uses
  25. globtype,version,systems,tokens,
  26. cutils,cclasses,comphook,
  27. globals,verbose,fmodule,finput,fppu,
  28. symconst,symbase,symtype,symdef,symsym,symtable,
  29. aasmtai,aasmcpu,aasmbase,
  30. cgbase,cpuinfo,cgobj,
  31. nbas,
  32. link,assemble,import,export,gendef,ppu,comprsrc,
  33. cresstr,procinfo,
  34. {$ifdef GDB}
  35. gdb,
  36. {$endif GDB}
  37. scanner,pbase,pexpr,psystem,psub;
  38. procedure fixseg(p:TAAsmoutput;sec:TSection);
  39. begin
  40. p.insert(Tai_section.Create(sec));
  41. if (cs_create_smart in aktmoduleswitches) then
  42. p.insert(Tai_cut.Create);
  43. p.concat(Tai_section.Create(sec_none));
  44. end;
  45. procedure create_objectfile;
  46. var
  47. DLLScanner : TDLLScanner;
  48. s : string;
  49. KeepShared : TStringList;
  50. begin
  51. { try to create import entries from system dlls }
  52. if target_info.DllScanSupported and
  53. (not current_module.linkOtherSharedLibs.Empty) then
  54. begin
  55. { Init DLLScanner }
  56. if assigned(CDLLScanner[target_info.system]) then
  57. DLLScanner:=CDLLScanner[target_info.system].Create
  58. else
  59. internalerror(200104121);
  60. KeepShared:=TStringList.Create;
  61. { Walk all shared libs }
  62. While not current_module.linkOtherSharedLibs.Empty do
  63. begin
  64. S:=current_module.linkOtherSharedLibs.Getusemask(link_allways);
  65. if not DLLScanner.scan(s) then
  66. KeepShared.Concat(s);
  67. end;
  68. DLLscanner.Free;
  69. { Recreate import section }
  70. if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
  71. begin
  72. if assigned(importssection)then
  73. importssection.clear
  74. else
  75. importssection:=taasmoutput.Create;
  76. importlib.generatelib;
  77. end;
  78. { Readd the not processed files }
  79. while not KeepShared.Empty do
  80. begin
  81. s:=KeepShared.GetFirst;
  82. current_module.linkOtherSharedLibs.add(s,link_allways);
  83. end;
  84. KeepShared.Free;
  85. end;
  86. { create the .s file and assemble it }
  87. GenerateAsm(false);
  88. { Also create a smartlinked version ? }
  89. if (cs_create_smart in aktmoduleswitches) then
  90. begin
  91. { regenerate the importssection for win32 }
  92. if assigned(importssection) and
  93. (target_info.system in [system_i386_win32,system_i386_wdosx]) then
  94. begin
  95. importsSection.clear;
  96. importlib.generatesmartlib;
  97. end;
  98. GenerateAsm(true);
  99. if target_asm.needar then
  100. Linker.MakeStaticLibrary;
  101. end;
  102. { resource files }
  103. CompileResourceFiles;
  104. end;
  105. procedure insertobjectfile;
  106. { Insert the used object file for this unit in the used list for this unit }
  107. begin
  108. current_module.linkunitofiles.add(current_module.objfilename^,link_static);
  109. current_module.flags:=current_module.flags or uf_static_linked;
  110. if (cs_create_smart in aktmoduleswitches) then
  111. begin
  112. current_module.linkunitstaticlibs.add(current_module.staticlibfilename^,link_smart);
  113. current_module.flags:=current_module.flags or uf_smart_linked;
  114. end;
  115. end;
  116. procedure insertsegment;
  117. var
  118. oldaktfilepos : tfileposinfo;
  119. begin
  120. { Insert Ident of the compiler }
  121. if (not (cs_create_smart in aktmoduleswitches))
  122. {$ifndef EXTDEBUG}
  123. and (not current_module.is_unit)
  124. {$endif}
  125. then
  126. begin
  127. { align the first data }
  128. dataSegment.insert(Tai_align.Create(const_align(32)));
  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. fixseg(picdata,sec_data);
  143. if assigned(resourcestringlist) then
  144. fixseg(resourcestringlist,sec_data);
  145. {$ifdef GDB}
  146. if assigned(debuglist) then
  147. begin
  148. oldaktfilepos:=aktfilepos;
  149. aktfilepos.line:=0;
  150. debugList.insert(Tai_symbol.Createname('gcc2_compiled',AT_FUNCTION,0));
  151. debugList.insert(Tai_symbol.Createname('fpc_compiled',AT_FUNCTION,0));
  152. fixseg(debuglist,sec_code);
  153. aktfilepos:=oldaktfilepos;
  154. end;
  155. {$endif GDB}
  156. end;
  157. procedure InsertThreadvarTablesTable;
  158. var
  159. hp : tused_unit;
  160. ltvTables : taasmoutput;
  161. count : longint;
  162. begin
  163. ltvTables:=TAAsmOutput.Create;
  164. count:=0;
  165. hp:=tused_unit(usedunits.first);
  166. while assigned(hp) do
  167. begin
  168. If (hp.u.flags and uf_threadvars)=uf_threadvars then
  169. begin
  170. ltvTables.concat(Tai_const_symbol.Createname(make_mangledname('THREADVARLIST',hp.u.globalsymtable,''),AT_DATA,0));
  171. inc(count);
  172. end;
  173. hp:=tused_unit(hp.next);
  174. end;
  175. { Add program threadvars, if any }
  176. If (current_module.flags and uf_threadvars)=uf_threadvars then
  177. begin
  178. ltvTables.concat(Tai_const_symbol.Createname(make_mangledname('THREADVARLIST',current_module.localsymtable,''),AT_DATA,0));
  179. inc(count);
  180. end;
  181. { TableCount }
  182. ltvTables.insert(Tai_const.Create_32bit(count));
  183. ltvTables.insert(Tai_symbol.Createname_global('FPC_THREADVARTABLES',AT_DATA,0));
  184. ltvTables.insert(Tai_align.Create(const_align(pointer_size)));
  185. ltvTables.concat(Tai_symbol_end.Createname('FPC_THREADVARTABLES'));
  186. { insert in data segment }
  187. if (cs_create_smart in aktmoduleswitches) then
  188. dataSegment.concat(Tai_cut.Create);
  189. dataSegment.concatlist(ltvTables);
  190. ltvTables.free;
  191. end;
  192. procedure AddToThreadvarList(p:tnamedindexitem;arg:pointer);
  193. var
  194. ltvTable : taasmoutput;
  195. begin
  196. ltvTable:=taasmoutput(arg);
  197. if (tsym(p).typ=varsym) and
  198. (vo_is_thread_var in tvarsym(p).varoptions) then
  199. begin
  200. { address of threadvar }
  201. ltvTable.concat(tai_const_symbol.Createname(tvarsym(p).mangledname,AT_DATA,0));
  202. { size of threadvar }
  203. ltvTable.concat(tai_const.create_32bit(tvarsym(p).getsize));
  204. end;
  205. end;
  206. procedure InsertThreadvars;
  207. var
  208. s : string;
  209. ltvTable : TAAsmoutput;
  210. begin
  211. ltvTable:=TAAsmoutput.create;
  212. if assigned(current_module.globalsymtable) then
  213. current_module.globalsymtable.foreach_static({$ifdef FPCPROCVAR}@{$endif}AddToThreadvarList,ltvTable);
  214. current_module.localsymtable.foreach_static({$ifdef FPCPROCVAR}@{$endif}AddToThreadvarList,ltvTable);
  215. if ltvTable.first<>nil then
  216. begin
  217. s:=make_mangledname('THREADVARLIST',current_module.localsymtable,'');
  218. { add begin and end of the list }
  219. ltvTable.insert(tai_symbol.Createname_global(s,AT_DATA,0));
  220. ltvTable.concat(tai_const.create_ptr(0)); { end of list marker }
  221. ltvTable.concat(tai_symbol_end.createname(s));
  222. if (cs_create_smart in aktmoduleswitches) then
  223. dataSegment.concat(Tai_cut.Create);
  224. dataSegment.concatlist(ltvTable);
  225. current_module.flags:=current_module.flags or uf_threadvars;
  226. end;
  227. ltvTable.Free;
  228. end;
  229. Procedure InsertResourceTablesTable;
  230. var
  231. hp : tused_unit;
  232. ResourceStringTables : taasmoutput;
  233. count : longint;
  234. begin
  235. ResourceStringTables:=TAAsmOutput.Create;
  236. count:=0;
  237. hp:=tused_unit(usedunits.first);
  238. while assigned(hp) do
  239. begin
  240. If (hp.u.flags and uf_has_resources)=uf_has_resources then
  241. begin
  242. ResourceStringTables.concat(Tai_const_symbol.Createname(make_mangledname('RESOURCESTRINGLIST',hp.u.globalsymtable,''),AT_DATA,0));
  243. inc(count);
  244. end;
  245. hp:=tused_unit(hp.next);
  246. end;
  247. { Add program resources, if any }
  248. If ResourceStringList<>Nil then
  249. begin
  250. ResourceStringTables.concat(Tai_const_symbol.Createname(make_mangledname('RESOURCESTRINGLIST',current_module.localsymtable,''),AT_DATA,0));
  251. Inc(Count);
  252. end;
  253. { TableCount }
  254. ResourceStringTables.insert(Tai_const.Create_32bit(count));
  255. ResourceStringTables.insert(Tai_symbol.Createname_global('FPC_RESOURCESTRINGTABLES',AT_DATA,0));
  256. ResourceStringTables.insert(Tai_align.Create(const_align(4)));
  257. ResourceStringTables.concat(Tai_symbol_end.Createname('FPC_RESOURCESTRINGTABLES'));
  258. { insert in data segment }
  259. if (cs_create_smart in aktmoduleswitches) then
  260. dataSegment.concat(Tai_cut.Create);
  261. dataSegment.concatlist(ResourceStringTables);
  262. ResourceStringTables.free;
  263. end;
  264. procedure InsertInitFinalTable;
  265. var
  266. hp : tused_unit;
  267. unitinits : taasmoutput;
  268. count : longint;
  269. begin
  270. unitinits:=TAAsmOutput.Create;
  271. count:=0;
  272. hp:=tused_unit(usedunits.first);
  273. while assigned(hp) do
  274. begin
  275. { call the unit init code and make it external }
  276. if (hp.u.flags and (uf_init or uf_finalize))<>0 then
  277. begin
  278. if (hp.u.flags and uf_init)<>0 then
  279. unitinits.concat(Tai_const_symbol.Createname(make_mangledname('INIT$',hp.u.globalsymtable,''),AT_FUNCTION,0))
  280. else
  281. unitinits.concat(Tai_const.Create_ptr(0));
  282. if (hp.u.flags and uf_finalize)<>0 then
  283. unitinits.concat(Tai_const_symbol.Createname(make_mangledname('FINALIZE$',hp.u.globalsymtable,''),AT_FUNCTION,0))
  284. else
  285. unitinits.concat(Tai_const.Create_ptr(0));
  286. inc(count);
  287. end;
  288. hp:=tused_unit(hp.next);
  289. end;
  290. { Insert initialization/finalization of the program }
  291. if (current_module.flags and (uf_init or uf_finalize))<>0 then
  292. begin
  293. if (current_module.flags and uf_init)<>0 then
  294. unitinits.concat(Tai_const_symbol.Createname(make_mangledname('INIT$',current_module.localsymtable,''),AT_FUNCTION,0))
  295. else
  296. unitinits.concat(Tai_const.Create_ptr(0));
  297. if (current_module.flags and uf_finalize)<>0 then
  298. unitinits.concat(Tai_const_symbol.Createname(make_mangledname('FINALIZE$',current_module.localsymtable,''),AT_FUNCTION,0))
  299. else
  300. unitinits.concat(Tai_const.Create_ptr(0));
  301. inc(count);
  302. end;
  303. { TableCount,InitCount }
  304. unitinits.insert(Tai_const.Create_32bit(0));
  305. unitinits.insert(Tai_const.Create_32bit(count));
  306. unitinits.insert(Tai_symbol.Createname_global('INITFINAL',AT_DATA,0));
  307. unitinits.insert(Tai_align.Create(const_align(4)));
  308. unitinits.concat(Tai_symbol_end.Createname('INITFINAL'));
  309. { insert in data segment }
  310. if (cs_create_smart in aktmoduleswitches) then
  311. dataSegment.concat(Tai_cut.Create);
  312. dataSegment.concatlist(unitinits);
  313. unitinits.free;
  314. end;
  315. procedure insertheap;
  316. begin
  317. if (cs_create_smart in aktmoduleswitches) then
  318. begin
  319. bssSegment.concat(Tai_cut.Create);
  320. dataSegment.concat(Tai_cut.Create);
  321. end;
  322. { On the Macintosh Classic M68k Architecture
  323. The Heap variable is simply a POINTER to the
  324. real HEAP. The HEAP must be set up by the RTL
  325. and must store the pointer in this value.
  326. On OS/2 the heap is also intialized by the RTL. We do
  327. not output a pointer }
  328. case target_info.system of
  329. system_i386_OS2,system_i386_EMX:
  330. ;
  331. system_powerpc_macos:
  332. ;
  333. system_i386_watcom:
  334. ;
  335. system_alpha_linux:
  336. ;
  337. system_m68k_Mac:
  338. bssSegment.concat(Tai_datablock.Create_global('HEAP',4));
  339. system_m68k_PalmOS:
  340. ;
  341. else
  342. begin
  343. bssSegment.concat(Tai_align.Create(var_align(heapsize)));
  344. bssSegment.concat(Tai_datablock.Create_global('HEAP',heapsize));
  345. end;
  346. end;
  347. {$ifdef m68k}
  348. if target_info.system<>system_m68k_PalmOS then
  349. begin
  350. dataSegment.concat(Tai_align.Create(const_align(4)));
  351. dataSegment.concat(Tai_symbol.Createname_global('HEAPSIZE',AT_DATA,4));
  352. dataSegment.concat(Tai_const.Create_32bit(heapsize));
  353. end;
  354. {$else m68k}
  355. dataSegment.concat(Tai_align.Create(const_align(4)));
  356. dataSegment.concat(Tai_symbol.Createname_global('HEAPSIZE',AT_DATA,4));
  357. dataSegment.concat(Tai_const.Create_32bit(heapsize));
  358. {$endif m68k}
  359. end;
  360. procedure insertstacklength;
  361. begin
  362. { stacksize can be specified and is now simulated }
  363. dataSegment.concat(Tai_align.Create(const_align(4)));
  364. dataSegment.concat(Tai_symbol.Createname_global('__stklen',AT_DATA,4));
  365. dataSegment.concat(Tai_const.Create_32bit(stacksize));
  366. end;
  367. procedure loaddefaultunits;
  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. tsymtable(hp.globalsymtable).next:=symtablestack;
  379. symtablestack:=hp.globalsymtable;
  380. { insert unitsym }
  381. unitsym:=tunitsym.create(s,hp.globalsymtable);
  382. inc(unitsym.refs);
  383. refsymtable.insert(unitsym);
  384. { add to used units }
  385. current_module.addusedunit(hp,false,unitsym);
  386. end;
  387. begin
  388. { are we compiling the system unit? }
  389. if (cs_compilesystem in aktmoduleswitches) then
  390. begin
  391. { create system defines }
  392. createconstdefs;
  393. { we don't need to reset anything, it's already done in parser.pas }
  394. exit;
  395. end;
  396. { insert the system unit, it is allways the first }
  397. Symtablestack:=nil;
  398. AddUnit('System');
  399. SystemUnit:=TGlobalSymtable(Symtablestack);
  400. { read default constant definitions }
  401. make_ref:=false;
  402. readconstdefs;
  403. make_ref:=true;
  404. {$ifdef cpufpemu}
  405. { Floating point emulation unit? }
  406. if (cs_fp_emulation in aktmoduleswitches) then
  407. AddUnit('SoftFpu');
  408. {$endif cpufpemu}
  409. { Thread support unit? }
  410. if (cs_threading in aktmoduleswitches) then
  411. AddUnit('SysThrds');
  412. { Objpas unit? }
  413. if m_objpas in aktmodeswitches then
  414. AddUnit('ObjPas');
  415. { Profile unit? Needed for go32v2 only }
  416. if (cs_profile in aktmoduleswitches) and
  417. (target_info.system in [system_i386_go32v2,system_i386_watcom]) then
  418. AddUnit('Profile');
  419. { Units only required for main module }
  420. if not(current_module.is_unit) then
  421. begin
  422. { Heaptrc unit }
  423. if (cs_gdb_heaptrc in aktglobalswitches) then
  424. AddUnit('HeapTrc');
  425. { Lineinfo unit }
  426. if (cs_gdb_lineinfo in aktglobalswitches) then
  427. AddUnit('LineInfo');
  428. { Lineinfo unit }
  429. if (cs_gdb_valgrind in aktglobalswitches) then
  430. AddUnit('CMem');
  431. end;
  432. { save default symtablestack }
  433. defaultsymtablestack:=symtablestack;
  434. end;
  435. procedure loadunits;
  436. var
  437. s,sorg : stringid;
  438. fn : string;
  439. pu : tused_unit;
  440. hp2 : tmodule;
  441. hp3 : tsymtable;
  442. unitsym : tunitsym;
  443. begin
  444. consume(_USES);
  445. {$ifdef DEBUG}
  446. test_symtablestack;
  447. {$endif DEBUG}
  448. repeat
  449. s:=pattern;
  450. sorg:=orgpattern;
  451. consume(_ID);
  452. { support "<unit> in '<file>'" construct, but not for tp7 }
  453. if not(m_tp7 in aktmodeswitches) then
  454. begin
  455. if try_to_consume(_OP_IN) then
  456. fn:=FixFileName(get_stringconst)
  457. else
  458. fn:='';
  459. end;
  460. { Give a warning if objpas is loaded }
  461. if s='OBJPAS' then
  462. Message(parser_w_no_objpas_use_mode);
  463. { Using the unit itself is not possible }
  464. if (s<>current_module.modulename^) then
  465. begin
  466. { check if the unit is already used }
  467. hp2:=nil;
  468. pu:=tused_unit(current_module.used_units.first);
  469. while assigned(pu) do
  470. begin
  471. if (pu.u.modulename^=s) then
  472. begin
  473. hp2:=pu.u;
  474. break;
  475. end;
  476. pu:=tused_unit(pu.next);
  477. end;
  478. if not assigned(hp2) then
  479. hp2:=registerunit(current_module,sorg,fn)
  480. else
  481. Message1(sym_e_duplicate_id,s);
  482. { Create unitsym, we need to use the name as specified, we
  483. can not use the modulename because that can be different
  484. when -Un is used }
  485. unitsym:=tunitsym.create(sorg,nil);
  486. refsymtable.insert(unitsym);
  487. { the current module uses the unit hp2 }
  488. current_module.addusedunit(hp2,true,unitsym);
  489. end
  490. else
  491. Message1(sym_e_duplicate_id,s);
  492. if token=_COMMA then
  493. begin
  494. pattern:='';
  495. consume(_COMMA);
  496. end
  497. else
  498. break;
  499. until false;
  500. consume(_SEMICOLON);
  501. { Load the units }
  502. pu:=tused_unit(current_module.used_units.first);
  503. while assigned(pu) do
  504. begin
  505. { Only load the units that are in the current
  506. (interface/implementation) uses clause }
  507. if pu.in_uses and
  508. (pu.in_interface=current_module.in_interface) then
  509. begin
  510. tppumodule(pu.u).loadppu;
  511. { is our module compiled? then we can stop }
  512. if current_module.state=ms_compiled then
  513. exit;
  514. { add this unit to the dependencies }
  515. pu.u.adddependency(current_module);
  516. { save crc values }
  517. pu.checksum:=pu.u.crc;
  518. pu.interface_checksum:=pu.u.interface_crc;
  519. { connect unitsym to the globalsymtable of the unit }
  520. pu.unitsym.unitsymtable:=pu.u.globalsymtable;
  521. { increase refs of the unitsym when the unit contains
  522. initialization/finalization code so it doesn't trigger
  523. the unit not used hint }
  524. if (pu.u.flags and (uf_init or uf_finalize))<>0 then
  525. inc(pu.unitsym.refs);
  526. end;
  527. pu:=tused_unit(pu.next);
  528. end;
  529. { set the symtable to systemunit so it gets reorderd correctly,
  530. then insert the units in the symtablestack }
  531. pu:=tused_unit(current_module.used_units.first);
  532. symtablestack:=defaultsymtablestack;
  533. while assigned(pu) do
  534. begin
  535. if pu.in_uses then
  536. begin
  537. { Reinsert in symtablestack }
  538. hp3:=symtablestack;
  539. while assigned(hp3) do
  540. begin
  541. { insert units only once ! }
  542. if pu.u.globalsymtable=hp3 then
  543. break;
  544. hp3:=hp3.next;
  545. { unit isn't inserted }
  546. if hp3=nil then
  547. begin
  548. tsymtable(pu.u.globalsymtable).next:=symtablestack;
  549. symtablestack:=tsymtable(pu.u.globalsymtable);
  550. {$ifdef DEBUG}
  551. test_symtablestack;
  552. {$endif DEBUG}
  553. end;
  554. end;
  555. end;
  556. pu:=tused_unit(pu.next);
  557. end;
  558. end;
  559. {$IfDef GDB}
  560. procedure write_gdb_info;
  561. procedure reset_unit_type_info;
  562. var
  563. hp : tmodule;
  564. begin
  565. hp:=tmodule(loaded_units.first);
  566. while assigned(hp) do
  567. begin
  568. hp.is_stab_written:=false;
  569. hp:=tmodule(hp.next);
  570. end;
  571. end;
  572. procedure write_used_unit_type_info(hp:tmodule);
  573. var
  574. pu : tused_unit;
  575. begin
  576. pu:=tused_unit(hp.used_units.first);
  577. while assigned(pu) do
  578. begin
  579. if not pu.u.is_stab_written then
  580. begin
  581. { prevent infinte loop for circular dependencies }
  582. pu.u.is_stab_written:=true;
  583. { write type info from used units, use a depth first
  584. strategy to reduce the recursion in writing all
  585. dependent stabs }
  586. write_used_unit_type_info(pu.u);
  587. if assigned(pu.u.globalsymtable) then
  588. tglobalsymtable(pu.u.globalsymtable).concattypestabto(debuglist);
  589. end;
  590. pu:=tused_unit(pu.next);
  591. end;
  592. end;
  593. begin
  594. if not (cs_debuginfo in aktmoduleswitches) then
  595. exit;
  596. { reset unit type info flag }
  597. reset_unit_type_info;
  598. { write used types from the used units }
  599. write_used_unit_type_info(current_module);
  600. { first write the types from this unit }
  601. if assigned(current_module.globalsymtable) then
  602. begin
  603. { all types }
  604. tglobalsymtable(current_module.globalsymtable).concattypestabto(debuglist);
  605. { and all local symbols}
  606. tglobalsymtable(current_module.globalsymtable).concatstabto(debuglist);
  607. end;
  608. if assigned(current_module.localsymtable) then
  609. begin
  610. { all types }
  611. tstaticsymtable(current_module.localsymtable).concattypestabto(debuglist);
  612. { and all local symbols}
  613. tstaticsymtable(current_module.localsymtable).concatstabto(debuglist);
  614. end;
  615. if (cs_gdb_dbx in aktglobalswitches) then
  616. begin
  617. debugList.concat(tai_comment.Create(strpnew('EINCL of global '+
  618. tglobalsymtable(current_module.globalsymtable).name^+' has index '+
  619. tostr(tglobalsymtable(current_module.globalsymtable).unitid))));
  620. debugList.concat(Tai_stabs.Create(strpnew('"'+
  621. tglobalsymtable(current_module.globalsymtable).name^+'",'+
  622. tostr(N_EINCL)+',0,0,0')));
  623. tglobalsymtable(current_module.globalsymtable).dbx_count_ok:={true}false;
  624. dbx_counter:=tglobalsymtable(current_module.globalsymtable).prev_dbx_counter;
  625. do_count_dbx:=false;
  626. end;
  627. end;
  628. {$EndIf GDB}
  629. procedure reset_all_defs;
  630. procedure reset_used_unit_defs(hp:tmodule);
  631. var
  632. pu : tused_unit;
  633. begin
  634. pu:=tused_unit(hp.used_units.first);
  635. while assigned(pu) do
  636. begin
  637. if not pu.u.is_reset then
  638. begin
  639. { prevent infinte loop for circular dependencies }
  640. pu.u.is_reset:=true;
  641. if assigned(pu.u.globalsymtable) then
  642. begin
  643. tglobalsymtable(pu.u.globalsymtable).reset_all_defs;
  644. reset_used_unit_defs(pu.u);
  645. end;
  646. end;
  647. pu:=tused_unit(pu.next);
  648. end;
  649. end;
  650. var
  651. hp2 : tmodule;
  652. begin
  653. hp2:=tmodule(loaded_units.first);
  654. while assigned(hp2) do
  655. begin
  656. hp2.is_reset:=false;
  657. hp2:=tmodule(hp2.next);
  658. end;
  659. reset_used_unit_defs(current_module);
  660. end;
  661. procedure parse_implementation_uses;
  662. begin
  663. if token=_USES then
  664. begin
  665. loadunits;
  666. {$ifdef DEBUG}
  667. test_symtablestack;
  668. {$endif DEBUG}
  669. end;
  670. end;
  671. procedure setupglobalswitches;
  672. begin
  673. { can't have local browser when no global browser }
  674. if (cs_local_browser in aktmoduleswitches) and
  675. not(cs_browser in aktmoduleswitches) then
  676. exclude(aktmoduleswitches,cs_local_browser);
  677. { define a symbol in delphi,objfpc,tp,gpc mode }
  678. if (m_delphi in aktmodeswitches) then
  679. current_scanner.def_macro('FPC_DELPHI')
  680. else
  681. if (m_tp7 in aktmodeswitches) then
  682. current_scanner.def_macro('FPC_TP')
  683. else
  684. if (m_objfpc in aktmodeswitches) then
  685. current_scanner.def_macro('FPC_OBJFPC')
  686. else
  687. if (m_gpc in aktmodeswitches) then
  688. current_scanner.def_macro('FPC_GPC');
  689. end;
  690. function create_main_proc(const name:string;potype:tproctypeoption;st:tsymtable):tprocdef;
  691. var
  692. stt : tsymtable;
  693. ps : tprocsym;
  694. pd : tprocdef;
  695. begin
  696. { there should be no current_procinfo available }
  697. if assigned(current_procinfo) then
  698. internalerror(200304275);
  699. {Generate a procsym for main}
  700. make_ref:=false;
  701. { try to insert in in static symtable ! }
  702. stt:=symtablestack;
  703. symtablestack:=st;
  704. { generate procsym }
  705. ps:=tprocsym.create('$'+name);
  706. { main are allways used }
  707. inc(ps.refs);
  708. symtablestack.insert(ps);
  709. pd:=tprocdef.create(main_program_level);
  710. include(pd.procoptions,po_public);
  711. pd.procsym:=ps;
  712. ps.addprocdef(pd);
  713. { restore symtable }
  714. make_ref:=true;
  715. symtablestack:=stt;
  716. { set procdef options }
  717. pd.proctypeoption:=potype;
  718. pd.proccalloption:=pocall_default;
  719. pd.forwarddef:=false;
  720. pd.setmangledname(target_info.cprefix+name);
  721. pd.aliasnames.insert(pd.mangledname);
  722. { We don't need is a local symtable. Change it into the static
  723. symtable }
  724. pd.localst.free;
  725. pd.localst:=st;
  726. { set procinfo and current_procinfo.procdef }
  727. current_procinfo:=cprocinfo.create(nil);
  728. current_module.procinfo:=current_procinfo;
  729. current_procinfo.procdef:=pd;
  730. { return procdef }
  731. create_main_proc:=pd;
  732. { main proc does always a call e.g. to init system unit }
  733. include(current_procinfo.flags,pi_do_call);
  734. end;
  735. procedure release_main_proc(pd:tprocdef);
  736. begin
  737. { this is a main proc, so there should be no parent }
  738. if not(assigned(current_procinfo)) or
  739. assigned(current_procinfo.parent) or
  740. not(current_procinfo.procdef=pd) then
  741. internalerror(200304276);
  742. { remove procinfo }
  743. current_module.procinfo:=nil;
  744. current_procinfo.free;
  745. current_procinfo:=nil;
  746. { remove localst as it was replaced by staticsymtable }
  747. pd.localst:=nil;
  748. end;
  749. procedure gen_implicit_initfinal(flag:word;st:tsymtable);
  750. var
  751. pd : tprocdef;
  752. begin
  753. { update module flags }
  754. current_module.flags:=current_module.flags or flag;
  755. { create procdef }
  756. case flag of
  757. uf_init :
  758. begin
  759. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'init_implicit'),potype_unitinit,st);
  760. pd.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
  761. end;
  762. uf_finalize :
  763. begin
  764. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize_implicit'),potype_unitfinalize,st);
  765. pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
  766. end;
  767. else
  768. internalerror(200304253);
  769. end;
  770. tcgprocinfo(current_procinfo).code:=cnothingnode.create;
  771. tcgprocinfo(current_procinfo).add_entry_exit_code;
  772. tcgprocinfo(current_procinfo).generate_code;
  773. release_main_proc(pd);
  774. end;
  775. procedure proc_unit;
  776. function is_assembler_generated:boolean;
  777. begin
  778. is_assembler_generated:=(Errorcount=0) and
  779. not(
  780. codeSegment.empty and
  781. dataSegment.empty and
  782. bssSegment.empty and
  783. ((importssection=nil) or importsSection.empty) and
  784. ((resourcesection=nil) or resourceSection.empty) and
  785. ((resourcestringlist=nil) or resourcestringList.empty)
  786. );
  787. end;
  788. var
  789. main_file: tinputfile;
  790. st : tsymtable;
  791. unitst : tglobalsymtable;
  792. store_crc,store_interface_crc : cardinal;
  793. s1,s2 : ^string; {Saves stack space}
  794. force_init_final : boolean;
  795. pd : tprocdef;
  796. unitname8 : string[8];
  797. begin
  798. consume(_UNIT);
  799. if compile_level=1 then
  800. Status.IsExe:=false;
  801. if token=_ID then
  802. begin
  803. { create filenames and unit name }
  804. main_file := current_scanner.inputfile;
  805. while assigned(main_file.next) do
  806. main_file := main_file.next;
  807. new(s1);
  808. s1^:=current_module.modulename^;
  809. current_module.SetFileName(main_file.path^+main_file.name^,true);
  810. current_module.SetModuleName(orgpattern);
  811. { check for system unit }
  812. new(s2);
  813. s2^:=upper(SplitName(main_file.name^));
  814. unitname8:=copy(current_module.modulename^,1,8);
  815. if (cs_check_unit_name in aktglobalswitches) and
  816. (
  817. not(
  818. (current_module.modulename^=s2^) or
  819. (
  820. (length(current_module.modulename^)>8) and
  821. (unitname8=s2^)
  822. )
  823. )
  824. or
  825. (
  826. (length(s1^)>8) and
  827. (s1^<>current_module.modulename^)
  828. )
  829. ) then
  830. Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
  831. if (current_module.modulename^='SYSTEM') then
  832. include(aktmoduleswitches,cs_compilesystem);
  833. dispose(s2);
  834. dispose(s1);
  835. end;
  836. consume(_ID);
  837. consume(_SEMICOLON);
  838. consume(_INTERFACE);
  839. { global switches are read, so further changes aren't allowed }
  840. current_module.in_global:=false;
  841. { handle the global switches }
  842. setupglobalswitches;
  843. message1(unit_u_loading_interface_units,current_module.modulename^);
  844. { update status }
  845. status.currentmodule:=current_module.realmodulename^;
  846. { maybe turn off m_objpas if we are compiling objpas }
  847. if (current_module.modulename^='OBJPAS') then
  848. exclude(aktmodeswitches,m_objpas);
  849. parse_only:=true;
  850. { generate now the global symboltable }
  851. st:=tglobalsymtable.create(current_module.modulename^);
  852. refsymtable:=st;
  853. unitst:=tglobalsymtable(st);
  854. { define first as local to overcome dependency conflicts }
  855. current_module.localsymtable:=st;
  856. { the unit name must be usable as a unit specifier }
  857. { inside the unit itself (PM) }
  858. { this also forbids to have another symbol }
  859. { with the same name as the unit }
  860. refsymtable.insert(tunitsym.create(current_module.realmodulename^,unitst));
  861. { load default units, like the system unit }
  862. loaddefaultunits;
  863. { reset }
  864. make_ref:=true;
  865. { insert qualifier for the system unit (allows system.writeln) }
  866. if not(cs_compilesystem in aktmoduleswitches) then
  867. begin
  868. if token=_USES then
  869. begin
  870. loadunits;
  871. { has it been compiled at a higher level ?}
  872. if current_module.state=ms_compiled then
  873. exit;
  874. end;
  875. { ... but insert the symbol table later }
  876. st.next:=symtablestack;
  877. symtablestack:=st;
  878. end
  879. else
  880. { while compiling a system unit, some types are directly inserted }
  881. begin
  882. st.next:=symtablestack;
  883. symtablestack:=st;
  884. insert_intern_types(st);
  885. end;
  886. { now we know the place to insert the constants }
  887. constsymtable:=symtablestack;
  888. { move the global symtab from the temporary local to global }
  889. current_module.globalsymtable:=current_module.localsymtable;
  890. current_module.localsymtable:=nil;
  891. reset_all_defs;
  892. { number all units, so we know if a unit is used by this unit or
  893. needs to be added implicitly }
  894. current_module.numberunits;
  895. { ... parse the declarations }
  896. Message1(parser_u_parsing_interface,current_module.realmodulename^);
  897. read_interface_declarations;
  898. { leave when we got an error }
  899. if (Errorcount>0) and not status.skip_error then
  900. begin
  901. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  902. status.skip_error:=true;
  903. exit;
  904. end;
  905. { Our interface is compiled, generate CRC and switch to implementation }
  906. if not(cs_compilesystem in aktmoduleswitches) and
  907. (Errorcount=0) then
  908. tppumodule(current_module).getppucrc;
  909. current_module.in_interface:=false;
  910. current_module.interface_compiled:=true;
  911. { First reload all units depending on our interface, we need to do this
  912. in the implementation part to prevent errorneous circular references }
  913. reload_flagged_units;
  914. { Parse the implementation section }
  915. consume(_IMPLEMENTATION);
  916. Message1(unit_u_loading_implementation_units,current_module.modulename^);
  917. parse_only:=false;
  918. { generates static symbol table }
  919. st:=tstaticsymtable.create(current_module.modulename^);
  920. current_module.localsymtable:=st;
  921. { remove the globalsymtable from the symtable stack }
  922. { to reinsert it after loading the implementation units }
  923. symtablestack:=unitst.next;
  924. { we don't want implementation units symbols in unitsymtable !! PM }
  925. refsymtable:=st;
  926. { Read the implementation units }
  927. parse_implementation_uses;
  928. if current_module.state=ms_compiled then
  929. exit;
  930. { reset ranges/stabs in exported definitions }
  931. reset_all_defs;
  932. { All units are read, now give them a number }
  933. current_module.numberunits;
  934. { now we can change refsymtable }
  935. refsymtable:=st;
  936. { but reinsert the global symtable as lasts }
  937. unitst.next:=symtablestack;
  938. symtablestack:=unitst;
  939. {$ifdef DEBUG}
  940. test_symtablestack;
  941. {$endif DEBUG}
  942. constsymtable:=symtablestack;
  943. {$ifdef Splitheap}
  944. if testsplit then
  945. begin
  946. Split_Heap;
  947. allow_special:=true;
  948. Switch_to_temp_heap;
  949. end;
  950. { it will report all crossings }
  951. allow_special:=false;
  952. {$endif Splitheap}
  953. Message1(parser_u_parsing_implementation,current_module.modulename^);
  954. if current_module.in_interface then
  955. internalerror(200212285);
  956. { Compile the unit }
  957. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'init'),potype_unitinit,st);
  958. pd.aliasnames.insert(make_mangledname('INIT$',current_module.localsymtable,''));
  959. tcgprocinfo(current_procinfo).parse_body;
  960. tcgprocinfo(current_procinfo).generate_code;
  961. tcgprocinfo(current_procinfo).resetprocdef;
  962. release_main_proc(pd);
  963. { if the unit contains ansi/widestrings, initialization and
  964. finalization code must be forced }
  965. force_init_final:=tglobalsymtable(current_module.globalsymtable).needs_init_final or
  966. tstaticsymtable(current_module.localsymtable).needs_init_final;
  967. { should we force unit initialization? }
  968. { this is a hack, but how can it be done better ? }
  969. if force_init_final and ((current_module.flags and uf_init)=0) then
  970. gen_implicit_initfinal(uf_init,st);
  971. { finalize? }
  972. if token=_FINALIZATION then
  973. begin
  974. { set module options }
  975. current_module.flags:=current_module.flags or uf_finalize;
  976. { Compile the finalize }
  977. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,st);
  978. pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
  979. tcgprocinfo(current_procinfo).parse_body;
  980. tcgprocinfo(current_procinfo).generate_code;
  981. tcgprocinfo(current_procinfo).resetprocdef;
  982. release_main_proc(pd);
  983. end
  984. else if force_init_final then
  985. gen_implicit_initfinal(uf_finalize,st);
  986. { the last char should always be a point }
  987. consume(_POINT);
  988. { generate a list of threadvars }
  989. InsertThreadvars;
  990. { Generate resoucestrings }
  991. If ResourceStrings.ResStrCount>0 then
  992. begin
  993. ResourceStrings.CreateResourceStringList;
  994. current_module.flags:=current_module.flags or uf_has_resources;
  995. { only write if no errors found }
  996. if (Errorcount=0) then
  997. ResourceStrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst'));
  998. end;
  999. if (Errorcount=0) then
  1000. begin
  1001. { test static symtable }
  1002. tstoredsymtable(st).allsymbolsused;
  1003. tstoredsymtable(st).allprivatesused;
  1004. current_module.allunitsused;
  1005. end;
  1006. {$ifdef GDB}
  1007. write_gdb_info;
  1008. {$endif GDB}
  1009. if (Errorcount=0) then
  1010. begin
  1011. { tests, if all (interface) forwards are resolved }
  1012. tstoredsymtable(symtablestack).check_forwards;
  1013. { check if all private fields are used }
  1014. tstoredsymtable(symtablestack).allprivatesused;
  1015. { remove cross unit overloads }
  1016. tstoredsymtable(symtablestack).unchain_overloaded;
  1017. end;
  1018. { leave when we got an error }
  1019. if (Errorcount>0) and not status.skip_error then
  1020. begin
  1021. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1022. status.skip_error:=true;
  1023. exit;
  1024. end;
  1025. { generate imports }
  1026. if current_module.uses_imports then
  1027. importlib.generatelib;
  1028. { insert own objectfile, or say that it's in a library
  1029. (no check for an .o when loading) }
  1030. if is_assembler_generated then
  1031. insertobjectfile
  1032. else
  1033. current_module.flags:=current_module.flags or uf_no_link;
  1034. if cs_local_browser in aktmoduleswitches then
  1035. current_module.localsymtable:=refsymtable;
  1036. if is_assembler_generated then
  1037. begin
  1038. { finish asmlist by adding segment starts }
  1039. insertsegment;
  1040. { assemble }
  1041. create_objectfile;
  1042. end;
  1043. { Write out the ppufile after the object file has been created }
  1044. store_interface_crc:=current_module.interface_crc;
  1045. store_crc:=current_module.crc;
  1046. if (Errorcount=0) then
  1047. tppumodule(current_module).writeppu;
  1048. if not(cs_compilesystem in aktmoduleswitches) then
  1049. if store_interface_crc<>current_module.interface_crc then
  1050. Message1(unit_u_interface_crc_changed,current_module.ppufilename^);
  1051. {$ifdef EXTDEBUG}
  1052. if not(cs_compilesystem in aktmoduleswitches) then
  1053. if (store_crc<>current_module.crc) and simplify_ppu then
  1054. Message1(unit_u_implementation_crc_changed,current_module.ppufilename^);
  1055. {$endif EXTDEBUG}
  1056. { remove static symtable (=refsymtable) here to save some mem }
  1057. if not (cs_local_browser in aktmoduleswitches) then
  1058. begin
  1059. st.free;
  1060. current_module.localsymtable:=nil;
  1061. end;
  1062. { leave when we got an error }
  1063. if (Errorcount>0) and not status.skip_error then
  1064. begin
  1065. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1066. status.skip_error:=true;
  1067. exit;
  1068. end;
  1069. Message1(unit_u_finished_compiling,current_module.modulename^);
  1070. end;
  1071. procedure proc_program(islibrary : boolean);
  1072. var
  1073. main_file: tinputfile;
  1074. st : tsymtable;
  1075. hp : tmodule;
  1076. pd : tprocdef;
  1077. begin
  1078. DLLsource:=islibrary;
  1079. Status.IsLibrary:=IsLibrary;
  1080. Status.IsExe:=true;
  1081. parse_only:=false;
  1082. { relocation works only without stabs under win32 !! PM }
  1083. { internal assembler uses rva for stabs info
  1084. so it should work with relocated DLLs }
  1085. if RelocSection and
  1086. (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1087. (target_info.assem<>as_i386_pecoff) then
  1088. begin
  1089. include(aktglobalswitches,cs_link_strip);
  1090. { Warning stabs info does not work with reloc section !! }
  1091. if cs_debuginfo in aktmoduleswitches then
  1092. begin
  1093. Message1(parser_w_parser_reloc_no_debug,current_module.mainsource^);
  1094. Message(parser_w_parser_win32_debug_needs_WN);
  1095. exclude(aktmoduleswitches,cs_debuginfo);
  1096. end;
  1097. end;
  1098. { get correct output names }
  1099. main_file := current_scanner.inputfile;
  1100. while assigned(main_file.next) do
  1101. main_file := main_file.next;
  1102. current_module.SetFileName(main_file.path^+main_file.name^,true);
  1103. if islibrary then
  1104. begin
  1105. consume(_LIBRARY);
  1106. stringdispose(current_module.modulename);
  1107. current_module.modulename:=stringdup(pattern);
  1108. current_module.islibrary:=true;
  1109. exportlib.preparelib(pattern);
  1110. consume(_ID);
  1111. consume(_SEMICOLON);
  1112. end
  1113. else
  1114. { is there an program head ? }
  1115. if token=_PROGRAM then
  1116. begin
  1117. consume(_PROGRAM);
  1118. stringdispose(current_module.modulename);
  1119. stringdispose(current_module.realmodulename);
  1120. current_module.modulename:=stringdup(pattern);
  1121. current_module.realmodulename:=stringdup(orgpattern);
  1122. if (target_info.system in [system_i386_WIN32,system_i386_wdosx]) then
  1123. exportlib.preparelib(pattern);
  1124. consume(_ID);
  1125. if token=_LKLAMMER then
  1126. begin
  1127. consume(_LKLAMMER);
  1128. repeat
  1129. consume(_ID);
  1130. until not try_to_consume(_COMMA);
  1131. consume(_RKLAMMER);
  1132. end;
  1133. consume(_SEMICOLON);
  1134. end
  1135. else if (target_info.system in [system_i386_WIN32,system_i386_wdosx]) then
  1136. exportlib.preparelib(current_module.modulename^);
  1137. { global switches are read, so further changes aren't allowed }
  1138. current_module.in_global:=false;
  1139. { setup things using the global switches }
  1140. setupglobalswitches;
  1141. { set implementation flag }
  1142. current_module.in_interface:=false;
  1143. current_module.interface_compiled:=true;
  1144. { insert after the unit symbol tables the static symbol table }
  1145. { of the program }
  1146. st:=tstaticsymtable.create(current_module.modulename^);;
  1147. current_module.localsymtable:=st;
  1148. refsymtable:=st;
  1149. { load standard units (system,objpas,profile unit) }
  1150. loaddefaultunits;
  1151. {Load the units used by the program we compile.}
  1152. if token=_USES then
  1153. loadunits;
  1154. { reset ranges/stabs in exported definitions }
  1155. reset_all_defs;
  1156. { All units are read, now give them a number }
  1157. current_module.numberunits;
  1158. {Insert the name of the main program into the symbol table.}
  1159. if current_module.realmodulename^<>'' then
  1160. st.insert(tunitsym.create(current_module.realmodulename^,st));
  1161. { ...is also constsymtable, this is the symtable where }
  1162. { the elements of enumeration types are inserted }
  1163. constsymtable:=st;
  1164. Message1(parser_u_parsing_implementation,current_module.mainsource^);
  1165. { The program intialization needs an alias, so it can be called
  1166. from the bootstrap code.}
  1167. if islibrary or
  1168. (target_info.system in [system_powerpc_macos,system_powerpc_darwin]) then
  1169. begin
  1170. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'main'),potype_proginit,st);
  1171. { Win32 startup code needs a single name }
  1172. // if (target_info.system in [system_i386_win32,system_i386_wdosx]) then
  1173. pd.aliasnames.insert('PASCALMAIN');
  1174. end
  1175. else
  1176. begin
  1177. pd:=create_main_proc('main',potype_proginit,st);
  1178. pd.aliasnames.insert('PASCALMAIN');
  1179. end;
  1180. tcgprocinfo(current_procinfo).parse_body;
  1181. tcgprocinfo(current_procinfo).generate_code;
  1182. tcgprocinfo(current_procinfo).resetprocdef;
  1183. release_main_proc(pd);
  1184. { should we force unit initialization? }
  1185. if tstaticsymtable(current_module.localsymtable).needs_init_final then
  1186. begin
  1187. { initialize section }
  1188. gen_implicit_initfinal(uf_init,st);
  1189. { finalize section }
  1190. gen_implicit_initfinal(uf_finalize,st);
  1191. end;
  1192. { Add symbol to the exports section for win32 so smartlinking a
  1193. DLL will include the edata section }
  1194. if assigned(exportlib) and
  1195. (target_info.system in [system_i386_win32,system_i386_wdosx]) and
  1196. assigned(current_module._exports.first) then
  1197. codesegment.concat(tai_const_symbol.create(exportlib.edatalabel));
  1198. If ResourceStrings.ResStrCount>0 then
  1199. begin
  1200. ResourceStrings.CreateResourceStringList;
  1201. { only write if no errors found }
  1202. if (Errorcount=0) then
  1203. ResourceStrings.WriteResourceFile(ForceExtension(current_module.ppufilename^,'.rst'));
  1204. end;
  1205. { finalize? }
  1206. if token=_FINALIZATION then
  1207. begin
  1208. { set module options }
  1209. current_module.flags:=current_module.flags or uf_finalize;
  1210. { Compile the finalize }
  1211. pd:=create_main_proc(make_mangledname('',current_module.localsymtable,'finalize'),potype_unitfinalize,st);
  1212. pd.aliasnames.insert(make_mangledname('FINALIZE$',current_module.localsymtable,''));
  1213. tcgprocinfo(current_procinfo).parse_body;
  1214. tcgprocinfo(current_procinfo).generate_code;
  1215. tcgprocinfo(current_procinfo).resetprocdef;
  1216. release_main_proc(pd);
  1217. end;
  1218. { consume the last point }
  1219. consume(_POINT);
  1220. {$ifdef GDB}
  1221. write_gdb_info;
  1222. {$endif GDB}
  1223. { leave when we got an error }
  1224. if (Errorcount>0) and not status.skip_error then
  1225. begin
  1226. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1227. status.skip_error:=true;
  1228. exit;
  1229. end;
  1230. if (Errorcount=0) then
  1231. begin
  1232. { test static symtable }
  1233. tstoredsymtable(st).allsymbolsused;
  1234. tstoredsymtable(st).allprivatesused;
  1235. current_module.allunitsused;
  1236. end;
  1237. { generate a list of threadvars }
  1238. InsertThreadvars;
  1239. { generate imports }
  1240. if current_module.uses_imports then
  1241. importlib.generatelib;
  1242. if islibrary or
  1243. (target_info.system in [system_i386_WIN32,system_i386_wdosx]) or
  1244. (target_info.system=system_i386_NETWARE) then
  1245. exportlib.generatelib;
  1246. { insert Tables and Heap }
  1247. insertThreadVarTablesTable;
  1248. insertResourceTablesTable;
  1249. insertinitfinaltable;
  1250. insertheap;
  1251. insertstacklength;
  1252. // datasize:=symtablestack.datasize;
  1253. { finish asmlist by adding segment starts }
  1254. insertsegment;
  1255. { insert own objectfile }
  1256. insertobjectfile;
  1257. { assemble and link }
  1258. create_objectfile;
  1259. { leave when we got an error }
  1260. if (Errorcount>0) and not status.skip_error then
  1261. begin
  1262. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1263. status.skip_error:=true;
  1264. exit;
  1265. end;
  1266. { create the executable when we are at level 1 }
  1267. if (compile_level=1) then
  1268. begin
  1269. { insert all .o files from all loaded units }
  1270. hp:=tmodule(loaded_units.first);
  1271. while assigned(hp) do
  1272. begin
  1273. linker.AddModuleFiles(hp);
  1274. hp:=tmodule(hp.next);
  1275. end;
  1276. { write .def file }
  1277. if (cs_link_deffile in aktglobalswitches) then
  1278. deffile.writefile;
  1279. { finally we can create a executable }
  1280. if (not current_module.is_unit) then
  1281. begin
  1282. if DLLSource then
  1283. linker.MakeSharedLibrary
  1284. else
  1285. linker.MakeExecutable;
  1286. end;
  1287. end;
  1288. end;
  1289. end.
  1290. {
  1291. $Log$
  1292. Revision 1.146 2004-03-14 20:10:14 peter
  1293. * fix stabs lineno for fpc_compiled
  1294. Revision 1.145 2004/03/10 22:52:57 peter
  1295. * more stabs fixes
  1296. * special mode -gv for valgrind compatible stabs
  1297. Revision 1.144 2004/03/09 20:45:04 peter
  1298. * more stabs updates
  1299. Revision 1.143 2004/03/08 22:07:47 peter
  1300. * stabs updates to write stabs for def for all implictly used
  1301. units
  1302. Revision 1.142 2004/03/02 17:32:12 florian
  1303. * make cycle fixed
  1304. + pic support for darwin
  1305. + support of importing vars from shared libs on darwin implemented
  1306. Revision 1.141 2004/03/02 00:36:33 olle
  1307. * big transformation of Tai_[const_]Symbol.Create[data]name*
  1308. Revision 1.140 2004/02/26 16:16:38 peter
  1309. * tai_const.create_ptr added
  1310. Revision 1.139 2004/02/06 22:37:00 daniel
  1311. * Removed not very usefull nextglobal & previousglobal fields from
  1312. Tstoreddef, saving 78 kb of memory
  1313. Revision 1.138 2004/02/04 22:15:15 daniel
  1314. * Rtti generation moved to ncgutil
  1315. * Assmtai usage of symsym removed
  1316. * operator overloading cleanup up
  1317. Revision 1.137 2004/01/28 16:48:24 peter
  1318. use local string of 8 chars
  1319. Revision 1.136 2004/01/04 21:08:09 jonas
  1320. * Never generate a "main" symbol for PASCALMAIN for Darwin and classic
  1321. Mac OS, they use a C-main in their system unit
  1322. Revision 1.135 2003/12/12 19:42:21 peter
  1323. * check unit name when expected unitname > 8 chars
  1324. Revision 1.134 2003/12/08 22:33:43 peter
  1325. * don't allow duplicate uses
  1326. * fix wrong circular dependency
  1327. Revision 1.133 2003/11/29 20:13:25 florian
  1328. * fixed several pi_do_call problems
  1329. Revision 1.132 2003/10/29 19:48:51 peter
  1330. * renamed mangeldname_prefix to make_mangledname and made it more
  1331. generic
  1332. * make_mangledname is now also used for internal threadvar/resstring
  1333. lists
  1334. * Add P$ in front of program modulename to prevent duplicated symbols
  1335. at assembler level, because the main program can have the same name
  1336. as a unit, see webtbs/tw1251b
  1337. Revision 1.131 2003/10/24 17:40:23 peter
  1338. * cleanup of the entry and exit code insertion
  1339. Revision 1.130 2003/10/22 15:22:33 peter
  1340. * fixed unitsym-globalsymtable relation so the uses of a unit
  1341. is counted correctly
  1342. Revision 1.129 2003/10/21 15:14:33 peter
  1343. * fixed memleak for initfinalcode
  1344. * exit from generatecode when there are already errors
  1345. Revision 1.128 2003/10/01 20:34:49 peter
  1346. * procinfo unit contains tprocinfo
  1347. * cginfo renamed to cgbase
  1348. * moved cgmessage to verbose
  1349. * fixed ppc and sparc compiles
  1350. Revision 1.127 2003/09/30 08:39:50 michael
  1351. + Patch from Wiktor Sywula for watcom support
  1352. Revision 1.126 2003/09/23 18:03:08 peter
  1353. * add missing release of main_proc
  1354. Revision 1.125 2003/09/23 17:56:05 peter
  1355. * locals and paras are allocated in the code generation
  1356. * tvarsym.localloc contains the location of para/local when
  1357. generating code for the current procedure
  1358. Revision 1.124 2003/09/09 20:59:27 daniel
  1359. * Adding register allocation order
  1360. Revision 1.123 2003/09/09 15:55:44 peter
  1361. * use register with least interferences in spillregister
  1362. Revision 1.122 2003/09/07 22:09:35 peter
  1363. * preparations for different default calling conventions
  1364. * various RA fixes
  1365. Revision 1.121 2003/09/05 17:41:12 florian
  1366. * merged Wiktor's Watcom patches in 1.1
  1367. Revision 1.120 2003/08/23 22:29:24 peter
  1368. * reload flagged units when interface is loaded
  1369. Revision 1.119 2003/08/21 14:47:41 peter
  1370. * remove convert_registers
  1371. Revision 1.118 2003/08/20 17:48:49 peter
  1372. * fixed stackalloc to not allocate localst.datasize twice
  1373. * order of stackalloc code fixed for implicit init/final
  1374. Revision 1.117 2003/08/20 09:07:00 daniel
  1375. * New register coding now mandatory, some more convert_registers calls
  1376. removed.
  1377. Revision 1.116 2003/07/23 11:04:15 jonas
  1378. * split en_exit_code into a part that may allocate a register and a part
  1379. that doesn't, so the former can be done before the register colouring
  1380. has been performed
  1381. Revision 1.115 2003/07/06 17:58:22 peter
  1382. * framepointer fixes for sparc
  1383. * parent framepointer code more generic
  1384. Revision 1.114 2003/06/13 21:19:31 peter
  1385. * current_procdef removed, use current_procinfo.procdef instead
  1386. Revision 1.113 2003/06/09 12:23:30 peter
  1387. * init/final of procedure data splitted from genentrycode
  1388. * use asmnode getposition to insert final at the correct position
  1389. als for the implicit try...finally
  1390. Revision 1.112 2003/06/07 20:26:32 peter
  1391. * re-resolving added instead of reloading from ppu
  1392. * tderef object added to store deref info for resolving
  1393. Revision 1.111 2003/06/03 20:21:45 mazen
  1394. - removed unneeded ifdefs
  1395. - removed unneeded cases for sparc and x86_64
  1396. Revision 1.110 2003/06/03 13:01:59 daniel
  1397. * Register allocator finished
  1398. Revision 1.109 2003/05/26 21:17:17 peter
  1399. * procinlinenode removed
  1400. * aktexit2label removed, fast exit removed
  1401. + tcallnode.inlined_pass_2 added
  1402. Revision 1.108 2003/05/25 10:27:12 peter
  1403. * moved Comment calls to messge file
  1404. Revision 1.107 2003/05/22 21:31:35 peter
  1405. * defer codegeneration for nested procedures
  1406. Revision 1.106 2003/05/15 18:58:53 peter
  1407. * removed selfpointer_offset, vmtpointer_offset
  1408. * tvarsym.adjusted_address
  1409. * address in localsymtable is now in the real direction
  1410. * removed some obsolete globals
  1411. Revision 1.105 2003/05/11 19:31:28 florian
  1412. * fixed implicit init/final code for units, stack frame was wrong for ppc
  1413. Revision 1.104 2003/04/28 21:19:02 peter
  1414. * fix stabs generation for implicit initfinal
  1415. Revision 1.103 2003/04/27 11:21:34 peter
  1416. * aktprocdef renamed to current_procinfo.procdef
  1417. * procinfo renamed to current_procinfo
  1418. * procinfo will now be stored in current_module so it can be
  1419. cleaned up properly
  1420. * gen_main_procsym changed to create_main_proc and release_main_proc
  1421. to also generate a tprocinfo structure
  1422. * fixed unit implicit initfinal
  1423. Revision 1.102 2003/04/27 07:29:50 peter
  1424. * current_procinfo.procdef cleanup, current_procdef is now always nil when parsing
  1425. a new procdef declaration
  1426. * aktprocsym removed
  1427. * lexlevel removed, use symtable.symtablelevel instead
  1428. * implicit init/final code uses the normal genentry/genexit
  1429. * funcret state checking updated for new funcret handling
  1430. Revision 1.101 2003/04/23 12:35:34 florian
  1431. * fixed several issues with powerpc
  1432. + applied a patch from Jonas for nested function calls (PowerPC only)
  1433. * ...
  1434. Revision 1.100 2003/04/12 15:13:03 peter
  1435. * Use the original unitname when defining a unitsym
  1436. Revision 1.99 2003/03/23 23:21:42 hajny
  1437. + emx target added
  1438. Revision 1.98 2003/03/17 22:20:08 peter
  1439. *** empty log message ***
  1440. Revision 1.97 2003/03/17 13:36:39 peter
  1441. * fix import linking under linux
  1442. Revision 1.96 2003/02/19 22:00:14 daniel
  1443. * Code generator converted to new register notation
  1444. - Horribily outdated todo.txt removed
  1445. Revision 1.95 2003/02/06 22:36:55 mazen
  1446. * fixing bug related to errornous program main entry stack frame
  1447. Revision 1.94 2003/01/30 21:46:20 peter
  1448. * tai_const_symbol.createdataname added
  1449. Revision 1.93 2003/01/11 11:19:54 hajny
  1450. * correction from rev. 1.88 put back
  1451. Revision 1.92 2003/01/08 18:43:56 daniel
  1452. * Tregister changed into a record
  1453. Revision 1.91 2003/01/05 13:36:53 florian
  1454. * x86-64 compiles
  1455. + very basic support for float128 type (x86-64 only)
  1456. Revision 1.90 2002/12/29 18:17:23 peter
  1457. * insert unitsym with the name as specified in the uses list
  1458. Revision 1.89 2002/12/29 14:57:50 peter
  1459. * unit loading changed to first register units and load them
  1460. afterwards. This is needed to support uses xxx in yyy correctly
  1461. * unit dependency check fixed
  1462. Revision 1.88 2002/12/27 19:09:33 hajny
  1463. * another (hopefully final ;-) ) fix for not linked import libraries for units with no code
  1464. Revision 1.87 2002/12/24 23:32:56 peter
  1465. * Use FixFilename for specified unit sourcefile in uses
  1466. Revision 1.86 2002/12/06 16:56:58 peter
  1467. * only compile cs_fp_emulation support when cpufpuemu is defined
  1468. * define cpufpuemu for m68k only
  1469. Revision 1.85 2002/11/30 21:32:24 carl
  1470. + Add loading of softfpu in emulation mode
  1471. + Correct routine call for softfpu
  1472. * Extended type must also be defined even with softfpu
  1473. Revision 1.84 2002/11/15 01:58:53 peter
  1474. * merged changes from 1.0.7 up to 04-11
  1475. - -V option for generating bug report tracing
  1476. - more tracing for option parsing
  1477. - errors for cdecl and high()
  1478. - win32 import stabs
  1479. - win32 records<=8 are returned in eax:edx (turned off by default)
  1480. - heaptrc update
  1481. - more info for temp management in .s file with EXTDEBUG
  1482. Revision 1.83 2002/11/09 15:33:26 carl
  1483. * major alignment updates
  1484. Revision 1.82 2002/10/16 06:32:52 michael
  1485. + Renamed thread unit to systhrds
  1486. Revision 1.81 2002/10/14 19:42:34 peter
  1487. * only use init tables for threadvars
  1488. Revision 1.80 2002/10/06 19:41:30 peter
  1489. * Add finalization of typed consts
  1490. * Finalization of globals in the main program
  1491. Revision 1.79 2002/09/09 17:34:15 peter
  1492. * tdicationary.replace added to replace and item in a dictionary. This
  1493. is only allowed for the same name
  1494. * varsyms are inserted in symtable before the types are parsed. This
  1495. fixes the long standing "var longint : longint" bug
  1496. - consume_idlist and idstringlist removed. The loops are inserted
  1497. at the callers place and uses the symtable for duplicate id checking
  1498. Revision 1.78 2002/09/07 15:25:07 peter
  1499. * old logs removed and tabs fixed
  1500. Revision 1.77 2002/09/03 16:26:27 daniel
  1501. * Make Tprocdef.defs protected
  1502. Revision 1.76 2002/09/02 18:46:26 peter
  1503. * insert PASCALMAIN in library for Win32 only
  1504. Revision 1.75 2002/08/31 15:59:30 florian
  1505. + HEAP* stuff must be generated for Linux/PPC as well
  1506. + direct assembler reader searches now global and static symtables as well
  1507. Revision 1.74 2002/08/25 19:25:20 peter
  1508. * sym.insert_in_data removed
  1509. * symtable.insertvardata/insertconstdata added
  1510. * removed insert_in_data call from symtable.insert, it needs to be
  1511. called separatly. This allows to deref the address calculation
  1512. * procedures now calculate the parast addresses after the procedure
  1513. directives are parsed. This fixes the cdecl parast problem
  1514. * push_addr_param has an extra argument that specifies if cdecl is used
  1515. or not
  1516. Revision 1.73 2002/08/18 20:06:25 peter
  1517. * inlining is now also allowed in interface
  1518. * renamed write/load to ppuwrite/ppuload
  1519. * tnode storing in ppu
  1520. * nld,ncon,nbas are already updated for storing in ppu
  1521. Revision 1.72 2002/08/17 09:23:39 florian
  1522. * first part of procinfo rewrite
  1523. Revision 1.71 2002/08/11 13:24:12 peter
  1524. * saving of asmsymbols in ppu supported
  1525. * asmsymbollist global is removed and moved into a new class
  1526. tasmlibrarydata that will hold the info of a .a file which
  1527. corresponds with a single module. Added librarydata to tmodule
  1528. to keep the library info stored for the module. In the future the
  1529. objectfiles will also be stored to the tasmlibrarydata class
  1530. * all getlabel/newasmsymbol and friends are moved to the new class
  1531. Revision 1.70 2002/08/10 14:46:29 carl
  1532. + moved target_cpu_string to cpuinfo
  1533. * renamed asmmode enum.
  1534. * assembler reader has now less ifdef's
  1535. * move from nppcmem.pas -> ncgmem.pas vec. node.
  1536. Revision 1.69 2002/07/26 21:15:41 florian
  1537. * rewrote the system handling
  1538. Revision 1.68 2002/07/04 20:43:01 florian
  1539. * first x86-64 patches
  1540. Revision 1.67 2002/07/01 18:46:25 peter
  1541. * internal linker
  1542. * reorganized aasm layer
  1543. Revision 1.66 2002/05/16 19:46:43 carl
  1544. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1545. + try to fix temp allocation (still in ifdef)
  1546. + generic constructor calls
  1547. + start of tassembler / tmodulebase class cleanup
  1548. Revision 1.65 2002/05/14 19:34:49 peter
  1549. * removed old logs and updated copyright year
  1550. Revision 1.64 2002/05/12 16:53:09 peter
  1551. * moved entry and exitcode to ncgutil and cgobj
  1552. * foreach gets extra argument for passing local data to the
  1553. iterator function
  1554. * -CR checks also class typecasts at runtime by changing them
  1555. into as
  1556. * fixed compiler to cycle with the -CR option
  1557. * fixed stabs with elf writer, finally the global variables can
  1558. be watched
  1559. * removed a lot of routines from cga unit and replaced them by
  1560. calls to cgobj
  1561. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1562. u32bit then the other is typecasted also to u32bit without giving
  1563. a rangecheck warning/error.
  1564. * fixed pascal calling method with reversing also the high tree in
  1565. the parast, detected by tcalcst3 test
  1566. Revision 1.63 2002/05/06 19:54:50 carl
  1567. + added more patches from Mazen for SPARC port
  1568. Revision 1.62 2002/04/20 21:32:24 carl
  1569. + generic FPC_CHECKPOINTER
  1570. + first parameter offset in stack now portable
  1571. * rename some constants
  1572. + move some cpu stuff to other units
  1573. - remove unused constents
  1574. * fix stacksize for some targets
  1575. * fix generic size problems which depend now on EXTEND_SIZE constant
  1576. Revision 1.61 2002/04/19 15:46:02 peter
  1577. * mangledname rewrite, tprocdef.mangledname is now created dynamicly
  1578. in most cases and not written to the ppu
  1579. * add mangeledname_prefix() routine to generate the prefix of
  1580. manglednames depending on the current procedure, object and module
  1581. * removed static procprefix since the mangledname is now build only
  1582. on demand from tprocdef.mangledname
  1583. Revision 1.60 2002/04/14 16:53:10 carl
  1584. + align code section and data section according to alignment rules
  1585. Revision 1.59 2002/04/07 17:58:38 carl
  1586. + generic stack checking
  1587. Revision 1.58 2002/04/04 19:06:03 peter
  1588. * removed unused units
  1589. * use tlocation.size in cg.a_*loc*() routines
  1590. }