From e344ee3cd7ddda9d68ddcff9cb6c3446871e9add Mon Sep 17 00:00:00 2001 From: Jonas Maebe Date: Fri, 19 May 2006 15:49:07 +0000 Subject: [PATCH] + support for register variables which contain records git-svn-id: trunk@3580 - --- .gitattributes | 1 + compiler/cgbase.pas | 11 ++- compiler/cgobj.pas | 206 +++++++++++++++++++++++++++++++++++++++++- compiler/cgutils.pas | 6 ++ compiler/globtype.pas | 7 ++ compiler/htypechk.pas | 17 +++- compiler/ncgcal.pas | 2 +- compiler/ncgld.pas | 10 ++ compiler/ncgmem.pas | 51 ++++++++--- compiler/ncgutil.pas | 23 ++++- compiler/nmem.pas | 8 +- compiler/symdef.pas | 9 ++ compiler/symsym.pas | 7 +- tests/test/trecreg.pp | 69 ++++++++++++++ 14 files changed, 396 insertions(+), 31 deletions(-) create mode 100644 tests/test/trecreg.pp diff --git a/.gitattributes b/.gitattributes index 08fbe11724..298afa9c86 100644 --- a/.gitattributes +++ b/.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 diff --git a/compiler/cgbase.pas b/compiler/cgbase.pas index 01fe26633e..f2a0a2bdff 100644 --- a/compiler/cgbase.pas +++ b/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; diff --git a/compiler/cgobj.pas b/compiler/cgobj.pas index d7a79e16f3..eb0e685071 100644 --- a/compiler/cgobj.pas +++ b/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; diff --git a/compiler/cgutils.pas b/compiler/cgutils.pas index e485ca4d4c..26b3206a2d 100644 --- a/compiler/cgutils.pas +++ b/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; diff --git a/compiler/globtype.pas b/compiler/globtype.pas index 6d0f778368..03ad58ecbf 100644 --- a/compiler/globtype.pas +++ b/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; diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas index 2443b1073d..005a87056a 100644 --- a/compiler/htypechk.pas +++ b/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); diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas index 8cc5c19139..4b00094bc3 100644 --- a/compiler/ncgcal.pas +++ b/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 } diff --git a/compiler/ncgld.pas b/compiler/ncgld.pas index ee2708de7a..94b7df066f 100644 --- a/compiler/ncgld.pas +++ b/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); diff --git a/compiler/ncgmem.pas b/compiler/ncgmem.pas index 6673439ca8..27e1f94d70 100644 --- a/compiler/ncgmem.pas +++ b/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; diff --git a/compiler/ncgutil.pas b/compiler/ncgutil.pas index 1180b71fa6..7da4769824 100644 --- a/compiler/ncgutil.pas +++ b/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 diff --git a/compiler/nmem.pas b/compiler/nmem.pas index 922f87124b..d2310b74a0 100644 --- a/compiler/nmem.pas +++ b/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; diff --git a/compiler/symdef.pas b/compiler/symdef.pas index 4c435554be..003390635e 100644 --- a/compiler/symdef.pas +++ b/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; diff --git a/compiler/symsym.pas b/compiler/symsym.pas index 08c722ca11..2277dbce69 100644 --- a/compiler/symsym.pas +++ b/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; diff --git a/tests/test/trecreg.pp b/tests/test/trecreg.pp new file mode 100644 index 0000000000..a22b6093ee --- /dev/null +++ b/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.