pmodules.pas 64 KB

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