pmodules.pas 66 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934
  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. {$define New_GDB}
  20. interface
  21. procedure proc_unit;
  22. procedure proc_program(islibrary : boolean);
  23. implementation
  24. uses
  25. globtype,version,systems,tokens,
  26. cobjects,comphook,globals,verbose,files,
  27. symconst,symtable,aasm,hcodegen,
  28. link,assemble,import,export,gendef,ppu,comprsrc,
  29. cresstr,cpubase,cpuasm,
  30. scanner,pbase,psystem,pdecl,psub,parser;
  31. procedure create_objectfile;
  32. begin
  33. { create the .s file and assemble it }
  34. GenerateAsm(false);
  35. { Also create a smartlinked version ? }
  36. if (cs_smartlink in aktmoduleswitches) then
  37. begin
  38. GenerateAsm(true);
  39. if target_asm.needar then
  40. Linker.MakeStaticLibrary(SmartLinkFilesCnt);
  41. end;
  42. { resource files }
  43. CompileResourceFiles;
  44. end;
  45. procedure insertobjectfile;
  46. { Insert the used object file for this unit in the used list for this unit }
  47. begin
  48. current_module^.linkunitofiles.insert(current_module^.objfilename^,link_static);
  49. current_module^.flags:=current_module^.flags or uf_static_linked;
  50. if (cs_smartlink in aktmoduleswitches) then
  51. begin
  52. current_module^.linkunitstaticlibs.insert(current_module^.staticlibfilename^,link_smart);
  53. current_module^.flags:=current_module^.flags or uf_smart_linked;
  54. end;
  55. end;
  56. procedure insertsegment;
  57. procedure fixseg(p:paasmoutput;sec:tsection);
  58. begin
  59. p^.insert(new(pai_section,init(sec)));
  60. if (cs_smartlink in aktmoduleswitches) then
  61. p^.insert(new(pai_cut,init));
  62. p^.concat(new(pai_section,init(sec_none)));
  63. end;
  64. begin
  65. {Insert Ident of the compiler}
  66. if (not (cs_smartlink in aktmoduleswitches))
  67. {$ifndef EXTDEBUG}
  68. and (not current_module^.is_unit)
  69. {$endif}
  70. then
  71. begin
  72. datasegment^.insert(new(pai_align,init(4)));
  73. datasegment^.insert(new(pai_string,init('FPC '+full_version_string+
  74. ' for '+target_cpu_string+' - '+target_info.short_name)));
  75. end;
  76. { Insert start and end of sections }
  77. fixseg(codesegment,sec_code);
  78. fixseg(datasegment,sec_data);
  79. fixseg(bsssegment,sec_bss);
  80. { we should use .rdata section for these two no ? }
  81. { .rdata is a read only data section (PM) }
  82. fixseg(rttilist,sec_data);
  83. fixseg(consts,sec_data);
  84. if assigned(resourcestringlist) then
  85. fixseg(resourcestringlist,sec_data);
  86. {$ifdef GDB}
  87. if assigned(debuglist) then
  88. fixseg(debuglist,sec_code);
  89. {$endif GDB}
  90. end;
  91. procedure InsertInitFinalTable;
  92. var
  93. hp : pused_unit;
  94. unitinits : taasmoutput;
  95. count : longint;
  96. begin
  97. unitinits.init;
  98. count:=0;
  99. hp:=pused_unit(usedunits.first);
  100. while assigned(hp) do
  101. begin
  102. { call the unit init code and make it external }
  103. if (hp^.u^.flags and (uf_init or uf_finalize))<>0 then
  104. begin
  105. if (hp^.u^.flags and uf_init)<>0 then
  106. begin
  107. unitinits.concat(new(pai_const_symbol,initname('INIT$$'+hp^.u^.modulename^)));
  108. end
  109. else
  110. unitinits.concat(new(pai_const,init_32bit(0)));
  111. if (hp^.u^.flags and uf_finalize)<>0 then
  112. begin
  113. unitinits.concat(new(pai_const_symbol,initname('FINALIZE$$'+hp^.u^.modulename^)));
  114. end
  115. else
  116. unitinits.concat(new(pai_const,init_32bit(0)));
  117. inc(count);
  118. end;
  119. hp:=Pused_unit(hp^.next);
  120. end;
  121. { TableCount,InitCount }
  122. unitinits.insert(new(pai_const,init_32bit(0)));
  123. unitinits.insert(new(pai_const,init_32bit(count)));
  124. unitinits.insert(new(pai_symbol,initname_global('INITFINAL',0)));
  125. unitinits.concat(new(pai_symbol_end,initname('INITFINAL')));
  126. { insert in data segment }
  127. if (cs_smartlink in aktmoduleswitches) then
  128. datasegment^.concat(new(pai_cut,init));
  129. datasegment^.concatlist(@unitinits);
  130. unitinits.done;
  131. end;
  132. procedure insertheap;
  133. begin
  134. if (cs_smartlink in aktmoduleswitches) then
  135. begin
  136. bsssegment^.concat(new(pai_cut,init));
  137. datasegment^.concat(new(pai_cut,init));
  138. end;
  139. { On the Macintosh Classic M68k Architecture
  140. The Heap variable is simply a POINTER to the
  141. real HEAP. The HEAP must be set up by the RTL
  142. and must store the pointer in this value.
  143. On OS/2 the heap is also intialized by the RTL. We do
  144. not output a pointer }
  145. case target_info.target of
  146. {$ifdef i386}
  147. target_i386_OS2:
  148. ;
  149. {$endif i386}
  150. {$ifdef alpha}
  151. target_alpha_linux:
  152. ;
  153. {$endif alpha}
  154. {$ifdef powerpc}
  155. target_powerpc_linux:
  156. ;
  157. {$endif powerpc}
  158. {$ifdef m68k}
  159. target_m68k_Mac:
  160. bsssegment^.concat(new(pai_datablock,init_global('HEAP',4)));
  161. target_m68k_PalmOS:
  162. ;
  163. {$endif m68k}
  164. else
  165. bsssegment^.concat(new(pai_datablock,init_global('HEAP',heapsize)));
  166. end;
  167. {$ifdef m68k}
  168. if target_info.target<>target_m68k_PalmOS then
  169. begin
  170. datasegment^.concat(new(pai_symbol,init_global('HEAP_SIZE')));
  171. datasegment^.concat(new(pai_const,init_32bit(heapsize)));
  172. end;
  173. {$else m68k}
  174. datasegment^.concat(new(pai_symbol,initname_global('HEAPSIZE',4)));
  175. datasegment^.concat(new(pai_const,init_32bit(heapsize)));
  176. {$endif m68k}
  177. end;
  178. procedure inserttargetspecific;
  179. begin
  180. case target_info.target of
  181. {$ifdef alpha}
  182. target_alpha_linux:
  183. ;
  184. {$endif alpha}
  185. {$ifdef powerpc}
  186. target_powerpc_linux:
  187. ;
  188. {$endif powerpc}
  189. {$ifdef i386}
  190. target_i386_GO32V2 :
  191. begin
  192. { stacksize can be specified }
  193. datasegment^.concat(new(pai_symbol,initname_global('__stklen',4)));
  194. datasegment^.concat(new(pai_const,init_32bit(stacksize)));
  195. end;
  196. target_i386_WIN32 :
  197. begin
  198. { Generate an external entry to be sure that _mainCRTStarup will be
  199. linked, can't use concat_external because those aren't written for
  200. asw (PFV) }
  201. target_link.bindcmd[1]:=target_link.bindcmd[1]+' -d '+deffile.fname;
  202. if DLLsource then
  203. target_link.binders:=2;
  204. if RelocSection then
  205. begin
  206. target_link.linkcmd:=target_link.linkcmd+' --base-file base.$$$';
  207. target_link.bindcmd[1]:=target_link.bindcmd[1]+' --base-file base.$$$';
  208. target_link.binders:=2;
  209. end;
  210. if apptype=at_gui then
  211. begin
  212. target_link.linkcmd:='--subsystem windows '+target_link.linkcmd;
  213. target_link.bindcmd[2]:='--subsystem windows '+target_link.bindcmd[2];
  214. end;
  215. if DLLsource then
  216. begin
  217. target_link.linkcmd:='--dll '+target_link.linkcmd;
  218. target_link.bindcmd[2]:='--dll '+target_link.bindcmd[2];
  219. end;
  220. end;
  221. {$endif i386}
  222. {$ifdef m68k}
  223. target_m68k_Atari :
  224. begin
  225. { stacksize can be specified }
  226. datasegment^.concat(new(pai_symbol,init_global('__stklen',4)));
  227. datasegment^.concat(new(pai_const,init_32bit(stacksize)));
  228. end;
  229. {$endif m68k}
  230. end;
  231. end;
  232. function loadunit(const s : string;compile_system:boolean) : pmodule;forward;
  233. procedure load_usedunits(compile_system:boolean);
  234. var
  235. pu : pused_unit;
  236. loaded_unit : pmodule;
  237. load_refs : boolean;
  238. nextmapentry : longint;
  239. begin
  240. load_refs:=true;
  241. { init the map }
  242. new(current_module^.map);
  243. fillchar(current_module^.map^,sizeof(tunitmap),#0);
  244. {$ifdef NEWMAP}
  245. current_module^.map^[0]:=current_module;
  246. {$endif NEWMAP}
  247. nextmapentry:=1;
  248. { load the used units from interface }
  249. current_module^.in_implementation:=false;
  250. pu:=pused_unit(current_module^.used_units.first);
  251. while assigned(pu) do
  252. begin
  253. if (not pu^.loaded) and (pu^.in_interface) then
  254. begin
  255. loaded_unit:=loadunit(pu^.name^,false);
  256. if current_module^.compiled then
  257. exit;
  258. { register unit in used units }
  259. pu^.u:=loaded_unit;
  260. pu^.loaded:=true;
  261. { doubles are not important for that list PM }
  262. pu^.u^.dependent_units.concat(new(pdependent_unit,init(current_module)));
  263. { need to recompile the current unit ? }
  264. if loaded_unit^.crc<>pu^.checksum then
  265. begin
  266. Message2(unit_u_recompile_crc_change,current_module^.modulename^,pu^.name^);
  267. current_module^.recompile_reason:=rr_crcchanged;
  268. current_module^.do_compile:=true;
  269. dispose(current_module^.map);
  270. current_module^.map:=nil;
  271. exit;
  272. end;
  273. { setup the map entry for deref }
  274. {$ifndef NEWMAP}
  275. current_module^.map^[nextmapentry]:=loaded_unit^.globalsymtable;
  276. {$else NEWMAP}
  277. current_module^.map^[nextmapentry]:=loaded_unit;
  278. {$endif NEWMAP}
  279. inc(nextmapentry);
  280. if nextmapentry>maxunits then
  281. Message(unit_f_too_much_units);
  282. end;
  283. pu:=pused_unit(pu^.next);
  284. end;
  285. { ok, now load the unit }
  286. current_module^.globalsymtable:=new(punitsymtable,loadasunit);
  287. { now only read the implementation part }
  288. current_module^.in_implementation:=true;
  289. { load the used units from implementation }
  290. pu:=pused_unit(current_module^.used_units.first);
  291. while assigned(pu) do
  292. begin
  293. if (not pu^.loaded) and (not pu^.in_interface) then
  294. begin
  295. loaded_unit:=loadunit(pu^.name^,false);
  296. if current_module^.compiled then
  297. exit;
  298. { register unit in used units }
  299. pu^.u:=loaded_unit;
  300. pu^.loaded:=true;
  301. { need to recompile the current unit ? }
  302. if (loaded_unit^.interface_crc<>pu^.interface_checksum) and
  303. not(current_module^.in_second_compile) then
  304. begin
  305. Message2(unit_u_recompile_crc_change,current_module^.modulename^,pu^.name^+' {impl}');
  306. current_module^.recompile_reason:=rr_crcchanged;
  307. current_module^.do_compile:=true;
  308. dispose(current_module^.map);
  309. current_module^.map:=nil;
  310. exit;
  311. end;
  312. { setup the map entry for deref }
  313. {$ifndef NEWMAP}
  314. current_module^.map^[nextmapentry]:=loaded_unit^.globalsymtable;
  315. {$else NEWMAP}
  316. current_module^.map^[nextmapentry]:=loaded_unit;
  317. {$endif NEWMAP}
  318. inc(nextmapentry);
  319. if nextmapentry>maxunits then
  320. Message(unit_f_too_much_units);
  321. end;
  322. pu:=pused_unit(pu^.next);
  323. end;
  324. { load browser info if stored }
  325. if ((current_module^.flags and uf_has_browser)<>0) and load_refs then
  326. punitsymtable(current_module^.globalsymtable)^.load_symtable_refs;
  327. { remove the map, it's not needed anymore }
  328. dispose(current_module^.map);
  329. current_module^.map:=nil;
  330. end;
  331. function loadunit(const s : string;compile_system:boolean) : pmodule;
  332. const
  333. ImplIntf : array[boolean] of string[15]=('interface','implementation');
  334. var
  335. st : punitsymtable;
  336. second_time : boolean;
  337. old_current_ppu : pppufile;
  338. old_current_module,hp,hp2 : pmodule;
  339. name : string;{ necessary because current_module^.mainsource^ is reset in compile !! }
  340. scanner : pscannerfile;
  341. procedure loadppufile;
  342. begin
  343. { load interface section }
  344. if not current_module^.do_compile then
  345. load_interface;
  346. { only load units when we don't recompile }
  347. if not current_module^.do_compile then
  348. load_usedunits(compile_system);
  349. { recompile if set }
  350. if current_module^.do_compile then
  351. begin
  352. { we don't need the ppufile anymore }
  353. if assigned(current_module^.ppufile) then
  354. begin
  355. dispose(current_module^.ppufile,done);
  356. current_module^.ppufile:=nil;
  357. current_ppu:=nil;
  358. end;
  359. { recompile the unit or give a fatal error if sources not available }
  360. if not(current_module^.sources_avail) then
  361. if (not current_module^.search_unit(current_module^.modulename^,true))
  362. and (length(current_module^.modulename^)>8) then
  363. current_module^.search_unit(copy(current_module^.modulename^,1,8),true);
  364. if not(current_module^.sources_avail) then
  365. begin
  366. if current_module^.recompile_reason=rr_noppu then
  367. Message1(unit_f_cant_find_ppu,current_module^.modulename^)
  368. else
  369. Message1(unit_f_cant_compile_unit,current_module^.modulename^);
  370. end
  371. else
  372. begin
  373. if current_module^.in_second_compile then
  374. Message1(parser_d_compiling_second_time,current_module^.modulename^);
  375. current_scanner^.tempcloseinputfile;
  376. name:=current_module^.mainsource^;
  377. if assigned(scanner) then
  378. scanner^.invalid:=true;
  379. compile(name,compile_system);
  380. if (not current_scanner^.invalid) then
  381. current_scanner^.tempopeninputfile;
  382. end;
  383. end
  384. else
  385. begin
  386. { only reassemble ? }
  387. if (current_module^.do_assemble) then
  388. OnlyAsm;
  389. end;
  390. if assigned(current_module^.ppufile) then
  391. begin
  392. dispose(current_module^.ppufile,done);
  393. current_module^.ppufile:=nil;
  394. current_ppu:=nil;
  395. end;
  396. end;
  397. var
  398. dummy : pmodule;
  399. begin
  400. old_current_module:=current_module;
  401. old_current_ppu:=current_ppu;
  402. { Info }
  403. Message3(unit_u_load_unit,current_module^.modulename^,ImplIntf[current_module^.in_implementation],s);
  404. { unit not found }
  405. st:=nil;
  406. { search all loaded units }
  407. hp:=pmodule(loaded_units.first);
  408. while assigned(hp) do
  409. begin
  410. if hp^.modulename^=s then
  411. begin
  412. { forced to reload ? }
  413. if hp^.do_reload then
  414. begin
  415. hp^.do_reload:=false;
  416. break;
  417. end;
  418. { the unit is already registered }
  419. { and this means that the unit }
  420. { is already compiled }
  421. { else there is a cyclic unit use }
  422. if assigned(hp^.globalsymtable) then
  423. st:=punitsymtable(hp^.globalsymtable)
  424. else
  425. begin
  426. { both units in interface ? }
  427. if (not current_module^.in_implementation) and (not hp^.in_implementation) then
  428. begin
  429. { check for a cycle }
  430. hp2:=current_module^.loaded_from;
  431. while assigned(hp2) and (hp2<>hp) do
  432. begin
  433. if hp2^.in_implementation then
  434. hp2:=nil
  435. else
  436. hp2:=hp2^.loaded_from;
  437. end;
  438. if assigned(hp2) then
  439. Message2(unit_f_circular_unit_reference,current_module^.modulename^,hp^.modulename^);
  440. end;
  441. end;
  442. break;
  443. end;
  444. { the next unit }
  445. hp:=pmodule(hp^.next);
  446. end;
  447. { the unit is not in the symtable stack }
  448. if (not assigned(st)) then
  449. begin
  450. if assigned(hp) then
  451. begin
  452. { remove the old unit }
  453. loaded_units.remove(hp);
  454. scanner:=hp^.scanner;
  455. hp^.reset;
  456. hp^.scanner:=scanner;
  457. { try to reopen ppu }
  458. hp^.search_unit(s,false);
  459. { try to load the unit a second time first }
  460. current_module:=hp;
  461. current_module^.in_second_compile:=true;
  462. Message1(unit_u_second_load_unit,current_module^.modulename^);
  463. second_time:=true;
  464. end
  465. else
  466. { generates a new unit info record }
  467. begin
  468. current_module:=new(pmodule,init(s,true));
  469. scanner:=nil;
  470. second_time:=false;
  471. end;
  472. current_ppu:=current_module^.ppufile;
  473. { now we can register the unit }
  474. current_module^.loaded_from:=old_current_module;
  475. loaded_units.insert(current_module);
  476. { now realy load the ppu }
  477. loadppufile;
  478. { set compiled flag }
  479. current_module^.compiled:=true;
  480. { load return pointer }
  481. hp:=current_module;
  482. { for a second_time recompile reload all dependent units,
  483. for a first time compile register the unit _once_ }
  484. if second_time then
  485. begin
  486. { now reload all dependent units }
  487. hp2:=pmodule(loaded_units.first);
  488. while assigned(hp2) do
  489. begin
  490. if hp2^.do_reload then
  491. dummy:=loadunit(hp2^.modulename^,false);
  492. hp2:=pmodule(hp2^.next);
  493. end;
  494. end
  495. else
  496. usedunits.concat(new(pused_unit,init(current_module,true)));
  497. end;
  498. { set the old module }
  499. current_ppu:=old_current_ppu;
  500. current_module:=old_current_module;
  501. loadunit:=hp;
  502. end;
  503. procedure loaddefaultunits;
  504. var
  505. hp : pmodule;
  506. begin
  507. { are we compiling the system unit? }
  508. if (cs_compilesystem in aktmoduleswitches) then
  509. begin
  510. { create system defines }
  511. createconstdefs;
  512. { we don't need to reset anything, it's already done in parser.pas }
  513. exit;
  514. end;
  515. { insert the system unit, it is allways the first }
  516. hp:=loadunit(upper(target_info.system_unit),true);
  517. systemunit:=hp^.globalsymtable;
  518. { it's always the first unit }
  519. systemunit^.next:=nil;
  520. symtablestack:=systemunit;
  521. { add to the used units }
  522. current_module^.used_units.concat(new(pused_unit,init(hp,true)));
  523. refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
  524. { read default constant definitions }
  525. make_ref:=false;
  526. readconstdefs;
  527. make_ref:=true;
  528. { if POWER is defined in the RTL then use it for starstar overloading }
  529. getsym('POWER',false);
  530. if assigned(srsym) and (srsym^.typ=procsym) and (overloaded_operators[_STARSTAR]=nil) then
  531. overloaded_operators[_STARSTAR]:=pprocsym(srsym);
  532. { Objpas unit? }
  533. if m_objpas in aktmodeswitches then
  534. begin
  535. hp:=loadunit('OBJPAS',false);
  536. objpasunit:=hp^.globalsymtable;
  537. { insert in stack }
  538. objpasunit^.next:=symtablestack;
  539. symtablestack:=objpasunit;
  540. { add to the used units }
  541. current_module^.used_units.concat(new(pused_unit,init(hp,true)));
  542. refsymtable^.insert(new(punitsym,init('OBJPAS',objpasunit)));
  543. end
  544. else
  545. objpasunit:=nil;
  546. { Profile unit? Needed for go32v2 only }
  547. if (cs_profile in aktmoduleswitches) and (target_info.target=target_i386_go32v2) then
  548. begin
  549. hp:=loadunit('PROFILE',false);
  550. psymtable(hp^.globalsymtable)^.next:=symtablestack;
  551. symtablestack:=hp^.globalsymtable;
  552. { add to the used units }
  553. current_module^.used_units.concat(new(pused_unit,init(hp,true)));
  554. refsymtable^.insert(new(punitsym,init('PROFILE',hp^.globalsymtable)));
  555. end;
  556. { Heaptrc unit? (not needed for units), this is here to be sure that it is really
  557. loaded as first unit }
  558. if (cs_gdb_heaptrc in aktglobalswitches) and not(current_module^.is_unit)then
  559. begin
  560. hp:=loadunit('HEAPTRC',false);
  561. psymtable(hp^.globalsymtable)^.next:=symtablestack;
  562. symtablestack:=hp^.globalsymtable;
  563. { add to the used units }
  564. current_module^.used_units.concat(new(pused_unit,init(hp,true)));
  565. refsymtable^.insert(new(punitsym,init('HEAPTRC',hp^.globalsymtable)));
  566. end;
  567. { save default symtablestack }
  568. defaultsymtablestack:=symtablestack;
  569. end;
  570. procedure loadunits;
  571. var
  572. s : stringid;
  573. pu,
  574. hp : pused_unit;
  575. hp2 : pmodule;
  576. hp3 : psymtable;
  577. oldprocsym:Pprocsym;
  578. begin
  579. oldprocsym:=aktprocsym;
  580. consume(_USES);
  581. {$ifdef DEBUG}
  582. test_symtablestack;
  583. {$endif DEBUG}
  584. repeat
  585. s:=pattern;
  586. consume(_ID);
  587. { Give a warning if objpas is loaded }
  588. if s='OBJPAS' then
  589. Message(parser_w_no_objpas_use_mode);
  590. { check if the unit is already used }
  591. pu:=pused_unit(current_module^.used_units.first);
  592. while assigned(pu) do
  593. begin
  594. if (pu^.name^=s) then
  595. break;
  596. pu:=pused_unit(pu^.next);
  597. end;
  598. { avoid uses of itself }
  599. if not assigned(pu) and (s<>current_module^.modulename^) then
  600. begin
  601. { load the unit }
  602. hp2:=loadunit(s,false);
  603. { the current module uses the unit hp2 }
  604. current_module^.used_units.concat(new(pused_unit,init(hp2,not current_module^.in_implementation)));
  605. pused_unit(current_module^.used_units.last)^.in_uses:=true;
  606. if current_module^.compiled then
  607. exit;
  608. refsymtable^.insert(new(punitsym,init(s,hp2^.globalsymtable)));
  609. end
  610. else
  611. Message1(sym_e_duplicate_id,s);
  612. if token=_COMMA then
  613. begin
  614. pattern:='';
  615. consume(_COMMA);
  616. end
  617. else
  618. break;
  619. until false;
  620. consume(_SEMICOLON);
  621. { set the symtable to systemunit so it gets reorderd correctly }
  622. symtablestack:=defaultsymtablestack;
  623. { now insert the units in the symtablestack }
  624. hp:=pused_unit(current_module^.used_units.first);
  625. while assigned(hp) do
  626. begin
  627. {$IfDef GDB}
  628. {$IfnDef New_GDB}
  629. if (cs_debuginfo in aktmoduleswitches) and
  630. not hp^.is_stab_written then
  631. begin
  632. punitsymtable(hp^.u^.globalsymtable)^.concattypestabto(debuglist);
  633. hp^.is_stab_written:=true;
  634. hp^.unitid:=psymtable(hp^.u^.globalsymtable)^.unitid;
  635. end;
  636. {$endIf nDef New_GDB}
  637. {$EndIf GDB}
  638. if hp^.in_uses then
  639. begin
  640. hp3:=symtablestack;
  641. while assigned(hp3) do
  642. begin
  643. { insert units only once ! }
  644. if hp^.u^.globalsymtable=hp3 then
  645. break;
  646. hp3:=hp3^.next;
  647. { unit isn't inserted }
  648. if hp3=nil then
  649. begin
  650. psymtable(hp^.u^.globalsymtable)^.next:=symtablestack;
  651. symtablestack:=psymtable(hp^.u^.globalsymtable);
  652. {$ifdef CHAINPROCSYMS}
  653. symtablestack^.chainprocsyms;
  654. {$endif CHAINPROCSYMS}
  655. {$ifdef DEBUG}
  656. test_symtablestack;
  657. {$endif DEBUG}
  658. end;
  659. end;
  660. end;
  661. hp:=pused_unit(hp^.next);
  662. end;
  663. aktprocsym:=oldprocsym;
  664. end;
  665. procedure write_gdb_info;
  666. {$IfDef GDB}
  667. var
  668. hp : pused_unit;
  669. begin
  670. if not (cs_debuginfo in aktmoduleswitches) then
  671. exit;
  672. { now insert the units in the symtablestack }
  673. hp:=pused_unit(current_module^.used_units.first);
  674. while assigned(hp) do
  675. begin
  676. if (cs_debuginfo in aktmoduleswitches) and
  677. not hp^.is_stab_written then
  678. begin
  679. punitsymtable(hp^.u^.globalsymtable)^.concattypestabto(debuglist);
  680. hp^.is_stab_written:=true;
  681. hp^.unitid:=psymtable(hp^.u^.globalsymtable)^.unitid;
  682. end;
  683. hp:=pused_unit(hp^.next);
  684. end;
  685. if current_module^.in_implementation then
  686. begin
  687. if assigned(current_module^.localsymtable) then
  688. begin
  689. { all types }
  690. punitsymtable(current_module^.localsymtable)^.concattypestabto(debuglist);
  691. { and all local symbols}
  692. punitsymtable(current_module^.localsymtable)^.concatstabto(debuglist);
  693. end;
  694. end
  695. else
  696. begin
  697. if assigned(current_module^.globalsymtable) then
  698. begin
  699. { all types }
  700. punitsymtable(current_module^.globalsymtable)^.concattypestabto(debuglist);
  701. { and all local symbols}
  702. punitsymtable(current_module^.globalsymtable)^.concatstabto(debuglist);
  703. end;
  704. end;
  705. end;
  706. {$Else GDB}
  707. begin
  708. end;
  709. {$EndIf GDB}
  710. procedure parse_implementation_uses(symt:Psymtable);
  711. begin
  712. if token=_USES then
  713. begin
  714. symt^.symtabletype:=unitsymtable;
  715. loadunits;
  716. symt^.symtabletype:=globalsymtable;
  717. {$ifdef DEBUG}
  718. test_symtablestack;
  719. {$endif DEBUG}
  720. end;
  721. end;
  722. procedure gen_main_procsym(const name:string;options:tproctypeoption;st:psymtable);
  723. var
  724. stt : psymtable;
  725. begin
  726. {Generate a procsym for main}
  727. make_ref:=false;
  728. aktprocsym:=new(Pprocsym,init(name));
  729. {Try to insert in in static symtable ! }
  730. stt:=symtablestack;
  731. symtablestack:=st;
  732. aktprocsym^.definition:=new(Pprocdef,init);
  733. symtablestack:=stt;
  734. aktprocsym^.definition^.proctypeoption:=options;
  735. aktprocsym^.definition^.setmangledname(target_os.cprefix+name);
  736. aktprocsym^.definition^.forwarddef:=false;
  737. make_ref:=true;
  738. { The localst is a local symtable. Change it into the static
  739. symtable }
  740. dispose(aktprocsym^.definition^.localst,done);
  741. aktprocsym^.definition^.localst:=st;
  742. { and insert the procsym in symtable }
  743. st^.insert(aktprocsym);
  744. { set some informations about the main program }
  745. with procinfo do
  746. begin
  747. retdef:=voiddef;
  748. _class:=nil;
  749. call_offset:=8;
  750. framepointer:=frame_pointer;
  751. flags:=0;
  752. end;
  753. end;
  754. procedure proc_unit;
  755. function is_assembler_generated:boolean;
  756. begin
  757. is_assembler_generated:=(Errorcount=0) and
  758. not(
  759. codesegment^.empty and
  760. datasegment^.empty and
  761. bsssegment^.empty and
  762. ((importssection=nil) or importssection^.empty) and
  763. ((resourcesection=nil) or resourcesection^.empty) and
  764. ((resourcestringlist=nil) or resourcestringlist^.empty)
  765. );
  766. end;
  767. var
  768. names : Tstringcontainer;
  769. st : psymtable;
  770. unitst : punitsymtable;
  771. {$ifdef GDB}
  772. pu : pused_unit;
  773. {$endif GDB}
  774. {$ifdef Test_Double_checksum}
  775. store_crc : longint;
  776. {$endif}
  777. s1,s2 : ^string; {Saves stack space}
  778. begin
  779. consume(_UNIT);
  780. if token=_ID then
  781. begin
  782. { create filenames and unit name }
  783. current_module^.SetFileName(current_scanner^.inputfile^.path^+current_scanner^.inputfile^.name^,true);
  784. stringdispose(current_module^.modulename);
  785. current_module^.modulename:=stringdup(upper(pattern));
  786. { check for system unit }
  787. new(s1);
  788. new(s2);
  789. s1^:=upper(target_info.system_unit);
  790. s2^:=upper(SplitName(current_scanner^.inputfile^.name^));
  791. if (cs_compilesystem in aktmoduleswitches) then
  792. begin
  793. if ((length(current_module^.modulename^)>8) or
  794. (current_module^.modulename^<>s1^) or
  795. (current_module^.modulename^<>s2^)) then
  796. Message1(unit_e_illegal_unit_name,current_module^.modulename^);
  797. end
  798. else
  799. begin
  800. if (cs_check_unit_name in aktglobalswitches) and
  801. not((current_module^.modulename^=s2^) or
  802. ((length(current_module^.modulename^)>8) and
  803. (copy(current_module^.modulename^,1,8)=s2^))) then
  804. Message1(unit_e_illegal_unit_name,current_module^.modulename^);
  805. if (current_module^.modulename^=s1^) then
  806. Message(unit_w_switch_us_missed);
  807. end;
  808. dispose(s2);
  809. dispose(s1);
  810. end;
  811. consume(_ID);
  812. consume(_SEMICOLON);
  813. consume(_INTERFACE);
  814. { global switches are read, so further changes aren't allowed }
  815. current_module^.in_global:=false;
  816. { can't have local browser when no global browser }
  817. if (cs_local_browser in aktmoduleswitches) and
  818. not(cs_browser in aktmoduleswitches) then
  819. aktmoduleswitches:=aktmoduleswitches-[cs_local_browser];
  820. Message1(unit_u_start_parse_interface,current_module^.modulename^);
  821. { update status }
  822. status.currentmodule:=current_module^.modulename^;
  823. { maybe turn off m_objpas if we are compiling objpas }
  824. if (current_module^.modulename^='OBJPAS') then
  825. aktmodeswitches:=aktmodeswitches-[m_objpas];
  826. { this should be placed after uses !!}
  827. {$ifndef UseNiceNames}
  828. procprefix:='_'+current_module^.modulename^+'$$';
  829. {$else UseNiceNames}
  830. procprefix:='_'+tostr(length(current_module^.modulename^))+lowercase(current_module^.modulename^)+'_';
  831. {$endif UseNiceNames}
  832. parse_only:=true;
  833. { generate now the global symboltable }
  834. st:=new(punitsymtable,init(globalsymtable,current_module^.modulename^));
  835. refsymtable:=st;
  836. unitst:=punitsymtable(st);
  837. { define first as local to overcome dependency conflicts }
  838. current_module^.localsymtable:=st;
  839. { the unit name must be usable as a unit specifier }
  840. { inside the unit itself (PM) }
  841. { this also forbids to have another symbol }
  842. { with the same name as the unit }
  843. refsymtable^.insert(new(punitsym,init(current_module^.modulename^,unitst)));
  844. { a unit compiled at command line must be inside the loaded_unit list }
  845. if (compile_level=1) then
  846. loaded_units.insert(current_module);
  847. { load default units, like the system unit }
  848. loaddefaultunits;
  849. { reset }
  850. make_ref:=true;
  851. lexlevel:=0;
  852. { insert qualifier for the system unit (allows system.writeln) }
  853. if not(cs_compilesystem in aktmoduleswitches) then
  854. begin
  855. if token=_USES then
  856. begin
  857. unitst^.symtabletype:=unitsymtable;
  858. loadunits;
  859. { has it been compiled at a higher level ?}
  860. if current_module^.compiled then
  861. begin
  862. { this unit symtable is obsolete }
  863. { dispose(unitst,done);
  864. disposed as localsymtable !! }
  865. exit;
  866. end;
  867. unitst^.symtabletype:=globalsymtable;
  868. end;
  869. { ... but insert the symbol table later }
  870. st^.next:=symtablestack;
  871. symtablestack:=st;
  872. end
  873. else
  874. { while compiling a system unit, some types are directly inserted }
  875. begin
  876. st^.next:=symtablestack;
  877. symtablestack:=st;
  878. insert_intern_types(st);
  879. end;
  880. { now we know the place to insert the constants }
  881. constsymtable:=symtablestack;
  882. { move the global symtab from the temporary local to global }
  883. current_module^.globalsymtable:=current_module^.localsymtable;
  884. current_module^.localsymtable:=nil;
  885. reset_global_defs;
  886. { number all units, so we know if a unit is used by this unit or
  887. needs to be added implicitly }
  888. numberunits;
  889. { ... parse the declarations }
  890. read_interface_declarations;
  891. { leave when we got an error }
  892. if (Errorcount>0) and not status.skip_error then
  893. begin
  894. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  895. status.skip_error:=true;
  896. exit;
  897. end;
  898. {$ifdef New_GDB}
  899. write_gdb_info;
  900. {$endIf Def New_GDB}
  901. {$ifdef Test_Double_checksum}
  902. if (Errorcount=0) then
  903. writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),true);
  904. {$endif Test_Double_checksum}
  905. { Parse the implementation section }
  906. consume(_IMPLEMENTATION);
  907. current_module^.in_implementation:=true;
  908. Message1(unit_u_start_parse_implementation,current_module^.modulename^);
  909. parse_only:=false;
  910. { generates static symbol table }
  911. st:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
  912. current_module^.localsymtable:=st;
  913. { remove the globalsymtable from the symtable stack }
  914. { to reinsert it after loading the implementation units }
  915. symtablestack:=unitst^.next;
  916. { we don't want implementation units symbols in unitsymtable !! PM }
  917. refsymtable:=st;
  918. { Read the implementation units }
  919. parse_implementation_uses(unitst);
  920. if current_module^.compiled then
  921. begin
  922. exit;
  923. end;
  924. { reset ranges/stabs in exported definitions }
  925. reset_global_defs;
  926. { All units are read, now give them a number }
  927. numberunits;
  928. { now we can change refsymtable }
  929. refsymtable:=st;
  930. { but reinsert the global symtable as lasts }
  931. unitst^.next:=symtablestack;
  932. symtablestack:=unitst;
  933. {$ifdef DEBUG}
  934. test_symtablestack;
  935. {$endif DEBUG}
  936. constsymtable:=symtablestack;
  937. {$ifdef Splitheap}
  938. if testsplit then
  939. begin
  940. Split_Heap;
  941. allow_special:=true;
  942. Switch_to_temp_heap;
  943. end;
  944. { it will report all crossings }
  945. allow_special:=false;
  946. {$endif Splitheap}
  947. { Generate a procsym }
  948. gen_main_procsym(current_module^.modulename^+'_init',potype_unitinit,st);
  949. { Compile the unit }
  950. codegen_newprocedure;
  951. names.init;
  952. names.insert('INIT$$'+current_module^.modulename^);
  953. names.insert(target_os.cprefix+current_module^.modulename^+'_init');
  954. compile_proc_body(names,true,false);
  955. names.done;
  956. codegen_doneprocedure;
  957. { avoid self recursive destructor call !! PM }
  958. aktprocsym^.definition^.localst:=nil;
  959. { finalize? }
  960. if token=_FINALIZATION then
  961. begin
  962. { set module options }
  963. current_module^.flags:=current_module^.flags or uf_finalize;
  964. { Generate a procsym }
  965. gen_main_procsym(current_module^.modulename^+'_finalize',potype_unitfinalize,st);
  966. { Compile the finalize }
  967. codegen_newprocedure;
  968. names.init;
  969. names.insert('FINALIZE$$'+current_module^.modulename^);
  970. names.insert(target_os.cprefix+current_module^.modulename^+'_finalize');
  971. compile_proc_body(names,true,false);
  972. names.done;
  973. codegen_doneprocedure;
  974. end;
  975. { the last char should always be a point }
  976. consume(_POINT);
  977. { avoid self recursive destructor call !! PM }
  978. aktprocsym^.definition^.localst:=nil;
  979. { absence does not matter here !! }
  980. aktprocsym^.definition^.forwarddef:=false;
  981. { test static symtable }
  982. if (Errorcount=0) then
  983. st^.allsymbolsused;
  984. { size of the static data }
  985. datasize:=st^.datasize;
  986. {$ifdef GDB}
  987. { add all used definitions even for implementation}
  988. if (cs_debuginfo in aktmoduleswitches) then
  989. begin
  990. {$IfnDef New_GDB}
  991. if assigned(current_module^.globalsymtable) then
  992. begin
  993. { all types }
  994. punitsymtable(current_module^.globalsymtable)^.concattypestabto(debuglist);
  995. { and all local symbols}
  996. punitsymtable(current_module^.globalsymtable)^.concatstabto(debuglist);
  997. end;
  998. { all local types }
  999. punitsymtable(st)^.concattypestabto(debuglist);
  1000. { and all local symbols}
  1001. st^.concatstabto(debuglist);
  1002. {$else New_GDB}
  1003. write_gdb_info;
  1004. {$endIf Def New_GDB}
  1005. end;
  1006. {$endif GDB}
  1007. reset_global_defs;
  1008. { tests, if all (interface) forwards are resolved }
  1009. if (Errorcount=0) then
  1010. symtablestack^.check_forwards;
  1011. { now we have a correct unit, change the symtable type }
  1012. current_module^.in_implementation:=false;
  1013. symtablestack^.symtabletype:=unitsymtable;
  1014. {$ifdef GDB}
  1015. punitsymtable(symtablestack)^.is_stab_written:=false;
  1016. {$endif GDB}
  1017. { leave when we got an error }
  1018. if (Errorcount>0) and not status.skip_error then
  1019. begin
  1020. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1021. status.skip_error:=true;
  1022. exit;
  1023. end;
  1024. { generate imports }
  1025. if current_module^.uses_imports then
  1026. importlib^.generatelib;
  1027. { insert own objectfile, or say that it's in a library
  1028. (no check for an .o when loading) }
  1029. if is_assembler_generated then
  1030. insertobjectfile
  1031. else
  1032. current_module^.flags:=current_module^.flags or uf_no_link;
  1033. if cs_local_browser in aktmoduleswitches then
  1034. current_module^.localsymtable:=refsymtable;
  1035. { Write out the ppufile }
  1036. {$ifdef Test_Double_checksum}
  1037. store_crc:=current_module^.interface_crc;
  1038. {$endif Test_Double_checksum}
  1039. if (Errorcount=0) then
  1040. writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack),false);
  1041. {$ifdef Test_Double_checksum}
  1042. if store_crc<>current_module^.interface_crc then
  1043. Def_comment(V_Warning,current_module^.ppufilename^+' CRC changed '+
  1044. tostr(store_crc)+'<>'+tostr(current_module^.interface_crc));
  1045. {$endif def Test_Double_checksum}
  1046. { must be done only after local symtable ref stores !! }
  1047. closecurrentppu;
  1048. {$ifdef GDB}
  1049. pu:=pused_unit(usedunits.first);
  1050. while assigned(pu) do
  1051. begin
  1052. if assigned(pu^.u^.globalsymtable) then
  1053. punitsymtable(pu^.u^.globalsymtable)^.is_stab_written:=false;
  1054. pu:=pused_unit(pu^.next);
  1055. end;
  1056. {$endif GDB}
  1057. { remove static symtable (=refsymtable) here to save some mem }
  1058. if not (cs_local_browser in aktmoduleswitches) then
  1059. begin
  1060. dispose(st,done);
  1061. current_module^.localsymtable:=nil;
  1062. end;
  1063. if is_assembler_generated then
  1064. begin
  1065. { finish asmlist by adding segment starts }
  1066. insertsegment;
  1067. { assemble }
  1068. create_objectfile;
  1069. end;
  1070. { leave when we got an error }
  1071. if (Errorcount>0) and not status.skip_error then
  1072. begin
  1073. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1074. status.skip_error:=true;
  1075. exit;
  1076. end;
  1077. end;
  1078. procedure proc_program(islibrary : boolean);
  1079. var
  1080. st : psymtable;
  1081. hp : pmodule;
  1082. names : Tstringcontainer;
  1083. begin
  1084. DLLsource:=islibrary;
  1085. parse_only:=false;
  1086. if islibrary then
  1087. begin
  1088. consume(_LIBRARY);
  1089. stringdispose(current_module^.modulename);
  1090. current_module^.modulename:=stringdup(pattern);
  1091. current_module^.islibrary:=true;
  1092. exportlib^.preparelib(pattern);
  1093. consume(_ID);
  1094. consume(_SEMICOLON);
  1095. end
  1096. else
  1097. { is there an program head ? }
  1098. if token=_PROGRAM then
  1099. begin
  1100. consume(_PROGRAM);
  1101. stringdispose(current_module^.modulename);
  1102. current_module^.modulename:=stringdup(pattern);
  1103. consume(_ID);
  1104. if token=_LKLAMMER then
  1105. begin
  1106. consume(_LKLAMMER);
  1107. idlist;
  1108. consume(_RKLAMMER);
  1109. end;
  1110. consume(_SEMICOLON);
  1111. end;
  1112. { global switches are read, so further changes aren't allowed }
  1113. current_module^.in_global:=false;
  1114. { can't have local browser when no global browser }
  1115. if (cs_local_browser in aktmoduleswitches) and
  1116. not(cs_browser in aktmoduleswitches) then
  1117. aktmoduleswitches:=aktmoduleswitches-[cs_local_browser];
  1118. { set implementation flag }
  1119. current_module^.in_implementation:=true;
  1120. { insert after the unit symbol tables the static symbol table }
  1121. { of the program }
  1122. st:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
  1123. current_module^.localsymtable:=st;
  1124. symtablestack:=st;
  1125. refsymtable:=st;
  1126. { necessary for browser }
  1127. loaded_units.insert(current_module);
  1128. { load standard units (system,objpas,profile unit) }
  1129. loaddefaultunits;
  1130. { reset }
  1131. lexlevel:=0;
  1132. {Load the units used by the program we compile.}
  1133. if token=_USES then
  1134. loadunits;
  1135. { reset ranges/stabs in exported definitions }
  1136. reset_global_defs;
  1137. { All units are read, now give them a number }
  1138. numberunits;
  1139. {Insert the name of the main program into the symbol table.}
  1140. if current_module^.modulename^<>'' then
  1141. {st^.insert(new(pprogramsym,init(current_module^.modulename^)));}
  1142. st^.insert(new(punitsym,init(current_module^.modulename^,punitsymtable(st))));
  1143. { ...is also constsymtable, this is the symtable where }
  1144. { the elements of enumeration types are inserted }
  1145. constsymtable:=st;
  1146. { Generate a procsym for main }
  1147. gen_main_procsym('main',potype_proginit,st);
  1148. { reset }
  1149. procprefix:='';
  1150. {The program intialization needs an alias, so it can be called
  1151. from the bootstrap code.}
  1152. codegen_newprocedure;
  1153. names.init;
  1154. names.insert('program_init');
  1155. names.insert('PASCALMAIN');
  1156. names.insert(target_os.cprefix+'main');
  1157. {$ifdef m68k}
  1158. if target_info.target=target_m68k_PalmOS then
  1159. names.insert('PilotMain');
  1160. {$endif}
  1161. compile_proc_body(names,true,false);
  1162. names.done;
  1163. { avoid self recursive destructor call !! PM }
  1164. aktprocsym^.definition^.localst:=nil;
  1165. { consider these symbols as global ones }
  1166. { for browser }
  1167. current_module^.globalsymtable:=current_module^.localsymtable;
  1168. current_module^.localsymtable:=nil;
  1169. codegen_doneprocedure;
  1170. { consume the last point }
  1171. consume(_POINT);
  1172. {$ifdef New_GDB}
  1173. write_gdb_info;
  1174. {$endIf Def New_GDB}
  1175. { leave when we got an error }
  1176. if (Errorcount>0) and not status.skip_error then
  1177. begin
  1178. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1179. status.skip_error:=true;
  1180. exit;
  1181. end;
  1182. { generate imports }
  1183. if current_module^.uses_imports then
  1184. importlib^.generatelib;
  1185. if islibrary then
  1186. exportlib^.generatelib;
  1187. { insert heap }
  1188. insertresourcestrings;
  1189. insertinitfinaltable;
  1190. insertheap;
  1191. inserttargetspecific;
  1192. datasize:=symtablestack^.datasize;
  1193. { finish asmlist by adding segment starts }
  1194. insertsegment;
  1195. { insert own objectfile }
  1196. insertobjectfile;
  1197. { assemble and link }
  1198. create_objectfile;
  1199. { leave when we got an error }
  1200. if (Errorcount>0) and not status.skip_error then
  1201. begin
  1202. Message1(unit_f_errors_in_unit,tostr(Errorcount));
  1203. status.skip_error:=true;
  1204. exit;
  1205. end;
  1206. { create the executable when we are at level 1 }
  1207. if (compile_level=1) then
  1208. begin
  1209. { insert all .o files from all loaded units }
  1210. hp:=pmodule(loaded_units.first);
  1211. while assigned(hp) do
  1212. begin
  1213. Linker.AddModuleFiles(hp);
  1214. hp:=pmodule(hp^.next);
  1215. end;
  1216. { write .def file }
  1217. if (cs_link_deffile in aktglobalswitches) then
  1218. deffile.writefile;
  1219. { finally we can create a executable }
  1220. if (not current_module^.is_unit) then
  1221. Linker.MakeExecutable;
  1222. end;
  1223. end;
  1224. end.
  1225. {
  1226. $Log$
  1227. Revision 1.140 1999-08-04 13:02:57 jonas
  1228. * all tokens now start with an underscore
  1229. * PowerPC compiles!!
  1230. Revision 1.139 1999/08/04 00:23:15 florian
  1231. * renamed i386asm and i386base to cpuasm and cpubase
  1232. Revision 1.138 1999/08/03 22:03:02 peter
  1233. * moved bitmask constants to sets
  1234. * some other type/const renamings
  1235. Revision 1.137 1999/08/03 17:09:38 florian
  1236. * the alpha compiler can be compiled now
  1237. Revision 1.136 1999/08/02 17:17:10 florian
  1238. * small changes for the new code generator
  1239. Revision 1.135 1999/07/29 20:54:04 peter
  1240. * write .size also
  1241. Revision 1.134 1999/07/26 09:42:11 florian
  1242. * bugs 494-496 fixed
  1243. Revision 1.133 1999/07/24 00:13:25 peter
  1244. * also number units for program
  1245. Revision 1.132 1999/07/23 11:37:48 peter
  1246. * error for illegal type reference, instead of 10998
  1247. Revision 1.131 1999/07/22 09:37:54 florian
  1248. + resourcestring implemented
  1249. + start of longstring support
  1250. Revision 1.130 1999/07/14 21:19:11 florian
  1251. + implemented a better error message if a PPU file isn't found as suggested
  1252. by Lee John
  1253. Revision 1.129 1999/07/06 21:48:24 florian
  1254. * a lot bug fixes:
  1255. - po_external isn't any longer necessary for procedure compatibility
  1256. - m_tp_procvar is in -Sd now available
  1257. - error messages of procedure variables improved
  1258. - return values with init./finalization fixed
  1259. - data types with init./finalization aren't any longer allowed in variant
  1260. record
  1261. Revision 1.128 1999/07/06 00:53:48 peter
  1262. * merged
  1263. Revision 1.127 1999/07/05 16:21:27 peter
  1264. * fixed linking for units without linking necessary
  1265. Revision 1.126 1999/07/03 00:29:56 peter
  1266. * new link writing to the ppu, one .ppu is needed for all link types,
  1267. static (.o) is now always created also when smartlinking is used
  1268. Revision 1.125 1999/06/15 13:57:32 peter
  1269. * merged
  1270. Revision 1.124.2.2 1999/07/06 00:47:52 peter
  1271. * killed recompile bug
  1272. Revision 1.124.2.1 1999/06/15 13:54:26 peter
  1273. * don't run ar anymore for binary writer, also not with -CS
  1274. Revision 1.124 1999/05/27 19:44:48 peter
  1275. * removed oldasm
  1276. * plabel -> pasmlabel
  1277. * -a switches to source writing automaticly
  1278. * assembler readers OOPed
  1279. * asmsymbol automaticly external
  1280. * jumptables and other label fixes for asm readers
  1281. Revision 1.123 1999/05/21 13:55:06 peter
  1282. * NEWLAB for label as symbol
  1283. Revision 1.122 1999/05/18 22:36:29 pierre
  1284. * little redondant code removed
  1285. Revision 1.121 1999/05/17 14:43:54 pierre
  1286. * reset current_ppu to nil when appropriate
  1287. Revision 1.120 1999/05/13 21:59:35 peter
  1288. * removed oldppu code
  1289. * warning if objpas is loaded from uses
  1290. * first things for new deref writing
  1291. Revision 1.119 1999/05/09 11:38:08 peter
  1292. * don't write .o and link if errors occure during assembling
  1293. Revision 1.118 1999/05/03 18:03:28 peter
  1294. * no ar.exe running field in target_asm
  1295. Revision 1.117 1999/05/01 13:24:32 peter
  1296. * merged nasm compiler
  1297. * old asm moved to oldasm/
  1298. Revision 1.116 1999/04/26 23:22:42 peter
  1299. * fixed double .o file insertion
  1300. Revision 1.115 1999/04/26 18:29:58 peter
  1301. * farpointerdef moved into pointerdef.is_far
  1302. Revision 1.114 1999/04/26 13:31:39 peter
  1303. * release storenumber,double_checksum
  1304. Revision 1.113 1999/04/25 17:32:14 peter
  1305. * fixed double_checksum
  1306. Revision 1.112 1999/04/25 15:08:38 peter
  1307. * small fixes for double_checksum
  1308. Revision 1.111 1999/04/21 09:43:46 peter
  1309. * storenumber works
  1310. * fixed some typos in double_checksum
  1311. + incompatible types type1 and type2 message (with storenumber)
  1312. Revision 1.110 1999/04/17 13:14:52 peter
  1313. * concat_external added for new init/final
  1314. Revision 1.109 1999/04/15 12:19:59 peter
  1315. + finalization support
  1316. Revision 1.108 1999/04/14 09:14:52 peter
  1317. * first things to store the symbol/def number in the ppu
  1318. Revision 1.107 1999/04/08 10:53:54 michael
  1319. * Fixed forgotten ;
  1320. Revision 1.106 1999/04/07 15:39:30 pierre
  1321. + double_checksum code added
  1322. Revision 1.105 1999/03/26 00:05:38 peter
  1323. * released valintern
  1324. + deffile is now removed when compiling is finished
  1325. * ^( compiles now correct
  1326. + static directive
  1327. * shrd fixed
  1328. Revision 1.104 1999/03/24 23:17:17 peter
  1329. * fixed bugs 212,222,225,227,229,231,233
  1330. Revision 1.103 1999/03/18 20:30:46 peter
  1331. + .a writer
  1332. Revision 1.102 1999/03/16 21:07:25 peter
  1333. * check for dup uses
  1334. Revision 1.101 1999/02/25 21:02:43 peter
  1335. * ag386bin updates
  1336. + coff writer
  1337. Revision 1.100 1999/02/23 18:29:20 pierre
  1338. * win32 compilation error fix
  1339. + some work for local browser (not cl=omplete yet)
  1340. Revision 1.99 1999/02/22 13:06:58 pierre
  1341. + -b and -bl options work !
  1342. + cs_local_browser ($L+) is disabled if cs_browser ($Y+)
  1343. is not enabled when quitting global section
  1344. * local vars and procedures are not yet stored into PPU
  1345. Revision 1.98 1999/02/22 02:15:29 peter
  1346. * updates for ag386bin
  1347. Revision 1.97 1999/02/16 00:45:31 peter
  1348. * fixed crashes by forgotten strpnew() for init_symbol
  1349. Revision 1.96 1999/02/05 08:54:27 pierre
  1350. + linkofiles splitted inot linkofiles and linkunitfiles
  1351. because linkofiles must be stored with directory
  1352. to enabled linking of different objects with same name
  1353. in a different directory
  1354. Revision 1.95 1999/02/03 09:44:36 pierre
  1355. * symbol nubering begins with 1 in number_symbols
  1356. * program tmodule has globalsymtable for its staticsymtable
  1357. (to get it displayed in IDE globals list)
  1358. + list of symbol (browcol) greatly improved for IDE
  1359. Revision 1.94 1999/01/12 14:25:31 peter
  1360. + BrowserLog for browser.log generation
  1361. + BrowserCol for browser info in TCollections
  1362. * released all other UseBrowser
  1363. Revision 1.93 1999/01/06 12:39:46 peter
  1364. * renamed resource -> comprsrc (conflicted with FV)
  1365. Revision 1.92 1998/12/28 23:26:23 peter
  1366. + resource file handling ($R directive) for Win32
  1367. Revision 1.91 1998/12/15 17:14:17 peter
  1368. * fix for tp7
  1369. Revision 1.90 1998/12/15 10:23:26 peter
  1370. + -iSO, -iSP, -iTO, -iTP
  1371. Revision 1.89 1998/12/11 00:03:34 peter
  1372. + globtype,tokens,version unit splitted from globals
  1373. Revision 1.88 1998/12/08 10:18:11 peter
  1374. + -gh for heaptrc unit
  1375. Revision 1.87 1998/12/01 23:40:53 pierre
  1376. * new try for correct debug info generation
  1377. Revision 1.86 1998/11/30 09:43:22 pierre
  1378. * some range check bugs fixed (still not working !)
  1379. + added DLL writing support for win32 (also accepts variables)
  1380. + TempAnsi for code that could be used for Temporary ansi strings
  1381. handling
  1382. Revision 1.85 1998/11/28 16:20:54 peter
  1383. + support for dll variables
  1384. Revision 1.84 1998/11/18 09:18:03 pierre
  1385. + automatic loading of profile unit with -pg option
  1386. in go32v2 mode (also defines FPC_PROFILE)
  1387. * some memory leaks removed
  1388. * unreleased temp problem with sets solved
  1389. Revision 1.83 1998/11/16 11:29:00 pierre
  1390. * stackcheck removed for i386_win32
  1391. * exportlist does not crash at least !!
  1392. (was need for tests dir !)z
  1393. Revision 1.82 1998/11/12 12:55:16 pierre
  1394. * fix for bug0176 and bug0177
  1395. Revision 1.81 1998/11/12 11:34:58 peter
  1396. * fix for empty .o files and linking of libs
  1397. Revision 1.80 1998/11/06 09:48:14 pierre
  1398. * double initialization code calling bug fixed
  1399. Revision 1.79 1998/11/03 11:33:11 peter
  1400. + search_unit arg to only search for sources
  1401. Revision 1.78 1998/10/30 12:23:41 peter
  1402. * fix for lognunitname and longunit.pas
  1403. Revision 1.77 1998/10/29 11:35:52 florian
  1404. * some dll support for win32
  1405. * fixed assembler writing for PalmOS
  1406. Revision 1.76 1998/10/28 18:26:15 pierre
  1407. * removed some erros after other errors (introduced by useexcept)
  1408. * stabs works again correctly (for how long !)
  1409. Revision 1.75 1998/10/27 13:45:35 pierre
  1410. * classes get a vmt allways
  1411. * better error info (tried to remove
  1412. several error strings introduced by the tpexcept handling)
  1413. Revision 1.74 1998/10/26 09:34:50 peter
  1414. * unit check name works now for all units, not only systemunit
  1415. Revision 1.73 1998/10/22 23:53:27 peter
  1416. * leave when an error has been in the interface (else other units could
  1417. be compiled with the implementation uses!)
  1418. * don't always compile when not in implementation with a second_load
  1419. Revision 1.72 1998/10/22 11:36:34 peter
  1420. * fixed imports generation at the wrong place
  1421. Revision 1.71 1998/10/21 20:13:10 peter
  1422. * check for importsection for empty asm file
  1423. Revision 1.70 1998/10/20 09:30:05 peter
  1424. * set also in_library flag when no .o is generated
  1425. Revision 1.68 1998/10/19 08:54:59 pierre
  1426. * wrong stabs info corrected once again !!
  1427. + variable vmt offset with vmt field only if required
  1428. implemented now !!!
  1429. Revision 1.67 1998/10/13 13:10:25 peter
  1430. * new style for m68k/i386 infos and enums
  1431. Revision 1.66 1998/10/09 16:36:05 pierre
  1432. * some memory leaks specific to usebrowser define fixed
  1433. * removed tmodule.implsymtable (was like tmodule.localsymtable)
  1434. Revision 1.65 1998/10/09 14:38:55 pierre
  1435. * add a second load for PPU file
  1436. Revision 1.64 1998/10/09 08:56:28 pierre
  1437. * several memory leaks fixed
  1438. Revision 1.63 1998/10/08 23:29:01 peter
  1439. * -vu shows unit info, -vt shows tried/used files
  1440. Revision 1.62 1998/10/08 17:17:25 pierre
  1441. * current_module old scanner tagged as invalid if unit is recompiled
  1442. + added ppheap for better info on tracegetmem of heaptrc
  1443. (adds line column and file index)
  1444. * several memory leaks removed ith help of heaptrc !!
  1445. Revision 1.61 1998/10/08 13:48:47 peter
  1446. * fixed memory leaks for do nothing source
  1447. * fixed unit interdependency
  1448. Revision 1.60 1998/10/06 17:16:54 pierre
  1449. * some memory leaks fixed (thanks to Peter for heaptrc !)
  1450. Revision 1.59 1998/10/05 21:33:26 peter
  1451. * fixed 161,165,166,167,168
  1452. Revision 1.58 1998/09/30 16:43:37 peter
  1453. * fixed unit interdependency with circular uses
  1454. Revision 1.57 1998/09/30 12:11:52 peter
  1455. * fixed circular uses which looped forever
  1456. Revision 1.56 1998/09/28 11:22:15 pierre
  1457. * did not compile for browser
  1458. * merge from fixes
  1459. Revision 1.48.2.1 1998/09/28 10:55:16 pierre
  1460. fix for current_module dispose bug
  1461. Revision 1.55 1998/09/28 11:04:03 peter
  1462. * fixed loaddefaultunits which was at the wrong place for programs, so
  1463. the default defs were not loaded when main was initialized
  1464. Revision 1.54 1998/09/24 23:49:12 peter
  1465. + aktmodeswitches
  1466. Revision 1.53 1998/09/23 12:20:50 pierre
  1467. * main program tmodule had no symtable (crashed browser)
  1468. * unit symbols problem fixed !!
  1469. Revision 1.52 1998/09/22 17:13:49 pierre
  1470. + browsing updated and developed
  1471. records and objects fields are also stored
  1472. Revision 1.51 1998/09/22 15:40:55 peter
  1473. * some extra ifdef GDB
  1474. Revision 1.50 1998/09/21 08:45:17 pierre
  1475. + added vmt_offset in tobjectdef.write for fututre use
  1476. (first steps to have objects without vmt if no virtual !!)
  1477. + added fpu_used field for tabstractprocdef :
  1478. sets this level to 2 if the functions return with value in FPU
  1479. (is then set to correct value at parsing of implementation)
  1480. THIS MIGHT refuse some code with FPU expression too complex
  1481. that were accepted before and even in some cases
  1482. that don't overflow in fact
  1483. ( like if f : float; is a forward that finally in implementation
  1484. only uses one fpu register !!)
  1485. Nevertheless I think that it will improve security on
  1486. FPU operations !!
  1487. * most other changes only for UseBrowser code
  1488. (added symtable references for record and objects)
  1489. local switch for refs to args and local of each function
  1490. (static symtable still missing)
  1491. UseBrowser still not stable and probably broken by
  1492. the definition hash array !!
  1493. Revision 1.49 1998/09/18 08:01:36 pierre
  1494. + improvement on the usebrowser part
  1495. (does not work correctly for now)
  1496. Revision 1.48 1998/09/09 15:33:07 peter
  1497. * fixed in_global to allow directives also after interface token
  1498. Revision 1.47 1998/09/09 11:50:55 pierre
  1499. * forward def are not put in record or objects
  1500. + added check for forwards also in record and objects
  1501. * dummy parasymtable for unit initialization removed from
  1502. symtable stack
  1503. Revision 1.46 1998/09/03 11:24:01 peter
  1504. * moved more inputfile things from tscannerfile to tinputfile
  1505. * changed ifdef Sourceline to cs_asm_source
  1506. Revision 1.45 1998/08/31 12:26:28 peter
  1507. * m68k and palmos updates from surebugfixes
  1508. Revision 1.44 1998/08/26 15:35:33 peter
  1509. * fixed scannerfiles for macros
  1510. + $I %<environment>%
  1511. Revision 1.43 1998/08/26 10:08:47 peter
  1512. * fixed problem with libprefix at the wrong place
  1513. * fixed lib generation with smartlinking and no -CS used
  1514. Revision 1.42 1998/08/19 18:04:54 peter
  1515. * fixed current_module^.in_implementation flag
  1516. Revision 1.41 1998/08/17 10:10:08 peter
  1517. - removed OLDPPU
  1518. Revision 1.40 1998/08/17 09:17:50 peter
  1519. * static/shared linking updates
  1520. Revision 1.39 1998/08/14 21:56:37 peter
  1521. * setting the outputfile using -o works now to create static libs
  1522. Revision 1.38 1998/08/10 14:50:13 peter
  1523. + localswitches, moduleswitches, globalswitches splitting
  1524. Revision 1.37 1998/08/10 10:18:31 peter
  1525. + Compiler,Comphook unit which are the new interface units to the
  1526. compiler
  1527. Revision 1.36 1998/07/14 14:46:54 peter
  1528. * released NEWINPUT
  1529. Revision 1.35 1998/07/08 12:39:38 peter
  1530. * heap_size for m68k
  1531. Revision 1.34 1998/07/07 11:20:03 peter
  1532. + NEWINPUT for a better inputfile and scanner object
  1533. Revision 1.33 1998/06/25 11:15:34 pierre
  1534. * ppu files where not closed in newppu !!
  1535. second compilation was impossible due to too many opened files
  1536. (not visible in 'make cycle' as we remove all the ppu files)
  1537. Revision 1.32 1998/06/25 08:48:16 florian
  1538. * first version of rtti support
  1539. Revision 1.31 1998/06/24 14:48:35 peter
  1540. * ifdef newppu -> ifndef oldppu
  1541. Revision 1.30 1998/06/17 14:10:16 peter
  1542. * small os2 fixes
  1543. * fixed interdependent units with newppu (remake3 under linux works now)
  1544. Revision 1.29 1998/06/16 08:56:25 peter
  1545. + targetcpu
  1546. * cleaner pmodules for newppu
  1547. Revision 1.28 1998/06/13 00:10:10 peter
  1548. * working browser and newppu
  1549. * some small fixes against crashes which occured in bp7 (but not in
  1550. fpc?!)
  1551. Revision 1.27 1998/06/11 13:58:08 peter
  1552. * small fix to let newppu compile
  1553. Revision 1.26 1998/06/09 16:01:47 pierre
  1554. + added procedure directive parsing for procvars
  1555. (accepted are popstack cdecl and pascal)
  1556. + added C vars with the following syntax
  1557. var C calias 'true_c_name';(can be followed by external)
  1558. reason is that you must add the Cprefix
  1559. which is target dependent
  1560. Revision 1.25 1998/06/08 22:59:49 peter
  1561. * smartlinking works for win32
  1562. * some defines to exclude some compiler parts
  1563. Revision 1.24 1998/06/08 13:13:44 pierre
  1564. + temporary variables now in temp_gen.pas unit
  1565. because it is processor independent
  1566. * mppc68k.bat modified to undefine i386 and support_mmx
  1567. (which are defaults for i386)
  1568. Revision 1.23 1998/06/05 17:47:29 peter
  1569. * some better uses clauses
  1570. Revision 1.22 1998/06/05 14:37:34 pierre
  1571. * fixes for inline for operators
  1572. * inline procedure more correctly restricted
  1573. Revision 1.21 1998/06/04 23:51:53 peter
  1574. * m68k compiles
  1575. + .def file creation moved to gendef.pas so it could also be used
  1576. for win32
  1577. Revision 1.20 1998/06/04 09:55:42 pierre
  1578. * demangled name of procsym reworked to become independant of the mangling scheme
  1579. Revision 1.19 1998/06/03 23:40:38 peter
  1580. + unlimited file support, release tempclose
  1581. Revision 1.18 1998/06/03 22:49:00 peter
  1582. + wordbool,longbool
  1583. * rename bis,von -> high,low
  1584. * moved some systemunit loading/creating to psystem.pas
  1585. Revision 1.17 1998/05/28 14:40:25 peter
  1586. * fixes for newppu, remake3 works now with it
  1587. Revision 1.16 1998/05/27 19:45:06 peter
  1588. * symtable.pas splitted into includefiles
  1589. * symtable adapted for $ifdef NEWPPU
  1590. Revision 1.15 1998/05/23 01:21:22 peter
  1591. + aktasmmode, aktoptprocessor, aktoutputformat
  1592. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  1593. + $LIBNAME to set the library name where the unit will be put in
  1594. * splitted cgi386 a bit (codeseg to large for bp7)
  1595. * nasm, tasm works again. nasm moved to ag386nsm.pas
  1596. Revision 1.14 1998/05/20 09:42:35 pierre
  1597. + UseTokenInfo now default
  1598. * unit in interface uses and implementation uses gives error now
  1599. * only one error for unknown symbol (uses lastsymknown boolean)
  1600. the problem came from the label code !
  1601. + first inlined procedures and function work
  1602. (warning there might be allowed cases were the result is still wrong !!)
  1603. * UseBrower updated gives a global list of all position of all used symbols
  1604. with switch -gb
  1605. Revision 1.13 1998/05/12 10:47:00 peter
  1606. * moved printstatus to verb_def
  1607. + V_Normal which is between V_Error and V_Warning and doesn't have a
  1608. prefix like error: warning: and is included in V_Default
  1609. * fixed some messages
  1610. * first time parameter scan is only for -v and -T
  1611. - removed old style messages
  1612. Revision 1.12 1998/05/11 13:07:56 peter
  1613. + $ifdef NEWPPU for the new ppuformat
  1614. + $define GDB not longer required
  1615. * removed all warnings and stripped some log comments
  1616. * no findfirst/findnext anymore to remove smartlink *.o files
  1617. Revision 1.11 1998/05/06 18:36:53 peter
  1618. * tai_section extended with code,data,bss sections and enumerated type
  1619. * ident 'compiled by FPC' moved to pmodules
  1620. * small fix for smartlink
  1621. Revision 1.10 1998/05/04 17:54:28 peter
  1622. + smartlinking works (only case jumptable left todo)
  1623. * redesign of systems.pas to support assemblers and linkers
  1624. + Unitname is now also in the PPU-file, increased version to 14
  1625. Revision 1.9 1998/05/01 16:38:45 florian
  1626. * handling of private and protected fixed
  1627. + change_keywords_to_tp implemented to remove
  1628. keywords which aren't supported by tp
  1629. * break and continue are now symbols of the system unit
  1630. + widestring, longstring and ansistring type released
  1631. Revision 1.8 1998/04/30 15:59:41 pierre
  1632. * GDB works again better :
  1633. correct type info in one pass
  1634. + UseTokenInfo for better source position
  1635. * fixed one remaining bug in scanner for line counts
  1636. * several little fixes
  1637. Revision 1.7 1998/04/29 10:33:59 pierre
  1638. + added some code for ansistring (not complete nor working yet)
  1639. * corrected operator overloading
  1640. * corrected nasm output
  1641. + started inline procedures
  1642. + added starstarn : use ** for exponentiation (^ gave problems)
  1643. + started UseTokenInfo cond to get accurate positions
  1644. Revision 1.6 1998/04/27 23:10:28 peter
  1645. + new scanner
  1646. * $makelib -> if smartlink
  1647. * small filename fixes pmodule.setfilename
  1648. * moved import from files.pas -> import.pas
  1649. Revision 1.5 1998/04/14 23:27:03 florian
  1650. + exclude/include with constant second parameter added
  1651. Revision 1.4 1998/04/10 14:41:43 peter
  1652. * removed some Hints
  1653. * small speed optimization for AsmLn
  1654. Revision 1.3 1998/04/03 09:51:00 daniel
  1655. * Fixed heap allocation for OS/2.
  1656. }