fppu.pas 56 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686
  1. {
  2. Copyright (c) 1998-2002 by Florian Klaempfl
  3. This unit implements the first loading and searching of the modules
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. unit fppu;
  18. {$i fpcdefs.inc}
  19. { close ppufiles on system that are
  20. short on file handles like DOS system PM }
  21. {$ifdef GO32V2}
  22. {$define SHORT_ON_FILE_HANDLES}
  23. {$endif GO32V2}
  24. {$ifdef WATCOM}
  25. {$define SHORT_ON_FILE_HANDLES}
  26. {$endif WATCOM}
  27. interface
  28. uses
  29. cutils,cclasses,
  30. globtype,globals,finput,fmodule,
  31. symbase,ppu,symtype;
  32. type
  33. { tppumodule }
  34. tppumodule = class(tmodule)
  35. ppufile : tcompilerppufile; { the PPU file }
  36. sourcefn : pshortstring; { Source specified with "uses .. in '..'" }
  37. comments : TCmdStrList;
  38. {$ifdef Test_Double_checksum}
  39. crc_array : pointer;
  40. crc_size : longint;
  41. crc_array2 : pointer;
  42. crc_size2 : longint;
  43. {$endif def Test_Double_checksum}
  44. constructor create(LoadedFrom:TModule;const s:string;const fn:string;_is_unit:boolean);
  45. destructor destroy;override;
  46. procedure reset;override;
  47. function openppu:boolean;
  48. procedure getppucrc;
  49. procedure writeppu;
  50. procedure loadppu;
  51. function needrecompile:boolean;
  52. private
  53. function search_unit(onlysource,shortname:boolean):boolean;
  54. procedure load_interface;
  55. procedure load_implementation;
  56. procedure load_usedunits;
  57. procedure printcomments;
  58. procedure queuecomment(s:string;v,w:longint);
  59. procedure writesourcefiles;
  60. procedure writeusedunit(intf:boolean);
  61. procedure writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
  62. procedure writederefmap;
  63. procedure writederefdata;
  64. procedure writeImportSymbols;
  65. procedure writeResources;
  66. procedure readsourcefiles;
  67. procedure readloadunit;
  68. procedure readlinkcontainer(var p:tlinkcontainer);
  69. procedure readderefmap;
  70. procedure readderefdata;
  71. procedure readImportSymbols;
  72. procedure readResources;
  73. procedure readwpofile;
  74. {$IFDEF MACRO_DIFF_HINT}
  75. procedure writeusedmacro(p:TNamedIndexItem;arg:pointer);
  76. procedure writeusedmacros;
  77. procedure readusedmacros;
  78. {$ENDIF}
  79. end;
  80. procedure reload_flagged_units;
  81. function registerunit(callermodule:tmodule;const s : TIDString;const fn:string) : tppumodule;
  82. implementation
  83. uses
  84. SysUtils,
  85. cfileutl,
  86. verbose,systems,version,
  87. symtable, symsym,
  88. wpoinfo,
  89. scanner,
  90. aasmbase,ogbase,
  91. parser,
  92. comphook;
  93. {****************************************************************************
  94. Helpers
  95. ****************************************************************************}
  96. procedure reload_flagged_units;
  97. var
  98. hp : tmodule;
  99. begin
  100. { now reload all dependent units }
  101. hp:=tmodule(loaded_units.first);
  102. while assigned(hp) do
  103. begin
  104. if hp.do_reload then
  105. tppumodule(hp).loadppu;
  106. hp:=tmodule(hp.next);
  107. end;
  108. end;
  109. {****************************************************************************
  110. TPPUMODULE
  111. ****************************************************************************}
  112. constructor tppumodule.create(LoadedFrom:TModule;const s:string;const fn:string;_is_unit:boolean);
  113. begin
  114. inherited create(LoadedFrom,s,_is_unit);
  115. ppufile:=nil;
  116. sourcefn:=stringdup(fn);
  117. end;
  118. destructor tppumodule.Destroy;
  119. begin
  120. if assigned(ppufile) then
  121. ppufile.free;
  122. ppufile:=nil;
  123. comments.free;
  124. comments:=nil;
  125. stringdispose(sourcefn);
  126. inherited Destroy;
  127. end;
  128. procedure tppumodule.reset;
  129. begin
  130. if assigned(ppufile) then
  131. begin
  132. ppufile.free;
  133. ppufile:=nil;
  134. end;
  135. inherited reset;
  136. end;
  137. procedure tppumodule.queuecomment(s:string;v,w:longint);
  138. begin
  139. if comments = nil then
  140. comments := TCmdStrList.create;
  141. comments.insert(s);
  142. end;
  143. procedure tppumodule.printcomments;
  144. var
  145. comment: string;
  146. begin
  147. if comments = nil then
  148. exit;
  149. { comments are inserted in reverse order }
  150. repeat
  151. comment := comments.getlast;
  152. if length(comment) = 0 then
  153. exit;
  154. do_comment(v_normal, comment);
  155. until false;
  156. end;
  157. function tppumodule.openppu:boolean;
  158. var
  159. ppufiletime : longint;
  160. begin
  161. openppu:=false;
  162. Message1(unit_t_ppu_loading,ppufilename^,@queuecomment);
  163. { Get ppufile time (also check if the file exists) }
  164. ppufiletime:=getnamedfiletime(ppufilename^);
  165. if ppufiletime=-1 then
  166. exit;
  167. { Open the ppufile }
  168. Message1(unit_u_ppu_name,ppufilename^);
  169. ppufile:=tcompilerppufile.create(ppufilename^);
  170. if not ppufile.openfile then
  171. begin
  172. ppufile.free;
  173. ppufile:=nil;
  174. Message(unit_u_ppu_file_too_short);
  175. exit;
  176. end;
  177. { check for a valid PPU file }
  178. if not ppufile.CheckPPUId then
  179. begin
  180. ppufile.free;
  181. ppufile:=nil;
  182. Message(unit_u_ppu_invalid_header);
  183. exit;
  184. end;
  185. { check for allowed PPU versions }
  186. if not (ppufile.GetPPUVersion = CurrentPPUVersion) then
  187. begin
  188. Message1(unit_u_ppu_invalid_version,tostr(ppufile.GetPPUVersion),@queuecomment);
  189. ppufile.free;
  190. ppufile:=nil;
  191. exit;
  192. end;
  193. { check the target processor }
  194. if tsystemcpu(ppufile.header.cpu)<>target_cpu then
  195. begin
  196. ppufile.free;
  197. ppufile:=nil;
  198. Message(unit_u_ppu_invalid_processor,@queuecomment);
  199. exit;
  200. end;
  201. { check target }
  202. if tsystem(ppufile.header.target)<>target_info.system then
  203. begin
  204. ppufile.free;
  205. ppufile:=nil;
  206. Message(unit_u_ppu_invalid_target,@queuecomment);
  207. exit;
  208. end;
  209. {$ifdef cpufpemu}
  210. { check if floating point emulation is on?
  211. fpu emulation isn't unit levelwise because it affects calling convention }
  212. if ((ppufile.header.flags and uf_fpu_emulation)<>0) xor
  213. (cs_fp_emulation in current_settings.moduleswitches) then
  214. begin
  215. ppufile.free;
  216. ppufile:=nil;
  217. Message(unit_u_ppu_invalid_fpumode,@queuecomment);
  218. exit;
  219. end;
  220. {$endif cpufpemu}
  221. { Load values to be access easier }
  222. flags:=ppufile.header.flags;
  223. crc:=ppufile.header.checksum;
  224. interface_crc:=ppufile.header.interface_checksum;
  225. indirect_crc:=ppufile.header.indirect_checksum;
  226. { Show Debug info }
  227. Message1(unit_u_ppu_time,filetimestring(ppufiletime));
  228. Message1(unit_u_ppu_flags,tostr(flags));
  229. Message1(unit_u_ppu_crc,hexstr(ppufile.header.checksum,8));
  230. Message1(unit_u_ppu_crc,hexstr(ppufile.header.interface_checksum,8)+' (intfc)');
  231. Message1(unit_u_ppu_crc,hexstr(ppufile.header.indirect_checksum,8)+' (indc)');
  232. Comment(V_used,'Number of definitions: '+tostr(ppufile.header.deflistsize));
  233. Comment(V_used,'Number of symbols: '+tostr(ppufile.header.symlistsize));
  234. do_compile:=false;
  235. openppu:=true;
  236. end;
  237. function tppumodule.search_unit(onlysource,shortname:boolean):boolean;
  238. var
  239. singlepathstring,
  240. filename : TCmdStr;
  241. Function UnitExists(const ext:string;var foundfile:TCmdStr):boolean;
  242. begin
  243. if CheckVerbosity(V_Tried) then
  244. Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
  245. UnitExists:=FindFile(FileName+ext,Singlepathstring,true,foundfile);
  246. end;
  247. Function PPUSearchPath(const s:TCmdStr):boolean;
  248. var
  249. found : boolean;
  250. hs : TCmdStr;
  251. begin
  252. Found:=false;
  253. singlepathstring:=FixPath(s,false);
  254. { Check for PPU file }
  255. Found:=UnitExists(target_info.unitext,hs);
  256. if Found then
  257. Begin
  258. SetFileName(hs,false);
  259. Found:=OpenPPU;
  260. End;
  261. PPUSearchPath:=Found;
  262. end;
  263. Function SourceSearchPath(const s:TCmdStr):boolean;
  264. var
  265. found : boolean;
  266. hs : TCmdStr;
  267. begin
  268. Found:=false;
  269. singlepathstring:=FixPath(s,false);
  270. { Check for Sources }
  271. ppufile:=nil;
  272. do_compile:=true;
  273. recompile_reason:=rr_noppu;
  274. {Check for .pp file}
  275. Found:=UnitExists(sourceext,hs);
  276. if not Found then
  277. begin
  278. { Check for .pas }
  279. Found:=UnitExists(pasext,hs);
  280. end;
  281. if not Found and (m_mac in current_settings.modeswitches) then
  282. begin
  283. { Check for .p, if mode is macpas}
  284. Found:=UnitExists(pext,hs);
  285. end;
  286. stringdispose(mainsource);
  287. if Found then
  288. begin
  289. sources_avail:=true;
  290. { Load Filenames when found }
  291. mainsource:=StringDup(hs);
  292. SetFileName(hs,false);
  293. end
  294. else
  295. sources_avail:=false;
  296. SourceSearchPath:=Found;
  297. end;
  298. Function SearchPath(const s:TCmdStr):boolean;
  299. var
  300. found : boolean;
  301. begin
  302. { First check for a ppu, then for the source }
  303. found:=false;
  304. if not onlysource then
  305. found:=PPUSearchPath(s);
  306. if not found then
  307. found:=SourceSearchPath(s);
  308. SearchPath:=found;
  309. end;
  310. Function SearchPathList(list:TSearchPathList):boolean;
  311. var
  312. hp : TCmdStrListItem;
  313. found : boolean;
  314. begin
  315. found:=false;
  316. hp:=TCmdStrListItem(list.First);
  317. while assigned(hp) do
  318. begin
  319. found:=SearchPath(hp.Str);
  320. if found then
  321. break;
  322. hp:=TCmdStrListItem(hp.next);
  323. end;
  324. SearchPathList:=found;
  325. end;
  326. var
  327. fnd : boolean;
  328. hs : TCmdStr;
  329. begin
  330. if shortname then
  331. filename:=FixFileName(Copy(realmodulename^,1,8))
  332. else
  333. filename:=FixFileName(realmodulename^);
  334. { try to find unit
  335. 1. look for ppu in cwd
  336. 2. look for ppu in outputpath if set, this is tp7 compatible (PFV)
  337. 3. look for ppu in maindir
  338. 4. look for the specified source file (from the uses line)
  339. 5. look for source in cwd
  340. 6. look for source in maindir
  341. 7. local unit pathlist
  342. 8. global unit pathlist }
  343. fnd:=false;
  344. if not onlysource then
  345. begin
  346. fnd:=PPUSearchPath('.');
  347. if (not fnd) and (outputpath^<>'') then
  348. fnd:=PPUSearchPath(outputpath^);
  349. if (not fnd) and Assigned(main_module) and (main_module.Path^<>'') then
  350. fnd:=PPUSearchPath(main_module.Path^);
  351. end;
  352. if (not fnd) and (sourcefn^<>'') then
  353. begin
  354. { the full filename is specified so we can't use here the
  355. searchpath (PFV) }
  356. if CheckVerbosity(V_Tried) then
  357. Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,sourceext));
  358. fnd:=FindFile(ChangeFileExt(sourcefn^,sourceext),'',true,hs);
  359. if not fnd then
  360. begin
  361. if CheckVerbosity(V_Tried) then
  362. Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,pasext));
  363. fnd:=FindFile(ChangeFileExt(sourcefn^,pasext),'',true,hs);
  364. end;
  365. if not fnd and ((m_mac in current_settings.modeswitches) or (tf_p_ext_support in target_info.flags)) then
  366. begin
  367. if CheckVerbosity(V_Tried) then
  368. Message1(unit_t_unitsearch,ChangeFileExt(sourcefn^,pext));
  369. fnd:=FindFile(ChangeFileExt(sourcefn^,pext),'',true,hs);
  370. end;
  371. if fnd then
  372. begin
  373. sources_avail:=true;
  374. do_compile:=true;
  375. recompile_reason:=rr_noppu;
  376. stringdispose(mainsource);
  377. mainsource:=StringDup(hs);
  378. SetFileName(hs,false);
  379. end;
  380. end;
  381. if not fnd then
  382. fnd:=SourceSearchPath('.');
  383. if (not fnd) and Assigned(main_module) and (main_module.Path^<>'') then
  384. fnd:=SourceSearchPath(main_module.Path^);
  385. if (not fnd) and Assigned(loaded_from) then
  386. fnd:=SearchPathList(loaded_from.LocalUnitSearchPath);
  387. if not fnd then
  388. fnd:=SearchPathList(UnitSearchPath);
  389. { try to find a file with the first 8 chars of the modulename, like
  390. dos }
  391. if (not fnd) and (length(filename)>8) then
  392. begin
  393. filename:=copy(filename,1,8);
  394. fnd:=SearchPath('.');
  395. if (not fnd) then
  396. fnd:=SearchPathList(LocalUnitSearchPath);
  397. if not fnd then
  398. fnd:=SearchPathList(UnitSearchPath);
  399. end;
  400. search_unit:=fnd;
  401. end;
  402. {**********************************
  403. PPU Reading/Writing Helpers
  404. ***********************************}
  405. {$IFDEF MACRO_DIFF_HINT}
  406. var
  407. is_initial: Boolean;
  408. procedure tppumodule.writeusedmacro(p:TNamedIndexItem;arg:pointer);
  409. begin
  410. if tmacro(p).is_used or is_initial then
  411. begin
  412. ppufile.putstring(p.name);
  413. ppufile.putbyte(byte(is_initial));
  414. ppufile.putbyte(byte(tmacro(p).is_used));
  415. end;
  416. end;
  417. procedure tppumodule.writeusedmacros;
  418. begin
  419. ppufile.do_crc:=false;
  420. is_initial:= true;
  421. initialmacrosymtable.foreach(@writeusedmacro,nil);
  422. is_initial:= false;
  423. if assigned(globalmacrosymtable) then
  424. globalmacrosymtable.foreach(@writeusedmacro,nil);
  425. localmacrosymtable.foreach(@writeusedmacro,nil);
  426. ppufile.writeentry(ibusedmacros);
  427. ppufile.do_crc:=true;
  428. end;
  429. {$ENDIF}
  430. procedure tppumodule.writesourcefiles;
  431. var
  432. hp : tinputfile;
  433. i,j : longint;
  434. begin
  435. { second write the used source files }
  436. ppufile.do_crc:=false;
  437. hp:=sourcefiles.files;
  438. { write source files directly in good order }
  439. j:=0;
  440. while assigned(hp) do
  441. begin
  442. inc(j);
  443. hp:=hp.ref_next;
  444. end;
  445. while j>0 do
  446. begin
  447. hp:=sourcefiles.files;
  448. for i:=1 to j-1 do
  449. hp:=hp.ref_next;
  450. ppufile.putstring(hp.name^);
  451. ppufile.putlongint(hp.getfiletime);
  452. dec(j);
  453. end;
  454. ppufile.writeentry(ibsourcefiles);
  455. ppufile.do_crc:=true;
  456. end;
  457. procedure tppumodule.writeusedunit(intf:boolean);
  458. var
  459. hp : tused_unit;
  460. oldcrc : boolean;
  461. begin
  462. { write a reference for each used unit }
  463. hp:=tused_unit(used_units.first);
  464. while assigned(hp) do
  465. begin
  466. if hp.in_interface=intf then
  467. begin
  468. ppufile.putstring(hp.u.realmodulename^);
  469. { the checksum should not affect the crc of this unit ! (PFV) }
  470. oldcrc:=ppufile.do_crc;
  471. ppufile.do_crc:=false;
  472. ppufile.putlongint(longint(hp.checksum));
  473. ppufile.putlongint(longint(hp.interface_checksum));
  474. ppufile.putlongint(longint(hp.indirect_checksum));
  475. ppufile.do_crc:=oldcrc;
  476. { combine all indirect checksums from units used by this unit }
  477. if intf then
  478. ppufile.indirect_crc:=ppufile.indirect_crc xor hp.indirect_checksum;
  479. end;
  480. hp:=tused_unit(hp.next);
  481. end;
  482. ppufile.do_interface_crc:=true;
  483. ppufile.writeentry(ibloadunit);
  484. end;
  485. procedure tppumodule.writelinkcontainer(var p:tlinkcontainer;id:byte;strippath:boolean);
  486. var
  487. hcontainer : tlinkcontainer;
  488. s : string;
  489. mask : cardinal;
  490. begin
  491. hcontainer:=TLinkContainer.Create;
  492. while not p.empty do
  493. begin
  494. s:=p.get(mask);
  495. if strippath then
  496. ppufile.putstring(ExtractFileName(s))
  497. else
  498. ppufile.putstring(s);
  499. ppufile.putlongint(mask);
  500. hcontainer.add(s,mask);
  501. end;
  502. ppufile.writeentry(id);
  503. p.Free;
  504. p:=hcontainer;
  505. end;
  506. procedure tppumodule.writederefmap;
  507. var
  508. i : longint;
  509. oldcrc : boolean;
  510. begin
  511. { This does not influence crc }
  512. oldcrc:=ppufile.do_crc;
  513. ppufile.do_crc:=false;
  514. { The unit map used for resolving }
  515. ppufile.putlongint(derefmapcnt);
  516. for i:=0 to derefmapcnt-1 do
  517. begin
  518. if not assigned(derefmap[i].u) then
  519. internalerror(2005011512);
  520. ppufile.putstring(derefmap[i].u.modulename^)
  521. end;
  522. ppufile.writeentry(ibderefmap);
  523. ppufile.do_crc:=oldcrc;
  524. end;
  525. procedure tppumodule.writederefdata;
  526. var
  527. oldcrc : boolean;
  528. len,hlen : longint;
  529. buf : array[0..1023] of byte;
  530. begin
  531. if longword(derefdataintflen)>derefdata.size then
  532. internalerror(200310223);
  533. derefdata.seek(0);
  534. { Write interface data }
  535. len:=derefdataintflen;
  536. while (len>0) do
  537. begin
  538. if len>1024 then
  539. hlen:=1024
  540. else
  541. hlen:=len;
  542. derefdata.read(buf,hlen);
  543. ppufile.putdata(buf,hlen);
  544. dec(len,hlen);
  545. end;
  546. { Write implementation data, this does not influence crc }
  547. oldcrc:=ppufile.do_crc;
  548. ppufile.do_crc:=false;
  549. len:=derefdata.size-derefdataintflen;
  550. while (len>0) do
  551. begin
  552. if len>1024 then
  553. hlen:=1024
  554. else
  555. hlen:=len;
  556. derefdata.read(buf,hlen);
  557. ppufile.putdata(buf,hlen);
  558. dec(len,hlen);
  559. end;
  560. if derefdata.pos<>derefdata.size then
  561. internalerror(200310224);
  562. ppufile.do_crc:=oldcrc;
  563. ppufile.writeentry(ibderefdata);
  564. end;
  565. procedure tppumodule.writeImportSymbols;
  566. var
  567. i,j : longint;
  568. ImportLibrary : TImportLibrary;
  569. ImportSymbol : TImportSymbol;
  570. begin
  571. for i:=0 to ImportLibraryList.Count-1 do
  572. begin
  573. ImportLibrary:=TImportLibrary(ImportLibraryList[i]);
  574. ppufile.putstring(ImportLibrary.Name);
  575. ppufile.putlongint(ImportLibrary.ImportSymbolList.Count);
  576. for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  577. begin
  578. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
  579. ppufile.putstring(ImportSymbol.Name);
  580. ppufile.putlongint(ImportSymbol.OrdNr);
  581. ppufile.putbyte(byte(ImportSymbol.IsVar));
  582. end;
  583. end;
  584. ppufile.writeentry(ibImportSymbols);
  585. end;
  586. procedure tppumodule.writeResources;
  587. var
  588. res : TCmdStrListItem;
  589. begin
  590. res:=TCmdStrListItem(ResourceFiles.First);
  591. while res<>nil do
  592. begin
  593. ppufile.putstring(res.FPStr);
  594. res:=TCmdStrListItem(res.Next);
  595. end;
  596. ppufile.writeentry(ibresources);
  597. end;
  598. {$IFDEF MACRO_DIFF_HINT}
  599. {
  600. Define MACRO_DIFF_HINT for the whole compiler (and ppudump)
  601. to turn this facility on. Also the hint messages defined
  602. below must be commented in in the msg/errore.msg file.
  603. There is some problems with this, thats why it is shut off:
  604. At the first compilation, consider a macro which is not initially
  605. defined, but it is used (e g the check that it is undefined is true).
  606. Since it do not exist, there is no macro object where the is_used
  607. flag can be set. Later on when the macro is defined, and the ppu
  608. is opened, the check cannot detect this.
  609. Also, in which macro object should this flag be set ? It cant be set
  610. for macros in the initialmacrosymboltable since this table is shared
  611. between different files.
  612. }
  613. procedure tppumodule.readusedmacros;
  614. var
  615. hs : string;
  616. mac : tmacro;
  617. was_initial,
  618. was_used : boolean;
  619. {Reads macros which was defined or used when the module was compiled.
  620. This is done when a ppu file is open, before it possibly is parsed.}
  621. begin
  622. while not ppufile.endofentry do
  623. begin
  624. hs:=ppufile.getstring;
  625. was_initial:=boolean(ppufile.getbyte);
  626. was_used:=boolean(ppufile.getbyte);
  627. mac:=tmacro(initialmacrosymtable.Find(hs));
  628. if assigned(mac) then
  629. begin
  630. {$ifndef EXTDEBUG}
  631. { if we don't have the sources why tell }
  632. if sources_avail then
  633. {$endif ndef EXTDEBUG}
  634. if (not was_initial) and was_used then
  635. Message2(unit_h_cond_not_set_in_last_compile,hs,mainsource^);
  636. end
  637. else { not assigned }
  638. if was_initial and
  639. was_used then
  640. Message2(unit_h_cond_set_in_last_compile,hs,mainsource^);
  641. end;
  642. end;
  643. {$ENDIF}
  644. procedure tppumodule.readsourcefiles;
  645. var
  646. temp,hs : string;
  647. temp_dir : TCmdStr;
  648. main_dir : TCmdStr;
  649. found,
  650. is_main : boolean;
  651. orgfiletime,
  652. source_time : longint;
  653. hp : tinputfile;
  654. begin
  655. sources_avail:=(flags and uf_release) = 0;
  656. if not sources_avail then
  657. exit;
  658. is_main:=true;
  659. main_dir:='';
  660. while not ppufile.endofentry do
  661. begin
  662. hs:=ppufile.getstring;
  663. orgfiletime:=ppufile.getlongint;
  664. temp_dir:='';
  665. if (flags and uf_in_library)<>0 then
  666. begin
  667. sources_avail:=false;
  668. temp:=' library';
  669. end
  670. else if pos('Macro ',hs)=1 then
  671. begin
  672. { we don't want to find this file }
  673. { but there is a problem with file indexing !! }
  674. temp:='';
  675. end
  676. else
  677. begin
  678. { check the date of the source files:
  679. 1 path of ppu
  680. 2 path of main source
  681. 3 current dir
  682. 4 include/unit path }
  683. Source_Time:=GetNamedFileTime(path^+hs);
  684. found:=false;
  685. if Source_Time<>-1 then
  686. hs:=path^+hs
  687. else
  688. if not(is_main) then
  689. begin
  690. Source_Time:=GetNamedFileTime(main_dir+hs);
  691. if Source_Time<>-1 then
  692. hs:=main_dir+hs;
  693. end;
  694. if Source_Time=-1 then
  695. Source_Time:=GetNamedFileTime(hs);
  696. if (Source_Time=-1) then
  697. begin
  698. if is_main then
  699. found:=unitsearchpath.FindFile(hs,true,temp_dir)
  700. else
  701. found:=includesearchpath.FindFile(hs,true,temp_dir);
  702. if found then
  703. begin
  704. Source_Time:=GetNamedFileTime(temp_dir);
  705. if Source_Time<>-1 then
  706. hs:=temp_dir;
  707. end;
  708. end;
  709. if Source_Time<>-1 then
  710. begin
  711. if is_main then
  712. main_dir:=ExtractFilePath(hs);
  713. temp:=' time '+filetimestring(source_time);
  714. if (orgfiletime<>-1) and
  715. (source_time<>orgfiletime) then
  716. begin
  717. do_compile:=true;
  718. recompile_reason:=rr_sourcenewer;
  719. Message2(unit_u_source_modified,hs,ppufilename^,@queuecomment);
  720. temp:=temp+' *';
  721. end;
  722. end
  723. else
  724. begin
  725. sources_avail:=false;
  726. temp:=' not found';
  727. end;
  728. hp:=tdosinputfile.create(hs);
  729. { the indexing is wrong here PM }
  730. sourcefiles.register_file(hp);
  731. end;
  732. if is_main then
  733. begin
  734. stringdispose(mainsource);
  735. mainsource:=stringdup(hs);
  736. end;
  737. Message1(unit_u_ppu_source,hs+temp,@queuecomment);
  738. is_main:=false;
  739. end;
  740. { check if we want to rebuild every unit, only if the sources are
  741. available }
  742. if do_build and sources_avail then
  743. begin
  744. do_compile:=true;
  745. recompile_reason:=rr_build;
  746. end;
  747. end;
  748. procedure tppumodule.readloadunit;
  749. var
  750. hs : string;
  751. pu : tused_unit;
  752. hp : tppumodule;
  753. indchecksum,
  754. intfchecksum,
  755. checksum : cardinal;
  756. begin
  757. while not ppufile.endofentry do
  758. begin
  759. hs:=ppufile.getstring;
  760. checksum:=cardinal(ppufile.getlongint);
  761. intfchecksum:=cardinal(ppufile.getlongint);
  762. indchecksum:=cardinal(ppufile.getlongint);
  763. { set the state of this unit before registering, this is
  764. needed for a correct circular dependency check }
  765. hp:=registerunit(self,hs,'');
  766. pu:=addusedunit(hp,false,nil);
  767. pu.checksum:=checksum;
  768. pu.interface_checksum:=intfchecksum;
  769. pu.indirect_checksum:=indchecksum;
  770. end;
  771. in_interface:=false;
  772. end;
  773. procedure tppumodule.readlinkcontainer(var p:tlinkcontainer);
  774. var
  775. s : string;
  776. m : longint;
  777. begin
  778. while not ppufile.endofentry do
  779. begin
  780. s:=ppufile.getstring;
  781. m:=ppufile.getlongint;
  782. p.add(s,m);
  783. end;
  784. end;
  785. procedure tppumodule.readderefmap;
  786. var
  787. i : longint;
  788. begin
  789. { Load unit map used for resolving }
  790. derefmapsize:=ppufile.getlongint;
  791. derefmapcnt:=derefmapsize;
  792. getmem(derefmap,derefmapsize*sizeof(tderefmaprec));
  793. fillchar(derefmap^,derefmapsize*sizeof(tderefmaprec),0);
  794. for i:=0 to derefmapsize-1 do
  795. derefmap[i].modulename:=stringdup(ppufile.getstring);
  796. end;
  797. procedure tppumodule.readderefdata;
  798. var
  799. len,hlen : longint;
  800. buf : array[0..1023] of byte;
  801. begin
  802. len:=ppufile.entrysize;
  803. while (len>0) do
  804. begin
  805. if len>1024 then
  806. hlen:=1024
  807. else
  808. hlen:=len;
  809. ppufile.getdata(buf,hlen);
  810. derefdata.write(buf,hlen);
  811. dec(len,hlen);
  812. end;
  813. end;
  814. procedure tppumodule.readImportSymbols;
  815. var
  816. j,
  817. extsymcnt : longint;
  818. ImportLibrary : TImportLibrary;
  819. extsymname : string;
  820. extsymordnr : longint;
  821. extsymisvar : boolean;
  822. begin
  823. while not ppufile.endofentry do
  824. begin
  825. ImportLibrary:=TImportLibrary.Create(ImportLibraryList,ppufile.getstring);
  826. extsymcnt:=ppufile.getlongint;
  827. for j:=0 to extsymcnt-1 do
  828. begin
  829. extsymname:=ppufile.getstring;
  830. extsymordnr:=ppufile.getlongint;
  831. extsymisvar:=(ppufile.getbyte<>0);
  832. TImportSymbol.Create(ImportLibrary.ImportSymbolList,extsymname,extsymordnr,extsymisvar);
  833. end;
  834. end;
  835. end;
  836. procedure tppumodule.readResources;
  837. begin
  838. while not ppufile.endofentry do
  839. resourcefiles.Insert(ppufile.getstring);
  840. end;
  841. procedure tppumodule.readwpofile;
  842. var
  843. orgwpofilename: string;
  844. orgwpofiletime: longint;
  845. begin
  846. { check whether we are using the same wpo feedback input file as when
  847. this unit was compiled (same file name and file date)
  848. }
  849. orgwpofilename:=ppufile.getstring;
  850. orgwpofiletime:=ppufile.getlongint;
  851. if (extractfilename(orgwpofilename)<>extractfilename(wpofeedbackinput)) or
  852. (orgwpofiletime<>GetNamedFileTime(orgwpofilename)) then
  853. { make sure we don't throw away a precompiled unit if the user simply
  854. forgot to specify the right wpo feedback file
  855. }
  856. message3(unit_e_different_wpo_file,ppufilename^,orgwpofilename,filetimestring(orgwpofiletime));
  857. end;
  858. procedure tppumodule.load_interface;
  859. var
  860. b : byte;
  861. newmodulename : string;
  862. begin
  863. { read interface part }
  864. repeat
  865. b:=ppufile.readentry;
  866. case b of
  867. ibmodulename :
  868. begin
  869. newmodulename:=ppufile.getstring;
  870. if (cs_check_unit_name in current_settings.globalswitches) and
  871. (upper(newmodulename)<>modulename^) then
  872. Message2(unit_f_unit_name_error,realmodulename^,newmodulename);
  873. stringdispose(modulename);
  874. stringdispose(realmodulename);
  875. modulename:=stringdup(upper(newmodulename));
  876. realmodulename:=stringdup(newmodulename);
  877. end;
  878. ibsourcefiles :
  879. readsourcefiles;
  880. {$IFDEF MACRO_DIFF_HINT}
  881. ibusedmacros :
  882. readusedmacros;
  883. {$ENDIF}
  884. ibloadunit :
  885. readloadunit;
  886. iblinkunitofiles :
  887. readlinkcontainer(LinkUnitOFiles);
  888. iblinkunitstaticlibs :
  889. readlinkcontainer(LinkUnitStaticLibs);
  890. iblinkunitsharedlibs :
  891. readlinkcontainer(LinkUnitSharedLibs);
  892. iblinkotherofiles :
  893. readlinkcontainer(LinkotherOFiles);
  894. iblinkotherstaticlibs :
  895. readlinkcontainer(LinkotherStaticLibs);
  896. iblinkothersharedlibs :
  897. readlinkcontainer(LinkotherSharedLibs);
  898. iblinkotherframeworks :
  899. readlinkcontainer(LinkOtherFrameworks);
  900. ibmainname:
  901. begin
  902. mainname:=stringdup(ppufile.getstring);
  903. if (mainaliasname<>defaultmainaliasname) then
  904. Message1(scan_w_multiple_main_name_overrides,mainaliasname);
  905. mainaliasname:=mainname^;
  906. end;
  907. ibImportSymbols :
  908. readImportSymbols;
  909. ibderefmap :
  910. readderefmap;
  911. ibderefdata :
  912. readderefdata;
  913. ibresources:
  914. readResources;
  915. ibwpofile:
  916. readwpofile;
  917. ibendinterface :
  918. break;
  919. else
  920. Message1(unit_f_ppu_invalid_entry,tostr(b));
  921. end;
  922. { we can already stop when we know that we must recompile }
  923. if do_compile then
  924. exit;
  925. until false;
  926. end;
  927. procedure tppumodule.load_implementation;
  928. var
  929. b : byte;
  930. begin
  931. { read implementation part }
  932. repeat
  933. b:=ppufile.readentry;
  934. case b of
  935. ibloadunit :
  936. readloadunit;
  937. ibasmsymbols :
  938. { TODO: Remove ibasmsymbols}
  939. ;
  940. ibendimplementation :
  941. break;
  942. else
  943. Message1(unit_f_ppu_invalid_entry,tostr(b));
  944. end;
  945. until false;
  946. end;
  947. procedure tppumodule.writeppu;
  948. begin
  949. Message1(unit_u_ppu_write,realmodulename^);
  950. { create unit flags }
  951. if do_release then
  952. flags:=flags or uf_release;
  953. if assigned(localsymtable) then
  954. flags:=flags or uf_local_symtable;
  955. {$ifdef cpufpemu}
  956. if (cs_fp_emulation in current_settings.moduleswitches) then
  957. flags:=flags or uf_fpu_emulation;
  958. {$endif cpufpemu}
  959. {$ifdef Test_Double_checksum_write}
  960. Assign(CRCFile,s+'.IMP');
  961. Rewrite(CRCFile);
  962. {$endif def Test_Double_checksum_write}
  963. { create new ppufile }
  964. ppufile:=tcompilerppufile.create(ppufilename^);
  965. if not ppufile.createfile then
  966. Message(unit_f_ppu_cannot_write);
  967. { first the unitname }
  968. ppufile.putstring(realmodulename^);
  969. ppufile.writeentry(ibmodulename);
  970. { write the alternate main procedure name if any }
  971. if assigned(mainname) then
  972. begin
  973. ppufile.putstring(mainname^);
  974. ppufile.writeentry(ibmainname);
  975. end;
  976. writesourcefiles;
  977. {$IFDEF MACRO_DIFF_HINT}
  978. writeusedmacros;
  979. {$ENDIF}
  980. { write interface uses }
  981. writeusedunit(true);
  982. { write the objectfiles and libraries that come for this unit,
  983. preserve the containers becuase they are still needed to load
  984. the link.res.
  985. All doesn't depend on the crc! It doesn't matter
  986. if a unit is in a .o or .a file }
  987. ppufile.do_crc:=false;
  988. { write after source files, so that we know whether or not the compiler
  989. will recompile the unit when checking whether the correct wpo file is
  990. used (if it will recompile the unit anyway, it doesn't matter)
  991. }
  992. if (wpofeedbackinput<>'') then
  993. begin
  994. ppufile.putstring(wpofeedbackinput);
  995. ppufile.putlongint(getnamedfiletime(wpofeedbackinput));
  996. ppufile.writeentry(ibwpofile);
  997. end;
  998. writelinkcontainer(linkunitofiles,iblinkunitofiles,true);
  999. writelinkcontainer(linkunitstaticlibs,iblinkunitstaticlibs,true);
  1000. writelinkcontainer(linkunitsharedlibs,iblinkunitsharedlibs,true);
  1001. writelinkcontainer(linkotherofiles,iblinkotherofiles,false);
  1002. writelinkcontainer(linkotherstaticlibs,iblinkotherstaticlibs,true);
  1003. writelinkcontainer(linkothersharedlibs,iblinkothersharedlibs,true);
  1004. writelinkcontainer(linkotherframeworks,iblinkotherframeworks,true);
  1005. writeImportSymbols;
  1006. writeResources;
  1007. ppufile.do_crc:=true;
  1008. { generate implementation deref data, the interface deref data is
  1009. already generated when calculating the interface crc }
  1010. if (cs_compilesystem in current_settings.moduleswitches) then
  1011. begin
  1012. tstoredsymtable(globalsymtable).buildderef;
  1013. derefdataintflen:=derefdata.size;
  1014. end
  1015. else
  1016. { the unit may have been re-resolved, in which case the current
  1017. position in derefdata is not necessarily at the end }
  1018. derefdata.seek(derefdata.size);
  1019. tstoredsymtable(globalsymtable).buildderefimpl;
  1020. if (flags and uf_local_symtable)<>0 then
  1021. begin
  1022. tstoredsymtable(localsymtable).buildderef;
  1023. tstoredsymtable(localsymtable).buildderefimpl;
  1024. end;
  1025. tunitwpoinfo(wpoinfo).buildderef;
  1026. tunitwpoinfo(wpoinfo).buildderefimpl;
  1027. writederefmap;
  1028. writederefdata;
  1029. ppufile.writeentry(ibendinterface);
  1030. { write the symtable entries }
  1031. tstoredsymtable(globalsymtable).ppuwrite(ppufile);
  1032. if assigned(globalmacrosymtable) and (globalmacrosymtable.SymList.count > 0) then
  1033. begin
  1034. ppufile.putbyte(byte(true));
  1035. ppufile.writeentry(ibexportedmacros);
  1036. tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);
  1037. end
  1038. else
  1039. begin
  1040. ppufile.putbyte(byte(false));
  1041. ppufile.writeentry(ibexportedmacros);
  1042. end;
  1043. { everything after this doesn't affect the crc }
  1044. ppufile.do_crc:=false;
  1045. { write implementation uses }
  1046. writeusedunit(false);
  1047. { end of implementation }
  1048. ppufile.writeentry(ibendimplementation);
  1049. { write static symtable
  1050. needed for local debugging of unit functions }
  1051. if (flags and uf_local_symtable)<>0 then
  1052. tstoredsymtable(localsymtable).ppuwrite(ppufile);
  1053. { write whole program optimisation-related information }
  1054. tunitwpoinfo(wpoinfo).ppuwrite(ppufile);
  1055. { the last entry ibend is written automaticly }
  1056. { flush to be sure }
  1057. ppufile.flush;
  1058. { create and write header }
  1059. ppufile.header.size:=ppufile.size;
  1060. ppufile.header.checksum:=ppufile.crc;
  1061. ppufile.header.interface_checksum:=ppufile.interface_crc;
  1062. ppufile.header.indirect_checksum:=ppufile.indirect_crc;
  1063. ppufile.header.compiler:=wordversion;
  1064. ppufile.header.cpu:=word(target_cpu);
  1065. ppufile.header.target:=word(target_info.system);
  1066. ppufile.header.flags:=flags;
  1067. ppufile.header.deflistsize:=current_module.deflist.count;
  1068. ppufile.header.symlistsize:=current_module.symlist.count;
  1069. ppufile.writeheader;
  1070. { save crc in current module also }
  1071. crc:=ppufile.crc;
  1072. interface_crc:=ppufile.interface_crc;
  1073. indirect_crc:=ppufile.indirect_crc;
  1074. {$ifdef Test_Double_checksum_write}
  1075. close(CRCFile);
  1076. {$endif Test_Double_checksum_write}
  1077. ppufile.closefile;
  1078. ppufile.free;
  1079. ppufile:=nil;
  1080. end;
  1081. procedure tppumodule.getppucrc;
  1082. begin
  1083. {$ifdef Test_Double_checksum_write}
  1084. Assign(CRCFile,s+'.INT')
  1085. Rewrite(CRCFile);
  1086. {$endif def Test_Double_checksum_write}
  1087. { create new ppufile }
  1088. ppufile:=tcompilerppufile.create(ppufilename^);
  1089. ppufile.crc_only:=true;
  1090. if not ppufile.createfile then
  1091. Message(unit_f_ppu_cannot_write);
  1092. { first the unitname }
  1093. ppufile.putstring(realmodulename^);
  1094. ppufile.writeentry(ibmodulename);
  1095. { the interface units affect the crc }
  1096. writeusedunit(true);
  1097. { deref data of interface that affect the crc }
  1098. derefdata.reset;
  1099. tstoredsymtable(globalsymtable).buildderef;
  1100. derefdataintflen:=derefdata.size;
  1101. writederefmap;
  1102. writederefdata;
  1103. ppufile.writeentry(ibendinterface);
  1104. { write the symtable entries }
  1105. tstoredsymtable(globalsymtable).ppuwrite(ppufile);
  1106. if assigned(globalmacrosymtable) and (globalmacrosymtable.SymList.count > 0) then
  1107. begin
  1108. ppufile.putbyte(byte(true));
  1109. ppufile.writeentry(ibexportedmacros);
  1110. tstoredsymtable(globalmacrosymtable).ppuwrite(ppufile);
  1111. end
  1112. else
  1113. begin
  1114. ppufile.putbyte(byte(false));
  1115. ppufile.writeentry(ibexportedmacros);
  1116. end;
  1117. { save crc }
  1118. crc:=ppufile.crc;
  1119. interface_crc:=ppufile.interface_crc;
  1120. indirect_crc:=ppufile.indirect_crc;
  1121. { end of implementation, to generate a correct ppufile
  1122. for ppudump when using INTFPPU define }
  1123. ppufile.writeentry(ibendimplementation);
  1124. {$ifdef Test_Double_checksum}
  1125. crc_array:=ppufile.crc_test;
  1126. ppufile.crc_test:=nil;
  1127. crc_size:=ppufile.crc_index2;
  1128. crc_array2:=ppufile.crc_test2;
  1129. ppufile.crc_test2:=nil;
  1130. crc_size2:=ppufile.crc_index2;
  1131. {$endif Test_Double_checksum}
  1132. {$ifdef Test_Double_checksum_write}
  1133. close(CRCFile);
  1134. {$endif Test_Double_checksum_write}
  1135. { create and write header, this will only be used
  1136. for debugging purposes }
  1137. ppufile.header.size:=ppufile.size;
  1138. ppufile.header.checksum:=ppufile.crc;
  1139. ppufile.header.interface_checksum:=ppufile.interface_crc;
  1140. ppufile.header.indirect_checksum:=ppufile.indirect_crc;
  1141. ppufile.header.compiler:=wordversion;
  1142. ppufile.header.cpu:=word(target_cpu);
  1143. ppufile.header.target:=word(target_info.system);
  1144. ppufile.header.flags:=flags;
  1145. ppufile.writeheader;
  1146. ppufile.closefile;
  1147. ppufile.free;
  1148. ppufile:=nil;
  1149. end;
  1150. procedure tppumodule.load_usedunits;
  1151. var
  1152. pu : tused_unit;
  1153. begin
  1154. if current_module<>self then
  1155. internalerror(200212284);
  1156. { load the used units from interface }
  1157. in_interface:=true;
  1158. pu:=tused_unit(used_units.first);
  1159. while assigned(pu) do
  1160. begin
  1161. if pu.in_interface then
  1162. begin
  1163. tppumodule(pu.u).loadppu;
  1164. { if this unit is compiled we can stop }
  1165. if state=ms_compiled then
  1166. exit;
  1167. { add this unit to the dependencies }
  1168. pu.u.adddependency(self);
  1169. { need to recompile the current unit, check the interface
  1170. crc. And when not compiled with -Ur then check the complete
  1171. crc }
  1172. if (pu.u.interface_crc<>pu.interface_checksum) or
  1173. (pu.u.indirect_crc<>pu.indirect_checksum) or
  1174. (
  1175. ((ppufile.header.flags and uf_release)=0) and
  1176. (pu.u.crc<>pu.checksum)
  1177. ) then
  1178. begin
  1179. Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^,@queuecomment);
  1180. {$ifdef DEBUG_UNIT_CRC_CHANGES}
  1181. if (pu.u.interface_crc<>pu.interface_checksum) then
  1182. writeln(' intfcrc change: ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8))
  1183. else if (pu.u.indirect_crc<>pu.indirect_checksum) then
  1184. writeln(' indcrc change: ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8))
  1185. else
  1186. writeln(' implcrc change: ',hexstr(pu.u.crc,8),' <> ',hexstr(pu.checksum,8));
  1187. {$endif DEBUG_UNIT_CRC_CHANGES}
  1188. recompile_reason:=rr_crcchanged;
  1189. do_compile:=true;
  1190. exit;
  1191. end;
  1192. end;
  1193. pu:=tused_unit(pu.next);
  1194. end;
  1195. { ok, now load the interface of this unit }
  1196. if current_module<>self then
  1197. internalerror(200208187);
  1198. deflist.count:=ppufile.header.deflistsize;
  1199. symlist.count:=ppufile.header.symlistsize;
  1200. globalsymtable:=tglobalsymtable.create(modulename^,moduleid);
  1201. tstoredsymtable(globalsymtable).ppuload(ppufile);
  1202. if ppufile.readentry<>ibexportedmacros then
  1203. Message(unit_f_ppu_read_error);
  1204. if boolean(ppufile.getbyte) then
  1205. begin
  1206. globalmacrosymtable:=tmacrosymtable.Create(true);
  1207. tstoredsymtable(globalmacrosymtable).ppuload(ppufile)
  1208. end;
  1209. interface_compiled:=true;
  1210. { read the implementation part, containing
  1211. the implementation uses and ObjData }
  1212. in_interface:=false;
  1213. load_implementation;
  1214. { now only read the implementation uses }
  1215. pu:=tused_unit(used_units.first);
  1216. while assigned(pu) do
  1217. begin
  1218. if (not pu.in_interface) then
  1219. begin
  1220. tppumodule(pu.u).loadppu;
  1221. { if this unit is compiled we can stop }
  1222. if state=ms_compiled then
  1223. exit;
  1224. { add this unit to the dependencies }
  1225. pu.u.adddependency(self);
  1226. { need to recompile the current unit ? }
  1227. if (pu.u.interface_crc<>pu.interface_checksum) or
  1228. (pu.u.indirect_crc<>pu.indirect_checksum) then
  1229. begin
  1230. Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^+' {impl}',@queuecomment);
  1231. {$ifdef DEBUG_UNIT_CRC_CHANGES}
  1232. if (pu.u.interface_crc<>pu.interface_checksum) then
  1233. writeln(' intfcrc change (2): ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8))
  1234. else if (pu.u.indirect_crc<>pu.indirect_checksum) then
  1235. writeln(' indcrc change (2): ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8));
  1236. {$endif DEBUG_UNIT_CRC_CHANGES}
  1237. recompile_reason:=rr_crcchanged;
  1238. do_compile:=true;
  1239. exit;
  1240. end;
  1241. end;
  1242. pu:=tused_unit(pu.next);
  1243. end;
  1244. { load implementation symtable }
  1245. if (flags and uf_local_symtable)<>0 then
  1246. begin
  1247. localsymtable:=tstaticsymtable.create(modulename^,moduleid);
  1248. tstaticsymtable(localsymtable).ppuload(ppufile);
  1249. end;
  1250. { we can now derefence all pointers to the implementation parts }
  1251. tstoredsymtable(globalsymtable).derefimpl;
  1252. if assigned(localsymtable) then
  1253. tstoredsymtable(localsymtable).derefimpl;
  1254. { read whole program optimisation-related information }
  1255. wpoinfo:=tunitwpoinfo.ppuload(ppufile);
  1256. tunitwpoinfo(wpoinfo).deref;
  1257. tunitwpoinfo(wpoinfo).derefimpl;
  1258. end;
  1259. function tppumodule.needrecompile:boolean;
  1260. var
  1261. pu : tused_unit;
  1262. begin
  1263. result:=false;
  1264. pu:=tused_unit(used_units.first);
  1265. while assigned(pu) do
  1266. begin
  1267. { need to recompile the current unit, check the interface
  1268. crc. And when not compiled with -Ur then check the complete
  1269. crc }
  1270. if (pu.u.interface_crc<>pu.interface_checksum) or
  1271. (pu.u.indirect_crc<>pu.indirect_checksum) or
  1272. (
  1273. (pu.in_interface) and
  1274. (pu.u.crc<>pu.checksum)
  1275. ) then
  1276. begin
  1277. {$ifdef DEBUG_UNIT_CRC_CHANGES}
  1278. if (pu.u.interface_crc<>pu.interface_checksum) then
  1279. writeln(' intfcrc change (3): ',hexstr(pu.u.interface_crc,8),' <> ',hexstr(pu.interface_checksum,8))
  1280. else if (pu.u.indirect_crc<>pu.indirect_checksum) then
  1281. writeln(' indcrc change (3): ',hexstr(pu.u.indirect_crc,8),' <> ',hexstr(pu.indirect_checksum,8))
  1282. else
  1283. writeln(' implcrc change (3): ',hexstr(pu.u.crc,8),' <> ',hexstr(pu.checksum,8));
  1284. {$endif DEBUG_UNIT_CRC_CHANGES}
  1285. result:=true;
  1286. exit;
  1287. end;
  1288. pu:=tused_unit(pu.next);
  1289. end;
  1290. end;
  1291. procedure tppumodule.loadppu;
  1292. const
  1293. ImplIntf : array[boolean] of string[15]=('implementation','interface');
  1294. var
  1295. do_load,
  1296. second_time,
  1297. reresolvedependent: boolean;
  1298. old_current_module : tmodule;
  1299. begin
  1300. old_current_module:=current_module;
  1301. Message3(unit_u_load_unit,old_current_module.modulename^,
  1302. ImplIntf[old_current_module.in_interface],
  1303. modulename^);
  1304. { Update loaded_from to detect cycles }
  1305. loaded_from:=old_current_module;
  1306. { check if the globalsymtable is already available, but
  1307. we must reload when the do_reload flag is set }
  1308. if (not do_reload) and
  1309. assigned(globalsymtable) then
  1310. exit;
  1311. { reset }
  1312. do_load:=true;
  1313. second_time:=false;
  1314. reresolvedependent:=false;
  1315. set_current_module(self);
  1316. { A force reload }
  1317. if do_reload then
  1318. begin
  1319. Message(unit_u_forced_reload);
  1320. do_reload:=false;
  1321. { When the unit is already loaded or being loaded
  1322. we can maybe skip a complete reload/recompile }
  1323. if assigned(globalsymtable) and
  1324. (not needrecompile) then
  1325. begin
  1326. { When we don't have any data stored yet there
  1327. is nothing to resolve }
  1328. if interface_compiled then
  1329. begin
  1330. Message1(unit_u_reresolving_unit,modulename^);
  1331. tstoredsymtable(globalsymtable).deref;
  1332. tstoredsymtable(globalsymtable).derefimpl;
  1333. if assigned(localsymtable) then
  1334. begin
  1335. tstoredsymtable(localsymtable).deref;
  1336. tstoredsymtable(localsymtable).derefimpl;
  1337. end;
  1338. reresolvedependent:=true;
  1339. end
  1340. else
  1341. Message1(unit_u_skipping_reresolving_unit,modulename^);
  1342. do_load:=false;
  1343. end;
  1344. end;
  1345. if do_load then
  1346. begin
  1347. { loading the unit for a second time? }
  1348. if state=ms_registered then
  1349. state:=ms_load
  1350. else
  1351. begin
  1352. { try to load the unit a second time first }
  1353. Message1(unit_u_second_load_unit,modulename^);
  1354. Message2(unit_u_previous_state,modulename^,ModuleStateStr[state]);
  1355. { Flag modules to reload }
  1356. flagdependent(old_current_module);
  1357. { Reset the module }
  1358. reset;
  1359. if state in [ms_compile,ms_second_compile] then
  1360. begin
  1361. Message1(unit_u_second_compile_unit,modulename^);
  1362. state:=ms_second_compile;
  1363. do_compile:=true;
  1364. end
  1365. else
  1366. state:=ms_second_load;
  1367. second_time:=true;
  1368. end;
  1369. { close old_current_ppu on system that are
  1370. short on file handles like DOS PM }
  1371. {$ifdef SHORT_ON_FILE_HANDLES}
  1372. if old_current_module.is_unit and
  1373. assigned(tppumodule(old_current_module).ppufile) then
  1374. tppumodule(old_current_module).ppufile.tempclose;
  1375. {$endif SHORT_ON_FILE_HANDLES}
  1376. { try to opening ppu, skip this when we already
  1377. know that we need to compile the unit }
  1378. if not do_compile then
  1379. begin
  1380. Message1(unit_u_loading_unit,modulename^);
  1381. search_unit(false,false);
  1382. if not do_compile then
  1383. begin
  1384. load_interface;
  1385. if not do_compile then
  1386. begin
  1387. load_usedunits;
  1388. if not do_compile then
  1389. Message1(unit_u_finished_loading_unit,modulename^);
  1390. end;
  1391. end;
  1392. { PPU is not needed anymore }
  1393. if assigned(ppufile) then
  1394. begin
  1395. ppufile.closefile;
  1396. ppufile.free;
  1397. ppufile:=nil;
  1398. end;
  1399. end;
  1400. { Do we need to recompile the unit }
  1401. if do_compile then
  1402. begin
  1403. { recompile the unit or give a fatal error if sources not available }
  1404. if not(sources_avail) then
  1405. begin
  1406. if (not search_unit(true,false)) and
  1407. (length(modulename^)>8) then
  1408. search_unit(true,true);
  1409. if not(sources_avail) then
  1410. begin
  1411. printcomments;
  1412. if recompile_reason=rr_noppu then
  1413. Message2(unit_f_cant_find_ppu,realmodulename^,loaded_from.realmodulename^)
  1414. else
  1415. Message1(unit_f_cant_compile_unit,realmodulename^);
  1416. end;
  1417. end;
  1418. { we found the sources, we do not need the verbose messages anymore }
  1419. if comments <> nil then
  1420. begin
  1421. comments.free;
  1422. comments:=nil;
  1423. end;
  1424. { Flag modules to reload }
  1425. flagdependent(old_current_module);
  1426. { Reset the module }
  1427. reset;
  1428. { compile this module }
  1429. if not(state in [ms_compile,ms_second_compile]) then
  1430. state:=ms_compile;
  1431. compile(mainsource^);
  1432. end
  1433. else
  1434. state:=ms_compiled;
  1435. if current_module<>self then
  1436. internalerror(200212282);
  1437. if in_interface then
  1438. internalerror(200212283);
  1439. { for a second_time recompile reload all dependent units,
  1440. for a first time compile register the unit _once_ }
  1441. if second_time then
  1442. reload_flagged_units
  1443. else
  1444. usedunits.concat(tused_unit.create(self,true,false,nil));
  1445. { reopen the old module }
  1446. {$ifdef SHORT_ON_FILE_HANDLES}
  1447. if old_current_module.is_unit and
  1448. assigned(tppumodule(old_current_module).ppufile) then
  1449. tppumodule(old_current_module).ppufile.tempopen;
  1450. {$endif SHORT_ON_FILE_HANDLES}
  1451. end
  1452. else if reresolvedependent then
  1453. begin
  1454. { only reresolve the wpoinfo now that this unit (and hence all of
  1455. its dependent units) have been reloaded/recompiled, because the
  1456. wpo info can depend those units' interface defs. }
  1457. if assigned(wpoinfo) then
  1458. begin
  1459. tunitwpoinfo(wpoinfo).deref;
  1460. tunitwpoinfo(wpoinfo).derefimpl;
  1461. end;
  1462. { We have to flag the units that depend on this unit even
  1463. though it didn't change, because they might also
  1464. indirectly depend on the unit that did change (e.g.,
  1465. in case rgobj, rgx86 and rgcpu have been compiled
  1466. already, and then rgobj is recompiled for some reason
  1467. -> rgx86 is re-reresolved, but the vmtentries of trgcpu
  1468. must also be re-resolved, because they will also contain
  1469. pointers to procdefs in the old trgobj (in case of a
  1470. recompile, all old defs are freed) }
  1471. flagdependent(old_current_module);
  1472. reload_flagged_units;
  1473. end;
  1474. { we are back, restore current_module }
  1475. set_current_module(old_current_module);
  1476. end;
  1477. {*****************************************************************************
  1478. RegisterUnit
  1479. *****************************************************************************}
  1480. function registerunit(callermodule:tmodule;const s : TIDString;const fn:string) : tppumodule;
  1481. var
  1482. ups : TIDString;
  1483. hp : tppumodule;
  1484. hp2 : tmodule;
  1485. begin
  1486. { Info }
  1487. ups:=upper(s);
  1488. { search all loaded units }
  1489. hp:=tppumodule(loaded_units.first);
  1490. while assigned(hp) do
  1491. begin
  1492. if hp.modulename^=ups then
  1493. begin
  1494. { only check for units. The main program is also
  1495. as a unit in the loaded_units list. We simply need
  1496. to ignore this entry (PFV) }
  1497. if hp.is_unit then
  1498. begin
  1499. { both units in interface ? }
  1500. if callermodule.in_interface and
  1501. hp.in_interface then
  1502. begin
  1503. { check for a cycle }
  1504. hp2:=callermodule.loaded_from;
  1505. while assigned(hp2) and (hp2<>hp) do
  1506. begin
  1507. if hp2.in_interface then
  1508. hp2:=hp2.loaded_from
  1509. else
  1510. hp2:=nil;
  1511. end;
  1512. if assigned(hp2) then
  1513. Message2(unit_f_circular_unit_reference,callermodule.realmodulename^,hp.realmodulename^);
  1514. end;
  1515. break;
  1516. end;
  1517. end;
  1518. { the next unit }
  1519. hp:=tppumodule(hp.next);
  1520. end;
  1521. { the unit is not in the loaded units,
  1522. we create an entry and register the unit }
  1523. if not assigned(hp) then
  1524. begin
  1525. Message1(unit_u_registering_new_unit,Upper(s));
  1526. hp:=tppumodule.create(callermodule,s,fn,true);
  1527. hp.loaded_from:=callermodule;
  1528. addloadedunit(hp);
  1529. end;
  1530. { return }
  1531. registerunit:=hp;
  1532. end;
  1533. end.