development/compilers/freepascal/compiler/globals.pas

   1 {
   2     $Id$
   3     Copyright (C) 1998-2000 by Florian Klaempfl
   4
   5     This unit implements some support functions and global variables
   6
   7     This program is free software; you can redistribute it and/or modify
   8     it under the terms of the GNU General Public License as published by
   9     the Free Software Foundation; either version 2 of the License, or
  10     (at your option) any later version.
  11
  12     This program is distributed in the hope that it will be useful,
  13     but WITHOUT ANY WARRANTY; without even the implied warranty of
  14     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15     GNU General Public License for more details.
  16
  17     You should have received a copy of the GNU General Public License
  18     along with this program; if not, write to the Free Software
  19     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20
  21  ****************************************************************************
  22 }
  23
  24 {$ifdef tp}
  25   {$E+,N+}
  26 {$endif}
  27
  28 unit globals;
  29
  30   interface
  31
  32     uses
  33 {$ifdef win32}
  34       windows,
  35 {$endif}
  36 {$ifdef linux}
  37       linux,
  38 {$endif}
  39 {$ifdef Delphi}
  40       sysutils,
  41       dmisc,
  42 {$else}
  43       strings,dos,
  44 {$endif}
  45 {$ifdef TP}
  46       objects,
  47 {$endif}
  48       globtype,version,tokens,systems,cobjects;
  49
  50     const
  51 {$ifdef linux}
  52        DirSep = '/';
  53 {$else}
  54   {$ifdef amiga}
  55        DirSep = '/';
  56   {$else}
  57   {$ifdef aros}
  58        DirSep = '/';
  59   {$else}
  60
  61        DirSep = '\';
  62   {$endif}
  63 {$endif}
  64 {$endif}
  65
  66 {$ifdef Splitheap}
  67        testsplit : boolean = false;
  68 {$endif Splitheap}
  69
  70        delphimodeswitches : tmodeswitches=
  71          [m_delphi,m_tp,m_all,m_class,m_objpas,m_result,m_string_pchar,
  72           m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal,m_default_ansistring];
  73        fpcmodeswitches    : tmodeswitches=
  74          [m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward,
  75           m_cvar_support,m_initfinal,m_add_pointer];
  76        objfpcmodeswitches : tmodeswitches=
  77          [m_objfpc,m_fpc,m_all,m_class,m_objpas,m_result,m_string_pchar,m_nested_comment,
  78           m_repeat_forward,m_cvar_support,m_initfinal,m_add_pointer];
  79        tpmodeswitches     : tmodeswitches=
  80          [m_tp7,m_tp,m_all,m_tp_procvar];
  81        gpcmodeswitches    : tmodeswitches=
  82          [m_gpc,m_all];
  83
  84     type
  85        TSearchPathList = object(TStringQueue)
  86          procedure AddPath(s:string;addfirst:boolean);
  87          procedure AddList(list:TSearchPathList;addfirst:boolean);
  88          function  FindFile(const f : string;var b : boolean) : string;
  89        end;
  90
  91     var
  92        { specified inputfile }
  93        inputdir       : dirstr;
  94        inputfile      : namestr;
  95        inputextension : extstr;
  96        { specified outputfile with -o parameter }
  97        outputfile     : namestr;
  98        { specified with -FE or -FU }
  99        outputexedir   : dirstr;
 100        outputunitdir  : dirstr;
 101
 102        { things specified with parameters }
 103        paralinkoptions,
 104        paradynamiclinker : string;
 105        parapreprocess    : boolean;
 106
 107        { directory where the utils can be found (options -FD) }
 108        utilsdirectory : dirstr;
 109
 110        { some flags for global compiler switches }
 111        do_build,
 112        do_make       : boolean;
 113        not_unit_proc : boolean;
 114        { path for searching units, different paths can be seperated by ; }
 115        exepath            : dirstr;  { Path to ppc }
 116        librarysearchpath,
 117        unitsearchpath,
 118        objectsearchpath,
 119        includesearchpath  : TSearchPathList;
 120
 121        { deffile }
 122        usewindowapi  : boolean;
 123        description   : string;
 124        dllversion    : string;
 125        dllmajor,dllminor : word;
 126
 127        { current position }
 128        token,                        { current token being parsed }
 129        idtoken    : ttoken;          { holds the token if the pattern is a known word }
 130        tokenpos,                     { last postion of the read token }
 131        aktfilepos : tfileposinfo;    { current position }
 132
 133        { type of currently parsed block }
 134        { isn't full implemented (FK)    }
 135        block_type : tblock_type;
 136
 137        in_args : boolean;                { arguments must be checked especially }
 138        parsing_para_level : longint;     { parameter level, used to convert
 139                                              proc calls to proc loads in firstcalln }
 140        { Must_be_valid : boolean;           should the variable already have a value
 141         obsolete replace by set_varstate function }
 142        compile_level : word;
 143        make_ref : boolean;
 144        resolving_forward : boolean;      { used to add forward reference as second ref }
 145        use_esp_stackframe : boolean;     { to test for call with ESP as stack frame }
 146        inlining_procedure : boolean;     { are we inlining a procedure }
 147
 148 {$ifdef TP}
 149        use_big      : boolean;
 150 {$endif}
 151
 152      { commandline values }
 153        initdefines        : tlinkedlist;
 154        initglobalswitches : tglobalswitches;
 155        initmoduleswitches : tmoduleswitches;
 156        initlocalswitches  : tlocalswitches;
 157        initmodeswitches   : tmodeswitches;
 158        {$IFDEF testvarsets}
 159         Initsetalloc,                            {0=fixed, 1 =var}
 160        {$ENDIF}
 161        initpackenum       : longint;
 162        initpackrecords    : tpackrecords;
 163        initoutputformat   : tasm;
 164        initoptprocessor,
 165        initspecificoptprocessor : tprocessors;
 166        initasmmode        : tasmmode;
 167      { current state values }
 168        aktglobalswitches : tglobalswitches;
 169        aktmoduleswitches : tmoduleswitches;
 170        aktlocalswitches  : tlocalswitches;
 171        nextaktlocalswitches : tlocalswitches;
 172        localswitcheschanged : boolean;
 173        aktmodeswitches   : tmodeswitches;
 174        {$IFDEF testvarsets}
 175         aktsetalloc,
 176        {$ENDIF}
 177        aktpackenum       : longint;
 178        aktmaxfpuregisters: longint;
 179        aktpackrecords    : tpackrecords;
 180        aktoutputformat   : tasm;
 181        aktoptprocessor,
 182        aktspecificoptprocessor : tprocessors;
 183        aktasmmode        : tasmmode;
 184
 185      { Memory sizes }
 186        heapsize,
 187        maxheapsize,
 188        stacksize    : longint;
 189
 190 {$Ifdef EXTDEBUG}
 191        total_of_firstpass,
 192        firstpass_several : longint;
 193 {$ifdef FPC}
 194        EntryMemUsed : longint;
 195 {$endif FPC}
 196      { parameter switches }
 197        debugstop,
 198        only_one_pass : boolean;
 199 {$EndIf EXTDEBUG}
 200        { windows application type }
 201        apptype : tapptype;
 202
 203     const
 204        RelocSection : boolean = true;
 205        RelocSectionSetExplicitly : boolean = false;
 206        LinkTypeSetExplicitly : boolean = false;
 207        DLLsource : boolean = false;
 208        DLLImageBase : pstring = nil;
 209        UseDeffileForExport : boolean = true;
 210        ForceDeffileForExport : boolean = false;
 211
 212        { used to set all registers used for each global function
 213          this should dramatically decrease the number of
 214          recompilations needed PM }
 215        simplify_ppu : boolean = false;
 216
 217        { should we allow non static members ? }
 218        allow_only_static : boolean = false;
 219
 220        Inside_asm_statement : boolean = false;
 221
 222     { for error info in pp.pas }
 223     const
 224        parser_current_file : string = '';
 225
 226 {$ifdef debug}
 227     { if the pointer don't point to the heap then write an error }
 228     function assigned(p : pointer) : boolean;
 229 {$endif}
 230     function min(a,b : longint) : longint;
 231     function max(a,b : longint) : longint;
 232     function align(i,a:longint):longint;
 233     function align_from_size(datasize:longint;length:longint):longint;
 234     procedure Replace(var s:string;s1:string;const s2:string);
 235     procedure ReplaceCase(var s:string;const s1,s2:string);
 236     function upper(const s : string) : string;
 237     function lower(const s : string) : string;
 238     function trimspace(const s:string):string;
 239     {$ifdef FPC}
 240     function tostru(i:cardinal) : string;
 241     {$else}
 242     function tostru(i:longint) : string;
 243     {$endif}
 244     procedure uppervar(var s : string);
 245     function hexstr(val : longint;cnt : byte) : string;
 246     function tostr(i : longint) : string;
 247     function tostr_with_plus(i : longint) : string;
 248     procedure valint(S : string;var V : longint;var code : integer);
 249     function is_number(const s : string) : boolean;
 250     function ispowerof2(value : longint;var power : longint) : boolean;
 251     { enable ansistring comparison }
 252     function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint;
 253     function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
 254     function bstoslash(const s : string) : string;
 255     procedure abstract;
 256
 257     function getdatestr:string;
 258     function gettimestr:string;
 259     function filetimestring( t : longint) : string;
 260
 261     procedure DefaultReplacements(var s:string);
 262     function  GetCurrentDir:string;
 263     function  path_absolute(const s : string) : boolean;
 264     Function  PathExists ( F : String) : Boolean;
 265     Function  FileExists ( Const F : String) : Boolean;
 266     Function  RemoveFile(const f:string):boolean;
 267     Function  RemoveDir(d:string):boolean;
 268     Function  GetFileTime ( Var F : File) : Longint;
 269     Function  GetNamedFileTime ( Const F : String) : Longint;
 270     Function  SplitPath(const s:string):string;
 271     Function  SplitFileName(const s:string):string;
 272     Function  SplitName(const s:string):string;
 273     Function  SplitExtension(Const HStr:String):String;
 274     Function  AddExtension(Const HStr,ext:String):String;
 275     Function  ForceExtension(Const HStr,ext:String):String;
 276     Function  FixPath(s:string;allowdot:boolean):string;
 277     function  FixFileName(const s:string):string;
 278     procedure SplitBinCmd(const s:string;var bstr,cstr:string);
 279     procedure SynchronizeFileTime(const fn1,fn2:string);
 280     function  FindFile(const f : string;path : string;var b : boolean) : string;
 281     function  FindExe(bin:string;var found:boolean):string;
 282     function  GetShortName(const n:string):string;
 283
 284     Procedure Shell(const command:string);
 285     function  GetEnvPChar(const envname:string):pchar;
 286     procedure FreeEnvPChar(p:pchar);
 287
 288     Function SetCompileMode(const s:string; changeInit: boolean):boolean;
 289
 290     procedure InitGlobals;
 291     procedure DoneGlobals;
 292
 293
 294 implementation
 295
 296     uses
 297       comphook;
 298
 299     procedure abstract;
 300       begin
 301         do_internalerror(255);
 302       end;
 303
 304
 305     function ngraphsearchvalue(const s1,s2 : string) : double;
 306       const
 307          n = 3;
 308       var
 309          equals,i,j : longint;
 310          hs : string;
 311       begin
 312          equals:=0;
 313          { is the string long enough ? }
 314          if min(length(s1),length(s2))-n+1<1 then
 315            begin
 316               ngraphsearchvalue:=0.0;
 317               exit;
 318            end;
 319          for i:=1 to length(s1)-n+1 do
 320            begin
 321               hs:=copy(s1,i,n);
 322               for j:=1 to length(s2)-n+1 do
 323                 if hs=copy(s2,j,n) then
 324                   inc(equals);
 325            end;
 326 {$ifdef fpc}
 327          ngraphsearchvalue:=equals/double(max(length(s1),length(s2))-n+1);
 328 {$else}
 329          ngraphsearchvalue:=equals/(max(length(s1),length(s2))-n+1);
 330 {$endif}
 331       end;
 332
 333
 334     function bstoslash(const s : string) : string;
 335     {
 336       return string s with all \ changed into /
 337     }
 338       var
 339          i : longint;
 340       begin
 341         for i:=1to length(s) do
 342          if s[i]='\' then
 343           bstoslash[i]:='/'
 344          else
 345           bstoslash[i]:=s[i];
 346          {$ifndef TP}
 347            {$ifopt H+}
 348              setlength(bstoslash,length(s));
 349            {$else}
 350              bstoslash[0]:=s[0];
 351            {$endif}
 352          {$else}
 353            bstoslash[0]:=s[0];
 354          {$endif}
 355       end;
 356
 357 {$ifdef debug}
 358
 359     function assigned(p : pointer) : boolean;
 360 {$ifndef FPC}
 361     {$ifndef DPMI}
 362       type
 363          ptrrec = record
 364             ofs,seg : word;
 365          end;
 366       var
 367          lp : longint;
 368     {$endif DPMI}
 369 {$endif FPC}
 370       begin
 371 {$ifdef FPC}
 372           { Assigned is used for procvar and
 373             stack stored temp records !! PM }
 374          (* if (p<>nil) {and
 375             ((p<heaporg) or
 376             (p>heapptr))} then
 377            do_internalerror(230); *)
 378 {$else}
 379     {$ifdef DPMI}
 380          assigned:=(p<>nil);
 381          exit;
 382     {$else DPMI}
 383          if p=nil then
 384            lp:=0
 385          else
 386            lp:=longint(ptrrec(p).seg)*16+longint(ptrrec(p).ofs);
 387          if (lp<>0) and
 388             ((lp<longint(seg(heaporg^))*16+longint(ofs(heaporg^))) or
 389             (lp>longint(seg(heapptr^))*16+longint(ofs(heapptr^)))) then
 390            do_internalerror(230);
 391     {$endif DPMI}
 392 {$endif FPC}
 393          assigned:=(p<>nil);
 394       end;
 395 {$endif}
 396
 397
 398     function min(a,b : longint) : longint;
 399     {
 400       return the minimal of a and b
 401     }
 402       begin
 403          if a>b then
 404            min:=b
 405          else
 406            min:=a;
 407       end;
 408
 409
 410     function max(a,b : longint) : longint;
 411     {
 412       return the maximum of a and b
 413     }
 414       begin
 415          if a<b then
 416            max:=b
 417          else
 418            max:=a;
 419       end;
 420
 421     function align_from_size(datasize:longint;length:longint):longint;
 422
 423     {Increases the datasize with the required alignment; i.e. on pentium
 424      words should be aligned word; and dwords should be aligned dword.
 425      So for a word (len=2), datasize is increased to the nearest multiple
 426      of 2, and for len=4, datasize is increased to the nearest multiple of
 427      4.}
 428
 429     var data_align:word;
 430
 431     begin
 432         {$IFDEF I386}
 433         if length>2 then
 434             data_align:=4
 435         else if length>1 then
 436             data_align:=2
 437         else
 438             data_align:=1;
 439         {$ENDIF}
 440         {$IFDEF M68K}
 441         data_align:=2;
 442         {$ENDIF}
 443         align_from_size:=(datasize+data_align-1) and not(data_align-1);
 444     end;
 445
 446
 447     function align(i,a:longint):longint;
 448     {
 449       return value <i> aligned <a> boundary
 450     }
 451       begin
 452         align:=(i+a-1) and not(a-1);
 453       end;
 454
 455
 456     procedure Replace(var s:string;s1:string;const s2:string);
 457       var
 458          last,
 459          i  : longint;
 460       begin
 461         s1:=upper(s1);
 462         last:=0;
 463         repeat
 464           i:=pos(s1,upper(s));
 465           if i=last then
 466            i:=0;
 467           if (i>0) then
 468            begin
 469              Delete(s,i,length(s1));
 470              Insert(s2,s,i);
 471              last:=i;
 472            end;
 473         until (i=0);
 474       end;
 475
 476
 477     procedure ReplaceCase(var s:string;const s1,s2:string);
 478       var
 479          last,
 480          i  : longint;
 481       begin
 482         last:=0;
 483         repeat
 484           i:=pos(s1,s);
 485           if i=last then
 486            i:=0;
 487           if (i>0) then
 488            begin
 489              Delete(s,i,length(s1));
 490              Insert(s2,s,i);
 491              last:=i;
 492            end;
 493         until (i=0);
 494       end;
 495
 496
 497     function upper(const s : string) : string;
 498     {
 499       return uppercased string of s
 500     }
 501       var
 502          i  : longint;
 503       begin
 504          for i:=1 to length(s) do
 505           if s[i] in ['a'..'z'] then
 506            upper[i]:=char(byte(s[i])-32)
 507           else
 508            upper[i]:=s[i];
 509         upper[0]:=s[0];
 510       end;
 511
 512
 513     function lower(const s : string) : string;
 514     {
 515       return lowercased string of s
 516     }
 517       var
 518          i : longint;
 519       begin
 520          for i:=1 to length(s) do
 521           if s[i] in ['A'..'Z'] then
 522            lower[i]:=char(byte(s[i])+32)
 523           else
 524            lower[i]:=s[i];
 525         lower[0]:=s[0];
 526       end;
 527
 528
 529     procedure uppervar(var s : string);
 530     {
 531       uppercase string s
 532     }
 533       var
 534          i : longint;
 535       begin
 536          for i:=1 to length(s) do
 537           if s[i] in ['a'..'z'] then
 538            s[i]:=char(byte(s[i])-32);
 539       end;
 540
 541     function hexstr(val : longint;cnt : byte) : string;
 542       const
 543         HexTbl : array[0..15] of char='0123456789ABCDEF';
 544       var
 545         i : longint;
 546       begin
 547         hexstr[0]:=char(cnt);
 548         for i:=cnt downto 1 do
 549          begin
 550            hexstr[i]:=hextbl[val and $f];
 551            val:=val shr 4;
 552          end;
 553       end;
 554
 555 {$ifdef FPC}
 556    function tostru(i:cardinal):string;
 557    {
 558      return string of value i, but for cardinals
 559    }
 560       var
 561         hs : string;
 562       begin
 563         str(i,hs);
 564         tostru:=hs;
 565       end;
 566 {$else FPC}
 567     function tostru(i:longint):string;
 568       begin
 569         tostru:=tostr(i);
 570       end;
 571 {$endif FPC}
 572
 573
 574    function trimspace(const s:string):string;
 575    {
 576      return s with all leading and ending spaces and tabs removed
 577    }
 578      var
 579        i,j : longint;
 580      begin
 581        i:=length(s);
 582        while (i>0) and (s[i] in [#9,' ']) do
 583         dec(i);
 584        j:=1;
 585        while (j<i) and (s[j] in [#9,' ']) do
 586         inc(j);
 587        trimspace:=Copy(s,j,i-j+1);
 588      end;
 589
 590
 591    function tostr(i : longint) : string;
 592    {
 593      return string of value i
 594    }
 595      var
 596         hs : string;
 597      begin
 598         str(i,hs);
 599         tostr:=hs;
 600      end;
 601
 602
 603    function tostr_with_plus(i : longint) : string;
 604    {
 605      return string of value i, but always include a + when i>=0
 606    }
 607      var
 608         hs : string;
 609      begin
 610         str(i,hs);
 611         if i>=0 then
 612           tostr_with_plus:='+'+hs
 613         else
 614           tostr_with_plus:=hs;
 615      end;
 616
 617
 618     procedure valint(S : string;var V : longint;var code : integer);
 619     {
 620       val() with support for octal, which is not supported under tp7
 621     }
 622 {$ifndef FPC}
 623       var
 624         vs : longint;
 625         c  : byte;
 626       begin
 627         if s[1]='%' then
 628           begin
 629              vs:=0;
 630              longint(v):=0;
 631              for c:=2 to length(s) do
 632                begin
 633                   if s[c]='0' then
 634                     vs:=vs shl 1
 635                   else
 636                   if s[c]='1' then
 637                     vs:=vs shl 1+1
 638                   else
 639                     begin
 640                       code:=c;
 641                       exit;
 642                     end;
 643                end;
 644              code:=0;
 645              longint(v):=vs;
 646           end
 647         else
 648          system.val(S,V,code);
 649       end;
 650 {$else not FPC}
 651       begin
 652          system.val(S,V,code);
 653       end;
 654 {$endif not FPC}
 655
 656
 657     function is_number(const s : string) : boolean;
 658     {
 659       is string a correct number ?
 660     }
 661       var
 662          w : integer;
 663          l : longint;
 664       begin
 665          valint(s,l,w);
 666          is_number:=(w=0);
 667       end;
 668
 669
 670     function ispowerof2(value : longint;var power : longint) : boolean;
 671     {
 672       return if value is a power of 2. And if correct return the power
 673     }
 674       var
 675          hl : longint;
 676          i : longint;
 677       begin
 678          hl:=1;
 679          ispowerof2:=true;
 680          for i:=0 to 31 do
 681            begin
 682               if hl=value then
 683                 begin
 684                    power:=i;
 685                    exit;
 686                 end;
 687               hl:=hl shl 1;
 688            end;
 689          ispowerof2:=false;
 690       end;
 691
 692
 693     { enable ansistring comparison }
 694     { 0 means equal }
 695     { 1 means p1 > p2 }
 696     { -1 means p1 < p2 }
 697     function compareansistrings(p1,p2 : pchar;length1,length2 : longint) : longint;
 698
 699       var
 700          i,j : longint;
 701       begin
 702          compareansistrings:=0;
 703          j:=min(length1,length2);
 704          i:=0;
 705          while (i<j) do
 706           begin
 707             if p1[i]>p2[i] then
 708              begin
 709                compareansistrings:=1;
 710                exit;
 711              end
 712             else
 713              if p1[i]<p2[i] then
 714               begin
 715                 compareansistrings:=-1;
 716                 exit;
 717               end;
 718             inc(i);
 719           end;
 720          if length1>length2 then
 721           compareansistrings:=1
 722          else
 723           if length1<length2 then
 724            compareansistrings:=-1;
 725       end;
 726
 727
 728     function concatansistrings(p1,p2 : pchar;length1,length2 : longint) : pchar;
 729       var
 730          p : pchar;
 731       begin
 732          getmem(p,length1+length2+1);
 733          move(p1[0],p[0],length1);
 734          move(p2[0],p[length1],length2+1);
 735          concatansistrings:=p;
 736       end;
 737
 738
 739 {****************************************************************************
 740                                Time Handling
 741 ****************************************************************************}
 742
 743     Function L0(l:longint):string;
 744     {
 745       return the string of value l, if l<10 then insert a zero, so
 746       the string is always at least 2 chars '01','02',etc
 747     }
 748       var
 749         s : string;
 750       begin
 751         Str(l,s);
 752         if l<10 then
 753          s:='0'+s;
 754         L0:=s;
 755       end;
 756
 757
 758    function gettimestr:string;
 759    {
 760      get the current time in a string HH:MM:SS
 761    }
 762       var
 763         hour,min,sec,hsec : word;
 764       begin
 765 {$ifdef delphi}
 766         dmisc.gettime(hour,min,sec,hsec);
 767 {$else delphi}
 768         dos.gettime(hour,min,sec,hsec);
 769 {$endif delphi}
 770         gettimestr:=L0(Hour)+':'+L0(min)+':'+L0(sec);
 771       end;
 772
 773
 774    function getdatestr:string;
 775    {
 776      get the current date in a string YY/MM/DD
 777    }
 778       var
 779         Year,Month,Day,Wday : Word;
 780       begin
 781 {$ifdef delphi}
 782         dmisc.getdate(year,month,day,wday);
 783 {$else}
 784         dos.getdate(year,month,day,wday);
 785 {$endif}
 786         getdatestr:=L0(Year)+'/'+L0(Month)+'/'+L0(Day);
 787       end;
 788
 789
 790    function  filetimestring( t : longint) : string;
 791    {
 792      convert dos datetime t to a string YY/MM/DD HH:MM:SS
 793    }
 794      var
 795      {$ifndef linux}
 796        DT : DateTime;
 797      {$endif}
 798        Year,Month,Day,Hour,Min,Sec : Word;
 799      begin
 800        if t=-1 then
 801         begin
 802           FileTimeString:='Not Found';
 803           exit;
 804         end;
 805      {$ifndef linux}
 806        unpacktime(t,DT);
 807        Year:=dT.year;month:=dt.month;day:=dt.day;
 808        Hour:=dt.hour;min:=dt.min;sec:=dt.sec;
 809      {$else}
 810        EpochToLocal (t,year,month,day,hour,min,sec);
 811      {$endif}
 812        filetimestring:=L0(Year)+'/'+L0(Month)+'/'+L0(Day)+' '+L0(Hour)+':'+L0(min)+':'+L0(sec);
 813      end;
 814
 815
 816 {****************************************************************************
 817                           Default Macro Handling
 818 ****************************************************************************}
 819
 820      procedure DefaultReplacements(var s:string);
 821        begin
 822          { Replace some macro's }
 823          Replace(s,'$FPCVER',version_string);
 824          Replace(s,'$VERSION',version_string);
 825          Replace(s,'$FULLVERSION',full_version_string);
 826          Replace(s,'$FPCDATE',date_string);
 827          Replace(s,'$FPCTARGET',target_cpu_string);
 828          Replace(s,'$FPCCPU',target_cpu_string);
 829          Replace(s,'$TARGET',target_path);
 830          Replace(s,'$FPCOS',target_path);
 831        end;
 832
 833
 834 {****************************************************************************
 835                                File Handling
 836 ****************************************************************************}
 837
 838    function GetCurrentDir:string;
 839      var
 840        CurrentDir : string;
 841      begin
 842        GetDir(0,CurrentDir);
 843        GetCurrentDir:=FixPath(CurrentDir,false);
 844      end;
 845
 846
 847    function path_absolute(const s : string) : boolean;
 848    {
 849      is path s an absolute path?
 850    }
 851      begin
 852         path_absolute:=false;
 853 {$ifdef linux}
 854         if (length(s)>0) and (s[1]='/') then
 855           path_absolute:=true;
 856 {$else linux}
 857   {$ifdef amiga}
 858         if ((length(s)>0) and ((s[1]='\') or (s[1]='/'))) or (Pos(':',s) = length(s)) then
 859           path_absolute:=true;
 860   {$else}
 861         if ((length(s)>0) and ((s[1]='\') or (s[1]='/'))) or
 862            ((length(s)>2) and (s[2]=':') and ((s[3]='\') or (s[3]='/'))) then
 863           path_absolute:=true;
 864   {$endif amiga}
 865 {$endif linux}
 866      end;
 867
 868 {$ifndef FPC}
 869     Procedure FindClose(var Info : SearchRec);
 870       Begin
 871       End;
 872 {$endif not FPC}
 873
 874
 875     Function FileExists ( Const F : String) : Boolean;
 876 {$ifndef delphi}
 877       Var
 878          Info : SearchRec;
 879 {$endif}
 880       begin
 881 {$ifdef delphi}
 882          FileExists:=sysutils.FileExists(f);
 883 {$else}
 884         findfirst(F,readonly+archive+hidden,info);
 885         FileExists:=(doserror=0);
 886         findclose(Info);
 887 {$endif delphi}
 888       end;
 889
 890
 891     Function PathExists ( F : String) : Boolean;
 892       Var
 893         Info : SearchRec;
 894       begin
 895         if F[Length(f)] in ['/','\'] then
 896          Delete(f,length(f),1);
 897         findfirst(F,readonly+archive+hidden+directory,info);
 898         PathExists:=(doserror=0) and ((info.attr and directory)=directory);
 899         findclose(Info);
 900       end;
 901
 902
 903     Function RemoveFile(const f:string):boolean;
 904       var
 905         g : file;
 906       begin
 907         assign(g,f);
 908         {$I-}
 909          erase(g);
 910         {$I+}
 911         RemoveFile:=(ioresult=0);
 912       end;
 913
 914
 915     Function RemoveDir(d:string):boolean;
 916       begin
 917         if d[length(d)]=DirSep then
 918          Delete(d,length(d),1);
 919         {$I-}
 920          rmdir(d);
 921         {$I+}
 922         RemoveDir:=(ioresult=0);
 923       end;
 924
 925
 926     Function SplitPath(const s:string):string;
 927       var
 928         i : longint;
 929       begin
 930         i:=Length(s);
 931         while (i>0) and not(s[i] in ['/','\']) do
 932          dec(i);
 933         SplitPath:=Copy(s,1,i);
 934       end;
 935
 936
 937     Function SplitFileName(const s:string):string;
 938       var
 939         p : dirstr;
 940         n : namestr;
 941         e : extstr;
 942       begin
 943         FSplit(s,p,n,e);
 944         SplitFileName:=n+e;
 945       end;
 946
 947
 948     Function SplitName(const s:string):string;
 949       var
 950         i,j : longint;
 951       begin
 952         i:=Length(s);
 953         j:=Length(s);
 954         while (i>0) and not(s[i] in ['/','\']) do
 955          dec(i);
 956         while (j>0) and (s[j]<>'.') do
 957          dec(j);
 958         if j<=i then
 959          j:=255;
 960         SplitName:=Copy(s,i+1,j-(i+1));
 961       end;
 962
 963
 964     Function SplitExtension(Const HStr:String):String;
 965       var
 966         j : longint;
 967       begin
 968         j:=length(Hstr);
 969         while (j>0) and (Hstr[j]<>'.') do
 970          begin
 971            if hstr[j]=DirSep then
 972             j:=0
 973            else
 974             dec(j);
 975          end;
 976         if j=0 then
 977          j:=254;
 978         SplitExtension:=Copy(Hstr,j,255);
 979       end;
 980
 981
 982     Function AddExtension(Const HStr,ext:String):String;
 983       begin
 984         if (Ext<>'') and (SplitExtension(HStr)='') then
 985          AddExtension:=Hstr+Ext
 986         else
 987          AddExtension:=Hstr;
 988       end;
 989
 990
 991     Function ForceExtension(Const HStr,ext:String):String;
 992       var
 993         j : longint;
 994       begin
 995         j:=length(Hstr);
 996         while (j>0) and (Hstr[j]<>'.') do
 997          dec(j);
 998         if j=0 then
 999          j:=255;
1000         ForceExtension:=Copy(Hstr,1,j-1)+Ext;
1001       end;
1002
1003
1004     Function FixPath(s:string;allowdot:boolean):string;
1005       var
1006         i : longint;
1007       begin
1008         { Fix separator }
1009         for i:=1 to length(s) do
1010          if s[i] in ['/','\'] then
1011           s[i]:=DirSep;
1012         { Fix ending / }
1013         if (length(s)>0) and (s[length(s)]<>DirSep) and
1014            (s[length(s)]<>':') then
1015          s:=s+DirSep;
1016         { Remove ./ }
1017         if (not allowdot) and (s='.'+DirSep) then
1018          s:='';
1019         { return }
1020 {$ifdef linux}
1021         FixPath:=s;
1022 {$else}
1023         FixPath:=Lower(s);
1024 {$endif}
1025       end;
1026
1027
1028    function FixFileName(const s:string):string;
1029      var
1030        i      : longint;
1031       {$ifdef Linux}
1032        NoPath : boolean;
1033       {$endif Linux}
1034      begin
1035       {$ifdef Linux}
1036        NoPath:=true;
1037       {$endif Linux}
1038        for i:=length(s) downto 1 do
1039         begin
1040           case s[i] of
1041       {$ifdef Linux}
1042        '/','\' : begin
1043                    FixFileName[i]:='/';
1044                    NoPath:=false; {Skip lowercasing path: 'X11'<>'x11' }
1045                  end;
1046       'A'..'Z' : if NoPath then
1047                   FixFileName[i]:=char(byte(s[i])+32)
1048                  else
1049                   FixFileName[i]:=s[i];
1050       {$else}
1051            '/' : FixFileName[i]:='\';
1052       'A'..'Z' : FixFileName[i]:=char(byte(s[i])+32);
1053       {$endif}
1054           else
1055            FixFileName[i]:=s[i];
1056           end;
1057         end;
1058        {$ifndef TP}
1059          {$ifopt H+}
1060            SetLength(FixFileName,length(s));
1061          {$else}
1062            FixFileName[0]:=s[0];
1063          {$endif}
1064        {$else}
1065          FixFileName[0]:=s[0];
1066        {$endif}
1067      end;
1068
1069
1070    procedure SplitBinCmd(const s:string;var bstr,cstr:string);
1071      var
1072        i : longint;
1073      begin
1074        i:=pos(' ',s);
1075        if i>0 then
1076         begin
1077           bstr:=Copy(s,1,i-1);
1078           cstr:=Copy(s,i+1,length(s)-i);
1079         end
1080        else
1081         begin
1082           bstr:='';
1083           cstr:='';
1084         end;
1085      end;
1086
1087
1088
1089    procedure TSearchPathList.AddPath(s:string;addfirst:boolean);
1090      var
1091        j        : longint;
1092        hs,hsd,
1093        CurrentDir,
1094        CurrPath : string;
1095        dir      : searchrec;
1096    {$IFDEF NEWST}
1097        hp       : PStringItem;
1098    {$ELSE}
1099        hp       : PStringQueueItem;
1100    {$ENDIF}
1101
1102        procedure addcurrpath;
1103        begin
1104          if addfirst then
1105           begin
1106             Delete(currPath);
1107             Insert(currPath);
1108           end
1109          else
1110           begin
1111             { Check if already in path, then we don't add it }
1112             hp:=Find(currPath);
1113             if not assigned(hp) then
1114              Concat(currPath);
1115           end;
1116        end;
1117
1118      begin
1119        if s='' then
1120         exit;
1121      { Support default macro's }
1122        DefaultReplacements(s);
1123      { get current dir }
1124        CurrentDir:=GetCurrentDir;
1125        repeat
1126          { get currpath }
1127          if addfirst then
1128           begin
1129             j:=length(s);
1130             while (j>0) and (s[j]<>';') do
1131              dec(j);
1132             CurrPath:=FixPath(Copy(s,j+1,length(s)-j),false);
1133             if j=0 then
1134              s:=''
1135             else
1136              System.Delete(s,j,length(s)-j+1);
1137           end
1138          else
1139           begin
1140             j:=Pos(';',s);
1141             if j=0 then
1142              j:=255;
1143             CurrPath:=FixPath(Copy(s,1,j-1),false);
1144             System.Delete(s,1,j);
1145           end;
1146          { fix pathname }
1147          if CurrPath='' then
1148           CurrPath:='.'+DirSep
1149          else
1150           begin
1151             CurrPath:=FixPath(FExpand(CurrPath),false);
1152             if (CurrentDir<>'') and (Copy(CurrPath,1,length(CurrentDir))=CurrentDir) then
1153              CurrPath:='.'+DirSep+Copy(CurrPath,length(CurrentDir)+1,255);
1154           end;
1155          { wildcard adding ? }
1156          if pos('*',currpath)>0 then
1157           begin
1158             if currpath[length(currpath)]=dirsep then
1159              hs:=Copy(currpath,1,length(CurrPath)-1)
1160             else
1161              hs:=currpath;
1162             hsd:=SplitPath(hs);
1163             findfirst(hs,directory,dir);
1164             while doserror=0 do
1165              begin
1166                if (dir.name<>'.') and
1167                   (dir.name<>'..') and
1168                   ((dir.attr and directory)<>0) then
1169                 begin
1170                   currpath:=hsd+dir.name+dirsep;
1171                   hp:=Find(currPath);
1172                   if not assigned(hp) then
1173                    AddCurrPath;
1174                 end;
1175                findnext(dir);
1176              end;
1177             FindClose(dir);
1178           end
1179          else
1180           begin
1181             if PathExists(currpath) then
1182              addcurrpath;
1183           end;
1184        until (s='');
1185      end;
1186
1187
1188    procedure TSearchPathList.AddList(list:TSearchPathList;addfirst:boolean);
1189      var
1190        s : string;
1191        hl : TSearchPathList;
1192      {$IFDEF NEWST}
1193        hp,hp2 : PStringItem;
1194      {$ELSE}
1195        hp,hp2 : PStringQueueItem;
1196      {$ENDIF}
1197      begin
1198        if list.empty then
1199         exit;
1200        { create temp and reverse the list }
1201        if addfirst then
1202         begin
1203           hl.Init;
1204           hp:=list.first;
1205           while assigned(hp) do
1206            begin
1207              hl.insert(hp^.data^);
1208              hp:=hp^.next;
1209            end;
1210           while not hl.empty do
1211            begin
1212              s:=hl.Get;
1213              Delete(s);
1214              Insert(s);
1215            end;
1216           hl.done;
1217         end
1218        else
1219         begin
1220           hp:=list.first;
1221           while assigned(hp) do
1222            begin
1223              hp2:=Find(hp^.data^);
1224              { Check if already in path, then we don't add it }
1225              if not assigned(hp2) then
1226               Concat(hp^.data^);
1227              hp:=hp^.next;
1228            end;
1229         end;
1230      end;
1231
1232
1233    function TSearchPathList.FindFile(const f : string;var b : boolean) : string;
1234      Var
1235      {$IFDEF NEWST}
1236        p : PStringItem;
1237      {$ELSE}
1238        p : PStringQueueItem;
1239      {$ENDIF}
1240      begin
1241        FindFile:='';
1242        b:=false;
1243        p:=first;
1244        while assigned(p) do
1245         begin
1246           If FileExists(p^.data^+f) then
1247            begin
1248              FindFile:=p^.data^;
1249              b:=true;
1250              exit;
1251            end;
1252           p:=p^.next;
1253         end;
1254      end;
1255
1256
1257    Function GetFileTime ( Var F : File) : Longint;
1258    Var
1259    {$ifdef linux}
1260      Info : Stat;
1261    {$endif}
1262      L : longint;
1263    begin
1264    {$ifdef linux}
1265      FStat (F,Info);
1266      L:=Info.Mtime;
1267    {$else}
1268      GetFTime(f,l);
1269    {$endif}
1270      GetFileTime:=L;
1271    end;
1272
1273
1274    Function GetNamedFileTime (Const F : String) : Longint;
1275    begin
1276      GetNamedFileTime:=do_getnamedfiletime(F);
1277    end;
1278
1279
1280    {Touch Assembler and object time to ppu time is there is a ppufilename}
1281    procedure SynchronizeFileTime(const fn1,fn2:string);
1282    var
1283      f : file;
1284      l : longint;
1285    begin
1286      Assign(f,fn1);
1287      {$I-}
1288       reset(f,1);
1289      {$I+}
1290      if ioresult=0 then
1291       begin
1292         getftime(f,l);
1293         { just to be sure in case there are rounding errors }
1294         setftime(f,l);
1295         close(f);
1296         assign(f,fn2);
1297         {$I-}
1298          reset(f,1);
1299         {$I+}
1300         if ioresult=0 then
1301          begin
1302            setftime(f,l);
1303            close(f);
1304          end;
1305       end;
1306    end;
1307
1308
1309    function FindFile(const f : string;path : string;var b : boolean) : string;
1310       Var
1311         singlepathstring : string;
1312         i : longint;
1313      begin
1314      {$ifdef linux}
1315        for i:=1 to length(path) do
1316         if path[i]=':' then
1317        path[i]:=';';
1318      {$endif}
1319        b:=false;
1320        FindFile:='';
1321        repeat
1322          i:=pos(';',path);
1323          if i=0 then
1324            i:=256;
1325          singlepathstring:=FixPath(copy(path,1,i-1),false);
1326          delete(path,1,i);
1327          If FileExists (singlepathstring+f) then
1328            begin
1329              FindFile:=singlepathstring;
1330              b:=true;
1331              exit;
1332            end;
1333        until path='';
1334      end;
1335
1336    function FindExe(bin:string;var found:boolean):string;
1337    begin
1338      bin:=FixFileName(bin)+source_os.exeext;
1339 {$ifdef delphi}
1340      FindExe:=FindFile(bin,'.;'+exepath+';'+dmisc.getenv('PATH'),found)+bin;
1341 {$else delphi}
1342      FindExe:=FindFile(bin,'.;'+exepath+';'+dos.getenv('PATH'),found)+bin;
1343 {$endif delphi}
1344    end;
1345
1346
1347     function GetShortName(const n:string):string;
1348 {$ifdef win32}
1349       var
1350         hs,hs2 : string;
1351         i : longint;
1352 {$endif}
1353 {$ifdef go32v2}
1354       var
1355         hs : string;
1356 {$endif}
1357       begin
1358         GetShortName:=n;
1359 {$ifdef win32}
1360         hs:=n+#0;
1361         i:=Windows.GetShortPathName(@hs[1],@hs2[1],high(hs2));
1362         if (i>0) and (i<=high(hs2)) then
1363           begin
1364             hs2[0]:=chr(strlen(@hs2[1]));
1365             GetShortName:=hs2;
1366           end;
1367 {$endif}
1368 {$ifdef go32v2}
1369         hs:=n;
1370         if Dos.GetShortName(hs) then
1371          GetShortName:=hs;
1372 {$endif}
1373       end;
1374
1375
1376  {****************************************************************************
1377                                OS Dependent things
1378  ****************************************************************************}
1379
1380     function GetEnvPChar(const envname:string):pchar;
1381       {$ifdef win32}
1382       var
1383         s     : string;
1384         i,len : longint;
1385         hp,p,p2 : pchar;
1386       {$endif}
1387       begin
1388       {$ifdef linux}
1389         GetEnvPchar:=Linux.Getenv(envname);
1390         {$define GETENVOK}
1391       {$endif}
1392       {$ifdef win32}
1393         GetEnvPchar:=nil;
1394         p:=GetEnvironmentStrings;
1395         hp:=p;
1396         while hp^<>#0 do
1397          begin
1398            s:=strpas(hp);
1399            i:=pos('=',s);
1400            len:=strlen(hp);
1401            if upper(copy(s,1,i-1))=upper(envname) then
1402             begin
1403               GetMem(p2,len-length(envname));
1404               Move(hp[i],p2^,len-length(envname));
1405               GetEnvPchar:=p2;
1406               break;
1407             end;
1408            { next string entry}
1409            hp:=hp+len+1;
1410          end;
1411         FreeEnvironmentStrings(p);
1412         {$define GETENVOK}
1413       {$endif}
1414       {$ifdef GETENVOK}
1415         {$undef GETENVOK}
1416       {$else}
1417         GetEnvPchar:=StrPNew(Dos.Getenv(envname));
1418       {$endif}
1419       end;
1420
1421
1422     procedure FreeEnvPChar(p:pchar);
1423       begin
1424       {$ifndef linux}
1425         StrDispose(p);
1426       {$endif}
1427       end;
1428
1429     Procedure Shell(const command:string);
1430       { This is already defined in the linux.ppu for linux, need for the *
1431         expansion under linux }
1432       {$ifdef linux}
1433       begin
1434         Linux.Shell(command);
1435       end;
1436       {$else}
1437       var
1438         comspec : string;
1439       begin
1440         comspec:=getenv('COMSPEC');
1441         Exec(comspec,' /C '+command);
1442       end;
1443       {$endif}
1444
1445
1446     Function SetCompileMode(const s:string; changeInit: boolean):boolean;
1447       var
1448         b : boolean;
1449       begin
1450         b:=true;
1451         if s='DEFAULT' then
1452           aktmodeswitches:=initmodeswitches
1453         else
1454          if s='DELPHI' then
1455           aktmodeswitches:=delphimodeswitches
1456         else
1457          if s='TP' then
1458           aktmodeswitches:=tpmodeswitches
1459         else
1460          if s='FPC' then
1461           aktmodeswitches:=fpcmodeswitches
1462         else
1463          if s='OBJFPC' then
1464           aktmodeswitches:=objfpcmodeswitches
1465         else
1466          if s='GPC' then
1467           aktmodeswitches:=gpcmodeswitches
1468         else
1469          b:=false;
1470
1471         if b and changeInit then
1472           initmodeswitches := aktmodeswitches;
1473
1474         if b then
1475          begin
1476            { turn ansistrings on by default ? }
1477            if (m_default_ansistring in aktmodeswitches) then
1478             begin
1479               include(aktlocalswitches,cs_ansistrings);
1480               if changeinit then
1481                include(initlocalswitches,cs_ansistrings);
1482             end
1483            else
1484             begin
1485               exclude(aktlocalswitches,cs_ansistrings);
1486               if changeinit then
1487                exclude(initlocalswitches,cs_ansistrings);
1488             end;
1489          end;
1490
1491         SetCompileMode:=b;
1492       end;
1493
1494
1495 {****************************************************************************
1496                                     Init
1497 ****************************************************************************}
1498
1499 {$ifdef linux}
1500   {$define need_path_search}
1501 {$endif linux}
1502 {$ifdef os2}
1503   {$define need_path_search}
1504 {$endif os2}
1505
1506    procedure get_exepath;
1507      var
1508        hs1 : namestr;
1509        hs2 : extstr;
1510 {$ifdef need_path_search}
1511        b: boolean;
1512 {$endif}
1513      begin
1514 {$ifdef delphi}
1515        exepath:=dmisc.getenv('PPC_EXEC_PATH');
1516 {$else delphi}
1517        exepath:=dos.getenv('PPC_EXEC_PATH');
1518 {$endif delphi}
1519        if exepath='' then
1520         fsplit(FixFileName(paramstr(0)),exepath,hs1,hs2);
1521 {$ifndef VER0_99_15}
1522    {$ifdef need_path_search}
1523        if exepath='' then
1524         begin
1525           if pos(source_os.exeext,hs1) <>
1526                (length(hs1) - length(source_os.exeext)+1) then
1527             hs1 := hs1 + source_os.exeext;
1528       {$ifdef delphi}
1529           exepath := findfile(hs1,dmisc.getenv('PATH'),b);
1530       {$else delphi}
1531           exepath := findfile(hs1,dos.getenv('PATH'),b);
1532       {$endif delphi}
1533         end;
1534    {$endif need_path_search}
1535 {$endif}
1536        exepath:=FixPath(exepath,false);
1537      end;
1538
1539
1540
1541    procedure DoneGlobals;
1542      begin
1543        initdefines.done;
1544        if assigned(DLLImageBase) then
1545          StringDispose(DLLImageBase);
1546        RelocSection:=true;
1547        RelocSectionSetExplicitly:=false;
1548        DLLsource:=false;
1549        UseDeffileForExport:=true;
1550        librarysearchpath.Done;
1551        unitsearchpath.Done;
1552        objectsearchpath.Done;
1553        includesearchpath.Done;
1554      end;
1555
1556    procedure InitGlobals;
1557      begin
1558       { set global switches }
1559         do_build:=false;
1560         do_make:=true;
1561 {$ifdef tp}
1562         use_big:=false;
1563 {$endif tp}
1564        compile_level:=0;
1565
1566       { Output }
1567         OutputFile:='';
1568         OutputExeDir:='';
1569         OutputUnitDir:='';
1570
1571       { Utils directory }
1572         utilsdirectory:='';
1573
1574       { Search Paths }
1575         librarysearchpath.Init;
1576         unitsearchpath.Init;
1577         includesearchpath.Init;
1578         objectsearchpath.Init;
1579
1580       { Def file }
1581         usewindowapi:=false;
1582         description:='Compiled by FPC '+version_string+' - '+target_cpu_string;
1583         dllversion:='';
1584
1585       { Init values }
1586         initmodeswitches:=fpcmodeswitches;
1587         initlocalswitches:=[cs_check_io];
1588         initmoduleswitches:=[cs_extsyntax,cs_browser];
1589         initglobalswitches:=[cs_check_unit_name,cs_link_static];
1590 {$ifdef i386}
1591         initoptprocessor:=Class386;
1592         initspecificoptprocessor:=Class386;
1593         initpackenum:=4;
1594         {$IFDEF testvarsets}
1595         initsetalloc:=0;
1596         {$ENDIF}
1597         initpackrecords:=packrecord_2;
1598         initoutputformat:=target_asm.id;
1599         initasmmode:=asmmode_i386_att;
1600 {$else not i386}
1601   {$ifdef m68k}
1602         initoptprocessor:=MC68000;
1603         include(initmoduleswitches,cs_fp_emulation);
1604         initpackenum:=4;
1605         {$IFDEF testvarsets}
1606          initsetalloc:=0;
1607         {$ENDIF}
1608         initpackrecords:=packrecord_2;
1609         initoutputformat:=as_m68k_as;
1610         initasmmode:=asmmode_m68k_mot;
1611   {$endif m68k}
1612 {$endif i386}
1613         initdefines.init;
1614
1615       { memory sizes, will be overriden by parameter or default for target
1616         in options or init_parser }
1617         stacksize:=0;
1618         heapsize:=0;
1619         maxheapsize:=0;
1620
1621       { compile state }
1622         in_args:=false;
1623         { must_be_valid:=true; obsolete PM }
1624         not_unit_proc:=true;
1625
1626         apptype:=at_cui;
1627      end;
1628
1629 begin
1630   get_exepath;
1631 {$ifdef EXTDEBUG}
1632 {$ifdef FPC}
1633   EntryMemUsed:=system.HeapSize-MemAvail;
1634 {$endif FPC}
1635 {$endif}
1636 end.
1637 {
1638   $Log$
1639   Revision 1.1  2002/02/19 08:22:21  sasu
1640   Initial revision
1641
1642   Revision 1.1.2.6  2000/09/27 21:20:04  peter
1643     * also set initlocalswitches in setcompilemode
1644
1645   Revision 1.1.2.5  2000/09/26 10:36:11  jonas
1646     * initmodeswitches is changed is you change the compiler mode from the
1647       command line (the -S<x> switches didn't work anymore for changing the
1648       compiler mode)
1649
1650   Revision 1.1.2.4  2000/09/24 21:36:26  peter
1651     + setcompilemode() routine
1652
1653   Revision 1.1.2.3  2000/09/24 10:39:15  peter
1654     * fixed ^Z in previous log message
1655
1656   Revision 1.1.2.2  2000/09/24 10:17:07  jonas
1657     + searching of exe in path also for OS/2
1658     * fixed searching of exe in path
1659
1660   Revision 1.1.2.1  2000/08/12 15:29:52  peter
1661     * patch from Gabor for IDE to support memory stream reading
1662
1663   Revision 1.1  2000/07/13 06:29:50  michael
1664   + Initial import
1665
1666   Revision 1.67  2000/06/19 19:57:19  pierre
1667    * smart link is default on win32
1668
1669   Revision 1.66  2000/06/18 18:05:54  peter
1670     * no binary value reading with % if not fpc mode
1671     * extended illegal char message with the char itself (Delphi like)
1672
1673   Revision 1.65  2000/06/15 18:10:11  peter
1674     * first look for ppu in cwd and outputpath and after that for source
1675       in cwd
1676     * fixpath() for not linux makes path now lowercase so comparing paths
1677       with different cases (sometimes a drive letter could be
1678       uppercased) gives the expected results
1679     * sources_checked flag if there was already a full search for sources
1680       which aren't found, so another scan isn't done when checking for the
1681       sources only when recompile is needed
1682
1683   Revision 1.64  2000/06/11 07:00:21  peter
1684     * fixed pchar->string conversion for delphi mode
1685
1686   Revision 1.63  2000/05/12 08:58:51  pierre
1687    * adapted to Delphi 3
1688
1689   Revision 1.62  2000/05/12 05:55:04  pierre
1690    * * get it to compile with Delphi by Kovacs Attila Zoltan
1691
1692   Revision 1.61  2000/05/11 09:37:25  pierre
1693    * do not use upcase for strings, reported by Kovacs Attila Zoltan
1694
1695   Revision 1.60  2000/05/04 20:46:17  peter
1696     * ansistrings are now default on for delphi mode, as most ppl expect
1697       this
1698
1699   Revision 1.59  2000/05/03 14:36:57  pierre
1700    * fix for tests/test/testrang.pp bug
1701
1702   Revision 1.58  2000/04/14 12:27:57  pierre
1703    * setfiletime to both files in synchronize
1704
1705   Revision 1.57  2000/03/23 15:35:47  peter
1706     * $VERSION is now version_string
1707     + $FULLVERSION is now full_version_string
1708
1709   Revision 1.56  2000/03/20 16:04:05  pierre
1710    * probably a fix for bug 615
1711
1712   Revision 1.55  2000/03/08 15:39:45  daniel
1713     + Added align_from_size function as suggested by Peter.
1714
1715   Revision 1.54  2000/02/28 17:23:57  daniel
1716   * Current work of symtable integration committed. The symtable can be
1717     activated by defining 'newst', but doesn't compile yet. Changes in type
1718     checking and oop are completed. What is left is to write a new
1719     symtablestack and adapt the parser to use it.
1720
1721   Revision 1.53  2000/02/14 20:58:44  marco
1722    * Basic structures for new sethandling implemented.
1723
1724   Revision 1.52  2000/02/10 11:45:48  peter
1725     * addpath fixed with list of paths when inserting at the beginning
1726     * if exepath=currentdir then it's not inserted in path list
1727     * searchpaths in ppc386.cfg are now added at the beginning of the
1728       list instead of at the end. (commandline is not changed)
1729     * check paths before inserting in list
1730
1731   Revision 1.51  2000/02/09 13:22:53  peter
1732     * log truncated
1733
1734   Revision 1.50  2000/01/26 14:31:03  marco
1735    * $VERSION is now also substituted in -F paths (that have subst active)
1736
1737   Revision 1.49  2000/01/23 21:29:14  florian
1738     * CMOV support in optimizer (in define USECMOV)
1739     + start of support of exceptions in constructors
1740
1741   Revision 1.48  2000/01/23 16:36:37  peter
1742     * better auto RTL dir detection
1743
1744   Revision 1.47  2000/01/20 00:23:03  pierre
1745    * fix for GetShortName, now checks results from Win32
1746
1747   Revision 1.46  2000/01/07 01:14:27  peter
1748     * updated copyright to 2000
1749
1750   Revision 1.45  2000/01/07 00:08:09  peter
1751     * tp7 fix
1752
1753   Revision 1.44  2000/01/06 15:48:59  peter
1754     * wildcard support for directory adding, this allows the use of units/*
1755       in ppc386.cfg
1756
1757   Revision 1.43  2000/01/04 15:15:50  florian
1758     + added compiler switch $maxfpuregisters
1759     + fixed a small problem in secondvecn
1760
1761   Revision 1.42  1999/12/22 01:01:48  peter
1762     - removed freelabel()
1763     * added undefined label detection in internal assembler, this prevents
1764       a lot of ld crashes and wrong .o files
1765     * .o files aren't written anymore if errors have occured
1766     * inlining of assembler labels is now correct
1767
1768   Revision 1.41  1999/12/20 23:23:28  pierre
1769    + $description $version
1770
1771   Revision 1.40  1999/12/20 21:42:34  pierre
1772     + dllversion global variable
1773     * FPC_USE_CPREFIX code removed, not necessary anymore
1774       as we use .edata direct writing by default now.
1775
1776   Revision 1.39  1999/12/08 10:40:00  pierre
1777     + allow use of unit var in exports of DLL for win32
1778       by using direct export writing by default instead of use of DEFFILE
1779       that does not allow assembler labels that do not
1780       start with an underscore.
1781       Use -WD to force use of Deffile for Win32 DLL
1782
1783   Revision 1.38  1999/12/06 18:21:03  peter
1784     * support !ENVVAR for long commandlines
1785     * win32/go32v2 write short pathnames to link.res so c:\Program Files\ is
1786       finally supported as installdir.
1787
1788   Revision 1.37  1999/12/02 17:34:34  peter
1789     * preprocessor support. But it fails on the caret in type blocks
1790
1791   Revision 1.36  1999/11/18 15:34:45  pierre
1792     * Notes/Hints for local syms changed to
1793       Set_varstate function
1794
1795   Revision 1.35  1999/11/17 17:04:59  pierre
1796    * Notes/hints changes
1797
1798   Revision 1.34  1999/11/15 17:42:41  pierre
1799    * -g disables reloc section for win32
1800
1801   Revision 1.33  1999/11/12 11:03:50  peter
1802     * searchpaths changed to stringqueue object
1803
1804   Revision 1.32  1999/11/09 23:34:46  pierre
1805    + resolving_forward boolean used for references
1806
1807   Revision 1.31  1999/11/09 13:00:38  peter
1808     * define FPC_DELPHI,FPC_OBJFPC,FPC_TP,FPC_GPC
1809     * initial support for ansistring default with modes
1810
1811 }