files.pas 31 KB

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