From 4ad7a65de65a75598e45307b6dd0e3c251bd04f3 Mon Sep 17 00:00:00 2001 From: Stephen Heumann Date: Thu, 4 Mar 2021 23:52:41 -0600 Subject: [PATCH] Process floating-point values within the compiler using the extended type. This means that floating-point constants can now have the range and precision of the extended type (aka long double), and floating-point constant expressions evaluated within the compiler also have that same range and precision (matching expressions evaluated at run time). This new behavior is intended to match the behavior specified in the C99 and later standards for FLT_EVAL_METHOD 2. This fixes the previous problem where long double constants and constant expressions of type long double were not represented and evaluated with the full range and precision that they should be. It also gives extra range and precision to constants and constant expressions of type double or float. This may have pluses and minuses, but at any rate it is consistent with the existing behavior for expressions evaluated at run time, and with one of the possible models of floating point evaluation specified in the C standards. --- CCommon.pas | 10 ++++---- CGC.asm | 33 ++++++------------------ CGC.macros | 4 +-- CGC.pas | 2 +- CGI.pas | 10 ++++---- DAG.pas | 20 ++++----------- Expression.pas | 69 ++++++++++++++++++++------------------------------ Gen.pas | 3 +-- Header.pas | 42 +++++++++++++++--------------- Scanner.pas | 12 ++++----- Table.asm | 8 +++--- 11 files changed, 85 insertions(+), 128 deletions(-) diff --git a/CCommon.pas b/CCommon.pas index e587ccd..da99843 100644 --- a/CCommon.pas +++ b/CCommon.pas @@ -168,7 +168,7 @@ type ident, {identifiers} {constants} intconst,uintconst,longconst,ulongconst,longlongconst, - ulonglongconst,doubleconst, + ulonglongconst,extendedconst, stringconst, {reserved words} _Alignassy,_Alignofsy,_Atomicsy,_Boolsy,_Complexsy, @@ -209,7 +209,7 @@ type tokenSet = set of tokenEnum; tokenClass = (reservedWord,reservedSymbol,identifier,intConstant,longConstant, - longlongConstant,doubleConstant,stringConstant,macroParameter); + longlongConstant,realConstant,stringConstant,macroParameter); identPtr = ^identRecord; {^ to a symbol table entry} tokenType = record {a token} kind: tokenEnum; {kind of token} @@ -222,7 +222,7 @@ type intConstant : (ival: integer); longConstant : (lval: longint); longlongConstant: (qval: longlong); - doubleConstant: (rval: double); + realConstant : (rval: extended); stringConstant: (sval: longstringPtr; ispstring: boolean); macroParameter: (pnum: integer); @@ -325,7 +325,7 @@ type cgReal, cgDouble, cgComp, - cgExtended: (rVal: double); + cgExtended: (rVal: extended); cgVoid, ccPointer: ( pVal: longint; @@ -490,7 +490,7 @@ var {expression results} {------------------} doDispose: boolean; {dispose of the expression tree as we go?} - realExpressionValue: double; {value of the last real constant expression} + realExpressionValue: extended; {value of the last real constant expression} llExpressionValue: longlong; {value of the last long long constant expression} expressionValue: longint; {value of the last constant expression} expressionType: typePtr; {the type of the expression} diff --git a/CGC.asm b/CGC.asm index 4b9867f..6720205 100644 --- a/CGC.asm +++ b/CGC.asm @@ -10,8 +10,8 @@ * CnvSX start cg rec equ 4 record containing values -rec_real equ 0 disp to real value -rec_ext equ 8 disp to extended (SANE) value +rec_real equ 0 disp to real (extended) value +rec_ext equ 10 disp to extended (SANE) value tsc set up DP phd @@ -25,7 +25,7 @@ rec_ext equ 8 disp to extended (SANE) value adc #0 pha phx - fd2x convert TOS to extended + fx2x convert TOS to extended move4 0,4 return pld pla @@ -44,32 +44,15 @@ rec_ext equ 8 disp to extended (SANE) value * CnvSC start cg rec equ 4 record containing values -rec_real equ 0 disp to real value -rec_ext equ 8 disp to extended (SANE) value -rec_cmp equ 18 disp to comp (SANE) value +rec_real equ 0 disp to real (extended) value +rec_ext equ 10 disp to extended (SANE) value +rec_cmp equ 20 disp to comp (SANE) value tsc set up DP phd tcd ph4 rec push addr of real number - clc push addr of SANE number - lda rec - adc #rec_ext - tax - lda rec+2 - adc #0 - pha - phx - fd2x convert TOS to extended - clc push addr of SANE number - lda rec - adc #rec_ext - tax - lda rec+2 - adc #0 - pha - phx - clc push addr of COMP number + clc push addr of SANE comp number lda rec adc #rec_cmp tax @@ -77,7 +60,7 @@ rec_cmp equ 18 disp to comp (SANE) value adc #0 pha phx - fx2c convert TOS to extended + fx2c convert TOS to SANE comp number move4 0,4 return pld pla diff --git a/CGC.macros b/CGC.macros index 4613e41..3c79c79 100644 --- a/CGC.macros +++ b/CGC.macros @@ -175,8 +175,8 @@ sta 2+&op mend MACRO -&LAB FD2X -&LAB PEA $010E +&LAB FX2X +&LAB PEA $0010 LDX #$090A JSL $E10000 MEND diff --git a/CGC.pas b/CGC.pas index 348e1ff..23970df 100644 --- a/CGC.pas +++ b/CGC.pas @@ -32,7 +32,7 @@ type {pcode code generation} {---------------------} realrec = record {used to convert from real to in-SANE} - itsReal: double; + itsReal: extended; inSANE: packed array[1..10] of byte; inCOMP: packed array[1..8] of byte; end; diff --git a/CGI.pas b/CGI.pas index fcca32a..4ca07ef 100644 --- a/CGI.pas +++ b/CGI.pas @@ -266,7 +266,7 @@ type cgReal, cgDouble, cgComp, - cgExtended : (rval: double); + cgExtended : (rval: extended); cgString : (str: longStringPtr); cgVoid, ccPointer : (pval: longint; pstr: longStringPtr); @@ -579,7 +579,7 @@ procedure GenQ1 (fop: pcodes; qval: longlong; fp1: integer); { fp1 - integer parameter } -procedure GenR1t (fop: pcodes; rval: double; fp1: integer; tp: baseTypeEnum); +procedure GenR1t (fop: pcodes; rval: extended; fp1: integer; tp: baseTypeEnum); { generate an instruction that uses a real and an int } { } @@ -605,7 +605,7 @@ procedure GenLdcQuad (qval: longlong); { qval - value to load } -procedure GenLdcReal (rval: double); +procedure GenLdcReal (rval: extended); { load a real constant } { } @@ -1247,7 +1247,7 @@ if codeGeneration then begin end; {GenQ1} -procedure GenR1t {fop: pcodes; rval: double; fp1: integer; tp: baseTypeEnum}; +procedure GenR1t {fop: pcodes; rval: extended; fp1: integer; tp: baseTypeEnum}; { generate an instruction that uses a real and an int } { } @@ -1335,7 +1335,7 @@ if codeGeneration then begin end; {GenTool} -procedure GenLdcReal {rval: double}; +procedure GenLdcReal {rval: extended}; { load a real constant } { } diff --git a/DAG.pas b/DAG.pas index ce3e48e..7613c4a 100644 --- a/DAG.pas +++ b/DAG.pas @@ -489,7 +489,7 @@ var opcode: pcodes; {temp opcode} optype: baseTypeEnum; {temp optype} q: integer; {temp for integer calculations} - rval: double; {temp for real calculations} + rval: extended; {temp for real calculations} fromtype, totype, firstType: record {for converting numbers to optypes} case boolean of @@ -1232,14 +1232,9 @@ case op^.opcode of {check for optimizations of this node} end; cgQuad,cgUQuad: ; cgDouble,cgExtended: begin - {only convert values exactly representable in double} rval := CnvLLX(op^.left^.qval); - if rval = CnvLLX(op^.left^.qval) then begin - op^.left^.qval := longlong0; - op^.left^.rval := rval; - end {if} - else - doit := false; + op^.left^.qval := longlong0; + op^.left^.rval := rval; end; cgReal,cgComp: doit := false; @@ -1259,14 +1254,9 @@ case op^.opcode of {check for optimizations of this node} end; cgQuad,cgUQuad: ; cgDouble,cgExtended: begin - {only convert values exactly representable in double} rval := CnvULLX(op^.left^.qval); - if rval = CnvULLX(op^.left^.qval) then begin - op^.left^.qval := longlong0; - op^.left^.rval := rval; - end {if} - else - doit := false; + op^.left^.qval := longlong0; + op^.left^.rval := rval; end; cgReal,cgComp: doit := false; diff --git a/Expression.pas b/Expression.pas index e118b35..b860fb0 100644 --- a/Expression.pas +++ b/Expression.pas @@ -969,9 +969,8 @@ var lCodeGeneration: boolean; {local copy of codeGeneration} op: tokenPtr; {work pointer} op1,op2: longint; {for evaluating constant expressions} - rop1,rop2: double; {for evaluating double expressions} + rop1,rop2: extended; {for evaluating fp expressions} llop1, llop2: longlong; {for evaluating long long expressions} - extop1: extended; {temporary for conversions} tp: typePtr; {cast type} unsigned: boolean; {is the term unsigned?} @@ -1454,23 +1453,13 @@ var end; {if} if op^.right^.token.kind in [intconst,uintconst,longconst,ulongconst, - longlongconst,ulonglongconst,doubleconst] then + longlongconst,ulonglongconst,extendedconst] then if op^.left^.token.kind in [intconst,uintconst,longconst,ulongconst, - longlongconst,ulonglongconst,doubleconst] then + longlongconst,ulonglongconst,extendedconst] then begin - ekind := doubleconst; {evaluate a constant operation} - extop1 := RealVal(op^.left^.token); - rop1 := extop1; - if op^.left^.token.kind in [longlongconst,ulonglongconst] then - if rop1 <> extop1 then - if not (op^.token.kind in [barbarop,andandop]) then - goto 1; - extop1 := RealVal(op^.right^.token); - rop2 := extop1; - if op^.right^.token.kind in [longlongconst,ulonglongconst] then - if rop2 <> extop1 then - if not (op^.token.kind in [barbarop,andandop]) then - goto 1; + ekind := extendedconst; {evaluate a constant operation} + rop1 := RealVal(op^.left^.token); + rop2 := RealVal(op^.right^.token); dispose(op^.right); op^.right := nil; dispose(op^.left); @@ -1522,8 +1511,8 @@ var end {if} else begin op^.token.rval := rop1; - op^.token.class := doubleConstant; - op^.token.kind := doubleConst; + op^.token.class := realConstant; + op^.token.kind := extendedConst; end; {else} end; {if} 1: @@ -1574,7 +1563,7 @@ var else if op^.token.kind = castoper then begin class := op^.left^.token.class; if class in [intConstant,longConstant,longlongconstant, - doubleConstant] then begin + realConstant] then begin tp := op^.castType; while tp^.kind = definedType do tp := tp^.dType; @@ -1582,7 +1571,7 @@ var baseType := tp^.baseType; if (baseType < cgString) or (baseType in [cgQuad,cgUQuad]) then begin - if class = doubleConstant then begin + if class = realConstant then begin rop1 := RealVal(op^.left^.token); if baseType = cgUQuad then CnvXULL(llop1, rop1) @@ -1592,13 +1581,9 @@ var else begin {handle integer constants} GetLongLongVal(llop1, op^.left^.token); if op^.left^.token.kind = ulonglongconst then - extop1 := CnvULLX(llop1) + rop1 := CnvULLX(llop1) else - extop1 := CnvLLX(llop1); - rop1 := extop1; - if baseType in [cgExtended,cgComp] then - if rop1 <> extop1 then - goto 3; + rop1 := CnvLLX(llop1); end; {else if} dispose(op^.left); op^.left := nil; @@ -1648,8 +1633,8 @@ var op^.token.qval := llop1; end {else if} else begin - op^.token.kind := doubleConst; - op^.token.class := doubleConstant; + op^.token.kind := extendedConst; + op^.token.class := realConstant; op^.token.rval := rop1; end; {else if} end; {if} @@ -1727,15 +1712,15 @@ var op^.token.ival := long(op1).lsw; end; {else} end {else if} - else if op^.left^.token.kind = doubleconst then begin - ekind := doubleconst; {evaluate a constant operation} + else if op^.left^.token.kind = extendedconst then begin + ekind := extendedconst; {evaluate a constant operation} rop1 := RealVal(op^.left^.token); dispose(op^.left); op^.left := nil; case op^.token.kind of uminus : begin {unary -} - op^.token.class := doubleConstant; - op^.token.kind := doubleConst; + op^.token.class := realConstant; + op^.token.kind := extendedConst; op^.token.rval := -rop1; end; excch : begin {!} @@ -1745,8 +1730,8 @@ var end; otherwise : begin {illegal operation} Error(66); - op^.token.class := doubleConstant; - op^.token.kind := doubleConst; + op^.token.class := realConstant; + op^.token.kind := extendedConst; op^.token.rval := rop1; end; end; {case} @@ -1812,10 +1797,10 @@ if token.kind in startExpression then begin sp^.right := nil; stack := sp; if kind in [preprocessorExpression,arrayExpression] then - if token.kind in [stringconst,doubleconst] then begin + if token.kind in [stringconst,extendedconst] then begin if kind = arrayExpression then begin op := opStack; - if token.kind = doubleconst then + if token.kind = extendedconst then if op <> nil then if op^.token.kind = castoper then if op^.casttype^.kind = scalarType then @@ -3148,7 +3133,7 @@ var or ((divisor.class = longConstant) and (divisor.lval = 0)) or ((divisor.class = longlongConstant) and (divisor.qval.lo = 0) and (divisor.qval.hi = 0)) - or ((divisor.class = doubleConstant) and (divisor.rval = 0.0)) then + or ((divisor.class = realConstant) and (divisor.rval = 0.0)) then Error(129); end; {CheckDivByZero} @@ -3270,10 +3255,10 @@ case tree^.token.kind of end; {if} end; {case longlongConst} - doubleConst: begin + extendedConst: begin GenLdcReal(tree^.token.rval); expressionType := doublePtr; - end; {case doubleConst} + end; {case extendedConst} stringConst: begin GenS(pc_lca, tree^.token.sval); @@ -4395,7 +4380,7 @@ else begin {record the expression for an initialize expressionType := ulongLongPtr; isConstant := true; end {else if} - else if tree^.token.kind = doubleconst then begin + else if tree^.token.kind = extendedconst then begin realExpressionValue := tree^.token.rval; expressionType := extendedPtr; isConstant := true; @@ -4450,7 +4435,7 @@ procedure InitExpression; begin {InitExpression} startTerm := [ident,intconst,uintconst,longconst,ulongconst,longlongconst, - ulonglongconst,doubleconst,stringconst,_Genericsy]; + ulonglongconst,extendedconst,stringconst,_Genericsy]; startExpression:= startTerm + [lparench,asteriskch,andch,plusch,minusch,excch,tildech,sizeofsy, plusplusop,minusminusop,typedef,_Alignofsy]; diff --git a/Gen.pas b/Gen.pas index ab572ef..40814dd 100644 --- a/Gen.pas +++ b/Gen.pas @@ -5862,7 +5862,7 @@ procedure GenTree {op: icptr}; { Generate code for a pc_ldc } type - kind = (vint, vbyte, vreal); {kinds of equivalenced data} + kind = (vint, vbyte); {kinds of equivalenced data} var i: integer; {loop/index variable} @@ -5871,7 +5871,6 @@ procedure GenTree {op: icptr}; case rkind: kind of vint: (i: integer); vbyte: (b1, b2, b3, b4, b5, b6, b7, b8: byte); - vreal: (r: double); end; begin {GenLdc} diff --git a/Header.pas b/Header.pas index 731c3ce..01990d3 100644 --- a/Header.pas +++ b/Header.pas @@ -18,7 +18,7 @@ uses CCommon, MM, Scanner, Symbol, CGI; {$segment 'SCANNER'} const - symFileVersion = 10; {version number of .sym file format} + symFileVersion = 11; {version number of .sym file format} var inhibitHeader: boolean; {should .sym includes be blocked?} @@ -280,19 +280,19 @@ if numErrors <> 0 then end; {CloseSymbols} -function ReadDouble: double; +function ReadExtended: extended; -{ Read a double precision real from the symbol file } +{ Read an extended precision real from the symbol file } { } { Returns: value read } type - doubleptr = ^double; + extendedptr = ^extended; -begin {ReadDouble} -ReadDouble := doubleptr(symPtr)^; -symPtr := pointer(ord4(symPtr)+8); -end; {ReadDouble} +begin {ReadExtended} +ReadExtended := extendedptr(symPtr)^; +symPtr := pointer(ord4(symPtr)+10); +end; {ReadExtended} function ReadLong: longint; @@ -400,24 +400,24 @@ symPtr := pointer(ord4(symPtr) + len); end; {ReadChars} -procedure WriteDouble (d: double); +procedure WriteExtended (e: extended); -{ Write a double constant to the symbol file } +{ Write an extended constant to the symbol file } { } { parameters: } -{ d - constant to write } +{ e - constant to write } var - dPtr: ^double; {work pointer} + ePtr: ^extended; {work pointer} -begin {WriteDouble} -if bufLen < 8 then +begin {WriteExtended} +if bufLen < 10 then Purge; -dPtr := pointer(bufPtr); -dPtr^ := d; -bufPtr := pointer(ord4(bufPtr) + 8); -bufLen := bufLen - 8; -end; {WriteDouble} +ePtr := pointer(bufPtr); +ePtr^ := e; +bufPtr := pointer(ord4(bufPtr) + 10); +bufLen := bufLen - 10; +end; {WriteExtended} procedure WriteLong (i: longint); @@ -715,7 +715,7 @@ procedure EndInclude {chPtr: ptr}; WriteLong(token.qval.lo); WriteLong(token.qval.hi); end; - doubleConstant: WriteDouble(token.rval); + realConstant: WriteExtended(token.rval); stringConstant: begin WriteLongString(token.sval); WriteByte(ord(token.ispstring)); @@ -1339,7 +1339,7 @@ var token.qval.lo := ReadLong; token.qval.hi := ReadLong; end; - doubleConstant: token.rval := ReadDouble; + realConstant: token.rval := ReadExtended; stringConstant: begin token.sval := ReadLongString; token.ispstring := ReadByte <> 0; diff --git a/Scanner.pas b/Scanner.pas index 872d921..4d73a7a 100644 --- a/Scanner.pas +++ b/Scanner.pas @@ -752,7 +752,7 @@ case token.kind of longlongConst, ulonglongConst: write('0x...'); {TODO implement} - doubleConst: write(token.rval:1); + extendedConst: write(token.rval:1); stringConst: begin write('"'); @@ -2330,7 +2330,7 @@ var if (tk1^.token.qval.lo <> tk2^.token.qval.lo) or (tk1^.token.qval.hi <> tk2^.token.qval.hi) then goto 3; - doubleConstant: + realConstant: if tk1^.token.rval <> tk2^.token.rval then goto 3; stringConstant: begin @@ -3356,8 +3356,8 @@ numString[0] := chr(stringIndex); {set the length of the string} if doingPPExpression then isLongLong := true; if isReal then begin {convert a real constant} - token.kind := doubleConst; - token.class := doubleConstant; + token.kind := extendedConst; + token.class := realConstant; if stringIndex > 80 then begin FlagError(131); token.rval := 0.0; @@ -3797,7 +3797,7 @@ lintErrors := [51,104,105,110,124,125,128,129,130,147,151,152,153,154,155]; spaceStr := ' '; {strings used in stringization} quoteStr := '"'; {set of classes for numeric constants} -numericConstants := [intConstant,longConstant,longlongConstant,doubleConstant]; +numericConstants := [intConstant,longConstant,longlongConstant,realConstant]; new(mp); {__LINE__} mp^.name := @'__LINE__'; @@ -3965,7 +3965,7 @@ repeat case token.class of intConstant : token.ival := -token.ival; longConstant : token.lval := -token.lval; - doubleConstant: token.rval := -token.rval; + realConstant : token.rval := -token.rval; longlongConstant,otherwise: Error(108); end; {case} end {if} diff --git a/Table.asm b/Table.asm index fbbf4a9..9eace01 100644 --- a/Table.asm +++ b/Table.asm @@ -285,7 +285,7 @@ charSym start single character symbols enum ident,0 identifiers ! constants enum (intconst,uintconst,longconst,ulongconst,longlongconst) - enum (ulonglongconst,doubleconst) + enum (ulonglongconst,extendedconst) enum stringconst ! reserved words enum (_Alignassy,_Alignofsy,_Atomicsy,_Boolsy,_Complexsy) @@ -359,7 +359,7 @@ icp start in-coming priority for expression dc i1'200' ulongconst dc i1'200' longlongconst dc i1'200' ulonglongconst - dc i1'200' doubleconst + dc i1'200' extendedconst dc i1'200' stringconst dc i1'200' _Alignassy dc i1'16' _Alignofsy @@ -526,7 +526,7 @@ isp start in stack priority for expression dc i1'0' ulongconst dc i1'0' longlongconst dc i1'0' ulonglongconst - dc i1'0' doubleconst + dc i1'0' extendedconst dc i1'0' stringconst dc i1'0' _Alignassy dc i1'16' _Alignofsy @@ -899,7 +899,7 @@ wordHash start reserved word hash table enum ident,0 identifiers ! constants enum (intconst,uintconst,longconst,ulongconst,longlongconst) - enum (ulonglongconst,doubleconst) + enum (ulonglongconst,extendedconst) enum stringconst ! reserved words enum (_Alignassy,_Alignofsy,_Atomicsy,_Boolsy,_Complexsy)