fmodule.pas 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. This unit implements the first loading and searching of the modules
  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 fmodule;
  19. {$i fpcdefs.inc}
  20. {$ifdef go32v2}
  21. {$define shortasmprefix}
  22. {$endif}
  23. {$ifdef tos}
  24. {$define shortasmprefix}
  25. {$endif}
  26. {$ifdef OS2}
  27. { Allthough OS/2 supports long filenames I play it safe and
  28. use 8.3 filenames, because this allows the compiler to run
  29. on a FAT partition. (DM) }
  30. {$define shortasmprefix}
  31. {$endif}
  32. interface
  33. uses
  34. cutils,cclasses,
  35. globals,finput,
  36. symbase,aasmbase;
  37. type
  38. trecompile_reason = (rr_unknown,
  39. rr_noppu,rr_sourcenewer,rr_build,rr_crcchanged
  40. );
  41. TExternalsItem=class(TLinkedListItem)
  42. public
  43. found : longbool;
  44. data : pstring;
  45. constructor Create(const s:string);
  46. Destructor Destroy;override;
  47. end;
  48. tlinkcontaineritem=class(tlinkedlistitem)
  49. public
  50. data : pstring;
  51. needlink : cardinal;
  52. constructor Create(const s:string;m:cardinal);
  53. destructor Destroy;override;
  54. end;
  55. tlinkcontainer=class(tlinkedlist)
  56. procedure add(const s : string;m:cardinal);
  57. function get(var m:cardinal) : string;
  58. function getusemask(mask:cardinal) : string;
  59. function find(const s:string):boolean;
  60. end;
  61. tmodule = class;
  62. tused_unit = class;
  63. tunitmap = array[0..maxunits-1] of tmodule;
  64. punitmap = ^tunitmap;
  65. tmodule = class(tmodulebase)
  66. do_reload, { force reloading of the unit }
  67. do_compile, { need to compile the sources }
  68. sources_avail, { if all sources are reachable }
  69. is_unit,
  70. in_interface, { processing the implementation part? }
  71. in_global : boolean; { allow global settings }
  72. recompile_reason : trecompile_reason; { the reason why the unit should be recompiled }
  73. crc,
  74. interface_crc : cardinal;
  75. flags : cardinal; { the PPU flags }
  76. islibrary : boolean; { if it is a library (win32 dll) }
  77. map : punitmap; { mapping of all used units }
  78. unitcount : longint; { local unit counter }
  79. globalsymtable, { pointer to the global symtable of this unit }
  80. localsymtable : tsymtable;{ pointer to the local symtable of this unit }
  81. scanner : pointer; { scanner object used }
  82. loaded_from : tmodule;
  83. uses_imports : boolean; { Set if the module imports from DLL's.}
  84. imports : tlinkedlist;
  85. _exports : tlinkedlist;
  86. externals : tlinkedlist; {Only for DLL scanners by using Unix-style $LINKLIB }
  87. resourcefiles : tstringlist;
  88. linkunitofiles,
  89. linkunitstaticlibs,
  90. linkunitsharedlibs,
  91. linkotherofiles, { objects,libs loaded from the source }
  92. linkothersharedlibs, { using $L or $LINKLIB or import lib (for linux) }
  93. linkotherstaticlibs : tlinkcontainer;
  94. used_units : tlinkedlist;
  95. dependent_units : tlinkedlist;
  96. localunitsearchpath, { local searchpaths }
  97. localobjectsearchpath,
  98. localincludesearchpath,
  99. locallibrarysearchpath : TSearchPathList;
  100. asmprefix : pstring; { prefix for the smartlink asmfiles }
  101. librarydata : tasmlibrarydata; { librarydata for this module }
  102. {create creates a new module which name is stored in 's'. LoadedFrom
  103. points to the module calling it. It is nil for the first compiled
  104. module. This allow inheritence of all path lists. MUST pay attention
  105. to that when creating link.res!!!!(mazen)}
  106. constructor create(LoadedFrom:TModule;const s:string;_is_unit:boolean);
  107. destructor destroy;override;
  108. procedure reset;virtual;
  109. procedure adddependency(callermodule:tmodule);
  110. procedure flagdependent(callermodule:tmodule);
  111. function addusedunit(hp:tmodule;inuses:boolean):tused_unit;
  112. procedure numberunits;
  113. end;
  114. tused_unit = class(tlinkedlistitem)
  115. unitid : longint;
  116. checksum,
  117. interface_checksum : cardinal;
  118. in_uses,
  119. in_interface,
  120. is_stab_written : boolean;
  121. u : tmodule;
  122. constructor create(_u : tmodule;intface,inuses:boolean);
  123. end;
  124. tdependent_unit = class(tlinkedlistitem)
  125. u : tmodule;
  126. constructor create(_u : tmodule);
  127. end;
  128. var
  129. main_module : tmodule; { Main module of the program }
  130. current_module : tmodule; { Current module which is compiled or loaded }
  131. compiled_module : tmodule; { Current module which is compiled }
  132. usedunits : tlinkedlist; { Used units for this program }
  133. loaded_units : tlinkedlist; { All loaded units }
  134. SmartLinkOFiles : TStringList; { List of .o files which are generated,
  135. used to delete them after linking }
  136. function get_source_file(moduleindex,fileindex : longint) : tinputfile;
  137. implementation
  138. uses
  139. {$ifdef delphi}
  140. dmisc,
  141. {$else}
  142. dos,
  143. {$endif}
  144. verbose,systems,
  145. scanner;
  146. {*****************************************************************************
  147. Global Functions
  148. *****************************************************************************}
  149. function get_source_file(moduleindex,fileindex : longint) : tinputfile;
  150. var
  151. hp : tmodule;
  152. begin
  153. hp:=tmodule(loaded_units.first);
  154. while assigned(hp) and (hp.unit_index<>moduleindex) do
  155. hp:=tmodule(hp.next);
  156. if assigned(hp) then
  157. get_source_file:=hp.sourcefiles.get_file(fileindex)
  158. else
  159. get_source_file:=nil;
  160. end;
  161. {****************************************************************************
  162. TLinkContainerItem
  163. ****************************************************************************}
  164. constructor TLinkContainerItem.Create(const s:string;m:cardinal);
  165. begin
  166. inherited Create;
  167. data:=stringdup(s);
  168. needlink:=m;
  169. end;
  170. destructor TLinkContainerItem.Destroy;
  171. begin
  172. stringdispose(data);
  173. end;
  174. {****************************************************************************
  175. TLinkContainer
  176. ****************************************************************************}
  177. procedure TLinkContainer.add(const s : string;m:cardinal);
  178. begin
  179. inherited concat(TLinkContainerItem.Create(s,m));
  180. end;
  181. function TLinkContainer.get(var m:cardinal) : string;
  182. var
  183. p : tlinkcontaineritem;
  184. begin
  185. p:=tlinkcontaineritem(inherited getfirst);
  186. if p=nil then
  187. begin
  188. get:='';
  189. m:=0;
  190. end
  191. else
  192. begin
  193. get:=p.data^;
  194. m:=p.needlink;
  195. p.free;
  196. end;
  197. end;
  198. function TLinkContainer.getusemask(mask:cardinal) : string;
  199. var
  200. p : tlinkcontaineritem;
  201. found : boolean;
  202. begin
  203. found:=false;
  204. repeat
  205. p:=tlinkcontaineritem(inherited getfirst);
  206. if p=nil then
  207. begin
  208. getusemask:='';
  209. exit;
  210. end;
  211. getusemask:=p.data^;
  212. found:=(p.needlink and mask)<>0;
  213. p.free;
  214. until found;
  215. end;
  216. function TLinkContainer.find(const s:string):boolean;
  217. var
  218. newnode : tlinkcontaineritem;
  219. begin
  220. find:=false;
  221. newnode:=tlinkcontaineritem(First);
  222. while assigned(newnode) do
  223. begin
  224. if newnode.data^=s then
  225. begin
  226. find:=true;
  227. exit;
  228. end;
  229. newnode:=tlinkcontaineritem(newnode.next);
  230. end;
  231. end;
  232. {****************************************************************************
  233. TExternalsItem
  234. ****************************************************************************}
  235. constructor tExternalsItem.Create(const s:string);
  236. begin
  237. inherited Create;
  238. found:=false;
  239. data:=stringdup(s);
  240. end;
  241. destructor tExternalsItem.Destroy;
  242. begin
  243. stringdispose(data);
  244. inherited;
  245. end;
  246. {****************************************************************************
  247. TUSED_UNIT
  248. ****************************************************************************}
  249. constructor tused_unit.create(_u : tmodule;intface,inuses:boolean);
  250. begin
  251. u:=_u;
  252. in_interface:=intface;
  253. in_uses:=inuses;
  254. is_stab_written:=false;
  255. unitid:=0;
  256. if _u.state=ms_compiled then
  257. begin
  258. checksum:=u.crc;
  259. interface_checksum:=u.interface_crc;
  260. end
  261. else
  262. begin
  263. checksum:=0;
  264. interface_checksum:=0;
  265. end;
  266. end;
  267. {****************************************************************************
  268. TDENPENDENT_UNIT
  269. ****************************************************************************}
  270. constructor tdependent_unit.create(_u : tmodule);
  271. begin
  272. u:=_u;
  273. end;
  274. {****************************************************************************
  275. TMODULE
  276. ****************************************************************************}
  277. constructor tmodule.create(LoadedFrom:TModule;const s:string;_is_unit:boolean);
  278. var
  279. p : dirstr;
  280. n : namestr;
  281. e : extstr;
  282. begin
  283. FSplit(s,p,n,e);
  284. { Programs have the name 'Program' to don't conflict with dup id's }
  285. if _is_unit then
  286. inherited create(n)
  287. else
  288. inherited create('Program');
  289. mainsource:=stringdup(s);
  290. { Dos has the famous 8.3 limit :( }
  291. {$ifdef shortasmprefix}
  292. asmprefix:=stringdup(FixFileName('as'));
  293. {$else}
  294. asmprefix:=stringdup(FixFileName(n));
  295. {$endif}
  296. setfilename(p+n,true);
  297. localunitsearchpath:=TSearchPathList.Create;
  298. localobjectsearchpath:=TSearchPathList.Create;
  299. localincludesearchpath:=TSearchPathList.Create;
  300. locallibrarysearchpath:=TSearchPathList.Create;
  301. used_units:=TLinkedList.Create;
  302. dependent_units:=TLinkedList.Create;
  303. resourcefiles:=TStringList.Create;
  304. linkunitofiles:=TLinkContainer.Create;
  305. linkunitstaticlibs:=TLinkContainer.Create;
  306. linkunitsharedlibs:=TLinkContainer.Create;
  307. linkotherofiles:=TLinkContainer.Create;
  308. linkotherstaticlibs:=TLinkContainer.Create;
  309. linkothersharedlibs:=TLinkContainer.Create;
  310. crc:=0;
  311. interface_crc:=0;
  312. flags:=0;
  313. scanner:=nil;
  314. map:=nil;
  315. globalsymtable:=nil;
  316. localsymtable:=nil;
  317. loaded_from:=LoadedFrom;
  318. do_reload:=false;
  319. unitcount:=1;
  320. do_compile:=false;
  321. sources_avail:=true;
  322. recompile_reason:=rr_unknown;
  323. in_interface:=true;
  324. in_global:=true;
  325. is_unit:=_is_unit;
  326. islibrary:=false;
  327. uses_imports:=false;
  328. imports:=TLinkedList.Create;
  329. _exports:=TLinkedList.Create;
  330. externals:=TLinkedList.Create;
  331. librarydata:=tasmlibrarydata.create(realmodulename^);
  332. end;
  333. destructor tmodule.Destroy;
  334. {$ifdef MEMDEBUG}
  335. var
  336. d : tmemdebug;
  337. {$endif}
  338. begin
  339. if assigned(map) then
  340. dispose(map);
  341. if assigned(imports) then
  342. imports.free;
  343. if assigned(_exports) then
  344. _exports.free;
  345. if assigned(externals) then
  346. externals.free;
  347. if assigned(scanner) then
  348. begin
  349. { also update current_scanner if it was pointing
  350. to this module }
  351. if current_scanner=tscannerfile(scanner) then
  352. current_scanner:=nil;
  353. tscannerfile(scanner).free;
  354. end;
  355. used_units.free;
  356. dependent_units.free;
  357. resourcefiles.Free;
  358. linkunitofiles.Free;
  359. linkunitstaticlibs.Free;
  360. linkunitsharedlibs.Free;
  361. linkotherofiles.Free;
  362. linkotherstaticlibs.Free;
  363. linkothersharedlibs.Free;
  364. stringdispose(objfilename);
  365. stringdispose(newfilename);
  366. stringdispose(ppufilename);
  367. stringdispose(staticlibfilename);
  368. stringdispose(sharedlibfilename);
  369. stringdispose(exefilename);
  370. stringdispose(outputpath);
  371. stringdispose(path);
  372. stringdispose(realmodulename);
  373. stringdispose(mainsource);
  374. stringdispose(asmprefix);
  375. localunitsearchpath.Free;
  376. localobjectsearchpath.free;
  377. localincludesearchpath.free;
  378. locallibrarysearchpath.free;
  379. {$ifdef MEMDEBUG}
  380. d:=tmemdebug.create(modulename^+' - symtable');
  381. {$endif}
  382. if assigned(globalsymtable) then
  383. globalsymtable.free;
  384. if assigned(localsymtable) then
  385. localsymtable.free;
  386. {$ifdef MEMDEBUG}
  387. d.free;
  388. {$endif}
  389. {$ifdef MEMDEBUG}
  390. d:=tmemdebug.create(modulename^+' - librarydata');
  391. {$endif}
  392. librarydata.free;
  393. {$ifdef MEMDEBUG}
  394. d.free;
  395. {$endif}
  396. stringdispose(modulename);
  397. inherited Destroy;
  398. end;
  399. procedure tmodule.reset;
  400. begin
  401. if assigned(scanner) then
  402. begin
  403. { also update current_scanner if it was pointing
  404. to this module }
  405. if current_scanner=tscannerfile(scanner) then
  406. current_scanner:=nil;
  407. tscannerfile(scanner).free;
  408. scanner:=nil;
  409. end;
  410. if assigned(globalsymtable) then
  411. begin
  412. globalsymtable.free;
  413. globalsymtable:=nil;
  414. end;
  415. if assigned(localsymtable) then
  416. begin
  417. localsymtable.free;
  418. localsymtable:=nil;
  419. end;
  420. if assigned(map) then
  421. begin
  422. dispose(map);
  423. map:=nil;
  424. end;
  425. sourcefiles.free;
  426. sourcefiles:=tinputfilemanager.create;
  427. librarydata.free;
  428. librarydata:=tasmlibrarydata.create(realmodulename^);
  429. imports.free;
  430. imports:=tlinkedlist.create;
  431. _exports.free;
  432. _exports:=tlinkedlist.create;
  433. externals.free;
  434. externals:=tlinkedlist.create;
  435. used_units.free;
  436. used_units:=TLinkedList.Create;
  437. dependent_units.free;
  438. dependent_units:=TLinkedList.Create;
  439. resourcefiles.Free;
  440. resourcefiles:=TStringList.Create;
  441. linkunitofiles.Free;
  442. linkunitofiles:=TLinkContainer.Create;
  443. linkunitstaticlibs.Free;
  444. linkunitstaticlibs:=TLinkContainer.Create;
  445. linkunitsharedlibs.Free;
  446. linkunitsharedlibs:=TLinkContainer.Create;
  447. linkotherofiles.Free;
  448. linkotherofiles:=TLinkContainer.Create;
  449. linkotherstaticlibs.Free;
  450. linkotherstaticlibs:=TLinkContainer.Create;
  451. linkothersharedlibs.Free;
  452. linkothersharedlibs:=TLinkContainer.Create;
  453. uses_imports:=false;
  454. do_compile:=false;
  455. in_interface:=true;
  456. in_global:=true;
  457. crc:=0;
  458. interface_crc:=0;
  459. flags:=0;
  460. unitcount:=1;
  461. recompile_reason:=rr_unknown;
  462. {
  463. The following fields should not
  464. be reset:
  465. mainsource
  466. loaded_from
  467. state
  468. sources_avail
  469. }
  470. end;
  471. procedure tmodule.adddependency(callermodule:tmodule);
  472. begin
  473. { This is not needed for programs }
  474. if not callermodule.is_unit then
  475. exit;
  476. Comment(V_Used,'Add dependency for '+callermodule.modulename^+' to '+modulename^);
  477. dependent_units.concat(tdependent_unit.create(callermodule));
  478. end;
  479. procedure tmodule.flagdependent(callermodule:tmodule);
  480. var
  481. pm : tdependent_unit;
  482. begin
  483. { flag all units that depend on this unit for reloading }
  484. pm:=tdependent_unit(current_module.dependent_units.first);
  485. while assigned(pm) do
  486. begin
  487. { We do not have to reload the unit that wants to load
  488. this unit }
  489. if pm.u=callermodule then
  490. Comment(v_used,'No reload, is caller: '+pm.u.modulename^)
  491. else
  492. if pm.u.state=ms_second_compile then
  493. Comment(v_used,'No reload, already in second compile: '+pm.u.modulename^)
  494. else
  495. begin
  496. pm.u.do_reload:=true;
  497. Comment(v_used,'Flag for reload '+pm.u.modulename^);
  498. end;
  499. pm:=tdependent_unit(pm.next);
  500. end;
  501. end;
  502. function tmodule.addusedunit(hp:tmodule;inuses:boolean):tused_unit;
  503. var
  504. pu : tused_unit;
  505. begin
  506. pu:=tused_unit.create(hp,in_interface,inuses);
  507. used_units.concat(pu);
  508. addusedunit:=pu;
  509. end;
  510. procedure tmodule.numberunits;
  511. var
  512. counter : word;
  513. hp : tused_unit;
  514. hp1 : tmodule;
  515. begin
  516. { Reset all numbers to -1 }
  517. hp1:=tmodule(loaded_units.first);
  518. while assigned(hp1) do
  519. begin
  520. if assigned(hp1.globalsymtable) then
  521. hp1.globalsymtable.unitid:=$ffff;
  522. hp1:=tmodule(hp1.next);
  523. end;
  524. { Our own symtable gets unitid 0, for a program there is
  525. no globalsymtable }
  526. if assigned(globalsymtable) then
  527. globalsymtable.unitid:=0;
  528. { number units }
  529. counter:=1;
  530. hp:=tused_unit(used_units.first);
  531. while assigned(hp) do
  532. begin
  533. tsymtable(hp.u.globalsymtable).unitid:=counter;
  534. inc(counter);
  535. hp:=tused_unit(hp.next);
  536. end;
  537. end;
  538. end.
  539. {
  540. $Log$
  541. Revision 1.32 2002-12-29 14:57:50 peter
  542. * unit loading changed to first register units and load them
  543. afterwards. This is needed to support uses xxx in yyy correctly
  544. * unit dependency check fixed
  545. Revision 1.31 2002/12/07 14:27:07 carl
  546. * 3% memory optimization
  547. * changed some types
  548. + added type checking with different size for call node and for
  549. parameters
  550. Revision 1.30 2002/11/24 18:19:56 carl
  551. + tos also has short filenames
  552. Revision 1.29 2002/11/20 12:36:23 mazen
  553. * $UNITPATH directive is now working
  554. Revision 1.28 2002/09/05 19:29:42 peter
  555. * memdebug enhancements
  556. Revision 1.27 2002/08/16 15:31:08 peter
  557. * fixed possible crashes with current_scanner
  558. Revision 1.26 2002/08/12 16:46:04 peter
  559. * tscannerfile is now destroyed in tmodule.reset and current_scanner
  560. is updated accordingly. This removes all the loading and saving of
  561. the old scanner and the invalid flag marking
  562. Revision 1.25 2002/08/11 14:28:19 peter
  563. * TScannerFile.SetInvalid added that will also reset inputfile
  564. Revision 1.24 2002/08/11 13:24:11 peter
  565. * saving of asmsymbols in ppu supported
  566. * asmsymbollist global is removed and moved into a new class
  567. tasmlibrarydata that will hold the info of a .a file which
  568. corresponds with a single module. Added librarydata to tmodule
  569. to keep the library info stored for the module. In the future the
  570. objectfiles will also be stored to the tasmlibrarydata class
  571. * all getlabel/newasmsymbol and friends are moved to the new class
  572. Revision 1.23 2002/05/16 19:46:36 carl
  573. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  574. + try to fix temp allocation (still in ifdef)
  575. + generic constructor calls
  576. + start of tassembler / tmodulebase class cleanup
  577. Revision 1.22 2002/05/14 19:34:41 peter
  578. * removed old logs and updated copyright year
  579. Revision 1.21 2002/04/04 19:05:55 peter
  580. * removed unused units
  581. * use tlocation.size in cg.a_*loc*() routines
  582. Revision 1.20 2002/03/28 20:46:59 carl
  583. - remove go32v1 support
  584. }