fppu.pas 54 KB

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