cutils.pas 23 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Florian Klaempfl
  4. This unit implements some support functions
  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
  7. by 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. {# This unit contains some generic support functions which are used
  19. in the different parts of the compiler.
  20. }
  21. unit cutils;
  22. {$i fpcdefs.inc}
  23. interface
  24. type
  25. pstring = ^string;
  26. {# Returns the minimal value between @var(a) and @var(b) }
  27. function min(a,b : longint) : longint;{$ifdef USEINLINE}inline;{$endif}
  28. {# Returns the maximum value between @var(a) and @var(b) }
  29. function max(a,b : longint) : longint;{$ifdef USEINLINE}inline;{$endif}
  30. {# Returns the value in @var(x) swapped to different endian }
  31. function SwapLong(x : longint): longint;{$ifdef USEINLINE}inline;{$endif}
  32. {# Returns the value in @va(x) swapped to different endian }
  33. function SwapWord(x : word): word;{$ifdef USEINLINE}inline;{$endif}
  34. {# Return value @var(i) aligned on @var(a) boundary }
  35. function align(i,a:longint):longint;{$ifdef USEINLINE}inline;{$endif}
  36. function used_align(varalign,minalign,maxalign:longint):longint;
  37. function size_2_align(len : longint) : longint;
  38. procedure Replace(var s:string;s1:string;const s2:string);
  39. procedure ReplaceCase(var s:string;const s1,s2:string);
  40. function upper(const s : string) : string;
  41. function lower(const s : string) : string;
  42. function trimbspace(const s:string):string;
  43. function trimspace(const s:string):string;
  44. function space (b : longint): string;
  45. function PadSpace(const s:string;len:longint):string;
  46. function GetToken(var s:string;endchar:char):string;
  47. procedure uppervar(var s : string);
  48. function hexstr(val : cardinal;cnt : cardinal) : string;
  49. function tostru(i:cardinal) : string;{$ifdef USEINLINE}inline;{$endif}
  50. function tostr(i : longint) : string;{$ifdef USEINLINE}inline;{$endif}
  51. function realtostr(e:extended):string;{$ifdef USEINLINE}inline;{$endif}
  52. function int64tostr(i : int64) : string;{$ifdef USEINLINE}inline;{$endif}
  53. function tostr_with_plus(i : longint) : string;{$ifdef USEINLINE}inline;{$endif}
  54. function DStr(l:longint):string;
  55. procedure valint(S : string;var V : longint;var code : integer);
  56. {# Returns true if the string s is a number }
  57. function is_number(const s : string) : boolean;{$ifdef USEINLINE}inline;{$endif}
  58. {# Returns true if value is a power of 2, the actual
  59. exponent value is returned in power.
  60. }
  61. function ispowerof2(value : int64;var power : longint) : boolean;
  62. function maybequoted(const s:string):string;
  63. function CompareText(S1, S2: string): longint;
  64. { releases the string p and assignes nil to p }
  65. { if p=nil then freemem isn't called }
  66. procedure stringdispose(var p : pstring);{$ifdef USEINLINE}inline;{$endif}
  67. { allocates mem for a copy of s, copies s to this mem and returns }
  68. { a pointer to this mem }
  69. function stringdup(const s : string) : pstring;{$ifdef USEINLINE}inline;{$endif}
  70. {# Allocates memory for the string @var(s) and copies s as zero
  71. terminated string to that allocated memory and returns a pointer
  72. to that mem
  73. }
  74. function strpnew(const s : string) : pchar;
  75. procedure strdispose(var p : pchar);
  76. {# makes the character @var(c) lowercase, with spanish, french and german
  77. character set
  78. }
  79. function lowercase(c : char) : char;
  80. { makes zero terminated string to a pascal string }
  81. { the data in p is modified and p is returned }
  82. function pchar2pstring(p : pchar) : pstring;
  83. { ambivalent to pchar2pstring }
  84. function pstring2pchar(p : pstring) : pchar;
  85. { Speed/Hash value }
  86. Function GetSpeedValue(Const s:String):cardinal;
  87. { Ansistring (pchar+length) support }
  88. procedure ansistringdispose(var p : pchar;length : longint);
  89. function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint;
  90. function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
  91. {*****************************************************************************
  92. File Functions
  93. *****************************************************************************}
  94. function DeleteFile(const fn:string):boolean;
  95. implementation
  96. uses
  97. {$ifdef delphi}
  98. sysutils
  99. {$else}
  100. strings
  101. {$endif}
  102. ;
  103. var
  104. uppertbl,
  105. lowertbl : array[char] of char;
  106. function min(a,b : longint) : longint;{$ifdef USEINLINE}inline;{$endif}
  107. {
  108. return the minimal of a and b
  109. }
  110. begin
  111. if a>b then
  112. min:=b
  113. else
  114. min:=a;
  115. end;
  116. function max(a,b : longint) : longint;{$ifdef USEINLINE}inline;{$endif}
  117. {
  118. return the maximum of a and b
  119. }
  120. begin
  121. if a<b then
  122. max:=b
  123. else
  124. max:=a;
  125. end;
  126. Function SwapLong(x : longint): longint;{$ifdef USEINLINE}inline;{$endif}
  127. var
  128. y : word;
  129. z : word;
  130. Begin
  131. y := x shr 16;
  132. y := word(longint(y) shl 8) or (y shr 8);
  133. z := x and $FFFF;
  134. z := word(longint(z) shl 8) or (z shr 8);
  135. SwapLong := (longint(z) shl 16) or longint(y);
  136. End;
  137. Function SwapWord(x : word): word;{$ifdef USEINLINE}inline;{$endif}
  138. var
  139. z : byte;
  140. Begin
  141. z := x shr 8;
  142. x := x and $ff;
  143. x := (x shl 8);
  144. SwapWord := x or z;
  145. End;
  146. function align(i,a:longint):longint;{$ifdef USEINLINE}inline;{$endif}
  147. {
  148. return value <i> aligned <a> boundary
  149. }
  150. begin
  151. { for 0 and 1 no aligning is needed }
  152. if a<=1 then
  153. align:=i
  154. else
  155. align:=((i+a-1) div a) * a;
  156. end;
  157. function size_2_align(len : longint) : longint;
  158. begin
  159. if len>16 then
  160. size_2_align:=32
  161. else if len>8 then
  162. size_2_align:=16
  163. else if len>4 then
  164. size_2_align:=8
  165. else if len>2 then
  166. size_2_align:=4
  167. else if len>1 then
  168. size_2_align:=2
  169. else
  170. size_2_align:=1;
  171. end;
  172. function used_align(varalign,minalign,maxalign:longint):longint;
  173. begin
  174. { varalign : minimum alignment required for the variable
  175. minalign : Minimum alignment of this structure, 0 = undefined
  176. maxalign : Maximum alignment of this structure, 0 = undefined }
  177. if (minalign>0) and
  178. (varalign<minalign) then
  179. used_align:=minalign
  180. else
  181. begin
  182. if (maxalign>0) and
  183. (varalign>maxalign) then
  184. used_align:=maxalign
  185. else
  186. used_align:=varalign;
  187. end;
  188. end;
  189. procedure Replace(var s:string;s1:string;const s2:string);
  190. var
  191. last,
  192. i : longint;
  193. begin
  194. s1:=upper(s1);
  195. last:=0;
  196. repeat
  197. i:=pos(s1,upper(s));
  198. if i=last then
  199. i:=0;
  200. if (i>0) then
  201. begin
  202. Delete(s,i,length(s1));
  203. Insert(s2,s,i);
  204. last:=i;
  205. end;
  206. until (i=0);
  207. end;
  208. procedure ReplaceCase(var s:string;const s1,s2:string);
  209. var
  210. last,
  211. i : longint;
  212. begin
  213. last:=0;
  214. repeat
  215. i:=pos(s1,s);
  216. if i=last then
  217. i:=0;
  218. if (i>0) then
  219. begin
  220. Delete(s,i,length(s1));
  221. Insert(s2,s,i);
  222. last:=i;
  223. end;
  224. until (i=0);
  225. end;
  226. function upper(const s : string) : string;
  227. {
  228. return uppercased string of s
  229. }
  230. var
  231. i : longint;
  232. begin
  233. for i:=1 to length(s) do
  234. upper[i]:=uppertbl[s[i]];
  235. upper[0]:=s[0];
  236. end;
  237. function lower(const s : string) : string;
  238. {
  239. return lowercased string of s
  240. }
  241. var
  242. i : longint;
  243. begin
  244. for i:=1 to length(s) do
  245. lower[i]:=lowertbl[s[i]];
  246. lower[0]:=s[0];
  247. end;
  248. procedure uppervar(var s : string);
  249. {
  250. uppercase string s
  251. }
  252. var
  253. i : longint;
  254. begin
  255. for i:=1 to length(s) do
  256. s[i]:=uppertbl[s[i]];
  257. end;
  258. procedure initupperlower;
  259. var
  260. c : char;
  261. begin
  262. for c:=#0 to #255 do
  263. begin
  264. lowertbl[c]:=c;
  265. uppertbl[c]:=c;
  266. case c of
  267. 'A'..'Z' :
  268. lowertbl[c]:=char(byte(c)+32);
  269. 'a'..'z' :
  270. uppertbl[c]:=char(byte(c)-32);
  271. end;
  272. end;
  273. end;
  274. function hexstr(val : cardinal;cnt : cardinal) : string;
  275. const
  276. HexTbl : array[0..15] of char='0123456789ABCDEF';
  277. var
  278. i,j : cardinal;
  279. begin
  280. { calculate required length }
  281. i:=0;
  282. j:=val;
  283. while (j>0) do
  284. begin
  285. inc(i);
  286. j:=j shr 4;
  287. end;
  288. { generate fillers }
  289. j:=0;
  290. while (i+j<cnt) do
  291. begin
  292. inc(j);
  293. hexstr[j]:='0';
  294. end;
  295. { generate hex }
  296. inc(j,i);
  297. hexstr[0]:=chr(j);
  298. while (val>0) do
  299. begin
  300. hexstr[j]:=hextbl[val and $f];
  301. dec(j);
  302. val:=val shr 4;
  303. end;
  304. end;
  305. function tostru(i:cardinal):string;{$ifdef USEINLINE}inline;{$endif}
  306. {
  307. return string of value i, but for cardinals
  308. }
  309. begin
  310. str(i,result);
  311. end;
  312. function tostr(i : longint) : string;{$ifdef USEINLINE}inline;{$endif}
  313. {
  314. return string of value i
  315. }
  316. begin
  317. str(i,result);
  318. end;
  319. function DStr(l:longint):string;
  320. var
  321. TmpStr : string[32];
  322. i : longint;
  323. begin
  324. Str(l,TmpStr);
  325. i:=Length(TmpStr);
  326. while (i>3) do
  327. begin
  328. dec(i,3);
  329. if TmpStr[i]<>'-' then
  330. insert('.',TmpStr,i+1);
  331. end;
  332. DStr:=TmpStr;
  333. end;
  334. function trimbspace(const s:string):string;
  335. {
  336. return s with all leading spaces and tabs removed
  337. }
  338. var
  339. i,j : longint;
  340. begin
  341. j:=1;
  342. i:=length(s);
  343. while (j<i) and (s[j] in [#9,' ']) do
  344. inc(j);
  345. trimbspace:=Copy(s,j,i-j+1);
  346. end;
  347. function trimspace(const s:string):string;
  348. {
  349. return s with all leading and ending spaces and tabs removed
  350. }
  351. var
  352. i,j : longint;
  353. begin
  354. i:=length(s);
  355. while (i>0) and (s[i] in [#9,' ']) do
  356. dec(i);
  357. j:=1;
  358. while (j<i) and (s[j] in [#9,' ']) do
  359. inc(j);
  360. trimspace:=Copy(s,j,i-j+1);
  361. end;
  362. function space (b : longint): string;
  363. var
  364. s: string;
  365. begin
  366. space[0] := chr(b);
  367. s[0] := chr(b);
  368. FillChar (S[1],b,' ');
  369. space:=s;
  370. end;
  371. function PadSpace(const s:string;len:longint):string;
  372. {
  373. return s with spaces add to the end
  374. }
  375. begin
  376. if length(s)<len then
  377. PadSpace:=s+Space(len-length(s))
  378. else
  379. PadSpace:=s;
  380. end;
  381. function GetToken(var s:string;endchar:char):string;
  382. var
  383. i : longint;
  384. begin
  385. GetToken:='';
  386. s:=TrimSpace(s);
  387. if s[1]='''' then
  388. begin
  389. i:=1;
  390. while (i<length(s)) do
  391. begin
  392. inc(i);
  393. if s[i]='''' then
  394. begin
  395. { Remove double quote }
  396. if (i<length(s)) and
  397. (s[i+1]='''') then
  398. begin
  399. Delete(s,i,1);
  400. inc(i);
  401. end
  402. else
  403. begin
  404. GetToken:=Copy(s,2,i-2);
  405. Delete(s,1,i);
  406. exit;
  407. end;
  408. end;
  409. end;
  410. GetToken:=s;
  411. s:='';
  412. end
  413. else
  414. begin
  415. i:=pos(EndChar,s);
  416. if i=0 then
  417. begin
  418. GetToken:=s;
  419. s:='';
  420. exit;
  421. end
  422. else
  423. begin
  424. GetToken:=Copy(s,1,i-1);
  425. Delete(s,1,i);
  426. exit;
  427. end;
  428. end;
  429. end;
  430. function realtostr(e:extended):string;{$ifdef USEINLINE}inline;{$endif}
  431. begin
  432. str(e,result);
  433. end;
  434. function int64tostr(i : int64) : string;{$ifdef USEINLINE}inline;{$endif}
  435. {
  436. return string of value i
  437. }
  438. begin
  439. str(i,result);
  440. end;
  441. function tostr_with_plus(i : longint) : string;{$ifdef USEINLINE}inline;{$endif}
  442. {
  443. return string of value i, but always include a + when i>=0
  444. }
  445. begin
  446. str(i,result);
  447. if i>=0 then
  448. result:='+'+result;
  449. end;
  450. procedure valint(S : string;var V : longint;var code : integer);
  451. {
  452. val() with support for octal, which is not supported under tp7
  453. }
  454. {$ifndef FPC}
  455. var
  456. vs : longint;
  457. c : byte;
  458. begin
  459. if s[1]='%' then
  460. begin
  461. vs:=0;
  462. longint(v):=0;
  463. for c:=2 to length(s) do
  464. begin
  465. if s[c]='0' then
  466. vs:=vs shl 1
  467. else
  468. if s[c]='1' then
  469. vs:=vs shl 1+1
  470. else
  471. begin
  472. code:=c;
  473. exit;
  474. end;
  475. end;
  476. code:=0;
  477. longint(v):=vs;
  478. end
  479. else
  480. system.val(S,V,code);
  481. end;
  482. {$else not FPC}
  483. begin
  484. system.val(S,V,code);
  485. end;
  486. {$endif not FPC}
  487. function is_number(const s : string) : boolean;{$ifdef USEINLINE}inline;{$endif}
  488. {
  489. is string a correct number ?
  490. }
  491. var
  492. w : integer;
  493. l : longint;
  494. begin
  495. valint(s,l,w);
  496. is_number:=(w=0);
  497. end;
  498. function ispowerof2(value : int64;var power : longint) : boolean;
  499. {
  500. return if value is a power of 2. And if correct return the power
  501. }
  502. var
  503. hl : int64;
  504. i : longint;
  505. begin
  506. if value and (value - 1) <> 0 then
  507. begin
  508. ispowerof2 := false;
  509. exit
  510. end;
  511. hl:=1;
  512. ispowerof2:=true;
  513. for i:=0 to 63 do
  514. begin
  515. if hl=value then
  516. begin
  517. power:=i;
  518. exit;
  519. end;
  520. hl:=hl shl 1;
  521. end;
  522. ispowerof2:=false;
  523. end;
  524. function maybequoted(const s:string):string;
  525. var
  526. s1 : string;
  527. i : integer;
  528. quoted : boolean;
  529. begin
  530. quoted:=false;
  531. s1:='"';
  532. for i:=1 to length(s) do
  533. begin
  534. case s[i] of
  535. '"' :
  536. begin
  537. quoted:=true;
  538. s1:=s1+'\"';
  539. end;
  540. ' ',
  541. #128..#255 :
  542. begin
  543. quoted:=true;
  544. s1:=s1+s[i];
  545. end;
  546. else
  547. s1:=s1+s[i];
  548. end;
  549. end;
  550. if quoted then
  551. maybequoted:=s1+'"'
  552. else
  553. maybequoted:=s;
  554. end;
  555. function pchar2pstring(p : pchar) : pstring;
  556. var
  557. w,i : longint;
  558. begin
  559. w:=strlen(p);
  560. for i:=w-1 downto 0 do
  561. p[i+1]:=p[i];
  562. p[0]:=chr(w);
  563. pchar2pstring:=pstring(p);
  564. end;
  565. function pstring2pchar(p : pstring) : pchar;
  566. var
  567. w,i : longint;
  568. begin
  569. w:=length(p^);
  570. for i:=1 to w do
  571. p^[i-1]:=p^[i];
  572. p^[w]:=#0;
  573. pstring2pchar:=pchar(p);
  574. end;
  575. function lowercase(c : char) : char;
  576. begin
  577. case c of
  578. #65..#90 : c := chr(ord (c) + 32);
  579. #154 : c:=#129; { german }
  580. #142 : c:=#132; { german }
  581. #153 : c:=#148; { german }
  582. #144 : c:=#130; { french }
  583. #128 : c:=#135; { french }
  584. #143 : c:=#134; { swedish/norge (?) }
  585. #165 : c:=#164; { spanish }
  586. #228 : c:=#229; { greek }
  587. #226 : c:=#231; { greek }
  588. #232 : c:=#227; { greek }
  589. end;
  590. lowercase := c;
  591. end;
  592. function strpnew(const s : string) : pchar;
  593. var
  594. p : pchar;
  595. begin
  596. getmem(p,length(s)+1);
  597. strpcopy(p,s);
  598. strpnew:=p;
  599. end;
  600. procedure strdispose(var p : pchar);
  601. begin
  602. if assigned(p) then
  603. begin
  604. freemem(p,strlen(p)+1);
  605. p:=nil;
  606. end;
  607. end;
  608. procedure stringdispose(var p : pstring);{$ifdef USEINLINE}inline;{$endif}
  609. begin
  610. if assigned(p) then
  611. begin
  612. freemem(p,length(p^)+1);
  613. p:=nil;
  614. end;
  615. end;
  616. function stringdup(const s : string) : pstring;{$ifdef USEINLINE}inline;{$endif}
  617. begin
  618. getmem(result,length(s)+1);
  619. result^:=s;
  620. end;
  621. function CompareText(S1, S2: string): longint;
  622. begin
  623. UpperVar(S1);
  624. UpperVar(S2);
  625. if S1<S2 then
  626. CompareText:=-1
  627. else
  628. if S1>S2 then
  629. CompareText:= 1
  630. else
  631. CompareText:=0;
  632. end;
  633. {*****************************************************************************
  634. GetSpeedValue
  635. *****************************************************************************}
  636. {$ifdef ver1_0}
  637. {$R-}
  638. {$endif}
  639. var
  640. Crc32Tbl : array[0..255] of cardinal;
  641. procedure MakeCRC32Tbl;
  642. var
  643. crc : cardinal;
  644. i,n : integer;
  645. begin
  646. for i:=0 to 255 do
  647. begin
  648. crc:=i;
  649. for n:=1 to 8 do
  650. if odd(longint(crc)) then
  651. crc:=cardinal(crc shr 1) xor cardinal($edb88320)
  652. else
  653. crc:=cardinal(crc shr 1);
  654. Crc32Tbl[i]:=crc;
  655. end;
  656. end;
  657. Function GetSpeedValue(Const s:String):cardinal;
  658. var
  659. i : integer;
  660. InitCrc : cardinal;
  661. begin
  662. if Crc32Tbl[1]=0 then
  663. MakeCrc32Tbl;
  664. InitCrc:=cardinal($ffffffff);
  665. for i:=1 to Length(s) do
  666. InitCrc:=Crc32Tbl[byte(InitCrc) xor ord(s[i])] xor (InitCrc shr 8);
  667. GetSpeedValue:=InitCrc;
  668. end;
  669. {*****************************************************************************
  670. Ansistring (PChar+Length)
  671. *****************************************************************************}
  672. procedure ansistringdispose(var p : pchar;length : longint);
  673. begin
  674. if assigned(p) then
  675. begin
  676. freemem(p,length+1);
  677. p:=nil;
  678. end;
  679. end;
  680. { enable ansistring comparison }
  681. { 0 means equal }
  682. { 1 means p1 > p2 }
  683. { -1 means p1 < p2 }
  684. function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint;
  685. var
  686. i,j : longint;
  687. begin
  688. compareansistrings:=0;
  689. j:=min(length1,length2);
  690. i:=0;
  691. while (i<j) do
  692. begin
  693. if p1[i]>p2[i] then
  694. begin
  695. compareansistrings:=1;
  696. exit;
  697. end
  698. else
  699. if p1[i]<p2[i] then
  700. begin
  701. compareansistrings:=-1;
  702. exit;
  703. end;
  704. inc(i);
  705. end;
  706. if length1>length2 then
  707. compareansistrings:=1
  708. else
  709. if length1<length2 then
  710. compareansistrings:=-1;
  711. end;
  712. function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
  713. var
  714. p : pchar;
  715. begin
  716. getmem(p,length1+length2+1);
  717. move(p1[0],p[0],length1);
  718. move(p2[0],p[length1],length2+1);
  719. concatansistrings:=p;
  720. end;
  721. {*****************************************************************************
  722. File Functions
  723. *****************************************************************************}
  724. function DeleteFile(const fn:string):boolean;
  725. var
  726. f : file;
  727. begin
  728. {$I-}
  729. assign(f,fn);
  730. erase(f);
  731. {$I-}
  732. DeleteFile:=(IOResult=0);
  733. end;
  734. initialization
  735. initupperlower;
  736. end.
  737. {
  738. $Log$
  739. Revision 1.29 2003-10-31 15:51:11 peter
  740. * USEINLINE directive added (not enabled yet)
  741. Revision 1.28 2003/09/03 15:55:00 peter
  742. * NEWRA branch merged
  743. Revision 1.27.2.2 2003/08/29 17:28:59 peter
  744. * next batch of updates
  745. Revision 1.27.2.1 2003/08/29 09:41:25 daniel
  746. * Further mkx86reg development
  747. Revision 1.27 2003/07/05 20:06:28 jonas
  748. * fixed some range check errors that occurred on big endian systems
  749. * slightly optimized the swap*() functions
  750. Revision 1.26 2003/04/04 15:34:25 peter
  751. * quote names with hi-ascii chars
  752. Revision 1.25 2003/01/09 21:42:27 peter
  753. * realtostr added
  754. Revision 1.24 2002/12/27 18:05:27 peter
  755. * support quotes in gettoken
  756. Revision 1.23 2002/10/05 12:43:24 carl
  757. * fixes for Delphi 6 compilation
  758. (warning : Some features do not work under Delphi)
  759. Revision 1.22 2002/09/05 19:29:42 peter
  760. * memdebug enhancements
  761. Revision 1.21 2002/07/26 11:16:35 jonas
  762. * fixed (actual and potential) range errors
  763. Revision 1.20 2002/07/07 11:13:34 carl
  764. * range check error fix (patch from Sergey)
  765. Revision 1.19 2002/07/07 09:52:32 florian
  766. * powerpc target fixed, very simple units can be compiled
  767. * some basic stuff for better callparanode handling, far from being finished
  768. Revision 1.18 2002/07/01 18:46:22 peter
  769. * internal linker
  770. * reorganized aasm layer
  771. Revision 1.17 2002/05/18 13:34:07 peter
  772. * readded missing revisions
  773. Revision 1.16 2002/05/16 19:46:36 carl
  774. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  775. + try to fix temp allocation (still in ifdef)
  776. + generic constructor calls
  777. + start of tassembler / tmodulebase class cleanup
  778. Revision 1.14 2002/04/12 17:16:35 carl
  779. + more documentation of basic unit
  780. }