+ support for register variables which contain records

git-svn-id: trunk@3580 -

.gitattributes

@@ -5752,6 +5752,7 @@ tests/test/trange3.pp svneol=native#text/plain
 tests/test/trange4.pp svneol=native#text/plain
 tests/test/trange5.pp svneol=native#text/plain
 tests/test/trangeob.pp svneol=native#text/plain
+tests/test/trecreg.pp -text
 tests/test/tresstr.pp svneol=native#text/plain
 tests/test/trtti1.pp svneol=native#text/plain
 tests/test/trtti2.pp svneol=native#text/plain

compiler/cgbase.pas

@@ -50,7 +50,10 @@ interface
          { multimedia register }
          LOC_MMREGISTER,
          { Constant multimedia reg which shouldn't be modified }
-         LOC_CMMREGISTER
+         LOC_CMMREGISTER,
+         { contiguous subset of bits of an integer register }
+         LOC_SUBSETREG,
+         LOC_CSUBSETREG
        );
 
        { since we have only 16bit offsets, we need to be able to specify the high
@@ -266,7 +269,7 @@ interface
           OS_M8,OS_M16,OS_M32,OS_M64,OS_M128,OS_M8,OS_M16,OS_M32,
           OS_M64,OS_M128);
 
-       tcgloc2str : array[TCGLoc] of string[11] = (
+       tcgloc2str : array[TCGLoc] of string[12] = (
             'LOC_INVALID',
             'LOC_VOID',
             'LOC_CONST',
@@ -281,7 +284,9 @@ interface
             'LOC_MMXREG',
             'LOC_CMMXREG',
             'LOC_MMREG',
-            'LOC_CMMREG');
+            'LOC_CMMREG',
+            'LOC_SSETREG',
+            'LOC_CSSETREG');
 
     var
        mms_movescalar : pmmshuffle;

compiler/cgobj.pas

@@ -214,6 +214,14 @@ unit cgobj;
           procedure a_load_loc_ref(list : TAsmList;tosize: tcgsize; const loc: tlocation; const ref : treference);
           procedure a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);virtual; abstract;
 
+          procedure a_load_subsetreg_reg(list : TAsmList; subsetregsize, subsetsize: tcgsize; startbit: byte; tosize: tcgsize; subsetreg, destreg: tregister); virtual;
+          procedure a_load_reg_subsetreg(list : TAsmList; fromsize: tcgsize; subsetregsize, subsetsize: tcgsize; startbit: byte; fromreg, subsetreg: tregister); virtual;
+          procedure a_load_subsetreg_subsetreg(list: TAsmlist; fromsubsetregsize, fromsubsetsize: tcgsize; fromstartbit: byte; tosubsetregsize, tosubsetsize: tcgsize; tostartbit: byte; fromsubsetreg, tosubsetreg: tregister); virtual;
+          procedure a_load_subsetreg_ref(list : TAsmList; subsetregsize, subsetsize: tcgsize; startbit: byte; tosize: tcgsize; subsetreg: tregister; const destref: treference); virtual;
+          procedure a_load_ref_subsetreg(list : TAsmList; fromsize, subsetregsize, subsetsize: tcgsize; startbit: byte; const fromref: treference; subsetreg: tregister); virtual;
+          procedure a_load_const_subsetreg(list: TAsmlist; subsetregsize, subsetsize: tcgsize; startbit: byte; a: aint; subsetreg: tregister); virtual;
+          procedure a_load_subsetreg_loc(list: TAsmlist; subsetregsize, subsetsize: tcgsize; startbit: byte; subsetreg: tregister; const loc: tlocation); virtual;
+
           { fpu move instructions }
           procedure a_loadfpu_reg_reg(list: TAsmList; size:tcgsize; reg1, reg2: tregister); virtual; abstract;
           procedure a_loadfpu_ref_reg(list: TAsmList; size: tcgsize; const ref: treference; reg: tregister); virtual; abstract;
@@ -244,10 +252,12 @@ unit cgobj;
           { destination (JM)                                                    }
           procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: TCGSize; a: Aint; reg: TRegister); virtual; abstract;
           procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: Aint; const ref: TReference); virtual;
+          procedure a_op_const_subsetreg(list : TAsmList; Op : TOpCG; size, subsetregsize, subsetsize : TCGSize; startbit: byte; a : aint; subsetreg: TRegister); virtual;
           procedure a_op_const_loc(list : TAsmList; Op: TOpCG; a: Aint; const loc: tlocation);
           procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); virtual; abstract;
           procedure a_op_reg_ref(list : TAsmList; Op: TOpCG; size: TCGSize; reg: TRegister; const ref: TReference); virtual;
           procedure a_op_ref_reg(list : TAsmList; Op: TOpCG; size: TCGSize; const ref: TReference; reg: TRegister); virtual;
+          procedure a_op_reg_subsetreg(list : TAsmList; Op : TOpCG; opsize, subsetregsize, subsetsize : TCGSize; startbit: byte; reg, subsetreg: TRegister); virtual;
           procedure a_op_reg_loc(list : TAsmList; Op: TOpCG; reg: tregister; const loc: tlocation);
           procedure a_op_ref_loc(list : TAsmList; Op: TOpCG; const ref: TReference; const loc: tlocation);
 
@@ -269,6 +279,8 @@ unit cgobj;
           procedure a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel); virtual; abstract;
           procedure a_cmp_ref_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; const ref: treference; reg : tregister; l : tasmlabel); virtual;
           procedure a_cmp_reg_ref_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg : tregister; const ref: treference; l : tasmlabel); virtual;
+          procedure a_cmp_subsetreg_reg_label(list : TAsmList; subsetregsize, subsetsize : tcgsize; startbit : byte; cmpsize : tcgsize; cmp_op : topcmp; subsetreg, reg : tregister; l : tasmlabel); virtual;
+
           procedure a_cmp_loc_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; const loc: tlocation; reg : tregister; l : tasmlabel);
           procedure a_cmp_reg_loc_label(list : TAsmList;size : tcgsize;cmp_op : topcmp; reg: tregister; const loc: tlocation; l : tasmlabel);
           procedure a_cmp_ref_loc_label(list: TAsmList; size: tcgsize;cmp_op: topcmp; const ref: treference; const loc: tlocation;
@@ -849,6 +861,112 @@ implementation
                        some generic implementations
 ****************************************************************************}
 
+{$ifopt r+}
+{$define rangeon}
+{$endif}
+
+{$ifopt q+}
+{$define overflowon}
+{$endif}
+
+   procedure tcg.a_load_subsetreg_reg(list : TAsmList; subsetregsize, subsetsize: tcgsize; startbit: byte; tosize: tcgsize; subsetreg, destreg: tregister);
+     var
+       bitmask: aint;
+       tmpreg: tregister;
+       stopbit: byte;
+     begin
+       tmpreg:=getintregister(list,subsetregsize);
+       a_op_const_reg_reg(list,OP_SHR,subsetregsize,startbit,subsetreg,tmpreg);
+       stopbit := startbit+(tcgsize2size[subsetsize] * 8);
+       // on x86(64), 1 shl 32(64) = 1 instead of 0
+       if (stopbit - startbit <> AIntBits) then
+         bitmask := (1 shl (stopbit-startbit)) - 1
+       else
+         bitmask := -1;
+       a_op_const_reg(list,OP_AND,subsetregsize,bitmask,tmpreg);
+       tmpreg := makeregsize(list,tmpreg,subsetsize);
+       a_load_reg_reg(list,tcgsize2unsigned[subsetsize],subsetsize,tmpreg,tmpreg);
+       a_load_reg_reg(list,subsetsize,tosize,tmpreg,destreg);
+     end;
+
+
+   procedure tcg.a_load_reg_subsetreg(list : TAsmList; fromsize: tcgsize; subsetregsize, subsetsize: tcgsize; startbit: byte; fromreg, subsetreg: tregister);
+     var
+       bitmask: aint;
+       tmpreg: tregister;
+       stopbit: byte;
+     begin
+       tmpreg:=getintregister(list,subsetregsize);
+       a_load_reg_reg(list,fromsize,subsetregsize,fromreg,tmpreg);
+       a_op_const_reg(list,OP_SHL,subsetregsize,startbit,tmpreg);
+       stopbit := startbit+(tcgsize2size[subsetsize] * 8);
+       // on x86(64), 1 shl 32(64) = 1 instead of 0
+       if (stopbit <> AIntBits) then
+         bitmask := not(((1 shl stopbit)-1) xor ((1 shl startbit)-1))
+       else
+         bitmask := not(-1 xor ((1 shl startbit)-1));
+       a_op_const_reg(list,OP_AND,subsetregsize,bitmask,subsetreg);
+       a_op_reg_reg(list,OP_OR,subsetregsize,tmpreg,subsetreg);
+     end;
+
+
+  procedure tcg.a_load_subsetreg_subsetreg(list: TAsmlist; fromsubsetregsize, fromsubsetsize: tcgsize; fromstartbit: byte; tosubsetregsize, tosubsetsize: tcgsize; tostartbit: byte; fromsubsetreg, tosubsetreg: tregister);
+    var
+      tmpreg: tregister;
+    begin
+      tmpreg := getintregister(list,tosubsetsize);
+      a_load_subsetreg_reg(list,fromsubsetregsize,fromsubsetsize,fromstartbit,tosubsetsize,fromsubsetreg,tmpreg);
+      a_load_reg_subsetreg(list,tosubsetsize,tosubsetregsize,tosubsetsize,tostartbit,tmpreg,tosubsetreg);
+    end;
+
+
+   procedure tcg.a_load_subsetreg_ref(list : TAsmList; subsetregsize, subsetsize: tcgsize; startbit: byte; tosize: tcgsize; subsetreg: tregister; const destref: treference);
+     var
+       tmpreg: tregister;
+     begin
+       tmpreg := getintregister(list,tosize);
+       a_load_subsetreg_reg(list,subsetregsize,subsetsize,startbit,tosize,subsetreg,tmpreg);
+       a_load_reg_ref(list,tosize,tosize,tmpreg,destref);
+     end;
+
+
+   procedure tcg.a_load_ref_subsetreg(list : TAsmList; fromsize, subsetregsize, subsetsize: tcgsize; startbit: byte; const fromref: treference; subsetreg: tregister);
+     var
+       tmpreg: tregister;
+     begin
+       tmpreg := getintregister(list,subsetsize);
+       a_load_ref_reg(list,fromsize,subsetsize,fromref,tmpreg);
+       a_load_reg_subsetreg(list,subsetsize,subsetregsize,subsetsize,startbit,tmpreg,subsetreg);
+     end;
+
+
+  procedure tcg.a_load_const_subsetreg(list: TAsmlist; subsetregsize, subsetsize: tcgsize; startbit: byte; a: aint; subsetreg: tregister);
+    var
+      bitmask: aint;
+      stopbit: byte;
+    begin
+       stopbit := startbit+(tcgsize2size[subsetsize] * 8);
+       // on x86(64), 1 shl 32(64) = 1 instead of 0
+       if (stopbit <> AIntBits) then
+         bitmask := not(((1 shl stopbit)-1) xor ((1 shl startbit)-1))
+       else
+         bitmask := (1 shl startbit) - 1;
+       a_op_const_reg(list,OP_AND,subsetregsize,bitmask,subsetreg);
+       a_op_const_reg(list,OP_OR,subsetregsize,a shl startbit,subsetreg);
+    end;
+
+
+{$ifdef rangeon}
+{$r+}
+{$undef rangeon}
+{$endif}
+
+{$ifdef overflowon}
+{$q+}
+{$undef overflowon}
+{$endif}
+
+
     procedure tcg.a_load_ref_ref(list : TAsmList;fromsize,tosize : tcgsize;const sref : treference;const dref : treference);
       var
         tmpreg: tregister;
@@ -879,6 +997,8 @@ implementation
             a_load_const_ref(list,loc.size,a,loc.reference);
           LOC_REGISTER,LOC_CREGISTER:
             a_load_const_reg(list,loc.size,a,loc.register);
+          LOC_SUBSETREG,LOC_CSUBSETREG:
+            a_load_const_subsetreg(list,loc.subsetregsize,loc.size,loc.startbit,a,loc.subsetreg);
           else
             internalerror(200203272);
         end;
@@ -892,6 +1012,8 @@ implementation
             a_load_reg_ref(list,fromsize,loc.size,reg,loc.reference);
           LOC_REGISTER,LOC_CREGISTER:
             a_load_reg_reg(list,fromsize,loc.size,reg,loc.register);
+          LOC_SUBSETREG,LOC_CSUBSETREG:
+            a_load_reg_subsetreg(list,fromsize,loc.subsetregsize,loc.size,loc.startbit,reg,loc.subsetreg);
           else
             internalerror(200203271);
         end;
@@ -907,6 +1029,8 @@ implementation
             a_load_reg_reg(list,loc.size,tosize,loc.register,reg);
           LOC_CONSTANT:
             a_load_const_reg(list,tosize,loc.value,reg);
+          LOC_SUBSETREG,LOC_CSUBSETREG:
+            a_load_subsetreg_reg(list,loc.subsetregsize,loc.size,loc.startbit,tosize,loc.subsetreg,reg);
           else
             internalerror(200109092);
         end;
@@ -922,12 +1046,29 @@ implementation
             a_load_reg_ref(list,loc.size,tosize,loc.register,ref);
           LOC_CONSTANT:
             a_load_const_ref(list,tosize,loc.value,ref);
+          LOC_SUBSETREG,LOC_CSUBSETREG:
+            a_load_subsetreg_ref(list,loc.subsetregsize,loc.size,loc.startbit,tosize,loc.subsetreg,ref);
           else
             internalerror(200109302);
         end;
       end;
 
 
+    procedure tcg.a_load_subsetreg_loc(list: TAsmlist; subsetregsize, subsetsize: tcgsize; startbit: byte; subsetreg: tregister; const loc: tlocation);
+      begin
+        case loc.loc of
+          LOC_REFERENCE,LOC_CREFERENCE:
+            a_load_subsetreg_ref(list,subsetregsize,subsetsize,startbit,loc.size,subsetreg,loc.reference);
+          LOC_REGISTER,LOC_CREGISTER:
+            a_load_subsetreg_reg(list,subsetregsize,subsetsize,startbit,loc.size,subsetreg,loc.register);
+          LOC_SUBSETREG,LOC_CSUBSETREG:
+            a_load_subsetreg_subsetreg(list,subsetregsize,subsetsize,startbit,loc.subsetregsize,loc.size,loc.startbit,subsetreg,loc.subsetreg);
+          else
+            internalerror(2006051510);
+        end;
+      end;
+
+
     procedure tcg.optimize_op_const(var op: topcg; var a : aint);
       var
         powerval : longint;
@@ -1083,6 +1224,17 @@ implementation
       end;
 
 
+    procedure tcg.a_op_const_subsetreg(list : TAsmList; Op : TOpCG; size, subsetregsize, subsetsize : TCGSize; startbit: byte; a : aint; subsetreg: TRegister);
+      var
+        tmpreg: tregister;
+      begin
+        tmpreg := cg.getintregister(list, size);
+        a_load_subsetreg_reg(list,subsetregsize,subsetsize,startbit,size,subsetreg,tmpreg);
+        a_op_const_reg(list,op,size,a,tmpreg);
+        a_load_reg_subsetreg(list,size,subsetregsize,subsetsize,startbit,tmpreg,subsetreg);
+      end;
+
+
     procedure tcg.a_op_const_loc(list : TAsmList; Op: TOpCG; a: aint; const loc: tlocation);
       begin
         case loc.loc of
@@ -1090,6 +1242,8 @@ implementation
             a_op_const_reg(list,op,loc.size,a,loc.register);
           LOC_REFERENCE, LOC_CREFERENCE:
             a_op_const_ref(list,op,loc.size,a,loc.reference);
+          LOC_SUBSETREG, LOC_CSUBSETREG:
+            a_op_const_subsetreg(list,op,loc.size,loc.subsetregsize,loc.size,loc.startbit,a,loc.subsetreg);
           else
             internalerror(200109061);
         end;
@@ -1130,6 +1284,17 @@ implementation
       end;
 
 
+    procedure tcg.a_op_reg_subsetreg(list : TAsmList; Op : TOpCG; opsize, subsetregsize, subsetsize : TCGSize; startbit: byte; reg, subsetreg: TRegister);
+      var
+        tmpreg: tregister;
+      begin
+        tmpreg := cg.getintregister(list, opsize);
+        a_load_subsetreg_reg(list,subsetregsize,subsetsize,startbit,opsize,subsetreg,tmpreg);
+        a_op_reg_reg(list,op,opsize,reg,tmpreg);
+        a_load_reg_subsetreg(list,opsize,subsetregsize,subsetsize,startbit,tmpreg,subsetreg);
+      end;
+
+
     procedure tcg.a_op_reg_loc(list : TAsmList; Op: TOpCG; reg: tregister; const loc: tlocation);
 
       begin
@@ -1138,6 +1303,8 @@ implementation
             a_op_reg_reg(list,op,loc.size,reg,loc.register);
           LOC_REFERENCE, LOC_CREFERENCE:
             a_op_reg_ref(list,op,loc.size,reg,loc.reference);
+          LOC_SUBSETREG, LOC_CSUBSETREG:
+            a_op_reg_subsetreg(list,op,loc.size,loc.subsetregsize,loc.size,loc.startbit,reg,loc.subsetreg);
           else
             internalerror(200109061);
         end;
@@ -1159,11 +1326,19 @@ implementation
               a_load_ref_reg(list,loc.size,loc.size,ref,tmpreg);
               a_op_reg_ref(list,op,loc.size,tmpreg,loc.reference);
             end;
+          LOC_SUBSETREG, LOC_CSUBSETREG:
+            begin
+              tmpreg:=getintregister(list,loc.size);
+              a_load_subsetreg_reg(list,loc.subsetregsize,loc.size,loc.startbit,loc.size,loc.subsetreg,tmpreg);
+              a_op_ref_reg(list,op,loc.size,ref,tmpreg);
+              a_load_reg_subsetreg(list,loc.size,loc.subsetregsize,loc.size,loc.startbit,tmpreg,loc.subsetreg);
+            end;
           else
             internalerror(200109061);
         end;
       end;
 
+
     procedure Tcg.a_op_const_reg_reg(list:TAsmList;op:Topcg;size:Tcgsize;
                                      a:aint;src,dst:Tregister);
 
@@ -1211,6 +1386,7 @@ implementation
 
       var
         tmpreg: tregister;
+
       begin
         tmpreg:=getintregister(list,size);
         a_load_ref_reg(list,size,size,ref,tmpreg);
@@ -1221,12 +1397,21 @@ implementation
     procedure tcg.a_cmp_const_loc_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : aint;const loc : tlocation;
       l : tasmlabel);
 
+      var
+        tmpreg : tregister;
+
       begin
         case loc.loc of
           LOC_REGISTER,LOC_CREGISTER:
             a_cmp_const_reg_label(list,size,cmp_op,a,loc.register,l);
           LOC_REFERENCE,LOC_CREFERENCE:
             a_cmp_const_ref_label(list,size,cmp_op,a,loc.reference,l);
+          LOC_SUBSETREG, LOC_CSUBSETREG:
+            begin
+              tmpreg:=getintregister(list,size);
+              a_load_subsetreg_reg(list,loc.subsetregsize,loc.size,loc.startbit,size,loc.subsetreg,tmpreg);
+              a_cmp_const_reg_label(list,size,cmp_op,a,tmpreg,l);
+            end
           else
             internalerror(200109061);
         end;
@@ -1270,12 +1455,25 @@ implementation
             a_cmp_ref_reg_label(list,size,cmp_op,loc.reference,reg,l);
           LOC_CONSTANT:
             a_cmp_const_reg_label(list,size,cmp_op,loc.value,reg,l);
+          LOC_SUBSETREG,
+          LOC_CSUBSETREG:
+            a_cmp_subsetreg_reg_label(list,loc.subsetregsize,loc.size,loc.startbit,size,cmp_op,loc.subsetreg,reg,l);
           else
             internalerror(200203231);
         end;
       end;
 
 
+    procedure tcg.a_cmp_subsetreg_reg_label(list : TAsmList; subsetregsize, subsetsize : tcgsize; startbit : byte; cmpsize : tcgsize; cmp_op : topcmp; subsetreg, reg : tregister; l : tasmlabel);
+      var
+        tmpreg: tregister;
+      begin
+        tmpreg:=getintregister(list, cmpsize);
+        a_load_subsetreg_reg(list,subsetregsize,subsetsize,startbit,cmpsize,subsetreg,tmpreg);
+        a_cmp_reg_reg_label(list,cmpsize,cmp_op,tmpreg,reg,l);
+      end;
+
+
     procedure tcg.a_cmp_ref_loc_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;const ref: treference;const loc : tlocation;
       l : tasmlabel);
       var
@@ -1289,7 +1487,13 @@ implementation
               tmpreg:=getintregister(list,size);
               a_load_ref_reg(list,size,size,loc.reference,tmpreg);
               a_cmp_ref_reg_label(list,size,cmp_op,ref,tmpreg,l);
-            end
+            end;
+          LOC_SUBSETREG, LOC_CSUBSETREG:
+            begin
+              tmpreg:=getintregister(list, size);
+              a_load_ref_reg(list,size,size,loc.reference,tmpreg);
+              a_cmp_subsetreg_reg_label(list,loc.subsetregsize,loc.size,loc.startbit,size,swap_opcmp(cmp_op),loc.subsetreg,tmpreg,l);
+            end;
           else
             internalerror(200109061);
         end;

compiler/cgutils.pas

@@ -93,6 +93,12 @@ unit cgutils;
                 2 : (register64 : tregister64);
 {$endif cpu64bit}
               );
+            LOC_SUBSETREG,
+            LOC_CSUBSETREG : (
+              subsetreg : tregister;
+              startbit: byte;
+              subsetregsize: tcgsize;
+            );
       end;
 
 

compiler/globtype.pas

@@ -49,10 +49,17 @@ than 255 characters. That's why using Ansi Strings}
 {$ifdef cpu64bit}
        AWord = qword;
        AInt = Int64;
+
+     Const
+       AIntBits = 64;
 {$else cpu64bit}
        AWord = longword;
        AInt = longint;
+
+     Const
+       AIntBits = 32;
 {$endif cpu64bit}
+     Type
        PAWord = ^AWord;
        PAInt = ^AInt;
 

compiler/htypechk.pas

@@ -641,14 +641,21 @@ implementation
 ****************************************************************************}
 
     { marks an lvalue as "unregable" }
-    procedure make_not_regable(p : tnode; how: tvarregable);
+    procedure make_not_regable_intern(p : tnode; how: tvarregable; records_only: boolean);
       begin
          case p.nodetype of
+             subscriptn:
+               make_not_regable_intern(tsubscriptnode(p).left,how,true);
             typeconvn :
-              make_not_regable(ttypeconvnode(p).left,how);
+               if (ttypeconvnode(p).resulttype.def.deftype = recorddef) then
+                 make_not_regable_intern(ttypeconvnode(p).left,how,false)
+               else
+                 make_not_regable_intern(ttypeconvnode(p).left,how,records_only);
             loadn :
               if (tloadnode(p).symtableentry.typ in [globalvarsym,localvarsym,paravarsym]) and
-                 (tabstractvarsym(tloadnode(p).symtableentry).varregable <> vr_none) then
+                 (tabstractvarsym(tloadnode(p).symtableentry).varregable <> vr_none) and
+                 ((not records_only) or
+                  (tabstractvarsym(tloadnode(p).symtableentry).vartype.def.deftype = recorddef)) then
                 if (tloadnode(p).symtableentry.typ = paravarsym) then
                   tabstractvarsym(tloadnode(p).symtableentry).varregable:=how
                 else
@@ -656,6 +663,10 @@ implementation
          end;
       end;
 
+    procedure make_not_regable(p : tnode; how: tvarregable);
+      begin
+        make_not_regable_intern(p,how,false);
+      end;
 
     { calculates the needed registers for a binary operator }
     procedure calcregisters(p : tbinarynode;r32,fpu,mmx : word);

compiler/ncgcal.pas

@@ -126,7 +126,7 @@ implementation
           exit;
 
         { Move flags and jump in register to make it less complex }
-        if left.location.loc in [LOC_FLAGS,LOC_JUMP] then
+        if left.location.loc in [LOC_FLAGS,LOC_JUMP,LOC_SUBSETREG,LOC_CSUBSETREG] then
           location_force_reg(current_asmdata.CurrAsmList,left.location,def_cgsize(left.resulttype.def),false);
 
         { Handle Floating point types differently }

compiler/ncgld.pas

@@ -609,6 +609,9 @@ implementation
                         left.location.size,
                         right.location.reference,
                         left.location.register,mms_movescalar);
+                    LOC_SUBSETREG,
+                    LOC_CSUBSETREG:
+                      cg.a_load_ref_subsetreg(current_asmdata.CurrAsmList,right.location.size,left.location.subsetregsize,left.location.size,left.location.startbit,right.location.reference,left.location.subsetreg);
                     else
                       internalerror(200203284);
                   end;
@@ -675,6 +678,13 @@ implementation
                         tfloat2tcgsize[fputyp],
                         right.location.register,left.location);
                 end;
+              LOC_SUBSETREG,
+              LOC_CSUBSETREG:
+                begin
+                  cg.a_load_subsetreg_loc(current_asmdata.CurrAsmList,
+                      right.location.subsetregsize,right.location.size,right.location.startbit,
+                      right.location.register,left.location);
+                end;
               LOC_JUMP :
                 begin
                   current_asmdata.getjumplabel(hlabel);

compiler/ncgmem.pas

@@ -307,28 +307,51 @@ implementation
              { some abi's require that functions return (some) records in }
              { registers                                                  }
              case location.loc of
-               LOC_REGISTER:
-                 location_force_mem(current_asmdata.CurrAsmList,location);
                LOC_REFERENCE,
                LOC_CREFERENCE:
                  ;
-{              record regvars are not supported yet
-               LOC_CREGISTER:                        }
+               LOC_REGISTER,
+               LOC_CREGISTER:
+                 begin
+                   if (left.location.loc = LOC_REGISTER) then
+                     location.loc := LOC_SUBSETREG
+                   else
+                     location.loc := LOC_CSUBSETREG;
+                   location.size:=def_cgsize(resulttype.def);
+                   location.subsetreg := left.location.register;
+                   location.subsetregsize := left.location.size;
+                   if (target_info.endian = ENDIAN_BIG) then
+                     location.startbit := (tcgsize2size[location.subsetregsize] - tcgsize2size[location.size] - vs.fieldoffset) * 8
+                   else
+                     location.startbit := (vs.fieldoffset * 8);
+                 end;
+               LOC_SUBSETREG,
+               LOC_CSUBSETREG:
+                 begin
+                   location.size:=def_cgsize(resulttype.def);
+                   if (target_info.endian = ENDIAN_BIG) then
+                     inc(location.startbit, (left.resulttype.def.size - tcgsize2size[location.size] - vs.fieldoffset) * 8)
+                   else
+                     inc(location.startbit, vs.fieldoffset * 8);
+                 end;
                else
                  internalerror(2006031901);
              end;
            end;
 
-         inc(location.reference.offset,vs.fieldoffset);
-{$ifdef SUPPORT_UNALIGNED}
-         { packed? }
-         if (vs.owner.defowner.deftype in [recorddef,objectdef]) and
-           (tabstractrecordsymtable(vs.owner).usefieldalignment=1) then
-           location.reference.alignment:=1;
-{$endif SUPPORT_UNALIGNED}
-
-         { also update the size of the location }
-         location.size:=def_cgsize(resulttype.def);
+         if (location.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
+           begin
+             inc(location.reference.offset,vs.fieldoffset);
+    {$ifdef SUPPORT_UNALIGNED}
+             { packed? }
+             if (vs.owner.defowner.deftype in [recorddef,objectdef]) and
+               (tabstractrecordsymtable(vs.owner).usefieldalignment=1) then
+               location.reference.alignment:=1;
+    {$endif SUPPORT_UNALIGNED}
+    
+             { also update the size of the location }
+             location.size:=def_cgsize(resulttype.def);
+           end;
          paraloc1.done;
       end;
 

compiler/ncgutil.pas

@@ -261,6 +261,7 @@ implementation
       var
         opsize : tcgsize;
         storepos : tfileposinfo;
+        tmpreg : tregister;
       begin
          if nf_error in p.flags then
            exit;
@@ -283,12 +284,15 @@ implementation
                 begin
                    opsize:=def_cgsize(p.resulttype.def);
                    case p.location.loc of
+                     LOC_SUBSETREG,LOC_CSUBSETREG:
+                       begin
+                         tmpreg := cg.getintregister(list,OS_INT);
+                         cg.a_load_subsetreg_reg(list,p.location.subsetregsize,p.location.size,p.location.startbit,OS_INT,p.location.subsetreg,tmpreg);
+                         cg.a_cmp_const_reg_label(list,OS_INT,OC_NE,0,tmpreg,current_procinfo.CurrTrueLabel);
+                         cg.a_jmp_always(list,current_procinfo.CurrFalseLabel);
+                       end;
                      LOC_CREGISTER,LOC_REGISTER,LOC_CREFERENCE,LOC_REFERENCE :
                        begin
-{$ifdef OLDREGVARS}
-                         if (p.location.loc = LOC_CREGISTER) then
-                           load_regvar_reg(list,p.location.register);
-{$endif OLDREGVARS}
                          cg.a_cmp_const_loc_label(list,opsize,OC_NE,0,p.location,current_procinfo.CurrTrueLabel);
                          cg.a_jmp_always(list,current_procinfo.CurrFalseLabel);
                        end;
@@ -572,7 +576,8 @@ implementation
                        (l.loc in [LOC_REFERENCE,LOC_CREFERENCE]) then
                       inc(l.reference.offset,TCGSize2Size[l.size]-TCGSize2Size[dst_size]);
 {$ifdef x86}
-                   l.size:=dst_size;
+                  if not (l.loc in [LOC_SUBSETREG,LOC_CSUBSETREG]) then
+                     l.size:=dst_size;
 {$endif x86}
                   end;
                  cg.a_load_loc_reg(list,dst_size,l,hregister);
@@ -743,6 +748,14 @@ implementation
               location_reset(l,LOC_REFERENCE,l.size);
               l.reference:=r;
             end;
+          LOC_SUBSETREG,
+          LOC_CSUBSETREG:
+            begin
+              tg.GetTemp(list,TCGSize2Size[l.size],tt_normal,r);
+              cg.a_load_subsetreg_ref(list,l.subsetregsize,l.size,l.startbit,l.size,l.subsetreg,r);
+              location_reset(l,LOC_REFERENCE,l.size);
+              l.reference:=r;
+            end;
           LOC_CREFERENCE,
           LOC_REFERENCE : ;
           else

compiler/nmem.pas

@@ -579,6 +579,11 @@ implementation
         { tp procvar support }
         maybe_call_procvar(left,true);
         resulttype:=vs.vartype;
+
+        // don't put records from which we load fields which aren't regable in integer registers
+        if (left.resulttype.def.deftype = recorddef) and
+           not(tstoreddef(resulttype.def).is_intregable) then
+          make_not_regable(left,vr_addr);
       end;
 
     procedure Tsubscriptnode.mark_write;
@@ -608,9 +613,6 @@ implementation
            end
          else
            begin
-              if (left.expectloc<>LOC_CREFERENCE) and
-                 (left.expectloc<>LOC_REFERENCE) then
-                CGMessage(parser_e_illegal_expression);
               expectloc:=left.expectloc;
            end;
       end;

compiler/symdef.pas

@@ -1148,6 +1148,8 @@ implementation
 
 
    function tstoreddef.is_intregable : boolean;
+     var
+       recsize,recsizep2: longint;
      begin
         is_intregable:=false;
         case deftype of
@@ -1162,6 +1164,13 @@ implementation
             is_intregable:=is_class(self) or is_interface(self);
           setdef:
             is_intregable:=(tsetdef(self).settype=smallset);
+          recorddef:
+            begin
+              recsize:=size;
+              is_intregable:=
+                ispowerof2(recsize,recsizep2) and
+                (recsize <= sizeof(aint));
+            end;
         end;
      end;
 

compiler/symsym.pas

@@ -1283,7 +1283,12 @@ implementation
                 ((refpara and
                   (varregable <> vr_none)) or
                  (not refpara and
-                  not(varregable in [vr_none,vr_addr])));
+                  not(varregable in [vr_none,vr_addr])))
+{$if not defined(powerpc) and not defined(powerpc64)}
+                and ((vartype.def.deftype <> recorddef) or
+                     (varregable = vr_addr) or
+                     not(varstate in [vs_written,vs_readwritten]));
+{$endif}
       end;
 
 

tests/test/trecreg.pp

@@ -0,0 +1,69 @@
+type
+  u_char = byte;
+  u_short = word;
+  u_long = cardinal;
+
+  wrec = record
+    w: word;
+  end;
+
+  wrec2 = record
+    b1,b2: byte;
+  end;
+
+  SunB = record
+    s_b1,
+    s_b2,
+    s_b3,
+    s_b4: u_char;
+  end;
+
+  SunW = record
+    s_w1: wrec;
+    s_w2: wrec2;
+  end;
+
+  in_addr =  record
+    case Integer of
+      0: (S_un_b: SunB);
+      1: (S_un_w: SunW);
+      2: (S_addr: u_long);
+  end;
+
+procedure t(i: in_addr);
+begin
+  if (i.s_un_b.s_b1 <> $de) or
+     (i.s_un_b.s_b2 <> $ad) or
+     (i.s_un_b.s_b3 <> $be) or
+     (i.s_un_b.s_b4 <> $ef) then
+    begin
+      writeln('error1');
+      halt(1);
+    end;
+end;
+
+procedure t2(i: in_addr);
+begin
+  if (i.s_un_w.s_w1.w <> $cafe) or
+     (i.s_un_w.s_w2.b1 <> $ba) or
+     (i.s_un_w.s_w2.b2 <> $be) then
+    begin
+      writeln('error2');
+      halt(2);
+    end;
+end;
+
+
+var
+  i: in_addr;
+begin
+  i.s_un_b.s_b1 := $de;
+  i.s_un_b.s_b2 := $ad;
+  i.s_un_b.s_b3 := $be;
+  i.s_un_b.s_b4 := $ef;
+  t(i);
+  i.s_un_w.s_w1.w := $cafe;
+  i.s_un_w.s_w2.b1 := $ba;
+  i.s_un_w.s_w2.b2 := $be;
+  t2(i);
+end.