mirror of
https://github.com/byteworksinc/ORCA-C.git
synced 2024-05-31 18:41:31 +00:00
Implement the standard pragmas, in particular FENV_ACCESS.
The FENV_ACCESS pragma is now implemented. It causes floating-point operations to be evaluated at run time to the maximum extent possible, so that they can affect and be affected by the floating-point environment. It also disables optimizations that might evaluate floating-point operations at compile time or move them around calls to the <fenv.h> functions. The FP_CONTRACT and CX_LIMITED_RANGE pragmas are also recognized, but they have no effect. (FP_CONTRACT relates to "contracting" floating-point expressions in a way that ORCA/C does not do, and CX_LIMITED_RANGE relates to complex arithmetic, which ORCA/C does not support.)
This commit is contained in:
parent
c0727315e0
commit
f9f79983f8
|
@ -525,6 +525,8 @@ var
|
||||||
lintIsError: boolean; {treat lint messages as errors?}
|
lintIsError: boolean; {treat lint messages as errors?}
|
||||||
fIsNoreturn: boolean; {is the current function _Noreturn?}
|
fIsNoreturn: boolean; {is the current function _Noreturn?}
|
||||||
doingMain: boolean; {are we processing the main function?}
|
doingMain: boolean; {are we processing the main function?}
|
||||||
|
fenvAccess: boolean; {is the FENV_ACCESS pragma on?}
|
||||||
|
fenvAccessInFunction: boolean; {was FENV_ACCESS on anywhere in current function?}
|
||||||
|
|
||||||
{syntactic classes of tokens}
|
{syntactic classes of tokens}
|
||||||
{---------------------------}
|
{---------------------------}
|
||||||
|
|
18
DAG.pas
18
DAG.pas
|
@ -5291,7 +5291,8 @@ var
|
||||||
|
|
||||||
|
|
||||||
begin {Generate}
|
begin {Generate}
|
||||||
if peepHole then {peephole optimization}
|
{peephole optimization}
|
||||||
|
if peepHole and not fenvAccessInFunction then
|
||||||
repeat
|
repeat
|
||||||
rescan := false;
|
rescan := false;
|
||||||
PeepHoleOptimization(DAGhead);
|
PeepHoleOptimization(DAGhead);
|
||||||
|
@ -5306,22 +5307,27 @@ var
|
||||||
BasicBlocks; {build the basic blocks}
|
BasicBlocks; {build the basic blocks}
|
||||||
if commonSubexpression or loopOptimizations then
|
if commonSubexpression or loopOptimizations then
|
||||||
if not volatile then
|
if not volatile then
|
||||||
FlagIndirectUses; {create a list of all indirect uses}
|
if not fenvAccessInFunction then
|
||||||
|
FlagIndirectUses; {create a list of all indirect uses}
|
||||||
if commonSubexpression then {common sub-expression removal}
|
if commonSubexpression then {common sub-expression removal}
|
||||||
if not volatile then
|
if not volatile then
|
||||||
CommonSubexpressionElimination;
|
if not fenvAccessInFunction then
|
||||||
|
CommonSubexpressionElimination;
|
||||||
if loopOptimizations then {loop optimizations}
|
if loopOptimizations then {loop optimizations}
|
||||||
if not volatile then
|
if not volatile then
|
||||||
DoLoopOptimization;
|
if not fenvAccessInFunction then
|
||||||
|
DoLoopOptimization;
|
||||||
{ if printSymbols then {debug}
|
{ if printSymbols then {debug}
|
||||||
{ PrintBlocks(@'DAG: ', DAGblocks); {debug}
|
{ PrintBlocks(@'DAG: ', DAGblocks); {debug}
|
||||||
if commonSubexpression or loopOptimizations then
|
if commonSubexpression or loopOptimizations then
|
||||||
if not volatile then
|
if not volatile then
|
||||||
DisposeOpList(c_ind); {dispose of indirect use list}
|
if not fenvAccessInFunction then
|
||||||
|
DisposeOpList(c_ind); {dispose of indirect use list}
|
||||||
Gen(DAGblocks); {generate native code}
|
Gen(DAGblocks); {generate native code}
|
||||||
if loopOptimizations then {dump and dynamic space}
|
if loopOptimizations then {dump and dynamic space}
|
||||||
if not volatile then
|
if not volatile then
|
||||||
DumpLoopLists;
|
if not fenvAccessInFunction then
|
||||||
|
DumpLoopLists;
|
||||||
DAGhead := nil; {reset the DAG pointers}
|
DAGhead := nil; {reset the DAG pointers}
|
||||||
end; {Generate}
|
end; {Generate}
|
||||||
|
|
||||||
|
|
|
@ -959,7 +959,7 @@ var
|
||||||
|
|
||||||
{ do an operation }
|
{ do an operation }
|
||||||
|
|
||||||
label 1,2,3;
|
label 1,2,3,4;
|
||||||
|
|
||||||
var
|
var
|
||||||
baseType: baseTypeEnum; {base type of value to cast}
|
baseType: baseTypeEnum; {base type of value to cast}
|
||||||
|
@ -1457,6 +1457,9 @@ var
|
||||||
if op^.left^.token.kind in [intconst,uintconst,longconst,ulongconst,
|
if op^.left^.token.kind in [intconst,uintconst,longconst,ulongconst,
|
||||||
longlongconst,ulonglongconst,extendedconst] then
|
longlongconst,ulonglongconst,extendedconst] then
|
||||||
begin
|
begin
|
||||||
|
if fenvAccess then
|
||||||
|
if kind in [normalExpression, autoInitializerExpression] then
|
||||||
|
goto 1;
|
||||||
ekind := extendedconst; {evaluate a constant operation}
|
ekind := extendedconst; {evaluate a constant operation}
|
||||||
rop1 := RealVal(op^.left^.token);
|
rop1 := RealVal(op^.left^.token);
|
||||||
rop2 := RealVal(op^.right^.token);
|
rop2 := RealVal(op^.right^.token);
|
||||||
|
@ -1569,6 +1572,11 @@ var
|
||||||
tp := tp^.dType;
|
tp := tp^.dType;
|
||||||
if tp^.kind = scalarType then begin
|
if tp^.kind = scalarType then begin
|
||||||
baseType := tp^.baseType;
|
baseType := tp^.baseType;
|
||||||
|
if fenvAccess then
|
||||||
|
if kind in [normalExpression, autoInitializerExpression] then
|
||||||
|
if (baseType in [cgReal,cgDouble,cgComp,cgExtended])
|
||||||
|
or (class = realConstant) then
|
||||||
|
goto 3;
|
||||||
if (baseType < cgString) or (baseType in [cgQuad,cgUQuad])
|
if (baseType < cgString) or (baseType in [cgQuad,cgUQuad])
|
||||||
then begin
|
then begin
|
||||||
if class = realConstant then begin
|
if class = realConstant then begin
|
||||||
|
@ -1713,6 +1721,9 @@ var
|
||||||
end; {else}
|
end; {else}
|
||||||
end {else if}
|
end {else if}
|
||||||
else if op^.left^.token.kind = extendedconst then begin
|
else if op^.left^.token.kind = extendedconst then begin
|
||||||
|
if fenvAccess then
|
||||||
|
if kind in [normalExpression, autoInitializerExpression] then
|
||||||
|
goto 4;
|
||||||
ekind := extendedconst; {evaluate a constant operation}
|
ekind := extendedconst; {evaluate a constant operation}
|
||||||
rop1 := RealVal(op^.left^.token);
|
rop1 := RealVal(op^.left^.token);
|
||||||
dispose(op^.left);
|
dispose(op^.left);
|
||||||
|
@ -1737,6 +1748,7 @@ var
|
||||||
end; {case}
|
end; {case}
|
||||||
end; {if}
|
end; {if}
|
||||||
end; {if}
|
end; {if}
|
||||||
|
4:
|
||||||
end;
|
end;
|
||||||
|
|
||||||
otherwise: Error(57);
|
otherwise: Error(57);
|
||||||
|
|
|
@ -18,7 +18,7 @@ uses CCommon, MM, Scanner, Symbol, CGI;
|
||||||
{$segment 'SCANNER'}
|
{$segment 'SCANNER'}
|
||||||
|
|
||||||
const
|
const
|
||||||
symFileVersion = 11; {version number of .sym file format}
|
symFileVersion = 12; {version number of .sym file format}
|
||||||
|
|
||||||
var
|
var
|
||||||
inhibitHeader: boolean; {should .sym includes be blocked?}
|
inhibitHeader: boolean; {should .sym includes be blocked?}
|
||||||
|
@ -888,6 +888,8 @@ procedure EndInclude {chPtr: ptr};
|
||||||
end;
|
end;
|
||||||
|
|
||||||
p_unix: WriteByte(ord(unix_1));
|
p_unix: WriteByte(ord(unix_1));
|
||||||
|
|
||||||
|
p_fenv_access: WriteByte(ord(fenvAccess));
|
||||||
|
|
||||||
end; {case}
|
end; {case}
|
||||||
end; {if}
|
end; {if}
|
||||||
|
@ -1545,6 +1547,8 @@ var
|
||||||
end;
|
end;
|
||||||
|
|
||||||
p_unix: unix_1 := boolean(ReadByte);
|
p_unix: unix_1 := boolean(ReadByte);
|
||||||
|
|
||||||
|
p_fenv_access: fenvAccess := boolean(ReadByte);
|
||||||
|
|
||||||
end; {case}
|
end; {case}
|
||||||
end; {while}
|
end; {while}
|
||||||
|
|
|
@ -131,6 +131,7 @@ type
|
||||||
case kind: statementKind of
|
case kind: statementKind of
|
||||||
compoundSt: (
|
compoundSt: (
|
||||||
doingDeclaration: boolean; {doing declarations? (or statements)}
|
doingDeclaration: boolean; {doing declarations? (or statements)}
|
||||||
|
lFenvAccess: boolean; {previous value of fenvAccess just}
|
||||||
);
|
);
|
||||||
ifSt: (
|
ifSt: (
|
||||||
ifLab: integer; {branch point}
|
ifLab: integer; {branch point}
|
||||||
|
@ -302,8 +303,9 @@ var
|
||||||
stPtr: statementPtr; {for creating a compound statement record}
|
stPtr: statementPtr; {for creating a compound statement record}
|
||||||
|
|
||||||
begin {CompoundStatement}
|
begin {CompoundStatement}
|
||||||
Match(lbracech,27); {make sure there is an opening '{'}
|
|
||||||
new(stPtr); {create a statement record}
|
new(stPtr); {create a statement record}
|
||||||
|
stPtr^.lFenvAccess := fenvAccess; {save existing value of fenvAccess}
|
||||||
|
Match(lbracech,27); {make sure there is an opening '{'}
|
||||||
stPtr^.next := statementList;
|
stPtr^.next := statementList;
|
||||||
statementList := stPtr;
|
statementList := stPtr;
|
||||||
stPtr^.kind := compoundSt;
|
stPtr^.kind := compoundSt;
|
||||||
|
@ -373,6 +375,7 @@ if not doingFunction then begin {if so, finish it off}
|
||||||
functionName := nil;
|
functionName := nil;
|
||||||
end; {if}
|
end; {if}
|
||||||
PopTable; {remove this symbol table}
|
PopTable; {remove this symbol table}
|
||||||
|
fenvAccess := stPtr^.lFenvAccess; {restore old value of fenvAccess}
|
||||||
dispose(stPtr); {dump the record}
|
dispose(stPtr); {dump the record}
|
||||||
if dumpLocal then begin
|
if dumpLocal then begin
|
||||||
useGlobalPool := true; {start using the global memory pool}
|
useGlobalPool := true; {start using the global memory pool}
|
||||||
|
@ -3797,6 +3800,7 @@ if isFunction then begin
|
||||||
Gen1Name(pc_lao, 0, lp^.name);
|
Gen1Name(pc_lao, 0, lp^.name);
|
||||||
Gen2t(pc_str, 0, 0, cgULong);
|
Gen2t(pc_str, 0, 0, cgULong);
|
||||||
end; {if}
|
end; {if}
|
||||||
|
fenvAccessInFunction := fenvAccess;
|
||||||
if isAsm then begin
|
if isAsm then begin
|
||||||
AsmFunction(variable); {handle assembly language functions}
|
AsmFunction(variable); {handle assembly language functions}
|
||||||
PopTable;
|
PopTable;
|
||||||
|
|
61
Scanner.pas
61
Scanner.pas
|
@ -39,7 +39,7 @@ type
|
||||||
p_nda,p_debug,p_lint,p_memorymodel,p_expand,
|
p_nda,p_debug,p_lint,p_memorymodel,p_expand,
|
||||||
p_optimize,p_stacksize,p_toolparms,p_databank,p_rtl,
|
p_optimize,p_stacksize,p_toolparms,p_databank,p_rtl,
|
||||||
p_noroot,p_path,p_ignore,p_segment,p_nba,
|
p_noroot,p_path,p_ignore,p_segment,p_nba,
|
||||||
p_xcmd,p_unix,p_line,p_endofenum);
|
p_xcmd,p_unix,p_line,p_fenv_access,p_endofenum);
|
||||||
|
|
||||||
{preprocessor types}
|
{preprocessor types}
|
||||||
{------------------}
|
{------------------}
|
||||||
|
@ -236,6 +236,8 @@ type
|
||||||
elseFound: boolean; {has an #else been found?}
|
elseFound: boolean; {has an #else been found?}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
onOffEnum = (on,off,default); {on-off values in standard pragmas}
|
||||||
|
|
||||||
var
|
var
|
||||||
dateStr: longStringPtr; {macro date string}
|
dateStr: longStringPtr; {macro date string}
|
||||||
doingPPExpression: boolean; {are we processing a preprocessor expression?}
|
doingPPExpression: boolean; {are we processing a preprocessor expression?}
|
||||||
|
@ -252,6 +254,7 @@ var
|
||||||
includeCount: 0..maxint; {nested include files (for EndInclude)}
|
includeCount: 0..maxint; {nested include files (for EndInclude)}
|
||||||
macroFound: macroRecordPtr; {last macro found by IsDefined}
|
macroFound: macroRecordPtr; {last macro found by IsDefined}
|
||||||
needWriteLine: boolean; {is there a line that needs to be written?}
|
needWriteLine: boolean; {is there a line that needs to be written?}
|
||||||
|
onOffValue: onOffEnum; {value of last on-off switch}
|
||||||
wroteLine: boolean; {has the current line already been written?}
|
wroteLine: boolean; {has the current line already been written?}
|
||||||
numErr: 0..maxErr; {number of errors in this line}
|
numErr: 0..maxErr; {number of errors in this line}
|
||||||
oneStr: string[2]; {string form of __STDC__, etc.}
|
oneStr: string[2]; {string form of __STDC__, etc.}
|
||||||
|
@ -692,6 +695,7 @@ if list or (numErr <> 0) then begin
|
||||||
154: msg := @'lint: function declared _Noreturn can return or has unreachable code';
|
154: msg := @'lint: function declared _Noreturn can return or has unreachable code';
|
||||||
155: msg := @'lint: non-void function may not return a value or has unreachable code';
|
155: msg := @'lint: non-void function may not return a value or has unreachable code';
|
||||||
156: msg := @'invalid suffix on numeric constant';
|
156: msg := @'invalid suffix on numeric constant';
|
||||||
|
157: msg := @'unknown or malformed standard pragma';
|
||||||
otherwise: Error(57);
|
otherwise: Error(57);
|
||||||
end; {case}
|
end; {case}
|
||||||
writeln(msg^);
|
writeln(msg^);
|
||||||
|
@ -2034,6 +2038,41 @@ var
|
||||||
end; {NumericDirective}
|
end; {NumericDirective}
|
||||||
|
|
||||||
|
|
||||||
|
procedure OnOffSwitch;
|
||||||
|
|
||||||
|
{ Process an of-off-switch, as used in standard pragmas. }
|
||||||
|
|
||||||
|
var
|
||||||
|
flaggedError: boolean; {did we flag an error already?}
|
||||||
|
|
||||||
|
begin {OnOffSwitch}
|
||||||
|
onOffValue := off;
|
||||||
|
flaggedError := false;
|
||||||
|
NextToken; {skip the standard pragma name}
|
||||||
|
if token.kind = typedef then
|
||||||
|
token.kind := ident;
|
||||||
|
if token.kind <> ident then begin
|
||||||
|
Error(157);
|
||||||
|
flaggedError := true;
|
||||||
|
end {if}
|
||||||
|
else if token.name^ = 'ON' then
|
||||||
|
onOffValue := on
|
||||||
|
else if token.name^ = 'OFF' then
|
||||||
|
onOffValue := off
|
||||||
|
else if token.name^ = 'DEFAULT' then
|
||||||
|
onOffValue := default
|
||||||
|
else begin
|
||||||
|
Error(157);
|
||||||
|
flaggedError := true;
|
||||||
|
end; {else}
|
||||||
|
if not flaggedError then begin
|
||||||
|
NextToken;
|
||||||
|
if token.kind <> eolsy then
|
||||||
|
Error(11);
|
||||||
|
end; {if}
|
||||||
|
end; {OnOffSwitch}
|
||||||
|
|
||||||
|
|
||||||
procedure ProcessIf (skip: boolean);
|
procedure ProcessIf (skip: boolean);
|
||||||
|
|
||||||
{ handle the processing for #if, #ifdef and #ifndef }
|
{ handle the processing for #if, #ifdef and #ifndef }
|
||||||
|
@ -3018,6 +3057,25 @@ if ch in ['a','d','e','i','l','p','u','w'] then begin
|
||||||
if token.kind <> eolsy then
|
if token.kind <> eolsy then
|
||||||
Error(11);
|
Error(11);
|
||||||
end {else if}
|
end {else if}
|
||||||
|
else if token.name^ = 'STDC' then begin
|
||||||
|
expandMacros := false;
|
||||||
|
NextToken;
|
||||||
|
if token.name^ = 'FP_CONTRACT' then
|
||||||
|
OnOffSwitch
|
||||||
|
else if token.name^ = 'CX_LIMITED_RANGE' then
|
||||||
|
OnOffSwitch
|
||||||
|
else if token.name^ = 'FENV_ACCESS' then begin
|
||||||
|
OnOffSwitch;
|
||||||
|
FlagPragmas(p_fenv_access);
|
||||||
|
fenvAccess := (onOffValue = on);
|
||||||
|
if fenvAccess then
|
||||||
|
if doingFunction then
|
||||||
|
fenvAccessInFunction := true;
|
||||||
|
end
|
||||||
|
else
|
||||||
|
Error(157);
|
||||||
|
expandMacros := true;
|
||||||
|
end {else if}
|
||||||
else if (lint & lintPragmas) <> 0 then
|
else if (lint & lintPragmas) <> 0 then
|
||||||
Error(110);
|
Error(110);
|
||||||
goto 2;
|
goto 2;
|
||||||
|
@ -3789,6 +3847,7 @@ doingStringOrCharacter := false; {not doing a string}
|
||||||
doingPPExpression := false; {not doing a preprocessor expression}
|
doingPPExpression := false; {not doing a preprocessor expression}
|
||||||
unix_1 := false; {int is 16 bits}
|
unix_1 := false; {int is 16 bits}
|
||||||
lintIsError := true; {lint messages are considered errors}
|
lintIsError := true; {lint messages are considered errors}
|
||||||
|
fenvAccess := false; {not accessing fp environment}
|
||||||
|
|
||||||
{error codes for lint messages}
|
{error codes for lint messages}
|
||||||
{if changed, also change maxLint}
|
{if changed, also change maxLint}
|
||||||
|
|
Loading…
Reference in New Issue
Block a user