files.pas 33 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115
  1. {
  2. $Id$
  3. Copyright (c) 1996-98 by Florian Klaempfl
  4. This unit implements an extended file management and the first loading
  5. and searching of the modules (ppufiles)
  6. This program is free software; you can redistribute it and/or modify
  7. it under the terms of the GNU General Public License as published by
  8. the Free Software Foundation; either version 2 of the License, or
  9. (at your option) any later version.
  10. This program is distributed in the hope that it will be useful,
  11. but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  13. GNU General Public License for more details.
  14. You should have received a copy of the GNU General Public License
  15. along with this program; if not, write to the Free Software
  16. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  17. ****************************************************************************
  18. }
  19. unit files;
  20. interface
  21. uses
  22. cobjects,globals,ppu;
  23. const
  24. {$ifdef FPC}
  25. maxunits = 1024;
  26. InputFileBufSize=32*1024;
  27. linebufincrease=512;
  28. {$else}
  29. maxunits = 128;
  30. InputFileBufSize=1024;
  31. linebufincrease=64;
  32. {$endif}
  33. type
  34. {$ifdef FPC}
  35. tlongintarr = array[0..1000000] of longint;
  36. {$else}
  37. tlongintarr = array[0..16000] of longint;
  38. {$endif}
  39. plongintarr = ^tlongintarr;
  40. pinputfile = ^tinputfile;
  41. tinputfile = object
  42. path,name : pstring; { path and filename }
  43. next : pinputfile; { next file for reading }
  44. f : file; { current file handle }
  45. is_macro,
  46. endoffile, { still bytes left to read }
  47. closed : boolean; { is the file closed }
  48. buf : pchar; { buffer }
  49. bufstart, { buffer start position in the file }
  50. bufsize, { amount of bytes in the buffer }
  51. maxbufsize : longint; { size in memory for the buffer }
  52. saveinputpointer : pchar; { save fields for scanner variables }
  53. savelastlinepos,
  54. saveline_no : longint;
  55. linebuf : plongintarr; { line buffer to retrieve lines }
  56. maxlinebuf : longint;
  57. ref_count : longint; { to handle the browser refs }
  58. ref_index : longint;
  59. ref_next : pinputfile;
  60. constructor init(const fn:string);
  61. destructor done;
  62. procedure setpos(l:longint);
  63. procedure seekbuf(fpos:longint);
  64. procedure readbuf;
  65. function open:boolean;
  66. procedure close;
  67. procedure tempclose;
  68. function tempopen:boolean;
  69. procedure setmacro(p:pchar;len:longint);
  70. procedure setline(line,linepos:longint);
  71. function getlinestr(l:longint):string;
  72. end;
  73. pfilemanager = ^tfilemanager;
  74. tfilemanager = object
  75. files : pinputfile;
  76. last_ref_index : longint;
  77. constructor init;
  78. destructor done;
  79. procedure register_file(f : pinputfile);
  80. procedure inverse_register_indexes;
  81. function get_file(l:longint) : pinputfile;
  82. function get_file_name(l :longint):string;
  83. function get_file_path(l :longint):string;
  84. end;
  85. type
  86. tunitmap = array[0..maxunits-1] of pointer;
  87. punitmap = ^tunitmap;
  88. pmodule = ^tmodule;
  89. tmodule = object(tlinkedlist_item)
  90. ppufile : pppufile; { the PPU file }
  91. crc,
  92. flags : longint; { the PPU flags }
  93. compiled, { unit is already compiled }
  94. do_assemble, { only assemble the object, don't recompile }
  95. do_compile, { need to compile the sources }
  96. sources_avail, { if all sources are reachable }
  97. is_unit,
  98. in_implementation, { processing the implementation part? }
  99. in_global : boolean; { allow global settings }
  100. map : punitmap; { mapping of all used units }
  101. unitcount : word; { local unit counter }
  102. unit_index : word; { global counter for browser }
  103. symtable : pointer; { pointer to the psymtable of this unit }
  104. {$ifdef UseBrowser}
  105. implsymtable : pointer;
  106. {$endif UseBrowser}
  107. uses_imports : boolean; { Set if the module imports from DLL's.}
  108. imports : plinkedlist;
  109. sourcefiles : tfilemanager;
  110. linksharedlibs,
  111. linkstaticlibs,
  112. linkofiles : tstringcontainer;
  113. used_units : tlinkedlist;
  114. { used in firstpass for faster settings }
  115. scanner : pointer;
  116. path, { path where the module is find/created }
  117. modulename, { name of the module in uppercase }
  118. objfilename, { fullname of the objectfile }
  119. asmfilename, { fullname of the assemblerfile }
  120. ppufilename, { fullname of the ppufile }
  121. staticlibfilename, { fullname of the static libraryfile }
  122. sharedlibfilename, { fullname of the shared libraryfile }
  123. exefilename, { fullname of the exefile }
  124. asmprefix, { prefix for the smartlink asmfiles }
  125. mainsource : pstring; { name of the main sourcefile }
  126. constructor init(const s:string;_is_unit:boolean);
  127. destructor done;virtual;
  128. procedure setfilename(const fn:string);
  129. function openppu:boolean;
  130. function search_unit(const n : string):boolean;
  131. end;
  132. pused_unit = ^tused_unit;
  133. tused_unit = object(tlinkedlist_item)
  134. unitid : word;
  135. name : pstring;
  136. checksum : longint;
  137. loaded : boolean;
  138. in_uses,
  139. in_interface,
  140. is_stab_written : boolean;
  141. u : pmodule;
  142. constructor init(_u : pmodule;intface:boolean);
  143. constructor init_to_load(const n:string;c:longint;intface:boolean);
  144. destructor done;virtual;
  145. end;
  146. var
  147. main_module : pmodule; { Main module of the program }
  148. current_module : pmodule; { Current module which is compiled }
  149. current_ppu : pppufile; { Current ppufile which is read }
  150. global_unit_count : word;
  151. usedunits : tlinkedlist; { Used units for this program }
  152. loaded_units : tlinkedlist; { All loaded units }
  153. implementation
  154. uses
  155. dos,verbose,systems;
  156. {****************************************************************************
  157. TINPUTFILE
  158. ****************************************************************************}
  159. constructor tinputfile.init(const fn:string);
  160. var
  161. p,n,e : string;
  162. begin
  163. FSplit(fn,p,n,e);
  164. name:=stringdup(n+e);
  165. path:=stringdup(p);
  166. next:=nil;
  167. { file info }
  168. is_macro:=false;
  169. endoffile:=false;
  170. closed:=true;
  171. buf:=nil;
  172. bufstart:=0;
  173. bufsize:=0;
  174. maxbufsize:=InputFileBufSize;
  175. { save fields }
  176. saveinputpointer:=nil;
  177. saveline_no:=0;
  178. savelastlinepos:=0;
  179. { indexing refs }
  180. ref_next:=nil;
  181. ref_count:=0;
  182. ref_index:=0;
  183. { line buffer }
  184. linebuf:=nil;
  185. maxlinebuf:=0;
  186. end;
  187. destructor tinputfile.done;
  188. begin
  189. stringdispose(path);
  190. stringdispose(name);
  191. { free memory }
  192. if assigned(linebuf) then
  193. freemem(linebuf,maxlinebuf shl 2);
  194. end;
  195. procedure tinputfile.setpos(l:longint);
  196. begin
  197. bufstart:=l;
  198. end;
  199. procedure tinputfile.seekbuf(fpos:longint);
  200. begin
  201. if closed then
  202. exit;
  203. seek(f,fpos);
  204. bufstart:=fpos;
  205. bufsize:=0;
  206. end;
  207. procedure tinputfile.readbuf;
  208. {$ifdef TP}
  209. var
  210. w : word;
  211. {$endif}
  212. begin
  213. if is_macro then
  214. endoffile:=true;
  215. if closed then
  216. exit;
  217. inc(bufstart,bufsize);
  218. {$ifdef TP}
  219. blockread(f,buf^,maxbufsize-1,w);
  220. bufsize:=w;
  221. {$else}
  222. blockread(f,buf^,maxbufsize-1,bufsize);
  223. {$endif}
  224. buf[bufsize]:=#0;
  225. endoffile:=not(bufsize=maxbufsize-1);
  226. end;
  227. function tinputfile.open:boolean;
  228. var
  229. ofm : byte;
  230. begin
  231. open:=false;
  232. if not closed then
  233. Close;
  234. ofm:=filemode;
  235. filemode:=0;
  236. Assign(f,path^+name^);
  237. {$I-}
  238. reset(f,1);
  239. {$I+}
  240. filemode:=ofm;
  241. if ioresult<>0 then
  242. exit;
  243. { file }
  244. endoffile:=false;
  245. closed:=false;
  246. Getmem(buf,MaxBufsize);
  247. bufstart:=0;
  248. bufsize:=0;
  249. open:=true;
  250. end;
  251. procedure tinputfile.close;
  252. var
  253. i : word;
  254. begin
  255. if is_macro then
  256. begin
  257. Freemem(buf,maxbufsize);
  258. is_macro:=false;
  259. closed:=true;
  260. exit;
  261. end;
  262. if not closed then
  263. begin
  264. {$I-}
  265. system.close(f);
  266. {$I+}
  267. i:=ioresult;
  268. Freemem(buf,maxbufsize);
  269. closed:=true;
  270. end;
  271. buf:=nil;
  272. bufstart:=0;
  273. end;
  274. procedure tinputfile.tempclose;
  275. var
  276. i : word;
  277. begin
  278. if is_macro then
  279. exit;
  280. if not closed then
  281. begin
  282. {$I-}
  283. system.close(f);
  284. {$I+}
  285. i:=ioresult;
  286. Freemem(buf,maxbufsize);
  287. buf:=nil;
  288. closed:=true;
  289. end;
  290. end;
  291. function tinputfile.tempopen:boolean;
  292. var
  293. ofm : byte;
  294. begin
  295. tempopen:=false;
  296. if is_macro then
  297. begin
  298. tempopen:=true;
  299. exit;
  300. end;
  301. if not closed then
  302. exit;
  303. ofm:=filemode;
  304. filemode:=0;
  305. Assign(f,path^+name^);
  306. {$I-}
  307. reset(f,1);
  308. {$I+}
  309. filemode:=ofm;
  310. if ioresult<>0 then
  311. exit;
  312. closed:=false;
  313. { get new mem }
  314. Getmem(buf,maxbufsize);
  315. { restore state }
  316. seek(f,BufStart);
  317. bufsize:=0;
  318. readbuf;
  319. tempopen:=true;
  320. end;
  321. procedure tinputfile.setmacro(p:pchar;len:longint);
  322. begin
  323. { create new buffer }
  324. getmem(buf,len+1);
  325. move(p^,buf^,len);
  326. buf[len]:=#0;
  327. { reset }
  328. bufstart:=0;
  329. bufsize:=len;
  330. maxbufsize:=len+1;
  331. is_macro:=true;
  332. endoffile:=true;
  333. closed:=true;
  334. end;
  335. procedure tinputfile.setline(line,linepos:longint);
  336. var
  337. oldlinebuf : plongintarr;
  338. begin
  339. if line<1 then
  340. exit;
  341. while (line>=maxlinebuf) do
  342. begin
  343. oldlinebuf:=linebuf;
  344. { create new linebuf and move old info }
  345. getmem(linebuf,(maxlinebuf+linebufincrease) shl 2);
  346. if assigned(oldlinebuf) then
  347. begin
  348. move(oldlinebuf^,linebuf^,maxlinebuf shl 2);
  349. freemem(oldlinebuf,maxlinebuf shl 2);
  350. end;
  351. fillchar(linebuf^[maxlinebuf],linebufincrease shl 2,0);
  352. inc(maxlinebuf,linebufincrease);
  353. end;
  354. linebuf^[line]:=linepos;
  355. end;
  356. function tinputfile.getlinestr(l:longint):string;
  357. var
  358. c : char;
  359. i,
  360. fpos : longint;
  361. p : pchar;
  362. begin
  363. getlinestr:='';
  364. if l<maxlinebuf then
  365. begin
  366. fpos:=linebuf^[l];
  367. { fpos is set negativ if the line was already written }
  368. { but we still know the correct value }
  369. if fpos<0 then
  370. fpos:=-fpos+1;
  371. if closed then
  372. open;
  373. { in current buf ? }
  374. if (fpos<bufstart) or (fpos>bufstart+bufsize) then
  375. begin
  376. seekbuf(fpos);
  377. readbuf;
  378. end;
  379. { the begin is in the buf now simply read until #13,#10 }
  380. i:=0;
  381. p:=@buf[fpos-bufstart];
  382. repeat
  383. c:=p^;
  384. if c=#0 then
  385. begin
  386. readbuf;
  387. p:=buf;
  388. c:=p^;
  389. end;
  390. if c in [#10,#13] then
  391. break;
  392. inc(i);
  393. getlinestr[i]:=c;
  394. inc(longint(p));
  395. until (i=255);
  396. getlinestr[0]:=chr(i);
  397. end;
  398. end;
  399. {****************************************************************************
  400. TFILEMANAGER
  401. ****************************************************************************}
  402. constructor tfilemanager.init;
  403. begin
  404. files:=nil;
  405. last_ref_index:=0;
  406. end;
  407. destructor tfilemanager.done;
  408. var
  409. hp : pinputfile;
  410. begin
  411. hp:=files;
  412. while assigned(hp) do
  413. begin
  414. files:=files^.ref_next;
  415. dispose(hp,done);
  416. hp:=files;
  417. end;
  418. last_ref_index:=0;
  419. end;
  420. procedure tfilemanager.register_file(f : pinputfile);
  421. begin
  422. inc(last_ref_index);
  423. f^.ref_next:=files;
  424. f^.ref_index:=last_ref_index;
  425. files:=f;
  426. end;
  427. { this procedure is necessary after loading the
  428. sources files from a PPU file PM }
  429. procedure tfilemanager.inverse_register_indexes;
  430. var
  431. f : pinputfile;
  432. begin
  433. f:=files;
  434. while assigned(f) do
  435. begin
  436. f^.ref_index:=last_ref_index-f^.ref_index+1;
  437. f:=f^.ref_next;
  438. end;
  439. end;
  440. function tfilemanager.get_file(l :longint) : pinputfile;
  441. var
  442. ff : pinputfile;
  443. begin
  444. ff:=files;
  445. while assigned(ff) and (ff^.ref_index<>l) do
  446. ff:=ff^.ref_next;
  447. get_file:=ff;
  448. end;
  449. function tfilemanager.get_file_name(l :longint):string;
  450. var
  451. hp : pinputfile;
  452. begin
  453. hp:=get_file(l);
  454. if assigned(hp) then
  455. get_file_name:=hp^.name^
  456. else
  457. get_file_name:='';
  458. end;
  459. function tfilemanager.get_file_path(l :longint):string;
  460. var
  461. hp : pinputfile;
  462. begin
  463. hp:=get_file(l);
  464. if assigned(hp) then
  465. get_file_path:=hp^.path^
  466. else
  467. get_file_path:='';
  468. end;
  469. {****************************************************************************
  470. TMODULE
  471. ****************************************************************************}
  472. procedure tmodule.setfilename(const fn:string);
  473. var
  474. p : dirstr;
  475. n : NameStr;
  476. e : ExtStr;
  477. begin
  478. stringdispose(objfilename);
  479. stringdispose(asmfilename);
  480. stringdispose(ppufilename);
  481. stringdispose(staticlibfilename);
  482. stringdispose(sharedlibfilename);
  483. stringdispose(exefilename);
  484. stringdispose(path);
  485. { Create names }
  486. fsplit(fn,p,n,e);
  487. p:=FixPath(p);
  488. n:=FixFileName(n);
  489. { set path and obj,asm,ppu names }
  490. path:=stringdup(p);
  491. objfilename:=stringdup(p+n+target_info.objext);
  492. asmfilename:=stringdup(p+n+target_info.asmext);
  493. ppufilename:=stringdup(p+n+target_info.unitext);
  494. { lib and exe could be loaded with a file specified with -o }
  495. if OutputFile<>'' then
  496. n:=OutputFile;
  497. staticlibfilename:=stringdup(p+target_os.libprefix+n+target_os.staticlibext);
  498. sharedlibfilename:=stringdup(p+target_os.libprefix+n+target_os.sharedlibext);
  499. exefilename:=stringdup(p+n+target_os.exeext);
  500. end;
  501. function tmodule.openppu:boolean;
  502. var
  503. objfiletime,
  504. ppufiletime,
  505. asmfiletime : longint;
  506. begin
  507. openppu:=false;
  508. { Get ppufile time (also check if the file exists) }
  509. ppufiletime:=getnamedfiletime(ppufilename^);
  510. if ppufiletime=-1 then
  511. exit;
  512. { Open the ppufile }
  513. Message1(unit_u_ppu_loading,ppufilename^);
  514. ppufile:=new(pppufile,init(ppufilename^));
  515. if not ppufile^.open then
  516. begin
  517. dispose(ppufile,done);
  518. Message(unit_d_ppu_file_too_short);
  519. exit;
  520. end;
  521. { check for a valid PPU file }
  522. if not ppufile^.CheckPPUId then
  523. begin
  524. dispose(ppufile,done);
  525. Message(unit_d_ppu_invalid_header);
  526. exit;
  527. end;
  528. { check for allowed PPU versions }
  529. if not (ppufile^.GetPPUVersion in [15]) then
  530. begin
  531. dispose(ppufile,done);
  532. Message1(unit_d_ppu_invalid_version,tostr(ppufile^.GetPPUVersion));
  533. exit;
  534. end;
  535. { check the target processor }
  536. if ttargetcpu(ppufile^.header.cpu)<>target_cpu then
  537. begin
  538. dispose(ppufile,done);
  539. Comment(V_Debug,'unit is compiled for an other processor');
  540. exit;
  541. end;
  542. { check target }
  543. if ttarget(ppufile^.header.target)<>target_info.target then
  544. begin
  545. dispose(ppufile,done);
  546. Comment(V_Debug,'unit is compiled for an other target');
  547. exit;
  548. end;
  549. {!!!!!!!!!!!!!!!!!!! }
  550. { Load values to be access easier }
  551. flags:=ppufile^.header.flags;
  552. crc:=ppufile^.header.checksum;
  553. { Show Debug info }
  554. Message1(unit_d_ppu_time,filetimestring(ppufiletime));
  555. Message1(unit_d_ppu_flags,tostr(flags));
  556. Message1(unit_d_ppu_crc,tostr(ppufile^.header.checksum));
  557. { check the object and assembler file to see if we need only to
  558. assemble, only if it's not in a library }
  559. do_compile:=false;
  560. if (flags and uf_in_library)=0 then
  561. begin
  562. if ((flags and uf_static_linked)<>0) or
  563. ((flags and uf_smartlink)<>0) then
  564. begin
  565. objfiletime:=getnamedfiletime(staticlibfilename^);
  566. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  567. do_compile:=true;
  568. end
  569. else
  570. if (flags and uf_shared_linked)<>0 then
  571. begin
  572. objfiletime:=getnamedfiletime(sharedlibfilename^);
  573. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  574. do_compile:=true;
  575. end
  576. else
  577. begin
  578. { the objectfile should be newer than the ppu file }
  579. objfiletime:=getnamedfiletime(objfilename^);
  580. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  581. begin
  582. { check if assembler file is older than ppu file }
  583. asmfileTime:=GetNamedFileTime(asmfilename^);
  584. if (asmfiletime<0) or (ppufiletime>asmfiletime) then
  585. begin
  586. Message(unit_d_obj_and_asm_are_older_than_ppu);
  587. do_compile:=true;
  588. { we should try to get the source file }
  589. exit;
  590. end
  591. else
  592. begin
  593. Message(unit_d_obj_is_older_than_asm);
  594. if not(cs_asm_extern in aktglobalswitches) then
  595. exit;
  596. end;
  597. end;
  598. end;
  599. end;
  600. openppu:=true;
  601. end;
  602. function tmodule.search_unit(const n : string):boolean;
  603. var
  604. ext : string[8];
  605. singlepathstring,
  606. unitPath,
  607. filename : string;
  608. found : boolean;
  609. start,i : longint;
  610. Function UnitExists(const ext:string):boolean;
  611. begin
  612. Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
  613. UnitExists:=FileExists(Singlepathstring+FileName+ext);
  614. end;
  615. begin
  616. start:=1;
  617. filename:=FixFileName(n);
  618. unitpath:=UnitSearchPath;
  619. Found:=false;
  620. repeat
  621. { Create current path to check }
  622. i:=pos(';',unitpath);
  623. if i=0 then
  624. i:=length(unitpath)+1;
  625. singlepathstring:=FixPath(copy(unitpath,start,i-start));
  626. delete(unitpath,start,i-start+1);
  627. { Check for PPL file }
  628. if not Found then
  629. begin
  630. Found:=UnitExists(target_info.unitlibext);
  631. if Found then
  632. Begin
  633. SetFileName(SinglePathString+FileName);
  634. Found:=OpenPPU;
  635. End;
  636. end;
  637. { Check for PPU file }
  638. if not Found then
  639. begin
  640. Found:=UnitExists(target_info.unitext);
  641. if Found then
  642. Begin
  643. SetFileName(SinglePathString+FileName);
  644. Found:=OpenPPU;
  645. End;
  646. end;
  647. { Check for Sources }
  648. if not Found then
  649. begin
  650. ppufile:=nil;
  651. do_compile:=true;
  652. {Check for .pp file}
  653. Found:=UnitExists(target_os.sourceext);
  654. if Found then
  655. Ext:=target_os.sourceext
  656. else
  657. begin
  658. {Check for .pas}
  659. Found:=UnitExists(target_os.pasext);
  660. if Found then
  661. Ext:=target_os.pasext;
  662. end;
  663. stringdispose(mainsource);
  664. if Found then
  665. begin
  666. sources_avail:=true;
  667. {Load Filenames when found}
  668. mainsource:=StringDup(SinglePathString+FileName+Ext);
  669. SetFileName(SinglePathString+FileName);
  670. end
  671. else
  672. sources_avail:=false;
  673. end;
  674. until Found or (unitpath='');
  675. search_unit:=Found;
  676. end;
  677. constructor tmodule.init(const s:string;_is_unit:boolean);
  678. var
  679. p : dirstr;
  680. n : namestr;
  681. e : extstr;
  682. begin
  683. FSplit(s,p,n,e);
  684. { Programs have the name program to don't conflict with dup id's }
  685. if _is_unit then
  686. modulename:=stringdup(Upper(n))
  687. else
  688. modulename:=stringdup('PROGRAM');
  689. mainsource:=stringdup(s);
  690. ppufilename:=nil;
  691. objfilename:=nil;
  692. asmfilename:=nil;
  693. staticlibfilename:=nil;
  694. sharedlibfilename:=nil;
  695. exefilename:=nil;
  696. { Dos has the famous 8.3 limit :( }
  697. {$ifdef tp}
  698. asmprefix:=stringdup(FixFileName('as'));
  699. {$else}
  700. {$ifdef go32v2}
  701. asmprefix:=stringdup(FixFileName('as'));
  702. {$else}
  703. asmprefix:=stringdup(FixFileName(n));
  704. {$endif}
  705. {$endif tp}
  706. path:=nil;
  707. setfilename(p+n);
  708. used_units.init;
  709. sourcefiles.init;
  710. linkofiles.init;
  711. linkstaticlibs.init;
  712. linksharedlibs.init;
  713. ppufile:=nil;
  714. scanner:=nil;
  715. map:=nil;
  716. symtable:=nil;
  717. {$ifdef UseBrowser}
  718. implsymtable:=nil;
  719. {$endif UseBrowser}
  720. flags:=0;
  721. crc:=0;
  722. unitcount:=1;
  723. inc(global_unit_count);
  724. unit_index:=global_unit_count;
  725. do_assemble:=false;
  726. do_compile:=false;
  727. sources_avail:=true;
  728. compiled:=false;
  729. in_implementation:=false;
  730. in_global:=true;
  731. is_unit:=_is_unit;
  732. uses_imports:=false;
  733. imports:=new(plinkedlist,init);
  734. { set smartlink flag }
  735. if (cs_smartlink in aktmoduleswitches) then
  736. flags:=flags or uf_smartlink;
  737. { search the PPU file if it is an unit }
  738. if is_unit then
  739. begin
  740. if (not search_unit(modulename^)) and (length(modulename^)>8) then
  741. search_unit(copy(modulename^,1,8));
  742. end;
  743. end;
  744. destructor tmodule.done;
  745. begin
  746. if assigned(map) then
  747. dispose(map);
  748. if assigned(ppufile) then
  749. dispose(ppufile,done);
  750. if assigned(imports) then
  751. dispose(imports,done);
  752. used_units.done;
  753. sourcefiles.done;
  754. linkofiles.done;
  755. linkstaticlibs.done;
  756. linksharedlibs.done;
  757. stringdispose(objfilename);
  758. stringdispose(asmfilename);
  759. stringdispose(ppufilename);
  760. stringdispose(staticlibfilename);
  761. stringdispose(sharedlibfilename);
  762. stringdispose(exefilename);
  763. stringdispose(path);
  764. stringdispose(modulename);
  765. stringdispose(mainsource);
  766. stringdispose(asmprefix);
  767. inherited done;
  768. end;
  769. {****************************************************************************
  770. TUSED_UNIT
  771. ****************************************************************************}
  772. constructor tused_unit.init(_u : pmodule;intface:boolean);
  773. begin
  774. u:=_u;
  775. in_interface:=intface;
  776. in_uses:=false;
  777. is_stab_written:=false;
  778. loaded:=true;
  779. name:=stringdup(_u^.modulename^);
  780. checksum:=_u^.crc;
  781. unitid:=0;
  782. end;
  783. constructor tused_unit.init_to_load(const n:string;c:longint;intface:boolean);
  784. begin
  785. u:=nil;
  786. in_interface:=intface;
  787. in_uses:=false;
  788. is_stab_written:=false;
  789. loaded:=false;
  790. name:=stringdup(n);
  791. checksum:=c;
  792. unitid:=0;
  793. end;
  794. destructor tused_unit.done;
  795. begin
  796. stringdispose(name);
  797. inherited done;
  798. end;
  799. end.
  800. {
  801. $Log$
  802. Revision 1.47 1998-09-22 17:13:43 pierre
  803. + browsing updated and developed
  804. records and objects fields are also stored
  805. Revision 1.46 1998/09/21 08:45:10 pierre
  806. + added vmt_offset in tobjectdef.write for fututre use
  807. (first steps to have objects without vmt if no virtual !!)
  808. + added fpu_used field for tabstractprocdef :
  809. sets this level to 2 if the functions return with value in FPU
  810. (is then set to correct value at parsing of implementation)
  811. THIS MIGHT refuse some code with FPU expression too complex
  812. that were accepted before and even in some cases
  813. that don't overflow in fact
  814. ( like if f : float; is a forward that finally in implementation
  815. only uses one fpu register !!)
  816. Nevertheless I think that it will improve security on
  817. FPU operations !!
  818. * most other changes only for UseBrowser code
  819. (added symtable references for record and objects)
  820. local switch for refs to args and local of each function
  821. (static symtable still missing)
  822. UseBrowser still not stable and probably broken by
  823. the definition hash array !!
  824. Revision 1.45 1998/09/18 09:58:51 peter
  825. * -s doesn't require the .o to be available, this allows compiling of
  826. everything on other platforms (profiling the windows.pp loading ;)
  827. Revision 1.44 1998/09/10 13:51:32 peter
  828. * tp compiler also uses 'as' as asmprefix
  829. Revision 1.43 1998/09/03 17:08:45 pierre
  830. * better lines for stabs
  831. (no scroll back to if before else part
  832. no return to case line at jump outside case)
  833. + source lines also if not in order
  834. Revision 1.42 1998/09/03 11:24:00 peter
  835. * moved more inputfile things from tscannerfile to tinputfile
  836. * changed ifdef Sourceline to cs_asm_source
  837. Revision 1.41 1998/08/26 15:35:30 peter
  838. * fixed scannerfiles for macros
  839. + $I %<environment>%
  840. Revision 1.40 1998/08/26 10:08:48 peter
  841. * fixed problem with libprefix at the wrong place
  842. * fixed lib generation with smartlinking and no -CS used
  843. Revision 1.39 1998/08/25 16:44:16 pierre
  844. * openppu was true even if the object file is missing
  845. this lead to trying to open a filename without extension
  846. and prevented the 'make cycle' to work for win32
  847. Revision 1.38 1998/08/19 10:06:12 peter
  848. * fixed filenames and removedir which supports slash at the end
  849. Revision 1.37 1998/08/18 20:52:19 peter
  850. * renamed in_main to in_global which is more logical
  851. Revision 1.36 1998/08/17 10:10:07 peter
  852. - removed OLDPPU
  853. Revision 1.35 1998/08/17 09:17:44 peter
  854. * static/shared linking updates
  855. Revision 1.34 1998/08/14 21:56:31 peter
  856. * setting the outputfile using -o works now to create static libs
  857. Revision 1.33 1998/08/11 14:09:08 peter
  858. * fixed some messages and smaller msgtxt.inc
  859. Revision 1.32 1998/08/10 14:49:58 peter
  860. + localswitches, moduleswitches, globalswitches splitting
  861. Revision 1.31 1998/07/14 14:46:48 peter
  862. * released NEWINPUT
  863. Revision 1.30 1998/07/07 11:19:55 peter
  864. + NEWINPUT for a better inputfile and scanner object
  865. Revision 1.29 1998/06/25 10:51:00 pierre
  866. * removed a remaining ifndef NEWPPU
  867. replaced by ifdef OLDPPU
  868. * added uf_finalize to ppu unit
  869. Revision 1.28 1998/06/25 08:48:12 florian
  870. * first version of rtti support
  871. Revision 1.27 1998/06/24 14:48:34 peter
  872. * ifdef newppu -> ifndef oldppu
  873. Revision 1.26 1998/06/17 14:36:19 peter
  874. * forgot an $ifndef OLDPPU :(
  875. Revision 1.25 1998/06/17 14:10:11 peter
  876. * small os2 fixes
  877. * fixed interdependent units with newppu (remake3 under linux works now)
  878. Revision 1.24 1998/06/16 08:56:20 peter
  879. + targetcpu
  880. * cleaner pmodules for newppu
  881. Revision 1.23 1998/06/15 14:44:36 daniel
  882. * BP updates.
  883. Revision 1.22 1998/06/14 18:25:41 peter
  884. * small fix with crc in newppu
  885. Revision 1.21 1998/06/13 00:10:05 peter
  886. * working browser and newppu
  887. * some small fixes against crashes which occured in bp7 (but not in
  888. fpc?!)
  889. Revision 1.20 1998/06/12 14:50:48 peter
  890. * removed the tree dependency to types.pas
  891. * long_fil.pas support (not fully tested yet)
  892. Revision 1.19 1998/06/12 10:32:26 pierre
  893. * column problem hopefully solved
  894. + C vars declaration changed
  895. Revision 1.18 1998/06/11 13:58:07 peter
  896. * small fix to let newppu compile
  897. Revision 1.17 1998/06/09 16:01:40 pierre
  898. + added procedure directive parsing for procvars
  899. (accepted are popstack cdecl and pascal)
  900. + added C vars with the following syntax
  901. var C calias 'true_c_name';(can be followed by external)
  902. reason is that you must add the Cprefix
  903. which is target dependent
  904. Revision 1.16 1998/06/04 10:42:19 pierre
  905. * small bug fix in load_ppu or openppu
  906. Revision 1.15 1998/05/28 14:37:53 peter
  907. * default programname is PROGRAM (like TP7) to avoid dup id's
  908. Revision 1.14 1998/05/27 19:45:02 peter
  909. * symtable.pas splitted into includefiles
  910. * symtable adapted for $ifndef OLDPPU
  911. Revision 1.13 1998/05/23 01:21:05 peter
  912. + aktasmmode, aktoptprocessor, aktoutputformat
  913. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  914. + $LIBNAME to set the library name where the unit will be put in
  915. * splitted cgi386 a bit (codeseg to large for bp7)
  916. * nasm, tasm works again. nasm moved to ag386nsm.pas
  917. Revision 1.12 1998/05/20 09:42:33 pierre
  918. + UseTokenInfo now default
  919. * unit in interface uses and implementation uses gives error now
  920. * only one error for unknown symbol (uses lastsymknown boolean)
  921. the problem came from the label code !
  922. + first inlined procedures and function work
  923. (warning there might be allowed cases were the result is still wrong !!)
  924. * UseBrower updated gives a global list of all position of all used symbols
  925. with switch -gb
  926. Revision 1.11 1998/05/12 10:46:59 peter
  927. * moved printstatus to verb_def
  928. + V_Normal which is between V_Error and V_Warning and doesn't have a
  929. prefix like error: warning: and is included in V_Default
  930. * fixed some messages
  931. * first time parameter scan is only for -v and -T
  932. - removed old style messages
  933. Revision 1.10 1998/05/11 13:07:53 peter
  934. + $ifndef OLDPPU for the new ppuformat
  935. + $define GDB not longer required
  936. * removed all warnings and stripped some log comments
  937. * no findfirst/findnext anymore to remove smartlink *.o files
  938. Revision 1.9 1998/05/06 15:04:20 pierre
  939. + when trying to find source files of a ppufile
  940. check the includepathlist for included files
  941. the main file must still be in the same directory
  942. Revision 1.8 1998/05/04 17:54:25 peter
  943. + smartlinking works (only case jumptable left todo)
  944. * redesign of systems.pas to support assemblers and linkers
  945. + Unitname is now also in the PPU-file, increased version to 14
  946. Revision 1.7 1998/05/01 16:38:44 florian
  947. * handling of private and protected fixed
  948. + change_keywords_to_tp implemented to remove
  949. keywords which aren't supported by tp
  950. * break and continue are now symbols of the system unit
  951. + widestring, longstring and ansistring type released
  952. Revision 1.6 1998/05/01 07:43:53 florian
  953. + basics for rtti implemented
  954. + switch $m (generate rtti for published sections)
  955. Revision 1.5 1998/04/30 15:59:40 pierre
  956. * GDB works again better :
  957. correct type info in one pass
  958. + UseTokenInfo for better source position
  959. * fixed one remaining bug in scanner for line counts
  960. * several little fixes
  961. Revision 1.4 1998/04/29 10:33:52 pierre
  962. + added some code for ansistring (not complete nor working yet)
  963. * corrected operator overloading
  964. * corrected nasm output
  965. + started inline procedures
  966. + added starstarn : use ** for exponentiation (^ gave problems)
  967. + started UseTokenInfo cond to get accurate positions
  968. Revision 1.3 1998/04/27 23:10:28 peter
  969. + new scanner
  970. * $makelib -> if smartlink
  971. * small filename fixes pmodule.setfilename
  972. * moved import from files.pas -> import.pas
  973. Revision 1.2 1998/04/21 10:16:47 peter
  974. * patches from strasbourg
  975. * objects is not used anymore in the fpc compiled version
  976. }