fmodule.pas 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652
  1. {
  2. $Id$
  3. Copyright (c) 1998-2000 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 defines.inc}
  20. {$ifdef go32v1}
  21. {$define shortasmprefix}
  22. {$endif}
  23. {$ifdef go32v2}
  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;
  37. const
  38. maxunits = 1024;
  39. type
  40. trecompile_reason = (rr_unknown,
  41. rr_noppu,rr_sourcenewer,rr_build,rr_crcchanged
  42. );
  43. TExternalsItem=class(TLinkedListItem)
  44. public
  45. found : longbool;
  46. data : pstring;
  47. constructor Create(const s:string);
  48. Destructor Destroy;override;
  49. end;
  50. tlinkcontaineritem=class(tlinkedlistitem)
  51. public
  52. data : pstring;
  53. needlink : cardinal;
  54. constructor Create(const s:string;m:cardinal);
  55. destructor Destroy;override;
  56. end;
  57. tlinkcontainer=class(tlinkedlist)
  58. procedure add(const s : string;m:cardinal);
  59. function get(var m:cardinal) : string;
  60. function getusemask(mask:cardinal) : string;
  61. function find(const s:string):boolean;
  62. end;
  63. {$ifndef NEWMAP}
  64. tunitmap = array[0..maxunits-1] of pointer;
  65. punitmap = ^tunitmap;
  66. {$else NEWMAP}
  67. tunitmap = array[0..maxunits-1] of tmodule;
  68. punitmap = ^tunitmap;
  69. {$endif NEWMAP}
  70. tmodule = class(tmodulebase)
  71. compiled, { unit is already compiled }
  72. do_reload, { force reloading of the unit }
  73. do_compile, { need to compile the sources }
  74. sources_avail, { if all sources are reachable }
  75. sources_checked, { if there is already done a check for the sources }
  76. is_unit,
  77. in_compile, { is it being compiled ?? }
  78. in_second_compile, { is this unit being compiled for the 2nd time? }
  79. in_second_load, { is this unit PPU loaded a 2nd time? }
  80. in_implementation, { processing the implementation part? }
  81. in_global : boolean; { allow global settings }
  82. recompile_reason : trecompile_reason; { the reason why the unit should be recompiled }
  83. crc,
  84. interface_crc : cardinal;
  85. flags : cardinal; { the PPU flags }
  86. islibrary : boolean; { if it is a library (win32 dll) }
  87. map : punitmap; { mapping of all used units }
  88. unitcount : longint; { local unit counter }
  89. globalsymtable, { pointer to the global symtable of this unit }
  90. localsymtable : tsymtable;{ pointer to the local symtable of this unit }
  91. scanner : pointer; { scanner object used }
  92. loaded_from : tmodule;
  93. uses_imports : boolean; { Set if the module imports from DLL's.}
  94. imports : tlinkedlist;
  95. _exports : tlinkedlist;
  96. externals : tlinkedlist; {Only for DLL scanners by using Unix-style $LINKLIB }
  97. resourcefiles : tstringlist;
  98. linkunitofiles,
  99. linkunitstaticlibs,
  100. linkunitsharedlibs,
  101. linkotherofiles, { objects,libs loaded from the source }
  102. linkothersharedlibs, { using $L or $LINKLIB or import lib (for linux) }
  103. linkotherstaticlibs : tlinkcontainer;
  104. used_units : tlinkedlist;
  105. dependent_units : tlinkedlist;
  106. localunitsearchpath, { local searchpaths }
  107. localobjectsearchpath,
  108. localincludesearchpath,
  109. locallibrarysearchpath : TSearchPathList;
  110. asmprefix : pstring; { prefix for the smartlink asmfiles }
  111. constructor create(const s:string;_is_unit:boolean);
  112. destructor destroy;override;
  113. procedure reset;virtual;
  114. procedure numberunits;
  115. end;
  116. tused_unit = class(tlinkedlistitem)
  117. unitid : longint;
  118. name : pstring;
  119. realname : pstring;
  120. checksum,
  121. interface_checksum : cardinal;
  122. loaded : boolean;
  123. in_uses,
  124. in_interface,
  125. is_stab_written : boolean;
  126. u : tmodule;
  127. constructor create(_u : tmodule;intface:boolean);
  128. constructor create_to_load(const n:string;c,intfc:cardinal;intface:boolean);
  129. destructor destroy;override;
  130. end;
  131. tdependent_unit = class(tlinkedlistitem)
  132. u : tmodule;
  133. constructor create(_u : tmodule);
  134. end;
  135. var
  136. main_module : tmodule; { Main module of the program }
  137. current_module : tmodule; { Current module which is compiled or loaded }
  138. compiled_module : tmodule; { Current module which is compiled }
  139. usedunits : tlinkedlist; { Used units for this program }
  140. loaded_units : tlinkedlist; { All loaded units }
  141. SmartLinkOFiles : TStringList; { List of .o files which are generated,
  142. used to delete them after linking }
  143. function get_source_file(moduleindex,fileindex : longint) : tinputfile;
  144. implementation
  145. uses
  146. {$ifdef delphi}
  147. dmisc,
  148. {$else}
  149. dos,
  150. {$endif}
  151. globtype,verbose,systems,
  152. scanner;
  153. {*****************************************************************************
  154. Global Functions
  155. *****************************************************************************}
  156. function get_source_file(moduleindex,fileindex : longint) : tinputfile;
  157. var
  158. hp : tmodule;
  159. begin
  160. hp:=tmodule(loaded_units.first);
  161. while assigned(hp) and (hp.unit_index<>moduleindex) do
  162. hp:=tmodule(hp.next);
  163. if assigned(hp) then
  164. get_source_file:=hp.sourcefiles.get_file(fileindex)
  165. else
  166. get_source_file:=nil;
  167. end;
  168. {****************************************************************************
  169. TLinkContainerItem
  170. ****************************************************************************}
  171. constructor TLinkContainerItem.Create(const s:string;m:cardinal);
  172. begin
  173. inherited Create;
  174. data:=stringdup(s);
  175. needlink:=m;
  176. end;
  177. destructor TLinkContainerItem.Destroy;
  178. begin
  179. stringdispose(data);
  180. end;
  181. {****************************************************************************
  182. TLinkContainer
  183. ****************************************************************************}
  184. procedure TLinkContainer.add(const s : string;m:cardinal);
  185. begin
  186. inherited concat(TLinkContainerItem.Create(s,m));
  187. end;
  188. function TLinkContainer.get(var m:cardinal) : string;
  189. var
  190. p : tlinkcontaineritem;
  191. begin
  192. p:=tlinkcontaineritem(inherited getfirst);
  193. if p=nil then
  194. begin
  195. get:='';
  196. m:=0;
  197. end
  198. else
  199. begin
  200. get:=p.data^;
  201. m:=p.needlink;
  202. p.free;
  203. end;
  204. end;
  205. function TLinkContainer.getusemask(mask:cardinal) : string;
  206. var
  207. p : tlinkcontaineritem;
  208. found : boolean;
  209. begin
  210. found:=false;
  211. repeat
  212. p:=tlinkcontaineritem(inherited getfirst);
  213. if p=nil then
  214. begin
  215. getusemask:='';
  216. exit;
  217. end;
  218. getusemask:=p.data^;
  219. found:=(p.needlink and mask)<>0;
  220. p.free;
  221. until found;
  222. end;
  223. function TLinkContainer.find(const s:string):boolean;
  224. var
  225. newnode : tlinkcontaineritem;
  226. begin
  227. find:=false;
  228. newnode:=tlinkcontaineritem(First);
  229. while assigned(newnode) do
  230. begin
  231. if newnode.data^=s then
  232. begin
  233. find:=true;
  234. exit;
  235. end;
  236. newnode:=tlinkcontaineritem(newnode.next);
  237. end;
  238. end;
  239. {****************************************************************************
  240. TExternalsItem
  241. ****************************************************************************}
  242. constructor tExternalsItem.Create(const s:string);
  243. begin
  244. inherited Create;
  245. found:=false;
  246. data:=stringdup(s);
  247. end;
  248. destructor tExternalsItem.Destroy;
  249. begin
  250. stringdispose(data);
  251. inherited;
  252. end;
  253. {****************************************************************************
  254. TUSED_UNIT
  255. ****************************************************************************}
  256. constructor tused_unit.create(_u : tmodule;intface:boolean);
  257. begin
  258. u:=_u;
  259. in_interface:=intface;
  260. in_uses:=false;
  261. is_stab_written:=false;
  262. loaded:=true;
  263. name:=stringdup(_u.modulename^);
  264. realname:=stringdup(_u.realmodulename^);
  265. checksum:=_u.crc;
  266. interface_checksum:=_u.interface_crc;
  267. unitid:=0;
  268. end;
  269. constructor tused_unit.create_to_load(const n:string;c,intfc:cardinal;intface:boolean);
  270. begin
  271. u:=nil;
  272. in_interface:=intface;
  273. in_uses:=false;
  274. is_stab_written:=false;
  275. loaded:=false;
  276. name:=stringdup(upper(n));
  277. realname:=stringdup(n);
  278. checksum:=c;
  279. interface_checksum:=intfc;
  280. unitid:=0;
  281. end;
  282. destructor tused_unit.destroy;
  283. begin
  284. stringdispose(realname);
  285. stringdispose(name);
  286. inherited destroy;
  287. end;
  288. {****************************************************************************
  289. TDENPENDENT_UNIT
  290. ****************************************************************************}
  291. constructor tdependent_unit.create(_u : tmodule);
  292. begin
  293. u:=_u;
  294. end;
  295. {****************************************************************************
  296. TMODULE
  297. ****************************************************************************}
  298. constructor tmodule.create(const s:string;_is_unit:boolean);
  299. var
  300. p : dirstr;
  301. n : namestr;
  302. e : extstr;
  303. begin
  304. FSplit(s,p,n,e);
  305. { Programs have the name 'Program' to don't conflict with dup id's }
  306. if _is_unit then
  307. inherited create(n)
  308. else
  309. inherited create('Program');
  310. mainsource:=stringdup(s);
  311. { Dos has the famous 8.3 limit :( }
  312. {$ifdef shortasmprefix}
  313. asmprefix:=stringdup(FixFileName('as'));
  314. {$else}
  315. asmprefix:=stringdup(FixFileName(n));
  316. {$endif}
  317. setfilename(p+n,true);
  318. localunitsearchpath:=TSearchPathList.Create;
  319. localobjectsearchpath:=TSearchPathList.Create;
  320. localincludesearchpath:=TSearchPathList.Create;
  321. locallibrarysearchpath:=TSearchPathList.Create;
  322. used_units:=TLinkedList.Create;
  323. dependent_units:=TLinkedList.Create;
  324. resourcefiles:=TStringList.Create;
  325. linkunitofiles:=TLinkContainer.Create;
  326. linkunitstaticlibs:=TLinkContainer.Create;
  327. linkunitsharedlibs:=TLinkContainer.Create;
  328. linkotherofiles:=TLinkContainer.Create;
  329. linkotherstaticlibs:=TLinkContainer.Create;
  330. linkothersharedlibs:=TLinkContainer.Create;
  331. crc:=0;
  332. interface_crc:=0;
  333. flags:=0;
  334. scanner:=nil;
  335. map:=nil;
  336. globalsymtable:=nil;
  337. localsymtable:=nil;
  338. loaded_from:=nil;
  339. do_reload:=false;
  340. unitcount:=1;
  341. do_compile:=false;
  342. sources_avail:=true;
  343. sources_checked:=false;
  344. compiled:=false;
  345. recompile_reason:=rr_unknown;
  346. in_second_load:=false;
  347. in_compile:=false;
  348. in_second_compile:=false;
  349. in_implementation:=false;
  350. in_global:=true;
  351. is_unit:=_is_unit;
  352. islibrary:=false;
  353. uses_imports:=false;
  354. imports:=TLinkedList.Create;
  355. _exports:=TLinkedList.Create;
  356. externals:=TLinkedList.Create;
  357. end;
  358. destructor tmodule.Destroy;
  359. {$ifdef MEMDEBUG}
  360. var
  361. d : tmemdebug;
  362. {$endif}
  363. begin
  364. if assigned(map) then
  365. dispose(map);
  366. if assigned(imports) then
  367. imports.free;
  368. imports:=nil;
  369. if assigned(_exports) then
  370. _exports.free;
  371. _exports:=nil;
  372. if assigned(externals) then
  373. externals.free;
  374. externals:=nil;
  375. if assigned(scanner) then
  376. tscannerfile(scanner).invalid:=true;
  377. used_units.free;
  378. dependent_units.free;
  379. resourcefiles.Free;
  380. linkunitofiles.Free;
  381. linkunitstaticlibs.Free;
  382. linkunitsharedlibs.Free;
  383. linkotherofiles.Free;
  384. linkotherstaticlibs.Free;
  385. linkothersharedlibs.Free;
  386. stringdispose(objfilename);
  387. stringdispose(asmfilename);
  388. stringdispose(ppufilename);
  389. stringdispose(staticlibfilename);
  390. stringdispose(sharedlibfilename);
  391. stringdispose(exefilename);
  392. stringdispose(outputpath);
  393. stringdispose(path);
  394. stringdispose(modulename);
  395. stringdispose(realmodulename);
  396. stringdispose(mainsource);
  397. stringdispose(asmprefix);
  398. localunitsearchpath.Free;
  399. localobjectsearchpath.free;
  400. localincludesearchpath.free;
  401. locallibrarysearchpath.free;
  402. {$ifdef MEMDEBUG}
  403. d.init('symtable');
  404. {$endif}
  405. if assigned(globalsymtable) then
  406. globalsymtable.free;
  407. globalsymtable:=nil;
  408. if assigned(localsymtable) then
  409. localsymtable.free;
  410. localsymtable:=nil;
  411. {$ifdef MEMDEBUG}
  412. d.free;
  413. {$endif}
  414. inherited Destroy;
  415. end;
  416. procedure tmodule.reset;
  417. var
  418. pm : tdependent_unit;
  419. begin
  420. if assigned(scanner) then
  421. tscannerfile(scanner).invalid:=true;
  422. if assigned(globalsymtable) then
  423. begin
  424. globalsymtable.free;
  425. globalsymtable:=nil;
  426. end;
  427. if assigned(localsymtable) then
  428. begin
  429. localsymtable.free;
  430. localsymtable:=nil;
  431. end;
  432. if assigned(map) then
  433. begin
  434. dispose(map);
  435. map:=nil;
  436. end;
  437. sourcefiles.free;
  438. sourcefiles:=tinputfilemanager.create;
  439. imports.free;
  440. imports:=tlinkedlist.create;
  441. _exports.free;
  442. _exports:=tlinkedlist.create;
  443. externals.free;
  444. externals:=tlinkedlist.create;
  445. used_units.free;
  446. used_units:=TLinkedList.Create;
  447. { all units that depend on this one must be recompiled ! }
  448. pm:=tdependent_unit(dependent_units.first);
  449. while assigned(pm) do
  450. begin
  451. if pm.u.in_second_compile then
  452. Comment(v_debug,'No reload already in second compile: '+pm.u.modulename^)
  453. else
  454. begin
  455. pm.u.do_reload:=true;
  456. Comment(v_debug,'Reloading '+pm.u.modulename^+' needed because '+modulename^+' is reloaded');
  457. end;
  458. pm:=tdependent_unit(pm.next);
  459. end;
  460. dependent_units.free;
  461. dependent_units:=TLinkedList.Create;
  462. resourcefiles.Free;
  463. resourcefiles:=TStringList.Create;
  464. linkunitofiles.Free;
  465. linkunitofiles:=TLinkContainer.Create;
  466. linkunitstaticlibs.Free;
  467. linkunitstaticlibs:=TLinkContainer.Create;
  468. linkunitsharedlibs.Free;
  469. linkunitsharedlibs:=TLinkContainer.Create;
  470. linkotherofiles.Free;
  471. linkotherofiles:=TLinkContainer.Create;
  472. linkotherstaticlibs.Free;
  473. linkotherstaticlibs:=TLinkContainer.Create;
  474. linkothersharedlibs.Free;
  475. linkothersharedlibs:=TLinkContainer.Create;
  476. uses_imports:=false;
  477. do_compile:=false;
  478. { sources_avail:=true;
  479. should not be changed PM }
  480. compiled:=false;
  481. in_implementation:=false;
  482. in_global:=true;
  483. crc:=0;
  484. interface_crc:=0;
  485. flags:=0;
  486. {loaded_from:=nil;
  487. should not be changed PFV }
  488. unitcount:=1;
  489. recompile_reason:=rr_unknown;
  490. end;
  491. procedure tmodule.numberunits;
  492. var
  493. counter : longint;
  494. hp : tused_unit;
  495. hp1 : tmodule;
  496. begin
  497. { Reset all numbers to -1 }
  498. hp1:=tmodule(loaded_units.first);
  499. while assigned(hp1) do
  500. begin
  501. if assigned(hp1.globalsymtable) then
  502. hp1.globalsymtable.unitid:=$ffff;
  503. hp1:=tmodule(hp1.next);
  504. end;
  505. { Our own symtable gets unitid 0, for a program there is
  506. no globalsymtable }
  507. if assigned(globalsymtable) then
  508. globalsymtable.unitid:=0;
  509. { number units }
  510. counter:=1;
  511. hp:=tused_unit(used_units.first);
  512. while assigned(hp) do
  513. begin
  514. tsymtable(hp.u.globalsymtable).unitid:=counter;
  515. inc(counter);
  516. hp:=tused_unit(hp.next);
  517. end;
  518. end;
  519. end.
  520. {
  521. $Log$
  522. Revision 1.17 2001-06-04 11:49:08 peter
  523. * store used units in original type in ppu
  524. Revision 1.16 2001/06/03 15:15:31 peter
  525. * dllprt0 stub for linux shared libs
  526. * pass -init and -fini for linux shared libs
  527. * libprefix splitted into staticlibprefix and sharedlibprefix
  528. Revision 1.15 2001/05/09 14:11:10 jonas
  529. * range check error fixes from Peter
  530. Revision 1.14 2001/05/06 14:49:16 peter
  531. * ppu object to class rewrite
  532. * move ppu read and write stuff to fppu
  533. Revision 1.13 2001/04/18 22:01:53 peter
  534. * registration of targets and assemblers
  535. Revision 1.12 2001/04/13 18:08:37 peter
  536. * scanner object to class
  537. Revision 1.11 2001/04/13 01:22:07 peter
  538. * symtable change to classes
  539. * range check generation and errors fixed, make cycle DEBUG=1 works
  540. * memory leaks fixed
  541. Revision 1.10 2001/04/02 21:20:29 peter
  542. * resulttype rewrite
  543. Revision 1.9 2001/03/13 18:45:06 peter
  544. * fixed some memory leaks
  545. Revision 1.8 2001/03/06 18:28:02 peter
  546. * patch from Pavel with a new and much faster DLL Scanner for
  547. automatic importing so $linklib works for DLLs. Thanks Pavel!
  548. Revision 1.7 2001/02/20 21:41:15 peter
  549. * new fixfilename, findfile for unix. Look first for lowercase, then
  550. NormalCase and last for UPPERCASE names.
  551. Revision 1.6 2000/12/25 00:07:25 peter
  552. + new tlinkedlist class (merge of old tstringqueue,tcontainer and
  553. tlinkedlist objects)
  554. Revision 1.5 2000/11/07 20:48:33 peter
  555. * removed ref_count from pinputfile it's not used
  556. Revision 1.4 2000/10/31 22:02:46 peter
  557. * symtable splitted, no real code changes
  558. Revision 1.3 2000/10/15 07:47:51 peter
  559. * unit names and procedure names are stored mixed case
  560. Revision 1.2 2000/09/24 15:06:16 peter
  561. * use defines.inc
  562. Revision 1.1 2000/08/27 16:11:50 peter
  563. * moved some util functions from globals,cobjects to cutils
  564. * splitted files into finput,fmodule
  565. }