diff --git a/CCommon.pas b/CCommon.pas index ef0b84c..8b9c340 100644 --- a/CCommon.pas +++ b/CCommon.pas @@ -114,7 +114,7 @@ type {Misc.} {-----} long = record lsw,msw: integer; end; {for extracting words from longints} - longlong = record low32,high32: longint; end; {64-bit integer representation} + longlong = record lo,hi: longint; end; {64-bit integer representation} cString = packed array [1..256] of char; {null terminated string} cStringPtr = ^cString; @@ -167,7 +167,8 @@ type tokenEnum = ( {enumeration of the tokens} ident, {identifiers} {constants} - intconst,uintconst,longconst,ulongconst,doubleconst, + intconst,uintconst,longconst,ulongconst,longlongconst, + ulonglongconst,doubleconst, stringconst, {reserved words} _Alignassy,_Alignofsy,_Atomicsy,_Boolsy,_Complexsy, @@ -208,7 +209,7 @@ type tokenSet = set of tokenEnum; tokenClass = (reservedWord,reservedSymbol,identifier,intConstant,longConstant, - doubleConstant,stringConstant,macroParameter); + longlongConstant,doubleConstant,stringConstant,macroParameter); identPtr = ^identRecord; {^ to a symbol table entry} tokenType = record {a token} kind: tokenEnum; {kind of token} @@ -220,6 +221,7 @@ type symbolPtr: identPtr); intConstant : (ival: integer); longConstant : (lval: longint); + longlongConstant: (qval: longlong); doubleConstant: (rval: double); stringConstant: (sval: longstringPtr; ispstring: boolean); @@ -487,6 +489,7 @@ var {------------------} doDispose: boolean; {dispose of the expression tree as we go?} realExpressionValue: double; {value of the last real constant expression} + longlongExpressionValue: longlong; {value of the last long long constant expression} expressionValue: longint; {value of the last constant expression} expressionType: typePtr; {the type of the expression} initializerTree: tokenPtr; {for non-constant initializers} diff --git a/CGI.pas b/CGI.pas index fa81c44..b87c48b 100644 --- a/CGI.pas +++ b/CGI.pas @@ -575,6 +575,14 @@ procedure GenLdcLong (lval: longint); { lval - value to load } +procedure GenLdcQuad (qval: longlong); + +{ load a long long constant } +{ } +{ parameters: } +{ qval - value to load } + + procedure GenLdcReal (rval: double); { load a real constant } @@ -1238,6 +1246,27 @@ if codeGeneration then begin end; {GenLdcLong} +procedure GenLdcQuad {qval: longlong}; + +{ load a long long constant } +{ } +{ parameters: } +{ qval - value to load } + +var + lcode: icptr; {local copy of code} + +begin {GenLdcQuad} +if codeGeneration then begin + lcode := code; + lcode^.optype := cgQuad; + lcode^.qval.lo := qval.lo; + lcode^.qval.hi := qval.hi; + Gen0(pc_ldc); + end; {if} +end; {GenLdcQuad} + + procedure GenTool {fop: pcodes; fp1, fp2: integer; dispatcher: longint}; { generate a tool call } diff --git a/DAG.pas b/DAG.pas index fe777da..8af07b9 100644 --- a/DAG.pas +++ b/DAG.pas @@ -167,8 +167,8 @@ else if (op1 <> nil) and (op2 <> nil) then if op1^.lval = op2^.lval then CodesMatch := true; cgQuad, cgUQuad: - if op1^.qval.low32 = op2^.qval.low32 then - if op1^.qval.high32 = op2^.qval.high32 then + if op1^.qval.lo = op2^.qval.lo then + if op1^.qval.hi = op2^.qval.hi then CodesMatch := true; cgReal, cgDouble, cgComp, cgExtended: if op1^.rval = op2^.rval then diff --git a/Expression.pas b/Expression.pas index e07067d..65aa3ec 100644 --- a/Expression.pas +++ b/Expression.pas @@ -2810,6 +2810,8 @@ var if opType^.baseType in [cgByte,cgWord,cgUByte,cgUWord,cgLong,cgULong] then if ((divisor.class = intConstant) and (divisor.ival = 0)) 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 Error(129); end; {CheckDivByZero} @@ -2831,6 +2833,12 @@ var shiftCount := shiftCountTok.ival else if shiftCountTok.class = longConstant then shiftCount := shiftCountTok.lval + else if shiftCountTok.class = longlongConstant then begin + if shiftCountTok.qval.hi = 0 then + shiftCount := shiftCountTok.qval.lo + else + shiftCount := -1; + end {else if} else shiftCount := 0; @@ -2911,6 +2919,18 @@ case tree^.token.kind of lastconst := tree^.token.lval; end; {case longConst} + longlongConst,ulonglongConst: begin + GenLdcQuad(tree^.token.qval); + if tree^.token.kind = longlongConst then + expressionType := longlongPtr + else + expressionType := ulonglongPtr; + if (tree^.token.qval.hi = 0) and (tree^.token.qval.lo >= 0) then begin + lastwasconst := true; + lastconst := tree^.token.qval.lo; + end; {if} + end; {case longlongConst} + doubleConst: begin GenLdcReal(tree^.token.rval); expressionType := doublePtr; @@ -3920,6 +3940,18 @@ else begin {record the expression for an initialize expressionType := ulongPtr; isConstant := true; end {else if} + else if tree^.token.kind = longlongconst then begin + longlongExpressionValue.lo := tree^.token.qval.lo; + longlongExpressionValue.hi := tree^.token.qval.hi; + expressionType := longLongPtr; + isConstant := true; + end {else if} + else if tree^.token.kind = ulonglongconst then begin + longlongExpressionValue.lo := tree^.token.qval.lo; + longlongExpressionValue.hi := tree^.token.qval.hi; + expressionType := ulongLongPtr; + isConstant := true; + end {else if} else if tree^.token.kind = doubleconst then begin realExpressionValue := tree^.token.rval; expressionType := extendedPtr; @@ -3955,8 +3987,8 @@ procedure InitExpression; { initialize the expression handler } begin {InitExpression} -startTerm := [ident,intconst,uintconst,longconst,ulongconst,doubleconst, - stringconst,_Genericsy]; +startTerm := [ident,intconst,uintconst,longconst,ulongconst,longlongconst, + ulonglongconst,doubleconst,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 af7898d..20a8389 100644 --- a/Gen.pas +++ b/Gen.pas @@ -4986,6 +4986,13 @@ procedure GenTree {op: icptr}; GenNative(m_pea, immediate, long(op^.lval).lsw, nil, 0); end; + cgQuad,cgUQuad: begin + GenNative(m_pea, immediate, long(op^.qval.hi).msw, nil, 0); + GenNative(m_pea, immediate, long(op^.qval.hi).lsw, nil, 0); + GenNative(m_pea, immediate, long(op^.qval.lo).msw, nil, 0); + GenNative(m_pea, immediate, long(op^.qval.lo).lsw, nil, 0); + end; + otherwise: Error(cge1); end; {case} diff --git a/Header.pas b/Header.pas index bcdd8f4..731c3ce 100644 --- a/Header.pas +++ b/Header.pas @@ -18,7 +18,7 @@ uses CCommon, MM, Scanner, Symbol, CGI; {$segment 'SCANNER'} const - symFileVersion = 9; {version number of .sym file format} + symFileVersion = 10; {version number of .sym file format} var inhibitHeader: boolean; {should .sym includes be blocked?} @@ -711,6 +711,10 @@ procedure EndInclude {chPtr: ptr}; identifier: WriteString(token.name); intConstant: WriteWord(token.ival); longConstant: WriteLong(token.lval); + longlongConstant: begin + WriteLong(token.qval.lo); + WriteLong(token.qval.hi); + end; doubleConstant: WriteDouble(token.rval); stringConstant: begin WriteLongString(token.sval); @@ -1331,6 +1335,10 @@ var identifier: token.name := ReadString; intConstant: token.ival := ReadWord; longConstant: token.lval := ReadLong; + longlongConstant: begin + token.qval.lo := ReadLong; + token.qval.hi := ReadLong; + end; doubleConstant: token.rval := ReadDouble; stringConstant: begin token.sval := ReadLongString; diff --git a/Parser.pas b/Parser.pas index 3e4ccca..2835bda 100644 --- a/Parser.pas +++ b/Parser.pas @@ -1846,6 +1846,8 @@ var size := rtree^.token.ival else if rtree^.token.kind in [longconst,ulongconst] then size := rtree^.token.lval + else if rtree^.token.kind in [longlongconst,ulonglongconst] then + size := rtree^.token.qval.lo else begin Error(18); errorFound := true; @@ -2056,11 +2058,13 @@ var operator := tree^.token.kind; while operator in [plusch,minusch] do begin with tree^.right^.token do - if kind in [intConst,longConst] then begin + if kind in [intConst,longConst,longlongConst] then begin if kind = intConst then offSet2 := ival - else - offset2 := lval; + else if kind = longConst then + offset2 := lval + else {if kind = longlongConst then} + offset2 := qval.lo; if operator = plusch then offset := offset + offset2 else @@ -4179,12 +4183,19 @@ var {do assignment conversions} while tree^.token.kind = castoper do tree := tree^.left; - isConstant := tree^.token.class in [intConstant,longConstant]; + isConstant := + tree^.token.class in [intConstant,longConstant,longlongConstant]; if isConstant then if tree^.token.class = intConstant then val := tree^.token.ival - else - val := tree^.token.lval; + else if tree^.token.class = longConstant then + val := tree^.token.lval + else {if tree^.token.class = longlongConstant then} begin + if (tree^.token.qval.hi = 0) and (tree^.token.qval.lo >= 0) then + val := tree^.token.qval.lo + else + isConstant := false; + end; {else} { if isConstant then if tree^.token.class = intConstant then diff --git a/Scanner.pas b/Scanner.pas index 67b81bf..ddacdce 100644 --- a/Scanner.pas +++ b/Scanner.pas @@ -272,6 +272,7 @@ var lintErrors: set of 1..maxLint; {lint error codes} spaceStr: string[2]; {string ' ' (used in stringization)} quoteStr: string[2]; {string '"' (used in stringization)} + numericConstants: set of tokenClass; {token classes for numeric constants} {-- External procedures; see expression evaluator for notes ----} @@ -742,6 +743,9 @@ case token.kind of longConst, ulongConst: write(token.lval:1); + + longlongConst, + ulonglongConst: write('0x...'); {TODO implement} doubleConst: write(token.rval:1); @@ -1043,7 +1047,7 @@ if class1 in [identifier,reservedWord] then begin str2 := tk2.name else if class2 = reservedWord then str2 := @reservedWords[kind2] - else if class2 in [intConstant,longConstant,doubleConstant] then + else if class2 in numericConstants then str2 := tk2.numString else begin Error(63); @@ -1067,8 +1071,8 @@ if class1 in [identifier,reservedWord] then begin goto 1; end {class1 in [identifier,reservedWord]} -else if class1 in [intConstant,longConstant,doubleConstant] then begin - if class2 in [intConstant,longConstant,doubleConstant] then +else if class1 in numericConstants then begin + if class2 in numericConstants then str2 := tk2.numString else if class2 = identifier then str2 := tk2.name @@ -1086,7 +1090,7 @@ else if class1 in [intConstant,longConstant,doubleConstant] then begin tk1 := token; token := lt; goto 1; - end {else if class1 in [intConstant,longConstant,doubleConstant]} + end {else if class1 in numericConstants} else if class1 = stringConstant then begin if class2 = stringConstant then begin @@ -1106,7 +1110,7 @@ else if class1 = stringConstant then begin end {else if} else if kind1 = dotch then begin - if class2 in [intConstant,longConstant,doubleConstant] then begin + if class2 in numericConstants then begin workString := concat(tk1.numString^, tk2.numString^); lt := token; DoNumber(true); @@ -1114,7 +1118,7 @@ else if kind1 = dotch then begin token := lt; goto 1; end; {if} - end {else if class1 in [intConstant,longConstant,doubleConstant]} + end {else if class1 in numericConstants} else if kind1 = poundch then begin if kind2 = poundch then begin @@ -1846,7 +1850,7 @@ else begin new(tempString); tempString^[0] := chr(0); while - (token.class in [reservedWord,intconstant,longconstant,doubleconstant]) + (token.class in ([reservedWord] + numericConstants)) or (token.kind in [dotch,ident]) do begin if token.kind = ident then tempString^ := concat(tempString^, token.name^) @@ -1854,7 +1858,7 @@ else begin tempString^ := concat(tempString^, '.') else if token.class = reservedWord then tempString^ := concat(tempString^, reservedWords[token.kind]) - else {if token.class in [intconst,longconst,doubleconst] then} + else {if token.class in numericConstants then} tempString^ := concat(tempString^, token.numstring^); NextToken; end; {while} @@ -2317,6 +2321,10 @@ var longConstant: if tk1^.token.lval <> tk2^.token.lval then goto 3; + longlongConstant: + if (tk1^.token.qval.lo <> tk2^.token.qval.lo) or + (tk1^.token.qval.hi <> tk2^.token.qval.hi) then + goto 3; doubleConstant: if tk1^.token.rval <> tk2^.token.rval then goto 3; @@ -3145,12 +3153,14 @@ var isBin: boolean; {is the value a binary number?} isHex: boolean; {is the value a hex number?} isLong: boolean; {is the value a long number?} + isLongLong: boolean; {is the value a long long number?} isReal: boolean; {is the value a real number?} numIndex: 0..maxLine; {index into workString} sp: stringPtr; {for saving identifier names} stringIndex: 0..maxLine; {length of the number string} unsigned: boolean; {is the number unsigned?} val: integer; {value of a digit} + c1: char; {saved copy of last character} numString: pString; {characters in the number} @@ -3217,6 +3227,7 @@ isBin := false; {assume it's not binary} isHex := false; {assume it's not hex} isReal := false; {assume it's an integer} isLong := false; {assume a short integer} +isLongLong := false; unsigned := false; {assume signed numbers} stringIndex := 0; {no digits so far...} if scanWork then begin {set up the scanner} @@ -3276,11 +3287,17 @@ if c2 in ['e','E'] then begin {handle an exponent} end; {if} 1: while c2 in ['l','u','L','U'] do {check for long or unsigned} - if c2 in ['l','L'] then begin - NextChar; - if isLong then + if c2 in ['l','L'] then begin + if isLong or isLongLong then FlagError(156); - isLong := true; + c1 := c2; + NextChar; + if c2 = c1 then begin + NextChar; + isLongLong := true; + end {if} + else + isLong := true; end {if} else {if c2 in ['u','U'] then} begin NextChar; @@ -3293,6 +3310,8 @@ while c2 in ['l','u','L','U'] do {check for long or unsigned} if c2 in ['f','F'] then begin {allow F designator on reals} if unsigned then FlagError(91); + if isLongLong then + FlagError(156); if not isReal then begin FlagError(100); isReal := true; @@ -3395,7 +3414,17 @@ else begin {hex, octal, & binary} end; {else} if long(token.lval).msw <> 0 then isLong := true; - if isLong then begin + if isLongLong then begin + {TODO support actual long long range} + token.qval.lo := token.lval; + token.qval.hi := 0; + if unsigned then + token.kind := ulonglongConst + else + token.kind := longlongConst; + token.class := longlongConstant; + end {if} + else if isLong then begin if unsigned or (token.lval & $80000000 <> 0) then token.kind := ulongConst else @@ -3718,6 +3747,8 @@ 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]; new(mp); {__LINE__} mp^.name := @'__LINE__'; @@ -3877,7 +3908,7 @@ repeat intConstant : token.ival := -token.ival; longConstant : token.lval := -token.lval; doubleConstant: token.rval := -token.rval; - otherwise: ; + longlongConstant,otherwise: Error(108); end; {case} end {if} else diff --git a/Table.asm b/Table.asm index e154d9f..fbbf4a9 100644 --- a/Table.asm +++ b/Table.asm @@ -284,7 +284,8 @@ charKinds start character set charSym start single character symbols enum ident,0 identifiers ! constants - enum (intconst,uintconst,longconst,ulongconst,doubleconst) + enum (intconst,uintconst,longconst,ulongconst,longlongconst) + enum (ulonglongconst,doubleconst) enum stringconst ! reserved words enum (_Alignassy,_Alignofsy,_Atomicsy,_Boolsy,_Complexsy) @@ -356,6 +357,8 @@ icp start in-coming priority for expression dc i1'200' uintconst dc i1'200' longconst dc i1'200' ulongconst + dc i1'200' longlongconst + dc i1'200' ulonglongconst dc i1'200' doubleconst dc i1'200' stringconst dc i1'200' _Alignassy @@ -521,6 +524,8 @@ isp start in stack priority for expression dc i1'0' uintconst dc i1'0' longconst dc i1'0' ulongconst + dc i1'0' longlongconst + dc i1'0' ulonglongconst dc i1'0' doubleconst dc i1'0' stringconst dc i1'0' _Alignassy @@ -893,7 +898,8 @@ wordHash start reserved word hash table enum ident,0 identifiers ! constants - enum (intconst,uintconst,longconst,ulongconst,doubleconst) + enum (intconst,uintconst,longconst,ulongconst,longlongconst) + enum (ulonglongconst,doubleconst) enum stringconst ! reserved words enum (_Alignassy,_Alignofsy,_Atomicsy,_Boolsy,_Complexsy)