diff options
| -rw-r--r-- | compiler/compinnr.inc | 1 | ||||
| -rw-r--r-- | compiler/ncginl.pas | 11 | ||||
| -rw-r--r-- | compiler/ninl.pas | 11 | ||||
| -rw-r--r-- | compiler/options.pas | 5 | ||||
| -rw-r--r-- | compiler/x86/nx86inl.pas | 24 | ||||
| -rw-r--r-- | rtl/inc/generic.inc | 10 | ||||
| -rw-r--r-- | rtl/inc/innr.inc | 1 | ||||
| -rw-r--r-- | rtl/inc/systemh.inc | 36 | ||||
| -rw-r--r-- | tests/test/tpopcnt1.pp | 28 |
9 files changed, 120 insertions, 7 deletions
diff --git a/compiler/compinnr.inc b/compiler/compinnr.inc index 4c899dce03..d1cdc124aa 100644 --- a/compiler/compinnr.inc +++ b/compiler/compinnr.inc @@ -86,6 +86,7 @@ const in_default_x = 76; in_box_x = 77; { managed platforms: wrap in class instance } in_unbox_x_y = 78; { manage platforms: extract from class instance } + in_popcnt_x = 79; { Internal constant functions } in_const_sqr = 100; diff --git a/compiler/ncginl.pas b/compiler/ncginl.pas index c233ef7780..06899d684f 100644 --- a/compiler/ncginl.pas +++ b/compiler/ncginl.pas @@ -58,6 +58,7 @@ interface procedure second_new; virtual; procedure second_setlength; virtual; abstract; procedure second_box; virtual; abstract; + procedure second_popcnt; virtual; end; implementation @@ -177,6 +178,8 @@ implementation second_setlength; in_box_x: second_box; + in_popcnt_x: + second_popcnt; else internalerror(9); end; end; @@ -734,6 +737,12 @@ implementation end; + procedure tcginlinenode.second_popcnt; + begin + internalerror(2012082601); + end; + + begin cinlinenode:=tcginlinenode; -end. +end. s diff --git a/compiler/ninl.pas b/compiler/ninl.pas index fabf6806f2..fa2d881fd8 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -3046,6 +3046,14 @@ implementation resultdef:=u32inttype end; + in_popcnt_x: + begin + set_varstate(left,vs_read,[vsf_must_be_valid]); + if not is_integer(left.resultdef) then + CGMessage1(type_e_integer_expr_expected,left.resultdef.typename); + resultdef:=left.resultdef; + end; + in_objc_selector_x: begin result:=cobjcselectornode.create(left); @@ -3467,7 +3475,8 @@ implementation in_sar_x, in_sar_x_y, in_bsf_x, - in_bsr_x: + in_bsr_x, + in_popcnt_x: expectloc:=LOC_REGISTER; in_new_x: result:=first_new; diff --git a/compiler/options.pas b/compiler/options.pas index f7f29f2dec..b7563961ad 100644 --- a/compiler/options.pas +++ b/compiler/options.pas @@ -2781,6 +2781,11 @@ begin def_system_macro('FPC_HAS_INTERNAL_BSX'); {$endif} +{ inline bsf/bsr implementation } +{$if defined(x86) or defined(x86_64)} + def_system_macro('FPC_HAS_INTERNAL_POPCNT'); +{$endif} + {$ifdef powerpc64} def_system_macro('FPC_HAS_LWSYNC'); {$endif} diff --git a/compiler/x86/nx86inl.pas b/compiler/x86/nx86inl.pas index b08ca6d007..8bc07edbf5 100644 --- a/compiler/x86/nx86inl.pas +++ b/compiler/x86/nx86inl.pas @@ -60,6 +60,7 @@ interface procedure second_prefetch;override; procedure second_abs_long;override; + procedure second_popcnt;override; private procedure load_fpu_location; end; @@ -542,4 +543,27 @@ implementation end; + procedure tx86inlinenode.second_popcnt; + var + opsize: tcgsize; + begin + secondpass(left); + + opsize:=tcgsize2unsigned[left.location.size]; + + { no 8 Bit popcont } + if opsize=OS_8 then + opsize:=OS_16; + + if not(left.location.loc in [LOC_REGISTER,LOC_CREGISTER,LOC_REFERENCE,LOC_CREFERENCE]) or + (left.location.size<>opsize) then + hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,hlcg.tcgsize2orddef(opsize),true); + + location_reset(location,LOC_REGISTER,opsize); + location.register:=cg.getintregister(current_asmdata.CurrAsmList,opsize); + if left.location.loc in [LOC_REGISTER,LOC_CREGISTER] then + current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_POPCNT,TCGSize2OpSize[opsize],left.location.register,location.register)) + else + current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_POPCNT,TCGSize2OpSize[opsize],left.location.reference,location.register)); + end; end. diff --git a/rtl/inc/generic.inc b/rtl/inc/generic.inc index 856ad35899..b0d194d75e 100644 --- a/rtl/inc/generic.inc +++ b/rtl/inc/generic.inc @@ -2444,3 +2444,13 @@ function BsrQWord(Const AValue : QWord): cardinal; end; {$endif} {$endif} + +{$ifndef FPC_HAS_INTERNAL_POPCNT_QWORD} +{$ifndef FPC_SYSTEM_HAS_POPCNT_QWORD} +function PopCnt(Const AValue : QWord): QWord; + begin + Result:=PopCnt(lo(AValue))+PopCnt(hi(AValue)) + end; +{$endif} +{$endif} + diff --git a/rtl/inc/innr.inc b/rtl/inc/innr.inc index c9324dcc57..dd655b4d6f 100644 --- a/rtl/inc/innr.inc +++ b/rtl/inc/innr.inc @@ -87,6 +87,7 @@ const fpc_in_default_x = 76; fpc_in_box_x = 77; { managed platforms: wrap in class instance } fpc_in_unbox_x_y = 78; { manage platforms: extract from class instance } + fpc_in_popcnt_x = 79; { Internal constant functions } fpc_in_const_sqr = 100; diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc index a4715dd2a9..0ba1e9124f 100644 --- a/rtl/inc/systemh.inc +++ b/rtl/inc/systemh.inc @@ -860,6 +860,42 @@ function BsfQWord(Const AValue : QWord): cardinal;{$ifdef SYSTEMINLINE}inline;{$ function BsrQWord(Const AValue : QWord): cardinal;{$ifdef SYSTEMINLINE}inline;{$endif} {$endif FPC_HAS_INTERNAL_BSF_QWORD} +{$ifdef FPC_HAS_INTERNAL_POPCNT} +{$if defined(cpui386) or defined(cpux86_64)} +{$define FPC_HAS_INTERNAL_POPCNT_BYTE} +{$define FPC_HAS_INTERNAL_POPCNT_WORD} +{$define FPC_HAS_INTERNAL_POPCNT_DWORD} +{$endif} +{$if defined(cpux86_64)} +{$define FPC_HAS_INTERNAL_POPCNT_QWORD} +{$endif} +{$endif} + + +{$ifdef FPC_HAS_INTERNAL_POPCNT_BYTE} +function PopCnt(Const AValue: Byte): Byte;[internproc:fpc_in_popcnt_x]; +{$else} +function PopCnt(Const AValue: Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif} +{$endif FPC_HAS_INTERNAL_POPCNT_BYTE} + +{$ifdef FPC_HAS_INTERNAL_POPCNT_WORD} +function PopCnt(Const AValue: Word): Word;[internproc:fpc_in_popcnt_x]; +{$else} +function PopCnt(Const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif} +{$endif FPC_HAS_INTERNAL_POPCNT_WORD} + +{$ifdef FPC_HAS_INTERNAL_POPCNT_DWORD} +function PopCnt(Const AValue : DWord): DWord;[internproc:fpc_in_popcnt_x]; +{$else} +function PopCnt(Const AValue : DWord): DWord; +{$endif FPC_HAS_INTERNAL_POPCNT_DWORD} + +{$ifdef FPC_HAS_INTERNAL_POPCNT_QWORD} +function PopCnt(Const AValue : QWord): QWord;[internproc:fpc_in_popcnt_x]; +{$else} +function PopCnt(Const AValue : QWord): QWord; +{$endif FPC_HAS_INTERNAL_POPCNT_QWORD} + {$ifndef FPUNONE} { float math routines } {$I mathh.inc} diff --git a/tests/test/tpopcnt1.pp b/tests/test/tpopcnt1.pp index 993847865d..ad3a8aa333 100644 --- a/tests/test/tpopcnt1.pp +++ b/tests/test/tpopcnt1.pp @@ -5,7 +5,7 @@ var i : integer; d : dword; li : longint; - q : qword + q : qword; i64 : int64; begin @@ -23,6 +23,9 @@ begin if popcnt(b)<>1 then halt(1); + writeln('popcnt(<byte>); passed'); + +{ si:=$54; if popcnt(si)<>3 then halt(1); @@ -34,6 +37,7 @@ begin si:=$20; if popcnt(si)<>1 then halt(1); +} { 16 Bit } @@ -49,6 +53,9 @@ begin if popcnt(w)<>2 then halt(1); + writeln('popcnt(<word>); passed'); + +{ i:=$5454; if popcnt(i)<>6 then halt(1); @@ -60,11 +67,12 @@ begin i:=$2020; if popcnt(i)<>2 then halt(1); +} { 32 Bit } d:=$a4a4a4a4; - if popcnt(w)<>12 then + if popcnt(d)<>12 then halt(1); d:=$0; @@ -75,6 +83,9 @@ begin if popcnt(d)<>4 then halt(1); + writeln('popcnt(<dword>); passed'); + +{ li:=$54545454; if popcnt(li)<>12 then halt(1); @@ -86,11 +97,11 @@ begin li:=$20402080; if popcnt(li)<>4 then halt(1); - +} { 64 Bit } - q:=$a4a4a4a4a4a4a4a4; + q:=qword($a4a4a4a4a4a4a4a4); if popcnt(q)<>24 then halt(1); @@ -102,6 +113,13 @@ begin if popcnt(q)<>8 then halt(1); + q:=qword($a4a4a4a400000000); + if popcnt(q)<>12 then + halt(1); + + writeln('popcnt(<qword>); passed'); + +{ i64:=$5454545454545454; if popcnt(i64)<>24 then halt(1); @@ -113,7 +131,7 @@ begin i64:=$2040208020402080; if popcnt(li)<>8 then halt(1); - +} writeln('ok'); end. |