fppu.pas 55 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680
  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. incfile_found,
  560. main_found,
  561. is_main : boolean;
  562. orgfiletime,
  563. source_time : longint;
  564. hp : tinputfile;
  565. begin
  566. sources_avail:=true;
  567. is_main:=true;
  568. main_dir:='';
  569. while not ppufile.endofentry do
  570. begin
  571. hs:=ppufile.getstring;
  572. orgfiletime:=ppufile.getlongint;
  573. temp_dir:='';
  574. if (flags and uf_in_library)<>0 then
  575. begin
  576. sources_avail:=false;
  577. temp:=' library';
  578. end
  579. else if pos('Macro ',hs)=1 then
  580. begin
  581. { we don't want to find this file }
  582. { but there is a problem with file indexing !! }
  583. temp:='';
  584. end
  585. else
  586. begin
  587. { check the date of the source files }
  588. Source_Time:=GetNamedFileTime(path^+hs);
  589. incfile_found:=false;
  590. main_found:=false;
  591. if Source_Time<>-1 then
  592. hs:=path^+hs
  593. else
  594. if not(is_main) then
  595. begin
  596. Source_Time:=GetNamedFileTime(main_dir+hs);
  597. if Source_Time<>-1 then
  598. hs:=main_dir+hs;
  599. end;
  600. if (Source_Time=-1) then
  601. begin
  602. if is_main then
  603. main_found:=unitsearchpath.FindFile(hs,temp_dir)
  604. else
  605. incfile_found:=includesearchpath.FindFile(hs,temp_dir);
  606. if incfile_found or main_found then
  607. begin
  608. Source_Time:=GetNamedFileTime(temp_dir);
  609. if Source_Time<>-1 then
  610. hs:=temp_dir;
  611. end;
  612. end;
  613. if Source_Time=-1 then
  614. begin
  615. sources_avail:=false;
  616. temp:=' not found';
  617. end
  618. else
  619. begin
  620. if main_found then
  621. main_dir:=temp_dir;
  622. { time newer? But only allow if the file is not searched
  623. in the include path (PFV), else you've problems with
  624. units which use the same includefile names }
  625. if incfile_found then
  626. temp:=' found'
  627. else
  628. begin
  629. temp:=' time '+filetimestring(source_time);
  630. if (orgfiletime<>-1) and
  631. (source_time<>orgfiletime) then
  632. begin
  633. if ((flags and uf_release)=0) then
  634. begin
  635. do_compile:=true;
  636. recompile_reason:=rr_sourcenewer;
  637. end
  638. else
  639. Message2(unit_h_source_modified,hs,ppufilename^);
  640. temp:=temp+' *';
  641. end;
  642. end;
  643. end;
  644. hp:=tinputfile.create(hs);
  645. { the indexing is wrong here PM }
  646. sourcefiles.register_file(hp);
  647. end;
  648. if is_main then
  649. begin
  650. stringdispose(mainsource);
  651. mainsource:=stringdup(hs);
  652. end;
  653. Message1(unit_u_ppu_source,hs+temp);
  654. is_main:=false;
  655. end;
  656. { check if we want to rebuild every unit, only if the sources are
  657. available }
  658. if do_build and sources_avail and
  659. ((flags and uf_release)=0) then
  660. begin
  661. do_compile:=true;
  662. recompile_reason:=rr_build;
  663. end;
  664. end;
  665. procedure tppumodule.readloadunit;
  666. var
  667. hs : string;
  668. pu : tused_unit;
  669. hp : tppumodule;
  670. intfchecksum,
  671. checksum : cardinal;
  672. begin
  673. while not ppufile.endofentry do
  674. begin
  675. hs:=ppufile.getstring;
  676. checksum:=cardinal(ppufile.getlongint);
  677. intfchecksum:=cardinal(ppufile.getlongint);
  678. { set the state of this unit before registering, this is
  679. needed for a correct circular dependency check }
  680. hp:=registerunit(self,hs,'');
  681. pu:=addusedunit(hp,false,nil);
  682. pu.checksum:=checksum;
  683. pu.interface_checksum:=intfchecksum;
  684. end;
  685. in_interface:=false;
  686. end;
  687. procedure tppumodule.readlinkcontainer(var p:tlinkcontainer);
  688. var
  689. s : string;
  690. m : longint;
  691. begin
  692. while not ppufile.endofentry do
  693. begin
  694. s:=ppufile.getstring;
  695. m:=ppufile.getlongint;
  696. p.add(s,m);
  697. end;
  698. end;
  699. procedure tppumodule.readderefdata;
  700. var
  701. len,hlen : longint;
  702. buf : array[0..1023] of byte;
  703. begin
  704. len:=ppufile.entrysize;
  705. while (len>0) do
  706. begin
  707. if len>1024 then
  708. hlen:=1024
  709. else
  710. hlen:=len;
  711. ppufile.getdata(buf,hlen);
  712. derefdata.write(buf,hlen);
  713. dec(len,hlen);
  714. end;
  715. end;
  716. procedure tppumodule.readasmsymbols;
  717. var
  718. labelnr,
  719. i : longint;
  720. name : string;
  721. bind : TAsmSymBind;
  722. typ : TAsmSymType;
  723. asmsymtype : byte;
  724. begin
  725. librarydata.asmsymbolppuidx:=ppufile.getlongint;
  726. if librarydata.asmsymbolppuidx>0 then
  727. begin
  728. getmem(librarydata.asmsymbolidx,librarydata.asmsymbolppuidx*sizeof(pointer));
  729. fillchar(librarydata.asmsymbolidx^,librarydata.asmsymbolppuidx*sizeof(pointer),0);
  730. for i:=1 to librarydata.asmsymbolppuidx do
  731. begin
  732. asmsymtype:=ppufile.getbyte;
  733. case asmsymtype of
  734. 1 :
  735. name:=ppufile.getstring;
  736. 2..4 :
  737. labelnr:=ppufile.getlongint;
  738. else
  739. internalerror(200208192);
  740. end;
  741. bind:=tasmsymbind(ppufile.getbyte);
  742. typ:=tasmsymtype(ppufile.getbyte);
  743. case asmsymtype of
  744. 1 :
  745. librarydata.asmsymbolidx^[i-1]:=librarydata.newasmsymboltype(name,bind,typ);
  746. 2 :
  747. librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,false,false);
  748. 3 :
  749. librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,true,false);
  750. 4 :
  751. librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,false,true);
  752. end;
  753. end;
  754. end;
  755. end;
  756. procedure tppumodule.load_interface;
  757. var
  758. b : byte;
  759. newmodulename : string;
  760. begin
  761. { read interface part }
  762. repeat
  763. b:=ppufile.readentry;
  764. case b of
  765. ibmodulename :
  766. begin
  767. newmodulename:=ppufile.getstring;
  768. if (cs_check_unit_name in aktglobalswitches) and
  769. (upper(newmodulename)<>modulename^) then
  770. Message2(unit_f_unit_name_error,realmodulename^,newmodulename);
  771. stringdispose(modulename);
  772. stringdispose(realmodulename);
  773. modulename:=stringdup(upper(newmodulename));
  774. realmodulename:=stringdup(newmodulename);
  775. end;
  776. ibsourcefiles :
  777. readsourcefiles;
  778. ibusedmacros :
  779. readusedmacros;
  780. ibloadunit :
  781. readloadunit;
  782. iblinkunitofiles :
  783. readlinkcontainer(LinkUnitOFiles);
  784. iblinkunitstaticlibs :
  785. readlinkcontainer(LinkUnitStaticLibs);
  786. iblinkunitsharedlibs :
  787. readlinkcontainer(LinkUnitSharedLibs);
  788. iblinkotherofiles :
  789. readlinkcontainer(LinkotherOFiles);
  790. iblinkotherstaticlibs :
  791. readlinkcontainer(LinkotherStaticLibs);
  792. iblinkothersharedlibs :
  793. readlinkcontainer(LinkotherSharedLibs);
  794. ibderefdata :
  795. readderefdata;
  796. ibendinterface :
  797. break;
  798. else
  799. Message1(unit_f_ppu_invalid_entry,tostr(b));
  800. end;
  801. until false;
  802. end;
  803. procedure tppumodule.load_implementation;
  804. var
  805. b : byte;
  806. oldobjectlibrary : tasmlibrarydata;
  807. begin
  808. { read implementation part }
  809. repeat
  810. b:=ppufile.readentry;
  811. case b of
  812. ibloadunit :
  813. readloadunit;
  814. ibasmsymbols :
  815. readasmsymbols;
  816. ibendimplementation :
  817. break;
  818. else
  819. Message1(unit_f_ppu_invalid_entry,tostr(b));
  820. end;
  821. until false;
  822. { we can now derefence all pointers to the implementation parts }
  823. oldobjectlibrary:=objectlibrary;
  824. objectlibrary:=librarydata;
  825. aktglobalsymtable:=tstoredsymtable(globalsymtable);
  826. tstoredsymtable(globalsymtable).derefimpl;
  827. if assigned(localsymtable) then
  828. begin
  829. aktstaticsymtable:=tstoredsymtable(localsymtable);
  830. tstoredsymtable(localsymtable).derefimpl;
  831. end;
  832. objectlibrary:=oldobjectlibrary;
  833. end;
  834. procedure tppumodule.load_symtable_refs;
  835. var
  836. b : byte;
  837. i : longint;
  838. begin
  839. { load local symtable first }
  840. if ((flags and uf_local_browser)<>0) then
  841. begin
  842. localsymtable:=tstaticsymtable.create(modulename^);
  843. tstaticsymtable(localsymtable).ppuload(ppufile);
  844. end;
  845. { load browser }
  846. if (flags and uf_has_browser)<>0 then
  847. begin
  848. tstoredsymtable(globalsymtable).load_references(ppufile,true);
  849. for i:=0 to mapsize-1 do
  850. tstoredsymtable(globalsymtable).load_references(ppufile,false);
  851. b:=ppufile.readentry;
  852. if b<>ibendbrowser then
  853. Message1(unit_f_ppu_invalid_entry,tostr(b));
  854. end;
  855. if ((flags and uf_local_browser)<>0) then
  856. tstaticsymtable(localsymtable).load_references(ppufile,true);
  857. end;
  858. procedure tppumodule.writeppu;
  859. var
  860. pu : tused_unit;
  861. begin
  862. Message1(unit_u_ppu_write,realmodulename^);
  863. { create unit flags }
  864. {$ifdef GDB}
  865. if cs_gdb_dbx in aktglobalswitches then
  866. flags:=flags or uf_has_dbx;
  867. {$endif GDB}
  868. if cs_browser in aktmoduleswitches then
  869. flags:=flags or uf_has_browser;
  870. if cs_local_browser in aktmoduleswitches then
  871. flags:=flags or uf_local_browser;
  872. if do_release then
  873. flags:=flags or uf_release;
  874. {$ifdef cpufpemu}
  875. if (cs_fp_emulation in aktmoduleswitches) then
  876. flags:=flags or uf_fpu_emulation;
  877. {$endif cpufpemu}
  878. {$ifdef Test_Double_checksum_write}
  879. Assign(CRCFile,s+'.IMP');
  880. Rewrite(CRCFile);
  881. {$endif def Test_Double_checksum_write}
  882. { create new ppufile }
  883. ppufile:=tcompilerppufile.create(ppufilename^);
  884. if not ppufile.createfile then
  885. Message(unit_f_ppu_cannot_write);
  886. { first the unitname }
  887. ppufile.putstring(realmodulename^);
  888. ppufile.writeentry(ibmodulename);
  889. writesourcefiles;
  890. writeusedmacros;
  891. { write interface uses }
  892. writeusedunit(true);
  893. { write the objectfiles and libraries that come for this unit,
  894. preserve the containers becuase they are still needed to load
  895. the link.res. All doesn't depend on the crc! It doesn't matter
  896. if a unit is in a .o or .a file }
  897. ppufile.do_crc:=false;
  898. writelinkcontainer(linkunitofiles,iblinkunitofiles,true);
  899. writelinkcontainer(linkunitstaticlibs,iblinkunitstaticlibs,true);
  900. writelinkcontainer(linkunitsharedlibs,iblinkunitsharedlibs,true);
  901. writelinkcontainer(linkotherofiles,iblinkotherofiles,false);
  902. writelinkcontainer(linkotherstaticlibs,iblinkotherstaticlibs,true);
  903. writelinkcontainer(linkothersharedlibs,iblinkothersharedlibs,true);
  904. ppufile.do_crc:=true;
  905. { generate implementation deref data, the interface deref data is
  906. already generated when calculating the interface crc }
  907. if (cs_compilesystem in aktmoduleswitches) then
  908. begin
  909. aktglobalsymtable:=tstoredsymtable(globalsymtable);
  910. tstoredsymtable(globalsymtable).buildderef;
  911. derefdataintflen:=derefdata.size;
  912. end;
  913. tstoredsymtable(globalsymtable).buildderefimpl;
  914. if ((flags and uf_local_browser)<>0) and
  915. assigned(localsymtable) then
  916. begin
  917. aktglobalsymtable:=tstoredsymtable(globalsymtable);
  918. aktstaticsymtable:=tstoredsymtable(localsymtable);
  919. tstoredsymtable(localsymtable).buildderef;
  920. tstoredsymtable(localsymtable).buildderefimpl;
  921. end;
  922. writederefdata;
  923. ppufile.writeentry(ibendinterface);
  924. { write the symtable entries }
  925. tstoredsymtable(globalsymtable).ppuwrite(ppufile);
  926. { everything after this doesn't affect the crc }
  927. ppufile.do_crc:=false;
  928. { write implementation uses }
  929. writeusedunit(false);
  930. { write asmsymbols }
  931. writeasmsymbols;
  932. { end of implementation }
  933. ppufile.writeentry(ibendimplementation);
  934. { write static symtable
  935. needed for local debugging of unit functions }
  936. if ((flags and uf_local_browser)<>0) and
  937. assigned(localsymtable) then
  938. tstoredsymtable(localsymtable).ppuwrite(ppufile);
  939. { write all browser section }
  940. if (flags and uf_has_browser)<>0 then
  941. begin
  942. tstoredsymtable(globalsymtable).write_references(ppufile,true);
  943. pu:=tused_unit(used_units.first);
  944. while assigned(pu) do
  945. begin
  946. tstoredsymtable(pu.u.globalsymtable).write_references(ppufile,false);
  947. pu:=tused_unit(pu.next);
  948. end;
  949. ppufile.writeentry(ibendbrowser);
  950. end;
  951. if ((flags and uf_local_browser)<>0) and
  952. assigned(localsymtable) then
  953. tstaticsymtable(localsymtable).write_references(ppufile,true);
  954. { the last entry ibend is written automaticly }
  955. { flush to be sure }
  956. ppufile.flush;
  957. { create and write header }
  958. ppufile.header.size:=ppufile.size;
  959. ppufile.header.checksum:=ppufile.crc;
  960. ppufile.header.interface_checksum:=ppufile.interface_crc;
  961. ppufile.header.compiler:=wordversion;
  962. ppufile.header.cpu:=word(target_cpu);
  963. ppufile.header.target:=word(target_info.system);
  964. ppufile.header.flags:=flags;
  965. ppufile.writeheader;
  966. { save crc in current module also }
  967. crc:=ppufile.crc;
  968. interface_crc:=ppufile.interface_crc;
  969. {$ifdef Test_Double_checksum_write}
  970. close(CRCFile);
  971. {$endif Test_Double_checksum_write}
  972. ppufile.closefile;
  973. ppufile.free;
  974. ppufile:=nil;
  975. end;
  976. procedure tppumodule.getppucrc;
  977. begin
  978. {$ifdef Test_Double_checksum_write}
  979. Assign(CRCFile,s+'.INT')
  980. Rewrite(CRCFile);
  981. {$endif def Test_Double_checksum_write}
  982. { create new ppufile }
  983. ppufile:=tcompilerppufile.create(ppufilename^);
  984. ppufile.crc_only:=true;
  985. if not ppufile.createfile then
  986. Message(unit_f_ppu_cannot_write);
  987. { first the unitname }
  988. ppufile.putstring(realmodulename^);
  989. ppufile.writeentry(ibmodulename);
  990. { the interface units affect the crc }
  991. writeusedunit(true);
  992. { deref data of interface that affect the crc }
  993. derefdata.reset;
  994. aktglobalsymtable:=tstoredsymtable(globalsymtable);
  995. tstoredsymtable(globalsymtable).buildderef;
  996. derefdataintflen:=derefdata.size;
  997. writederefdata;
  998. ppufile.writeentry(ibendinterface);
  999. { write the symtable entries }
  1000. tstoredsymtable(globalsymtable).ppuwrite(ppufile);
  1001. { save crc }
  1002. crc:=ppufile.crc;
  1003. interface_crc:=ppufile.interface_crc;
  1004. { end of implementation, to generate a correct ppufile
  1005. for ppudump when using INTFPPU define }
  1006. ppufile.writeentry(ibendimplementation);
  1007. {$ifdef Test_Double_checksum}
  1008. crc_array:=ppufile.crc_test;
  1009. ppufile.crc_test:=nil;
  1010. crc_size:=ppufile.crc_index2;
  1011. crc_array2:=ppufile.crc_test2;
  1012. ppufile.crc_test2:=nil;
  1013. crc_size2:=ppufile.crc_index2;
  1014. {$endif Test_Double_checksum}
  1015. {$ifdef Test_Double_checksum_write}
  1016. close(CRCFile);
  1017. {$endif Test_Double_checksum_write}
  1018. { create and write header, this will only be used
  1019. for debugging purposes }
  1020. ppufile.header.size:=ppufile.size;
  1021. ppufile.header.checksum:=ppufile.crc;
  1022. ppufile.header.interface_checksum:=ppufile.interface_crc;
  1023. ppufile.header.compiler:=wordversion;
  1024. ppufile.header.cpu:=word(target_cpu);
  1025. ppufile.header.target:=word(target_info.system);
  1026. ppufile.header.flags:=flags;
  1027. ppufile.writeheader;
  1028. ppufile.closefile;
  1029. ppufile.free;
  1030. ppufile:=nil;
  1031. end;
  1032. procedure tppumodule.load_usedunits;
  1033. var
  1034. pu : tused_unit;
  1035. load_refs : boolean;
  1036. begin
  1037. if current_module<>self then
  1038. internalerror(200212284);
  1039. load_refs:=true;
  1040. { load the used units from interface }
  1041. in_interface:=true;
  1042. pu:=tused_unit(used_units.first);
  1043. while assigned(pu) do
  1044. begin
  1045. if pu.in_interface then
  1046. begin
  1047. tppumodule(pu.u).loadppu;
  1048. { if this unit is compiled we can stop }
  1049. if state=ms_compiled then
  1050. exit;
  1051. { add this unit to the dependencies }
  1052. pu.u.adddependency(self);
  1053. { need to recompile the current unit, check the interface
  1054. crc. And when not compiled with -Ur then check the complete
  1055. crc }
  1056. if (pu.u.interface_crc<>pu.interface_checksum) or
  1057. (
  1058. ((ppufile.header.flags and uf_release)=0) and
  1059. (pu.u.crc<>pu.checksum)
  1060. ) then
  1061. begin
  1062. Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^);
  1063. recompile_reason:=rr_crcchanged;
  1064. do_compile:=true;
  1065. exit;
  1066. end;
  1067. end;
  1068. pu:=tused_unit(pu.next);
  1069. end;
  1070. numberunits;
  1071. { ok, now load the interface of this unit }
  1072. if current_module<>self then
  1073. internalerror(200208187);
  1074. globalsymtable:=tglobalsymtable.create(modulename^);
  1075. tstoredsymtable(globalsymtable).ppuload(ppufile);
  1076. interface_compiled:=true;
  1077. { read the implementation part, containing
  1078. the implementation uses and objectdata }
  1079. in_interface:=false;
  1080. load_implementation;
  1081. { now only read the implementation uses }
  1082. pu:=tused_unit(used_units.first);
  1083. while assigned(pu) do
  1084. begin
  1085. if (not pu.in_interface) then
  1086. begin
  1087. tppumodule(pu.u).loadppu;
  1088. { if this unit is compiled we can stop }
  1089. if state=ms_compiled then
  1090. exit;
  1091. { add this unit to the dependencies }
  1092. pu.u.adddependency(self);
  1093. { need to recompile the current unit ? }
  1094. if (pu.u.interface_crc<>pu.interface_checksum) then
  1095. begin
  1096. Message2(unit_u_recompile_crc_change,realmodulename^,pu.u.realmodulename^+' {impl}');
  1097. recompile_reason:=rr_crcchanged;
  1098. do_compile:=true;
  1099. exit;
  1100. end;
  1101. end;
  1102. pu:=tused_unit(pu.next);
  1103. end;
  1104. numberunits;
  1105. { load browser info if stored }
  1106. if ((flags and uf_has_browser)<>0) and load_refs then
  1107. begin
  1108. if current_module<>self then
  1109. internalerror(200208188);
  1110. load_symtable_refs;
  1111. end;
  1112. end;
  1113. function tppumodule.needrecompile:boolean;
  1114. var
  1115. pu : tused_unit;
  1116. begin
  1117. result:=false;
  1118. pu:=tused_unit(used_units.first);
  1119. while assigned(pu) do
  1120. begin
  1121. { need to recompile the current unit, check the interface
  1122. crc. And when not compiled with -Ur then check the complete
  1123. crc }
  1124. if (pu.u.interface_crc<>pu.interface_checksum) or
  1125. (
  1126. (pu.in_interface) and
  1127. (pu.u.crc<>pu.checksum)
  1128. ) then
  1129. begin
  1130. result:=true;
  1131. exit;
  1132. end;
  1133. pu:=tused_unit(pu.next);
  1134. end;
  1135. end;
  1136. procedure tppumodule.loadppu;
  1137. const
  1138. ImplIntf : array[boolean] of string[15]=('implementation','interface');
  1139. var
  1140. do_load,
  1141. second_time : boolean;
  1142. old_current_module : tmodule;
  1143. begin
  1144. old_current_module:=current_module;
  1145. Message3(unit_u_load_unit,old_current_module.modulename^,
  1146. ImplIntf[old_current_module.in_interface],
  1147. modulename^);
  1148. { Update loaded_from to detect cycles }
  1149. loaded_from:=old_current_module;
  1150. { check if the globalsymtable is already available, but
  1151. we must reload when the do_reload flag is set }
  1152. if (not do_reload) and
  1153. assigned(globalsymtable) then
  1154. exit;
  1155. { reset }
  1156. do_load:=true;
  1157. second_time:=false;
  1158. current_module:=self;
  1159. SetCompileModule(current_module);
  1160. Fillchar(aktfilepos,0,sizeof(aktfilepos));
  1161. { A force reload }
  1162. if do_reload then
  1163. begin
  1164. Message(unit_u_forced_reload);
  1165. do_reload:=false;
  1166. { When the unit is already loaded or being loaded
  1167. we can maybe skip a complete reload/recompile }
  1168. if assigned(globalsymtable) and
  1169. (not needrecompile) then
  1170. begin
  1171. { When we don't have any data stored yet there
  1172. is nothing to resolve }
  1173. if interface_compiled then
  1174. begin
  1175. Message1(unit_u_reresolving_unit,modulename^);
  1176. aktglobalsymtable:=tstoredsymtable(globalsymtable);
  1177. tstoredsymtable(globalsymtable).deref;
  1178. tstoredsymtable(globalsymtable).derefimpl;
  1179. if assigned(localsymtable) then
  1180. begin
  1181. aktstaticsymtable:=tstoredsymtable(localsymtable);
  1182. tstoredsymtable(localsymtable).deref;
  1183. tstoredsymtable(localsymtable).derefimpl;
  1184. end;
  1185. end
  1186. else
  1187. Message1(unit_u_skipping_reresolving_unit,modulename^);
  1188. do_load:=false;
  1189. end;
  1190. end;
  1191. if do_load then
  1192. begin
  1193. { we are loading a new module, save the state of the scanner
  1194. and reset scanner+module }
  1195. if assigned(current_scanner) then
  1196. current_scanner.tempcloseinputfile;
  1197. current_scanner:=nil;
  1198. { loading the unit for a second time? }
  1199. if state=ms_registered then
  1200. state:=ms_load
  1201. else
  1202. begin
  1203. { try to load the unit a second time first }
  1204. Message1(unit_u_second_load_unit,modulename^);
  1205. Message2(unit_u_previous_state,modulename^,ModuleStateStr[state]);
  1206. { Flag modules to reload }
  1207. flagdependent(old_current_module);
  1208. { Reset the module }
  1209. reset;
  1210. if state in [ms_compile,ms_second_compile] then
  1211. begin
  1212. Message1(unit_u_second_compile_unit,modulename^);
  1213. state:=ms_second_compile;
  1214. do_compile:=true;
  1215. end
  1216. else
  1217. state:=ms_second_load;
  1218. second_time:=true;
  1219. end;
  1220. { close old_current_ppu on system that are
  1221. short on file handles like DOS PM }
  1222. {$ifdef SHORT_ON_FILE_HANDLES}
  1223. if old_current_module.is_unit and
  1224. assigned(tppumodule(old_current_module).ppufile) then
  1225. tppumodule(old_current_module).ppufile.tempclose;
  1226. {$endif SHORT_ON_FILE_HANDLES}
  1227. { try to opening ppu, skip this when we already
  1228. know that we need to compile the unit }
  1229. if not do_compile then
  1230. begin
  1231. Message1(unit_u_loading_unit,modulename^);
  1232. search_unit(false,false);
  1233. if not do_compile then
  1234. begin
  1235. load_interface;
  1236. if not do_compile then
  1237. begin
  1238. load_usedunits;
  1239. if not do_compile then
  1240. Message1(unit_u_finished_loading_unit,modulename^);
  1241. end;
  1242. end;
  1243. { PPU is not needed anymore }
  1244. if assigned(ppufile) then
  1245. begin
  1246. ppufile.closefile;
  1247. ppufile.free;
  1248. ppufile:=nil;
  1249. end;
  1250. end;
  1251. { Do we need to recompile the unit }
  1252. if do_compile then
  1253. begin
  1254. { recompile the unit or give a fatal error if sources not available }
  1255. if not(sources_avail) then
  1256. begin
  1257. if (not search_unit(true,false)) and
  1258. (length(modulename^)>8) then
  1259. search_unit(true,true);
  1260. if not(sources_avail) then
  1261. begin
  1262. if recompile_reason=rr_noppu then
  1263. Message1(unit_f_cant_find_ppu,modulename^)
  1264. else
  1265. Message1(unit_f_cant_compile_unit,modulename^);
  1266. end;
  1267. end;
  1268. { Flag modules to reload }
  1269. flagdependent(old_current_module);
  1270. { Reset the module }
  1271. reset;
  1272. { compile this module }
  1273. if not(state in [ms_compile,ms_second_compile]) then
  1274. state:=ms_compile;
  1275. compile(mainsource^);
  1276. end
  1277. else
  1278. state:=ms_compiled;
  1279. if current_module<>self then
  1280. internalerror(200212282);
  1281. if in_interface then
  1282. internalerror(200212283);
  1283. { for a second_time recompile reload all dependent units,
  1284. for a first time compile register the unit _once_ }
  1285. if second_time then
  1286. reload_flagged_units
  1287. else
  1288. usedunits.concat(tused_unit.create(self,true,false,nil));
  1289. { reopen the old module }
  1290. {$ifdef SHORT_ON_FILE_HANDLES}
  1291. if old_current_module.is_unit and
  1292. assigned(tppumodule(old_current_module).ppufile) then
  1293. tppumodule(old_current_module).ppufile.tempopen;
  1294. {$endif SHORT_ON_FILE_HANDLES}
  1295. { reload old scanner }
  1296. current_scanner:=tscannerfile(old_current_module.scanner);
  1297. if assigned(current_scanner) then
  1298. begin
  1299. current_scanner.tempopeninputfile;
  1300. current_scanner.gettokenpos
  1301. end
  1302. else
  1303. fillchar(aktfilepos,sizeof(aktfilepos),0);
  1304. end;
  1305. { we are back, restore current_module }
  1306. current_module:=old_current_module;
  1307. SetCompileModule(current_module);
  1308. end;
  1309. {*****************************************************************************
  1310. RegisterUnit
  1311. *****************************************************************************}
  1312. function registerunit(callermodule:tmodule;const s : stringid;const fn:string) : tppumodule;
  1313. var
  1314. ups : stringid;
  1315. hp : tppumodule;
  1316. hp2,
  1317. shortnamehp : tmodule;
  1318. begin
  1319. { Info }
  1320. ups:=upper(s);
  1321. { search all loaded units }
  1322. shortnamehp:=nil;
  1323. hp:=tppumodule(loaded_units.first);
  1324. while assigned(hp) do
  1325. begin
  1326. if hp.modulename^=ups then
  1327. begin
  1328. { only check for units. The main program is also
  1329. as a unit in the loaded_units list. We simply need
  1330. to ignore this entry (PFV) }
  1331. if hp.is_unit then
  1332. begin
  1333. { both units in interface ? }
  1334. if callermodule.in_interface and
  1335. hp.in_interface then
  1336. begin
  1337. { check for a cycle }
  1338. hp2:=callermodule.loaded_from;
  1339. while assigned(hp2) and (hp2<>hp) do
  1340. begin
  1341. if hp2.in_interface then
  1342. hp2:=hp2.loaded_from
  1343. else
  1344. hp2:=nil;
  1345. end;
  1346. if assigned(hp2) then
  1347. Message2(unit_f_circular_unit_reference,callermodule.modulename^,hp.modulename^);
  1348. end;
  1349. break;
  1350. end;
  1351. end
  1352. else
  1353. if copy(hp.modulename^,1,8)=ups then
  1354. shortnamehp:=hp;
  1355. { the next unit }
  1356. hp:=tppumodule(hp.next);
  1357. end;
  1358. if assigned(shortnamehp) and not assigned(hp) then
  1359. Message2(unit_w_unit_name_error,s,shortnamehp.modulename^);
  1360. { the unit is not in the loaded units,
  1361. we create an entry and register the unit }
  1362. if not assigned(hp) then
  1363. begin
  1364. Message1(unit_u_registering_new_unit,Upper(s));
  1365. hp:=tppumodule.create(callermodule,s,fn,true);
  1366. hp.loaded_from:=callermodule;
  1367. loaded_units.insert(hp);
  1368. end;
  1369. { return }
  1370. registerunit:=hp;
  1371. end;
  1372. end.
  1373. {
  1374. $Log$
  1375. Revision 1.46 2003-11-03 12:32:48 marco
  1376. * cycle detection patch from peter
  1377. Revision 1.45 2003/10/29 21:55:10 peter
  1378. * don't set second_load when second_compile was already set
  1379. Revision 1.44 2003/10/29 21:02:51 peter
  1380. * set ms_compiled after the program/unit is parsed
  1381. * check for ms_compiled before checking preproc matches
  1382. Revision 1.43 2003/10/23 14:44:07 peter
  1383. * splitted buildderef and buildderefimpl to fix interface crc
  1384. calculation
  1385. Revision 1.42 2003/10/22 20:40:00 peter
  1386. * write derefdata in a separate ppu entry
  1387. Revision 1.41 2003/10/22 17:38:25 peter
  1388. * write implementation units in implementation part of the ppu
  1389. so it doesn't confuse the unit loading
  1390. Revision 1.40 2003/10/22 15:22:33 peter
  1391. * fixed unitsym-globalsymtable relation so the uses of a unit
  1392. is counted correctly
  1393. Revision 1.39 2003/09/05 17:41:12 florian
  1394. * merged Wiktor's Watcom patches in 1.1
  1395. Revision 1.38 2003/08/23 22:29:24 peter
  1396. * reload flagged units when interface is loaded
  1397. Revision 1.37 2003/06/08 11:40:14 peter
  1398. * moved message to msg file
  1399. Revision 1.36 2003/06/07 20:26:32 peter
  1400. * re-resolving added instead of reloading from ppu
  1401. * tderef object added to store deref info for resolving
  1402. Revision 1.35 2003/05/25 10:27:12 peter
  1403. * moved Comment calls to messge file
  1404. Revision 1.34 2003/05/23 17:04:37 peter
  1405. * write interface crc to .ppu.intf when enabled
  1406. * when a unit is compiled with -Ur check only interface crc
  1407. Revision 1.33 2003/04/27 11:21:32 peter
  1408. * aktprocdef renamed to current_procdef
  1409. * procinfo renamed to current_procinfo
  1410. * procinfo will now be stored in current_module so it can be
  1411. cleaned up properly
  1412. * gen_main_procsym changed to create_main_proc and release_main_proc
  1413. to also generate a tprocinfo structure
  1414. * fixed unit implicit initfinal
  1415. Revision 1.32 2003/04/27 07:29:50 peter
  1416. * current_procdef cleanup, current_procdef is now always nil when parsing
  1417. a new procdef declaration
  1418. * aktprocsym removed
  1419. * lexlevel removed, use symtable.symtablelevel instead
  1420. * implicit init/final code uses the normal genentry/genexit
  1421. * funcret state checking updated for new funcret handling
  1422. Revision 1.31 2003/04/26 00:30:52 peter
  1423. * reset aktfilepos when setting new module for compile
  1424. Revision 1.30 2003/03/27 17:44:13 peter
  1425. * fixed small mem leaks
  1426. Revision 1.29 2002/12/29 14:57:50 peter
  1427. * unit loading changed to first register units and load them
  1428. afterwards. This is needed to support uses xxx in yyy correctly
  1429. * unit dependency check fixed
  1430. Revision 1.28 2002/12/06 16:56:57 peter
  1431. * only compile cs_fp_emulation support when cpufpuemu is defined
  1432. * define cpufpuemu for m68k only
  1433. Revision 1.27 2002/11/20 12:36:24 mazen
  1434. * $UNITPATH directive is now working
  1435. Revision 1.26 2002/11/15 01:58:46 peter
  1436. * merged changes from 1.0.7 up to 04-11
  1437. - -V option for generating bug report tracing
  1438. - more tracing for option parsing
  1439. - errors for cdecl and high()
  1440. - win32 import stabs
  1441. - win32 records<=8 are returned in eax:edx (turned off by default)
  1442. - heaptrc update
  1443. - more info for temp management in .s file with EXTDEBUG
  1444. Revision 1.25 2002/10/20 14:49:31 peter
  1445. * store original source time in ppu so it can be compared instead of
  1446. comparing with the ppu time
  1447. Revision 1.24 2002/10/04 20:13:10 peter
  1448. * set in_second_load flag before resetting the module, this is
  1449. required to skip some checkings
  1450. Revision 1.23 2002/08/19 19:36:42 peter
  1451. * More fixes for cross unit inlining, all tnodes are now implemented
  1452. * Moved pocall_internconst to po_internconst because it is not a
  1453. calling type at all and it conflicted when inlining of these small
  1454. functions was requested
  1455. Revision 1.22 2002/08/18 19:58:28 peter
  1456. * more current_scanner fixes
  1457. Revision 1.21 2002/08/15 15:09:41 carl
  1458. + fpu emulation helpers (ppu checking also)
  1459. Revision 1.20 2002/08/12 16:46:04 peter
  1460. * tscannerfile is now destroyed in tmodule.reset and current_scanner
  1461. is updated accordingly. This removes all the loading and saving of
  1462. the old scanner and the invalid flag marking
  1463. Revision 1.19 2002/08/11 14:28:19 peter
  1464. * TScannerFile.SetInvalid added that will also reset inputfile
  1465. Revision 1.18 2002/08/11 13:24:11 peter
  1466. * saving of asmsymbols in ppu supported
  1467. * asmsymbollist global is removed and moved into a new class
  1468. tasmlibrarydata that will hold the info of a .a file which
  1469. corresponds with a single module. Added librarydata to tmodule
  1470. to keep the library info stored for the module. In the future the
  1471. objectfiles will also be stored to the tasmlibrarydata class
  1472. * all getlabel/newasmsymbol and friends are moved to the new class
  1473. Revision 1.17 2002/07/26 21:15:37 florian
  1474. * rewrote the system handling
  1475. Revision 1.16 2002/05/16 19:46:36 carl
  1476. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1477. + try to fix temp allocation (still in ifdef)
  1478. + generic constructor calls
  1479. + start of tassembler / tmodulebase class cleanup
  1480. Revision 1.15 2002/05/14 19:34:41 peter
  1481. * removed old logs and updated copyright year
  1482. Revision 1.14 2002/05/12 16:53:05 peter
  1483. * moved entry and exitcode to ncgutil and cgobj
  1484. * foreach gets extra argument for passing local data to the
  1485. iterator function
  1486. * -CR checks also class typecasts at runtime by changing them
  1487. into as
  1488. * fixed compiler to cycle with the -CR option
  1489. * fixed stabs with elf writer, finally the global variables can
  1490. be watched
  1491. * removed a lot of routines from cga unit and replaced them by
  1492. calls to cgobj
  1493. * u32bit-s32bit updates for and,or,xor nodes. When one element is
  1494. u32bit then the other is typecasted also to u32bit without giving
  1495. a rangecheck warning/error.
  1496. * fixed pascal calling method with reversing also the high tree in
  1497. the parast, detected by tcalcst3 test
  1498. Revision 1.13 2002/04/04 19:05:56 peter
  1499. * removed unused units
  1500. * use tlocation.size in cg.a_*loc*() routines
  1501. Revision 1.12 2002/03/28 20:46:44 carl
  1502. - remove go32v1 support
  1503. Revision 1.11 2002/01/19 14:20:13 peter
  1504. * check for -Un when loading ppu with wrong name
  1505. }