globals.pas 51 KB

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