Apple-2gs-SW
/
ORCA-C
mirror of https://github.com/byteworksinc/ORCA-C.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity

Fix so the type of shift expressions depends only on the (promoted) type of their left operand. 

This is as required by the C standards: the type of the right operand should not affect the result type.

The following program demonstrates problems with the old behavior:

#include <stdio.h>

int main(void)
{
    unsigned long ul;
    long l;
    unsigned u;
    int i;

    ul = 0x8000 << 1L; /* should be 0 */
    printf("%lx\n", ul);

    l = -1 >> 1U; /* should be -1 */
    printf("%ld\n", l);

    u = 0xFF10;
    l = 8;
    ul = u << l; /* should be 0x1000 */
    printf("%lx\n", ul);

    l = -4;
    ul = 1;
    l = l >> ul; /* should be -2 */
    printf("%ld\n", l);
}
This commit is contained in:
Stephen Heumann 2016-11-07 18:57:40 -06:00
parent 5618b2810e
commit af48935d43
1 changed files with 26 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
Expression.pas
View File

@ -1061,11 +1061,17 @@ var
op1 := ord(op1 >= op2);
ekind := intconst;
end;
ltltop : op1 := op1 << op2; {<<}
gtgtop : if unsigned1 then {>>}
ltltop : begin {<<}
op1 := op1 << op2;
ekind := kindLeft;
end;
gtgtop : begin {>>}
if unsigned1 then
op1 := lshr(op1,op2)
else
op1 := op1 >> op2;
ekind := kindLeft;
end;
plusch : op1 := op1 + op2; {+}
minusch : op1 := op1 - op2; {-}
asteriskch : if unsigned then {*}
@ -3199,9 +3205,16 @@ case tree^.token.kind of
ltltop: begin {<<}
GenerateCode(tree^.left);
et := UsualUnaryConversions;
lType := expressionType;
GenerateCode(tree^.right);
case UsualBinaryConversions(lType) of
if (expressionType^.kind <> scalarType)
or not (expressionType^.baseType in
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong]) then
error(66);
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:
@ -3209,13 +3222,21 @@ case tree^.token.kind of
otherwise:
error(66);
end; {case}
expressionType := lType;
end; {case ltltop}
gtgtop: begin {>>}
GenerateCode(tree^.left);
et := UsualUnaryConversions;
lType := expressionType;
GenerateCode(tree^.right);
case UsualBinaryConversions(lType) of
if (expressionType^.kind <> scalarType)
or not (expressionType^.baseType in
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong]) then
error(66);
if expressionType^.baseType <> et then
Gen2(pc_cnv, ord(expressionType^.baseType), ord(et));
case et of
cgByte,cgWord:
Gen0(pc_shr);
cgUByte,cgUWord:
@ -3227,6 +3248,7 @@ case tree^.token.kind of
otherwise:
error(66);
end; {case}
expressionType := lType;
end; {case gtgtop}
plusch: begin {+}