pmodules.pas 59 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 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 defines.inc}
  20. { close old_current_ppu on system that are
  21. short on file handles like DOS system PM }
  22. {$ifdef GO32V1}
  23. {$define SHORT_ON_FILE_HANDLES}
  24. {$endif GO32V1}
  25. {$ifdef GO32V2}
  26. {$define SHORT_ON_FILE_HANDLES}
  27. {$endif GO32V2}
  28. {$define New_GDB}
  29. interface
  30. procedure proc_unit;
  31. procedure proc_program(islibrary : boolean);
  32. implementation
  33. uses
  34. globtype,version,systems,tokens,
  35. cutils,cobjects,comphook,
  36. globals,verbose,fmodule,finput,
  37. symconst,symbase,symppu,symdef,symsym,symtable,aasm,types,
  38. {$ifdef newcg}
  39. cgbase,
  40. {$else newcg}
  41. hcodegen,
  42. {$ifdef i386}
  43. cgai386,
  44. {$endif i386}
  45. {$endif newcg}
  46. link,assemble,import,export,gendef,ppu,comprsrc,
  47. cresstr,cpubase,cpuasm,
  48. {$ifdef GDB}
  49. gdb,
  50. {$endif GDB}
  51. scanner,pbase,psystem,psub,parser;
  52. procedure create_objectfile;
  53. begin
  54. { create the .s file and assemble it }
  55. GenerateAsm(false);
  56. { Also create a smartlinked version ? }
  57. if (cs_create_smart in aktmoduleswitches) then
  58. begin
  59. { regenerate the importssection for win32 }
  60. if assigned(importssection) and
  61. (target_info.target=target_i386_win32) then
  62. begin
  63. importsSection.clear;
  64. importlib.generatesmartlib;
  65. end;
  66. GenerateAsm(true);
  67. if target_asm.needar then
  68. Linker.MakeStaticLibrary;
  69. end;
  70. { resource files }
  71. CompileResourceFiles;
  72. end;
  73. procedure insertobjectfile;
  74. { Insert the used object file for this unit in the used list for this unit }
  75. begin
  76. current_module.linkunitofiles.add(current_module.objfilename^,link_static);
  77. current_module.flags:=current_module.flags or uf_static_linked;
  78. if (cs_create_smart in aktmoduleswitches) then
  79. begin
  80. current_module.linkunitstaticlibs.add(current_module.staticlibfilename^,link_smart);
  81. current_module.flags:=current_module.flags or uf_smart_linked;
  82. end;
  83. end;
  84. procedure insertsegment;
  85. procedure fixseg(p:TAAsmoutput;sec:tsection);
  86. begin
  87. p.insert(Tai_section.Create(sec));
  88. if (cs_create_smart in aktmoduleswitches) then
  89. p.insert(Tai_cut.Create);
  90. p.concat(Tai_section.Create(sec_none));
  91. end;
  92. begin
  93. { Insert Ident of the compiler }
  94. if (not (cs_create_smart in aktmoduleswitches))
  95. {$ifndef EXTDEBUG}
  96. and (not current_module.is_unit)
  97. {$endif}
  98. then
  99. begin
  100. dataSegment.insert(Tai_align.Create(4));
  101. dataSegment.insert(Tai_string.Create('FPC '+full_version_string+
  102. ' ['+date_string+'] for '+target_cpu_string+' - '+target_info.short_name));
  103. end;
  104. { finish codesegment }
  105. codeSegment.concat(Tai_align.Create(16));
  106. { Insert start and end of sections }
  107. fixseg(codesegment,sec_code);
  108. fixseg(datasegment,sec_data);
  109. fixseg(bsssegment,sec_bss);
  110. { we should use .rdata section for these two no ? }
  111. { .rdata is a read only data section (PM) }
  112. fixseg(rttilist,sec_data);
  113. fixseg(consts,sec_data);
  114. if assigned(resourcestringlist) then
  115. fixseg(resourcestringlist,sec_data);
  116. {$ifdef GDB}
  117. if assigned(debuglist) then
  118. begin
  119. debugList.insert(Tai_symbol.Createname('gcc2_compiled',0));
  120. debugList.insert(Tai_symbol.Createname('fpc_compiled',0));
  121. fixseg(debuglist,sec_code);
  122. end;
  123. {$endif GDB}
  124. end;
  125. Procedure InsertResourceTablesTable;
  126. var
  127. hp : tused_unit;
  128. ResourceStringTables : taasmoutput;
  129. count : longint;
  130. begin
  131. ResourceStringTables:=TAAsmOutput.Create;
  132. count:=0;
  133. hp:=tused_unit(usedunits.first);
  134. while assigned(hp) do
  135. begin
  136. If (hp.u.flags and uf_has_resources)=uf_has_resources then
  137. begin
  138. ResourceStringTables.concat(Tai_const_symbol.Createname(hp.u.modulename^+'_RESOURCESTRINGLIST'));
  139. inc(count);
  140. end;
  141. hp:=tused_unit(hp.next);
  142. end;
  143. { Add program resources, if any }
  144. If ResourceStringList<>Nil then
  145. begin
  146. ResourceStringTables.concat(Tai_const_symbol.Createname(current_module.modulename^+'_RESOURCESTRINGLIST'));
  147. Inc(Count);
  148. end;
  149. { TableCount }
  150. { doesn't work because of bug in the compiler !! (JM)
  151. With ResourceStringTables do}
  152. begin
  153. ResourceStringTables.insert(Tai_const.Create_32bit(count));
  154. ResourceStringTables.insert(Tai_symbol.Createdataname_global('FPC_RESOURCESTRINGTABLES',0));
  155. ResourceStringTables.concat(Tai_symbol_end.Createname('FPC_RESOURCESTRINGTABLES'));
  156. end;
  157. { insert in data segment }
  158. if (cs_create_smart in aktmoduleswitches) then
  159. dataSegment.concat(Tai_cut.Create);
  160. dataSegment.concatlist(ResourceStringTables);
  161. ResourceStringTables.free;
  162. end;
  163. procedure InsertInitFinalTable;
  164. var
  165. hp : tused_unit;
  166. unitinits : taasmoutput;
  167. count : longint;
  168. begin
  169. unitinits:=TAAsmOutput.Create;
  170. count:=0;
  171. hp:=tused_unit(usedunits.first);
  172. while assigned(hp) do
  173. begin
  174. { call the unit init code and make it external }
  175. if (hp.u.flags and (uf_init or uf_finalize))<>0 then
  176. begin
  177. if (hp.u.flags and uf_init)<>0 then
  178. unitinits.concat(Tai_const_symbol.Createname('INIT$$'+hp.u.modulename^))
  179. else
  180. unitinits.concat(Tai_const.Create_32bit(0));
  181. if (hp.u.flags and uf_finalize)<>0 then
  182. unitinits.concat(Tai_const_symbol.Createname('FINALIZE$$'+hp.u.modulename^))
  183. else
  184. unitinits.concat(Tai_const.Create_32bit(0));
  185. inc(count);
  186. end;
  187. hp:=tused_unit(hp.next);
  188. end;
  189. if current_module.islibrary then
  190. if (current_module.flags and uf_finalize)<>0 then
  191. begin
  192. { INIT code is done by PASCALMAIN calling }
  193. unitinits.concat(Tai_const.Create_32bit(0));
  194. unitinits.concat(Tai_const_symbol.Createname('FINALIZE$$'+current_module.modulename^));
  195. inc(count);
  196. end;
  197. { TableCount,InitCount }
  198. unitinits.insert(Tai_const.Create_32bit(0));
  199. unitinits.insert(Tai_const.Create_32bit(count));
  200. unitinits.insert(Tai_symbol.Createdataname_global('INITFINAL',0));
  201. unitinits.concat(Tai_symbol_end.Createname('INITFINAL'));
  202. { insert in data segment }
  203. if (cs_create_smart in aktmoduleswitches) then
  204. dataSegment.concat(Tai_cut.Create);
  205. dataSegment.concatlist(unitinits);
  206. unitinits.free;
  207. end;
  208. procedure insertheap;
  209. begin
  210. if (cs_create_smart in aktmoduleswitches) then
  211. begin
  212. bssSegment.concat(Tai_cut.Create);
  213. dataSegment.concat(Tai_cut.Create);
  214. end;
  215. { On the Macintosh Classic M68k Architecture
  216. The Heap variable is simply a POINTER to the
  217. real HEAP. The HEAP must be set up by the RTL
  218. and must store the pointer in this value.
  219. On OS/2 the heap is also intialized by the RTL. We do
  220. not output a pointer }
  221. case target_info.target of
  222. {$ifdef i386}
  223. target_i386_OS2:
  224. ;
  225. {$endif i386}
  226. {$ifdef alpha}
  227. target_alpha_linux:
  228. ;
  229. {$endif alpha}
  230. {$ifdef powerpc}
  231. target_powerpc_linux:
  232. ;
  233. {$endif powerpc}
  234. {$ifdef m68k}
  235. target_m68k_Mac:
  236. bssSegment.concat(Tai_datablock.Create_global('HEAP',4));
  237. target_m68k_PalmOS:
  238. ;
  239. {$endif m68k}
  240. else
  241. bssSegment.concat(Tai_datablock.Create_global('HEAP',heapsize));
  242. end;
  243. {$ifdef m68k}
  244. if target_info.target<>target_m68k_PalmOS then
  245. begin
  246. dataSegment.concat(Tai_symbol.Createdataname_global('HEAP_SIZE',0));
  247. dataSegment.concat(Tai_const.Create_32bit(heapsize));
  248. end;
  249. {$else m68k}
  250. dataSegment.concat(Tai_symbol.Createdataname_global('HEAPSIZE',4));
  251. dataSegment.concat(Tai_const.Create_32bit(heapsize));
  252. {$endif m68k}
  253. end;
  254. procedure inserttargetspecific;
  255. begin
  256. case target_info.target of
  257. {$ifdef alpha}
  258. target_alpha_linux:
  259. ;
  260. {$endif alpha}
  261. {$ifdef powerpc}
  262. target_powerpc_linux:
  263. ;
  264. {$endif powerpc}
  265. {$ifdef i386}
  266. target_i386_GO32V2 :
  267. begin
  268. { stacksize can be specified }
  269. dataSegment.concat(Tai_symbol.Createdataname_global('__stklen',4));
  270. dataSegment.concat(Tai_const.Create_32bit(stacksize));
  271. end;
  272. {$endif i386}
  273. {$ifdef m68k}
  274. target_m68k_Atari :
  275. begin
  276. { stacksize can be specified }
  277. dataSegment.concat(Tai_symbol.Createdataname_global('__stklen',4));
  278. dataSegment.concat(Tai_const.Create_32bit(stacksize));
  279. end;
  280. {$endif m68k}
  281. end;
  282. end;
  283. function loadunit(const s : string;compile_system:boolean) : tmodule;forward;
  284. procedure load_usedunits(compile_system:boolean);
  285. var
  286. pu : tused_unit;
  287. loaded_unit : tmodule;
  288. load_refs : boolean;
  289. nextmapentry : longint;
  290. begin
  291. load_refs:=true;
  292. { init the map }
  293. new(current_module.map);
  294. fillchar(current_module.map^,sizeof(tunitmap),#0);
  295. {$ifdef NEWMAP}
  296. current_module.map^[0]:=current_module;
  297. {$endif NEWMAP}
  298. nextmapentry:=1;
  299. { load the used units from interface }
  300. current_module.in_implementation:=false;
  301. pu:=tused_unit(current_module.used_units.first);
  302. while assigned(pu) do
  303. begin
  304. if (not pu.loaded) and (pu.in_interface) then
  305. begin
  306. loaded_unit:=loadunit(pu.name^,false);
  307. if current_module.compiled then
  308. exit;
  309. { register unit in used units }
  310. pu.u:=loaded_unit;
  311. pu.loaded:=true;
  312. { doubles are not important for that list PM }
  313. pu.u.dependent_units.concat(tdependent_unit.create(current_module));
  314. { need to recompile the current unit ? }
  315. if loaded_unit.crc<>pu.checksum then
  316. begin
  317. Message2(unit_u_recompile_crc_change,current_module.modulename^,pu.name^);
  318. current_module.recompile_reason:=rr_crcchanged;
  319. current_module.do_compile:=true;
  320. dispose(current_module.map);
  321. current_module.map:=nil;
  322. exit;
  323. end;
  324. { setup the map entry for deref }
  325. {$ifndef NEWMAP}
  326. current_module.map^[nextmapentry]:=loaded_unit.globalsymtable;
  327. {$else NEWMAP}
  328. current_module.map^[nextmapentry]:=loaded_unit;
  329. {$endif NEWMAP}
  330. inc(nextmapentry);
  331. if nextmapentry>maxunits then
  332. Message(unit_f_too_much_units);
  333. end;
  334. pu:=tused_unit(pu.next);
  335. end;
  336. { ok, now load the unit }
  337. current_module.globalsymtable:=new(punitsymtable,loadasunit);
  338. { now only read the implementation part }
  339. current_module.in_implementation:=true;
  340. { load the used units from implementation }
  341. pu:=tused_unit(current_module.used_units.first);
  342. while assigned(pu) do
  343. begin
  344. if (not pu.loaded) and (not pu.in_interface) then
  345. begin
  346. loaded_unit:=loadunit(pu.name^,false);
  347. if current_module.compiled then
  348. exit;
  349. { register unit in used units }
  350. pu.u:=loaded_unit;
  351. pu.loaded:=true;
  352. { need to recompile the current unit ? }
  353. if (loaded_unit.interface_crc<>pu.interface_checksum) {and
  354. not(current_module.in_second_compile) } then
  355. begin
  356. Message2(unit_u_recompile_crc_change,current_module.modulename^,pu.name^+' {impl}');
  357. current_module.recompile_reason:=rr_crcchanged;
  358. current_module.do_compile:=true;
  359. dispose(current_module.map);
  360. current_module.map:=nil;
  361. exit;
  362. end;
  363. { setup the map entry for deref }
  364. {$ifndef NEWMAP}
  365. current_module.map^[nextmapentry]:=loaded_unit.globalsymtable;
  366. {$else NEWMAP}
  367. current_module.map^[nextmapentry]:=loaded_unit;
  368. {$endif NEWMAP}
  369. inc(nextmapentry);
  370. if nextmapentry>maxunits then
  371. Message(unit_f_too_much_units);
  372. end;
  373. pu:=tused_unit(pu.next);
  374. end;
  375. { load browser info if stored }
  376. if ((current_module.flags and uf_has_browser)<>0) and load_refs then
  377. punitsymtable(current_module.globalsymtable)^.load_symtable_refs;
  378. { remove the map, it's not needed anymore }
  379. dispose(current_module.map);
  380. current_module.map:=nil;
  381. end;
  382. function loadunit(const s : string;compile_system:boolean) : tmodule;
  383. const
  384. ImplIntf : array[boolean] of string[15]=('interface','implementation');
  385. var
  386. st : punitsymtable;
  387. second_time : boolean;
  388. old_current_ppu : pppufile;
  389. old_current_module,hp,hp2 : tmodule;
  390. name : string;{ necessary because current_module.mainsource^ is reset in compile !! }
  391. scanner : pscannerfile;
  392. procedure loadppufile;
  393. begin
  394. { load interface section }
  395. if not current_module.do_compile then
  396. load_interface;
  397. { only load units when we don't recompile }
  398. if not current_module.do_compile then
  399. load_usedunits(compile_system);
  400. { recompile if set }
  401. if current_module.do_compile then
  402. begin
  403. { we don't need the ppufile anymore }
  404. if assigned(current_module.ppufile) then
  405. begin
  406. dispose(current_module.ppufile,done);
  407. current_module.ppufile:=nil;
  408. current_ppu:=nil;
  409. end;
  410. { recompile the unit or give a fatal error if sources not available }
  411. if not(current_module.sources_avail) and
  412. not(current_module.sources_checked) then
  413. if (not current_module.search_unit(current_module.modulename^,true))
  414. and (length(current_module.modulename^)>8) then
  415. current_module.search_unit(copy(current_module.modulename^,1,8),true);
  416. if not(current_module.sources_avail) then
  417. begin
  418. hp:=current_module;
  419. current_module:=old_current_module;
  420. if hp.recompile_reason=rr_noppu then
  421. Message1(unit_f_cant_find_ppu,hp.modulename^)
  422. else
  423. Message1(unit_f_cant_compile_unit,hp.modulename^);
  424. current_module:=hp;
  425. end
  426. else
  427. begin
  428. if current_module.in_compile then
  429. begin
  430. current_module.in_second_compile:=true;
  431. Message1(parser_d_compiling_second_time,current_module.modulename^);
  432. end;
  433. current_scanner^.tempcloseinputfile;
  434. name:=current_module.mainsource^;
  435. if assigned(scanner) then
  436. scanner^.invalid:=true;
  437. compile(name,compile_system);
  438. current_module.in_second_compile:=false;
  439. if (not current_scanner^.invalid) then
  440. current_scanner^.tempopeninputfile;
  441. end;
  442. end
  443. else
  444. begin
  445. { only reassemble ? }
  446. if (current_module.do_assemble) then
  447. OnlyAsm;
  448. end;
  449. if assigned(current_module.ppufile) then
  450. begin
  451. dispose(current_module.ppufile,done);
  452. current_module.ppufile:=nil;
  453. current_ppu:=nil;
  454. end;
  455. end;
  456. var
  457. dummy : tmodule;
  458. begin
  459. old_current_module:=current_module;
  460. old_current_ppu:=current_ppu;
  461. { Info }
  462. Message3(unit_u_load_unit,current_module.modulename^,ImplIntf[current_module.in_implementation],s);
  463. { unit not found }
  464. st:=nil;
  465. dummy:=nil;
  466. { search all loaded units }
  467. hp:=tmodule(loaded_units.first);
  468. while assigned(hp) do
  469. begin
  470. if hp.modulename^=s then
  471. begin
  472. { forced to reload ? }
  473. if hp.do_reload then
  474. begin
  475. hp.do_reload:=false;
  476. break;
  477. end;
  478. { the unit is already registered }
  479. { and this means that the unit }
  480. { is already compiled }
  481. { else there is a cyclic unit use }
  482. if assigned(hp.globalsymtable) then
  483. st:=punitsymtable(hp.globalsymtable)
  484. else
  485. begin
  486. { both units in interface ? }
  487. if (not current_module.in_implementation) and (not hp.in_implementation) then
  488. begin
  489. { check for a cycle }
  490. hp2:=current_module.loaded_from;
  491. while assigned(hp2) and (hp2<>hp) do
  492. begin
  493. if hp2.in_implementation then
  494. hp2:=nil
  495. else
  496. hp2:=hp2.loaded_from;
  497. end;
  498. if assigned(hp2) then
  499. Message2(unit_f_circular_unit_reference,current_module.modulename^,hp.modulename^);
  500. end;
  501. end;
  502. break;
  503. end
  504. else if copy(hp.modulename^,1,8)=s then
  505. dummy:=hp;
  506. { the next unit }
  507. hp:=tmodule(hp.next);
  508. end;
  509. if assigned(dummy) and not assigned(hp) then
  510. Message2(unit_w_unit_name_error,s,dummy.modulename^);
  511. { the unit is not in the symtable stack }
  512. if (not assigned(st)) then
  513. begin
  514. if assigned(hp) then
  515. begin
  516. { remove the old unit }
  517. loaded_units.remove(hp);
  518. scanner:=hp.scanner;
  519. hp.reset;
  520. hp.scanner:=scanner;
  521. { try to reopen ppu }
  522. hp.search_unit(s,false);
  523. { try to load the unit a second time first }
  524. current_module:=hp;
  525. current_module.in_second_load:=true;
  526. Message1(unit_u_second_load_unit,current_module.modulename^);
  527. second_time:=true;
  528. end
  529. else
  530. { generates a new unit info record }
  531. begin
  532. current_module:=tmodule.create(s,true);
  533. scanner:=nil;
  534. second_time:=false;
  535. end;
  536. current_ppu:=current_module.ppufile;
  537. { close old_current_ppu on system that are
  538. short on file handles like DOS PM }
  539. {$ifdef SHORT_ON_FILE_HANDLES}
  540. if assigned(old_current_ppu) then
  541. old_current_ppu^.tempclose;
  542. {$endif SHORT_ON_FILE_HANDLES}
  543. { now we can register the unit }
  544. current_module.loaded_from:=old_current_module;
  545. loaded_units.insert(current_module);
  546. { now realy load the ppu }
  547. loadppufile;
  548. { set compiled flag }
  549. current_module.compiled:=true;
  550. { load return pointer }
  551. hp:=current_module;
  552. { for a second_time recompile reload all dependent units,
  553. for a first time compile register the unit _once_ }
  554. if second_time then
  555. begin
  556. { now reload all dependent units }
  557. hp2:=tmodule(loaded_units.first);
  558. while assigned(hp2) do
  559. begin
  560. if hp2.do_reload then
  561. dummy:=loadunit(hp2.modulename^,false);
  562. hp2:=tmodule(hp2.next);
  563. end;
  564. end
  565. else
  566. usedunits.concat(tused_unit.create(current_module,true));
  567. end;
  568. { set the old module }
  569. {$ifdef SHORT_ON_FILE_HANDLES}
  570. if assigned(old_current_ppu) then
  571. old_current_ppu^.tempopen;
  572. {$endif SHORT_ON_FILE_HANDLES}
  573. current_ppu:=old_current_ppu;
  574. current_module:=old_current_module;
  575. { we are back }
  576. SetCompileModule(current_module);
  577. loadunit:=hp;
  578. end;
  579. procedure loaddefaultunits;
  580. var
  581. hp : tmodule;
  582. unitsym : punitsym;
  583. begin
  584. { are we compiling the system unit? }
  585. if (cs_compilesystem in aktmoduleswitches) then
  586. begin
  587. { create system defines }
  588. createconstdefs;
  589. { we don't need to reset anything, it's already done in parser.pas }
  590. exit;
  591. end;
  592. { insert the system unit, it is allways the first }
  593. hp:=loadunit('SYSTEM',true);
  594. systemunit:=hp.globalsymtable;
  595. { it's always the first unit }
  596. systemunit^.next:=nil;
  597. symtablestack:=systemunit;
  598. { add to the used units }
  599. current_module.used_units.concat(tused_unit.create(hp,true));
  600. unitsym:=new(punitsym,init('System',systemunit));
  601. inc(unitsym^.refs);
  602. refsymtable^.insert(unitsym);
  603. { read default constant definitions }
  604. make_ref:=false;
  605. readconstdefs;
  606. { if POWER is defined in the RTL then use it for starstar overloading }
  607. {$ifdef DONOTCHAINOPERATORS}
  608. getsym('POWER',false);
  609. {$endif DONOTCHAINOPERATORS}
  610. make_ref:=true;
  611. {$ifdef DONOTCHAINOPERATORS}
  612. { Code now in chainoperators PM }
  613. if assigned(srsym) and (srsym^.typ=procsym) and (overloaded_operators[_STARSTAR]=nil) then
  614. overloaded_operators[_STARSTAR]:=pprocsym(srsym);
  615. {$endif DONOTCHAINOPERATORS}
  616. { Objpas unit? }
  617. if m_objpas in aktmodeswitches then
  618. begin
  619. hp:=loadunit('ObjPas',false);
  620. psymtable(hp.globalsymtable)^.next:=symtablestack;
  621. symtablestack:=hp.globalsymtable;
  622. { add to the used units }
  623. current_module.used_units.concat(tused_unit.create(hp,true));
  624. unitsym:=new(punitsym,init('ObjPas',hp.globalsymtable));
  625. inc(unitsym^.refs);
  626. refsymtable^.insert(unitsym);
  627. end;
  628. { Profile unit? Needed for go32v2 only }
  629. if (cs_profile in aktmoduleswitches) and (target_info.target=target_i386_go32v2) then
  630. begin
  631. hp:=loadunit('Profile',false);
  632. psymtable(hp.globalsymtable)^.next:=symtablestack;
  633. symtablestack:=hp.globalsymtable;
  634. { add to the used units }
  635. current_module.used_units.concat(tused_unit.create(hp,true));
  636. unitsym:=new(punitsym,init('Profile',hp.globalsymtable));
  637. inc(unitsym^.refs);
  638. refsymtable^.insert(unitsym);
  639. end;
  640. { Units only required for main module }
  641. if not(current_module.is_unit) then
  642. begin
  643. { Heaptrc unit }
  644. if (cs_gdb_heaptrc in aktglobalswitches) then
  645. begin
  646. hp:=loadunit('HeapTrc',false);
  647. psymtable(hp.globalsymtable)^.next:=symtablestack;
  648. symtablestack:=hp.globalsymtable;
  649. { add to the used units }
  650. current_module.used_units.concat(tused_unit.create(hp,true));
  651. unitsym:=new(punitsym,init('HeapTrc',hp.globalsymtable));
  652. inc(unitsym^.refs);
  653. refsymtable^.insert(unitsym);
  654. end;
  655. { Lineinfo unit }
  656. if (cs_gdb_lineinfo in aktglobalswitches) then
  657. begin
  658. hp:=loadunit('LineInfo',false);
  659. psymtable(hp.globalsymtable)^.next:=symtablestack;
  660. symtablestack:=hp.globalsymtable;
  661. { add to the used units }
  662. current_module.used_units.concat(tused_unit.create(hp,true));
  663. unitsym:=new(punitsym,init('LineInfo',hp.globalsymtable));
  664. inc(unitsym^.refs);
  665. refsymtable^.insert(unitsym);
  666. end;
  667. end;
  668. { save default symtablestack }
  669. defaultsymtablestack:=symtablestack;
  670. end;
  671. procedure loadunits;
  672. var
  673. s,sorg : stringid;
  674. pu,
  675. hp : tused_unit;
  676. hp2 : tmodule;
  677. hp3 : psymtable;
  678. oldprocsym:Pprocsym;
  679. unitsym : punitsym;
  680. begin
  681. oldprocsym:=aktprocsym;
  682. consume(_USES);
  683. {$ifdef DEBUG}
  684. test_symtablestack;
  685. {$endif DEBUG}
  686. repeat
  687. s:=pattern;
  688. sorg:=orgpattern;
  689. consume(_ID);
  690. { Give a warning if objpas is loaded }
  691. if s='OBJPAS' then
  692. Message(parser_w_no_objpas_use_mode);
  693. { check if the unit is already used }
  694. pu:=tused_unit(current_module.used_units.first);
  695. while assigned(pu) do
  696. begin
  697. if (pu.name^=s) then
  698. break;
  699. pu:=tused_unit(pu.next);
  700. end;
  701. { avoid uses of itself }
  702. if not assigned(pu) and (s<>current_module.modulename^) then
  703. begin
  704. { load the unit }
  705. hp2:=loadunit(s,false);
  706. { the current module uses the unit hp2 }
  707. current_module.used_units.concat(tused_unit.create(hp2,not current_module.in_implementation));
  708. tused_unit(current_module.used_units.last).in_uses:=true;
  709. if current_module.compiled then
  710. exit;
  711. unitsym:=new(punitsym,init(sorg,hp2.globalsymtable));
  712. { never claim about unused unit if
  713. there is init or finalize code PM }
  714. if (hp2.flags and (uf_init or uf_finalize))<>0 then
  715. inc(unitsym^.refs);
  716. refsymtable^.insert(unitsym);
  717. end
  718. else
  719. Message1(sym_e_duplicate_id,s);
  720. if token=_COMMA then
  721. begin
  722. pattern:='';
  723. consume(_COMMA);
  724. end
  725. else
  726. break;
  727. until false;
  728. consume(_SEMICOLON);
  729. { set the symtable to systemunit so it gets reorderd correctly }
  730. symtablestack:=defaultsymtablestack;
  731. { now insert the units in the symtablestack }
  732. hp:=tused_unit(current_module.used_units.first);
  733. while assigned(hp) do
  734. begin
  735. {$IfDef GDB}
  736. if (cs_debuginfo in aktmoduleswitches) and
  737. (cs_gdb_dbx in aktglobalswitches) and
  738. not hp.is_stab_written then
  739. begin
  740. punitsymtable(hp.u.globalsymtable)^.concattypestabto(debuglist);
  741. hp.is_stab_written:=true;
  742. hp.unitid:=psymtable(hp.u.globalsymtable)^.unitid;
  743. end;
  744. {$EndIf GDB}
  745. if hp.in_uses then
  746. begin
  747. hp3:=symtablestack;
  748. while assigned(hp3) do
  749. begin
  750. { insert units only once ! }
  751. if hp.u.globalsymtable=hp3 then
  752. break;
  753. hp3:=hp3^.next;
  754. { unit isn't inserted }
  755. if hp3=nil then
  756. begin
  757. psymtable(hp.u.globalsymtable)^.next:=symtablestack;
  758. symtablestack:=psymtable(hp.u.globalsymtable);
  759. {$ifdef CHAINPROCSYMS}
  760. symtablestack^.chainprocsyms;
  761. {$endif CHAINPROCSYMS}
  762. {$ifdef DEBUG}
  763. test_symtablestack;
  764. {$endif DEBUG}
  765. end;
  766. end;
  767. end;
  768. hp:=tused_unit(hp.next);
  769. end;
  770. aktprocsym:=oldprocsym;
  771. end;
  772. procedure write_gdb_info;
  773. {$IfDef GDB}
  774. var
  775. hp : tused_unit;
  776. begin
  777. if not (cs_debuginfo in aktmoduleswitches) then
  778. exit;
  779. if (cs_gdb_dbx in aktglobalswitches) then
  780. begin
  781. debugList.concat(Tai_asm_comment.Create(strpnew('EINCL of global '+
  782. punitsymtable(current_module.globalsymtable)^.name^+' has index '+
  783. tostr(punitsymtable(current_module.globalsymtable)^.unitid))));
  784. debugList.concat(Tai_stabs.Create(strpnew('"'+
  785. punitsymtable(current_module.globalsymtable)^.name^+'",'+
  786. tostr(N_EINCL)+',0,0,0')));
  787. punitsymtable(current_module.globalsymtable)^.dbx_count_ok:={true}false;
  788. dbx_counter:=punitsymtable(current_module.globalsymtable)^.prev_dbx_counter;
  789. do_count_dbx:=false;
  790. end;
  791. { now insert the units in the symtablestack }
  792. hp:=tused_unit(current_module.used_units.first);
  793. while assigned(hp) do
  794. begin
  795. if (cs_debuginfo in aktmoduleswitches) and
  796. not hp.is_stab_written then
  797. begin
  798. punitsymtable(hp.u.globalsymtable)^.concattypestabto(debuglist);
  799. hp.is_stab_written:=true;
  800. hp.unitid:=psymtable(hp.u.globalsymtable)^.unitid;
  801. end;
  802. hp:=tused_unit(hp.next);
  803. end;
  804. if current_module.in_implementation and
  805. assigned(current_module.localsymtable) then
  806. begin
  807. { all types }
  808. punitsymtable(current_module.localsymtable)^.concattypestabto(debuglist);
  809. { and all local symbols}
  810. punitsymtable(current_module.localsymtable)^.concatstabto(debuglist);
  811. end
  812. else if assigned(current_module.globalsymtable) then
  813. begin
  814. { all types }
  815. punitsymtable(current_module.globalsymtable)^.concattypestabto(debuglist);
  816. { and all local symbols}
  817. punitsymtable(current_module.globalsymtable)^.concatstabto(debuglist);
  818. end;
  819. end;
  820. {$Else GDB}
  821. begin
  822. end;
  823. {$EndIf GDB}
  824. procedure parse_implementation_uses(symt:Psymtable);
  825. begin
  826. if token=_USES then
  827. begin
  828. symt^.symtabletype:=unitsymtable;
  829. loadunits;
  830. symt^.symtabletype:=globalsymtable;
  831. {$ifdef DEBUG}
  832. test_symtablestack;
  833. {$endif DEBUG}
  834. end;
  835. end;
  836. procedure setupglobalswitches;
  837. begin
  838. { can't have local browser when no global browser }
  839. if (cs_local_browser in aktmoduleswitches) and
  840. not(cs_browser in aktmoduleswitches) then
  841. exclude(aktmoduleswitches,cs_local_browser);
  842. { define a symbol in delphi,objfpc,tp,gpc mode }
  843. if (m_delphi in aktmodeswitches) then
  844. current_scanner^.def_macro('FPC_DELPHI')
  845. else
  846. if (m_tp in aktmodeswitches) then
  847. current_scanner^.def_macro('FPC_TP')
  848. else
  849. if (m_objfpc in aktmodeswitches) then
  850. current_scanner^.def_macro('FPC_OBJFPC')
  851. else
  852. if (m_gpc in aktmodeswitches) then
  853. current_scanner^.def_macro('FPC_GPC');
  854. end;
  855. procedure gen_main_procsym(const name:string;options:tproctypeoption;st:psymtable);
  856. var
  857. stt : psymtable;
  858. begin
  859. {Generate a procsym for main}
  860. make_ref:=false;
  861. aktprocsym:=new(Pprocsym,init('$'+name));
  862. { main are allways used }
  863. inc(aktprocsym^.refs);
  864. {Try to insert in in static symtable ! }
  865. stt:=symtablestack;
  866. symtablestack:=st;
  867. aktprocsym^.definition:=new(Pprocdef,init);
  868. symtablestack:=stt;
  869. aktprocsym^.definition^.proctypeoption:=options;
  870. aktprocsym^.definition^.setmangledname(target_os.cprefix+name);
  871. aktprocsym^.definition^.forwarddef:=false;
  872. make_ref:=true;
  873. { The localst is a local symtable. Change it into the static
  874. symtable }
  875. dispose(aktprocsym^.definition^.localst,done);
  876. aktprocsym^.definition^.localst:=st;
  877. { and insert the procsym in symtable }
  878. st^.insert(aktprocsym);
  879. { set some informations about the main program }
  880. with procinfo^ do
  881. begin
  882. returntype.setdef(voiddef);
  883. _class:=nil;
  884. para_offset:=8;
  885. framepointer:=frame_pointer;
  886. flags:=0;
  887. end;
  888. end;
  889. procedure proc_unit;
  890. function is_assembler_generated:boolean;
  891. begin
  892. is_assembler_generated:=(Errorcount=0) and
  893. not(
  894. codeSegment.empty and
  895. dataSegment.empty and
  896. bssSegment.empty and
  897. ((importssection=nil) or importsSection.empty) and
  898. ((resourcesection=nil) or resourceSection.empty) and
  899. ((resourcestringlist=nil) or resourcestringList.empty)
  900. );
  901. end;
  902. var
  903. main_file: tinputfile;
  904. st : psymtable;
  905. unitst : punitsymtable;
  906. {$ifdef GDB}
  907. pu : tused_unit;
  908. {$endif GDB}
  909. store_crc,store_interface_crc : longint;
  910. s2 : ^string; {Saves stack space}
  911. force_init_final : boolean;
  912. begin
  913. consume(_UNIT);
  914. if token=_ID then
  915. begin
  916. { create filenames and unit name }
  917. main_file := current_scanner^.inputfile;
  918. while assigned(main_file.next) do
  919. main_file := main_file.next;
  920. current_module.SetFileName(main_file.path^+main_file.name^,true);
  921. stringdispose(current_module.modulename);
  922. stringdispose(current_module.realmodulename);
  923. current_module.modulename:=stringdup(pattern);
  924. current_module.realmodulename:=stringdup(orgpattern);
  925. { check for system unit }
  926. new(s2);
  927. s2^:=upper(SplitName(main_file.name^));
  928. if (cs_compilesystem in aktmoduleswitches) then
  929. begin
  930. if ((length(current_module.modulename^)>8) or
  931. (current_module.modulename^<>'SYSTEM') or
  932. (current_module.modulename^<>s2^)) then
  933. Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
  934. end
  935. else
  936. begin
  937. if (cs_check_unit_name in aktglobalswitches) and
  938. not((current_module.modulename^=s2^) or
  939. ((length(current_module.modulename^)>8) and
  940. (copy(current_module.modulename^,1,8)=s2^))) then
  941. Message1(unit_e_illegal_unit_name,current_module.realmodulename^);
  942. if (current_module.modulename^='SYSTEM') then
  943. Message(unit_w_switch_us_missed);
  944. end;
  945. dispose(s2);
  946. end;
  947. consume(_ID);
  948. consume(_SEMICOLON);
  949. consume(_INTERFACE);
  950. { global switches are read, so further changes aren't allowed }
  951. current_module.in_global:=false;
  952. { handle the global switches }
  953. setupglobalswitches;
  954. Message1(unit_u_start_parse_interface,current_module.realmodulename^);
  955. { update status }
  956. status.currentmodule:=current_module.realmodulename^;
  957. { maybe turn off m_objpas if we are compiling objpas }
  958. if (current_module.modulename^='OBJPAS') then
  959. aktmodeswitches:=aktmodeswitches-[m_objpas];
  960. { this should be placed after uses !!}
  961. {$ifndef UseNiceNames}
  962. procprefix:='_'+current_module.modulename^+'$$';
  963. {$else UseNiceNames}
  964. procprefix:='_'+tostr(length(current_module.modulename^))+lowercase(current_module.modulename^)+'_';
  965. {$endif UseNiceNames}
  966. parse_only:=true;
  967. { generate now the global symboltable }
  968. st:=new(punitsymtable,init(globalsymtable,current_module.modulename^));
  969. refsymtable:=st;
  970. unitst:=punitsymtable(st);
  971. { define first as local to overcome dependency conflicts }
  972. current_module.localsymtable:=st;
  973. { the unit name must be usable as a unit specifier }
  974. { inside the unit itself (PM) }
  975. { this also forbids to have another symbol }
  976. { with the same name as the unit }
  977. refsymtable^.insert(new(punitsym,init(current_module.realmodulename^,unitst)));
  978. { a unit compiled at command line must be inside the loaded_unit list }
  979. if (compile_level=1) then
  980. loaded_units.insert(current_module);
  981. { load default units, like the system unit }
  982. loaddefaultunits;
  983. { reset }
  984. make_ref:=true;
  985. lexlevel:=0;
  986. { insert qualifier for the system unit (allows system.writeln) }
  987. if not(cs_compilesystem in aktmoduleswitches) then
  988. begin
  989. if token=_USES then
  990. begin
  991. unitst^.symtabletype:=unitsymtable;
  992. loadunits;
  993. { has it been compiled at a higher level ?}
  994. if current_module.compiled then
  995. begin
  996. { this unit symtable is obsolete }
  997. { dispose(unitst,done);
  998. disposed as localsymtable !! }
  999. RestoreUnitSyms;
  1000. exit;
  1001. end;
  1002. unitst^.symtabletype:=globalsymtable;
  1003. end;
  1004. { ... but insert the symbol table later }
  1005. st^.next:=symtablestack;
  1006. symtablestack:=st;
  1007. end
  1008. else
  1009. { while compiling a system unit, some types are directly inserted }
  1010. begin
  1011. st^.next:=symtablestack;
  1012. symtablestack:=st;
  1013. insert_intern_types(st);
  1014. end;
  1015. { now we know the place to insert the constants }
  1016. constsymtable:=symtablestack;
  1017. { move the global symtab from the temporary local to global }
  1018. current_module.globalsymtable:=current_module.localsymtable;
  1019. current_module.localsymtable:=nil;
  1020. reset_global_defs;
  1021. { number all units, so we know if a unit is used by this unit or
  1022. needs to be added implicitly }
  1023. numberunits;
  1024. { ... parse the declarations }
  1025. Message1(parser_u_parsing_interface,current_module.realmodulename^);
  1026. read_interface_declarations;
  1027. { leave when we got an error }
  1028. if (Errorcount>0) and not status.skip_error then
  1029. begin
  1030. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1031. status.skip_error:=true;
  1032. exit;
  1033. end;
  1034. {else in inteface its somatimes necessary even if unused
  1035. st^.allunitsused; }
  1036. {$ifdef New_GDB}
  1037. write_gdb_info;
  1038. {$endIf Def New_GDB}
  1039. if not(cs_compilesystem in aktmoduleswitches) then
  1040. if (Errorcount=0) then
  1041. writeunitas(current_module.ppufilename^,punitsymtable(symtablestack),true);
  1042. { Parse the implementation section }
  1043. consume(_IMPLEMENTATION);
  1044. current_module.in_implementation:=true;
  1045. Message1(unit_u_start_parse_implementation,current_module.modulename^);
  1046. parse_only:=false;
  1047. { generates static symbol table }
  1048. st:=new(punitsymtable,init(staticsymtable,current_module.modulename^));
  1049. current_module.localsymtable:=st;
  1050. { remove the globalsymtable from the symtable stack }
  1051. { to reinsert it after loading the implementation units }
  1052. symtablestack:=unitst^.next;
  1053. { we don't want implementation units symbols in unitsymtable !! PM }
  1054. refsymtable:=st;
  1055. { Read the implementation units }
  1056. parse_implementation_uses(unitst);
  1057. if current_module.compiled then
  1058. begin
  1059. RestoreUnitSyms;
  1060. exit;
  1061. end;
  1062. { reset ranges/stabs in exported definitions }
  1063. reset_global_defs;
  1064. { All units are read, now give them a number }
  1065. numberunits;
  1066. { now we can change refsymtable }
  1067. refsymtable:=st;
  1068. { but reinsert the global symtable as lasts }
  1069. unitst^.next:=symtablestack;
  1070. symtablestack:=unitst;
  1071. {$ifndef DONOTCHAINOPERATORS}
  1072. pstoredsymtable(symtablestack)^.chainoperators;
  1073. {$endif DONOTCHAINOPERATORS}
  1074. {$ifdef DEBUG}
  1075. test_symtablestack;
  1076. {$endif DEBUG}
  1077. constsymtable:=symtablestack;
  1078. {$ifdef Splitheap}
  1079. if testsplit then
  1080. begin
  1081. Split_Heap;
  1082. allow_special:=true;
  1083. Switch_to_temp_heap;
  1084. end;
  1085. { it will report all crossings }
  1086. allow_special:=false;
  1087. {$endif Splitheap}
  1088. Message1(parser_u_parsing_implementation,current_module.realmodulename^);
  1089. { Compile the unit }
  1090. codegen_newprocedure;
  1091. gen_main_procsym(current_module.modulename^+'_init',potype_unitinit,st);
  1092. aktprocsym^.definition^.aliasnames.insert('INIT$$'+current_module.modulename^);
  1093. aktprocsym^.definition^.aliasnames.insert(target_os.cprefix+current_module.modulename^+'_init');
  1094. compile_proc_body(true,false);
  1095. codegen_doneprocedure;
  1096. { avoid self recursive destructor call !! PM }
  1097. aktprocsym^.definition^.localst:=nil;
  1098. { if the unit contains ansi/widestrings, initialization and
  1099. finalization code must be forced }
  1100. force_init_final:=needs_init_final(current_module.globalsymtable)
  1101. or needs_init_final(current_module.localsymtable);
  1102. { should we force unit initialization? }
  1103. { this is a hack, but how can it be done better ? }
  1104. if force_init_final and ((current_module.flags and uf_init)=0) then
  1105. begin
  1106. current_module.flags:=current_module.flags or uf_init;
  1107. { now we can insert a cut }
  1108. if (cs_create_smart in aktmoduleswitches) then
  1109. codeSegment.concat(Tai_cut.Create);
  1110. genimplicitunitinit(codesegment);
  1111. end;
  1112. { finalize? }
  1113. if token=_FINALIZATION then
  1114. begin
  1115. { set module options }
  1116. current_module.flags:=current_module.flags or uf_finalize;
  1117. { Compile the finalize }
  1118. codegen_newprocedure;
  1119. gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
  1120. aktprocsym^.definition^.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
  1121. aktprocsym^.definition^.aliasnames.insert(target_os.cprefix+current_module.modulename^+'_finalize');
  1122. compile_proc_body(true,false);
  1123. codegen_doneprocedure;
  1124. end
  1125. else if force_init_final then
  1126. begin
  1127. current_module.flags:=current_module.flags or uf_finalize;
  1128. { now we can insert a cut }
  1129. if (cs_create_smart in aktmoduleswitches) then
  1130. codeSegment.concat(Tai_cut.Create);
  1131. genimplicitunitfinal(codesegment);
  1132. end;
  1133. { the last char should always be a point }
  1134. consume(_POINT);
  1135. If ResourceStrings.ResStrCount>0 then
  1136. begin
  1137. ResourceStrings.CreateResourceStringList;
  1138. current_module.flags:=current_module.flags or uf_has_resources;
  1139. { only write if no errors found }
  1140. if (Errorcount=0) then
  1141. ResourceStrings.WriteResourceFile(current_module.ModuleName^);
  1142. end;
  1143. { avoid self recursive destructor call !! PM }
  1144. aktprocsym^.definition^.localst:=nil;
  1145. { absence does not matter here !! }
  1146. aktprocsym^.definition^.forwarddef:=false;
  1147. { test static symtable }
  1148. if (Errorcount=0) then
  1149. begin
  1150. pstoredsymtable(st)^.allsymbolsused;
  1151. pstoredsymtable(st)^.allunitsused;
  1152. pstoredsymtable(st)^.allprivatesused;
  1153. end;
  1154. { size of the static data }
  1155. datasize:=st^.datasize;
  1156. {$ifdef GDB}
  1157. { add all used definitions even for implementation}
  1158. if (cs_debuginfo in aktmoduleswitches) then
  1159. begin
  1160. {$IfnDef New_GDB}
  1161. if assigned(current_module.globalsymtable) then
  1162. begin
  1163. { all types }
  1164. punitsymtable(current_module.globalsymtable)^.concattypestabto(debuglist);
  1165. { and all local symbols}
  1166. punitsymtable(current_module.globalsymtable)^.concatstabto(debuglist);
  1167. end;
  1168. { all local types }
  1169. punitsymtable(st)^.concattypestabto(debuglist);
  1170. { and all local symbols}
  1171. st^.concatstabto(debuglist);
  1172. {$else New_GDB}
  1173. write_gdb_info;
  1174. {$endIf Def New_GDB}
  1175. end;
  1176. {$endif GDB}
  1177. reset_global_defs;
  1178. { tests, if all (interface) forwards are resolved }
  1179. if (Errorcount=0) then
  1180. begin
  1181. pstoredsymtable(symtablestack)^.check_forwards;
  1182. pstoredsymtable(symtablestack)^.allprivatesused;
  1183. end;
  1184. { now we have a correct unit, change the symtable type }
  1185. current_module.in_implementation:=false;
  1186. symtablestack^.symtabletype:=unitsymtable;
  1187. {$ifdef GDB}
  1188. punitsymtable(symtablestack)^.is_stab_written:=false;
  1189. {$endif GDB}
  1190. { leave when we got an error }
  1191. if (Errorcount>0) and not status.skip_error then
  1192. begin
  1193. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1194. status.skip_error:=true;
  1195. closecurrentppu;
  1196. exit;
  1197. end;
  1198. { generate imports }
  1199. if current_module.uses_imports then
  1200. importlib.generatelib;
  1201. { insert own objectfile, or say that it's in a library
  1202. (no check for an .o when loading) }
  1203. if is_assembler_generated then
  1204. insertobjectfile
  1205. else
  1206. current_module.flags:=current_module.flags or uf_no_link;
  1207. if cs_local_browser in aktmoduleswitches then
  1208. current_module.localsymtable:=refsymtable;
  1209. { Write out the ppufile }
  1210. store_interface_crc:=current_module.interface_crc;
  1211. store_crc:=current_module.crc;
  1212. if (Errorcount=0) then
  1213. writeunitas(current_module.ppufilename^,punitsymtable(symtablestack),false);
  1214. if not(cs_compilesystem in aktmoduleswitches) then
  1215. if store_interface_crc<>current_module.interface_crc then
  1216. Comment(V_Warning,current_module.ppufilename^+' Interface CRC changed '+
  1217. tostr(store_crc)+'<>'+tostr(current_module.interface_crc));
  1218. {$ifdef EXTDEBUG}
  1219. if not(cs_compilesystem in aktmoduleswitches) then
  1220. if (store_crc<>current_module.crc) and simplify_ppu then
  1221. Comment(V_Warning,current_module.ppufilename^+' implementation CRC changed '+
  1222. tostr(store_crc)+'<>'+tostr(current_module.interface_crc));
  1223. {$endif EXTDEBUG}
  1224. { must be done only after local symtable ref stores !! }
  1225. closecurrentppu;
  1226. {$ifdef GDB}
  1227. pu:=tused_unit(usedunits.first);
  1228. while assigned(pu) do
  1229. begin
  1230. if assigned(pu.u.globalsymtable) then
  1231. punitsymtable(pu.u.globalsymtable)^.is_stab_written:=false;
  1232. pu:=tused_unit(pu.next);
  1233. end;
  1234. {$endif GDB}
  1235. { remove static symtable (=refsymtable) here to save some mem }
  1236. if not (cs_local_browser in aktmoduleswitches) then
  1237. begin
  1238. dispose(st,done);
  1239. current_module.localsymtable:=nil;
  1240. end;
  1241. RestoreUnitSyms;
  1242. if is_assembler_generated then
  1243. begin
  1244. { finish asmlist by adding segment starts }
  1245. insertsegment;
  1246. { assemble }
  1247. create_objectfile;
  1248. end;
  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. end;
  1257. procedure proc_program(islibrary : boolean);
  1258. var
  1259. main_file: tinputfile;
  1260. st : psymtable;
  1261. hp : tmodule;
  1262. begin
  1263. DLLsource:=islibrary;
  1264. IsExe:=true;
  1265. parse_only:=false;
  1266. { relocation works only without stabs under win32 !! PM }
  1267. { internal assembler uses rva for stabs info
  1268. so it should work with relocated DLLs }
  1269. if RelocSection and
  1270. (target_info.target=target_i386_win32) and
  1271. (target_info.assem<>as_i386_pecoff) then
  1272. begin
  1273. aktglobalswitches:=aktglobalswitches+[cs_link_strip];
  1274. { Warning stabs info does not work with reloc section !! }
  1275. if cs_debuginfo in aktmoduleswitches then
  1276. begin
  1277. Message1(parser_w_parser_reloc_no_debug,current_module.mainsource^);
  1278. Message(parser_w_parser_win32_debug_needs_WN);
  1279. aktmoduleswitches:=aktmoduleswitches-[cs_debuginfo];
  1280. end;
  1281. end;
  1282. { get correct output names }
  1283. main_file := current_scanner^.inputfile;
  1284. while assigned(main_file.next) do
  1285. main_file := main_file.next;
  1286. current_module.SetFileName(main_file.path^+main_file.name^,true);
  1287. if islibrary then
  1288. begin
  1289. consume(_LIBRARY);
  1290. stringdispose(current_module.modulename);
  1291. current_module.modulename:=stringdup(pattern);
  1292. current_module.islibrary:=true;
  1293. exportlib.preparelib(pattern);
  1294. consume(_ID);
  1295. consume(_SEMICOLON);
  1296. end
  1297. else
  1298. { is there an program head ? }
  1299. if token=_PROGRAM then
  1300. begin
  1301. consume(_PROGRAM);
  1302. stringdispose(current_module.modulename);
  1303. stringdispose(current_module.realmodulename);
  1304. current_module.modulename:=stringdup(pattern);
  1305. current_module.realmodulename:=stringdup(orgpattern);
  1306. if (target_info.target=target_i386_WIN32) then
  1307. exportlib.preparelib(pattern);
  1308. consume(_ID);
  1309. if token=_LKLAMMER then
  1310. begin
  1311. consume(_LKLAMMER);
  1312. idlist;
  1313. consume(_RKLAMMER);
  1314. end;
  1315. consume(_SEMICOLON);
  1316. end
  1317. else if (target_info.target=target_i386_WIN32) then
  1318. exportlib.preparelib(current_module.modulename^);
  1319. { global switches are read, so further changes aren't allowed }
  1320. current_module.in_global:=false;
  1321. { setup things using the global switches }
  1322. setupglobalswitches;
  1323. { set implementation flag }
  1324. current_module.in_implementation:=true;
  1325. { insert after the unit symbol tables the static symbol table }
  1326. { of the program }
  1327. st:=new(punitsymtable,init(staticsymtable,current_module.modulename^));
  1328. current_module.localsymtable:=st;
  1329. symtablestack:=st;
  1330. refsymtable:=st;
  1331. { necessary for browser }
  1332. loaded_units.insert(current_module);
  1333. { load standard units (system,objpas,profile unit) }
  1334. loaddefaultunits;
  1335. { reset }
  1336. lexlevel:=0;
  1337. {Load the units used by the program we compile.}
  1338. if token=_USES then
  1339. loadunits;
  1340. {$ifndef DONOTCHAINOPERATORS}
  1341. pstoredsymtable(symtablestack)^.chainoperators;
  1342. {$endif DONOTCHAINOPERATORS}
  1343. { reset ranges/stabs in exported definitions }
  1344. reset_global_defs;
  1345. { All units are read, now give them a number }
  1346. numberunits;
  1347. {Insert the name of the main program into the symbol table.}
  1348. if current_module.realmodulename^<>'' then
  1349. st^.insert(new(punitsym,init(current_module.realmodulename^,punitsymtable(st))));
  1350. { ...is also constsymtable, this is the symtable where }
  1351. { the elements of enumeration types are inserted }
  1352. constsymtable:=st;
  1353. Message1(parser_u_parsing_implementation,current_module.mainsource^);
  1354. { reset }
  1355. procprefix:='';
  1356. {The program intialization needs an alias, so it can be called
  1357. from the bootstrap code.}
  1358. codegen_newprocedure;
  1359. gen_main_procsym('main',potype_proginit,st);
  1360. aktprocsym^.definition^.aliasnames.insert('program_init');
  1361. aktprocsym^.definition^.aliasnames.insert('PASCALMAIN');
  1362. aktprocsym^.definition^.aliasnames.insert(target_os.cprefix+'main');
  1363. {$ifdef m68k}
  1364. if target_info.target=target_m68k_PalmOS then
  1365. aktprocsym^.definition^.aliasnames.insert('PilotMain');
  1366. {$endif m68k}
  1367. compile_proc_body(true,false);
  1368. { avoid self recursive destructor call !! PM }
  1369. aktprocsym^.definition^.localst:=nil;
  1370. { consider these symbols as global ones }
  1371. { for browser }
  1372. current_module.globalsymtable:=current_module.localsymtable;
  1373. current_module.localsymtable:=nil;
  1374. If ResourceStrings.ResStrCount>0 then
  1375. begin
  1376. ResourceStrings.CreateResourceStringList;
  1377. { only write if no errors found }
  1378. if (Errorcount=0) then
  1379. ResourceStrings.WriteResourceFile(current_module.ModuleName^);
  1380. end;
  1381. codegen_doneprocedure;
  1382. { finalize? }
  1383. if token=_FINALIZATION then
  1384. begin
  1385. { set module options }
  1386. current_module.flags:=current_module.flags or uf_finalize;
  1387. { Compile the finalize }
  1388. codegen_newprocedure;
  1389. gen_main_procsym(current_module.modulename^+'_finalize',potype_unitfinalize,st);
  1390. aktprocsym^.definition^.aliasnames.insert('FINALIZE$$'+current_module.modulename^);
  1391. aktprocsym^.definition^.aliasnames.insert(target_os.cprefix+current_module.modulename^+'_finalize');
  1392. compile_proc_body(true,false);
  1393. codegen_doneprocedure;
  1394. end;
  1395. { consume the last point }
  1396. consume(_POINT);
  1397. {$ifdef New_GDB}
  1398. write_gdb_info;
  1399. {$endIf Def New_GDB}
  1400. { leave when we got an error }
  1401. if (Errorcount>0) and not status.skip_error then
  1402. begin
  1403. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1404. status.skip_error:=true;
  1405. exit;
  1406. end;
  1407. { test static symtable }
  1408. if (Errorcount=0) then
  1409. begin
  1410. pstoredsymtable(st)^.allsymbolsused;
  1411. pstoredsymtable(st)^.allunitsused;
  1412. pstoredsymtable(st)^.allprivatesused;
  1413. end;
  1414. { generate imports }
  1415. if current_module.uses_imports then
  1416. importlib.generatelib;
  1417. if islibrary or
  1418. (target_info.target=target_i386_WIN32) then
  1419. exportlib.generatelib;
  1420. { insert heap }
  1421. insertResourceTablesTable;
  1422. insertinitfinaltable;
  1423. insertheap;
  1424. inserttargetspecific;
  1425. datasize:=symtablestack^.datasize;
  1426. { finish asmlist by adding segment starts }
  1427. insertsegment;
  1428. { insert own objectfile }
  1429. insertobjectfile;
  1430. { assemble and link }
  1431. create_objectfile;
  1432. { leave when we got an error }
  1433. if (Errorcount>0) and not status.skip_error then
  1434. begin
  1435. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1436. status.skip_error:=true;
  1437. exit;
  1438. end;
  1439. { create the executable when we are at level 1 }
  1440. if (compile_level=1) then
  1441. begin
  1442. { insert all .o files from all loaded units }
  1443. hp:=tmodule(loaded_units.first);
  1444. while assigned(hp) do
  1445. begin
  1446. linker.AddModuleFiles(hp);
  1447. hp:=tmodule(hp.next);
  1448. end;
  1449. { write .def file }
  1450. if (cs_link_deffile in aktglobalswitches) then
  1451. deffile.writefile;
  1452. { finally we can create a executable }
  1453. if (not current_module.is_unit) then
  1454. begin
  1455. if DLLSource then
  1456. linker.MakeSharedLibrary
  1457. else
  1458. linker.MakeExecutable;
  1459. end;
  1460. end;
  1461. end;
  1462. end.
  1463. {
  1464. $Log$
  1465. Revision 1.20 2000-12-25 00:07:27 peter
  1466. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  1467. tlinkedlist objects)
  1468. Revision 1.19 2000/11/29 00:30:36 florian
  1469. * unused units removed from uses clause
  1470. * some changes for widestrings
  1471. Revision 1.18 2000/11/01 23:04:37 peter
  1472. * tprocdef.fullprocname added for better casesensitve writing of
  1473. procedures
  1474. Revision 1.17 2000/10/31 22:02:50 peter
  1475. * symtable splitted, no real code changes
  1476. Revision 1.16 2000/10/21 14:36:26 peter
  1477. * merged pierres fixes
  1478. Revision 1.15 2000/10/15 09:08:58 peter
  1479. * use System for the systemunit instead of target dependent
  1480. Revision 1.14 2000/10/15 07:47:51 peter
  1481. * unit names and procedure names are stored mixed case
  1482. Revision 1.13 2000/10/04 14:51:08 pierre
  1483. * IsExe restored
  1484. Revision 1.12 2000/09/30 16:07:40 peter
  1485. * filepos when unit not found (merged)
  1486. Revision 1.11 2000/09/24 21:33:47 peter
  1487. * message updates merges
  1488. Revision 1.10 2000/09/24 15:06:22 peter
  1489. * use defines.inc
  1490. Revision 1.9 2000/08/31 07:53:02 michael
  1491. + Applied patch from Peter
  1492. Revision 1.8 2000/08/29 19:00:01 peter
  1493. * _init and _finalize procsyms also need a $ prefix
  1494. Revision 1.7 2000/08/27 20:19:39 peter
  1495. * store strings with case in ppu, when an internal symbol is created
  1496. a '$' is prefixed so it's not automatic uppercased
  1497. Revision 1.6 2000/08/27 16:11:52 peter
  1498. * moved some util functions from globals,cobjects to cutils
  1499. * splitted files into finput,fmodule
  1500. Revision 1.5 2000/08/25 08:48:22 jonas
  1501. * fixed bug with include files at the very beginning of .pp/.pas files
  1502. (wrong name used for generating exe/checking unit name) (merged from
  1503. fixes branch)
  1504. Revision 1.4 2000/08/21 11:27:44 pierre
  1505. * fix the stabs problems
  1506. Revision 1.3 2000/07/13 12:08:26 michael
  1507. + patched to 1.1.0 with former 1.09patch from peter
  1508. Revision 1.2 2000/07/13 11:32:45 michael
  1509. + removed logs
  1510. }