Apple-2gs-SW/ORCA-C
1
0
Fork 0
mirror of https://github.com/byteworksinc/ORCA-C.git synced 2024-06-10 22:29:27 +00:00
Code Issues Projects Releases Wiki Activity

Implement the _Bool type from C99.

Browse Source
This commit is contained in:
Stephen Heumann 2021-01-25 21:22:58 -06:00
parent 83a1a7ad88
commit 52132db18a
4 changed files with 85 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CCommon.pas
View File

@ -157,7 +157,7 @@ type
cTypeEnum = (ctChar, ctSChar, ctUChar, ctShort, ctUShort, ctInt, ctUInt, cTypeEnum = (ctChar, ctSChar, ctUChar, ctShort, ctUShort, ctInt, ctUInt,
ctLong, ctULong, ctFloat, ctDouble, ctLongDouble, ctComp, ctLong, ctULong, ctFloat, ctDouble, ctLongDouble, ctComp,
ctVoid, ctInt32, ctUInt32); ctVoid, ctInt32, ctUInt32, ctBool);
{tokens} {tokens}
{------} {------}

79
Expression.pas
View File

@ -489,8 +489,21 @@ else if kind2 in
baseType2 := t2^.baseType; baseType2 := t2^.baseType;
if baseType2 in [cgString,cgVoid] then if baseType2 in [cgString,cgVoid] then
Error(47) Error(47)
else if genCode then else if genCode then begin
Gen2(pc_cnv, ord(baseType2), ord(baseType1)); if t1^.cType = ctBool then begin
expressionType := t2;
CompareToZero(pc_neq);
end {if}
else
Gen2(pc_cnv, ord(baseType2), ord(baseType1));
end {else if}
end {else if}
else if (t1^.cType = ctBool)
and (kind2 in [pointerType,arrayType]) then begin
if genCode then begin
expressionType := t2;
CompareToZero(pc_neq);
end {if}
end {else if} end {else if}
else else
Error(47); Error(47);
@ -1296,7 +1309,10 @@ var
if baseType in [cgByte,cgWord] then begin if baseType in [cgByte,cgWord] then begin
op^.token.kind := intConst; op^.token.kind := intConst;
op^.token.class := intConstant; op^.token.class := intConstant;
op^.token.ival := long(op1).lsw; if tp^.cType = ctBool then
op^.token.ival := ord(rop1 <> 0.0)
else
op^.token.ival := long(op1).lsw;
if baseType = cgByte then if baseType = cgByte then
with op^.token do begin with op^.token do begin
ival := ival & $00FF; ival := ival & $00FF;
@ -1847,7 +1863,10 @@ var
et,rt: baseTypeEnum; {work variables} et,rt: baseTypeEnum; {work variables}
begin {Cast} begin {Cast}
if (tp^.kind = scalarType) and (expressionType^.kind = scalarType) then begin if (tp^.kind = scalarType) and (tp^.cType = ctBool) then begin
CompareToZero(pc_neq);
end {if}
else if (tp^.kind = scalarType) and (expressionType^.kind = scalarType) then begin
rt := tp^.baseType; rt := tp^.baseType;
et := expressionType^.baseType; et := expressionType^.baseType;
if rt <> et then if rt <> et then
@ -1963,7 +1982,8 @@ if tree^.token.class = identifier then begin
bitDisp := ip^.bitDisp; bitDisp := ip^.bitDisp;
bitSize := ip^.bitSize; bitSize := ip^.bitSize;
isBitField := (bitSize+bitDisp) <> 0; isBitField := (bitSize+bitDisp) <> 0;
unsigned := ip^.itype^.baseType in [cgUByte,cgUWord,cgULong]; unsigned := (ip^.itype^.baseType in [cgUByte,cgUWord,cgULong])
or (ip^.itype^.cType = ctBool);
goto 1; goto 1;
end; {if} end; {if}
ip := ip^.next; ip := ip^.next;
@ -2306,6 +2326,10 @@ var
Gen0(pc_adi) Gen0(pc_adi)
else else
Gen0(pc_sbi); Gen0(pc_sbi);
if expressionType^.cType = ctBool then begin
CompareToZero(pc_neq);
expressionType := boolPtr;
end {if}
end; end;
cgLong,cgULong: begin cgLong,cgULong: begin
@ -2357,10 +2381,16 @@ var
if iType^.kind = scalarType then begin if iType^.kind = scalarType then begin
iSize := 1; iSize := 1;
baseType := iType^.baseType; baseType := iType^.baseType;
if baseType in [cgReal,cgDouble,cgComp,cgExtended] then begin if (baseType in [cgReal,cgDouble,cgComp,cgExtended])
or (iType^.cType = ctBool) then begin
{do real inc or dec} {do real or bool inc or dec}
LoadScalar(tree^.id); {load the value} LoadScalar(tree^.id); {load the value}
if pc_l in [pc_lli,pc_lld] then
if iType^.cType = ctBool then begin
t1 := GetTemp(cgWordSize);
Gen2t(pc_cop, t1, 0, cgWord);
end; {if}
tp := baseType; tp := baseType;
expressionType := iType; expressionType := iType;
IncOrDec(pc_l in [pc_lli,pc_lil]); {do the ++ or --} IncOrDec(pc_l in [pc_lli,pc_lil]); {do the ++ or --}
@ -2372,11 +2402,21 @@ var
otherwise: ; otherwise: ;
end; {case} end; {case}
{correct the value for postfix ops} {correct the value for postfix ops}
if pc_l in [pc_lli,pc_lld] then if pc_l in [pc_lli,pc_lld] then
IncOrDec(pc_l = pc_lld); if iType^.cType = ctBool then begin
expressionType := doublePtr; Gen0t(pc_pop, cgWord);
Gen2t(pc_lod, t1, 0, cgWord);
Gen0t(pc_bno, cgWord);
FreeTemp(t1, cgWordSize);
end {if}
else
IncOrDec(pc_l = pc_lld);
if iType^.cType = ctBool then
expressionType := boolPtr
else
expressionType := doublePtr;
goto 1; goto 1;
end; {if} end; {else if}
end {if} end {if}
else {if iType^.kind in [pointerType,arrayType] then} begin else {if iType^.kind in [pointerType,arrayType] then} begin
lSize := iType^.pType^.size; lSize := iType^.pType^.size;
@ -2435,7 +2475,8 @@ var
tp := UsualUnaryConversions tp := UsualUnaryConversions
else else
tp := UsualUnaryConversions; tp := UsualUnaryConversions;
if tp in [cgByte,cgUByte,cgWord,cgUword] then if (tp in [cgByte,cgUByte,cgWord,cgUword])
and (expressionType^.cType <> ctBool) then
Gen0t(pc_i, tp) {do indirect inc/dec} Gen0t(pc_i, tp) {do indirect inc/dec}
else begin else begin
t1 := GetTemp(cgLongSize); t1 := GetTemp(cgLongSize);
@ -2444,6 +2485,11 @@ var
Gen2t(pc_lod, t1, 0, cgULong); Gen2t(pc_lod, t1, 0, cgULong);
FreeTemp(t1, cgLongSize); FreeTemp(t1, cgLongSize);
Gen1t(pc_ind, 0, tp); {load the value} Gen1t(pc_ind, 0, tp); {load the value}
if pc_l in [pc_lli,pc_lld] then
if expressionType^.cType = ctBool then begin
t1 := GetTemp(cgWordSize);
Gen2t(pc_cop, t1, 0, cgWord);
end; {if}
IncOrDec(pc_l in [pc_lli,pc_lil]); {do the ++ or --} IncOrDec(pc_l in [pc_lli,pc_lil]); {do the ++ or --}
if isBitField then {copy the value} if isBitField then {copy the value}
if bitDisp+bitSize > 16 then begin if bitDisp+bitSize > 16 then begin
@ -2459,7 +2505,14 @@ var
Gen0t(pc_bno, tp); Gen0t(pc_bno, tp);
end; {else} end; {else}
if pc_l in [pc_lli,pc_lld] then {correct the value for postfix ops} if pc_l in [pc_lli,pc_lld] then {correct the value for postfix ops}
IncOrDec(pc_l = pc_lld); if expressionType^.cType = ctBool then begin
Gen0t(pc_pop, cgWord);
Gen2t(pc_lod, t1, 0, cgWord);
Gen0t(pc_bno, cgWord);
FreeTemp(t1, cgWordSize);
end {if}
else
IncOrDec(pc_l = pc_lld);
end; {else} end; {else}
end; {else} end; {else}
1: 1:

6
Parser.pas
View File

@ -2694,7 +2694,8 @@ var
if (tPtr^.kind <> scalarType) if (tPtr^.kind <> scalarType)
or not (tPtr^.baseType in or not (tPtr^.baseType in
[cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong]) [cgByte,cgUByte,cgWord,cgUWord,cgLong,cgULong])
or (expressionValue > tPtr^.size*8) then or (expressionValue > tPtr^.size*8)
or ((expressionValue > 1) and (tPtr^.cType = ctBool)) then
Error(115); Error(115);
if alignmentSpecified then if alignmentSpecified then
Error(142); Error(142);
@ -2813,8 +2814,7 @@ var
else if typeSpecifiers = [compsy] then else if typeSpecifiers = [compsy] then
myTypeSpec := compPtr myTypeSpec := compPtr
else if typeSpecifiers = [_Boolsy] then begin else if typeSpecifiers = [_Boolsy] then begin
Error(135); myTypeSpec := boolPtr;
myTypeSpec := intPtr;
end {else if} end {else if}
else else
UnexpectedTokenError(expectedNext); UnexpectedTokenError(expectedNext);

17
Symbol.pas
View File

@ -40,6 +40,7 @@
{ doublePtr - pointer to the base type for double } { doublePtr - pointer to the base type for double }
{ compPtr - pointer to the base type for comp } { compPtr - pointer to the base type for comp }
{ extendedPtr - pointer to the base type for extended } { extendedPtr - pointer to the base type for extended }
{ boolPtr - pointer to the base type for _Bool }
{ voidPtr - pointer to the base type for void } { voidPtr - pointer to the base type for void }
{ voidPtrPtr - typeless pointer, for some type casting } { voidPtrPtr - typeless pointer, for some type casting }
{ stringTypePtr - pointer to the base type for string } { stringTypePtr - pointer to the base type for string }
@ -77,7 +78,7 @@ var
{base types} {base types}
charPtr,sCharPtr,uCharPtr,shortPtr,uShortPtr,intPtr,uIntPtr,int32Ptr, charPtr,sCharPtr,uCharPtr,shortPtr,uShortPtr,intPtr,uIntPtr,int32Ptr,
uInt32Ptr,longPtr,uLongPtr,floatPtr,doublePtr,compPtr,extendedPtr, uInt32Ptr,longPtr,uLongPtr,floatPtr,doublePtr,compPtr,extendedPtr,
stringTypePtr,voidPtr,voidPtrPtr,defaultStruct: typePtr; boolPtr,stringTypePtr,voidPtr,voidPtrPtr,defaultStruct: typePtr;
{---------------------------------------------------------------} {---------------------------------------------------------------}
@ -967,7 +968,10 @@ var
case tp^.baseType of case tp^.baseType of
cgByte: val := $40; cgByte: val := $40;
cgUByte: val := $00; cgUByte: val := $00;
cgWord: val := $01; cgWord: if tp^.cType = ctBool then
val := $09
else
val := $01;
cgUWord: val := $41; cgUWord: val := $41;
cgLong: val := $02; cgLong: val := $02;
cgULong: val := $42; cgULong: val := $42;
@ -1338,6 +1342,15 @@ with extendedPtr^ do begin
baseType := cgExtended; baseType := cgExtended;
cType := ctLongDouble; cType := ctLongDouble;
end; {with} end; {with}
new(boolPtr); {_Bool}
with boolPtr^ do begin
size := cgWordSize;
saveDisp := 0;
isConstant := false;
kind := scalarType;
baseType := cgWord;
cType := ctBool;
end; {with}
new(stringTypePtr); {string constant type} new(stringTypePtr); {string constant type}
with stringTypePtr^ do begin with stringTypePtr^ do begin
size := 0; size := 0;