From f9f79983f8b36c7b01d56d73b9c23c15494344f8 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Sat, 6 Mar 2021 00:57:13 -0600 Subject: [PATCH] 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 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.) --- CCommon.pas | 2 ++ DAG.pas | 18 ++++++++++----- Expression.pas | 14 +++++++++++- Header.pas | 6 ++++- Parser.pas | 6 ++++- Scanner.pas | 61 +++++++++++++++++++++++++++++++++++++++++++++++++- 6 files changed, 97 insertions(+), 10 deletions(-) diff --git a/CCommon.pas b/CCommon.pas index da99843..697ae42 100644 --- a/CCommon.pas +++ b/CCommon.pas @@ -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} {---------------------------} diff --git a/DAG.pas b/DAG.pas index bfe0458..4c2be75 100644 --- a/DAG.pas +++ b/DAG.pas @@ -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} diff --git a/Expression.pas b/Expression.pas index b860fb0..8599617 100644 --- a/Expression.pas +++ b/Expression.pas @@ -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); diff --git a/Header.pas b/Header.pas index 01990d3..e47bddc 100644 --- a/Header.pas +++ b/Header.pas @@ -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} diff --git a/Parser.pas b/Parser.pas index d6e5652..e7c470d 100644 --- a/Parser.pas +++ b/Parser.pas @@ -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; diff --git a/Scanner.pas b/Scanner.pas index 4d73a7a..4a65cbb 100644 --- a/Scanner.pas +++ b/Scanner.pas @@ -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}