globals.pas 49 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811
  1. {
  2. $Id$
  3. Copyright (C) 1993-98 by Florian Klaempfl
  4. This unit implements some support functions and global variables
  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. {$ifdef tp}
  19. {$E+,N+}
  20. {$endif}
  21. unit globals;
  22. interface
  23. uses
  24. {$ifdef Delphi4}
  25. dmisc,
  26. sysutils,
  27. {$else}
  28. strings,dos,
  29. {$endif}
  30. {$ifdef linux}
  31. {$ifdef TP}
  32. objects,
  33. {$endif}
  34. linux,
  35. {$endif}
  36. globtype,version,tokens,systems,cobjects;
  37. const
  38. {$ifdef linux}
  39. DirSep = '/';
  40. {$else}
  41. {$ifdef amiga}
  42. DirSep = '/';
  43. {$else}
  44. DirSep = '\';
  45. {$endif}
  46. {$endif}
  47. {$ifdef Splitheap}
  48. testsplit : boolean = false;
  49. {$endif Splitheap}
  50. delphimodeswitches : tmodeswitches=
  51. [m_delphi,m_tp,m_all,m_class,m_objpas,m_result,m_string_pchar,
  52. m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal];
  53. fpcmodeswitches : tmodeswitches=
  54. [m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward,
  55. m_cvar_support,m_initfinal];
  56. objfpcmodeswitches : tmodeswitches=
  57. [m_fpc,m_all,m_class,m_objpas,m_result,m_string_pchar,m_nested_comment,
  58. m_repeat_forward,m_cvar_support,m_initfinal];
  59. tpmodeswitches : tmodeswitches=
  60. [m_tp,m_all,m_tp_procvar];
  61. gpcmodeswitches : tmodeswitches=
  62. [m_gpc,m_all];
  63. var
  64. { specified inputfile }
  65. inputdir : dirstr;
  66. inputfile : namestr;
  67. inputextension : extstr;
  68. { specified outputfile with -o parameter }
  69. outputfile : namestr;
  70. { specified with -FE or -FU }
  71. outputexedir : dirstr;
  72. outputunitdir : dirstr;
  73. { things specified with parameters }
  74. paralinkoptions,
  75. paradynamiclinker : string;
  76. { directory where the utils can be found (options -FD) }
  77. utilsdirectory : dirstr;
  78. { some flags for global compiler switches }
  79. do_build,
  80. do_make : boolean;
  81. not_unit_proc : boolean;
  82. { path for searching units, different paths can be seperated by ; }
  83. exepath : dirstr; { Path to ppc }
  84. librarysearchpath,
  85. unitsearchpath,
  86. objectsearchpath,
  87. includesearchpath : string;
  88. { deffile }
  89. usewindowapi : boolean;
  90. description : string;
  91. { current position }
  92. token, { current token being parsed }
  93. idtoken : ttoken; { holds the token if the pattern is a known word }
  94. tokenpos, { last postion of the read token }
  95. aktfilepos : tfileposinfo; { current position }
  96. { type of currently parsed block }
  97. { isn't full implemented (FK) }
  98. block_type : tblock_type;
  99. in_args : boolean; { arguments must be checked especially }
  100. parsing_para_level : longint; { parameter level, used to convert
  101. proc calls to proc loads in firstcalln }
  102. Must_be_valid : boolean; { should the variable already have a value }
  103. compile_level : word;
  104. make_ref : boolean;
  105. use_esp_stackframe : boolean; { to test for call with ESP as stack frame }
  106. {$ifdef TP}
  107. use_big : boolean;
  108. {$endif}
  109. { commandline values }
  110. initdefines : tlinkedlist;
  111. initglobalswitches : tglobalswitches;
  112. initmoduleswitches : tmoduleswitches;
  113. initlocalswitches : tlocalswitches;
  114. initmodeswitches : tmodeswitches;
  115. initpackenum : longint;
  116. initpackrecords : tpackrecords;
  117. initoutputformat : tasm;
  118. initoptprocessor : tprocessors;
  119. initasmmode : tasmmode;
  120. { current state values }
  121. aktglobalswitches : tglobalswitches;
  122. aktmoduleswitches : tmoduleswitches;
  123. aktlocalswitches : tlocalswitches;
  124. aktmodeswitches : tmodeswitches;
  125. aktpackenum : longint;
  126. aktpackrecords : tpackrecords;
  127. aktoutputformat : tasm;
  128. aktoptprocessor : tprocessors;
  129. aktasmmode : tasmmode;
  130. { Memory sizes }
  131. heapsize,
  132. maxheapsize,
  133. stacksize : longint;
  134. {$Ifdef EXTDEBUG}
  135. total_of_firstpass,
  136. firstpass_several : longint;
  137. {$ifdef FPC}
  138. EntryMemUsed : longint;
  139. {$endif FPC}
  140. { parameter switches }
  141. debugstop,
  142. only_one_pass : boolean;
  143. {$EndIf EXTDEBUG}
  144. { windows application type }
  145. apptype : tapptype;
  146. const
  147. RelocSection : boolean = true;
  148. DLLsource : boolean = false;
  149. DLLImageBase : pstring = nil;
  150. { used to set all registers used for each global function
  151. this should dramatically decrease the number of
  152. recompilations needed PM }
  153. simplify_ppu : boolean = false;
  154. { should we allow non static members ? }
  155. allow_only_static : boolean = false;
  156. Inside_asm_statement : boolean = false;
  157. { for error info in pp.pas }
  158. const
  159. parser_current_file : string = '';
  160. {$ifdef debug}
  161. { if the pointer don't point to the heap then write an error }
  162. function assigned(p : pointer) : boolean;
  163. {$endif}
  164. function min(a,b : longint) : longint;
  165. function max(a,b : longint) : longint;
  166. function align(i,a:longint):longint;
  167. procedure Replace(var s:string;s1:string;const s2:string);
  168. procedure ReplaceCase(var s:string;const s1,s2:string);
  169. function upper(const s : string) : string;
  170. function lower(const s : string) : string;
  171. function trimspace(const s:string):string;
  172. {$ifdef FPC}
  173. function tostru(i:cardinal) : string;
  174. {$else}
  175. function tostru(i:longint) : string;
  176. {$endif}
  177. procedure uppervar(var s : string);
  178. function tostr(i : longint) : string;
  179. function tostr_with_plus(i : longint) : string;
  180. procedure valint(S : string;var V : longint;var code : integer);
  181. function is_number(const s : string) : boolean;
  182. function ispowerof2(value : longint;var power : longint) : boolean;
  183. { enable ansistring comparison }
  184. function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint;
  185. function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
  186. function bstoslash(const s : string) : string;
  187. procedure abstract;
  188. function getdatestr:string;
  189. function gettimestr:string;
  190. function filetimestring( t : longint) : string;
  191. procedure DefaultReplacements(var s:string);
  192. function path_absolute(const s : string) : boolean;
  193. Function FileExists ( Const F : String) : Boolean;
  194. Function RemoveFile(const f:string):boolean;
  195. Function RemoveDir(d:string):boolean;
  196. Function GetFileTime ( Var F : File) : Longint;
  197. Function GetNamedFileTime ( Const F : String) : Longint;
  198. Function SplitFileName(const s:string):string;
  199. Function SplitName(const s:string):string;
  200. Function SplitExtension(Const HStr:String):String;
  201. Function AddExtension(Const HStr,ext:String):String;
  202. Function ForceExtension(Const HStr,ext:String):String;
  203. Function FixPath(s:string;allowdot:boolean):string;
  204. function FixFileName(const s:string):string;
  205. procedure AddPathToList(var list:string;s:string;first:boolean);
  206. function search(const f : string;path : string;var b : boolean) : string;
  207. procedure SynchronizeFileTime(const fn1,fn2:string);
  208. function FindExe(bin:string;var found:boolean):string;
  209. procedure InitGlobals;
  210. procedure DoneGlobals;
  211. procedure strdispose(var p : pchar);
  212. implementation
  213. uses
  214. comphook;
  215. procedure strdispose(var p : pchar);
  216. begin
  217. if assigned(p) then
  218. begin
  219. freemem(p,strlen(p)+1);
  220. p:=nil;
  221. end;
  222. end;
  223. function ngraphsearchvalue(const s1,s2 : string) : double;
  224. const
  225. n = 3;
  226. var
  227. equals,i,j : longint;
  228. hs : string;
  229. begin
  230. equals:=0;
  231. { is the string long enough ? }
  232. if min(length(s1),length(s2))-n+1<1 then
  233. begin
  234. ngraphsearchvalue:=0.0;
  235. exit;
  236. end;
  237. for i:=1 to length(s1)-n+1 do
  238. begin
  239. hs:=copy(s1,i,n);
  240. for j:=1 to length(s2)-n+1 do
  241. if hs=copy(s2,j,n) then
  242. inc(equals);
  243. end;
  244. {$ifdef fpc}
  245. ngraphsearchvalue:=equals/double(max(length(s1),length(s2))-n+1);
  246. {$else}
  247. ngraphsearchvalue:=equals/(max(length(s1),length(s2))-n+1);
  248. {$endif}
  249. end;
  250. function bstoslash(const s : string) : string;
  251. {
  252. return string s with all \ changed into /
  253. }
  254. var
  255. i : longint;
  256. begin
  257. for i:=1to length(s) do
  258. if s[i]='\' then
  259. bstoslash[i]:='/'
  260. else
  261. bstoslash[i]:=s[i];
  262. {$ifndef TP}
  263. {$ifopt H+}
  264. setlength(bstoslash,length(s));
  265. {$else}
  266. bstoslash[0]:=s[0];
  267. {$endif}
  268. {$else}
  269. bstoslash[0]:=s[0];
  270. {$endif}
  271. end;
  272. {$ifdef debug}
  273. function assigned(p : pointer) : boolean;
  274. {$ifndef FPC}
  275. {$ifndef DPMI}
  276. var
  277. lp : longint;
  278. {$endif DPMI}
  279. {$endif FPC}
  280. begin
  281. {$ifdef FPC}
  282. { Assigned is used for procvar and
  283. stack stored temp records !! PM }
  284. (* if (p<>nil) {and
  285. ((p<heaporg) or
  286. (p>heapptr))} then
  287. do_internalerror(230); *)
  288. {$else}
  289. {$ifdef DPMI}
  290. assigned:=(p<>nil);
  291. exit;
  292. {$else DPMI}
  293. if p=nil then
  294. lp:=0
  295. else
  296. lp:=longint(ptrrec(p).seg)*16+longint(ptrrec(p).ofs);
  297. if (lp<>0) and
  298. ((lp<longint(seg(heaporg^))*16+longint(ofs(heaporg^))) or
  299. (lp>longint(seg(heapptr^))*16+longint(ofs(heapptr^)))) then
  300. do_internalerror(230);
  301. {$endif DPMI}
  302. {$endif FPC}
  303. assigned:=(p<>nil);
  304. end;
  305. {$endif}
  306. function min(a,b : longint) : longint;
  307. {
  308. return the minimal of a and b
  309. }
  310. begin
  311. if a>b then
  312. min:=b
  313. else
  314. min:=a;
  315. end;
  316. function max(a,b : longint) : longint;
  317. {
  318. return the maximum of a and b
  319. }
  320. begin
  321. if a<b then
  322. max:=b
  323. else
  324. max:=a;
  325. end;
  326. function align(i,a:longint):longint;
  327. {
  328. return value <i> aligned <a> boundary
  329. }
  330. begin
  331. align:=(i+a-1) and not(a-1);
  332. end;
  333. procedure Replace(var s:string;s1:string;const s2:string);
  334. var
  335. last,
  336. i : longint;
  337. begin
  338. s1:=upper(s1);
  339. last:=0;
  340. repeat
  341. i:=pos(s1,upper(s));
  342. if i=last then
  343. i:=0;
  344. if (i>0) then
  345. begin
  346. Delete(s,i,length(s1));
  347. Insert(s2,s,i);
  348. last:=i;
  349. end;
  350. until (i=0);
  351. end;
  352. procedure ReplaceCase(var s:string;const s1,s2:string);
  353. var
  354. last,
  355. i : longint;
  356. begin
  357. last:=0;
  358. repeat
  359. i:=pos(s1,s);
  360. if i=last then
  361. i:=0;
  362. if (i>0) then
  363. begin
  364. Delete(s,i,length(s1));
  365. Insert(s2,s,i);
  366. last:=i;
  367. end;
  368. until (i=0);
  369. end;
  370. function upper(const s : string) : string;
  371. {
  372. return uppercased string of s
  373. }
  374. var
  375. i : longint;
  376. begin
  377. for i:=1 to length(s) do
  378. if s[i] in ['a'..'z'] then
  379. upper[i]:=char(byte(s[i])-32)
  380. else
  381. upper[i]:=s[i];
  382. {$ifdef FPC}
  383. {$ifopt H+}
  384. setlength(upper,length(s));
  385. {$else}
  386. upper[0]:=s[0];
  387. {$endif}
  388. {$else}
  389. upper[0]:=s[0];
  390. {$endif}
  391. end;
  392. function lower(const s : string) : string;
  393. {
  394. return lowercased string of s
  395. }
  396. var
  397. i : longint;
  398. begin
  399. for i:=1 to length(s) do
  400. if s[i] in ['A'..'Z'] then
  401. lower[i]:=char(byte(s[i])+32)
  402. else
  403. lower[i]:=s[i];
  404. {$ifndef TP}
  405. {$ifopt H+}
  406. setlength(lower,length(s));
  407. {$else}
  408. lower[0]:=s[0];
  409. {$endif}
  410. {$else}
  411. lower[0]:=s[0];
  412. {$endif}
  413. end;
  414. procedure uppervar(var s : string);
  415. {
  416. uppercase string s
  417. }
  418. var
  419. i : longint;
  420. begin
  421. for i:=1 to length(s) do
  422. if s[i] in ['a'..'z'] then
  423. s[i]:=char(byte(s[i])-32);
  424. end;
  425. {$ifdef FPC}
  426. function tostru(i:cardinal):string;
  427. {
  428. return string of value i, but for cardinals
  429. }
  430. var hs:string;
  431. begin
  432. str(i,hs);
  433. tostru:=hs;
  434. end;
  435. {$else FPC}
  436. function tostru(i:longint):string;
  437. begin
  438. tostru:=tostr(i);
  439. end;
  440. {$endif FPC}
  441. function trimspace(const s:string):string;
  442. {
  443. return s with all leading and ending spaces and tabs removed
  444. }
  445. var
  446. i,j : longint;
  447. begin
  448. i:=length(s);
  449. while (i>0) and (s[i] in [#9,' ']) do
  450. dec(i);
  451. j:=1;
  452. while (j<i) and (s[j] in [#9,' ']) do
  453. inc(j);
  454. trimspace:=Copy(s,j,i-j+1);
  455. end;
  456. function tostr(i : longint) : string;
  457. {
  458. return string of value i
  459. }
  460. var
  461. hs : string;
  462. begin
  463. str(i,hs);
  464. tostr:=hs;
  465. end;
  466. function tostr_with_plus(i : longint) : string;
  467. {
  468. return string of value i, but always include a + when i>=0
  469. }
  470. var
  471. hs : string;
  472. begin
  473. str(i,hs);
  474. if i>=0 then
  475. tostr_with_plus:='+'+hs
  476. else
  477. tostr_with_plus:=hs;
  478. end;
  479. procedure valint(S : string;var V : longint;var code : integer);
  480. {
  481. val() with support for octal, which is not supported under tp7
  482. }
  483. {$ifndef FPC}
  484. var
  485. vs : longint;
  486. c : byte;
  487. begin
  488. if s[1]='%' then
  489. begin
  490. vs:=0;
  491. longint(v):=0;
  492. for c:=2 to length(s) do
  493. begin
  494. if s[c]='0' then
  495. vs:=vs shl 1
  496. else
  497. if s[c]='1' then
  498. vs:=vs shl 1+1
  499. else
  500. begin
  501. code:=c;
  502. exit;
  503. end;
  504. end;
  505. code:=0;
  506. longint(v):=vs;
  507. end
  508. else
  509. system.val(S,V,code);
  510. end;
  511. {$else not FPC}
  512. begin
  513. system.val(S,V,code);
  514. end;
  515. {$endif not FPC}
  516. function is_number(const s : string) : boolean;
  517. {
  518. is string a correct number ?
  519. }
  520. var
  521. w : integer;
  522. l : longint;
  523. begin
  524. valint(s,l,w);
  525. is_number:=(w=0);
  526. end;
  527. function ispowerof2(value : longint;var power : longint) : boolean;
  528. {
  529. return if value is a power of 2. And if correct return the power
  530. }
  531. var
  532. hl : longint;
  533. i : longint;
  534. begin
  535. hl:=1;
  536. ispowerof2:=true;
  537. for i:=0 to 31 do
  538. begin
  539. if hl=value then
  540. begin
  541. power:=i;
  542. exit;
  543. end;
  544. hl:=hl shl 1;
  545. end;
  546. ispowerof2:=false;
  547. end;
  548. { enable ansistring comparison }
  549. { 0 means equal }
  550. { 1 means p1 > p2 }
  551. { -1 means p1 < p2 }
  552. function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint;
  553. var
  554. i,j : longint;
  555. begin
  556. compareansistrings:=0;
  557. j:=min(length1,length2);
  558. i:=0;
  559. while (i<j) do
  560. begin
  561. if p1[i]>p2[i] then
  562. begin
  563. compareansistrings:=1;
  564. exit;
  565. end
  566. else
  567. if p1[i]<p2[i] then
  568. begin
  569. compareansistrings:=-1;
  570. exit;
  571. end;
  572. inc(i);
  573. end;
  574. if length1>length2 then
  575. compareansistrings:=1
  576. else
  577. if length1<length2 then
  578. compareansistrings:=-1;
  579. end;
  580. function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
  581. var
  582. p : pchar;
  583. begin
  584. getmem(p,length1+length2+1);
  585. move(p1[0],p[0],length1);
  586. move(p2[0],p[length1],length2+1);
  587. concatansistrings:=p;
  588. end;
  589. {****************************************************************************
  590. Time Handling
  591. ****************************************************************************}
  592. Function L0(l:longint):string;
  593. {
  594. return the string of value l, if l<10 then insert a zero, so
  595. the string is always at least 2 chars '01','02',etc
  596. }
  597. var
  598. s : string;
  599. begin
  600. Str(l,s);
  601. if l<10 then
  602. s:='0'+s;
  603. L0:=s;
  604. end;
  605. function gettimestr:string;
  606. {
  607. get the current time in a string HH:MM:SS
  608. }
  609. var
  610. hour,min,sec,hsec : word;
  611. begin
  612. {$ifdef delphi}
  613. dmisc.gettime(hour,min,sec,hsec);
  614. {$else delphi}
  615. dos.gettime(hour,min,sec,hsec);
  616. {$endif delphi}
  617. gettimestr:=L0(Hour)+':'+L0(min)+':'+L0(sec);
  618. end;
  619. function getdatestr:string;
  620. {
  621. get the current date in a string YY/MM/DD
  622. }
  623. var
  624. Year,Month,Day,Wday : Word;
  625. begin
  626. {$ifdef delphi}
  627. dmisc.getdate(year,month,day,wday);
  628. {$else}
  629. dos.getdate(year,month,day,wday);
  630. {$endif}
  631. getdatestr:=L0(Year)+'/'+L0(Month)+'/'+L0(Day);
  632. end;
  633. function filetimestring( t : longint) : string;
  634. {
  635. convert dos datetime t to a string YY/MM/DD HH:MM:SS
  636. }
  637. var
  638. {$ifndef linux}
  639. DT : DateTime;
  640. {$endif}
  641. Year,Month,Day,Hour,Min,Sec : Word;
  642. begin
  643. if t=-1 then
  644. begin
  645. FileTimeString:='Not Found';
  646. exit;
  647. end;
  648. {$ifndef linux}
  649. unpacktime(t,DT);
  650. Year:=dT.year;month:=dt.month;day:=dt.day;
  651. Hour:=dt.hour;min:=dt.min;sec:=dt.sec;
  652. {$else}
  653. EpochToLocal (t,year,month,day,hour,min,sec);
  654. {$endif}
  655. filetimestring:=L0(Year)+'/'+L0(Month)+'/'+L0(Day)+' '+L0(Hour)+':'+L0(min)+':'+L0(sec);
  656. end;
  657. {****************************************************************************
  658. Default Macro Handling
  659. ****************************************************************************}
  660. procedure DefaultReplacements(var s:string);
  661. begin
  662. { Replace some macro's }
  663. Replace(s,'$FPCVER',full_version_string);
  664. Replace(s,'$FPCDATE',date_string);
  665. Replace(s,'$FPCTARGET',target_cpu_string);
  666. Replace(s,'$FPCCPU',target_cpu_string);
  667. Replace(s,'$TARGET',target_path);
  668. Replace(s,'$FPCOS',target_path);
  669. end;
  670. {****************************************************************************
  671. File Handling
  672. ****************************************************************************}
  673. function path_absolute(const s : string) : boolean;
  674. {
  675. is path s an absolute path?
  676. }
  677. begin
  678. path_absolute:=false;
  679. {$ifdef linux}
  680. if (length(s)>0) and (s[1]='/') then
  681. path_absolute:=true;
  682. {$else linux}
  683. {$ifdef amiga}
  684. if ((length(s)>0) and ((s[1]='\') or (s[1]='/'))) or (Pos(':',s) = length(s)) then
  685. path_absolute:=true;
  686. {$else}
  687. if ((length(s)>0) and ((s[1]='\') or (s[1]='/'))) or
  688. ((length(s)>2) and (s[2]=':') and ((s[3]='\') or (s[3]='/'))) then
  689. path_absolute:=true;
  690. {$endif amiga}
  691. {$endif linux}
  692. end;
  693. {$ifndef FPC}
  694. Procedure FindClose(var Info : SearchRec);
  695. Begin
  696. End;
  697. {$endif not FPC}
  698. {$ifdef delphi}
  699. Function FileExists ( Const F : String) : Boolean;
  700. begin
  701. FileExists:=sysutils.FileExists(f);
  702. end;
  703. {$else}
  704. Function FileExists ( Const F : String) : Boolean;
  705. Var
  706. {$ifdef linux}
  707. Info : Stat;
  708. {$else}
  709. Info : SearchRec;
  710. {$endif}
  711. begin
  712. {$ifdef linux}
  713. FileExists:=FStat(F,info);
  714. {$else}
  715. findfirst(F,readonly+archive+hidden,info);
  716. FileExists:=(doserror=0);
  717. findclose(Info);
  718. {$endif}
  719. end;
  720. {$endif}
  721. Function RemoveFile(const f:string):boolean;
  722. var
  723. g : file;
  724. begin
  725. assign(g,f);
  726. {$I-}
  727. erase(g);
  728. {$I+}
  729. RemoveFile:=(ioresult=0);
  730. end;
  731. Function RemoveDir(d:string):boolean;
  732. begin
  733. if d[length(d)]=DirSep then
  734. Delete(d,length(d),1);
  735. {$I-}
  736. rmdir(d);
  737. {$I+}
  738. RemoveDir:=(ioresult=0);
  739. end;
  740. Function SplitFileName(const s:string):string;
  741. var
  742. p : dirstr;
  743. n : namestr;
  744. e : extstr;
  745. begin
  746. FSplit(s,p,n,e);
  747. SplitFileName:=n+e;
  748. end;
  749. Function SplitName(const s:string):string;
  750. var
  751. i,j : longint;
  752. begin
  753. i:=Length(s);
  754. j:=Length(s);
  755. while (i>0) and not(s[i] in ['/','\']) do
  756. dec(i);
  757. while (j>0) and (s[j]<>'.') do
  758. dec(j);
  759. if j<=i then
  760. j:=255;
  761. SplitName:=Copy(s,i+1,j-(i+1));
  762. end;
  763. Function SplitExtension(Const HStr:String):String;
  764. var
  765. j : longint;
  766. begin
  767. j:=length(Hstr);
  768. while (j>0) and (Hstr[j]<>'.') do
  769. begin
  770. if hstr[j]=DirSep then
  771. j:=0
  772. else
  773. dec(j);
  774. end;
  775. if j=0 then
  776. j:=254;
  777. SplitExtension:=Copy(Hstr,j,255);
  778. end;
  779. Function AddExtension(Const HStr,ext:String):String;
  780. begin
  781. if (Ext<>'') and (SplitExtension(HStr)='') then
  782. AddExtension:=Hstr+Ext
  783. else
  784. AddExtension:=Hstr;
  785. end;
  786. Function ForceExtension(Const HStr,ext:String):String;
  787. var
  788. j : longint;
  789. begin
  790. j:=length(Hstr);
  791. while (j>0) and (Hstr[j]<>'.') do
  792. dec(j);
  793. if j=0 then
  794. j:=255;
  795. ForceExtension:=Copy(Hstr,1,j-1)+Ext;
  796. end;
  797. Function FixPath(s:string;allowdot:boolean):string;
  798. var
  799. i : longint;
  800. begin
  801. { Fix separator }
  802. for i:=1 to length(s) do
  803. if s[i] in ['/','\'] then
  804. s[i]:=DirSep;
  805. { Fix ending / }
  806. if (length(s)>0) and (s[length(s)]<>DirSep) and
  807. (s[length(s)]<>':') then
  808. s:=s+DirSep;
  809. { Remove ./ }
  810. if (not allowdot) and (s='.'+DirSep) then
  811. s:='';
  812. { return }
  813. FixPath:=s;
  814. end;
  815. function FixFileName(const s:string):string;
  816. var
  817. i : longint;
  818. NoPath : boolean;
  819. begin
  820. NoPath:=true;
  821. for i:=length(s) downto 1 do
  822. begin
  823. case s[i] of
  824. {$ifdef Linux}
  825. '/','\' : begin
  826. FixFileName[i]:='/';
  827. NoPath:=false; {Skip lowercasing path: 'X11'<>'x11' }
  828. end;
  829. 'A'..'Z' : if NoPath then
  830. FixFileName[i]:=char(byte(s[i])+32)
  831. else
  832. FixFileName[i]:=s[i];
  833. {$else}
  834. '/' : FixFileName[i]:='\';
  835. 'A'..'Z' : FixFileName[i]:=char(byte(s[i])+32);
  836. {$endif}
  837. else
  838. FixFileName[i]:=s[i];
  839. end;
  840. end;
  841. {$ifndef TP}
  842. {$ifopt H+}
  843. SetLength(FixFileName,length(s));
  844. {$else}
  845. FixFileName[0]:=s[0];
  846. {$endif}
  847. {$else}
  848. FixFileName[0]:=s[0];
  849. {$endif}
  850. end;
  851. procedure AddPathToList(var list:string;s:string;first:boolean);
  852. var
  853. LastAdd,
  854. starti,i,j : longint;
  855. Found : boolean;
  856. CurrentDir,
  857. CurrPath,
  858. AddList : string;
  859. begin
  860. if s='' then
  861. exit;
  862. { Support default macro's }
  863. DefaultReplacements(s);
  864. { Fix List }
  865. if (length(list)>0) and (list[length(list)]<>';') then
  866. list:=list+';';
  867. GetDir(0,CurrentDir);
  868. CurrentDir:=FixPath(CurrentDir,false);
  869. AddList:='';
  870. LastAdd:=1;
  871. repeat
  872. j:=Pos(';',s);
  873. if j=0 then
  874. j:=255;
  875. {Get Pathname}
  876. CurrPath:=FixPath(Copy(s,1,j-1),false);
  877. if CurrPath='' then
  878. CurrPath:='.'+DirSep+';'
  879. else
  880. begin
  881. CurrPath:=FixPath(FExpand(CurrPath),false)+';';
  882. if (Copy(CurrPath,1,length(CurrentDir))=CurrentDir) then
  883. CurrPath:='.'+DirSep+Copy(CurrPath,length(CurrentDir)+1,255);
  884. end;
  885. Delete(s,1,j);
  886. {Check if already in path}
  887. found:=false;
  888. i:=0;
  889. starti:=1;
  890. while (not found) and (i<length(list)) do
  891. begin
  892. inc(i);
  893. if (list[i]=';') then
  894. begin
  895. found:=(CurrPath=Copy(List,starti,i-starti+1));
  896. if Found then
  897. begin
  898. if First then
  899. Delete(List,Starti,i-starti+1); {The new entry is placed first}
  900. end
  901. else
  902. starti:=i+1;
  903. end;
  904. end;
  905. if First then
  906. begin
  907. Insert(CurrPath,List,LastAdd);
  908. inc(LastAdd,Length(CurrPath));
  909. end
  910. else
  911. if not Found then
  912. List:=List+CurrPath
  913. until (s='');
  914. end;
  915. function search(const f : string;path : string;var b : boolean) : string;
  916. Var
  917. singlepathstring : string;
  918. i : longint;
  919. begin
  920. {$ifdef linux}
  921. for i:=1 to length(path) do
  922. if path[i]=':' then
  923. path[i]:=';';
  924. {$endif}
  925. b:=false;
  926. search:='';
  927. repeat
  928. i:=pos(';',path);
  929. if i=0 then
  930. i:=255;
  931. singlepathstring:=FixPath(copy(path,1,i-1),false);
  932. delete(path,1,i);
  933. If FileExists (singlepathstring+f) then
  934. begin
  935. Search:=singlepathstring;
  936. b:=true;
  937. exit;
  938. end;
  939. until path='';
  940. end;
  941. Function GetFileTime ( Var F : File) : Longint;
  942. Var
  943. {$ifdef linux}
  944. Info : Stat;
  945. {$endif}
  946. L : longint;
  947. begin
  948. {$ifdef linux}
  949. FStat (F,Info);
  950. L:=Info.Mtime;
  951. {$else}
  952. GetFTime(f,l);
  953. {$endif}
  954. GetFileTime:=L;
  955. end;
  956. Function GetNamedFileTime (Const F : String) : Longint;
  957. var
  958. L : Longint;
  959. {$ifndef linux}
  960. info : SearchRec;
  961. {$else}
  962. info : stat;
  963. {$endif}
  964. begin
  965. l:=-1;
  966. {$ifdef linux}
  967. if FStat (F,Info) then
  968. L:=info.mtime;
  969. {$else}
  970. {$ifdef delphi}
  971. dmisc.FindFirst (F,archive+readonly+hidden,info);
  972. {$else delphi}
  973. FindFirst (F,archive+readonly+hidden,info);
  974. {$endif delphi}
  975. if DosError=0 then
  976. l:=info.time;
  977. {$ifdef Linux}
  978. FindClose(info);
  979. {$endif}
  980. {$ifdef Win32}
  981. FindClose(info);
  982. {$endif}
  983. {$endif}
  984. GetNamedFileTime:=l;
  985. end;
  986. {Touch Assembler and object time to ppu time is there is a ppufilename}
  987. procedure SynchronizeFileTime(const fn1,fn2:string);
  988. var
  989. f : file;
  990. l : longint;
  991. begin
  992. Assign(f,fn1);
  993. {$I-}
  994. reset(f,1);
  995. {$I+}
  996. if ioresult=0 then
  997. begin
  998. getftime(f,l);
  999. close(f);
  1000. assign(f,fn2);
  1001. {$I-}
  1002. reset(f,1);
  1003. {$I+}
  1004. if ioresult=0 then
  1005. begin
  1006. setftime(f,l);
  1007. close(f);
  1008. end;
  1009. end;
  1010. end;
  1011. function FindExe(bin:string;var found:boolean):string;
  1012. begin
  1013. bin:=FixFileName(bin)+source_os.exeext;
  1014. {$ifdef delphi}
  1015. FindExe:=Search(bin,'.;'+exepath+';'+dmisc.getenv('PATH'),found)+bin;
  1016. {$else delphi}
  1017. FindExe:=Search(bin,'.;'+exepath+';'+dos.getenv('PATH'),found)+bin;
  1018. {$endif delphi}
  1019. end;
  1020. procedure abstract;
  1021. begin
  1022. do_internalerror(255);
  1023. end;
  1024. {****************************************************************************
  1025. Init
  1026. ****************************************************************************}
  1027. procedure get_exepath;
  1028. var
  1029. hs1 : namestr;
  1030. hs2 : extstr;
  1031. begin
  1032. {$ifdef delphi}
  1033. exepath:=dmisc.getenv('PPC_EXEC_PATH');
  1034. {$else delphi}
  1035. exepath:=dos.getenv('PPC_EXEC_PATH');
  1036. {$endif delphi}
  1037. if exepath='' then
  1038. fsplit(FixFileName(paramstr(0)),exepath,hs1,hs2);
  1039. {$ifdef linux}
  1040. if exepath='' then
  1041. fsearch(hs1,dos.getenv('PATH'));
  1042. {$endif}
  1043. exepath:=FixPath(exepath,false);
  1044. end;
  1045. procedure DoneGlobals;
  1046. begin
  1047. initdefines.done;
  1048. if assigned(DLLImageBase) then
  1049. StringDispose(DLLImageBase);
  1050. end;
  1051. procedure InitGlobals;
  1052. begin
  1053. { set global switches }
  1054. do_build:=false;
  1055. do_make:=true;
  1056. {$ifdef tp}
  1057. use_big:=false;
  1058. {$endif tp}
  1059. { Output }
  1060. OutputFile:='';
  1061. OutputExeDir:='';
  1062. OutputUnitDir:='';
  1063. { Utils directory }
  1064. utilsdirectory:='';
  1065. { Def file }
  1066. usewindowapi:=false;
  1067. description:='Compiled by FPC '+version_string+' - '+target_cpu_string;
  1068. { Init values }
  1069. initmodeswitches:=fpcmodeswitches;
  1070. initlocalswitches:=[];
  1071. initmoduleswitches:=[cs_extsyntax,cs_browser];
  1072. initglobalswitches:=[cs_check_unit_name,cs_link_static];
  1073. {$ifdef i386}
  1074. initoptprocessor:=Class386;
  1075. initpackenum:=4;
  1076. initpackrecords:=packrecord_2;
  1077. initoutputformat:=target_asm.id;
  1078. initasmmode:=asmmode_i386_att;
  1079. {$else not i386}
  1080. {$ifdef m68k}
  1081. initoptprocessor:=MC68000;
  1082. include(initmoduleswitches,cs_fp_emulation);
  1083. initpackenum:=4;
  1084. initpackrecords:=packrecord_2;
  1085. initoutputformat:=as_m68k_as;
  1086. initasmmode:=asmmode_m68k_mot;
  1087. {$endif m68k}
  1088. {$endif i386}
  1089. initdefines.init;
  1090. { memory sizes, will be overriden by parameter or default for target
  1091. in options or init_parser }
  1092. stacksize:=0;
  1093. heapsize:=0;
  1094. maxheapsize:=0;
  1095. { compile state }
  1096. in_args:=false;
  1097. must_be_valid:=true;
  1098. not_unit_proc:=true;
  1099. apptype:=at_cui;
  1100. end;
  1101. begin
  1102. get_exepath;
  1103. {$ifdef EXTDEBUG}
  1104. {$ifdef FPC}
  1105. EntryMemUsed:=system.HeapSize-MemAvail;
  1106. {$endif FPC}
  1107. {$endif}
  1108. end.
  1109. {
  1110. $Log$
  1111. Revision 1.23 1999-09-07 15:11:00 pierre
  1112. * use do_internalerror insetead of runerror
  1113. Revision 1.22 1999/08/30 10:17:56 peter
  1114. * fixed crash in psub
  1115. * ansistringcompare fixed
  1116. * support for #$0b8
  1117. Revision 1.21 1999/08/27 10:45:00 pierre
  1118. options -Ca sets simply_ppu to true
  1119. Revision 1.20 1999/08/19 13:02:12 pierre
  1120. + label faillabel added for _FAIL support
  1121. Revision 1.19 1999/08/16 15:35:21 pierre
  1122. * fix for DLL relocation problems
  1123. * external bss vars had wrong stabs for pecoff
  1124. + -WB11000000 to specify default image base, allows to
  1125. load several DLLs with debugging info included
  1126. (relocatable DLL are stripped because the relocation
  1127. of the .Stab section is misplaced by ldw)
  1128. Revision 1.18 1999/08/11 17:26:32 peter
  1129. * tlinker object is now inherited for win32 and dos
  1130. * postprocessexecutable is now a method of tlinker
  1131. Revision 1.17 1999/08/10 12:51:14 pierre
  1132. * bind_win32_dll removed (Relocsection used instead)
  1133. * now relocsection is true by default ! (needs dlltool
  1134. for DLL generation)
  1135. Revision 1.16 1999/08/05 20:54:19 daniel
  1136. * Changes for new symtable.
  1137. Revision 1.15 1999/08/03 17:09:35 florian
  1138. * the alpha compiler can be compiled now
  1139. Revision 1.14 1999/07/23 16:05:19 peter
  1140. * alignment is now saved in the symtable
  1141. * C alignment added for records
  1142. * PPU version increased to solve .12 <-> .13 probs
  1143. Revision 1.13 1999/07/18 10:19:52 florian
  1144. * made it compilable with Dlephi 4 again
  1145. + fixed problem with large stack allocations on win32
  1146. Revision 1.12 1999/07/13 19:14:44 michael
  1147. + Defaultreplacemens now more logical
  1148. Revision 1.11 1999/07/10 10:26:18 peter
  1149. * merged
  1150. Revision 1.8.2.2 1999/07/10 10:03:04 peter
  1151. * fixed initialization/finalization in fpc mode
  1152. * allow $TARGET also in search paths
  1153. Revision 1.8.2.1 1999/07/07 07:53:21 michael
  1154. + Merged patches from florian
  1155. Revision 1.10 1999/07/06 21:48:16 florian
  1156. * a lot bug fixes:
  1157. - po_external isn't any longer necessary for procedure compatibility
  1158. - m_tp_procvar is in -Sd now available
  1159. - error messages of procedure variables improved
  1160. - return values with init./finalization fixed
  1161. - data types with init./finalization aren't any longer allowed in variant
  1162. record
  1163. Revision 1.9 1999/07/03 00:29:48 peter
  1164. * new link writing to the ppu, one .ppu is needed for all link types,
  1165. static (.o) is now always created also when smartlinking is used
  1166. Revision 1.8 1999/05/27 19:44:29 peter
  1167. * removed oldasm
  1168. * plabel -> pasmlabel
  1169. * -a switches to source writing automaticly
  1170. * assembler readers OOPed
  1171. * asmsymbol automaticly external
  1172. * jumptables and other label fixes for asm readers
  1173. Revision 1.7 1999/05/13 21:59:26 peter
  1174. * removed oldppu code
  1175. * warning if objpas is loaded from uses
  1176. * first things for new deref writing
  1177. Revision 1.6 1999/05/05 10:05:50 florian
  1178. * a delphi compiled compiler recompiles ppc
  1179. Revision 1.5 1999/05/04 21:44:43 florian
  1180. * changes to compile it with Delphi 4.0
  1181. Revision 1.4 1999/04/26 13:31:32 peter
  1182. * release storenumber,double_checksum
  1183. Revision 1.3 1999/04/21 14:12:55 peter
  1184. * default asm changed to att
  1185. Revision 1.2 1999/04/16 09:56:05 pierre
  1186. * unused local var commented
  1187. Revision 1.1 1999/04/08 09:14:46 michael
  1188. + Re-added;
  1189. Revision 1.119 1999/04/07 14:15:53 pierre
  1190. * assigned test for FPC removed, problems with stack variables
  1191. Revision 1.118 1999/03/17 22:23:17 florian
  1192. * a FPC compiled compiler checks now also in debug mode in assigned
  1193. if a pointer points to the heap
  1194. * when a symtable is loaded, there is no need to check for duplicate
  1195. symbols. This leads to crashes because defowner isn't assigned
  1196. in this case
  1197. Revision 1.117 1999/03/04 13:55:42 pierre
  1198. * some m68k fixes (still not compilable !)
  1199. * new(tobj) does not give warning if tobj has no VMT !
  1200. Revision 1.116 1999/03/02 18:20:09 peter
  1201. * fixed compareansistring which gave always -1 or 1 and never 0 :)
  1202. Revision 1.115 1999/03/01 15:43:47 peter
  1203. * synchronize also the objfile for ag386bin
  1204. Revision 1.114 1999/02/25 21:02:36 peter
  1205. * ag386bin updates
  1206. + coff writer
  1207. Revision 1.113 1999/02/22 13:06:50 pierre
  1208. + -b and -bl options work !
  1209. + cs_local_browser ($L+) is disabled if cs_browser ($Y+)
  1210. is not enabled when quitting global section
  1211. * local vars and procedures are not yet stored into PPU
  1212. Revision 1.111 1999/02/11 09:46:22 pierre
  1213. * fix for normal method calls inside static methods :
  1214. WARNING there were both parser and codegen errors !!
  1215. added static_call boolean to calln tree
  1216. Revision 1.110 1999/01/27 13:05:42 pierre
  1217. * give include file name on error
  1218. Revision 1.109 1999/01/22 16:56:50 pierre
  1219. * findclose problem fixed
  1220. Revision 1.108 1999/01/22 10:08:19 daniel
  1221. * Findclose is removed for go32v1 and go32v2 platforms, because this is
  1222. TP incompatible. It is now only called for Linux and Win32.
  1223. Revision 1.107 1999/01/12 14:25:27 peter
  1224. + BrowserLog for browser.log generation
  1225. + BrowserCol for browser info in TCollections
  1226. * released all other UseBrowser
  1227. Revision 1.106 1999/01/05 08:19:57 florian
  1228. * mainly problem with invalid case ranges fixed (reported by Jonas)
  1229. Revision 1.105 1998/12/28 23:26:16 peter
  1230. + resource file handling ($R directive) for Win32
  1231. Revision 1.104 1998/12/23 22:49:42 peter
  1232. * forgot one conflict :(
  1233. Revision 1.103 1998/12/23 22:48:41 peter
  1234. * fixed findclose problem
  1235. Revision 1.102 1998/12/23 14:26:30 jonas
  1236. * patch from Peter: remove FindClose call in FileExists (caused error under Dos
  1237. when opening the ppc386.cfg file)
  1238. Revision 1.101 1998/12/23 14:02:00 peter
  1239. * daniels patches against the latest versions
  1240. Revision 1.99 1998/12/19 00:23:47 florian
  1241. * ansistring memory leaks fixed
  1242. Revision 1.98 1998/12/15 10:23:24 peter
  1243. + -iSO, -iSP, -iTO, -iTP
  1244. Revision 1.97 1998/12/11 00:03:17 peter
  1245. + globtype,tokens,version unit splitted from globals
  1246. Revision 1.96 1998/12/08 10:18:06 peter
  1247. + -gh for heaptrc unit
  1248. Revision 1.95 1998/12/03 10:17:30 peter
  1249. * target_os.use_bound_instruction boolean
  1250. Revision 1.94 1998/11/30 13:26:22 pierre
  1251. * the code for ordering the exported procs/vars was buggy
  1252. + added -WB to force binding (Ozerski way of creating DLL)
  1253. this is off by default as direct writing of .edata section seems
  1254. OK
  1255. Revision 1.93 1998/11/30 09:43:10 pierre
  1256. * some range check bugs fixed (still not working !)
  1257. + added DLL writing support for win32 (also accepts variables)
  1258. + TempAnsi for code that could be used for Temporary ansi strings
  1259. handling
  1260. Revision 1.92 1998/11/27 14:50:37 peter
  1261. + open strings, $P switch support
  1262. Revision 1.91 1998/11/26 21:33:08 peter
  1263. * rangecheck updates
  1264. Revision 1.90 1998/11/24 17:03:23 peter
  1265. * removed obsolete version.inc
  1266. Revision 1.89 1998/11/16 15:41:41 peter
  1267. * tp7 didn't like my ifopt H+ :(
  1268. Revision 1.88 1998/11/16 10:17:07 peter
  1269. * fixed for H+ compilation
  1270. Revision 1.87 1998/11/15 16:32:36 florian
  1271. * some stuff of Pavel implement (win32 dll creation)
  1272. * bug with ansistring function results fixed
  1273. Revision 1.86 1998/11/05 12:02:43 peter
  1274. * released useansistring
  1275. * removed -Sv, its now available in fpc modes
  1276. Revision 1.85 1998/10/26 22:23:30 peter
  1277. + fixpath() has an extra option to allow a ./ as path
  1278. Revision 1.84 1998/10/25 23:30:15 peter
  1279. * valint fix for tp7 to overcome overflow
  1280. Revision 1.83 1998/10/22 17:54:02 florian
  1281. + switch $APPTYPE for win32 added
  1282. Revision 1.82 1998/10/22 11:56:44 pierre
  1283. * FixPath handling of c: corrected
  1284. Revision 1.81 1998/10/19 15:41:00 peter
  1285. * better splitname to support glib-1.1.dll alike names
  1286. Revision 1.80 1998/10/16 13:37:17 florian
  1287. + switch -FD added to specify the path for utilities
  1288. Revision 1.79 1998/10/16 08:51:46 peter
  1289. + target_os.stackalignment
  1290. + stack can be aligned at 2 or 4 byte boundaries
  1291. Revision 1.78 1998/10/14 13:38:21 peter
  1292. * fixed path with staticlib/objects in ppufiles
  1293. Revision 1.77 1998/10/13 14:01:09 peter
  1294. * fixed -al
  1295. Revision 1.76 1998/10/13 13:10:15 peter
  1296. * new style for m68k/i386 infos and enums
  1297. Revision 1.75 1998/10/13 08:19:32 pierre
  1298. + source_os is now set correctly for cross-processor compilers
  1299. (tos contains all target_infos and
  1300. we use CPU86 and CPU68 conditionals to
  1301. get the source operating system
  1302. this only works if you do not undefine
  1303. the source target !!)
  1304. * several cg68k memory leaks fixed
  1305. + started to change the code so that it should be possible to have
  1306. a complete compiler (both for m68k and i386 !!)
  1307. Revision 1.74 1998/10/12 10:28:29 florian
  1308. + auto dereferencing of pointers to structured types in delphi mode
  1309. Revision 1.73 1998/10/12 09:49:56 florian
  1310. + support of <procedure var type>:=<pointer> in delphi mode added
  1311. Revision 1.72 1998/10/06 17:16:48 pierre
  1312. * some memory leaks fixed (thanks to Peter for heaptrc !)
  1313. Revision 1.71 1998/09/30 19:53:54 michael
  1314. + Upgraded to version 0.99.9
  1315. Revision 1.70 1998/09/29 15:23:03 peter
  1316. * remove also the end files for smartlinking
  1317. Revision 1.69 1998/09/26 17:45:28 peter
  1318. + idtoken and only one token table
  1319. Revision 1.68 1998/09/24 23:49:04 peter
  1320. + aktmodeswitches
  1321. Revision 1.67 1998/09/22 17:13:46 pierre
  1322. + browsing updated and developed
  1323. records and objects fields are also stored
  1324. Revision 1.66 1998/09/22 15:40:54 peter
  1325. * some extra ifdef GDB
  1326. Revision 1.65 1998/09/18 16:03:38 florian
  1327. * some changes to compile with Delphi
  1328. Revision 1.64 1998/09/10 15:25:29 daniel
  1329. + Added maxheapsize.
  1330. * Corrected semi-bug in calling the assembler and the linker
  1331. Revision 1.63 1998/09/09 18:17:13 florian
  1332. * version number changed to 0.99.8
  1333. Revision 1.62 1998/09/07 17:36:59 florian
  1334. * first fixes for published properties
  1335. Revision 1.61 1998/09/03 11:21:52 peter
  1336. * -al sets cs_asm_source
  1337. Revision 1.60 1998/09/01 12:53:20 peter
  1338. + aktpackenum
  1339. Revision 1.59 1998/09/01 07:54:18 pierre
  1340. * UseBrowser a little updated (might still be buggy !!)
  1341. * bug in psub.pas in function specifier removed
  1342. * stdcall allowed in interface and in implementation
  1343. (FPC will not yet complain if it is missing in either part
  1344. because stdcall is only a dummy !!)
  1345. Revision 1.58 1998/08/31 12:26:25 peter
  1346. * m68k and palmos updates from surebugfixes
  1347. Revision 1.57 1998/08/29 13:51:09 peter
  1348. * moved get_exepath to globals
  1349. + date_string const with the current date for 0.99.7+
  1350. Revision 1.56 1998/08/26 15:35:31 peter
  1351. * fixed scannerfiles for macros
  1352. + $I %<environment>%
  1353. Revision 1.55 1998/08/25 12:42:35 pierre
  1354. * CDECL changed to CVAR for variables
  1355. specifications are read in structures also
  1356. + started adding GPC compatibility mode ( option -Sp)
  1357. * names changed to lowercase
  1358. Revision 1.54 1998/08/19 18:04:53 peter
  1359. * fixed current_module^.in_implementation flag
  1360. Revision 1.53 1998/08/19 16:07:45 jonas
  1361. * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
  1362. Revision 1.52 1998/08/19 10:06:13 peter
  1363. * fixed filenames and removedir which supports slash at the end
  1364. Revision 1.51 1998/08/17 09:17:46 peter
  1365. * static/shared linking updates
  1366. Revision 1.50 1998/08/14 21:56:33 peter
  1367. * setting the outputfile using -o works now to create static libs
  1368. Revision 1.49 1998/08/13 10:57:31 peter
  1369. * constant sets are now written correctly to the ppufile
  1370. Revision 1.48 1998/08/11 15:31:37 peter
  1371. * write extended to ppu file
  1372. * new version 0.99.7
  1373. Revision 1.47 1998/08/10 14:49:59 peter
  1374. + localswitches, moduleswitches, globalswitches splitting
  1375. Revision 1.46 1998/08/10 10:18:25 peter
  1376. + Compiler,Comphook unit which are the new interface units to the
  1377. compiler
  1378. Revision 1.45 1998/07/24 22:16:56 florian
  1379. * internal error 10 together with array access fixed. I hope
  1380. that's the final fix.
  1381. Revision 1.44 1998/07/18 17:11:08 florian
  1382. + ansi string constants fixed
  1383. + switch $H partial implemented
  1384. Revision 1.43 1998/07/14 21:46:42 peter
  1385. * updated messages file
  1386. Revision 1.42 1998/07/08 14:28:35 daniel
  1387. * Fixed small TP incompatibility: Fsplit requires use of dirstr, namestr and
  1388. extstr
  1389. Revision 1.41 1998/07/07 11:19:56 peter
  1390. + NEWINPUT for a better inputfile and scanner object
  1391. Revision 1.40 1998/06/25 08:48:13 florian
  1392. * first version of rtti support
  1393. Revision 1.39 1998/06/17 14:10:12 peter
  1394. * small os2 fixes
  1395. * fixed interdependent units with newppu (remake3 under linux works now)
  1396. Revision 1.38 1998/06/16 08:56:21 peter
  1397. + targetcpu
  1398. * cleaner pmodules for newppu
  1399. Revision 1.37 1998/06/13 00:10:06 peter
  1400. * working browser and newppu
  1401. * some small fixes against crashes which occured in bp7 (but not in
  1402. fpc?!)
  1403. Revision 1.36 1998/06/12 16:15:31 pierre
  1404. * external name 'C_var';
  1405. export name 'intern_C_var';
  1406. cdecl;
  1407. cdecl;external;
  1408. are now supported only with -Sv switch
  1409. Revision 1.34 1998/06/04 23:51:39 peter
  1410. * m68k compiles
  1411. + .def file creation moved to gendef.pas so it could also be used
  1412. for win32
  1413. Revision 1.33 1998/06/03 22:48:54 peter
  1414. + wordbool,longbool
  1415. * rename bis,von -> high,low
  1416. * moved some systemunit loading/creating to psystem.pas
  1417. Revision 1.32 1998/05/30 14:31:04 peter
  1418. + $ASMMODE
  1419. Revision 1.31 1998/05/28 14:40:24 peter
  1420. * fixes for newppu, remake3 works now with it
  1421. Revision 1.30 1998/05/27 19:45:03 peter
  1422. * symtable.pas splitted into includefiles
  1423. * symtable adapted for $ifdef NEWPPU
  1424. Revision 1.29 1998/05/25 17:11:39 pierre
  1425. * firstpasscount bug fixed
  1426. now all is already set correctly the first time
  1427. under EXTDEBUG try -gp to skip all other firstpasses
  1428. it works !!
  1429. * small bug fixes
  1430. - for smallsets with -dTESTSMALLSET
  1431. - some warnings removed (by correcting code !)
  1432. Revision 1.28 1998/05/23 01:21:07 peter
  1433. + aktasmmode, aktoptprocessor, aktoutputformat
  1434. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  1435. + $LIBNAME to set the library name where the unit will be put in
  1436. * splitted cgi386 a bit (codeseg to large for bp7)
  1437. * nasm, tasm works again. nasm moved to ag386nsm.pas
  1438. Revision 1.27 1998/05/20 09:42:33 pierre
  1439. + UseTokenInfo now default
  1440. * unit in interface uses and implementation uses gives error now
  1441. * only one error for unknown symbol (uses lastsymknown boolean)
  1442. the problem came from the label code !
  1443. + first inlined procedures and function work
  1444. (warning there might be allowed cases were the result is still wrong !!)
  1445. * UseBrower updated gives a global list of all position of all used symbols
  1446. with switch -gb
  1447. Revision 1.26 1998/05/12 10:46:59 peter
  1448. * moved printstatus to verb_def
  1449. + V_Normal which is between V_Error and V_Warning and doesn't have a
  1450. prefix like error: warning: and is included in V_Default
  1451. * fixed some messages
  1452. * first time parameter scan is only for -v and -T
  1453. - removed old style messages
  1454. Revision 1.25 1998/05/11 13:07:54 peter
  1455. + $ifdef NEWPPU for the new ppuformat
  1456. + $define GDB not longer required
  1457. * removed all warnings and stripped some log comments
  1458. * no findfirst/findnext anymore to remove smartlink *.o files
  1459. Revision 1.24 1998/05/08 09:21:20 michael
  1460. * Added missing -Fl message to messages file.
  1461. * Corrected mangling of file names when doing Linklib
  1462. * -Fl now actually WORKS.
  1463. * Librarysearchpath is now a field in linker object.
  1464. Revision 1.23 1998/05/06 15:04:20 pierre
  1465. + when trying to find source files of a ppufile
  1466. check the includepathlist for included files
  1467. the main file must still be in the same directory
  1468. Revision 1.22 1998/05/06 08:38:39 pierre
  1469. * better position info with UseTokenInfo
  1470. UseTokenInfo greatly simplified
  1471. + added check for changed tree after first time firstpass
  1472. (if we could remove all the cases were it happen
  1473. we could skip all firstpass if firstpasscount > 1)
  1474. Only with ExtDebug
  1475. Revision 1.21 1998/05/04 17:54:25 peter
  1476. + smartlinking works (only case jumptable left todo)
  1477. * redesign of systems.pas to support assemblers and linkers
  1478. + Unitname is now also in the PPU-file, increased version to 14
  1479. Revision 1.20 1998/05/01 07:43:53 florian
  1480. + basics for rtti implemented
  1481. + switch $m (generate rtti for published sections)
  1482. Revision 1.19 1998/04/30 15:59:40 pierre
  1483. * GDB works again better :
  1484. correct type info in one pass
  1485. + UseTokenInfo for better source position
  1486. * fixed one remaining bug in scanner for line counts
  1487. * several little fixes
  1488. Revision 1.18 1998/04/29 10:33:52 pierre
  1489. + added some code for ansistring (not complete nor working yet)
  1490. * corrected operator overloading
  1491. * corrected nasm output
  1492. + started inline procedures
  1493. + added starstarn : use ** for exponentiation (^ gave problems)
  1494. + started UseTokenInfo cond to get accurate positions
  1495. Revision 1.17 1998/04/27 23:10:28 peter
  1496. + new scanner
  1497. * $makelib -> if smartlink
  1498. * small filename fixes pmodule.setfilename
  1499. * moved import from files.pas -> import.pas
  1500. Revision 1.16 1998/04/27 15:45:20 peter
  1501. + -Xl for smartlink
  1502. + target_info.arext = .a
  1503. Revision 1.15 1998/04/22 21:06:50 florian
  1504. * last fixes before the release:
  1505. - veryyyy slow firstcall fixed
  1506. Revision 1.14 1998/04/21 13:48:09 michael
  1507. + Updated patch number
  1508. Revision 1.13 1998/04/21 10:16:47 peter
  1509. * patches from strasbourg
  1510. * objects is not used anymore in the fpc compiled version
  1511. Revision 1.12 1998/04/09 14:28:06 jonas
  1512. + basic k6 and 6x86 optimizing support (-O7 and -O8)
  1513. Revision 1.11 1998/04/08 16:58:02 pierre
  1514. * several bugfixes
  1515. ADD ADC and AND are also sign extended
  1516. nasm output OK (program still crashes at end
  1517. and creates wrong assembler files !!)
  1518. procsym types sym in tdef removed !!
  1519. Revision 1.10 1998/04/08 11:34:22 peter
  1520. * nasm works (linux only tested)
  1521. Revision 1.9 1998/04/07 21:37:30 peter
  1522. * fixed fixpath to also change / and \ slashes and better addpathtolist
  1523. Revision 1.8 1998/04/07 13:19:44 pierre
  1524. * bugfixes for reset_gdb_info
  1525. in MEM parsing for go32v2
  1526. better external symbol creation
  1527. support for rhgdb.exe (lowercase file names)
  1528. Revision 1.7 1998/04/06 16:19:46 peter
  1529. * fixed the -Up.. bug
  1530. }