فهرست منبع

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

carl 23 سال پیش
والد
کامیت
67486c96c3
51فایلهای تغییر یافته به همراه677 افزوده شده و 195 حذف شده
  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;
          procedure fixuprelocs;virtual;
        end;
        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;
        pasmsymbolidxarr = ^tasmsymbolidxarr;
 
 
        TAsmLibraryData = class(TLinkedListItem)
        TAsmLibraryData = class(TLinkedListItem)
@@ -859,7 +863,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
     * More fixes for cross unit inlining, all tnodes are now implemented
     * Moved pocall_internconst to po_internconst because it is not a
     * Moved pocall_internconst to po_internconst because it is not a
       calling type at all and it conflicted when inlining of these small
       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;
     procedure tai_label.derefimpl;
       begin
       begin
-        objectlibrary.DerefAsmsymbol(l);
+        objectlibrary.DerefAsmsymbol(tasmsymbol(l));
         l.is_set:=true;
         l.is_set:=true;
       end;
       end;
 
 
@@ -1548,7 +1548,11 @@ uses
 end.
 end.
 {
 {
   $Log$
   $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
     * More fixes for cross unit inlining, all tnodes are now implemented
     * Moved pocall_internconst to po_internconst because it is not a
     * Moved pocall_internconst to po_internconst because it is not a
       calling type at all and it conflicted when inlining of these small
       calling type at all and it conflicted when inlining of these small

+ 14 - 1
compiler/aggas.pas

@@ -317,6 +317,9 @@ var
       e        : extended;
       e        : extended;
       do_line  : boolean;
       do_line  : boolean;
       sep      : char;
       sep      : char;
+{$ifdef delphi}
+      _64bitarray : t64bitarray;
+{$endif}
     begin
     begin
       if not assigned(p) then
       if not assigned(p) then
        exit;
        exit;
@@ -493,8 +496,10 @@ var
                 AsmWriteLn(target_asm.comment+target_asm.comment+double2str(tai_real_64bit(hp).value));
                 AsmWriteLn(target_asm.comment+target_asm.comment+double2str(tai_real_64bit(hp).value));
                d:=tai_real_64bit(hp).value;
                d:=tai_real_64bit(hp).value;
                { swap the values to correct endian if required }
                { swap the values to correct endian if required }
+{$ifdef fpc}               
                if source_info.endian <> target_info.endian then
                if source_info.endian <> target_info.endian then
                  swap64bitarray(t64bitarray(d));
                  swap64bitarray(t64bitarray(d));
+{$endif}
                AsmWrite(#9'.byte'#9);
                AsmWrite(#9'.byte'#9);
                for i:=0 to 7 do
                for i:=0 to 7 do
                 begin
                 begin
@@ -510,9 +515,11 @@ var
                if do_line then
                if do_line then
                 AsmWriteLn(target_asm.comment+target_asm.comment+single2str(tai_real_32bit(hp).value));
                 AsmWriteLn(target_asm.comment+target_asm.comment+single2str(tai_real_32bit(hp).value));
                sin:=tai_real_32bit(hp).value;
                sin:=tai_real_32bit(hp).value;
+{$ifdef fpc}
                { swap the values to correct endian if required }
                { swap the values to correct endian if required }
                if source_info.endian <> target_info.endian then
                if source_info.endian <> target_info.endian then
                  swap32bitarray(t32bitarray(sin));
                  swap32bitarray(t32bitarray(sin));
+{$endif}                 
                AsmWrite(#9'.byte'#9);
                AsmWrite(#9'.byte'#9);
                for i:=0 to 3 do
                for i:=0 to 3 do
                 begin
                 begin
@@ -533,9 +540,11 @@ var
 {$else}
 {$else}
                co:=tai_comp_64bit(hp).value;
                co:=tai_comp_64bit(hp).value;
 {$endif}
 {$endif}
+{$ifdef fpc}
                { swap the values to correct endian if required }
                { swap the values to correct endian if required }
                if source_info.endian <> target_info.endian then
                if source_info.endian <> target_info.endian then
                  swap64bitarray(t64bitarray(co));
                  swap64bitarray(t64bitarray(co));
+{$endif}                 
                for i:=0 to 7 do
                for i:=0 to 7 do
                 begin
                 begin
                   if i<>0 then
                   if i<>0 then
@@ -800,7 +809,11 @@ var
 end.
 end.
 {
 {
   $Log$
   $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
     * write double # before float constants when -al is turned on
       else some gas versions interpret it as line number
       else some gas versions interpret it as line number
 
 

+ 9 - 2
compiler/cclasses.pas

@@ -316,7 +316,9 @@ implementation
       begin
       begin
         if startmem<>0 then
         if startmem<>0 then
          begin
          begin
+{$ifndef Delphi}
            inc(TotalMem,memavail-startmem);
            inc(TotalMem,memavail-startmem);
+{$endif}           
            startmem:=0;
            startmem:=0;
          end;
          end;
       end;
       end;
@@ -862,8 +864,9 @@ end;
 
 
     function counttree(p: tnamedindexitem): longint;
     function counttree(p: tnamedindexitem): longint;
       begin
       begin
+        counttree:=0;
         if not assigned(p) then
         if not assigned(p) then
-          exit(0);
+          exit;
         result := 1;
         result := 1;
         inc(result,counttree(p.fleft));
         inc(result,counttree(p.fleft));
         inc(result,counttree(p.fright));
         inc(result,counttree(p.fright));
@@ -1844,7 +1847,11 @@ end;
 end.
 end.
 {
 {
   $Log$
   $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
     * tdicationary.replace added to replace and item in a dictionary. This
       is only allowed for the same name
       is only allowed for the same name
     * varsyms are inserted in symtable before the types are parsed. This
     * 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,
        aasmbase,aasmtai,aasmcpu,
        cpuinfo, cpubase,
        cpuinfo, cpubase,
        cginfo, cgobj,
        cginfo, cgobj,
-       node,symtype;
+       node,symtype
+{$ifdef delphi}
+       ,dmisc
+{$endif}
+       ;
 
 
     type
     type
       {# Defines all the methods required on 32-bit processors
       {# 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);
     procedure tcg64f32.a_param64_reg(list : taasmoutput;reg : tregister64;const locpara : tparalocation);
       begin
       begin
+{$ifdef FPC}
 {$warning FIX ME}
 {$warning FIX ME}
+{$endif}
          cg.a_param_reg(list,OS_32,reg.reghi,locpara);
          cg.a_param_reg(list,OS_32,reg.reghi,locpara);
          { the nr+1 needs definitivly a fix FK }
          { the nr+1 needs definitivly a fix FK }
          { maybe the parameter numbering needs }
          { maybe the parameter numbering needs }
@@ -427,7 +433,9 @@ unit cg64f32;
 
 
     procedure tcg64f32.a_param64_const(list : taasmoutput;value : qword;const locpara : tparalocation);
     procedure tcg64f32.a_param64_const(list : taasmoutput;value : qword;const locpara : tparalocation);
       begin
       begin
+{$ifdef fpc}
 {$warning FIX ME}
 {$warning FIX ME}
+{$endif}
         if target_info.endian = endian_big then
         if target_info.endian = endian_big then
           swap_qword(value);
           swap_qword(value);
          cg.a_param_const(list,OS_32,hi(value),locpara);
          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);
     procedure tcg64f32.a_param64_loc(list : taasmoutput;const l:tlocation;const locpara : tparalocation);
       begin
       begin
+{$ifdef fpc}
 {$warning FIX ME}
 {$warning FIX ME}
+{$endif}
         case l.loc of
         case l.loc of
           LOC_REGISTER,
           LOC_REGISTER,
           LOC_CREGISTER :
           LOC_CREGISTER :
@@ -738,7 +748,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * a_load_reg_reg() now has two size parameters: source and dest. This
       allows some optimizations on architectures that don't encode the
       allows some optimizations on architectures that don't encode the
       register size in the register name.
       register size in the register name.

+ 7 - 2
compiler/cgbase.pas

@@ -181,12 +181,13 @@ unit cgbase;
           fpuregvars_refs : array[1..maxfpuvarregs] of longint;
           fpuregvars_refs : array[1..maxfpuvarregs] of longint;
        end;
        end;
 
 
+       tcprocinfo = class of tprocinfo;
 
 
     var
     var
        {# information about the current sub routine being parsed (@var(pprocinfo))}
        {# information about the current sub routine being parsed (@var(pprocinfo))}
        procinfo : tprocinfo;
        procinfo : tprocinfo;
 
 
-       cprocinfo : class of tprocinfo;
+       cprocinfo : tcprocinfo;
 
 
        { labels for BREAK and CONTINUE }
        { labels for BREAK and CONTINUE }
        aktbreaklabel,aktcontinuelabel : tasmlabel;
        aktbreaklabel,aktcontinuelabel : tasmlabel;
@@ -657,7 +658,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * range check error fix
 
 
   Revision 1.30  2002/09/30 07:00:44  florian
   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,
        cclasses,aasmbase,aasmtai,aasmcpu,symtable,
        cpubase,cpuinfo,cpupara,
        cpubase,cpuinfo,cpupara,
        cginfo,
        cginfo,
-       symconst,symbase,symtype,node;
+       symconst,symbase,symtype,node
+{$ifdef delphi}
+       ,dmisc
+{$endif}
+       ;
 
 
     type
     type
        talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE);
        talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE);
@@ -1081,7 +1085,7 @@ unit cgobj;
       end;
       end;
 
 
 
 
-    function tcg.reg_cgsize(const reg: tregister) : tcgsize;
+    class function tcg.reg_cgsize(const reg: tregister) : tcgsize;
       begin
       begin
         reg_cgsize := OS_INT;
         reg_cgsize := OS_INT;
       end;
       end;
@@ -1089,7 +1093,9 @@ unit cgobj;
 
 
     procedure tcg.g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;delsource,loadref : boolean);
     procedure tcg.g_copyshortstring(list : taasmoutput;const source,dest : treference;len:byte;delsource,loadref : boolean);
       begin
       begin
+{$ifdef FPC}
         {$warning FIX ME!}
         {$warning FIX ME!}
+{$endif}        
         a_paramaddr_ref(list,dest,paramanager.getintparaloc(3));
         a_paramaddr_ref(list,dest,paramanager.getintparaloc(3));
         if loadref then
         if loadref then
           a_param_ref(list,OS_ADDR,source,paramanager.getintparaloc(2))
           a_param_ref(list,OS_ADDR,source,paramanager.getintparaloc(2))
@@ -1573,7 +1579,8 @@ unit cgobj;
      end;
      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
       begin
         a_load64_reg_reg(list,regsrc,regdst);
         a_load64_reg_reg(list,regsrc,regdst);
         a_op64_const_reg(list,op,value,regdst);
         a_op64_const_reg(list,op,value,regdst);
@@ -1588,14 +1595,19 @@ unit cgobj;
 
 
 
 
 
 
-
+initialization
+    ;
 finalization
 finalization
   cg.free;
   cg.free;
   cg64.free;
   cg64.free;
 end.
 end.
 {
 {
   $Log$
   $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
     * Copy() is now internal syssym that calls compilerprocs
 
 
   Revision 1.59  2002/09/17 18:54:02  jonas
   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.
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
 
  **********************************************************************}
  **********************************************************************}
+{$ifndef delphi}
 {$mode objfpc}
 {$mode objfpc}
+{$endif}
 unit charset;
 unit charset;
 
 
   interface
   interface
@@ -69,7 +71,7 @@ unit charset;
          t : text;
          t : text;
          s,hs : string;
          s,hs : string;
          scanpos,charpos,unicodevalue : longint;
          scanpos,charpos,unicodevalue : longint;
-         code : word;
+         code : integer;
          flag : tunicodecharmappingflag;
          flag : tunicodecharmappingflag;
          p : punicodemap;
          p : punicodemap;
          lastchar : longint;
          lastchar : longint;
@@ -146,8 +148,13 @@ unit charset;
                           end;
                           end;
                         flag:=umf_noinfo;
                         flag:=umf_noinfo;
                      end;
                      end;
+{$ifdef delphi}
+                   data^.flag:=flag;
+                   data^.unicode:=unicodevalue;
+{$else}
                    data[charpos].flag:=flag;
                    data[charpos].flag:=flag;
                    data[charpos].unicode:=unicodevalue;
                    data[charpos].unicode:=unicodevalue;
+{$endif delphi}
                    if charpos>lastchar then
                    if charpos>lastchar then
                      lastchar:=charpos;
                      lastchar:=charpos;
                 end;
                 end;
@@ -209,7 +216,11 @@ unit charset;
 
 
       begin
       begin
          if ord(c)<=p^.lastchar then
          if ord(c)<=p^.lastchar then
+{$ifdef Delphi}
+           getunicode:=p^.map.unicode
+{$else}
            getunicode:=p^.map[ord(c)].unicode
            getunicode:=p^.map[ord(c)].unicode
+{$endif}
          else
          else
            getunicode:=0;
            getunicode:=0;
       end;
       end;
@@ -223,7 +234,11 @@ unit charset;
          { at least map to space }
          { at least map to space }
          getascii:=#32;
          getascii:=#32;
          for i:=0 to p^.lastchar do
          for i:=0 to p^.lastchar do
+{$ifdef Delphi}
+           if p^.map.unicode=c then
+{$else}
            if p^.map[i].unicode=c then
            if p^.map[i].unicode=c then
+{$endif}
              begin
              begin
                 if i<256 then
                 if i<256 then
                   getascii:=chr(i)
                   getascii:=chr(i)
@@ -252,7 +267,11 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $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
     * old logs removed and tabs fixed
 
 
   Revision 1.1  2002/07/20 17:11:48  florian
   Revision 1.1  2002/07/20 17:11:48  florian

+ 10 - 7
compiler/cutils.pas

@@ -30,11 +30,6 @@ unit cutils;
 
 
 interface
 interface
 
 
-{$ifdef delphi}
-    type
-       dword = cardinal;
-       qword = int64;
-{$endif}
 
 
     type
     type
        pstring = ^string;
        pstring = ^string;
@@ -426,9 +421,13 @@ uses
 
 
 
 
     function space (b : longint): string;
     function space (b : longint): string;
+      var
+       s: string;
       begin
       begin
         space[0] := chr(b);
         space[0] := chr(b);
-        FillChar (Space[1],b,' ');
+        s[0] := chr(b);
+        FillChar (S[1],b,' ');
+        space:=s;
       end;
       end;
 
 
 
 
@@ -821,7 +820,11 @@ initialization
 end.
 end.
 {
 {
   $Log$
   $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
     * memdebug enhancements
 
 
   Revision 1.21  2002/07/26 11:16:35  jonas
   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 overload_procs : pprocdeflist) : tprocdef;
      var
      var
        p :pprocdeflist;
        p :pprocdeflist;
+       _result : tprocdef;
      begin
      begin
           internal_assignment_overloaded:=nil;
           internal_assignment_overloaded:=nil;
           p := nil;
           p := nil;
@@ -1301,18 +1302,24 @@ implementation
             exit;
             exit;
 
 
           { look for an exact match first, from start of list }
           { 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,
              search_procdef_byretdef_by1paradef(to_def,from_def,dm_exact,
                p);
                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 }
           { .... 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,
            search_procdef_byretdef_by1paradef(to_def,from_def,dm_equal,
                 p);
                 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 }
           {  .... then for convert level 1, continue from where we were at }
           internal_assignment_overloaded:=overloaded_operators[_ASSIGNMENT].
           internal_assignment_overloaded:=overloaded_operators[_ASSIGNMENT].
@@ -1962,7 +1969,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
     * check parameters from left to right in equal_paras, so default
       parameters are checked at the end
       parameters are checked at the end
 
 

+ 21 - 4
compiler/dmisc.pas

@@ -38,9 +38,6 @@ uses
 {$endif}
 {$endif}
   sysutils;
   sysutils;
 
 
-{$ifdef VER100}
-   type int64 = longint;
-{$endif}
 
 
 Const
 Const
   Max_Path = 255;
   Max_Path = 255;
@@ -71,6 +68,9 @@ Const
 
 
 Type
 Type
   DWord   = Cardinal;
   DWord   = Cardinal;
+  qword = int64;
+  tlongint = array[0..65535] of longint;
+  plongintarray = ^tlongint;
 
 
 { Needed for Win95 LFN Support }
 { Needed for Win95 LFN Support }
   ComStr  = String[255];
   ComStr  = String[255];
@@ -144,6 +144,9 @@ Procedure SetCBreak(breakvalue: boolean);
 Procedure GetVerify(var verify: boolean);
 Procedure GetVerify(var verify: boolean);
 Procedure SetVerify(verify: boolean);
 Procedure SetVerify(verify: boolean);
 
 
+{Memory}
+function  CompareByte(const buf1,buf2;len:longint):longint;
+
 {Do Nothing Functions}
 {Do Nothing Functions}
 Procedure SwapVectors;
 Procedure SwapVectors;
 Procedure GetIntVec(intno: byte; var vector: pointer);
 Procedure GetIntVec(intno: byte; var vector: pointer);
@@ -152,6 +155,16 @@ Procedure Keep(exitcode: word);
 
 
 implementation
 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;
     function upper(const s : string) : string;
     {
     {
       return uppercased string of s
       return uppercased string of s
@@ -840,7 +853,11 @@ End;
 end.
 end.
 {
 {
   $Log$
   $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)
     + stab register indexes for powerpc (moved from gdb to cpubase)
     + tprocessor enumeration moved to cpuinfo
     + tprocessor enumeration moved to cpuinfo
     + linker in target_info is now a class
     + linker in target_info is now a class

+ 8 - 2
compiler/fpcdefs.inc

@@ -24,7 +24,6 @@
   {$Z1}
   {$Z1}
 
 
   {$undef FPCPROCVAR}
   {$undef FPCPROCVAR}
-  {$define USEEXCEPT}
 {$endif}
 {$endif}
 
 
 
 
@@ -32,6 +31,9 @@
 {$define cpuflags}
 {$define cpuflags}
 
 
 {$ifdef i386}
 {$ifdef i386}
+  {$ifdef delphi}
+  {$define oldset}
+  {$endif}
   {$define x86}
   {$define x86}
 {$else}
 {$else}
   {$define oldset}
   {$define oldset}
@@ -46,7 +48,11 @@
 {$endif alpha}
 {$endif alpha}
 {
 {
   $Log$
   $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
     * fixes to common code to get the alpha compiler compiled applied
 
 
   Revision 1.10  2002/09/29 23:19:05  florian
   Revision 1.10  2002/09/29 23:19:05  florian

+ 9 - 1
compiler/globtype.pas

@@ -143,6 +143,7 @@ interface
          pocall_system         { system call }
          pocall_system         { system call }
        );
        );
        tproccalloptions = set of tproccalloption;
        tproccalloptions = set of tproccalloption;
+       
 
 
      const
      const
        proccalloptionStr : array[tproccalloption] of string[14]=('',
        proccalloptionStr : array[tproccalloption] of string[14]=('',
@@ -166,12 +167,15 @@ interface
 
 
        tnormalset = set of byte; { 256 elements set }
        tnormalset = set of byte; { 256 elements set }
        pnormalset = ^tnormalset;
        pnormalset = ^tnormalset;
+       
+       
 
 
        pboolean   = ^boolean;
        pboolean   = ^boolean;
        pdouble    = ^double;
        pdouble    = ^double;
        pbyte      = ^byte;
        pbyte      = ^byte;
        pword      = ^word;
        pword      = ^word;
        plongint   = ^longint;
        plongint   = ^longint;
+       plongintarray = plongint;
 
 
        Tconstant=record
        Tconstant=record
             case signed:boolean of
             case signed:boolean of
@@ -207,7 +211,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
     * More fixes for cross unit inlining, all tnodes are now implemented
     * Moved pocall_internconst to po_internconst because it is not a
     * Moved pocall_internconst to po_internconst because it is not a
       calling type at all and it conflicted when inlining of these small
       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,
        cginfo,cgbase,cgobj,cg64f32,cgx86,
        aasmbase,aasmtai,aasmcpu,
        aasmbase,aasmtai,aasmcpu,
        cpubase,cpuinfo,cpupara,
        cpubase,cpuinfo,cpupara,
-       node,symconst;
+       node,symconst
+{$ifdef delphi}
+       ,dmisc
+{$endif}
+       ;
 
 
     type
     type
       tcg386 = class(tcgx86)
       tcg386 = class(tcgx86)
@@ -170,7 +174,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * old logs removed and tabs fixed
 
 
   Revision 1.29  2002/07/20 19:28:47  florian
   Revision 1.29  2002/07/20 19:28:47  florian

+ 10 - 2
compiler/i386/cpubase.pas

@@ -39,7 +39,11 @@ uses
   globals,
   globals,
   cpuinfo,
   cpuinfo,
   aasmbase,
   aasmbase,
-  cginfo;
+  cginfo
+{$ifdef delphi}
+  ,dmisc
+{$endif}
+  ;
 
 
 
 
 {*****************************************************************************
 {*****************************************************************************
@@ -521,7 +525,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
     - remove valuelow/valuehigh fields from tlocation, because they depend
       on the endianess of the host operating system -> difficult to get
       on the endianess of the host operating system -> difficult to get
       right. Use lo/hi(location.valueqword) instead (remember to use
       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 }
                 { inlined code is in inlinecode }
                 begin
                 begin
                    { process the inlinecode }
                    { process the inlinecode }
-                   secondpass(inlinecode);
+                   secondpass(tnode(inlinecode));
                    { free the args }
                    { free the args }
                    if tprocdef(procdefinition).parast.datasize>0 then
                    if tprocdef(procdefinition).parast.datasize>0 then
                      tg.UnGetTemp(exprasmlist,pararef);
                      tg.UnGetTemp(exprasmlist,pararef);
@@ -1311,7 +1311,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * a_load_reg_reg() now has two size parameters: source and dest. This
       allows some optimizations on architectures that don't encode the
       allows some optimizations on architectures that don't encode the
       register size in the register name.
       register size in the register name.

+ 70 - 30
compiler/i386/n386cnv.pas

@@ -322,37 +322,38 @@ implementation
 
 
 
 
     procedure ti386typeconvnode.second_call_helper(c : tconverttype);
     procedure ti386typeconvnode.second_call_helper(c : tconverttype);
+{$ifdef fpc}    
       const
       const
          secondconvert : array[tconverttype] of pointer = (
          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
       type
          tprocedureofobject = procedure of object;
          tprocedureofobject = procedure of object;
@@ -370,13 +371,52 @@ implementation
          r.obj:=self;
          r.obj:=self;
          tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
          tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
       end;
       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
 begin
    ctypeconvnode:=ti386typeconvnode;
    ctypeconvnode:=ti386typeconvnode;
 end.
 end.
 {
 {
   $Log$
   $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
     * a_load_reg_reg() now has two size parameters: source and dest. This
       allows some optimizations on architectures that don't encode the
       allows some optimizations on architectures that don't encode the
       register size in the register name.
       register size in the register name.

+ 6 - 2
compiler/i386/rgcpu.pas

@@ -36,6 +36,7 @@ unit rgcpu;
 
 
     type
     type
        trgcpu = class(trgobj)
        trgcpu = class(trgobj)
+         fpuvaroffset : byte;
 
 
           { to keep the same allocation order as with the old routines }
           { to keep the same allocation order as with the old routines }
           function getregisterint(list: taasmoutput): tregister; override;
           function getregisterint(list: taasmoutput): tregister; override;
@@ -70,7 +71,6 @@ unit rgcpu;
          { corrects the fpu stack register by ofs }
          { corrects the fpu stack register by ofs }
          function correct_fpuregister(r : tregister;ofs : byte) : tregister;
          function correct_fpuregister(r : tregister;ofs : byte) : tregister;
 
 
-         fpuvaroffset : byte;
        end;
        end;
 
 
 
 
@@ -429,7 +429,11 @@ end.
 
 
 {
 {
   $Log$
   $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
     * first part of procinfo rewrite
 
 
   Revision 1.8  2002/07/01 18:46:34  peter
   Revision 1.8  2002/07/01 18:46:34  peter

+ 6 - 2
compiler/impdef.pas

@@ -69,7 +69,7 @@ var
   impname:string;
   impname:string;
   TheWord:array[0..1]of char;
   TheWord:array[0..1]of char;
   PEoffset:cardinal;
   PEoffset:cardinal;
-  loaded:{$ifdef fpc}longint{$else}integer{$endif};
+  loaded:longint;
 
 
 function DOSstubOK(var x:longint):longbool;
 function DOSstubOK(var x:longint):longbool;
 begin
 begin
@@ -479,7 +479,11 @@ end.
 
 
 {
 {
   $Log$
   $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
     * readded missing revisions
 
 
   Revision 1.8  2002/05/16 19:46:37  carl
   Revision 1.8  2002/05/16 19:46:37  carl

+ 7 - 1
compiler/ncal.pas

@@ -742,7 +742,9 @@ implementation
       begin
       begin
         inherited ppuload(t,ppufile);
         inherited ppuload(t,ppufile);
         symtableprocentry:=tprocsym(ppufile.getderef);
         symtableprocentry:=tprocsym(ppufile.getderef);
+{$ifdef fpc}
 {$warning FIXME: No withsymtable support}
 {$warning FIXME: No withsymtable support}
+{$endif}
         symtableproc:=nil;
         symtableproc:=nil;
         procdefinition:=tprocdef(ppufile.getderef);
         procdefinition:=tprocdef(ppufile.getderef);
         restypeset:=boolean(ppufile.getbyte);
         restypeset:=boolean(ppufile.getbyte);
@@ -2628,7 +2630,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * support inherited; support for overload as it is handled by
       delphi. This is only for delphi mode as it is working is
       delphi. This is only for delphi mode as it is working is
       undocumented and hard to predict what is done
       undocumented and hard to predict what is done

+ 6 - 2
compiler/ncgcal.pas

@@ -990,7 +990,7 @@ implementation
                 { inlined code is in inlinecode }
                 { inlined code is in inlinecode }
                 begin
                 begin
                    { process the inlinecode }
                    { process the inlinecode }
-                   secondpass(inlinecode);
+                   secondpass(tnode(inlinecode));
                    { free the args }
                    { free the args }
                    if tprocdef(procdefinition).parast.datasize>0 then
                    if tprocdef(procdefinition).parast.datasize>0 then
                      tg.UnGetTemp(exprasmlist,pararef);
                      tg.UnGetTemp(exprasmlist,pararef);
@@ -1492,7 +1492,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * fixes to common code to get the alpha compiler compiled applied
 
 
   Revision 1.23  2002/09/17 18:54:02  jonas
   Revision 1.23  2002/09/17 18:54:02  jonas

+ 9 - 1
compiler/ncgcnv.pas

@@ -160,7 +160,9 @@ interface
                else
                else
                 begin
                 begin
                   location.register:=rg.getregisterint(exprasmlist);
                   location.register:=rg.getregisterint(exprasmlist);
+{$ifdef fpc}
 {$warning Todo: convert widestrings to ascii when typecasting them to pchars}
 {$warning Todo: convert widestrings to ascii when typecasting them to pchars}
+{$endif}
                   cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,
                   cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,
                     location.register);
                     location.register);
                 end;
                 end;
@@ -433,7 +435,9 @@ interface
 
 
     procedure tcgtypeconvnode.second_char_to_char;
     procedure tcgtypeconvnode.second_char_to_char;
       begin
       begin
+{$ifdef fpc}
         {$warning todo: add RTL routine for widechar-char conversion }
         {$warning todo: add RTL routine for widechar-char conversion }
+{$endif}        
         { Quick hack to atleast generate 'working' code (PFV) }
         { Quick hack to atleast generate 'working' code (PFV) }
         second_int_to_int;
         second_int_to_int;
       end;
       end;
@@ -503,7 +507,11 @@ end.
 
 
 {
 {
   $Log$
   $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
     * a_load_reg_reg() now has two size parameters: source and dest. This
       allows some optimizations on architectures that don't encode the
       allows some optimizations on architectures that don't encode the
       register size in the register name.
       register size in the register name.

+ 22 - 4
compiler/ncgcon.pas

@@ -67,7 +67,11 @@ implementation
       verbose,globals,
       verbose,globals,
       symconst,symdef,aasmbase,aasmtai,defbase,
       symconst,symdef,aasmbase,aasmtai,defbase,
       cpuinfo,cpubase,
       cpuinfo,cpubase,
-      cginfo,cgbase,tgobj,rgobj;
+      cginfo,cgbase,tgobj,rgobj
+{$ifdef delphi}
+      ,dmisc
+{$endif}
+      ;
 
 
 
 
 {*****************************************************************************
 {*****************************************************************************
@@ -77,11 +81,9 @@ implementation
     procedure tcgrealconstnode.pass_2;
     procedure tcgrealconstnode.pass_2;
       { I suppose the parser/pass_1 must make sure the generated real  }
       { I suppose the parser/pass_1 must make sure the generated real  }
       { constants are actually supported by the target processor? (JM) }
       { constants are actually supported by the target processor? (JM) }
-
       const
       const
         floattype2ait:array[tfloattype] of taitype=
         floattype2ait:array[tfloattype] of taitype=
           (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit);
           (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit);
-
       var
       var
          hp1 : tai;
          hp1 : tai;
          lastlabel : tasmlabel;
          lastlabel : tasmlabel;
@@ -152,7 +154,12 @@ implementation
     procedure tcgordconstnode.pass_2;
     procedure tcgordconstnode.pass_2;
       begin
       begin
          location_reset(location,LOC_CONSTANT,def_cgsize(resulttype.def));
          location_reset(location,LOC_CONSTANT,def_cgsize(resulttype.def));
+{$ifdef delphi}
+   { Delphi crashes on this statement }
+         location.valueqword:=value;
+{$else}         
          location.valueqword:=qword(value);
          location.valueqword:=qword(value);
+{$endif}
       end;
       end;
 
 
 
 
@@ -525,7 +532,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * inlining is now also allowed in interface
     * renamed write/load to ppuwrite/ppuload
     * renamed write/load to ppuwrite/ppuload
     * tnode storing in ppu
     * tnode storing in ppu
@@ -614,3 +625,10 @@ end.
       when used with int64's under Delphi)
       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));
        cg.a_param_const(exprasmlist,OS_INT,aktfilepos.line,paramanager.getintparaloc(3));
        { filename string }
        { filename string }
        hp2:=cstringconstnode.createstr(current_module.sourcefiles.get_file_name(aktfilepos.fileindex),st_shortstring);
        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
        if codegenerror then
           exit;
           exit;
        cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,paramanager.getintparaloc(2));
        cg.a_paramaddr_ref(exprasmlist,hp2.location.reference,paramanager.getintparaloc(2));
@@ -610,7 +610,11 @@ end.
 
 
 {
 {
   $Log$
   $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
     * fixes to common code to get the alpha compiler compiled applied
 
 
   Revision 1.14  2002/09/17 18:54:02  jonas
   Revision 1.14  2002/09/17 18:54:02  jonas

+ 11 - 3
compiler/ncgmem.pas

@@ -85,9 +85,10 @@ implementation
     uses
     uses
 {$ifdef delphi}
 {$ifdef delphi}
       sysutils,
       sysutils,
+{$else}
+      strings,
 {$endif}
 {$endif}
 {$ifdef GDB}
 {$ifdef GDB}
-      strings,
       gdb,
       gdb,
 {$endif GDB}
 {$endif GDB}
       globtype,systems,
       globtype,systems,
@@ -608,8 +609,9 @@ implementation
                 else
                 else
                   internalerror(2002032219);
                   internalerror(2002032219);
               end;
               end;
-
+{$ifdef fpc}
 {$warning FIXME}
 {$warning FIXME}
+{$endif}
               { check for a zero length string,
               { check for a zero length string,
                 we can use the ansistring routine here }
                 we can use the ansistring routine here }
               if (cs_check_range in aktlocalswitches) then
               if (cs_check_range in aktlocalswitches) then
@@ -653,7 +655,9 @@ implementation
                      else
                      else
                        begin
                        begin
                           { range checking for open and dynamic arrays !!!! }
                           { range checking for open and dynamic arrays !!!! }
+{$ifdef fpc}
 {$warning FIXME}
 {$warning FIXME}
+{$endif}
                           {!!!!!!!!!!!!!!!!!}
                           {!!!!!!!!!!!!!!!!!}
                        end;
                        end;
                   end;
                   end;
@@ -864,7 +868,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * a_load_reg_reg() now has two size parameters: source and dest. This
       allows some optimizations on architectures that don't encode the
       allows some optimizations on architectures that don't encode the
       register size in the register name.
       register size in the register name.

+ 37 - 9
compiler/ncgset.pas

@@ -59,14 +59,6 @@ interface
           procedure pass_2;override;
           procedure pass_2;override;
 
 
         protected
         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;
           with_sign : boolean;
           opsize : tcgsize;
           opsize : tcgsize;
           jmp_gt,jmp_lt,jmp_le : topcmp;
           jmp_gt,jmp_lt,jmp_le : topcmp;
@@ -79,6 +71,14 @@ interface
           { has the implementation jumptable support }
           { has the implementation jumptable support }
           min_label : tconstexprint;
           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;
        end;
 
 
 
 
@@ -708,8 +708,13 @@ implementation
                 if opsize in [OS_S64,OS_64] then
                 if opsize in [OS_S64,OS_64] then
                   begin
                   begin
                      objectlibrary.getlabel(l1);
                      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_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);
                      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);
                      cg.a_label(exprasmlist,l1);
                   end
                   end
                 else
                 else
@@ -728,12 +733,21 @@ implementation
                      if opsize in [OS_64,OS_S64] then
                      if opsize in [OS_64,OS_S64] then
                        begin
                        begin
                           objectlibrary.getlabel(l1);
                           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))),
                           cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_lt, aword(hi(int64(t^._low))),
                                hregister2, elselabel);
                                hregister2, elselabel);
                           cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_gt, aword(hi(int64(t^._low))),
                           cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_gt, aword(hi(int64(t^._low))),
                                hregister2, l1);
                                hregister2, l1);
                           { the comparisation of the low dword must be always unsigned! }
                           { 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);
                           cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_B, aword(lo(int64(t^._low))), hregister, elselabel);
+{$endif}                          
                           cg.a_label(exprasmlist,l1);
                           cg.a_label(exprasmlist,l1);
                        end
                        end
                      else
                      else
@@ -746,11 +760,19 @@ implementation
                 if opsize in [OS_S64,OS_64] then
                 if opsize in [OS_S64,OS_64] then
                   begin
                   begin
                      objectlibrary.getlabel(l1);
                      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,
                      cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_lt, aword(hi(int64(t^._high))), hregister2,
                            t^.statement);
                            t^.statement);
                      cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_gt, aword(hi(int64(t^._high))), hregister2,
                      cg.a_cmp_const_reg_label(exprasmlist, OS_INT, jmp_gt, aword(hi(int64(t^._high))), hregister2,
                            l1);
                            l1);
                     cg.a_cmp_const_reg_label(exprasmlist, OS_INT, OC_BE, aword(lo(int64(t^._high))), hregister, t^.statement);
                     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);
                     cg.a_label(exprasmlist,l1);
                   end
                   end
                 else
                 else
@@ -993,7 +1015,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * range check error fixes
 
 
   Revision 1.20  2002/09/17 18:54:03  jonas
   Revision 1.20  2002/09/17 18:54:03  jonas
@@ -1077,3 +1103,5 @@ end.
   + generic sets
   + generic sets
 
 
 }
 }
+
+

+ 32 - 3
compiler/ncnv.pas

@@ -29,7 +29,11 @@ interface
     uses
     uses
        node,
        node,
        symtype,symppu,defbase,
        symtype,symppu,defbase,
-       nld;
+       nld
+{$ifdef Delphi}
+       ,dmisc
+{$endif}
+       ;
 
 
     type
     type
        ttypeconvnode = class(tunarynode)
        ttypeconvnode = class(tunarynode)
@@ -874,7 +878,7 @@ implementation
 
 
 
 
     function ttypeconvnode.resulttype_call_helper(c : tconverttype) : tnode;
     function ttypeconvnode.resulttype_call_helper(c : tconverttype) : tnode;
-
+{$ifdef fpc}
       const
       const
          resulttypeconvert : array[tconverttype] of pointer = (
          resulttypeconvert : array[tconverttype] of pointer = (
           {equal} nil,
           {equal} nil,
@@ -923,6 +927,27 @@ implementation
          if assigned(r.proc) then
          if assigned(r.proc) then
           result:=tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
           result:=tprocedureofobject(r){$ifdef FPC}();{$endif FPC}
       end;
       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;
     function ttypeconvnode.det_resulttype:tnode;
@@ -2059,7 +2084,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     - 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
       know the runtime type of <class>! It could be a child class of the given type
       which implements additional interfaces
       which implements additional interfaces

+ 7 - 3
compiler/ncon.pas

@@ -373,7 +373,7 @@ implementation
       begin
       begin
         inherited derefimpl;
         inherited derefimpl;
         restype.resolve;
         restype.resolve;
-        objectlibrary.derefasmsymbol(lab_real);
+        objectlibrary.derefasmsymbol(tasmsymbol(lab_real));
       end;
       end;
 
 
 
 
@@ -656,7 +656,7 @@ implementation
     procedure tstringconstnode.derefimpl;
     procedure tstringconstnode.derefimpl;
       begin
       begin
         inherited derefimpl;
         inherited derefimpl;
-        objectlibrary.derefasmsymbol(lab_str);
+        objectlibrary.derefasmsymbol(tasmsymbol(lab_str));
       end;
       end;
 
 
 
 
@@ -924,7 +924,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * old logs removed and tabs fixed
 
 
   Revision 1.41  2002/09/07 12:16:04  carl
   Revision 1.41  2002/09/07 12:16:04  carl

+ 11 - 2
compiler/nflw.pas

@@ -355,8 +355,13 @@ implementation
                 left:=Tunarynode(left).left;
                 left:=Tunarynode(left).left;
                 t.left:=nil;
                 t.left:=nil;
                 t.destroy;
                 t.destroy;
+{$ifdef Delphi}
+                { How can this be handled in Delphi ? }
+                RunError(255);
+{$else}
                 {Symdif operator, in case you are wondering:}
                 {Symdif operator, in case you are wondering:}
                 flags:=flags >< [nf_checknegate];
                 flags:=flags >< [nf_checknegate];
+{$endif}
             end;
             end;
          { loop instruction }
          { loop instruction }
          if assigned(right) then
          if assigned(right) then
@@ -1025,7 +1030,7 @@ implementation
       begin
       begin
         inherited derefimpl;
         inherited derefimpl;
         resolvesym(pointer(labsym));
         resolvesym(pointer(labsym));
-        objectlibrary.derefasmsymbol(labelnr);
+        objectlibrary.derefasmsymbol(tasmsymbol(labelnr));
       end;
       end;
 
 
 
 
@@ -1405,7 +1410,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * old logs removed and tabs fixed
 
 
   Revision 1.51  2002/09/07 12:16:04  carl
   Revision 1.51  2002/09/07 12:16:04  carl

+ 8 - 2
compiler/nld.pas

@@ -186,7 +186,9 @@ implementation
       begin
       begin
         inherited ppuload(t,ppufile);
         inherited ppuload(t,ppufile);
         symtableentry:=tsym(ppufile.getderef);
         symtableentry:=tsym(ppufile.getderef);
+{$ifdef fpc}
 {$warning FIXME: No withsymtable support}
 {$warning FIXME: No withsymtable support}
+{$endif}
         symtable:=nil;
         symtable:=nil;
         procdef:=tprocdef(ppufile.getderef);
         procdef:=tprocdef(ppufile.getderef);
       end;
       end;
@@ -832,7 +834,7 @@ implementation
         if not allow_array_constructor then
         if not allow_array_constructor then
          begin
          begin
            hp:=tarrayconstructornode(getcopy);
            hp:=tarrayconstructornode(getcopy);
-           arrayconstructor_to_set(hp);
+           arrayconstructor_to_set(tnode(hp));
            result:=hp;
            result:=hp;
            exit;
            exit;
          end;
          end;
@@ -1152,7 +1154,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     + compile-time range checking for strings
 
 
   Revision 1.60  2002/09/27 21:13:28  carl
   Revision 1.60  2002/09/27 21:13:28  carl

+ 14 - 6
compiler/nobj.pas

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

+ 7 - 3
compiler/nset.pas

@@ -502,8 +502,8 @@ implementation
 
 
     procedure ppuderefcaserecord(p : pcaserecord);
     procedure ppuderefcaserecord(p : pcaserecord);
       begin
       begin
-         objectlibrary.derefasmsymbol(p^._at);
-         objectlibrary.derefasmsymbol(p^.statement);
+         objectlibrary.derefasmsymbol(tasmsymbol(p^._at));
+         objectlibrary.derefasmsymbol(tasmsymbol(p^.statement));
          if assigned(p^.greater) then
          if assigned(p^.greater) then
            ppuderefcaserecord(p^.greater);
            ppuderefcaserecord(p^.greater);
          if assigned(p^.less) then
          if assigned(p^.less) then
@@ -691,7 +691,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * second part bug report 1996 fix, testrange in cordconstnode
       only called if option is set (also make parsing a tiny faster)
       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;
       end;
       end;
 
 
+initialization
+  ;      
 finalization
 finalization
   paramanager.free;
   paramanager.free;
 end.
 end.
 
 
 {
 {
    $Log$
    $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
      * fixes to common code to get the alpha compiler compiled applied
 
 
    Revision 1.19  2002/09/30 07:00:47  florian
    Revision 1.19  2002/09/30 07:00:47  florian

+ 11 - 2
compiler/pdecobj.pas

@@ -41,7 +41,12 @@ implementation
       cgbase,
       cgbase,
       node,nld,nmem,ncon,ncnv,ncal,pass_1,
       node,nld,nmem,ncon,ncnv,ncal,pass_1,
       scanner,
       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;
     function object_dec(const n : stringid;fd : tobjectdef) : tdef;
     { this function parses an object or class declaration }
     { this function parses an object or class declaration }
@@ -1156,7 +1161,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
     * don't allow interface without m_class mode
 
 
   Revision 1.53  2002/09/27 21:13:28  carl
   Revision 1.53  2002/09/27 21:13:28  carl

+ 13 - 2
compiler/pdecvar.pas

@@ -47,7 +47,12 @@ implementation
        scanner,
        scanner,
        pbase,pexpr,ptype,ptconst,pdecsub,
        pbase,pexpr,ptype,ptconst,pdecsub,
        { link }
        { link }
-       import;
+       import
+{$ifdef Delphi}
+       ,dmisc
+       ,sysutils
+{$endif}
+       ;
 
 
     const
     const
        variantrecordlevel : longint = 0;
        variantrecordlevel : longint = 0;
@@ -306,7 +311,9 @@ implementation
                   symdone:=true;
                   symdone:=true;
                end;
                end;
              { hint directive }
              { hint directive }
+{$ifdef fpc}
              {$warning hintdirective not stored in syms}
              {$warning hintdirective not stored in syms}
+{$endif}             
              dummysymoptions:=[];
              dummysymoptions:=[];
              try_consume_hintdirective(dummysymoptions);
              try_consume_hintdirective(dummysymoptions);
              { for a record there doesn't need to be a ; before the END or ) }
              { for a record there doesn't need to be a ; before the END or ) }
@@ -567,7 +574,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
     * bugfix of crash
 
 
   Revision 1.34  2002/10/03 21:22:01  carl
   Revision 1.34  2002/10/03 21:22:01  carl

+ 9 - 1
compiler/pexports.pas

@@ -48,6 +48,10 @@ implementation
        pbase,pexpr,
        pbase,pexpr,
        { link }
        { link }
        gendef,export
        gendef,export
+{$ifdef Delphi}
+       ,dmisc
+       ,sysutils
+{$endif}
        ;
        ;
 
 
 
 
@@ -165,7 +169,11 @@ end.
 
 
 {
 {
   $Log$
   $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
     * Make Tprocdef.defs protected
 
 
   Revision 1.22  2002/07/26 21:15:41  florian
   Revision 1.22  2002/07/26 21:15:41  florian

+ 27 - 7
compiler/ppc.dof

@@ -1,12 +1,14 @@
+[FileVersion]
+Version=6.0
 [Compiler]
 [Compiler]
-A=1
+A=8
 B=0
 B=0
 C=0
 C=0
 D=1
 D=1
 E=0
 E=0
 F=0
 F=0
 G=1
 G=1
-H=1
+H=0
 I=1
 I=1
 J=1
 J=1
 K=0
 K=0
@@ -15,12 +17,12 @@ M=0
 N=1
 N=1
 O=0
 O=0
 P=1
 P=1
-Q=0
-R=0
+Q=1
+R=1
 S=0
 S=0
 T=0
 T=0
 U=0
 U=0
-V=1
+V=0
 W=1
 W=1
 X=1
 X=1
 Y=1
 Y=1
@@ -33,6 +35,7 @@ MapFile=0
 OutputObjs=0
 OutputObjs=0
 ConsoleApp=0
 ConsoleApp=0
 DebugInfo=0
 DebugInfo=0
+RemoteSymbols=0
 MinStackSize=16384
 MinStackSize=16384
 MaxStackSize=1048576
 MaxStackSize=1048576
 ImageBase=4194304
 ImageBase=4194304
@@ -40,14 +43,19 @@ ExeDescription=
 [Directories]
 [Directories]
 OutputDir=
 OutputDir=
 UnitOutputDir=
 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
 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=
 DebugSourceDirs=
 UsePackages=0
 UsePackages=0
 [Parameters]
 [Parameters]
 RunParams=
 RunParams=
 HostApplication=
 HostApplication=
+Launcher=
+UseLauncher=0
+DebugCWD=
 [Version Info]
 [Version Info]
 IncludeVerInfo=0
 IncludeVerInfo=0
 AutoIncBuild=0
 AutoIncBuild=0
@@ -73,3 +81,15 @@ OriginalFilename=
 ProductName=
 ProductName=
 ProductVersion=1.0.0.0
 ProductVersion=1.0.0.0
 Comments=
 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
   USE_RHIDE           generates errors and warning in an format recognized
                       by rhide
                       by rhide
-  TP                  to compile the compiler with Turbo or Borland Pascal
   GDB*                support of the GNU Debugger
   GDB*                support of the GNU Debugger
   I386                generate a compiler for the Intel i386+
   I386                generate a compiler for the Intel i386+
   M68K                generate a compiler for the M68000
   M68K                generate a compiler for the M68000
@@ -158,7 +157,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $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
     * old logs removed and tabs fixed
 
 
   Revision 1.4  2002/08/12 15:08:40  carl
   Revision 1.4  2002/08/12 15:08:40  carl

+ 11 - 2
compiler/psystem.pas

@@ -48,7 +48,12 @@ implementation
 {$ifdef GDB}
 {$ifdef GDB}
       gdb,
       gdb,
 {$endif 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);
     procedure insertinternsyms(p : tsymtable);
@@ -470,7 +475,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
     * Copy() is now internal syssym that calls compilerprocs
 
 
   Revision 1.40  2002/09/27 21:13:29  carl
   Revision 1.40  2002/09/27 21:13:29  carl

+ 12 - 3
compiler/rgobj.pas

@@ -36,7 +36,11 @@ unit rgobj;
       cpubase,
       cpubase,
       cpuinfo,
       cpuinfo,
       aasmbase,aasmtai,aasmcpu,
       aasmbase,aasmtai,aasmcpu,
-      cclasses,globtype,cginfo,cgbase,node;
+      cclasses,globtype,cginfo,cgbase,node
+{$ifdef delphi}
+      ,dmisc
+{$endif}
+      ;
 
 
     type
     type
        regvar_longintarray = array[firstreg..lastreg] of longint;
        regvar_longintarray = array[firstreg..lastreg] of longint;
@@ -986,14 +990,19 @@ unit rgobj;
       end;
       end;
 
 
 
 
-
+initialization
+   ;
 finalization
 finalization
   rg.free;
   rg.free;
 end.
 end.
 
 
 {
 {
   $Log$
   $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
     * tempgen cleanup
     * tt_noreuse temp type added that will be used in genentrycode
     * tt_noreuse temp type added that will be used in genentrycode
 
 

+ 8 - 1
compiler/symdef.pas

@@ -38,6 +38,9 @@ interface
        node,
        node,
        { aasm }
        { aasm }
        aasmbase,aasmtai,cpubase,cpuinfo
        aasmbase,aasmtai,cpubase,cpuinfo
+{$ifdef Delphi}
+       ,dmisc
+{$endif}
        ;
        ;
 
 
 
 
@@ -5556,7 +5559,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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)
     * low-highval always checked if limit ober 2GB is reached (to avoid overflow)
 
 
   Revision 1.95  2002/09/16 09:31:10  florian
   Revision 1.95  2002/09/16 09:31:10  florian

+ 13 - 1
compiler/symppu.pas

@@ -90,7 +90,11 @@ implementation
   {$define Range_check_on}
   {$define Range_check_on}
 {$endif opt R+}
 {$endif opt R+}
 {$R- needed here }
 {$R- needed here }
+{$ifdef Delphi}
+            result:=int64(l1)+(int64(l2) shl 32);
+{$else}
             result:=qword(l1)+(int64(l2) shl 32);
             result:=qword(l1)+(int64(l2) shl 32);
+{$endif}
 {$ifdef Range_check_on}
 {$ifdef Range_check_on}
   {$R+}
   {$R+}
   {$undef Range_check_on}
   {$undef Range_check_on}
@@ -113,7 +117,11 @@ implementation
   {$define Range_check_on}
   {$define Range_check_on}
 {$endif opt R+}
 {$endif opt R+}
 {$R- needed here }
 {$R- needed here }
+{$ifdef Delphi}
+            result:=int64(l1)+(int64(l2) shl 32);
+{$else}
             result:=qword(l1)+(int64(l2) shl 32);
             result:=qword(l1)+(int64(l2) shl 32);
+{$endif}
 {$ifdef Range_check_on}
 {$ifdef Range_check_on}
   {$R+}
   {$R+}
   {$undef Range_check_on}
   {$undef Range_check_on}
@@ -494,7 +502,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
    * fixed compilation cycle with -Cr option by adding explicit
      longint typecast in PutPtrUInt and putexprint methods.
      longint typecast in PutPtrUInt and putexprint methods.
    + added checks for sizeof and internalerros if size is not handled.
    + 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;
         search_procdef_bypara:=nil;
         pd:=defs;
         pd:=defs;
         while assigned(pd) do
         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;
     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
         {This function will return the pprocdef of pprocsym that
          is the best match for procvardef. When there are multiple
          is the best match for procvardef. When there are multiple
          matches it returns nil.}
          matches it returns nil.}
         {Try to find an exact match first.}
         {Try to find an exact match first.}
         search_procdef_byprocvardef:=nil;
         search_procdef_byprocvardef:=nil;
+        _result := nil;
         pd:=defs;
         pd:=defs;
         while assigned(pd) do
         while assigned(pd) do
           begin
           begin
@@ -1058,25 +1058,27 @@ implementation
             pd:=pd^.next;
             pd:=pd^.next;
           end;
           end;
         {Try a convertable match, if no exact match was found.}
         {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;
     function Tprocsym.search_procdef_by1paradef(firstpara:Tdef):Tprocdef;
       var
       var
@@ -2502,7 +2504,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
     * split boolean check in two lines for easier debugging
 
 
   Revision 1.67  2002/09/26 12:04:53  florian
   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
         if not(cs_compilesystem in aktmoduleswitches) then
           srsym := ttypesym(searchsymonlyin(systemunit,s))
           srsym := ttypesym(searchsymonlyin(systemunit,s))
         else
         else
-          searchsym(s,srsym,symowner);
+          searchsym(s,tsym(srsym),symowner);
         searchsystype :=
         searchsystype :=
           assigned(srsym) and
           assigned(srsym) and
           (srsym.typ = typesym);
           (srsym.typ = typesym);
@@ -2059,7 +2059,7 @@ implementation
             symowner := systemunit;
             symowner := systemunit;
           end
           end
         else
         else
-          searchsym(s,srsym,symowner);
+          searchsym(s,tsym(srsym),symowner);
         searchsysvar :=
         searchsysvar :=
           assigned(srsym) and
           assigned(srsym) and
           (srsym.typ = varsym);
           (srsym.typ = varsym);
@@ -2311,7 +2311,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $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
     * real fix internalerror for dup ids in union sym
 
 
   Revision 1.71  2002/09/09 17:34:16  peter
   Revision 1.71  2002/09/09 17:34:16  peter

+ 7 - 3
compiler/systems.pas

@@ -631,14 +631,14 @@ begin
   {$ifdef cpu86}
   {$ifdef cpu86}
     default_target(source_info.system);
     default_target(source_info.system);
   {$else cpu86}
   {$else cpu86}
-    default_target(target_i386_linux);
+    default_target(system_i386_linux);
   {$endif cpu86}
   {$endif cpu86}
 {$endif i386}
 {$endif i386}
 {$ifdef x86_64}
 {$ifdef x86_64}
   {$ifdef cpu86_64}
   {$ifdef cpu86_64}
     default_target(source_info.system);
     default_target(source_info.system);
   {$else cpu86_64}
   {$else cpu86_64}
-    default_target(target_x86_64_linux);
+    default_target(system_x86_64_linux);
   {$endif cpu86_64}
   {$endif cpu86_64}
 {$endif x86_64}
 {$endif x86_64}
 {$ifdef m68k}
 {$ifdef m68k}
@@ -675,7 +675,11 @@ finalization
 end.
 end.
 {
 {
   $Log$
   $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
    * correct tsystem enumeration
 
 
   Revision 1.55  2002/09/07 18:05:51  florian
   Revision 1.55  2002/09/07 18:05:51  florian

+ 9 - 1
compiler/systems/t_beos.pas

@@ -60,7 +60,11 @@ interface
 implementation
 implementation
 
 
   uses
   uses
+{$ifdef delphi}
+    dmisc,
+{$else}
     dos,
     dos,
+{$endif}
     cutils,cclasses,
     cutils,cclasses,
     verbose,systems,globtype,globals,
     verbose,systems,globtype,globals,
     symconst,script,
     symconst,script,
@@ -466,7 +470,11 @@ initialization
 end.
 end.
 {
 {
   $Log$
   $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
     * tdicationary.replace added to replace and item in a dictionary. This
       is only allowed for the same name
       is only allowed for the same name
     * varsyms are inserted in symtable before the types are parsed. This
     * varsyms are inserted in symtable before the types are parsed. This

+ 10 - 3
compiler/systems/t_wdosx.pas

@@ -68,10 +68,13 @@ const
                              TLINKERWDOSX
                              TLINKERWDOSX
 *****************************************************************************}
 *****************************************************************************}
 function TLinkerWdosx.MakeExecutable:boolean;
 function TLinkerWdosx.MakeExecutable:boolean;
+var
+ b: boolean;
 begin
 begin
- Result:=inherited;
- if Result then
+ b := Inherited MakeExecutable;
+ if b then
   DoExec(FindUtil('stubit'),current_module.exefilename^,false,false);
   DoExec(FindUtil('stubit'),current_module.exefilename^,false,false);
+ Result := b; 
 end;
 end;
 
 
 {****************************************************************************
 {****************************************************************************
@@ -99,7 +102,11 @@ end.
 
 
 {
 {
   $Log$
   $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
     * moved files to systems directory
 
 
   Revision 1.10  2002/08/12 15:08:44  carl
   Revision 1.10  2002/08/12 15:08:44  carl

+ 6 - 1
compiler/systems/t_win32.pas

@@ -28,6 +28,7 @@ interface
     uses
     uses
 {$ifdef Delphi}
 {$ifdef Delphi}
        dmisc,
        dmisc,
+       sysutils,
 {$else Delphi}
 {$else Delphi}
        dos,
        dos,
 {$endif Delphi}
 {$endif Delphi}
@@ -1562,7 +1563,11 @@ initialization
 end.
 end.
 {
 {
   $Log$
   $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
     * tdicationary.replace added to replace and item in a dictionary. This
       is only allowed for the same name
       is only allowed for the same name
     * varsyms are inserted in symtable before the types are parsed. This
     * 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}
 {$i fpcdefs.inc}
 
 
 { Don't include messages in the executable }
 { Don't include messages in the executable }
-{.$define EXTERN_MSG}
+{$ifdef Delphi}
+{$define EXTERN_MSG}
+{$endif}
 
 
 interface
 interface
 
 
@@ -680,7 +682,11 @@ var
 end.
 end.
 {
 {
   $Log$
   $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
     * renamed local current_module to compiling_module because it
       confused a lot in gdb
       confused a lot in gdb
 
 

+ 15 - 2
compiler/widestr.pas

@@ -27,13 +27,18 @@ unit widestr;
   interface
   interface
 
 
     uses
     uses
-       charset;
+       charset
+{$ifdef delphi}
+       ,sysutils
+{$endif}
+       ;
 
 
 
 
     type
     type
        tcompilerwidechar = word;
        tcompilerwidechar = word;
        tcompilerwidecharptr = ^tcompilerwidechar;
        tcompilerwidecharptr = ^tcompilerwidechar;
 {$ifdef delphi}
 {$ifdef delphi}
+       strlenint = integer;
        { delphi doesn't allow pointer accessing as array }
        { delphi doesn't allow pointer accessing as array }
        tcompilerwidechararray = array[0..0] of tcompilerwidechar;
        tcompilerwidechararray = array[0..0] of tcompilerwidechar;
        pcompilerwidechar = ^tcompilerwidechararray;
        pcompilerwidechar = ^tcompilerwidechararray;
@@ -147,7 +152,11 @@ unit widestr;
          temp:=s2^.len;
          temp:=s2^.len;
          if maxi>temp then
          if maxi>temp then
            maxi:=Temp;
            maxi:=Temp;
+{$ifdef Delphi}
+         temp:=strlenint(comparemem(@s1^.data,@s2^.data,maxi));
+{$else}
          temp:=compareword(s1^.data^,s2^.data^,maxi);
          temp:=compareword(s1^.data^,s2^.data^,maxi);
+{$endif}
          if temp=0 then
          if temp=0 then
            temp:=s1^.len-s2^.len;
            temp:=s1^.len-s2^.len;
          comparewidestrings:=temp;
          comparewidestrings:=temp;
@@ -231,7 +240,11 @@ unit widestr;
 end.
 end.
 {
 {
   $Log$
   $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
     + source code page support
 
 
   Revision 1.10  2002/05/18 13:34:21  peter
   Revision 1.10  2002/05/18 13:34:21  peter

+ 6 - 2
compiler/x86/cgx86.pas

@@ -295,7 +295,7 @@ unit cgx86;
                               Assembler code
                               Assembler code
 ****************************************************************************}
 ****************************************************************************}
 
 
-    function tcgx86.reg_cgsize(const reg: tregister): tcgsize;
+    class function tcgx86.reg_cgsize(const reg: tregister): tcgsize;
       const
       const
         regsize_2_cgsize: array[S_B..S_L] of tcgsize = (OS_8,OS_16,OS_32);
         regsize_2_cgsize: array[S_B..S_L] of tcgsize = (OS_8,OS_16,OS_32);
       begin
       begin
@@ -1681,7 +1681,11 @@ unit cgx86;
 end.
 end.
 {
 {
   $Log$
   $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
     * a_load_reg_reg() now has two size parameters: source and dest. This
       allows some optimizations on architectures that don't encode the
       allows some optimizations on architectures that don't encode the
       register size in the register name.
       register size in the register name.