fppu.pas 55 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686
  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 fppu;
  19. {$i fpcdefs.inc}
  20. { close ppufiles on system that are
  21. short on file handles like DOS system PM }
  22. {$ifdef GO32V2}
  23. {$define SHORT_ON_FILE_HANDLES}
  24. {$endif GO32V2}
  25. {$ifdef WATCOM}
  26. {$define SHORT_ON_FILE_HANDLES}
  27. {$endif WATCOM}
  28. interface
  29. uses
  30. cutils,cclasses,
  31. globtype,globals,finput,fmodule,
  32. symbase,symppu,ppu;
  33. type
  34. tppumodule = class(tmodule)
  35. ppufile : tcompilerppufile; { the PPU file }
  36. sourcefn : pstring; { Source specified with "uses .. in '..'" }
  37. {$ifdef Test_Double_checksum}
  38. crc_array : pointer;
  39. crc_size : longint;
  40. crc_array2 : pointer;
  41. crc_size2 : longint;
  42. {$endif def Test_Double_checksum}
  43. constructor create(LoadedFrom:TModule;const s:string;const fn:string;_is_unit:boolean);
  44. destructor destroy;override;
  45. procedure reset;override;
  46. function openppu:boolean;
  47. procedure getppucrc;
  48. procedure writeppu;
  49. procedure loadppu;
  50. function needrecompile:boolean;
  51. private
  52. function search_unit(onlysource,shortname:boolean):boolean;
  53. procedure load_interface;
  54. procedure load_implementation;
  55. procedure load_symtable_refs;
  56. procedure load_usedunits;
  57. procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
  58. procedure writeusedmacros;
  59. procedure writesourcefiles;
  60. procedure writeusedunit(intf:boolean);
  61. procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
  62. procedure writederefdata;
  63. procedure putasmsymbol_in_idx(s:tnamedindexitem;arg:pointer);
  64. procedure writeasmsymbols;
  65. procedure readusedmacros;
  66. procedure readsourcefiles;
  67. procedure readloadunit;
  68. procedure readlinkcontainer(var p:tlinkcontainer);
  69. procedure readderefdata;
  70. procedure readasmsymbols;
  71. end;
  72. procedure reload_flagged_units;
  73. function registerunit(callermodule:tmodule;const s : stringid;const fn:string) : tppumodule;
  74. implementation
  75. uses
  76. verbose,systems,version,
  77. symtable,
  78. scanner,
  79. aasmbase,
  80. parser;
  81. {****************************************************************************
  82. Helpers
  83. ****************************************************************************}
  84. procedure reload_flagged_units;
  85. var
  86. hp : tmodule;
  87. begin
  88. { now reload all dependent units }
  89. hp:=tmodule(loaded_units.first);
  90. while assigned(hp) do
  91. begin
  92. if hp.do_reload then
  93. tppumodule(hp).loadppu;
  94. hp:=tmodule(hp.next);
  95. end;
  96. end;
  97. {****************************************************************************
  98. TPPUMODULE
  99. ****************************************************************************}
  100. constructor tppumodule.create(LoadedFrom:TModule;const s:string;const fn:string;_is_unit:boolean);
  101. begin
  102. inherited create(LoadedFrom,s,_is_unit);
  103. ppufile:=nil;
  104. sourcefn:=stringdup(fn);
  105. end;
  106. destructor tppumodule.Destroy;
  107. begin
  108. if assigned(ppufile) then
  109. ppufile.free;
  110. ppufile:=nil;
  111. stringdispose(sourcefn);
  112. inherited Destroy;
  113. end;
  114. procedure tppumodule.reset;
  115. begin
  116. if assigned(ppufile) then
  117. begin
  118. ppufile.free;
  119. ppufile:=nil;
  120. end;
  121. inherited reset;
  122. end;
  123. function tppumodule.openppu:boolean;
  124. var
  125. ppufiletime : longint;
  126. begin
  127. openppu:=false;
  128. Message1(unit_t_ppu_loading,ppufilename^);
  129. { Get ppufile time (also check if the file exists) }
  130. ppufiletime:=getnamedfiletime(ppufilename^);
  131. if ppufiletime=-1 then
  132. exit;
  133. { Open the ppufile }
  134. Message1(unit_u_ppu_name,ppufilename^);
  135. ppufile:=tcompilerppufile.create(ppufilename^);
  136. if not ppufile.openfile then
  137. begin
  138. ppufile.free;
  139. ppufile:=nil;
  140. Message(unit_u_ppu_file_too_short);
  141. exit;
  142. end;
  143. { check for a valid PPU file }
  144. if not ppufile.CheckPPUId then
  145. begin
  146. ppufile.free;
  147. ppufile:=nil;
  148. Message(unit_u_ppu_invalid_header);
  149. exit;
  150. end;
  151. { check for allowed PPU versions }
  152. if not (ppufile.GetPPUVersion = CurrentPPUVersion) then
  153. begin
  154. Message1(unit_u_ppu_invalid_version,tostr(ppufile.GetPPUVersion));
  155. ppufile.free;
  156. ppufile:=nil;
  157. exit;
  158. end;
  159. { check the target processor }
  160. if tsystemcpu(ppufile.header.cpu)<>target_cpu then
  161. begin
  162. ppufile.free;
  163. ppufile:=nil;
  164. Message(unit_u_ppu_invalid_processor);
  165. exit;
  166. end;
  167. { check target }
  168. if tsystem(ppufile.header.target)<>target_info.system then
  169. begin
  170. ppufile.free;
  171. ppufile:=nil;
  172. Message(unit_u_ppu_invalid_target);
  173. exit;
  174. end;
  175. {$ifdef cpufpemu}
  176. { check if floating point emulation is on?}
  177. if ((ppufile.header.flags and uf_fpu_emulation)<>0) and
  178. (cs_fp_emulation in aktmoduleswitches) then
  179. begin
  180. ppufile.free;
  181. ppufile:=nil;
  182. Message(unit_u_ppu_invalid_fpumode);
  183. exit;
  184. end;
  185. {$endif cpufpemu}
  186. { Load values to be access easier }
  187. flags:=ppufile.header.flags;
  188. crc:=ppufile.header.checksum;
  189. interface_crc:=ppufile.header.interface_checksum;
  190. { Show Debug info }
  191. Message1(unit_u_ppu_time,filetimestring(ppufiletime));
  192. Message1(unit_u_ppu_flags,tostr(flags));
  193. Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8));
  194. Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
  195. do_compile:=false;
  196. openppu:=true;
  197. end;
  198. function tppumodule.search_unit(onlysource,shortname:boolean):boolean;
  199. var
  200. singlepathstring,
  201. filename : string;
  202. Function UnitExists(const ext:string;var foundfile:string):boolean;
  203. begin
  204. Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
  205. UnitExists:=FindFile(FileName+ext,Singlepathstring,foundfile);
  206. end;
  207. Function PPUSearchPath(const s:string):boolean;
  208. var
  209. found : boolean;
  210. hs : string;
  211. begin
  212. Found:=false;
  213. singlepathstring:=FixPath(s,false);
  214. { Check for PPU file }
  215. Found:=UnitExists(target_info.unitext,hs);
  216. if Found then
  217. Begin
  218. SetFileName(hs,false);
  219. Found:=OpenPPU;
  220. End;
  221. PPUSearchPath:=Found;
  222. end;
  223. Function SourceSearchPath(const s:string):boolean;
  224. var
  225. found : boolean;
  226. hs : string;
  227. begin
  228. Found:=false;
  229. singlepathstring:=FixPath(s,false);
  230. { Check for Sources }
  231. ppufile:=nil;
  232. do_compile:=true;
  233. recompile_reason:=rr_noppu;
  234. {Check for .pp file}
  235. Found:=UnitExists(target_info.sourceext,hs);
  236. if not Found then
  237. begin
  238. { Check for .pas }
  239. Found:=UnitExists(target_info.pasext,hs);
  240. end;
  241. stringdispose(mainsource);
  242. if Found then
  243. begin
  244. sources_avail:=true;
  245. { Load Filenames when found }
  246. mainsource:=StringDup(hs);
  247. SetFileName(hs,false);
  248. end
  249. else
  250. sources_avail:=false;
  251. SourceSearchPath:=Found;
  252. end;
  253. Function SearchPath(const s:string):boolean;
  254. var
  255. found : boolean;
  256. begin
  257. { First check for a ppu, then for the source }
  258. found:=false;
  259. if not onlysource then
  260. found:=PPUSearchPath(s);
  261. if not found then
  262. found:=SourceSearchPath(s);
  263. SearchPath:=found;
  264. end;
  265. Function SearchPathList(list:TSearchPathList):boolean;
  266. var
  267. hp : TStringListItem;
  268. found : boolean;
  269. begin
  270. found:=false;
  271. hp:=TStringListItem(list.First);
  272. while assigned(hp) do
  273. begin
  274. found:=SearchPath(hp.Str);
  275. if found then
  276. break;
  277. hp:=TStringListItem(hp.next);
  278. end;
  279. SearchPathList:=found;
  280. end;
  281. var
  282. fnd : boolean;
  283. hs : string;
  284. begin
  285. if shortname then
  286. filename:=FixFileName(Copy(realmodulename^,1,8))
  287. else
  288. filename:=FixFileName(realmodulename^);
  289. { try to find unit
  290. 1. look for ppu in cwd
  291. 2. look for ppu in outputpath if set, this is tp7 compatible (PFV)
  292. 3. look for the specified source file (from the uses line)
  293. 4. look for source in cwd
  294. 5. local unit pathlist
  295. 6. global unit pathlist }
  296. fnd:=false;
  297. if not onlysource then
  298. begin
  299. fnd:=PPUSearchPath('.');
  300. if (not fnd) and (outputpath^<>'') then
  301. fnd:=PPUSearchPath(outputpath^);
  302. end;
  303. if (not fnd) and (sourcefn^<>'') then
  304. begin
  305. { the full filename is specified so we can't use here the
  306. searchpath (PFV) }
  307. Message1(unit_t_unitsearch,AddExtension(sourcefn^,target_info.sourceext));
  308. fnd:=FindFile(AddExtension(sourcefn^,target_info.sourceext),'',hs);
  309. if not fnd then
  310. begin
  311. Message1(unit_t_unitsearch,AddExtension(sourcefn^,target_info.pasext));
  312. fnd:=FindFile(AddExtension(sourcefn^,target_info.pasext),'',hs);
  313. end;
  314. if fnd then
  315. begin
  316. sources_avail:=true;
  317. do_compile:=true;
  318. recompile_reason:=rr_noppu;
  319. stringdispose(mainsource);
  320. mainsource:=StringDup(hs);
  321. SetFileName(hs,false);
  322. end;
  323. end;
  324. if not fnd then
  325. fnd:=SourceSearchPath('.');
  326. if (not fnd) and Assigned(Loaded_From) then
  327. fnd:=SearchPathList(Loaded_From.LocalUnitSearchPath);
  328. if not fnd then
  329. fnd:=SearchPathList(UnitSearchPath);
  330. { try to find a file with the first 8 chars of the modulename, like
  331. dos }
  332. if (not fnd) and (length(filename)>8) then
  333. begin
  334. filename:=copy(filename,1,8);
  335. fnd:=SearchPath('.');
  336. if (not fnd) then
  337. fnd:=SearchPathList(LocalUnitSearchPath);
  338. if not fnd then
  339. fnd:=SearchPathList(UnitSearchPath);
  340. end;
  341. search_unit:=fnd;
  342. end;
  343. {**********************************
  344. PPU Reading/Writing Helpers
  345. ***********************************}
  346. procedure tppumodule.writeusedmacro(p:TNamedIndexItem;arg:pointer);
  347. begin
  348. if tmacro(p).is_used or tmacro(p).defined_at_startup then
  349. begin
  350. ppufile.putstring(p.name);
  351. ppufile.putbyte(byte(tmacro(p).defined_at_startup));
  352. ppufile.putbyte(byte(tmacro(p).is_used));
  353. end;
  354. end;
  355. procedure tppumodule.writeusedmacros;
  356. begin
  357. ppufile.do_crc:=false;
  358. tscannerfile(scanner).macros.foreach({$ifdef FPCPROCVAR}@{$endif}writeusedmacro,nil);
  359. ppufile.writeentry(ibusedmacros);
  360. ppufile.do_crc:=true;
  361. end;
  362. procedure tppumodule.writesourcefiles;
  363. var
  364. hp : tinputfile;
  365. i,j : longint;
  366. begin
  367. { second write the used source files }
  368. ppufile.do_crc:=false;
  369. hp:=sourcefiles.files;
  370. { write source files directly in good order }
  371. j:=0;
  372. while assigned(hp) do
  373. begin
  374. inc(j);
  375. hp:=hp.ref_next;
  376. end;
  377. while j>0 do
  378. begin
  379. hp:=sourcefiles.files;
  380. for i:=1 to j-1 do
  381. hp:=hp.ref_next;
  382. ppufile.putstring(hp.name^);
  383. ppufile.putlongint(hp.getfiletime);
  384. dec(j);
  385. end;
  386. ppufile.writeentry(ibsourcefiles);
  387. ppufile.do_crc:=true;
  388. end;
  389. procedure tppumodule.writeusedunit(intf:boolean);
  390. var
  391. hp : tused_unit;
  392. oldcrc : boolean;
  393. begin
  394. { renumber the units for derefence writing }
  395. numberunits;
  396. { write a reference for each used unit }
  397. hp:=tused_unit(used_units.first);
  398. while assigned(hp) do
  399. begin
  400. if hp.in_interface=intf then
  401. begin
  402. ppufile.putstring(hp.u.realmodulename^);
  403. { the checksum should not affect the crc of this unit ! (PFV) }
  404. oldcrc:=ppufile.do_crc;
  405. ppufile.do_crc:=false;
  406. ppufile.putlongint(longint(hp.checksum));
  407. ppufile.putlongint(longint(hp.interface_checksum));
  408. ppufile.do_crc:=oldcrc;
  409. end;
  410. hp:=tused_unit(hp.next);
  411. end;
  412. ppufile.do_interface_crc:=true;
  413. ppufile.writeentry(ibloadunit);
  414. end;
  415. procedure tppumodule.writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
  416. var
  417. hcontainer : tlinkcontainer;
  418. s : string;
  419. mask : cardinal;
  420. begin
  421. hcontainer:=TLinkContainer.Create;
  422. while not p.empty do
  423. begin
  424. s:=p.get(mask);
  425. if strippath then
  426. ppufile.putstring(SplitFileName(s))
  427. else
  428. ppufile.putstring(s);
  429. ppufile.putlongint(mask);
  430. hcontainer.add(s,mask);
  431. end;
  432. ppufile.writeentry(id);
  433. p.Free;
  434. p:=hcontainer;
  435. end;
  436. procedure tppumodule.writederefdata;
  437. var
  438. oldcrc : boolean;
  439. len,hlen : longint;
  440. buf : array[0..1023] of byte;
  441. begin
  442. if derefdataintflen>derefdata.size then
  443. internalerror(200310223);
  444. derefdata.seek(0);
  445. { Write interface data }
  446. len:=derefdataintflen;
  447. while (len>0) do
  448. begin
  449. if len>1024 then
  450. hlen:=1024
  451. else
  452. hlen:=len;
  453. derefdata.read(buf,hlen);
  454. ppufile.putdata(buf,hlen);
  455. dec(len,hlen);
  456. end;
  457. { Write implementation data, this does not influence crc }
  458. oldcrc:=ppufile.do_crc;
  459. ppufile.do_crc:=false;
  460. len:=derefdata.size-derefdataintflen;
  461. while (len>0) do
  462. begin
  463. if len>1024 then
  464. hlen:=1024
  465. else
  466. hlen:=len;
  467. derefdata.read(buf,hlen);
  468. ppufile.putdata(buf,hlen);
  469. dec(len,hlen);
  470. end;
  471. if derefdata.pos<>derefdata.size then
  472. internalerror(200310224);
  473. ppufile.do_crc:=oldcrc;
  474. ppufile.writeentry(ibderefdata);
  475. end;
  476. procedure tppumodule.putasmsymbol_in_idx(s:tnamedindexitem;arg:pointer);
  477. begin
  478. if tasmsymbol(s).ppuidx<>-1 then
  479. librarydata.asmsymbolidx^[tasmsymbol(s).ppuidx-1]:=tasmsymbol(s);
  480. end;
  481. procedure tppumodule.writeasmsymbols;
  482. var
  483. s : tasmsymbol;
  484. i : longint;
  485. asmsymtype : byte;
  486. begin
  487. { get an ordered list of all symbols to put in the ppu }
  488. getmem(librarydata.asmsymbolidx,librarydata.asmsymbolppuidx*sizeof(pointer));
  489. fillchar(librarydata.asmsymbolidx^,librarydata.asmsymbolppuidx*sizeof(pointer),0);
  490. librarydata.symbolsearch.foreach({$ifdef FPCPROCVAR}@{$endif}putasmsymbol_in_idx,nil);
  491. { write the number of symbols }
  492. ppufile.putlongint(librarydata.asmsymbolppuidx);
  493. { write the symbols from the indexed list to the ppu }
  494. for i:=1 to librarydata.asmsymbolppuidx do
  495. begin
  496. s:=librarydata.asmsymbolidx^[i-1];
  497. if not assigned(s) then
  498. internalerror(200208071);
  499. asmsymtype:=1;
  500. if s.Classtype=tasmlabel then
  501. begin
  502. if tasmlabel(s).is_addr then
  503. asmsymtype:=4
  504. else if tasmlabel(s).typ=AT_DATA then
  505. asmsymtype:=3
  506. else
  507. asmsymtype:=2;
  508. end;
  509. ppufile.putbyte(asmsymtype);
  510. case asmsymtype of
  511. 1 :
  512. ppufile.putstring(s.name);
  513. 2 :
  514. ppufile.putlongint(tasmlabel(s).labelnr);
  515. end;
  516. ppufile.putbyte(byte(s.defbind));
  517. ppufile.putbyte(byte(s.typ));
  518. end;
  519. ppufile.writeentry(ibasmsymbols);
  520. end;
  521. procedure tppumodule.readusedmacros;
  522. var
  523. hs : string;
  524. mac : tmacro;
  525. was_defined_at_startup,
  526. was_used : boolean;
  527. begin
  528. { only possible when we've a scanner of the current file }
  529. if not assigned(current_scanner) then
  530. exit;
  531. while not ppufile.endofentry do
  532. begin
  533. hs:=ppufile.getstring;
  534. was_defined_at_startup:=boolean(ppufile.getbyte);
  535. was_used:=boolean(ppufile.getbyte);
  536. mac:=tmacro(tscannerfile(current_scanner).macros.search(hs));
  537. if assigned(mac) then
  538. begin
  539. {$ifndef EXTDEBUG}
  540. { if we don't have the sources why tell }
  541. if sources_avail then
  542. {$endif ndef EXTDEBUG}
  543. if (not was_defined_at_startup) and
  544. was_used and
  545. mac.defined_at_startup then
  546. Message2(unit_h_cond_not_set_in_last_compile,hs,mainsource^);
  547. end
  548. else { not assigned }
  549. if was_defined_at_startup and
  550. was_used then
  551. Message2(unit_h_cond_set_in_last_compile,hs,mainsource^);
  552. end;
  553. end;
  554. procedure tppumodule.readsourcefiles;
  555. var
  556. temp,hs : string;
  557. temp_dir : string;
  558. main_dir : string;
  559. found,
  560. is_main : boolean;
  561. orgfiletime,
  562. source_time : longint;
  563. hp : tinputfile;
  564. begin
  565. sources_avail:=true;
  566. is_main:=true;
  567. main_dir:='';
  568. while not ppufile.endofentry do
  569. begin
  570. hs:=ppufile.getstring;
  571. orgfiletime:=ppufile.getlongint;
  572. temp_dir:='';
  573. if (flags and uf_in_library)<>0 then
  574. begin
  575. sources_avail:=false;
  576. temp:=' library';
  577. end
  578. else if pos('Macro ',hs)=1 then
  579. begin
  580. { we don't want to find this file }
  581. { but there is a problem with file indexing !! }
  582. temp:='';
  583. end
  584. else
  585. begin
  586. { check the date of the source files:
  587. 1 path of ppu
  588. 2 path of main source
  589. 3 current dir
  590. 4 include/unit path }
  591. Source_Time:=GetNamedFileTime(path^+hs);
  592. found:=false;
  593. if Source_Time<>-1 then
  594. hs:=path^+hs
  595. else
  596. if not(is_main) then
  597. begin
  598. Source_Time:=GetNamedFileTime(main_dir+hs);
  599. if Source_Time<>-1 then
  600. hs:=main_dir+hs;
  601. end;
  602. if Source_Time=-1 then
  603. Source_Time:=GetNamedFileTime(hs);
  604. if (Source_Time=-1) then
  605. begin
  606. if is_main then
  607. found:=unitsearchpath.FindFile(hs,temp_dir)
  608. else
  609. found:=includesearchpath.FindFile(hs,temp_dir);
  610. if found then
  611. begin
  612. Source_Time:=GetNamedFileTime(temp_dir);
  613. if Source_Time<>-1 then
  614. hs:=temp_dir;
  615. end;
  616. end;
  617. if Source_Time<>-1 then
  618. begin
  619. if is_main then
  620. main_dir:=temp_dir;
  621. temp:=' time '+filetimestring(source_time);
  622. if (orgfiletime<>-1) and
  623. (source_time<>orgfiletime) then
  624. begin
  625. if ((flags and uf_release)=0) then
  626. begin
  627. do_compile:=true;
  628. recompile_reason:=rr_sourcenewer;
  629. end
  630. else
  631. Message2(unit_h_source_modified,hs,ppufilename^);
  632. temp:=temp+' *';
  633. end;
  634. end
  635. else
  636. begin
  637. sources_avail:=false;
  638. temp:=' not found';
  639. end;
  640. hp:=tinputfile.create(hs);
  641. { the indexing is wrong here PM }
  642. sourcefiles.register_file(hp);
  643. end;
  644. if is_main then
  645. begin
  646. stringdispose(mainsource);
  647. mainsource:=stringdup(hs);
  648. end;
  649. Message1(unit_u_ppu_source,hs+temp);
  650. is_main:=false;
  651. end;
  652. { check if we want to rebuild every unit, only if the sources are
  653. available }
  654. if do_build and sources_avail and
  655. ((flags and uf_release)=0) then
  656. begin
  657. do_compile:=true;
  658. recompile_reason:=rr_build;
  659. end;
  660. end;
  661. procedure tppumodule.readloadunit;
  662. var
  663. hs : string;
  664. pu : tused_unit;
  665. hp : tppumodule;
  666. intfchecksum,
  667. checksum : cardinal;
  668. begin
  669. while not ppufile.endofentry do
  670. begin
  671. hs:=ppufile.getstring;
  672. checksum:=cardinal(ppufile.getlongint);
  673. intfchecksum:=cardinal(ppufile.getlongint);
  674. { set the state of this unit before registering, this is
  675. needed for a correct circular dependency check }
  676. hp:=registerunit(self,hs,'');
  677. pu:=addusedunit(hp,false,nil);
  678. pu.checksum:=checksum;
  679. pu.interface_checksum:=intfchecksum;
  680. end;
  681. in_interface:=false;
  682. end;
  683. procedure tppumodule.readlinkcontainer(var p:tlinkcontainer);
  684. var
  685. s : string;
  686. m : longint;
  687. begin
  688. while not ppufile.endofentry do
  689. begin
  690. s:=ppufile.getstring;
  691. m:=ppufile.getlongint;
  692. p.add(s,m);
  693. end;
  694. end;
  695. procedure tppumodule.readderefdata;
  696. var
  697. len,hlen : longint;
  698. buf : array[0..1023] of byte;
  699. begin
  700. len:=ppufile.entrysize;
  701. while (len>0) do
  702. begin
  703. if len>1024 then
  704. hlen:=1024
  705. else
  706. hlen:=len;
  707. ppufile.getdata(buf,hlen);
  708. derefdata.write(buf,hlen);
  709. dec(len,hlen);
  710. end;
  711. end;
  712. procedure tppumodule.readasmsymbols;
  713. var
  714. labelnr,
  715. i : longint;
  716. name : string;
  717. bind : TAsmSymBind;
  718. typ : TAsmSymType;
  719. asmsymtype : byte;
  720. begin
  721. librarydata.asmsymbolppuidx:=ppufile.getlongint;
  722. if librarydata.asmsymbolppuidx>0 then
  723. begin
  724. getmem(librarydata.asmsymbolidx,librarydata.asmsymbolppuidx*sizeof(pointer));
  725. fillchar(librarydata.asmsymbolidx^,librarydata.asmsymbolppuidx*sizeof(pointer),0);
  726. for i:=1 to librarydata.asmsymbolppuidx do
  727. begin
  728. asmsymtype:=ppufile.getbyte;
  729. case asmsymtype of
  730. 1 :
  731. name:=ppufile.getstring;
  732. 2..4 :
  733. labelnr:=ppufile.getlongint;
  734. else
  735. internalerror(200208192);
  736. end;
  737. bind:=tasmsymbind(ppufile.getbyte);
  738. typ:=tasmsymtype(ppufile.getbyte);
  739. case asmsymtype of
  740. 1 :
  741. librarydata.asmsymbolidx^[i-1]:=librarydata.newasmsymboltype(name,bind,typ);
  742. 2 :
  743. librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,false,false);
  744. 3 :
  745. librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,true,false);
  746. 4 :
  747. librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,false,true);
  748. end;
  749. end;
  750. end;
  751. end;
  752. procedure tppumodule.load_interface;
  753. var
  754. b : byte;
  755. newmodulename : string;
  756. begin
  757. { read interface part }
  758. repeat
  759. b:=ppufile.readentry;
  760. case b of
  761. ibmodulename :
  762. begin
  763. newmodulename:=ppufile.getstring;
  764. if (cs_check_unit_name in aktglobalswitches) and
  765. (upper(newmodulename)<>modulename^) then
  766. Message2(unit_f_unit_name_error,realmodulename^,newmodulename);
  767. stringdispose(modulename);
  768. stringdispose(realmodulename);
  769. modulename:=stringdup(upper(newmodulename));
  770. realmodulename:=stringdup(newmodulename);
  771. end;
  772. ibsourcefiles :
  773. readsourcefiles;
  774. ibusedmacros :
  775. readusedmacros;
  776. ibloadunit :
  777. readloadunit;
  778. iblinkunitofiles :
  779. readlinkcontainer(LinkUnitOFiles);
  780. iblinkunitstaticlibs :
  781. readlinkcontainer(LinkUnitStaticLibs);
  782. iblinkunitsharedlibs :
  783. readlinkcontainer(LinkUnitSharedLibs);
  784. iblinkotherofiles :
  785. readlinkcontainer(LinkotherOFiles);
  786. iblinkotherstaticlibs :
  787. readlinkcontainer(LinkotherStaticLibs);
  788. iblinkothersharedlibs :
  789. readlinkcontainer(LinkotherSharedLibs);
  790. ibderefdata :
  791. readderefdata;
  792. ibendinterface :
  793. break;
  794. else
  795. Message1(unit_f_ppu_invalid_entry,tostr(b));
  796. end;
  797. until false;
  798. end;
  799. procedure tppumodule.load_implementation;
  800. var
  801. b : byte;
  802. begin
  803. { read implementation part }
  804. repeat
  805. b:=ppufile.readentry;
  806. case b of
  807. ibloadunit :
  808. readloadunit;
  809. ibasmsymbols :
  810. readasmsymbols;
  811. ibendimplementation :
  812. break;
  813. else
  814. Message1(unit_f_ppu_invalid_entry,tostr(b));
  815. end;
  816. until false;
  817. end;
  818. procedure tppumodule.load_symtable_refs;
  819. var
  820. b : byte;
  821. i : longint;
  822. begin
  823. { load local symtable first }
  824. if ((flags and uf_local_browser)<>0) then
  825. begin
  826. localsymtable:=tstaticsymtable.create(modulename^);
  827. tstaticsymtable(localsymtable).ppuload(ppufile);
  828. end;
  829. { load browser }
  830. if (flags and uf_has_browser)<>0 then
  831. begin
  832. tstoredsymtable(globalsymtable).load_references(ppufile,true);
  833. for i:=0 to mapsize-1 do
  834. tstoredsymtable(globalsymtable).load_references(ppufile,false);
  835. b:=ppufile.readentry;
  836. if b<>ibendbrowser then
  837. Message1(unit_f_ppu_invalid_entry,tostr(b));
  838. end;
  839. if ((flags and uf_local_browser)<>0) then
  840. tstaticsymtable(localsymtable).load_references(ppufile,true);
  841. end;
  842. procedure tppumodule.writeppu;
  843. var
  844. pu : tused_unit;
  845. begin
  846. Message1(unit_u_ppu_write,realmodulename^);
  847. { create unit flags }
  848. {$ifdef GDB}
  849. if cs_gdb_dbx in aktglobalswitches then
  850. flags:=flags or uf_has_dbx;
  851. {$endif GDB}
  852. if cs_browser in aktmoduleswitches then
  853. flags:=flags or uf_has_browser;
  854. if cs_local_browser in aktmoduleswitches then
  855. flags:=flags or uf_local_browser;
  856. if do_release then
  857. flags:=flags or uf_release;
  858. {$ifdef cpufpemu}
  859. if (cs_fp_emulation in aktmoduleswitches) then
  860. flags:=flags or uf_fpu_emulation;
  861. {$endif cpufpemu}
  862. {$ifdef Test_Double_checksum_write}
  863. Assign(CRCFile,s+'.IMP');
  864. Rewrite(CRCFile);
  865. {$endif def Test_Double_checksum_write}
  866. { create new ppufile }
  867. ppufile:=tcompilerppufile.create(ppufilename^);
  868. if not ppufile.createfile then
  869. Message(unit_f_ppu_cannot_write);
  870. { first the unitname }
  871. ppufile.putstring(realmodulename^);
  872. ppufile.writeentry(ibmodulename);
  873. writesourcefiles;
  874. writeusedmacros;
  875. { write interface uses }
  876. writeusedunit(true);
  877. { write the objectfiles and libraries that come for this unit,
  878. preserve the containers becuase they are still needed to load
  879. the link.res. All doesn't depend on the crc! It doesn't matter
  880. if a unit is in a .o or .a file }
  881. ppufile.do_crc:=false;
  882. writelinkcontainer(linkunitofiles,iblinkunitofiles,true);
  883. writelinkcontainer(linkunitstaticlibs,iblinkunitstaticlibs,true);
  884. writelinkcontainer(linkunitsharedlibs,iblinkunitsharedlibs,true);
  885. writelinkcontainer(linkotherofiles,iblinkotherofiles,false);
  886. writelinkcontainer(linkotherstaticlibs,iblinkotherstaticlibs,true);
  887. writelinkcontainer(linkothersharedlibs,iblinkothersharedlibs,true);
  888. ppufile.do_crc:=true;
  889. { generate implementation deref data, the interface deref data is
  890. already generated when calculating the interface crc }
  891. if (cs_compilesystem in aktmoduleswitches) then
  892. begin
  893. aktglobalsymtable:=tstoredsymtable(globalsymtable);
  894. tstoredsymtable(globalsymtable).buildderef;
  895. derefdataintflen:=derefdata.size;
  896. end;
  897. tstoredsymtable(globalsymtable).buildderefimpl;
  898. if ((flags and uf_local_browser)<>0) and
  899. assigned(localsymtable) then
  900. begin
  901. aktglobalsymtable:=tstoredsymtable(globalsymtable);
  902. aktstaticsymtable:=tstoredsymtable(localsymtable);
  903. tstoredsymtable(localsymtable).buildderef;
  904. tstoredsymtable(localsymtable).buildderefimpl;
  905. end;
  906. writederefdata;
  907. ppufile.writeentry(ibendinterface);
  908. { write the symtable entries }
  909. tstoredsymtable(globalsymtable).ppuwrite(ppufile);
  910. { everything after this doesn't affect the crc }
  911. ppufile.do_crc:=false;
  912. { write implementation uses }
  913. writeusedunit(false);
  914. { write asmsymbols }
  915. writeasmsymbols;
  916. { end of implementation }
  917. ppufile.writeentry(ibendimplementation);
  918. { write static symtable
  919. needed for local debugging of unit functions }
  920. if ((flags and uf_local_browser)<>0) and
  921. assigned(localsymtable) then
  922. tstoredsymtable(localsymtable).ppuwrite(ppufile);
  923. { write all browser section }
  924. if (flags and uf_has_browser)<>0 then
  925. begin
  926. tstoredsymtable(globalsymtable).write_references(ppufile,true);
  927. pu:=tused_unit(used_units.first);
  928. while assigned(pu) do
  929. begin
  930. tstoredsymtable(pu.u.globalsymtable).write_references(ppufile,false);
  931. pu:=tused_unit(pu.next);
  932. end;
  933. ppufile.writeentry(ibendbrowser);
  934. end;
  935. if ((flags and uf_local_browser)<>0) and
  936. assigned(localsymtable) then
  937. tstaticsymtable(localsymtable).write_references(ppufile,true);
  938. { the last entry ibend is written automaticly }
  939. { flush to be sure }
  940. ppufile.flush;
  941. { create and write header }
  942. ppufile.header.size:=ppufile.size;
  943. ppufile.header.checksum:=ppufile.crc;
  944. ppufile.header.interface_checksum:=ppufile.interface_crc;
  945. ppufile.header.compiler:=wordversion;
  946. ppufile.header.cpu:=word(target_cpu);
  947. ppufile.header.target:=word(target_info.system);
  948. ppufile.header.flags:=flags;
  949. ppufile.writeheader;
  950. { save crc in current module also }
  951. crc:=ppufile.crc;
  952. interface_crc:=ppufile.interface_crc;
  953. {$ifdef Test_Double_checksum_write}
  954. close(CRCFile);
  955. {$endif Test_Double_checksum_write}
  956. ppufile.closefile;
  957. ppufile.free;
  958. ppufile:=nil;
  959. end;
  960. procedure tppumodule.getppucrc;
  961. begin
  962. {$ifdef Test_Double_checksum_write}
  963. Assign(CRCFile,s+'.INT')
  964. Rewrite(CRCFile);
  965. {$endif def Test_Double_checksum_write}
  966. { create new ppufile }
  967. ppufile:=tcompilerppufile.create(ppufilename^);
  968. ppufile.crc_only:=true;
  969. if not ppufile.createfile then
  970. Message(unit_f_ppu_cannot_write);
  971. { first the unitname }
  972. ppufile.putstring(realmodulename^);
  973. ppufile.writeentry(ibmodulename);
  974. { the interface units affect the crc }
  975. writeusedunit(true);
  976. { deref data of interface that affect the crc }
  977. derefdata.reset;
  978. aktglobalsymtable:=tstoredsymtable(globalsymtable);
  979. tstoredsymtable(globalsymtable).buildderef;
  980. derefdataintflen:=derefdata.size;
  981. writederefdata;
  982. ppufile.writeentry(ibendinterface);
  983. { write the symtable entries }
  984. tstoredsymtable(globalsymtable).ppuwrite(ppufile);
  985. { save crc }
  986. crc:=ppufile.crc;
  987. interface_crc:=ppufile.interface_crc;
  988. { end of implementation, to generate a correct ppufile
  989. for ppudump when using INTFPPU define }
  990. ppufile.writeentry(ibendimplementation);
  991. {$ifdef Test_Double_checksum}
  992. crc_array:=ppufile.crc_test;
  993. ppufile.crc_test:=nil;
  994. crc_size:=ppufile.crc_index2;
  995. crc_array2:=ppufile.crc_test2;
  996. ppufile.crc_test2:=nil;
  997. crc_size2:=ppufile.crc_index2;
  998. {$endif Test_Double_checksum}
  999. {$ifdef Test_Double_checksum_write}
  1000. close(CRCFile);
  1001. {$endif Test_Double_checksum_write}
  1002. { create and write header, this will only be used
  1003. for debugging purposes }
  1004. ppufile.header.size:=ppufile.size;
  1005. ppufile.header.checksum:=ppufile.crc;
  1006. ppufile.header.interface_checksum:=ppufile.interface_crc;
  1007. ppufile.header.compiler:=wordversion;
  1008. ppufile.header.cpu:=word(target_cpu);
  1009. ppufile.header.target:=word(target_info.system);
  1010. ppufile.header.flags:=flags;
  1011. ppufile.writeheader;
  1012. ppufile.closefile;
  1013. ppufile.free;
  1014. ppufile:=nil;
  1015. end;
  1016. procedure tppumodule.load_usedunits;
  1017. var
  1018. pu : tused_unit;
  1019. load_refs : boolean;
  1020. oldobjectlibrary : tasmlibrarydata;
  1021. begin
  1022. if current_module<>self then
  1023. internalerror(200212284);
  1024. load_refs:=true;
  1025. { load the used units from interface }
  1026. in_interface:=true;
  1027. pu:=tused_unit(used_units.first);
  1028. while assigned(pu) do
  1029. begin
  1030. if pu.in_interface then
  1031. begin
  1032. tppumodule(pu.u).loadppu;
  1033. { if this unit is compiled we can stop }
  1034. if state=ms_compiled then
  1035. exit;
  1036. { add this unit to the dependencies }
  1037. pu.u.adddependency(self);
  1038. { need to recompile the current unit, check the interface
  1039. crc. And when not compiled with -Ur then check the complete
  1040. crc }
  1041. if (pu.u.interface_crc<>pu.interface_checksum) or
  1042. (
  1043. ((ppufile.header.flags and uf_release)=0) and
  1044. (pu.u.crc<>pu.checksum)
  1045. ) then
  1046. begin
  1047. Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^);
  1048. recompile_reason:=rr_crcchanged;
  1049. do_compile:=true;
  1050. exit;
  1051. end;
  1052. end;
  1053. pu:=tused_unit(pu.next);
  1054. end;
  1055. numberunits;
  1056. { ok, now load the interface of this unit }
  1057. if current_module<>self then
  1058. internalerror(200208187);
  1059. globalsymtable:=tglobalsymtable.create(modulename^);
  1060. tstoredsymtable(globalsymtable).ppuload(ppufile);
  1061. interface_compiled:=true;
  1062. { read the implementation part, containing
  1063. the implementation uses and objectdata }
  1064. in_interface:=false;
  1065. load_implementation;
  1066. { now only read the implementation uses }
  1067. pu:=tused_unit(used_units.first);
  1068. while assigned(pu) do
  1069. begin
  1070. if (not pu.in_interface) then
  1071. begin
  1072. tppumodule(pu.u).loadppu;
  1073. { if this unit is compiled we can stop }
  1074. if state=ms_compiled then
  1075. exit;
  1076. { add this unit to the dependencies }
  1077. pu.u.adddependency(self);
  1078. { need to recompile the current unit ? }
  1079. if (pu.u.interface_crc<>pu.interface_checksum) then
  1080. begin
  1081. Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^+' {impl}');
  1082. recompile_reason:=rr_crcchanged;
  1083. do_compile:=true;
  1084. exit;
  1085. end;
  1086. end;
  1087. pu:=tused_unit(pu.next);
  1088. end;
  1089. numberunits;
  1090. { we can now derefence all pointers to the implementation parts }
  1091. oldobjectlibrary:=objectlibrary;
  1092. objectlibrary:=librarydata;
  1093. aktglobalsymtable:=tstoredsymtable(globalsymtable);
  1094. tstoredsymtable(globalsymtable).derefimpl;
  1095. if assigned(localsymtable) then
  1096. begin
  1097. aktstaticsymtable:=tstoredsymtable(localsymtable);
  1098. tstoredsymtable(localsymtable).derefimpl;
  1099. end;
  1100. objectlibrary:=oldobjectlibrary;
  1101. { load browser info if stored }
  1102. if ((flags and uf_has_browser)<>0) and load_refs then
  1103. begin
  1104. if current_module<>self then
  1105. internalerror(200208188);
  1106. load_symtable_refs;
  1107. end;
  1108. end;
  1109. function tppumodule.needrecompile:boolean;
  1110. var
  1111. pu : tused_unit;
  1112. begin
  1113. result:=false;
  1114. pu:=tused_unit(used_units.first);
  1115. while assigned(pu) do
  1116. begin
  1117. { need to recompile the current unit, check the interface
  1118. crc. And when not compiled with -Ur then check the complete
  1119. crc }
  1120. if (pu.u.interface_crc<>pu.interface_checksum) or
  1121. (
  1122. (pu.in_interface) and
  1123. (pu.u.crc<>pu.checksum)
  1124. ) then
  1125. begin
  1126. result:=true;
  1127. exit;
  1128. end;
  1129. pu:=tused_unit(pu.next);
  1130. end;
  1131. end;
  1132. procedure tppumodule.loadppu;
  1133. const
  1134. ImplIntf : array[boolean] of string[15]=('implementation','interface');
  1135. var
  1136. do_load,
  1137. second_time : boolean;
  1138. old_current_module : tmodule;
  1139. begin
  1140. old_current_module:=current_module;
  1141. Message3(unit_u_load_unit,old_current_module.modulename^,
  1142. ImplIntf[old_current_module.in_interface],
  1143. modulename^);
  1144. { Update loaded_from to detect cycles }
  1145. loaded_from:=old_current_module;
  1146. { check if the globalsymtable is already available, but
  1147. we must reload when the do_reload flag is set }
  1148. if (not do_reload) and
  1149. assigned(globalsymtable) then
  1150. exit;
  1151. { reset }
  1152. do_load:=true;
  1153. second_time:=false;
  1154. current_module:=self;
  1155. SetCompileModule(current_module);
  1156. Fillchar(aktfilepos,0,sizeof(aktfilepos));
  1157. { A force reload }
  1158. if do_reload then
  1159. begin
  1160. Message(unit_u_forced_reload);
  1161. do_reload:=false;
  1162. { When the unit is already loaded or being loaded
  1163. we can maybe skip a complete reload/recompile }
  1164. if assigned(globalsymtable) and
  1165. (not needrecompile) then
  1166. begin
  1167. { When we don't have any data stored yet there
  1168. is nothing to resolve }
  1169. if interface_compiled then
  1170. begin
  1171. Message1(unit_u_reresolving_unit,modulename^);
  1172. aktglobalsymtable:=tstoredsymtable(globalsymtable);
  1173. tstoredsymtable(globalsymtable).deref;
  1174. tstoredsymtable(globalsymtable).derefimpl;
  1175. if assigned(localsymtable) then
  1176. begin
  1177. aktstaticsymtable:=tstoredsymtable(localsymtable);
  1178. tstoredsymtable(localsymtable).deref;
  1179. tstoredsymtable(localsymtable).derefimpl;
  1180. end;
  1181. end
  1182. else
  1183. Message1(unit_u_skipping_reresolving_unit,modulename^);
  1184. do_load:=false;
  1185. end;
  1186. end;
  1187. if do_load then
  1188. begin
  1189. { we are loading a new module, save the state of the scanner
  1190. and reset scanner+module }
  1191. if assigned(current_scanner) then
  1192. current_scanner.tempcloseinputfile;
  1193. current_scanner:=nil;
  1194. { loading the unit for a second time? }
  1195. if state=ms_registered then
  1196. state:=ms_load
  1197. else
  1198. begin
  1199. { try to load the unit a second time first }
  1200. Message1(unit_u_second_load_unit,modulename^);
  1201. Message2(unit_u_previous_state,modulename^,ModuleStateStr[state]);
  1202. { Flag modules to reload }
  1203. flagdependent(old_current_module);
  1204. { Reset the module }
  1205. reset;
  1206. if state in [ms_compile,ms_second_compile] then
  1207. begin
  1208. Message1(unit_u_second_compile_unit,modulename^);
  1209. state:=ms_second_compile;
  1210. do_compile:=true;
  1211. end
  1212. else
  1213. state:=ms_second_load;
  1214. second_time:=true;
  1215. end;
  1216. { close old_current_ppu on system that are
  1217. short on file handles like DOS PM }
  1218. {$ifdef SHORT_ON_FILE_HANDLES}
  1219. if old_current_module.is_unit and
  1220. assigned(tppumodule(old_current_module).ppufile) then
  1221. tppumodule(old_current_module).ppufile.tempclose;
  1222. {$endif SHORT_ON_FILE_HANDLES}
  1223. { try to opening ppu, skip this when we already
  1224. know that we need to compile the unit }
  1225. if not do_compile then
  1226. begin
  1227. Message1(unit_u_loading_unit,modulename^);
  1228. search_unit(false,false);
  1229. if not do_compile then
  1230. begin
  1231. load_interface;
  1232. if not do_compile then
  1233. begin
  1234. load_usedunits;
  1235. if not do_compile then
  1236. Message1(unit_u_finished_loading_unit,modulename^);
  1237. end;
  1238. end;
  1239. { PPU is not needed anymore }
  1240. if assigned(ppufile) then
  1241. begin
  1242. ppufile.closefile;
  1243. ppufile.free;
  1244. ppufile:=nil;
  1245. end;
  1246. end;
  1247. { Do we need to recompile the unit }
  1248. if do_compile then
  1249. begin
  1250. { recompile the unit or give a fatal error if sources not available }
  1251. if not(sources_avail) then
  1252. begin
  1253. if (not search_unit(true,false)) and
  1254. (length(modulename^)>8) then
  1255. search_unit(true,true);
  1256. if not(sources_avail) then
  1257. begin
  1258. if recompile_reason=rr_noppu then
  1259. Message1(unit_f_cant_find_ppu,modulename^)
  1260. else
  1261. Message1(unit_f_cant_compile_unit,modulename^);
  1262. end;
  1263. end;
  1264. { Flag modules to reload }
  1265. flagdependent(old_current_module);
  1266. { Reset the module }
  1267. reset;
  1268. { compile this module }
  1269. if not(state in [ms_compile,ms_second_compile]) then
  1270. state:=ms_compile;
  1271. compile(mainsource^);
  1272. end
  1273. else
  1274. state:=ms_compiled;
  1275. if current_module<>self then
  1276. internalerror(200212282);
  1277. if in_interface then
  1278. internalerror(200212283);
  1279. { for a second_time recompile reload all dependent units,
  1280. for a first time compile register the unit _once_ }
  1281. if second_time then
  1282. reload_flagged_units
  1283. else
  1284. usedunits.concat(tused_unit.create(self,true,false,nil));
  1285. { reopen the old module }
  1286. {$ifdef SHORT_ON_FILE_HANDLES}
  1287. if old_current_module.is_unit and
  1288. assigned(tppumodule(old_current_module).ppufile) then
  1289. tppumodule(old_current_module).ppufile.tempopen;
  1290. {$endif SHORT_ON_FILE_HANDLES}
  1291. { reload old scanner }
  1292. current_scanner:=tscannerfile(old_current_module.scanner);
  1293. if assigned(current_scanner) then
  1294. begin
  1295. current_scanner.tempopeninputfile;
  1296. current_scanner.gettokenpos
  1297. end
  1298. else
  1299. fillchar(aktfilepos,sizeof(aktfilepos),0);
  1300. end;
  1301. { we are back, restore current_module }
  1302. current_module:=old_current_module;
  1303. SetCompileModule(current_module);
  1304. end;
  1305. {*****************************************************************************
  1306. RegisterUnit
  1307. *****************************************************************************}
  1308. function registerunit(callermodule:tmodule;const s : stringid;const fn:string) : tppumodule;
  1309. var
  1310. ups : stringid;
  1311. hp : tppumodule;
  1312. hp2,
  1313. shortnamehp : tmodule;
  1314. begin
  1315. { Info }
  1316. ups:=upper(s);
  1317. { search all loaded units }
  1318. shortnamehp:=nil;
  1319. hp:=tppumodule(loaded_units.first);
  1320. while assigned(hp) do
  1321. begin
  1322. if hp.modulename^=ups then
  1323. begin
  1324. { only check for units. The main program is also
  1325. as a unit in the loaded_units list. We simply need
  1326. to ignore this entry (PFV) }
  1327. if hp.is_unit then
  1328. begin
  1329. { both units in interface ? }
  1330. if callermodule.in_interface and
  1331. hp.in_interface then
  1332. begin
  1333. { check for a cycle }
  1334. hp2:=callermodule.loaded_from;
  1335. while assigned(hp2) and (hp2<>hp) do
  1336. begin
  1337. if hp2.in_interface then
  1338. hp2:=hp2.loaded_from
  1339. else
  1340. hp2:=nil;
  1341. end;
  1342. if assigned(hp2) then
  1343. Message2(unit_f_circular_unit_reference,callermodule.modulename^,hp.modulename^);
  1344. end;
  1345. break;
  1346. end;
  1347. end
  1348. else
  1349. if copy(hp.modulename^,1,8)=ups then
  1350. shortnamehp:=hp;
  1351. { the next unit }
  1352. hp:=tppumodule(hp.next);
  1353. end;
  1354. if assigned(shortnamehp) and not assigned(hp) then
  1355. Message2(unit_w_unit_name_error,s,shortnamehp.modulename^);
  1356. { the unit is not in the loaded units,
  1357. we create an entry and register the unit }
  1358. if not assigned(hp) then
  1359. begin
  1360. Message1(unit_u_registering_new_unit,Upper(s));
  1361. hp:=tppumodule.create(callermodule,s,fn,true);
  1362. hp.loaded_from:=callermodule;
  1363. loaded_units.insert(hp);
  1364. end;
  1365. { return }
  1366. registerunit:=hp;
  1367. end;
  1368. end.
  1369. {
  1370. $Log$
  1371. Revision 1.49 2003-12-22 22:15:43 peter
  1372. * deref implementation after implementation units are loaded and
  1373. numbered
  1374. Revision 1.48 2003/12/14 18:13:18 peter
  1375. * also check currnet dir when searching source files
  1376. Revision 1.47 2003/11/28 17:23:16 peter
  1377. * serach also in include path for used files
  1378. Revision 1.46 2003/11/03 12:32:48 marco
  1379. * cycle detection patch from peter
  1380. Revision 1.45 2003/10/29 21:55:10 peter
  1381. * don't set second_load when second_compile was already set
  1382. Revision 1.44 2003/10/29 21:02:51 peter
  1383. * set ms_compiled after the program/unit is parsed
  1384. * check for ms_compiled before checking preproc matches
  1385. Revision 1.43 2003/10/23 14:44:07 peter
  1386. * splitted buildderef and buildderefimpl to fix interface crc
  1387. calculation
  1388. Revision 1.42 2003/10/22 20:40:00 peter
  1389. * write derefdata in a separate ppu entry
  1390. Revision 1.41 2003/10/22 17:38:25 peter
  1391. * write implementation units in implementation part of the ppu
  1392. so it doesn't confuse the unit loading
  1393. Revision 1.40 2003/10/22 15:22:33 peter
  1394. * fixed unitsym-globalsymtable relation so the uses of a unit
  1395. is counted correctly
  1396. Revision 1.39 2003/09/05 17:41:12 florian
  1397. * merged Wiktor's Watcom patches in 1.1
  1398. Revision 1.38 2003/08/23 22:29:24 peter
  1399. * reload flagged units when interface is loaded
  1400. Revision 1.37 2003/06/08 11:40:14 peter
  1401. * moved message to msg file
  1402. Revision 1.36 2003/06/07 20:26:32 peter
  1403. * re-resolving added instead of reloading from ppu
  1404. * tderef object added to store deref info for resolving
  1405. Revision 1.35 2003/05/25 10:27:12 peter
  1406. * moved Comment calls to messge file
  1407. Revision 1.34 2003/05/23 17:04:37 peter
  1408. * write interface crc to .ppu.intf when enabled
  1409. * when a unit is compiled with -Ur check only interface crc
  1410. Revision 1.33 2003/04/27 11:21:32 peter
  1411. * aktprocdef renamed to current_procdef
  1412. * procinfo renamed to current_procinfo
  1413. * procinfo will now be stored in current_module so it can be
  1414. cleaned up properly
  1415. * gen_main_procsym changed to create_main_proc and release_main_proc
  1416. to also generate a tprocinfo structure
  1417. * fixed unit implicit initfinal
  1418. Revision 1.32 2003/04/27 07:29:50 peter
  1419. * current_procdef cleanup, current_procdef is now always nil when parsing
  1420. a new procdef declaration
  1421. * aktprocsym removed
  1422. * lexlevel removed, use symtable.symtablelevel instead
  1423. * implicit init/final code uses the normal genentry/genexit
  1424. * funcret state checking updated for new funcret handling
  1425. Revision 1.31 2003/04/26 00:30:52 peter
  1426. * reset aktfilepos when setting new module for compile
  1427. Revision 1.30 2003/03/27 17:44:13 peter
  1428. * fixed small mem leaks
  1429. Revision 1.29 2002/12/29 14:57:50 peter
  1430. * unit loading changed to first register units and load them
  1431. afterwards. This is needed to support uses xxx in yyy correctly
  1432. * unit dependency check fixed
  1433. Revision 1.28 2002/12/06 16:56:57 peter
  1434. * only compile cs_fp_emulation support when cpufpuemu is defined
  1435. * define cpufpuemu for m68k only
  1436. Revision 1.27 2002/11/20 12:36:24 mazen
  1437. * $UNITPATH directive is now working
  1438. Revision 1.26 2002/11/15 01:58:46 peter
  1439. * merged changes from 1.0.7 up to 04-11
  1440. - -V option for generating bug report tracing
  1441. - more tracing for option parsing
  1442. - errors for cdecl and high()
  1443. - win32 import stabs
  1444. - win32 records<=8 are returned in eax:edx (turned off by default)
  1445. - heaptrc update
  1446. - more info for temp management in .s file with EXTDEBUG
  1447. Revision 1.25 2002/10/20 14:49:31 peter
  1448. * store original source time in ppu so it can be compared instead of
  1449. comparing with the ppu time
  1450. Revision 1.24 2002/10/04 20:13:10 peter
  1451. * set in_second_load flag before resetting the module, this is
  1452. required to skip some checkings
  1453. Revision 1.23 2002/08/19 19:36:42 peter
  1454. * More fixes for cross unit inlining, all tnodes are now implemented
  1455. * Moved pocall_internconst to po_internconst because it is not a
  1456. calling type at all and it conflicted when inlining of these small
  1457. functions was requested
  1458. Revision 1.22 2002/08/18 19:58:28 peter
  1459. * more current_scanner fixes
  1460. Revision 1.21 2002/08/15 15:09:41 carl
  1461. + fpu emulation helpers (ppu checking also)
  1462. Revision 1.20 2002/08/12 16:46:04 peter
  1463. * tscannerfile is now destroyed in tmodule.reset and current_scanner
  1464. is updated accordingly. This removes all the loading and saving of
  1465. the old scanner and the invalid flag marking
  1466. Revision 1.19 2002/08/11 14:28:19 peter
  1467. * TScannerFile.SetInvalid added that will also reset inputfile
  1468. Revision 1.18 2002/08/11 13:24:11 peter
  1469. * saving of asmsymbols in ppu supported
  1470. * asmsymbollist global is removed and moved into a new class
  1471. tasmlibrarydata that will hold the info of a .a file which
  1472. corresponds with a single module. Added librarydata to tmodule
  1473. to keep the library info stored for the module. In the future the
  1474. objectfiles will also be stored to the tasmlibrarydata class
  1475. * all getlabel/newasmsymbol and friends are moved to the new class
  1476. Revision 1.17 2002/07/26 21:15:37 florian
  1477. * rewrote the system handling
  1478. Revision 1.16 2002/05/16 19:46:36 carl
  1479. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1480. + try to fix temp allocation (still in ifdef)
  1481. + generic constructor calls
  1482. + start of tassembler / tmodulebase class cleanup
  1483. Revision 1.15 2002/05/14 19:34:41 peter
  1484. * removed old logs and updated copyright year
  1485. Revision 1.14 2002/05/12 16:53:05 peter
  1486. * moved entry and exitcode to ncgutil and cgobj
  1487. * foreach gets extra argument for passing local data to the
  1488. iterator function
  1489. * -CR checks also class typecasts at runtime by changing them
  1490. into as
  1491. * fixed compiler to cycle with the -CR option
  1492. * fixed stabs with elf writer, finally the global variables can
  1493. be watched
  1494. * removed a lot of routines from cga unit and replaced them by
  1495. calls to cgobj
  1496. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1497. u32bit then the other is typecasted also to u32bit without giving
  1498. a rangecheck warning/error.
  1499. * fixed pascal calling method with reversing also the high tree in
  1500. the parast, detected by tcalcst3 test
  1501. Revision 1.13 2002/04/04 19:05:56 peter
  1502. * removed unused units
  1503. * use tlocation.size in cg.a_*loc*() routines
  1504. Revision 1.12 2002/03/28 20:46:44 carl
  1505. - remove go32v1 support
  1506. Revision 1.11 2002/01/19 14:20:13 peter
  1507. * check for -Un when loading ppu with wrong name
  1508. }