pmodules.pas 62 KB

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