Selaa lähdekoodia

* fixes for Delphi 6 compilation
(warning : Some features do not work under Delphi)

carl 23 vuotta sitten
vanhempi
commit
67486c96c3
51 muutettua tiedostoa jossa 677 lisäystä ja 195 poistoa
  1. 10 2
      compiler/aasmbase.pas
  2. 6 2
      compiler/aasmtai.pas
  3. 14 1
      compiler/aggas.pas
  4. 9 2
      compiler/cclasses.pas
  5. 16 2
      compiler/cg64f32.pas
  6. 7 2
      compiler/cgbase.pas
  7. 17 5
      compiler/cgobj.pas
  8. 21 2
      compiler/charset.pas
  9. 10 7
      compiler/cutils.pas
  10. 18 7
      compiler/defbase.pas
  11. 21 4
      compiler/dmisc.pas
  12. 8 2
      compiler/fpcdefs.inc
  13. 9 1
      compiler/globtype.pas
  14. 10 2
      compiler/i386/cgcpu.pas
  15. 10 2
      compiler/i386/cpubase.pas
  16. 6 2
      compiler/i386/n386cal.pas
  17. 70 30
      compiler/i386/n386cnv.pas
  18. 6 2
      compiler/i386/rgcpu.pas
  19. 6 2
      compiler/impdef.pas
  20. 7 1
      compiler/ncal.pas
  21. 6 2
      compiler/ncgcal.pas
  22. 9 1
      compiler/ncgcnv.pas
  23. 22 4
      compiler/ncgcon.pas
  24. 7 3
      compiler/ncginl.pas
  25. 11 3
      compiler/ncgmem.pas
  26. 37 9
      compiler/ncgset.pas
  27. 32 3
      compiler/ncnv.pas
  28. 7 3
      compiler/ncon.pas
  29. 11 2
      compiler/nflw.pas
  30. 8 2
      compiler/nld.pas
  31. 14 6
      compiler/nobj.pas
  32. 7 3
      compiler/nset.pas
  33. 7 1
      compiler/paramgr.pas
  34. 11 2
      compiler/pdecobj.pas
  35. 13 2
      compiler/pdecvar.pas
  36. 9 1
      compiler/pexports.pas
  37. 27 7
      compiler/ppc.dof
  38. 5 2
      compiler/ppc.dpr
  39. 11 2
      compiler/psystem.pas
  40. 12 3
      compiler/rgobj.pas
  41. 8 1
      compiler/symdef.pas
  42. 13 1
      compiler/symppu.pas
  43. 41 35
      compiler/symsym.pas
  44. 7 3
      compiler/symtable.pas
  45. 7 3
      compiler/systems.pas
  46. 9 1
      compiler/systems/t_beos.pas
  47. 10 3
      compiler/systems/t_wdosx.pas
  48. 6 1
      compiler/systems/t_win32.pas
  49. 8 2
      compiler/verbose.pas
  50. 15 2
      compiler/widestr.pas
  51. 6 2
      compiler/x86/cgx86.pas

+ 10 - 2
compiler/aasmbase.pas

@@ -161,7 +161,11 @@ interface
          procedure fixuprelocs;virtual;
        end;
 
-       tasmsymbolidxarr = array[0..$7fffffff div sizeof(pointer)] of tasmsymbol;
+{$ifndef delphi}
+       tasmsymbolidxarr = array[0..($7fffffff div sizeof(pointer))] of tasmsymbol;
+{$else}
+       tasmsymbolidxarr = array[0..high(word)] of tasmsymbol;
+{$endif}
        pasmsymbolidxarr = ^tasmsymbolidxarr;
 
        TAsmLibraryData = class(TLinkedListItem)
@@ -859,7 +863,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.8  2002-08-19 19:36:42  peter
+  Revision 1.9  2002-10-05 12:43:23  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.8  2002/08/19 19:36:42  peter
     * More fixes for cross unit inlining, all tnodes are now implemented
     * Moved pocall_internconst to po_internconst because it is not a
       calling type at all and it conflicted when inlining of these small

+ 6 - 2
compiler/aasmtai.pas

@@ -1045,7 +1045,7 @@ uses
 
     procedure tai_label.derefimpl;
       begin
-        objectlibrary.DerefAsmsymbol(l);
+        objectlibrary.DerefAsmsymbol(tasmsymbol(l));
         l.is_set:=true;
       end;
 
@@ -1548,7 +1548,11 @@ uses
 end.
 {
   $Log$
-  Revision 1.8  2002-08-19 19:36:42  peter
+  Revision 1.9  2002-10-05 12:43:23  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.8  2002/08/19 19:36:42  peter
     * More fixes for cross unit inlining, all tnodes are now implemented
     * Moved pocall_internconst to po_internconst because it is not a
       calling type at all and it conflicted when inlining of these small

+ 14 - 1
compiler/aggas.pas

@@ -317,6 +317,9 @@ var
       e        : extended;
       do_line  : boolean;
       sep      : char;
+{$ifdef delphi}
+      _64bitarray : t64bitarray;
+{$endif}
     begin
       if not assigned(p) then
        exit;
@@ -493,8 +496,10 @@ var
                 AsmWriteLn(target_asm.comment+target_asm.comment+double2str(tai_real_64bit(hp).value));
                d:=tai_real_64bit(hp).value;
                { swap the values to correct endian if required }
+{$ifdef fpc}               
                if source_info.endian <> target_info.endian then
                  swap64bitarray(t64bitarray(d));
+{$endif}
                AsmWrite(#9'.byte'#9);
                for i:=0 to 7 do
                 begin
@@ -510,9 +515,11 @@ var
                if do_line then
                 AsmWriteLn(target_asm.comment+target_asm.comment+single2str(tai_real_32bit(hp).value));
                sin:=tai_real_32bit(hp).value;
+{$ifdef fpc}
                { swap the values to correct endian if required }
                if source_info.endian <> target_info.endian then
                  swap32bitarray(t32bitarray(sin));
+{$endif}                 
                AsmWrite(#9'.byte'#9);
                for i:=0 to 3 do
                 begin
@@ -533,9 +540,11 @@ var
 {$else}
                co:=tai_comp_64bit(hp).value;
 {$endif}
+{$ifdef fpc}
                { swap the values to correct endian if required }
                if source_info.endian <> target_info.endian then
                  swap64bitarray(t64bitarray(co));
+{$endif}                 
                for i:=0 to 7 do
                 begin
                   if i<>0 then
@@ -800,7 +809,11 @@ var
 end.
 {
   $Log$
-  Revision 1.12  2002-08-31 16:05:17  florian
+  Revision 1.13  2002-10-05 12:43:23  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.12  2002/08/31 16:05:17  florian
     * write double # before float constants when -al is turned on
       else some gas versions interpret it as line number
 

+ 9 - 2
compiler/cclasses.pas

@@ -316,7 +316,9 @@ implementation
       begin
         if startmem<>0 then
          begin
+{$ifndef Delphi}
            inc(TotalMem,memavail-startmem);
+{$endif}           
            startmem:=0;
          end;
       end;
@@ -862,8 +864,9 @@ end;
 
     function counttree(p: tnamedindexitem): longint;
       begin
+        counttree:=0;
         if not assigned(p) then
-          exit(0);
+          exit;
         result := 1;
         inc(result,counttree(p.fleft));
         inc(result,counttree(p.fright));
@@ -1844,7 +1847,11 @@ end;
 end.
 {
   $Log$
-  Revision 1.19  2002-09-09 17:34:14  peter
+  Revision 1.20  2002-10-05 12:43:23  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.19  2002/09/09 17:34:14  peter
     * tdicationary.replace added to replace and item in a dictionary. This
       is only allowed for the same name
     * varsyms are inserted in symtable before the types are parsed. This

+ 16 - 2
compiler/cg64f32.pas

@@ -35,7 +35,11 @@ unit cg64f32;
        aasmbase,aasmtai,aasmcpu,
        cpuinfo, cpubase,
        cginfo, cgobj,
-       node,symtype;
+       node,symtype
+{$ifdef delphi}
+       ,dmisc
+{$endif}
+       ;
 
     type
       {# Defines all the methods required on 32-bit processors
@@ -415,7 +419,9 @@ unit cg64f32;
 
     procedure tcg64f32.a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);
       begin
+{$ifdef FPC}
 {$warning FIX ME}
+{$endif}
          cg.a_param_reg(list,OS_32,reg.reghi,locpara);
          { the nr+1 needs definitivly a fix FK }
          { maybe the parameter numbering needs }
@@ -427,7 +433,9 @@ unit cg64f32;
 
     procedure tcg64f32.a_param64_const(list : taasmoutput;value : qword;const locpara : tparalocation);
       begin
+{$ifdef fpc}
 {$warning FIX ME}
+{$endif}
         if target_info.endian = endian_big then
           swap_qword(value);
          cg.a_param_const(list,OS_32,hi(value),locpara);
@@ -463,7 +471,9 @@ unit cg64f32;
 
     procedure tcg64f32.a_param64_loc(list : taasmoutput;const l:tlocation;const locpara : tparalocation);
       begin
+{$ifdef fpc}
 {$warning FIX ME}
+{$endif}
         case l.loc of
           LOC_REGISTER,
           LOC_CREGISTER :
@@ -738,7 +748,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.30  2002-09-17 18:54:01  jonas
+  Revision 1.31  2002-10-05 12:43:23  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.30  2002/09/17 18:54:01  jonas
     * a_load_reg_reg() now has two size parameters: source and dest. This
       allows some optimizations on architectures that don't encode the
       register size in the register name.

+ 7 - 2
compiler/cgbase.pas

@@ -181,12 +181,13 @@ unit cgbase;
           fpuregvars_refs : array[1..maxfpuvarregs] of longint;
        end;
 
+       tcprocinfo = class of tprocinfo;
 
     var
        {# information about the current sub routine being parsed (@var(pprocinfo))}
        procinfo : tprocinfo;
 
-       cprocinfo : class of tprocinfo;
+       cprocinfo : tcprocinfo;
 
        { labels for BREAK and CONTINUE }
        aktbreaklabel,aktcontinuelabel : tasmlabel;
@@ -657,7 +658,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.31  2002-10-03 21:20:19  carl
+  Revision 1.32  2002-10-05 12:43:23  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.31  2002/10/03 21:20:19  carl
     * range check error fix
 
   Revision 1.30  2002/09/30 07:00:44  florian

+ 17 - 5
compiler/cgobj.pas

@@ -41,7 +41,11 @@ unit cgobj;
        cclasses,aasmbase,aasmtai,aasmcpu,symtable,
        cpubase,cpuinfo,cpupara,
        cginfo,
-       symconst,symbase,symtype,node;
+       symconst,symbase,symtype,node
+{$ifdef delphi}
+       ,dmisc
+{$endif}
+       ;
 
     type
        talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE);
@@ -1081,7 +1085,7 @@ unit cgobj;
       end;
 
 
-    function tcg.reg_cgsize(const reg: tregister) : tcgsize;
+    class function tcg.reg_cgsize(const reg: tregister) : tcgsize;
       begin
         reg_cgsize := OS_INT;
       end;
@@ -1089,7 +1093,9 @@ unit cgobj;
 
     procedure tcg.g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;delsource,loadref : boolean);
       begin
+{$ifdef FPC}
         {$warning FIX ME!}
+{$endif}        
         a_paramaddr_ref(list,dest,paramanager.getintparaloc(3));
         if loadref then
           a_param_ref(list,OS_ADDR,source,paramanager.getintparaloc(2))
@@ -1573,7 +1579,8 @@ unit cgobj;
      end;
 
 
-    procedure tcg64.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;regsrc,regdst : tregister64);
+    procedure tcg64.a_op64_const_reg_reg(list: taasmoutput;op:TOpCG;value : qword;
+       regsrc,regdst : tregister64);
       begin
         a_load64_reg_reg(list,regsrc,regdst);
         a_op64_const_reg(list,op,value,regdst);
@@ -1588,14 +1595,19 @@ unit cgobj;
 
 
 
-
+initialization
+    ;
 finalization
   cg.free;
   cg64.free;
 end.
 {
   $Log$
-  Revision 1.60  2002-10-02 18:20:52  peter
+  Revision 1.61  2002-10-05 12:43:23  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.60  2002/10/02 18:20:52  peter
     * Copy() is now internal syssym that calls compilerprocs
 
   Revision 1.59  2002/09/17 18:54:02  jonas

+ 21 - 2
compiler/charset.pas

@@ -14,7 +14,9 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{$ifndef delphi}
 {$mode objfpc}
+{$endif}
 unit charset;
 
   interface
@@ -69,7 +71,7 @@ unit charset;
          t : text;
          s,hs : string;
          scanpos,charpos,unicodevalue : longint;
-         code : word;
+         code : integer;
          flag : tunicodecharmappingflag;
          p : punicodemap;
          lastchar : longint;
@@ -146,8 +148,13 @@ unit charset;
                           end;
                         flag:=umf_noinfo;
                      end;
+{$ifdef delphi}
+                   data^.flag:=flag;
+                   data^.unicode:=unicodevalue;
+{$else}
                    data[charpos].flag:=flag;
                    data[charpos].unicode:=unicodevalue;
+{$endif delphi}
                    if charpos>lastchar then
                      lastchar:=charpos;
                 end;
@@ -209,7 +216,11 @@ unit charset;
 
       begin
          if ord(c)<=p^.lastchar then
+{$ifdef Delphi}
+           getunicode:=p^.map.unicode
+{$else}
            getunicode:=p^.map[ord(c)].unicode
+{$endif}
          else
            getunicode:=0;
       end;
@@ -223,7 +234,11 @@ unit charset;
          { at least map to space }
          getascii:=#32;
          for i:=0 to p^.lastchar do
+{$ifdef Delphi}
+           if p^.map.unicode=c then
+{$else}
            if p^.map[i].unicode=c then
+{$endif}
              begin
                 if i<256 then
                   getascii:=chr(i)
@@ -252,7 +267,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.2  2002-09-07 15:25:02  peter
+  Revision 1.3  2002-10-05 12:43:24  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.2  2002/09/07 15:25:02  peter
     * old logs removed and tabs fixed
 
   Revision 1.1  2002/07/20 17:11:48  florian

+ 10 - 7
compiler/cutils.pas

@@ -30,11 +30,6 @@ unit cutils;
 
 interface
 
-{$ifdef delphi}
-    type
-       dword = cardinal;
-       qword = int64;
-{$endif}
 
     type
        pstring = ^string;
@@ -426,9 +421,13 @@ uses
 
 
     function space (b : longint): string;
+      var
+       s: string;
       begin
         space[0] := chr(b);
-        FillChar (Space[1],b,' ');
+        s[0] := chr(b);
+        FillChar (S[1],b,' ');
+        space:=s;
       end;
 
 
@@ -821,7 +820,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.22  2002-09-05 19:29:42  peter
+  Revision 1.23  2002-10-05 12:43:24  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.22  2002/09/05 19:29:42  peter
     * memdebug enhancements
 
   Revision 1.21  2002/07/26 11:16:35  jonas

+ 18 - 7
compiler/defbase.pas

@@ -1294,6 +1294,7 @@ implementation
         var overload_procs : pprocdeflist) : tprocdef;
      var
        p :pprocdeflist;
+       _result : tprocdef;
      begin
           internal_assignment_overloaded:=nil;
           p := nil;
@@ -1301,18 +1302,24 @@ implementation
             exit;
 
           { look for an exact match first, from start of list }
-          internal_assignment_overloaded:=overloaded_operators[_ASSIGNMENT].
+          _result:=overloaded_operators[_ASSIGNMENT].
              search_procdef_byretdef_by1paradef(to_def,from_def,dm_exact,
                p);
-          if assigned(internal_assignment_overloaded) then
-            exit;
+          if assigned(_result) then
+            begin
+              internal_assignment_overloaded := _result;
+              exit;
+            end;
 
           { .... then look for an equal match, from start of list }
-          internal_assignment_overloaded:=overloaded_operators[_ASSIGNMENT].
+          _result:=overloaded_operators[_ASSIGNMENT].
            search_procdef_byretdef_by1paradef(to_def,from_def,dm_equal,
                 p);
-          if assigned(internal_assignment_overloaded) then
-            exit;
+          if assigned(_result) then
+            begin
+              internal_assignment_overloaded := _result;
+              exit;
+            end;
 
           {  .... then for convert level 1, continue from where we were at }
           internal_assignment_overloaded:=overloaded_operators[_ASSIGNMENT].
@@ -1962,7 +1969,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.15  2002-10-05 00:50:01  peter
+  Revision 1.16  2002-10-05 12:43:24  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.15  2002/10/05 00:50:01  peter
     * check parameters from left to right in equal_paras, so default
       parameters are checked at the end
 

+ 21 - 4
compiler/dmisc.pas

@@ -38,9 +38,6 @@ uses
 {$endif}
   sysutils;
 
-{$ifdef VER100}
-   type int64 = longint;
-{$endif}
 
 Const
   Max_Path = 255;
@@ -71,6 +68,9 @@ Const
 
 Type
   DWord   = Cardinal;
+  qword = int64;
+  tlongint = array[0..65535] of longint;
+  plongintarray = ^tlongint;
 
 { Needed for Win95 LFN Support }
   ComStr  = String[255];
@@ -144,6 +144,9 @@ Procedure SetCBreak(breakvalue: boolean);
 Procedure GetVerify(var verify: boolean);
 Procedure SetVerify(verify: boolean);
 
+{Memory}
+function  CompareByte(const buf1,buf2;len:longint):longint;
+
 {Do Nothing Functions}
 Procedure SwapVectors;
 Procedure GetIntVec(intno: byte; var vector: pointer);
@@ -152,6 +155,16 @@ Procedure Keep(exitcode: word);
 
 implementation
 
+    function  CompareByte(const buf1,buf2;len:longint):longint;
+      begin
+         { Both buffers are similar }
+         if comparemem(@buf1, @buf2, len) then
+            CompareByte := 0
+         else
+            CompareByte := 1; 
+      end;
+
+
     function upper(const s : string) : string;
     {
       return uppercased string of s
@@ -840,7 +853,11 @@ End;
 end.
 {
   $Log$
-  Revision 1.10  2002-08-12 15:08:39  carl
+  Revision 1.11  2002-10-05 12:43:24  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.10  2002/08/12 15:08:39  carl
     + stab register indexes for powerpc (moved from gdb to cpubase)
     + tprocessor enumeration moved to cpuinfo
     + linker in target_info is now a class

+ 8 - 2
compiler/fpcdefs.inc

@@ -24,7 +24,6 @@
   {$Z1}
 
   {$undef FPCPROCVAR}
-  {$define USEEXCEPT}
 {$endif}
 
 
@@ -32,6 +31,9 @@
 {$define cpuflags}
 
 {$ifdef i386}
+  {$ifdef delphi}
+  {$define oldset}
+  {$endif}
   {$define x86}
 {$else}
   {$define oldset}
@@ -46,7 +48,11 @@
 {$endif alpha}
 {
   $Log$
-  Revision 1.11  2002-09-30 07:00:45  florian
+  Revision 1.12  2002-10-05 12:43:24  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.11  2002/09/30 07:00:45  florian
     * fixes to common code to get the alpha compiler compiled applied
 
   Revision 1.10  2002/09/29 23:19:05  florian

+ 9 - 1
compiler/globtype.pas

@@ -143,6 +143,7 @@ interface
          pocall_system         { system call }
        );
        tproccalloptions = set of tproccalloption;
+       
 
      const
        proccalloptionStr : array[tproccalloption] of string[14]=('',
@@ -166,12 +167,15 @@ interface
 
        tnormalset = set of byte; { 256 elements set }
        pnormalset = ^tnormalset;
+       
+       
 
        pboolean   = ^boolean;
        pdouble    = ^double;
        pbyte      = ^byte;
        pword      = ^word;
        plongint   = ^longint;
+       plongintarray = plongint;
 
        Tconstant=record
             case signed:boolean of
@@ -207,7 +211,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.31  2002-08-19 19:36:42  peter
+  Revision 1.32  2002-10-05 12:43:24  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.31  2002/08/19 19:36:42  peter
     * More fixes for cross unit inlining, all tnodes are now implemented
     * Moved pocall_internconst to po_internconst because it is not a
       calling type at all and it conflicted when inlining of these small

+ 10 - 2
compiler/i386/cgcpu.pas

@@ -32,7 +32,11 @@ unit cgcpu;
        cginfo,cgbase,cgobj,cg64f32,cgx86,
        aasmbase,aasmtai,aasmcpu,
        cpubase,cpuinfo,cpupara,
-       node,symconst;
+       node,symconst
+{$ifdef delphi}
+       ,dmisc
+{$endif}
+       ;
 
     type
       tcg386 = class(tcgx86)
@@ -170,7 +174,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.30  2002-09-07 15:25:10  peter
+  Revision 1.31  2002-10-05 12:43:29  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.30  2002/09/07 15:25:10  peter
     * old logs removed and tabs fixed
 
   Revision 1.29  2002/07/20 19:28:47  florian

+ 10 - 2
compiler/i386/cpubase.pas

@@ -39,7 +39,11 @@ uses
   globals,
   cpuinfo,
   aasmbase,
-  cginfo;
+  cginfo
+{$ifdef delphi}
+  ,dmisc
+{$endif}
+  ;
 
 
 {*****************************************************************************
@@ -521,7 +525,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.31  2002-08-14 18:41:48  jonas
+  Revision 1.32  2002-10-05 12:43:29  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.31  2002/08/14 18:41:48  jonas
     - remove valuelow/valuehigh fields from tlocation, because they depend
       on the endianess of the host operating system -> difficult to get
       right. Use lo/hi(location.valueqword) instead (remember to use

+ 6 - 2
compiler/i386/n386cal.pas

@@ -1001,7 +1001,7 @@ implementation
                 { inlined code is in inlinecode }
                 begin
                    { process the inlinecode }
-                   secondpass(inlinecode);
+                   secondpass(tnode(inlinecode));
                    { free the args }
                    if tprocdef(procdefinition).parast.datasize>0 then
                      tg.UnGetTemp(exprasmlist,pararef);
@@ -1311,7 +1311,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.72  2002-09-17 18:54:03  jonas
+  Revision 1.73  2002-10-05 12:43:29  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.72  2002/09/17 18:54:03  jonas
     * a_load_reg_reg() now has two size parameters: source and dest. This
       allows some optimizations on architectures that don't encode the
       register size in the register name.

+ 70 - 30
compiler/i386/n386cnv.pas

@@ -322,37 +322,38 @@ implementation
 
 
     procedure ti386typeconvnode.second_call_helper(c : tconverttype);
+{$ifdef fpc}    
       const
          secondconvert : array[tconverttype] of pointer = (
-           @second_nothing, {equal}
-           @second_nothing, {not_possible}
-           @second_nothing, {second_string_to_string, handled in resulttype pass }
-           @second_char_to_string,
-           @second_nothing, {char_to_charray}
-           @second_nothing, { pchar_to_string, handled in resulttype pass }
-           @second_nothing, {cchar_to_pchar}
-           @second_cstring_to_pchar,
-           @second_ansistring_to_pchar,
-           @second_string_to_chararray,
-           @second_nothing, { chararray_to_string, handled in resulttype pass }
-           @second_array_to_pointer,
-           @second_pointer_to_array,
-           @second_int_to_int,
-           @second_int_to_bool,
-           @second_bool_to_bool,
-           @second_bool_to_int,
-           @second_real_to_real,
-           @second_int_to_real,
-           @second_proc_to_procvar,
-           @second_nothing, { arrayconstructor_to_set }
-           @second_nothing, { second_load_smallset, handled in first pass }
-           @second_cord_to_pointer,
-           @second_nothing, { interface 2 string }
-           @second_nothing, { interface 2 guid   }
-           @second_class_to_intf,
-           @second_char_to_char,
-           @second_nothing,  { normal_2_smallset }
-           @second_nothing   { dynarray_2_openarray }
+           {$ifdef fpc}@{$endif}second_nothing, {equal}
+           {$ifdef fpc}@{$endif}second_nothing, {not_possible}
+           {$ifdef fpc}@{$endif}second_nothing, {second_string_to_string, handled in resulttype pass }
+           {$ifdef fpc}@{$endif}second_char_to_string,
+           {$ifdef fpc}@{$endif}second_nothing, {char_to_charray}
+           {$ifdef fpc}@{$endif}second_nothing, { pchar_to_string, handled in resulttype pass }
+           {$ifdef fpc}@{$endif}second_nothing, {cchar_to_pchar}
+           {$ifdef fpc}@{$endif}second_cstring_to_pchar,
+           {$ifdef fpc}@{$endif}second_ansistring_to_pchar,
+           {$ifdef fpc}@{$endif}second_string_to_chararray,
+           {$ifdef fpc}@{$endif}second_nothing, { chararray_to_string, handled in resulttype pass }
+           {$ifdef fpc}@{$endif}second_array_to_pointer,
+           {$ifdef fpc}@{$endif}second_pointer_to_array,
+           {$ifdef fpc}@{$endif}second_int_to_int,
+           {$ifdef fpc}@{$endif}second_int_to_bool,
+           {$ifdef fpc}@{$endif}second_bool_to_bool,
+           {$ifdef fpc}@{$endif}second_bool_to_int,
+           {$ifdef fpc}@{$endif}second_real_to_real,
+           {$ifdef fpc}@{$endif}second_int_to_real,
+           {$ifdef fpc}@{$endif}second_proc_to_procvar,
+           {$ifdef fpc}@{$endif}second_nothing, { arrayconstructor_to_set }
+           {$ifdef fpc}@{$endif}second_nothing, { second_load_smallset, handled in first pass }
+           {$ifdef fpc}@{$endif}second_cord_to_pointer,
+           {$ifdef fpc}@{$endif}second_nothing, { interface 2 string }
+           {$ifdef fpc}@{$endif}second_nothing, { interface 2 guid   }
+           {$ifdef fpc}@{$endif}second_class_to_intf,
+           {$ifdef fpc}@{$endif}second_char_to_char,
+           {$ifdef fpc}@{$endif}second_nothing,  { normal_2_smallset }
+           {$ifdef fpc}@{$endif}second_nothing   { dynarray_2_openarray }
          );
       type
          tprocedureofobject = procedure of object;
@@ -370,13 +371,52 @@ implementation
          r.obj:=self;
          tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
       end;
+{$else}
+     begin
+        case c of 
+          tc_equal,
+          tc_not_possible,
+          tc_string_2_string : second_nothing;
+          tc_char_2_string : second_char_to_string;
+          tc_char_2_chararray : second_nothing;
+          tc_pchar_2_string : second_nothing;
+          tc_cchar_2_pchar : second_nothing;
+          tc_cstring_2_pchar : second_cstring_to_pchar;
+          tc_ansistring_2_pchar : second_ansistring_to_pchar;
+          tc_string_2_chararray : second_string_to_chararray;
+          tc_chararray_2_string : second_nothing;
+          tc_array_2_pointer : second_array_to_pointer;
+          tc_pointer_2_array : second_pointer_to_array;
+          tc_int_2_int : second_int_to_int;
+          tc_int_2_bool : second_int_to_bool;
+          tc_bool_2_bool : second_bool_to_bool;
+          tc_bool_2_int : second_bool_to_int;
+          tc_real_2_real : second_real_to_real;
+          tc_int_2_real : second_int_to_real;
+          tc_proc_2_procvar : second_proc_to_procvar;
+          tc_arrayconstructor_2_set : second_nothing;
+          tc_load_smallset : second_nothing;
+          tc_cord_2_pointer : second_cord_to_pointer;
+          tc_intf_2_string : second_nothing;
+          tc_intf_2_guid : second_nothing;
+          tc_class_2_intf : second_class_to_intf;
+          tc_char_2_char : second_char_to_char;
+          tc_normal_2_smallset : second_nothing;
+          tc_dynarray_2_openarray : second_nothing;
+        end;
+     end;
+{$endif}
 
 begin
    ctypeconvnode:=ti386typeconvnode;
 end.
 {
   $Log$
-  Revision 1.49  2002-09-17 18:54:03  jonas
+  Revision 1.50  2002-10-05 12:43:29  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.49  2002/09/17 18:54:03  jonas
     * a_load_reg_reg() now has two size parameters: source and dest. This
       allows some optimizations on architectures that don't encode the
       register size in the register name.

+ 6 - 2
compiler/i386/rgcpu.pas

@@ -36,6 +36,7 @@ unit rgcpu;
 
     type
        trgcpu = class(trgobj)
+         fpuvaroffset : byte;
 
           { to keep the same allocation order as with the old routines }
           function getregisterint(list: taasmoutput): tregister; override;
@@ -70,7 +71,6 @@ unit rgcpu;
          { corrects the fpu stack register by ofs }
          function correct_fpuregister(r : tregister;ofs : byte) : tregister;
 
-         fpuvaroffset : byte;
        end;
 
 
@@ -429,7 +429,11 @@ end.
 
 {
   $Log$
-  Revision 1.9  2002-08-17 09:23:48  florian
+  Revision 1.10  2002-10-05 12:43:29  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.9  2002/08/17 09:23:48  florian
     * first part of procinfo rewrite
 
   Revision 1.8  2002/07/01 18:46:34  peter

+ 6 - 2
compiler/impdef.pas

@@ -69,7 +69,7 @@ var
   impname:string;
   TheWord:array[0..1]of char;
   PEoffset:cardinal;
-  loaded:{$ifdef fpc}longint{$else}integer{$endif};
+  loaded:longint;
 
 function DOSstubOK(var x:longint):longbool;
 begin
@@ -479,7 +479,11 @@ end.
 
 {
   $Log$
-  Revision 1.9  2002-05-18 13:34:08  peter
+  Revision 1.10  2002-10-05 12:43:24  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.9  2002/05/18 13:34:08  peter
     * readded missing revisions
 
   Revision 1.8  2002/05/16 19:46:37  carl

+ 7 - 1
compiler/ncal.pas

@@ -742,7 +742,9 @@ implementation
       begin
         inherited ppuload(t,ppufile);
         symtableprocentry:=tprocsym(ppufile.getderef);
+{$ifdef fpc}
 {$warning FIXME: No withsymtable support}
+{$endif}
         symtableproc:=nil;
         procdefinition:=tprocdef(ppufile.getderef);
         restypeset:=boolean(ppufile.getbyte);
@@ -2628,7 +2630,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.102  2002-10-05 00:48:57  peter
+  Revision 1.103  2002-10-05 12:43:25  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.102  2002/10/05 00:48:57  peter
     * support inherited; support for overload as it is handled by
       delphi. This is only for delphi mode as it is working is
       undocumented and hard to predict what is done

+ 6 - 2
compiler/ncgcal.pas

@@ -990,7 +990,7 @@ implementation
                 { inlined code is in inlinecode }
                 begin
                    { process the inlinecode }
-                   secondpass(inlinecode);
+                   secondpass(tnode(inlinecode));
                    { free the args }
                    if tprocdef(procdefinition).parast.datasize>0 then
                      tg.UnGetTemp(exprasmlist,pararef);
@@ -1492,7 +1492,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.24  2002-09-30 07:00:45  florian
+  Revision 1.25  2002-10-05 12:43:25  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.24  2002/09/30 07:00:45  florian
     * fixes to common code to get the alpha compiler compiled applied
 
   Revision 1.23  2002/09/17 18:54:02  jonas

+ 9 - 1
compiler/ncgcnv.pas

@@ -160,7 +160,9 @@ interface
                else
                 begin
                   location.register:=rg.getregisterint(exprasmlist);
+{$ifdef fpc}
 {$warning Todo: convert widestrings to ascii when typecasting them to pchars}
+{$endif}
                   cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,
                     location.register);
                 end;
@@ -433,7 +435,9 @@ interface
 
     procedure tcgtypeconvnode.second_char_to_char;
       begin
+{$ifdef fpc}
         {$warning todo: add RTL routine for widechar-char conversion }
+{$endif}        
         { Quick hack to atleast generate 'working' code (PFV) }
         second_int_to_int;
       end;
@@ -503,7 +507,11 @@ end.
 
 {
   $Log$
-  Revision 1.32  2002-09-17 18:54:02  jonas
+  Revision 1.33  2002-10-05 12:43:25  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.32  2002/09/17 18:54:02  jonas
     * a_load_reg_reg() now has two size parameters: source and dest. This
       allows some optimizations on architectures that don't encode the
       register size in the register name.

+ 22 - 4
compiler/ncgcon.pas

@@ -67,7 +67,11 @@ implementation
       verbose,globals,
       symconst,symdef,aasmbase,aasmtai,defbase,
       cpuinfo,cpubase,
-      cginfo,cgbase,tgobj,rgobj;
+      cginfo,cgbase,tgobj,rgobj
+{$ifdef delphi}
+      ,dmisc
+{$endif}
+      ;
 
 
 {*****************************************************************************
@@ -77,11 +81,9 @@ implementation
     procedure tcgrealconstnode.pass_2;
       { I suppose the parser/pass_1 must make sure the generated real  }
       { constants are actually supported by the target processor? (JM) }
-
       const
         floattype2ait:array[tfloattype] of taitype=
           (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit);
-
       var
          hp1 : tai;
          lastlabel : tasmlabel;
@@ -152,7 +154,12 @@ implementation
     procedure tcgordconstnode.pass_2;
       begin
          location_reset(location,LOC_CONSTANT,def_cgsize(resulttype.def));
+{$ifdef delphi}
+   { Delphi crashes on this statement }
+         location.valueqword:=value;
+{$else}         
          location.valueqword:=qword(value);
+{$endif}
       end;
 
 
@@ -525,7 +532,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.19  2002-08-18 20:06:23  peter
+  Revision 1.20  2002-10-05 12:43:25  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.19  2002/08/18 20:06:23  peter
     * inlining is now also allowed in interface
     * renamed write/load to ppuwrite/ppuload
     * tnode storing in ppu
@@ -614,3 +625,10 @@ end.
       when used with int64's under Delphi)
 
 }
+
+
+
+
+
+
+

+ 7 - 3
compiler/ncginl.pas

@@ -194,8 +194,8 @@ implementation
        cg.a_param_const(exprasmlist,OS_INT,aktfilepos.line,paramanager.getintparaloc(3));
        { filename string }
        hp2:=cstringconstnode.createstr(current_module.sourcefiles.get_file_name(aktfilepos.fileindex),st_shortstring);
-       firstpass(hp2);
-       secondpass(hp2);
+       firstpass(tnode(hp2));
+       secondpass(tnode(hp2));
        if codegenerror then
           exit;
        cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,paramanager.getintparaloc(2));
@@ -610,7 +610,11 @@ end.
 
 {
   $Log$
-  Revision 1.15  2002-09-30 07:00:46  florian
+  Revision 1.16  2002-10-05 12:43:25  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.15  2002/09/30 07:00:46  florian
     * fixes to common code to get the alpha compiler compiled applied
 
   Revision 1.14  2002/09/17 18:54:02  jonas

+ 11 - 3
compiler/ncgmem.pas

@@ -85,9 +85,10 @@ implementation
     uses
 {$ifdef delphi}
       sysutils,
+{$else}
+      strings,
 {$endif}
 {$ifdef GDB}
-      strings,
       gdb,
 {$endif GDB}
       globtype,systems,
@@ -608,8 +609,9 @@ implementation
                 else
                   internalerror(2002032219);
               end;
-
+{$ifdef fpc}
 {$warning FIXME}
+{$endif}
               { check for a zero length string,
                 we can use the ansistring routine here }
               if (cs_check_range in aktlocalswitches) then
@@ -653,7 +655,9 @@ implementation
                      else
                        begin
                           { range checking for open and dynamic arrays !!!! }
+{$ifdef fpc}
 {$warning FIXME}
+{$endif}
                           {!!!!!!!!!!!!!!!!!}
                        end;
                   end;
@@ -864,7 +868,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.28  2002-09-17 18:54:02  jonas
+  Revision 1.29  2002-10-05 12:43:25  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.28  2002/09/17 18:54:02  jonas
     * a_load_reg_reg() now has two size parameters: source and dest. This
       allows some optimizations on architectures that don't encode the
       register size in the register name.

+ 37 - 9
compiler/ncgset.pas

@@ -59,14 +59,6 @@ interface
           procedure pass_2;override;
 
         protected
-
-          procedure optimizevalues(var max_linear_list:longint;var max_dist:cardinal);virtual;
-          function  has_jumptable : boolean;virtual;
-          procedure genjumptable(hp : pcaserecord;min_,max_ : longint); virtual;
-          procedure genlinearlist(hp : pcaserecord); virtual;
-          procedure genlinearcmplist(hp : pcaserecord); virtual;
-          procedure gentreejmp(p : pcaserecord);
-
           with_sign : boolean;
           opsize : tcgsize;
           jmp_gt,jmp_lt,jmp_le : topcmp;
@@ -79,6 +71,14 @@ interface
           { has the implementation jumptable support }
           min_label : tconstexprint;
 
+          procedure optimizevalues(var max_linear_list:longint;var max_dist:cardinal);virtual;
+          function  has_jumptable : boolean;virtual;
+          procedure genjumptable(hp : pcaserecord;min_,max_ : longint); virtual;
+          procedure genlinearlist(hp : pcaserecord); virtual;
+          procedure genlinearcmplist(hp : pcaserecord); virtual;
+          procedure gentreejmp(p : pcaserecord);
+
+
        end;
 
 
@@ -708,8 +708,13 @@ implementation
                 if opsize in [OS_S64,OS_64] then
                   begin
                      objectlibrary.getlabel(l1);
+{$ifdef Delphi}
+                     cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_NE, hi((t^._low)),hregister2,l1);
+                     cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_EQ, lo((t^._low)),hregister, t^.statement);
+{$else}
                      cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_NE, aword(hi(int64(t^._low))),hregister2,l1);
                      cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_EQ, aword(lo(int64(t^._low))),hregister, t^.statement);
+{$endif}
                      cg.a_label(exprasmlist,l1);
                   end
                 else
@@ -728,12 +733,21 @@ implementation
                      if opsize in [OS_64,OS_S64] then
                        begin
                           objectlibrary.getlabel(l1);
+{$ifdef Delphi}
+                          cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_lt, aword(hi((t^._low))),
+                               hregister2, elselabel);
+                          cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_gt, aword(hi((t^._low))),
+                               hregister2, l1);
+                          { the comparisation of the low dword must be always unsigned! }
+                          cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_B, aword(lo((t^._low))), hregister, elselabel);
+{$else}
                           cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_lt, aword(hi(int64(t^._low))),
                                hregister2, elselabel);
                           cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_gt, aword(hi(int64(t^._low))),
                                hregister2, l1);
                           { the comparisation of the low dword must be always unsigned! }
                           cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_B, aword(lo(int64(t^._low))), hregister, elselabel);
+{$endif}                          
                           cg.a_label(exprasmlist,l1);
                        end
                      else
@@ -746,11 +760,19 @@ implementation
                 if opsize in [OS_S64,OS_64] then
                   begin
                      objectlibrary.getlabel(l1);
+{$ifdef Delphi}
+                     cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_lt, aword(hi(t^._high)), hregister2,
+                           t^.statement);
+                     cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_gt, aword(hi(t^._high)), hregister2,
+                           l1);
+                    cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_BE, aword(lo(t^._high)), hregister, t^.statement);
+{$else}
                      cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_lt, aword(hi(int64(t^._high))), hregister2,
                            t^.statement);
                      cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_gt, aword(hi(int64(t^._high))), hregister2,
                            l1);
                     cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_BE, aword(lo(int64(t^._high))), hregister, t^.statement);
+{$endif}                    
                     cg.a_label(exprasmlist,l1);
                   end
                 else
@@ -993,7 +1015,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.21  2002-10-03 21:31:10  carl
+  Revision 1.22  2002-10-05 12:43:25  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.21  2002/10/03 21:31:10  carl
     * range check error fixes
 
   Revision 1.20  2002/09/17 18:54:03  jonas
@@ -1077,3 +1103,5 @@ end.
   + generic sets
 
 }
+
+

+ 32 - 3
compiler/ncnv.pas

@@ -29,7 +29,11 @@ interface
     uses
        node,
        symtype,symppu,defbase,
-       nld;
+       nld
+{$ifdef Delphi}
+       ,dmisc
+{$endif}
+       ;
 
     type
        ttypeconvnode = class(tunarynode)
@@ -874,7 +878,7 @@ implementation
 
 
     function ttypeconvnode.resulttype_call_helper(c : tconverttype) : tnode;
-
+{$ifdef fpc}
       const
          resulttypeconvert : array[tconverttype] of pointer = (
           {equal} nil,
@@ -923,6 +927,27 @@ implementation
          if assigned(r.proc) then
           result:=tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
       end;
+{$else}
+      begin
+        case c of
+          tc_string_2_string: resulttype_string_to_string;
+          tc_char_2_string : resulttype_char_to_string;
+          tc_char_2_chararray: resulttype_char_to_chararray;
+          tc_pchar_2_string : resulttype_pchar_to_string;
+          tc_cchar_2_pchar : resulttype_cchar_to_pchar;
+          tc_cstring_2_pchar : resulttype_cstring_to_pchar;
+          tc_string_2_chararray : resulttype_string_to_chararray;
+          tc_chararray_2_string : resulttype_chararray_to_string;
+          tc_real_2_real : resulttype_real_to_real;
+          tc_int_2_real : resulttype_int_to_real;
+          tc_arrayconstructor_2_set : resulttype_arrayconstructor_to_set;
+          tc_cord_2_pointer : resulttype_cord_to_pointer;
+          tc_intf_2_guid : resulttype_interface_to_guid;
+          tc_char_2_char : resulttype_char_to_char;
+          tc_dynarray_2_openarray : resulttype_dynarray_to_openarray;
+        end;
+      end;
+{$Endif fpc}
 
 
     function ttypeconvnode.det_resulttype:tnode;
@@ -2059,7 +2084,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.84  2002-10-02 20:23:50  florian
+  Revision 1.85  2002-10-05 12:43:25  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.84  2002/10/02 20:23:50  florian
     - removed the relation check for <class> as <interface> because we don't
       know the runtime type of <class>! It could be a child class of the given type
       which implements additional interfaces

+ 7 - 3
compiler/ncon.pas

@@ -373,7 +373,7 @@ implementation
       begin
         inherited derefimpl;
         restype.resolve;
-        objectlibrary.derefasmsymbol(lab_real);
+        objectlibrary.derefasmsymbol(tasmsymbol(lab_real));
       end;
 
 
@@ -656,7 +656,7 @@ implementation
     procedure tstringconstnode.derefimpl;
       begin
         inherited derefimpl;
-        objectlibrary.derefasmsymbol(lab_str);
+        objectlibrary.derefasmsymbol(tasmsymbol(lab_str));
       end;
 
 
@@ -924,7 +924,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.42  2002-09-07 15:25:03  peter
+  Revision 1.43  2002-10-05 12:43:25  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.42  2002/09/07 15:25:03  peter
     * old logs removed and tabs fixed
 
   Revision 1.41  2002/09/07 12:16:04  carl

+ 11 - 2
compiler/nflw.pas

@@ -355,8 +355,13 @@ implementation
                 left:=Tunarynode(left).left;
                 t.left:=nil;
                 t.destroy;
+{$ifdef Delphi}
+                { How can this be handled in Delphi ? }
+                RunError(255);
+{$else}
                 {Symdif operator, in case you are wondering:}
                 flags:=flags >< [nf_checknegate];
+{$endif}
             end;
          { loop instruction }
          if assigned(right) then
@@ -1025,7 +1030,7 @@ implementation
       begin
         inherited derefimpl;
         resolvesym(pointer(labsym));
-        objectlibrary.derefasmsymbol(labelnr);
+        objectlibrary.derefasmsymbol(tasmsymbol(labelnr));
       end;
 
 
@@ -1405,7 +1410,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.52  2002-09-07 15:25:03  peter
+  Revision 1.53  2002-10-05 12:43:25  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.52  2002/09/07 15:25:03  peter
     * old logs removed and tabs fixed
 
   Revision 1.51  2002/09/07 12:16:04  carl

+ 8 - 2
compiler/nld.pas

@@ -186,7 +186,9 @@ implementation
       begin
         inherited ppuload(t,ppufile);
         symtableentry:=tsym(ppufile.getderef);
+{$ifdef fpc}
 {$warning FIXME: No withsymtable support}
+{$endif}
         symtable:=nil;
         procdef:=tprocdef(ppufile.getderef);
       end;
@@ -832,7 +834,7 @@ implementation
         if not allow_array_constructor then
          begin
            hp:=tarrayconstructornode(getcopy);
-           arrayconstructor_to_set(hp);
+           arrayconstructor_to_set(tnode(hp));
            result:=hp;
            exit;
          end;
@@ -1152,7 +1154,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.61  2002-10-03 21:26:08  carl
+  Revision 1.62  2002-10-05 12:43:25  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.61  2002/10/03 21:26:08  carl
     + compile-time range checking for strings
 
   Revision 1.60  2002/09/27 21:13:28  carl

+ 14 - 6
compiler/nobj.pas

@@ -29,7 +29,11 @@ interface
 
     uses
        cutils,cclasses,cpuinfo,
-       symdef,aasmbase,aasmtai,aasmcpu;
+       symdef,aasmbase,aasmtai,aasmcpu,globtype
+{$ifdef Delphi}
+       ,dmisc
+{$endif}
+       ;
 
     type
       pprocdeftree = ^tprocdeftree;
@@ -93,7 +97,7 @@ interface
         function  gintfgetvtbllabelname(intfindex: integer): string;
         procedure gintfcreatevtbl(intfindex: integer; rawdata,rawcode: TAAsmoutput);
         procedure gintfgenentry(intfindex, contintfindex: integer; rawdata: TAAsmoutput);
-        procedure gintfoptimizevtbls(implvtbl : plongint);
+        procedure gintfoptimizevtbls(implvtbl : plongintarray);
         procedure gintfwritedata;
         function  gintfgetcprocdef(proc: tprocdef;const name: string): tprocdef;
         procedure gintfdoonintf(intf: tobjectdef; intfindex: longint);
@@ -139,7 +143,7 @@ implementation
 {$else}
        strings,
 {$endif}
-       globtype,globals,verbose,
+       globals,verbose,
        symtable,symconst,symtype,symsym,defbase,paramgr,
 {$ifdef GDB}
        gdb,
@@ -860,7 +864,7 @@ implementation
       end;
 
 
-    procedure tclassheader.gintfoptimizevtbls(implvtbl : plongint);
+    procedure tclassheader.gintfoptimizevtbls(implvtbl : plongintarray);
       type
         tcompintfentry = record
           weight: longint;
@@ -943,7 +947,7 @@ implementation
     procedure tclassheader.gintfwritedata;
       var
         rawdata,rawcode: taasmoutput;
-        impintfindexes: plongint;
+        impintfindexes: plongintarray;
         max: longint;
         i: longint;
       begin
@@ -1301,7 +1305,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.28  2002-09-16 14:11:13  peter
+  Revision 1.29  2002-10-05 12:43:25  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.28  2002/09/16 14:11:13  peter
     * add argument to equal_paras() to support default values or not
 
   Revision 1.27  2002/09/03 16:26:26  daniel

+ 7 - 3
compiler/nset.pas

@@ -502,8 +502,8 @@ implementation
 
     procedure ppuderefcaserecord(p : pcaserecord);
       begin
-         objectlibrary.derefasmsymbol(p^._at);
-         objectlibrary.derefasmsymbol(p^.statement);
+         objectlibrary.derefasmsymbol(tasmsymbol(p^._at));
+         objectlibrary.derefasmsymbol(tasmsymbol(p^.statement));
          if assigned(p^.greater) then
            ppuderefcaserecord(p^.greater);
          if assigned(p^.less) then
@@ -691,7 +691,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.33  2002-09-07 12:16:03  carl
+  Revision 1.34  2002-10-05 12:43:25  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.33  2002/09/07 12:16:03  carl
     * second part bug report 1996 fix, testrange in cordconstnode
       only called if option is set (also make parsing a tiny faster)
 

+ 7 - 1
compiler/paramgr.pas

@@ -327,13 +327,19 @@ unit paramgr;
            end;
       end;
 
+initialization
+  ;      
 finalization
   paramanager.free;
 end.
 
 {
    $Log$
-   Revision 1.20  2002-09-30 07:07:25  florian
+   Revision 1.21  2002-10-05 12:43:25  carl
+     * fixes for Delphi 6 compilation
+      (warning : Some features do not work under Delphi)
+
+   Revision 1.20  2002/09/30 07:07:25  florian
      * fixes to common code to get the alpha compiler compiled applied
 
    Revision 1.19  2002/09/30 07:00:47  florian

+ 11 - 2
compiler/pdecobj.pas

@@ -41,7 +41,12 @@ implementation
       cgbase,
       node,nld,nmem,ncon,ncnv,ncal,pass_1,
       scanner,
-      pbase,pexpr,pdecsub,pdecvar,ptype;
+      pbase,pexpr,pdecsub,pdecvar,ptype
+{$ifdef delphi}
+      ,dmisc
+      ,sysutils
+{$endif}
+      ;
 
     function object_dec(const n : stringid;fd : tobjectdef) : tdef;
     { this function parses an object or class declaration }
@@ -1156,7 +1161,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.54  2002-10-02 18:20:20  peter
+  Revision 1.55  2002-10-05 12:43:25  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.54  2002/10/02 18:20:20  peter
     * don't allow interface without m_class mode
 
   Revision 1.53  2002/09/27 21:13:28  carl

+ 13 - 2
compiler/pdecvar.pas

@@ -47,7 +47,12 @@ implementation
        scanner,
        pbase,pexpr,ptype,ptconst,pdecsub,
        { link }
-       import;
+       import
+{$ifdef Delphi}
+       ,dmisc
+       ,sysutils
+{$endif}
+       ;
 
     const
        variantrecordlevel : longint = 0;
@@ -306,7 +311,9 @@ implementation
                   symdone:=true;
                end;
              { hint directive }
+{$ifdef fpc}
              {$warning hintdirective not stored in syms}
+{$endif}             
              dummysymoptions:=[];
              try_consume_hintdirective(dummysymoptions);
              { for a record there doesn't need to be a ; before the END or ) }
@@ -567,7 +574,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.35  2002-10-04 20:53:05  carl
+  Revision 1.36  2002-10-05 12:43:26  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.35  2002/10/04 20:53:05  carl
     * bugfix of crash
 
   Revision 1.34  2002/10/03 21:22:01  carl

+ 9 - 1
compiler/pexports.pas

@@ -48,6 +48,10 @@ implementation
        pbase,pexpr,
        { link }
        gendef,export
+{$ifdef Delphi}
+       ,dmisc
+       ,sysutils
+{$endif}
        ;
 
 
@@ -165,7 +169,11 @@ end.
 
 {
   $Log$
-  Revision 1.23  2002-09-03 16:26:27  daniel
+  Revision 1.24  2002-10-05 12:43:26  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.23  2002/09/03 16:26:27  daniel
     * Make Tprocdef.defs protected
 
   Revision 1.22  2002/07/26 21:15:41  florian

+ 27 - 7
compiler/ppc.dof

@@ -1,12 +1,14 @@
+[FileVersion]
+Version=6.0
 [Compiler]
-A=1
+A=8
 B=0
 C=0
 D=1
 E=0
 F=0
 G=1
-H=1
+H=0
 I=1
 J=1
 K=0
@@ -15,12 +17,12 @@ M=0
 N=1
 O=0
 P=1
-Q=0
-R=0
+Q=1
+R=1
 S=0
 T=0
 U=0
-V=1
+V=0
 W=1
 X=1
 Y=1
@@ -33,6 +35,7 @@ MapFile=0
 OutputObjs=0
 ConsoleApp=0
 DebugInfo=0
+RemoteSymbols=0
 MinStackSize=16384
 MaxStackSize=1048576
 ImageBase=4194304
@@ -40,14 +43,19 @@ ExeDescription=
 [Directories]
 OutputDir=
 UnitOutputDir=
-SearchPath=
+PackageDLLOutputDir=
+PackageDCPOutputDir=
+SearchPath=i386;x86;systems
 Packages=VCL50;VCLX50;VCLSMP50;VCLDB50;VCLADO50;ibevnt50;VCLBDE50;VCLDBX50;QRPT50;TEEUI50;TEEDB50;TEE50;DSS50;TEEQR50;VCLIB50;VCLMID50;VCLIE50;INETDB50;INET50;NMFAST50;WEBMID50;dclocx50;dclaxserver50
-Conditionals=delphi i386 gdb support_mmx
+Conditionals=delphi i386 gdb support_mmx cpu86 noopt
 DebugSourceDirs=
 UsePackages=0
 [Parameters]
 RunParams=
 HostApplication=
+Launcher=
+UseLauncher=0
+DebugCWD=
 [Version Info]
 IncludeVerInfo=0
 AutoIncBuild=0
@@ -73,3 +81,15 @@ OriginalFilename=
 ProductName=
 ProductVersion=1.0.0.0
 Comments=
+[HistoryLists\hlConditionals]
+Count=2
+Item0=delphi i386 gdb support_mmx cpu86 noopt
+Item1=delphi i386 gdb support_mmx cpu86
+[HistoryLists\hlUnitAliases]
+Count=1
+Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE;
+[HistoryLists\hlSearchPath]
+Count=3
+Item0=i386;x86;systems
+Item1=i386;x86
+Item2=i386 x86

+ 5 - 2
compiler/ppc.dpr

@@ -32,7 +32,6 @@ program ppc;
   -----------------------------------------------------------------
   USE_RHIDE           generates errors and warning in an format recognized
                       by rhide
-  TP                  to compile the compiler with Turbo or Borland Pascal
   GDB*                support of the GNU Debugger
   I386                generate a compiler for the Intel i386+
   M68K                generate a compiler for the M68000
@@ -158,7 +157,11 @@ begin
 end.
 {
   $Log$
-  Revision 1.5  2002-09-07 15:25:07  peter
+  Revision 1.6  2002-10-05 12:43:27  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.5  2002/09/07 15:25:07  peter
     * old logs removed and tabs fixed
 
   Revision 1.4  2002/08/12 15:08:40  carl

+ 11 - 2
compiler/psystem.pas

@@ -48,7 +48,12 @@ implementation
 {$ifdef GDB}
       gdb,
 {$endif GDB}
-      node,nbas,nflw,nset,ncon,ncnv,nld,nmem,ncal,nmat,nadd,ninl,nopt;
+      node,nbas,nflw,nset,ncon,ncnv,nld,nmem,ncal,nmat,nadd,ninl,nopt
+{$ifdef Delphi}
+      ,dmisc
+      ,sysutils
+{$endif}
+      ;
 
 
     procedure insertinternsyms(p : tsymtable);
@@ -470,7 +475,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.41  2002-10-02 18:20:53  peter
+  Revision 1.42  2002-10-05 12:43:27  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.41  2002/10/02 18:20:53  peter
     * Copy() is now internal syssym that calls compilerprocs
 
   Revision 1.40  2002/09/27 21:13:29  carl

+ 12 - 3
compiler/rgobj.pas

@@ -36,7 +36,11 @@ unit rgobj;
       cpubase,
       cpuinfo,
       aasmbase,aasmtai,aasmcpu,
-      cclasses,globtype,cginfo,cgbase,node;
+      cclasses,globtype,cginfo,cgbase,node
+{$ifdef delphi}
+      ,dmisc
+{$endif}
+      ;
 
     type
        regvar_longintarray = array[firstreg..lastreg] of longint;
@@ -986,14 +990,19 @@ unit rgobj;
       end;
 
 
-
+initialization
+   ;
 finalization
   rg.free;
 end.
 
 {
   $Log$
-  Revision 1.19  2002-08-23 16:14:49  peter
+  Revision 1.20  2002-10-05 12:43:28  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.19  2002/08/23 16:14:49  peter
     * tempgen cleanup
     * tt_noreuse temp type added that will be used in genentrycode
 

+ 8 - 1
compiler/symdef.pas

@@ -38,6 +38,9 @@ interface
        node,
        { aasm }
        aasmbase,aasmtai,cpubase,cpuinfo
+{$ifdef Delphi}
+       ,dmisc
+{$endif}
        ;
 
 
@@ -5556,7 +5559,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.96  2002-09-27 21:13:29  carl
+  Revision 1.97  2002-10-05 12:43:28  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.96  2002/09/27 21:13:29  carl
     * low-highval always checked if limit ober 2GB is reached (to avoid overflow)
 
   Revision 1.95  2002/09/16 09:31:10  florian

+ 13 - 1
compiler/symppu.pas

@@ -90,7 +90,11 @@ implementation
   {$define Range_check_on}
 {$endif opt R+}
 {$R- needed here }
+{$ifdef Delphi}
+            result:=int64(l1)+(int64(l2) shl 32);
+{$else}
             result:=qword(l1)+(int64(l2) shl 32);
+{$endif}
 {$ifdef Range_check_on}
   {$R+}
   {$undef Range_check_on}
@@ -113,7 +117,11 @@ implementation
   {$define Range_check_on}
 {$endif opt R+}
 {$R- needed here }
+{$ifdef Delphi}
+            result:=int64(l1)+(int64(l2) shl 32);
+{$else}
             result:=qword(l1)+(int64(l2) shl 32);
+{$endif}
 {$ifdef Range_check_on}
   {$R+}
   {$undef Range_check_on}
@@ -494,7 +502,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.16  2002-08-26 14:05:57  pierre
+  Revision 1.17  2002-10-05 12:43:29  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.16  2002/08/26 14:05:57  pierre
    * fixed compilation cycle with -Cr option by adding explicit
      longint typecast in PutPtrUInt and putexprint methods.
    + added checks for sizeof and internalerros if size is not handled.

+ 41 - 35
compiler/symsym.pas

@@ -1020,28 +1020,28 @@ implementation
         search_procdef_bypara:=nil;
         pd:=defs;
         while assigned(pd) do
-          begin
-            if equal_paras(pd^.def.para,params,cp_value_equal_const,allowdefault) or
-               (allowconvert and
-                convertable_paras(pd^.def.para,params,cp_value_equal_const)) then
-              begin
-                search_procdef_bypara:=pd^.def;
-                break;
-              end;
-            pd:=pd^.next;
-          end;
-      end;
-
+            begin
+                if equal_paras(pd^.def.para,params,cp_value_equal_const,allowdefault) or
+                   (allowconvert and convertable_paras(pd^.def.para,params,
+                                                       cp_value_equal_const)) then
+                    begin
+                        search_procdef_bypara:=pd^.def;
+                        break;
+                    end;
+                pd:=pd^.next;
+            end;
+    end;
 
     function Tprocsym.search_procdef_byprocvardef(d:Tprocvardef):Tprocdef;
-      var
-        pd:Pprocdeflist;
-      begin
+    var pd:Pprocdeflist;
+        _result : tprocdef;
+    begin
         {This function will return the pprocdef of pprocsym that
          is the best match for procvardef. When there are multiple
          matches it returns nil.}
         {Try to find an exact match first.}
         search_procdef_byprocvardef:=nil;
+        _result := nil;
         pd:=defs;
         while assigned(pd) do
           begin
@@ -1058,25 +1058,27 @@ implementation
             pd:=pd^.next;
           end;
         {Try a convertable match, if no exact match was found.}
-        if not assigned(search_procdef_byprocvardef) and not assigned(pd) then
-          begin
-            pd:=defs;
-            while assigned(pd) do
-              begin
-                if proc_to_procvar_equal(pd^.def,d,false) then
-                  begin
-                    { already found a match ? Then stop and return nil }
-                    if assigned(search_procdef_byprocvardef) then
-                      begin
-                        search_procdef_byprocvardef:=nil;
-                        break;
-                      end;
-                    search_procdef_byprocvardef:=pd^.def;
-                  end;
-                pd:=pd^.next;
-              end;
-          end;
-      end;
+        if not assigned(_result) and not assigned(pd) then
+            begin
+                pd:=defs;
+                while assigned(pd) do
+                    begin
+                        if proc_to_procvar_equal(pd^.def,d,false) then
+                            begin
+                                { already found a match ? Then stop and return nil }
+                                if assigned(_result) then
+                                    begin
+                                        search_procdef_byprocvardef:=nil;
+                                        _result := nil;
+                                        break;
+                                    end;
+                                search_procdef_byprocvardef:=pd^.def;
+                                _result:=pd^.def;
+                            end;
+                        pd:=pd^.next;
+                    end;
+            end;
+    end;
 
     function Tprocsym.search_procdef_by1paradef(firstpara:Tdef):Tprocdef;
       var
@@ -2502,7 +2504,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.68  2002-10-05 00:52:20  peter
+  Revision 1.69  2002-10-05 12:43:29  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.68  2002/10/05 00:52:20  peter
     * split boolean check in two lines for easier debugging
 
   Revision 1.67  2002/09/26 12:04:53  florian

+ 7 - 3
compiler/symtable.pas

@@ -2044,7 +2044,7 @@ implementation
         if not(cs_compilesystem in aktmoduleswitches) then
           srsym := ttypesym(searchsymonlyin(systemunit,s))
         else
-          searchsym(s,srsym,symowner);
+          searchsym(s,tsym(srsym),symowner);
         searchsystype :=
           assigned(srsym) and
           (srsym.typ = typesym);
@@ -2059,7 +2059,7 @@ implementation
             symowner := systemunit;
           end
         else
-          searchsym(s,srsym,symowner);
+          searchsym(s,tsym(srsym),symowner);
         searchsysvar :=
           assigned(srsym) and
           (srsym.typ = varsym);
@@ -2311,7 +2311,11 @@ implementation
 end.
 {
   $Log$
-  Revision 1.72  2002-09-09 19:41:46  peter
+  Revision 1.73  2002-10-05 12:43:29  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.72  2002/09/09 19:41:46  peter
     * real fix internalerror for dup ids in union sym
 
   Revision 1.71  2002/09/09 17:34:16  peter

+ 7 - 3
compiler/systems.pas

@@ -631,14 +631,14 @@ begin
   {$ifdef cpu86}
     default_target(source_info.system);
   {$else cpu86}
-    default_target(target_i386_linux);
+    default_target(system_i386_linux);
   {$endif cpu86}
 {$endif i386}
 {$ifdef x86_64}
   {$ifdef cpu86_64}
     default_target(source_info.system);
   {$else cpu86_64}
-    default_target(target_x86_64_linux);
+    default_target(system_x86_64_linux);
   {$endif cpu86_64}
 {$endif x86_64}
 {$ifdef m68k}
@@ -675,7 +675,11 @@ finalization
 end.
 {
   $Log$
-  Revision 1.56  2002-10-03 21:18:29  carl
+  Revision 1.57  2002-10-05 12:43:29  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.56  2002/10/03 21:18:29  carl
    * correct tsystem enumeration
 
   Revision 1.55  2002/09/07 18:05:51  florian

+ 9 - 1
compiler/systems/t_beos.pas

@@ -60,7 +60,11 @@ interface
 implementation
 
   uses
+{$ifdef delphi}
+    dmisc,
+{$else}
     dos,
+{$endif}
     cutils,cclasses,
     verbose,systems,globtype,globals,
     symconst,script,
@@ -466,7 +470,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.2  2002-09-09 17:34:17  peter
+  Revision 1.3  2002-10-05 12:43:29  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.2  2002/09/09 17:34:17  peter
     * tdicationary.replace added to replace and item in a dictionary. This
       is only allowed for the same name
     * varsyms are inserted in symtable before the types are parsed. This

+ 10 - 3
compiler/systems/t_wdosx.pas

@@ -68,10 +68,13 @@ const
                              TLINKERWDOSX
 *****************************************************************************}
 function TLinkerWdosx.MakeExecutable:boolean;
+var
+ b: boolean;
 begin
- Result:=inherited;
- if Result then
+ b := Inherited MakeExecutable;
+ if b then
   DoExec(FindUtil('stubit'),current_module.exefilename^,false,false);
+ Result := b; 
 end;
 
 {****************************************************************************
@@ -99,7 +102,11 @@ end.
 
 {
   $Log$
-  Revision 1.1  2002-09-06 15:03:50  carl
+  Revision 1.2  2002-10-05 12:43:29  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.1  2002/09/06 15:03:50  carl
     * moved files to systems directory
 
   Revision 1.10  2002/08/12 15:08:44  carl

+ 6 - 1
compiler/systems/t_win32.pas

@@ -28,6 +28,7 @@ interface
     uses
 {$ifdef Delphi}
        dmisc,
+       sysutils,
 {$else Delphi}
        dos,
 {$endif Delphi}
@@ -1562,7 +1563,11 @@ initialization
 end.
 {
   $Log$
-  Revision 1.2  2002-09-09 17:34:17  peter
+  Revision 1.3  2002-10-05 12:43:29  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.2  2002/09/09 17:34:17  peter
     * tdicationary.replace added to replace and item in a dictionary. This
       is only allowed for the same name
     * varsyms are inserted in symtable before the types are parsed. This

+ 8 - 2
compiler/verbose.pas

@@ -25,7 +25,9 @@ unit verbose;
 {$i fpcdefs.inc}
 
 { Don't include messages in the executable }
-{.$define EXTERN_MSG}
+{$ifdef Delphi}
+{$define EXTERN_MSG}
+{$endif}
 
 interface
 
@@ -680,7 +682,11 @@ var
 end.
 {
   $Log$
-  Revision 1.20  2002-08-18 19:59:03  peter
+  Revision 1.21  2002-10-05 12:43:29  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.20  2002/08/18 19:59:03  peter
     * renamed local current_module to compiling_module because it
       confused a lot in gdb
 

+ 15 - 2
compiler/widestr.pas

@@ -27,13 +27,18 @@ unit widestr;
   interface
 
     uses
-       charset;
+       charset
+{$ifdef delphi}
+       ,sysutils
+{$endif}
+       ;
 
 
     type
        tcompilerwidechar = word;
        tcompilerwidecharptr = ^tcompilerwidechar;
 {$ifdef delphi}
+       strlenint = integer;
        { delphi doesn't allow pointer accessing as array }
        tcompilerwidechararray = array[0..0] of tcompilerwidechar;
        pcompilerwidechar = ^tcompilerwidechararray;
@@ -147,7 +152,11 @@ unit widestr;
          temp:=s2^.len;
          if maxi>temp then
            maxi:=Temp;
+{$ifdef Delphi}
+         temp:=strlenint(comparemem(@s1^.data,@s2^.data,maxi));
+{$else}
          temp:=compareword(s1^.data^,s2^.data^,maxi);
+{$endif}
          if temp=0 then
            temp:=s1^.len-s2^.len;
          comparewidestrings:=temp;
@@ -231,7 +240,11 @@ unit widestr;
 end.
 {
   $Log$
-  Revision 1.11  2002-07-20 17:16:03  florian
+  Revision 1.12  2002-10-05 12:43:29  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.11  2002/07/20 17:16:03  florian
     + source code page support
 
   Revision 1.10  2002/05/18 13:34:21  peter

+ 6 - 2
compiler/x86/cgx86.pas

@@ -295,7 +295,7 @@ unit cgx86;
                               Assembler code
 ****************************************************************************}
 
-    function tcgx86.reg_cgsize(const reg: tregister): tcgsize;
+    class function tcgx86.reg_cgsize(const reg: tregister): tcgsize;
       const
         regsize_2_cgsize: array[S_B..S_L] of tcgsize = (OS_8,OS_16,OS_32);
       begin
@@ -1681,7 +1681,11 @@ unit cgx86;
 end.
 {
   $Log$
-  Revision 1.17  2002-09-17 18:54:06  jonas
+  Revision 1.18  2002-10-05 12:43:30  carl
+    * fixes for Delphi 6 compilation
+     (warning : Some features do not work under Delphi)
+
+  Revision 1.17  2002/09/17 18:54:06  jonas
     * a_load_reg_reg() now has two size parameters: source and dest. This
       allows some optimizations on architectures that don't encode the
       register size in the register name.