symppu.inc 16 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542
  1. {
  2. $Id$
  3. Copyright (c) 1993-98 by Florian Klaempfl, Pierre Muller
  4. Implementation of the reading of PPU Files for the symtable
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. const
  19. {$ifdef FPC}
  20. ppubufsize=32768;
  21. {$ELSE}
  22. {$IFDEF USEOVERLAY}
  23. ppubufsize=512;
  24. {$ELSE}
  25. ppubufsize=4096;
  26. {$ENDIF}
  27. {$ENDIF}
  28. {*****************************************************************************
  29. PPU Writing
  30. *****************************************************************************}
  31. procedure writebyte(b:byte);
  32. begin
  33. current_ppu^.putbyte(b);
  34. end;
  35. procedure writeword(w:word);
  36. begin
  37. current_ppu^.putword(w);
  38. end;
  39. procedure writelong(l:longint);
  40. begin
  41. current_ppu^.putlongint(l);
  42. end;
  43. procedure writereal(d:bestreal);
  44. begin
  45. current_ppu^.putreal(d);
  46. end;
  47. procedure writestring(const s:string);
  48. begin
  49. current_ppu^.putstring(s);
  50. end;
  51. procedure writenormalset(var s); {You cannot pass an array[0..31] of byte!}
  52. begin
  53. current_ppu^.putdata(s,sizeof(tnormalset));
  54. end;
  55. procedure writecontainer(var p:tstringcontainer;id:byte;hold:boolean);
  56. var
  57. hcontainer : tstringcontainer;
  58. s : string;
  59. begin
  60. if hold then
  61. hcontainer.init;
  62. while not p.empty do
  63. begin
  64. s:=p.get;
  65. current_ppu^.putstring(s);
  66. if hold then
  67. hcontainer.insert(s);
  68. end;
  69. current_ppu^.writeentry(id);
  70. if hold then
  71. p:=hcontainer;
  72. end;
  73. procedure writeposinfo(const p:tfileposinfo);
  74. begin
  75. current_ppu^.putword(p.fileindex);
  76. current_ppu^.putlongint(p.line);
  77. current_ppu^.putword(p.column);
  78. end;
  79. procedure writedefref(p : pdef);
  80. begin
  81. if p=nil then
  82. current_ppu^.putlongint($ffffffff)
  83. else
  84. begin
  85. if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then
  86. current_ppu^.putword($ffff)
  87. else
  88. current_ppu^.putword(p^.owner^.unitid);
  89. current_ppu^.putword(p^.indexnb);
  90. end;
  91. end;
  92. procedure writesymref(p : psym);
  93. begin
  94. if p=nil then
  95. current_ppu^.putlongint($ffffffff)
  96. else
  97. begin
  98. if (p^.owner^.symtabletype in [recordsymtable,objectsymtable]) then
  99. current_ppu^.putword($ffff)
  100. else
  101. current_ppu^.putword(p^.owner^.unitid);
  102. current_ppu^.putword(p^.indexnb);
  103. end;
  104. end;
  105. procedure writesourcefiles;
  106. var
  107. hp : pinputfile;
  108. begin
  109. { second write the used source files }
  110. hp:=current_module^.sourcefiles^.files;
  111. while assigned(hp) do
  112. begin
  113. { only name and extension }
  114. current_ppu^.putstring(hp^.name^);
  115. hp:=hp^.ref_next;
  116. end;
  117. current_ppu^.writeentry(ibsourcefiles);
  118. end;
  119. procedure writeusedunit;
  120. var
  121. hp : pused_unit;
  122. begin
  123. numberunits;
  124. hp:=pused_unit(current_module^.used_units.first);
  125. while assigned(hp) do
  126. begin
  127. current_ppu^.putstring(hp^.name^);
  128. { the checksum should not affect the crc of this unit ! (PFV) }
  129. current_ppu^.do_crc:=false;
  130. current_ppu^.putlongint(hp^.checksum);
  131. current_ppu^.do_crc:=true;
  132. current_ppu^.putbyte(byte(hp^.in_interface));
  133. hp:=pused_unit(hp^.next);
  134. end;
  135. current_ppu^.writeentry(ibloadunit_int);
  136. end;
  137. procedure writeunitas(const s : string;unittable : punitsymtable);
  138. begin
  139. Message1(unit_u_ppu_write,s);
  140. { create unit flags }
  141. with Current_Module^ do
  142. begin
  143. if cs_create_staticlib in aktmoduleswitches then
  144. begin
  145. flags:=flags or uf_static_linked;
  146. if SplitName(ppufilename^)<>SplitName(staticlibfilename^) then
  147. flags:=flags or uf_in_library;
  148. end;
  149. if cs_create_sharedlib in aktmoduleswitches then
  150. begin
  151. flags:=flags or uf_shared_linked;
  152. if SplitName(ppufilename^)<>SplitName(sharedlibfilename^) then
  153. flags:=flags or uf_in_library;
  154. end;
  155. if cs_smartlink in aktmoduleswitches then
  156. flags:=flags or uf_smartlink;
  157. {$ifdef GDB}
  158. if use_dbx then
  159. flags:=flags or uf_has_dbx;
  160. {$endif GDB}
  161. if target_os.endian=endian_big then
  162. flags:=flags or uf_big_endian;
  163. {$ifdef UseBrowser}
  164. if cs_browser in aktmoduleswitches then
  165. flags:=flags or uf_has_browser;
  166. if cs_local_browser in aktmoduleswitches then
  167. flags:=flags or uf_local_browser;
  168. {$endif UseBrowser}
  169. end;
  170. { open ppufile }
  171. current_ppu:=new(pppufile,init(s));
  172. if not current_ppu^.create then
  173. Message(unit_f_ppu_cannot_write);
  174. current_ppu^.change_endian:=source_os.endian<>target_os.endian;
  175. { write symbols and definitions }
  176. unittable^.writeasunit;
  177. { flush to be sure }
  178. current_ppu^.flush;
  179. { create and write header }
  180. current_ppu^.header.size:=current_ppu^.size;
  181. current_ppu^.header.checksum:=current_ppu^.crc;
  182. current_ppu^.header.compiler:=wordversion;
  183. current_ppu^.header.cpu:=word(target_cpu);
  184. current_ppu^.header.target:=word(target_info.target);
  185. current_ppu^.header.flags:=current_module^.flags;
  186. current_ppu^.writeheader;
  187. { save crc in current_module also }
  188. current_module^.crc:=current_ppu^.crc;
  189. { close }
  190. current_ppu^.close;
  191. dispose(current_ppu,done);
  192. end;
  193. {*****************************************************************************
  194. PPU Reading
  195. *****************************************************************************}
  196. function readbyte:byte;
  197. begin
  198. readbyte:=current_ppu^.getbyte;
  199. if current_ppu^.error then
  200. Message(unit_f_ppu_read_error);
  201. end;
  202. function readword:word;
  203. begin
  204. readword:=current_ppu^.getword;
  205. if current_ppu^.error then
  206. Message(unit_f_ppu_read_error);
  207. end;
  208. function readlong:longint;
  209. begin
  210. readlong:=current_ppu^.getlongint;
  211. if current_ppu^.error then
  212. Message(unit_f_ppu_read_error);
  213. end;
  214. function readreal : bestreal;
  215. begin
  216. readreal:=current_ppu^.getreal;
  217. if current_ppu^.error then
  218. Message(unit_f_ppu_read_error);
  219. end;
  220. function readstring : string;
  221. begin
  222. readstring:=current_ppu^.getstring;
  223. if current_ppu^.error then
  224. Message(unit_f_ppu_read_error);
  225. end;
  226. procedure readnormalset(var s); {You cannot pass an array [0..31] of byte.}
  227. begin
  228. current_ppu^.getdata(s,sizeof(tnormalset));
  229. if current_ppu^.error then
  230. Message(unit_f_ppu_read_error);
  231. end;
  232. procedure readcontainer(var p:tstringcontainer);
  233. begin
  234. while not current_ppu^.endofentry do
  235. p.insert(current_ppu^.getstring);
  236. end;
  237. procedure readposinfo(var p:tfileposinfo);
  238. begin
  239. p.fileindex:=current_ppu^.getword;
  240. p.line:=current_ppu^.getlongint;
  241. p.column:=current_ppu^.getword;
  242. end;
  243. function readdefref : pdef;
  244. var
  245. hd : pdef;
  246. begin
  247. longint(hd):=current_ppu^.getword;
  248. longint(hd):=longint(hd) or (longint(current_ppu^.getword) shl 16);
  249. readdefref:=hd;
  250. end;
  251. {$ifdef UseBrowser}
  252. function readsymref : psym;
  253. var
  254. hd : psym;
  255. begin
  256. longint(hd):=current_ppu^.getword;
  257. longint(hd):=longint(hd) or (longint(current_ppu^.getword) shl 16);
  258. readsymref:=hd;
  259. end;
  260. {$endif}
  261. procedure readsourcefiles;
  262. var
  263. temp,hs : string;
  264. incfile_found : boolean;
  265. ppufiletime,
  266. source_time : longint;
  267. {$ifdef UseBrowser}
  268. hp : pinputfile;
  269. {$endif UseBrowser}
  270. begin
  271. ppufiletime:=getnamedfiletime(current_module^.ppufilename^);
  272. current_module^.sources_avail:=true;
  273. while not current_ppu^.endofentry do
  274. begin
  275. hs:=current_ppu^.getstring;
  276. temp:='';
  277. if (current_module^.flags and uf_in_library)<>0 then
  278. begin
  279. current_module^.sources_avail:=false;
  280. temp:=' library';
  281. end
  282. else if pos('Macro ',hs)=1 then
  283. begin
  284. { we don't want to find this file }
  285. { but there is a problem with file indexing !! }
  286. temp:='';
  287. end
  288. else
  289. begin
  290. { check the date of the source files }
  291. Source_Time:=GetNamedFileTime(current_module^.path^+hs);
  292. { search for include files in the includepathlist, this
  293. can't be done, becuase a .inc file with the same name as
  294. used by a unit will cause the unit to recompile which is
  295. not the intention (PFV) }
  296. { OK but then only the last filename
  297. should not be searched in include files (PM)}
  298. if (Source_Time=-1) and not current_ppu^.endofentry then
  299. begin
  300. temp:=search(hs,includesearchpath,incfile_found);
  301. if incfile_found then
  302. begin
  303. hs:=temp+hs;
  304. Source_Time:=GetNamedFileTime(hs);
  305. end;
  306. end
  307. else
  308. hs:=current_module^.path^+hs;
  309. if Source_Time=-1 then
  310. begin
  311. current_module^.sources_avail:=false;
  312. temp:=' not found';
  313. end
  314. else
  315. begin
  316. temp:=' time '+filetimestring(source_time);
  317. if (source_time>ppufiletime) then
  318. begin
  319. current_module^.do_compile:=true;
  320. temp:=temp+' *'
  321. end;
  322. end;
  323. {$ifdef UseBrowser}
  324. new(hp,init(hs));
  325. { the indexing is wrong here PM }
  326. current_module^.sourcefiles^.register_file(hp);
  327. {$endif UseBrowser}
  328. end;
  329. Message1(unit_u_ppu_source,hs+temp);
  330. end;
  331. { main source is always the last }
  332. stringdispose(current_module^.mainsource);
  333. current_module^.mainsource:=stringdup(hs);
  334. { the indexing is corrected here PM }
  335. current_module^.sourcefiles^.inverse_register_indexes;
  336. { check if we want to rebuild every unit, only if the sources are
  337. available }
  338. if do_build and current_module^.sources_avail then
  339. current_module^.do_compile:=true;
  340. end;
  341. procedure readloadunit;
  342. var
  343. hs : string;
  344. checksum : longint;
  345. in_interface : boolean;
  346. begin
  347. while not current_ppu^.endofentry do
  348. begin
  349. hs:=current_ppu^.getstring;
  350. checksum:=current_ppu^.getlongint;
  351. in_interface:=(current_ppu^.getbyte<>0);
  352. current_module^.used_units.concat(new(pused_unit,init_to_load(hs,checksum,in_interface)));
  353. end;
  354. end;
  355. procedure load_interface;
  356. var
  357. b : byte;
  358. begin
  359. { read interface part }
  360. repeat
  361. b:=current_ppu^.readentry;
  362. case b of
  363. { ibinitunit : usedunits^.insert(readstring); }
  364. ibmodulename : begin
  365. stringdispose(current_module^.modulename);
  366. current_module^.modulename:=stringdup(current_ppu^.getstring);
  367. end;
  368. ibsourcefiles : readsourcefiles;
  369. ibloadunit_int : readloadunit;
  370. iblinksharedlibs : readcontainer(current_module^.LinkSharedLibs);
  371. iblinkstaticlibs : readcontainer(current_module^.LinkStaticLibs);
  372. iblinkofiles : readcontainer(current_module^.LinkOFiles);
  373. ibendinterface : break;
  374. else
  375. Message1(unit_f_ppu_invalid_entry,tostr(b));
  376. end;
  377. until false;
  378. end;
  379. {
  380. $Log$
  381. Revision 1.21 1998-10-14 10:45:10 pierre
  382. * ppu problems for m68k fixed (at least in cross compiling)
  383. * one last memory leak for sysamiga fixed
  384. * the amiga RTL compiles now completely !!
  385. Revision 1.20 1998/10/13 13:10:30 peter
  386. * new style for m68k/i386 infos and enums
  387. Revision 1.19 1998/10/08 23:29:07 peter
  388. * -vu shows unit info, -vt shows tried/used files
  389. Revision 1.18 1998/09/28 16:57:27 pierre
  390. * changed all length(p^.value_str^) into str_length(p)
  391. to get it work with and without ansistrings
  392. * changed sourcefiles field of tmodule to a pointer
  393. Revision 1.17 1998/09/22 17:13:53 pierre
  394. + browsing updated and developed
  395. records and objects fields are also stored
  396. Revision 1.16 1998/09/22 15:40:56 peter
  397. * some extra ifdef GDB
  398. Revision 1.15 1998/09/21 08:45:23 pierre
  399. + added vmt_offset in tobjectdef.write for fututre use
  400. (first steps to have objects without vmt if no virtual !!)
  401. + added fpu_used field for tabstractprocdef :
  402. sets this level to 2 if the functions return with value in FPU
  403. (is then set to correct value at parsing of implementation)
  404. THIS MIGHT refuse some code with FPU expression too complex
  405. that were accepted before and even in some cases
  406. that don't overflow in fact
  407. ( like if f : float; is a forward that finally in implementation
  408. only uses one fpu register !!)
  409. Nevertheless I think that it will improve security on
  410. FPU operations !!
  411. * most other changes only for UseBrowser code
  412. (added symtable references for record and objects)
  413. local switch for refs to args and local of each function
  414. (static symtable still missing)
  415. UseBrowser still not stable and probably broken by
  416. the definition hash array !!
  417. Revision 1.14 1998/09/01 07:54:24 pierre
  418. * UseBrowser a little updated (might still be buggy !!)
  419. * bug in psub.pas in function specifier removed
  420. * stdcall allowed in interface and in implementation
  421. (FPC will not yet complain if it is missing in either part
  422. because stdcall is only a dummy !!)
  423. Revision 1.13 1998/08/17 10:10:11 peter
  424. - removed OLDPPU
  425. Revision 1.12 1998/08/17 09:17:53 peter
  426. * static/shared linking updates
  427. Revision 1.11 1998/08/16 20:32:49 peter
  428. * crcs of used units are not important for the current crc, reduces the
  429. amount of recompiles
  430. Revision 1.10 1998/08/13 10:57:30 peter
  431. * constant sets are now written correctly to the ppufile
  432. Revision 1.9 1998/08/11 15:31:41 peter
  433. * write extended to ppu file
  434. * new version 0.99.7
  435. Revision 1.8 1998/08/10 14:50:29 peter
  436. + localswitches, moduleswitches, globalswitches splitting
  437. Revision 1.7 1998/07/14 14:47:07 peter
  438. * released NEWINPUT
  439. Revision 1.6 1998/07/07 11:20:14 peter
  440. + NEWINPUT for a better inputfile and scanner object
  441. Revision 1.5 1998/06/24 14:48:39 peter
  442. * ifdef newppu -> ifndef oldppu
  443. Revision 1.4 1998/06/16 08:56:32 peter
  444. + targetcpu
  445. * cleaner pmodules for newppu
  446. Revision 1.3 1998/06/13 00:10:17 peter
  447. * working browser and newppu
  448. * some small fixes against crashes which occured in bp7 (but not in
  449. fpc?!)
  450. Revision 1.2 1998/05/28 14:40:28 peter
  451. * fixes for newppu, remake3 works now with it
  452. Revision 1.1 1998/05/27 19:45:09 peter
  453. * symtable.pas splitted into includefiles
  454. * symtable adapted for $ifdef NEWPPU
  455. }