pmodules.pas 63 KB

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