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)