Implement 64-bit shifts.

This commit is contained in:
Stephen Heumann 2021-02-12 15:06:15 -06:00
parent 00d72f04d3
commit 8faafcc7c8
6 changed files with 67 additions and 16 deletions

View File

@ -576,25 +576,32 @@
{ }
{ pc_shl - shift left }
{ pc_sll - shift left long }
{ pc_slq - shift left long long }
{ }
{ Gen0(pc_shl) cgByte,cgUByte,cgWord,cgUWord }
{ Gen0(pc_sll) cgLong,cgULong }
{ Gen0(pc_slq) cgQuad,cgUQuad (tos-1) / cgWord (tos) }
{ }
{ The value at tos-1 is shifted left by the number of bits }
{ specified by tos. The result is an integer, which replaces }
{ the operands on the stack. The right bit positions are }
{ filled with zeros. }
{ filled with zeros. For pc_slq, only the value at tos-1 is }
{ cgQuad/cgUQuad; the shift count at tos is cgWord or cgUWord. }
{ }
{ }
{ pc_shr - shift right }
{ pc_usr - unsigned shift right }
{ pc_slr - long shift right }
{ pc_vsr - unsigned long shift right }
{ pc_sqr - long long shift right }
{ pc_wsr - unsigned long long shift right }
{ }
{ Gen0(pc_shr) cgByte,cgWord }
{ Gen0(pc_usr) cgUByte,cgUWord }
{ Gen0(pc_slr) cgLong }
{ Gen0(pc_vsr) cgULong }
{ Gen0(pc_sqr) cgQuad (tos-1) / cgWord (tos) }
{ Gen0(pc_wsr) cgUQuad (tos-1) / cgWord (tos) }
{ }
{ The value at tos-1 is shifted right by the number of bits }
{ specified by tos. The result is an integer, which replaces }
@ -604,7 +611,9 @@
{ }
{ Pc_usr is the unsigned form. The operation is the same, }
{ except that the leftmost bit is replaced with a zero. }
{ Pc_vsr is used for unsigned long operations. }
{ Pc_vsr is used for unsigned long operations, and pc_wsr is }
{ used for unsigned long long operations. }
{ }
{ }
{ pc_stk - stack an operand }
{ }

View File

@ -230,7 +230,7 @@ type
pc_gli,pc_gdl,pc_gld,pc_cpi,pc_tri,pc_lbu,pc_lbf,pc_sbf,pc_cbf,dc_cns,
dc_prm,pc_nat,pc_bno,pc_nop,pc_psh,pc_ili,pc_iil,pc_ild,pc_idl,
pc_bqr,pc_bqx,pc_baq,pc_bnq,pc_ngq,pc_adq,pc_sbq,pc_mpq,pc_umq,pc_dvq,
pc_udq,pc_mdq,pc_uqm);
pc_udq,pc_mdq,pc_uqm,pc_slq,pc_sqr,pc_wsr);
{intermediate code}
{-----------------}

View File

@ -2385,9 +2385,12 @@ case op^.opcode of
TypeOf := cgULong;
pc_bnq, pc_ngq, pc_bqr, pc_bqx, pc_baq, pc_adq, pc_sbq, pc_mpq,
pc_umq, pc_dvq, pc_udq, pc_mdq, pc_uqm:
pc_dvq, pc_mdq, pc_slq, pc_sqr:
TypeOf := cgQuad;
pc_umq, pc_udq, pc_uqm, pc_wsr:
TypeOf := cgUQuad;
pc_ngr, pc_adr, pc_dvr, pc_mpr, pc_sbr:
TypeOf := cgExtended;
@ -5063,7 +5066,8 @@ case code^.opcode of
pc_ulm, pc_mpi, pc_umi, pc_mpl, pc_uml, pc_mpr, pc_psh, pc_sbi,
pc_sbl, pc_sbr, pc_shl, pc_sll, pc_shr, pc_usr, pc_slr, pc_vsr,
pc_tri, pc_sbf, pc_sto, pc_cui, pc_bqr, pc_bqx, pc_baq, pc_adq,
pc_sbq, pc_mpq, pc_umq, pc_dvq, pc_udq, pc_mdq, pc_uqm:
pc_sbq, pc_mpq, pc_umq, pc_dvq, pc_udq, pc_mdq, pc_uqm, pc_slq,
pc_sqr, pc_wsr:
begin
code^.right := Pop;
code^.left := Pop;

View File

@ -3090,10 +3090,17 @@ case tree^.token.kind of
[cgReal,cgDouble,cgComp,cgExtended,cgVoid] then
Error(66);
et := UsualUnaryConversions;
if et <> Unary(ltype^.baseType) then begin
Gen2(pc_cnv, et, ord(Unary(ltype^.baseType)));
if ltype^.baseType in [cgQuad,cgUQuad] then begin
if not (et in [cgWord,cgUWord]) then begin
Gen2(pc_cnv, et, ord(cgWord));
end; {if}
expressionType := lType;
end; {if}
end {if}
else
if et <> Unary(ltype^.baseType) then begin
Gen2(pc_cnv, et, ord(Unary(ltype^.baseType)));
expressionType := lType;
end; {if}
end; {if}
if kind <> pointerType then
et := UsualBinaryConversions(lType)
@ -3190,6 +3197,8 @@ case tree^.token.kind of
Gen0(pc_shl)
else if et in [cgLong,cgULong] then
Gen0(pc_sll)
else if et in [cgQuad,cgUQuad] then
Gen0(pc_slq)
else
Error(66);
@ -3202,6 +3211,10 @@ case tree^.token.kind of
Gen0(pc_slr)
else if et = cgULong then
Gen0(pc_vsr)
else if et = cgQuad then
Gen0(pc_sqr)
else if et = cgUQuad then
Gen0(pc_wsr)
else
Error(66);
@ -3399,15 +3412,22 @@ case tree^.token.kind of
GenerateCode(tree^.right);
if (expressionType^.kind <> scalarType)
or not (expressionType^.baseType in
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong]) then
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad]) then
error(66);
if expressionType^.baseType <> et then
Gen2(pc_cnv, ord(expressionType^.baseType), ord(et));
if et in [cgQuad,cgUQuad] then begin
if not (expressionType^.baseType in [cgWord,cgUWord]) then
Gen2(pc_cnv, ord(expressionType^.baseType), ord(cgWord));
end {if}
else
if expressionType^.baseType <> et then
Gen2(pc_cnv, ord(expressionType^.baseType), ord(et));
case et of
cgByte,cgUByte,cgWord,cgUWord:
Gen0(pc_shl);
cgLong,cgULong:
Gen0(pc_sll);
cgQuad,cgUQuad:
Gen0(pc_slq);
otherwise:
error(66);
end; {case}
@ -3425,10 +3445,15 @@ case tree^.token.kind of
GenerateCode(tree^.right);
if (expressionType^.kind <> scalarType)
or not (expressionType^.baseType in
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong]) then
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong,cgQuad,cgUQuad]) then
error(66);
if expressionType^.baseType <> et then
Gen2(pc_cnv, ord(expressionType^.baseType), ord(et));
if et in [cgQuad,cgUQuad] then begin
if not (expressionType^.baseType in [cgWord,cgUWord]) then
Gen2(pc_cnv, ord(expressionType^.baseType), ord(cgWord));
end {if}
else
if expressionType^.baseType <> et then
Gen2(pc_cnv, ord(expressionType^.baseType), ord(et));
case et of
cgByte,cgWord:
Gen0(pc_shr);
@ -3438,6 +3463,10 @@ case tree^.token.kind of
Gen0(pc_slr);
cgULong:
Gen0(pc_vsr);
cgQuad:
Gen0(pc_sqr);
cgUQuad:
Gen0(pc_wsr);
otherwise:
error(66);
end; {case}

10
Gen.pas
View File

@ -4575,6 +4575,12 @@ procedure GenTree {op: icptr};
GenImplied(m_tcs);
end;
pc_slq: GenCall(85);
pc_sqr: GenCall(86);
pc_wsr: GenCall(87);
otherwise: Error(cge1);
end; {case}
end; {GenBinQuad}
@ -6263,8 +6269,8 @@ case op^.opcode of
pc_and,pc_bnd,pc_bor,pc_bxr,pc_ior: GenLogic(op);
pc_blr,pc_blx,pc_bal,pc_dvl,pc_mdl,pc_mpl,pc_sll,pc_slr,pc_udl,pc_ulm,
pc_uml,pc_vsr: GenBinLong(op);
pc_bqr,pc_bqx,pc_baq,pc_mpq,pc_umq,pc_dvq,pc_udq,pc_mdq,pc_uqm:
GenBinQuad(op);
pc_bqr,pc_bqx,pc_baq,pc_mpq,pc_umq,pc_dvq,pc_udq,pc_mdq,pc_uqm,pc_slq,
pc_sqr,pc_wsr: GenBinQuad(op);
pc_bnl,pc_ngl: GenUnaryLong(op);
pc_bnq,pc_ngq: GenUnaryQuad(op);
pc_bno: GenBno(op);

View File

@ -2039,6 +2039,9 @@ case callNum of
82: sp := @'~UDIV8';
83: sp := @'~CNVLONGLONGREAL';
84: sp := @'~CNVULONGLONGREAL';
85: sp := @'~SHL8';
86: sp := @'~ASHR8';
87: sp := @'~LSHR8';
otherwise:
Error(cge1);
end; {case}