globals.pas 49 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814
  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. {$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.24 1999-09-08 16:05:31 peter
  1112. * pointer add/sub is now as expected and the same results as inc/dec
  1113. Revision 1.23 1999/09/07 15:11:00 pierre
  1114. * use do_internalerror insetead of runerror
  1115. Revision 1.22 1999/08/30 10:17:56 peter
  1116. * fixed crash in psub
  1117. * ansistringcompare fixed
  1118. * support for #$0b8
  1119. Revision 1.21 1999/08/27 10:45:00 pierre
  1120. options -Ca sets simply_ppu to true
  1121. Revision 1.20 1999/08/19 13:02:12 pierre
  1122. + label faillabel added for _FAIL support
  1123. Revision 1.19 1999/08/16 15:35:21 pierre
  1124. * fix for DLL relocation problems
  1125. * external bss vars had wrong stabs for pecoff
  1126. + -WB11000000 to specify default image base, allows to
  1127. load several DLLs with debugging info included
  1128. (relocatable DLL are stripped because the relocation
  1129. of the .Stab section is misplaced by ldw)
  1130. Revision 1.18 1999/08/11 17:26:32 peter
  1131. * tlinker object is now inherited for win32 and dos
  1132. * postprocessexecutable is now a method of tlinker
  1133. Revision 1.17 1999/08/10 12:51:14 pierre
  1134. * bind_win32_dll removed (Relocsection used instead)
  1135. * now relocsection is true by default ! (needs dlltool
  1136. for DLL generation)
  1137. Revision 1.16 1999/08/05 20:54:19 daniel
  1138. * Changes for new symtable.
  1139. Revision 1.15 1999/08/03 17:09:35 florian
  1140. * the alpha compiler can be compiled now
  1141. Revision 1.14 1999/07/23 16:05:19 peter
  1142. * alignment is now saved in the symtable
  1143. * C alignment added for records
  1144. * PPU version increased to solve .12 <-> .13 probs
  1145. Revision 1.13 1999/07/18 10:19:52 florian
  1146. * made it compilable with Dlephi 4 again
  1147. + fixed problem with large stack allocations on win32
  1148. Revision 1.12 1999/07/13 19:14:44 michael
  1149. + Defaultreplacemens now more logical
  1150. Revision 1.11 1999/07/10 10:26:18 peter
  1151. * merged
  1152. Revision 1.8.2.2 1999/07/10 10:03:04 peter
  1153. * fixed initialization/finalization in fpc mode
  1154. * allow $TARGET also in search paths
  1155. Revision 1.8.2.1 1999/07/07 07:53:21 michael
  1156. + Merged patches from florian
  1157. Revision 1.10 1999/07/06 21:48:16 florian
  1158. * a lot bug fixes:
  1159. - po_external isn't any longer necessary for procedure compatibility
  1160. - m_tp_procvar is in -Sd now available
  1161. - error messages of procedure variables improved
  1162. - return values with init./finalization fixed
  1163. - data types with init./finalization aren't any longer allowed in variant
  1164. record
  1165. Revision 1.9 1999/07/03 00:29:48 peter
  1166. * new link writing to the ppu, one .ppu is needed for all link types,
  1167. static (.o) is now always created also when smartlinking is used
  1168. Revision 1.8 1999/05/27 19:44:29 peter
  1169. * removed oldasm
  1170. * plabel -> pasmlabel
  1171. * -a switches to source writing automaticly
  1172. * assembler readers OOPed
  1173. * asmsymbol automaticly external
  1174. * jumptables and other label fixes for asm readers
  1175. Revision 1.7 1999/05/13 21:59:26 peter
  1176. * removed oldppu code
  1177. * warning if objpas is loaded from uses
  1178. * first things for new deref writing
  1179. Revision 1.6 1999/05/05 10:05:50 florian
  1180. * a delphi compiled compiler recompiles ppc
  1181. Revision 1.5 1999/05/04 21:44:43 florian
  1182. * changes to compile it with Delphi 4.0
  1183. Revision 1.4 1999/04/26 13:31:32 peter
  1184. * release storenumber,double_checksum
  1185. Revision 1.3 1999/04/21 14:12:55 peter
  1186. * default asm changed to att
  1187. Revision 1.2 1999/04/16 09:56:05 pierre
  1188. * unused local var commented
  1189. Revision 1.1 1999/04/08 09:14:46 michael
  1190. + Re-added;
  1191. Revision 1.119 1999/04/07 14:15:53 pierre
  1192. * assigned test for FPC removed, problems with stack variables
  1193. Revision 1.118 1999/03/17 22:23:17 florian
  1194. * a FPC compiled compiler checks now also in debug mode in assigned
  1195. if a pointer points to the heap
  1196. * when a symtable is loaded, there is no need to check for duplicate
  1197. symbols. This leads to crashes because defowner isn't assigned
  1198. in this case
  1199. Revision 1.117 1999/03/04 13:55:42 pierre
  1200. * some m68k fixes (still not compilable !)
  1201. * new(tobj) does not give warning if tobj has no VMT !
  1202. Revision 1.116 1999/03/02 18:20:09 peter
  1203. * fixed compareansistring which gave always -1 or 1 and never 0 :)
  1204. Revision 1.115 1999/03/01 15:43:47 peter
  1205. * synchronize also the objfile for ag386bin
  1206. Revision 1.114 1999/02/25 21:02:36 peter
  1207. * ag386bin updates
  1208. + coff writer
  1209. Revision 1.113 1999/02/22 13:06:50 pierre
  1210. + -b and -bl options work !
  1211. + cs_local_browser ($L+) is disabled if cs_browser ($Y+)
  1212. is not enabled when quitting global section
  1213. * local vars and procedures are not yet stored into PPU
  1214. Revision 1.111 1999/02/11 09:46:22 pierre
  1215. * fix for normal method calls inside static methods :
  1216. WARNING there were both parser and codegen errors !!
  1217. added static_call boolean to calln tree
  1218. Revision 1.110 1999/01/27 13:05:42 pierre
  1219. * give include file name on error
  1220. Revision 1.109 1999/01/22 16:56:50 pierre
  1221. * findclose problem fixed
  1222. Revision 1.108 1999/01/22 10:08:19 daniel
  1223. * Findclose is removed for go32v1 and go32v2 platforms, because this is
  1224. TP incompatible. It is now only called for Linux and Win32.
  1225. Revision 1.107 1999/01/12 14:25:27 peter
  1226. + BrowserLog for browser.log generation
  1227. + BrowserCol for browser info in TCollections
  1228. * released all other UseBrowser
  1229. Revision 1.106 1999/01/05 08:19:57 florian
  1230. * mainly problem with invalid case ranges fixed (reported by Jonas)
  1231. Revision 1.105 1998/12/28 23:26:16 peter
  1232. + resource file handling ($R directive) for Win32
  1233. Revision 1.104 1998/12/23 22:49:42 peter
  1234. * forgot one conflict :(
  1235. Revision 1.103 1998/12/23 22:48:41 peter
  1236. * fixed findclose problem
  1237. Revision 1.102 1998/12/23 14:26:30 jonas
  1238. * patch from Peter: remove FindClose call in FileExists (caused error under Dos
  1239. when opening the ppc386.cfg file)
  1240. Revision 1.101 1998/12/23 14:02:00 peter
  1241. * daniels patches against the latest versions
  1242. Revision 1.99 1998/12/19 00:23:47 florian
  1243. * ansistring memory leaks fixed
  1244. Revision 1.98 1998/12/15 10:23:24 peter
  1245. + -iSO, -iSP, -iTO, -iTP
  1246. Revision 1.97 1998/12/11 00:03:17 peter
  1247. + globtype,tokens,version unit splitted from globals
  1248. Revision 1.96 1998/12/08 10:18:06 peter
  1249. + -gh for heaptrc unit
  1250. Revision 1.95 1998/12/03 10:17:30 peter
  1251. * target_os.use_bound_instruction boolean
  1252. Revision 1.94 1998/11/30 13:26:22 pierre
  1253. * the code for ordering the exported procs/vars was buggy
  1254. + added -WB to force binding (Ozerski way of creating DLL)
  1255. this is off by default as direct writing of .edata section seems
  1256. OK
  1257. Revision 1.93 1998/11/30 09:43:10 pierre
  1258. * some range check bugs fixed (still not working !)
  1259. + added DLL writing support for win32 (also accepts variables)
  1260. + TempAnsi for code that could be used for Temporary ansi strings
  1261. handling
  1262. Revision 1.92 1998/11/27 14:50:37 peter
  1263. + open strings, $P switch support
  1264. Revision 1.91 1998/11/26 21:33:08 peter
  1265. * rangecheck updates
  1266. Revision 1.90 1998/11/24 17:03:23 peter
  1267. * removed obsolete version.inc
  1268. Revision 1.89 1998/11/16 15:41:41 peter
  1269. * tp7 didn't like my ifopt H+ :(
  1270. Revision 1.88 1998/11/16 10:17:07 peter
  1271. * fixed for H+ compilation
  1272. Revision 1.87 1998/11/15 16:32:36 florian
  1273. * some stuff of Pavel implement (win32 dll creation)
  1274. * bug with ansistring function results fixed
  1275. Revision 1.86 1998/11/05 12:02:43 peter
  1276. * released useansistring
  1277. * removed -Sv, its now available in fpc modes
  1278. Revision 1.85 1998/10/26 22:23:30 peter
  1279. + fixpath() has an extra option to allow a ./ as path
  1280. Revision 1.84 1998/10/25 23:30:15 peter
  1281. * valint fix for tp7 to overcome overflow
  1282. Revision 1.83 1998/10/22 17:54:02 florian
  1283. + switch $APPTYPE for win32 added
  1284. Revision 1.82 1998/10/22 11:56:44 pierre
  1285. * FixPath handling of c: corrected
  1286. Revision 1.81 1998/10/19 15:41:00 peter
  1287. * better splitname to support glib-1.1.dll alike names
  1288. Revision 1.80 1998/10/16 13:37:17 florian
  1289. + switch -FD added to specify the path for utilities
  1290. Revision 1.79 1998/10/16 08:51:46 peter
  1291. + target_os.stackalignment
  1292. + stack can be aligned at 2 or 4 byte boundaries
  1293. Revision 1.78 1998/10/14 13:38:21 peter
  1294. * fixed path with staticlib/objects in ppufiles
  1295. Revision 1.77 1998/10/13 14:01:09 peter
  1296. * fixed -al
  1297. Revision 1.76 1998/10/13 13:10:15 peter
  1298. * new style for m68k/i386 infos and enums
  1299. Revision 1.75 1998/10/13 08:19:32 pierre
  1300. + source_os is now set correctly for cross-processor compilers
  1301. (tos contains all target_infos and
  1302. we use CPU86 and CPU68 conditionals to
  1303. get the source operating system
  1304. this only works if you do not undefine
  1305. the source target !!)
  1306. * several cg68k memory leaks fixed
  1307. + started to change the code so that it should be possible to have
  1308. a complete compiler (both for m68k and i386 !!)
  1309. Revision 1.74 1998/10/12 10:28:29 florian
  1310. + auto dereferencing of pointers to structured types in delphi mode
  1311. Revision 1.73 1998/10/12 09:49:56 florian
  1312. + support of <procedure var type>:=<pointer> in delphi mode added
  1313. Revision 1.72 1998/10/06 17:16:48 pierre
  1314. * some memory leaks fixed (thanks to Peter for heaptrc !)
  1315. Revision 1.71 1998/09/30 19:53:54 michael
  1316. + Upgraded to version 0.99.9
  1317. Revision 1.70 1998/09/29 15:23:03 peter
  1318. * remove also the end files for smartlinking
  1319. Revision 1.69 1998/09/26 17:45:28 peter
  1320. + idtoken and only one token table
  1321. Revision 1.68 1998/09/24 23:49:04 peter
  1322. + aktmodeswitches
  1323. Revision 1.67 1998/09/22 17:13:46 pierre
  1324. + browsing updated and developed
  1325. records and objects fields are also stored
  1326. Revision 1.66 1998/09/22 15:40:54 peter
  1327. * some extra ifdef GDB
  1328. Revision 1.65 1998/09/18 16:03:38 florian
  1329. * some changes to compile with Delphi
  1330. Revision 1.64 1998/09/10 15:25:29 daniel
  1331. + Added maxheapsize.
  1332. * Corrected semi-bug in calling the assembler and the linker
  1333. Revision 1.63 1998/09/09 18:17:13 florian
  1334. * version number changed to 0.99.8
  1335. Revision 1.62 1998/09/07 17:36:59 florian
  1336. * first fixes for published properties
  1337. Revision 1.61 1998/09/03 11:21:52 peter
  1338. * -al sets cs_asm_source
  1339. Revision 1.60 1998/09/01 12:53:20 peter
  1340. + aktpackenum
  1341. Revision 1.59 1998/09/01 07:54:18 pierre
  1342. * UseBrowser a little updated (might still be buggy !!)
  1343. * bug in psub.pas in function specifier removed
  1344. * stdcall allowed in interface and in implementation
  1345. (FPC will not yet complain if it is missing in either part
  1346. because stdcall is only a dummy !!)
  1347. Revision 1.58 1998/08/31 12:26:25 peter
  1348. * m68k and palmos updates from surebugfixes
  1349. Revision 1.57 1998/08/29 13:51:09 peter
  1350. * moved get_exepath to globals
  1351. + date_string const with the current date for 0.99.7+
  1352. Revision 1.56 1998/08/26 15:35:31 peter
  1353. * fixed scannerfiles for macros
  1354. + $I %<environment>%
  1355. Revision 1.55 1998/08/25 12:42:35 pierre
  1356. * CDECL changed to CVAR for variables
  1357. specifications are read in structures also
  1358. + started adding GPC compatibility mode ( option -Sp)
  1359. * names changed to lowercase
  1360. Revision 1.54 1998/08/19 18:04:53 peter
  1361. * fixed current_module^.in_implementation flag
  1362. Revision 1.53 1998/08/19 16:07:45 jonas
  1363. * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
  1364. Revision 1.52 1998/08/19 10:06:13 peter
  1365. * fixed filenames and removedir which supports slash at the end
  1366. Revision 1.51 1998/08/17 09:17:46 peter
  1367. * static/shared linking updates
  1368. Revision 1.50 1998/08/14 21:56:33 peter
  1369. * setting the outputfile using -o works now to create static libs
  1370. Revision 1.49 1998/08/13 10:57:31 peter
  1371. * constant sets are now written correctly to the ppufile
  1372. Revision 1.48 1998/08/11 15:31:37 peter
  1373. * write extended to ppu file
  1374. * new version 0.99.7
  1375. Revision 1.47 1998/08/10 14:49:59 peter
  1376. + localswitches, moduleswitches, globalswitches splitting
  1377. Revision 1.46 1998/08/10 10:18:25 peter
  1378. + Compiler,Comphook unit which are the new interface units to the
  1379. compiler
  1380. Revision 1.45 1998/07/24 22:16:56 florian
  1381. * internal error 10 together with array access fixed. I hope
  1382. that's the final fix.
  1383. Revision 1.44 1998/07/18 17:11:08 florian
  1384. + ansi string constants fixed
  1385. + switch $H partial implemented
  1386. Revision 1.43 1998/07/14 21:46:42 peter
  1387. * updated messages file
  1388. Revision 1.42 1998/07/08 14:28:35 daniel
  1389. * Fixed small TP incompatibility: Fsplit requires use of dirstr, namestr and
  1390. extstr
  1391. Revision 1.41 1998/07/07 11:19:56 peter
  1392. + NEWINPUT for a better inputfile and scanner object
  1393. Revision 1.40 1998/06/25 08:48:13 florian
  1394. * first version of rtti support
  1395. Revision 1.39 1998/06/17 14:10:12 peter
  1396. * small os2 fixes
  1397. * fixed interdependent units with newppu (remake3 under linux works now)
  1398. Revision 1.38 1998/06/16 08:56:21 peter
  1399. + targetcpu
  1400. * cleaner pmodules for newppu
  1401. Revision 1.37 1998/06/13 00:10:06 peter
  1402. * working browser and newppu
  1403. * some small fixes against crashes which occured in bp7 (but not in
  1404. fpc?!)
  1405. Revision 1.36 1998/06/12 16:15:31 pierre
  1406. * external name 'C_var';
  1407. export name 'intern_C_var';
  1408. cdecl;
  1409. cdecl;external;
  1410. are now supported only with -Sv switch
  1411. Revision 1.34 1998/06/04 23:51:39 peter
  1412. * m68k compiles
  1413. + .def file creation moved to gendef.pas so it could also be used
  1414. for win32
  1415. Revision 1.33 1998/06/03 22:48:54 peter
  1416. + wordbool,longbool
  1417. * rename bis,von -> high,low
  1418. * moved some systemunit loading/creating to psystem.pas
  1419. Revision 1.32 1998/05/30 14:31:04 peter
  1420. + $ASMMODE
  1421. Revision 1.31 1998/05/28 14:40:24 peter
  1422. * fixes for newppu, remake3 works now with it
  1423. Revision 1.30 1998/05/27 19:45:03 peter
  1424. * symtable.pas splitted into includefiles
  1425. * symtable adapted for $ifdef NEWPPU
  1426. Revision 1.29 1998/05/25 17:11:39 pierre
  1427. * firstpasscount bug fixed
  1428. now all is already set correctly the first time
  1429. under EXTDEBUG try -gp to skip all other firstpasses
  1430. it works !!
  1431. * small bug fixes
  1432. - for smallsets with -dTESTSMALLSET
  1433. - some warnings removed (by correcting code !)
  1434. Revision 1.28 1998/05/23 01:21:07 peter
  1435. + aktasmmode, aktoptprocessor, aktoutputformat
  1436. + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  1437. + $LIBNAME to set the library name where the unit will be put in
  1438. * splitted cgi386 a bit (codeseg to large for bp7)
  1439. * nasm, tasm works again. nasm moved to ag386nsm.pas
  1440. Revision 1.27 1998/05/20 09:42:33 pierre
  1441. + UseTokenInfo now default
  1442. * unit in interface uses and implementation uses gives error now
  1443. * only one error for unknown symbol (uses lastsymknown boolean)
  1444. the problem came from the label code !
  1445. + first inlined procedures and function work
  1446. (warning there might be allowed cases were the result is still wrong !!)
  1447. * UseBrower updated gives a global list of all position of all used symbols
  1448. with switch -gb
  1449. Revision 1.26 1998/05/12 10:46:59 peter
  1450. * moved printstatus to verb_def
  1451. + V_Normal which is between V_Error and V_Warning and doesn't have a
  1452. prefix like error: warning: and is included in V_Default
  1453. * fixed some messages
  1454. * first time parameter scan is only for -v and -T
  1455. - removed old style messages
  1456. Revision 1.25 1998/05/11 13:07:54 peter
  1457. + $ifdef NEWPPU for the new ppuformat
  1458. + $define GDB not longer required
  1459. * removed all warnings and stripped some log comments
  1460. * no findfirst/findnext anymore to remove smartlink *.o files
  1461. Revision 1.24 1998/05/08 09:21:20 michael
  1462. * Added missing -Fl message to messages file.
  1463. * Corrected mangling of file names when doing Linklib
  1464. * -Fl now actually WORKS.
  1465. * Librarysearchpath is now a field in linker object.
  1466. Revision 1.23 1998/05/06 15:04:20 pierre
  1467. + when trying to find source files of a ppufile
  1468. check the includepathlist for included files
  1469. the main file must still be in the same directory
  1470. Revision 1.22 1998/05/06 08:38:39 pierre
  1471. * better position info with UseTokenInfo
  1472. UseTokenInfo greatly simplified
  1473. + added check for changed tree after first time firstpass
  1474. (if we could remove all the cases were it happen
  1475. we could skip all firstpass if firstpasscount > 1)
  1476. Only with ExtDebug
  1477. Revision 1.21 1998/05/04 17:54:25 peter
  1478. + smartlinking works (only case jumptable left todo)
  1479. * redesign of systems.pas to support assemblers and linkers
  1480. + Unitname is now also in the PPU-file, increased version to 14
  1481. Revision 1.20 1998/05/01 07:43:53 florian
  1482. + basics for rtti implemented
  1483. + switch $m (generate rtti for published sections)
  1484. Revision 1.19 1998/04/30 15:59:40 pierre
  1485. * GDB works again better :
  1486. correct type info in one pass
  1487. + UseTokenInfo for better source position
  1488. * fixed one remaining bug in scanner for line counts
  1489. * several little fixes
  1490. Revision 1.18 1998/04/29 10:33:52 pierre
  1491. + added some code for ansistring (not complete nor working yet)
  1492. * corrected operator overloading
  1493. * corrected nasm output
  1494. + started inline procedures
  1495. + added starstarn : use ** for exponentiation (^ gave problems)
  1496. + started UseTokenInfo cond to get accurate positions
  1497. Revision 1.17 1998/04/27 23:10:28 peter
  1498. + new scanner
  1499. * $makelib -> if smartlink
  1500. * small filename fixes pmodule.setfilename
  1501. * moved import from files.pas -> import.pas
  1502. Revision 1.16 1998/04/27 15:45:20 peter
  1503. + -Xl for smartlink
  1504. + target_info.arext = .a
  1505. Revision 1.15 1998/04/22 21:06:50 florian
  1506. * last fixes before the release:
  1507. - veryyyy slow firstcall fixed
  1508. Revision 1.14 1998/04/21 13:48:09 michael
  1509. + Updated patch number
  1510. Revision 1.13 1998/04/21 10:16:47 peter
  1511. * patches from strasbourg
  1512. * objects is not used anymore in the fpc compiled version
  1513. Revision 1.12 1998/04/09 14:28:06 jonas
  1514. + basic k6 and 6x86 optimizing support (-O7 and -O8)
  1515. Revision 1.11 1998/04/08 16:58:02 pierre
  1516. * several bugfixes
  1517. ADD ADC and AND are also sign extended
  1518. nasm output OK (program still crashes at end
  1519. and creates wrong assembler files !!)
  1520. procsym types sym in tdef removed !!
  1521. Revision 1.10 1998/04/08 11:34:22 peter
  1522. * nasm works (linux only tested)
  1523. Revision 1.9 1998/04/07 21:37:30 peter
  1524. * fixed fixpath to also change / and \ slashes and better addpathtolist
  1525. Revision 1.8 1998/04/07 13:19:44 pierre
  1526. * bugfixes for reset_gdb_info
  1527. in MEM parsing for go32v2
  1528. better external symbol creation
  1529. support for rhgdb.exe (lowercase file names)
  1530. Revision 1.7 1998/04/06 16:19:46 peter
  1531. * fixed the -Up.. bug
  1532. }