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

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:
Stephen Heumann 2021-03-06 00:57:13 -06:00
parent c0727315e0
commit f9f79983f8
6 changed files with 97 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
CCommon.pas
View File

@ -525,6 +525,8 @@ var
lintIsError: boolean; {treat lint messages as errors?}
fIsNoreturn: boolean; {is the current function _Noreturn?}
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}
{---------------------------}

18
DAG.pas
View File

@ -5291,7 +5291,8 @@ var
begin {Generate}
if peepHole then {peephole optimization}
{peephole optimization}
if peepHole and not fenvAccessInFunction then
repeat
rescan := false;
PeepHoleOptimization(DAGhead);
@ -5306,22 +5307,27 @@ var
BasicBlocks; {build the basic blocks}
if commonSubexpression or loopOptimizations 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 not volatile then
CommonSubexpressionElimination;
if not fenvAccessInFunction then
CommonSubexpressionElimination;
if loopOptimizations then {loop optimizations}
if not volatile then
DoLoopOptimization;
if not fenvAccessInFunction then
DoLoopOptimization;
{ if printSymbols then {debug}
{ PrintBlocks(@'DAG: ', DAGblocks); {debug}
if commonSubexpression or loopOptimizations 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}
if loopOptimizations then {dump and dynamic space}
if not volatile then
DumpLoopLists;
if not fenvAccessInFunction then
DumpLoopLists;
DAGhead := nil; {reset the DAG pointers}
end; {Generate}

14
Expression.pas
View File

@ -959,7 +959,7 @@ var
{ do an operation }
label 1,2,3;
label 1,2,3,4;
var
baseType: baseTypeEnum; {base type of value to cast}
@ -1457,6 +1457,9 @@ var
if op^.left^.token.kind in [intconst,uintconst,longconst,ulongconst,
longlongconst,ulonglongconst,extendedconst] then
begin
if fenvAccess then
if kind in [normalExpression, autoInitializerExpression] then
goto 1;
ekind := extendedconst; {evaluate a constant operation}
rop1 := RealVal(op^.left^.token);
rop2 := RealVal(op^.right^.token);
@ -1569,6 +1572,11 @@ var
tp := tp^.dType;
if tp^.kind = scalarType then begin
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])
then begin
if class = realConstant then begin
@ -1713,6 +1721,9 @@ var
end; {else}
end {else if}
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}
rop1 := RealVal(op^.left^.token);
dispose(op^.left);
@ -1737,6 +1748,7 @@ var
end; {case}
end; {if}
end; {if}
4:
end;
otherwise: Error(57);

6
Header.pas
View File

@ -18,7 +18,7 @@ uses CCommon, MM, Scanner, Symbol, CGI;
{$segment 'SCANNER'}
const
symFileVersion = 11; {version number of .sym file format}
symFileVersion = 12; {version number of .sym file format}
var
inhibitHeader: boolean; {should .sym includes be blocked?}
@ -888,6 +888,8 @@ procedure EndInclude {chPtr: ptr};
end;
p_unix: WriteByte(ord(unix_1));
p_fenv_access: WriteByte(ord(fenvAccess));
end; {case}
end; {if}
@ -1545,6 +1547,8 @@ var
end;
p_unix: unix_1 := boolean(ReadByte);
p_fenv_access: fenvAccess := boolean(ReadByte);
end; {case}
end; {while}

6
Parser.pas
View File

@ -131,6 +131,7 @@ type
case kind: statementKind of
compoundSt: (
doingDeclaration: boolean; {doing declarations? (or statements)}
lFenvAccess: boolean; {previous value of fenvAccess just}
);
ifSt: (
ifLab: integer; {branch point}
@ -302,8 +303,9 @@ var
stPtr: statementPtr; {for creating a compound statement record}
begin {CompoundStatement}
Match(lbracech,27); {make sure there is an opening '{'}
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;
statementList := stPtr;
stPtr^.kind := compoundSt;
@ -373,6 +375,7 @@ if not doingFunction then begin {if so, finish it off}
functionName := nil;
end; {if}
PopTable; {remove this symbol table}
fenvAccess := stPtr^.lFenvAccess; {restore old value of fenvAccess}
dispose(stPtr); {dump the record}
if dumpLocal then begin
useGlobalPool := true; {start using the global memory pool}
@ -3797,6 +3800,7 @@ if isFunction then begin
Gen1Name(pc_lao, 0, lp^.name);
Gen2t(pc_str, 0, 0, cgULong);
end; {if}
fenvAccessInFunction := fenvAccess;
if isAsm then begin
AsmFunction(variable); {handle assembly language functions}
PopTable;

61
Scanner.pas
View File

@ -39,7 +39,7 @@ type
p_nda,p_debug,p_lint,p_memorymodel,p_expand,
p_optimize,p_stacksize,p_toolparms,p_databank,p_rtl,
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}
{------------------}
@ -236,6 +236,8 @@ type
elseFound: boolean; {has an #else been found?}
end;
onOffEnum = (on,off,default); {on-off values in standard pragmas}
var
dateStr: longStringPtr; {macro date string}
doingPPExpression: boolean; {are we processing a preprocessor expression?}
@ -252,6 +254,7 @@ var
includeCount: 0..maxint; {nested include files (for EndInclude)}
macroFound: macroRecordPtr; {last macro found by IsDefined}
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?}
numErr: 0..maxErr; {number of errors in this line}
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';
155: msg := @'lint: non-void function may not return a value or has unreachable code';
156: msg := @'invalid suffix on numeric constant';
157: msg := @'unknown or malformed standard pragma';
otherwise: Error(57);
end; {case}
writeln(msg^);
@ -2034,6 +2038,41 @@ var
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);
{ 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
Error(11);
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
Error(110);
goto 2;
@ -3789,6 +3847,7 @@ doingStringOrCharacter := false; {not doing a string}
doingPPExpression := false; {not doing a preprocessor expression}
unix_1 := false; {int is 16 bits}
lintIsError := true; {lint messages are considered errors}
fenvAccess := false; {not accessing fp environment}
{error codes for lint messages}
{if changed, also change maxLint}