globals.pas 49 KB

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