files.pas 32 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068
  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. { fpos is set negativ if the line was already written }
  364. { but we still know the correct value }
  365. if fpos<0 then
  366. fpos:=-fpos+1;
  367. if closed then
  368. open;
  369. { in current buf ? }
  370. if (fpos<bufstart) or (fpos>bufstart+bufsize) then
  371. begin
  372. seekbuf(fpos);
  373. readbuf;
  374. end;
  375. { the begin is in the buf now simply read until #13,#10 }
  376. i:=0;
  377. p:=@buf[fpos-bufstart];
  378. repeat
  379. c:=p^;
  380. if c=#0 then
  381. begin
  382. readbuf;
  383. p:=buf;
  384. c:=p^;
  385. end;
  386. if c in [#10,#13] then
  387. break;
  388. inc(i);
  389. getlinestr[i]:=c;
  390. inc(longint(p));
  391. until (i=255);
  392. getlinestr[0]:=chr(i);
  393. end;
  394. end;
  395. {****************************************************************************
  396. TFILEMANAGER
  397. ****************************************************************************}
  398. constructor tfilemanager.init;
  399. begin
  400. files:=nil;
  401. last_ref_index:=0;
  402. end;
  403. destructor tfilemanager.done;
  404. var
  405. hp : pinputfile;
  406. begin
  407. hp:=files;
  408. while assigned(hp) do
  409. begin
  410. files:=files^.ref_next;
  411. dispose(hp,done);
  412. hp:=files;
  413. end;
  414. last_ref_index:=0;
  415. end;
  416. procedure tfilemanager.register_file(f : pinputfile);
  417. begin
  418. inc(last_ref_index);
  419. f^.ref_next:=files;
  420. f^.ref_index:=last_ref_index;
  421. files:=f;
  422. end;
  423. function tfilemanager.get_file(l :longint) : pinputfile;
  424. var
  425. ff : pinputfile;
  426. begin
  427. ff:=files;
  428. while assigned(ff) and (ff^.ref_index<>l) do
  429. ff:=ff^.ref_next;
  430. get_file:=ff;
  431. end;
  432. function tfilemanager.get_file_name(l :longint):string;
  433. var
  434. hp : pinputfile;
  435. begin
  436. hp:=get_file(l);
  437. if assigned(hp) then
  438. get_file_name:=hp^.name^
  439. else
  440. get_file_name:='';
  441. end;
  442. function tfilemanager.get_file_path(l :longint):string;
  443. var
  444. hp : pinputfile;
  445. begin
  446. hp:=get_file(l);
  447. if assigned(hp) then
  448. get_file_path:=hp^.path^
  449. else
  450. get_file_path:='';
  451. end;
  452. {****************************************************************************
  453. TMODULE
  454. ****************************************************************************}
  455. procedure tmodule.setfilename(const fn:string);
  456. var
  457. p : dirstr;
  458. n : NameStr;
  459. e : ExtStr;
  460. begin
  461. stringdispose(objfilename);
  462. stringdispose(asmfilename);
  463. stringdispose(ppufilename);
  464. stringdispose(staticlibfilename);
  465. stringdispose(sharedlibfilename);
  466. stringdispose(exefilename);
  467. stringdispose(path);
  468. { Create names }
  469. fsplit(fn,p,n,e);
  470. p:=FixPath(p);
  471. n:=FixFileName(n);
  472. { set path and obj,asm,ppu names }
  473. path:=stringdup(p);
  474. objfilename:=stringdup(p+n+target_info.objext);
  475. asmfilename:=stringdup(p+n+target_info.asmext);
  476. ppufilename:=stringdup(p+n+target_info.unitext);
  477. { lib and exe could be loaded with a file specified with -o }
  478. if OutputFile<>'' then
  479. n:=OutputFile;
  480. staticlibfilename:=stringdup(p+target_os.libprefix+n+target_os.staticlibext);
  481. sharedlibfilename:=stringdup(p+target_os.libprefix+n+target_os.sharedlibext);
  482. exefilename:=stringdup(p+n+target_os.exeext);
  483. end;
  484. function tmodule.openppu:boolean;
  485. var
  486. objfiletime,
  487. ppufiletime,
  488. asmfiletime : longint;
  489. begin
  490. openppu:=false;
  491. { Get ppufile time (also check if the file exists) }
  492. ppufiletime:=getnamedfiletime(ppufilename^);
  493. if ppufiletime=-1 then
  494. exit;
  495. { Open the ppufile }
  496. Message1(unit_u_ppu_loading,ppufilename^);
  497. ppufile:=new(pppufile,init(ppufilename^));
  498. if not ppufile^.open then
  499. begin
  500. dispose(ppufile,done);
  501. Message(unit_d_ppu_file_too_short);
  502. exit;
  503. end;
  504. { check for a valid PPU file }
  505. if not ppufile^.CheckPPUId then
  506. begin
  507. dispose(ppufile,done);
  508. Message(unit_d_ppu_invalid_header);
  509. exit;
  510. end;
  511. { check for allowed PPU versions }
  512. if not (ppufile^.GetPPUVersion in [15]) then
  513. begin
  514. dispose(ppufile,done);
  515. Message1(unit_d_ppu_invalid_version,tostr(ppufile^.GetPPUVersion));
  516. exit;
  517. end;
  518. { check the target processor }
  519. if ttargetcpu(ppufile^.header.cpu)<>target_cpu then
  520. begin
  521. dispose(ppufile,done);
  522. Comment(V_Debug,'unit is compiled for an other processor');
  523. exit;
  524. end;
  525. { check target }
  526. if ttarget(ppufile^.header.target)<>target_info.target then
  527. begin
  528. dispose(ppufile,done);
  529. Comment(V_Debug,'unit is compiled for an other target');
  530. exit;
  531. end;
  532. {!!!!!!!!!!!!!!!!!!! }
  533. { Load values to be access easier }
  534. flags:=ppufile^.header.flags;
  535. crc:=ppufile^.header.checksum;
  536. { Show Debug info }
  537. Message1(unit_d_ppu_time,filetimestring(ppufiletime));
  538. Message1(unit_d_ppu_flags,tostr(flags));
  539. Message1(unit_d_ppu_crc,tostr(ppufile^.header.checksum));
  540. { check the object and assembler file to see if we need only to
  541. assemble, only if it's not in a library }
  542. do_compile:=false;
  543. if (flags and uf_in_library)=0 then
  544. begin
  545. if ((flags and uf_static_linked)<>0) or
  546. ((flags and uf_smartlink)<>0) then
  547. begin
  548. objfiletime:=getnamedfiletime(staticlibfilename^);
  549. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  550. do_compile:=true;
  551. end
  552. else
  553. if (flags and uf_shared_linked)<>0 then
  554. begin
  555. objfiletime:=getnamedfiletime(sharedlibfilename^);
  556. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  557. do_compile:=true;
  558. end
  559. else
  560. begin
  561. { the objectfile should be newer than the ppu file }
  562. objfiletime:=getnamedfiletime(objfilename^);
  563. if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
  564. begin
  565. { check if assembler file is older than ppu file }
  566. asmfileTime:=GetNamedFileTime(asmfilename^);
  567. if (asmfiletime<0) or (ppufiletime>asmfiletime) then
  568. begin
  569. Message(unit_d_obj_and_asm_are_older_than_ppu);
  570. do_compile:=true;
  571. { we should try to get the source file }
  572. exit;
  573. end
  574. else
  575. begin
  576. Message(unit_d_obj_is_older_than_asm);
  577. if not(cs_asm_extern in aktglobalswitches) then
  578. exit;
  579. end;
  580. end;
  581. end;
  582. end;
  583. openppu:=true;
  584. end;
  585. function tmodule.search_unit(const n : string):boolean;
  586. var
  587. ext : string[8];
  588. singlepathstring,
  589. unitPath,
  590. filename : string;
  591. found : boolean;
  592. start,i : longint;
  593. Function UnitExists(const ext:string):boolean;
  594. begin
  595. Message1(unit_t_unitsearch,Singlepathstring+filename+ext);
  596. UnitExists:=FileExists(Singlepathstring+FileName+ext);
  597. end;
  598. begin
  599. start:=1;
  600. filename:=FixFileName(n);
  601. unitpath:=UnitSearchPath;
  602. Found:=false;
  603. repeat
  604. { Create current path to check }
  605. i:=pos(';',unitpath);
  606. if i=0 then
  607. i:=length(unitpath)+1;
  608. singlepathstring:=FixPath(copy(unitpath,start,i-start));
  609. delete(unitpath,start,i-start+1);
  610. { Check for PPL file }
  611. if not Found then
  612. begin
  613. Found:=UnitExists(target_info.unitlibext);
  614. if Found then
  615. Begin
  616. SetFileName(SinglePathString+FileName);
  617. Found:=OpenPPU;
  618. End;
  619. end;
  620. { Check for PPU file }
  621. if not Found then
  622. begin
  623. Found:=UnitExists(target_info.unitext);
  624. if Found then
  625. Begin
  626. SetFileName(SinglePathString+FileName);
  627. Found:=OpenPPU;
  628. End;
  629. end;
  630. { Check for Sources }
  631. if not Found then
  632. begin
  633. ppufile:=nil;
  634. do_compile:=true;
  635. {Check for .pp file}
  636. Found:=UnitExists(target_os.sourceext);
  637. if Found then
  638. Ext:=target_os.sourceext
  639. else
  640. begin
  641. {Check for .pas}
  642. Found:=UnitExists(target_os.pasext);
  643. if Found then
  644. Ext:=target_os.pasext;
  645. end;
  646. stringdispose(mainsource);
  647. if Found then
  648. begin
  649. sources_avail:=true;
  650. {Load Filenames when found}
  651. mainsource:=StringDup(SinglePathString+FileName+Ext);
  652. SetFileName(SinglePathString+FileName);
  653. end
  654. else
  655. sources_avail:=false;
  656. end;
  657. until Found or (unitpath='');
  658. search_unit:=Found;
  659. end;
  660. constructor tmodule.init(const s:string;_is_unit:boolean);
  661. var
  662. p : dirstr;
  663. n : namestr;
  664. e : extstr;
  665. begin
  666. FSplit(s,p,n,e);
  667. { Programs have the name program to don't conflict with dup id's }
  668. if _is_unit then
  669. modulename:=stringdup(Upper(n))
  670. else
  671. modulename:=stringdup('PROGRAM');
  672. mainsource:=stringdup(s);
  673. ppufilename:=nil;
  674. objfilename:=nil;
  675. asmfilename:=nil;
  676. staticlibfilename:=nil;
  677. sharedlibfilename:=nil;
  678. exefilename:=nil;
  679. { Dos has the famous 8.3 limit :( }
  680. {$ifdef tp}
  681. asmprefix:=stringdup(FixFileName('as'));
  682. {$else}
  683. {$ifdef go32v2}
  684. asmprefix:=stringdup(FixFileName('as'));
  685. {$else}
  686. asmprefix:=stringdup(FixFileName(n));
  687. {$endif}
  688. {$endif tp}
  689. path:=nil;
  690. setfilename(p+n);
  691. used_units.init;
  692. sourcefiles.init;
  693. linkofiles.init;
  694. linkstaticlibs.init;
  695. linksharedlibs.init;
  696. ppufile:=nil;
  697. scanner:=nil;
  698. map:=nil;
  699. symtable:=nil;
  700. flags:=0;
  701. crc:=0;
  702. unitcount:=1;
  703. inc(global_unit_count);
  704. unit_index:=global_unit_count;
  705. do_assemble:=false;
  706. do_compile:=false;
  707. sources_avail:=true;
  708. compiled:=false;
  709. in_implementation:=false;
  710. in_global:=true;
  711. is_unit:=_is_unit;
  712. uses_imports:=false;
  713. imports:=new(plinkedlist,init);
  714. { set smartlink flag }
  715. if (cs_smartlink in aktmoduleswitches) then
  716. flags:=flags or uf_smartlink;
  717. { search the PPU file if it is an unit }
  718. if is_unit then
  719. begin
  720. if (not search_unit(modulename^)) and (length(modulename^)>8) then
  721. search_unit(copy(modulename^,1,8));
  722. end;
  723. end;
  724. destructor tmodule.done;
  725. begin
  726. if assigned(map) then
  727. dispose(map);
  728. if assigned(ppufile) then
  729. dispose(ppufile,done);
  730. if assigned(imports) then
  731. dispose(imports,done);
  732. used_units.done;
  733. sourcefiles.done;
  734. linkofiles.done;
  735. linkstaticlibs.done;
  736. linksharedlibs.done;
  737. stringdispose(objfilename);
  738. stringdispose(asmfilename);
  739. stringdispose(ppufilename);
  740. stringdispose(staticlibfilename);
  741. stringdispose(sharedlibfilename);
  742. stringdispose(exefilename);
  743. stringdispose(path);
  744. stringdispose(modulename);
  745. stringdispose(mainsource);
  746. stringdispose(asmprefix);
  747. inherited done;
  748. end;
  749. {****************************************************************************
  750. TUSED_UNIT
  751. ****************************************************************************}
  752. constructor tused_unit.init(_u : pmodule;intface:boolean);
  753. begin
  754. u:=_u;
  755. in_interface:=intface;
  756. in_uses:=false;
  757. is_stab_written:=false;
  758. loaded:=true;
  759. name:=stringdup(_u^.modulename^);
  760. checksum:=_u^.crc;
  761. unitid:=0;
  762. end;
  763. constructor tused_unit.init_to_load(const n:string;c:longint;intface:boolean);
  764. begin
  765. u:=nil;
  766. in_interface:=intface;
  767. in_uses:=false;
  768. is_stab_written:=false;
  769. loaded:=false;
  770. name:=stringdup(n);
  771. checksum:=c;
  772. unitid:=0;
  773. end;
  774. destructor tused_unit.done;
  775. begin
  776. stringdispose(name);
  777. inherited done;
  778. end;
  779. end.
  780. {
  781. $Log$
  782. Revision 1.45 1998-09-18 09:58:51 peter
  783. * -s doesn't require the .o to be available, this allows compiling of
  784. everything on other platforms (profiling the windows.pp loading ;)
  785. Revision 1.44 1998/09/10 13:51:32 peter
  786. * tp compiler also uses 'as' as asmprefix
  787. Revision 1.43 1998/09/03 17:08:45 pierre
  788. * better lines for stabs
  789. (no scroll back to if before else part
  790. no return to case line at jump outside case)
  791. + source lines also if not in order
  792. Revision 1.42 1998/09/03 11:24:00 peter
  793. * moved more inputfile things from tscannerfile to tinputfile
  794. * changed ifdef Sourceline to cs_asm_source
  795. Revision 1.41 1998/08/26 15:35:30 peter
  796. * fixed scannerfiles for macros
  797. + $I %<environment>%
  798. Revision 1.40 1998/08/26 10:08:48 peter
  799. * fixed problem with libprefix at the wrong place
  800. * fixed lib generation with smartlinking and no -CS used
  801. Revision 1.39 1998/08/25 16:44:16 pierre
  802. * openppu was true even if the object file is missing
  803. this lead to trying to open a filename without extension
  804. and prevented the 'make cycle' to work for win32
  805. Revision 1.38 1998/08/19 10:06:12 peter
  806. * fixed filenames and removedir which supports slash at the end
  807. Revision 1.37 1998/08/18 20:52:19 peter
  808. * renamed in_main to in_global which is more logical
  809. Revision 1.36 1998/08/17 10:10:07 peter
  810. - removed OLDPPU
  811. Revision 1.35 1998/08/17 09:17:44 peter
  812. * static/shared linking updates
  813. Revision 1.34 1998/08/14 21:56:31 peter
  814. * setting the outputfile using -o works now to create static libs
  815. Revision 1.33 1998/08/11 14:09:08 peter
  816. * fixed some messages and smaller msgtxt.inc
  817. Revision 1.32 1998/08/10 14:49:58 peter
  818. + localswitches, moduleswitches, globalswitches splitting
  819. Revision 1.31 1998/07/14 14:46:48 peter
  820. * released NEWINPUT
  821. Revision 1.30 1998/07/07 11:19:55 peter
  822. + NEWINPUT for a better inputfile and scanner object
  823. Revision 1.29 1998/06/25 10:51:00 pierre
  824. * removed a remaining ifndef NEWPPU
  825. replaced by ifdef OLDPPU
  826. * added uf_finalize to ppu unit
  827. Revision 1.28 1998/06/25 08:48:12 florian
  828. * first version of rtti support
  829. Revision 1.27 1998/06/24 14:48:34 peter
  830. * ifdef newppu -> ifndef oldppu
  831. Revision 1.26 1998/06/17 14:36:19 peter
  832. * forgot an $ifndef OLDPPU :(
  833. Revision 1.25 1998/06/17 14:10:11 peter
  834. * small os2 fixes
  835. * fixed interdependent units with newppu (remake3 under linux works now)
  836. Revision 1.24 1998/06/16 08:56:20 peter
  837. + targetcpu
  838. * cleaner pmodules for newppu
  839. Revision 1.23 1998/06/15 14:44:36 daniel
  840. * BP updates.
  841. Revision 1.22 1998/06/14 18:25:41 peter
  842. * small fix with crc in newppu
  843. Revision 1.21 1998/06/13 00:10:05 peter
  844. * working browser and newppu
  845. * some small fixes against crashes which occured in bp7 (but not in
  846. fpc?!)
  847. Revision 1.20 1998/06/12 14:50:48 peter
  848. * removed the tree dependency to types.pas
  849. * long_fil.pas support (not fully tested yet)
  850. Revision 1.19 1998/06/12 10:32:26 pierre
  851. * column problem hopefully solved
  852. + C vars declaration changed
  853. Revision 1.18 1998/06/11 13:58:07 peter
  854. * small fix to let newppu compile
  855. Revision 1.17 1998/06/09 16:01:40 pierre
  856. + added procedure directive parsing for procvars
  857. (accepted are popstack cdecl and pascal)
  858. + added C vars with the following syntax
  859. var C calias 'true_c_name';(can be followed by external)
  860. reason is that you must add the Cprefix
  861. which is target dependent
  862. Revision 1.16 1998/06/04 10:42:19 pierre
  863. * small bug fix in load_ppu or openppu
  864. Revision 1.15 1998/05/28 14:37:53 peter
  865. * default programname is PROGRAM (like TP7) to avoid dup id's
  866. Revision 1.14 1998/05/27 19:45:02 peter
  867. * symtable.pas splitted into includefiles
  868. * symtable adapted for $ifndef OLDPPU
  869. Revision 1.13 1998/05/23 01:21:05 peter
  870. + aktasmmode, aktoptprocessor, aktoutputformat
  871. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  872. + $LIBNAME to set the library name where the unit will be put in
  873. * splitted cgi386 a bit (codeseg to large for bp7)
  874. * nasm, tasm works again. nasm moved to ag386nsm.pas
  875. Revision 1.12 1998/05/20 09:42:33 pierre
  876. + UseTokenInfo now default
  877. * unit in interface uses and implementation uses gives error now
  878. * only one error for unknown symbol (uses lastsymknown boolean)
  879. the problem came from the label code !
  880. + first inlined procedures and function work
  881. (warning there might be allowed cases were the result is still wrong !!)
  882. * UseBrower updated gives a global list of all position of all used symbols
  883. with switch -gb
  884. Revision 1.11 1998/05/12 10:46:59 peter
  885. * moved printstatus to verb_def
  886. + V_Normal which is between V_Error and V_Warning and doesn't have a
  887. prefix like error: warning: and is included in V_Default
  888. * fixed some messages
  889. * first time parameter scan is only for -v and -T
  890. - removed old style messages
  891. Revision 1.10 1998/05/11 13:07:53 peter
  892. + $ifndef OLDPPU for the new ppuformat
  893. + $define GDB not longer required
  894. * removed all warnings and stripped some log comments
  895. * no findfirst/findnext anymore to remove smartlink *.o files
  896. Revision 1.9 1998/05/06 15:04:20 pierre
  897. + when trying to find source files of a ppufile
  898. check the includepathlist for included files
  899. the main file must still be in the same directory
  900. Revision 1.8 1998/05/04 17:54:25 peter
  901. + smartlinking works (only case jumptable left todo)
  902. * redesign of systems.pas to support assemblers and linkers
  903. + Unitname is now also in the PPU-file, increased version to 14
  904. Revision 1.7 1998/05/01 16:38:44 florian
  905. * handling of private and protected fixed
  906. + change_keywords_to_tp implemented to remove
  907. keywords which aren't supported by tp
  908. * break and continue are now symbols of the system unit
  909. + widestring, longstring and ansistring type released
  910. Revision 1.6 1998/05/01 07:43:53 florian
  911. + basics for rtti implemented
  912. + switch $m (generate rtti for published sections)
  913. Revision 1.5 1998/04/30 15:59:40 pierre
  914. * GDB works again better :
  915. correct type info in one pass
  916. + UseTokenInfo for better source position
  917. * fixed one remaining bug in scanner for line counts
  918. * several little fixes
  919. Revision 1.4 1998/04/29 10:33:52 pierre
  920. + added some code for ansistring (not complete nor working yet)
  921. * corrected operator overloading
  922. * corrected nasm output
  923. + started inline procedures
  924. + added starstarn : use ** for exponentiation (^ gave problems)
  925. + started UseTokenInfo cond to get accurate positions
  926. Revision 1.3 1998/04/27 23:10:28 peter
  927. + new scanner
  928. * $makelib -> if smartlink
  929. * small filename fixes pmodule.setfilename
  930. * moved import from files.pas -> import.pas
  931. Revision 1.2 1998/04/21 10:16:47 peter
  932. * patches from strasbourg
  933. * objects is not used anymore in the fpc compiled version
  934. }