files.pas 33 KB

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