* cg64 patch

  * basics for currency
  * asnode updates for class and interface (not finished)

compiler/cg64f32.pas

@@ -23,8 +23,7 @@
  ****************************************************************************
 }
 {# This unit implements the code generation for 64 bit int arithmethics on
-   32 bit processors. All 32-bit processors should use this class as
-   the base code generator class instead of tcg.
+   32 bit processors.
 }
 unit cg64f32;
 
@@ -40,51 +39,42 @@ unit cg64f32;
 
     type
       {# Defines all the methods required on 32-bit processors
-         to handle 64-bit integers. All 32-bit processors should
-         create derive a class of this type instead of @var(tcg).
+         to handle 64-bit integers.
       }
-      tcg64f32 = class(tcg)
-        procedure a_load64_const_ref(list : taasmoutput;valuelo, valuehi : AWord;const ref : treference);
-        procedure a_load64_reg_ref(list : taasmoutput;reglo, reghi : tregister;const ref : treference);
-        procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reglo,reghi : tregister);
-        procedure a_load64_reg_reg(list : taasmoutput;reglosrc,reghisrc,reglodst,reghidst : tregister);
-        procedure a_load64_const_reg(list : taasmoutput;valuelosrc,valuehisrc:AWord;reglodst,reghidst : tregister);
-        procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reglo,reghi : tregister);
-        procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);
-        procedure a_load64_const_loc(list : taasmoutput;valuelo, valuehi : AWord;const l : tlocation);
-        procedure a_load64_reg_loc(list : taasmoutput;reglo, reghi : tregister;const l : tlocation);
-        procedure a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
-        procedure a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);
-        procedure a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
-        procedure a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);
-        procedure a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
-        procedure a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);
-
-        procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reglo,reghi : tregister);virtual;abstract;
-        procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;reglosrc,reghisrc,reglodst,reghidst : tregister);virtual;abstract;
-        procedure a_op64_reg_ref(list : taasmoutput;op:TOpCG;reglosrc,reghisrc : tregister;const ref : treference);virtual;abstract;
-        procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;valuelosrc,valuehisrc:AWord;reglodst,reghidst : tregister);virtual;abstract;
-        procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;valuelosrc,valuehisrc:AWord;const ref : treference);virtual;abstract;
-        procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;valuelosrc,valuehisrc:aword;const l: tlocation);
-        procedure a_op64_reg_loc(list : taasmoutput;op:TOpCG;reglo,reghi : tregister;const l : tlocation);
-        procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reglo,reghi : tregister);
-
-        procedure a_param64_reg(list : taasmoutput;reglo,reghi : tregister;nr : longint);
-        procedure a_param64_const(list : taasmoutput;valuelo,valuehi : aword;nr : longint);
-        procedure a_param64_ref(list : taasmoutput;const r : treference;nr : longint);
-        procedure a_param64_loc(list : taasmoutput;const l : tlocation;nr : longint);
-
-        { override to catch 64bit rangechecks }
-        procedure g_rangecheck(list: taasmoutput; const p: tnode;
+      tcg64f32 = class(tcg64)
+        procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);override;
+        procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);override;
+        procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);override;
+        procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);override;
+        procedure a_load64_const_reg(list : taasmoutput;value: qword;reg : tregister64);override;
+        procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);override;
+        procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);override;
+        procedure a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);override;
+        procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);override;
+
+        procedure a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);override;
+        procedure a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);override;
+        procedure a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);override;
+        procedure a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);override;
+        procedure a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);override;
+        procedure a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);override;
+
+        procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);override;
+        procedure a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);override;
+        procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg : tregister64);override;
+
+        procedure a_param64_reg(list : taasmoutput;reg : tregister64;nr : longint);override;
+        procedure a_param64_const(list : taasmoutput;value : qword;nr : longint);override;
+        procedure a_param64_ref(list : taasmoutput;const r : treference;nr : longint);override;
+        procedure a_param64_loc(list : taasmoutput;const l : tlocation;nr : longint);override;
+
+        procedure g_rangecheck64(list: taasmoutput; const p: tnode;
           const todef: tdef); override;
-
-       private
-         { produces range check code for 32bit processors when one of the }
-         { operands is 64 bit                                             }
-         procedure g_rangecheck64(list : taasmoutput; p : tnode;todef : tdef);
-
       end;
 
+    {# Creates a tregister64 record from 2 32 Bit registers. }
+    function joinreg64(reglo,reghi : tregister) : tregister64;
+
   implementation
 
     uses
@@ -93,42 +83,45 @@ unit cg64f32;
        verbose,
        symbase,symconst,symdef,types;
 
-    procedure tcg64f32.a_load64_reg_ref(list : taasmoutput;reglo, reghi : tregister;const ref : treference);
+
+    function joinreg64(reglo,reghi : tregister) : tregister64;
+      begin
+         result.reglo:=reglo;
+         result.reghi:=reghi;
+      end;
+
+    procedure tcg64f32.a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);
       var
         tmpreg: tregister;
         tmpref: treference;
       begin
-        if target_info.endian = endian_big then
+        if target_info.endian=endian_big then
           begin
-            tmpreg := reglo;
-            reglo := reghi;
-            reghi := tmpreg;
+            tmpreg:=reg.reglo;
+            reg.reglo:=reg.reghi;
+            reg.reghi:=tmpreg;
           end;
-        a_load_reg_ref(list,OS_32,reglo,ref);
+        cg.a_load_reg_ref(list,OS_32,reg.reglo,ref);
         tmpref := ref;
         inc(tmpref.offset,4);
-        a_load_reg_ref(list,OS_32,reghi,tmpref);
+        cg.a_load_reg_ref(list,OS_32,reg.reghi,tmpref);
       end;
 
-    procedure tcg64f32.a_load64_const_ref(list : taasmoutput;valuelo, valuehi : AWord;const ref : treference);
+    procedure tcg64f32.a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);
       var
-        tmpvalue: AWord;
+        tmpvalue : DWord;
         tmpref: treference;
       begin
-        if target_info.endian = endian_big then
-          begin
-            tmpvalue := valuelo;
-            valuelo := valuehi;
-            valuehi := tmpvalue;
-          end;
-        a_load_const_ref(list,OS_32,valuelo,ref);
+        if target_info.endian<>source_info.endian then
+          swap_qword(value);
+        cg.a_load_const_ref(list,OS_32,lo(value),ref);
         tmpref := ref;
         inc(tmpref.offset,4);
-        a_load_const_ref(list,OS_32,valuehi,tmpref);
+        cg.a_load_const_ref(list,OS_32,hi(value),tmpref);
       end;
 
 
-    procedure tcg64f32.a_load64_ref_reg(list : taasmoutput;const ref : treference;reglo,reghi : tregister);
+    procedure tcg64f32.a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);
       var
         tmpreg: tregister;
         tmpref: treference;
@@ -136,59 +129,64 @@ unit cg64f32;
       begin
         if target_info.endian = endian_big then
           begin
-            tmpreg := reglo;
-            reglo := reghi;
-            reghi := tmpreg;
+            tmpreg := reg.reglo;
+            reg.reglo := reg.reghi;
+            reg.reghi := tmpreg;
           end;
         got_scratch:=false;
         tmpref := ref;
-        if (tmpref.base=reglo) then
+        if (tmpref.base=reg.reglo) then
          begin
-           tmpreg := get_scratch_reg_int(list);
+           tmpreg := cg.get_scratch_reg_int(list);
            got_scratch:=true;
-           a_load_reg_reg(list,OS_ADDR,tmpref.base,tmpreg);
+           cg.a_load_reg_reg(list,OS_ADDR,tmpref.base,tmpreg);
            tmpref.base:=tmpreg;
          end
         else
-         if (tmpref.index=reglo) then
+         { this works only for the i386, thus the i386 needs to override  }
+         { this method and this method must be replaced by a more generic }
+         { implementation FK                                              }
+         if (tmpref.index=reg.reglo) then
           begin
-            tmpreg := get_scratch_reg_int(list);
+            tmpreg:=cg.get_scratch_reg_int(list);
             got_scratch:=true;
-            a_load_reg_reg(list,OS_ADDR,tmpref.index,tmpreg);
+            cg.a_load_reg_reg(list,OS_ADDR,tmpref.index,tmpreg);
             tmpref.index:=tmpreg;
           end;
-        a_load_ref_reg(list,OS_32,tmpref,reglo);
+        cg.a_load_ref_reg(list,OS_32,tmpref,reg.reglo);
         inc(tmpref.offset,4);
-        a_load_ref_reg(list,OS_32,tmpref,reghi);
+        cg.a_load_ref_reg(list,OS_32,tmpref,reg.reghi);
         if got_scratch then
-         free_scratch_reg(list,tmpreg);
+          cg.free_scratch_reg(list,tmpreg);
       end;
 
 
-    procedure tcg64f32.a_load64_reg_reg(list : taasmoutput;reglosrc,reghisrc,reglodst,reghidst : tregister);
+    procedure tcg64f32.a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);
 
       begin
-        a_load_reg_reg(list,OS_32,reglosrc,reglodst);
-        a_load_reg_reg(list,OS_32,reghisrc,reghidst);
+        cg.a_load_reg_reg(list,OS_32,regsrc.reglo,regdst.reglo);
+        cg.a_load_reg_reg(list,OS_32,regsrc.reghi,regdst.reghi);
       end;
 
-    procedure tcg64f32.a_load64_const_reg(list : taasmoutput;valuelosrc,valuehisrc:AWord;reglodst,reghidst : tregister);
+    procedure tcg64f32.a_load64_const_reg(list : taasmoutput;value : qword;reg : tregister64);
 
       begin
-        a_load_const_reg(list,OS_32,valuelosrc,reglodst);
-        a_load_const_reg(list,OS_32,valuehisrc,reghidst);
+        if target_info.endian<>source_info.endian then
+          swap_qword(value);
+        cg.a_load_const_reg(list,OS_32,lo(value),reg.reglo);
+        cg.a_load_const_reg(list,OS_32,hi(value),reg.reghi);
       end;
 
-    procedure tcg64f32.a_load64_loc_reg(list : taasmoutput;const l : tlocation;reglo,reghi : tregister);
+    procedure tcg64f32.a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);
 
       begin
         case l.loc of
           LOC_REFERENCE, LOC_CREFERENCE:
-            a_load64_ref_reg(list,l.reference,reglo,reghi);
+            a_load64_ref_reg(list,l.reference,reg);
           LOC_REGISTER,LOC_CREGISTER:
-            a_load64_reg_reg(list,l.registerlow,l.registerhigh,reglo,reghi);
+            a_load64_reg_reg(list,l.register64,reg);
           LOC_CONSTANT :
-            a_load64_const_reg(list,l.valuelow,l.valuehigh,reglo,reghi);
+            a_load64_const_reg(list,l.valueqword,reg);
           else
             internalerror(200112292);
         end;
@@ -199,37 +197,37 @@ unit cg64f32;
       begin
         case l.loc of
           LOC_REGISTER,LOC_CREGISTER:
-            a_load64_reg_ref(list,l.registerlow,l.registerhigh,ref);
+            a_load64_reg_ref(list,l.reg64,ref);
           LOC_CONSTANT :
-            a_load64_const_ref(list,l.valuelow,l.valuehigh,ref);
+            a_load64_const_ref(list,l.valueqword,ref);
           else
             internalerror(200203288);
         end;
       end;
 
 
-    procedure tcg64f32.a_load64_const_loc(list : taasmoutput;valuelo, valuehi : AWord;const l : tlocation);
+    procedure tcg64f32.a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);
 
       begin
         case l.loc of
           LOC_REFERENCE, LOC_CREFERENCE:
-            a_load64_const_ref(list,valuelo,valuehi,l.reference);
+            a_load64_const_ref(list,value,l.reference);
           LOC_REGISTER,LOC_CREGISTER:
-            a_load64_const_reg(list,valuelo,valuehi,l.registerlow,l.registerhigh);
+            a_load64_const_reg(list,value,l.reg64);
           else
             internalerror(200112293);
         end;
       end;
 
 
-    procedure tcg64f32.a_load64_reg_loc(list : taasmoutput;reglo,reghi : tregister;const l : tlocation);
+    procedure tcg64f32.a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);
 
       begin
         case l.loc of
           LOC_REFERENCE, LOC_CREFERENCE:
-            a_load64_reg_ref(list,reglo,reghi,l.reference);
+            a_load64_reg_ref(list,reg,l.reference);
           LOC_REGISTER,LOC_CREGISTER:
-            a_load64_reg_reg(list,reglo,reghi,l.registerlow,l.registerhigh);
+            a_load64_reg_reg(list,reg,l.register64);
           else
             internalerror(200112293);
         end;
@@ -242,12 +240,12 @@ unit cg64f32;
         tmpref: treference;
       begin
         if target_info.endian = endian_big then
-          a_load_reg_ref(list,OS_32,reg,ref)
+          cg.a_load_reg_ref(list,OS_32,reg,ref)
         else
           begin
             tmpref := ref;
             inc(tmpref.offset,4);
-            a_load_reg_ref(list,OS_32,reg,tmpref)
+            cg.a_load_reg_ref(list,OS_32,reg,tmpref)
           end;
       end;
 
@@ -256,12 +254,12 @@ unit cg64f32;
         tmpref: treference;
       begin
         if target_info.endian = endian_little then
-          a_load_reg_ref(list,OS_32,reg,ref)
+          cg.a_load_reg_ref(list,OS_32,reg,ref)
         else
           begin
             tmpref := ref;
             inc(tmpref.offset,4);
-            a_load_reg_ref(list,OS_32,reg,tmpref)
+            cg.a_load_reg_ref(list,OS_32,reg,tmpref)
           end;
       end;
 
@@ -270,12 +268,12 @@ unit cg64f32;
         tmpref: treference;
       begin
         if target_info.endian = endian_big then
-          a_load_ref_reg(list,OS_32,ref,reg)
+          cg.a_load_ref_reg(list,OS_32,ref,reg)
         else
           begin
             tmpref := ref;
             inc(tmpref.offset,4);
-            a_load_ref_reg(list,OS_32,tmpref,reg)
+            cg.a_load_ref_reg(list,OS_32,tmpref,reg)
           end;
       end;
 
@@ -284,12 +282,12 @@ unit cg64f32;
         tmpref: treference;
       begin
         if target_info.endian = endian_little then
-          a_load_ref_reg(list,OS_32,ref,reg)
+          cg.a_load_ref_reg(list,OS_32,ref,reg)
         else
           begin
             tmpref := ref;
             inc(tmpref.offset,4);
-            a_load_ref_reg(list,OS_32,tmpref,reg)
+            cg.a_load_ref_reg(list,OS_32,tmpref,reg)
           end;
       end;
 
@@ -300,9 +298,9 @@ unit cg64f32;
           LOC_CREFERENCE :
             a_load64low_ref_reg(list,l.reference,reg);
           LOC_REGISTER :
-            a_load_reg_reg(list,OS_32,l.registerlow,reg);
+            cg.a_load_reg_reg(list,OS_32,l.registerlow,reg);
           LOC_CONSTANT :
-            a_load_const_reg(list,OS_32,l.valuelow,reg);
+            cg.a_load_const_reg(list,OS_32,l.valuelow,reg);
           else
             internalerror(200203244);
         end;
@@ -315,35 +313,35 @@ unit cg64f32;
           LOC_CREFERENCE :
             a_load64high_ref_reg(list,l.reference,reg);
           LOC_REGISTER :
-            a_load_reg_reg(list,OS_32,l.registerhigh,reg);
+            cg.a_load_reg_reg(list,OS_32,l.registerhigh,reg);
           LOC_CONSTANT :
-            a_load_const_reg(list,OS_32,l.valuehigh,reg);
+            cg.a_load_const_reg(list,OS_32,l.valuehigh,reg);
           else
             internalerror(200203244);
         end;
       end;
 
 
-    procedure tcg64f32.a_op64_const_loc(list : taasmoutput;op:TOpCG;valuelosrc,valuehisrc:aword;const l: tlocation);
+    procedure tcg64f32.a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);
       begin
         case l.loc of
           LOC_REFERENCE, LOC_CREFERENCE:
-            a_op64_const_reg(list,op,valuelosrc,valuehisrc,l.registerlow,l.registerhigh);
+            a_op64_const_reg(list,op,value,l.register64);
           LOC_REGISTER,LOC_CREGISTER:
-            a_op64_const_ref(list,op,valuelosrc,valuehisrc,l.reference);
+            a_op64_const_ref(list,op,value,l.reference);
           else
             internalerror(200203292);
         end;
       end;
 
 
-    procedure tcg64f32.a_op64_reg_loc(list : taasmoutput;op:TOpCG;reglo,reghi : tregister;const l : tlocation);
+    procedure tcg64f32.a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);
       begin
         case l.loc of
           LOC_REFERENCE, LOC_CREFERENCE:
-            a_op64_reg_ref(list,op,reglo,reghi,l.reference);
+            a_op64_reg_ref(list,op,reg,l.reference);
           LOC_REGISTER,LOC_CREGISTER:
-            a_op64_reg_reg(list,op,reglo,reghi,l.registerlow,l.registerhigh);
+            a_op64_reg_reg(list,op,reg,l.register64);
           else
             internalerror(2002032422);
         end;
@@ -351,32 +349,42 @@ unit cg64f32;
 
 
 
-    procedure tcg64f32.a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reglo,reghi : tregister);
+    procedure tcg64f32.a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg : tregister64);
       begin
         case l.loc of
           LOC_REFERENCE, LOC_CREFERENCE:
-            a_op64_ref_reg(list,op,l.reference,reglo,reghi);
+            a_op64_ref_reg(list,op,l.reference,reg);
           LOC_REGISTER,LOC_CREGISTER:
-            a_op64_reg_reg(list,op,l.registerlow,l.registerhigh,reglo,reghi);
+            a_op64_reg_reg(list,op,l.register64,reg);
           LOC_CONSTANT :
-            a_op64_const_reg(list,op,l.valuelow,l.valuehigh,reglo,reghi);
+            a_op64_const_reg(list,op,l.valueqword,reg);
           else
             internalerror(200203242);
         end;
       end;
 
 
-    procedure tcg64f32.a_param64_reg(list : taasmoutput;reglo,reghi : tregister;nr : longint);
+    procedure tcg64f32.a_param64_reg(list : taasmoutput;reg : tregister64;nr : longint);
       begin
-         a_param_reg(list,OS_32,reghi,nr);
-         a_param_reg(list,OS_32,reglo,nr+1);
+         cg.a_param_reg(list,OS_32,reg.reghi,nr);
+         { the nr+1 needs definitivly a fix FK }
+         { maybe the parameter numbering needs }
+         { to take care of this on 32 Bit      }
+         { systems FK                          }
+         cg.a_param_reg(list,OS_32,reg.reglo,nr+1);
       end;
 
 
-    procedure tcg64f32.a_param64_const(list : taasmoutput;valuelo,valuehi : aword;nr : longint);
+    procedure tcg64f32.a_param64_const(list : taasmoutput;value : qword;nr : longint);
       begin
-         a_param_const(list,OS_32,valuehi,nr);
-         a_param_const(list,OS_32,valuelo,nr+1);
+        if target_info.endian<>source_info.endian then
+          swap_qword(value);
+         cg.a_param_const(list,OS_32,hi(value),nr);
+         { the nr+1 needs definitivly a fix FK }
+         { maybe the parameter numbering needs }
+         { to take care of this on 32 Bit      }
+         { systems FK                          }
+         cg.a_param_const(list,OS_32,lo(value),nr+1);
       end;
 
 
@@ -386,8 +394,12 @@ unit cg64f32;
       begin
         tmpref := r;
         inc(tmpref.offset,4);
-        a_param_ref(list,OS_32,tmpref,nr);
-        a_param_ref(list,OS_32,r,nr+1);
+        cg.a_param_ref(list,OS_32,tmpref,nr);
+        { the nr+1 needs definitivly a fix FK }
+        { maybe the parameter numbering needs }
+        { to take care of this on 32 Bit      }
+        { systems FK                          }
+        cg.a_param_ref(list,OS_32,r,nr+1);
       end;
 
 
@@ -396,9 +408,9 @@ unit cg64f32;
         case l.loc of
           LOC_REGISTER,
           LOC_CREGISTER :
-            a_param64_reg(list,l.registerlow,l.registerhigh,nr);
+            a_param64_reg(list,l.register64,nr);
           LOC_CONSTANT :
-            a_param64_const(list,l.valuelow,l.valuehigh,nr);
+            a_param64_const(list,l.valueqword,nr);
           LOC_CREFERENCE,
           LOC_REFERENCE :
             a_param64_ref(list,l.reference,nr);
@@ -408,23 +420,7 @@ unit cg64f32;
       end;
 
 
-
-    procedure tcg64f32.g_rangecheck(list: taasmoutput; const p: tnode;
-        const todef: tdef);
-      begin
-        { range checking on and range checkable value? }
-        if not(cs_check_range in aktlocalswitches) or
-           not(todef.deftype in [orddef,enumdef,arraydef]) then
-          exit;
-        { special case for 64bit rangechecks }
-        if is_64bitint(p.resulttype.def) or is_64bitint(todef) then
-          g_rangecheck64(list,p,todef)
-        else
-          inherited g_rangecheck(list,p,todef);
-      end;
-
-
-    procedure tcg64f32.g_rangecheck64(list : taasmoutput; p : tnode;todef : tdef);
+    procedure tcg64f32.g_rangecheck64(list : taasmoutput;const p : tnode;const todef : tdef);
 
       var
         neglabel,
@@ -456,36 +452,36 @@ unit cg64f32;
                end
              else
                begin
-                 hreg := get_scratch_reg_int(list);
+                 hreg := cg.get_scratch_reg_int(list);
                  got_scratch := true;
                  a_load64high_ref_reg(list,p.location.reference,hreg);
                end;
              getlabel(poslabel);
 
              { check high dword, must be 0 (for positive numbers) }
-             a_cmp_const_reg_label(list,OS_32,OC_EQ,0,hreg,poslabel);
+             cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,0,hreg,poslabel);
 
              { It can also be $ffffffff, but only for negative numbers }
              if from_signed and to_signed then
                begin
                  getlabel(neglabel);
-                 a_cmp_const_reg_label(list,OS_32,OC_EQ,aword(-1),hreg,neglabel);
+                 cg.a_cmp_const_reg_label(list,OS_32,OC_EQ,aword(-1),hreg,neglabel);
                end;
              { !!! freeing of register should happen directly after compare! (JM) }
              if got_scratch then
-               free_scratch_reg(list,hreg);
+               cg.free_scratch_reg(list,hreg);
              { For all other values we have a range check error }
-             a_call_name(list,'FPC_RANGEERROR');
+             cg.a_call_name(list,'FPC_RANGEERROR');
 
              { if the high dword = 0, the low dword can be considered a }
              { simple cardinal                                          }
-             a_label(list,poslabel);
+             cg.a_label(list,poslabel);
              hdef:=torddef.create(u32bit,0,cardinal($ffffffff));
              { the real p.resulttype.def is already saved in fromdef }
              p.resulttype.def := hdef;
              { no use in calling just "g_rangecheck" since that one will }
              { simply call the inherited method too (JM)                 }
-             inherited g_rangecheck(list,p,todef);
+             cg.g_rangecheck(list,p,todef);
              hdef.free;
              { restore original resulttype.def }
              p.resulttype.def := todef;
@@ -493,10 +489,10 @@ unit cg64f32;
              if from_signed and to_signed then
                begin
                  getlabel(endlabel);
-                 a_jmp_always(list,endlabel);
+                 cg.a_jmp_always(list,endlabel);
                  { if the high dword = $ffffffff, then the low dword (when }
                  { considered as a longint) must be < 0                    }
-                 a_label(list,neglabel);
+                 cg.a_label(list,neglabel);
                  if p.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
                    begin
                      hreg := p.location.registerlow;
@@ -504,27 +500,27 @@ unit cg64f32;
                    end
                  else
                    begin
-                     hreg := get_scratch_reg_int(list);
+                     hreg := cg.get_scratch_reg_int(list);
                      got_scratch := true;
                      a_load64low_ref_reg(list,p.location.reference,hreg);
                    end;
                  { get a new neglabel (JM) }
                  getlabel(neglabel);
-                 a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel);
+                 cg.a_cmp_const_reg_label(list,OS_32,OC_LT,0,hreg,neglabel);
                  { !!! freeing of register should happen directly after compare! (JM) }
                  if got_scratch then
-                   free_scratch_reg(list,hreg);
+                   cg.free_scratch_reg(list,hreg);
 
-                 a_call_name(list,'FPC_RANGEERROR');
+                 cg.a_call_name(list,'FPC_RANGEERROR');
 
                  { if we get here, the 64bit value lies between }
                  { longint($80000000) and -1 (JM)               }
-                 a_label(list,neglabel);
+                 cg.a_label(list,neglabel);
                  hdef:=torddef.create(s32bit,longint($80000000),-1);
                  p.resulttype.def := hdef;
-                 inherited g_rangecheck(list,p,todef);
+                 cg.g_rangecheck(list,p,todef);
                  hdef.free;
-                 a_label(list,endlabel);
+                 cg.a_label(list,endlabel);
                end;
              registerdef := oldregisterdef;
              p.resulttype.def := fromdef;
@@ -558,23 +554,23 @@ unit cg64f32;
                  end
                else
                  begin
-                   hreg := get_scratch_reg_int(list);
+                   hreg := cg.get_scratch_reg_int(list);
                    got_scratch := true;
 
                    opsize := def_cgsize(p.resulttype.def);
                    if opsize in [OS_64,OS_S64] then
                      a_load64high_ref_reg(list,p.location.reference,hreg)
                    else
-                     a_load_ref_reg(list,opsize,p.location.reference,hreg);
+                     cg.a_load_ref_reg(list,opsize,p.location.reference,hreg);
                  end;
                getlabel(poslabel);
-               a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);
+               cg.a_cmp_const_reg_label(list,opsize,OC_GTE,0,hreg,poslabel);
 
                { !!! freeing of register should happen directly after compare! (JM) }
                if got_scratch then
-                 free_scratch_reg(list,hreg);
-               a_call_name(list,'FPC_RANGEERROR');
-               a_label(list,poslabel);
+                 cg.free_scratch_reg(list,hreg);
+               cg.a_call_name(list,'FPC_RANGEERROR');
+               cg.a_label(list,poslabel);
              end;
       end;
 
@@ -591,7 +587,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.14  2002-05-20 13:30:40  carl
+  Revision 1.15  2002-07-01 16:23:52  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.14  2002/05/20 13:30:40  carl
   * bugfix of hdisponen (base must be set, not index)
   * more portability fixes
 

compiler/cg64f64.pas

@@ -77,7 +77,7 @@ unit cg64f64;
 
     procedure tcg64f64.a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);
       begin
-      	 cg.a_load_const_ref(list,OS_64,value,ref);
+         cg.a_load_const_ref(list,OS_64,value,ref);
       end;
 
     procedure tcg64f64.a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);
@@ -177,7 +177,12 @@ unit cg64f64;
 end.
 {
   $Log$
-  Revision 1.1  2002-06-08 19:36:54  florian
+  Revision 1.2  2002-07-01 16:23:52  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.1  2002/06/08 19:36:54  florian
     * initial release
 
 }

compiler/cginfo.pas

@@ -55,14 +55,14 @@ interface
        (
           OC_NONE,
           OC_EQ,           { equality comparison              }
-          OC_GT,           { greater than (signed)            } 
+          OC_GT,           { greater than (signed)            }
           OC_LT,           { less than (signed)               }
-          OC_GTE,          { greater or equal than (signed)   } 
+          OC_GTE,          { greater or equal than (signed)   }
           OC_LTE,          { less or equal than (signed)      }
-          OC_NE,           { not equal                        } 
+          OC_NE,           { not equal                        }
           OC_BE,           { less or equal than (unsigned)    }
           OC_B,            { less than (unsigned)             }
-          OC_AE,           { greater or equal than (unsigned) } 
+          OC_AE,           { greater or equal than (unsigned) }
           OC_A             { greater than (unsigned)          }
         );
 
@@ -88,7 +88,7 @@ interface
          1,2,4,8,16,1,2,4,8,16);
 
        tfloat2tcgsize: array[tfloattype] of tcgsize =
-         (OS_F32,OS_F64,OS_F80,OS_C64);
+         (OS_F32,OS_F64,OS_F80,OS_C64,OS_C64);
 
        tcgsize2tfloat: array[OS_F32..OS_C64] of tfloattype =
          (s32real,s64real,s80real,s64comp);
@@ -101,7 +101,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.11  2002-05-27 19:16:08  carl
+  Revision 1.12  2002-07-01 16:23:52  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.11  2002/05/27 19:16:08  carl
   + added comments to virtual comparison flags
 
   Revision 1.10  2002/05/18 13:34:05  peter

compiler/cgobj.pas

@@ -71,7 +71,7 @@ unit cgobj;
 
           {# @abstract(Returns an int register for use as scratch register)
              This routine returns a register which can be used by
-             the code generator as a general purpose scratch register. 
+             the code generator as a general purpose scratch register.
              Since scratch_registers are scarce resources, the register
              should be freed by calling @link(free_scratch_reg) as
              soon as it is no longer required.
@@ -79,7 +79,7 @@ unit cgobj;
           function get_scratch_reg_int(list : taasmoutput) : tregister;virtual;
           {# @abstract(Returns an address register for use as scratch register)
              This routine returns a register which can be used by
-             the code generator as a pointer scratch register. 
+             the code generator as a pointer scratch register.
              Since scratch_registers are scarce resources, the register
              should be freed by calling @link(free_scratch_reg) as
              soon as it is no longer required.
@@ -335,8 +335,52 @@ unit cgobj;
           procedure g_restore_all_registers(list : taasmoutput;selfused,accused,acchiused:boolean);virtual;abstract;
        end;
 
+    {# @abstract(Abstract code generator for 64 Bit operations)
+       This class implements an abstract code generator class
+       for 64 Bit operations.
+    }
+    tcg64 = class
+        procedure a_load64_const_ref(list : taasmoutput;value : qword;const ref : treference);virtual;abstract;
+        procedure a_load64_reg_ref(list : taasmoutput;reg : tregister64;const ref : treference);virtual;abstract;
+        procedure a_load64_ref_reg(list : taasmoutput;const ref : treference;reg : tregister64);virtual;abstract;
+        procedure a_load64_reg_reg(list : taasmoutput;regsrc,regdst : tregister64);virtual;abstract;
+        procedure a_load64_const_reg(list : taasmoutput;value : qword;reg : tregister64);virtual;abstract;
+        procedure a_load64_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister64);virtual;abstract;
+        procedure a_load64_loc_ref(list : taasmoutput;const l : tlocation;const ref : treference);virtual;abstract;
+        procedure a_load64_const_loc(list : taasmoutput;value : qword;const l : tlocation);virtual;abstract;
+        procedure a_load64_reg_loc(list : taasmoutput;reg : tregister64;const l : tlocation);virtual;abstract;
+
+        procedure a_load64high_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);virtual;abstract;
+        procedure a_load64low_reg_ref(list : taasmoutput;reg : tregister;const ref : treference);virtual;abstract;
+        procedure a_load64high_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);virtual;abstract;
+        procedure a_load64low_ref_reg(list : taasmoutput;const ref : treference;reg : tregister);virtual;abstract;
+        procedure a_load64high_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);virtual;abstract;
+        procedure a_load64low_loc_reg(list : taasmoutput;const l : tlocation;reg : tregister);virtual;abstract;
+
+        procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);virtual;abstract;
+        procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);virtual;abstract;
+        procedure a_op64_reg_ref(list : taasmoutput;op:TOpCG;regsrc : tregister64;const ref : treference);virtual;abstract;
+        procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;regdst : tregister64);virtual;abstract;
+        procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);virtual;abstract;
+        procedure a_op64_const_loc(list : taasmoutput;op:TOpCG;value : qword;const l: tlocation);virtual;abstract;
+        procedure a_op64_reg_loc(list : taasmoutput;op:TOpCG;reg : tregister64;const l : tlocation);virtual;abstract;
+        procedure a_op64_loc_reg(list : taasmoutput;op:TOpCG;const l : tlocation;reg64 : tregister64);virtual;abstract;
+
+        procedure a_param64_reg(list : taasmoutput;reg64 : tregister64;nr : longint);virtual;abstract;
+        procedure a_param64_const(list : taasmoutput;value : qword;nr : longint);virtual;abstract;
+        procedure a_param64_ref(list : taasmoutput;const r : treference;nr : longint);virtual;abstract;
+        procedure a_param64_loc(list : taasmoutput;const l : tlocation;nr : longint);virtual;abstract;
+
+        { override to catch 64bit rangechecks }
+        procedure g_rangecheck64(list: taasmoutput; const p: tnode;
+          const todef: tdef);virtual;abstract;
+    end;
+
     var
-       cg : tcg; { this is the main code generator class }
+       {# Main code generator class }
+       cg : tcg;
+       {# Code generator class for all operations working with 64-Bit operands }
+       cg64 : tcg64;
 
   implementation
 
@@ -404,13 +448,13 @@ unit cgobj;
          a_reg_alloc(list,r);
          get_scratch_reg_int:=r;
       end;
-     
-    { the default behavior simply returns a general purpose register } 
+
+    { the default behavior simply returns a general purpose register }
     function tcg.get_scratch_reg_address(list : taasmoutput) : tregister;
      begin
        get_scratch_reg_address := get_scratch_reg_int(list);
      end;
-      
+
 
     procedure tcg.free_scratch_reg(list : taasmoutput;r : tregister);
 
@@ -992,6 +1036,11 @@ unit cgobj;
         if not(cs_check_range in aktlocalswitches) or
            not(todef.deftype in [orddef,enumdef,arraydef]) then
           exit;
+        if is_64bitint(p.resulttype.def) or is_64bitint(todef) then
+          begin
+             cg64.g_rangecheck64(list,p,todef);
+             exit;
+          end;
         { only check when assigning to scalar, subranges are different, }
         { when todef=fromdef then the check is always generated         }
         fromdef:=p.resulttype.def;
@@ -1202,7 +1251,7 @@ unit cgobj;
               g_finalize(list,procinfo^._class,href,false);
               a_label(list,nofinal);
             end;
-           { actually call destructor } 
+           { actually call destructor }
             { parameter 3 :vmt_offset     }
             a_param_const(list, OS_32, procinfo^._class.vmt_offset, 3);
             { parameter 2 : pointer to vmt }
@@ -1220,8 +1269,8 @@ unit cgobj;
         else
          internalerror(200006162);
       end;
-      
-      
+
+
     procedure tcg.g_call_fail_helper(list : taasmoutput);
       var
         href : treference;
@@ -1230,7 +1279,7 @@ unit cgobj;
         if is_class(procinfo^._class) then
           begin
 {$warning todo}
-   { Should simply casll FPC_DISPOSE_CLASS and then set the 
+   { Should simply casll FPC_DISPOSE_CLASS and then set the
      SELF_POINTER_REGISTER to NIL
    }
              internalerror(20020523);
@@ -1262,7 +1311,7 @@ unit cgobj;
         else
           internalerror(200006163);
       end;
-      
+
 
     procedure tcg.g_interrupt_stackframe_entry(list : taasmoutput);
       begin
@@ -1278,16 +1327,17 @@ unit cgobj;
       begin
       end;
 
-
-
-
-
 finalization
   cg.free;
 end.
 {
   $Log$
-  Revision 1.28  2002-06-06 18:53:17  jonas
+  Revision 1.29  2002-07-01 16:23:52  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.28  2002/06/06 18:53:17  jonas
     * fixed internalerror(10) with -Or for i386 (a_load_ref_ref now saves
       a general purpose register if it needs one but none are available)
 

compiler/cstreams.pas

@@ -387,7 +387,7 @@ end;
 function TCFileStream.Write(const Buffer; Count: Longint): Longint;
 begin
   CStreamError:=0;
-  BlockWrite (FHandle,Buffer,Count,Result);
+  BlockWrite (FHandle,(@Buffer)^,Count,Result);
   If Result=-1 then Result:=0;
 end;
 
@@ -610,7 +610,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.5  2002-05-18 13:34:06  peter
+  Revision 1.6  2002-07-01 16:23:52  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.5  2002/05/18 13:34:06  peter
     * readded missing revisions
 
   Revision 1.4  2002/05/16 19:46:36  carl

compiler/globals.pas

@@ -280,6 +280,7 @@ interface
 
     function  string2guid(const s: string; var GUID: TGUID): boolean;
     function  guid2string(const GUID: TGUID): string;
+    procedure swap_qword(var q : qword);
 
     function UpdateAlignmentStr(s:string;var a:talignmentinfo):boolean;
 
@@ -1266,6 +1267,11 @@ implementation
       end;
 
 
+    procedure swap_qword(var q : qword);
+      begin
+         q:=(qword(lo(q)) shl 32) or hi(q);
+      end;
+
     function UpdateAlignmentStr(s:string;var a:talignmentinfo):boolean;
       var
         tok  : string;
@@ -1460,7 +1466,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.58  2002-05-18 13:34:08  peter
+  Revision 1.59  2002-07-01 16:23:52  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.58  2002/05/18 13:34:08  peter
     * readded missing revisions
 
   Revision 1.57  2002/05/16 19:46:36  carl

compiler/i386/cgcpu.pas

@@ -33,7 +33,7 @@ unit cgcpu;
        node,symconst;
 
     type
-      tcg386 = class(tcg64f32)
+      tcg386 = class(tcg)
 
         { passing parameters, per default the parameter is pushed }
         { nr gives the number of the parameter (enumerated from   }
@@ -95,11 +95,6 @@ unit cgcpu;
         procedure g_flags2reg(list: taasmoutput; const f: tresflags; reg: TRegister); override;
         procedure g_flags2ref(list: taasmoutput; const f: tresflags; const ref: TReference); override;
 
-        procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reglo,reghi : tregister);override;
-        procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;reglosrc,reghisrc,reglodst,reghidst : tregister);override;
-        procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;valuelosrc,valuehisrc:AWord;reglodst,reghidst : tregister);override;
-        procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;valuelosrc,valuehisrc:AWord;const ref : treference);override;
-
         procedure g_concatcopy(list : taasmoutput;const source,dest : treference;len : aword; delsource,loadref : boolean);override;
 
         procedure g_push_exception(list : taasmoutput;const exceptbuf:treference;l:AWord; exceptlabel:TAsmLabel);override;
@@ -119,7 +114,7 @@ unit cgcpu;
         procedure g_call_constructor_helper(list : taasmoutput);override;
         procedure g_call_destructor_helper(list : taasmoutput);override;
         procedure g_call_fail_helper(list : taasmoutput);override;
-{$endif}        
+{$endif}
         procedure g_save_standard_registers(list : taasmoutput);override;
         procedure g_restore_standard_registers(list : taasmoutput);override;
         procedure g_save_all_registers(list : taasmoutput);override;
@@ -128,20 +123,25 @@ unit cgcpu;
         procedure g_overflowcheck(list: taasmoutput; const p: tnode);override;
 
       private
-
         procedure a_jmp_cond(list : taasmoutput;cond : TOpCmp;l: tasmlabel);
-        procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
         procedure sizes2load(s1 : tcgsize;s2 : topsize; var op: tasmop; var s3: topsize);
 
         procedure floatload(list: taasmoutput; t : tcgsize;const ref : treference);
         procedure floatstore(list: taasmoutput; t : tcgsize;const ref : treference);
         procedure floatloadops(t : tcgsize;var op : tasmop;var s : topsize);
         procedure floatstoreops(t : tcgsize;var op : tasmop;var s : topsize);
+      end;
 
+      tcg64f386 = class(tcg64f32)
+        procedure a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);override;
+        procedure a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);override;
+        procedure a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);override;
+        procedure a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);override;
+      private
+        procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
       end;
 
     const
-
       TOpCG2AsmOp: Array[topcg] of TAsmOp = (A_NONE,A_ADD,A_AND,A_DIV,
                             A_IDIV,A_MUL, A_IMUL, A_NEG,A_NOT,A_OR,
                             A_SAR,A_SHL,A_SHR,A_SUB,A_XOR);
@@ -1068,7 +1068,7 @@ unit cgcpu;
 
 { ************* 64bit operations ************ }
 
-    procedure tcg386.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
+    procedure tcg64f386.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp);
       begin
         case op of
           OP_ADD :
@@ -1102,45 +1102,45 @@ unit cgcpu;
       end;
 
 
-    procedure tcg386.a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reglo,reghi : tregister);
+    procedure tcg64f386.a_op64_ref_reg(list : taasmoutput;op:TOpCG;const ref : treference;reg : tregister64);
       var
         op1,op2 : TAsmOp;
         tempref : treference;
       begin
         get_64bit_ops(op,op1,op2);
-        list.concat(taicpu.op_ref_reg(op1,S_L,ref,reglo));
+        list.concat(taicpu.op_ref_reg(op1,S_L,ref,reg.reglo));
         tempref:=ref;
         inc(tempref.offset,4);
-        list.concat(taicpu.op_ref_reg(op2,S_L,tempref,reghi));
+        list.concat(taicpu.op_ref_reg(op2,S_L,tempref,reg.reghi));
       end;
 
 
-    procedure tcg386.a_op64_reg_reg(list : taasmoutput;op:TOpCG;reglosrc,reghisrc,reglodst,reghidst : tregister);
+    procedure tcg64f386.a_op64_reg_reg(list : taasmoutput;op:TOpCG;regsrc,regdst : tregister64);
       var
         op1,op2 : TAsmOp;
       begin
         get_64bit_ops(op,op1,op2);
-        list.concat(taicpu.op_reg_reg(op1,S_L,reglosrc,reglodst));
-        list.concat(taicpu.op_reg_reg(op2,S_L,reghisrc,reghidst));
+        list.concat(taicpu.op_reg_reg(op1,S_L,regsrc.reglo,regdst.reglo));
+        list.concat(taicpu.op_reg_reg(op2,S_L,regsrc.reghi,regdst.reghi));
       end;
 
 
-    procedure tcg386.a_op64_const_reg(list : taasmoutput;op:TOpCG;valuelosrc,valuehisrc:AWord;reglodst,reghidst : tregister);
+    procedure tcg64f386.a_op64_const_reg(list : taasmoutput;op:TOpCG;value : qword;reg : tregister64);
       var
         op1,op2 : TAsmOp;
       begin
         case op of
           OP_AND,OP_OR,OP_XOR:
             begin
-              a_op_const_reg(list,op,valuelosrc,reglodst);
-              a_op_const_reg(list,op,valuehisrc,reghidst);
+              cg.a_op_const_reg(list,op,lo(value),reg.reglo);
+              cg.a_op_const_reg(list,op,hi(value),reg.reghi);
             end;
           OP_ADD, OP_SUB:
             begin
               // can't use a_op_const_ref because this may use dec/inc
               get_64bit_ops(op,op1,op2);
-              list.concat(taicpu.op_const_reg(op1,S_L,valuelosrc,reglodst));
-              list.concat(taicpu.op_const_reg(op2,S_L,valuehisrc,reghidst));
+              list.concat(taicpu.op_const_reg(op1,S_L,lo(value),reg.reglo));
+              list.concat(taicpu.op_const_reg(op2,S_L,hi(value),reg.reghi));
             end;
           else
             internalerror(200204021);
@@ -1148,7 +1148,7 @@ unit cgcpu;
       end;
 
 
-    procedure tcg386.a_op64_const_ref(list : taasmoutput;op:TOpCG;valuelosrc,valuehisrc:AWord;const ref : treference);
+    procedure tcg64f386.a_op64_const_ref(list : taasmoutput;op:TOpCG;value : qword;const ref : treference);
       var
         op1,op2 : TAsmOp;
         tempref : treference;
@@ -1156,19 +1156,19 @@ unit cgcpu;
         case op of
           OP_AND,OP_OR,OP_XOR:
             begin
-              a_op_const_ref(list,op,OS_32,valuelosrc,ref);
+              cg.a_op_const_ref(list,op,OS_32,lo(value),ref);
               tempref:=ref;
               inc(tempref.offset,4);
-              a_op_const_ref(list,op,OS_32,valuehisrc,tempref);
+              cg.a_op_const_ref(list,op,OS_32,hi(value),tempref);
             end;
           OP_ADD, OP_SUB:
             begin
               get_64bit_ops(op,op1,op2);
               // can't use a_op_const_ref because this may use dec/inc
-              list.concat(taicpu.op_const_ref(op1,S_L,valuelosrc,ref));
+              list.concat(taicpu.op_const_ref(op1,S_L,lo(value),ref));
               tempref:=ref;
               inc(tempref.offset,4);
-              list.concat(taicpu.op_const_ref(op2,S_L,valuehisrc,tempref));
+              list.concat(taicpu.op_const_ref(op2,S_L,hi(value),tempref));
             end;
           else
             internalerror(200204022);
@@ -1779,10 +1779,16 @@ unit cgcpu;
 
 begin
   cg := tcg386.create;
+  cg64 := tcg64f386.create;
 end.
 {
   $Log$
-  Revision 1.23  2002-06-16 08:16:59  carl
+  Revision 1.24  2002-07-01 16:23:55  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.23  2002/06/16 08:16:59  carl
   * bugfix of missing popecx for shift operations
 
   Revision 1.22  2002/05/22 19:02:16  carl

compiler/i386/cpubase.pas

@@ -91,10 +91,18 @@ uses
         R_XMM0,R_XMM1,R_XMM2,R_XMM3,R_XMM4,R_XMM5,R_XMM6,R_XMM7
       );
 
+      {# A type to store register locations for 64 Bit values. }
+      tregister64 = packed record
+        reglo,reghi : tregister;
+      end;
+
+      {# alias for compact code }
+      treg64 = tregister64;
+
       {# Set type definition for registers }
       tregisterset = set of tregister;
 
-      {# Type definition for the array of string of register nnames }
+      {# Type definition for the array of string of register names }
       reg2strtable = array[tregister] of string[6];
 
     const
@@ -246,15 +254,20 @@ uses
               case longint of
                 1 : (value : AWord);
                 2 : (valuelow, valuehigh:AWord);
+                { overlay a complete 64 Bit value }
+                3 : (valueqword : qword);
               );
             LOC_CREFERENCE,
             LOC_REFERENCE : (reference : treference);
             { segment in reference at the same place as in loc_register }
             LOC_REGISTER,LOC_CREGISTER : (
               case longint of
-                1 : (register,segment,registerhigh : tregister);
+                1 : (register,registerhigh,segment : tregister);
                 { overlay a registerlow }
                 2 : (registerlow : tregister);
+                { overlay a 64 Bit register type }
+                3 : (reg64 : tregister64);
+                4 : (register64 : tregister64);
               );
             { it's only for better handling }
             LOC_MMXREGISTER,LOC_CMMXREGISTER : (mmxreg : tregister);
@@ -439,7 +452,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.23  2002-05-18 13:34:22  peter
+  Revision 1.24  2002-07-01 16:23:55  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.23  2002/05/18 13:34:22  peter
     * readded missing revisions
 
   Revision 1.22  2002/05/16 19:46:50  carl

compiler/i386/n386add.pas

@@ -964,7 +964,7 @@ interface
                   end;
                  hregister:=rg.getregisterint(exprasmlist);
                  hregister2:=rg.getregisterint(exprasmlist);
-                 tcg64f32(cg).a_load64_loc_reg(exprasmlist,left.location,hregister,hregister2);
+                 cg64.a_load64_loc_reg(exprasmlist,left.location,joinreg64(hregister,hregister2));
                  location_reset(left.location,LOC_REGISTER,OS_64);
                  left.location.registerlow:=hregister;
                  left.location.registerhigh:=hregister2;
@@ -983,9 +983,9 @@ interface
            { when swapped another result register }
            if (nodetype=subn) and (nf_swaped in flags) then
             begin
-              tcg64f32(cg).a_op64_reg_reg(exprasmlist,op,
-                left.location.registerlow,left.location.registerhigh,
-                right.location.registerlow,right.location.registerhigh);
+              cg64.a_op64_reg_reg(exprasmlist,op,
+                left.location.register64,
+                right.location.register64);
               location_swap(left.location,right.location);
               toggleflag(nf_swaped);
             end
@@ -998,9 +998,9 @@ interface
             end
            else
             begin
-              tcg64f32(cg).a_op64_reg_reg(exprasmlist,op,
-                right.location.registerlow,right.location.registerhigh,
-                left.location.registerlow,left.location.registerhigh);
+              cg64.a_op64_reg_reg(exprasmlist,op,
+                right.location.register64,
+                left.location.register64);
             end;
            location_release(exprasmlist,right.location);
          end
@@ -1010,10 +1010,10 @@ interface
            if (nodetype=subn) and (nf_swaped in flags) then
             begin
               rg.getexplicitregisterint(exprasmlist,R_EDI);
-              tcg64f32(cg).a_load64low_loc_reg(exprasmlist,right.location,R_EDI);
+              cg64.a_load64low_loc_reg(exprasmlist,right.location,R_EDI);
               emit_reg_reg(op1,opsize,left.location.registerlow,R_EDI);
               emit_reg_reg(A_MOV,opsize,R_EDI,left.location.registerlow);
-              tcg64f32(cg).a_load64high_loc_reg(exprasmlist,right.location,R_EDI);
+              cg64.a_load64high_loc_reg(exprasmlist,right.location,R_EDI);
               { the carry flag is still ok }
               emit_reg_reg(op2,opsize,left.location.registerhigh,R_EDI);
               emit_reg_reg(A_MOV,opsize,R_EDI,left.location.registerhigh);
@@ -1061,8 +1061,8 @@ interface
 
            else
             begin
-              tcg64f32(cg).a_op64_loc_reg(exprasmlist,op,right.location,
-                left.location.registerlow,left.location.registerhigh);
+              cg64.a_op64_loc_reg(exprasmlist,op,right.location,
+                left.location.register64);
               if (right.location.loc<>LOC_CREGISTER) then
                begin
                  location_freetemp(exprasmlist,right.location);
@@ -1572,7 +1572,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.39  2002-05-18 13:34:22  peter
+  Revision 1.40  2002-07-01 16:23:55  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.39  2002/05/18 13:34:22  peter
     * readded missing revisions
 
   Revision 1.38  2002/05/16 19:46:51  carl

compiler/i386/n386cal.pas

@@ -176,15 +176,6 @@ implementation
          { handle call by reference parameter }
          else if (defcoll.paratyp in [vs_var,vs_out]) then
            begin
-              { get temp for constants }
-              if left.location.loc=LOC_CONSTANT then
-               begin
-                 tg.gettempofsizereference(exprasmlist,left.resulttype.def.size,href);
-                 cg.a_load_loc_ref(exprasmlist,left.location,href);
-                 location_reset(left.location,LOC_REFERENCE,def_cgsize(left.resulttype.def));
-                 left.location.reference:=href;
-               end;
-
               if (left.location.loc<>LOC_REFERENCE) then
                begin
                  { passing self to a var parameter is allowed in
@@ -1206,8 +1197,8 @@ implementation
                                  location.registerhigh:=rg.getexplicitregisterint(exprasmlist,accumulatorhigh);
                                  location.registerlow:=rg.getexplicitregisterint(exprasmlist,accumulator);
                               end;
-                            tcg64f32(cg).a_load64_reg_reg(exprasmlist,accumulator,accumulatorhigh,
-                                location.registerlow,location.registerhigh);
+                            cg64.a_load64_reg_reg(exprasmlist,joinreg64(accumulator,accumulatorhigh),
+                                location.register64);
                           end
                          else
                           begin
@@ -1484,7 +1475,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.54  2002-05-20 13:30:40  carl
+  Revision 1.55  2002-07-01 16:23:56  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.54  2002/05/20 13:30:40  carl
   * bugfix of hdisponen (base must be set, not index)
   * more portability fixes
 

compiler/i386/n386inl.pas

@@ -179,8 +179,8 @@ implementation
                  location_force_reg(exprasmlist,location,cgsize,false);
 
                  if cgsize in [OS_64,OS_S64] then
-                  tcg64f32(cg).a_op64_const_reg(exprasmlist,cgop,1,0,
-                      location.registerlow,location.registerhigh)
+                  cg64.a_op64_const_reg(exprasmlist,cgop,1,
+                      location.register64)
                  else
                   cg.a_op_const_reg(exprasmlist,cgop,1,location.register);
 
@@ -235,8 +235,8 @@ implementation
                 if addconstant then
                  begin
                    if cgsize in [OS_64,OS_S64] then
-                    tcg64f32(cg).a_op64_const_loc(exprasmlist,addsubop[inlinenumber],
-                       addvalue,0,tcallparanode(left).left.location)
+                    cg64.a_op64_const_loc(exprasmlist,addsubop[inlinenumber],
+                       addvalue,tcallparanode(left).left.location)
                    else
                     cg.a_op_const_loc(exprasmlist,addsubop[inlinenumber],
                        addvalue,tcallparanode(left).left.location);
@@ -244,8 +244,8 @@ implementation
                 else
                  begin
                    if cgsize in [OS_64,OS_S64] then
-                    tcg64f32(cg).a_op64_reg_loc(exprasmlist,addsubop[inlinenumber],
-                       hregister,hregisterhi,tcallparanode(left).left.location)
+                     cg64.a_op64_reg_loc(exprasmlist,addsubop[inlinenumber],
+                       joinreg64(hregister,hregisterhi),tcallparanode(left).left.location)
                    else
                     cg.a_op_reg_loc(exprasmlist,addsubop[inlinenumber],
                        hregister,tcallparanode(left).left.location);
@@ -460,7 +460,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.44  2002-05-18 13:34:25  peter
+  Revision 1.45  2002-07-01 16:23:56  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.44  2002/05/18 13:34:25  peter
     * readded missing revisions
 
   Revision 1.43  2002/05/16 19:46:51  carl

compiler/ncal.pas

@@ -1512,7 +1512,8 @@ implementation
                   is_ansistring(resulttype.def) then
                  begin
                    { we use ansistrings so no fast exit here }
-                   procinfo^.no_fast_exit:=true;
+                   if assigned(procinfo) then
+                    procinfo^.no_fast_exit:=true;
                  end;
              end;
           end;
@@ -1870,7 +1871,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.76  2002-05-18 13:34:09  peter
+  Revision 1.77  2002-07-01 16:23:52  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.76  2002/05/18 13:34:09  peter
     * readded missing revisions
 
   Revision 1.75  2002/05/16 19:46:37  carl

compiler/ncgcnv.pas

@@ -444,18 +444,40 @@ interface
       var
         pushed : tpushedsaved;
       begin
-        { instance to check }
-        secondpass(left);
-        rg.saveusedregisters(exprasmlist,pushed,all_registers);
-        cg.a_param_loc(exprasmlist,left.location,2);
-        { type information }
-        secondpass(right);
-        cg.a_param_loc(exprasmlist,right.location,1);
-        location_release(exprasmlist,right.location);
-        { call helper }
-        cg.a_call_name(exprasmlist,'FPC_DO_AS');
-        cg.g_maybe_loadself(exprasmlist);
-        rg.restoreusedregisters(exprasmlist,pushed);
+        if (right.nodetype=guidconstn) then
+         begin
+{$warning need to push a third parameter}
+           { instance to check }
+           secondpass(left);
+           rg.saveusedregisters(exprasmlist,pushed,all_registers);
+           cg.a_param_loc(exprasmlist,left.location,2);
+           { type information }
+           secondpass(right);
+           cg.a_paramaddr_ref(exprasmlist,right.location.reference,1);
+           location_release(exprasmlist,right.location);
+           { call helper }
+           if is_class(left.resulttype.def) then
+             cg.a_call_name(exprasmlist,'FPC_CLASS_AS_INTF')
+           else
+             cg.a_call_name(exprasmlist,'FPC_INTF_AS');
+           cg.g_maybe_loadself(exprasmlist);
+           rg.restoreusedregisters(exprasmlist,pushed);
+         end
+        else
+         begin
+           { instance to check }
+           secondpass(left);
+           rg.saveusedregisters(exprasmlist,pushed,all_registers);
+           cg.a_param_loc(exprasmlist,left.location,2);
+           { type information }
+           secondpass(right);
+           cg.a_param_loc(exprasmlist,right.location,1);
+           location_release(exprasmlist,right.location);
+           { call helper }
+           cg.a_call_name(exprasmlist,'FPC_DO_AS');
+           cg.g_maybe_loadself(exprasmlist);
+           rg.restoreusedregisters(exprasmlist,pushed);
+         end;
 
         location_copy(location,left.location);
       end;
@@ -468,7 +490,12 @@ end.
 
 {
   $Log$
-  Revision 1.15  2002-05-18 13:34:09  peter
+  Revision 1.16  2002-07-01 16:23:53  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.15  2002/05/18 13:34:09  peter
     * readded missing revisions
 
   Revision 1.14  2002/05/16 19:46:37  carl

compiler/ncgcon.pas

@@ -80,7 +80,7 @@ implementation
 
       const
         floattype2ait:array[tfloattype] of tait=
-          (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit);
+          (ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_comp_64bit);
 
       var
          hp1 : tai;
@@ -519,7 +519,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2002-05-18 13:34:09  peter
+  Revision 1.11  2002-07-01 16:23:53  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.10  2002/05/18 13:34:09  peter
     * readded missing revisions
 
   Revision 1.9  2002/05/16 19:46:37  carl

compiler/ncgflw.pas

@@ -515,8 +515,8 @@ implementation
                         begin
                           cg.a_reg_alloc(exprasmlist,accumulatorhigh);
                           allocated_acchigh := true;
-                          tcg64f32(cg).a_load64_loc_reg(exprasmlist,left.location,
-                              accumulator,accumulatorhigh);
+                          cg64.a_load64_loc_reg(exprasmlist,left.location,
+                              joinreg64(accumulator,accumulatorhigh));
                         end
                       else
                         begin
@@ -601,8 +601,8 @@ do_jmp:
          rg.cleartempgen;
          secondpass(left);
       end;
-      
-      
+
+
 {*****************************************************************************
                              SecondFail
 *****************************************************************************}
@@ -612,7 +612,7 @@ do_jmp:
         cg.a_jmp_always(exprasmlist,faillabel);
       end;
 
-      
+
 
 
 begin
@@ -628,7 +628,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.19  2002-05-20 13:30:40  carl
+  Revision 1.20  2002-07-01 16:23:53  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.19  2002/05/20 13:30:40  carl
   * bugfix of hdisponen (base must be set, not index)
   * more portability fixes
 

compiler/ncgld.pas

@@ -264,10 +264,10 @@ implementation
                begin
                   if assigned(left) then
                     begin
-                       { 
-                         THIS IS A TERRIBLE HACK!!!!!! WHICH WILL NOT WORK 
-                         ON 64-BIT SYSTEMS: SINCE PROCSYM FOR METHODS     
-                         CONSISTS OF TWO OS_ADDR, so you cannot set it 
+                       {
+                         THIS IS A TERRIBLE HACK!!!!!! WHICH WILL NOT WORK
+                         ON 64-BIT SYSTEMS: SINCE PROCSYM FOR METHODS
+                         CONSISTS OF TWO OS_ADDR, so you cannot set it
                          to OS_64 - how to solve?? Carl
                        }
                        if (sizeof(aword) = 4) then
@@ -529,8 +529,8 @@ implementation
               LOC_CONSTANT :
                 begin
                   if right.location.size in [OS_64,OS_S64] then
-                   tcg64f32(cg).a_load64_const_loc(exprasmlist,
-                       right.location.valuelow,right.location.valuehigh,left.location)
+                   cg64.a_load64_const_loc(exprasmlist,
+                       right.location.valueqword,left.location)
                   else
                    cg.a_load_const_loc(exprasmlist,right.location.value,left.location);
                 end;
@@ -542,8 +542,8 @@ implementation
                       begin
                         cgsize:=def_cgsize(left.resulttype.def);
                         if cgsize in [OS_64,OS_S64] then
-                         tcg64f32(cg).a_load64_ref_reg(exprasmlist,
-                             right.location.reference,left.location.registerlow,left.location.registerhigh)
+                         cg64.a_load64_ref_reg(exprasmlist,
+                             right.location.reference,left.location.register64)
                         else
                          cg.a_load_ref_reg(exprasmlist,cgsize,
                              right.location.reference,left.location.register);
@@ -583,8 +583,8 @@ implementation
                 begin
                   cgsize:=def_cgsize(left.resulttype.def);
                   if cgsize in [OS_64,OS_S64] then
-                   tcg64f32(cg).a_load64_reg_loc(exprasmlist,
-                       right.location.registerlow,right.location.registerhigh,left.location)
+                   cg64.a_load64_reg_loc(exprasmlist,
+                     right.location.register64,left.location)
                   else
                    cg.a_load_reg_loc(exprasmlist,right.location.size,right.location.register,left.location);
                 end;
@@ -893,7 +893,7 @@ implementation
                    8 :
                      begin
                        if hp.left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then
-                        tcg64f32(cg).a_load64_loc_ref(exprasmlist,hp.left.location,href)
+                        cg64.a_load64_loc_ref(exprasmlist,hp.left.location,href)
                        else
                         cg.g_concatcopy(exprasmlist,hp.left.location.reference,href,elesize,freetemp,false);
                      end;
@@ -921,7 +921,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.9  2002-05-20 13:30:40  carl
+  Revision 1.10  2002-07-01 16:23:53  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.9  2002/05/20 13:30:40  carl
   * bugfix of hdisponen (base must be set, not index)
   * more portability fixes
 

compiler/ncgmem.pas

@@ -369,7 +369,7 @@ implementation
                       tmpreg := cg.get_scratch_reg_address(exprasmlist);
                       cg.a_loadaddr_ref_reg(exprasmlist,
                         left.location.reference,tmpreg);
-                    end;  
+                    end;
                 end;
 
                location_release(exprasmlist,left.location);
@@ -462,7 +462,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.13  2002-05-20 13:30:40  carl
+  Revision 1.14  2002-07-01 16:23:53  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.13  2002/05/20 13:30:40  carl
   * bugfix of hdisponen (base must be set, not index)
   * more portability fixes
 

compiler/ncgset.pas

@@ -36,16 +36,16 @@ interface
 
        tcginnode = class(tinnode)
           procedure pass_2;override;
-          {# Routine to test bitnumber in bitnumber register on value  
-             in value register. The __result register should be set 
-             to one if the bit is set, otherwise __result register 
+          {# Routine to test bitnumber in bitnumber register on value
+             in value register. The __result register should be set
+             to one if the bit is set, otherwise __result register
              should be set to zero.
-             
+
              Should be overriden on processors which have specific
              instructions to do bit tests.
           }
-          
-          procedure emit_bit_test_reg_reg(list : taasmoutput; bitnumber : tregister; 
+
+          procedure emit_bit_test_reg_reg(list : taasmoutput; bitnumber : tregister;
              value : tregister; __result :tregister);virtual;
        end;
 
@@ -287,7 +287,7 @@ implementation
             { "x in [y..z]" expression                               }
             adjustment := 0;
             hr := R_NO;
-            
+
             for i:=1 to numparts do
              if setparts[i].range then
               { use fact that a <= x <= b <=> cardinal(x-a) <= cardinal(b-a) }
@@ -301,7 +301,7 @@ implementation
                       { so in case of a LOC_CREGISTER first move the value }
                       { to edi (not done before because now we can do the  }
                       { move and substract in one instruction with LEA)    }
-                      if (left.location.loc = LOC_CREGISTER) and 
+                      if (left.location.loc = LOC_CREGISTER) and
                          (hr <> pleftreg) then
                         begin
                           hr:=cg.get_scratch_reg_int(exprasmlist);
@@ -396,13 +396,13 @@ implementation
                     else
                       internalerror(200203312);
                   end;
-                 { then do AND with constant and register }   
+                 { then do AND with constant and register }
                  cg.a_op_const_reg(exprasmlist,OP_AND,1 shl
                     (tordconstnode(left).value and 31),hr);
                  { if the value in the AND register is <> 0 then the value is equal. }
-                 cg.a_cmp_const_reg_label(exprasmlist,OS_32,OC_EQ,1 shl 
+                 cg.a_cmp_const_reg_label(exprasmlist,OS_32,OC_EQ,1 shl
                     (tordconstnode(left).value and 31),hr,l);
-                 cg.free_scratch_reg(exprasmlist,hr);  
+                 cg.free_scratch_reg(exprasmlist,hr);
                  getlabel(l3);
                  cg.a_jmp_always(exprasmlist,l3);
                  { Now place the end label if IN success }
@@ -422,7 +422,7 @@ implementation
                           hr3:=rg.makeregsize(left.location.register,OS_INT);
                           cg.a_load_reg_reg(exprasmlist,left.location.size,left.location.register,hr3);
                           hr:=cg.get_scratch_reg_int(exprasmlist);
-                          cg.a_load_reg_reg(exprasmlist,OS_INT,hr3,hr);          
+                          cg.a_load_reg_reg(exprasmlist,OS_INT,hr3,hr);
                        end;
                   else
                     begin
@@ -540,7 +540,7 @@ implementation
                   getlabel(l);
                   { use location.register as scratch register here }
                   inc(right.location.reference.offset,tordconstnode(left).value shr 3);
-                  cg.a_load_ref_reg(exprasmlist, OS_8, right.location.reference, location.register); 
+                  cg.a_load_ref_reg(exprasmlist, OS_8, right.location.reference, location.register);
                   cg.a_op_const_reg(exprasmlist, OP_AND,1 shl (tordconstnode(left).value and 7),
                      location.register);
                   cg.a_cmp_const_reg_label(exprasmlist,OS_8, OC_NE,0,location.register,l2);
@@ -580,13 +580,18 @@ implementation
 
 begin
    csetelementnode:=tcgsetelementnode;
-{$ifdef TEST_GENERIC}   
+{$ifdef TEST_GENERIC}
    cinnode:=tcginnode;
-{$endif}   
+{$endif}
 end.
 {
   $Log$
-  Revision 1.1  2002-06-16 08:14:56  carl
+  Revision 1.2  2002-07-01 16:23:53  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.1  2002/06/16 08:14:56  carl
   + generic sets
 
 }

compiler/ncgutil.pas

@@ -214,6 +214,7 @@ implementation
       var
         hregister,
         hregisterhi : tregister;
+        hreg64 : tregister64;
         hl : tasmlabel;
      begin
         { handle transformations to 64bit separate }
@@ -281,8 +282,10 @@ implementation
                  hregister:=rg.getregisterint(list);
                  hregisterhi:=rg.getregisterint(list);
                end;
+              hreg64.reglo:=hregister;
+              hreg64.reghi:=hregisterhi;
               { load value in new register }
-              tcg64f32(cg).a_load64_loc_reg(list,l,hregister,hregisterhi);
+              cg64.a_load64_loc_reg(list,l,hreg64);
               location_reset(l,LOC_REGISTER,dst_size);
               l.registerlow:=hregister;
               l.registerhigh:=hregisterhi;
@@ -464,7 +467,7 @@ implementation
             begin
               tg.gettempofsizereference(list,TCGSize2Size[l.size],r);
               if l.size in [OS_64,OS_S64] then
-               tcg64f32(cg).a_load64_loc_ref(list,l,r)
+               cg64.a_load64_loc_ref(list,l,r)
               else
                cg.a_load_loc_ref(list,l,r);
               location_reset(l,LOC_REFERENCE,l.size);
@@ -498,7 +501,7 @@ implementation
                  if l.size in [OS_64,OS_S64] then
                   begin
                     tg.gettempofsizereference(exprasmlist,8,s.ref);
-                    tcg64f32(cg).a_load64_reg_ref(exprasmlist,l.registerlow,l.registerhigh,s.ref);
+                    cg64.a_load64_reg_ref(exprasmlist,joinreg64(l.registerlow,l.registerhigh),s.ref);
                   end
                  else
                   begin
@@ -545,7 +548,7 @@ implementation
                begin
                  l.registerlow:=rg.getregisterint(exprasmlist);
                  l.registerhigh:=rg.getregisterint(exprasmlist);
-                 tcg64f32(cg).a_load64_ref_reg(exprasmlist,s.ref,l.registerlow,l.registerhigh);
+                 cg64.a_load64_ref_reg(exprasmlist,s.ref,joinreg64(l.registerlow,l.registerhigh));
                end
               else
                begin
@@ -692,10 +695,10 @@ implementation
                        if inlined then
                         begin
                           reference_reset_base(href,procinfo^.framepointer,para_offset-pushedparasize);
-                          tcg64f32(cg).a_load64_loc_ref(exprasmlist,p.location,href);
+                          cg64.a_load64_loc_ref(exprasmlist,p.location,href);
                         end
                        else
-                        tcg64f32(cg).a_param64_loc(exprasmlist,p.location,-1);
+                        cg64.a_param64_loc(exprasmlist,p.location,-1);
                      end
                     else
                      begin
@@ -878,6 +881,7 @@ implementation
                  cg.a_load_ref_reg(list,OS_ADDR,href,tmpreg);
                  reference_reset_base(href,tmpreg,0);
                  cg.g_initialize(list,tvarsym(p).vartype.def,href,false);
+                 cg.free_scratch_reg(list,tmpreg);
                end;
            end;
          end;
@@ -988,7 +992,7 @@ implementation
                   begin
                     uses_acchi:=true;
                     cg.a_reg_alloc(list,accumulatorhigh);
-                    tcg64f32(cg).a_load64_ref_reg(list,href,accumulator,accumulatorhigh);
+                    cg64.a_load64_ref_reg(list,href,joinreg64(accumulator,accumulatorhigh));
                   end
                  else
                   begin
@@ -1029,7 +1033,7 @@ implementation
              enumdef :
                begin
                  if cgsize in [OS_64,OS_S64] then
-                  tcg64f32(cg).a_load64_reg_ref(list,accumulator,accumulatorhigh,href)
+                   cg64.a_load64_reg_ref(list,joinreg64(accumulator,accumulatorhigh),href)
                  else
                   begin
                     hreg:=rg.makeregsize(accumulator,cgsize);
@@ -1607,7 +1611,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.17  2002-05-20 13:30:40  carl
+  Revision 1.18  2002-07-01 16:23:53  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.17  2002/05/20 13:30:40  carl
   * bugfix of hdisponen (base must be set, not index)
   * more portability fixes
 

compiler/ncnv.pas

@@ -102,7 +102,6 @@ interface
           procedure second_class_to_intf;virtual;abstract;
           procedure second_char_to_char;virtual;abstract;
           procedure second_nothing; virtual;abstract;
-
        end;
        ttypeconvnodeclass = class of ttypeconvnode;
 
@@ -703,7 +702,6 @@ implementation
          begin
            t:=crealconstnode.create(tordconstnode(left).value,resulttype);
            result:=t;
-           exit;
          end;
       end;
 
@@ -715,6 +713,13 @@ implementation
 
       begin
          result:=nil;
+         if is_currency(left.resulttype.def) and not(is_currency(resulttype.def)) then
+           begin
+           end
+         else
+           if is_currency(resulttype.def) then
+             begin
+             end;
          if left.nodetype=realconstn then
            begin
              t:=crealconstnode.create(trealconstnode(left).value_real,resulttype);
@@ -1713,7 +1718,18 @@ implementation
              end
             else
              CGMessage1(type_e_class_type_expected,left.resulttype.def.typename);
+
             resulttype:=right.resulttype;
+
+            { load the GUID of the interface }
+            if (right.nodetype=typen) then
+             begin
+               if tobjectdef(left.resulttype.def).isiidguidvalid then
+                right:=cguidconstnode.create(tobjectdef(left.resulttype.def).iidguid)
+               else
+                internalerror(200206282);
+               resulttypepass(right);
+             end;
           end
          else
           CGMessage1(type_e_class_or_interface_type_expected,right.resulttype.def.typename);
@@ -1739,7 +1755,12 @@ begin
 end.
 {
   $Log$
-  Revision 1.58  2002-05-18 13:34:09  peter
+  Revision 1.59  2002-07-01 16:23:53  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.58  2002/05/18 13:34:09  peter
     * readded missing revisions
 
   Revision 1.57  2002/05/16 19:46:37  carl

compiler/options.pas

@@ -1354,6 +1354,7 @@ begin
   def_symbol('HASCOMPILERPROC');
   def_symbol('VALUEGETMEM');
   def_symbol('VALUEFREEMEM');
+  def_symbol('HASCURRENCY');
 
   { some stuff for TP compatibility }
   case target_info.cpu of
@@ -1664,7 +1665,12 @@ finalization
 end.
 {
   $Log$
-  Revision 1.73  2002-05-18 13:34:11  peter
+  Revision 1.74  2002-07-01 16:23:53  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.73  2002/05/18 13:34:11  peter
     * readded missing revisions
 
   Revision 1.72  2002/05/16 19:46:41  carl

compiler/pdecobj.pas

@@ -972,18 +972,23 @@ implementation
                          end;
                        _PUBLISHED :
                          begin
+                           { we've to check for a pushlished section in non-  }
+                           { publishable classes later, if a real declaration }
+                           { this is the way, delphi does it                  }
                            if is_interface(aktclass) then
-                             Message(parser_e_no_access_specifier_in_interfaces)
-                           else
-                             if not(oo_can_have_published in aktclass.objectoptions) then
-                               Message(parser_e_cant_have_published);
+                             Message(parser_e_no_access_specifier_in_interfaces);
                            consume(_PUBLISHED);
                            current_object_option:=[sp_published];
                          end;
                        else
                          begin
                            if is_interface(aktclass) then
-                            Message(parser_e_no_vars_in_interfaces);
+                             Message(parser_e_no_vars_in_interfaces);
+
+                           if (sp_published in current_object_option) and
+                             not(oo_can_have_published in aktclass.objectoptions) then
+                             Message(parser_e_cant_have_published);
+
                            read_var_decs(false,true,false);
                          end;
                     end;
@@ -996,6 +1001,10 @@ implementation
                 _FUNCTION,
                 _CLASS :
                   begin
+                    if (sp_published in current_object_option) and
+                      not(oo_can_have_published in aktclass.objectoptions) then
+                      Message(parser_e_cant_have_published);
+
                     oldparse_only:=parse_only;
                     parse_only:=true;
                     parse_proc_dec;
@@ -1024,10 +1033,16 @@ implementation
                   end;
                 _CONSTRUCTOR :
                   begin
+                    if (sp_published in current_object_option) and
+                      not(oo_can_have_published in aktclass.objectoptions) then
+                      Message(parser_e_cant_have_published);
+
                     if not(sp_public in current_object_option) then
                       Message(parser_w_constructor_should_be_public);
+
                     if is_interface(aktclass) then
                       Message(parser_e_no_con_des_in_interfaces);
+
                     oldparse_only:=parse_only;
                     parse_only:=true;
                     constructor_head;
@@ -1046,13 +1061,20 @@ implementation
                   end;
                 _DESTRUCTOR :
                   begin
+                    if (sp_published in current_object_option) and
+                      not(oo_can_have_published in aktclass.objectoptions) then
+                      Message(parser_e_cant_have_published);
+
                     if there_is_a_destructor then
                       Message(parser_n_only_one_destructor);
+
                     if is_interface(aktclass) then
                       Message(parser_e_no_con_des_in_interfaces);
-                    there_is_a_destructor:=true;
+
                     if not(sp_public in current_object_option) then
                       Message(parser_w_destructor_should_be_public);
+
+                    there_is_a_destructor:=true;
                     oldparse_only:=parse_only;
                     parse_only:=true;
                     destructor_head;
@@ -1111,7 +1133,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.45  2002-05-18 13:34:12  peter
+  Revision 1.46  2002-07-01 16:23:53  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.45  2002/05/18 13:34:12  peter
     * readded missing revisions
 
   Revision 1.44  2002/05/16 19:46:42  carl

compiler/psystem.pas

@@ -116,6 +116,7 @@ begin
   addtype('Real',s64floattype);
 {$ifdef i386}
   adddef('Comp',tfloatdef.create(s64comp));
+  addtype('Currency',s64currencytype);
 {$endif}
   addtype('Pointer',voidpointertype);
   addtype('FarPointer',voidfarpointertype);
@@ -161,6 +162,7 @@ begin
   addtype('$s32real',s32floattype);
   addtype('$s64real',s64floattype);
   addtype('$s80real',s80floattype);
+  addtype('$s64currency',s64currencytype);
 { Add a type for virtual method tables }
   vmtsymtable:=trecordsymtable.create;
   vmttype.setdef(trecorddef.create(vmtsymtable));
@@ -205,6 +207,7 @@ begin
   globaldef('s32real',s32floattype);
   globaldef('s64real',s64floattype);
   globaldef('s80real',s80floattype);
+  globaldef('s64currency',s64currencytype);
   globaldef('boolean',booltype);
   globaldef('void_pointer',voidpointertype);
   globaldef('char_pointer',charpointertype);
@@ -249,6 +252,7 @@ begin
   s32floattype.setdef(tfloatdef.create(s32real));
   s64floattype.setdef(tfloatdef.create(s64real));
   s80floattype.setdef(tfloatdef.create(s80real));
+  s64currencytype.setdef(tfloatdef.create(s64currency));
 {$endif}
 {$ifdef m68k}
   s32floattype.setdef(tfloatdef.create(s32real));
@@ -276,7 +280,12 @@ end;
 end.
 {
   $Log$
-  Revision 1.26  2002-05-18 13:34:16  peter
+  Revision 1.27  2002-07-01 16:23:54  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.26  2002/05/18 13:34:16  peter
     * readded missing revisions
 
   Revision 1.25  2002/05/16 19:46:44  carl

compiler/symconst.pas

@@ -146,7 +146,7 @@ type
   { float types }
   tfloattype = (
     s32real,s64real,s80real,
-    s64comp
+    s64comp,s64currency
   );
 
   { string types }
@@ -334,7 +334,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.32  2002-05-18 13:34:18  peter
+  Revision 1.33  2002-07-01 16:23:54  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.32  2002/05/18 13:34:18  peter
     * readded missing revisions
 
   Revision 1.31  2002/05/16 19:46:44  carl

compiler/symdef.pas

@@ -648,6 +648,7 @@ interface
        s32floattype,              { pointer for realconstn }
        s64floattype,              { pointer for realconstn }
        s80floattype,              { pointer to type of temp. floats }
+       s64currencytype,           { pointer to a currency type }
        s32fixedtype,              { pointer to type of temp. fixed }
        cshortstringtype,          { pointer to type of short string const   }
        clongstringtype,           { pointer to type of long string const   }
@@ -1938,6 +1939,7 @@ implementation
             s64real : stabstring := strpnew('r'+
                tstoreddef(s32bittype.def).numberstring+';'+tostr(savesize)+';0;');
             { found this solution in stabsread.c from GDB v4.16 }
+            s64currency,
             s64comp : stabstring := strpnew('r'+
                tstoreddef(s32bittype.def).numberstring+';-'+tostr(savesize)+';0;');
             { under dos at least you must give a size of twelve instead of 10 !! }
@@ -1954,7 +1956,7 @@ implementation
       const
          {tfloattype = (s32real,s64real,s80real,s64bit);}
          translate : array[tfloattype] of byte =
-           (ftSingle,ftDouble,ftExtended,ftComp);
+           (ftSingle,ftDouble,ftExtended,ftComp,ftCurr);
       begin
          rttiList.concat(Tai_const.Create_8bit(tkFloat));
          write_rtti_name;
@@ -1971,7 +1973,7 @@ implementation
 
       const
         names : array[tfloattype] of string[20] = (
-          'Single','Double','Extended','Comp');
+          'Single','Double','Extended','Comp','Currency');
 
       begin
          gettypename:=names[typ];
@@ -5476,7 +5478,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.79  2002-05-18 13:34:18  peter
+  Revision 1.80  2002-07-01 16:23:54  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.79  2002/05/18 13:34:18  peter
     * readded missing revisions
 
   Revision 1.78  2002/05/16 19:46:44  carl

compiler/types.pas

@@ -151,6 +151,9 @@ interface
     {# Returns true, if definition is float }
     function is_fpu(def : tdef) : boolean;
 
+    {# Returns true, if def is a currency type }
+    function is_currency(def : tdef) : boolean;
+
     {# Returns true if the return value can be put in accumulator }
     function ret_in_acc(def : tdef) : boolean;
 
@@ -534,7 +537,14 @@ implementation
       end;
 
 
-    function range_to_basetype(low,high:TConstExprInt):tbasetype;
+    { returns true, if def is a currency type }
+    function is_currency(def : tdef) : boolean;
+      begin
+         is_currency:=(def.deftype=floatdef) and (tfloatdef(def).typ=s64currency);
+      end;
+
+
+      function range_to_basetype(low,high:TConstExprInt):tbasetype;
       begin
         { generate a unsigned range if high<0 and low>=0 }
         if (low>=0) and (high<0) then
@@ -1970,7 +1980,12 @@ implementation
 end.
 {
   $Log$
-  Revision 1.73  2002-05-18 13:34:21  peter
+  Revision 1.74  2002-07-01 16:23:54  peter
+    * cg64 patch
+    * basics for currency
+    * asnode updates for class and interface (not finished)
+
+  Revision 1.73  2002/05/18 13:34:21  peter
     * readded missing revisions
 
   Revision 1.72  2002/05/16 19:46:47  carl