globals.pas 49 KB

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