fppu.pas 56 KB

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