pmodules.pas 55 KB

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