pmodules.pas 46 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302
  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 TEST_IMPL does not work well }
  20. interface
  21. uses
  22. files;
  23. procedure addlinkerfiles(hp:pmodule);
  24. procedure loadsystemunit;
  25. procedure proc_unit;
  26. procedure proc_program(islibrary : boolean);
  27. implementation
  28. uses
  29. cobjects,verbose,systems,globals,
  30. symtable,aasm,hcodegen,
  31. link,assemble,import
  32. {$ifndef OLDPPU}
  33. ,ppu
  34. {$endif OLDPPU}
  35. {$ifdef i386}
  36. ,i386
  37. {$endif}
  38. {$ifdef m68k}
  39. ,m68k
  40. {$endif}
  41. ,scanner,pbase,psystem,pdecl,psub,parser;
  42. procedure addlinkerfiles(hp:pmodule);
  43. begin
  44. with hp^ do
  45. begin
  46. while not linkofiles.empty do
  47. Linker.AddObject(linkofiles.Get);
  48. while not linksharedlibs.empty do
  49. Linker.AddSharedLibrary(linksharedlibs.Get);
  50. while not linkstaticlibs.empty do
  51. Linker.AddStaticLibrary(linkstaticlibs.Get);
  52. end;
  53. end;
  54. procedure insertsegment;
  55. procedure fixseg(p:paasmoutput;sec:tsection);
  56. begin
  57. p^.insert(new(pai_section,init(sec)));
  58. if (cs_smartlink in aktswitches) then
  59. p^.insert(new(pai_cut,init));
  60. p^.concat(new(pai_section,init(sec_none)));
  61. end;
  62. begin
  63. {Insert Ident of the compiler}
  64. if (not (cs_smartlink in aktswitches))
  65. {$ifndef EXTDEBUG}
  66. and (not current_module^.is_unit)
  67. {$endif}
  68. then
  69. begin
  70. datasegment^.insert(new(pai_align,init(4)));
  71. datasegment^.insert(new(pai_string,init('FPC '+version_string+' for '+target_string+' - '+target_info.short_name)));
  72. end;
  73. { Insert start and end of sections }
  74. fixseg(codesegment,sec_code);
  75. fixseg(datasegment,sec_data);
  76. fixseg(bsssegment,sec_bss);
  77. fixseg(consts,sec_data);
  78. end;
  79. procedure insertheap;
  80. begin
  81. if (cs_smartlink in aktswitches) then
  82. begin
  83. bsssegment^.concat(new(pai_cut,init));
  84. datasegment^.concat(new(pai_cut,init));
  85. end;
  86. { On the Macintosh Classic M68k Architecture
  87. The Heap variable is simply a POINTER to the
  88. real HEAP. The HEAP must be set up by the RTL
  89. and must store the pointer in this value.
  90. On OS/2 the heap is also intialized by the RTL. We do
  91. not output a pointer }
  92. case target_info.target of
  93. {$ifdef i386}
  94. target_OS2 : ;
  95. {$endif i386}
  96. {$ifdef m68k}
  97. target_Mac68K : bsssegment^.concat(new(pai_datablock,init_global('HEAP',4)));
  98. {$endif m68k}
  99. else
  100. bsssegment^.concat(new(pai_datablock,init_global('HEAP',heapsize)));
  101. end;
  102. datasegment^.concat(new(pai_symbol,init_global('HEAPSIZE')));
  103. datasegment^.concat(new(pai_const,init_32bit(heapsize)));
  104. end;
  105. procedure inserttargetspecific;
  106. begin
  107. {$ifdef i386}
  108. case target_info.target of
  109. target_GO32V2 : begin
  110. { stacksize can be specified }
  111. datasegment^.concat(new(pai_symbol,init_global('__stklen')));
  112. datasegment^.concat(new(pai_const,init_32bit(stacksize)));
  113. end;
  114. target_WIN32 : begin
  115. { Generate an external entry to be sure that _mainCRTStarup will be
  116. linked, can't use concat_external because those aren't written for
  117. asw (PFV) }
  118. datasegment^.concat(new(pai_const,init_symbol('_mainCRTStartup')));
  119. end;
  120. end;
  121. {$endif i386}
  122. end;
  123. {$ifndef OLDPPU}
  124. function loadunit(const s : string;compile_system:boolean) : pmodule;forward;
  125. procedure load_usedunits(compile_system:boolean);
  126. var
  127. pu : pused_unit;
  128. loaded_unit : pmodule;
  129. nextmapentry : longint;
  130. begin
  131. { init the map }
  132. new(current_module^.map);
  133. nextmapentry:=1;
  134. { load the used units from interface }
  135. pu:=pused_unit(current_module^.used_units.first);
  136. while assigned(pu) do
  137. begin
  138. if (not pu^.loaded) and (pu^.in_interface) then
  139. begin
  140. loaded_unit:=loadunit(pu^.name^,false);
  141. if current_module^.compiled then
  142. exit;
  143. { register unit in used units }
  144. pu^.u:=loaded_unit;
  145. pu^.loaded:=true;
  146. { need to recompile the current unit ? }
  147. if loaded_unit^.crc<>pu^.checksum then
  148. begin
  149. current_module^.do_compile:=true;
  150. exit;
  151. end;
  152. { setup the map entry for deref }
  153. current_module^.map^[nextmapentry]:=loaded_unit^.symtable;
  154. inc(nextmapentry);
  155. if nextmapentry>maxunits then
  156. Message(unit_f_too_much_units);
  157. end;
  158. pu:=pused_unit(pu^.next);
  159. end;
  160. { ok, now load the unit }
  161. current_module^.symtable:=new(punitsymtable,loadasunit);
  162. { if this is the system unit insert the intern symbols }
  163. if compile_system then
  164. begin
  165. make_ref:=false;
  166. insertinternsyms(psymtable(current_module^.symtable));
  167. make_ref:=true;
  168. end;
  169. { now only read the implementation part }
  170. current_module^.in_implementation:=true;
  171. { load the used units from implementation }
  172. pu:=pused_unit(current_module^.used_units.first);
  173. while assigned(pu) do
  174. begin
  175. if (not pu^.loaded) and (not pu^.in_interface) then
  176. begin
  177. loaded_unit:=loadunit(pu^.name^,false);
  178. if current_module^.compiled then
  179. exit;
  180. { register unit in used units }
  181. pu^.u:=loaded_unit;
  182. pu^.loaded:=true;
  183. {$ifdef TEST_IMPL}
  184. { need to recompile the current unit ? }
  185. if loaded_unit^.crc<>pu^.checksum then
  186. begin
  187. current_module^.do_compile:=true;
  188. exit;
  189. end;
  190. { setup the map entry for deref }
  191. current_module^.map^[nextmapentry]:=loaded_unit^.symtable;
  192. inc(nextmapentry);
  193. if nextmapentry>maxunits then
  194. Message(unit_f_too_much_units);
  195. {$endif TEST_IMPL}
  196. end;
  197. pu:=pused_unit(pu^.next);
  198. end;
  199. { remove the map, it's not needed anymore }
  200. dispose(current_module^.map);
  201. current_module^.map:=nil;
  202. end;
  203. function loadunit(const s : string;compile_system:boolean) : pmodule;
  204. var
  205. st : punitsymtable;
  206. old_current_ppu : pppufile;
  207. old_current_module,hp : pmodule;
  208. procedure loadppufile;
  209. begin
  210. { load interface section }
  211. if not current_module^.do_compile then
  212. load_interface;
  213. { only load units when we don't recompile }
  214. if not current_module^.do_compile then
  215. load_usedunits(compile_system);
  216. { recompile if set }
  217. if current_module^.do_compile then
  218. begin
  219. { we needn't the ppufile }
  220. if assigned(current_module^.ppufile) then
  221. begin
  222. dispose(current_module^.ppufile,done);
  223. current_module^.ppufile:=nil;
  224. end;
  225. { recompile the unit or give a fatal error if sources not available }
  226. if not(current_module^.sources_avail) then
  227. Message1(unit_f_cant_compile_unit,current_module^.modulename^)
  228. else
  229. begin
  230. if assigned(old_current_module^.current_inputfile) then
  231. old_current_module^.current_inputfile^.tempclose;
  232. compile(current_module^.mainsource^,compile_system);
  233. if (not old_current_module^.compiled) and assigned(old_current_module^.current_inputfile) then
  234. old_current_module^.current_inputfile^.tempreopen;
  235. end;
  236. end
  237. else
  238. begin
  239. { only reassemble ? }
  240. if (current_module^.do_assemble) then
  241. OnlyAsm(current_module^.asmfilename^);
  242. { add the files for the linker }
  243. addlinkerfiles(current_module);
  244. end;
  245. end;
  246. begin
  247. old_current_module:=current_module;
  248. old_current_ppu:=current_ppu;
  249. { be sure not to mix lines from different files }
  250. { update_line; }
  251. { unit not found }
  252. st:=nil;
  253. { search all loaded units }
  254. hp:=pmodule(loaded_units.first);
  255. while assigned(hp) do
  256. begin
  257. if hp^.modulename^=s then
  258. begin
  259. { the unit is already registered }
  260. { and this means that the unit }
  261. { is already compiled }
  262. { else there is a cyclic unit use }
  263. if assigned(hp^.symtable) then
  264. st:=punitsymtable(hp^.symtable)
  265. else
  266. begin
  267. { recompile the unit ? }
  268. if (not current_module^.in_implementation) and (hp^.in_implementation) then
  269. Message(unit_f_circular_unit_reference);
  270. end;
  271. break;
  272. end;
  273. { the next unit }
  274. hp:=pmodule(hp^.next);
  275. end;
  276. { the unit is not in the symtable stack }
  277. if (not assigned(st)) then
  278. begin
  279. { if the unit is loaded remove it first }
  280. if assigned(hp) then
  281. begin
  282. { remove the old unit }
  283. loaded_units.remove(hp);
  284. dispose(hp,done);
  285. end;
  286. { generates a new unit info record }
  287. current_module:=new(pmodule,init(s,true));
  288. current_ppu:=current_module^.ppufile;
  289. { now we can register the unit }
  290. loaded_units.insert(current_module);
  291. { now realy load the ppu }
  292. loadppufile;
  293. { set compiled flag }
  294. current_module^.compiled:=true;
  295. { register the unit _once_ }
  296. usedunits.concat(new(pused_unit,init(current_module,true)));
  297. { load return pointer }
  298. hp:=current_module;
  299. end;
  300. { set the old module }
  301. current_ppu:=old_current_ppu;
  302. current_module:=old_current_module;
  303. loadunit:=hp;
  304. end;
  305. {$else OLDPPU}
  306. {*****************************************************************************
  307. Old PPU
  308. *****************************************************************************}
  309. function loadunit(const s : string;compile_system, in_uses : boolean) : pmodule;forward;
  310. procedure load_ppu(oldhp,hp : pmodule;compile_system : boolean);
  311. var
  312. loaded_unit : pmodule;
  313. b : byte;
  314. checksum,
  315. count,
  316. nextmapentry : longint;
  317. hs : string;
  318. begin
  319. { init the map }
  320. new(hp^.map);
  321. nextmapentry:=1;
  322. { load the used units from interface }
  323. hp^.ppufile^.read_data(b,1,count);
  324. while (b=ibloadunit) do
  325. begin
  326. { read unit name }
  327. hp^.ppufile^.read_data(hs[0],1,count);
  328. hp^.ppufile^.read_data(hs[1],byte(hs[0]),count);
  329. hp^.ppufile^.read_data(checksum,4,count);
  330. loaded_unit:=loadunit(hs,false,false);
  331. if hp^.compiled then
  332. exit;
  333. { if the crc of a used unit is the same as }
  334. { written to the PPU file, we needn't to }
  335. { recompile the current unit }
  336. if (loaded_unit^.crc<>checksum) then
  337. begin
  338. { we have to compile the current unit }
  339. { remove stuff which isn't needed }
  340. { forget the map }
  341. dispose(hp^.map);
  342. hp^.map:=nil;
  343. hp^.ppufile^.close;
  344. dispose(hp^.ppufile,done);
  345. hp^.ppufile:=nil;
  346. if not(hp^.sources_avail) then
  347. Message1(unit_f_cant_compile_unit,hp^.modulename^)
  348. else
  349. begin
  350. if assigned(oldhp^.current_inputfile) then
  351. oldhp^.current_inputfile^.tempclose;
  352. compile(hp^.mainsource^,compile_system);
  353. if (not oldhp^.compiled) and assigned(oldhp^.current_inputfile) then
  354. oldhp^.current_inputfile^.tempreopen;
  355. end;
  356. exit;
  357. end;
  358. { setup the map entry for deref }
  359. hp^.map^[nextmapentry]:=loaded_unit^.symtable;
  360. inc(nextmapentry);
  361. if nextmapentry>maxunits then
  362. Message(unit_f_too_much_units);
  363. { read until ibend }
  364. hp^.ppufile^.read_data(b,1,count);
  365. end;
  366. { ok, now load the unit }
  367. hp^.symtable:=new(punitsymtable,load(hp^.modulename^));
  368. { if this is the system unit insert the intern }
  369. { symbols }
  370. make_ref:=false;
  371. if compile_system then
  372. insertinternsyms(psymtable(hp^.symtable));
  373. make_ref:=true;
  374. { now only read the implementation part }
  375. hp^.in_implementation:=true;
  376. { load the used units from implementation }
  377. hp^.ppufile^.read_data(b,1,count);
  378. while (b<>ibend) and (b=ibloadunit) do
  379. begin
  380. { read unit name }
  381. hp^.ppufile^.read_data(hs[0],1,count);
  382. hp^.ppufile^.read_data(hs[1],byte(hs[0]),count);
  383. hp^.ppufile^.read_data(checksum,4,count);
  384. loaded_unit:=loadunit(hs,false,false);
  385. if hp^.compiled then exit;
  386. { if the crc of a used unit is the same as }
  387. { written to the PPU file, we needn't to }
  388. { recompile the current unit }
  389. { but for the implementation part }
  390. { the written crc is false, because }
  391. { not defined when writing the ppufile !! }
  392. {$ifdef TEST_IMPL}
  393. if (checksum<>0) and (loaded_unit^.crc<>checksum) then
  394. begin
  395. { we have to compile the current unit }
  396. { remove stuff which isn't needed }
  397. { forget the map }
  398. dispose(hp^.map);
  399. hp^.map:=nil;
  400. hp^.ppufile^.close;
  401. dispose(hp^.ppufile,done);
  402. hp^.ppufile:=nil;
  403. if not(hp^.sources_avail) then
  404. Message1(unit_f_cant_compile_unit,hp^.modulename^)
  405. else
  406. begin
  407. oldhp^.current_inputfile^.tempclose;
  408. compile(hp^.mainsource^,compile_system);
  409. oldhp^.current_inputfile^.tempclose;
  410. end;
  411. exit;
  412. end;
  413. {$endif TEST_IMPL}
  414. { read until ibend }
  415. hp^.ppufile^.read_data(b,1,count);
  416. end;
  417. hp^.ppufile^.close;
  418. dispose(hp^.map);
  419. hp^.map:=nil;
  420. end;
  421. function loadunit(const s : string;compile_system, in_uses : boolean) : pmodule;
  422. var
  423. st : punitsymtable;
  424. old_current_module,hp,nextmodule : pmodule;
  425. pu : pused_unit;
  426. hs : pstring;
  427. begin
  428. old_current_module:=current_module;
  429. { be sure not to mix lines from different files }
  430. { update_line; }
  431. { unit not found }
  432. st:=nil;
  433. { search all loaded units }
  434. hp:=pmodule(loaded_units.first);
  435. while assigned(hp) do
  436. begin
  437. if hp^.modulename^=s then
  438. begin
  439. { the unit is already registered }
  440. { and this means that the unit }
  441. { is already compiled }
  442. { else there is a cyclic unit use }
  443. if assigned(hp^.symtable) then
  444. st:=punitsymtable(hp^.symtable)
  445. else
  446. begin
  447. { recompile the unit ? }
  448. if (not current_module^.in_implementation) and (hp^.in_implementation) then
  449. Message(unit_f_circular_unit_reference);
  450. end;
  451. break;
  452. end;
  453. { the next unit }
  454. hp:=pmodule(hp^.next);
  455. end;
  456. { no error and the unit isn't loaded }
  457. if not(assigned(hp)) and (st=nil) then
  458. begin
  459. { generates a new unit info record }
  460. hp:=new(pmodule,init(s,true));
  461. { now we can register the unit }
  462. loaded_units.insert(hp);
  463. current_module:=hp;
  464. { force build ? }
  465. if (hp^.do_compile) or (hp^.sources_avail and do_build) then
  466. begin
  467. { we needn't the ppufile }
  468. if assigned(hp^.ppufile) then
  469. begin
  470. dispose(hp^.ppufile,done);
  471. hp^.ppufile:=nil;
  472. end;
  473. if not(hp^.sources_avail) then
  474. Message1(unit_f_cant_compile_unit,hp^.modulename^)
  475. else
  476. begin
  477. if assigned(old_current_module^.current_inputfile) then
  478. old_current_module^.current_inputfile^.tempclose;
  479. compile(hp^.mainsource^,compile_system);
  480. if (not old_current_module^.compiled) and assigned(old_current_module^.current_inputfile) then
  481. old_current_module^.current_inputfile^.tempreopen;
  482. end;
  483. end
  484. else
  485. begin
  486. { only reassemble ? }
  487. if (hp^.do_assemble) then
  488. OnlyAsm(hp^.asmfilename^);
  489. { we should know there the PPU file else it's an error and
  490. we can't load the unit }
  491. if hp^.ppufile^.name^<>'' then
  492. load_ppu(old_current_module,hp,compile_system);
  493. { add the files for the linker }
  494. addlinkerfiles(hp);
  495. end;
  496. { register the unit _once_ }
  497. usedunits.concat(new(pused_unit,init(hp,0)));
  498. { the unit is written, so we can set the symtable type }
  499. { to unitsymtable, else we get some dupid errors }
  500. { this is not the right place because of the }
  501. { ready label }
  502. { psymtable(hp^.symtable)^.symtabletype:=unitsymtable; }
  503. { placed at this end of proc_unit }
  504. psymtable(hp^.symtable)^.unitid:=0;
  505. { reset the unitnumbers for the other units }
  506. pu:=pused_unit(old_current_module^.used_units.first);
  507. while assigned(pu) do
  508. begin
  509. psymtable(pu^.u^.symtable)^.unitid:=pu^.unitid;
  510. pu:=pused_unit(pu^.next);
  511. end;
  512. end
  513. else
  514. if assigned(hp) and (st=nil) then
  515. begin
  516. { we have to compile the unit again, but it is already inserted !!}
  517. { we may have problem with the lost symtable !! }
  518. current_module:=hp;
  519. { we must preserve the unit chain }
  520. nextmodule:=pmodule(hp^.next);
  521. { we have to cleanup a little }
  522. hp^.special_done;
  523. new(hs);
  524. hs^:=hp^.mainsource^;
  525. hp^.init(hs^,true);
  526. dispose(hs);
  527. { we must preserve the unit chain }
  528. hp^.next:=nextmodule;
  529. if assigned(hp^.ppufile) then
  530. load_ppu(old_current_module,hp,compile_system)
  531. else
  532. begin
  533. {$ifdef UseBrowser}
  534. { here we need to remove the names ! }
  535. hp^.sourcefiles.done;
  536. hp^.sourcefiles.init;
  537. {$endif UseBrowser}
  538. if assigned(old_current_module^.current_inputfile) then
  539. old_current_module^.current_inputfile^.tempclose;
  540. Message1(parser_d_compiling_second_time,hp^.mainsource^);
  541. compile(hp^.mainsource^,compile_system);
  542. if (not old_current_module^.compiled) and assigned(old_current_module^.current_inputfile) then
  543. old_current_module^.current_inputfile^.tempreopen;
  544. end;
  545. current_module^.compiled:=true;
  546. end;
  547. { set the old module }
  548. current_module:=old_current_module;
  549. { the current module uses the unit hp }
  550. current_module^.used_units.concat(new(pused_unit,init(hp,0)));
  551. pused_unit(current_module^.used_units.last)^.in_uses:=in_uses;
  552. if in_uses and not current_module^.in_implementation then
  553. pused_unit(current_module^.used_units.last)^.in_interface:=true;
  554. loadunit:=hp;
  555. end;
  556. {$endif OLDPPU}
  557. procedure loadsystemunit;
  558. var
  559. hp : pmodule;
  560. begin
  561. { if the current file isn't a system unit the the system unit
  562. will be loaded }
  563. if not(cs_compilesystem in aktswitches) then
  564. begin
  565. {$ifndef OLDPPU}
  566. hp:=loadunit(upper(target_info.system_unit),true);
  567. systemunit:=hp^.symtable;
  568. { add to the used units }
  569. current_module^.used_units.concat(new(pused_unit,init(hp,true)));
  570. {$else OLDPPU}
  571. hp:=loadunit(upper(target_info.system_unit),true,true);
  572. systemunit:=hp^.symtable;
  573. { add to the used units }
  574. current_module^.used_units.concat(new(pused_unit,init(hp,0)));
  575. {$endif OLDPPU}
  576. { read default constant definitions }
  577. make_ref:=false;
  578. readconstdefs;
  579. { we could try to overload caret by default }
  580. symtablestack:=systemunit;
  581. { if POWER is defined in the RTL then use it for starstar overloading }
  582. getsym('POWER',false);
  583. if assigned(srsym) and (srsym^.typ=procsym) and
  584. (overloaded_operators[STARSTAR]=nil) then
  585. overloaded_operators[STARSTAR]:=pprocsym(srsym);
  586. make_ref:=true;
  587. end
  588. else
  589. begin
  590. createconstdefs;
  591. systemunit:=nil;
  592. end;
  593. end;
  594. procedure loadunits;
  595. var
  596. s : stringid;
  597. hp : pused_unit;
  598. hp2 : pmodule;
  599. hp3 : psymtable;
  600. oldprocsym:Pprocsym;
  601. begin
  602. oldprocsym:=aktprocsym;
  603. consume(_USES);
  604. {$ifdef DEBUG}
  605. test_symtablestack;
  606. {$endif DEBUG}
  607. repeat
  608. s:=pattern;
  609. consume(ID);
  610. {$ifndef OLDPPU}
  611. hp2:=loadunit(s,false);
  612. { the current module uses the unit hp2 }
  613. current_module^.used_units.concat(new(pused_unit,init(hp2,not current_module^.in_implementation)));
  614. pused_unit(current_module^.used_units.last)^.in_uses:=true;
  615. {$else OLDPPU}
  616. hp2:=loadunit(s,false,true);
  617. {$endif OLDPPU}
  618. if current_module^.compiled then
  619. exit;
  620. refsymtable^.insert(new(punitsym,init(s,hp2^.symtable)));
  621. if token=COMMA then
  622. begin
  623. pattern:='';
  624. consume(COMMA);
  625. end
  626. else
  627. break;
  628. until false;
  629. consume(SEMICOLON);
  630. { set the symtable to systemunit so it gets reorderd correctly }
  631. symtablestack:=systemunit;
  632. { now insert the units in the symtablestack }
  633. hp:=pused_unit(current_module^.used_units.first);
  634. while assigned(hp) do
  635. begin
  636. {$IfDef GDB}
  637. if (cs_debuginfo in aktswitches) and
  638. not hp^.is_stab_written then
  639. begin
  640. punitsymtable(hp^.u^.symtable)^.concattypestabto(debuglist);
  641. hp^.is_stab_written:=true;
  642. hp^.unitid:=psymtable(hp^.u^.symtable)^.unitid;
  643. end;
  644. {$EndIf GDB}
  645. if hp^.in_uses then
  646. begin
  647. hp3:=symtablestack;
  648. while assigned(hp3) do
  649. begin
  650. { insert units only once ! }
  651. if hp^.u^.symtable=hp3 then
  652. break;
  653. hp3:=hp3^.next;
  654. { unit isn't inserted }
  655. if hp3=nil then
  656. begin
  657. psymtable(hp^.u^.symtable)^.next:=symtablestack;
  658. symtablestack:=psymtable(hp^.u^.symtable);
  659. {$ifdef CHAINPROCSYMS}
  660. symtablestack^.chainprocsyms;
  661. {$endif CHAINPROCSYMS}
  662. {$ifdef DEBUG}
  663. test_symtablestack;
  664. {$endif DEBUG}
  665. end;
  666. end;
  667. end;
  668. hp:=pused_unit(hp^.next);
  669. end;
  670. aktprocsym:=oldprocsym;
  671. end;
  672. procedure parse_implementation_uses(symt:Psymtable);
  673. var
  674. old_module_in_implementation : boolean;
  675. begin
  676. if token=_USES then
  677. begin
  678. old_module_in_implementation:=module_in_implementation;
  679. module_in_implementation:=true;
  680. current_module^.in_implementation:=true;
  681. symt^.symtabletype:=unitsymtable;
  682. loadunits;
  683. symt^.symtabletype:=globalsymtable;
  684. {$ifdef DEBUG}
  685. test_symtablestack;
  686. {$endif DEBUG}
  687. module_in_implementation:=old_module_in_implementation;
  688. end;
  689. end;
  690. procedure proc_unit;
  691. var
  692. { unitname : stringid; }
  693. names:Tstringcontainer;
  694. p : psymtable;
  695. unitst : punitsymtable;
  696. pu : pused_unit;
  697. s1,s2 : ^string; {Saves stack space}
  698. begin
  699. consume(_UNIT);
  700. if token=ID then
  701. begin
  702. { create filenames and unit name }
  703. current_module^.SetFileName(current_module^.current_inputfile^.path^,current_module^.current_inputfile^.name^);
  704. stringdispose(current_module^.modulename);
  705. current_module^.modulename:=stringdup(upper(pattern));
  706. { check for system unit }
  707. new(s1);
  708. new(s2);
  709. s1^:=upper(target_info.system_unit);
  710. s2^:=upper(current_module^.current_inputfile^.name^);
  711. if (cs_compilesystem in aktswitches) then
  712. begin
  713. if (cs_check_unit_name in aktswitches) and
  714. ((length(current_module^.modulename^)>8) or
  715. (current_module^.modulename^<>s1^) or
  716. (current_module^.modulename^<>s2^)) then
  717. Message1(unit_e_illegal_unit_name,s1^);
  718. end
  719. else
  720. if (current_module^.modulename^=s1^) then
  721. Message(unit_w_switch_us_missed);
  722. dispose(s2);
  723. dispose(s1);
  724. { Add Object File }
  725. if (cs_smartlink in aktswitches) then
  726. current_module^.linkstaticlibs.insert(current_module^.libfilename^)
  727. else
  728. current_module^.linkofiles.insert(current_module^.objfilename^);
  729. end;
  730. consume(ID);
  731. consume(SEMICOLON);
  732. consume(_INTERFACE);
  733. { this should be placed after uses !!}
  734. {$ifndef UseNiceNames}
  735. procprefix:='_'+current_module^.modulename^+'$$';
  736. {$else UseNiceNames}
  737. procprefix:='_'+tostr(length(current_module^.unitname^))+lowercase(current_module^.unitname^)+'_';
  738. {$endif UseNiceNames}
  739. parse_only:=true;
  740. { generate now the global symboltable }
  741. p:=new(punitsymtable,init(globalsymtable,current_module^.modulename^));
  742. refsymtable:=p;
  743. unitst:=punitsymtable(p);
  744. { the unit name must be usable as a unit specifier }
  745. { inside the unit itself (PM) }
  746. { this also forbids to have another symbol }
  747. { with the same name as the unit }
  748. refsymtable^.insert(new(punitsym,init(current_module^.modulename^,unitst)));
  749. { set the symbol table for the current unit }
  750. { this must be set later for interdependency }
  751. { current_module^.symtable:=psymtable(p); }
  752. { a unit compiled at command line must be inside the loaded_unit list }
  753. if (compile_level=1) then
  754. begin
  755. loaded_units.insert(current_module);
  756. if cs_unit_to_lib in initswitches then
  757. begin
  758. current_module^.flags:=current_module^.flags or uf_in_library;
  759. if cs_shared_lib in initswitches then
  760. current_module^.flags:=current_module^.flags or uf_shared_library;
  761. end;
  762. end;
  763. { insert qualifier for the system unit (allows system.writeln) }
  764. if not(cs_compilesystem in aktswitches) then
  765. begin
  766. { insert the system unit }
  767. { it is allways the first }
  768. systemunit^.next:=nil;
  769. symtablestack:=systemunit;
  770. refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
  771. if token=_USES then
  772. begin
  773. unitst^.symtabletype:=unitsymtable;
  774. loadunits;
  775. { has it been compiled at a higher level ?}
  776. if current_module^.compiled then
  777. exit;
  778. unitst^.symtabletype:=globalsymtable;
  779. end;
  780. { ... but insert the symbol table later }
  781. p^.next:=symtablestack;
  782. symtablestack:=p;
  783. end
  784. else
  785. { while compiling a system unit, some types are directly inserted }
  786. begin
  787. p^.next:=symtablestack;
  788. symtablestack:=p;
  789. insert_intern_types(p);
  790. end;
  791. { displaced for inter-dependency considerations }
  792. current_module^.symtable:=psymtable(p);
  793. constsymtable:=symtablestack;
  794. { ... parse the declarations }
  795. read_interface_declarations;
  796. consume(_IMPLEMENTATION);
  797. parse_only:=false;
  798. {$ifdef GDB}
  799. { add all used definitions even for implementation}
  800. if (cs_debuginfo in aktswitches) then
  801. begin
  802. { all types }
  803. punitsymtable(refsymtable)^.concattypestabto(debuglist);
  804. { and all local symbols}
  805. refsymtable^.concatstabto(debuglist);
  806. end;
  807. {$endif GDB}
  808. { generates static symbol table }
  809. p:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
  810. {Generate a procsym.}
  811. make_ref:=false;
  812. aktprocsym:=new(Pprocsym,init(current_module^.modulename^+'_init'));
  813. aktprocsym^.definition:=new(Pprocdef,init);
  814. aktprocsym^.definition^.options:=aktprocsym^.definition^.options or pounitinit;
  815. aktprocsym^.definition^.setmangledname(current_module^.modulename^+'_init');
  816. make_ref:=true;
  817. {The generated procsym has a local symtable. Discard it and turn
  818. it into the static one.}
  819. dispose(aktprocsym^.definition^.localst,done);
  820. aktprocsym^.definition^.localst:=p;
  821. { remove the globalsymtable from the symtable stack }
  822. { to reinsert it after loading the implementation units }
  823. symtablestack:=unitst^.next;
  824. { number the definitions, so a deref from other units works }
  825. refsymtable^.number_defs;
  826. { Read the implementation units }
  827. parse_implementation_uses(unitst);
  828. numberunits;
  829. { now we can change refsymtable }
  830. refsymtable:=p;
  831. { but reinsert the global symtable as lasts }
  832. unitst^.next:=symtablestack;
  833. symtablestack:=unitst;
  834. {$ifdef DEBUG}
  835. test_symtablestack;
  836. {$endif DEBUG}
  837. constsymtable:=symtablestack;
  838. {$ifdef Splitheap}
  839. if testsplit then
  840. begin
  841. Split_Heap;
  842. allow_special:=true;
  843. Switch_to_temp_heap;
  844. end;
  845. { it will report all crossings }
  846. allow_special:=false;
  847. {$endif Splitheap}
  848. { set some informations }
  849. procinfo.retdef:=voiddef;
  850. procinfo._class:=nil;
  851. procinfo.call_offset:=8;
  852. { for temporary values }
  853. procinfo.framepointer:=frame_pointer;
  854. { clear flags }
  855. procinfo.flags:=0;
  856. { Create a new procedure }
  857. codegen_newprocedure;
  858. { Compile the unit }
  859. names.init;
  860. names.insert(current_module^.modulename^+'_init');
  861. names.insert('INIT$$'+current_module^.modulename^);
  862. compile_proc_body(names,true,false);
  863. names.done;
  864. { Shutdown the codegen for this procedure }
  865. codegen_doneprocedure;
  866. {$ifdef dummy}
  867. if token=_FINALIZATION then
  868. begin
  869. current_module^.flags:=current_module^.flags or uf_finalize;
  870. { clear flags }
  871. procinfo.flags:=0;
  872. {Reset the codegenerator.}
  873. codegen_newprocedure;
  874. names.init;
  875. names.insert(current_module^.modulename^+'_finalize');
  876. names.insert('FINALIZE$$'+current_module^.modulename^);
  877. compile_proc_body(names,true,false);
  878. names.done;
  879. codegen_doneprocedure;
  880. end;
  881. {$endif dummy}
  882. consume(POINT);
  883. { size of the static data }
  884. datasize:=symtablestack^.datasize;
  885. { unsed static symbols ? }
  886. symtablestack^.allsymbolsused;
  887. {$ifdef GDB}
  888. { add all used definitions even for implementation}
  889. if (cs_debuginfo in aktswitches) then
  890. begin
  891. { all types }
  892. punitsymtable(symtablestack)^.concattypestabto(debuglist);
  893. { and all local symbols}
  894. symtablestack^.concatstabto(debuglist);
  895. end;
  896. {$endif GDB}
  897. current_module^.in_implementation:=false;
  898. { deletes all symtables generated in the implementation part }
  899. while symtablestack^.symtabletype<>globalsymtable do
  900. dellexlevel;
  901. { tests, if all forwards are resolved }
  902. symtablestack^.check_forwards;
  903. symtablestack^.symtabletype:=unitsymtable;
  904. punitsymtable(symtablestack)^.is_stab_written:=false;
  905. {Write out the unit if the compile was succesfull.}
  906. if status.errorcount=0 then
  907. writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack));
  908. pu:=pused_unit(usedunits.first);
  909. while assigned(pu) do
  910. begin
  911. punitsymtable(pu^.u^.symtable)^.is_stab_written:=false;
  912. pu:=pused_unit(pu^.next);
  913. end;
  914. inc(datasize,symtablestack^.datasize);
  915. { generate imports }
  916. if current_module^.uses_imports then
  917. importlib^.generatelib;
  918. { finish asmlist by adding segment starts }
  919. insertsegment;
  920. end;
  921. procedure proc_program(islibrary : boolean);
  922. var
  923. st : psymtable;
  924. names : Tstringcontainer;
  925. begin
  926. { Trying to compile the system unit... }
  927. { if no unit defined... then issue a }
  928. { fatal error (avoids pointer problems)}
  929. { when referencing the non-existant }
  930. { system unit. }
  931. { System Unit should be compiled using proc_unit !! (PFV) }
  932. { if (cs_compilesystem in aktswitches) then
  933. Begin
  934. if token<>_UNIT then
  935. Message1(scan_f_syn_expected,'UNIT');
  936. consume(_UNIT);
  937. end;}
  938. parse_only:=false;
  939. if islibrary then
  940. begin
  941. consume(_LIBRARY);
  942. stringdispose(current_module^.modulename);
  943. current_module^.modulename:=stringdup(pattern);
  944. consume(ID);
  945. consume(SEMICOLON);
  946. end
  947. else
  948. { is there an program head ? }
  949. if token=_PROGRAM then
  950. begin
  951. consume(_PROGRAM);
  952. stringdispose(current_module^.modulename);
  953. current_module^.modulename:=stringdup(pattern);
  954. consume(ID);
  955. if token=LKLAMMER then
  956. begin
  957. consume(LKLAMMER);
  958. idlist;
  959. consume(RKLAMMER);
  960. end;
  961. consume(SEMICOLON);
  962. end;
  963. { insert after the unit symbol tables the static symbol table }
  964. { of the program }
  965. st:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
  966. {Generate a procsym.}
  967. make_ref:=false;
  968. aktprocsym:=new(Pprocsym,init('main'));
  969. aktprocsym^.definition:=new(Pprocdef,init);
  970. aktprocsym^.definition^.options:=aktprocsym^.definition^.options or poproginit;
  971. aktprocsym^.definition^.setmangledname(target_os.Cprefix+'main');
  972. make_ref:=true;
  973. {The localst is a local symtable. Change it into the static
  974. symtable.}
  975. dispose(aktprocsym^.definition^.localst,done);
  976. aktprocsym^.definition^.localst:=st;
  977. refsymtable:=st;
  978. { necessary for browser }
  979. loaded_units.insert(current_module);
  980. {Insert the symbols of the system unit into the stack of symbol
  981. tables.}
  982. symtablestack:=systemunit;
  983. systemunit^.next:=nil;
  984. refsymtable^.insert(new(punitsym,init('SYSTEM',systemunit)));
  985. {Load the units used by the program we compile.}
  986. if token=_USES then
  987. loadunits;
  988. {Insert the name of the main program into the symbol table.}
  989. if current_module^.modulename^<>'' then
  990. st^.insert(new(pprogramsym,init(current_module^.modulename^)));
  991. { ...is also constsymtable, this is the symtable where }
  992. { the elements of enumeration types are inserted }
  993. constsymtable:=st;
  994. { set some informations about the main program }
  995. with procinfo do
  996. begin
  997. retdef:=voiddef;
  998. _class:=nil;
  999. call_offset:=8;
  1000. framepointer:=frame_pointer;
  1001. flags:=0;
  1002. end;
  1003. procprefix:='';
  1004. in_except_block:=false;
  1005. codegen_newprocedure;
  1006. {The program intialization needs an alias, so it can be called
  1007. from the bootstrap code.}
  1008. names.init;
  1009. names.insert('program_init');
  1010. names.insert('PASCALMAIN');
  1011. names.insert(target_os.cprefix+'main');
  1012. compile_proc_body(names,true,false);
  1013. names.done;
  1014. codegen_doneprocedure;
  1015. consume(POINT);
  1016. if (cs_smartlink in aktswitches) then
  1017. current_module^.linkstaticlibs.insert(current_module^.libfilename^)
  1018. else
  1019. current_module^.linkofiles.insert(current_module^.objfilename^);
  1020. { insert heap }
  1021. insertheap;
  1022. { generate imports }
  1023. if current_module^.uses_imports then
  1024. importlib^.generatelib;
  1025. inserttargetspecific;
  1026. datasize:=symtablestack^.datasize;
  1027. { finish asmlist by adding segment starts }
  1028. insertsegment;
  1029. end;
  1030. end.
  1031. {
  1032. $Log$
  1033. Revision 1.32 1998-06-25 08:48:16 florian
  1034. * first version of rtti support
  1035. Revision 1.31 1998/06/24 14:48:35 peter
  1036. * ifdef newppu -> ifndef oldppu
  1037. Revision 1.30 1998/06/17 14:10:16 peter
  1038. * small os2 fixes
  1039. * fixed interdependent units with newppu (remake3 under linux works now)
  1040. Revision 1.29 1998/06/16 08:56:25 peter
  1041. + targetcpu
  1042. * cleaner pmodules for newppu
  1043. Revision 1.28 1998/06/13 00:10:10 peter
  1044. * working browser and newppu
  1045. * some small fixes against crashes which occured in bp7 (but not in
  1046. fpc?!)
  1047. Revision 1.27 1998/06/11 13:58:08 peter
  1048. * small fix to let newppu compile
  1049. Revision 1.26 1998/06/09 16:01:47 pierre
  1050. + added procedure directive parsing for procvars
  1051. (accepted are popstack cdecl and pascal)
  1052. + added C vars with the following syntax
  1053. var C calias 'true_c_name';(can be followed by external)
  1054. reason is that you must add the Cprefix
  1055. which is target dependent
  1056. Revision 1.25 1998/06/08 22:59:49 peter
  1057. * smartlinking works for win32
  1058. * some defines to exclude some compiler parts
  1059. Revision 1.24 1998/06/08 13:13:44 pierre
  1060. + temporary variables now in temp_gen.pas unit
  1061. because it is processor independent
  1062. * mppc68k.bat modified to undefine i386 and support_mmx
  1063. (which are defaults for i386)
  1064. Revision 1.23 1998/06/05 17:47:29 peter
  1065. * some better uses clauses
  1066. Revision 1.22 1998/06/05 14:37:34 pierre
  1067. * fixes for inline for operators
  1068. * inline procedure more correctly restricted
  1069. Revision 1.21 1998/06/04 23:51:53 peter
  1070. * m68k compiles
  1071. + .def file creation moved to gendef.pas so it could also be used
  1072. for win32
  1073. Revision 1.20 1998/06/04 09:55:42 pierre
  1074. * demangled name of procsym reworked to become independant of the mangling scheme
  1075. Revision 1.19 1998/06/03 23:40:38 peter
  1076. + unlimited file support, release tempclose
  1077. Revision 1.18 1998/06/03 22:49:00 peter
  1078. + wordbool,longbool
  1079. * rename bis,von -> high,low
  1080. * moved some systemunit loading/creating to psystem.pas
  1081. Revision 1.17 1998/05/28 14:40:25 peter
  1082. * fixes for newppu, remake3 works now with it
  1083. Revision 1.16 1998/05/27 19:45:06 peter
  1084. * symtable.pas splitted into includefiles
  1085. * symtable adapted for $ifdef NEWPPU
  1086. Revision 1.15 1998/05/23 01:21:22 peter
  1087. + aktasmmode, aktoptprocessor, aktoutputformat
  1088. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  1089. + $LIBNAME to set the library name where the unit will be put in
  1090. * splitted cgi386 a bit (codeseg to large for bp7)
  1091. * nasm, tasm works again. nasm moved to ag386nsm.pas
  1092. Revision 1.14 1998/05/20 09:42:35 pierre
  1093. + UseTokenInfo now default
  1094. * unit in interface uses and implementation uses gives error now
  1095. * only one error for unknown symbol (uses lastsymknown boolean)
  1096. the problem came from the label code !
  1097. + first inlined procedures and function work
  1098. (warning there might be allowed cases were the result is still wrong !!)
  1099. * UseBrower updated gives a global list of all position of all used symbols
  1100. with switch -gb
  1101. Revision 1.13 1998/05/12 10:47:00 peter
  1102. * moved printstatus to verb_def
  1103. + V_Normal which is between V_Error and V_Warning and doesn't have a
  1104. prefix like error: warning: and is included in V_Default
  1105. * fixed some messages
  1106. * first time parameter scan is only for -v and -T
  1107. - removed old style messages
  1108. Revision 1.12 1998/05/11 13:07:56 peter
  1109. + $ifdef NEWPPU for the new ppuformat
  1110. + $define GDB not longer required
  1111. * removed all warnings and stripped some log comments
  1112. * no findfirst/findnext anymore to remove smartlink *.o files
  1113. Revision 1.11 1998/05/06 18:36:53 peter
  1114. * tai_section extended with code,data,bss sections and enumerated type
  1115. * ident 'compiled by FPC' moved to pmodules
  1116. * small fix for smartlink
  1117. Revision 1.10 1998/05/04 17:54:28 peter
  1118. + smartlinking works (only case jumptable left todo)
  1119. * redesign of systems.pas to support assemblers and linkers
  1120. + Unitname is now also in the PPU-file, increased version to 14
  1121. Revision 1.9 1998/05/01 16:38:45 florian
  1122. * handling of private and protected fixed
  1123. + change_keywords_to_tp implemented to remove
  1124. keywords which aren't supported by tp
  1125. * break and continue are now symbols of the system unit
  1126. + widestring, longstring and ansistring type released
  1127. Revision 1.8 1998/04/30 15:59:41 pierre
  1128. * GDB works again better :
  1129. correct type info in one pass
  1130. + UseTokenInfo for better source position
  1131. * fixed one remaining bug in scanner for line counts
  1132. * several little fixes
  1133. Revision 1.7 1998/04/29 10:33:59 pierre
  1134. + added some code for ansistring (not complete nor working yet)
  1135. * corrected operator overloading
  1136. * corrected nasm output
  1137. + started inline procedures
  1138. + added starstarn : use ** for exponentiation (^ gave problems)
  1139. + started UseTokenInfo cond to get accurate positions
  1140. Revision 1.6 1998/04/27 23:10:28 peter
  1141. + new scanner
  1142. * $makelib -> if smartlink
  1143. * small filename fixes pmodule.setfilename
  1144. * moved import from files.pas -> import.pas
  1145. Revision 1.5 1998/04/14 23:27:03 florian
  1146. + exclude/include with constant second parameter added
  1147. Revision 1.4 1998/04/10 14:41:43 peter
  1148. * removed some Hints
  1149. * small speed optimization for AsmLn
  1150. Revision 1.3 1998/04/03 09:51:00 daniel
  1151. * Fixed heap allocation for OS/2.
  1152. }